Improve item location code

src/Dodge/Inventory/Add.hs

@@ -2,8 +2,10 @@ module Dodge.Inventory.Add (
     tryPutItemInInv,
     createPutItem,
     createAndSelectItem,
+    pickUpItem,
 ) where
 
+import Dodge.SoundLogic
 import Dodge.Inventory.FindRoot
 --import Dodge.Item.Grammar
 import Control.Lens
@@ -16,16 +18,21 @@ import Dodge.FloorItem
 import Dodge.Inventory.CheckSlots
 import qualified IntMapHelp as IM
 
-putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
-putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
-    flit <- w ^? cWorld . lWorld . floorItems . ix flid
-    (i, w') <- tryPutItemInInv cid flit w
-    return (Just i, w')
+--putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
+--putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
+--    flit <- w ^? cWorld . lWorld . floorItems . ix flid
+--    (i, w') <- tryPutItemInInv cid flit w
+--    return (Just i, w')
 
 putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
 putItemInInvSlot = IM.insert
 --putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
 
+tryPutItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
+tryPutItemIDInInv cid flitid w = do
+    flit <- w ^? cWorld . lWorld . floorItems . ix flitid
+    tryPutItemInInv cid flit w
+
 -- | Pick up a specific item.
 tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
 tryPutItemInInv cid flit w = case maybeInvSlot of
@@ -41,7 +48,8 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
   where
     it = _flIt flit
     maybeInvSlot = checkInvSlotsYou it w
-    updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_itID it) .~ InInv cid invid
+    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
@@ -53,6 +61,16 @@ createAndSelectItem itm w = case createPutItem itm w of
     (Nothing, w') -> w'
 
 createPutItem :: Item -> World -> (Maybe Int, World)
-createPutItem it w =
-    uncurry (putItemInInvID 0) $
+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
+
+-- | 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