diff options
-rw-r--r-- | Spear/Window.hs | 35 | ||||
-rw-r--r-- | demos/pong/Main.hs | 12 |
2 files changed, 28 insertions, 19 deletions
diff --git a/Spear/Window.hs b/Spear/Window.hs index 2ad6321..b3e838c 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs | |||
@@ -16,6 +16,7 @@ module Spear.Window | |||
16 | , withWindow | 16 | , withWindow |
17 | , events | 17 | , events |
18 | -- * Animation | 18 | -- * Animation |
19 | , Elapsed | ||
19 | , Dt | 20 | , Dt |
20 | , Step | 21 | , Step |
21 | , loop | 22 | , loop |
@@ -37,6 +38,7 @@ import Data.Char (ord) | |||
37 | import Control.Concurrent.MVar | 38 | import Control.Concurrent.MVar |
38 | import Control.Monad (when) | 39 | import Control.Monad (when) |
39 | import Control.Monad.IO.Class | 40 | import Control.Monad.IO.Class |
41 | import GHC.Float | ||
40 | import qualified Graphics.UI.GLFW as GLFW | 42 | import qualified Graphics.UI.GLFW as GLFW |
41 | import Graphics.UI.GLFW (DisplayBits(..), WindowMode(..)) | 43 | import Graphics.UI.GLFW (DisplayBits(..), WindowMode(..)) |
42 | import qualified Graphics.Rendering.OpenGL as GL | 44 | import qualified Graphics.Rendering.OpenGL as GL |
@@ -136,11 +138,14 @@ glfwInit = do | |||
136 | False -> gameError "GLFW.initialize failed" | 138 | False -> gameError "GLFW.initialize failed" |
137 | True -> return () | 139 | True -> return () |
138 | 140 | ||
141 | -- | Time elapsed since the application started. | ||
142 | type Elapsed = Double | ||
143 | |||
139 | -- | Time elapsed since the last frame. | 144 | -- | Time elapsed since the last frame. |
140 | type Dt = Float | 145 | type Dt = Float |
141 | 146 | ||
142 | -- | Return true if the application should continue running, false otherwise. | 147 | -- | Return true if the application should continue running, false otherwise. |
143 | type Step s = Dt -> Game s (Bool) | 148 | type Step s = Elapsed -> Dt -> Game s (Bool) |
144 | 149 | ||
145 | -- | Maximum frame rate. | 150 | -- | Maximum frame rate. |
146 | type FrameCap = Int | 151 | type FrameCap = Int |
@@ -150,15 +155,17 @@ loop :: Maybe FrameCap -> Step s -> Window -> Game s () | |||
150 | loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd | 155 | loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd |
151 | loop Nothing step wnd = do | 156 | loop Nothing step wnd = do |
152 | timer <- gameIO $ start newTimer | 157 | timer <- gameIO $ start newTimer |
153 | loop' (closeRequest wnd) timer step | 158 | loop' (closeRequest wnd) timer 0 step |
154 | return () | 159 | return () |
155 | 160 | ||
156 | loop' :: CloseRequest -> Timer -> Step s -> Game s () | 161 | loop' :: CloseRequest -> Timer -> Elapsed -> Step s -> Game s () |
157 | loop' closeRequest timer step = do | 162 | loop' closeRequest timer elapsed step = do |
158 | timer' <- gameIO $ tick timer | 163 | timer' <- gameIO $ tick timer |
159 | continue <- step $ getDelta timer' | 164 | let dt = getDelta timer' |
165 | let elapsed' = elapsed + float2Double dt | ||
166 | continue <- step elapsed' dt | ||
160 | close <- gameIO $ getRequest closeRequest | 167 | close <- gameIO $ getRequest closeRequest |
161 | when (continue && (not close)) $ loop' closeRequest timer' step | 168 | when (continue && (not close)) $ loop' closeRequest timer' elapsed' step |
162 | 169 | ||
163 | loopCapped :: Int -> Step s -> Window -> Game s () | 170 | loopCapped :: Int -> Step s -> Window -> Game s () |
164 | loopCapped maxFPS step wnd = do | 171 | loopCapped maxFPS step wnd = do |
@@ -166,20 +173,24 @@ loopCapped maxFPS step wnd = do | |||
166 | closeReq = closeRequest wnd | 173 | closeReq = closeRequest wnd |
167 | frameTimer <- gameIO $ start newTimer | 174 | frameTimer <- gameIO $ start newTimer |
168 | controlTimer <- gameIO $ start newTimer | 175 | controlTimer <- gameIO $ start newTimer |
169 | loopCapped' closeReq ddt frameTimer controlTimer step | 176 | loopCapped' closeReq ddt frameTimer controlTimer 0 step |
170 | return () | 177 | return () |
171 | 178 | ||
172 | loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s () | 179 | loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Elapsed -> Step s |
173 | loopCapped' closeRequest ddt frameTimer controlTimer step = do | 180 | -> Game s () |
181 | loopCapped' closeRequest ddt frameTimer controlTimer elapsed step = do | ||
174 | controlTimer' <- gameIO $ tick controlTimer | 182 | controlTimer' <- gameIO $ tick controlTimer |
175 | frameTimer' <- gameIO $ tick frameTimer | 183 | frameTimer' <- gameIO $ tick frameTimer |
176 | continue <- step $ getDelta frameTimer' | 184 | let dt = getDelta frameTimer' |
185 | let elapsed' = elapsed + float2Double dt | ||
186 | continue <- step elapsed' dt | ||
177 | close <- gameIO $ getRequest closeRequest | 187 | close <- gameIO $ getRequest closeRequest |
178 | controlTimer'' <- gameIO $ tick controlTimer' | 188 | controlTimer'' <- gameIO $ tick controlTimer' |
179 | let dt = getDelta controlTimer'' | 189 | let dt = getDelta controlTimer'' |
180 | when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) | 190 | when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) |
181 | when (continue && (not close)) $ | 191 | when (continue && (not close)) $ |
182 | loopCapped' closeRequest ddt frameTimer' controlTimer'' step | 192 | loopCapped' closeRequest ddt frameTimer' controlTimer'' |
193 | elapsed' step | ||
183 | 194 | ||
184 | getRequest :: MVar Bool -> IO Bool | 195 | getRequest :: MVar Bool -> IO Bool |
185 | getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of | 196 | getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of |
diff --git a/demos/pong/Main.hs b/demos/pong/Main.hs index e9a6dc1..d0664b7 100644 --- a/demos/pong/Main.hs +++ b/demos/pong/Main.hs | |||
@@ -14,7 +14,6 @@ import Graphics.Rendering.OpenGL.GL (($=)) | |||
14 | 14 | ||
15 | data GameState = GameState | 15 | data GameState = GameState |
16 | { wnd :: Window | 16 | { wnd :: Window |
17 | , elapsed :: Double | ||
18 | , world :: [GameObject] | 17 | , world :: [GameObject] |
19 | } | 18 | } |
20 | 19 | ||
@@ -27,17 +26,16 @@ initGame wnd = do | |||
27 | GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0 | 26 | GL.clearColor $= GL.Color4 0.7 0.5 0.7 1.0 |
28 | GL.matrixMode $= GL.Modelview 0 | 27 | GL.matrixMode $= GL.Modelview 0 |
29 | GL.loadIdentity | 28 | GL.loadIdentity |
30 | return $ GameState wnd 0 newWorld | 29 | return $ GameState wnd newWorld |
31 | 30 | ||
32 | step :: Dt -> Game GameState Bool | 31 | step :: Elapsed -> Dt -> Game GameState Bool |
33 | step dt = do | 32 | step elapsed dt = do |
34 | gs <- getGameState | 33 | gs <- getGameState |
35 | evts <- events (wnd gs) | 34 | evts <- events (wnd gs) |
36 | gameIO . process $ evts | 35 | gameIO . process $ evts |
37 | let evts' = translate evts | 36 | let evts' = translate evts |
38 | modifyGameState $ \ gs -> gs | 37 | modifyGameState $ \ gs -> gs |
39 | { world = stepWorld (elapsed gs) dt evts' (world gs) | 38 | { world = stepWorld elapsed dt evts' (world gs) } |
40 | , elapsed = elapsed gs + realToFrac dt } | ||
41 | getGameState >>= \gs -> gameIO . render $ world gs | 39 | getGameState >>= \gs -> gameIO . render $ world gs |
42 | return (not $ exitRequested evts) | 40 | return (not $ exitRequested evts) |
43 | 41 | ||
@@ -78,4 +76,4 @@ translate' _ = Nothing | |||
78 | exitRequested = any (==(KeyDown KEY_ESC)) | 76 | exitRequested = any (==(KeyDown KEY_ESC)) |
79 | 77 | ||
80 | f2d :: Float -> GL.GLdouble | 78 | f2d :: Float -> GL.GLdouble |
81 | f2d = realToFrac \ No newline at end of file | 79 | f2d = realToFrac |