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

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

Tone generators

Frequencies are always specified in ratios of the sample rate,
e.g. the frequency 0.01 for the sample rate 44100 Hz
means a physical frequency of 441 Hz.
-}
module Synthesizer.Plain.Oscillator where

import qualified Synthesizer.Plain.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Plain.Interpolation as Interpolation
import qualified Synthesizer.Plain.Signal as Sig

import Synthesizer.Plain.ToneModulation (freqsToPhases, )

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

import Data.Tuple.HT (mapFst, mapSnd, )

import NumericPrelude.Numeric
import NumericPrelude.Base


type Phase a = a


{- * Oscillators with arbitrary but constant waveforms -}

{- | oscillator with constant frequency -}
static :: (RealRing.C a) => Wave.T a b -> (Phase a -> a -> Sig.T b)
static :: forall a b. C a => T a b -> a -> a -> T b
static T a b
wave a
phase a
freq =
    (T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
        ((T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase))

{- | oscillator with modulated frequency -}
freqMod :: (RealRing.C a) => Wave.T a b -> Phase a -> Sig.T a -> Sig.T b
freqMod :: forall a b. C a => T a b -> a -> T a -> T b
freqMod T a b
wave a
phase T a
freqs =
    (T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
        (T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase) T a
freqs)

{- | oscillator with modulated phase -}
phaseMod :: (RealRing.C a) => Wave.T a b -> a -> Sig.T (Phase a) -> Sig.T b
phaseMod :: forall a b. C a => T a b -> a -> T a -> T b
phaseMod T a b
wave a
freq T a
phases =
    (T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (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] -> [b]
forall a b. (a -> b) -> a -> b
$
    (a -> T a -> T a) -> T a -> [T a] -> [T a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment T a
phases ((T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) T a
forall a. C a => a
zero)

{- | oscillator with modulated shape -}
shapeMod ::
    (RealRing.C a) => (c -> Wave.T a b) -> (Phase a) -> a -> Sig.T c -> Sig.T b
shapeMod :: forall a c b. C a => (c -> T a b) -> a -> a -> T c -> T b
shapeMod c -> T a b
wave a
phase a
freq T c
parameters =
    (c -> T a -> b) -> T c -> [T a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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) T c
parameters ([T a] -> [b]) -> [T a] -> [b]
forall a b. (a -> b) -> a -> b
$
    (T a -> T a) -> T a -> [T a]
forall a. (a -> a) -> a -> [a]
iterate (a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment a
freq) (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase)

{- | oscillator with both phase and frequency modulation -}
phaseFreqMod ::
    (RealRing.C a) => Wave.T a b -> Sig.T (Phase a) -> Sig.T a -> Sig.T b
phaseFreqMod :: forall a b. C a => T a b -> T a -> T a -> T b
phaseFreqMod T a b
wave T a
phases T a
freqs =
    (T a -> b) -> [T a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (T a b -> T a -> b
forall t y. T t y -> T t -> y
Wave.apply T a b
wave)
        ((a -> T a -> T a) -> T a -> [T a] -> [T a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> T a -> T a
forall a. C a => a -> T a -> T a
Phase.increment T a
phases (T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases T a
forall a. C a => a
zero T a
freqs))

{- | oscillator with both shape and frequency modulation -}
shapeFreqMod ::
    (RealRing.C a) =>
    (c -> Wave.T a b) -> Phase a -> Sig.T c -> Sig.T a -> Sig.T b
shapeFreqMod :: forall a c b. C a => (c -> T a b) -> a -> T c -> T a -> T b
shapeFreqMod c -> T a b
wave a
phase T c
parameters T a
freqs =
    (c -> T a -> b) -> T c -> [T a] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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) T c
parameters ([T a] -> [b]) -> [T a] -> [b]
forall a b. (a -> b) -> a -> b
$
    T a -> T a -> [T a]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (a -> T a
forall a. C a => a -> T a
Phase.fromRepresentative a
phase) T a
freqs


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

{- | oscillator with a sampled waveform with modulated frequency
     Should behave homogenously for different types of interpolation. -}
freqModSample ::
    (RealRing.C a) =>
    Interpolation.T a b -> [b] -> Phase a -> Sig.T a -> Sig.T b
freqModSample :: forall a b. C a => T a b -> [b] -> a -> T a -> [b]
freqModSample T a b
ip [b]
wave a
phase T a
freqs =
    let len :: a
len = Int -> a
forall a b. (C a, C b) => a -> b
fromIntegral ([b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
wave)
    in  T a b -> a -> T a -> [b] -> [b]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeCyclicPad
           T a b
ip (a
phasea -> a -> a
forall a. C a => a -> a -> a
*a
len) ((a -> a) -> T a -> T a
forall a b. (a -> b) -> [a] -> [b]
map (a
lena -> a -> a
forall a. C a => a -> a -> a
*) T a
freqs) [b]
wave

{- |
Shape control is a list of relative changes,
each of which must be non-negative in order to allow lazy processing.
'1' advances by one wave.
Frequency control can be negative.
If you want to use sampled waveforms as well
then use 'Wave.sample' in the list of waveforms.
With sampled waves this function is identical to HunkTranspose in Assampler.

Example: interpolate different versions
of 'Wave.oddCosine' and 'Wave.oddTriangle'.

You could also chop a tone into single waves
and use the waves as input for this function
but you certainly want to use
'Wave.sampledTone' or 'shapeFreqModFromSampledTone' instead,
because in the wave information for 'shapeFreqModSample'
shape and phase are strictly separated.
-}
shapeFreqModSample ::
    (RealRing.C c, RealRing.C b) =>
    Interpolation.T c (Wave.T b a) ->
    [Wave.T b a] -> c -> Phase b -> Sig.T c -> Sig.T b -> Sig.T a
shapeFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> [T b a] -> c -> b -> T c -> T b -> T a
shapeFreqModSample T c (T b a)
ip [T b a]
waves c
shape0 b
phase T c
shapes T b
freqs =
    (T b a -> T b -> a) -> [T b a] -> [T b] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply
       (T c (T b a) -> c -> T c -> [T b a] -> [T b a]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeConstantPad T c (T b a)
ip c
shape0 T c
shapes [T b a]
waves)
       (T b -> T b -> [T b]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases (b -> T b
forall a. C a => a -> T a
Phase.fromRepresentative b
phase) T b
freqs)
{-
GNUPlot.plotList [] $ take 500 $ shapeFreqModSample Interpolation.cubic (map Wave.truncOddCosine [0..3]) (0.1::Double) (0::Double) (repeat 0.005) (repeat 0.02)
-}

shapePhaseFreqModSample ::
    (RealRing.C c, RealRing.C b) =>
    Interpolation.T c (Wave.T b a) ->
    [Wave.T b a] -> c -> Sig.T c -> Sig.T (Phase b) -> Sig.T b -> Sig.T a
shapePhaseFreqModSample :: forall c b a.
(C c, C b) =>
T c (T b a) -> [T b a] -> c -> T c -> T b -> T b -> T a
shapePhaseFreqModSample T c (T b a)
ip [T b a]
waves c
shape0 T c
shapes T b
phases T b
freqs =
    (T b a -> T b -> a) -> [T b a] -> [T b] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith T b a -> T b -> a
forall t y. T t y -> T t -> y
Wave.apply
       (T c (T b a) -> c -> T c -> [T b a] -> [T b a]
forall t y. C t => T t y -> t -> T t -> T y -> T y
Interpolation.multiRelativeConstantPad T c (T b a)
ip c
shape0 T c
shapes [T b a]
waves)
       ((b -> T b -> T b) -> T b -> [T b] -> [T b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith b -> T b -> T b
forall a. C a => a -> T a -> T a
Phase.increment T b
phases (T b -> T b -> [T b]
forall a. C a => T a -> T a -> T (T a)
freqsToPhases T b
forall a. C a => a
zero T b
freqs))

{- |
Time stretching and frequency modulation of a pure tone.

We consider a tone as the result of a shape modulated oscillator,
and virtually reconstruct the waveform function
(a function of time and phase) by interpolation and resample it.
This way we can alter frequency and time progress of the tone independently.

This function is identical to using 'shapeFreqMod'
with a wave function constructed by 'Wave.sampledTone'
but it consumes the sampled source tone lazily
and thus allows only relative shape control with non-negative control steps.

The function is similar to 'shapeFreqModSample' but respects
that in a sampled tone, phase and shape control advance synchronously.
Actually we could re-use 'shapeFreqModSample' with modified phase values.
But we would have to cope with negative shape control jumps,
and waves would be padded locally cyclically.
The latter one is not wanted
since we want padding according to the adjacencies in the source tone.
Note that differently from 'shapeFreqModSample'
the shape control difference @1@ does not mean to skip to the next wave,
since this oscillator has no discrete waveforms.
Instead @1@ means that the shape alters as fast as in the prototype signal.

Although the shape difference values must be non-negative
I hesitate to give them the type @Number.NonNegative.T t@
because then you cannot call this function with other types
of non-negative numbers like 'Number.NonNegativeChunky.T'.

The prototype tone signal is reproduced if
@freqs == repeat (1\/period)@ and @shapes == repeat 1@.
-}
shapeFreqModFromSampledTone :: (RealField.C t) =>
    Interpolation.T t y ->
    Interpolation.T t y ->
    t -> Sig.T y -> t -> t -> Sig.T t -> Sig.T t -> Sig.T y
shapeFreqModFromSampledTone :: forall t y.
C t =>
T t y -> T t y -> t -> T y -> t -> t -> T t -> T t -> T y
shapeFreqModFromSampledTone
      T t y
ipLeap T t y
ipStep t
period T y
sampledTone
      t
shape0 t
phase T t
shapes T t
freqs =
   let periodInt :: Int
periodInt = t -> Int
forall b. C b => t -> b
forall a b. (C a, C b) => a -> b
round t
period
   in  (((t, t), Cell y) -> y) -> [((t, t), Cell y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map
          (((t, t) -> Cell y -> y) -> ((t, t), Cell y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell y -> y
forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep))
          (Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> [((t, t), Cell y)]
forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, t), Cell 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)
              Int
periodInt t
period T y
sampledTone
              (t
shape0, T t
shapes) (t -> T t
forall a. C a => a -> T a
Phase.fromRepresentative t
phase, T t
freqs))
{-
GNUPlot.plotList [] $ take 1000 $ shapeFreqModFromSampledTone Interpolation.linear Interpolation.linear (1/0.07::Double) (staticSine (0::Double) 0.07) 0 0 (repeat 0.1) (repeat 0.01)
GNUPlot.plotList [] $ take 1000 $ shapeFreqModFromSampledTone Interpolation.linear Interpolation.linear (1/0.07::Double) (staticSine (0::Double) 0.07) 0 0 (repeat 0.1) (iterate (*(1-2e-3)) 0.01)
GNUPlot.plotList [] $ take 101 $ shapeFreqModFromSampledTone Interpolation.linear Interpolation.linear (1/0.07::Double) (iterate (1+) (0::Double)) 0 0 (repeat 1) (repeat 0.7)
-}

shapePhaseFreqModFromSampledTone :: (RealField.C t) =>
    Interpolation.T t y ->
    Interpolation.T t y ->
    t -> Sig.T y -> t -> t -> Sig.T t -> Sig.T t -> Sig.T t -> Sig.T y
shapePhaseFreqModFromSampledTone :: forall t y.
C t =>
T t y -> T t y -> t -> T y -> t -> t -> T t -> T t -> T t -> T y
shapePhaseFreqModFromSampledTone
      T t y
ipLeap T t y
ipStep t
period T y
sampledTone
      t
shape0 t
phase T t
shapes T t
phases T t
freqs =
   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, T t), Cell y) -> y) -> [((t, T t), Cell y)] -> T y
forall a b. (a -> b) -> [a] -> [b]
map
          (((t, t) -> Cell y -> y) -> ((t, t), Cell y) -> y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (T t y -> T t y -> (t, t) -> Cell y -> y
forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
ToneMod.interpolateCell T t y
ipLeap T t y
ipStep) (((t, t), Cell y) -> y)
-> (((t, T t), Cell y) -> ((t, t), Cell y))
-> ((t, T t), Cell y)
-> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
ToneMod.seekCell Int
periodInt t
period) ([((t, T t), Cell y)] -> T y) -> [((t, T t), Cell y)] -> T y
forall a b. (a -> b) -> a -> b
$
       (t -> ((t, T t), Cell y) -> ((t, T t), Cell y))
-> T t -> [((t, T t), Cell y)] -> [((t, T t), Cell y)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\t
p -> ((t, T t) -> (t, T t)) -> ((t, T t), Cell y) -> ((t, T t), Cell y)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((T t -> T t) -> (t, T t) -> (t, T t)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (t -> T t -> T t
forall a. C a => a -> T a -> T a
Phase.increment t
p))) T t
phases ([((t, T t), Cell y)] -> [((t, T t), Cell y)])
-> [((t, T t), Cell y)] -> [((t, T t), Cell y)]
forall a b. (a -> b) -> a -> b
$
       Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> [((t, T t), Cell y)]
forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
ToneMod.oscillatorSuffixes
          Margin
marginLeap Margin
marginStep
          Int
periodInt t
period T y
sampledTone
          (t
shape0, T t
shapes)
          (t -> T t
forall a. C a => a -> T a
Phase.fromRepresentative t
phase, T t
freqs)


{- * Oscillators with specific waveforms -}

{- | impulse train with static frequency -}
staticImpulses :: (RealRing.C a) => a -> a -> Sig.T a
staticImpulses :: forall a. C a => a -> a -> T a
staticImpulses a
phase = a -> T a -> T a
forall a. C a => a -> T a -> T a
freqModImpulses a
phase (T a -> T a) -> (a -> T a) -> a -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T a
forall a. a -> [a]
repeat

{- | impulse train with modulated frequency -}
freqModImpulses :: (RealRing.C a) => a -> Sig.T a -> Sig.T a
freqModImpulses :: forall a. C a => a -> T a -> T a
freqModImpulses a
phase =
   (a -> a -> Maybe (a, a)) -> a -> T a -> T a
forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
Sig.crochetL
      (\a
freq a
p0 -> (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just ((a, a) -> Maybe (a, a)) -> (a, a) -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$
         let p1 :: a
p1 = a
p0a -> a -> a
forall a. C a => a -> a -> a
+a
freq
         in if a
p1a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
1
               then (a
1, a -> a
forall a. C a => a -> a
fraction a
p1)
               else (a
0, a
p1))
      (a -> a
forall a. C a => a -> a
fraction a
phase)

{- | sine oscillator with static frequency -}
staticSine :: (Trans.C a, RealRing.C a) => a -> a -> Sig.T a
staticSine :: forall a. (C a, C a) => a -> a -> T a
staticSine = T a a -> a -> a -> T a
forall a b. C a => T a b -> a -> a -> T b
static T a a
forall a. C a => T a a
Wave.sine

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

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

{- | saw tooth oscillator with static frequency -}
staticSaw :: RealRing.C a => a -> a -> Sig.T a
staticSaw :: forall a. C a => a -> a -> T a
staticSaw = T a a -> a -> a -> T a
forall a b. C a => T a b -> a -> a -> T b
static T a a
forall a. C a => T a a
Wave.saw

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