Push preloaddata into the universe

This commit is contained in:
2021-11-28 12:01:06 +00:00
parent 2fd2929bdf
commit 98e0ea971a
5 changed files with 31 additions and 31 deletions
+17 -19
View File
@@ -48,8 +48,7 @@ main = do
(flip handleEvent) (flip handleEvent)
theCleanup :: Universe -> IO () theCleanup :: Universe -> IO ()
theCleanup uv = let w = _uvWorld uv theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
in SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w)
firstWorldLoad :: Configuration -> IO Universe firstWorldLoad :: Configuration -> IO Universe
firstWorldLoad theConfig = do firstWorldLoad theConfig = do
@@ -57,34 +56,33 @@ firstWorldLoad theConfig = do
theKeyConfig <- loadKeyConfig theKeyConfig <- loadKeyConfig
pdata <- doPreload >>= applyWorldConfig theConfig pdata <- doPreload >>= applyWorldConfig theConfig
w <- generateWorldFromSeed 0 w <- generateWorldFromSeed 0
return $ Universe ( w & preloadData .~ pdata return $ Universe ( w
& keyConfig .~ theKeyConfig & keyConfig .~ theKeyConfig
& config .~ theConfig & config .~ theConfig
) ) pdata
theUpdateStep :: Universe -> IO Universe theUpdateStep :: Universe -> IO Universe
theUpdateStep = doSideEffects <=< traverseOf uvWorld theUpdateStep' theUpdateStep = doSideEffects <=< updateRenderSplit
theUpdateStep' :: World -> IO World updateRenderSplit :: Universe -> IO Universe
theUpdateStep' = updateRenderSplit updateRenderSplit u = do
let preData = _preloadData u
update (_uvWorld u) `par` void (doDrawing (_renderData preData) (_uvWorld u))
return $ u {_uvWorld = update (_uvWorld u)}
updateRenderSplit :: World -> IO World playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
updateRenderSplit w = do playSoundUnlessRewinding u
let preData = _preloadData w
update w `par` void (doDrawing (_renderData preData) w)
return $ update w
playSoundUnlessRewinding :: World -> IO (M.Map SoundOrigin Sound)
playSoundUnlessRewinding w
| _rewinding w = return M.empty | _rewinding w = return M.empty
| otherwise = playSoundAndUpdate (_soundData $ _preloadData w) (_playingSounds w) (_toPlaySounds w) | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
where
w = _uvWorld u
doSideEffects :: Universe -> IO Universe doSideEffects :: Universe -> IO Universe
doSideEffects u = do doSideEffects u = do
let w = _uvWorld u let w = _uvWorld u
let preData = _preloadData w let preData = _preloadData u
--newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w) --newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
newPlayingSounds <- playSoundUnlessRewinding w newPlayingSounds <- playSoundUnlessRewinding u
u' <- _sideEffects w u u' <- _sideEffects w u
endTicks <- SDL.ticks endTicks <- SDL.ticks
let lastFrameTicks = _frameTimer preData let lastFrameTicks = _frameTimer preData
@@ -95,7 +93,7 @@ doSideEffects u = do
. text $ "ms/frame " ++ show (endTicks - lastFrameTicks) . text $ "ms/frame " ++ show (endTicks - lastFrameTicks)
) )
return $ u' return $ u'
& uvWorld . preloadData . frameTimer .~ endTicks & preloadData . frameTimer .~ endTicks
& uvWorld . playingSounds .~ newPlayingSounds & uvWorld . playingSounds .~ newPlayingSounds
& uvWorld . toPlaySounds .~ M.empty & uvWorld . toPlaySounds .~ M.empty
& uvWorld . sideEffects .~ return & uvWorld . sideEffects .~ return
+1 -1
View File
@@ -54,6 +54,7 @@ import Data.Monoid
type CRUpdate = Creature -> World -> (Endo World, Maybe Creature) type CRUpdate = Creature -> World -> (Endo World, Maybe Creature)
data Universe = Universe data Universe = Universe
{ _uvWorld :: World { _uvWorld :: World
, _preloadData :: PreloadData
} }
data World = World data World = World
{ _keys :: !(S.Set Scancode) { _keys :: !(S.Set Scancode)
@@ -115,7 +116,6 @@ data World = World
, _gameRooms :: [GameRoom] -- consider using and IntMap , _gameRooms :: [GameRoom] -- consider using and IntMap
, _keyConfig :: KeyConfigSDL , _keyConfig :: KeyConfigSDL
, _config :: Configuration , _config :: Configuration
, _preloadData :: PreloadData
, _savedWorlds :: M.Map SaveSlot World , _savedWorlds :: M.Map SaveSlot World
, _rewindWorlds :: [World] , _rewindWorlds :: [World]
, _rewinding :: Bool , _rewinding :: Bool
+2 -2
View File
@@ -8,7 +8,7 @@ import Dodge.Bounds
--import Picture --import Picture
import Geometry.Data import Geometry.Data
--import Picture.Texture --import Picture.Texture
import Data.Preload --import Data.Preload
import System.Random import System.Random
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
@@ -80,7 +80,7 @@ defaultWorld = World
, _foregroundShape = mempty , _foregroundShape = mempty
, _distortions = [] , _distortions = []
, _gameRooms = [] , _gameRooms = []
, _preloadData = DummyPdata -- hack TODO remove this -- , _preloadData = DummyPdata -- hack TODO remove this
, _frameClock = 0 , _frameClock = 0
, _worldBounds = defaultBounds , _worldBounds = defaultBounds
, _rewindWorlds = [] , _rewindWorlds = []
+9 -7
View File
@@ -7,11 +7,12 @@ module Dodge.Menu
) )
where where
import Dodge.Data import Dodge.Data
import Dodge.PreloadData
import Dodge.Save import Dodge.Save
import Dodge.Config.Update import Dodge.Config.Update
import SDL import SDL
import SDL.Internal.Numbered import SDL.Internal.Numbered
import Preload.Update --import Preload.Update
import Dodge.Base.Window import Dodge.Base.Window
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.LevelGen import Dodge.LevelGen
@@ -165,7 +166,8 @@ startNewGame w = Just $ w
uvWorldSideEffects :: Int -> World -> b -> IO World uvWorldSideEffects :: Int -> World -> b -> IO World
uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w uvWorldSideEffects i w = const (generateWorldFromSeed i <&> keyConfig .~ _keyConfig w <&> config .~ _config w
<&> preloadData .~ _preloadData w) -- <&> preloadData .~ _preloadData w
)
-- this kills save games etc... -- this kills save games etc...
@@ -177,14 +179,14 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
updateFramebufferSize :: World -> World updateFramebufferSize :: World -> World
updateFramebufferSize w = w & sideEffects %~ up updateFramebufferSize w = w & sideEffects %~ sideEffectUpdatePreload divRes x y
where where
(x,y) = (round $ getWindowX w, round $ getWindowY w) (x,y) = (round $ getWindowX w, round $ getWindowY w)
divRes = w ^. config . resolution_factor divRes = w ^. config . resolution_factor
up :: (Universe -> IO Universe) -> Universe -> IO Universe -- up :: (Universe -> IO Universe) -> Universe -> IO Universe
up f w' = do -- up f w' = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld w')) -- pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
f $ w' & uvWorld . preloadData .~ pdata -- f $ w' & uvWorld . preloadData .~ pdata
--levelMenu :: Int -> ScreenLayer --levelMenu :: Int -> ScreenLayer
--levelMenu x = OptionScreen --levelMenu x = OptionScreen
+2 -2
View File
@@ -13,5 +13,5 @@ import Control.Lens
sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe sideEffectUpdatePreload :: Int -> Int -> Int -> (Universe -> IO Universe) -> Universe -> IO Universe
sideEffectUpdatePreload divRes x y f u = do sideEffectUpdatePreload divRes x y f u = do
pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData (_uvWorld u)) pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData u)
f $ u & uvWorld . preloadData .~ pdata f $ u & preloadData .~ pdata