Cleanup close items code

This commit is contained in:
2025-08-19 20:17:27 +01:00
parent a373b31152
commit 084210ea7d
2 changed files with 30 additions and 30 deletions
+21 -22
View File
@@ -17,7 +17,6 @@ module Dodge.Inventory (
destroyAllInvItems,
) where
import Dodge.Equipment
--import Dodge.Wall.Delete
--import Dodge.Item.Location
import Data.Function
@@ -26,6 +25,7 @@ import Data.Maybe
import Dodge.Base
import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.Equipment
--import Dodge.Euse
import Dodge.Inventory.CheckSlots
import Dodge.Inventory.Location
@@ -58,18 +58,22 @@ destroyInvItem cid invid w =
. (cWorld . lWorld . hotkeys . at hk .~ Nothing)
destroyAllInvItems :: Creature -> World -> World
destroyAllInvItems cr w = foldl' (flip $ destroyInvItem (cr ^. crID)) w
. reverse . IM.keys $ cr ^. crInv
destroyAllInvItems cr w =
foldl' (flip $ destroyInvItem (cr ^. crID)) w
. reverse
. IM.keys
$ cr ^. crInv
destroyItem :: Int -> World -> World
destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
Nothing -> error $ "Tried to destroy item that does not exist; item id: "++ show itid
Just InInv {_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
Just OnTurret{} -> error "need to write code for destroying items on turrets"
Just (OnFloor (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
Just (OnFloor (NInt i)) ->
w & cWorld . lWorld . itemLocations . at itid .~ Nothing
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
-- note rmInvItem does not fully destroy the item, other updates to the item
-- location are required
rmInvItem :: Int -> Int -> World -> World
@@ -119,23 +123,18 @@ rmInvItem cid invid w =
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w =
w
& hud . closeItems %~ f
w & hud . closeItems %~ f
& hud . closeButtons %~ g
where
g oldbts = intersect oldbts cbts `union` cbts
f olditems = intersect olditems citems `union` citems
cbts = _btID <$> filter (isclose . _btPos) activeButtons
citems =
fmap _flItID
. filter (isclose . _flItPos)
. IM.elems
$ w ^. cWorld . lWorld . floorItems . unNIntMap
isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
ypos = _crPos $ you w
activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
lw = w ^. cWorld . lWorld
citems = lw^..floorItems . unNIntMap . each . filtered (isclose . _flItPos) . to _flItID
isclose x = dist y x < 40 && hasButtonLOS y x w
y = _crPos $ you w
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
canpress bt = case bt ^. btEvent of
ButtonPress {_btOn = t} -> not t
ButtonPress{_btOn = t} -> not t
ButtonAccessTerminal tid -> fromMaybe False $ do
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
return (x /= TerminalDeactivated)
@@ -205,8 +204,8 @@ invSetSelectionPos i j w =
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations 0
where
f Nothing = Just (i,j,mempty)
f (Just (_,_,s)) = Just (i,j,s)
f Nothing = Just (i, j, mempty)
f (Just (_, _, s)) = Just (i, j, s)
scrollAugInvSel :: Int -> World -> World
scrollAugInvSel yi w
+9 -8
View File
@@ -159,7 +159,8 @@ drawSubInventory subinv cfig w = case subinv of
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory{} -> drawRBOptions cfig w
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> foldMap (drawTerminalDisplay cfig) (w ^? cWorld . lWorld . terminals . ix tid)
DisplayTerminal tid -> foldMap (drawTerminalDisplay cfig)
(w ^? cWorld . lWorld . terminals . ix tid)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
MapperInventory _ _ itid -> drawMapperInventory itid w
@@ -354,14 +355,14 @@ combineInventoryExtra sss msel cfig w = fold $ do
sss'
(Just (0, i))
--drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
drawTerminalDisplay :: Configuration -> Terminal -> Picture
drawTerminalDisplay cfig tm = invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig f
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
drawTerminalDisplay cfig tm =
invHead cfig ("T-" ++ show tid)
<> drawSelectionList secondColumnParams cfig f
<> color
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
(drawSelectionListBackground secondColumnParams cfig tsize)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
tid = tm ^. tmID
tsize = getMaxLinesTM + 1