From bc2c9c93697538f8a63800933dc82bb07efaada2 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Fri, 22 Nov 2024 10:33:49 +0000
Subject: [PATCH] Continue mouse/inventory refactor

---
 ghcidOutput                      | 16 +++++++++++++++-
 src/Dodge/Render/Picture.hs      | 14 +++++++-------
 src/Dodge/Update/Input/InGame.hs | 21 ++++++++++++++++++---
 3 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/ghcidOutput b/ghcidOutput
index abac1e2a8..31b6711cd 100644
--- a/ghcidOutput
+++ b/ghcidOutput
@@ -1 +1,15 @@
-All good (594 modules, at 21:00:22)
+/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:123:1-15: warning: [-Wunused-top-binds]
+    Defined but not used: ‘tryDropSelected’
+    |
+123 | tryDropSelected w = do
+    | ^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:130:1-17: warning: [-Wunused-top-binds]
+    Defined but not used: ‘tryPickupSelected’
+    |
+130 | tryPickupSelected w = do
+    | ^^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:134:19: warning: [-Wunused-matches]
+    Defined but not used: ‘x’
+    |
+134 |     OverInvDrag 3 x <- w ^? input . mouseContext
+    |                   ^
diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs
index dcfb61a00..cb74b8470 100644
--- a/src/Dodge/Render/Picture.hs
+++ b/src/Dodge/Render/Picture.hs
@@ -84,10 +84,10 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     MouseMenuClick {} -> drawMenuClick 5
     MouseMenuCursor -> drawMenuCursor 5
     MouseInGame -> drawPlus 5
-    OverInvDrag 0 (Just _) -> drawDrag 5
-    OverInvDrag 0 Nothing -> drawDragDrop 5
-    OverInvDrag 3 (Just _) -> drawDrag 5
-    OverInvDrag 3 Nothing -> drawDragPickup 5
+    OverInvDrag 0 (Just (0,_)) -> drawDrag 5
+    OverInvDrag 0 _ -> drawDragDrop 5
+    OverInvDrag 3 (Just (3,_)) -> drawDrag 5
+    OverInvDrag 3 _ -> drawDragPickup 5
     OverInvDrag _ _ -> drawEmptySet 5
     OverInvDragSelect {} -> drawDragSelect 5
     OverInvSelect {} -> drawSelect 5
@@ -180,9 +180,9 @@ drawDragDrop x =
 
 drawDragPickup :: Float -> Picture
 drawDragPickup x = 
-    line (fmap (+V2 z (-x)) [V2 (-x) x,V2 0 x,V2 0 (-x)])
-    <> line (fmap (+V2 z (-x)) [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)])
---    <> drawSelect 5
+    line [V2 (-0.5 *x) 0, V2 (-z) 0, V2 (-z) z]
+    <> line [V2 (-(z+y)) (z-y), V2 (-z) z, V2 (y-z) (z-y)]
+    <> drawSelect 5
   where
     z = 1.5 * x
     y = 0.7 * x
diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs
index d7c1a633a..c333a2371 100644
--- a/src/Dodge/Update/Input/InGame.hs
+++ b/src/Dodge/Update/Input/InGame.hs
@@ -119,6 +119,21 @@ dropSelected w = fromMaybe w $ do
     xs <- w ^? hud . hudElement . diSelectionExtra
     return $ IS.foldr (dropItem cr) w (IS.insert j xs)
 
+tryDropSelected :: World -> Maybe World
+tryDropSelected w = do
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    (0, j) <- w ^? hud . hudElement . diSelection . _Just
+    xs <- w ^? hud . hudElement . diSelectionExtra
+    return $ IS.foldr (dropItem cr) w (IS.insert j xs)
+
+tryPickupSelected :: World -> Maybe World
+tryPickupSelected w = do
+    cr <- w ^? cWorld . lWorld . creatures . ix 0
+    (3, j) <- w ^? hud . hudElement . diSelection . _Just
+    xs <- w ^? hud . hudElement . diSelectionExtra
+    OverInvDrag 3 x <- w ^? input . mouseContext
+    return $ IS.foldr (dropItem cr) w (IS.insert j xs)
+
 updateMouseReleaseInGame :: World -> World
 updateMouseReleaseInGame w = case w ^. input . mouseContext of
     OverInvDrag i mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
@@ -131,12 +146,12 @@ updateMouseReleaseInGame w = case w ^. input . mouseContext of
     OverInvDragSelect ssel (Just esel) ->
         w & input . mouseContext .~ MouseInGame
             & hud . hudElement . diSelectionExtra
-                .~ h (snd ssel) (snd esel) -- IM.keysSet  [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
+                .~ h ssel (snd esel) -- IM.keysSet  [min (snd ssel) (snd esel) + 1 .. max (snd ssel) (snd esel)]
             & augInvDirectSelect (min ssel esel)
     _ -> w
   where
-    h i j = fold $ do
-        sss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
+    h (k,i) j = fold $ do
+        sss <- w ^? hud . hudElement . diSections . ix k . ssItems
         let (_, xss) = IM.split (min i j -1) sss
             (yss, _) = IM.split (max i j + 1) xss
         return . IM.keysSet $ yss