diff options
-rw-r--r-- | Spear/App.hs | 32 | ||||
-rw-r--r-- | Spear/Sys/Timer.hsc | 8 | ||||
-rw-r--r-- | Spear/Window.hs | 25 |
3 files changed, 33 insertions, 32 deletions
diff --git a/Spear/App.hs b/Spear/App.hs index 41a338b..f70dd06 100644 --- a/Spear/App.hs +++ b/Spear/App.hs | |||
@@ -41,45 +41,45 @@ loop app window = do | |||
41 | resizeApp app (ResizeEvent width height) | 41 | resizeApp app (ResizeEvent width height) |
42 | renderApp app | 42 | renderApp app |
43 | 43 | ||
44 | let ddt = 1.0 / fromIntegral maxFPS -- Desired delta time. | 44 | let ddt = secToTimeDelta $ 1.0 / fromIntegral maxFPS -- Desired delta time. |
45 | timer <- gameIO newTimer | 45 | timer <- gameIO newTimer |
46 | gameIO $ Timer.start timer | 46 | gameIO $ Timer.start timer |
47 | loop' window ddt timer 0 0 app | 47 | loop' window ddt timer 0 0 app |
48 | 48 | ||
49 | loop' :: | 49 | loop' :: |
50 | Window -> | 50 | Window -> |
51 | Dt -> | 51 | TimeDelta -> -- Desired frame delta time. |
52 | Timer -> | 52 | Timer -> |
53 | Elapsed -> | 53 | TimeDelta -> -- Total elapsed app time. |
54 | Double -> -- Time budget. | 54 | TimeDelta -> -- Time budget. |
55 | App s -> | 55 | App s -> |
56 | Game s () | 56 | Game s () |
57 | loop' window ddt inputTimer elapsed timeBudget app = do | 57 | loop' window ddt inputTimer elapsed timeBudget app = do |
58 | timer <- gameIO $ tick inputTimer | 58 | timer <- gameIO $ tick inputTimer |
59 | 59 | ||
60 | (Events inputEvents windowEvents) <- gameIO $ pollEvents window | 60 | let timeBudgetThisFrame = timeBudget + deltaTime timer |
61 | let steps = timeBudgetThisFrame `div` ddt | ||
61 | 62 | ||
62 | let timeBudgetThisFrame = timeBudget + timeDeltaToSec (deltaTime timer) | 63 | continue <- and <$> forM [1..steps] (\i -> do |
64 | let t = timeDeltaToSec $ elapsed + i * ddt | ||
65 | let dt = timeDeltaToSec ddt | ||
66 | inputEvents <- gameIO $ pollInputEvents window | ||
67 | stepApp app t dt inputEvents) | ||
63 | 68 | ||
64 | let steps = floor (timeBudgetThisFrame / ddt) | 69 | let elapsed' = elapsed + steps * ddt |
65 | continue <- and <$> forM [1..steps] (\i -> | 70 | let timeBudget' = timeBudgetThisFrame `mod` ddt |
66 | stepApp app (elapsed + fromIntegral i * ddt) ddt inputEvents) | ||
67 | |||
68 | let elapsed' = elapsed + fromIntegral steps * ddt | ||
69 | let timeBudget' = timeBudgetThisFrame `mod'` ddt | ||
70 | 71 | ||
71 | when continue $ do | 72 | when continue $ do |
73 | windowEvents <- gameIO $ pollWindowEvents window | ||
72 | forM_ windowEvents $ \event -> case event of | 74 | forM_ windowEvents $ \event -> case event of |
73 | ResizeEvent {} -> resizeApp app event | 75 | ResizeEvent {} -> resizeApp app event |
74 | renderApp app | 76 | renderApp app |
75 | gameIO $ swapBuffers window | 77 | gameIO $ swapBuffers window |
76 | 78 | ||
77 | -- TODO: Conversion of TimeDelta to/from double should be unnecessary here. | ||
78 | -- We ideally need ddt expressed in TimeDelta. | ||
79 | frameEnd <- gameIO now | 79 | frameEnd <- gameIO now |
80 | let frameTime = timeDeltaToSec $ timeDiff (lastTick timer) frameEnd | 80 | let frameTime = timeDiff (lastTick timer) frameEnd |
81 | when (frameTime < ddt) $ do | 81 | when (frameTime < ddt) $ do |
82 | gameIO $ Timer.sleep (timeSecToDelta (ddt - frameTime)) | 82 | gameIO $ Timer.sleep (ddt - frameTime) |
83 | 83 | ||
84 | close <- gameIO $ shouldWindowClose window | 84 | close <- gameIO $ shouldWindowClose window |
85 | when (continue && not close) $ | 85 | when (continue && not close) $ |
diff --git a/Spear/Sys/Timer.hsc b/Spear/Sys/Timer.hsc index 2c806d8..98b88d6 100644 --- a/Spear/Sys/Timer.hsc +++ b/Spear/Sys/Timer.hsc | |||
@@ -4,13 +4,15 @@ | |||
4 | module Spear.Sys.Timer | 4 | module Spear.Sys.Timer |
5 | ( | 5 | ( |
6 | Timer(..) | 6 | Timer(..) |
7 | , TimePoint | ||
8 | , TimeDelta | ||
7 | , newTimer | 9 | , newTimer |
8 | , start | 10 | , start |
9 | , tick | 11 | , tick |
10 | , now | 12 | , now |
11 | , timeDiff | 13 | , timeDiff |
12 | , timeDeltaToSec | 14 | , timeDeltaToSec |
13 | , timeSecToDelta | 15 | , secToTimeDelta |
14 | , timePointToNs | 16 | , timePointToNs |
15 | , sleep | 17 | , sleep |
16 | ) | 18 | ) |
@@ -161,8 +163,8 @@ timeDeltaToSec :: TimeDelta -> Double | |||
161 | timeDeltaToSec = c_time_delta_to_sec | 163 | timeDeltaToSec = c_time_delta_to_sec |
162 | 164 | ||
163 | -- | Convert the time elapsed in seconds to a time delta. | 165 | -- | Convert the time elapsed in seconds to a time delta. |
164 | timeSecToDelta :: Double -> TimeDelta | 166 | secToTimeDelta :: Double -> TimeDelta |
165 | timeSecToDelta = c_sec_to_time_delta | 167 | secToTimeDelta = c_sec_to_time_delta |
166 | 168 | ||
167 | -- | Convert the time point to nanoseconds. | 169 | -- | Convert the time point to nanoseconds. |
168 | timePointToNs :: TimePoint -> Word64 | 170 | timePointToNs :: TimePoint -> Word64 |
diff --git a/Spear/Window.hs b/Spear/Window.hs index b130f5c..cbb9121 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs | |||
@@ -10,14 +10,14 @@ module Spear.Window | |||
10 | Height, | 10 | Height, |
11 | Init, | 11 | Init, |
12 | WindowEvent(..), | 12 | WindowEvent(..), |
13 | Events(..), | ||
14 | withWindow, | 13 | withWindow, |
15 | pollEvents, | 14 | pollWindowEvents, |
16 | shouldWindowClose, | 15 | shouldWindowClose, |
17 | swapBuffers, | 16 | swapBuffers, |
18 | getWindowSize, | 17 | getWindowSize, |
19 | 18 | ||
20 | -- * Input | 19 | -- * Input |
20 | pollInputEvents, | ||
21 | whenKeyDown, | 21 | whenKeyDown, |
22 | whenKeyUp, | 22 | whenKeyUp, |
23 | processKeys, | 23 | processKeys, |
@@ -70,11 +70,6 @@ data InputEvent | |||
70 | | MouseMove MousePos MouseDelta | 70 | | MouseMove MousePos MouseDelta |
71 | deriving (Eq, Show) | 71 | deriving (Eq, Show) |
72 | 72 | ||
73 | data Events = Events | ||
74 | { inputEvents :: [InputEvent] | ||
75 | , windowEvents :: [WindowEvent] | ||
76 | } | ||
77 | |||
78 | -- | A window. | 73 | -- | A window. |
79 | data Window = Window | 74 | data Window = Window |
80 | { glfwWindow :: GLFW.Window | 75 | { glfwWindow :: GLFW.Window |
@@ -133,13 +128,17 @@ setup (w, h) (major, minor) windowTitle = do | |||
133 | 128 | ||
134 | return $ Window window closeRequest inputEvents windowEvents | 129 | return $ Window window closeRequest inputEvents windowEvents |
135 | 130 | ||
136 | -- | Poll the window's events. | 131 | -- | Poll for input events. |
137 | pollEvents :: Window -> IO Events | 132 | pollInputEvents :: Window -> IO [InputEvent] |
138 | pollEvents window = do | 133 | pollInputEvents window = do |
134 | GLFW.pollEvents | ||
135 | getEvents (inputEventsMVar window) | ||
136 | |||
137 | -- | Poll for window events. | ||
138 | pollWindowEvents :: Window -> IO [WindowEvent] | ||
139 | pollWindowEvents window = do | ||
139 | GLFW.pollEvents | 140 | GLFW.pollEvents |
140 | inputEvents <- getEvents (inputEventsMVar window) | 141 | getEvents (windowEventsMVar window) |
141 | windowEvents <- getEvents (windowEventsMVar window) | ||
142 | return (Events inputEvents windowEvents) | ||
143 | 142 | ||
144 | getEvents :: MVar [a] -> IO [a] | 143 | getEvents :: MVar [a] -> IO [a] |
145 | getEvents mvar = tryTakeMVar mvar >>= \xs -> do | 144 | getEvents mvar = tryTakeMVar mvar >>= \xs -> do |