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

Maintainer  :  synthesizer@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes
-}
module Synthesizer.Dimensional.Amplitude.Displacement (
   mix, mixVolume,
   mixMulti, mixMultiVolume,
   raise, raiseVector, distort,
   map, mapLinear, mapExponential, mapLinearDimension,
   inflateGeneric, inflate,
   ) where

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

import qualified Synthesizer.Dimensional.Amplitude as Amp

import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat

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.Displacement as Disp
import qualified Synthesizer.State.Signal  as Sig

import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module         as Module
import qualified Algebra.Field          as Field
import qualified Algebra.Absolute       as Absolute
import qualified Algebra.Ring           as Ring

import qualified Data.List as List

import NumericPrelude.Base hiding (map, )
import NumericPrelude.Numeric
import Prelude ()


{- * Mixing -}

{- |
Mix two signals.
In contrast to 'zipWith' the result has the length of the longer signal.
-}
{-# INLINE mix #-}
mix ::
   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>
      SigA.R s u y yv
   -> SigA.R s u y yv
   -> SigA.R s u y yv
mix :: forall y yv u s.
(C y, C y, C y yv, C u) =>
R s u y yv -> R s u y yv -> R s u y yv
mix R s u y yv
x R s u y yv
y =
   forall y yv u s.
(C y, C y, C y yv, C u) =>
T u y -> R s u y yv -> R s u y yv -> R s u y yv
mixVolume
      (forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s u y yv
x) forall a. C a => a -> a -> a
+ forall u a. (C u, C a) => T u a -> T u a
DN.abs (forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude R s u y yv
y))
      R s u y yv
x R s u y yv
y

{-# INLINE mixVolume #-}
mixVolume ::
   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> SigA.R s u y yv
   -> SigA.R s u y yv
   -> SigA.R s u y yv
mixVolume :: forall y yv u s.
(C y, C y, C y yv, C u) =>
T u y -> R s u y yv -> R s u y yv -> R s u y yv
mixVolume T u y
v R s u y yv
x R s u y yv
y =
   let z :: T (Phantom s) (Numeric (T u y)) (T yv)
z = forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T u y
v
              (forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
SigA.vectorSamples (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T u y)) (T yv)
z) R s u y yv
x forall a. C a => a -> a -> a
+
               forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
SigA.vectorSamples (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T u y)) (T yv)
z) R s u y yv
y)
   in  forall {s}. T (Phantom s) (Numeric (T u y)) (T yv)
z

{- |
Mix one or more signals.
-}
{-# INLINE mixMulti #-}
mixMulti ::
   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>
      [SigA.R s u y yv]
   ->  SigA.R s u y yv
mixMulti :: forall y yv u s.
(C y, C y, C y yv, C u) =>
[R s u y yv] -> R s u y yv
mixMulti [R s u y yv]
x =
   forall y yv u s.
(C y, C y, C y yv, C u) =>
T u y -> [R s u y yv] -> R s u y yv
mixMultiVolume (forall a. C a => [a] -> a
sum (forall a b. (a -> b) -> [a] -> [b]
List.map (forall u a. (C u, C a) => T u a -> T u a
DN.abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rate amp sig. T rate (Numeric amp) sig -> amp
SigA.actualAmplitude) [R s u y yv]
x)) [R s u y yv]
x

{-# INLINE mixMultiVolume #-}
mixMultiVolume ::
   (Absolute.C y, Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> [SigA.R s u y yv]
   ->  SigA.R s u y yv
mixMultiVolume :: forall y yv u s.
(C y, C y, C y yv, C u) =>
T u y -> [R s u y yv] -> R s u y yv
mixMultiVolume T u y
v [R s u y yv]
x =
   let z :: T (Phantom s) (Numeric (T u y)) (T yv)
z = forall amp sig s. amp -> sig -> T (Phantom s) (Numeric amp) sig
SigA.fromBody T u y
v
              (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\R s u y yv
y -> (forall y yv (sig :: * -> *) amp rate.
(C y yv, Transform sig yv) =>
(amp -> y) -> T rate (Numeric amp) (sig yv) -> sig yv
SigA.vectorSamples (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T (Phantom s) (Numeric (T u y)) (T yv)
z) R s u y yv
y forall a. C a => a -> a -> a
+)) forall a. T a
Sig.empty [R s u y yv]
x)
   in  forall {s}. T (Phantom s) (Numeric (T u y)) (T yv)
z

{- |
Add a number to all of the signal values.
This is useful for adjusting the center of a modulation.
-}
{-# INLINE raise #-}
raise :: (Field.C y, Dim.C u) =>
      DN.T u y
   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)
   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)
raise :: forall y u rate.
(C y, C u) =>
T u y
-> T rate (Dimensional u y) (T y) -> T rate (Dimensional u y) (T y)
raise T u y
y' T rate (Dimensional u y) (T y)
x =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody
      (forall v. C v => v -> T v -> T v
Disp.raise (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T rate (Dimensional u y) (T y)
x T u y
y')) T rate (Dimensional u y) (T y)
x

{-# INLINE raiseVector #-}
raiseVector :: (Field.C y, Module.C y yv, Dim.C u) =>
      DN.T u y
   -> yv
   -> SigA.T rate (Amp.Dimensional u y) (Sig.T yv)
   -> SigA.T rate (Amp.Dimensional u y) (Sig.T yv)
raiseVector :: forall y yv u rate.
(C y, C y yv, C u) =>
T u y
-> yv
-> T rate (Dimensional u y) (T yv)
-> T rate (Dimensional u y) (T yv)
raiseVector T u y
y' yv
yv T rate (Dimensional u y) (T yv)
x =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody
      (forall v. C v => v -> T v -> T v
Disp.raise (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T rate (Dimensional u y) (T yv)
x T u y
y' forall a v. C a v => a -> v -> v
*> yv
yv)) T rate (Dimensional u y) (T yv)
x

{- |
Distort the signal using a flat function.
The first signal gives the scaling of the function.
If the scaling is c and the input sample is y,
then @c * f(y/c)@ is output.
This way we can use an (efficient) flat function
and have a simple, yet dimension conform, way of controlling the distortion.
E.g. if the distortion function is @tanh@
then the value @c@ controls the saturation level.
-}
{-# INLINE distort #-}
distort :: (Field.C y, Module.C y yv, Dim.C u) =>
      (yv -> yv)
   -> SigA.R s u y y
   -> SigA.R s u y yv
   -> SigA.R s u y yv
distort :: forall y yv u s.
(C y, C y yv, C u) =>
(yv -> yv) -> R s u y y -> R s u y yv -> R s u y yv
distort yv -> yv
f R s u y y
cs R s u y yv
xs =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody
      (forall a b c. (a -> b -> c) -> T a -> T b -> T c
Sig.zipWith
          (\y
c yv
y -> y
c forall a v. C a v => a -> v -> v
*> yv -> yv
f (forall a. C a => a -> a
recip y
c forall a v. C a v => a -> v -> v
*> yv
y))
          (forall y (sig :: * -> *) amp rate.
(C y, Transform sig y) =>
(amp -> y) -> T rate (Numeric amp) (sig y) -> sig y
SigA.scalarSamples (forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar R s u y yv
xs) R s u y y
cs)) R s u y yv
xs



{-# INLINE map #-}
map ::
   (Amp.Primitive amp) =>
   (y0 -> y1) ->
   SigA.T rate amp (Sig.T y0) ->
   SigA.T rate amp (Sig.T y1)
map :: forall amp y0 y1 rate.
Primitive amp =>
(y0 -> y1) -> T rate amp (T y0) -> T rate amp (T y1)
map y0 -> y1
f =
   forall sig0 sig1 rate amp.
(sig0 -> sig1) -> T rate amp sig0 -> T rate amp sig1
SigA.processBody (forall a b. (a -> b) -> T a -> T b
Sig.map y0 -> y1
f)


{-
This signature is too general.
It will cause strange type errors
if u is Scalar and further process want to use the Flat instance.
The Flat instance cannot be found, if q cannot be determined.

mapLinear :: (Flat.C y flat, Ring.C y, Dim.C u) =>
    y ->
    DN.T u q ->
    SigA.T rate flat (Sig.T y) ->
    SigA.T rate (Amp.Dimensional u q) (Sig.T y)
-}

{- |
Map a control curve without amplitude unit
by a linear (affine) function with a unit.
This is a combination of 'raise' and 'amplify'.
-}
{-# INLINE mapLinear #-}
mapLinear :: (Flat.C y flat, Ring.C y, Dim.C u) =>
   y ->
   DN.T u y ->
   SigA.T rate flat (Sig.T y) ->
   SigA.T rate (Amp.Dimensional u y) (Sig.T y)
mapLinear :: forall y flat u rate.
(C y flat, C y, C u) =>
y -> T u y -> T rate flat (T y) -> T rate (Dimensional u y) (T y)
mapLinear y
depth T u y
center =
   forall amp rate amplitude body0 body1.
amp
-> (T rate amplitude body0 -> body1)
-> T rate amplitude body0
-> T rate (Numeric amp) body1
mapAux T u y
center (forall a b. (a -> b) -> T a -> T b
Sig.map (\y
x -> forall a. C a => a
oneforall a. C a => a -> a -> a
+y
xforall a. C a => a -> a -> a
*y
depth) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y flat (sig :: * -> *) rate.
(C y flat, Transform sig y) =>
T rate flat (sig y) -> sig y
Flat.toSamples)

{-# INLINE mapExponential #-}
mapExponential :: (Flat.C y flat, Trans.C y, Dim.C u) =>
   y ->
   DN.T u q ->
   SigA.T rate flat (Sig.T y) ->
   SigA.T rate (Amp.Dimensional u q) (Sig.T y)
mapExponential :: forall y flat u q rate.
(C y flat, C y, C u) =>
y -> T u q -> T rate flat (T y) -> T rate (Dimensional u q) (T y)
mapExponential y
depth T u q
center =
   -- mapAux center (Sig.map (depth**) . Flat.toSamples)
   -- should be faster
   forall amp rate amplitude body0 body1.
amp
-> (T rate amplitude body0 -> body1)
-> T rate amplitude body0
-> T rate (Numeric amp) body1
mapAux T u q
center
      (let logDepth :: y
logDepth = forall a. C a => a -> a
log y
depth in forall a b. (a -> b) -> T a -> T b
Sig.map (forall a. C a => a -> a
exp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y
logDepthforall a. C a => a -> a -> a
*)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall y flat (sig :: * -> *) rate.
(C y flat, Transform sig y) =>
T rate flat (sig y) -> sig y
Flat.toSamples)

{-# INLINE mapLinearDimension #-}
mapLinearDimension ::
   (Field.C y, Absolute.C y, Dim.C u, Dim.C v) =>
      DN.T v y               {- ^ range: one is mapped to @center + range * ampX@ -}
   -> DN.T (Dim.Mul v u) y  {- ^ center: zero is mapped to @center@ -}
   -> SigA.T rate (Amp.Dimensional u y) (Sig.T y)
   -> SigA.T rate (Amp.Dimensional (Dim.Mul v u) y) (Sig.T y)
mapLinearDimension :: forall y u v rate.
(C y, C y, C u, C v) =>
T v y
-> T (Mul v u) y
-> T rate (Dimensional u y) (T y)
-> T rate (Dimensional (Mul v u) y) (T y)
mapLinearDimension T v y
range T (Mul v u) y
center T rate (Dimensional u y) (T y)
x =
   let absRange :: T (Mul v u) y
absRange  = forall u a. (C u, C a) => T u a -> T u a
DN.abs T v y
range 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 T rate (Dimensional u y) (T y)
x
       absCenter :: T (Mul v u) y
absCenter = forall u a. (C u, C a) => T u a -> T u a
DN.abs T (Mul v u) y
center
       rng :: y
rng = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T rate (Numeric (T (Mul v u) y)) (T y)
z T (Mul v u) y
absRange
       cnt :: y
cnt = forall y v rate sig.
(C y, C v) =>
T rate (Dimensional v y) sig -> T v y -> y
toAmplitudeScalar T rate (Numeric (T (Mul v u) y)) (T y)
z T (Mul v u) y
absCenter
       z :: T rate (Numeric (T (Mul v u) y)) (T y)
z =
          forall amp rate amplitude body0 body1.
amp
-> (T rate amplitude body0 -> body1)
-> T rate amplitude body0
-> T rate (Numeric amp) body1
mapAux (T (Mul v u) y
absRange forall a. C a => a -> a -> a
+ T (Mul v u) y
absCenter)
             (forall a b. (a -> b) -> T a -> T b
Sig.map (\y
y -> y
cnt forall a. C a => a -> a -> a
+ y
rngforall a. C a => a -> a -> a
*y
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall rate amplitude body. T rate amplitude body -> body
SigA.body)
             T rate (Dimensional u y) (T y)
x
   in  T rate (Numeric (T (Mul v u) y)) (T y)
z

mapAux ::
   amp ->
   (SigA.T rate amplitude body0 -> body1) ->
   SigA.T rate amplitude body0 ->
   SigA.T rate (Amp.Numeric amp) body1
mapAux :: forall amp rate amplitude body0 body1.
amp
-> (T rate amplitude body0 -> body1)
-> T rate amplitude body0
-> T rate (Numeric amp) body1
mapAux amp
amp T rate amplitude body0 -> body1
f T rate amplitude body0
xs =
   forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons (forall rate amplitude body. T rate amplitude body -> rate
SigA.sampleRate T rate amplitude body0
xs) (forall amp. amp -> Numeric amp
Amp.Numeric amp
amp) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T rate amplitude body0 -> body1
f forall a b. (a -> b) -> a -> b
$ T rate amplitude body0
xs



{- |
I suspect that this function will most oftenly not the right choice.
When the amplitude is Flat, better use 'inflate'.
When the amplitude is Numeric, better use @Filter.amplifyScalarDimension@
since this will not modify signal values
but only the global amplitude.
This is both more efficient and ensures boundedness of signal values.
-}
{-# INLINE inflateGeneric #-}
inflateGeneric ::
   (Flat.C y flat, SigG.Transform sig y) =>
   amp ->
   SigA.T rate flat (sig y) ->
   SigA.T rate (Amp.Numeric amp) (sig y)
inflateGeneric :: forall y flat (sig :: * -> *) amp rate.
(C y flat, Transform sig y) =>
amp -> T rate flat (sig y) -> T rate (Numeric amp) (sig y)
inflateGeneric amp
v =
   \T rate flat (sig y)
x ->
      forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons (forall rate amplitude body. T rate amplitude body -> rate
SigA.sampleRate T rate flat (sig y)
x) (forall amp. amp -> Numeric amp
Amp.Numeric amp
v)
         (forall y flat (sig :: * -> *) rate.
(C y flat, Transform sig y) =>
T rate flat (sig y) -> sig y
Flat.toSamples T rate flat (sig y)
x)

{-# INLINE inflate #-}
inflate ::
   amp ->
   SigA.T rate (Amp.Flat y) sig ->
   SigA.T rate (Amp.Numeric amp) sig
inflate :: forall amp rate y sig.
amp -> T rate (Flat y) sig -> T rate (Numeric amp) sig
inflate amp
v =
   \T rate (Flat y) sig
x ->
      forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons (forall rate amplitude body. T rate amplitude body -> rate
SigA.sampleRate T rate (Flat y) sig
x) (forall amp. amp -> Numeric amp
Amp.Numeric amp
v)
         (forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate (Flat y) sig
x)