Improve game loop timing.

Uses TimeDelta (uint64) for most computations and converts to double only before stepping the game logic.

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