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
    soundStart,
    soundContinue,
    soundContinueVol,
    soundFromGeneral,
    soundMultiFrom,
    stopSoundFrom,

    -- * 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

-- | Placeholder...
haltSound :: World -> World
haltSound w = w

-- | Placeholder...
pauseSound :: World -> World
pauseSound w = w

-- | Placeholder...
resumeSound :: Universe -> Universe
resumeSound w = w

soundWithStatusVolumeGeneral ::
    -- | Volume factor, 0 - 1
    Float ->
    PlayStatus ->
    -- | \"Creator\" of sound
    SoundOrigin ->
    -- | Position of sound
    (World -> Point2) ->
    -- | ID of sound to be played
    SoundID ->
    -- | Frames to play sound for, Nothing for until finished
    Maybe Int ->
    World ->
    World
soundWithStatusVolumeGeneral vol status so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
  where
    sound =
        Sound
            { _soundChunkID = sType
            , _soundTime = mtime
            , _soundStatus =
                SoundStatus
                    { _playStatus = status
                    , _isLooping = isJust mtime
                    }
            , _soundChannel = Nothing
            , _soundAngDist = Just (a, floor (225 * (1 - vol)))
            , _soundPos = fpos w
            , _soundVolume = soundToVol sType * vol
            , _soundVolumeFraction = vol
            }
    f _ s = s{_soundTime = mtime}
    a = soundAngle (fpos w) w

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 pos = soundWithStatusVolumeGeneral vol status so (const pos)

--soundWithStatusVolume vol status so pos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
--  where
--    sound = Sound
--        { _soundChunkID     = sType
--        , _soundTime        = mtime
--        , _soundStatus      = SoundStatus
--            {_playStatus = status
--            ,_isLooping  = isJust mtime
--            }
--        , _soundChannel     = Nothing
--        , _soundAngDist     = Just (a,floor (225 * (1 - vol)))
--        , _soundPos         = pos
--        , _soundVolume      = soundToVol sType * vol
--        , _soundVolumeFraction = vol
--        }
--    f _ s = s {_soundTime = mtime }
--    a = soundAngle pos 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

soundFromGeneral ::
    -- | \"Creator\" of sound
    SoundOrigin ->
    -- | Position of sound
    (World -> Point2) ->
    -- | ID of sound to be played
    SoundID ->
    -- | Frames to play sound for, Nothing for until finished
    Maybe Int ->
    World ->
    World
soundFromGeneral = soundWithStatusVolumeGeneral 1 ToStart

--soundFromGeneral so fpos sType mtime w = w & toPlaySounds %~ M.insertWith f so sound
--  where
--    sound = Sound
--        { _soundChunkID     = sType
--        , _soundTime        = mtime
--        , _soundStatus      = SoundStatus
--            { _playStatus = ToStart
--            , _isLooping  = isJust mtime
--            }
--        , _soundChannel     = Nothing
--        , _soundAngDist     = Just (a,0)
--        , _soundPos         = fpos w
--        , _soundVolume      = soundToVol sType
--        , _soundVolumeFraction = 1
--        }
--    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)) - (w ^. cWorld . camPos . camRot)
  where
    earPos = w ^. cWorld . camPos . camViewFrom

{- | 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] pos sType mtime w
--    = over toPlaySounds (M.insert so sound) w
--  where
--    sound = Sound
--        { _soundChunkID     = sType
--        , _soundTime        = mtime
--        , _soundStatus      = SoundStatus
--            { _playStatus = ToStart
--            , _isLooping  = isJust mtime
--            }
--        , _soundChannel     = Nothing
--        , _soundAngDist     = Just (a,0)
--        , _soundPos         = pos
--        , _soundVolume      = soundToVol sType
--        , _soundVolumeFraction     = 1
--        }
--    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 =
                SoundStatus
                    { _playStatus = ToStart
                    , _isLooping = 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)