Add enough audio for background music.

6 files changed, 203 insertions, 22 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index b93325d..f77136f 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -13,6 +13,8 @@ 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)
@@ -20,10 +22,11 @@ import           Data.Maybe                 (mapMaybe)
 
 
 data GameState = GameState
-  { window          :: Window
+  { context         :: AppContext
   , renderCoreState :: RenderCoreState
   , immRenderState  :: ImmRenderState
   , viewProjection  :: Matrix4
+  , backgroundMusic :: SoundSource
   , world           :: [GameObject]
   }
 
@@ -35,10 +38,19 @@ app = App options initGame endGame step render resize
 main :: IO ()
 main = runApp app
 
-initGame :: Window -> Game () GameState
-initGame window = do
+initGame :: AppContext -> Game () GameState
+initGame context = do
   (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState
-  return $ GameState window renderCoreState immRenderState Matrix4.id newWorld
+  (music, soundState') <- flip runSiblingGame (appSoundState context) $ do
+    musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav"
+    music <- makeSoundSource
+    liftIO $ do
+      setSoundSourceBuffer music musicBuffer
+      setSoundLoopMode music Loop
+      playSounds [music]
+    return music
+  let context' = context { appSoundState = soundState' }
+  return $ GameState context' renderCoreState immRenderState Matrix4.id music newWorld
 
 endGame :: Game GameState ()
 endGame = do
@@ -48,13 +60,12 @@ endGame = do
 
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
-  gs <- get
-  events <- processInput (window gs)
+  gameState <- get
+  events <- processInput (appWindow . context $ gameState)
   --when (events /= []) $ liftIO . putStrLn $ show events
-  modify $ \gs ->
-    gs
-      { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs)
-      }
+  modify $ \gameState -> gameState
+    { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gameState)
+    }
   return (not $ exitRequested inputEvents)
 
 processInput :: Window -> Game GameState [GameEvent]
diff --git a/README.md b/README.md
index 386250d..3296c35 100644
--- a/README.md
+++ b/README.md
@@ -12,9 +12,7 @@ Installation (Ubuntu)
 Install dependencies, then build with cabal:

 

 ```

-$ sudo apt install libxxf86vm-dev libglfw3-dev

-$ git clone https://github.com/jeannekamikaze/Spear.git

-$ cd Spear

+$ sudo apt install libxxf86vm-dev libglfw3-dev libopenal-dev libopenalut-dev

 $ cabal build

 ```

 

diff --git a/Spear.cabal b/Spear.cabal
index 306ef6a..ed37d66 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -14,6 +14,8 @@ data-dir: ""
 library

     build-depends:

       GLFW-b -any,

+      OpenAL -any,

+      ALUT -any,

       OpenGL >= 3,

       OpenGLRaw -any,

       StateVar -any,

@@ -81,6 +83,8 @@ library
       Spear.Scene.Graph

       Spear.Scene.Loader

       Spear.Scene.SceneResources

+      Spear.Sound.Sound

+      Spear.Sound.State

       Spear.Step

       Spear.Sys.Store

       Spear.Sys.Store.ID

diff --git a/Spear/App.hs b/Spear/App.hs
index 1520eee..8c0371e 100644
--- a/Spear/App.hs
+++ b/Spear/App.hs
@@ -1,6 +1,7 @@
 module Spear.App
 ( App(..)
 , AppOptions(..)
+, AppContext(..)
 , Elapsed
 , Dt
 , Step
@@ -10,13 +11,16 @@ module Spear.App
 )
 where
 
-import           Control.Monad
-import           Data.Fixed      (mod')
-import           GHC.Float
 import           Spear.Game
-import           Spear.Sys.Timer as Timer
+import           Spear.Sound.Sound
+import           Spear.Sound.State
+import           Spear.Sys.Timer   as Timer
 import           Spear.Window
 
+import           Control.Monad
+import           Data.Fixed        (mod')
+import           GHC.Float
+
 -- | Time elapsed.
 type Elapsed = Double
 
@@ -48,13 +52,18 @@ defaultAppOptions = AppOptions
 -- | Application state.
 data App s = App
   { appOptions :: AppOptions
-  , initApp    :: Window -> Game () s
+  , initApp    :: AppContext -> Game () s
   , endApp     :: Game s ()
   , stepApp    :: Step s
   , renderApp  :: Game s ()
   , resizeApp  :: WindowEvent -> Game s ()
   }
 
+-- | Application context.
+data AppContext = AppContext
+  { appWindow     :: Window
+  , appSoundState :: SoundState
+  }
 
 -- | Run the application.
 runApp :: App s -> IO ()
@@ -62,10 +71,14 @@ 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
+  in withWindow (w, h) (title ops) $ \window ->
+       withSoundContext $ flip evalGame () $ do
+        soundState <- evalSiblingGame initSoundSystem ()
+        let appContext = AppContext window soundState
+        gameState <- initApp app appContext
+        (result, endGameState) <- runSubGame (loop app window) gameState
+        runSubGame' (endApp app) endGameState
+        runSiblingGame' destroySoundSystem soundState
 
 -- | Convert FPS to desired delta time.
 fpsToDdt :: Int -> TimeDelta
diff --git a/Spear/Sound/Sound.hs b/Spear/Sound/Sound.hs
new file mode 100644
index 0000000..53a1a46
--- /dev/null
+++ b/Spear/Sound/Sound.hs
@@ -0,0 +1,101 @@
+module Spear.Sound.Sound
+( LoopMode(..)
+, withSoundContext
+, initSoundSystem
+, destroySoundSystem
+, loadAudioFile
+, deleteSoundBuffer
+, makeSoundSource
+, deleteSoundSource
+, setSoundSourceBuffer
+, setSoundLoopMode
+, playSounds
+)
+where
+
+import           Spear.Game
+import           Spear.Sound.State
+
+import           Data.Set          as Set
+import           Data.StateVar     (($=))
+import qualified Sound.ALUT        as AL
+
+
+data LoopMode
+  = SingleShot
+  | Loop
+  deriving (Show)
+
+
+-- | Create the sound context and run an IO action within the context.
+withSoundContext :: IO a -> IO a
+withSoundContext action = AL.withProgNameAndArgs AL.runALUT $
+  \name args -> action
+
+-- | Initialize the sound system.
+initSoundSystem :: Game () SoundState
+initSoundSystem = return newSoundState
+
+-- | Destroy the sound system.
+destroySoundSystem :: Game SoundState ()
+destroySoundSystem = do
+  state <- get
+  mapM_ release' (toList $ buffers state)
+  mapM_ release' (toList $ sources state)
+  put newSoundState
+
+-- | Load an audio file.
+loadAudioFile :: FilePath -> Game SoundState SoundBuffer
+loadAudioFile path = do
+  alBuffer <- liftIO $ AL.createBuffer (AL.File path)
+  resourceKey <- register $ AL.deleteObjectName alBuffer
+  let buffer = SoundBuffer alBuffer resourceKey
+  modify (\state -> state {
+    buffers = Set.insert buffer (buffers state)
+  })
+  return buffer
+
+-- | Delete the sound buffer.
+deleteSoundBuffer :: SoundBuffer -> Game SoundState ()
+deleteSoundBuffer buffer = do
+  modify (\state -> state {
+    buffers = Set.delete buffer (buffers state)
+  })
+  release' buffer
+
+-- | Create a sound source.
+--
+-- The new source sounds flat, like background music or sound effects in a 2D
+-- game. Change the source's (and listener's) properties to simulate 3D sound.
+makeSoundSource :: Game SoundState SoundSource
+makeSoundSource = do
+  alSource <- AL.genObjectName
+  resourceKey <- register $ AL.deleteObjectName alSource
+  let source = SoundSource alSource resourceKey
+  modify (\state -> state {
+    sources = Set.insert source (sources state)
+  })
+  return source
+
+-- | Delete the sound source.
+deleteSoundSource :: SoundSource -> Game SoundState ()
+deleteSoundSource source = do
+  modify (\state -> state {
+    sources = Set.delete source (sources state)
+  })
+  release' source
+
+-- | Set the sound that the sound source emits.
+setSoundSourceBuffer :: SoundSource -> SoundBuffer -> IO ()
+setSoundSourceBuffer source buffer =
+  AL.buffer (alSource source) $= Just (alBuffer buffer)
+
+-- | Set the sound's loop mode.
+setSoundLoopMode :: SoundSource -> LoopMode -> IO ()
+setSoundLoopMode source mode = AL.loopingMode (alSource source) $= alMode mode
+  where alMode SingleShot = AL.OneShot
+        alMode Loop       = AL.Looping
+
+-- | Play the sound sources.
+playSounds :: [SoundSource] -> IO ()
+playSounds = AL.play . (alSource <$>)
diff --git a/Spear/Sound/State.hs b/Spear/Sound/State.hs
new file mode 100644
index 0000000..d843de5
--- /dev/null
+++ b/Spear/Sound/State.hs
@@ -0,0 +1,54 @@
+module Spear.Sound.State where
+
+import           Spear.Game
+
+import           Data.Hashable
+import           Data.Set      as Set
+import qualified Sound.ALUT    as AL
+
+
+-- | A sound buffer.
+data SoundBuffer = SoundBuffer
+  { alBuffer       :: AL.Buffer
+  , bufferResource :: ReleaseKey
+  }
+
+-- | A sound source.
+data SoundSource = SoundSource
+  { alSource       :: AL.Source
+  , sourceResource :: ReleaseKey
+  }
+
+-- | Sound state.
+data SoundState = SoundState
+  { buffers :: Set SoundBuffer
+  , sources :: Set SoundSource
+  }
+
+
+instance ResourceClass SoundBuffer where
+  getResource = bufferResource
+
+instance ResourceClass SoundSource where
+  getResource = sourceResource
+
+instance Eq SoundBuffer where
+  a == b = alBuffer a == alBuffer b
+
+instance Eq SoundSource where
+  a == b = alSource a == alSource b
+
+instance Ord SoundBuffer where
+  a <  b = alBuffer a <  alBuffer b
+  a <= b = alBuffer a <= alBuffer b
+
+instance Ord SoundSource where
+  a < b  = alSource a <  alSource b
+  a <= b = alSource a <= alSource b
+
+
+newSoundState :: SoundState
+newSoundState = SoundState
+  { buffers = Set.empty
+  , sources = Set.empty
+  }