From df04706413ca2bba4017c5b2d19bc992aa985110 Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Thu, 14 Sep 2023 19:14:40 -0700 Subject: Improve game loop timing. Uses TimeDelta (uint64) for most computations and converts to double only before stepping the game logic. --- Spear/App.hs | 32 ++++++++++++++++---------------- Spear/Sys/Timer.hsc | 8 +++++--- Spear/Window.hs | 25 ++++++++++++------------- 3 files changed, 33 insertions(+), 32 deletions(-) diff --git a/Spear/App.hs b/Spear/App.hs index 41a338b..f70dd06 100644 --- a/Spear/App.hs +++ b/Spear/App.hs @@ -41,45 +41,45 @@ loop app window = do resizeApp app (ResizeEvent width height) renderApp app - let ddt = 1.0 / fromIntegral maxFPS -- Desired delta time. + let ddt = secToTimeDelta $ 1.0 / fromIntegral maxFPS -- Desired delta time. timer <- gameIO newTimer gameIO $ Timer.start timer loop' window ddt timer 0 0 app loop' :: Window -> - Dt -> + TimeDelta -> -- Desired frame delta time. Timer -> - Elapsed -> - Double -> -- Time budget. + TimeDelta -> -- Total elapsed app time. + TimeDelta -> -- Time budget. App s -> Game s () loop' window ddt inputTimer elapsed timeBudget app = do timer <- gameIO $ tick inputTimer - (Events inputEvents windowEvents) <- gameIO $ pollEvents window + let timeBudgetThisFrame = timeBudget + deltaTime timer + let steps = timeBudgetThisFrame `div` ddt - let timeBudgetThisFrame = timeBudget + timeDeltaToSec (deltaTime timer) + continue <- and <$> forM [1..steps] (\i -> do + let t = timeDeltaToSec $ elapsed + i * ddt + let dt = timeDeltaToSec ddt + inputEvents <- gameIO $ pollInputEvents window + stepApp app t dt inputEvents) - let steps = floor (timeBudgetThisFrame / ddt) - continue <- and <$> forM [1..steps] (\i -> - stepApp app (elapsed + fromIntegral i * ddt) ddt inputEvents) - - let elapsed' = elapsed + fromIntegral steps * ddt - let timeBudget' = timeBudgetThisFrame `mod'` ddt + let elapsed' = elapsed + steps * ddt + let timeBudget' = timeBudgetThisFrame `mod` ddt when continue $ do + windowEvents <- gameIO $ pollWindowEvents window forM_ windowEvents $ \event -> case event of ResizeEvent {} -> resizeApp app event renderApp app gameIO $ swapBuffers window - -- TODO: Conversion of TimeDelta to/from double should be unnecessary here. - -- We ideally need ddt expressed in TimeDelta. frameEnd <- gameIO now - let frameTime = timeDeltaToSec $ timeDiff (lastTick timer) frameEnd + let frameTime = timeDiff (lastTick timer) frameEnd when (frameTime < ddt) $ do - gameIO $ Timer.sleep (timeSecToDelta (ddt - frameTime)) + gameIO $ Timer.sleep (ddt - frameTime) close <- gameIO $ shouldWindowClose window when (continue && not close) $ diff --git a/Spear/Sys/Timer.hsc b/Spear/Sys/Timer.hsc index 2c806d8..98b88d6 100644 --- a/Spear/Sys/Timer.hsc +++ b/Spear/Sys/Timer.hsc @@ -4,13 +4,15 @@ module Spear.Sys.Timer ( Timer(..) +, TimePoint +, TimeDelta , newTimer , start , tick , now , timeDiff , timeDeltaToSec -, timeSecToDelta +, secToTimeDelta , timePointToNs , sleep ) @@ -161,8 +163,8 @@ timeDeltaToSec :: TimeDelta -> Double timeDeltaToSec = c_time_delta_to_sec -- | Convert the time elapsed in seconds to a time delta. -timeSecToDelta :: Double -> TimeDelta -timeSecToDelta = c_sec_to_time_delta +secToTimeDelta :: Double -> TimeDelta +secToTimeDelta = c_sec_to_time_delta -- | Convert the time point to nanoseconds. timePointToNs :: TimePoint -> Word64 diff --git a/Spear/Window.hs b/Spear/Window.hs index b130f5c..cbb9121 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs @@ -10,14 +10,14 @@ module Spear.Window Height, Init, WindowEvent(..), - Events(..), withWindow, - pollEvents, + pollWindowEvents, shouldWindowClose, swapBuffers, getWindowSize, -- * Input + pollInputEvents, whenKeyDown, whenKeyUp, processKeys, @@ -70,11 +70,6 @@ data InputEvent | MouseMove MousePos MouseDelta deriving (Eq, Show) -data Events = Events - { inputEvents :: [InputEvent] - , windowEvents :: [WindowEvent] - } - -- | A window. data Window = Window { glfwWindow :: GLFW.Window @@ -133,13 +128,17 @@ setup (w, h) (major, minor) windowTitle = do return $ Window window closeRequest inputEvents windowEvents --- | Poll the window's events. -pollEvents :: Window -> IO Events -pollEvents window = do +-- | Poll for input events. +pollInputEvents :: Window -> IO [InputEvent] +pollInputEvents window = do + GLFW.pollEvents + getEvents (inputEventsMVar window) + +-- | Poll for window events. +pollWindowEvents :: Window -> IO [WindowEvent] +pollWindowEvents window = do GLFW.pollEvents - inputEvents <- getEvents (inputEventsMVar window) - windowEvents <- getEvents (windowEventsMVar window) - return (Events inputEvents windowEvents) + getEvents (windowEventsMVar window) getEvents :: MVar [a] -> IO [a] getEvents mvar = tryTakeMVar mvar >>= \xs -> do -- cgit v1.2.3