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

Add general smooth scrolling, move camera into world

Browse Source
This commit is contained in:
justin
2023-03-26 20:09:00 +01:00
parent 73e742e1a2
commit 07a1d71039
32 changed files with 154 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+20 -11
View File
@@ -8,6 +8,7 @@ module Dodge.Update (updateUniverse) where
--import Dodge.InputFocus
import Dodge.SmoothScroll
import Color
import Control.Applicative
import Data.List
@@ -74,15 +75,21 @@ updateUniverse u =
. maybeOpenTerminal
. over (uvWorld . input . textInput) (const mempty)
. updateUniverseMid
. updateUseInput -- this should be pushed inside when the universe is paused etc
-- OR the keys should be tested "in game", so to speak
. updateUseInput -- this should be pushed inside when the universe is paused etc
-- OR the keys should be tested "in game", so to speak
. over uvWorld (updateCamera cfig)
. over (uvWorld . input) updateScrollTestValue
. over (uvWorld . cWorld . cClock) (+ 1)
. updateUniverseFirst
$ u
where
cfig = u ^. uvConfig
updateUniverseFirst :: Universe -> Universe
updateUniverseFirst u =
u
& uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
& over (uvWorld . input) updateScrollTestValue
& over (uvWorld . cWorld . cClock) (+ 1)
updateWorldEventFlags :: Universe -> Universe
updateWorldEventFlags u =
(uvWorld . worldEventFlags .~ mempty)
@@ -105,11 +112,12 @@ gotoTerminal w = case _uvScreenLayers w of
_ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
updateUniverseLast :: Universe -> Universe
updateUniverseLast u = u
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
updateUniverseLast u =
u
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
where
mp = u ^. uvWorld . input . mousePos
f LongPress = LongPress
@@ -141,7 +149,7 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
DeathTime{} -> u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
where
debugcamera = CamInGame /= (u ^. uvWorld . cWorld . cwCam . camControl)
debugcamera = CamInGame /= (u ^. uvWorld . wCam . camControl)
pauseTime :: Int -> World -> World
pauseTime itmloc w
@@ -262,6 +270,7 @@ advanceScrollAmount u =
u
& uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
& uvWorld . input . scrollAmount .~ 0
& uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
updatePastWorlds :: World -> World
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
@@ -287,7 +296,7 @@ zoneClouds :: World -> World
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
updateWorldSelect' :: World -> World
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w
updateWorldSelect' w = over input (updateWorldSelect (w ^. wCam)) w
updateWorldSelect :: Camera -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of