Files
loop/src/Dodge/SoundLogic.hs
T

185 lines
5.0 KiB
Haskell

{-|
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
, module Dodge.SoundLogic.Synonyms
) where
import Dodge.Data
import Dodge.SoundLogic.Synonyms
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.
Consider replacing instances with 'soundOncePos'.
-}
soundOnce :: Int -> World -> World
soundOnce i = 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 = w & soundQueue %~ ((i,a) :)
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
-> Point2 -- ^ The position of the sound in the world
-> World -> World
soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSound
where
theSound = Sound
{ _soundChunkID = sType
, _soundTime = Nothing
, _soundFadeTime = 0
, _soundStatus = ToStart
, _soundChannel = Nothing
, _soundPos = Just (a,0)
}
a = soundAngle p w
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 = sounds %~ M.insertWith f so sound
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.
TODO: add positional information.
-}
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)