Incomplete work on mouse interaction with filtered inventory

src/Dodge/Data/Input.hs

@@ -23,6 +23,8 @@ data MouseContext
     | MouseMenuClick {_mcoMenuClick :: Int}
     | MouseMenuCursor
     | OverInvDrag {_mcoDragPos :: Maybe Int}
+    | OverInvFiltDrag
+    | OverInvFiltDragDrop
     | OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverInvFilt { _mcoInvFilt :: (Int,Int)}

src/Dodge/Render/Picture.hs

@@ -86,6 +86,8 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     MouseInGame -> drawPlus 5
     OverInvDrag (Just _) -> drawDrag 5
     OverInvDrag Nothing -> drawDragDrop 5
+    OverInvFiltDrag -> drawFiltDrag 5
+    OverInvFiltDragDrop -> drawFiltDragDrop 5
     OverInvDragSelect {} -> drawDragSelect 5
     OverInvSelect {} -> drawSelect 5
     OverInvFilt {} -> drawCombFilter 5
@@ -156,16 +158,48 @@ drawDragSelect :: Float -> Picture
 drawDragSelect x = polygonWire $ rectWH (0.5 * x) x
 
 drawDrag :: Float -> Picture
-drawDrag x = line [V2 0 x,V2 0 (-x)]
+drawDrag x = line [V2 0 y,V2 0 z]
+    <> line [V2 0 (-y),V2 0 (-z)]
+    <> line [V2 (-w) (z-w), V2 0 z, V2 w (z-w)]
+    <> line [V2 (-w) (w-z), V2 0 (-z), V2 w (w-z)]
+    <> drawSelect 5
+  where
+    z = 1.5 * x
+    y = 0.5 * x
+    w = 0.3 * x
 
 drawDragDrop :: Float -> Picture
-drawDragDrop x = line [V2 (-x) x,V2 0 x,V2 0 (-x)]
-    <> line [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)] 
+drawDragDrop 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
   where
+    z = 1.5 * x
     y = 0.7 * x
 
+drawFiltDrag :: Float -> Picture
+drawFiltDrag x = polygonWire
+    [ V2 0 y
+    , V2 x y
+    , V2 0 (-y)
+    , V2 (-x) (-y)
+    ]
+  where
+    y = 0.5 * x
+
+drawFiltDragDrop :: Float -> Picture
+drawFiltDragDrop x = polygonWire
+    [ V2 0 y
+    , V2 x y
+    , V2 0 (-y)
+    , V2 (-x) (-y)
+    ] <> line [V2 (-x) x,V2 0 x,V2 0 (-x)]
+    <> line [V2 (-y) (y-x), V2 0 (-x), V2 y (y-x)]
+  where
+    y = 0.5 * x
+
 drawSelect :: Float -> Picture
-drawSelect x = polygonWire $ rectWH x (0.5 * x)
+drawSelect x = polygonWire $ rectWH (0.5 * x) (0.5 * x)
 --    line [V2 (-x) 0, V2 0 0]
 --drawSelect x = line 
 --    [ V2 x x

src/Dodge/TestString.hs

@@ -22,7 +22,8 @@ import qualified IntMapHelp as IM
 
 testStringInit :: Universe -> [String]
 testStringInit u = [show $
-    u ^? uvWorld . hud . hudElement . diSelectionExtra] 
+    u ^? uvWorld . input . mouseContext . mcoSelEnd
+    ] 
 --    fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . each . itLocation . ilIsRoot
 --    , show . fmap (fmap _siPictures) $ u ^? uvWorld . hud . hudElement . diSections . ix (-1) . ssItems
 --    <> [[toEnum (i+j * 32) | i <- [0..31]] | j <- [0..7]]

src/Dodge/Update.hs

@@ -304,56 +304,10 @@ checkTermDist w = fromMaybe w $ do
         w & hud . hudElement . subInventory
             .~ NoSubInventory --MouseInvNothing
 
----- for other mouse effects, see yourControl
---updateMouseInventoryEffects :: Configuration -> World -> World
---updateMouseInventoryEffects cfig w = w
-
---updateMouseInventorySelection :: Configuration -> World -> World
---updateMouseInventorySelection cfig w = fromMaybe w $ do
---    sss <- w ^? hud . hudElement . diSections
---    return $ updateMouseInventorySelection' sss cfig w
-
---updateMouseInventorySelection' ::
---    IM.IntMap (SelectionSection a) ->
---    Configuration ->
---    World ->
---    World
---updateMouseInventorySelection' sss cfig w
---    | leftclickstart = w
-----   case msel of
-----        Nothing -> fromMaybe w $ do
-----            ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
-----            return $
-----                w & input . mouseContext
-----                    .~ OverInvDragSelect ysel Nothing
-----        Just p -> w --startDrag p w
---    | leftclickheld = case w ^? input . mouseContext of
-----        Just OverInvDragSelect{} ->
-----            w & input . mouseContext . mcoSelEnd .~ msel
-----        Just OverInvDrag -> fromMaybe w $ do
-----            sel <- w ^? hud . hudElement . diSelection . _Just
-----            x <- w ^? hud . hudElement . diSelectionExtra
-----            return $ w & shiftInvItems sel x cfig mpos ldp sss
---        _ -> w
---    | otherwise = w
-----    | otherwise = case w ^? input . mouseContext of
-----        Just (OverInvDragSelect ssel (Just esel)) ->
-----            w & input . mouseContext .~ MouseInGame
-----                & hud . hudElement . diSelectionExtra
-----                    .~ (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
-----                & augInvDirectSelect (min ssel esel)
-----        _ -> w-- & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
---  where
---    leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
---    leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
---    nobuttonright = not $ ButtonRight `M.member` (w ^. input . mouseButtons)
---    mpos = w ^. input . mousePos
---    ldp = invDisplayParams w
---    msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
-
-
 updateMouseContext :: Configuration -> Universe -> Universe
 updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
+    OverInvFiltDrag -> u & uvWorld . input . mouseContext .~ invfiltdrag
+    OverInvFiltDragDrop -> u & uvWorld . input . mouseContext .~ invfiltdrag
     OverInvDrag {} -> u & uvWorld . input . mouseContext .~ invdrag
     OverInvDragSelect{} -> u
     _ -> u & uvWorld . input . mouseContext
@@ -387,6 +341,10 @@ updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
         sss <- w ^? hud . hudElement . diSections
         (0,j) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
         return $ OverInvDrag $ Just j
+    invfiltdrag = fromMaybe OverInvFiltDragDrop $ do
+        sss <- w ^? hud . hudElement . diSections
+        (0,_) <- inverseSelNumPos cfig (invDisplayParams w) sss mpos
+        return $ OverInvFiltDrag
     overinv = do
         sss <- w ^? hud . hudElement . diSections
         selpos <- inverseSelNumPos cfig (invDisplayParams w) sss mpos

src/Dodge/Update/Input/InGame.hs

@@ -39,12 +39,7 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
     DisplayCarte -> over uvWorld updatePressedButtonsCarte u
     DisplayInventory{_subInventory = si} -> case si of
         DisplayTerminal tmid -> updateKeysInTerminal tmid u
---            | lbinitialpress ->
---                u & uvWorld
---                    %~ doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)
---            | otherwise -> updateKeysInTerminal tmid u
         CombineInventory{_ciSections = sss, _ciSelection = msel}
---            | lbinitialpress -> u & uvWorld %~ updateCombineInvClick sss
             | inSubInvRegex (u ^. uvWorld) ->
                 u
                     & uvWorld . hud . hudElement . subInventory
@@ -123,6 +118,8 @@ dropSelected w = fromMaybe w $ do
 
 updateMouseReleaseInGame :: World -> World
 updateMouseReleaseInGame w = case w ^. input . mouseContext of 
+    OverInvFiltDrag -> w & input . mouseContext .~ MouseInGame
+    OverInvFiltDragDrop -> w & input . mouseContext .~ MouseInGame
     OverInvDrag mpos -> fromMaybe (dropSelected w & input . mouseContext .~ MouseInGame) $ do
             j <- mpos
             return $ w & input . mouseContext .~ OverInvSelect (0,j)
@@ -178,11 +175,13 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
     mpos = w ^. input . mousePos
 
 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
+startDrag (a, b) w = case w ^? hud . hudElement . diInvFilter . _Just of
+    Just {} -> w & input . mouseContext .~ OverInvFiltDrag
+    _ -> 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 =
         (input . mouseContext .~ OverInvDrag (Just b))