From 4bbd2d43b5c92197ea23bc3db42a9d2991390eb1 Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Sun, 17 Nov 2024 14:13:53 -0800
Subject: Remove vsync to fix stuttering.

---
 Demos/Pong/Main.hs |  2 +-
 Spear/App.hs       | 66 ++++++++++++++++++++++++++++++++++--------------------
 Spear/Window.hs    |  2 +-
 3 files changed, 44 insertions(+), 26 deletions(-)

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index 21fcb0c..d51a324 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -26,7 +26,7 @@ data GameState = GameState
   , world           :: [GameObject]
   }
 
-app = App step render resize
+app = App defaultAppOptions step render resize
 
 main =
   withWindow (1920, 1200) (Just "Pong") initGame endGame $
diff --git a/Spear/App.hs b/Spear/App.hs
index 96d45f1..bc4886c 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -3,6 +3,7 @@ module Spear.App
     Elapsed,
     Dt,
     Step,
+    defaultAppOptions,
     loop,
   )
 where
@@ -14,8 +15,6 @@ import           Spear.Game
 import           Spear.Sys.Timer as Timer
 import           Spear.Window
 
-maxFPS = 60
-
 -- | Time elapsed.
 type Elapsed = Double
 
@@ -25,9 +24,21 @@ type Dt = Double
 -- | Return true if the application should continue running, false otherwise.
 type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool
 
--- | Application functions.
+-- | Application options.
+data AppOptions = AppOptions
+  { maxFPS          :: Int
+  , enableProfiling :: Bool
+  }
+
+defaultAppOptions = AppOptions
+  { maxFPS          = 60
+  , enableProfiling = False
+  }
+
+-- | Application state.
 data App s = App
-  { stepApp   :: Step s
+  { options   :: AppOptions
+  , stepApp   :: Step s
   , renderApp :: Game s ()
   , resizeApp :: WindowEvent -> Game s ()
   }
@@ -41,50 +52,57 @@ loop app window = do
   resizeApp app (ResizeEvent width height)
   renderApp app
 
-  let ddt = secToTimeDelta $ 1.0 / fromIntegral maxFPS -- Desired delta time.
+  -- Desired delta time.
+  let fps = maxFPS . options $ app
+  let ddt = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0
   timer <- gameIO newTimer
   gameIO $ Timer.start timer
-  loop' window ddt timer 0 0 app
+  loop' window ddt 0 timer app
 
 loop' ::
   Window ->
   TimeDelta -> -- Desired frame delta time.
-  Timer ->
-  TimeDelta -> -- Total elapsed app time.
   TimeDelta -> -- Time budget.
+  Timer ->
   App s ->
   Game s ()
-loop' window ddt inputTimer elapsed timeBudget app = do
+loop' window ddt timeBudget inputTimer app = do
   timer        <- gameIO $ tick inputTimer
-  inputEvents  <- gameIO $ pollInputEvents window
   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
 
-  --gameIO . putStrLn $ "Steps: " ++ show steps
-
   continue <- and <$> forM [1..steps] (\i -> do
-    let t  = timeDeltaToSec $ elapsed + i * ddt
-    let dt = timeDeltaToSec ddt
+    inputEvents <- gameIO $ pollInputEvents window
+    let t = timeDeltaToSec $ elapsed + i * ddt
     stepApp app t dt inputEvents)
 
-  let elapsedNextFrame    = elapsed + steps * ddt
-  let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt
+  -- Variable time step game animation.
+  {-let t  = timeDeltaToSec $ runningTime timer
+  let dt = timeDeltaToSec $ deltaTime   timer
+  continue <- stepApp app t dt inputEvents-}
 
-  when (continue && not close) $ do
-    resized <- or <$> forM windowEvents (\event -> case event of
-      ResizeEvent {} -> resizeApp app event >> return True)
+  -- Process window events.
+  resized <- or <$> forM windowEvents (\event -> case event of
+    ResizeEvent {} -> resizeApp app event >> return True)
 
-    -- For smoother resizing, render only while not resizing.
-    unless resized $ do
-      renderApp app
-      gameIO $ swapBuffers window
+  -- For smoother resizing, render only while not resizing.
+  unless resized $ do
+    renderApp app
+    gameIO $ swapBuffers window
 
+  -- Limit frame rate if so requested by the application.
+  when ((maxFPS . options $ app) > 0) $ do
     frameEnd <- gameIO now
     let frameTime = timeDiff (lastTick timer) frameEnd
     when (frameTime < ddt) $ do
       gameIO $ Timer.sleep (ddt - frameTime)
 
-    loop' window ddt timer elapsedNextFrame timeBudgetNextFrame app
+  when (continue && not close) $ do
+    loop' window ddt timeBudgetNextFrame timer app
diff --git a/Spear/Window.hs b/Spear/Window.hs
index be52080..caddc5d 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -127,7 +127,7 @@ setup (w, h) windowTitle = do
 
   GLFW.makeContextCurrent maybeWindow
 
-  GLFW.swapInterval 1 -- Enable vsync.
+  GLFW.swapInterval 0 -- 1 enable vsync. -1 for adaptive vsync.
 
   GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest
   GLFW.setWindowSizeCallback  window . Just $ onResize      windowEvents
-- 
cgit v1.2.3