{-# OPTIONS_GHC -O2 -fno-implicit-prelude #-}
{- |
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.Basic.WaveSmoothed as WaveSmooth
import qualified Synthesizer.Basic.Wave         as Wave
import qualified Synthesizer.Basic.Phase        as Phase

import qualified Synthesizer.Causal.Process as Causal
import qualified Synthesizer.State.Signal as Sig

import qualified Synthesizer.Causal.Interpolation as Interpolation

{-
import qualified Algebra.RealTranscendental    as RealTrans
import qualified Algebra.Field                 as Field
import qualified Algebra.Module                as Module
import qualified Algebra.VectorSpace           as VectorSpace

import Algebra.Module((*>))
-}
import qualified Algebra.Transcendental        as Trans
import qualified Algebra.RealField             as RealField
import qualified Algebra.Ring                  as Ring
import qualified Algebra.Additive              as Additive

import Control.Arrow ((<<<), (&&&), second, returnA, )

import NumericPrelude

import qualified Prelude as P
import PreludeBase



{- * Oscillators with arbitrary but constant waveforms -}

{-# INLINE freqToPhases #-}
freqToPhases :: RealField.C a =>
   Phase.T a -> a -> Sig.T (Phase.T a)
freqToPhases phase freq =
   Sig.iterate (Phase.increment freq) phase

{-# INLINE freqsToPhases #-}
{- |
Convert a list of phase steps into a list of momentum phases.
phase is a number in the interval [0,1).
freq contains the phase steps.
-}
freqsToPhases :: RealField.C a =>
   Phase.T a -> Causal.T a (Phase.T a)
freqsToPhases phase =
   Causal.scanL (flip Phase.increment) phase


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


{-# INLINE phaseMod #-}
{- | oscillator with modulated phase -}
phaseMod :: (RealField.C a) =>
    Wave.T a b -> a -> Causal.T a b
phaseMod wave = shapeMod (Wave.phaseOffset wave) zero

{-# INLINE shapeMod #-}
{- | oscillator with modulated shape -}
shapeMod :: (RealField.C a) =>
    (c -> Wave.T a b) -> Phase.T a -> a -> Causal.T c b
shapeMod wave phase freq =
    Causal.applySnd
       (Causal.map (uncurry (Wave.apply . wave)))
       (freqToPhases phase freq)


{-# INLINE freqMod #-}
{- | oscillator with modulated frequency -}
freqMod :: (RealField.C a) =>
    Wave.T a b -> Phase.T a -> Causal.T a b
freqMod wave phase =
    Causal.map (Wave.apply wave) <<< freqsToPhases phase

{-# INLINE freqModAntiAlias #-}
{- | oscillator with modulated frequency -}
freqModAntiAlias :: (RealField.C a) =>
    WaveSmooth.T a b -> Phase.T a -> Causal.T a b
freqModAntiAlias wave phase =
    Causal.map (uncurry (WaveSmooth.apply wave)) <<<
    returnA &&& freqsToPhases phase

{-# INLINE phaseFreqMod #-}
{- | oscillator with both phase and frequency modulation -}
phaseFreqMod :: (RealField.C a) =>
    Wave.T a b -> Causal.T (a,a) b
phaseFreqMod wave = shapeFreqMod (Wave.phaseOffset wave) zero

{-# INLINE shapeFreqMod #-}
{- | oscillator with both shape and frequency modulation -}
shapeFreqMod :: (RealField.C a) =>
    (c -> Wave.T a b) -> Phase.T a -> Causal.T (c,a) b
shapeFreqMod wave phase =
    Causal.map (uncurry (Wave.apply . wave)) <<<
    second (freqsToPhases phase)


{-
{- | oscillator with a sampled waveform with constant frequency
     This essentially an interpolation with cyclic padding. -}
{-# INLINE staticSample #-}
staticSample :: RealField.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 :: RealField.C a =>
    Interpolation.T a b -> Sig.T b -> Phase.T a -> Causal.T a b
freqModSample ip wave phase =
    let len = Sig.length wave
        pr  = Phase.toRepresentative $ Phase.multiply len phase
    in  Interpolation.relativeCyclicPad ip pr wave
          <<< Causal.map (fromIntegral len *)



{- * 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, RealField.C a) => Phase.T a -> Causal.T a a
freqModSine = freqMod Wave.sine

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

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

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