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

Commit before only putting item locations in single itemLocations intmap

Browse Source
This commit is contained in:
justin
2024-09-24 09:31:20 +01:00
parent 77e5f684aa
commit a6eb5cf982
8 changed files with 242 additions and 216 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory/Add.hs
+36 -25
View File
@@ -1,7 +1,8 @@
module Dodge.Inventory.Add (
tryPutItemInInv,
createPutItem,
createAndSelectItem,
--createPutItem,
--createAndSelectItem,
createItemYou,
pickUpItem,
) where
@@ -11,16 +12,16 @@ import Dodge.Inventory.Location
--import Dodge.Item.Grammar
import Control.Lens
import Data.Maybe
import Dodge.Base.You
import Dodge.Combine.Module
import Dodge.Data.SelectionList
--import Dodge.Base.You
--import Dodge.Combine.Module
--import Dodge.Data.SelectionList
import Dodge.Data.World
import Dodge.FloorItem
import Dodge.Inventory.CheckSlots
import qualified IntMapHelp as IM
tryPutItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World)
tryPutItemIDInInv cid flitid w = do
tryPutFloorItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World)
tryPutFloorItemIDInInv cid flitid w = do
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid)
tryPutItemInInv cid flit w
@@ -34,8 +35,9 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
, w
& updateItLocation i
& cWorld . lWorld . floorItems . unNIntMap %~ IM.delete (_unNInt $ _flItID flit)
-- & cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
& cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
& cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
-- I forget whether using "at" rather than "IM.insert" here caused problems
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
& setInvPosFromSS
& cWorld . lWorld %~ crUpdateItemLocations cid
)
@@ -45,24 +47,33 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it)
.~ InInv cid invid False False
createAndSelectItem :: Item -> World -> World
createAndSelectItem itm w = case createPutItem itm w of
(Just i, w') ->
w'
& hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
& cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
.~ InInventory (SelectedItem i
$ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
(Nothing, w') -> w'
---- should select the item on the floor if no inventory space?
--createAndSelectItem :: Item -> World -> World
--createAndSelectItem itm w = case createPutItem itm w of
-- (Just i, w') ->
-- w'
-- & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
-- & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
-- .~ InInventory (SelectedItem i
-- $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
-- (Nothing, w') -> w'
createPutItem :: Item -> World -> (Maybe Int, World)
createPutItem it w = fromMaybe (Nothing,w) $ do
(i,w') <- uncurry (tryPutItemIDInInv 0) $
copyItemToFloorID (_crPos $ you w) (applyModules it) w
return (Just i, w')
--createPutItem :: Item -> World -> (Maybe Int, World)
--createPutItem it w = fromMaybe (Nothing,w) $ do
-- (i,w') <- uncurry (tryPutItemIDInInv 0) $
-- copyItemToFloorID (_crPos $ you w) (applyModules it) w
-- return (Just i, w')
--pickUpItemID :: Int -> Int -> World -> World
--pickUpItemID cid flid w = pickUpItem cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
createItemYou :: Item -> World -> (ItemLocation, World)
createItemYou itm w = fromMaybe (OnFloor flid, w') $ do
(invid, w'') <- tryPutFloorItemIDInInv 0 flid w'
itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
return (itloc, w'')
where
itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
(flid,w') = copyItemToFloorID pos (itm & itID .~ itid) w
-- | Pick up a specific item.
pickUpItem :: Int -> FloorItem -> World -> World