Further implementation of poitional sound

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

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])

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
+  where 
-          itRef = _crInvSel cr
+    cr = _creatures w IM.! cid
-          item = _crInv cr IM.! itRef
+    itRef = _crInvSel cr
-          pointerToItem = creatures . ix cid . crInv . ix itRef
+    item = _crInv cr IM.! itRef
-          fState = _wpFireState item
+    pointerToItem = creatures . ix cid . crInv . ix itRef
-          fRate = _wpFireRate item
+    fState = _wpFireState item
-          reloadCondition = _wpLoadedAmmo item == 0
+    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

@@ -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

@@ -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
+    j = newProjectileKey w
-    pks = [p..]
+    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

@@ -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

@@ -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

@@ -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/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