From 12b9253d857be440b0fc72a3344de20e4c60732a Mon Sep 17 00:00:00 2001
From: Jeanne-Kamikaze <jeannekamikaze@gmail.com>
Date: Sat, 17 Aug 2013 18:59:29 +0200
Subject: Added run function
---
Spear/Window.hs | 46 +++++++++++++++++++++++++++-------------------
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
, Width
, Height
, Init
+, run
, withWindow
, events
-- * Animation
@@ -71,6 +72,13 @@ events wnd = liftIO $ do
-- | Game initialiser.
type Init s = Window -> Game () s
+run :: MonadIO m => m (Either String a) -> m ()
+run r = do
+ result <- r
+ case result of
+ Left err -> liftIO $ putStrLn err
+ Right _ -> return ()
+
withWindow :: MonadIO m
=> Dimensions -> [DisplayBits] -> WindowMode -> Context
-> Maybe WindowTitle
@@ -142,15 +150,15 @@ loop :: Maybe FrameCap -> Step s -> Window -> Game s ()
loop (Just maxFPS) step wnd = loopCapped maxFPS step wnd
loop Nothing step wnd = do
timer <- gameIO $ start newTimer
- run (closeRequest wnd) timer step
+ loop' (closeRequest wnd) timer step
return ()
-run :: CloseRequest -> Timer -> Step s -> Game s ()
-run closeRequest timer step = do
- timer' <- gameIO $ tick timer
- continue <- step $ getDelta timer'
- close <- gameIO $ getRequest closeRequest
- when (continue && (not close)) $ run closeRequest timer' step
+loop' :: CloseRequest -> Timer -> Step s -> Game s ()
+loop' closeRequest timer step = do
+ timer' <- gameIO $ tick timer
+ continue <- step $ getDelta timer'
+ close <- gameIO $ getRequest closeRequest
+ when (continue && (not close)) $ loop' closeRequest timer' step
loopCapped :: Int -> Step s -> Window -> Game s ()
loopCapped maxFPS step wnd = do
@@ -158,20 +166,20 @@ loopCapped maxFPS step wnd = do
closeReq = closeRequest wnd
frameTimer <- gameIO $ start newTimer
controlTimer <- gameIO $ start newTimer
- runCapped closeReq ddt frameTimer controlTimer step
+ loopCapped' closeReq ddt frameTimer controlTimer step
return ()
-runCapped :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s ()
-runCapped closeRequest ddt frameTimer controlTimer step = do
- controlTimer' <- gameIO $ tick controlTimer
- frameTimer' <- gameIO $ tick frameTimer
- continue <- step $ getDelta frameTimer'
- close <- gameIO $ getRequest closeRequest
- controlTimer'' <- gameIO $ tick controlTimer'
- let dt = getDelta controlTimer''
- when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt)
- when (continue && (not close)) $
- runCapped closeRequest ddt frameTimer' controlTimer'' step
+loopCapped' :: CloseRequest -> Float -> Timer -> Timer -> Step s -> Game s ()
+loopCapped' closeRequest ddt frameTimer controlTimer step = do
+ controlTimer' <- gameIO $ tick controlTimer
+ frameTimer' <- gameIO $ tick frameTimer
+ continue <- step $ getDelta frameTimer'
+ close <- gameIO $ getRequest closeRequest
+ controlTimer'' <- gameIO $ tick controlTimer'
+ let dt = getDelta controlTimer''
+ when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt)
+ when (continue && (not close)) $
+ loopCapped' closeRequest ddt frameTimer' controlTimer'' step
getRequest :: MVar Bool -> IO Bool
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
, world :: [GameObject]
}
-main = do
- result <- run
- case result of
- Left err -> putStrLn err
- Right _ -> return ()
-
-run = withWindow (640,480) [] Window (2,0) (Just "Pong") initGame
- $ loop (Just 30) step
+main = run
+ $ withWindow (640,480) [] Window (2,0) (Just "Pong") initGame
+ $ loop (Just 30) step
initGame wnd = do
gameIO $ do
--
cgit v1.2.3