1 files changed, 47 insertions, 37 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index d51a324..22b1021 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
 module Main where
 
 import           Pong
@@ -5,52 +7,62 @@ 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
+import           Spear.Physics.Collision
 import           Spear.Render.Core.Pipeline
 import           Spear.Render.Core.State
 import           Spear.Render.Immediate
+import           Spear.Sound.Sound
+import           Spear.Sound.State
 import           Spear.Window
 
 import           Control.Monad              (when)
-import           Data.Maybe                 (mapMaybe)
 
 
-data GameState = GameState
-  { window          :: Window
-  , renderCoreState :: RenderCoreState
-  , immRenderState  :: ImmRenderState
-  , viewProjection  :: Matrix4
+data Pong = Pong
+  { viewProjection  :: Matrix4
+  , backgroundMusic :: SoundSource
   , world           :: [GameObject]
   }
 
-app = App defaultAppOptions step render resize
+type GameState = AppState Pong
+
+
+options = defaultAppOptions { title = "Pong" }
+
+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
-  (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState
-  return $ GameState window renderCoreState immRenderState Matrix4.id newWorld
+initGame :: Game AppContext Pong
+initGame = do
+  music <- siblingGame $ do
+    musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav"
+    music <- makeSoundSource
+    setSoundSourceBuffer music musicBuffer
+    setSoundLoopMode music Loop
+    playSounds [music]
+    return music
+  return $ Pong Matrix4.id music newWorld
 
 endGame :: Game GameState ()
-endGame = do
-  game <- getGameState
-  runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game)
+endGame = return ()
+
 
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
-  gs <- getGameState
-  events <- processInput (window gs)
-  --when (events /= []) $ gameIO . putStrLn $ show events
-  modifyGameState $ \gs ->
-    gs
-      { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
-      }
+  appState  <- get
+  gameState <- getGameState
+  events    <- processInput (appWindow appState)
+  --when (events /= []) $ liftIO . putStrLn $ show events
+  modifyGameState $ \pong -> pong
+    { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gameState)
+    }
   return (not $ exitRequested inputEvents)
 
 processInput :: Window -> Game GameState [GameEvent]
@@ -61,20 +73,19 @@ processInput window = processKeys window
 
 exitRequested = elem (KeyDown KEY_ESC)
 
+
 render :: Game GameState ()
 render = do
   gameState <- getGameState
-  immRenderState' <- flip execSubGame (immRenderState gameState) $ do
+  siblingGame $ do
     immStart
     immSetViewProjectionMatrix (viewProjection gameState)
     -- Clear the background to a different colour than the playable area to make
     -- the latter distinguishable.
-    gameIO $ do
-      setClearColour (0.2, 0.2, 0.2, 0.0)
-      clearBuffers [ColourBuffer]
+    setClearColour (0.2, 0.2, 0.2, 0.0)
+    clearBuffers [ColourBuffer]
     render' $ world gameState
     immEnd
-  saveGameState $ gameState { immRenderState = immRenderState' }
 
 render' :: [GameObject] -> Game ImmRenderState ()
 render' world = do
@@ -97,17 +108,16 @@ renderBackground =
       ,vec2 pmin pmax)]
 
 renderGO :: GameObject -> Game ImmRenderState ()
-renderGO go = do
-  let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go
-      (Vector2 xcenter ycenter) = position go
-  immPreservingMatrix $ do
-    immTranslate (vec3 xcenter ycenter 0)
+renderGO go =
+  let (AABB2Volume (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax))) = boundingVolume go
+  in
     immDrawQuads2d [
       (vec2 xmin ymin
       ,vec2 xmax ymin
       ,vec2 xmax ymax
       ,vec2 xmin ymax)]
 
+
 resize :: WindowEvent -> Game GameState ()
 resize (ResizeEvent w h) =
   let r = fromIntegral w / fromIntegral h
@@ -117,7 +127,7 @@ resize (ResizeEvent w h) =
       bottom = if r > 1 then 0 else -pad
       top    = if r > 1 then 1 else 1 + pad
   in do
-    gameIO $ setViewport 0 0 w h
-    modifyGameState $ \state -> state {
+    setViewport 0 0 w h
+    modifyGameState $ \pong -> pong {
       viewProjection = Matrix4.ortho left right bottom top (-1) 1
     }