withWindow tweaks; added runSubGame'

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