Simplify the main loop, events only perform functional update

src/Loop.hs

@@ -11,6 +11,7 @@ This module sets up an SDL window which may be updated using a simple game loop.
 module Loop (
     setupLoop,
     setupConLoop,
+    setupConLoop',
 ) where
 
 import Loop.Data
@@ -21,6 +22,7 @@ import qualified Data.Text as T
 import qualified Graphics.Rendering.OpenGL as GL
 import SDL
 import System.Mem
+import Data.Foldable
 
 -- | Create a game loop with an SDL window.
 setupLoop ::
@@ -180,3 +182,86 @@ doConLoop themvar spf window coneffs worldSideEffects eventFn !startWorld = go s
                         threadDelay (theDelay * 1000)
                         go $! updatedWorld
                     Nothing -> return ()
+
+-- | Create a game loop with an SDL window.
+setupConLoop' ::
+    -- | Target seconds per frame
+    Int ->
+    -- | Window title
+    T.Text ->
+    WindowConfig ->
+    -- | Function for cleaning up parameters, applied when exiting loop.
+    (world -> IO ()) ->
+    -- | Initial simulation state.
+    IO world ->
+    ---- | Concurrent effects. Evaluating 'Nothing' exits the loop
+    (world -> ConcurrentEffect world) ->
+    -- | update, called once per frame. Allows for side effects such as rendering.
+    (world -> IO world) ->
+    -- | SDL Event handling, once per frame. Note no side effects.
+    (world -> Event ->  world) ->
+    IO ()
+setupConLoop' spf title winconfig paramCleanup ioStartWorld coneffs sideEffects eventFn = do
+    initializeAll
+    themvar <- newEmptyMVar
+    bracket
+        (createWindow title winconfig)
+        destroyWindow
+        $ \window -> bracket
+            (glCreateContext window)
+            (\con -> GL.finish >> glDeleteContext con)
+            $ \_ ->
+                bracket
+                    ioStartWorld
+                    paramCleanup
+                    (doConLoop' themvar spf window coneffs sideEffects eventFn)
+
+-- | The internal loop.
+doConLoop' ::
+    -- | The mvar for concurrency
+    MVar (world -> Maybe world) ->
+    -- | target msec per frame
+    Int ->
+    -- | The SDL window.
+    Window ->
+    ---- | Concurrent effects, the first function in the pair is applied
+    ---- immediately
+    (world -> ConcurrentEffect world) ->
+    -- | simulation update. Allows for side effects such as rendering.
+    (world -> IO world) ->
+    -- | SDL Event handling. Note no side effects.
+    (world -> Event -> world) ->
+    -- | Current simulation state.
+    world ->
+    IO ()
+doConLoop' themvar spf window coneffs worldSideEffects eventFn !startWorld = go startWorld
+  where
+    go sw = do
+        startTicks <- ticks
+        es <- pollEvents
+        let mconeff = coneffs sw
+        case mconeff of
+            NoConcurrentEffect -> return ()
+            ConcurrentEffect _ acc -> do
+                _ <- forkIO $ do
+                    up <- acc
+                    putMVar themvar up
+                return ()
+        let startWorld'' = case mconeff of
+                NoConcurrentEffect -> sw
+                ConcurrentEffect immediatef _ -> immediatef
+        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
+                let updatedWorld = foldl' eventFn worldAfterSimStep es
+                performGC
+                endTicks <- ticks -- it might be better to use System.Clock (monotonic)
+                let theDelay = max 0 (spf + fromIntegral startTicks - fromIntegral endTicks)
+                threadDelay (theDelay * 1000)
+                go $! updatedWorld