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

Further implementation of poitional sound

Browse Source
This commit is contained in:
jgk
2021-04-06 19:19:23 +02:00
parent 48ef0c0088
commit 47ac104520
9 changed files with 44 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+2 -2
View File
@@ -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
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/TriggerType.hs
+17 -10
View File
@@ -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
src/Dodge/SoundLogic.hs
+11 -2
View File
@@ -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)
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/Preload.hs
+1 -1
View File
@@ -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)
src/Preload/Data.hs
+1 -1
View File
@@ -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
src/Sound.hs
+1 -1
View File
@@ -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
src/Sound/Preload.hs → src/Sound/Data.hs
+1 -1
View File
@@ -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