justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Merge branch 'master' of ssh://git.xkjq.uk:30001/justin/loop

Browse Source
This commit is contained in:
Ross
2021-04-06 21:55:47 +01:00
parent 79673574b9 9a86d03fae
commit 16f785fa5b
16 changed files with 288 additions and 125 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+14 -7
View File
@@ -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
data/music/undercity.mid
BIN
View File
Binary file not shown.
src/Dodge/Creature/Inanimate.hs
+5 -2
View File
@@ -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
src/Dodge/Data.hs
+4 -2
View File
@@ -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])
src/Dodge/Item/Weapon.hs
+3 -5
View File
@@ -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
src/Dodge/Item/Weapon/TriggerType.hs
+13 -10
View File
@@ -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
src/Dodge/LevelGen/Block.hs
+3 -4
View File
@@ -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
src/Dodge/LoadSound.hs
+54 -52
View File
@@ -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
]
src/Dodge/SoundLogic.hs
+129 -10
View File
@@ -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)
src/Dodge/WorldEvent/Explosion.hs
+6 -6
View File
@@ -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
src/Dodge/WorldEvent/Sound.hs
+5 -4
View File
@@ -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)
src/Music.hs
+9
View File
@@ -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
}
src/Preload.hs
+2 -7
View File
@@ -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
src/Preload/Data.hs
+6 -4
View File
@@ -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
src/Sound.hs
+31 -10
View File
@@ -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
src/Sound/Preload.hs → src/Sound/Data.hs
+4 -2
View File
@@ -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)