aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/App/Application.hs26
-rw-r--r--Spear/Game.hs5
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
24 24
25import Control.Concurrent.MVar 25import Control.Concurrent.MVar
26import Control.Monad (when) 26import Control.Monad (when)
27import Control.Monad.IO.Class
27import Graphics.UI.GLFW as GLFW 28import Graphics.UI.GLFW as GLFW
28import Graphics.Rendering.OpenGL as GL 29import Graphics.Rendering.OpenGL as GL
29 30
@@ -43,17 +44,20 @@ data SpearWindow = SpearWindow
43 { closeRequest :: CloseRequested 44 { closeRequest :: CloseRequested
44 } 45 }
45 46
46withWindow :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle 47withWindow :: MonadIO m
47 -> WindowSizeCallback -> (SpearWindow -> Game s a) -> Game s a 48 => Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle
48withWindow dim displayBits windowMode glVersion windowTitle onResize run = do 49 -> WindowSizeCallback -> (SpearWindow -> Game () a) -> m (Either String a)
49 glfwInit 50withWindow dim displayBits windowMode glVersion windowTitle onResize game = do
50 window <- setup dim displayBits windowMode glVersion windowTitle onResize 51 result <- liftIO . flip runGame () $ do
51 gs <- getGameState 52 glfwInit
52 (a,s) <- runSubGame (run window) gs 53 window <- setup dim displayBits windowMode glVersion windowTitle onResize
53 gameIO GLFW.closeWindow 54 result <- evalSubGame (game window) ()
54 gameIO GLFW.terminate 55 gameIO GLFW.closeWindow
55 saveGameState s 56 gameIO GLFW.terminate
56 return a 57 return result
58 case result of
59 Left err -> return $ Left err
60 Right (a,_) -> return $ Right a
57 61
58-- Set up an application 'SpearWindow'. 62-- Set up an application 'SpearWindow'.
59setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle 63setup :: 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
18 -- * Running and IO 18 -- * Running and IO
19, runGame 19, runGame
20, runSubGame 20, runSubGame
21, runSubGame'
21, evalSubGame 22, evalSubGame
22, execSubGame 23, execSubGame
23, gameIO 24, gameIO
@@ -88,6 +89,10 @@ runSubGame game state = gameIO (runGame game state) >>= \result -> case result o
88 Left err -> gameError err 89 Left err -> gameError err
89 Right x -> return x 90 Right x -> return x
90 91
92-- | Like 'runSubGame', but discarding the result.
93runSubGame' :: Game s a -> s -> Game t ()
94runSubGame' game state = runSubGame game state >> return ()
95
91-- | Run the given game and return its result. 96-- | Run the given game and return its result.
92evalSubGame :: Game s a -> s -> Game t a 97evalSubGame :: Game s a -> s -> Game t a
93evalSubGame g s = runSubGame g s >>= \(a,_) -> return a 98evalSubGame g s = runSubGame g s >>= \(a,_) -> return a