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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Filter (
   {- * Non-recursive -}

   {- ** Amplification -}
   amplify,
   amplifyDimension,
   amplifyScalarDimension,
   negate,
   envelope,
   envelopeScalarDimension,
   envelopeVector,
   envelopeVectorDimension,
 ) where


import qualified Synthesizer.Dimensional.Rate as Rate
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat

-- import qualified Synthesizer.Dimensional.Straight.Signal      as SigS
import qualified Synthesizer.Dimensional.Signal.Private as SigA
-- import Synthesizer.Dimensional.Signal.Private (toAmplitudeScalar)

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

import Number.DimensionTerm ((&*&))

import qualified Synthesizer.Generic.Signal            as SigG
import qualified Synthesizer.State.Signal              as Sig
import qualified Synthesizer.State.Filter.NonRecursive as FiltNR

-- import qualified Algebra.Transcendental as Trans
-- import qualified Algebra.Field          as Field
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive
import qualified Algebra.Module         as Module

-- import NumericPrelude.Numeric hiding (negate)
-- import NumericPrelude.Base as P
import Prelude ((.), flip, fmap, )


{- | The amplification factor must be positive. -}
{-# INLINE amplify #-}
amplify :: (Ring.C y, Dim.C u) =>
   y ->
   SigA.T rate (Amp.Dimensional u y) body ->
   SigA.T rate (Amp.Dimensional u y) body
amplify :: forall y u rate body.
(C y, C u) =>
y -> T rate (Dimensional u y) body -> T rate (Dimensional u y) body
amplify y
volume =
   forall amp0 amp1 rate body.
(amp0 -> amp1)
-> T rate (Numeric amp0) body -> T rate (Numeric amp1) body
processAmplitude (forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale y
volume)

{-# INLINE amplifyDimension #-}
amplifyDimension :: (Ring.C y, Dim.C u, Dim.C v) =>
   DN.T v y ->
   SigA.T rate (Amp.Dimensional u y) body ->
   SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) body
amplifyDimension :: forall y u v rate body.
(C y, C u, C v) =>
T v y
-> T rate (Dimensional u y) body
-> T rate (Dimensional (Mul v u) y) body
amplifyDimension T v y
volume =
   forall amp0 amp1 rate body.
(amp0 -> amp1)
-> T rate (Numeric amp0) body -> T rate (Numeric amp1) body
processAmplitude (T v y
volume forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*&)

{-# INLINE amplifyScalarDimension #-}
amplifyScalarDimension :: (Ring.C y, Dim.C v) =>
   DN.T v y ->
   SigA.T rate (Amp.Dimensional Dim.Scalar y) body ->
   SigA.T rate (Amp.Dimensional v y) body
amplifyScalarDimension :: forall y v rate body.
(C y, C v) =>
T v y
-> T rate (Dimensional Scalar y) body
-> T rate (Dimensional v y) body
amplifyScalarDimension T v y
volume =
   forall amp0 amp1 rate body.
(amp0 -> amp1)
-> T rate (Numeric amp0) body -> T rate (Numeric amp1) body
processAmplitude (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale T v y
volume forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scalar a -> a
DN.toNumber)

processAmplitude ::
   (amp0 -> amp1) ->
   SigA.T rate (Amp.Numeric amp0) body ->
   SigA.T rate (Amp.Numeric amp1) body
processAmplitude :: forall amp0 amp1 rate body.
(amp0 -> amp1)
-> T rate (Numeric amp0) body -> T rate (Numeric amp1) body
processAmplitude amp0 -> amp1
f (SigA.Cons rate
rate Numeric amp0
amp body
xs) =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons rate
rate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap amp0 -> amp1
f Numeric amp0
amp) body
xs

-- FIXME: move to Dimensional.Straight
{-# INLINE negate #-}
negate :: (SigG.Transform sig yv, Additive.C yv) =>
      SigA.T rate amp (sig yv)
   -> SigA.T rate amp (sig yv)
negate :: forall (sig :: * -> *) yv rate amp.
(Transform sig yv, C yv) =>
T rate amp (sig yv) -> T rate amp (sig yv)
negate =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall (sig :: * -> *) y0 y1.
(Transform0 sig, Storage (sig y0), Storage (sig y1)) =>
(y0 -> y1) -> sig y0 -> sig y1
SigG.map forall a. C a => a -> a
Additive.negate)

-- FIXME: move to Dimensional.Straight
{-# INLINE envelope #-}
envelope :: (Flat.C y flat, Ring.C y) =>
      SigA.T (Rate.Phantom s) flat (Sig.T y)   {- ^ the envelope -}
   -> SigA.T (Rate.Phantom s) amp (Sig.T y)    {- ^ the signal to be enveloped -}
   -> SigA.T (Rate.Phantom s) amp (Sig.T y)
envelope :: forall y flat s amp.
(C y flat, C y) =>
T (Phantom s) flat (T y)
-> T (Phantom s) amp (T y) -> T (Phantom s) amp (T y)
envelope T (Phantom s) flat (T y)
y =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall a. C a => T a -> T a -> T a
FiltNR.envelope (forall y flat (sig :: * -> *) rate.
(C y flat, Transform sig y) =>
T rate flat (sig y) -> sig y
Flat.toSamples T (Phantom s) flat (T y)
y))

{- |
This is like 'envelope' but it does not require
prior conversion to a flat signal,
what might violate the sample range (-1,1).
Instead the global amplitudes are multiplied.
-}
{-# INLINE envelopeScalarDimension #-}
envelopeScalarDimension :: (Dim.C v, Ring.C y) =>
      SigA.R s Dim.Scalar y y
         {- ^ the envelope -}
   -> SigA.R s v y y
         {- ^ the signal to be enveloped -}
   -> SigA.R s v y y
envelopeScalarDimension :: forall v y s.
(C v, C y) =>
R s Scalar y y -> R s v y y -> R s v y y
envelopeScalarDimension R s Scalar y y
y =
   forall amp0 amp1 rate body.
(amp0 -> amp1)
-> T rate (Numeric amp0) body -> T rate (Numeric amp1) body
processAmplitude (forall u a. (C u, C a) => a -> T u a -> T u a
DN.scale (forall a. Scalar a -> a
DN.toNumber (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s Scalar y y
y))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall a. C a => T a -> T a -> T a
FiltNR.envelope (forall rate amplitude body. T rate amplitude body -> body
SigA.body R s Scalar y y
y))

-- FIXME: move to Dimensional.Straight
{-# INLINE envelopeVector #-}
envelopeVector :: (Flat.C y0 flat, Module.C y0 yv) =>
      SigA.T (Rate.Phantom s) flat (Sig.T y0)   {- ^ the envelope -}
   -> SigA.T (Rate.Phantom s) amp (Sig.T yv)    {- ^ the signal to be enveloped -}
   -> SigA.T (Rate.Phantom s) amp (Sig.T yv)
envelopeVector :: forall y0 flat yv s amp.
(C y0 flat, C y0 yv) =>
T (Phantom s) flat (T y0)
-> T (Phantom s) amp (T yv) -> T (Phantom s) amp (T yv)
envelopeVector T (Phantom s) flat (T y0)
y =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall a v. C a v => T a -> T v -> T v
FiltNR.envelopeVector (forall y flat (sig :: * -> *) rate.
(C y flat, Transform sig y) =>
T rate flat (sig y) -> sig y
Flat.toSamples T (Phantom s) flat (T y0)
y))

{-# INLINE envelopeVectorDimension #-}
envelopeVectorDimension :: (Module.C y0 yv, Ring.C y, Dim.C u, Dim.C v) =>
      SigA.R s v y y0  {- ^ the envelope -}
   -> SigA.R s u y yv  {- ^ the signal to be enveloped -}
   -> SigA.R s (Dim.Mul v u) y yv
envelopeVectorDimension :: forall y0 yv y u v s.
(C y0 yv, C y, C u, C v) =>
R s v y y0 -> R s u y yv -> R s (Mul v u) y yv
envelopeVectorDimension R s v y y0
y R s u y yv
x =
   forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody
      (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s v y y0
y forall u v a. (C u, C v, C a) => T u a -> T v a -> T (Mul u v) a
&*& forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s u y yv
x)
      (forall a v. C a v => T a -> T v -> T v
FiltNR.envelopeVector (forall rate amplitude body. T rate amplitude body -> body
SigA.body R s v y y0
y) (forall rate amplitude body. T rate amplitude body -> body
SigA.body R s u y yv
x))