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

Refactor floor items to use centralised items intmap

Browse Source
This commit is contained in:
justin
2025-08-24 13:14:49 +01:00
parent c38d03165f
commit 22b4be440a
14 changed files with 170 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory/Add.hs
+79 -52
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Inventory.Add (
tryPutItemInInv,
createItemYou,
@@ -17,49 +18,13 @@ import Dodge.SoundLogic
import qualified IntMapHelp as IM
import NewInt
tryPutFloorItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
tryPutFloorItemIDInInv cid i w = do
flit <- w ^? cWorld . lWorld . floorItems . ix i
tryPutItemInInv cid flit w
-- not sure why we have the cid here, this will probably only work for cid == 0
tryPutItemInInvAt :: Int -> Int -> FloorItem -> World -> Maybe World
tryPutItemInInvAt i cid flit w = do
(j, w') <- tryPutItemInInv cid flit w
guard (i <= j)
return $ foldr f w' [i + 1 .. j]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
-- | Pick up a specific item.
tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
tryPutItemInInv cid flit w = do
i <- checkInvSlotsYou it w
Just
( i
, w
& cWorld . lWorld . floorItems %~ IM.delete (flit ^. flIt . itID . unNInt)
& cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
& updateItLocation i
-- I forget whether using "at" rather than "IM.insert" here caused problems
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- note item locations are updated twice: first for the ilInvID,
-- second for the root/selected item bools
& cWorld . lWorld %~ crUpdateItemLocations cid
& setInvPosFromSS
& updateselectionextra
& cWorld . lWorld %~ crUpdateItemLocations cid
)
where
updateselectionextra
| cid == 0 =
hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
it = _flIt flit
-- not sure if the following is necessary
updateItLocation invid w' =
w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
.~ InInv
-- should check that the item is not already in your inventory
-- this assumes that this is a floor item
tryPutItemInInv :: Int -> Int -> World -> Maybe (Int,World)
tryPutItemInInv cid itid w = do
itm <- w ^? cWorld . lWorld . items . ix itid
invid <- checkInvSlotsYou itm w
let itloc = InInv
{ _ilCrID = cid
, _ilInvID = invid
, _ilIsRoot = False
@@ -67,6 +32,66 @@ tryPutItemInInv cid flit w = do
, _ilIsAttached = False
, _ilEquipSite = Nothing
}
newitm = itm & itLocation .~ itloc
return $ (invid,) $ w
& cWorld . lWorld %~ crUpdateItemLocations cid
-- not sure about the order of these...
& cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ newitm
& cWorld . lWorld . items . at itid ?~ newitm
& cWorld . lWorld . itemLocations . at itid ?~ itloc
& cWorld . lWorld . floorItems . at itid .~ Nothing
& updateselectionextra
where
updateselectionextra
| cid == 0 =
hud . hudElement . diSelection . _Just . _3 %~ const mempty
| otherwise = id
-- not sure why we have the cid here, this will probably only work for cid == 0
tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
tryPutItemInInvAt i cid itid w = do
(j, w') <- tryPutItemInInv cid itid w
guard (i <= j)
return $ foldr f w' [i + 1 .. j]
where
f j = swapInvItems (\_ _ -> Just (j -1)) j
---- | Pick up a specific item.
--tryPutItemInInv :: Int -> Item -> Int -> World -> Maybe (Int, World)
--tryPutItemInInv cid flit itid w = do
-- i <- checkInvSlotsYou it w
-- Just
-- ( i
-- , w
-- & cWorld . lWorld . floorItems %~ IM.delete itid
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- & updateItLocation i
-- -- I forget whether using "at" rather than "IM.insert" here caused problems
-- -- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-- -- note item locations are updated twice: first for the ilInvID,
-- -- second for the root/selected item bools
-- & cWorld . lWorld %~ crUpdateItemLocations cid
-- & setInvPosFromSS
-- & updateselectionextra
-- & cWorld . lWorld %~ crUpdateItemLocations cid
-- )
-- where
-- updateselectionextra
-- | cid == 0 =
-- hud . hudElement . diSelection . _Just . _3 %~ const mempty
-- | otherwise = id
-- it = _flIt flit
-- -- not sure if the following is necessary
-- updateItLocation invid w' =
-- w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it)
-- .~ InInv
-- { _ilCrID = cid
-- , _ilInvID = invid
-- , _ilIsRoot = False
-- , _ilIsSelected = False
-- , _ilIsAttached = False
-- , _ilEquipSite = Nothing
-- }
---- should select the item on the floor if no inventory space?
--createAndSelectItem :: Item -> World -> World
@@ -87,7 +112,7 @@ tryPutItemInInv cid flit w = do
createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor, w') $ do
(invid, w'') <- tryPutFloorItemIDInInv 0 itid w'
(invid, w'') <- tryPutItemInInv 0 itid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'')
where
@@ -96,13 +121,15 @@ createItemYou itm w = fromMaybe (OnFloor, w') $ do
w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
-- | Pick up a specific item.
pickUpItem :: Int -> FloorItem -> World -> World
pickUpItem cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
tryPutItemInInv cid flit w
pickUpItem :: Int -> Int -> World -> World
pickUpItem cid itid w = fromMaybe w $ do
(_,w') <- tryPutItemInInv cid itid w
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
return $ soundStart (CrSound cid) p pickUpS Nothing w'
-- | Pick up a specific item.
pickUpItemAt :: Int -> Int -> FloorItem -> World -> World
pickUpItemAt invid cid flit w =
maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing) $
tryPutItemInInvAt invid cid flit w
pickUpItemAt :: Int -> Int -> Int -> World -> World
pickUpItemAt invid cid itid w = fromMaybe w $ do
w' <- tryPutItemInInvAt invid cid itid w
p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
return $ soundStart (CrSound cid) p pickUpS Nothing w'