Tweak mouse over display

src/Dodge/Render/HUD.hs

@@ -66,10 +66,10 @@ drawInventory sss w cfig =
         <> drawRootCursor w sss (w ^? hud . hudElement . diSelection . _Just) ldp cfig
         <> iextra
         <> drawMouseOver cfig w
-        <> translateScreenPos
-            cfig
-            (ldp ^. ldpPos)
-            (drawDISelections w)
+--        <> translateScreenPos
+--            cfig
+--            (ldp ^. ldpPos)
+--            (drawDISelections w)
   where
     ldp = invDisplayParams w
     curs = invCursorParams w
@@ -111,7 +111,9 @@ getRootItemBounds i inv = do
     return (x, y)
 
 drawMouseOver :: Configuration -> World -> Picture
-drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
+drawMouseOver cfig w = concat (invsel <|> combinvsel
+    <|> drawDragSelect cfig w)
+    <> concat (drawDragSelected cfig w)
   where
     invsel = do
         (j, i) <- w ^? input . mouseContext . mcoInvSelect <|>
@@ -140,15 +142,33 @@ drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
 --            return ((i, j), (i, j + x))
 --        _ -> Nothing
 
-drawDISelections :: World -> Picture
-drawDISelections w = fromMaybe mempty $ do
+--drawDISelections :: World -> Picture
+--drawDISelections w = fromMaybe mempty $
+--    drawDragSelect w <|> 
+--    drawDragSelected w
+
+drawDragSelected :: Configuration -> World -> Maybe Picture
+drawDragSelected cfig w = do
+    y <- w ^? hud . hudElement . diSelectionExtra
+    guard $ y > 0
+    (i,j) <- w ^? hud . hudElement . diSelection . _Just
+    guard $ i == 0
+    sss <- w ^? hud . hudElement . diSections
+    let idp = invDisplayParams w
+    let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (0, x)
+    return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
+     . color (withAlpha 0.2 white) . foldMap f $ [j .. j + y]
+
+drawDragSelect :: Configuration -> World -> Maybe Picture
+drawDragSelect cfig w = do
     OverInvDragSelect (i,j) mselend <- w ^? input . mouseContext
     (a,b) <- mselend
     guard $ i == a
     sss <- w ^? hud . hudElement . diSections
     let idp = invDisplayParams w
     let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (i, x)
-    return . color (withAlpha 0.2 white) . foldMap f $ [min j b .. max j b]
+    return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
+     . color (withAlpha 0.2 white) . foldMap f $ [min j b .. max j b]
 --  fromMaybe mempty $ do
 --    ((i, j), (a, b)) <- getMouseInvSel w
 --    guard $ i == a