From 70c97f5367c19abcb0964ba24e378029d9e52c58 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 9 Sep 2021 14:58:07 +0100 Subject: [PATCH] Refactor sounds --- appDodge/Main.hs | 2 +- src/Dodge/Base.hs | 4 +- src/Dodge/Creature/Action.hs | 11 ++- src/Dodge/Creature/Impulse.hs | 11 +-- src/Dodge/Creature/State.hs | 6 +- src/Dodge/Creature/State/WalkCycle.hs | 2 +- src/Dodge/Data.hs | 2 - src/Dodge/Data/SoundOrigin.hs | 4 + src/Dodge/Default.hs | 2 +- src/Dodge/Default/World.hs | 1 - src/Dodge/Initialisation.hs | 4 +- src/Dodge/Item/Consumable.hs | 5 +- src/Dodge/Item/Weapon.hs | 12 +-- src/Dodge/Item/Weapon/Grenade.hs | 4 +- src/Dodge/Item/Weapon/Launcher.hs | 4 +- src/Dodge/Item/Weapon/TriggerType.hs | 10 ++- src/Dodge/LevelGen/Block.hs | 4 +- src/Dodge/LevelGen/MoveDoor.hs | 2 +- src/Dodge/LevelGen/Switch.hs | 10 +-- src/Dodge/Particle/Bullet/HitEffect.hs | 12 +-- src/Dodge/SoundLogic.hs | 119 ++++++++----------------- src/Dodge/Update.hs | 4 +- src/Dodge/WorldEvent/Explosion.hs | 10 ++- src/Dodge/WorldEvent/SpawnParticle.hs | 2 +- src/Sound.hs | 26 ++---- src/Sound/Data.hs | 2 - 26 files changed, 113 insertions(+), 162 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 57372089f..63109ae8e 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -61,7 +61,7 @@ doSideEffects :: World -> IO World doSideEffects w = do let preData = _preloadData w void $ doDrawing (_renderData preData) w - playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) + --playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w) newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_sounds w) w' <- _sideEffects w w diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 5317ef6c0..10b476fb7 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -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 diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 6ecdeb5aa..049b586ad 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -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 diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index 86846ce30..3a95fbae6 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -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 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 59c2e0541..c396bbe7c 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -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 diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index d7bb77f14..c716bb4ea 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -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] diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 9d4ff1575..c1abf0a80 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Data/SoundOrigin.hs b/src/Dodge/Data/SoundOrigin.hs index 0fc6f2acb..ab80da764 100644 --- a/src/Dodge/Data/SoundOrigin.hs +++ b/src/Dodge/Data/SoundOrigin.hs @@ -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) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c26ff20d4..3f89dfc2f 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 804e6a5c8..bcd347977 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -48,7 +48,6 @@ defaultWorld = World , _worldEvents = id , _pressPlates = IM.empty , _buttons = IM.empty - , _soundQueue = [] , _sounds = M.empty , _playingSounds = M.empty , _corpses = IM.empty diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index e8947446a..244277dd4 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -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 diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs index 2a42cbe94..be229ae7f 100644 --- a/src/Dodge/Item/Consumable.hs +++ b/src/Dodge/Item/Consumable.hs @@ -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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index d72928514..81cf8f586 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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) diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index 7bb737248..11f125d09 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index 134bff237..6175ffd7e 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5ec85e812..36e2e4df7 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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 diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index 850c0718a..fe0b8a1fc 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -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 diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs index 31dc2ebbc..b98af5362 100644 --- a/src/Dodge/LevelGen/MoveDoor.hs +++ b/src/Dodge/LevelGen/MoveDoor.hs @@ -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) diff --git a/src/Dodge/LevelGen/Switch.hs b/src/Dodge/LevelGen/Switch.hs index b3e72290b..05ead9d10 100644 --- a/src/Dodge/LevelGen/Switch.hs +++ b/src/Dodge/LevelGen/Switch.hs @@ -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)) diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index d7b907434..c2c8ea3b4 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 33442d033..6a0215310 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index b2db155c4..e9f2144ed 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 5131b276f..11e616124 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -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 :) diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 5aaadab12..302a4469e 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -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 :) diff --git a/src/Sound.hs b/src/Sound.hs index 20fc9d09c..9d8690f82 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -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)) - diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index d515344d6..3b9fd70d3 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -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)