diff options
author | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-17 18:59:29 +0200 |
---|---|---|
committer | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-17 18:59:29 +0200 |
commit | 12b9253d857be440b0fc72a3344de20e4c60732a (patch) | |
tree | 100c05f427a65b1949dbbcc4db3d5dbd8f86e281 | |
parent | 59d2edd9877a2aa1e243597052a3af6bbeefa3cf (diff) |
Added run function
-rw-r--r-- | Spear/Window.hs | 46 | ||||
-rw-r--r-- | demos/pong/Main.hs | 11 |
2 files changed, 30 insertions, 27 deletions
diff --git a/Spear/Window.hs b/Spear/Window.hs index 1762da0..2ad6321 100644 --- a/Spear/Window.hs +++ b/Spear/Window.hs | |||
@@ -12,6 +12,7 @@ module Spear.Window | |||
12 | , Width | 12 | , Width |
13 | , Height | 13 | , Height |
14 | , Init | 14 | , Init |
15 | , run | ||
15 | , withWindow | 16 | , withWindow |
16 | , events | 17 | , events |
17 | -- * Animation | 18 | -- * Animation |
@@ -71,6 +72,13 @@ events wnd = liftIO $ do | |||
71 | -- | Game initialiser. | 72 | -- | Game initialiser. |
72 | type Init s = Window -> Game () s | 73 | type Init s = Window -> Game () s |
73 | 74 | ||
75 | run :: MonadIO m => m (Either String a) -> m () | ||
76 | run r = do | ||
77 | result <- r | ||
78 | case result of | ||
79 | Left err -> liftIO $ putStrLn err | ||
80 | Right _ -> return () | ||
81 | |||
74 | withWindow :: MonadIO m | 82 | withWindow :: MonadIO m |
75 | => Dimensions -> [DisplayBits] -> WindowMode -> Context | 83 | => Dimensions -> [DisplayBits] -> WindowMode -> Context |
76 | -> Maybe WindowTitle | 84 | -> Maybe WindowTitle |
@@ -142,15 +150,15 @@ loop :: Maybe FrameCap -> Step s -> Window -> Game s () | |||
142 | loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd | 150 | loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd |
143 | loop Nothing step wnd = do | 151 | loop Nothing step wnd = do |
144 | timer <- gameIO $ start newTimer | 152 | timer <- gameIO $ start newTimer |
145 | run (closeRequest wnd) timer step | 153 | loop' (closeRequest wnd) timer step |
146 | return () | 154 | return () |
147 | 155 | ||
148 | run :: CloseRequest -> Timer -> Step s -> Game s () | 156 | loop' :: CloseRequest -> Timer -> Step s -> Game s () |
149 | run closeRequest timer step = do | 157 | loop' closeRequest timer step = do |
150 | timer' <- gameIO $ tick timer | 158 | timer' <- gameIO $ tick timer |
151 | continue <- step $ getDelta timer' | 159 | continue <- step $ getDelta timer' |
152 | close <- gameIO $ getRequest closeRequest | 160 | close <- gameIO $ getRequest closeRequest |
153 | when (continue && (not close)) $ run closeRequest timer' step | 161 | when (continue && (not close)) $ loop' closeRequest timer' step |
154 | 162 | ||
155 | loopCapped :: Int -> Step s -> Window -> Game s () | 163 | loopCapped :: Int -> Step s -> Window -> Game s () |
156 | loopCapped maxFPS step wnd = do | 164 | loopCapped maxFPS step wnd = do |
@@ -158,20 +166,20 @@ loopCapped maxFPS step wnd = do | |||
158 | closeReq = closeRequest wnd | 166 | closeReq = closeRequest wnd |
159 | frameTimer <- gameIO $ start newTimer | 167 | frameTimer <- gameIO $ start newTimer |
160 | controlTimer <- gameIO $ start newTimer | 168 | controlTimer <- gameIO $ start newTimer |
161 | runCapped closeReq ddt frameTimer controlTimer step | 169 | loopCapped' closeReq ddt frameTimer controlTimer step |
162 | return () | 170 | return () |
163 | 171 | ||
164 | runCapped :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s () | 172 | loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s () |
165 | runCapped closeRequest ddt frameTimer controlTimer step = do | 173 | loopCapped' closeRequest ddt frameTimer controlTimer step = do |
166 | controlTimer' <- gameIO $ tick controlTimer | 174 | controlTimer' <- gameIO $ tick controlTimer |
167 | frameTimer' <- gameIO $ tick frameTimer | 175 | frameTimer' <- gameIO $ tick frameTimer |
168 | continue <- step $ getDelta frameTimer' | 176 | continue <- step $ getDelta frameTimer' |
169 | close <- gameIO $ getRequest closeRequest | 177 | close <- gameIO $ getRequest closeRequest |
170 | controlTimer'' <- gameIO $ tick controlTimer' | 178 | controlTimer'' <- gameIO $ tick controlTimer' |
171 | let dt = getDelta controlTimer'' | 179 | let dt = getDelta controlTimer'' |
172 | when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) | 180 | when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt) |
173 | when (continue && (not close)) $ | 181 | when (continue && (not close)) $ |
174 | runCapped closeRequest ddt frameTimer' controlTimer'' step | 182 | loopCapped' closeRequest ddt frameTimer' controlTimer'' step |
175 | 183 | ||
176 | getRequest :: MVar Bool -> IO Bool | 184 | getRequest :: MVar Bool -> IO Bool |
177 | getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of | 185 | getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of |
diff --git a/demos/pong/Main.hs b/demos/pong/Main.hs index 8c379ec..e9a6dc1 100644 --- a/demos/pong/Main.hs +++ b/demos/pong/Main.hs | |||
@@ -18,14 +18,9 @@ data GameState = GameState | |||
18 | , world :: [GameObject] | 18 | , world :: [GameObject] |
19 | } | 19 | } |
20 | 20 | ||
21 | main = do | 21 | main = run |
22 | result <- run | 22 | $ withWindow (640,480) [] Window (2,0) (Just "Pong") initGame |
23 | case result of | 23 | $ loop (Just 30) step |
24 | Left err -> putStrLn err | ||
25 | Right _ -> return () | ||
26 | |||
27 | run = withWindow (640,480) [] Window (2,0) (Just "Pong") initGame | ||
28 | $ loop (Just 30) step | ||
29 | 24 | ||
30 | initGame wnd = do | 25 | initGame wnd = do |
31 | gameIO $ do | 26 | gameIO $ do |