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