Move towards serializing saves/loads faster

appDodge/Main.hs

@@ -1,38 +1,37 @@
-module Main 
-    ( main 
-    ) where
-import Dodge.Menu
-import Loop
-import Dodge.TestString
-import Dodge.Data
---import Dodge.StartNewGame
-import Dodge.Initialisation
-import Dodge.Concurrent
---import Dodge.LevelGen
-import Dodge.Update
-import Dodge.Event
-import Dodge.Render
-import Dodge.Config.Load
-import Dodge.Config.Update
-import Dodge.SoundLogic.LoadSound
-import Picture
-import Render
-import Preload.Render
-import Sound
-import Preload
-import Music
-import Data.Preload.Render
+module Main (
+    main,
+) where
 
 import Control.Lens
 import Control.Monad
---import Control.Monad.Parallel
-import qualified Data.Text as T
-import qualified IntMapHelp               as IM
-import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
-import qualified SDL
-import qualified SDL.Mixer                 as Mix
 import Control.Parallel
 import qualified Data.Map.Strict as M
+import Data.Preload.Render
+import qualified Data.Text as T
+import Dodge.Concurrent
+import Dodge.Config.Load
+import Dodge.Config.Update
+import Dodge.Data
+import Dodge.Event
+import Dodge.Initialisation
+import Dodge.LoadSeed
+import Dodge.Menu
+import Dodge.Render
+import Dodge.SoundLogic.LoadSound
+import Dodge.TestString
+import Dodge.Update
+import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
+import qualified IntMapHelp as IM
+import Loop
+import Music
+import Picture
+import Preload
+import Preload.Render
+import Render
+import qualified SDL
+import qualified SDL.Mixer as Mix
+import Sound
+import System.Directory
 
 main :: IO ()
 main = do
@@ -45,7 +44,7 @@ main = do
     setupConLoop
         20
         (T.pack "Simple Game Loop")
-        (winConfig sizex sizey (Just (posx,posy)))
+        (winConfig sizex sizey (Just (posx, posy)))
         theCleanup
         (firstWorldLoad con)
         conEffects
@@ -54,19 +53,22 @@ main = do
 
 -- | Create an OpenGL SDL window configuration with a given x and y size.
 winConfig :: Int -> Int -> Maybe (Int, Int) -> SDL.WindowConfig
-winConfig x y winpos = SDL.defaultWindow 
-    { SDL.windowGraphicsContext = SDL.OpenGLContext $ SDL.defaultOpenGL 
-        { SDL.glProfile = SDL.Core SDL.Normal 4 3
-        , SDL.glColorPrecision = SDL.V4 8 8 8 8
-        } 
-    , SDL.windowPosition = theWinPos
-    , SDL.windowInitialSize = SDL.V2 (fromIntegral x) (fromIntegral y)
-    , SDL.windowResizable = True
-    }
+winConfig x y winpos =
+    SDL.defaultWindow
+        { SDL.windowGraphicsContext =
+            SDL.OpenGLContext $
+                SDL.defaultOpenGL
+                    { SDL.glProfile = SDL.Core SDL.Normal 4 3
+                    , SDL.glColorPrecision = SDL.V4 8 8 8 8
+                    }
+        , SDL.windowPosition = theWinPos
+        , SDL.windowInitialSize = SDL.V2 (fromIntegral x) (fromIntegral y)
+        , SDL.windowResizable = True
+        }
   where
     theWinPos = case winpos of
-        Just (px,py) -> SDL.Absolute (SDL.P (SDL.V2 (fromIntegral px) (fromIntegral py)))
-        Nothing      -> SDL.Wherever
+        Just (px, py) -> SDL.Absolute (SDL.P (SDL.V2 (fromIntegral px) (fromIntegral py)))
+        Nothing -> SDL.Wherever
 
 theCleanup :: Universe -> IO ()
 theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
@@ -75,18 +77,23 @@ firstWorldLoad :: Configuration -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     pdata <- doPreload >>= applyWorldConfig theConfig
-    --return $ startNewGame $ Universe 
-    return $ Universe 
-        --{_uvWorld = initialWorld
-        {_uvWorld = splashScreen
-        ,_uvConfig    = theConfig
-        ,_preloadData = pdata
-        ,_uvScreenLayers = [splashMenu]
-        , _uvIOEffects  = return
-        , _uvTestString = testStringInit
-        , _quickSave = Nothing
-        , _uvConcEffects = NoConcEffect
-        }
+    --return $ startNewGame $ Universe
+    cancontinue <- doesFileExist "saveSlot/0"
+    mseed <- loadSeed
+    return $
+        Universe
+            { --{_uvWorld = initialWorld
+              _uvWorld = splashScreen
+            , _uvConfig = theConfig
+            , _preloadData = pdata
+            , _uvScreenLayers = [splashMenu]
+            , _uvIOEffects = return
+            , _uvTestString = testStringInit
+            , _quickSave = Nothing
+            , _uvConcEffects = NoConcEffect
+            , _uvCanContinue = cancontinue
+            , _uvMSeed = mseed
+            }
 
 theUpdateStep :: Universe -> IO Universe
 theUpdateStep = doSideEffects <=< updateRenderSplit
@@ -111,22 +118,27 @@ doSideEffects u = do
     u' <- _uvIOEffects u u
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
-    when (debugOn Show_ms_frame $ _uvConfig u) $ void $ renderFoldable
-        (_pictureShaders $ _renderData preData)
-        (setDepth (-1)
-            . translate (-0.5) (-0.8) . scale 0.0005 0.0005
-            $ fpsText (endTicks - lastFrameTicks)
-        )
-    return $ u' 
-        & preloadData . frameTimer .~ endTicks
-        & uvWorld . playingSounds .~ newPlayingSounds
-        & uvWorld . toPlaySounds  .~ M.empty
-        & uvIOEffects   .~ return
+    when (debugOn Show_ms_frame $ _uvConfig u) $
+        void $
+            renderFoldable
+                (_pictureShaders $ _renderData preData)
+                ( setDepth (-1)
+                    . translate (-0.5) (-0.8)
+                    . scale 0.0005 0.0005
+                    $ fpsText (endTicks - lastFrameTicks)
+                )
+    return $
+        u'
+            & preloadData . frameTimer .~ endTicks
+            & uvWorld . playingSounds .~ newPlayingSounds
+            & uvWorld . toPlaySounds .~ M.empty
+            & uvIOEffects .~ return
 
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
 fpsText x = color col $ text $ "ms/frame " ++ show x
   where
-    col | x < 22 = blue
+    col
+        | x < 22 = blue
         | x < 30 = green
         | x < 40 = yellow
         | x < 50 = orange
@@ -134,16 +146,17 @@ fpsText x = color col $ text $ "ms/frame " ++ show x
 
 doPreload :: IO PreloadData
 doPreload = do
-    rData   <- preloadRender
+    rData <- preloadRender
     lChunks <- loadSounds
-    lMusic  <- loadMusic
+    lMusic <- loadMusic
     Mix.playMusic Mix.Forever (lMusic IM.! 0)
-    return PreloadData 
-        { _renderData   = rData 
-        , _soundData    = SoundData {_loadedChunks = lChunks} 
-        , _musicData    = MusicData {_loadedMusic  = lMusic}
-        , _frameTimer   = 0
-        }
+    return
+        PreloadData
+            { _renderData = rData
+            , _soundData = SoundData{_loadedChunks = lChunks}
+            , _musicData = MusicData{_loadedMusic = lMusic}
+            , _frameTimer = 0
+            }
 
 --checkForGlErrors :: IO ()
 --checkForGlErrors = do