From 7801920fd29eb3b219b7ec7708b05f0faee0acec Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Tue, 6 Apr 2021 15:46:49 +0200
Subject: [PATCH] Add support for directional sound

---
 src/Dodge/Item/Weapon.hs |  2 +-
 src/Dodge/SoundLogic.hs  | 19 +++++++++++++++++++
 src/Sound.hs             | 10 +++++++++-
 src/Sound/Preload.hs     |  4 +++-
 4 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs
index 08a3ba7a4..f4c9bf074 100644
--- a/src/Dodge/Item/Weapon.hs
+++ b/src/Dodge/Item/Weapon.hs
@@ -810,7 +810,7 @@ moveShell time i cid rot accel w
                    $ set (projectiles . ix i . pjUpdate) 
                              (moveShell (time-1) i cid rot (rotateV rot accel))
                    $ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
-                   $ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
+                   $ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
                    $ makeFlameletTimed oldPos 
                          (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
                    $ smokeGen
diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs
index a0d633eda..fa1b0578e 100644
--- a/src/Dodge/SoundLogic.hs
+++ b/src/Dodge/SoundLogic.hs
@@ -1,6 +1,7 @@
 module Dodge.SoundLogic where
 import Dodge.Data
 import Sound.Preload (SoundStatus (..))
+import Geometry.Vector
 
 import Control.Lens
 import qualified Data.Map as M
@@ -29,6 +30,24 @@ soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
         , _soundPos         = Nothing
         }
 
+soundFromPos :: SoundOrigin -> Point2 -> Int -> Int -> Int -> World -> World
+soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound) w
+  where 
+    sound = Sound 
+        { _soundChunkID     = sType
+        , _soundTime        = Just time
+        , _soundStatus      = ToStart
+        , _soundFadeTime    = fadeTime
+        , _soundChannel     = Nothing
+        , _soundPos         = Just (a,0)
+        }
+    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
+    a = round 
+      . radToDeg 
+      . normalizeAngle 
+      . (+ pi)
+      $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w
+
 soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
 soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
   where 
diff --git a/src/Sound.hs b/src/Sound.hs
index f158043a2..76ea03369 100644
--- a/src/Sound.hs
+++ b/src/Sound.hs
@@ -63,7 +63,9 @@ updateSounds sd ss = do
 
 updateSound :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
 updateSound sd s =
-    initialisePlaying sd s >>= liftIO . decrementTimer >>= cleanupHalted
+    initialisePlaying sd s 
+    >>= liftIO . (decrementTimer >=> applyPosition) 
+    >>= cleanupHalted
 
 initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
 initialisePlaying sd s = case _soundStatus s of
@@ -98,6 +100,12 @@ decrementTimer s = case _soundTime s of
                                          & soundStatus .~ FadingOut)
     Nothing -> return s
 
+applyPosition :: Sound -> IO Sound
+applyPosition s = case _soundPos s of
+    Nothing     -> return s
+    Just (a,d)  -> Mix.effectPosition (fromJust $ _soundChannel s) a d
+                    >> return (s & soundPos .~ Nothing)
+
 fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
 fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
 fadeOutMaybe _ _ = return ()
diff --git a/src/Sound/Preload.hs b/src/Sound/Preload.hs
index 7ba4d541c..42ae04603 100644
--- a/src/Sound/Preload.hs
+++ b/src/Sound/Preload.hs
@@ -6,6 +6,8 @@ import qualified Data.IntMap as IM
 import qualified Data.Map as M
 import Control.Lens
 import Geometry
+import Data.Word (Word8)
+import Data.Int (Int16)
 
 data SoundStatus 
     = Playing
@@ -22,7 +24,7 @@ data Sound = Sound
     , _soundFadeTime    :: Int
     , _soundStatus      :: SoundStatus
     , _soundChannel     :: Maybe Mix.Channel
-    , _soundPos         :: Maybe Point2
+    , _soundPos         :: Maybe (Int16,Word8)
     , _soundChunkID     :: Int
     }
   deriving (Eq,Ord,Show)