diff options
-rw-r--r-- | Demos/Pong/Main.hs | 2 | ||||
-rw-r--r-- | Spear/App.hs | 66 | ||||
-rw-r--r-- | 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 | |||
26 | , world :: [GameObject] | 26 | , world :: [GameObject] |
27 | } | 27 | } |
28 | 28 | ||
29 | app = App step render resize | 29 | app = App defaultAppOptions step render resize |
30 | 30 | ||
31 | main = | 31 | main = |
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 | ) |
8 | where | 9 | where |
@@ -14,8 +15,6 @@ import Spear.Game | |||
14 | import Spear.Sys.Timer as Timer | 15 | import Spear.Sys.Timer as Timer |
15 | import Spear.Window | 16 | import Spear.Window |
16 | 17 | ||
17 | maxFPS = 60 | ||
18 | |||
19 | -- | Time elapsed. | 18 | -- | Time elapsed. |
20 | type Elapsed = Double | 19 | type 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. |
26 | type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool | 25 | type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool |
27 | 26 | ||
28 | -- | Application functions. | 27 | -- | Application options. |
28 | data AppOptions = AppOptions | ||
29 | { maxFPS :: Int | ||
30 | , enableProfiling :: Bool | ||
31 | } | ||
32 | |||
33 | defaultAppOptions = AppOptions | ||
34 | { maxFPS = 60 | ||
35 | , enableProfiling = False | ||
36 | } | ||
37 | |||
38 | -- | Application state. | ||
29 | data App s = App | 39 | data 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 | ||
49 | loop' :: | 62 | loop' :: |
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 () |
57 | loop' window ddt inputTimer elapsed timeBudget app = do | 69 | loop' 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 |