Files
loop/src/Dodge/SoundLogic.hs
T
2025-08-19 17:29:36 +01:00

224 lines
5.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,
soundContinueVol,
soundMultiFrom,
stopSoundFrom,
-- soundWithStatus,
-- * helper to determine the angle of a sound given a world position
soundAngle,
-- * Manipulation of all sounds
haltSound,
resumeSound,
pauseSound,
module Dodge.SoundLogic.LoadSound,
) where
import Control.Lens
import Data.Int (Int16)
import qualified Data.Map as M
import Data.Maybe
import Dodge.Data.Universe
import Dodge.SoundLogic.LoadSound
import Geometry.Data
import Geometry.Vector
import Sound.Data
import SDL.Mixer as Mix
-- | Placeholder...
haltSound :: World -> World
haltSound = id
-- | Placeholder...
pauseSound :: Universe -> Universe
pauseSound = uvIOEffects %~ \f u -> do
Mix.pause (-1)
f u
-- | Placeholder...
resumeSound :: Universe -> Universe
resumeSound = uvIOEffects %~ \f u -> do
Mix.resume (-1)
f u
soundWithStatusVolume ::
-- | Volume factor, 0 - 1
Float ->
PlayStatus ->
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundWithStatusVolume vol status so fpos sType mtime w =
w & toPlaySounds
%~ M.insert
so
(aSound vol status fpos sType mtime w)
aSound ::
-- | Volume factor, 0 - 1
Float ->
PlayStatus ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
Sound
aSound vol status fpos sType mtime w =
Sound
{ _soundChunkID = sType
, _soundTime = mtime
, _soundStatus =
SoundStatus
{ _playStatus = status
, _soundIsLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, floor (225 * (1 - vol)))
, _soundPos = fpos
, _soundVolume = soundToVol sType * vol
, _soundVolumeFraction = vol
}
where
a = soundAngle fpos w
soundWithStatus ::
PlayStatus ->
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundWithStatus = soundWithStatusVolume 1
soundStart ::
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundStart = soundWithStatus ToStart
soundContinue ::
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundContinue = soundWithStatus ToContinueStart
-- this needs to all be cleaned up, moved to general sounds
soundContinueVol ::
-- | volume
Float ->
-- | \"Creator\" of sound
SoundOrigin ->
-- | Position of sound
Point2 ->
-- | ID of sound to be played
SoundID ->
-- | Frames to play sound for, Nothing for until finished
Maybe Int ->
World ->
World
soundContinueVol vol = soundWithStatusVolume vol ToContinueStart
{- | 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
| d < 10 = 0
| otherwise =
round
. radToDeg
. f
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - (w ^. wCam . camRot)
where
earPos = w ^. wCam . camViewFrom
d = dist p earPos
-- the following should soften the positional effect
-- when you are close to the sound source
f x | x < pi / 2 = x * dfact
| x < 3 * pi / 2 = pi + (dfact * (x - pi))
| otherwise = 2*pi + (dfact * (x - 2*pi))
dfact = min ((d - 10) / 100) 1
{- | Uses the first free origin from a list.
Does nothing if all origins are already creating sounds.
-}
soundMultiFrom ::
[SoundOrigin] ->
-- | Position
Point2 ->
-- | Sound ID
SoundID ->
-- | Frames to play for, Nothing for full length
Maybe Int ->
World ->
World
soundMultiFrom [] _ _ _ w = 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 =
SoundStatus
{ _playStatus = ToStart
, _soundIsLooping = isJust mtime
}
, _soundChannel = Nothing
, _soundAngDist = Just (a, 0)
, _soundPos = pos
, _soundVolume = soundToVol sType
, _soundVolumeFraction = 1
}
a = soundAngle pos w
-- | Sets '_soundTime' to 0.
stopSoundFrom :: SoundOrigin -> World -> World
stopSoundFrom so = playingSounds . ix so . soundTime ?~ 0
--stopSoundFrom so = over (playingSounds . ix so . soundTime) (fmap $ min 0)