Continue mouse refactor, add explicit release event/timer

This commit is contained in:
2024-11-19 12:00:31 +00:00
parent 5b709cd7ba
commit e31f6dfd4b
10 changed files with 97 additions and 75 deletions
+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