Reimplement dragging upwards with mouse

src/Dodge/Render/HUD.hs

@@ -6,9 +6,9 @@ module Dodge.Render.HUD (
     selNumPosCardinal, -- this shoud probably be pushed back here
 ) where
 
-import Dodge.SelectionSections
 import Control.Lens
 import Control.Monad
+import Data.List (sort)
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
@@ -31,11 +31,11 @@ import Dodge.Render.Connectors
 import Dodge.Render.HUD.Carte
 import Dodge.Render.List
 import Dodge.ScreenPos
+import Dodge.SelectionSections
 import Dodge.SelectionSections.Draw
 import Geometry
 import qualified IntMapHelp as IM
 import Justify
-import Data.List (sort)
 import Picture
 import SDL (MouseButton (..))
 
@@ -60,7 +60,9 @@ drawInventory :: SelectionSections () -> World -> Configuration -> Picture
 drawInventory sss w cfig =
     drawSelectionSections sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
         <> iextra
-        <> translateScreenPos cfig (ldp ^. ldpPos)
+        <> translateScreenPos
+            cfig
+            (ldp ^. ldpPos)
             (drawDIMouseOver w)
         <> drawDISelections w cfig
         <> drawDISelections' w cfig
@@ -75,41 +77,39 @@ drawInventory sss w cfig =
 
 drawDIMouseOver :: World -> Picture
 drawDIMouseOver w = fromMaybe mempty $ do
-    (_,i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
+    (_, i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
     sss <- w ^? hud . hudElement . diSections
     let idp = invDisplayParams w
-    return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0,i) 10 idp sss
+    return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0, i) 10 idp sss
 
-getMouseInvSel :: World -> Maybe ((Int,Int),(Int,Int))
+getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
 getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
-    Just (MouseInvSelect s (Just e)) -> Just (s,e)
+    Just (MouseInvSelect s (Just e)) -> Just (s, e)
     _ -> Nothing
 
-getMouseInvSel' :: World -> Maybe ((Int,Int),(Int,Int))
-getMouseInvSel' w = case w ^? hud . hudElement . subInventory . nsSelected of
-    Just (MouseInvChosen x) -> do
-        (i,j) <- w ^? hud . hudElement . diSelection . _Just
-        return ((i,j),(i,j+x))
-    _ -> Nothing
+getMouseInvSel' :: World -> Maybe ((Int, Int), (Int, Int))
+getMouseInvSel' w = do
+    x <- w ^? hud . hudElement . diSelectionExtra
+    (i, j) <- w ^? hud . hudElement . diSelection . _Just
+    return ((i, j), (i, j + x))
 
 drawDISelections :: World -> Configuration -> Picture
 drawDISelections w cfig = fromMaybe mempty $ do
-    ((i,j),(a,b)) <- getMouseInvSel w
+    ((i, j), (a, b)) <- getMouseInvSel w
     sss <- w ^? hud . hudElement . diSections
     let idp = invDisplayParams w
     tp <- selNumPosCardinal NorthWest8 cfig idp sss i j
     bp <- selNumPosCardinal SouthWest8 cfig idp sss a b
-    return . color red . line $ sort [tp,bp]
+    return . color red . line $ sort [tp, bp]
 
 drawDISelections' :: World -> Configuration -> Picture
 drawDISelections' w cfig = fromMaybe mempty $ do
-    ((i,j),(a,b)) <- getMouseInvSel' w
+    ((i, j), (a, b)) <- getMouseInvSel' w
     sss <- w ^? hud . hudElement . diSections
     let idp = invDisplayParams w
     tp <- selNumPosCardinal NorthEast8 cfig idp sss i j
     bp <- selNumPosCardinal SouthEast8 cfig idp sss a b
-    return . color green . line $ sort [tp,bp]
-
+    return . color green . line $ sort [tp, bp]
 
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
@@ -246,9 +246,12 @@ inventoryExtraH sss cfig w i is = fromMaybe mempty $ do
   where
     snum = selNumPos cfig (invDisplayParams w) sss 0
 
-combineInventoryExtra :: SelectionSections CombinableItem 
-    -> Maybe (Int,Int)
-    -> Configuration -> World -> Picture
+combineInventoryExtra ::
+    SelectionSections CombinableItem ->
+    Maybe (Int, Int) ->
+    Configuration ->
+    World ->
+    Picture
 combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
     (i, j) <- msel
     cpos <- selSecYint i j sss
@@ -379,6 +382,7 @@ selNumPos ::
     Int ->
     Maybe Point2
 selNumPos = selNumPosCardinal West8
+
 --selNumPos cfig ldp sss i j = do
 --    ipos <- selSecYint i j sss
 --    size <- selSecSelSize i j sss
@@ -416,8 +420,5 @@ selNumPosCardinal card cfig ldp sss i j = do
     s = _ldpScale ldp
     ygap = _ldpVerticalGap ldp
 
-
-
-
 selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
 selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor