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