diff options
-rw-r--r-- | Spear/App.hs | 66 | ||||
-rw-r--r-- | Spear/Window.hs | 2 |
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 | |||
27 | -- | Application options. | 27 | -- | Application options. |
28 | data AppOptions = AppOptions | 28 | data AppOptions = AppOptions |
29 | { maxFPS :: Int | 29 | { maxFPS :: Int |
30 | , animationFPS :: Int | ||
30 | , enableProfiling :: Bool | 31 | , enableProfiling :: Bool |
31 | } | 32 | } |
32 | 33 | ||
33 | defaultAppOptions = AppOptions | 34 | defaultAppOptions = AppOptions |
34 | { maxFPS = 60 | 35 | { maxFPS = 60 -- If non-zero, cap frame rate to this value. |
36 | , animationFPS = 60 -- If non-zero, use fixed time step animation. | ||
35 | , enableProfiling = False | 37 | , enableProfiling = False |
36 | } | 38 | } |
37 | 39 | ||
@@ -43,6 +45,11 @@ data App s = App | |||
43 | , resizeApp :: WindowEvent -> Game s () | 45 | , resizeApp :: WindowEvent -> Game s () |
44 | } | 46 | } |
45 | 47 | ||
48 | |||
49 | -- | Convert FPS to desired delta time. | ||
50 | fpsToDdt :: Int -> TimeDelta | ||
51 | fpsToDdt fps = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0 | ||
52 | |||
46 | -- | Enter the main application loop. | 53 | -- | Enter the main application loop. |
47 | loop :: App s -> Window -> Game s () | 54 | loop :: App s -> Window -> Game s () |
48 | loop app window = do | 55 | loop app window = do |
@@ -52,43 +59,50 @@ loop app window = do | |||
52 | resizeApp app (ResizeEvent width height) | 59 | resizeApp app (ResizeEvent width height) |
53 | renderApp app | 60 | renderApp app |
54 | 61 | ||
55 | -- Desired delta time. | 62 | let ddt = fpsToDdt . maxFPS . options $ app -- Desired frame delta time. |
56 | let fps = maxFPS . options $ app | 63 | let animationDdt = fpsToDdt . animationFPS . options $ app -- Desired animation time step. |
57 | let ddt = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0 | 64 | |
58 | timer <- gameIO newTimer | 65 | timer <- gameIO newTimer |
59 | gameIO $ Timer.start timer | 66 | gameIO $ Timer.start timer |
60 | loop' window ddt 0 timer app | 67 | loop' window ddt animationDdt 0 timer app |
61 | 68 | ||
62 | loop' :: | 69 | loop' :: |
63 | Window -> | 70 | Window -> |
64 | TimeDelta -> -- Desired frame delta time. | 71 | TimeDelta -> -- Desired frame time delta. |
72 | TimeDelta -> -- Desired animation time delta. | ||
65 | TimeDelta -> -- Time budget. | 73 | TimeDelta -> -- Time budget. |
66 | Timer -> | 74 | Timer -> |
67 | App s -> | 75 | App s -> |
68 | Game s () | 76 | Game s () |
69 | loop' window ddt timeBudget inputTimer app = do | 77 | loop' window ddt animationDdt timeBudget inputTimer app = do |
70 | timer <- gameIO $ tick inputTimer | 78 | timer <- gameIO $ tick inputTimer |
71 | windowEvents <- gameIO $ pollWindowEvents window | 79 | windowEvents <- gameIO $ pollWindowEvents window |
72 | close <- gameIO $ shouldWindowClose window | 80 | close <- gameIO $ shouldWindowClose window |
73 | 81 | ||
74 | -- Fixed time step animation. | 82 | (continue, timeBudgetNextFrame) <- case animationDdt of |
75 | let elapsed = runningTime timer | 83 | 0 -> do |
76 | let dt = timeDeltaToSec ddt | 84 | -- Variable time step game animation. |
77 | let timeBudgetThisFrame = timeBudget + deltaTime timer | 85 | let t = timeDeltaToSec $ runningTime timer |
78 | let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt | 86 | let dt = timeDeltaToSec $ deltaTime timer |
79 | let steps = timeBudgetThisFrame `div` ddt | 87 | inputEvents <- gameIO $ pollInputEvents window |
80 | 88 | continue <- stepApp app t dt inputEvents | |
81 | continue <- and <$> forM [1..steps] (\i -> do | 89 | return (continue, 0) -- budget unused. |
82 | inputEvents <- gameIO $ pollInputEvents window | 90 | |
83 | let t = timeDeltaToSec $ elapsed + i * ddt | 91 | _ -> do |
84 | stepApp app t dt inputEvents) | 92 | -- Fixed time step animation. |
85 | 93 | let elapsed = runningTime timer | |
86 | -- Variable time step game animation. | 94 | let dt = timeDeltaToSec ddt |
87 | {- let t = timeDeltaToSec $ runningTime timer | 95 | let timeBudgetThisFrame = timeBudget + deltaTime timer |
88 | let dt = timeDeltaToSec $ deltaTime timer | 96 | let timeBudgetNextFrame = timeBudgetThisFrame `mod` ddt |
89 | inputEvents <- gameIO $ pollInputEvents window | 97 | let steps = timeBudgetThisFrame `div` ddt |
90 | continue <- stepApp app t dt inputEvents | 98 | gameIO . print $ steps |
91 | let timeBudgetNextFrame = 0 -- Unused. -} | 99 | |
100 | continue <- and <$> forM [1..steps] (\i -> do | ||
101 | inputEvents <- gameIO $ pollInputEvents window | ||
102 | let t = timeDeltaToSec $ elapsed + i * ddt | ||
103 | stepApp app t dt inputEvents) | ||
104 | |||
105 | return (continue, timeBudgetNextFrame) | ||
92 | 106 | ||
93 | -- Process window events. | 107 | -- Process window events. |
94 | resized <- or <$> forM windowEvents (\event -> case event of | 108 | resized <- or <$> forM windowEvents (\event -> case event of |
@@ -107,4 +121,4 @@ loop' window ddt timeBudget inputTimer app = do | |||
107 | gameIO $ Timer.sleep (ddt - frameTime) | 121 | gameIO $ Timer.sleep (ddt - frameTime) |
108 | 122 | ||
109 | when (continue && not close) $ do | 123 | when (continue && not close) $ do |
110 | loop' window ddt timeBudgetNextFrame timer app | 124 | 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 | |||
127 | 127 | ||
128 | GLFW.makeContextCurrent maybeWindow | 128 | GLFW.makeContextCurrent maybeWindow |
129 | 129 | ||
130 | GLFW.swapInterval 0 -- 1 enable vsync. -1 for adaptive vsync. | 130 | GLFW.swapInterval (-1) -- 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 |