Cleanup close items code
This commit is contained in:
+19
-20
@@ -17,7 +17,6 @@ module Dodge.Inventory (
|
|||||||
destroyAllInvItems,
|
destroyAllInvItems,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dodge.Equipment
|
|
||||||
--import Dodge.Wall.Delete
|
--import Dodge.Wall.Delete
|
||||||
--import Dodge.Item.Location
|
--import Dodge.Item.Location
|
||||||
import Data.Function
|
import Data.Function
|
||||||
@@ -26,6 +25,7 @@ import Data.Maybe
|
|||||||
import Dodge.Base
|
import Dodge.Base
|
||||||
import Dodge.Data.SelectionList
|
import Dodge.Data.SelectionList
|
||||||
import Dodge.Data.World
|
import Dodge.Data.World
|
||||||
|
import Dodge.Equipment
|
||||||
--import Dodge.Euse
|
--import Dodge.Euse
|
||||||
import Dodge.Inventory.CheckSlots
|
import Dodge.Inventory.CheckSlots
|
||||||
import Dodge.Inventory.Location
|
import Dodge.Inventory.Location
|
||||||
@@ -58,15 +58,19 @@ destroyInvItem cid invid w =
|
|||||||
. (cWorld . lWorld . hotkeys . at hk .~ Nothing)
|
. (cWorld . lWorld . hotkeys . at hk .~ Nothing)
|
||||||
|
|
||||||
destroyAllInvItems :: Creature -> World -> World
|
destroyAllInvItems :: Creature -> World -> World
|
||||||
destroyAllInvItems cr w = foldl' (flip $ destroyInvItem (cr ^. crID)) w
|
destroyAllInvItems cr w =
|
||||||
. reverse . IM.keys $ cr ^. crInv
|
foldl' (flip $ destroyInvItem (cr ^. crID)) w
|
||||||
|
. reverse
|
||||||
|
. IM.keys
|
||||||
|
$ cr ^. crInv
|
||||||
|
|
||||||
destroyItem :: Int -> World -> World
|
destroyItem :: Int -> World -> World
|
||||||
destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
|
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
|
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 InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
|
||||||
Just OnTurret{} -> error "need to write code for destroying items on turrets"
|
Just OnTurret{} -> error "need to write code for destroying items on turrets"
|
||||||
Just (OnFloor (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
Just (OnFloor (NInt i)) ->
|
||||||
|
w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
||||||
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
|
& cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
|
||||||
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
|
||||||
|
|
||||||
@@ -119,23 +123,18 @@ rmInvItem cid invid w =
|
|||||||
-- this looks ugly...
|
-- this looks ugly...
|
||||||
updateCloseObjects :: World -> World
|
updateCloseObjects :: World -> World
|
||||||
updateCloseObjects w =
|
updateCloseObjects w =
|
||||||
w
|
w & hud . closeItems %~ f
|
||||||
& hud . closeItems %~ f
|
|
||||||
& hud . closeButtons %~ g
|
& hud . closeButtons %~ g
|
||||||
where
|
where
|
||||||
g oldbts = intersect oldbts cbts `union` cbts
|
g oldbts = intersect oldbts cbts `union` cbts
|
||||||
f olditems = intersect olditems citems `union` citems
|
f olditems = intersect olditems citems `union` citems
|
||||||
cbts = _btID <$> filter (isclose . _btPos) activeButtons
|
lw = w ^. cWorld . lWorld
|
||||||
citems =
|
citems = lw^..floorItems . unNIntMap . each . filtered (isclose . _flItPos) . to _flItID
|
||||||
fmap _flItID
|
isclose x = dist y x < 40 && hasButtonLOS y x w
|
||||||
. filter (isclose . _flItPos)
|
y = _crPos $ you w
|
||||||
. IM.elems
|
cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
|
||||||
$ 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
|
|
||||||
canpress bt = case bt ^. btEvent of
|
canpress bt = case bt ^. btEvent of
|
||||||
ButtonPress {_btOn = t} -> not t
|
ButtonPress{_btOn = t} -> not t
|
||||||
ButtonAccessTerminal tid -> fromMaybe False $ do
|
ButtonAccessTerminal tid -> fromMaybe False $ do
|
||||||
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
|
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
|
||||||
return (x /= TerminalDeactivated)
|
return (x /= TerminalDeactivated)
|
||||||
@@ -205,8 +204,8 @@ invSetSelectionPos i j w =
|
|||||||
& setInvPosFromSS
|
& setInvPosFromSS
|
||||||
& cWorld . lWorld %~ crUpdateItemLocations 0
|
& cWorld . lWorld %~ crUpdateItemLocations 0
|
||||||
where
|
where
|
||||||
f Nothing = Just (i,j,mempty)
|
f Nothing = Just (i, j, mempty)
|
||||||
f (Just (_,_,s)) = Just (i,j,s)
|
f (Just (_, _, s)) = Just (i, j, s)
|
||||||
|
|
||||||
scrollAugInvSel :: Int -> World -> World
|
scrollAugInvSel :: Int -> World -> World
|
||||||
scrollAugInvSel yi w
|
scrollAugInvSel yi w
|
||||||
|
|||||||
@@ -159,7 +159,8 @@ drawSubInventory subinv cfig w = case subinv of
|
|||||||
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
-- LockedInventory -> mempty -- topInvCursor col cursPos cfig w
|
||||||
NoSubInventory{} -> drawRBOptions cfig w
|
NoSubInventory{} -> drawRBOptions cfig w
|
||||||
ExamineInventory -> drawExamineInventory 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
|
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
|
||||||
MapperInventory _ _ itid -> drawMapperInventory itid w
|
MapperInventory _ _ itid -> drawMapperInventory itid w
|
||||||
|
|
||||||
@@ -354,9 +355,9 @@ combineInventoryExtra sss msel cfig w = fold $ do
|
|||||||
sss'
|
sss'
|
||||||
(Just (0, i))
|
(Just (0, i))
|
||||||
|
|
||||||
--drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
|
|
||||||
drawTerminalDisplay :: Configuration -> Terminal -> Picture
|
drawTerminalDisplay :: Configuration -> Terminal -> Picture
|
||||||
drawTerminalDisplay cfig tm = invHead cfig ("T-" ++ show tid)
|
drawTerminalDisplay cfig tm =
|
||||||
|
invHead cfig ("T-" ++ show tid)
|
||||||
<> drawSelectionList secondColumnParams cfig f
|
<> drawSelectionList secondColumnParams cfig f
|
||||||
<> color
|
<> color
|
||||||
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
||||||
|
|||||||
Reference in New Issue
Block a user