diff options
-rw-r--r-- | Spear/App/Application.hs | 26 | ||||
-rw-r--r-- | 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 | |||
24 | 24 | ||
25 | import Control.Concurrent.MVar | 25 | import Control.Concurrent.MVar |
26 | import Control.Monad (when) | 26 | import Control.Monad (when) |
27 | import Control.Monad.IO.Class | ||
27 | import Graphics.UI.GLFW as GLFW | 28 | import Graphics.UI.GLFW as GLFW |
28 | import Graphics.Rendering.OpenGL as GL | 29 | import Graphics.Rendering.OpenGL as GL |
29 | 30 | ||
@@ -43,17 +44,20 @@ data SpearWindow = SpearWindow | |||
43 | { closeRequest :: CloseRequested | 44 | { closeRequest :: CloseRequested |
44 | } | 45 | } |
45 | 46 | ||
46 | withWindow :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle | 47 | withWindow :: MonadIO m |
47 | -> WindowSizeCallback -> (SpearWindow -> Game s a) -> Game s a | 48 | => Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle |
48 | withWindow dim displayBits windowMode glVersion windowTitle onResize run = do | 49 | -> WindowSizeCallback -> (SpearWindow -> Game () a) -> m (Either String a) |
49 | glfwInit | 50 | withWindow 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'. |
59 | setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Maybe WindowTitle | 63 | 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 | |||
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. | ||
93 | runSubGame' :: Game s a -> s -> Game t () | ||
94 | runSubGame' 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. |
92 | evalSubGame :: Game s a -> s -> Game t a | 97 | evalSubGame :: Game s a -> s -> Game t a |
93 | evalSubGame g s = runSubGame g s >>= \(a,_) -> return a | 98 | evalSubGame g s = runSubGame g s >>= \(a,_) -> return a |