diff --git a/appDodge/Main.hs b/appDodge/Main.hs index eabbe7a97..089144c93 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 79d36719f..43aa6bfb7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 455e2825b..b6a7ce630 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -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 = [] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index d5ca7a3a1..a19829d5d 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -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 diff --git a/src/Dodge/PreloadData.hs b/src/Dodge/PreloadData.hs index d79c61724..4ece667b5 100644 --- a/src/Dodge/PreloadData.hs +++ b/src/Dodge/PreloadData.hs @@ -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