Can pick up items by dragging

ghcidOutput

@@ -1 +1 @@
-All good (593 modules, at 12:39:43)
+All good (593 modules, at 14:02:41)

src/Dodge/Base/Collide.hs

@@ -206,10 +206,11 @@ hasLOS p1 p2 =
 
 hasButtonLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasButtonLOS #-}
-hasButtonLOS p1 p2 =
-    not
-        . collidePointTestFilter (not . _wlTouchThrough) p1 p2
-        . wlsNearSeg p1 p2
+hasButtonLOS _ _ = const True
+--hasButtonLOS p1 p2 =
+--    not
+--        . collidePointTestFilter (not . _wlTouchThrough) p1 p2
+--        . wlsNearSeg p1 p2
 
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOSIndirect #-}

src/Dodge/DisplayInventory.hs

@@ -183,8 +183,7 @@ filterSectionsPair ::
     String ->
     Maybe String ->
     (IM.IntMap (SelectionItem a), IM.IntMap (SelectionItem a))
-filterSectionsPair infocus filtfn itms filtdescription mfilt =
-    (filtsis, itms')
+filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
   where
     filtcurs = if infocus then cFilledRect else cWireRect
     filtsis = fold $ do
@@ -345,21 +344,19 @@ enterCombineInv :: Configuration -> World -> World
 enterCombineInv cfig w =
     w & hud . hudElement . subInventory
         .~ CombineInventory
-            { _ciSections = sss
+            { _ciSections = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
             , _ciSelection = selpos
             , _ciFilter = Nothing
             }
         & hud . hudElement . diInvFilter .~ Nothing
   where
     cm' = IM.fromDistinctAscList . zip [0 ..] $ combineList w
-    cm
-        | null cm' = IM.singleton 0 $ SelectionInfo ["No possible combinations"] 1 False white 0
+    cm  | null cm' = IM.singleton 0 
+            $ SelectionInfo ["No possible combinations"] 1 False white 0
         | otherwise = cm'
-    sss = IM.fromDistinctAscList [(-1, filtsection), (0, combsection)]
     selpos
         | null cm' = Nothing
         | otherwise = Just (0, 0)
-    availablelines = getAvailableListLines secondColumnParams cfig
     filtsection =
         SelectionSection
             { _ssItems = mempty
@@ -374,6 +371,7 @@ enterCombineInv cfig w =
             cm
             availablelines
             0
+    availablelines = getAvailableListLines secondColumnParams cfig
 
 regexList :: String -> [String] -> Bool
 regexList x = any (List.isInfixOf x)

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)