From 4da5bfa497769668d8fd8298f68548f78fa81929 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Fri, 25 Oct 2024 10:40:22 +0100
Subject: [PATCH] Implement downwards inventory drag, buggy

---
 ghcidOutput         |  9 ++------
 src/Dodge/Update.hs | 56 +++++++++++++++++++++++++++++----------------
 2 files changed, 38 insertions(+), 27 deletions(-)

diff --git a/ghcidOutput b/ghcidOutput
index f2678c723..ea03e43d7 100644
--- a/ghcidOutput
+++ b/ghcidOutput
@@ -1,10 +1,5 @@
-/home/justin/Haskell/loop/src/Dodge/Update.hs:356:5-9: warning: [-Wunused-local-binds]
+/home/justin/Haskell/loop/src/Dodge/Update.hs:366:5-9: warning: [-Wunused-local-binds]
     Defined but not used: ‘mysel’
     |
-356 |     mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
+366 |     mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
     |     ^^^^^
-/home/justin/Haskell/loop/src/Dodge/Update.hs:359:17-19: warning: [-Wunused-matches]
-    Defined but not used: ‘sss’
-    |
-359 | shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
-    |                 ^^^
diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs
index 77a498b16..2f34cec66 100644
--- a/src/Dodge/Update.hs
+++ b/src/Dodge/Update.hs
@@ -292,8 +292,9 @@ checkTermDist w = fromMaybe w $ do
     btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
     btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
     guard $ dist btpos (_crPos $ you w) > 40
-    return $ w & hud . hudElement . subInventory 
-        .~ NoSubInventory MouseInvNothing Nothing
+    return $
+        w & hud . hudElement . subInventory
+            .~ NoSubInventory MouseInvNothing Nothing
 
 updateMouseInventorySelection :: Configuration -> World -> World
 updateMouseInventorySelection cfig w = fromMaybe w $ do
@@ -306,8 +307,9 @@ updateMouseInventorySelection' sss cfig w
     | leftclickstart = case msel of
         Nothing -> fromMaybe w $ do
             ysel <- mysel
-            return $ w & hud . hudElement . subInventory . nsSelected 
-                .~ MouseInvSelect ysel Nothing
+            return $
+                w & hud . hudElement . subInventory . nsSelected
+                    .~ MouseInvSelect ysel Nothing
         Just p -> startDrag p w
     | leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
         Just MouseInvSelect{} ->
@@ -319,7 +321,7 @@ updateMouseInventorySelection' sss cfig w
     | otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
         Just (MouseInvSelect ssel (Just esel)) ->
             w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
-                & hud . hudElement . diSelectionExtra 
+                & hud . hudElement . diSelectionExtra
                     .~ (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
                 & augInvDirectSelect (min ssel esel)
         Just (MouseInvSelect _ Nothing) ->
@@ -334,35 +336,49 @@ updateMouseInventorySelection' sss cfig w
     msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
     mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
 
-startDrag :: (Int,Int) -> World -> World
-startDrag (a,b) w = fromMaybe (augInvDirectSelect (a,b) $ setmichosen 0 w) $ do
-    (i,j) <- w ^? hud . hudElement . diSelection . _Just
+startDrag :: (Int, Int) -> World -> World
+startDrag (a, b) w = fromMaybe (augInvDirectSelect (a, b) $ setmichosen 0 w) $ do
+    (i, j) <- w ^? hud . hudElement . diSelection . _Just
     x <- w ^? hud . hudElement . diSelectionExtra
     guard $ i == a && b >= j && b <= j + x
     return $ setmichosen x w
   where
-    setmichosen x = (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
-        . (hud . hudElement . diSelectionExtra .~ x)
+    setmichosen x =
+        (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
+            . (hud . hudElement . diSelectionExtra .~ x)
 
-shiftInvItems :: (Int,Int) -> Configuration -> Point2 
-    -> ListDisplayParams
-    -> SelectionSections a 
-    -> World
-    -> World
+shiftInvItems ::
+    (Int, Int) ->
+    Configuration ->
+    Point2 ->
+    ListDisplayParams ->
+    SelectionSections a ->
+    World ->
+    World
 shiftInvItems topsel cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
-        Just p | p < topsel -> shiftInvItemsUp sss topsel w
-        _ -> w
+    Just p | p < topsel -> shiftInvItemsUp topsel w
+    _ -> fromMaybe w $ do
+        x <- w ^? hud . hudElement . diSelectionExtra
+        return $ case inverseSelBoundaryDown cfig ldp sss mpos of
+            Just p | p > (topsel & _2 +~ x) -> shiftInvItemsDown topsel x w
+            _ -> w
   where
     mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
 
-shiftInvItemsUp :: SelectionSections a -> (Int,Int) -> World -> World
-shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
+shiftInvItemsUp :: (Int, Int) -> World -> World
+shiftInvItemsUp (_, i) w = fromMaybe w $ do
     x <- w ^? hud . hudElement . diSelectionExtra
-    return $ foldl' f w [i..i+x]  
+    return $ foldl' f w [i .. i + x]
   where
     f w' i' = swapInvItems g i' w'
     g i' m = fmap fst $ IM.cycleLT i' m
 
+shiftInvItemsDown :: (Int, Int) -> Int -> World -> World
+shiftInvItemsDown (_, i) x w = foldl' f w $ reverse [i .. i + x]
+  where
+    f w' i' = swapInvItems g i' w'
+    g i' m = fmap fst $ IM.cycleGT i' m
+
 --shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
 --shiftInvItemsUp (_, i) (_, j) Just{} w =
 --    w