Continue mouse refactor, add explicit release event/timer

ghcidOutput

@@ -1,10 +1 @@
-/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:98:20: warning: [-Wunused-matches]
+All good (594 modules, at 11:57:14)
-    Defined but not used: ‘i’
-   |
-98 |     OverInvSelect (i,j) -> w
-   |                    ^
-/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:98:22: warning: [-Wunused-matches]
-    Defined but not used: ‘j’
-   |
-98 |     OverInvSelect (i,j) -> w
-   |                      ^

src/Dodge/Data/HUD.hs

@@ -24,16 +24,16 @@ data HUDElement
         }
     | DisplayCarte
 
-data MouseInventorySelection
+--data MouseInventorySelection
-    = MouseInvSelect
+--    = MouseInvSelect
-        {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
+--        {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
-    | MouseInvDrag
+--    | MouseInvDrag
-    | MouseInvNothing
+--    | MouseInvNothing
 
 data SubInventory
     = NoSubInventory
-        { _nsSelected :: MouseInventorySelection
+--        { _nsSelected :: MouseInventorySelection
-        }
+--        }
     | ExamineInventory
     | CombineInventory
         { _ciSections :: IntMap (SelectionSection CombinableItem)
@@ -54,4 +54,4 @@ data HUD = HUD
 makeLenses ''HUD
 makeLenses ''HUDElement
 makeLenses ''SubInventory
-makeLenses ''MouseInventorySelection
+--makeLenses ''MouseInventorySelection

src/Dodge/Data/Input.hs

@@ -23,7 +23,7 @@ data MouseContext
     | MouseMenuClick {_mcoMenuClick :: Int}
     | MouseMenuCursor
     | OverInvDrag
-    | OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: (Int,Int) }
+    | OverInvDragSelect { _mcoSelStart :: (Int,Int), _mcoSelEnd :: Maybe (Int,Int) }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverInvFilt { _mcoInvFilt :: (Int,Int)}
     | OverCombSelect { _mcoCombSelect :: (Int,Int)}
@@ -40,6 +40,7 @@ data Input = Input
     , _mouseMoving :: Bool
     , _pressedKeys :: M.Map Scancode PressType
     , _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down
+    , _mouseButtonsReleased :: M.Map MouseButton Int -- counts number of frames released
     , _scrollAmount :: Int
     , _smoothScrollAmount :: Int
     , _clickPos :: M.Map MouseButton Point2 -- updates on initial mouse button press

src/Dodge/Default/World.hs

@@ -22,6 +22,7 @@ defaultInput =
         , _textInput = mempty
         , _pressedKeys = mempty
         , _mouseButtons = mempty
+        , _mouseButtonsReleased = mempty
         , _mousePos = V2 0 0
         , _mouseMoving = False
         , _scrollAmount = 0
@@ -162,8 +163,8 @@ defaultDisplayInventory :: HUDElement
 defaultDisplayInventory =
     DisplayInventory
         { _subInventory = NoSubInventory 
-            {_nsSelected = MouseInvNothing
+--            {_nsSelected = MouseInvNothing
-            }
+--            }
         , _diSections = defaultInvSections
         , _diSelection = Just (1,0)
         , _diSelectionExtra = 0

src/Dodge/DisplayInventory.hs

@@ -32,7 +32,7 @@ toggleCombineInv :: Universe -> Universe
 toggleCombineInv uv = case uv ^? uvWorld . hud . hudElement . subInventory of
     Just CombineInventory{} ->
         uv & uvWorld . hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing
     _ -> uv & uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
 updateCombinePositioning :: Universe -> Universe

src/Dodge/Event/Input.hs

@@ -63,8 +63,10 @@ handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
 handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
 handleMouseButtonEvent mbev theinput = case mouseButtonEventMotion mbev of
     Released -> theinput & mouseButtons . at thebutton .~ Nothing
+        & mouseButtonsReleased . at thebutton ?~ 0
     Pressed -> theinput
         & mouseButtons . at thebutton ?~ 0
+        & mouseButtonsReleased . at thebutton .~ Nothing
         & clickPos . at thebutton ?~ (theinput ^. mousePos)
     -- note that mouse button down events are NOT repeating
   where

src/Dodge/Render/HUD.hs

@@ -131,23 +131,31 @@ drawMouseOver cfig w = fromMaybe mempty $ invsel <|> combinvsel
             . color (withAlpha 0.2 white)
             $ selSecDrawCursorAt 15 idp curs sss (j, i)
 
-getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
+--getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
-getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
+--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)
-    _ -> case w ^? hud . hudElement . diSelectionExtra of
+--    _ -> case w ^? hud . hudElement . diSelectionExtra of
-        Just x | x > 0 -> do
+--        Just x | x > 0 -> do
-            (i, j) <- w ^? hud . hudElement . diSelection . _Just
+--            (i, j) <- w ^? hud . hudElement . diSelection . _Just
-            return ((i, j), (i, j + x))
+--            return ((i, j), (i, j + x))
-        _ -> Nothing
+--        _ -> Nothing
 
 drawDISelections :: World -> Picture
 drawDISelections w = fromMaybe mempty $ do
-    ((i, j), (a, b)) <- getMouseInvSel w
+    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]
+--  fromMaybe mempty $ do
+--    ((i, j), (a, b)) <- getMouseInvSel w
+--    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]
 
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of

src/Dodge/Terminal.hs

@@ -226,7 +226,7 @@ exitTerminalSubInv :: World -> World
 exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
     Just _ ->
         w & hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing
     _ -> w
 
 damageCodeCommand :: TerminalCommand

src/Dodge/Update.hs

@@ -140,6 +140,7 @@ updateUniverseLast u =
         & uvWorld . input . pressedKeys . each %~ f
         & uvWorld . input . mouseMoving .~ False
         & uvWorld . input . mouseButtons . each +~ 1
+        & uvWorld . input . mouseButtonsReleased . each +~ 1
         & uvWorld . input . heldPos
             %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
         & uvWorld . input . heldWorldPos
@@ -165,7 +166,8 @@ updateUniverseMid u = case _uvScreenLayers u of
                     . updateClouds
                )
     (sl : _) -> u & updateUseInputOnScreen sl
-    [] -> timeFlowUpdate . updateUseInputInGame $ over uvWorld updateMouseClickInGame u
+    [] -> timeFlowUpdate . updateUseInputInGame $ over uvWorld 
+        (updateMouseInGame (u ^. uvConfig)) u
 
 timeFlowUpdate :: Universe -> Universe
 timeFlowUpdate u = case u ^. uvWorld . timeFlow of
@@ -300,7 +302,7 @@ checkTermDist w = fromMaybe w $ do
     guard $ dist btpos (_crPos $ you w) > 40
     return $
         w & hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing
 
 ---- for other mouse effects, see yourControl
 --updateMouseInventoryEffects :: Configuration -> World -> World
@@ -317,28 +319,29 @@ updateMouseInventorySelection' ::
     World ->
     World
 updateMouseInventorySelection' sss cfig w
-    | leftclickstart = case msel of
+    | leftclickstart = w
-        Nothing -> fromMaybe w $ do
+--   case msel of
-            ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
+--        Nothing -> fromMaybe w $ do
-            return $
+--            ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
-                w & hud . hudElement . subInventory . nsSelected
+--            return $
-                    .~ MouseInvSelect ysel Nothing
+--                w & input . mouseContext
-        Just p -> startDrag p w
+--                    .~ OverInvDragSelect ysel Nothing
-    | leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
+--        Just p -> w --startDrag p w
-        Just MouseInvSelect{} ->
+    | leftclickheld = case w ^? input . mouseContext of
-            w & hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
+        Just OverInvDragSelect{} ->
-        Just MouseInvDrag -> fromMaybe w $ do
+            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 = case w ^? hud . hudElement . subInventory . nsSelected of
+    | otherwise = case w ^? input . mouseContext of
-        Just (MouseInvSelect ssel (Just esel)) ->
+        Just (OverInvDragSelect ssel (Just esel)) ->
-            w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
+            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
+        _ -> w-- & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
   where
     leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
     leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
@@ -347,16 +350,6 @@ updateMouseInventorySelection' sss cfig w
     ldp = invDisplayParams w
     msel = inverseSelNumPos cfig ldp sss (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
-  where
-    setmichosen x =
-        (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
-            . (hud . hudElement . diSelectionExtra .~ x)
 
 shiftInvItems ::
     (Int, Int) ->
@@ -390,12 +383,14 @@ shiftInvItemsDown (_, i) x w = fromMaybe w $ do
 
 updateMouseContext :: Configuration -> Universe -> Universe
 updateMouseContext cfig u = case u ^. uvWorld . input . mouseContext of
-    OverInvDrag -> u
+    OverInvDrag | lbheld -> u
+    OverInvDragSelect{} | lbheld -> u
     _ -> u & uvWorld . input . mouseContext
         .~ fromMaybe
             aimcontext
             (overmenu <|> overinv <|> overcomb <|> overterm)
   where
+    lbheld = ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)
     overmenu = do
         screen <- u ^? uvScreenLayers . ix 0
         return $ case screen ^. scOptions of

src/Dodge/Update/Input/InGame.hs

@@ -1,8 +1,9 @@
 module Dodge.Update.Input.InGame (
     updateUseInputInGame,
-    updateMouseClickInGame,
+    updateMouseInGame,
 ) where
 
+import Dodge.ListDisplayParams
 import Control.Applicative
 import Control.Monad
 import qualified Data.IntMap.Strict as IM
@@ -87,18 +88,27 @@ updateUseInputInGame u = updateFunctionKeys $ case u ^. uvWorld . hud . hudEleme
                 & ciSelection .~ msel'
                 & ciFilter .~ filts'
 
-updateMouseClickInGame :: World -> World
+updateMouseInGame :: Configuration -> World -> World
-updateMouseClickInGame w = case w ^? input . mouseButtons . ix ButtonLeft of
+updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of
-    Just 0 -> updateMouseClickInGame' w
+    Just 0 -> updateMouseClickInGame cfig w
-    Just _ -> w
+    Just _ -> updateMouseHeldInGame w
     Nothing -> w
 
-updateMouseClickInGame' :: World -> World
+updateMouseHeldInGame :: World -> World
-updateMouseClickInGame' w = case w ^. input . mouseContext of
+updateMouseHeldInGame w = w
-    OverInvSelect (i,j) -> w
+
+updateMouseClickInGame :: Configuration -> World -> World
+updateMouseClickInGame cfig w = case w ^. input . mouseContext of
+    MouseInGame -> fromMaybe w $ do
+            sss <- w ^? hud . hudElement . diSections
+            ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
+            return $
+                w & input . mouseContext
+                    .~ OverInvDragSelect ysel Nothing
+    OverInvSelect x -> startDrag x w
     OverTerminalReturn tmid -> terminalReturnEffect tmid w
     OverTerminalEscape -> w 
-        & hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing
+        & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
     OverCombSelect x ->
         w & hud . hudElement . subInventory . ciSelection ?~ x
             & worldEventFlags . at CombineInventoryChange ?~ ()
@@ -112,7 +122,7 @@ updateMouseClickInGame' w = case w ^. input . mouseContext of
     OverCombEscape ->
         w
             & worldEventFlags . at InventoryChange ?~ ()
-            & hud . hudElement . subInventory .~ NoSubInventory MouseInvNothing
+            & hud . hudElement . subInventory .~ NoSubInventory --MouseInvNothing
     OverInvFilt (i, j) -> fromMaybe w $ do
         guard $ i == 0
         str <-
@@ -127,6 +137,20 @@ updateMouseClickInGame' w = case w ^. input . mouseContext of
                             & hud . hudElement . subInventory . ciFilter .~ Nothing
                 _ -> w & hud . hudElement . subInventory . ciFilter ?~ ("<" ++ str)
     _ -> w
+  where
+    ldp = invDisplayParams w
+    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
+  where
+    setmichosen x =
+        (input . mouseContext .~ OverInvDrag)
+            . (hud . hudElement . diSelectionExtra .~ x)
 
 updateFunctionKeys :: Universe -> Universe
 updateFunctionKeys u =
@@ -321,11 +345,11 @@ spaceAction w = case w ^. hud . hudElement of
         _ -> w
     DisplayInventory{_subInventory = DisplayTerminal{}} ->
         w & hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing
             & worldEventFlags . at InventoryChange ?~ ()
     _ ->
         w & hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing
   where
     theLoc =
         doWorldPos
@@ -337,7 +361,7 @@ toggleMap u = case u ^. uvWorld . hud . hudElement of
     DisplayCarte ->
         u & uvWorld . hud . hudElement
             .~ DisplayInventory
-                { _subInventory = NoSubInventory MouseInvNothing
+                { _subInventory = NoSubInventory --MouseInvNothing
                 , _diSections = defaultInvSections
                 , _diSelection = Nothing
                 , _diSelectionExtra = 0
@@ -351,7 +375,7 @@ toggleTweakInv :: World -> World
 toggleTweakInv w = case w ^? hud . hudElement . subInventory of
     Just ExamineInventory{} ->
         w
-            & thepointer .~ NoSubInventory MouseInvNothing
+            & thepointer .~ NoSubInventory --MouseInvNothing
     _ -> w & thepointer .~ ExamineInventory -- mi
   where
     thepointer = hud . hudElement . subInventory
@@ -375,4 +399,4 @@ maybeExitCombine w
     | ButtonRight `M.member` (w ^. input . mouseButtons) = w
     | otherwise =
         w & hud . hudElement . subInventory
-            .~ NoSubInventory MouseInvNothing
+            .~ NoSubInventory --MouseInvNothing