From e31f6dfd4bbfcf06530c5d72073e02611f7611d4 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 19 Nov 2024 12:00:31 +0000 Subject: [PATCH] Continue mouse refactor, add explicit release event/timer --- ghcidOutput | 11 +------ src/Dodge/Data/HUD.hs | 16 +++++----- src/Dodge/Data/Input.hs | 3 +- src/Dodge/Default/World.hs | 5 +-- src/Dodge/DisplayInventory.hs | 2 +- src/Dodge/Event/Input.hs | 2 ++ src/Dodge/Render/HUD.hs | 26 +++++++++------ src/Dodge/Terminal.hs | 2 +- src/Dodge/Update.hs | 51 ++++++++++++++---------------- src/Dodge/Update/Input/InGame.hs | 54 +++++++++++++++++++++++--------- 10 files changed, 97 insertions(+), 75 deletions(-) diff --git a/ghcidOutput b/ghcidOutput index 36842cfeb..7fb48250c 100644 --- a/ghcidOutput +++ b/ghcidOutput @@ -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) diff --git a/src/Dodge/Data/HUD.hs b/src/Dodge/Data/HUD.hs index ff43be4c0..26c5ece6b 100644 --- a/src/Dodge/Data/HUD.hs +++ b/src/Dodge/Data/HUD.hs @@ -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 diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 8780ea5d9..0537735a9 100644 --- a/src/Dodge/Data/Input.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 20e01b866..35a532785 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/DisplayInventory.hs b/src/Dodge/DisplayInventory.hs index 85e851c18..e25367874 100644 --- a/src/Dodge/DisplayInventory.hs +++ b/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 diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index e1cc1ddd4..3ee97af8b 100644 --- a/src/Dodge/Event/Input.hs +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index b86bdf803..edd05e07f 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 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 diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 8312e12bf..36cd3aa7c 100644 --- a/src/Dodge/Terminal.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e783d2484..a144ff4d3 100644 --- a/src/Dodge/Update.hs +++ b/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 - 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 diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index 5fbedbc71..2d08a1338 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/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 -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