Apply side effects to universe not world
This commit is contained in:
+22
-14
@@ -47,21 +47,26 @@ main = do
|
||||
theUpdateStep
|
||||
(flip handleEvent)
|
||||
|
||||
theCleanup :: World -> IO ()
|
||||
theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
|
||||
theCleanup :: Universe -> IO ()
|
||||
theCleanup uv = let w = _uvWorld uv
|
||||
in SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
|
||||
|
||||
firstWorldLoad :: Configuration -> IO World
|
||||
firstWorldLoad :: Configuration -> IO Universe
|
||||
firstWorldLoad theConfig = do
|
||||
SDL.cursorVisible $= False
|
||||
theKeyConfig <- loadKeyConfig
|
||||
pdata <- doPreload >>= applyWorldConfig theConfig
|
||||
w <- generateWorldFromSeed 0
|
||||
return $ w & preloadData .~ pdata
|
||||
return $ Universe ( w & preloadData .~ pdata
|
||||
& keyConfig .~ theKeyConfig
|
||||
& config .~ theConfig
|
||||
)
|
||||
|
||||
theUpdateStep :: World -> IO World
|
||||
theUpdateStep = doSideEffects <=< updateRenderSplit
|
||||
theUpdateStep :: Universe -> IO Universe
|
||||
theUpdateStep = doSideEffects <=< traverseOf uvWorld theUpdateStep'
|
||||
|
||||
theUpdateStep' :: World -> IO World
|
||||
theUpdateStep' = updateRenderSplit
|
||||
|
||||
updateRenderSplit :: World -> IO World
|
||||
updateRenderSplit w = do
|
||||
@@ -74,12 +79,13 @@ playSoundUnlessRewinding w
|
||||
| _rewinding w = return M.empty
|
||||
| otherwise = playSoundAndUpdate (_soundData $ _preloadData w) (_playingSounds w) (_toPlaySounds w)
|
||||
|
||||
doSideEffects :: World -> IO World
|
||||
doSideEffects w = do
|
||||
doSideEffects :: Universe -> IO Universe
|
||||
doSideEffects u = do
|
||||
let w = _uvWorld u
|
||||
let preData = _preloadData w
|
||||
--newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
|
||||
newPlayingSounds <- playSoundUnlessRewinding w
|
||||
w' <- _sideEffects w w
|
||||
u' <- _sideEffects w u
|
||||
endTicks <- SDL.ticks
|
||||
let lastFrameTicks = _frameTimer preData
|
||||
when (_debug_seconds_frame $ _config w) $ void $ renderFoldable
|
||||
@@ -88,11 +94,13 @@ doSideEffects w = do
|
||||
. translate (-0.5) (-0.8) . scale 0.0005 0.0005
|
||||
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
|
||||
)
|
||||
return $ w' & preloadData . frameTimer .~ endTicks
|
||||
& playingSounds .~ newPlayingSounds
|
||||
& toPlaySounds .~ M.empty
|
||||
& sideEffects .~ return
|
||||
& rewinding .~ False -- this is probably not the best place for this
|
||||
return $ u'
|
||||
& uvWorld . preloadData . frameTimer .~ endTicks
|
||||
& uvWorld . playingSounds .~ newPlayingSounds
|
||||
& uvWorld . toPlaySounds .~ M.empty
|
||||
& uvWorld . sideEffects .~ return
|
||||
& uvWorld . rewinding .~ False -- this is probably not the best place for this
|
||||
|
||||
|
||||
doPreload :: IO PreloadData
|
||||
doPreload = do
|
||||
|
||||
Reference in New Issue
Block a user