aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-17 18:59:29 +0200
committerJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-17 18:59:29 +0200
commit12b9253d857be440b0fc72a3344de20e4c60732a (patch)
tree100c05f427a65b1949dbbcc4db3d5dbd8f86e281
parent59d2edd9877a2aa1e243597052a3af6bbeefa3cf (diff)
Added run function
-rw-r--r--Spear/Window.hs46
-rw-r--r--demos/pong/Main.hs11
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.
72type Init s = Window -> Game () s 73type Init s = Window -> Game () s
73 74
75run :: MonadIO m => m (Either String a) -> m ()
76run r = do
77 result <- r
78 case result of
79 Left err -> liftIO $ putStrLn err
80 Right _ -> return ()
81
74withWindow :: MonadIO m 82withWindow :: 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 ()
142loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd 150loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd
143loop Nothing step wnd = do 151loop 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
148run :: CloseRequest -> Timer -> Step s -> Game s () 156loop' :: CloseRequest -> Timer -> Step s -> Game s ()
149run closeRequest timer step = do 157loop' 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
155loopCapped :: Int -> Step s -> Window -> Game s () 163loopCapped :: Int -> Step s -> Window -> Game s ()
156loopCapped maxFPS step wnd = do 164loopCapped 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
164runCapped :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s () 172loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s ()
165runCapped closeRequest ddt frameTimer controlTimer step = do 173loopCapped' 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
176getRequest :: MVar Bool -> IO Bool 184getRequest :: MVar Bool -> IO Bool
177getRequest mvar = tryTakeMVar mvar >>= \x -> return $ case x of 185getRequest 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
21main = do 21main = 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
27run = withWindow (640,480) [] Window (2,0) (Just "Pong") initGame
28 $ loop (Just 30) step
29 24
30initGame wnd = do 25initGame wnd = do
31 gameIO $ do 26 gameIO $ do