synthesizer-dimensional-0.2: src/Synthesizer/Dimensional/RateAmplitude/Instrument.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Dimensional.RateAmplitude.Instrument where
import qualified Synthesizer.Dimensional.Rate.Oscillator as Osci
import qualified Synthesizer.Dimensional.Rate.Filter as Filt
import qualified Synthesizer.Dimensional.RateAmplitude.Displacement as Disp
import qualified Synthesizer.Dimensional.RateAmplitude.Noise as Noise
-- import qualified Synthesizer.SampleRateDimension.Filter.Recursive as FiltR
-- import qualified Synthesizer.SampleRateDimension.Filter.NonRecursive as FiltNR
import qualified Synthesizer.Dimensional.RateAmplitude.Filter as FiltA
import qualified Synthesizer.Dimensional.RateAmplitude.Cut as Cut
import qualified Synthesizer.Dimensional.Amplitude.Cut as CutA
import qualified Synthesizer.Dimensional.RateAmplitude.Control as Ctrl
import qualified Synthesizer.Dimensional.Rate.Control as CtrlR
import qualified Synthesizer.Dimensional.Straight.Displacement as DispS
import qualified Synthesizer.Dimensional.Amplitude.Analysis as Ana
import qualified Synthesizer.Dimensional.Process as Proc
import qualified Synthesizer.Dimensional.Cyclic.Signal as SigC
import qualified Synthesizer.Dimensional.Straight.Signal as SigS
import qualified Synthesizer.Dimensional.RateAmplitude.Signal as SigA
import Synthesizer.Dimensional.RateAmplitude.Signal (($-), ($&), (&*^), (&*>^), )
import Synthesizer.Dimensional.RateAmplitude.Control ((-|#), ( #|-), (|#), ( #|), )
import Synthesizer.Dimensional.Process (($:), ($::), ($^), (.^), ($#), )
import Synthesizer.Dimensional.Amplitude.Control (mapLinear, mapExponential, )
import Foreign.Storable (Storable, )
import qualified Algebra.DimensionTerm as Dim
import qualified Number.DimensionTerm as DN
import Number.DimensionTerm ((*&), (&*&), )
import qualified Synthesizer.Interpolation.Module as Interpolation
import Synthesizer.Plain.Instrument (choirWave)
import qualified Synthesizer.Basic.Wave as Wave
import qualified Synthesizer.Basic.Phase as Phase
import qualified Number.NonNegative as NonNeg
import qualified Algebra.Transcendental as Trans
import qualified Algebra.Module as Module
import qualified Algebra.RealField as RealField
import qualified Algebra.Field as Field
import qualified Algebra.Ring as Ring
import System.Random (Random, randoms, randomRs, mkStdGen, )
import Synthesizer.Utility (randomRsBalanced, balanceLevel, )
import Data.List(zip4)
import PreludeBase
import NumericPrelude
{-| Create a sound of a slightly changed frequency
just as needed for a simple stereo sound. -}
{-# INLINE stereoPhaser #-}
stereoPhaser :: Ring.C a =>
(DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s u b b))
{- ^ A function mapping a frequency to a signal. -}
-> a {- ^ The factor to the frequency, should be close to 1. -}
-> DN.T Dim.Frequency a
{- ^ The base (undeviated) frequency of the sound. -}
-> Proc.T s Dim.Time a (SigA.R s u b b)
stereoPhaser sound dif freq =
sound (dif *& freq)
{-
allpassPlain :: (RealField.C a, Trans.C a, Module.C a a) =>
a -> a -> a -> a -> [a]
allpassPlain sampleRate halfLife k freq =
Filt.allpassCascade 10
(map Filt.AllpassParam (exponential2 (halfLife*sampleRate) k))
(simpleSaw sampleRate freq)
-}
{-# INLINE allpassDown #-}
allpassDown ::
(RealField.C a, Trans.C a, Module.C a a) =>
NonNeg.Int -> DN.T Dim.Time a ->
DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
allpassDown order halfLife filterfreq freq =
do x <- simpleSaw freq
FiltA.amplify 0.3 $:
(Disp.mix
$# x
$: (Filt.allpassCascade order Filt.allpassFlangerPhase
$: filterfreq &*^ CtrlR.exponential2 halfLife
$# x))
{-# INLINE moogDown #-}
{-# INLINE moogReso #-}
moogDown, moogReso ::
(RealField.C a, Trans.C a, Module.C a a) =>
NonNeg.Int -> DN.T Dim.Time a ->
DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
moogDown order halfLife filterfreq freq =
Filt.moogLowpass order
$- DN.fromNumber 10
$: filterfreq &*^ CtrlR.exponential2 halfLife
$: simpleSaw freq
moogReso order halfLife filterfreq freq =
Filt.moogLowpass order
$: DN.fromNumber 100 &*^ CtrlR.exponential2 halfLife
$- filterfreq
$: simpleSaw freq
{-# INLINE bell #-}
bell :: (Trans.C a, RealField.C a, Module.C a a) =>
DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
bell freq =
let halfLife = DN.time 0.5
in FiltA.amplify (1/3) $:
(Disp.mixMulti $::
(bellHarmonic 1 halfLife freq :
bellHarmonic 4 halfLife freq :
bellHarmonic 7 halfLife freq :
[]))
{-# INLINE bellHarmonic #-}
bellHarmonic :: (Trans.C a, RealField.C a, Module.C a a) =>
a -> DN.T Dim.Time a -> DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
bellHarmonic n halfLife freq =
Filt.envelope
$: CtrlR.exponential2 (recip n *& halfLife)
$: (DN.voltage 1
&*^ (Osci.freqMod Wave.sine zero
$: (mapLinear 0.005 (DN.frequency 5)
$^ Osci.static Wave.sine zero (n *& freq))))
{-# INLINE fastBell #-}
{-# INLINE squareBell #-}
{-# INLINE moogGuitar #-}
{-# INLINE moogGuitarSoft #-}
{-# INLINE fatSaw #-}
fastBell, squareBell, moogGuitar, moogGuitarSoft, fatSaw ::
(RealField.C a, Trans.C a, Module.C a a) =>
DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
fastBell freq =
Filt.envelope
$: CtrlR.exponential2 (DN.time 0.2)
$: (DN.voltage 1 &*^ Osci.static Wave.sine zero freq)
{-# INLINE filterSaw #-}
filterSaw :: (Module.C a a, Trans.C a, RealField.C a) =>
DN.T Dim.Frequency a -> DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
filterSaw filterFreq freq =
FiltA.amplify 0.1 $:
(Filt.lowpassFromUniversal $^
(Filt.universal
$- DN.fromNumber 10
$: filterFreq &*^ CtrlR.exponential2 (DN.time 0.1)
$: (DN.voltage 1 &*^ Osci.static Wave.saw zero freq)))
squareBell freq =
Filt.firstOrderLowpass
$: DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time (1/10))
-- (Osci.freqModSample Interpolation.cubic [0, 0.7, -0.3, 0.7, 0, -0.7, 0.3, -0.7] zero
$: (DN.voltage 1 &*^
(Osci.freqModSample Interpolation.linear
(SigC.fromPeriodList [0, 0.5, 0.6, 0.8, 0, -0.5, -0.6, -0.8]) zero
$: (mapLinear 0.01 freq
$^ (Osci.static Wave.sine zero (DN.frequency 5.0)))))
{-# INLINE fmBell #-}
fmBell :: (RealField.C a, Trans.C a, Module.C a a) =>
a -> a -> DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
fmBell depth freqRatio freq =
let modul =
Filt.envelope
$: CtrlR.exponential2 (DN.time 0.2)
$: DN.fromNumber depth &*^ Osci.static Wave.sine zero (freqRatio *& freq)
in Filt.envelope
$: CtrlR.exponential2 (DN.time 0.5)
$: (DN.voltage 1 &*^ (Osci.phaseMod Wave.sine freq $& modul))
moogGuitar freq =
let filterControl =
DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time 0.5)
tone =
DN.voltage 1 &*^
(Osci.freqMod Wave.saw zero
$: (mapLinear 0.005 freq $^
Osci.static Wave.sine zero (DN.frequency 5)))
in Filt.moogLowpass 4 $- DN.fromNumber 10 $: filterControl $: tone
moogGuitarSoft freq =
Filt.envelope
$: (fmap (1-) $^ CtrlR.exponential2 (DN.time 0.003))
$: moogGuitar freq
{- |
Phase modulation using a ring modulated signal.
May be used as some kind of e-guitar.
-}
fmRing ::
(RealField.C a, Trans.C a, Module.C a a) =>
DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
fmRing freq =
DN.voltage 1 &*^
(Osci.phaseMod (Wave.sineSawSmooth 1) freq
$: (DN.fromNumber 1 &*^ -- 0.2 for no distortion
(Filt.envelope
$: CtrlR.exponential2 (DN.time 0.2)
$: (Filt.envelope
$: Osci.static (Wave.raise one Wave.sine) (Phase.fromRepresentative 0.75) freq
$: Osci.static Wave.sine zero (5.001 *& freq)))))
fatPad ::
(RealField.C a, Trans.C a, Module.C a a, Random a) =>
DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
fatPad freq =
let env =
Cut.append
$: (Cut.take (DN.time 0.7) $:
Ctrl.cubicHermite
(DN.time 0, (DN.fromNumber 0, DN.frequency 1 &*& DN.fromNumber 5))
(DN.time 0.7, (DN.fromNumber 0.5, DN.frequency 1 &*& DN.fromNumber 0)))
$: Ctrl.constant (DN.fromNumber 0.5)
osci f =
DN.voltage 0.3 &*^
(Osci.phaseMod Wave.sine f
$: (DN.fromNumber 2 &*^
(Filt.envelope
$: env
$: Osci.static (Wave.sineSawSmooth 1) zero f)))
freqs = randomRsBalanced (mkStdGen 384) 3 1 0.03
in Disp.mixMulti $:: map (\k -> osci (k *& freq)) freqs
{-
renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "fat-pad" (Cut.take (DN.time 1.5) $: fatPad (DN.frequency 220))
-}
brass ::
(RealField.C a, Trans.C a, Module.C a a, Random a) =>
DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
brass freq =
let blobEnv = Ctrl.piecewise
(DN.fromNumber 0 |# (DN.time 0.05, Ctrl.cosinePiece) #|-
DN.fromNumber 1 -|# (DN.time 0.05, Ctrl.cosinePiece) #|
DN.fromNumber 0)
adsr = Ctrl.piecewise
(DN.fromNumber 0 |# (DN.time 0.1, Ctrl.cubicPiece (DN.frequency 1 &*& DN.fromNumber 10) (DN.frequency 1 &*& DN.fromNumber 0)) #|-
DN.fromNumber 0.5 -|# (DN.time 1, Ctrl.stepPiece) #|-
DN.fromNumber 0.5 -|# (DN.time 0.3, Ctrl.exponentialPiece (DN.fromNumber 0)) #|
DN.fromNumber 0.01)
osci b f =
DN.voltage 0.5 &*^
(Osci.freqMod Wave.saw zero $:
(Disp.mix
$: (mapLinear 0.01 f $^ Osci.static Wave.sine zero (DN.frequency 2))
$: ((b *& f) &*^ blobEnv)))
n = 4
freqs = randomRsBalanced (mkStdGen 295) n 1 0.03
blobAmps = balanceLevel 0 (take n (iterate (0.1+) 0))
in Filt.envelope
$: adsr
$: (Disp.mixMulti $:: zipWith (\b k -> osci b (k *& freq)) blobAmps freqs)
{-
Synthesizer.Dimensional.RateAmplitude.File.renderTimeVoltageMonoDoubleToInt16 (DN.frequency 44100) "brass" (brass (DN.frequency 440))
-}
{-| low pass with resonance -}
{-# INLINE filterSweep #-}
filterSweep :: (Module.C a v, Trans.C a, RealField.C a) =>
Phase.T a ->
Proc.T s Dim.Time a (
SigA.R s Dim.Voltage a v ->
SigA.R s Dim.Voltage a v)
filterSweep phase =
Filt.lowpassFromUniversal .^
(Filt.universal
$- DN.fromNumber 10
$: (mapExponential 2 (DN.frequency 1800) $^
Osci.static Wave.sine phase (DN.frequency (1/16))))
{-# INLINE fatSawChordFilter #-}
{-# INLINE fatSawChord #-}
fatSawChordFilter, fatSawChord ::
(RealField.C a, Trans.C a, Module.C a a) =>
DN.T Dim.Frequency a -> Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
fatSawChordFilter freq =
FiltA.amplify (1/2) $:
(Filt.lowpassFromUniversal $^
(Filt.universal
$- DN.fromNumber 10
$: filterDown
$: fatSawChord freq))
fatSawChord freq =
FiltA.amplify (1/3) $:
(Disp.mixMulti $::
[fatSaw ( 1 *& freq),
fatSaw ((5/4) *& freq),
fatSaw ((3/2) *& freq)])
{-# INLINE filterDown #-}
filterDown :: (RealField.C a, Trans.C a) =>
Proc.T s Dim.Time a (SigA.R s Dim.Frequency a a)
filterDown =
DN.frequency 4000 &*^ CtrlR.exponential2 (DN.time (1/3))
{-# INLINE simpleSaw #-}
simpleSaw :: (Ring.C a, Dim.C u, RealField.C v) =>
DN.T (Dim.Recip u) v ->
Proc.T s u v (SigA.R s Dim.Voltage a v)
simpleSaw freq =
DN.voltage 1 &*>^ Osci.static Wave.saw zero freq
{-| accumulate multiple similar saw sounds and observe the increase of volume
The oscillator @osc@ must accept relative frequencies. -}
{-# INLINE modulatedWave #-}
modulatedWave :: (Trans.C a, RealField.C a, Dim.C u) =>
Proc.T s u a (SigA.R s (Dim.Recip u) a a -> SigA.R s Dim.Voltage a a) ->
DN.T (Dim.Recip u) a ->
a -> Phase.T a ->
DN.T (Dim.Recip u) a ->
Proc.T s u a (SigA.R s Dim.Voltage a a)
modulatedWave osc freq depth phase speed =
osc $: (mapLinear depth freq $^
Osci.static Wave.sine phase speed)
{-# INLINE accumulationParameters #-}
accumulationParameters :: (Random a, Trans.C a, RealField.C a, Module.C a a) =>
[(Phase.T a, a, Phase.T a, DN.T Dim.Frequency a)]
accumulationParameters =
let starts = randoms (mkStdGen 48251)
depths = randomRs (0,0.02) (mkStdGen 12354)
phases = randoms (mkStdGen 74389)
speeds = randomRs (DN.frequency 0.1, DN.frequency 0.3)
(mkStdGen 03445)
in zip4 starts depths phases speeds
{-# INLINE accumulatedSaws #-}
{-# INLINE choir #-}
accumulatedSaws, choir ::
(Random a, Trans.C a, RealField.C a, Module.C a a) =>
DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
accumulatedSaws freq =
Disp.mixMulti $::
(map
(\(start, depth, phase, speed) ->
modulatedWave
(ampVolt (Osci.freqMod Wave.saw start))
freq depth phase speed)
accumulationParameters)
choir freq =
FiltA.amplify 0.2 $: (Disp.mixMulti $::
take 10
(map
(\(start, depth, phase, speed) ->
modulatedWave
(ampVolt (Osci.freqModSample Interpolation.constant
(SigC.fromPeriodList choirWave) start))
freq depth phase speed)
accumulationParameters))
fatSaw freq =
{- a simplified version of modulatedWave -}
let partial depth modPhase modFreq =
osciDoubleSaw $:
(mapLinear depth freq $^
Osci.static Wave.sine (Phase.fromRepresentative modPhase) modFreq)
in Disp.mixMulti $::
[partial 0.00311 0.0 (DN.frequency 20),
partial 0.00532 0.3 (DN.frequency 17),
partial 0.00981 0.9 (DN.frequency 6)]
{-# INLINE wasp #-}
{- |
A good choice is @freq = DN.frequency 110@
-}
wasp ::
(RealField.C q, Trans.C q, Module.C q q, Random q, Dim.C u) =>
DN.T (Dim.Recip u) q ->
Proc.T s u q (SigA.R s Dim.Voltage q q)
wasp freq =
Filt.envelope
$: (mapLinear 1 (DN.scalar 0.5) $^ Osci.static Wave.saw zero (recip 2.01 *& freq))
$: DN.voltage 0.7 &*^ Osci.static Wave.saw zero freq
{-# INLINE osciDoubleSaw #-}
osciDoubleSaw :: (RealField.C a, Module.C a a, Dim.C u) =>
Proc.T s u a (
SigA.R s (Dim.Recip u) a a ->
SigA.R s Dim.Voltage a a)
osciDoubleSaw =
ampVolt $
Osci.freqModSample Interpolation.linear
(SigC.fromPeriodList [-1, -0.2, 0.5, -0.5, 0.2, 1.0]) zero
{-# INLINE ampVolt #-}
ampVolt :: (Ring.C y, Dim.C u) =>
Proc.T s u y (a -> SigS.R s y) ->
Proc.T s u y (a -> SigA.R s Dim.Voltage y y)
ampVolt p =
Proc.withParam $ \x ->
DN.voltage 1 &*^ (p $# x)
{-|
A tone with a waveform with roughly the dependency @x -> x^?p@,
where the waveform is normalized to constant quadratic norm
-}
{-# INLINE osciSharp #-}
osciSharp :: (RealField.C a, Trans.C a) =>
DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
osciSharp freq =
let control = DN.fromNumber 10 &*^ CtrlR.exponential2 (DN.time 0.01)
in DN.voltage 1 &*^
(Osci.shapeMod Wave.powerNormed zero freq $& control)
{-|
Build a saw sound from its harmonics and modulate it.
Different to normal modulation
I modulate each harmonic with the same depth rather than a proportional one.
-}
{-# INLINE osciAbsModSaw #-}
osciAbsModSaw :: (RealField.C a, Trans.C a, Module.C a a) =>
DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
osciAbsModSaw freq =
let harmonic n =
DN.voltage (0.25 / fromInteger n)
&*^ (Osci.freqMod Wave.sine zero
$: (mapLinear 0.03 freq $^
(Osci.static Wave.sine zero (DN.frequency 1))))
in Disp.mixMulti $:: map harmonic [1..20]
{-|
Short pulsed Noise.white,
i.e. Noise.white amplified with pulses of varying H\/L ratio.
-}
{-# INLINE pulsedNoise #-}
pulsedNoise :: (Random a, RealField.C a, Trans.C a, Module.C a a) =>
DN.T Dim.Frequency a {-^ frequency of the pulses, interesting ones are around 100 Hz and below -} ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
pulsedNoise freq =
let raisedSine = Wave.raise one Wave.sine
c = Proc.pure Ana.lessOrEqual
$: (DN.voltage 1.0 &*^ Osci.static raisedSine zero freq)
$: (DN.voltage 0.2 &*^ Osci.static raisedSine zero (DN.frequency 0.1))
in Proc.pure CutA.selectBool
$- DN.voltage 0
$: Noise.white (DN.frequency 20000) (DN.voltage 1.0)
$: c
{-# INLINE noisePerc #-}
noisePerc :: (Random a, RealField.C a, Trans.C a) =>
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
noisePerc =
Filt.envelope
$: CtrlR.exponential2 (DN.time 0.1)
$: Noise.white (DN.frequency 20000) (DN.voltage 1.0)
{-# INLINE noiseBass #-}
noiseBass :: (Random a, RealField.C a, Trans.C a, Module.C a a, Storable a) =>
DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
noiseBass freq =
FiltA.combProc (DN.unrecip freq)
(Filt.firstOrderLowpass $- DN.frequency 2000)
$: noisePerc
{-|
Drum sound using the Karplus-Strong-Algorithm
This is a Noise.white enveloped by an exponential2
which is piped through the Karplus-Strong machine
for generating some frequency.
The whole thing is then frequency modulated
to give a falling frequency.
-}
{-# INLINE electroTom #-}
electroTom ::
(Random a, RealField.C a, Trans.C a, Module.C a a, Storable a) =>
Proc.T s Dim.Time a (SigA.R s Dim.Voltage a a)
electroTom =
let ks =
FiltA.combProc (DN.time (1/30))
(Filt.firstOrderLowpass $- (DN.frequency 1000))
$: noisePerc
in Filt.frequencyModulation Interpolation.linear
$: CtrlR.exponential2 (DN.time 0.3)
$: ks
{-# INLINE bassDrum #-}
bassDrum ::
(RealField.C q, Trans.C q, Module.C q q, Random q) =>
Proc.T s Dim.Time q (SigA.R s Dim.Voltage q q)
bassDrum =
Cut.take (DN.time 0.15) $:
(Disp.mix
$: (Filt.firstOrderLowpass
$- (DN.frequency 5000)
$: (Filt.envelope
$: (DispS.raise 0.03 $^ CtrlR.exponential2 (DN.time 0.002))
$: (Noise.white (DN.frequency 20000) (DN.voltage 1))))
$: (DN.voltage 0.5 &*^
(Filt.envelope
$: (CtrlR.exponential2 (DN.time 0.05))
$: (Osci.freqMod Wave.sine zero
$: (Ctrl.exponential2
(DN.time 0.15) (DN.frequency 100))))))