Fix bugs in item locations

src/Dodge/Inventory/Add.hs

@@ -6,7 +6,7 @@ module Dodge.Inventory.Add (
 ) where
 
 import Dodge.SoundLogic
-import Dodge.Inventory.FindRoot
+import Dodge.Inventory.Location
 --import Dodge.Item.Grammar
 import Control.Lens
 import Data.Maybe
@@ -24,9 +24,9 @@ import qualified IntMapHelp as IM
 --    (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)
+--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
@@ -43,7 +43,10 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
             , w
                 & updateItLocation i
                 & cWorld . lWorld . floorItems %~ IM.delete (_flItID flit)
-                & cWorld . lWorld . creatures . ix cid . crInv %~ putItemInInvSlot i it
+                -- & cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
+                & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
+                & setInvPosFromSS
+                & cWorld . lWorld %~ crUpdateItemLocations cid
             )
   where
     it = _flIt flit
@@ -57,7 +60,8 @@ createAndSelectItem itm w = case createPutItem itm w of
         w'
             & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
             & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
-                .~ InInventory (SelectedItem i (getRootItemID i (you w)))
+                .~  InInventory (SelectedItem i 
+                    $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
     (Nothing, w') -> w'
 
 createPutItem :: Item -> World -> (Maybe Int, World)
@@ -66,8 +70,8 @@ createPutItem it w = fromMaybe (Nothing,w) $ do
         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
+--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

src/Dodge/Inventory/FindRoot.hs

@@ -1,17 +0,0 @@
-module Dodge.Inventory.FindRoot where
-
-import Dodge.Item.Grammar
-import Dodge.Data.Creature
-import Data.Maybe
-import Control.Lens
-
-getRootItemID :: Int -> Creature -> Int
-getRootItemID i cr = fromMaybe i $ do
-    let adj = invAdj (_crInv cr)
-    adj ^? ix i . _1 . _Just . _1
-
-updateRootItemID :: Creature -> Creature
-updateRootItemID cr = fromMaybe cr $ do
-    i <- cr ^? crManipulation . manObject . inInventory . imSelectedItem
-    return $ cr & crManipulation . manObject . inInventory . imRootItem .~
-        getRootItemID i cr