From 47ac10452092941420f517dbadcd748ae5981e28 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 19:19:23 +0200 Subject: [PATCH] Further implementation of poitional sound --- app/Main.hs | 4 ++-- src/Dodge/Data.hs | 6 ++++-- src/Dodge/Item/Weapon/TriggerType.hs | 27 +++++++++++++++++---------- src/Dodge/SoundLogic.hs | 13 +++++++++++-- src/Dodge/WorldEvent/Explosion.hs | 12 ++++++------ src/Preload.hs | 2 +- src/Preload/Data.hs | 2 +- src/Sound.hs | 2 +- src/Sound/{Preload.hs => Data.hs} | 2 +- 9 files changed, 44 insertions(+), 26 deletions(-) rename src/Sound/{Preload.hs => Data.hs} (97%) diff --git a/app/Main.hs b/app/Main.hs index 783540bc9..3d050df53 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,7 +19,7 @@ import Picture.Render import Picture.Preload import Sound import Preload -import Sound.Preload +import Sound.Data import Music import Control.Concurrent @@ -63,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/src/Dodge/Data.hs b/src/Dodge/Data.hs index fe2405e54..3d42315e7 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/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5b2a789d5..3883d8827 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -45,7 +45,7 @@ withWarmUp t f cid w w | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 - $ soundFrom (CrWeaponSound cid) 26 1 0 + $ continueSound 26 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 @@ -54,18 +54,25 @@ withWarmUp t f cid w $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) 2 $ f cid - $ soundFrom (CrWeaponSound cid) 28 2 0 + $ continueSound 28 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 + continueSound soundID + | cid == 0 = soundFrom (CrWeaponSound cid) soundID 1 0 + | otherwise = soundFromPos (CrWeaponSound cid) (_crPos cr) soundID 1 0 withSound :: Int -> (Int -> World -> World) -> Int -> World -> World -withSound soundid f cid = soundOnce soundid . f cid +withSound soundid f 0 w = (soundOnce soundid . f 0) w +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/SoundLogic.hs b/src/Dodge/SoundLogic.hs index fa1b0578e..e25bd79e0 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -1,6 +1,6 @@ module Dodge.SoundLogic where import Dodge.Data -import Sound.Preload (SoundStatus (..)) +import Sound.Data (SoundStatus (..)) import Geometry.Vector import Control.Lens @@ -16,7 +16,16 @@ resumeSound :: World -> World resumeSound w = w soundOnce :: Int -> World -> World -soundOnce i = over soundQueue ((:) i) +soundOnce i = over soundQueue ((:) (i,0)) + +soundOncePos :: Int -> Point2 -> World -> World +soundOncePos i pos w = over soundQueue ((:) (i,a)) w + where + a = round + . radToDeg + . normalizeAngle + . (+ pi) + $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w soundOnceOrigin :: Int -> SoundOrigin -> World -> World soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) 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/Preload.hs b/src/Preload.hs index 45d516008..e642f3e64 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -8,7 +8,7 @@ import Preload.Data import Preload.Update import Picture.Preload -import Sound.Preload +import Sound.Data import Control.Lens import GHC.Word (Word32) diff --git a/src/Preload/Data.hs b/src/Preload/Data.hs index ad753939b..3df492e65 100644 --- a/src/Preload/Data.hs +++ b/src/Preload/Data.hs @@ -5,7 +5,7 @@ import Control.Lens import GHC.Word (Word32) import Picture.Preload -import Sound.Preload +import Sound.Data import Music data PreloadData a = PreloadData diff --git a/src/Sound.hs b/src/Sound.hs index dcb61df61..d22d67254 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -15,7 +15,7 @@ module Sound ( -- * Complex Playback , playAndUpdate ) where -import Sound.Preload +import Sound.Data import qualified SDL.Mixer as Mix import Data.Maybe diff --git a/src/Sound/Preload.hs b/src/Sound/Data.hs similarity index 97% rename from src/Sound/Preload.hs rename to src/Sound/Data.hs index 42ae04603..758a0cc7b 100644 --- a/src/Sound/Preload.hs +++ b/src/Sound/Data.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -module Sound.Preload +module Sound.Data where import qualified SDL.Mixer as Mix import qualified Data.IntMap as IM