{-
ToDo:
Antialiasing waveforms and oscillators

I think the oscillators should always provide the frequency
to the apply method of a wave.
Then the waveform can decide whether it wants to use it or not.
We could make a type class for simple and bandlimited waveforms.
However, there is a fundamental problem:
Distortion of a waveform (wave shaping)
can turn bandlimited waveforms into ones without band limits.
-}
module Synthesizer.Dimensional.Wave.Controlled where

import Synthesizer.Dimensional.Wave (SamplePhase, )

import qualified Synthesizer.Dimensional.Sample as Sample
import qualified Synthesizer.Dimensional.Map as MapD

import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Generic.Wave as WaveG
import qualified Synthesizer.Generic.Signal as SigG

import qualified Synthesizer.Interpolation as Interpolation

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

import qualified Algebra.Transcendental as Trans
import qualified Algebra.RealField      as RealField
import qualified Algebra.Ring           as Ring

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

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()


{- |
We define a dimensional parametrized waveform in terms of a Map.
This allows any kind and number of control parameters
and distortion of waveforms using @(distortion <<<)@
-}
type T c t y = MapD.T (c, SamplePhase t) y


{-# INLINE simple #-}
simple ::
   (Amp.Primitive cAmp) =>
   amp ->
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.T amp y)
simple :: forall cAmp amp c t y.
Primitive cAmp =>
amp -> (c -> T t y) -> T (T cAmp c) t (T amp y)
simple amp
amp c -> T t y
wave =
   forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
MapD.independent
      (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ amp
amp)
      (\(c
c,T t
p) -> forall t y. T t y -> T t -> y
Wave.apply (c -> T t y
wave c
c) T t
p)

{-# INLINE flat #-}
flat ::
   (Ring.C y, Amp.Primitive cAmp) =>
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.Flat y)
flat :: forall y cAmp c t.
(C y, Primitive cAmp) =>
(c -> T t y) -> T (T cAmp c) t (Flat y)
flat = forall cAmp amp c t y.
Primitive cAmp =>
amp -> (c -> T t y) -> T (T cAmp c) t (T amp y)
simple forall y. Flat y
Amp.Flat


{-# INLINE abstract #-}
abstract ::
   (Amp.Primitive cAmp) =>
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.Abstract y)
abstract :: forall cAmp c t y.
Primitive cAmp =>
(c -> T t y) -> T (T cAmp c) t (Abstract y)
abstract = forall cAmp amp c t y.
Primitive cAmp =>
amp -> (c -> T t y) -> T (T cAmp c) t (T amp y)
simple Abstract
Amp.Abstract


{-# INLINE amplified #-}
amplified ::
   (Ring.C y, Dim.C u, Amp.Primitive cAmp) =>
   DN.T u y ->
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.Dimensional u y y)
amplified :: forall y u cAmp c t.
(C y, C u, Primitive cAmp) =>
T u y -> (c -> T t y) -> T (T cAmp c) t (Dimensional u y y)
amplified = forall cAmp amp c t y.
Primitive cAmp =>
amp -> (c -> T t y) -> T (T cAmp c) t (T amp y)
simple forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall amp. amp -> Numeric amp
Amp.Numeric


{-# INLINE mapLinear #-}
mapLinear ::
   (Ring.C y, Dim.C u, Amp.Primitive cAmp) =>
   y ->
   DN.T u y ->
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.Dimensional u y y)
mapLinear :: forall y u cAmp c t.
(C y, C u, Primitive cAmp) =>
y -> T u y -> (c -> T t y) -> T (T cAmp c) t (Dimensional u y y)
mapLinear y
depth T u y
center =
   forall y u cAmp c t.
(C y, C u, Primitive cAmp) =>
T u y -> (c -> T t y) -> T (T cAmp c) t (Dimensional u y y)
amplified T u y
center forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall y z t. (y -> z) -> T t y -> T t z
Wave.distort (\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
.)

{-# INLINE mapExponential #-}
mapExponential ::
   (Trans.C y, Dim.C u, Amp.Primitive cAmp) =>
   y ->
   DN.T u y ->
   (c -> Wave.T t y) ->
   T (Sample.T cAmp c) t (Sample.Dimensional u y y)
mapExponential :: forall y u cAmp c t.
(C y, C u, Primitive cAmp) =>
y -> T u y -> (c -> T t y) -> T (T cAmp c) t (Dimensional u y y)
mapExponential y
depth T u y
center =
   -- amplified center . Wave.distort (depth**)
   -- should be faster
   forall y u cAmp c t.
(C y, C u, Primitive cAmp) =>
T u y -> (c -> T t y) -> T (T cAmp c) t (Dimensional u y y)
amplified T u y
center forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      let logDepth :: y
logDepth = forall a. C a => a -> a
log y
depth
      in  (forall y z t. (y -> z) -> T t y -> T t z
Wave.distort (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
.)



{- |
Interpolate first within waves and then across waves,
which is simpler but maybe less efficient for lists.
However for types with fast indexing/drop like StorableVector this is optimal.
-}
sampledTone ::
   (RealField.C t, SigG.Transform sig y, Dim.C u) =>
   Interpolation.T t y ->
   Interpolation.T t y ->
   DN.T u t ->
   SigA.T (Rate.Dimensional u t) amp (sig y) ->
   T (Sample.Flat t) t (Sample.T amp y)
sampledTone :: forall t (sig :: * -> *) y u amp.
(C t, Transform sig y, C u) =>
T t y
-> T t y
-> T u t
-> T (Dimensional u t) amp (sig y)
-> T (Flat t) t (T amp y)
sampledTone T t y
ipLeap T t y
ipStep T u t
period T (Dimensional u t) amp (sig y)
tone =
   forall cAmp amp c t y.
Primitive cAmp =>
amp -> (c -> T t y) -> T (T cAmp c) t (T amp y)
simple
      (forall rate amplitude body. T rate amplitude body -> amplitude
SigA.amplitude T (Dimensional u t) amp (sig y)
tone)
      (forall a (sig :: * -> *) v.
(C a, Transform sig v) =>
T a v -> T a v -> a -> sig v -> a -> T a v
WaveG.sampledTone T t y
ipLeap T t y
ipStep
          (forall u a. (C u, C a) => T u a -> T (Recip u) a -> a
DN.mulToScalar T u t
period (forall rate amp sig. T (Actual rate) amp sig -> rate
SigA.actualSampleRate T (Dimensional u t) amp (sig y)
tone))
          (forall rate amplitude body. T rate amplitude body -> body
SigA.body T (Dimensional u t) amp (sig y)
tone))