edge-0.8.18: Animation.hs

module Animation where

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 ResourceTracker (RT, getSound)
import Common (Time)
import GHC.Float ( double2Float )
import Math ( radToDeg )
import Moving (center, Locatable(..))
import Data.Maybe (isNothing, fromJust)

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