diff --git a/app/Main.hs b/app/Main.hs index 080c07ea8..01ac7ef6f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,30 +19,37 @@ import Picture.Render import Picture.Preload import Sound import Preload -import Sound.Preload +import Sound.Data +import Music import Control.Concurrent import Control.Lens import Foreign (Word32) import Control.Monad (when,void) - -import System.Random - -import System.Random import qualified Data.Map as M import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate) +import qualified Data.Map as M +import qualified Data.IntMap as IM import qualified SDL import qualified SDL.Mixer as Mix 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 @@ -56,7 +63,7 @@ main = do ( \preData w -> do startTicks <- SDL.ticks void $ doDrawing (_renderData preData) w - playSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) + playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w) endTicks <- SDL.ticks diff --git a/data/music/undercity.mid b/data/music/undercity.mid new file mode 100644 index 000000000..0100375a0 Binary files /dev/null and b/data/music/undercity.mid differ diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 4397a33d2..fe2108a85 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -35,8 +35,11 @@ updateLamp :: Int -> CRUpdate updateLamp i = unrandUpdate handleLS internalUpdate where handleLS cr w - | _crHP cr < 0 = explosionFlashAt (_crPos cr) $ mkSoundBreakGlass w & lightSources %~ IM.delete i - | otherwise = w & lightSources . ix i . lsPos .~ _crPos cr + | _crHP cr < 0 = explosionFlashAt cPos + $ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i + | otherwise = w & lightSources . ix i . lsPos .~ cPos + where + cPos = _crPos cr internalUpdate cr | _crHP cr < 0 = Nothing | otherwise = Just $ doDamage cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f07949a68..7cb91d76d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -10,7 +10,7 @@ module Dodge.Data where import Picture.Data import Geometry.Data -import Sound.Preload +import Sound.Data import Control.Lens import Control.Monad.State import System.Random @@ -25,6 +25,8 @@ import Codec.Picture (Image,PixelRGBA8) import qualified Data.DList as DL import Dodge.LoadConfig +import Data.Int (Int16) + data World = World { _keys :: !(S.Set Scancode) , _mouseButtons :: !(S.Set MouseButton) @@ -50,7 +52,7 @@ data World = World , _worldEvents :: !(World -> World) , _pressPlates :: IM.IntMap PressPlate , _buttons :: IM.IntMap Button - , _soundQueue :: [Int] + , _soundQueue :: [(Int,Int16)] , _sounds :: M.Map SoundOrigin Sound , _decorations :: IM.IntMap Picture , _corpses :: IM.IntMap (IM.IntMap [Corpse]) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 08a3ba7a4..d43799a3b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -810,7 +810,7 @@ moveShell time i cid rot accel w $ set (projectiles . ix i . pjUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) - $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 + $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 $ smokeGen @@ -879,8 +879,7 @@ tractorBeamAt colID i pos dir = Projectile aGasCloud :: Int -> World -> World aGasCloud cid w - = -- soundFrom Flame fireSound 2 500 - insertCloud $ set randGen g $ + = insertCloud $ set randGen g $ w where (a,g) = randomR (-0.1,0.1) (_randGen w) @@ -896,7 +895,6 @@ aGasCloud cid w aFlame :: Float -> Int -> World -> World aFlame a cid w = shakeCr cid 2 --- $ soundFrom Flame fireSound 2 500 $ insertFlame $ resetAngle $ set randGen g $ w where @@ -1381,7 +1379,7 @@ moveRemoteShell time i cid itid dir w $ set (projectiles . ix i . pjUpdate) (moveRemoteShell (time-1) i cid itid newdir) $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v) - $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250 + $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250 $ smokeGen $ makeFlameletTimed oldPos (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5b2a789d5..b6257936b 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -43,9 +43,9 @@ withWarmUp t f cid w | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) $ set (pointerToItem . wpFireState) 2 w - | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) + | t > 2 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 - $ soundFrom (CrWeaponSound cid) 26 1 0 + $ soundFrom (CrWeaponSound cid) 26 2 0 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 @@ -56,16 +56,19 @@ withWarmUp t f cid w $ f cid $ soundFrom (CrWeaponSound cid) 28 2 0 w - where cr = _creatures w IM.! cid - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointerToItem = creatures . ix cid . crInv . ix itRef - fState = _wpFireState item - fRate = _wpFireRate item - reloadCondition = _wpLoadedAmmo item == 0 + where + cr = _creatures w IM.! cid + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointerToItem = creatures . ix cid . crInv . ix itRef + fState = _wpFireState item + fRate = _wpFireRate item + reloadCondition = _wpLoadedAmmo item == 0 withSound :: Int -> (Int -> World -> World) -> Int -> World -> World -withSound soundid f cid = soundOnce soundid . f cid +withSound soundid f cid w = (soundOncePos soundid p . f cid) w + where + p = _crPos (_creatures w IM.! cid) withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index ee69fb2c7..9b48888c5 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -42,11 +42,10 @@ killBlock bl w = f bl . where f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl f bl = hitSound' bl - hitSound bl | _wlIsSeeThrough bl = mkSoundBreakGlass --- hitSound bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+8) 25 0 + pos = _wlLine bl !! 0 + hitSound bl | _wlIsSeeThrough bl = mkSoundBreakGlass pos | otherwise = soundMultiFrom sos soundid 25 0 - hitSound' bl | _wlIsSeeThrough bl = mkSoundSplinterGlass --- hitSound' bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+4) 25 0 + hitSound' bl | _wlIsSeeThrough bl = mkSoundSplinterGlass pos | otherwise = soundMultiFrom sos soundid 25 0 sos = [BlockDegradeSound 0,BlockDegradeSound 1] (soundid,_) = randomR (29,32) $ _randGen w diff --git a/src/Dodge/LoadSound.hs b/src/Dodge/LoadSound.hs index a825b8c98..f38b5da4e 100644 --- a/src/Dodge/LoadSound.hs +++ b/src/Dodge/LoadSound.hs @@ -14,15 +14,15 @@ import qualified SDL.Mixer as Mix -- }}} loadSounds :: IO (IM.IntMap Mix.Chunk) loadSounds = do - Mix.openAudio Mix.defaultAudio 256 + Mix.openAudio Mix.defaultAudio 128 pFireSound <- Mix.load "./data/sound/tap3.wav" click <- Mix.load "./data/sound/click1.wav" 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 + ] diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index a0d633eda..f6069cf7c 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -1,35 +1,144 @@ -module Dodge.SoundLogic where +{-| +Module : Dodge.SoundLogic +Description : Messages to "Sound" backend + +This module allows us to talk to the "Sound" module. +-} +module Dodge.SoundLogic ( + -- * Manipulation of individual sounds + soundOnce + , soundOncePos + , soundOnceOrigin + , soundFromPos + , soundFrom + , soundMultiFrom + , stopSoundFrom + + -- * Manipulation of all sounds + , haltSound + , resumeSound + , pauseSound + + -- * Synonyms for sound identifiers + , clickSound + , reloadSound + , pickUpSound + , putDownSound + , fireSound + , grenadeBang + , tapQuiet + , twoStepSound + , healSound + , doorSound + , twoStepSlowSound + , knifeSound + , buzzSound + , hitSound + , autoGunSound + , shotgunSound + , teleSound + , longGunSound + , launcherSound + , smokeTrailSound + , foot1Sound + , foot2Sound + ) where import Dodge.Data -import Sound.Preload (SoundStatus (..)) +import Sound.Data (SoundStatus (..)) +import Geometry.Vector +import Geometry (dist) import Control.Lens import qualified Data.Map as M +import Data.Int (Int16) +{-| Placeholder...-} haltSound :: World -> World haltSound w = w +{-| Placeholder...-} pauseSound :: World -> World pauseSound w = w +{-| Placeholder...-} resumeSound :: World -> World resumeSound w = w +{-| Add a sound to the queue for playback. +Consider replacing with 'soundOncePos'. + -} soundOnce :: Int -> World -> World -soundOnce i = over soundQueue ((:) i) +soundOnce i = over soundQueue ((:) (i,0)) -soundOnceOrigin :: Int -> SoundOrigin -> World -> World -soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) +{-| Play a sound with a given position in the world. +Uses the angle between the given position and '_cameraViewFrom', taking into account '_cameraRot'. + -} +soundOncePos :: Int -> Point2 -> World -> World +soundOncePos i pos w = over soundQueue ((:) (i,a)) w + where + a = soundAngle pos w + +{-| Play a sound once, with a given origin. +For each origin only one sound will play at a time. +-} +soundOnceOrigin + :: Int -- ^ ID of the sound to be played + -> SoundOrigin -- ^ The \"creator\" of the sound + -> Point2 -- ^ The position of the sound in the world + -> World -> World +soundOnceOrigin sType so p w = over sounds (M.insertWith (flip const) so theSound) w where - sound = Sound + theSound = Sound { _soundChunkID = sType , _soundTime = Nothing , _soundFadeTime = 0 , _soundStatus = ToStart , _soundChannel = Nothing - , _soundPos = Nothing + , _soundPos = Just (a,0) } + a = soundAngle p w -soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World +soundFromPos + :: SoundOrigin -- ^ \"Creator\" of sound + -> Point2 -- ^ Position of sound + -> Int -- ^ ID of sound to be played + -> Int -- ^ Frames to play sound for + -> Int -- ^ Time sound fades out after playing for the given number of frames (ms) + -> World -> World +soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound) w + where + sound = Sound + { _soundChunkID = sType + , _soundTime = Just time + , _soundStatus = ToStart + , _soundFadeTime = fadeTime + , _soundChannel = Nothing + , _soundPos = Just (a,0) + } + f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} + a = soundAngle pos w + +{-| Calculates the angle of a sound with reference to '_cameraViewFrom'. +Within 10 units considers the sound to be directly in front. +-} +soundAngle :: Point2 -> World -> Int16 +{-# INLINE soundAngle #-} +soundAngle p w + | dist p earPos < 10 = 0 + | otherwise = round + . radToDeg + . normalizeAngle + . (+ pi) + $ argV (vNormal (p -.- earPos)) - _cameraRot w + where + earPos = _cameraViewFrom w + +soundFrom + :: SoundOrigin + -> Int -- ^ Sound ID + -> Int -- ^ Frames to play + -> Int -- ^ Fade out time (ms) + -> World -> World soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w where sound = Sound @@ -42,7 +151,16 @@ soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w } f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} -soundMultiFrom :: [SoundOrigin] -> Int -> Int -> Int -> World -> World +{-| Uses the first free origin from a list. +Does nothing if all origins are already creating sounds. +TODO: add positional information. +-} +soundMultiFrom + :: [SoundOrigin] + -> Int -- ^ Sound ID + -> Int -- ^ Frames to play for + -> Int -- ^ Fade out time (ms) + -> World -> World soundMultiFrom [] _ _ _ w = w soundMultiFrom (so:sos) sType time fadeTime w | so `M.member` _sounds w = soundMultiFrom sos sType time fadeTime w @@ -57,7 +175,8 @@ soundMultiFrom (so:sos) sType time fadeTime w , _soundPos = Nothing } - +{- | Sets '_soundTime' to 0. + -} stopSoundFrom :: SoundOrigin -> World -> World stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0) diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 66072012d..85e186393 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -20,7 +20,7 @@ import Control.Lens -- The following should be improved.... I've made a first pass makePoisonExplosionAt :: Point2 -> World -> World -makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels +makePoisonExplosionAt p w = soundOncePos grenadeBang p $ foldr (makeGasCloud p) w vels where vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w) -- just change the number after replicate to get more or less clouds @@ -29,12 +29,12 @@ makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vel -- currently the clouds push away from each other rather hard if they are close makeTeslaExplosionAt :: Point2 -> World -> World -makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter +makeTeslaExplosionAt pos w = soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter where -- rad or 360? Radians (hopefully) everywhere xs = randomRs (0, 2*pi) $ _randGen w - p = newProjectileKey w - pks = [p..] + j = newProjectileKey w + pks = [j..] listOfFunctions = map (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i)))) [1 .. 29] @@ -43,7 +43,7 @@ makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- times -- the new flames are directly added to the list of particles makeFlameExplosionAt :: Point2 -> World -> World -makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w +makeFlameExplosionAt p w = soundOncePos grenadeBang p $ over particles' (newFlames ++ ) w where newFlames = zipWith makeFlameWithVelAndTime velocities timers makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing @@ -54,7 +54,7 @@ makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ makeExplosionAt :: Point2 -> World -> World -makeExplosionAt p w = soundOnce grenadeBang +makeExplosionAt p w = soundOncePos grenadeBang p . addFlames . explosionFlashAt p $ makeShockwaveAt [] p 50 10 1 white diff --git a/src/Dodge/WorldEvent/Sound.hs b/src/Dodge/WorldEvent/Sound.hs index a44c1d8e2..5f0b22833 100644 --- a/src/Dodge/WorldEvent/Sound.hs +++ b/src/Dodge/WorldEvent/Sound.hs @@ -1,18 +1,19 @@ module Dodge.WorldEvent.Sound where import Dodge.Data +import Geometry.Data (Point2) import Dodge.SoundLogic import System.Random import Control.Lens -mkSoundBreakGlass :: World -> World -mkSoundBreakGlass w = soundOnceOrigin soundid (GlassBreakSound 0) $ set randGen g w +mkSoundBreakGlass :: Point2 -> World -> World +mkSoundBreakGlass p w = soundOnceOrigin soundid (GlassBreakSound 0) p $ set randGen g w where (soundid,g) = _randGen w & randomR (37,40) -mkSoundSplinterGlass :: World -> World -mkSoundSplinterGlass w = soundOnceOrigin soundid (GlassBreakSound 1) $ set randGen g w +mkSoundSplinterGlass :: Point2 -> World -> World +mkSoundSplinterGlass p w = soundOnceOrigin soundid (GlassBreakSound 1) p $ set randGen g w where (soundid,g) = _randGen w & randomR (33,36) diff --git a/src/Music.hs b/src/Music.hs new file mode 100644 index 000000000..ad5d4e3e0 --- /dev/null +++ b/src/Music.hs @@ -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 + } diff --git a/src/Preload.hs b/src/Preload.hs index 3b893855e..e642f3e64 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -3,21 +3,16 @@ module Preload , module Preload.Data , module Preload.Update ) - where + where import Preload.Data import Preload.Update import Picture.Preload -import Sound.Preload +import Sound.Data 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 diff --git a/src/Preload/Data.hs b/src/Preload/Data.hs index 6b6e22314..3df492e65 100644 --- a/src/Preload/Data.hs +++ b/src/Preload/Data.hs @@ -5,12 +5,14 @@ import Control.Lens import GHC.Word (Word32) import Picture.Preload -import Sound.Preload +import Sound.Data +import Music data PreloadData a = PreloadData - { _renderData :: RenderData - , _soundData :: SoundData a - , _frameTimer :: Word32 + { _renderData :: RenderData + , _soundData :: SoundData a + , _musicData :: MusicData + , _frameTimer :: Word32 } makeLenses ''PreloadData diff --git a/src/Sound.hs b/src/Sound.hs index f158043a2..d22d67254 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -11,10 +11,11 @@ Uses SDL.Mixer. module Sound ( -- * Simple (One-Shot) Playback playSoundQueue + , playPositionalSoundQueue -- * Complex Playback , playAndUpdate ) where -import Sound.Preload +import Sound.Data import qualified SDL.Mixer as Mix import Data.Maybe @@ -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. @@ -63,7 +65,9 @@ updateSounds sd ss = do updateSound :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound updateSound sd s = - initialisePlaying sd s >>= liftIO . decrementTimer >>= cleanupHalted + initialisePlaying sd s + >>= liftIO . (decrementTimer >=> applyPosition) + >>= cleanupHalted initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound initialisePlaying sd s = case _soundStatus s of @@ -98,6 +102,12 @@ decrementTimer s = case _soundTime s of & soundStatus .~ FadingOut) Nothing -> return s +applyPosition :: Sound -> IO Sound +applyPosition s = case _soundPos s of + Nothing -> return s + Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d + >> return (s & soundPos .~ Nothing) + fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO () fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x fadeOutMaybe _ _ = return () @@ -112,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 diff --git a/src/Sound/Preload.hs b/src/Sound/Data.hs similarity index 86% rename from src/Sound/Preload.hs rename to src/Sound/Data.hs index 7ba4d541c..758a0cc7b 100644 --- a/src/Sound/Preload.hs +++ b/src/Sound/Data.hs @@ -1,11 +1,13 @@ {-# LANGUAGE TemplateHaskell #-} -module Sound.Preload +module Sound.Data where import qualified SDL.Mixer as Mix import qualified Data.IntMap as IM import qualified Data.Map as M import Control.Lens import Geometry +import Data.Word (Word8) +import Data.Int (Int16) data SoundStatus = Playing @@ -22,7 +24,7 @@ data Sound = Sound , _soundFadeTime :: Int , _soundStatus :: SoundStatus , _soundChannel :: Maybe Mix.Channel - , _soundPos :: Maybe Point2 + , _soundPos :: Maybe (Int16,Word8) , _soundChunkID :: Int } deriving (Eq,Ord,Show)