From 235e94cecb5688db1718fc981be73d833499aac9 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Sep 2021 18:00:11 +0100 Subject: [PATCH] Commit before attempting to simplify main loop --- src/Loop.hs | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) diff --git a/src/Loop.hs b/src/Loop.hs index c0bcc3afc..9b3532104 100644 --- a/src/Loop.hs +++ b/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.