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

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

Tone generators
-}
module Synthesizer.Causal.Oscillator where

import qualified Synthesizer.Causal.Oscillator.Core as Osci
import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.Causal.Interpolation as InterpolationC
import qualified Synthesizer.Causal.ToneModulation as ToneMod

import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave         as Wave
import qualified Synthesizer.Basic.Phase        as Phase

import qualified Synthesizer.Interpolation as Interpolation
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.State.Signal as Sig

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

import Control.Arrow ((^<<), (<<^), (<<<), (***), )

import NumericPrelude.Numeric
import NumericPrelude.Base



{- * Oscillators with arbitrary but constant waveforms -}

{-
{-# INLINE static #-}
{- | oscillator with constant frequency -}
static :: (RealRing.C a) =>
   Wave.T a b -> (Phase.T a -> a -> Sig.T b)
static wave phase freq =
   Sig.map (Wave.apply wave) (Osci.static phase freq)
-}


{-# INLINE phaseMod #-}
{- | oscillator with modulated phase -}
phaseMod :: (RealRing.C a) =>
   Wave.T a b -> a -> Causal.T a b
phaseMod :: forall a b. C a => T a b -> a -> T a b
phaseMod T a b
wave a
freq =
   T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave (T a -> b) -> T a (T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< a -> T a (T a)
forall a. C a => a -> T a (T a)
Osci.phaseMod a
freq

{-# INLINE shapeMod #-}
{- | oscillator with modulated shape -}
shapeMod :: (RealRing.C a) =>
   (c -> Wave.T a b) -> Phase.T a -> a -> Causal.T c b
shapeMod :: forall a c b. C a => (c -> T a b) -> T a -> a -> T c b
shapeMod c -> T a b
wave T a
phase a
freq =
   (c -> T a -> b) -> (c, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply (T a b -> T a -> b) -> (c -> T a b) -> c -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) ((c, T a) -> b) -> T c (c, T a) -> T c b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   T a -> a -> T c (c, T a)
forall a c. C a => T a -> a -> T c (c, T a)
Osci.shapeMod T a
phase a
freq


{-# INLINE freqMod #-}
{- | oscillator with modulated frequency -}
freqMod :: (RealRing.C a) =>
   Wave.T a b -> Phase.T a -> Causal.T a b
freqMod :: forall a b. C a => T a b -> T a -> T a b
freqMod T a b
wave T a
phase =
   T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave (T a -> b) -> T a (T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T a -> T a (T a)
forall a. C a => T a -> T a (T a)
Osci.freqMod T a
phase

{-# INLINE freqModAntiAlias #-}
{- | oscillator with modulated frequency -}
freqModAntiAlias :: (RealRing.C a) =>
   WaveSmooth.T a b -> Phase.T a -> Causal.T a b
freqModAntiAlias :: forall a b. C a => T a b -> T a -> T a b
freqModAntiAlias T a b
wave T a
phase =
   (a -> T a -> b) -> (a, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a b -> a -> T a -> b
forall t y. T t y -> t -> T t -> y
WaveSmooth.apply T a b
wave) ((a, T a) -> b) -> T a (a, T a) -> T a b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   T a -> T a (a, T a)
forall a. C a => T a -> T a (a, T a)
Osci.freqModAntiAlias T a
phase

{-# INLINE phaseFreqMod #-}
{- | oscillator with both phase and frequency modulation -}
phaseFreqMod :: (RealRing.C a) =>
   Wave.T a b -> Causal.T (a,a) b
phaseFreqMod :: forall a b. C a => T a b -> T (a, a) b
phaseFreqMod T a b
wave =
   T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave (T a -> b) -> T (a, a) (T a) -> T (a, a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< T (a, a) (T a)
forall a. C a => T (a, a) (T a)
Osci.phaseFreqMod

{-# INLINE shapeFreqMod #-}
{- | oscillator with both shape and frequency modulation -}
shapeFreqMod :: (RealRing.C a) =>
   (c -> Wave.T a b) -> Phase.T a -> Causal.T (c,a) b
shapeFreqMod :: forall a c b. C a => (c -> T a b) -> T a -> T (c, a) b
shapeFreqMod c -> T a b
wave T a
phase =
   (c -> T a -> b) -> (c, T a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply (T a b -> T a -> b) -> (c -> T a b) -> c -> T a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) ((c, T a) -> b) -> T (c, a) (c, T a) -> T (c, a) b
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   T a -> T (c, a) (c, T a)
forall a c. C a => T a -> T (c, a) (c, T a)
Osci.shapeFreqMod T a
phase


{-
{- | oscillator with a sampled waveform with constant frequency
    This essentially an interpolation with cyclic padding. -}
{-# INLINE staticSample #-}
staticSample :: RealRing.C a =>
   Interpolation.T a b -> Sig.T b -> Phase.T a -> a -> Sig.T b
staticSample ip wave phase freq =
   Causal.apply (freqModSample ip wave phase) (Sig.repeat freq)
-}

{- | oscillator with a sampled waveform with modulated frequency
    Should behave homogenously for different types of interpolation. -}
{-# INLINE freqModSample #-}
freqModSample :: RealRing.C a =>
   Interpolation.T a b -> Sig.T b -> Phase.T a -> Causal.T a b
freqModSample :: forall a b. C a => T a b -> T b -> T a -> T a b
freqModSample T a b
ip T b
wave T a
phase =
   let len :: Int
len = T b -> Int
forall a. T a -> Int
Sig.length T b
wave
       pr :: a
pr  = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
len a -> a -> a
forall a. C a => a -> a -> a
* T a -> a
forall a. T a -> a
Phase.toRepresentative T a
phase
   in  T a b -> a -> T b -> T a b
forall t y. C t => T t y -> t -> T y -> T t y
InterpolationC.relativeCyclicPad T a b
ip a
pr T b
wave
         T a b -> T a a -> T a b
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Causal.map (Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral Int
len a -> a -> a
forall a. C a => a -> a -> a
*)


{-# INLINE shapeFreqModSample #-}
shapeFreqModSample :: (RealRing.C c, RealRing.C b) =>
   Interpolation.T c (Wave.T b a) -> Sig.T (Wave.T b a) ->
   c -> Phase.T b ->
   Causal.T (c, b) a
shapeFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> T (T b a) -> c -> T b -> T (c, b) a
shapeFreqModSample T c (T b a)
ip T (T b a)
waves c
shape0 T b
phase =
   (T b a -> T b -> a) -> (T b a, T b) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply ((T b a, T b) -> a) -> T (c, b) (T b a, T b) -> T (c, b) a
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
      (T c (T b a) -> c -> T (T b a) -> T c (T b a)
forall t y. C t => T t y -> t -> T y -> T t y
InterpolationC.relativeConstantPad T c (T b a)
ip c
shape0 T (T b a)
waves T c (T b a) -> T b (T b) -> T (c, b) (T b a, T b)
forall b c b' c'. T b c -> T b' c' -> T (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
       T b -> T b (T b)
forall a. C a => T a -> T a (T a)
Osci.freqMod T b
phase)

{-# INLINE shapeFreqModFromSampledTone #-}
shapeFreqModFromSampledTone ::
   (RealField.C t, SigG.Transform sig y) =>
   Interpolation.T t y ->
   Interpolation.T t y ->
   t -> sig y ->
   t -> Phase.T t ->
   Causal.T (t,t) y
shapeFreqModFromSampledTone :: 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
shapeFreqModFromSampledTone
      T t y
ipLeap T t y
ipStep t
period sig y
sampledTone t
shape0 T t
phase =
   ((t, t) -> Cell sig y -> y) -> ((t, t), Cell sig y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell sig y -> y
forall (sig :: * -> *) y a b.
Read sig y =>
T a y -> T b y -> (a, b) -> Cell sig y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell sig y) -> y)
-> T (t, t) ((t, t), Cell sig y) -> T (t, t) y
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, t), Cell sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, t), Cell sig y)
ToneMod.oscillatorCells
      (T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap) (T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep)
      (t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period) t
period sig y
sampledTone
      (t
shape0, T t
phase)

{-# INLINE shapePhaseFreqModFromSampledTone #-}
shapePhaseFreqModFromSampledTone ::
   (RealField.C t, SigG.Transform sig y) =>
   Interpolation.T t y ->
   Interpolation.T t y ->
   t -> sig y ->
   t -> Phase.T t ->
   Causal.T (t,t,t) y
shapePhaseFreqModFromSampledTone :: 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
shapePhaseFreqModFromSampledTone
      T t y
ipLeap T t y
ipStep t
period sig y
sampledTone t
shape0 T t
phase =
   let periodInt :: Int
periodInt = t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period
       marginLeap :: Margin
marginLeap = T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap
       marginStep :: Margin
marginStep = T t y -> Margin
forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep
   in  (\(t
dp, ((t
s,T t
p), sig y
suffix)) ->
          ((t, t) -> Cell sig y -> y) -> ((t, t), Cell sig y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell sig y -> y
forall (sig :: * -> *) y a b.
Read sig y =>
T a y -> T b y -> (a, b) -> Cell sig y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell sig y) -> y) -> ((t, t), Cell sig y) -> y
forall a b. (a -> b) -> a -> b
$
          Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Int -> t -> ((t, T t), sig y) -> ((t, t), Cell sig y)
ToneMod.seekCell Int
periodInt t
period (((t, T t), sig y) -> ((t, t), Cell sig y))
-> ((t, T t), sig y) -> ((t, t), Cell sig y)
forall a b. (a -> b) -> a -> b
$
          ((t
s, t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.increment t
dp T t
p), sig y
suffix))
       ((t, ((t, T t), sig y)) -> y)
-> T (t, t, t) (t, ((t, T t), sig y)) -> T (t, t, t) y
forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
       T (t, t) ((t, T t), sig y) -> T (t, (t, t)) (t, ((t, T t), sig y))
forall b c d. T b c -> T (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second
          (Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
forall t (sig :: * -> *) y.
(C t, Transform sig y) =>
Margin
-> Margin
-> Int
-> t
-> sig y
-> (t, T t)
-> T (t, t) ((t, T t), sig y)
ToneMod.oscillatorSuffixes
             Margin
marginLeap Margin
marginStep
             Int
periodInt t
period sig y
sampledTone
             (t
shape0, T t
phase))
       T (t, (t, t)) (t, ((t, T t), sig y))
-> ((t, t, t) -> (t, (t, t))) -> T (t, t, t) (t, ((t, T t), sig y))
forall (a :: * -> * -> *) c d b.
Arrow a =>
a c d -> (b -> c) -> a b d
<<^
       (\(t
s,t
p,t
f) -> (t
p,(t
s,t
f)))


{- * Oscillators with specific waveforms -}

{-
{-# INLINE staticSine #-}
{- | sine oscillator with static frequency -}
staticSine :: (Trans.C a, RealField.C a) => Phase.T a -> a -> Sig.T a
staticSine = static Wave.sine
-}

{-# INLINE freqModSine #-}
{- | sine oscillator with modulated frequency -}
freqModSine :: (Trans.C a, RealRing.C a) => Phase.T a -> Causal.T a a
freqModSine :: forall a. (C a, C a) => T a -> T a a
freqModSine = T a a -> T a -> T a a
forall a b. C a => T a b -> T a -> T a b
freqMod T a a
forall a. C a => T a a
Wave.sine

{-# INLINE phaseModSine #-}
{- | sine oscillator with modulated phase, useful for FM synthesis -}
phaseModSine :: (Trans.C a, RealRing.C a) => a -> Causal.T a a
phaseModSine :: forall a. (C a, C a) => a -> T a a
phaseModSine = T a a -> a -> T a a
forall a b. C a => T a b -> a -> T a b
phaseMod T a a
forall a. C a => T a a
Wave.sine

{-
{-# INLINE staticSaw #-}
{- | saw tooth oscillator with modulated frequency -}
staticSaw :: RealRing.C a => Phase.T a -> a -> Sig.T a
staticSaw = static Wave.saw
-}

{-# INLINE freqModSaw #-}
{- | saw tooth oscillator with modulated frequency -}
freqModSaw :: RealRing.C a => Phase.T a -> Causal.T a a
freqModSaw :: forall a. C a => T a -> T a a
freqModSaw = T a a -> T a -> T a a
forall a b. C a => T a b -> T a -> T a b
freqMod T a a
forall a. C a => T a a
Wave.saw