justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue mouse refactor, add explicit release event/timer

Browse Source
This commit is contained in:
justin
2024-11-19 12:00:31 +00:00
parent 5b709cd7ba
commit e31f6dfd4b
10 changed files with 97 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/HUD.hs
+8 -8
View File
@@ -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
src/Dodge/Data/Input.hs
+2 -1
View File
@@ -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
+3 -2
View File
@@ -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
+1 -1
View File
@@ -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
+2
View File
@@ -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
+17 -9
View File
@@ -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
src/Dodge/Terminal.hs
+1 -1
View File
@@ -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
+23 -28
View File
@@ -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
src/Dodge/Update/Input/InGame.hs
+39 -15
View File
@@ -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