aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/App.hs32
-rw-r--r--Spear/Sys/Timer.hsc8
-rw-r--r--Spear/Window.hs25
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
49loop' :: 49loop' ::
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 ()
57loop' window ddt inputTimer elapsed timeBudget app = do 57loop' 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 @@
4module Spear.Sys.Timer 4module 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
161timeDeltaToSec = c_time_delta_to_sec 163timeDeltaToSec = 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.
164timeSecToDelta :: Double -> TimeDelta 166secToTimeDelta :: Double -> TimeDelta
165timeSecToDelta = c_sec_to_time_delta 167secToTimeDelta = c_sec_to_time_delta
166 168
167-- | Convert the time point to nanoseconds. 169-- | Convert the time point to nanoseconds.
168timePointToNs :: TimePoint -> Word64 170timePointToNs :: 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
73data Events = Events
74 { inputEvents :: [InputEvent]
75 , windowEvents :: [WindowEvent]
76 }
77
78-- | A window. 73-- | A window.
79data Window = Window 74data 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.
137pollEvents :: Window -> IO Events 132pollInputEvents :: Window -> IO [InputEvent]
138pollEvents window = do 133pollInputEvents window = do
134 GLFW.pollEvents
135 getEvents (inputEventsMVar window)
136
137-- | Poll for window events.
138pollWindowEvents :: Window -> IO [WindowEvent]
139pollWindowEvents 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
144getEvents :: MVar [a] -> IO [a] 143getEvents :: MVar [a] -> IO [a]
145getEvents mvar = tryTakeMVar mvar >>= \xs -> do 144getEvents mvar = tryTakeMVar mvar >>= \xs -> do