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 Dodge.Data
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)
import Data.Maybe

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

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

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

soundWithStatusVolume
    :: Float        -- ^ Volume factor, 0 - 1
    -> PlayStatus
    -> 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
soundWithStatusVolume vol status so pos sType mtime w = over toPlaySounds (M.insertWith f so sound) w
  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
    -> 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 = soundWithStatusVolume 1

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

-- this needs to all be cleaned up, moved to general sounds
soundContinueVol
    :: Float        -- ^ volume
    -> 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
soundContinueVol vol = soundWithStatusVolume vol 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      = 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)) - _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      = 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 = over (playingSounds . ix so . soundTime) (fmap $ min 0)