{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Copyright   :  (c) Henning Thielemann 2009
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.Process as CausalD
import qualified Synthesizer.Causal.Process as Causal
import Control.Arrow ((<<^), (<<<), second, )

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

import qualified Synthesizer.Causal.Oscillator as Osci

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.Wave         as Wave
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 Number.DimensionTerm ((&*&))

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

import NumericPrelude
import PreludeBase as P


type Frequency u t = Amp.Numeric (DN.T (Dim.Recip u) 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 amp t y   {- ^ waveform -}
   -> Phase.T t        {- ^ start phase -}
   -> Proc.T s u t
         (CausalD.T s (Frequency u t) amp t y)
freqMod wave phase =
   staticAuxHom wave $ \toFreq (Amp.Numeric freqAmp) w ->
      Osci.freqMod w phase <<< amplify (toFreq freqAmp)

{-
{- | 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 amp t y       {- ^ waveform -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t
         (CausalD.T s (Amp.Flat t) amp t y)
phaseMod wave freq =
   staticAuxHom wave $ \toFreq Amp.Flat w ->
      Osci.phaseMod w $ toFreq freq

{- | oscillator with modulated shape -}
{-# INLINE shapeMod #-}
shapeMod :: (RealField.C t, Dim.C u) =>
      WaveCtrl.T amp c t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t
         (CausalD.T s (Amp.Flat c) amp c y)
shapeMod wave phase freq =
   staticAuxCtrl wave $ \toFreq Amp.Flat w ->
      Osci.shapeMod w phase $ toFreq freq


{- | oscillator with a functional waveform with modulated phase and frequency -}
{-# INLINE phaseFreqMod #-}
phaseFreqMod :: (RealField.C t, Dim.C u) =>
      WaveD.T amp t y   {- ^ waveform -}
   -> Proc.T s u t
         (CausalD.T s (Amp.Flat t, Frequency u t) amp (t,t) y)
phaseFreqMod wave =
   freqModAuxHom wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->
      Osci.phaseFreqMod w <<< second (scaleFreq freqAmp)

{- | oscillator with both shape and frequency modulation -}
{-# INLINE shapeFreqMod #-}
shapeFreqMod :: (RealField.C t, Dim.C u) =>
      WaveCtrl.T amp c t y
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> Proc.T s u t
         (CausalD.T s (Amp.Flat c, Frequency u t) amp (c,t) y)
shapeFreqMod wave phase =
   freqModAuxCtrl wave $ \scaleFreq (Amp.Flat, Amp.Numeric freqAmp) w ->
      Osci.shapeFreqMod w phase <<< second (scaleFreq freqAmp)


{-
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
             (Amp.Flat t, Frequency u t) amp
             (t,t) yv)
shapeFreqModFromSampledTone
      ipLeap ipStep srcFreq sampledTone shape0 phase =
   let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone
   in  flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
       CausalD.consFlip $ \(Amp.Flat, Amp.Numeric freqAmp) ->
        (amp,
         Osci.shapeFreqModFromSampledTone
            ipLeap ipStep
            (DN.divToScalar srcRate srcFreq)
            samples
            shape0 phase
          <<< second (amplify (toFreq 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
             (Amp.Flat t, Amp.Flat t, Frequency u t) amp
             (t,t,t) yv)
shapePhaseFreqModFromSampledTone
      ipLeap ipStep srcFreq sampledTone shape0 phase =
   let SigA.Cons (Rate.Actual srcRate) amp samples = sampledTone
   in  flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
       CausalD.consFlip $ \(Amp.Flat, Amp.Flat, Amp.Numeric freqAmp) ->
        (amp,
         Osci.shapePhaseFreqModFromSampledTone
            ipLeap ipStep
            (DN.divToScalar srcRate srcFreq)
            samples
            shape0 phase
          <<^
          (\(s,p,f) -> (s,p, toFreq freqAmp * f)))
{-
          Causal.packTriple
          ^<<
          second (amplify (toFreq freqAmp))
          <<^
          Causal.unpackTriple
-}

-- helper functions

{-# INLINE freqModAuxCtrl #-}
freqModAuxCtrl :: (Dim.C u, Field.C t) =>
   WaveCtrl.T amp1 c t y ->
   ((DN.T (Dim.Recip u) t -> Causal.T t t) ->
    amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->
   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
freqModAuxCtrl wave f =
   staticAuxCtrl wave $ \toFreq -> f (amplify . toFreq)

{-# INLINE staticAuxCtrl #-}
staticAuxCtrl :: (Dim.C u, Field.C t) =>
   WaveCtrl.T amp1 c t y ->
   ((DN.T (Dim.Recip u) t -> t) ->
    amp0 -> (c -> Wave.T t y) -> Causal.T yv0 yv1) ->
   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
staticAuxCtrl (WaveCtrl.Cons amp1 wave) f =
   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
   CausalD.consFlip $ \amp0 ->
      (amp1, f toFreq amp0 wave)


{-# INLINE freqModAuxHom #-}
freqModAuxHom :: (Dim.C u, Field.C t) =>
   WaveD.T amp1 t y ->
   ((DN.T (Dim.Recip u) t -> Causal.T t t) ->
    amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->
   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
freqModAuxHom wave f =
   staticAuxHom wave $ \toFreq amp0 w -> f (amplify . toFreq) amp0 w

{-# INLINE staticAuxHom #-}
staticAuxHom :: (Dim.C u, Field.C t) =>
   WaveD.T amp1 t y ->
   ((DN.T (Dim.Recip u) t -> t) ->
    amp0 -> Wave.T t y -> Causal.T yv0 yv1) ->
   Proc.T s u t (CausalD.T s amp0 amp1 yv0 yv1)
staticAuxHom (WaveD.Cons amp1 wave) f =
   flip fmap (Proc.withParam toFrequencyScalar) $ \toFreq ->
   CausalD.consFlip $ \amp0 ->
      (amp1, f toFreq amp0 wave)


-- ToDo: move to Causal.Filter
amplify :: (Ring.C a) => a -> Causal.T a a
amplify x = Causal.map (x Ring.*)