{- |
Copyright   :  (c) Henning Thielemann 2008
License     :  GPL

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  Haskell 98


Basic definitions for signal processors
which are controlled by another signal.
If a control curve is expensive to compute,
or, what happens more frequently,
the conversion from natural control parameters
to internal control parameters is expensive,
then it can be more efficient to compute the control curve at a lower rate
and interpolate the internal control parameters of a particular process.
CSound and SuperCollider have a sample rate
that is common to all control curves,
the ratio between audio and control rate must be integral,
and they use constant interpolation exclusively.
With some more sophisticated interpolation
one may choose a larger gap between control and audio rate.
-}
module Synthesizer.Dimensional.ControlledProcess where

import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.RatePhantom as RP
import qualified Synthesizer.Dimensional.RateWrapper as SigP
-- import qualified Synthesizer.Dimensional.Straight.Signal as SigS
-- import qualified Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Causal.Process       as Causal
import qualified Synthesizer.Causal.Interpolation as Interpolation
import qualified Synthesizer.State.Signal as Sig
import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

-- import Synthesizer.Dimensional.Process (($:), ($#), )
-- import Synthesizer.Dimensional.RateAmplitude.Signal (($-))

-- import Number.DimensionTerm ((*&), ) -- ((&*&), (&/&))

import qualified Algebra.RealField      as RealField
-- import qualified Algebra.Field          as Field
-- import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

{-
import Control.Monad (liftM2, )
import qualified Control.Applicative as App
import Control.Applicative (Applicative)
-}

import NumericPrelude
{-
import PreludeBase as P
-}


{- |
@ec@ is the type for the curve of external control parameters,
@ic@ for internal control parameters.
-}
data T s ec ic a = Cons {
      converter :: ec -> Sig.T ic,
      processor :: Sig.T ic -> a
   }


{-# INLINE runSynchronous #-}
runSynchronous ::
   Proc.T s u t (T s ec ic a) ->
   Proc.T s u t (ec -> a)
runSynchronous cp =
   do p <- cp
      return (processor p . converter p)

{-# INLINE runSynchronous1 #-}
runSynchronous1 ::
   Proc.T s u t (T s (RP.T s sig0 ec0) ic a) ->
   Proc.T s u t (RP.T s sig0 ec0 -> a)
runSynchronous1 = runSynchronous

{-# INLINE runSynchronous2 #-}
runSynchronous2 ::
   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1) ic a) ->
   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> a)
runSynchronous2 = fmap curry . runSynchronous

{-# INLINE runSynchronous3 #-}
runSynchronous3 ::
   Proc.T s u t (T s (RP.T s sig0 ec0, RP.T s sig1 ec1, RP.T s sig2 ec2) ic a) ->
   Proc.T s u t (RP.T s sig0 ec0 -> RP.T s sig1 ec1 -> RP.T s sig2 ec2 -> a)
runSynchronous3 =
   fmap (\f x y z -> f (x,y,z)) . runSynchronous



{-# INLINE runAsynchronous #-}
runAsynchronous ::
   (Dim.C u, Additive.C ic, RealField.C t) =>
   Interpolation.T t ic ->
   Proc.T s u t (T s ec ic a) ->
   Rate.T r u t ->
   ec ->
   Proc.T s u t a
runAsynchronous ip cp srcRate sig =
   do p <- cp
      k <- fmap
              (DN.divToScalar (Rate.toDimensionNumber srcRate))
              Proc.getSampleRate
      return $
         processor p $
         Causal.apply
            (Interpolation.relativeConstantPad ip zero (converter p sig))
            (Sig.repeat k)

{-# INLINE runAsynchronous1 #-}
runAsynchronous1 ::
   (Dim.C u, Additive.C ic, RealField.C t) =>
   Interpolation.T t ic ->
   Proc.T s u t (T s (RP.T r sig0 ec0) ic a) ->
   SigP.T u t sig0 ec0 ->
   Proc.T s u t a
runAsynchronous1 ip cp x =
   uncurry (runAsynchronous ip cp) (SigP.toSignal x)

{-# INLINE runAsynchronous2 #-}
runAsynchronous2 ::
   (Dim.C u, Additive.C ic, RealField.C t) =>
   Interpolation.T t ic ->
   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1) ic a) ->
   SigP.T u t sig0 ec0 ->
   SigP.T u t sig1 ec1 ->
   Proc.T s u t a
runAsynchronous2 ip cp x y =
   let (srcRateX,sigX) = SigP.toSignal x
       (srcRateY,sigY) = SigP.toSignal y
       srcRate = Rate.common "ControlledProcess.runAsynchronous2" srcRateX srcRateY
   in  runAsynchronous ip cp srcRate (sigX,sigY)

{-# INLINE runAsynchronous3 #-}
runAsynchronous3 ::
   (Dim.C u, Additive.C ic, RealField.C t) =>
   Interpolation.T t ic ->
   Proc.T s u t (T s (RP.T r sig0 ec0, RP.T r sig1 ec1, RP.T r sig2 ec2) ic a) ->
   SigP.T u t sig0 ec0 ->
   SigP.T u t sig1 ec1 ->
   SigP.T u t sig2 ec2 ->
   Proc.T s u t a
runAsynchronous3 ip cp x y z =
   let (srcRateX,sigX) = SigP.toSignal x
       (srcRateY,sigY) = SigP.toSignal y
       (srcRateZ,sigZ) = SigP.toSignal z
       common = Rate.common "ControlledProcess.runAsynchronous3"
       srcRate = srcRateX `common` srcRateY `common` srcRateZ
   in  runAsynchronous ip cp srcRate (sigX,sigY,sigZ)