{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{- |
Copyright   :  (c) Henning Thielemann 2008-2010
License     :  GPL

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


This module contains various oscillators that respect physical dimensions.
By using the type variable @amp@ we show,
that the oscillators are homogeneous functions.
But since there are even no restrictions on the sample type,
we even show that values from the waveform
go untouched to the output signal.
-}
module Synthesizer.Dimensional.Rate.Oscillator (
   {- * Oscillators with constant waveforms -}
   static,
--   staticAntiAlias,
   freqMod,
--   freqModAntiAlias,
   phaseMod,
   phaseFreqMod,
   shapeMod,
   shapeFreqMod,
   staticSample,
   freqModSample,
--   shapeFreqModSample,
   shapeFreqModFromSampledTone,
   shapePhaseFreqModFromSampledTone,
   ) where

import qualified Synthesizer.Dimensional.Causal.Oscillator as OsciC
import qualified Synthesizer.State.Oscillator as Osci
import qualified Synthesizer.State.Signal as Sig

import qualified Synthesizer.Dimensional.Causal.Process as CausalD
import qualified Synthesizer.Dimensional.Causal.Oscillator.Core as OsciCore
import qualified Synthesizer.Dimensional.Map as MapD

import qualified Synthesizer.Dimensional.Sample as Sample
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
-- import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

-- 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.Cyclic.Signal as SigC

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 NumericPrelude.Numeric
import NumericPrelude.Base as P



type Signal s amp y =
   SigA.T (Rate.Phantom s) amp (Sig.T y)


{- * Oscillators with constant waveforms -}

{- | oscillator with a functional waveform with constant frequency -}
{-# INLINE static #-}
static ::
   (RealField.C t, Dim.C u) =>
      WaveD.T t (Sample.T amp y)       {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (Signal s amp y)
static :: forall t u amp y s.
(C t, C u) =>
T t (T amp y) -> T t -> T (Recip u) t -> T s u t (Signal s amp y)
static T t (T amp y)
wave T t
phase T (Recip u) t
freq =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (sig :: * -> *) yv0 yv1 amp0 amp1 rate.
(Transform sig yv0, Transform sig yv1) =>
Single amp0 amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
MapD.apply T t (T amp y)
wave) 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 constant frequency -}
{-# INLINE staticAntiAlias #-}
staticAntiAlias ::
   (RealField.C t, Dim.C u,
    Smooth amp t wave sig) =>
      WaveD.T t (Sample.T amp y)
                   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (Signal s amp y)
staticAntiAlias wave phase =
   staticAux (\freq -> withWave wave $ \w -> Osci.staticAntiAlias w phase freq)
-}

{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqMod #-}
freqMod ::
   (RealField.C t, Dim.C u) =>
      WaveD.T t (Sample.T amp y)       {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> Proc.T s u t (
        SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> Signal s amp y)
freqMod :: forall t u amp y s.
(C t, C u) =>
T t (T amp y)
-> T t -> T s u t (R s (Recip u) t t -> Signal s amp y)
freqMod T t (T amp y)
wave T t
phase =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
CausalD.apply forall a b. (a -> b) -> a -> b
$
   forall t u y s.
(C t, C u) =>
T t y -> T t -> T s u t (T s (SampleFrequency u t) y)
OsciC.freqMod T t (T amp y)
wave T t
phase

{-
{- | oscillator with a functional waveform with modulated frequency -}
{-# INLINE freqModAntiAlias #-}
freqModAntiAlias ::
   (RealField.C t, Dim.C u,
    Smooth amp t wave sig) =>
      WaveD.T t (Sample.T amp y)
                   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> Proc.T s u t (
        SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> Signal s amp y)
freqModAntiAlias wave phase =
   freqModAux (\t -> withWave wave $ \w -> Osci.freqModAntiAlias w phase t)
-}

{- | oscillator with modulated phase -}
{-# INLINE phaseMod #-}
phaseMod ::
   (Flat.C t flat, RealField.C t, Dim.C u) =>
      WaveD.T t (Sample.T amp y)       {- ^ waveform -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (
        Signal s flat t
                   {- v phase modulation, phases must have no unit -}
     -> Signal s amp y)
phaseMod :: forall t flat u amp y s.
(C t flat, C t, C u) =>
T t (T amp y)
-> T (Recip u) t -> T s u t (Signal s flat t -> Signal s amp y)
phaseMod T t (T amp y)
wave T (Recip u) t
freq =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall yv0 amp0 (sig :: * -> *) yv1 s amp1.
(C yv0 amp0, Transform sig yv0, Transform sig yv1) =>
Single s (Flat yv0) amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
CausalD.applyFlat forall a b. (a -> b) -> a -> b
$
   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)
OsciC.phaseMod T t (T amp y)
wave T (Recip u) t
freq

{- | oscillator with modulated shape -}
{-# INLINE shapeMod #-}
shapeMod ::
   (RealField.C t, Dim.C u) =>
      WaveCtrl.T (Sample.T cAmp c) t (Sample.T amp y)
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (
        Signal s cAmp c {- v shape control -}
     -> Signal s amp y)
shapeMod :: forall t u cAmp c amp y s.
(C t, C u) =>
T (T cAmp c) t (T amp y)
-> T t
-> T (Recip u) t
-> T s u t (Signal s cAmp c -> Signal s amp y)
shapeMod T (T cAmp c) t (T amp y)
wave T t
phase T (Recip u) t
freq =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
CausalD.apply forall a b. (a -> b) -> a -> b
$
   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)
OsciC.shapeMod T (T cAmp c) t (T amp y)
wave T t
phase T (Recip u) t
freq

{- | oscillator with a functional waveform with modulated phase and frequency -}
{-# INLINE phaseFreqMod #-}
phaseFreqMod ::
   (Flat.C t flat, RealField.C t, Dim.C u) =>
      WaveD.T t (Sample.T amp y)       {- ^ waveform -}
   -> Proc.T s u t (
        Signal s flat t
                     {- v phase control -}
     -> SigA.R s (Dim.Recip u) t t
                     {- v frequency control -}
     -> Signal s amp y)
phaseFreqMod :: forall t flat u amp y s.
(C t flat, C t, C u) =>
T t (T amp y)
-> T s u t (Signal s flat t -> R s (Recip u) t t -> Signal s amp y)
phaseFreqMod T t (T amp y)
wave =
   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 t u y s.
(C t, C u) =>
T t y -> T s u t (T s (Flat t, SampleFrequency u t) y)
OsciC.phaseFreqMod T t (T amp y)
wave) forall a b. (a -> b) -> a -> b
$ \T s (Flat t, SampleFrequency u t) (T amp y)
osci Signal s flat t
phases R s (Recip u) t t
freqs ->
      forall yv amp (sig :: * -> *) s restSampleIn restSampleOut.
(C yv amp, Read sig yv) =>
T s (T (Flat yv) yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
CausalD.applyFlatFst T s (Flat t, SampleFrequency u t) (T amp y)
osci Signal s flat t
phases
      forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
`CausalD.apply`
      R s (Recip u) t t
freqs

{- | oscillator with both shape and frequency modulation -}
{-# INLINE shapeFreqMod #-}
shapeFreqMod :: (RealField.C t, Dim.C u) =>
      WaveCtrl.T (Sample.T cAmp c) t (Sample.T amp y)
                   {- ^ waveform -}
   -> Phase.T t    {- ^ phase -}
   -> Proc.T s u t (
        Signal s cAmp c
                     {- v shape control -}
     -> SigA.R s (Dim.Recip u) t t
                     {- v frequency control -}
     -> Signal s amp y)
shapeFreqMod :: forall t u cAmp c amp y s.
(C t, C u) =>
T (T cAmp c) t (T amp y)
-> T t
-> T s u t (Signal s cAmp c -> R s (Recip u) t t -> Signal s amp y)
shapeFreqMod T (T cAmp c) t (T amp y)
wave T t
phase =
   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 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)
OsciC.shapeFreqMod T (T cAmp c) t (T amp y)
wave T t
phase) forall a b. (a -> b) -> a -> b
$ \T s (T cAmp c, SampleFrequency u t) (T amp y)
osci Signal s cAmp c
shapes R s (Recip u) t t
freqs ->
      forall (sig :: * -> *) yv s amp restSampleIn restSampleOut.
Read sig yv =>
T s (T amp yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
CausalD.applyFst T s (T cAmp c, SampleFrequency u t) (T amp y)
osci Signal s cAmp c
shapes
      forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
`CausalD.apply`
      R s (Recip u) t t
freqs


{- |
oscillator with a sampled waveform with constant frequency
This is essentially an interpolation with cyclic padding.
You can also achieve this with a waveform constructed by 'Wave.sample'.
-}
{-# INLINE staticSample #-}
staticSample :: (RealField.C t, Dim.C u) =>
      Interpolation.T t y
   -> SigA.T rate amp (SigC.T (Sig.T y))   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> DN.T (Dim.Recip u) t
                   {- ^ frequency -}
   -> Proc.T s u t (Signal s amp y)
staticSample :: forall t u y rate amp s.
(C t, C u) =>
T t y
-> T rate amp (T (T y))
-> T t
-> T (Recip u) t
-> T s u t (Signal s amp y)
staticSample T t y
ip T rate amp (T (T y))
wave T t
phase T (Recip u) t
freq =
   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 t u s. (C t, C u) => T (Recip u) t -> T s u t t
toFrequencyScalar T (Recip u) t
freq) forall a b. (a -> b) -> a -> b
$
      forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom (forall rate amplitude body. T rate amplitude body -> amplitude
SigA.amplitude T rate amp (T (T y))
wave) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a b. C a => T a b -> T b -> T a -> a -> T b
Osci.staticSample T t y
ip (forall period. T period -> period
SigC.toPeriod forall a b. (a -> b) -> a -> b
$ forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate amp (T (T y))
wave) T t
phase

{- |
oscillator with a sampled waveform with modulated frequency
Should behave homogenously for different types of interpolation.
-}
{-# INLINE freqModSample #-}
freqModSample :: (RealField.C t, Dim.C u) =>
      Interpolation.T t y
   -> SigA.T rate amp (SigC.T (Sig.T y))   {- ^ waveform -}
   -> Phase.T t    {- ^ start phase -}
   -> Proc.T s u t (
        SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> Signal s amp y)
freqModSample :: forall t u y rate amp s.
(C t, C u) =>
T t y
-> T rate amp (T (T y))
-> T t
-> T s u t (R s (Recip u) t t -> Signal s amp y)
freqModSample T t y
ip T rate amp (T (T y))
wave T t
phase =
   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 rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom (forall rate amplitude body. T rate amplitude body -> amplitude
SigA.amplitude T rate amp (T (T y))
wave) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a b. C a => T a b -> T b -> T a -> T a -> T b
Osci.freqModSample T t y
ip (forall period. T period -> period
SigC.toPeriod forall a b. (a -> b) -> a -> b
$ forall rate amplitude body. T rate amplitude body -> body
SigA.body T rate amp (T (T y))
wave) T t
phase forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall y (sig :: * -> *) amp rate.
(C y, Transform sig y) =>
(amp -> y) -> T rate (Numeric amp) (sig y) -> sig y
SigA.scalarSamples T (Recip u) t -> t
toFreq


{-
{-# INLINE shapeFreqModSample #-}
shapeFreqModSample :: (RealField.C c, RealField.C t) =>
      Interpolation.T c (Wave.T t y)
   -> sig (Wave.T t y)
   -> c -> Phase.T t
   -> Proc.T s u t (
        Signal s flat c
                   {- v shape control -}
     -> SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> SigS.R s y)
shapeFreqModSample ip waves shape0 phase =
    uncurry Wave.apply ^<<
       (InterpolationC.relativeConstantPad ip shape0 waves ***
        freqsToPhases phase)
-}

{-# INLINE shapeFreqModFromSampledTone #-}
shapeFreqModFromSampledTone ::
    (RealField.C t, Dim.C u, Flat.C t flat) =>
      Interpolation.T t yv
   -> Interpolation.T t yv
   -> DN.T (Dim.Recip u) t
                   {- ^ source frequency -}
   -> SigA.T (Rate.Dimensional u t) amp (Sig.T yv)
   -> t -> Phase.T t
   -> Proc.T s u t (
        Signal s flat t
                   {- v shape control -}
     -> SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> Signal s amp yv)
shapeFreqModFromSampledTone :: forall t u flat yv amp s.
(C t, C u, C t flat) =>
T t yv
-> T t yv
-> T (Recip u) t
-> T (Dimensional u t) amp (T yv)
-> t
-> T t
-> T s
     u
     t
     (Signal s flat t -> R s (Recip u) t t -> Signal s amp yv)
shapeFreqModFromSampledTone
      T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (T yv)
sampledTone t
shape0 T t
phase =
   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 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))
OsciC.shapeFreqModFromSampledTone
         T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (T yv)
sampledTone t
shape0 T t
phase)
      (\T s (Flat t, SampleFrequency u t) (T amp yv)
osci ->
         \Signal s flat t
shapes R s (Recip u) t t
freqs ->
            T s (Flat t, SampleFrequency u t) (T amp yv)
osci
            forall yv amp (sig :: * -> *) s restSampleIn restSampleOut.
(C yv amp, Read sig yv) =>
T s (T (Flat yv) yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
`CausalD.applyFlatFst`
            Signal s flat t
shapes
            forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
`CausalD.apply`
            R s (Recip u) t t
freqs)


{-# INLINE shapePhaseFreqModFromSampledTone #-}
shapePhaseFreqModFromSampledTone ::
    (RealField.C t, Dim.C u, Flat.C t flatS, Flat.C t flatP) =>
      Interpolation.T t yv
   -> Interpolation.T t yv
   -> DN.T (Dim.Recip u) t
                   {- ^ source frequency -}
   -> SigA.T (Rate.Dimensional u t) amp (Sig.T yv)
   -> t -> Phase.T t
   -> Proc.T s u t (
        Signal s flatS t
                   {- v shape control -}
     -> Signal s flatP t
                   {- v phase control -}
     -> SigA.R s (Dim.Recip u) t t
                   {- v frequency control -}
     -> Signal s amp yv)
shapePhaseFreqModFromSampledTone :: forall t u flatS flatP yv amp s.
(C t, C u, C t flatS, C t flatP) =>
T t yv
-> T t yv
-> T (Recip u) t
-> T (Dimensional u t) amp (T yv)
-> t
-> T t
-> T s
     u
     t
     (Signal s flatS t
      -> Signal s flatP t -> R s (Recip u) t t -> Signal s amp yv)
shapePhaseFreqModFromSampledTone
      T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (T yv)
sampledTone t
shape0 T t
phase =
   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 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))
OsciC.shapePhaseFreqModFromSampledTone
         T t yv
ipLeap T t yv
ipStep T (Recip u) t
srcFreq T (Dimensional u t) amp (T yv)
sampledTone t
shape0 T t
phase)
      (\T s (Flat t, Flat t, SampleFrequency u t) (T amp yv)
osci ->
         \Signal s flatS t
shapes Signal s flatP t
phaseDistort R s (Recip u) t t
freqs ->
            (T s (Flat t, Flat t, SampleFrequency u t) (T amp yv)
osci forall s sample1 sample2 sample0.
T s sample1 sample2 -> T sample0 sample1 -> T s sample0 sample2
CausalD.<<^ forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow (sample0, (sample1, sample2)) (sample0, sample1, sample2)
MapD.packTriple)
            forall yv amp (sig :: * -> *) s restSampleIn restSampleOut.
(C yv amp, Read sig yv) =>
T s (T (Flat yv) yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
`CausalD.applyFlatFst`
            Signal s flatS t
shapes
            forall yv amp (sig :: * -> *) s restSampleIn restSampleOut.
(C yv amp, Read sig yv) =>
T s (T (Flat yv) yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
`CausalD.applyFlatFst`
            Signal s flatP t
phaseDistort
            forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
`CausalD.apply`
            R s (Recip u) t t
freqs)