{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Copyright   :  (c) Henning Thielemann 2009-2010
License     :  GPL

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

-}
module Synthesizer.Dimensional.Causal.Oscillator (
{-
   static,
   staticAntiAlias,
-}
   freqMod,
{-
   freqModAntiAlias,
-}
   phaseMod,
   phaseFreqMod,
   shapeMod,
   shapeFreqMod,
{-
   staticSample,
   freqModSample,
-}
--   shapeFreqModSample,
   shapeFreqModFromSampledTone,
   shapePhaseFreqModFromSampledTone,
   ) where

import qualified Synthesizer.Dimensional.Causal.Oscillator.Core as OsciCore
import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import Control.Arrow ((<<^), (<<<), second, )

import qualified Synthesizer.Dimensional.Sample as Sample

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

import qualified Synthesizer.Causal.Oscillator as Osci
import Synthesizer.Causal.Filter.NonRecursive (amplify, )

import qualified Synthesizer.Generic.Signal as SigG

-- import qualified Synthesizer.Dimensional.Wave.Smoothed as WaveSmooth
import qualified Synthesizer.Dimensional.Wave.Controlled as WaveCtrl
import qualified Synthesizer.Dimensional.Wave as WaveD
import qualified Synthesizer.Basic.Phase        as Phase

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Process as Proc
import Synthesizer.Dimensional.Process (toFrequencyScalar, )

import qualified Synthesizer.Interpolation as Interpolation

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

import qualified Algebra.RealField          as RealField

import NumericPrelude.Numeric
import NumericPrelude.Base as P


type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) t)
type SampleFrequency u t = Sample.T (Frequency u t) t


{-
{- | oscillator with a functional waveform with constant frequency -}
{-# INLINE static #-}
static :: (RealField.C t, Dim.C u) =>
      WaveD.T amp t y   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (SigS.R s y)
static wave phase =
   staticAuxHom (SigS.fromSamples . Osci.static wave phase)

{- | oscillator with a functional waveform with constant frequency -}
{-# INLINE staticAntiAlias #-}
staticAntiAlias :: (RealField.C t, Dim.C u) =>
      WaveSmooth.T amp t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (SigS.R s y)
staticAntiAlias wave phase =
   staticAuxHom (SigS.fromSamples . Osci.staticAntiAlias wave phase)
-}

{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqMod #-}
freqMod :: (RealField.C t, Dim.C u) =>
      WaveD.T t y   {- ^ waveform -}
   -> Phase.T t        {- ^ start phase -}
   -> Proc.T s u t
         (CausalD.T s (SampleFrequency u t) y)
freqMod :: forall t u y s.
(C t, C u) =>
T t y -> T t -> T s u t (T s (SampleFrequency u t) y)
freqMod T t y
wave T t
phase =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T t y
wave forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
CausalD.^<<) forall a b. (a -> b) -> a -> b
$ forall t u s.
(C t, C u) =>
T t -> T s u t (T s (SampleFrequency u t) (SamplePhase t))
OsciCore.freqMod T t
phase

{-
{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqModAntiAlias #-}
freqModAntiAlias :: (RealField.C t, Dim.C u) =>
      WaveSmooth.T amp t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> Proc.T s u t
         (CausalD.T s (Frequency u t) amp t y)
freqModAntiAlias wave phase =
   freqModAuxHom wave $ \scaleFreq freqAmp w ->
      Osci.freqModAntiAlias w phase <<< scaleFreq freqAmp
-}

{- | oscillator with modulated phase -}
{-# INLINE phaseMod #-}
phaseMod :: (RealField.C t, Dim.C u) =>
      WaveD.T t y       {- ^ waveform -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t
         (CausalD.T s (Sample.Flat t) y)
phaseMod :: forall t u y s.
(C t, C u) =>
T t y -> T (Recip u) t -> T s u t (T s (Flat t) y)
phaseMod T t y
wave T (Recip u) t
freq =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T t y
wave forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
CausalD.^<<) forall a b. (a -> b) -> a -> b
$
   forall t u s.
(C t, C u) =>
T (Recip u) t -> T s u t (T s (Flat t) (SamplePhase t))
OsciCore.phaseMod T (Recip u) t
freq


{- | oscillator with modulated shape -}
{-# INLINE shapeMod #-}
shapeMod :: (RealField.C t, Dim.C u) =>
      WaveCtrl.T c t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t
         (CausalD.T s c y)
shapeMod :: forall t u c y s.
(C t, C u) =>
T c t y -> T t -> T (Recip u) t -> T s u t (T s c y)
shapeMod T c t y
wave T t
phase T (Recip u) t
freq =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T c t y
wave forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
CausalD.^<<) forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (restSample, T amp yv)
CausalD.feedSnd forall a b. (a -> b) -> a -> b
$
   forall t u s.
(C t, C u) =>
T t -> T (Recip u) t -> T s u t (T (Phantom s) Abstract (T (T t)))
OsciCore.static T t
phase T (Recip u) t
freq


{- | oscillator with a functional waveform with modulated phase and frequency -}
{-# INLINE phaseFreqMod #-}
phaseFreqMod :: (RealField.C t, Dim.C u) =>
      WaveD.T t y   {- ^ waveform -}
   -> Proc.T s u t
         (CausalD.T s (Sample.Flat t, SampleFrequency u t) y)
phaseFreqMod :: forall t u y s.
(C t, C u) =>
T t y -> T s u t (T s (Flat t, SampleFrequency u t) y)
phaseFreqMod T t y
wave =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T t y
wave forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
CausalD.^<<) forall a b. (a -> b) -> a -> b
$
   forall t u s.
(C t, C u) =>
T s u t (T s (Flat t, SampleFrequency u t) (SamplePhase t))
OsciCore.phaseFreqMod


{- | oscillator with both shape and frequency modulation -}
{-# INLINE shapeFreqMod #-}
shapeFreqMod :: (RealField.C t, Dim.C u) =>
      WaveCtrl.T c t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> Proc.T s u t
         (CausalD.T s (c, SampleFrequency u t) y)
shapeFreqMod :: forall t u c y s.
(C t, C u) =>
T c t y -> T t -> T s u t (T s (c, SampleFrequency u t) y)
shapeFreqMod T c t y
wave T t
phase =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (T c t y
wave forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
CausalD.^<<) forall a b. (a -> b) -> a -> b
$
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$
   forall t u s.
(C t, C u) =>
T t -> T s u t (T s (SampleFrequency u t) (SamplePhase t))
OsciCore.freqMod T t
phase


{-
We could decouple source time and target time which yields

      DN.T (Dim.Recip u0) t
                   {- ^ source frequency -}
   -> SigP.T u0 (SigA.D v y (SigS.T sig)) y
   -> t -> Phase.T t
   -> Proc.T s u1 t (
        CausalD.T s (DN.T (Dim.Div u0 u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)

but most oftenly we do not need the conversion of the time scale.
If we need it, we can use the frequency modulation function.

We could measure the shape parameter in multiples of the source wave period.
This would yield

      DN.T (Dim.Recip u0) t
                   {- ^ source frequency -}
   -> SigP.T u0 (SigA.D v y (SigS.T sig)) y
   -> t -> Phase.T t
   -> Proc.T s u1 t (
        CausalD.T s (DN.T (Dim.Recip u1) t, DN.T (Dim.Recip u1) t) Amp.Flat (t,t) y)

but this way, adjustment of the shape parameter is coupled to the source period.
-}
{-# INLINE shapeFreqModFromSampledTone #-}
shapeFreqModFromSampledTone ::
    (RealField.C t, SigG.Transform sig yv, Dim.C u) =>
      Interpolation.T t yv
   -> Interpolation.T t yv
   -> DN.T (Dim.Recip u) t
                   {- ^ source frequency -}
   -> SigA.T (Rate.Dimensional u t) amp (sig yv)
   -> t -> Phase.T t
   -> Proc.T s u t
         (CausalD.T s
             (Sample.Flat t, SampleFrequency u t)
             (Sample.T amp yv))
shapeFreqModFromSampledTone :: forall t (sig :: * -> *) yv u amp s.
(C t, Transform sig yv, C u) =>
T t yv
-> T t yv
-> T (Recip u) t
-> T (Dimensional u t) amp (sig yv)
-> t
-> T t
-> T s u t (T s (Flat t, SampleFrequency u t) (T amp yv))
shapeFreqModFromSampledTone
      T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (sig yv)
sampledTone t
shape0 T t
phase =
   let SigA.Cons (Rate.Actual T (Recip u) t
srcRate) amp
amp sig yv
samples = T (Dimensional u t) amp (sig yv)
sampledTone
   in  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) t -> t
toFreq ->
       forall sample0 sample1 s.
(Amplitude sample0
 -> (Amplitude sample1,
     T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \(Flat t
Amp.Flat, Amp.Numeric T (Recip u) t
freqAmp) ->
        (amp
amp,
         forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t) y
Osci.shapeFreqModFromSampledTone
            T t yv
ipLeap T t yv
ipStep
            (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T (Recip u) t
srcRate T (Recip u) t
srcFreq)
            sig yv
samples
            t
shape0 T t
phase
          forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (forall a. C a => a -> T a a
amplify (T (Recip u) t -> t
toFreq T (Recip u) t
freqAmp)))


{-# INLINE shapePhaseFreqModFromSampledTone #-}
shapePhaseFreqModFromSampledTone ::
    (RealField.C t, SigG.Transform sig yv, Dim.C u) =>
      Interpolation.T t yv
   -> Interpolation.T t yv
   -> DN.T (Dim.Recip u) t
                   {- ^ source frequency -}
   -> SigA.T (Rate.Dimensional u t) amp (sig yv)
   -> t -> Phase.T t
   -> Proc.T s u t
         (CausalD.T s
             (Sample.Flat t, Sample.Flat t, SampleFrequency u t)
             (Sample.T amp yv))
shapePhaseFreqModFromSampledTone :: forall t (sig :: * -> *) yv u amp s.
(C t, Transform sig yv, C u) =>
T t yv
-> T t yv
-> T (Recip u) t
-> T (Dimensional u t) amp (sig yv)
-> t
-> T t
-> T s u t (T s (Flat t, Flat t, SampleFrequency u t) (T amp yv))
shapePhaseFreqModFromSampledTone
      T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (sig yv)
sampledTone t
shape0 T t
phase =
   let SigA.Cons (Rate.Actual T (Recip u) t
srcRate) amp
amp sig yv
samples = T (Dimensional u t) amp (sig yv)
sampledTone
   in  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a s u t b. (a -> T s u t b) -> T s u t (a -> b)
Proc.withParam forall t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar) forall a b. (a -> b) -> a -> b
$ \T (Recip u) t -> t
toFreq ->
       forall sample0 sample1 s.
(Amplitude sample0
 -> (Amplitude sample1,
     T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
CausalD.consFlip forall a b. (a -> b) -> a -> b
$ \(Flat t
Amp.Flat, Flat t
Amp.Flat, Amp.Numeric T (Recip u) t
freqAmp) ->
        (amp
amp,
         forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
T t y -> T t y -> t -> sig y -> t -> T t -> T (t, t, t) y
Osci.shapePhaseFreqModFromSampledTone
            T t yv
ipLeap T t yv
ipStep
            (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T (Recip u) t
srcRate T (Recip u) t
srcFreq)
            sig yv
samples
            t
shape0 T t
phase
          forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
          (\(t
s,t
p,t
f) -> (t
s,t
p, T (Recip u) t -> t
toFreq T (Recip u) t
freqAmp forall a. C a => a -> a -> a
* t
f)))
{-
          Causal.packTriple
          ^<<
          second (amplify (toFreq freqAmp))
          <<^
          Causal.unpackTriple
-}