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

Separate out input datatype

Browse Source
This commit is contained in:
justin
2022-10-29 11:36:57 +01:00
parent 82e2a5a234
commit af6cdff063
19 changed files with 160 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+18 -18
View File
@@ -67,7 +67,7 @@ updateUniverse :: Universe -> Universe
updateUniverse = updateUniverseLast . updateUniverseFirst
updateUniverseLast :: Universe -> Universe
updateUniverseLast = over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held
updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
{- For most menus the only way to change the world is using event handling. -}
updateUniverseFirst :: Universe -> Universe
@@ -100,12 +100,12 @@ functionalUpdate' u = case u ^. uvWorld . cWorld . timeFlow of
_ -> u
doTimeScroll :: Int -> World -> World
doTimeScroll smoothing w = case w ^? mouseButtons . ix ButtonLeft of
doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of
Just False -> w & cWorld . timeFlow .~ NormalTimeFlow
_ -> doTimeScroll' smoothing w
doTimeScroll' :: Int -> World -> World
doTimeScroll' smoothing w = case w ^. scrollAmount of
doTimeScroll' smoothing w = case w ^. input . scrollAmount of
x | x > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20
x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0
x | x < (-1) -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing .~ negate 20
@@ -207,21 +207,21 @@ functionalUpdate w =
updateWheelEvents :: World -> World
updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y)))
where
y = w ^. scrollAmount
y = w ^. input . scrollAmount
advanceScrollAmount :: Universe -> Universe
advanceScrollAmount u =
u
& uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u)
& uvWorld . scrollAmount .~ 0
& uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
& uvWorld . input . scrollAmount .~ 0
updatePastWorlds :: World -> World
updatePastWorlds w = w & cWorld . pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
moveHammersUp :: Universe -> Universe
--moveHammersUp = uvWorld . hammers .~ M.empty
moveHammersUp = uvWorld . hammers %~ M.map moveHammerUp
moveHammersUp = uvWorld . input . hammers %~ M.map moveHammerUp
--moveHammersUp = uvWorld . hammers . each %~ (moveHammerUp $!)
--moveHammersUp = uvWorld %~ ( (hammers . each %~ (moveHammerUp $!)) $!)
@@ -250,27 +250,27 @@ zoneClouds w =
updateWorldSelect :: World -> World
updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of
updateWorldSelect w = f . g $ case (w ^? input . mouseButtons . ix ButtonLeft, w ^? input . mouseButtons . ix ButtonRight) of
(Just False, Nothing) ->
w & lLine . _1 .~ mwp
& lrLine . _1 .~ mwp
w & input . lLine . _1 .~ mwp
& input . lrLine . _1 .~ mwp
(Just True, Nothing) ->
w & lLine . _2 .~ mwp
& lrLine . _1 .~ mwp
w & input . lLine . _2 .~ mwp
& input . lrLine . _1 .~ mwp
(Nothing, Just False) ->
w & rLine . _1 .~ mwp
& lrLine . _2 .~ mwp
w & input . rLine . _1 .~ mwp
& input . lrLine . _2 .~ mwp
(Nothing, Just True) ->
w & rLine . _2 .~ mwp
& lrLine . _2 .~ mwp
w & input . rLine . _2 .~ mwp
& input . lrLine . _2 .~ mwp
_ -> w
where
mwp = mouseWorldPos w
f
| ButtonLeft `M.member` _mouseButtons w = lSelect .~ mwp
| ButtonLeft `M.member` _mouseButtons (_input w) = input . lSelect .~ mwp
| otherwise = id
g
| ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp
| ButtonRight `M.member` _mouseButtons (_input w) = input . rSelect .~ mwp
| otherwise = id
--mcChooseUpdate :: Machine -> Machine -> World -> World