Push preloaddata into the universe
This commit is contained in:
+17
-19
@@ -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
@@ -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
|
||||||
|
|||||||
@@ -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
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user