Add music support
This commit is contained in:
+11
-1
@@ -20,6 +20,7 @@ import Picture.Preload
|
||||
import Sound
|
||||
import Preload
|
||||
import Sound.Preload
|
||||
import Music
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Lens
|
||||
@@ -30,6 +31,7 @@ import Control.Monad (when,void)
|
||||
import System.Random
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.IntMap as IM
|
||||
import qualified SDL
|
||||
import qualified SDL.Mixer as Mix
|
||||
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
||||
@@ -37,9 +39,17 @@ import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
||||
doPreload' :: IO (PreloadData a)
|
||||
doPreload' = do
|
||||
lChunks <- loadSounds
|
||||
lMusic <- loadMusic
|
||||
let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty}
|
||||
mData = MusicData {_loadedMusic = lMusic}
|
||||
Mix.playMusic Mix.Forever (lMusic IM.! 0)
|
||||
rData <- preloadRender
|
||||
return $ PreloadData rData sData 0
|
||||
return $ PreloadData
|
||||
{ _renderData = rData
|
||||
, _soundData = sData
|
||||
, _musicData = mData
|
||||
, _frameTimer = 0
|
||||
}
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
||||
Binary file not shown.
+53
-51
@@ -20,9 +20,9 @@ loadSounds = do
|
||||
reloadSound' <- Mix.load "./data/sound/reload1.wav"
|
||||
tone440 <- Mix.load "./data/sound/tone440.wav"
|
||||
pickupSound' <- Mix.load "./data/sound/pickUp.wav"
|
||||
putdownSound' <- Mix.load "./data/sound/whiteNoiseFadeOut.wav"
|
||||
fireSound' <- Mix.load "./data/sound/fire1.wav"
|
||||
grenadeBang' <- Mix.load "./data/sound/grenade.wav"
|
||||
putdownSound' <- Mix.load "./data/sound/whiteNoiseFadeOut.wav"
|
||||
fireSound' <- Mix.load "./data/sound/fire1.wav"
|
||||
grenadeBang' <- Mix.load "./data/sound/grenade.wav"
|
||||
tapQuiet' <- Mix.load "./data/sound/tapQuiet.wav"
|
||||
twoStep' <- Mix.load "./data/sound/twoStep.wav"
|
||||
healSound' <- Mix.load "./data/sound/heal.wav"
|
||||
@@ -57,52 +57,54 @@ loadSounds = do
|
||||
glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav"
|
||||
glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav"
|
||||
foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav"
|
||||
return $ IM.fromList $ zip [0..]
|
||||
$ [ pFireSound
|
||||
, click
|
||||
, reloadSound'
|
||||
, tone440
|
||||
, pickupSound'
|
||||
, putdownSound'
|
||||
, fireSound'
|
||||
, grenadeBang'
|
||||
, tapQuiet'
|
||||
, twoStep'
|
||||
, healSound'
|
||||
, doorSound'
|
||||
, twoStepSlow'
|
||||
, knifeSound'
|
||||
, buzzSound'
|
||||
, hitSound' --15
|
||||
, autoGunSound'
|
||||
, shotgunSound'
|
||||
, teleSound'
|
||||
, longGunSound'
|
||||
, launcherSound'
|
||||
, smokeTrailSound'
|
||||
, foot1Sound'
|
||||
, foot2Sound'
|
||||
, lasSound'
|
||||
, teslaSound' --25
|
||||
, crankSlow'
|
||||
, autoB'
|
||||
, mini'
|
||||
, impactA'
|
||||
, impactB' --30
|
||||
, impactC'
|
||||
, impactD'
|
||||
, glassShat1' --33
|
||||
, glassShat2'
|
||||
, glassShat3'
|
||||
, glassShat4'
|
||||
, glass1' --37
|
||||
, glass2'
|
||||
, glass3'
|
||||
, glass4' --40
|
||||
, foamSpray'
|
||||
]
|
||||
|
||||
|
||||
soundOnce :: Int -> World -> World
|
||||
soundOnce i = over soundQueue ((:) i)
|
||||
return $ IM.fromList $ zip [0..] $
|
||||
[ pFireSound
|
||||
, click
|
||||
, reloadSound'
|
||||
, tone440
|
||||
, pickupSound'
|
||||
, putdownSound'
|
||||
, fireSound'
|
||||
, grenadeBang'
|
||||
, tapQuiet'
|
||||
, twoStep'
|
||||
, healSound'
|
||||
, doorSound'
|
||||
, twoStepSlow'
|
||||
, knifeSound'
|
||||
, buzzSound'
|
||||
, hitSound' --15
|
||||
, autoGunSound'
|
||||
, shotgunSound'
|
||||
, teleSound'
|
||||
, longGunSound'
|
||||
, launcherSound'
|
||||
, smokeTrailSound'
|
||||
, foot1Sound'
|
||||
, foot2Sound'
|
||||
, lasSound'
|
||||
, teslaSound' --25
|
||||
, crankSlow'
|
||||
, autoB'
|
||||
, mini'
|
||||
, impactA'
|
||||
, impactB' --30
|
||||
, impactC'
|
||||
, impactD'
|
||||
, glassShat1' --33
|
||||
, glassShat2'
|
||||
, glassShat3'
|
||||
, glassShat4'
|
||||
, glass1' --37
|
||||
, glass2'
|
||||
, glass3'
|
||||
, glass4' --40
|
||||
, foamSpray'
|
||||
]
|
||||
|
||||
loadMusic :: IO (IM.IntMap Mix.Music)
|
||||
loadMusic = do
|
||||
undercity <- Mix.load "./data/music/undercity.mid"
|
||||
return $ IM.fromList $ zip [0..] $
|
||||
[ undercity
|
||||
]
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Music
|
||||
where
|
||||
import qualified SDL.Mixer as Mix
|
||||
import qualified Data.IntMap as IM
|
||||
|
||||
data MusicData = MusicData
|
||||
{ _loadedMusic :: IM.IntMap Mix.Music
|
||||
}
|
||||
+1
-6
@@ -3,7 +3,7 @@ module Preload
|
||||
, module Preload.Data
|
||||
, module Preload.Update
|
||||
)
|
||||
where
|
||||
where
|
||||
import Preload.Data
|
||||
import Preload.Update
|
||||
|
||||
@@ -13,11 +13,6 @@ import Control.Lens
|
||||
|
||||
import GHC.Word (Word32)
|
||||
|
||||
--doPreload :: IO (PreloadData a)
|
||||
--doPreload = do
|
||||
-- sData <- preloadSound
|
||||
-- rData <- preloadRender
|
||||
-- return $ PreloadData rData sData 0
|
||||
|
||||
cleanUpPreload :: PreloadData a -> IO ()
|
||||
cleanUpPreload pd = do
|
||||
|
||||
+5
-3
@@ -6,11 +6,13 @@ import GHC.Word (Word32)
|
||||
|
||||
import Picture.Preload
|
||||
import Sound.Preload
|
||||
import Music
|
||||
|
||||
data PreloadData a = PreloadData
|
||||
{ _renderData :: RenderData
|
||||
, _soundData :: SoundData a
|
||||
, _frameTimer :: Word32
|
||||
{ _renderData :: RenderData
|
||||
, _soundData :: SoundData a
|
||||
, _musicData :: MusicData
|
||||
, _frameTimer :: Word32
|
||||
}
|
||||
|
||||
makeLenses ''PreloadData
|
||||
|
||||
+21
-8
@@ -11,6 +11,7 @@ Uses SDL.Mixer.
|
||||
module Sound (
|
||||
-- * Simple (One-Shot) Playback
|
||||
playSoundQueue
|
||||
, playPositionalSoundQueue
|
||||
-- * Complex Playback
|
||||
, playAndUpdate
|
||||
) where
|
||||
@@ -24,6 +25,7 @@ import Control.Monad
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Lens
|
||||
import Data.Int (Int16)
|
||||
{- | Start playing new sounds and update sound specifications.
|
||||
A Map of new sound specifications is merged with a Map of already playing sounds,
|
||||
then sounds in the merged Map are updated.
|
||||
@@ -120,18 +122,29 @@ cleanupHalted s = do
|
||||
|
||||
-----------------------------------------------------------------
|
||||
{- | Play sounds from a list of indices.
|
||||
Each sound starts playing (and will not repeat) if there is a free channel.
|
||||
For each index, the corresponding sound starts playing if there is a free channel.
|
||||
Use this if you don't care about timing, overlapping, fading, or sound positions.
|
||||
-}
|
||||
playSoundQueue :: IM.IntMap Mix.Chunk -> [Int] -> IO ()
|
||||
playSoundQueue chunkMap ns = forM_ ns $ \n -> playIfFree (chunkMap IM.! n) Mix.Once
|
||||
playSoundQueue chunkMap ns = forM_ ns $ \n -> runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once
|
||||
{- | Given a chunk, attempt to play this on a free channel a given number of
|
||||
times. Returns 'Just' the channel if succeeds.
|
||||
-}
|
||||
playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel)
|
||||
playIfFree c times = do
|
||||
mayChan <- Mix.getAvailable Mix.DefaultGroup
|
||||
case mayChan of
|
||||
Nothing -> return Nothing
|
||||
Just i -> Just <$> Mix.playOn i times c
|
||||
|
||||
playIfFree :: Mix.Chunk -> Mix.Times -> MaybeT IO Mix.Channel
|
||||
playIfFree c times = do
|
||||
i <- MaybeT $ Mix.getAvailable Mix.DefaultGroup
|
||||
liftIO $ Mix.playOn i times c
|
||||
|
||||
-----------------------------------------------------------------
|
||||
{- | Play sounds from a list of index/position pairs.
|
||||
As for 'playSoundQueue', but with positional information in the form of an Int16.
|
||||
-}
|
||||
playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO ()
|
||||
playPositionalSoundQueue chunkMap ns = forM_ ns $ \(n,a) ->
|
||||
runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a
|
||||
|
||||
setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel
|
||||
setChannelPos a i = do
|
||||
liftIO $ Mix.effectPosition i a 0
|
||||
return i
|
||||
|
||||
Reference in New Issue
Block a user