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

Minor tweaking, argument refining

Browse Source
This commit is contained in:
justin
2022-10-29 12:20:19 +01:00
parent af6cdff063
commit afaef480db
17 changed files with 59 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+17 -15
View File
@@ -147,7 +147,7 @@ functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (cWorld . lWorld . lClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld updateWorldSelect'
-- . over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
-- . over (uvWorld . hammers . each) moveHammerUp
@@ -248,29 +248,31 @@ zoneClouds w =
& cWorld . lWorld . clZoning %~ \zn ->
foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds)
updateWorldSelect' :: World -> World
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . lWorld . camPos)) w
updateWorldSelect :: World -> World
updateWorldSelect w = f . g $ case (w ^? input . mouseButtons . ix ButtonLeft, w ^? input . mouseButtons . ix ButtonRight) of
updateWorldSelect :: CamPos -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
(Just False, Nothing) ->
w & input . lLine . _1 .~ mwp
& input . lrLine . _1 .~ mwp
inp & lLine . _1 .~ mwp
& lrLine . _1 .~ mwp
(Just True, Nothing) ->
w & input . lLine . _2 .~ mwp
& input . lrLine . _1 .~ mwp
inp & lLine . _2 .~ mwp
& lrLine . _1 .~ mwp
(Nothing, Just False) ->
w & input . rLine . _1 .~ mwp
& input . lrLine . _2 .~ mwp
inp & rLine . _1 .~ mwp
& lrLine . _2 .~ mwp
(Nothing, Just True) ->
w & input . rLine . _2 .~ mwp
& input . lrLine . _2 .~ mwp
_ -> w
inp & rLine . _2 .~ mwp
& lrLine . _2 .~ mwp
_ -> inp
where
mwp = mouseWorldPos w
mwp = mouseWorldPos inp cam
f
| ButtonLeft `M.member` _mouseButtons (_input w) = input . lSelect .~ mwp
| ButtonLeft `M.member` _mouseButtons inp = lSelect .~ mwp
| otherwise = id
g
| ButtonRight `M.member` _mouseButtons (_input w) = input . rSelect .~ mwp
| ButtonRight `M.member` _mouseButtons inp = rSelect .~ mwp
| otherwise = id
--mcChooseUpdate :: Machine -> Machine -> World -> World