{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {- | Copyright : (c) Henning Thielemann 2008, 2009 License : GPL Maintainer : synthesizer@henning-thielemann.de Stability : provisional Portability : requires multi-parameter type classes -} 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.Abstraction.HomogeneousGen as Hom import qualified Synthesizer.Dimensional.Abstraction.Flat as Flat import qualified Synthesizer.Dimensional.Amplitude as Amp import qualified Synthesizer.Dimensional.RatePhantom as RP import qualified Synthesizer.Dimensional.RateWrapper as SigP 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 as OsciC import qualified Synthesizer.Dimensional.Map as MapD import qualified Synthesizer.Generic.Signal as SigG import qualified Synthesizer.Basic.WaveSmoothed as WaveSmooth import qualified Synthesizer.Basic.Wave as Wave import qualified Synthesizer.Basic.Phase as Phase import qualified Synthesizer.Dimensional.Straight.Signal as SigS import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC import qualified Synthesizer.Dimensional.Amplitude.Signal 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 qualified Algebra.Field as Field -- import NumericPrelude import PreludeBase as P {- | This class is similar to the Homogeneous class in the implementation, but it is even more strict semantically. It requires that values from the waveform go untouched to the output signal, whereas Homogeneous class still allows homogeneous (aka amplitude-unit-independent) operations. We could use the Homogeneous constraints immediately in the oscillator functions, but with the functional dependencies we get more from type inference. This way, the compiler knows, that when we apply an oscillator to a flat wave, that we want a flat signal as output. -} class (Hom.C amp (Wave.T t) wave, Hom.C amp Sig.T signal) => Simple amp t wave signal | wave -> t, signal t -> wave, wave -> signal, signal -> amp, wave -> amp where instance Simple CausalD.Flat t (Wave.T t) (SigS.T Sig.T) where instance (Amp.C amp) => Simple amp t (SigA.T amp (Wave.T t)) (SigA.T amp (SigS.T Sig.T)) where class (Hom.C amp (WaveSmooth.T t) wave, Hom.C amp Sig.T signal) => Smooth amp t wave signal | wave -> t, signal t -> wave, wave -> signal, signal -> amp, wave -> amp where instance Smooth CausalD.Flat t (WaveSmooth.T t) (SigS.T Sig.T) where instance (Amp.C amp) => Smooth amp t (SigA.T amp (WaveSmooth.T t)) (SigA.T amp (SigS.T Sig.T)) where withWave :: (Hom.C amp waveStore wave, Hom.C amp Sig.T sig) => wave y -> (waveStore y -> Sig.T y) -> RP.T s sig y withWave w f = RP.fromSignal $ Hom.plainProcessSamples f w {- * Oscillators with constant waveforms -} {- | oscillator with a functional waveform with constant frequency -} {-# INLINE static #-} static :: (RealField.C t, Dim.C u, Simple amp t wave sig) => wave y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> DN.T (Dim.Recip u) t {- ^ frequency -} -> Proc.T s u t (RP.T s sig y) static wave phase = staticAux (\freq -> withWave wave $ \w -> Osci.static w phase freq) {- | oscillator with a functional waveform with constant frequency -} {-# INLINE staticAntiAlias #-} staticAntiAlias :: (RealField.C t, Dim.C u, Smooth amp t wave sig) => wave y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> DN.T (Dim.Recip u) t {- ^ frequency -} -> Proc.T s u t (RP.T s sig 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, Simple amp t wave sig) => wave y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> Proc.T s u t ( SigA.R s (Dim.Recip u) t t {- v frequency control -} -> RP.T s sig y) freqMod wave phase = freqModAux (\t -> withWave wave $ \w -> Osci.freqMod w phase t) {- | oscillator with a functional waveform with modulated frequency -} {-# INLINE freqModAntiAlias #-} freqModAntiAlias :: (RealField.C t, Dim.C u, Smooth amp t wave sig) => wave y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> Proc.T s u t ( SigA.R s (Dim.Recip u) t t {- v frequency control -} -> RP.T s sig y) freqModAntiAlias wave phase = freqModAux (\t -> withWave wave $ \w -> Osci.freqModAntiAlias w phase t) {- | oscillator with modulated phase -} {-# INLINE phaseMod #-} phaseMod :: (Flat.C flat t, RealField.C t, Dim.C u, Simple amp t wave sig) => wave y {- ^ waveform -} -> DN.T (Dim.Recip u) t {- ^ frequency -} -> Proc.T s u t ( RP.T s flat t {- v phase modulation, phases must have no unit -} -> RP.T s sig y) phaseMod wave = staticAux (\freq sig -> withWave wave $ \w -> Osci.phaseMod w freq . Flat.toSamples $ sig) {- | oscillator with modulated shape -} {-# INLINE shapeMod #-} shapeMod :: (Flat.C flat c, RealField.C t, Dim.C u) => (c -> Wave.T t y) {- ^ waveform -} -> Phase.T t {- ^ phase -} -> DN.T (Dim.Recip u) t {- ^ frequency -} -> Proc.T s u t ( RP.T s flat c {- v shape control -} -> SigS.R s y) shapeMod wave phase = staticAux (\freq -> SigS.fromSamples . Osci.shapeMod wave phase freq . Flat.toSamples) {- | oscillator with a functional waveform with modulated phase and frequency -} {-# INLINE phaseFreqMod #-} phaseFreqMod :: (Flat.C flat t, RealField.C t, Dim.C u, Simple amp t wave sig) => wave y {- ^ waveform -} -> Proc.T s u t ( RP.T s flat t {- v phase control -} -> SigA.R s (Dim.Recip u) t t {- v frequency control -} -> RP.T s sig y) phaseFreqMod wave = fmap flip $ freqModAux (\ freqs phases -> withWave wave $ \w -> Osci.phaseFreqMod w (Flat.toSamples phases) freqs) {- | oscillator with both shape and frequency modulation -} {-# INLINE shapeFreqMod #-} shapeFreqMod :: (Flat.C flat c, RealField.C t, Dim.C u) => (c -> Wave.T t y) {- ^ waveform -} -> Phase.T t {- ^ phase -} -> Proc.T s u t ( RP.T s flat c {- v shape control -} -> SigA.R s (Dim.Recip u) t t {- v frequency control -} -> SigS.R s y) shapeFreqMod wave phase = fmap flip $ freqModAux (\ freqs parameters -> SigS.fromSamples $ Osci.shapeFreqMod wave phase (Flat.toSamples parameters) 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 -> SigC.R r y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> DN.T (Dim.Recip u) t {- ^ frequency -} -> Proc.T s u t (SigS.R s y) staticSample ip wave phase = staticAux (SigS.fromSamples . Osci.staticSample ip (SigC.toPeriod wave) 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 -> SigC.R r y {- ^ waveform -} -> Phase.T t {- ^ start phase -} -> Proc.T s u t ( SigA.R s (Dim.Recip u) t t {- v frequency control -} -> SigS.R s y) freqModSample ip wave phase = freqModAux (SigS.fromSamples . Osci.freqModSample ip (SigC.toPeriod wave) phase) {- {-# 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 ( RP.T 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, SigG.Transform storage yv, Dim.C u, Hom.C amp storage input, Hom.C amp Sig.T output, Flat.C flat t) => Interpolation.T t yv -> Interpolation.T t yv -> DN.T (Dim.Recip u) t {- ^ source frequency -} -> SigP.T u t input yv -> t -> Phase.T t -> Proc.T s u t ( RP.T s flat t {- v shape control -} -> SigA.R s (Dim.Recip u) t t {- v frequency control -} -> RP.T s output yv) shapeFreqModFromSampledTone ipLeap ipStep srcFreq sampledTone shape0 phase = flip fmap (OsciC.shapeFreqModFromSampledTone ipLeap ipStep srcFreq sampledTone shape0 phase) (\osci -> \shapes freqs -> osci `CausalD.applyFlatFst` shapes `CausalD.apply` freqs) {-# INLINE shapePhaseFreqModFromSampledTone #-} shapePhaseFreqModFromSampledTone :: (RealField.C t, SigG.Transform storage yv, Dim.C u, Hom.C amp storage input, Hom.C amp Sig.T output, Flat.C flatS t, Flat.C flatP t) => Interpolation.T t yv -> Interpolation.T t yv -> DN.T (Dim.Recip u) t {- ^ source frequency -} -> SigP.T u t input yv -> t -> Phase.T t -> Proc.T s u t ( RP.T s flatS t {- v shape control -} -> RP.T s flatP t {- v phase control -} -> SigA.R s (Dim.Recip u) t t {- v frequency control -} -> RP.T s output yv) shapePhaseFreqModFromSampledTone ipLeap ipStep srcFreq sampledTone shape0 phase = flip fmap (OsciC.shapePhaseFreqModFromSampledTone ipLeap ipStep srcFreq sampledTone shape0 phase) (\osci -> \shapes phaseDistort freqs -> (osci CausalD.<<^ MapD.packTriple) `CausalD.applyFlatFst` shapes `CausalD.applyFlatFst` phaseDistort `CausalD.apply` freqs) {-# INLINE freqModAux #-} freqModAux :: (Field.C t, Dim.C u) => (Sig.T t -> c) -> Proc.T s u t ( SigA.R s (Dim.Recip u) t t -> c) freqModAux f = fmap (\toFreq -> f . SigA.scalarSamples toFreq) (Proc.withParam toFrequencyScalar) {-# INLINE staticAux #-} staticAux :: (Dim.C u, Field.C t) => (t -> c) -> DN.T (Dim.Recip u) t -> Proc.T s u t c staticAux f freq = fmap f (toFrequencyScalar freq)