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

import qualified Synthesizer.Generic.SampledValue as Sample

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

import Foreign.Storable (Storable (..), )

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


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)


{-# INLINE roundUp #-}
roundUp :: Int -> Int -> Int
roundUp m x = x + mod (-x) m

-- cf. StorableInstances
instance (Storable a) => Storable (T a) where
   sizeOf ~(Cons l r) =
      roundUp (alignment r) (sizeOf l) + sizeOf r
   alignment x = alignment (left x)
   peek ptr =
      do l <- peekByteOff ptr 0
         let peekSecond :: Storable b => b -> IO b
             peekSecond ru =
                peekByteOff ptr (roundUp (alignment ru) (sizeOf l))
         r <- peekSecond undefined
         return (Cons l r)
   poke ptr (Cons l r) =
      pokeByteOff ptr 0 l >>
      pokeByteOff ptr (roundUp (alignment r) (sizeOf l)) r


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 (Sample.C a) => Sample.C (T a) -- where