Move window setup to App.

3 files changed, 65 insertions, 58 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index 66fa223..de8e6f2 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -26,14 +26,13 @@ data GameState = GameState
   , world           :: [GameObject]
   }
 
+options = defaultAppOptions { title = "Pong" }
 
-app = App defaultAppOptions step render resize
+app = App options initGame endGame step render resize
 
 
-main =
-  withWindow (1920, 1200) (Just "Pong") initGame endGame $
-    loop app
-
+main :: IO ()
+main = runApp app
 
 initGame :: Window -> Game () GameState
 initGame window = do
diff --git a/Spear/App.hs b/Spear/App.hs
index 7f23359..61ea3b1 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -1,11 +1,13 @@
 module Spear.App
-  ( App(..),
-    Elapsed,
-    Dt,
-    Step,
-    defaultAppOptions,
-    loop,
-  )
+( App(..)
+, AppOptions(..)
+, Elapsed
+, Dt
+, Step
+, defaultAppOptions
+, runApp
+, loop
+)
 where
 
 import           Control.Monad
@@ -26,26 +28,45 @@ type Step s = Elapsed -> Dt -> [InputEvent] -> Game s Bool
 
 -- | Application options.
 data AppOptions = AppOptions
-  { maxFPS          :: Int
+  { title           :: String
+  , windowWidth     :: Int
+  , windowHeight    :: Int
+  , maxFPS          :: Int
   , animationFPS    :: Int
   , enableProfiling :: Bool
   }
 
 defaultAppOptions = AppOptions
-  { maxFPS          = 0  -- If non-zero, cap frame rate to this value.
+  { title           = "Spear Application"
+  , windowWidth     = 1920
+  , windowHeight    = 1080
+  , maxFPS          = 0  -- If non-zero, cap frame rate to this value.
   , animationFPS    = 60 -- If non-zero, use fixed time step animation.
   , enableProfiling = False
   }
 
 -- | Application state.
 data App s = App
-  { options   :: AppOptions
-  , stepApp   :: Step s
-  , renderApp :: Game s ()
-  , resizeApp :: WindowEvent -> Game s ()
+  { appOptions :: AppOptions
+  , initApp    :: Window -> Game () s
+  , endApp     :: Game s ()
+  , stepApp    :: Step s
+  , renderApp  :: Game s ()
+  , resizeApp  :: WindowEvent -> Game s ()
   }
 
 
+-- | Run the application.
+runApp :: App s -> IO ()
+runApp app =
+  let ops = appOptions app
+      w = windowWidth  ops
+      h = windowHeight ops
+  in withWindow (w, h) (title ops) $ \window -> flip evalGame () $ do
+      gameState <- initApp app window
+      (result, endGameState) <- runSubGame (loop app window) gameState
+      runSubGame' (endApp app) endGameState
+
 -- | Convert FPS to desired delta time.
 fpsToDdt :: Int -> TimeDelta
 fpsToDdt fps = if fps > 0 then secToTimeDelta (1.0 / fromIntegral fps) else 0
@@ -59,8 +80,8 @@ loop app window = do
   resizeApp app (ResizeEvent width height)
   renderApp app
 
-  let ddt          = fpsToDdt .       maxFPS . options $ app -- Desired render time step.
-  let animationDdt = fpsToDdt . animationFPS . options $ app -- Desired animation time step.
+  let ddt          = fpsToDdt .       maxFPS . appOptions $ app -- Desired render time step.
+  let animationDdt = fpsToDdt . animationFPS . appOptions $ app -- Desired animation time step.
 
   timer <- gameIO newTimer
   gameIO $ Timer.start timer
@@ -121,7 +142,7 @@ loop' window renderDdt animationDdt lastAnimationTime inputTimer app = do
 
   -- Limit frame rate if so requested by the application.
   -- This currently makes the rendering stutter and is not very desirable.
-  when ((maxFPS . options $ app) > 0) $ do
+  when ((maxFPS . appOptions $ app) > 0) $ do
     frameEnd <- gameIO now
     let ddt = renderDdt
     let frameTime = timeDiff (lastTick timer) frameEnd
diff --git a/Spear/Window.hs b/Spear/Window.hs
index 65ca243..2dcd1fa 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -7,7 +7,6 @@ module Spear.Window
     Window,
     Width,
     Height,
-    Init,
     WindowEvent(..),
     withWindow,
     pollWindowEvents,
@@ -21,10 +20,10 @@ module Spear.Window
     whenKeyUp,
     processKeys,
     processButtons,
-    InputEvent (..),
-    Key (..),
-    MouseButton (..),
-    MouseProp (..),
+    InputEvent(..),
+    Key(..),
+    MouseButton(..),
+    MouseProp(..),
     MousePos,
     MouseDelta,
   )
@@ -52,12 +51,6 @@ type Dimensions = (Width, Height)
 
 type WindowTitle = String
 
--- | Game initialiser.
-type Init s = Window -> Game () s
-
--- | Game finalizer.
-type End s = Game s ()
-
 -- | Window exception.
 newtype WindowException = WindowException String deriving (Show)
 
@@ -85,28 +78,22 @@ data Window = Window
 
 withWindow ::
   Dimensions ->
-  Maybe WindowTitle ->
-  Init s ->
-  End s ->
-  (Window -> Game s a) ->
+  WindowTitle ->
+  (Window -> IO a) ->
   IO a
-withWindow dim@(w, h) windowTitle init end run = do
-  flip evalGame () $ do
-    window <- gameIO $ do
-      success <- GLFW.init
-      unless success $ throw (WindowException "GLFW.initialize failed")
-      setup dim windowTitle
-    gameState <- init window
-    (result, endGameState) <- runSubGame (run window) gameState
-    runSubGame' end endGameState
-    gameIO $ do
-      GLFW.destroyWindow $ glfwWindow window
-      GLFW.terminate
-    return result
+withWindow dim@(w, h) windowTitle run = do
+  window <- do
+    success <- GLFW.init
+    unless success $ throw (WindowException "GLFW.initialize failed")
+    setup dim windowTitle
+  result <- run window
+  GLFW.destroyWindow $ glfwWindow window
+  GLFW.terminate
+  return result
 
 setup ::
   Dimensions ->
-  Maybe WindowTitle ->
+  WindowTitle ->
   IO Window
 setup (w, h) windowTitle = do
   closeRequest <- newEmptyMVar
@@ -118,7 +105,7 @@ setup (w, h) windowTitle = do
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor major
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor minor
     when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
-    GLFW.createWindow w h (fromMaybe "Spear" windowTitle) Nothing Nothing
+    GLFW.createWindow w h windowTitle Nothing Nothing
 
   unless (isJust maybeWindow)
     $ throwIO (WindowException "GLFW.openWindow failed")
@@ -141,7 +128,7 @@ setup (w, h) windowTitle = do
 pollInputEvents :: Window -> IO [InputEvent]
 pollInputEvents window = do
   GLFW.pollEvents
-  getEvents (inputEventsMVar  window)
+  getEvents (inputEventsMVar window)
 
 -- | Poll for window events.
 pollWindowEvents :: Window -> IO [WindowEvent]
@@ -206,23 +193,23 @@ replaceMVar mvar val = tryTakeMVar mvar >> putMVar mvar val
 addEvent :: MVar [a] -> a -> IO ()
 addEvent mvar val =
   tryTakeMVar mvar >>= \xs -> case xs of
-    Nothing     -> putMVar mvar [val] -- >> (putStrLn $ show val)
-    Just events -> putMVar mvar (val : events) -- >> (putStrLn $ show (val:events))
+    Nothing     -> putMVar mvar [val]
+    Just events -> putMVar mvar (val : events)
 
 -- Input
 
 -- | Run the game action when the key is down.
-whenKeyDown :: GLFW.Window -> Key -> Game s a -> Game s ()
+whenKeyDown :: GLFW.Window -> Key -> Game s () -> Game s ()
 whenKeyDown = whenKeyInState GLFW.KeyState'Pressed
 
 -- | Run the game action when the key is up.
-whenKeyUp :: GLFW.Window -> Key -> Game s a -> Game s ()
+whenKeyUp :: GLFW.Window -> Key -> Game s () -> Game s ()
 whenKeyUp = whenKeyInState GLFW.KeyState'Released
 
-whenKeyInState :: GLFW.KeyState -> GLFW.Window -> Key -> Game s a -> Game s ()
+whenKeyInState :: GLFW.KeyState -> GLFW.Window -> Key -> Game s () -> Game s ()
 whenKeyInState state window key game = do
   isDown <- fmap (==state) $ gameIO . GLFW.getKey window . toGLFWkey $ key
-  when isDown $ void game
+  when isDown game
 
 -- | Check whether the given keys are pressed and return the value associated
 -- with each of the pressed keys.