Use adaptive sync if available.

2 files changed, 41 insertions, 27 deletions

diff --git a/Spear/App.hs b/Spear/App.hs
index 1230a61..f8afc9e 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -27,11 +27,13 @@ type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool
 -- | Application options.
 data AppOptions = AppOptions
   { maxFPS          :: Int
+  , animationFPS    :: Int
   , enableProfiling :: Bool
   }
 
 defaultAppOptions = AppOptions
-  { maxFPS          = 60
+  { maxFPS          = 60 -- If non-zero, cap frame rate to this value.
+  , animationFPS    = 60 -- If non-zero, use fixed time step animation.
   , enableProfiling = False
   }
 
@@ -43,6 +45,11 @@ data App s = App
   , resizeApp :: WindowEvent -> Game s ()
   }
 
+
+-- | Convert FPS to desired delta time.
+fpsToDdt :: Int -> TimeDelta
+fpsToDdt fps = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0
+
 -- | Enter the main application loop.
 loop :: App s -> Window -> Game s ()
 loop app window = do
@@ -52,43 +59,50 @@ loop app window = do
   resizeApp app (ResizeEvent width height)
   renderApp app
 
-  -- Desired delta time.
-  let fps = maxFPS . options $ app
-  let ddt = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0
+  let ddt          = fpsToDdt .       maxFPS . options $ app -- Desired frame delta time.
+  let animationDdt = fpsToDdt . animationFPS . options $ app -- Desired animation time step.
+
   timer <- gameIO newTimer
   gameIO $ Timer.start timer
-  loop' window ddt 0 timer app
+  loop' window ddt animationDdt 0 timer app
 
 loop' ::
   Window ->
-  TimeDelta -> -- Desired frame delta time.
+  TimeDelta -> -- Desired frame time delta.
+  TimeDelta -> -- Desired animation time delta.
   TimeDelta -> -- Time budget.
   Timer ->
   App s ->
   Game s ()
-loop' window ddt timeBudget inputTimer app = do
+loop' window ddt animationDdt timeBudget inputTimer app = do
   timer        <- gameIO $ tick inputTimer
   windowEvents <- gameIO $ pollWindowEvents window
   close        <- gameIO $ shouldWindowClose window
 
-  -- Fixed time step animation.
-  let elapsed = runningTime timer
-  let dt = timeDeltaToSec ddt
-  let timeBudgetThisFrame = timeBudget + deltaTime timer
-  let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt
-  let steps = timeBudgetThisFrame `div` ddt
-
-  continue <- and <$> forM [1..steps] (\i -> do
-    inputEvents <- gameIO $ pollInputEvents window
-    let t = timeDeltaToSec $ elapsed + i * ddt
-    stepApp app t dt inputEvents)
-
-  -- Variable time step game animation.
-  {- let t  = timeDeltaToSec $ runningTime timer
-  let dt = timeDeltaToSec $ deltaTime   timer
-  inputEvents <- gameIO $ pollInputEvents window
-  continue <- stepApp app t dt inputEvents
-  let timeBudgetNextFrame = 0 -- Unused. -}
+  (continue, timeBudgetNextFrame) <- case animationDdt of
+    0 -> do
+      -- Variable time step game animation.
+      let t  = timeDeltaToSec $ runningTime timer
+      let dt = timeDeltaToSec $ deltaTime   timer
+      inputEvents <- gameIO $ pollInputEvents window
+      continue <- stepApp app t dt inputEvents
+      return (continue, 0) -- budget unused.
+
+    _ -> do
+      -- Fixed time step animation.
+      let elapsed = runningTime timer
+      let dt = timeDeltaToSec ddt
+      let timeBudgetThisFrame = timeBudget + deltaTime timer
+      let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt
+      let steps = timeBudgetThisFrame `div` ddt
+      gameIO . print $ steps
+
+      continue <- and <$> forM [1..steps] (\i -> do
+        inputEvents <- gameIO $ pollInputEvents window
+        let t = timeDeltaToSec $ elapsed + i * ddt
+        stepApp app t dt inputEvents)
+
+      return (continue, timeBudgetNextFrame)
 
   -- Process window events.
   resized <- or <$> forM windowEvents (\event -> case event of
@@ -107,4 +121,4 @@ loop' window ddt timeBudget inputTimer app = do
       gameIO $ Timer.sleep (ddt - frameTime)
 
   when (continue && not close) $ do
-    loop' window ddt timeBudgetNextFrame timer app
+    loop' window ddt animationDdt timeBudgetNextFrame timer app
diff --git a/Spear/Window.hs b/Spear/Window.hs
index caddc5d..65ca243 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -127,7 +127,7 @@ setup (w, h) windowTitle = do
 
   GLFW.makeContextCurrent maybeWindow
 
-  GLFW.swapInterval 0 -- 1 enable vsync. -1 for adaptive vsync.
+  GLFW.swapInterval (-1) -- 1 enable vsync. -1 for adaptive vsync.
 
   GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest
   GLFW.setWindowSizeCallback  window . Just $ onResize      windowEvents