Continue mouse refactor, add explicit release event/timer

2024-11-19 12:00:31 +00:00
parent 5b709cd7ba
commit e31f6dfd4b
10 changed files with 97 additions and 75 deletions
@@ -1,10 +1 @@
-/home/justin/Haskell/loop/src/Dodge/Update/Input/InGame.hs:98:20: warning: [-Wunused-matches]
-    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
-   |                      ^
+All good (594 modules, at 11:57:14)
@@ -24,16 +24,16 @@ data HUDElement
        }
    | DisplayCarte

-data MouseInventorySelection
-    = MouseInvSelect
-        {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
-    | MouseInvDrag
-    | MouseInvNothing
+--data MouseInventorySelection
+--    = MouseInvSelect
+--        {_misSelStart :: (Int, Int), _misMaybeEnd :: Maybe (Int, Int)}
+--    | MouseInvDrag
+--    | 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 w = case w ^? hud . hudElement . subInventory . nsSelected of
-    Just (MouseInvSelect s (Just e)) -> Just (s, e)
-    _ -> case w ^? hud . hudElement . diSelectionExtra of
-        Just x | x > 0 -> do
-            (i, j) <- w ^? hud . hudElement . diSelection . _Just
-            return ((i, j), (i, j + x))
-        _ -> Nothing
+--getMouseInvSel :: World -> Maybe ((Int, Int), (Int, Int))
+--getMouseInvSel w = case w ^? hud . hudElement . subInventory . nsSelected of
+--    Just (MouseInvSelect s (Just e)) -> Just (s, e)
+--    _ -> case w ^? hud . hudElement . diSelectionExtra of
+--        Just x | x > 0 -> do
+--            (i, j) <- w ^? hud . hudElement . diSelection . _Just
+--            return ((i, j), (i, j + x))
+--        _ -> 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
@@ -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
@@ -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
-        Nothing -> fromMaybe w $ do
-            ysel <- inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
-            return $
-                w & hud . hudElement . subInventory . nsSelected
-                    .~ MouseInvSelect ysel Nothing
-        Just p -> startDrag p w
-    | leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
-        Just MouseInvSelect{} ->
-            w & hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
-        Just MouseInvDrag -> fromMaybe w $ do
+    | 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 = case w ^? hud . hudElement . subInventory . nsSelected of
-        Just (MouseInvSelect ssel (Just esel)) ->
-            w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
+    | 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
+        _ -> 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
@@ -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
-updateMouseClickInGame w = case w ^? input . mouseButtons . ix ButtonLeft of
-    Just 0 -> updateMouseClickInGame' w
-    Just _ -> w
+updateMouseInGame :: Configuration -> World -> World
+updateMouseInGame cfig w = case w ^? input . mouseButtons . ix ButtonLeft of
+    Just 0 -> updateMouseClickInGame cfig w
+    Just _ -> updateMouseHeldInGame w
    Nothing -> w

-updateMouseClickInGame' :: World -> World
-updateMouseClickInGame' w = case w ^. input . mouseContext of
-    OverInvSelect (i,j) -> w
+updateMouseHeldInGame :: World -> World
+updateMouseHeldInGame w = 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