aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/Window.hs35
-rw-r--r--demos/pong/Main.hs12
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)
37import Control.Concurrent.MVar 38import Control.Concurrent.MVar
38import Control.Monad (when) 39import Control.Monad (when)
39import Control.Monad.IO.Class 40import Control.Monad.IO.Class
41import GHC.Float
40import qualified Graphics.UI.GLFW as GLFW 42import qualified Graphics.UI.GLFW as GLFW
41import Graphics.UI.GLFW (DisplayBits(..), WindowMode(..)) 43import Graphics.UI.GLFW (DisplayBits(..), WindowMode(..))
42import qualified Graphics.Rendering.OpenGL as GL 44import 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.
142type Elapsed = Double
143
139-- | Time elapsed since the last frame. 144-- | Time elapsed since the last frame.
140type Dt = Float 145type 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.
143type Step s = Dt -> Game s (Bool) 148type Step s = Elapsed -> Dt -> Game s (Bool)
144 149
145-- | Maximum frame rate. 150-- | Maximum frame rate.
146type FrameCap = Int 151type FrameCap = Int
@@ -150,15 +155,17 @@ loop :: Maybe FrameCap -> Step s -> Window -> Game s ()
150loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd 155loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd
151loop Nothing step wnd = do 156loop 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
156loop' :: CloseRequest -> Timer -> Step s -> Game s () 161loop' :: CloseRequest -> Timer -> Elapsed -> Step s -> Game s ()
157loop' closeRequest timer step = do 162loop' 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
163loopCapped :: Int -> Step s -> Window -> Game s () 170loopCapped :: Int -> Step s -> Window -> Game s ()
164loopCapped maxFPS step wnd = do 171loopCapped 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
172loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s () 179loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Elapsed -> Step s
173loopCapped' closeRequest ddt frameTimer controlTimer step = do 180 -> Game s ()
181loopCapped' 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
184getRequest :: MVar Bool -> IO Bool 195getRequest :: MVar Bool -> IO Bool
185getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of 196getRequest 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
15data GameState = GameState 15data 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
32step :: Dt -> Game GameState Bool 31step :: Elapsed -> Dt -> Game GameState Bool
33step dt = do 32step 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
78exitRequested = any (==(KeyDown KEY_ESC)) 76exitRequested = any (==(KeyDown KEY_ESC))
79 77
80f2d :: Float -> GL.GLdouble 78f2d :: Float -> GL.GLdouble
81f2d = realToFrac \ No newline at end of file 79f2d = realToFrac