Tweak sound positions

src/Dodge/SoundLogic.hs

@@ -1,33 +1,89 @@
-module Dodge.SoundLogic where
+{-|
+Module      : Dodge.SoundLogic
+Description : Messages to "Sound" backend
+
+This module allows us to talk to the "Sound" module.
+-}
+module Dodge.SoundLogic (
+    -- * Manipulation of individual sounds
+      soundOnce
+    , soundOncePos
+    , soundOnceOrigin
+    , soundFromPos
+    , soundFrom
+    , soundMultiFrom
+    , stopSoundFrom
+
+    -- * Manipulation of all sounds
+    , haltSound
+    , resumeSound
+    , pauseSound
+
+    -- * Synonyms for sound identifiers
+    , clickSound 
+    , reloadSound 
+    , pickUpSound  
+    , putDownSound 
+    , fireSound    
+    , grenadeBang 
+    , tapQuiet 
+    , twoStepSound 
+    , healSound 
+    , doorSound 
+    , twoStepSlowSound 
+    , knifeSound 
+    , buzzSound 
+    , hitSound 
+    , autoGunSound 
+    , shotgunSound 
+    , teleSound 
+    , longGunSound 
+    , launcherSound 
+    , smokeTrailSound 
+    , foot1Sound 
+    , foot2Sound 
+    ) where
 import Dodge.Data
 import Sound.Data (SoundStatus (..))
 import Geometry.Vector
+import Geometry (dist)
 
 import Control.Lens
 import qualified Data.Map as M
+import Data.Int (Int16)
 
+{-| Placeholder...-}
 haltSound :: World -> World
 haltSound w = w
 
+{-| Placeholder...-}
 pauseSound :: World -> World
 pauseSound w = w
 
+{-| Placeholder...-}
 resumeSound :: World -> World
 resumeSound w = w
 
+{-| Add a sound to the queue for playback.
+ -}
 soundOnce :: Int -> World -> World
 soundOnce i = over 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 = over soundQueue ((:) (i,a)) w
   where
-    a = round 
-      . radToDeg 
-      . normalizeAngle 
-      . (+ pi)
-      $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w
+    a = soundAngle pos w
 
-soundOnceOrigin :: Int -> SoundOrigin -> World -> World
+{-| Play a sound once, with a given origin.
+For each origin only one sound will play at a time.
+-}
+soundOnceOrigin 
+    :: Int          -- ^ ID of the sound to be played
+    -> SoundOrigin  -- ^ The \"creator\" of the sound
+    -> World -> World
 soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
   where 
     sound = Sound 
@@ -39,7 +95,13 @@ soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
         , _soundPos         = Nothing
         }
 
-soundFromPos :: SoundOrigin -> Point2 -> Int -> Int -> Int -> World -> World
+soundFromPos 
+    :: 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
   where 
     sound = Sound 
@@ -51,13 +113,29 @@ soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound
         , _soundPos         = Just (a,0)
         }
     f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
-    a = round 
+    a = soundAngle pos w
+
+{-| Calculates the angle of a sound with reference to '_cameraViewFrom'.
+Within 10 units considers the sound to be directly in front.
+-}
+soundAngle :: Point2 -> World -> Int16
+{-# INLINE soundAngle #-}
+soundAngle p w
+    | dist p earPos < 10 = 0
+    | otherwise = round 
       . radToDeg 
       . normalizeAngle 
       . (+ pi)
-      $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w
+      $ argV (vNormal (p -.- earPos)) - _cameraRot w
+  where
+    earPos = _cameraViewFrom w
 
-soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
+soundFrom 
+    :: SoundOrigin 
+    -> Int -- ^ Sound ID
+    -> Int -- ^ Frames to play
+    -> Int -- ^ Fade out time (ms)
+    -> World -> World
 soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
   where 
     sound = Sound 
@@ -70,7 +148,15 @@ soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
         }
     f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
 
-soundMultiFrom :: [SoundOrigin] -> Int -> Int -> Int -> World -> World
+{-| Uses the first free origin from a list.
+Does nothing if all origins are already creating sounds.
+-}
+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
@@ -85,7 +171,8 @@ soundMultiFrom (so:sos) sType time fadeTime w
         , _soundPos         = Nothing
         }
 
-
+{- | Sets '_soundTime' to 0.
+ -}
 stopSoundFrom :: SoundOrigin -> World -> World
 stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)