Stereo.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-
This data type can be used as sample type for stereo signals.
-}
module Synthesizer.Frame.Stereo (T, left, right, cons, map, ) where

import qualified Sound.Sox.Frame as Frame

import qualified Synthesizer.Interpolation.Class as Interpol
import qualified Algebra.Module   as Module
import qualified Algebra.Additive as Additive

import Foreign.Storable (Storable (..), )
import qualified Foreign.Storable.Record as Store

import Control.Applicative (liftA2, )

import NumericPrelude
import PreludeBase hiding (map)
import Prelude ()



-- cf. Sound.Sox.Frame.Stereo
data T a = Cons {left, right :: !a}


{-# INLINE cons #-}
cons :: a -> a -> T a
cons = Cons

{-# INLINE map #-}
map :: (a -> b) -> T a -> T b
map f (Cons l r) = Cons (f l) (f r)

instance Functor T where
   fmap = map


store :: Storable a => Store.Dictionary (T a)
store =
   Store.run $
   liftA2 Cons
      (Store.element left)
      (Store.element right)

instance (Storable a) => Storable (T a) where
   sizeOf = Store.sizeOf store
   alignment = Store.alignment store
   peek = Store.peek store
   poke = Store.poke store


instance (Additive.C a) => Additive.C (T a) where
   {-# INLINE zero #-}
   {-# INLINE negate #-}
   {-# INLINE (+) #-}
   {-# INLINE (-) #-}
   zero                             = Cons zero zero
   (+)    (Cons xl xr) (Cons yl yr) = Cons (xl+yl) (xr+yr)
   (-)    (Cons xl xr) (Cons yl yr) = Cons (xl-yl) (xr-yr)
   negate (Cons xl xr)              = Cons (negate xl) (negate xr)

instance (Module.C a b) => Module.C a (T b) where
   {-# INLINE (*>) #-}
   s *> (Cons l r)   = Cons (s *> l) (s *> r)

instance Interpol.C a b => Interpol.C a (T b) where
   {-# INLINE scaleAndAccumulate #-}
   scaleAndAccumulate =
      Interpol.makeMac2 Cons left right


instance Frame.C a => Frame.C (T a) where
   numberOfChannels y = 2 * Frame.numberOfChannels (left y)
   format y = Frame.format (left y)