aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/App.hs66
-rw-r--r--Spear/Window.hs2
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.
28data AppOptions = AppOptions 28data AppOptions = AppOptions
29 { maxFPS :: Int 29 { maxFPS :: Int
30 , animationFPS :: Int
30 , enableProfiling :: Bool 31 , enableProfiling :: Bool
31 } 32 }
32 33
33defaultAppOptions = AppOptions 34defaultAppOptions = 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.
50fpsToDdt :: Int -> TimeDelta
51fpsToDdt 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.
47loop :: App s -> Window -> Game s () 54loop :: App s -> Window -> Game s ()
48loop app window = do 55loop 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
62loop' :: 69loop' ::
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 ()
69loop' window ddt timeBudget inputTimer app = do 77loop' 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