159 lines
4.6 KiB
Haskell
159 lines
4.6 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
|
|
soundStart
|
|
, soundContinue
|
|
, 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.LoadSound
|
|
|
|
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
|
|
|
|
soundWithStatus
|
|
:: SoundStatus
|
|
-> SoundOrigin -- ^ \"Creator\" of sound
|
|
-> Point2 -- ^ Position of sound
|
|
-> SoundID -- ^ ID of sound to be played
|
|
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
|
-> World
|
|
-> World
|
|
soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = status
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = pos
|
|
, _soundVolume = soundToVol sType
|
|
}
|
|
f _ s = s {_soundTime = mtime }
|
|
a = soundAngle pos w
|
|
|
|
soundStart
|
|
:: SoundOrigin -- ^ \"Creator\" of sound
|
|
-> Point2 -- ^ Position of sound
|
|
-> SoundID -- ^ ID of sound to be played
|
|
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
|
-> World
|
|
-> World
|
|
soundStart = soundWithStatus ToStart
|
|
soundContinue
|
|
:: SoundOrigin -- ^ \"Creator\" of sound
|
|
-> Point2 -- ^ Position of sound
|
|
-> SoundID -- ^ ID of sound to be played
|
|
-> Maybe Int -- ^ Frames to play sound for, Nothing for until finished
|
|
-> World
|
|
-> World
|
|
soundContinue = soundWithStatus ToContinueStart
|
|
|
|
soundFromGeneral
|
|
:: SoundOrigin -- ^ \"Creator\" of sound
|
|
-> (World -> Point2) -- ^ Position of sound
|
|
-> SoundID -- ^ 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 toPlaySounds (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 = soundToVol 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
|
|
-> SoundID -- ^ Sound ID
|
|
-> Maybe Int -- ^ Frames to play for, Nothing for full length
|
|
-> World
|
|
-> World
|
|
soundMultiFrom [] _ _ _ w = w
|
|
soundMultiFrom [so] pos sType mtime w
|
|
= over toPlaySounds (M.insert so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = pos
|
|
, _soundVolume = soundToVol sType
|
|
}
|
|
a = soundAngle pos w
|
|
soundMultiFrom (so:sos) pos sType mtime w
|
|
| so `M.member` _playingSounds w = soundMultiFrom sos pos sType mtime w
|
|
| otherwise = over toPlaySounds (M.insert so sound) w
|
|
where
|
|
sound = Sound
|
|
{ _soundChunkID = sType
|
|
, _soundTime = mtime
|
|
, _soundStatus = ToStart
|
|
, _soundChannel = Nothing
|
|
, _soundAngDist = Just (a,0)
|
|
, _soundPos = pos
|
|
, _soundVolume = soundToVol sType
|
|
}
|
|
a = soundAngle pos w
|
|
{- | Sets '_soundTime' to 0. -}
|
|
stopSoundFrom :: SoundOrigin -> World -> World
|
|
stopSoundFrom so = over (playingSounds . ix so . soundTime) (fmap $ min 0)
|
|
|