justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue reload refactor

Browse Source
This commit is contained in:
justin
2022-06-21 14:07:17 +01:00
parent 14a7189b44
commit 53c8be0679
33 changed files with 106 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Action.hs
+4 -4
View File
@@ -243,16 +243,16 @@ stripNoItems cr = organiseInvKeys (_crID cr) .
organiseInvKeys :: Int -> World -> World
organiseInvKeys cid w = w & creatures . ix cid %~
( ( crInvSel .~ newSelKey ) . (crInv .~ newInv ) )
( ( crInvSel . iselPos .~ newSelKey ) . (crInv .~ newInv ) )
where
cr = _creatures w IM.! cid
pairs = IM.toList (_crInv cr)
newSelKey = fromMaybe 0 $ findIndex ( (== _crInvSel cr) . fst) pairs
newSelKey = fromMaybe 0 $ findIndex ( (== crSel cr) . fst) pairs
newInv = IM.fromAscList $ zip [0..] $ map snd pairs
dropUnselected :: Creature -> World -> World
dropUnselected cr w = foldr (dropItem cr) w . IM.keys
$ _crInvSel cr `IM.delete` _crInv cr
$ crSel cr `IM.delete` _crInv cr
dropExcept :: Creature -> Int -> World -> World
dropExcept cr invid w = foldr (dropItem cr) w . IM.keys
@@ -276,7 +276,7 @@ youDropItem w
youDropItem' :: World -> World
youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
Just Uncursed -> w
& dropItem cr (_crInvSel cr)
& dropItem cr (crSel cr)
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
_ -> w
where