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

Refactor sounds

Browse Source
This commit is contained in:
justin
2021-09-09 14:58:07 +01:00
parent be7b2d2cd7
commit 70c97f5367
26 changed files with 113 additions and 162 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+2 -2
View File
@@ -229,8 +229,8 @@ collidePointFF = undefined
-- | Looks for first collision of a circle with walls.
-- If found, gives point and reflection velocity, reflection damped in normal.
collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
collideCircWalls' p1 p2 rad ws
collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
collideCircWalls p1 p2 rad ws
= safeMinimumOn f
$ IM.mapMaybe
(( \(x:y:_) -> fmap
src/Dodge/Creature/Action.hs
+7 -4
View File
@@ -165,7 +165,8 @@ blinkAction
:: Creature
-> World
-> World
blinkAction cr w = soundOnce teleSound
blinkAction cr w
= soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleSound Nothing
. over radDistortion (distortionBulge ++)
. set (creatures . ix cid . crPos) p3
. blinkShockwave cid p3
@@ -195,9 +196,11 @@ youDropItem :: World -> World
youDropItem w = case yourItem w of
NoItem -> w
_ -> rmSelectedInvItem (_yourID w)
. copyItemToFloor (you w) (_crInvSel $ you w)
$ soundOnce putDownSound
. copyItemToFloor (you w) (_crInvSel cr)
$ soundFrom (CrSound (_crID cr)) (_crPos cr) putDownSound Nothing
w
where
cr = you w
{- | Copy an inventory item to the floor. -}
copyItemToFloor
:: Creature
@@ -229,7 +232,7 @@ pickUpItem
pickUpItem cid flit w = case maybeInvSlot of
Nothing -> w
Just i -> w
& soundOnce pickUpSound
& soundFrom (CrSound cid) (_flItPos flit) pickUpSound Nothing
& updateItLocation i
& floorItems %~ IM.delete (_flItID flit)
& creatures . ix cid . crInv . ix i %~ addItem it
src/Dodge/Creature/Impulse.hs
+6 -5
View File
@@ -52,9 +52,9 @@ followImpulse cr w imp = case imp of
ChangePosture post -> (id, cr & crStance . posture .~ post)
UseItem -> (tryUseItem cr, cr)
SwitchToItem i -> (id, cr & crInvSel .~ i)
Melee cid ->
(hitCr cid
, crMvBy (10 *.* normalizeV (posFromID cid -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
Melee cid' ->
(hitCr cid'
, crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20) -- randomise cooldown?
RandomTurn a -> (id, creatureTurn (rr a) cr)
MakeSound sid -> ( soundOnceOrigin sid (CrSound (_crID cr)) (_crPos cr) , cr )
DropItem -> undefined
@@ -78,8 +78,9 @@ followImpulse cr w imp = case imp of
turnRad = _mvTurnRad mvType
cpos = _crPos cr
cdir = _crDir cr
posFromID cid = _crPos $ _creatures w IM.! cid
cid = _crID cr
posFromID cid' = _crPos $ _creatures w IM.! cid'
rr a = fst $ randomR (-a,a) $ _randGen w
hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
. soundOnce hitSound
. soundFrom (CrSound cid) cpos hitSound Nothing
addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams
src/Dodge/Creature/State.hs
+3 -3
View File
@@ -135,11 +135,11 @@ invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
weaponReloadSounds :: Creature -> World -> World
weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
Just Weapon{_wpReloadType = PassiveReload stype,_wpReloadTime=rt,_wpReloadState=rs}
| rt == rs -> soundOncePos stype (_crPos cr) w
| rt == rs -> soundFrom (CrReloadSound 0) (_crPos cr) stype Nothing w
| otherwise -> w
Just Weapon{_wpReloadState = 0} -> w
Just Weapon{_wpReloadState = 1} -> stopSoundFrom (CrReloadSound cid) w
Just Weapon{} -> soundFrom (CrReloadSound cid) reloadSound 1 0 w
Just Weapon{} -> soundFrom (CrReloadSound cid) (_crPos cr) reloadSound (Just 1) w
_ -> w
where
cid = _crID cr
@@ -221,7 +221,7 @@ updateExpBarrel cr w
applyFuseDamage cr' = cr' & crHP %~
subtract (length . _piercedPoints . _crSpState $ _crState cr')
hiss | null poss = id
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
| otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) 41 (Just 1)
stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
damToExpBarrel :: [DamageType] -> Creature -> Creature
src/Dodge/Creature/State/WalkCycle.hs
+1 -1
View File
@@ -29,7 +29,7 @@ footstepSideEffect cr w = case cr ^? crStance . carriage of
makeFootstepSound :: Int -> Int -> FootForward -> Point2 -> World -> World
makeFootstepSound currentStride maxStride ff p
| currentStride > maxStride = soundMultiFromPos footor (chooseFootSound ff) 3 0 p
| currentStride > maxStride = soundMultiFrom footor p (chooseFootSound ff) Nothing
| otherwise = id
where
footor = [FootstepSound 0,FootstepSound 1]
src/Dodge/Data.hs
-2
View File
@@ -39,7 +39,6 @@ import GHC.Generics
import Control.Lens
import System.Random
import Data.Graph.Inductive
import Data.Int (Int16)
import qualified Data.Set as S
import qualified Data.IntSet as IS
import qualified Data.IntMap.Strict as IM
@@ -76,7 +75,6 @@ data World = World
, _worldEvents :: World -> World
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [(Int,Int16)]
, _sounds :: M.Map SoundOrigin Sound
, _playingSounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
src/Dodge/Data/SoundOrigin.hs
+4
View File
@@ -16,5 +16,9 @@ data SoundOrigin = InventorySound
| CrHitSound Int
| BarrelHiss Int
| GlassBreakSound Int
| TeleSound Int
| LeverSound Int
| Explosion Int
| Tap Int
deriving (Eq,Ord,Show)
src/Dodge/Default.hs
+1 -1
View File
@@ -212,7 +212,7 @@ defaultButton = Button
, _btEvent = \b w ->
set (buttons . ix (_btID b) . btPict) (onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10))
. set (buttons . ix (_btID b) . btState) BtNoLabel
. soundOnce 1 $ w
. soundFrom (LeverSound 0) (_btPos b) 1 Nothing $ w
, _btID = 0
, _btText = "Button"
, _btState = BtOff
src/Dodge/Default/World.hs
-1
View File
@@ -48,7 +48,6 @@ defaultWorld = World
, _worldEvents = id
, _pressPlates = IM.empty
, _buttons = IM.empty
, _soundQueue = []
, _sounds = M.empty
, _playingSounds = M.empty
, _corpses = IM.empty
src/Dodge/Initialisation.hs
+2 -2
View File
@@ -42,8 +42,8 @@ initialWorld = defaultWorld
, _mousePos = V2 0 0
, _testString = testStringInit
, _yourID = 0
, _worldEvents = soundOncePos foamSprayFadeOutSound (V2 0 0) . foldr ((.) . makeStartCloudAt) id
[V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
, _worldEvents = soundFrom BackgroundSound (V2 0 0) foamSprayFadeOutSound Nothing
. foldr ((.) . makeStartCloudAt) id [V3 x y 5 | x <- [-5,-3..5] , y <- [-5,-3..5]]
, _pressPlates = IM.empty
, _buttons = IM.empty
, _sounds = M.empty
src/Dodge/Item/Consumable.hs
+4 -1
View File
@@ -31,5 +31,8 @@ heal25 :: Int -> World -> Maybe World
heal25 = heal 25
heal :: Int -> Int -> World -> Maybe World
heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
| otherwise = Just $ soundOnce healSound w & creatures . ix n . crHP %~ min 10000 . (+ hp)
| otherwise = Just $ soundFrom (CrSound $ _crID cr) (_crPos cr) healSound Nothing w
& creatures . ix n . crHP %~ min 10000 . (+ hp)
where
cr = _creatures w IM.! n
src/Dodge/Item/Weapon.hs
+6 -6
View File
@@ -751,10 +751,10 @@ moveRemoteBomb itid time pID w
$ set (projectiles .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (f time) pID)
w
| time < 2 = case hitWl of
Just _ -> soundOnce tapQuiet $ halfV updatedWorld
Just (p,_) -> soundFrom (Tap 0) p tapQuiet Nothing $ halfV updatedWorld
_ -> halfV updatedWorld
| otherwise = case hitWl of
Just _ -> soundOnce tapQuiet updatedWorld
Just (p,_) -> soundFrom (Tap 0) p tapQuiet Nothing updatedWorld
_ -> updatedWorld
where
updatedWorld
@@ -768,7 +768,7 @@ moveRemoteBomb itid time pID w
-- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls
invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
hitWl = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = maybe newPos (invShift . fst) hitWl
setV v = set (projectiles . ix pID . pjVel) v
updateV = maybe id (setV . snd) hitWl
@@ -874,7 +874,7 @@ fireRemoteLauncher :: Creature -> World -> World
fireRemoteLauncher cr w = setLocation
$ resetFire
$ resetName
$ soundOnce launcherSound
$ soundFrom (CrWeaponSound cid) pos launcherSound Nothing
$ over projectiles addRemRocket w
where
i = IM.newKey $ _projectiles w
@@ -922,7 +922,7 @@ moveRemoteShell cid itid pj w
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
. ( pjDir .~ newdir )
)
& soundFromPos (ShellSound i) newPos smokeTrailSound 1 250
& soundFrom (ShellSound i) newPos smokeTrailSound (Just 1)
& smokeGen
& makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
| time > -200 = case thingHit of
@@ -944,7 +944,7 @@ moveRemoteShell cid itid pj w
(frict,g) = randomR (0.6,0.9) $ _randGen w
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
r1 = _randGen w & evalState (randInCirc 10)
smokeGen = makeSmokeCloudAt $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
src/Dodge/Item/Weapon/Grenade.hs
+2 -2
View File
@@ -31,7 +31,7 @@ moveGrenade 0 _ pID w = over projectiles (IM.delete pID)
pj = _projectiles w IM.! pID
explosion = _pjPayload pj
moveGrenade time dir pID w = case hitWl of
Just _ -> soundOnce tapQuiet updatedWorld
Just (p,_) -> soundFrom (Tap 0) p tapQuiet Nothing updatedWorld
_ -> updatedWorld
where
updatedWorld = updateV $ set (projectiles . ix pID . pjPos) finalPos
@@ -42,7 +42,7 @@ moveGrenade time dir pID w = case hitWl of
pj = _projectiles w IM.! pID
oldPos = _pjPos pj
newPos = _pjVel pj +.+ oldPos
hitWl = collideCircWalls' oldPos newPos 4 $ wallsNearPoint newPos w
hitWl = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
finalPos = maybe newPos fst hitWl
setV v = set (projectiles .ix pID.pjVel) v
updateV = maybe id (setV . snd) hitWl
src/Dodge/Item/Weapon/Launcher.hs
+2 -2
View File
@@ -106,7 +106,7 @@ doThrust :: Projectile -> World -> World
doThrust pj w = w
& randGen .~ g
& projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundFromPos (ShellSound i) newPos smokeTrailSound 1 250
& soundFrom (ShellSound i) newPos smokeTrailSound (Just 1)
& makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
& smokeGen
where
@@ -174,7 +174,7 @@ moveShell pj w
projectileExplosion = _pjPayload pj
newPos = oldPos +.+ vel
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w)
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
thingHit = hitCr <|> hitWl
reduceSpinBy :: Float -> Projectile -> World -> World
src/Dodge/Item/Weapon/TriggerType.hs
+7 -3
View File
@@ -126,7 +126,7 @@ withWarmUpI soundID f item cr w
| _wpReloadState item /= 0 = w
| curWarmUp < maxWarmUp = w
& pointerToItem . wpCurWarmUp +~ 2
& soundFrom (CrWeaponSound cid) soundID 2 0
& soundFrom (CrWeaponSound cid) (_crPos cr) soundID (Just 2)
| otherwise = w
& pointerToItem . wpCurWarmUp .~ maxWarmUp
& f item cr
@@ -141,7 +141,11 @@ The sound is emitted from the creature's position. -}
withSoundI
:: Int -- ^ Sound id
-> ChainEffect
withSoundI soundid f item cr = soundOncePos soundid (_crPos cr) . f item cr
withSoundI soundid f item cr
= soundFrom (CrWeaponSound cid) (_crPos cr) soundid Nothing
. f item cr
where
cid = _crID cr
{- | Adds a sound to a creature based world effect.
The sound is emitted from the creature's position. -}
@@ -150,7 +154,7 @@ withSoundForI
-> Int -- ^ Frames to play
-> ChainEffect
withSoundForI soundid playTime f item cr
= soundFromPos (CrWeaponSound (_crID cr)) (_crPos cr) soundid playTime 0
= soundFrom (CrWeaponSound (_crID cr)) (_crPos cr) soundid (Just playTime)
. f item cr
afterRecoil
src/Dodge/LevelGen/Block.hs
+2 -2
View File
@@ -44,10 +44,10 @@ killBlock bl w = f bl . flip (foldr unshadow) (_blShadows bl) $ w
pos = fst $ _wlLine bl
breakHitSound bl'
| _wlIsSeeThrough bl' = mkSoundBreakGlass pos
| otherwise = soundMultiFrom sos soundid 25 0
| otherwise = soundMultiFrom sos (fst $ _wlLine bl') (soundid + 4) Nothing
hitSound' bl'
| _wlIsSeeThrough bl' = mkSoundSplinterGlass pos
| otherwise = soundMultiFrom sos soundid 25 0
| otherwise = soundMultiFrom sos (fst $ _wlLine bl') soundid Nothing
sos = [BlockDegradeSound 0,BlockDegradeSound 1]
(soundid,_) = randomR (29,32) $ _randGen w
unshadow :: Int -> World -> World
src/Dodge/LevelGen/MoveDoor.hs
+1 -1
View File
@@ -65,7 +65,7 @@ addSoundToDoor i pld hwd (x:ys) = f x : ys
where
g dm w
| dist wp pld > 2 && dist wp hwd > 2
= soundFrom (WallSound i) doorSound 1 0 $ dm w
= soundFrom (WallSound i) wp doorSound (Just 1) $ dm w
| otherwise = dm w
where
wp = snd $ _wlLine (_walls w IM.! i)
src/Dodge/LevelGen/Switch.hs
+4 -6
View File
@@ -18,11 +18,7 @@ makeButton c eff = Button
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = \b w -> eff . over buttons (IM.adjust turnOn (_btID b))
-- . set (buttons . ix (_btID b) . btPict)
-- (onLayer WlLayer $ color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
-- . set (buttons . ix (_btID b) . btState) BtNoLabel
-- . set (buttons . ix (_btID b) . btEvent) (\b -> return)
. soundOnce 1 $ w
. soundFromGeneral (LeverSound 0) (btpos b) 1 Nothing $ w
, _btID = 0
, _btText = "Button"
--, _btText = "Button"
@@ -31,6 +27,7 @@ makeButton c eff = Button
where
turnOn bt = bt {_btState = BtNoLabel, _btPict = onPict, _btEvent = const id}
onPict = setLayer 0 $ onLayer WlLayer (color c $ polygon $ rectNSEW (-3) (-5) 10 (-10))
btpos b w' = _btPos $ _buttons w' IM.! _btID b
makeSwitch
:: Color
@@ -47,7 +44,8 @@ makeSwitch c effOn effOff = Button
, _btState = BtOff
}
where
flipSwitch b w = switchEffect b . soundOnce 1 $ w
flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) 1 Nothing $ w
bpos b w = _btPos $ _buttons w IM.! _btID b
switchEffect b = case _btState b of
BtOff -> effOn . over buttons (IM.adjust turnOn (_btID b))
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
src/Dodge/Particle/Bullet/HitEffect.hs
+6 -6
View File
@@ -35,7 +35,7 @@ bulHitCr bt p cr w
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
makeHitSound = soundMultiFrom [CrHitSound 0] p 15 (Just 10)
flashEff = over worldEvents (bloodFlashAt p . )
cid = _crID cr
(d1,_) = randomR (-0.7,0.7) $ _randGen w
@@ -53,7 +53,7 @@ bulBounceArmCr' bt p cr w
mvDams = [ PushDam 1 $ 2 *.* bulVel ]
addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
makeHitSound = soundMultiFrom [CrHitSound 0] p 15 (Just 10)
flashEff = over worldEvents ((.) $ bloodFlashAt p)
cid = _crID cr
newDir = safeNormalizeV (p -.- _crPos cr)
@@ -74,7 +74,7 @@ bulPenCr' bt p cr w
]
++
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ soundMultiFrom [CrHitSound 0] ep 15 (Just 10)
$ over worldEvents (addPiercer . )
w
where
@@ -98,7 +98,7 @@ hvBulHitCr bt p cr w
]
++
)
$ soundMultiFrom [CrHitSound 0] 15 10 0
$ soundMultiFrom [CrHitSound 0] ep 15 (Just 10)
w
where
(d1,_) = randomR (-0.7,0.7) $ _randGen w
@@ -110,7 +110,7 @@ bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
bulIncCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
( Piercing 60 sp p ep : )
$ soundMultiFrom [CrHitSound 0] 15 10 0
. soundMultiFrom [CrHitSound 0] p 15 (Just 10)
$ incFlamelets
w
where
@@ -124,7 +124,7 @@ bulConCr' :: Particle -> Point2 -> Creature -> World -> World
bulConCr' bt p cr w
= over (creatures . ix cid . crState . crDamage)
( Piercing 60 sp p ep : )
$ soundMultiFrom [CrHitSound 0] 15 10 0
. soundMultiFrom [CrHitSound 0] p 15 (Just 10)
$ mkwave
w
where
src/Dodge/SoundLogic.hs
+37 -82
View File
@@ -6,13 +6,10 @@ This module allows us to talk to the "Sound" module.
-}
module Dodge.SoundLogic (
-- * Manipulation of individual sounds
soundOnce
, soundOncePos
, soundOnceOrigin
, soundFromPos
soundOnceOrigin
, soundFrom
, soundFromGeneral
, soundMultiFrom
, soundMultiFromPos
, stopSoundFrom
-- * Manipulation of all sounds
@@ -41,20 +38,6 @@ pauseSound w = w
resumeSound :: World -> World
resumeSound w = w
{-| Add a sound to the queue for playback.
Consider replacing instances with 'soundOncePos'.
-}
soundOnce :: Int -> World -> World
soundOnce i = soundQueue %~ ((i,0) : )
{-| 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 = w & soundQueue %~ ((i,a) :)
where
a = soundAngle pos w
{-| Play a sound once, with a given origin.
For each origin only one sound will play at a time.
-}
@@ -69,7 +52,6 @@ soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSou
theSound = Sound
{ _soundChunkID = sType
, _soundTime = Nothing
, _soundFadeTime = 0
, _soundStatus = ToStart
, _soundChannel = Nothing
, _soundAngDist = Just (a,0)
@@ -78,28 +60,48 @@ soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSou
}
a = soundAngle p w
soundFromPos
soundFrom
:: 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
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundFrom so pos sType mtime w = over sounds (M.insertWith f so sound) w
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = Just time
, _soundTime = mtime
, _soundStatus = ToStart
, _soundFadeTime = fadeTime
, _soundChannel = Nothing
, _soundAngDist = Just (a,0)
, _soundPos = pos
, _soundVolume = soundVolID sType
}
f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
f _ s = s {_soundTime = mtime }
a = soundAngle pos w
soundFromGeneral
:: SoundOrigin -- ^ \"Creator\" of sound
-> (World -> Point2) -- ^ Position of sound
-> Int -- ^ ID of sound to be played
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
-> World
-> World
soundFromGeneral so fpos sType mtime w = over sounds (M.insertWith f so sound) w
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = mtime
, _soundStatus = ToStart
, _soundChannel = Nothing
, _soundAngDist = Just (a,0)
, _soundPos = fpos w
, _soundVolume = soundVolID sType
}
f _ s = s {_soundTime = mtime }
a = soundAngle (fpos w) w
{-| Calculates the angle of a sound with reference to '_cameraViewFrom'.
Within 10 units considers the sound to be directly in front.
-}
@@ -115,71 +117,24 @@ soundAngle p 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 = w & sounds %~ M.insertWith f so sound
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = Just time
, _soundStatus = ToStart
, _soundFadeTime = fadeTime
, _soundChannel = Nothing
, _soundAngDist = Nothing
, _soundPos = _cameraCenter w
, _soundVolume = soundVolID sType
}
f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
{-| 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
| otherwise = over sounds (M.insert so sound) w
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = Nothing
, _soundStatus = ToStart
, _soundFadeTime = fadeTime
, _soundChannel = Nothing
, _soundAngDist = Nothing
, _soundPos = _cameraCenter w
, _soundVolume = soundVolID sType
}
{-| Uses the first free origin from a list.
Does nothing if all origins are already creating sounds. -}
soundMultiFromPos
soundMultiFrom
:: [SoundOrigin]
-> Int -- ^ Sound ID
-> Int -- ^ Frames to play for
-> Int -- ^ Fade out time (ms)
-> Point2 -- ^ Position
-> Int -- ^ Sound ID
-> Maybe Int -- ^ Frames to play for, Nothing for full length
-> World
-> World
soundMultiFromPos [] _ _ _ _ w = w
soundMultiFromPos (so:sos) sType time fadeTime pos w
| so `M.member` _sounds w = soundMultiFromPos sos sType time fadeTime pos w
soundMultiFrom [] _ _ _ w = w
soundMultiFrom (so:sos) pos sType mtime w
| so `M.member` _sounds w = soundMultiFrom sos pos sType mtime w
| otherwise = over sounds (M.insert so sound) w
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = Nothing
, _soundTime = mtime
, _soundStatus = ToStart
, _soundFadeTime = fadeTime
, _soundChannel = Nothing
, _soundAngDist = Just (a,0)
, _soundPos = pos
src/Dodge/Update.hs
+2 -2
View File
@@ -117,7 +117,7 @@ updateTriggers w
cr = _creatures w IM.! 0 & crPos .~ V2 0 0
updateSoundQueue :: World -> World
updateSoundQueue = set soundQueue [] . set sounds M.empty
updateSoundQueue = set sounds M.empty
updateLightSources :: World -> World
updateLightSources w = set tempLightSources (catMaybes tlss) w'
@@ -195,7 +195,7 @@ updateCloud w c
oldPos2 = stripZ oldPos
newPos@(V3 _ _ npz) = oldPos +.+.+ newVel
newPos2 = stripZ newPos
hitWl = collideCircWalls' oldPos2 newPos2 5 $ wallsNearPoint newPos2 w
hitWl = collideCircWalls oldPos2 newPos2 5 $ wallsNearPoint newPos2 w
finalPos = addZ npz $ maybe newPos2 fst hitWl
finalVel = addZ nvz $ maybe newVel2 snd hitWl
src/Dodge/WorldEvent/Explosion.hs
+7 -3
View File
@@ -28,7 +28,9 @@ makePoisonExplosionAt
:: Point2 -- ^ Position
-> World
-> World
makePoisonExplosionAt p w = soundOncePos grenadeBang p $ foldr (makeGasCloud p) w vels
makePoisonExplosionAt p w
= soundMultiFrom [Explosion 0,Explosion 1] p grenadeBang Nothing
$ foldr (makeGasCloud p) w vels
where
vels = replicateM 25 (randInCirc 2) & evalState $ _randGen w
-- just change the number after replicateM to get more or less clouds
@@ -54,7 +56,9 @@ makeFlameExplosionAt
:: Point2 -- ^ Position
-> World
-> World
makeFlameExplosionAt p w = soundOncePos grenadeBang p $ over particles (newFlames ++ ) w
makeFlameExplosionAt p w
= soundMultiFrom [Explosion 0,Explosion 1] p grenadeBang Nothing
$ over particles (newFlames ++ ) w
where
newFlames = zipWith makeFlameWithVelAndTime velocities timers
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
@@ -68,7 +72,7 @@ makeExplosionAt
-> World
-> World
makeExplosionAt p w
= soundOncePos grenadeBang p
= soundMultiFrom [Explosion 0,Explosion 1] p grenadeBang Nothing
. addFlames
-- . explosionFlashAt p
. over tempLightSources (theTLS :)
src/Dodge/WorldEvent/SpawnParticle.hs
+1 -1
View File
@@ -97,7 +97,7 @@ moveFlame rotd w pt
_ -> (glare $ doSound damcrs , mvPt)
where
time = _btTimer' pt
doSound = soundFrom Flame fireSound 2 500 -- . over worldEvents ((.) $ flameGlareAt ep)
doSound = soundFrom Flame (V2 x y) fireSound (Just 2) -- . over worldEvents ((.) $ flameGlareAt ep)
glare
| time `mod` 5 == 0
= tempLightSources %~ (theTLS :)
src/Sound.hs
+5 -21
View File
@@ -55,7 +55,7 @@ playSoundAndUpdate sData oldSounds newSounds
mergeSound :: Sound -> Sound -> Sound
mergeSound oldS newS
| _soundChunkID newS == _soundChunkID oldS && _soundStatus oldS /= FadingOut
| _soundChunkID newS == _soundChunkID oldS
= newS & soundChannel .~ _soundChannel oldS
& soundStatus .~ _soundStatus oldS
| otherwise = newS & soundChannel .~ _soundChannel oldS
@@ -87,25 +87,18 @@ tryPlay sd s = do
& soundChannel ?~ i
& soundStatus .~ JustStartedPlaying
--repetitions :: Sound -> Mix.Times
--repetitions s = case _soundTime s of
-- Nothing -> Mix.Once
-- _ -> Mix.Forever
tryGetChannel :: Sound -> MaybeT IO Mix.Channel
tryGetChannel s = case _soundChannel s of
Just i -> return i
Nothing -> MaybeT $ Mix.getAvailable Mix.DefaultGroup
decrementTimer :: Sound -> IO Sound
decrementTimer s = case _soundTime s of
Just t
| t > 0 -> return $ s & soundTime ?~ t - 1
| otherwise -> fadeOutMaybe (_soundChannel s) (_soundFadeTime s)
>> return (s & soundTime .~ Nothing
& soundStatus .~ FadingOut)
| otherwise -> do
forM_ (_soundChannel s) Mix.halt
return $ s & soundTime .~ Nothing
Nothing -> return s
applyPosition :: Sound -> IO Sound
@@ -114,14 +107,6 @@ applyPosition s = case _soundAngDist s of
Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d
>> return (s & soundAngDist .~ Nothing)
fadeOutMaybe
:: Maybe Mix.Channel
-> Int -- ^ fade out time: UNUSED, Mix.fadeOut is buggy
-> IO ()
--fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
fadeOutMaybe (Just x) _ = Mix.halt x
fadeOutMaybe _ _ = return ()
cleanupHalted :: Sound -> MaybeT IO Sound
cleanupHalted s = do
i <- MaybeT $ return $ _soundChannel s
@@ -137,10 +122,10 @@ 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 -> 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 -> MaybeT IO Mix.Channel
playIfFree c times = do
i <- MaybeT $ Mix.getAvailable Mix.DefaultGroup
@@ -171,4 +156,3 @@ Behind the scenes, scales a float [0,1] to an Int [0..128].
-}
setMusicVolume :: Float -> IO ()
setMusicVolume x = Mix.setMusicVolume (round (x * 128))
src/Sound/Data.hs
-2
View File
@@ -12,7 +12,6 @@ import Data.Int (Int16)
data SoundStatus
= JustStartedPlaying
| Playing
| FadingOut
| ToStart
deriving (Eq,Ord,Show)
@@ -21,7 +20,6 @@ newtype SoundData = SoundData
}
data Sound = Sound
{ _soundTime :: Maybe Int
, _soundFadeTime :: Int
, _soundStatus :: SoundStatus
, _soundChannel :: Maybe Mix.Channel
, _soundAngDist :: Maybe (Int16,Word8)