Can pick up items by dragging

src/Dodge/Update/Input/InGame.hs

@@ -3,6 +3,7 @@ module Dodge.Update.Input.InGame (
     updateMouseInGame,
 ) where
 
+import Data.Monoid
 import NewInt
 import Control.Applicative
 import Control.Monad
@@ -112,22 +113,27 @@ tryDropSelected mpos w = do
     xs <- w ^? hud . hudElement . diSelectionExtra
     return $ IS.foldr (dropItem cr) w xs
 
-tryPickupSelected :: Maybe (Int,Int) -> World -> Maybe World
-tryPickupSelected mpos w = do
+tryPickupSelected :: Int -> Maybe (Int,Int) -> World -> Maybe World
+tryPickupSelected k mpos w = do
+    guard $ k == 3
     guard $ maybe True (\(i,_) -> i == 0) mpos
---    cr <- w ^? cWorld . lWorld . creatures . ix 0
---    let nfreeslots = crNumFreeSlots cr
-    (3, _) <- w ^? hud . hudElement . diSelection . _Just
---    xs <- w ^? hud . hudElement . diSelectionExtra
---    OverInvDrag 3 x <- w ^? input . mouseContext
-    return w
---    return $ IS.foldr (dropItem cr) w xs
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    let nfreeslots = crNumFreeSlots cr
+    xs <- w ^? hud . hudElement . diSelectionExtra
+    let itmstopickup = mapMaybe g $ IS.toList xs
+    let slotsneeded = alaf Sum foldMap (_itInvSize . _flIt) $ itmstopickup
+    guard $ nfreeslots >= slotsneeded
+    return $ foldl' (flip $ pickUpItem 0) w itmstopickup
+  where
+    g i = do
+        NInt j <- w ^? hud . closeItems . ix i
+        w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
 
 updateMouseReleaseInGame :: World -> World
 updateMouseReleaseInGame w = case w ^. input . mouseContext of
-    OverInvDrag _ mpos _ _ -> 
+    OverInvDrag k mpos _ _ -> 
         input . mouseContext .~ MouseInGame $
-        fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected mpos w
+        fromMaybe w $ tryDropSelected mpos w <|> tryPickupSelected k mpos w
 --    OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
 --        j <- mpos
 --        guard $ fst j == i
@@ -243,6 +249,8 @@ shiftInvItems ::
     World ->
     World
 shiftInvItems k x ab bn xs ss w = fromMaybe w $ do
+    let xk = fst x
+    guard $ xk == k || xk + 1 == k || xk -1 == k
     (maxi,_) <- IS.maxView xs
     (mini,_) <- IS.minView xs
     if x < (k,mini)