150 lines
4.3 KiB
Haskell
150 lines
4.3 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
|
|
soundOnceOrigin
|
|
, soundFrom
|
|
, soundFromGeneral
|
|
, soundMultiFrom
|
|
, stopSoundFrom
|
|
|
|
-- * Manipulation of all sounds
|
|
, haltSound
|
|
, resumeSound
|
|
, pauseSound
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Sound.Data
|
|
import Geometry.Data
|
|
import Geometry.Vector
|
|
import Dodge.SoundLogic.Synonyms
|
|
|
|
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
|
|
|
|
{-| 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
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = p
|
|
, _soundVolume = soundVolID sType
|
|
}
|
|
a = soundAngle p w
|
|
|
|
soundFrom
|
|
:: SoundOrigin -- ^ \"Creator\" of sound
|
|
-> Point2 -- ^ Position of sound
|
|
-> Int -- ^ ID of sound to be played
|
|
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
|
-> World
|
|
-> World
|
|
soundFrom so pos sType mtime w = over sounds (M.insertWith f so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = pos
|
|
, _soundVolume = soundVolID sType
|
|
}
|
|
f _ s = s {_soundTime = mtime }
|
|
a = soundAngle pos w
|
|
|
|
soundFromGeneral
|
|
:: SoundOrigin -- ^ \"Creator\" of sound
|
|
-> (World -> Point2) -- ^ Position of sound
|
|
-> Int -- ^ ID of sound to be played
|
|
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
|
-> World
|
|
-> World
|
|
soundFromGeneral so fpos sType mtime w = over sounds (M.insertWith f so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = fpos w
|
|
, _soundVolume = soundVolID sType
|
|
}
|
|
f _ s = s {_soundTime = mtime }
|
|
a = soundAngle (fpos w) 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
|
|
|
|
{-| Uses the first free origin from a list.
|
|
Does nothing if all origins are already creating sounds. -}
|
|
soundMultiFrom
|
|
:: [SoundOrigin]
|
|
-> Point2 -- ^ Position
|
|
-> Int -- ^ Sound ID
|
|
-> Maybe Int -- ^ Frames to play for, Nothing for full length
|
|
-> World
|
|
-> World
|
|
soundMultiFrom [] _ _ _ w = w
|
|
soundMultiFrom (so:sos) pos sType mtime w
|
|
| so `M.member` _sounds w = soundMultiFrom sos pos sType mtime w
|
|
| otherwise = over sounds (M.insert so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = pos
|
|
, _soundVolume = soundVolID sType
|
|
}
|
|
a = soundAngle pos w
|
|
{- | Sets '_soundTime' to 0. -}
|
|
stopSoundFrom :: SoundOrigin -> World -> World
|
|
stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)
|
|
|