aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Demos/Pong/Main.hs2
-rw-r--r--Spear/App.hs66
-rw-r--r--Spear/Window.hs2
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
26 , world :: [GameObject] 26 , world :: [GameObject]
27 } 27 }
28 28
29app = App step render resize 29app = App defaultAppOptions step render resize
30 30
31main = 31main =
32 withWindow (1920, 1200) (Just "Pong") initGame endGame $ 32 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
3 Elapsed, 3 Elapsed,
4 Dt, 4 Dt,
5 Step, 5 Step,
6 defaultAppOptions,
6 loop, 7 loop,
7 ) 8 )
8where 9where
@@ -14,8 +15,6 @@ import Spear.Game
14import Spear.Sys.Timer as Timer 15import Spear.Sys.Timer as Timer
15import Spear.Window 16import Spear.Window
16 17
17maxFPS = 60
18
19-- | Time elapsed. 18-- | Time elapsed.
20type Elapsed = Double 19type Elapsed = Double
21 20
@@ -25,9 +24,21 @@ type Dt = Double
25-- | Return true if the application should continue running, false otherwise. 24-- | Return true if the application should continue running, false otherwise.
26type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool 25type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool
27 26
28-- | Application functions. 27-- | Application options.
28data AppOptions = AppOptions
29 { maxFPS :: Int
30 , enableProfiling :: Bool
31 }
32
33defaultAppOptions = AppOptions
34 { maxFPS = 60
35 , enableProfiling = False
36 }
37
38-- | Application state.
29data App s = App 39data App s = App
30 { stepApp :: Step s 40 { options :: AppOptions
41 , stepApp :: Step s
31 , renderApp :: Game s () 42 , renderApp :: Game s ()
32 , resizeApp :: WindowEvent -> Game s () 43 , resizeApp :: WindowEvent -> Game s ()
33 } 44 }
@@ -41,50 +52,57 @@ loop app window = do
41 resizeApp app (ResizeEvent width height) 52 resizeApp app (ResizeEvent width height)
42 renderApp app 53 renderApp app
43 54
44 let ddt = secToTimeDelta $ 1.0 / fromIntegral maxFPS -- Desired delta time. 55 -- Desired delta time.
56 let fps = maxFPS . options $ app
57 let ddt = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0
45 timer <- gameIO newTimer 58 timer <- gameIO newTimer
46 gameIO $ Timer.start timer 59 gameIO $ Timer.start timer
47 loop' window ddt timer 0 0 app 60 loop' window ddt 0 timer app
48 61
49loop' :: 62loop' ::
50 Window -> 63 Window ->
51 TimeDelta -> -- Desired frame delta time. 64 TimeDelta -> -- Desired frame delta time.
52 Timer ->
53 TimeDelta -> -- Total elapsed app time.
54 TimeDelta -> -- Time budget. 65 TimeDelta -> -- Time budget.
66 Timer ->
55 App s -> 67 App s ->
56 Game s () 68 Game s ()
57loop' window ddt inputTimer elapsed timeBudget app = do 69loop' window ddt timeBudget inputTimer app = do
58 timer <- gameIO $ tick inputTimer 70 timer <- gameIO $ tick inputTimer
59 inputEvents <- gameIO $ pollInputEvents window
60 windowEvents <- gameIO $ pollWindowEvents window 71 windowEvents <- gameIO $ pollWindowEvents window
61 close <- gameIO $ shouldWindowClose window 72 close <- gameIO $ shouldWindowClose window
62 73
74 -- Fixed time step animation.
75 let elapsed = runningTime timer
76 let dt = timeDeltaToSec ddt
63 let timeBudgetThisFrame = timeBudget + deltaTime timer 77 let timeBudgetThisFrame = timeBudget + deltaTime timer
78 let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt
64 let steps = timeBudgetThisFrame `div` ddt 79 let steps = timeBudgetThisFrame `div` ddt
65 80
66 --gameIO . putStrLn $ "Steps: " ++ show steps
67
68 continue <- and <$> forM [1..steps] (\i -> do 81 continue <- and <$> forM [1..steps] (\i -> do
69 let t = timeDeltaToSec $ elapsed + i * ddt 82 inputEvents <- gameIO $ pollInputEvents window
70 let dt = timeDeltaToSec ddt 83 let t = timeDeltaToSec $ elapsed + i * ddt
71 stepApp app t dt inputEvents) 84 stepApp app t dt inputEvents)
72 85
73 let elapsedNextFrame = elapsed + steps * ddt 86 -- Variable time step game animation.
74 let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt 87 {-let t = timeDeltaToSec $ runningTime timer
88 let dt = timeDeltaToSec $ deltaTime timer
89 continue <- stepApp app t dt inputEvents-}
75 90
76 when (continue && not close) $ do 91 -- Process window events.
77 resized <- or <$> forM windowEvents (\event -> case event of 92 resized <- or <$> forM windowEvents (\event -> case event of
78 ResizeEvent {} -> resizeApp app event >> return True) 93 ResizeEvent {} -> resizeApp app event >> return True)
79 94
80 -- For smoother resizing, render only while not resizing. 95 -- For smoother resizing, render only while not resizing.
81 unless resized $ do 96 unless resized $ do
82 renderApp app 97 renderApp app
83 gameIO $ swapBuffers window 98 gameIO $ swapBuffers window
84 99
100 -- Limit frame rate if so requested by the application.
101 when ((maxFPS . options $ app) > 0) $ do
85 frameEnd <- gameIO now 102 frameEnd <- gameIO now
86 let frameTime = timeDiff (lastTick timer) frameEnd 103 let frameTime = timeDiff (lastTick timer) frameEnd
87 when (frameTime < ddt) $ do 104 when (frameTime < ddt) $ do
88 gameIO $ Timer.sleep (ddt - frameTime) 105 gameIO $ Timer.sleep (ddt - frameTime)
89 106
90 loop' window ddt timer elapsedNextFrame timeBudgetNextFrame app 107 when (continue && not close) $ do
108 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
127 127
128 GLFW.makeContextCurrent maybeWindow 128 GLFW.makeContextCurrent maybeWindow
129 129
130 GLFW.swapInterval 1 -- Enable vsync. 130 GLFW.swapInterval 0 -- 1 enable vsync. -1 for adaptive vsync.
131 131
132 GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest 132 GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest
133 GLFW.setWindowSizeCallback window . Just $ onResize windowEvents 133 GLFW.setWindowSizeCallback window . Just $ onResize windowEvents