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

Refactor event/input

Browse Source
This commit is contained in:
jgk
2021-03-26 14:52:25 +01:00
parent 420cf7fc4b
commit 07d84cc1c6
14 changed files with 91 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Event.hs
+30 -32
View File
@@ -15,6 +15,13 @@ import Data.Function (on)
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import SDL
-- Deals with direct events
-- This includes individual key/mouse presses, but /not/ continuous held down input
-- We cannot handle multiple keys held down at once here,
-- (eg left mouse button + right mouse button)
-- because these are separate events
-- Instead we store the events in a set, and deal with the combinations in
-- Update
handleEvent :: Event -> World -> Maybe World
handleEvent e = case eventPayload e of
@@ -52,37 +59,42 @@ handleResizeEvent sev = Just . set windowX (fromIntegral x)
where V2 x y = windowSizeChangedEventSize sev
handlePressedMouseButton :: MouseButton -> World -> Maybe World
handlePressedMouseButton ButtonMiddle w = Just $ set lbClickMousePos (_mousePos w) w
handlePressedMouseButton but w
| (but == ButtonRight && _carteDisplay w) || (but == ButtonMiddle && not (_carteDisplay w))
= Just $ w & clickMousePos .~ _mousePos w
handlePressedMouseButton _ w = Just w
wheelUpEvent :: World -> World
wheelUpEvent w = case _carteDisplay w of
True -> w & carteZoom .~ min 0.5 (z+(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollUp w)
True | rbDown -> w & carteZoom .~ min 0.75 (z+(0.1*z))
| otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i - 1)
_ | rbDown -> fromMaybe (closeObjScrollUp w)
$ (yourItem w ^? itScrollUp)
<*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1}
| otherwise -> upInvPos w
| lbDown -> w & cameraZoom +~ 0.1
| otherwise -> upInvPos w
where
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
rbDown = ButtonRight `S.member` _mouseButtons w
lbDown = ButtonLeft `S.member` _mouseButtons w
z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
wheelDownEvent :: World -> World
wheelDownEvent w = case _carteDisplay w of
True -> w & carteZoom .~ max 0.05 (z-(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollDown w)
$ (yourItem w ^? itScrollDown)
<*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
True | rbDown -> w & carteZoom .~ max 0.05 (z-(0.1*z))
| otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i + 1)
False | rbDown -> fromMaybe (closeObjScrollDown w)
$ (yourItem w ^? itScrollDown)
<*> pure (_crInvSel (you w))
<*> pure w
| lbDown -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
where
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
rbDown = ButtonRight `S.member` _mouseButtons w
lbDown = ButtonLeft `S.member` _mouseButtons w
z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
@@ -110,17 +122,3 @@ mouseActionsCr keys cr
where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mouseActionsWorld :: S.Set MouseButton -> World -> World
mouseActionsWorld keys w
| lbPressed && rbPressed
= useItem (_yourID w) w
| mbPressed
= set lbClickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w
| otherwise
= w
where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
rotation = angleBetween (_mousePos w) (_lbClickMousePos w)