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.NormedSpace.Maximum   as NormedMax
import qualified Algebra.NormedSpace.Euclidean as NormedEuc
import qualified Algebra.NormedSpace.Sum       as NormedSum

import qualified Algebra.Module    as Module
import qualified Algebra.Algebraic as Algebraic
import qualified Algebra.Additive  as Additive

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

import Control.Applicative (liftA2, )
import Control.Monad (liftM2, )

import Test.QuickCheck (Arbitrary(..), )

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



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


instance Show a => Show (T a) where
   showsPrec p x =
      showParen (p >= 10)
         (showString "Stereo.cons " . showsPrec 11 (left x) .
          showString " " . showsPrec 11 (right x))

instance (Arbitrary a) => Arbitrary (T a) where
   arbitrary = liftM2 cons arbitrary arbitrary
   coarbitrary = error "Stereo.coarbitrary not implemented"


{-# 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 v) => Module.C a (T v) where
   {-# INLINE (*>) #-}
   s *> (Cons l r)   = Cons (s *> l) (s *> r)

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


instance (Additive.C a, NormedSum.C a v) => NormedSum.C a (T v) where
   norm (Cons l r) =
      NormedSum.norm l + NormedSum.norm r

instance (NormedEuc.Sqr a v) => NormedEuc.Sqr a (T v) where
   normSqr (Cons l r) =
      NormedEuc.normSqr l + NormedEuc.normSqr r

instance (Algebraic.C a, NormedEuc.Sqr a v) => NormedEuc.C a (T v) where
   norm = NormedEuc.defltNorm

instance (Ord a, NormedMax.C a v) => NormedMax.C a (T v) where
   norm (Cons l r) =
      max (NormedMax.norm l) (NormedMax.norm r)


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