loop/src/Dodge/SoundLogic.hs

{-|
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 = soundAngle pos w

{-| 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 
        { _soundChunkID     = sType
        , _soundTime        = Nothing
        , _soundFadeTime    = 0
        , _soundStatus      = ToStart
        , _soundChannel     = Nothing
        , _soundPos         = Nothing
        }

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 
        { _soundChunkID     = sType
        , _soundTime        = Just time
        , _soundStatus      = ToStart
        , _soundFadeTime    = fadeTime
        , _soundChannel     = Nothing
        , _soundPos         = Just (a,0)
        }
    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
    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 (p -.- earPos)) - _cameraRot w
  where
    earPos = _cameraViewFrom w

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 
        { _soundChunkID     = sType
        , _soundTime        = Just time
        , _soundStatus      = ToStart
        , _soundFadeTime    = fadeTime
        , _soundChannel     = Nothing
        , _soundPos         = Nothing
        }
    f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}

{-| 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
    | otherwise = over sounds (M.insert so sound) w
  where 
    sound = Sound 
        { _soundChunkID     = sType
        , _soundTime        = Nothing
        , _soundStatus      = ToStart
        , _soundFadeTime    = fadeTime
        , _soundChannel     = Nothing
        , _soundPos         = Nothing
        }

{- | Sets '_soundTime' to 0.
 -}
stopSoundFrom :: SoundOrigin -> World -> World
stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)

reloadSound,putDownSound,pickUpSound,fireSound,grenadeBang,healSound,teleSound,twoStepSlowSound :: Int
clickSound = 1
reloadSound = 2
pickUpSound  = 4
putDownSound = 5
fireSound    = 6
grenadeBang = 7
tapQuiet = 8
twoStepSound = 9
healSound = 10
doorSound = 11
twoStepSlowSound = 12
knifeSound = 13
buzzSound = 14
hitSound = 15
autoGunSound = 16
shotgunSound = 17
teleSound = 18
longGunSound = 19
launcherSound = 20
smokeTrailSound = 21
foot1Sound = 22
foot2Sound = 23