Commit before attempting to simplify main loop

src/Loop.hs

@@ -52,6 +52,57 @@ setupLoop
                     initParams 
                     paramCleanup 
                     $ doLoop window startWorld sideEffects eventFn worldFn
+
+
+-- | Create a game loop with an SDL window.
+setupLoop'
+    :: (Int,Int)            -- ^ The window size.
+    -> (world -> IO ())    -- ^ Function for cleaning up parameters, applied when exiting loop.
+    -> IO world             -- ^ Initial simulation state.
+    -> (world -> IO world)   -- ^ update, called once per frame. Allows for side effects such as rendering.
+    -> (world -> Event -> Maybe world)
+                            -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop.
+    -> IO ()
+setupLoop' (xSize,ySize) paramCleanup ioStartWorld sideEffects eventFn = do 
+    initializeAll
+    bracket 
+        (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize)) 
+        destroyWindow 
+        $ \window -> bracket 
+            (glCreateContext window) 
+            ( \con -> GL.finish >> glDeleteContext con)
+            $ \_   -> bracket 
+                ioStartWorld
+                paramCleanup 
+                $ doLoop' window sideEffects eventFn
+-- | The internal loop.
+doLoop'
+    :: Window   -- ^ The SDL window.
+    -> (world -> IO world) -- ^ simulation update. 
+    -> (world -> Event -> Maybe world) -- ^ SDL Event handling.
+    -> world    -- ^ Current simulation state.
+    -> IO ()
+doLoop' 
+    window 
+    worldSideEffects 
+    eventFn 
+    startWorld
+  = do
+    startTicks <- ticks
+    worldAfterSimStep <- worldSideEffects startWorld
+    glSwapWindow window
+    events <- pollEvents
+    maybeUpdatedWorld <- foldM (applyEventIO eventFn) (Just worldAfterSimStep) events
+    case maybeUpdatedWorld of
+        Just updatedWorld -> do 
+            performGC
+            endTicks <- ticks -- it might be better to use System.Clock (monotonic)
+
+            let theDelay = max 0 (20 + fromIntegral startTicks - fromIntegral endTicks)
+            threadDelay (theDelay * 1000 )
+
+            doLoop' window worldSideEffects eventFn updatedWorld
+        Nothing -> return ()
 -- | The internal loop.
 doLoop 
     :: Window   -- ^ The SDL window.