Fix close floor item bug

src/Dodge/Inventory/Add.hs

@@ -1,27 +1,21 @@
 module Dodge.Inventory.Add (
     tryPutItemInInv,
-    --createPutItem,
-    --createAndSelectItem,
     createItemYou,
     pickUpItem,
     pickUpItemAt,
 ) where
 
-import Dodge.Inventory.Swap
-import Control.Monad
-import NewInt
-import Dodge.SoundLogic
-import Dodge.Inventory.Location
---import Dodge.Item.Grammar
 import Control.Lens
+import Control.Monad
 import Data.Maybe
---import Dodge.Base.You
---import Dodge.Combine.Module
---import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.FloorItem
 import Dodge.Inventory.CheckSlots
+import Dodge.Inventory.Location
+import Dodge.Inventory.Swap
+import Dodge.SoundLogic
 import qualified IntMapHelp as IM
+import NewInt
 
 tryPutFloorItemIDInInv :: Int -> Int -> World -> Maybe (Int, World)
 tryPutFloorItemIDInInv cid i w = do
@@ -31,49 +25,48 @@ tryPutFloorItemIDInInv cid i w = do
 -- 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
+    (j, w') <- tryPutItemInInv cid flit w
     guard (i <= j)
-    return $ foldr f w' [i+1..j]
+    return $ foldr f w' [i + 1 .. j]
   where
-    f j = swapInvItems (\_ _ -> Just (j-1)) j
-    
+    f j = swapInvItems (\_ _ -> Just (j -1)) j
 
 -- | Pick up a specific item.
 tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
-tryPutItemInInv cid flit w = case maybeInvSlot of
-    Nothing -> Nothing
-    Just i ->
-        Just
-            ( i
-            , w
-                & cWorld . lWorld . floorItems %~ IM.delete (flit ^. flIt . itID . unNInt)
-                & cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert 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
-            )
+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 %~ IM.insert 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
+    updateselectionextra
+        | cid == 0 =
+            hud . hudElement . diSelection . _Just . _3 %~ const mempty
         | otherwise = id
     it = _flIt flit
-    maybeInvSlot = checkInvSlotsYou it w
     -- 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
-            }
+    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
@@ -82,7 +75,7 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
 --        w'
 --            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
 --            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
---                .~  InInventory (SelectedItem i 
+--                .~  InInventory (SelectedItem i
 --                    $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
 --    (Nothing, w') -> w'
 
@@ -101,7 +94,6 @@ createItemYou itm w = fromMaybe (OnFloor, w') $ do
     itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
     w' = copyItemToFloorID pos (itm & itID .~ NInt itid) w
-    
 
 -- | Pick up a specific item.
 pickUpItem :: Int -> FloorItem -> World -> World