edge-0.9.1.0: Animation.hs

{-|
Module      : Animation
Description : Classes for animation objects and sound processing functions
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com
-}

module Animation where

import Prelude (Maybe(..), IO, ($), return, (>>=), (.), negate, (-), String, Float, Bool(..))
import Graphics.Gloss.Data.Picture (Picture(..))
import Data.WrapAround (WP, vectorRelation, WM, WP)
import Sound.ALUT (DistanceModel(InverseDistanceClamped), Source, ($=), play, stop, genObjectNames, buffer, sourcePosition, Vertex3(..), sourceRelative, referenceDistance, rolloffFactor, sourceGain, SourceRelative(..))
import GHC.Float ( double2Float )
import Data.Maybe (isNothing, fromJust)

import ResourceTracker
import Common
import Math
import Moving

class Animation a where
  image :: a -> Time -> Picture

class Audible a where
  processAudio :: a -> WP -> IO a
  terminateAudio :: a -> IO a

{-
  Note to self: I need to terminateAudio for the purpose of stopping sound
  from Audible objects before they vanish (e.g., before a level change).
  However, I am also concerned about the fact that the Sound.OpenAL API
  doesn't seem to have any call for destroying a Source. I wonder if this is
  handled automatically somehow, if I this will lead to a memory leak, with
  Source objects accumulating in whatever system stores them.
-}

audioReferenceDistance = 300.0 :: Float

audioRolloffFactor = 3.0 :: Float

audioDistanceModel = InverseDistanceClamped

handSndSrc
  :: a -- ^ the object
  -> (a -> Bool) -- ^ func which checks if sound queued to play
  -> (a -> Maybe Source) -- ^ func which retrieves source from object
  -> (a -> a) -- ^ func which unqueues shot sound
  -> (a -> RT) -- ^ func which gets resource tracker
  -> String -- ^ name of sound file
  -> (a -> Source -> a) -- ^ func which sets source in object
  -> WP -- ^ listener center point
  -> WM -- ^ wrap map shared between listener and object
  -> (a -> WP) -- ^ func which receives center point of object
  -> IO a

-- |Abstraction for playing a sound source when queued.
handSndSrc a f h i k e l m n q
  = do if f a then g a else return a
  where g b = do case h b of
                   Just x -> do sourcePosition x $= (Vertex3 (double2Float u)
                                                             (double2Float (-v)) 0)
                                play [x]
                                return (i b)
                   Nothing -> do j b >>= g
        j d = do [c] <- genObjectNames 1
                 buffer c $= getSound (k d) e
                 referenceDistance c $= audioReferenceDistance
                 return (l d c)
        (u, v) = vectorRelation n m (q a)

-- |Abstraction for terminating a sound source in an object.
termSndSrc
  :: a -- ^ the object
  -> (a -> Maybe Source) -- ^ func which retrieves source from object
  -> IO a
termSndSrc a f = case f a of
                   Nothing -> return a
                   Just x -> do stop [x]
                                return a

-- |The angle of many images have to be rotated because of differing ideas
-- of angle orientation between my code and the gloss framework
reorient a b = Rotate ((double2Float . negate . radToDeg) a - 90) b

procOneTimeSnd
  :: (Locatable a)
  => a -- ^ object
  -> (a -> Maybe Source) -- ^ func that retrieves Source from object
  -> WP -- ^ listener's center
  -> (a -> RT) -- ^ func that retrieves object's resource tracker
  -> String -- ^ name of sound file
  -> Float -- ^ source gain
  -> (a -> WM) -- ^ func that retrieves object's wrap map
  -> (a -> Maybe Source -> a) -- ^ func that sets object's source
  -> IO a
procOneTimeSnd s f a h d e i j =
  if isNothing (f s)
    then do c <- g s
            let (x, y) = vectorRelation (i c) a (center c)
            let b = fromJust $ f c
            sourcePosition b $= Vertex3 (double2Float x) (double2Float (-y)) 0
            play [b]
            return c
    else return s
  where g t = do [u] <- genObjectNames 1
                 buffer u $= getSound (h t) d
                 sourceRelative u $= Listener
                 referenceDistance u $= audioReferenceDistance
                 rolloffFactor u $= audioRolloffFactor
                 sourceGain u $= e
                 return (j t (Just u))