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.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
stereoPhaser :: Ring.C a =>
(DN.T Dim.Frequency a ->
Proc.T s Dim.Time a (SigA.R s u b b))
-> a
-> DN.T Dim.Frequency a
-> Proc.T s Dim.Time a (SigA.R s u b b)
stereoPhaser sound dif freq =
sound (dif *& freq)
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))
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
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 :
[]))
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))))
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)
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))
$: (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)))))
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
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 &*^
(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
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)
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))))
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)])
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))
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
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)
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
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 =
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)]
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
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
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)
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)
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]
pulsedNoise :: (Random a, 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)
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
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)
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
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
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))))))