module Synthesizer.LLVM.Server.CausalPacked.InstrumentPlug (
tineStereoFM,
helixNoise,
) where
import Synthesizer.LLVM.Server.CausalPacked.Instrument (
Control, DetuneBendModControl,
WithEnvelopeControl, StereoChunk,
pingControlledEnvelope,
stringControlledEnvelope,
reorderEnvelopeControl, )
import Synthesizer.LLVM.Server.CommonPacked (
Param, VectorValue, )
import Synthesizer.LLVM.Server.Common (
SampleRate, Real,
frequencyConst, timeConst,
number, transposeModulation, )
import qualified Synthesizer.CausalIO.Process as PIO
import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&), )
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
import qualified Synthesizer.LLVM.CausalParameterized.FunctionalPlug as FP
import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import qualified Synthesizer.LLVM.Parameter as Param
import qualified Synthesizer.LLVM.Interpolation as Interpolation
import qualified Synthesizer.LLVM.Wave as WaveL
import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
import qualified Synthesizer.LLVM.MIDI as MIDIL
import qualified Synthesizer.Zip as Zip
import qualified LLVM.Core as LLVM
import qualified Data.Traversable as Trav
import Control.Category (id, (.), )
import Control.Applicative (liftA2, )
import NumericPrelude.Numeric
import NumericPrelude.Base hiding (id, (.), )
type FuncP pp pl = FP.T pp (SampleRate Real, pl)
stereoFrequenciesFromDetuneBendModulation ::
Param pl Real ->
(FuncP pp pl inp (LLVM.Value Real),
FuncP pp pl inp (BM.T (LLVM.Value Real))) ->
FuncP pp pl inp (Stereo.T VectorValue)
stereoFrequenciesFromDetuneBendModulation speed (detune, freq) =
CausalP.envelopeStereo $&
(MIDIL.frequencyFromBendModulationPacked speed $& freq)
&|&
(CausalP.mapSimple (Trav.mapM Serial.upsample) $&
liftA2 Stereo.cons (one + detune) (one detune))
tineStereoFM ::
IO (SampleRate Real -> Real -> Real ->
PIO.T
(WithEnvelopeControl
(Zip.T
(Zip.T (Control Real) (Control Real))
DetuneBendModControl))
StereoChunk)
tineStereoFM =
liftA2
(\osc env sr vel freq ->
osc (sr, freq) (sr, vel)
.
Zip.arrowFirstShorten (env sr vel)
.
reorderEnvelopeControl)
(FP.withArgs $ \(env, ((index0,depth0), (detune,fm))) ->
let vel = number id
freqs =
stereoFrequenciesFromDetuneBendModulation
(frequencyConst 5)
(FP.plug detune,
FP.plug $ liftA2 (uncurry transposeModulation) FP.askParameter fm)
index = CausalP.mapSimple Serial.upsample $& FP.plug index0
depth = CausalP.mapSimple Serial.upsample $& FP.plug depth0
expo =
FP.fromSignal $
SigPS.exponential2 (timeConst 1) (1 + vel)
osci freq =
CausalPS.osciSimple WaveL.approxSine2 $&
expo * depth *
(CausalPS.osciSimple WaveL.approxSine2
$& zero &|& index*freq)
&|&
freq
in CausalP.envelopeStereo $&
FP.plug env &|& Stereo.liftApplicative osci freqs)
(pingControlledEnvelope (Just 0.01))
helixNoise ::
IO (SampleRate Real -> Real -> Real ->
PIO.T
(WithEnvelopeControl
(Zip.T (Control Real) DetuneBendModControl))
StereoChunk)
helixNoise =
liftA2
(\osc env sr vel freq ->
osc (sr, freq) (sr, vel)
.
Zip.arrowFirstShorten (env sr vel)
.
reorderEnvelopeControl)
(FP.withArgs $ \(env, (speed0, (detune,fm))) ->
let freqs =
stereoFrequenciesFromDetuneBendModulation
(frequencyConst 5)
(FP.plug detune,
FP.plug $ liftA2 (uncurry transposeModulation) FP.askParameter fm)
speed = CausalP.mapSimple Serial.upsample $& FP.plug speed0
in CausalP.envelopeStereo $&
FP.plug env &|& Stereo.liftApplicative (helixOsci speed) freqs)
stringControlledEnvelope
helixOsci ::
FP.T pp pl inp VectorValue ->
FP.T pp pl inp VectorValue ->
FP.T pp pl inp VectorValue
helixOsci speed freq =
CausalPS.pack
(Helix.dynamicLimited Interpolation.cubic Interpolation.cubic
64 (64 :: Param.T p Real) (SigP.noise 66 0.2))
$&
speed &|&
(CausalPS.osciCore $& 0 &|& freq)