Work on saving/loading concurrently

src/Loop.hs

@@ -102,8 +102,8 @@ setupConLoop ::
     (world -> IO ()) ->
     -- | Initial simulation state.
     IO world ->
-    -- | Concurrent effects
-    (world -> Maybe (IO (world -> world))) ->
+    -- | Concurrent effects. Evaluating 'Nothing' exits the loop
+    (world -> Maybe (world -> world,IO (world -> Maybe world))) ->
     -- | update, called once per frame. Allows for side effects such as rendering.
     (world -> IO world) ->
     -- | SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
@@ -127,13 +127,14 @@ setupConLoop spf title winconfig paramCleanup ioStartWorld coneffs sideEffects e
 -- | The internal loop.
 doConLoop ::
     -- | The mvar for concurrency
-    MVar (world -> world) ->
+    MVar (world -> Maybe world) ->
     -- | target msec per frame
     Int ->
     -- | The SDL window.
     Window ->
-    -- | Concurrent effects
-    (world -> Maybe (IO (world -> world))) ->
+    -- | Concurrent effects, the first function in the pair is applied
+    -- immediately
+    (world -> Maybe (world->world,IO (world -> Maybe world))) ->
     -- | simulation update.
     (world -> IO world) ->
     -- | SDL Event handling.
@@ -143,25 +144,30 @@ doConLoop ::
     IO ()
 doConLoop themvar spf window coneffs worldSideEffects eventFn startWorld = do
     startTicks <- ticks
-    mconupdate <- tryTakeMVar themvar
-    case coneffs startWorld of
+    let mconeff = coneffs startWorld
+    case mconeff of
         Nothing -> return ()
-        Just acc -> do
+        Just (_,acc) -> do
             _ <- forkIO $ do
                 up <- acc
                 putMVar themvar up
             return ()
-    let startWorld' = case mconupdate of
-            Just conupdate -> conupdate startWorld
-            Nothing -> startWorld
-    worldAfterSimStep <- worldSideEffects startWorld'
-    glSwapWindow window
-    maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
-    case maybeUpdatedWorld of
-        Just updatedWorld -> do
-            performGC
-            endTicks <- ticks -- it might be better to use System.Clock (monotonic)
-            let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
-            threadDelay (theDelay * 1000)
-            doConLoop themvar spf window coneffs worldSideEffects eventFn updatedWorld
+    let startWorld'' = maybe id fst mconeff startWorld
+    mconupdate <- tryTakeMVar themvar
+    let mstartWorld' = case mconupdate of
+            Just conupdate -> conupdate startWorld''
+            Nothing -> Just startWorld''
+    case mstartWorld' of
         Nothing -> return ()
+        Just startWorld' -> do
+            worldAfterSimStep <- worldSideEffects startWorld'
+            glSwapWindow window
+            maybeUpdatedWorld <- pollEvents >>= foldM (applyEventIO eventFn) (Just worldAfterSimStep)
+            case maybeUpdatedWorld of
+                Just updatedWorld -> do
+                    performGC
+                    endTicks <- ticks -- it might be better to use System.Clock (monotonic)
+                    let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
+                    threadDelay (theDelay * 1000)
+                    doConLoop themvar spf window coneffs worldSideEffects eventFn updatedWorld
+                Nothing -> return ()