{-# 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 =
   forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> T t -> y
Wave.apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   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 =
   forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> t -> T t -> y
WaveSmooth.apply T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   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 =
   forall t y. T t y -> T t -> y
Wave.apply T a b
wave forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<< 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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall t y. T t y -> T t -> y
Wave.apply forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> T a b
wave) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   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 = forall a. T a -> Int
Sig.length T b
wave
       pr :: a
pr  = forall a b. (C a, C b) => a -> b
fromIntegral Int
len forall a. C a => a -> a -> a
* forall a. T a -> a
Phase.toRepresentative T a
phase
   in  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
         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. (a -> b) -> T a b
Causal.map (forall a b. (C a, C b) => a -> b
fromIntegral Int
len 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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall t y. T t y -> T t -> y
Wave.apply forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
      (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 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
       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 =
   forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
   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
      (forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap) (forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep)
      (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 = forall a b. (C a, C b) => a -> b
round t
period
       marginLeap :: Margin
marginLeap = forall t y. T t y -> Margin
Interpolation.margin T t y
ipLeap
       marginStep :: Margin
marginStep = forall t y. T t y -> Margin
Interpolation.margin T t y
ipStep
   in  (\(t
dp, ((t
s,T t
p), sig y
suffix)) ->
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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) forall a b. (a -> b) -> a -> b
$
          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 forall a b. (a -> b) -> a -> b
$
          ((t
s, forall a. C a => a -> T a -> T a
Phase.increment t
dp T t
p), sig y
suffix))
       forall (a :: * -> * -> *) c d b.
Arrow a =>
(c -> d) -> a b c -> a b d
^<<
       forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Causal.second
          (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))
       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 = forall a b. C a => T a b -> T a -> T a b
freqMod 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 = forall a b. C a => T a b -> a -> T a b
phaseMod 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 = forall a b. C a => T a b -> T a -> T a b
freqMod forall a. C a => T a a
Wave.saw