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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

For a description see "Synthesizer.Dimensional.Process".
module Synthesizer.Dimensional.RateAmplitude.Signal (
   T, R,
   amplitude, samples,
   fromSignal, fromSamples,
   scalarSamples, fromScalarSamples, scalarSamplesGeneric,
   vectorSamples, fromVectorSamples,
   ($-),  ($&),
   (&*^), (&*>^),
   Peaks(Peaks), fromPeaks,
   cache, bindCached, share,

   ) where

import Synthesizer.Dimensional.Process (($:), ($^), ($#), )
import qualified Synthesizer.Dimensional.Process as Proc

import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat
import qualified Synthesizer.Dimensional.Abstraction.RateIndependent as Ind
import qualified Synthesizer.Dimensional.RatePhantom as RP

import Synthesizer.Dimensional.Amplitude.Signal as SigA
import qualified Synthesizer.Dimensional.Amplitude.Control as CtrlV
import qualified Synthesizer.Dimensional.Straight.Signal   as SigS
import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Storable.Signal as SigSt
import qualified Synthesizer.Generic.SampledValue as Sample
import qualified Synthesizer.Frame.Stereo as Stereo

import qualified BinarySample as BinSmp
import Data.Int (Int16)

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim
import Number.DimensionTerm ((&/&))

import qualified Algebra.Module         as Module
import qualified Algebra.RealField      as RealField
import qualified Algebra.Field          as Field
import qualified Algebra.Real           as Real
import qualified Algebra.Ring           as Ring

-- import qualified Data.List as List

import NumericPrelude (zero, one, )
-- import PreludeBase
import Prelude (($), (.), Bool, Ord, fmap, return, (=<<), )

type DimensionGradient u v = Dim.Mul (Dim.Recip u) v

{-# INLINE toGradientScalar #-}
toGradientScalar :: (Field.C q, Dim.C u, Dim.C v) =>
   DN.T v q -> DN.T (DimensionGradient u v) q -> Proc.T s u q q
toGradientScalar amp steepness =
   (DN.rewriteDimension (Dim.identityRight . Dim.applyRightMul Dim.cancelRight . Dim.associateRight) $
    steepness &/& amp)

{- |
We want to represent streams of discrete events
in a manner that is more safe than plain @[Bool]@.
Each peak can be imagined as a Dirac impulse.

A @[Bool]@ could be used accidentally for 'Synthesizer.Dimensional.Amplitude.Cut.selectBool',
where @selectBool@ is intended for piecewise constant control curves.

You may think that a type like @Peak = Peak Bool@ as sample type
in @T s Peak@ would also do the job.
Actually, this wouldn't be a good idea
since you can apply constant interpolation on it,
which obviously fools the idea of a peak.
newtype Peaks s = Peaks {getPeaks :: Sig.T Bool}

{- |
This is the most frequently needed transformation (if not the only one)
of a stream of peaks.
It converts to a signal of peaks with area 1.
This convention is especially useful for smoothing filters
that eventually produce frequency progress curves.
{-# INLINE fromPeaks #-}
fromPeaks ::
   (Ord q, Ring.C q, Dim.C u) =>
   Proc.T s u q (Peaks s -> R s (Dim.Recip u) q q)
fromPeaks =
   do rate <- Proc.getSampleRate
      return $
         fromScalarSamples rate .
         Sig.map (\c -> if c then one else zero) .

infixl 0 $-, $&

{- |
Take a scalar argument where a process expects a signal.
Only possible for non-negative values so far.
{-# INLINE ($-) #-}
($-) :: (Field.C y, Real.C y, Dim.C u, Dim.C v) =>
    Proc.T s u t (R s v y y -> a) -> DN.T v y -> Proc.T s u t a
($-) f x = f $: Proc.pure (CtrlV.constant x)

{- |
Take a signal with 'DN.Scalar' unit in amplitude
where the process expects a plain 'Sig.T'.
{-# INLINE ($&) #-}
($&) :: (Ring.C y) =>
   Proc.T s u t (SigS.R s y -> a) ->
   Proc.T s u t (R s Dim.Scalar y y) ->
   Proc.T s u t a
($&) f arg =
   do x <- arg
      f $# SigS.fromSamples (scalarSamples DN.toNumber x)
--      f $# toScalarSignal one x

infix 7 &*^, &*>^

{-# INLINE (&*^) #-}
(&*^) :: (Flat.C flat y) =>
   DN.T v y ->
   Proc.T s u t (RP.T s flat y) ->
   Proc.T s u t (R s v y y)
(&*^) v x = fromSamples v . Flat.toSamples $^ x

{-# INLINE (&*^) #-}
(&*^) :: (Flat.C flat y) =>
   DN.T v y ->
   Proc.T s u t (SigS.R s y) ->
   Proc.T s u t (R s v y y)
(&*^) v x = fromSignal v $^ x

{-# INLINE (&*>^) #-}
(&*>^) ::
   DN.T v y ->
   Proc.T s u t (SigS.R s yv) ->
   Proc.T s u t (R s v y yv)
(&*>^) v x = fromSignal v $^ x

{-# INLINE cache #-}
cache ::
   (Dim.C v, Ind.C w, Sample.C yv0) =>
   Proc.T s u t (w (T v y (SigS.T Sig.T)) yv0) ->
   Proc.T s u t (w (T v y (SigS.T Sig.T)) yv0)
cache =
   fmap (processSamples
      (Sig.fromStorableSignal . Sig.toStorableSignal SigSt.defaultChunkSize))

{-# INLINE bindCached #-}
bindCached ::
   (Dim.C v, Ind.C w, Sample.C yv0) =>
   Proc.T s u t (w (T v y (SigS.T Sig.T)) yv0) ->
   (w (T v y (SigS.T Sig.T)) yv0 -> Proc.T s u t b) ->
   Proc.T s u t b
bindCached x y =
   y =<< cache x

{-# INLINE share #-}
share ::
   (Dim.C v, Ind.C w, Sample.C yv0) =>
   Proc.T s u t (w (T v y (SigS.T Sig.T)) yv0) ->
   (Proc.T s u t (w (T v y (SigS.T Sig.T)) yv0) -> Proc.T s u t b) ->
   Proc.T s u t b
share x y = bindCached x (y . return)

{-# INLINE toStorableInt16Mono #-}
toStorableInt16Mono ::
   (Ind.C w, RealField.C a, BinSmp.C a) =>
   w (SigA.S Dim.Voltage a) a ->
   w SigSt.T Int16
toStorableInt16Mono =
      (Sig.toStorableSignal SigSt.defaultChunkSize .
       Sig.map BinSmp.numToInt16Packed .
       SigA.scalarSamplesPrivate (DN.toNumberWithDimension Dim.voltage))

{-# INLINE toStorableInt16Stereo #-}
toStorableInt16Stereo ::
   (Ind.C w, Module.C a a, RealField.C a, BinSmp.C a) =>
   w (SigA.S Dim.Voltage a) (Stereo.T a) ->
   w SigSt.T (Stereo.T Int16)
toStorableInt16Stereo =
      (Sig.toStorableSignal SigSt.defaultChunkSize .
       Sig.map (Stereo.map BinSmp.numToInt16Packed) .
       SigA.vectorSamplesPrivate (DN.toNumberWithDimension Dim.voltage))