Improve item pickup by dragging

src/Dodge/Inventory/Add.hs

@@ -4,8 +4,11 @@ module Dodge.Inventory.Add (
     --createAndSelectItem,
     createItemYou,
     pickUpItem,
+    pickUpItemAt,
 ) where
 
+import Dodge.Inventory.Swap
+import Control.Monad
 import NewInt
 import Dodge.SoundLogic
 import Dodge.Inventory.Location
@@ -25,6 +28,16 @@ tryPutFloorItemIDInInv cid flitid w = do
     flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid)
     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 = case maybeInvSlot of
@@ -93,3 +106,9 @@ pickUpItem :: Int -> FloorItem -> World -> World
 pickUpItem cid flit w =
     maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
         tryPutItemInInv cid flit 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