4 files changed, 55 insertions, 32 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index 993c0ff..22b1021 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -7,7 +7,7 @@ import           Pong
 import           Spear.App
 import           Spear.Game
 import           Spear.Math.AABB
-import           Spear.Math.Matrix4         as Matrix4 hiding (position)
+import           Spear.Math.Matrix4         as Matrix4
 import           Spear.Math.Spatial
 import           Spear.Math.Spatial2
 import           Spear.Math.Vector
@@ -20,12 +20,10 @@ import           Spear.Sound.State
 import           Spear.Window
 
 import           Control.Monad              (when)
-import           Data.Maybe                 (mapMaybe)
 
 
 data Pong = Pong
-  { immRenderState  :: ImmRenderState
-  , viewProjection  :: Matrix4
+  { viewProjection  :: Matrix4
   , backgroundMusic :: SoundSource
   , world           :: [GameObject]
   }
@@ -43,10 +41,6 @@ main = runApp app
 
 initGame :: Game AppContext Pong
 initGame = do
-  renderCoreState <- contextRenderCoreState <$> get
-  (immRenderState, renderCoreState') <- runSiblingGame renderCoreState newImmRenderer
-  -- TODO: This can work if we use FlexibleContexts and change the function signatures.
-  --immRenderState <- newImmRenderer
   music <- siblingGame $ do
     musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav"
     music <- makeSoundSource
@@ -54,13 +48,10 @@ initGame = do
     setSoundLoopMode music Loop
     playSounds [music]
     return music
-  return $ Pong immRenderState Matrix4.id music newWorld
+  return $ Pong Matrix4.id music newWorld
 
 endGame :: Game GameState ()
-endGame = do
-  renderCoreState <- appRenderCoreState <$> get
-  game <- getGameState
-  exec' runSiblingGame renderCoreState (deleteImmRenderer $ immRenderState game)
+endGame = return ()
 
 
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
@@ -86,7 +77,7 @@ exitRequested = elem (KeyDown KEY_ESC)
 render :: Game GameState ()
 render = do
   gameState <- getGameState
-  immRenderState' <- exec runSiblingGame (immRenderState gameState) $ do
+  siblingGame $ do
     immStart
     immSetViewProjectionMatrix (viewProjection gameState)
     -- Clear the background to a different colour than the playable area to make
@@ -95,7 +86,6 @@ render = do
     clearBuffers [ColourBuffer]
     render' $ world gameState
     immEnd
-  putGameState $ gameState { immRenderState = immRenderState' }
 
 render' :: [GameObject] -> Game ImmRenderState ()
 render' world = do
diff --git a/Spear/App.hs b/Spear/App.hs
index 75bf6fa..6e8f5f2 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 module Spear.App
@@ -19,6 +20,7 @@ where
 
 import           Spear.Game
 import           Spear.Render.Core.State
+import           Spear.Render.Immediate
 import           Spear.Sound.Sound
 import           Spear.Sound.State
 import           Spear.Sys.Timer         as Timer
@@ -78,46 +80,61 @@ data AppContext = AppContext
   { contextWindow          :: Window
   , contextRenderCoreState :: RenderCoreState
   , contextSoundState      :: SoundState
+  , contextImmRenderState  :: ImmRenderState
   }
 
 instance HasState AppContext RenderCoreState where
   getInnerState = contextRenderCoreState
-  setInnerState context renderCoreState = context { contextRenderCoreState = renderCoreState }
+  setInnerState context state = context { contextRenderCoreState = state }
 
 instance HasState AppContext SoundState where
   getInnerState = contextSoundState
-  setInnerState context soundState = context { contextSoundState = soundState }
+  setInnerState context state = context { contextSoundState = state }
+
+instance HasState AppContext ImmRenderState where
+  getInnerState = contextImmRenderState
+  setInnerState context state = context { contextImmRenderState = state }
 
 -- | Application state.
 data AppState s = AppState
   { appWindow          :: Window
   , appRenderCoreState :: RenderCoreState
   , appSoundState      :: SoundState
-  , customState        :: s
+  , appImmRenderState  :: ImmRenderState
+  , appCustomState     :: s
   }
 
+-- Requires FlexibleInstances.
+instance HasState (AppState s) s where
+  getInnerState = appCustomState
+  setInnerState appState state = appState { appCustomState = state }
+
 instance HasState (AppState s) RenderCoreState where
   getInnerState = appRenderCoreState
-  setInnerState appState renderCoreState = appState { appRenderCoreState = renderCoreState }
+  setInnerState appState state = appState { appRenderCoreState = state }
 
 instance HasState (AppState s) SoundState where
   getInnerState = appSoundState
-  setInnerState appState soundState = appState { appSoundState = soundState }
+  setInnerState appState state = appState { appSoundState = state }
+
+instance HasState (AppState s) ImmRenderState where
+  getInnerState = appImmRenderState
+  setInnerState appState state = appState { appImmRenderState = state }
 
 
 -- | Get the custom state in the app state.
 getGameState :: Game (AppState s) s
-getGameState = customState <$> get
+getGameState = appCustomState <$> get
 
 -- | Put the custom state in the app state.
 putGameState :: s -> Game (AppState s) ()
 putGameState custom = do
   appState <- get
-  put $ appState { customState = custom }
+  put $ appState { appCustomState = custom }
 
 -- | Modify the custom state in the app state.
 modifyGameState :: (s -> s) -> Game (AppState s) ()
-modifyGameState f = modify $ \appState -> appState { customState = f (customState appState )}
+modifyGameState f = modify $ \appState -> appState { appCustomState = f (appCustomState appState )}
 
 -- | Run the application.
 runApp :: App s -> IO ()
@@ -129,21 +146,29 @@ runApp app =
     withWindow (w, h) (title ops) $ \window ->
       withSoundContext $ eval runGame () $ do
         -- Create initial context.
+        -- We could modify function signatures such as:
+        --   newImmRenderer :: HasState s RenderCoreState => Game s ImmRenderState
+        -- to simplify things a bit. But I'm not sure I want HasState to
+        -- proliferate like that right now.
         initialSoundState <- eval runSiblingGame () initSoundSystem
-        let context = AppContext window newRenderCoreState initialSoundState
+        (immRenderState, renderCoreState) <- runSiblingGame newRenderCoreState newImmRenderer
+        let context = AppContext window renderCoreState initialSoundState immRenderState
         -- Create initial app state.
         (gameState, context') <- runSiblingGame context (initApp app)
         let appState = AppState {
           appWindow          = contextWindow context'
         , appRenderCoreState = contextRenderCoreState context'
         , appSoundState      = contextSoundState context'
-        , customState        = gameState
+        , appImmRenderState  = contextImmRenderState context'
+        , appCustomState     = gameState
         }
         -- Run app.
-        (result, endGameState) <- runSiblingGame appState (loop app window)
+        (result, endAppState) <- runSubGame appState $ do
+          loop app window
+          endApp app
         -- Shut down.
-        exec' runSiblingGame endGameState (endApp app)
-        exec' runSiblingGame (appSoundState appState) destroySoundSystem
+        exec' runSiblingGame (appRenderCoreState endAppState) $ deleteImmRenderer (appImmRenderState endAppState)
+        exec' runSiblingGame (appSoundState endAppState) destroySoundSystem
 
 -- | Enter the main application loop.
 loop :: App s -> Window -> Game (AppState s) ()
diff --git a/Spear/Game.hs b/Spear/Game.hs
index 1af8e9b..0c8b963 100644
--- a/Spear/Game.hs
+++ b/Spear/Game.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances          #-}

 {-# LANGUAGE GeneralizedNewtypeDeriving #-}

 {-# LANGUAGE MultiParamTypeClasses      #-}

 

@@ -79,6 +80,11 @@ class HasState s t where
   getInnerState :: s -> t

   setInnerState :: s -> t -> s

 

+-- Identity instance.

+instance HasState s s where

+  getInnerState = id

+  setInnerState s s' = s'

+

 

 -- | Release the given 'Resource'.

 release' :: ResourceClass a => a -> Game s ()

@@ -129,7 +135,7 @@ exec' runner game state = void $  runner game state
 -- | Run a sibling game on nested state.

 siblingGame :: HasState s t => Game t a -> Game s a

 siblingGame tAction = do

-  tState <- getInnerState <$> get

-  (result, tState') <- runSiblingGame tState tAction

-  modify $ \outerState -> setInnerState outerState tState'

+  outerState <- getInnerState <$> get

+  (result, outerState') <- runSiblingGame outerState tAction

+  modify $ \outerState -> setInnerState outerState outerState'

   return result

diff --git a/Spear/Render/Immediate.hs b/Spear/Render/Immediate.hs
index b3a8998..786e844 100644
--- a/Spear/Render/Immediate.hs
+++ b/Spear/Render/Immediate.hs
@@ -74,7 +74,9 @@ deleteImmRenderer immState = do
   deleteGeometry (triangles immState)
 
 -- The functions below are all defined inside the Game ImmRenderState monad so
--- that all of the drawing can conveniently happen inside the monad.
+-- that all of the drawing can conveniently happen inside the monad. They could
+-- technically be defined inside MonadIO, but then we would have to explicitly
+-- pass in the ImmRenderState.
 
 immStart :: Game ImmRenderState ()
 immStart = do