From 0674a9efc4e753d243ceb933e59db2ab3238a7bb Mon Sep 17 00:00:00 2001
From: Jeanne-Kamikaze <jeannekamikaze@gmail.com>
Date: Fri, 10 May 2013 17:56:09 +0200
Subject: withWindow tweaks; added runSubGame'

---
 Spear/App/Application.hs | 26 +++++++++++++++-----------
 Spear/Game.hs            |  5 +++++
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/Spear/App/Application.hs b/Spear/App/Application.hs
index 8f1e726..ce1d5cb 100644
--- a/Spear/App/Application.hs
+++ b/Spear/App/Application.hs
@@ -24,6 +24,7 @@ import Spear.Sys.Timer as Timer
 
 import Control.Concurrent.MVar
 import Control.Monad (when)
+import Control.Monad.IO.Class
 import Graphics.UI.GLFW as GLFW
 import Graphics.Rendering.OpenGL as GL
 
@@ -43,17 +44,20 @@ data SpearWindow = SpearWindow
      { closeRequest :: CloseRequested
      }
 
-withWindow :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle
-           -> WindowSizeCallback -> (SpearWindow -> Game s a) -> Game s a
-withWindow dim displayBits windowMode glVersion windowTitle onResize run = do
-           glfwInit
-           window <- setup dim displayBits windowMode glVersion windowTitle onResize
-           gs <- getGameState
-           (a,s) <- runSubGame (run window) gs
-           gameIO GLFW.closeWindow
-           gameIO GLFW.terminate
-           saveGameState s
-           return a
+withWindow :: MonadIO m
+           => Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle
+           -> WindowSizeCallback -> (SpearWindow -> Game () a) -> m (Either String a)
+withWindow dim displayBits windowMode glVersion windowTitle onResize game = do
+           result <- liftIO . flip runGame () $ do
+                glfwInit
+                window <- setup dim displayBits windowMode glVersion windowTitle onResize
+                result <- evalSubGame (game window) ()
+                gameIO GLFW.closeWindow
+                gameIO GLFW.terminate
+                return result
+           case result of
+                Left err    -> return $ Left err
+                Right (a,_) -> return $ Right a
 
 -- Set up an application 'SpearWindow'.
 setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle
diff --git a/Spear/Game.hs b/Spear/Game.hs
index bf58c82..8d4d8bb 100644
--- a/Spear/Game.hs
+++ b/Spear/Game.hs
@@ -18,6 +18,7 @@ module Spear.Game
     -- * Running and IO
 ,   runGame
 ,   runSubGame
+,   runSubGame'
 ,   evalSubGame
 ,   execSubGame
 ,   gameIO
@@ -88,6 +89,10 @@ runSubGame game state = gameIO (runGame game state) >>= \result -> case result o
            Left err -> gameError err
            Right x  -> return x
 
+-- | Like 'runSubGame', but discarding the result.
+runSubGame' :: Game s a -> s -> Game t ()
+runSubGame' game state = runSubGame game state >> return ()
+
 -- | Run the given game and return its result.
 evalSubGame :: Game s a -> s -> Game t a
 evalSubGame g s = runSubGame g s >>= \(a,_) -> return a
-- 
cgit v1.2.3