{- ToDo: organization: compile instrument when switching a MIDI program However caching and sharing might be a good idea like for quickly changing between tomatensalat syllabels. Ideally we just need to run instrument generation using unsafeInterleaveIO. This however will trigger instrument compilation when the sound is played the first time. This may cause buffer underruns. On the other hand, forcing instrument compilation on program changes might still cause buffer underruns. instruments: tonal noise can be produced by modulating pink noise experimental: multiply with waveforms other than sine use bits of an ASCII code as waveform use a greymap picture as source of waveforms mix of detuned noisy-waverforms, try different and uniform waveforms mix of sawtooth, where every sawtooth is modulated with red noise mix of sine with harmonics where every harmonic is modulated differently Flute: sine + filtered noise Drum with various parameters derive percussive instruments from fmString and arcString (for bass synths) an FM sound with a slowly changing timbre by using a very slightly detuned frequency for the modulator making a tone out of noise using time stretch with helix algorithm a chorus effect could be applied by two successive helix stretches or by mixture of two stretches signals additionally a resonant filter could be applied a kind of Karplus-Strong algorithm with a non-linear function of past values e.g. y(t) = f(y(t-d), y(t-2*d)) where d is the tone period and f is non-linear, maybe chaotic function. In order to limit the appearance of chaotic waveforms, we could combine this with a lowpass filter. let attack and release depend on On and Off velocity tineStereoFM: continuous control of the modulation index by linear interpolation of waves between modulations with integral indices. E.g. modulation index 2.3 means 0.7*modulation with index 2 and 0.3*modulation with index 3. effects: reverb and controllable delay phaser or Chebyshev filter reverb where many single combs are mixed every comb has ever-increasing frequency, but is faded in and out. Should give an endless effect where the reverb becomes higher and higher. continuous sounds: fly water/bubbles when I accidentally did not scale filter frequency with sample rate, the filter sound much like water bubbles. I think a control curve consisting of some ramps will do the same. hail, Geiger counter, pitch applied by comb filter at a very high impulse rate the impulses itself can generate an almost periodic signal Speech sounds improvements (tomatensalat) use PSOLA for transposition To this end divide signal into tonal part and residue (noise) by a comb filter. Maybe a non-linear comb filter may help, that selects the center value from the filter window, if the side values are similar and returns zero, if the the side values differ too much. Process the tonal part by PSOLA and simply mix it with the non-tonal part on replay. Harmonizer-like: We like to input an audio signal of speech and a set of keys, and the speech is extended to chords according to the pressed keys. The lowest key is interpreted as base frequency of the input audio speech. A PSOLA method transposes the audio input. Resonant filter controlled by keys applied to an audio input signal or an ordinary audio signal generated by other keys. The splitting of keys however could be performed by a MIDI event stream editor. -} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE EmptyDataDecls #-} module Synthesizer.LLVM.Server.Packed.Instrument ( InputArg(..), FrequencyControl, Modulation, DetuneModulation, pingRelease, pingStereoRelease, pingStereoReleaseFM, squareStereoReleaseFM, bellStereoFM, bellNoiseStereoFM, tine, tineStereo, softString, softStringFM, tineStereoFM, tineControlledFM, fenderFM, tineModulatorBankFM, tineBankFM, resonantFMSynth, softStringDetuneFM, softStringShapeFM, cosineStringStereoFM, arcSineStringStereoFM, arcTriangleStringStereoFM, arcSquareStringStereoFM, arcSawStringStereoFM, fmStringStereoFM, wind, windPhaser, filterSawStereoFM, brass, sampledSound, -- * helper functions stereoNoise, frequencyFromBendModulation, piecewiseConstantVector, -- * for testing pingReleaseEnvelope, adsr, ) where import Synthesizer.LLVM.Server.CommonPacked import Synthesizer.LLVM.Server.Common import qualified Synthesizer.LLVM.Server.SampledSound as Sample import qualified Synthesizer.LLVM.MIDI.BendModulation as BM import qualified Synthesizer.LLVM.ConstantPiece as Const import qualified Synthesizer.MIDI.PiecewiseConstant as PC import qualified Synthesizer.MIDI.EventList as Ev import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime) import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Filter.Universal as UniFilterL import qualified Synthesizer.LLVM.Filter.Allpass as Allpass import qualified Synthesizer.LLVM.Filter.Moog as MoogL import qualified Synthesizer.LLVM.MIDI as MIDIL import qualified Synthesizer.LLVM.Causal.Render as CausalRender import qualified Synthesizer.LLVM.Causal.ControlledPacked as CtrlPS import qualified Synthesizer.LLVM.Causal.ProcessPacked as CausalPS import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Causal.Functional as F import qualified Synthesizer.LLVM.Generator.Render as Render import qualified Synthesizer.LLVM.Generator.SignalPacked as SigPS import qualified Synthesizer.LLVM.Generator.Signal as Sig import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Wave as WaveL import Synthesizer.LLVM.Causal.Process (($<#), ($*), ($<), ($>)) import Synthesizer.LLVM.Causal.Functional (($&), (&|&)) import qualified LLVM.DSL.Expression as Expr import qualified LLVM.Extra.Multi.Value as MultiValue import LLVM.DSL.Expression (Exp) import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM import qualified Type.Data.Num.Decimal as TypeNum import qualified Synthesizer.Causal.Class as CausalClass import qualified Synthesizer.Generic.Cut as CutG import qualified Synthesizer.Storable.Signal as SigSt import qualified Data.StorableVector.Lazy.Pattern as SVP import qualified Data.StorableVector.Lazy as SVL import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter import qualified Control.Monad.HT as M import Control.Arrow ((<<<), (^<<), (<<^), (&&&), (***), arr, first, second) import Control.Category (id) import Control.Applicative (liftA2, liftA3) import qualified Data.Traversable as Trav import Data.Traversable (traverse) import Data.Semigroup ((<>)) import Data.Tuple.HT (fst3, snd3, thd3) import qualified Numeric.NonNegative.Chunky as NonNegChunky import qualified Algebra.Additive as Additive import NumericPrelude.Numeric (zero, one, round, (^?), (+), (-), (*)) import Prelude hiding (Real, round, break, id, (+), (-), (*)) frequencyControl :: (MultiValue.Field a, MultiValue.RationalConstant a) => SampleRate (Exp a) -> Sig.T (Const.T (MultiValue.T a)) -> Sig.T (Const.T (MultiValue.T a)) frequencyControl sr xs = Const.causalMap (frequency sr) $* xs data FrequencyControl a instance (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => Input (FrequencyControl b) a where data InputArg (FrequencyControl b) a = FrequencyControl (Sig.T (Const.T (MultiValue.T b))) type InputSource (FrequencyControl b) a = Sig.T (Const.T (MultiValue.T b)) evalInput sampleRate = FrequencyControl . frequencyControl sampleRate modulation :: (MultiValue.Field a, MultiValue.RationalConstant a) => SampleRate (Exp a) -> (Sig.T (Const.T (MultiValue.T (BM.T a))), Exp a) -> Sig.T (Const.T (BM.T (MultiValue.T a))) modulation sr (fm,freq) = transposeModulation sr freq (fmap BM.unMultiValue <$> fm) data Modulation a instance (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => Input (Modulation b) a where data InputArg (Modulation b) a = Modulation (Sig.T (Const.T (BM.T (MultiValue.T b)))) type InputSource (Modulation b) a = (Sig.T (Const.T (MultiValue.T (BM.T b))), Exp b) evalInput sampleRate (fm,freq) = Modulation $ modulation sampleRate (fm,freq) detuneModulation :: (MultiValue.Field a, MultiValue.RationalConstant a) => SampleRate (Exp a) -> (b, Sig.T (Const.T (MultiValue.T (BM.T a))), Exp a) -> (b, Sig.T (Const.T (BM.T (MultiValue.T a)))) detuneModulation sr (det,fm,freq) = (det, transposeModulation sr freq (fmap BM.unMultiValue <$> fm)) data DetuneModulation a instance (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => Input (DetuneModulation b) a where data InputArg (DetuneModulation b) a = DetuneModulation (Sig.T (Const.T (MultiValue.T b)), Sig.T (Const.T (BM.T (MultiValue.T b)))) type InputSource (DetuneModulation b) a = (Sig.T (Const.T (MultiValue.T b)), Sig.T (Const.T (MultiValue.T (BM.T b))), Exp b) evalInput sampleRate (det,fm,freq) = DetuneModulation $ detuneModulation sampleRate (det,fm,freq) type RealValue = MultiValue.T Real frequencyFromBendModulation :: Exp Real -> Sig.T (Const.T (BM.T RealValue)) -> Sig.T VectorValue frequencyFromBendModulation speed fmFreq = MIDIL.frequencyFromBendModulationPacked speed $* piecewiseConstant fmFreq stereoFrequenciesFromDetuneBendModulation :: Exp Real -> (Sig.T (Const.T RealValue), Sig.T (Const.T (BM.T RealValue))) -> Sig.T (Stereo.T VectorValue) stereoFrequenciesFromDetuneBendModulation speed (det,fm) = (Causal.envelopeStereo $< frequencyFromBendModulation speed fm) <<< liftA2 Stereo.cons (one + id) (one - id) $* piecewiseConstantVector det piecewiseConstantVector :: Sig.T (Const.T RealValue) -> Sig.T VectorValue piecewiseConstantVector xs = piecewiseConstant (Const.causalMap Serial.upsample $* xs) pingReleaseEnvelope :: IO (Real -> Real -> SigSt.ChunkSize -> SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Vector) pingReleaseEnvelope = liftA2 (\pressed release decay rel vcsize sr vel dur -> SigStL.continuePacked (pioApplyToLazyTime (pressed sr decay vel) dur) (\x -> release vcsize sr rel x)) (CausalRender.run $ wrapped $ \(Time decay) (Number velocity) (SampleRate _sr) -> Causal.fromSignal (SigPS.exponential2 decay (amplitudeFromVelocity velocity))) (Render.run $ wrapped $ \(Time releaseHL) (Number amplitude) (SampleRate _sr) -> let releaseTime = releaseHL * 5 / fromIntegral vectorSize in Causal.take (Expr.roundToIntFast releaseTime) $* SigPS.exponential2 releaseHL amplitude) pingRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real Vector) pingRelease = liftA2 (\osc env dec rel vcsize sr vel freq dur -> pioApply (osc sr freq) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Frequency freq) (SampleRate _sr) -> Causal.envelope $> SigPS.osci WaveL.saw zero freq) pingReleaseEnvelope pingStereoRelease :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Vector)) pingStereoRelease = liftA2 (\osc env dec rel vcsize sr vel freq dur -> pioApply (osc sr freq) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Frequency freq) (SampleRate _sr) -> Stereo.multiValue <$> Causal.envelopeStereo $> liftA2 Stereo.cons (SigPS.osci WaveL.saw zero (0.999*freq)) (SigPS.osci WaveL.saw zero (1.001*freq))) pingReleaseEnvelope pingStereoReleaseFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> Real -> Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) pingStereoReleaseFM = liftA2 (\osc env dec rel detune shape phase phaseDecay vcsize fm sr vel freq dur -> pioApply (osc sr (phase, phaseDecay) shape (detune, fm, freq)) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Number phase, Time decay) (Control shape) (DetuneModulation fm) -> constant frequency 10 $ \speed _sr -> Stereo.multiValue <$> Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled (CausalPS.shapeModOsci WaveL.rationalApproxSine1) $< piecewiseConstantVector shape) <<^ Stereo.interleave $< (liftA2 Stereo.cons id (Additive.negate id) $* SigPS.exponential2 decay phase) $* stereoFrequenciesFromDetuneBendModulation speed fm)) pingReleaseEnvelope {- | Square like wave constructed as difference of two phase shifted sawtooth like oscillations. -} squareStereoReleaseFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) squareStereoReleaseFM = liftA2 (\osc env dec rel detune shape phase vcsize fm sr vel freq dur -> pioApply (osc sr (phase, shape) (detune, fm, freq)) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Control phs, Control shp) (DetuneModulation fm) -> constant frequency 10 $ \speed _sr -> (let chanOsci :: Causal.T ((VectorValue, VectorValue), VectorValue) VectorValue chanOsci = ((CausalPS.shapeModOsci WaveL.rationalApproxSine1 <<< second (first (Additive.negate id))) - CausalPS.shapeModOsci WaveL.rationalApproxSine1) <<^ (\((p,s),f) -> (s,(p,f))) in Stereo.multiValue <$> Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled chanOsci $< liftA2 (,) (piecewiseConstantVector phs) (piecewiseConstantVector shp)) $* stereoFrequenciesFromDetuneBendModulation speed fm))) pingReleaseEnvelope type Triple a = (a, a, a) bellStereoFM :: IO (Real -> Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) bellStereoFM = liftA2 (\osc env dec rel detune vcsize fm sr vel freq dur -> pioApply (osc sr (detune, fm, freq) vel (env (dec/4) rel vcsize sr vel dur) (env (dec/7) rel vcsize sr vel dur)) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(DetuneModulation fm) (Number vel) (Signal env4) (Signal env7) -> constant frequency 5 $ \speed _sr -> (let osci :: (Triple VectorValue -> VectorValue) -> Exp Real -> Exp Real -> Causal.T (Triple VectorValue, Stereo.T VectorValue) (Stereo.T VectorValue) osci sel v d = Causal.envelopeStereo <<< (arr sel *** (CausalPS.amplifyStereo v <<< Causal.stereoFromMono (CausalPS.osci WaveL.approxSine4 $< zero) <<< CausalPS.amplifyStereo d)) in Stereo.multiValue <$> sumNested [osci fst3 0.6 1, osci snd3 (0.02 * 50^?vel) 4, osci thd3 (0.02 * 100^?vel) 7] <<< CausalClass.feedSnd (stereoFrequenciesFromDetuneBendModulation speed fm) <<< arr (\(e1,(e4,e7)) -> (e1,e4,e7)) $> {- Be careful, those storable vectors shorten the whole sound if they have shorter release than the main envelope. -} liftA2 (,) env4 env7)) pingReleaseEnvelope bellNoiseStereoFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) bellNoiseStereoFM = liftA2 (\osc env dec rel noiseAmp noiseReson vcsize fm sr vel freq dur -> pioApply (osc sr (fm, freq) (noiseAmp, noiseReson) vel (env (dec/4) rel vcsize sr vel dur) (env (dec/7) rel vcsize sr vel dur)) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Modulation fm) (Control noiseAmp, Control noiseReson) (Number vel) (Signal env4) (Signal env7) -> constant noiseReference 20000 $ \noiseRef -> constant frequency 5 $ \speed _sr -> (let osci :: (Triple VectorValue -> VectorValue) -> Exp Real -> Exp Real -> Causal.T (Triple VectorValue, VectorValue) VectorValue osci sel v d = Causal.envelope <<< (arr sel *** (CausalPS.amplify v <<< (CausalPS.osci WaveL.approxSine4 $< zero) <<< CausalPS.amplify d)) noise :: (Triple VectorValue -> VectorValue) -> Exp Real -> Causal.T (Triple VectorValue, VectorValue) VectorValue noise sel d = (Causal.envelope $< piecewiseConstantVector noiseAmp) <<< Causal.envelope <<< (arr sel *** ({- UniFilter.lowpass ^<< -} (CtrlPS.process $> SigPS.noise 12 noiseRef) <<< {- (Causal.quantizeLift (Causal.zipWith UniFilterL.parameter) $<# (128 / fromIntegral vectorSize :: Real)) -} (Causal.quantizeLift (Causal.zipWith (MoogL.parameter TypeNum.d8)) $<# (128 / fromIntegral vectorSize :: Real)) <<< CausalClass.feedFst (piecewiseConstant noiseReson) <<< Causal.map Serial.subsample <<< CausalPS.amplify d)) in liftA2 Stereo.consMultiValue (sumNested [osci fst3 0.6 (1*0.999), osci snd3 (0.02 * 50^?vel) (4*0.999), osci thd3 (0.02 * 100^?vel) (7*0.999), noise fst3 0.999]) (sumNested [osci fst3 0.6 (1*1.001), osci snd3 (0.02 * 50^?vel) (4*1.001), osci thd3 (0.02 * 100^?vel) (7*1.001), noise fst3 1.001]) <<< CausalClass.feedSnd (frequencyFromBendModulation speed fm) <<< arr (\(e1,(e4,e7)) -> (e1,e4,e7)) $> {- Be careful, those storable vectors shorten the whole sound if they have shorter release than the main envelope. -} liftA2 (,) env4 env7)) pingReleaseEnvelope tine :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real Vector) tine = liftA2 (\osc env dec rel vcsize sr vel freq dur -> pioApply (osc sr vel freq) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Number vel) (Frequency freq) -> constant time 1 $ \halfLife _sr -> (Causal.envelope $> (CausalPS.osci WaveL.approxSine2 $> SigPS.constant freq $* (Causal.envelope $< SigPS.exponential2 halfLife (vel+1) $* SigPS.osci WaveL.approxSine2 zero (2*freq))))) pingReleaseEnvelope tineStereo :: IO (Real -> Real -> SigSt.ChunkSize -> Instrument Real (Stereo.T Vector)) tineStereo = liftA2 (\osc env dec rel vcsize sr vel freq dur -> pioApply (osc sr vel freq) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Number vel) (Frequency freq) -> constant time 1 $ \halfLife _sr -> (let chanOsci d = CausalPS.osci WaveL.approxSine2 $> SigPS.constant (freq*d) in Stereo.multiValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (chanOsci 0.995) (chanOsci 1.005) $* (SigPS.exponential2 halfLife (vel+1) * SigPS.osci WaveL.approxSine2 zero (2*freq))))) pingReleaseEnvelope softStringReleaseEnvelope :: IO (Real -> SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Vector) softStringReleaseEnvelope = liftA2 (\rev env attackTime sr vel dur -> let attackTimeVector :: Word attackTimeVector = round (attackTime * vectorRate sr) {- release <- take attackTime beginning would yield a space leak, thus we first split 'beginning' and then concatenate it again -} {- We can not easily generate attack and sustain separately, because we want to use the chunk structure implied by 'dur'. -} (attack, sustain) = SigSt.splitAt (fromIntegral attackTimeVector) $ pioApplyToLazyTime (env sr (amplitudeFromVelocity vel) attackTimeVector) dur release = rev attack in attack <> sustain <> release) SigStL.makeReversePacked (CausalRender.run $ wrapped $ \(Number amp) (Parameter attackTimeVector) (SampleRate _sr) -> Causal.fromSignal $ (<> SigPS.constant amp) $ (CausalPS.amplify amp <<< Causal.take attackTimeVector $* SigPS.parabolaFadeInInf (fromIntegral vectorSize * Expr.fromIntegral attackTimeVector))) softString :: IO (Instrument Real (Stereo.T Vector)) softString = liftA2 (\osc env sr vel freq dur -> pioApply (osc sr freq) (env 1 sr vel dur)) (CausalRender.run $ wrapped $ \(Frequency freq) (SampleRate _sr) -> let osci d = SigPS.osci WaveL.saw zero (d * freq) in Stereo.multiValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (osci 1.005 + osci 0.998) (osci 1.002 + osci 0.995))) softStringReleaseEnvelope softStringFM :: IO (PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) softStringFM = liftA2 (\osc env fm sr vel freq dur -> pioApply (osc sr (fm, freq)) (env 1 sr vel dur)) (CausalRender.run $ wrapped $ \(Modulation fm) -> constant frequency 5 $ \speed _sr -> let osci d = (CausalPS.osci WaveL.saw $< zero) <<< CausalPS.amplify d in Stereo.multiValue <$> (Causal.envelopeStereo $> (liftA2 Stereo.cons (osci 1.005 + osci 0.998) (osci 1.002 + osci 0.995) $* frequencyFromBendModulation speed fm))) softStringReleaseEnvelope tineStereoFM :: IO (Real -> Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) tineStereoFM = liftA2 (\osc env dec rel vcsize fm sr vel freq dur -> pioApply (osc sr vel (fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Number vel) (Modulation fm) -> constant time 1 $ \halfLife -> constant frequency 5 $ \speed _sr -> (let chanOsci d = CausalPS.osci WaveL.approxSine2 <<< second (CausalPS.amplify d) in Stereo.multiValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (chanOsci 0.995) (chanOsci 1.005) <<< (((Causal.envelope $< SigPS.exponential2 halfLife (vel+1)) <<< (CausalPS.osci WaveL.approxSine2 $< zero) <<< CausalPS.amplify 2) &&& id) $* frequencyFromBendModulation speed fm))) pingReleaseEnvelope _tineControlledProc, tineControlledFnProc :: Sig.T (Const.T RealValue) -> Sig.T (Const.T RealValue) -> Exp Real -> SampleRate (Exp Real) -> Causal.T (Stereo.T VectorValue) (Stereo.T VectorValue) _tineControlledProc index depth vel = constant time 1 $ \halfLife _sr -> Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2) <<< Stereo.interleave ^<< ((Causal.envelopeStereo $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2 $< zero) <<< (Causal.envelopeStereo $< piecewiseConstantVector index)) &&& id tineControlledFnProc index depth vel = constant time 1 $ \halfLife _sr -> F.withGuidedArgs F.atom $ \freq -> Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2) $& liftA2 (liftA2 (,)) ((Causal.envelopeStereo $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2 $< zero) <<< (Causal.envelopeStereo $< piecewiseConstantVector index) $& freq) freq tineControlledFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) tineControlledFM = liftA2 (\osc env dec rel detune index depth vcsize fm sr vel freq dur -> pioApply (osc sr (index, depth) vel (detune, fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Control index, Control depth) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> Stereo.multiValue <$> Causal.envelopeStereo $> (tineControlledFnProc index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) pingReleaseEnvelope fenderProc :: Sig.T (Const.T RealValue) -> Sig.T (Const.T RealValue) -> Sig.T (Const.T RealValue) -> Exp Real -> SampleRate (Exp Real) -> Causal.T (Stereo.T VectorValue) (Stereo.T VectorValue) fenderProc fade index depth vel = constant time 1 $ \halfLife _sr -> F.withGuidedArgs F.atom $ \stereoFreq -> let channel_n_1 :: F.T VectorValue VectorValue -> F.T VectorValue VectorValue channel_n_1 freq = CausalPS.osci WaveL.approxSine2 $& ((Causal.envelope $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< (CausalPS.osci WaveL.approxSine2 $< zero) <<< (Causal.envelope $< piecewiseConstantVector index) $& freq) &|& freq channel_1_2 :: F.T VectorValue VectorValue -> F.T VectorValue VectorValue channel_1_2 freq = CausalPS.osci WaveL.approxSine2 $& ((Causal.envelope $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< (CausalPS.osci WaveL.approxSine2 $< zero) $& freq) &|& (CausalPS.amplify 2 $& freq) in (Causal.stereoFromMonoControlled (fadeProcess (F.compile $ channel_n_1 $ F.lift id) (F.compile $ channel_1_2 $ F.lift id)) $< piecewiseConstantVector fade) $& stereoFreq fenderFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) fenderFM = liftA2 (\osc env dec rel detune index depth fade vcsize fm sr vel freq dur -> pioApply (osc sr (index, depth) fade vel (detune, fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Control index, Control depth) (Control fade) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> Stereo.multiValue <$> Causal.envelopeStereo $> (fenderProc fade index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) pingReleaseEnvelope fmModulator :: Exp Real -> Exp Real -> Sig.T (Const.T RealValue) -> SampleRate (Exp Real) -> Causal.T (Stereo.T VectorValue) (Stereo.T VectorValue) fmModulator vel n depth = constant time 1 $ \halfLife _sr -> (Causal.envelopeStereo $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2 $< zero) <<< CausalPS.amplifyStereo n tineModulatorBankFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) tineModulatorBankFM = liftA2 (\osc env dec rel detune depth1 depth2 depth3 depth4 vcsize fm sr vel freq dur -> pioApply (osc sr depth1 depth2 depth3 depth4 vel (detune, fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Control depth1) (Control depth2) (Control depth3) (Control depth4) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> Stereo.multiValue <$> (Causal.envelopeStereo $> (Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2) <<< Stereo.interleave ^<< sumNested [fmModulator vel 1 depth1 sr, fmModulator vel 2 depth2 sr, fmModulator vel 3 depth3 sr, fmModulator vel 4 depth4 sr] &&& id $* stereoFrequenciesFromDetuneBendModulation speed fm))) pingReleaseEnvelope tineBankFM :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) tineBankFM = liftA2 (\osc env dec rel detune depth1 depth2 depth3 depth4 partial1 partial2 partial3 partial4 vcsize fm sr vel freq dur -> pioApply (osc sr depth1 depth2 depth3 depth4 partial1 partial2 partial3 partial4 vel (detune, fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Control depth1) (Control depth2) (Control depth3) (Control depth4) (Control partial1) (Control partial2) (Control partial3) (Control partial4) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> (let partial :: VectorValue -> Int -> VectorValue -> LLVM.CodeGenFunction r VectorValue partial amp n t = A.mul amp =<< WaveL.partial WaveL.approxSine2 n t in Stereo.multiValue <$> Causal.envelopeStereo $> (Causal.stereoFromMono (CausalPS.shapeModOsci (\(p1,(p2,(p3,p4))) t -> do y1 <- A.mul p1 =<< WaveL.approxSine2 t y2 <- partial p2 2 t y3 <- partial p3 3 t y4 <- partial p4 4 t A.add y1 =<< A.add y2 =<< A.add y3 y4) $< (liftA2 (,) (piecewiseConstantVector partial1) $ liftA2 (,) (piecewiseConstantVector partial2) $ liftA2 (,) (piecewiseConstantVector partial3) (piecewiseConstantVector partial4))) <<< Stereo.interleave ^<< sumNested [fmModulator vel 1 depth1 sr, fmModulator vel 2 depth2 sr, fmModulator vel 3 depth3 sr, fmModulator vel 4 depth4 sr] &&& id $* stereoFrequenciesFromDetuneBendModulation speed fm))) pingReleaseEnvelope {- | FM synthesis where the modulator is a resonantly filtered sawtooth. This way we get a sinus-like modulator where the sine frequency (that is, something like the modulation index) can be controlled continously. -} resonantFMSynthProc :: Sig.T (Const.T RealValue) -> Sig.T (Const.T RealValue) -> Sig.T (Const.T RealValue) -> Exp Real -> SampleRate (Exp Real) -> Causal.T (Stereo.T VectorValue) (Stereo.T VectorValue) resonantFMSynthProc reson index depth vel = constant time 1 $ \halfLife _sr -> F.withGuidedArgs (Stereo.cons F.atom F.atom) $ \stereoFreq -> let chan :: F.T inp VectorValue -> F.T inp VectorValue chan freq = CausalPS.osci WaveL.approxSine2 $& ((Causal.envelope $< (piecewiseConstantVector depth * SigPS.exponential2 halfLife (vel+1))) <<< UniFilter.lowpass ^<< CtrlPS.process $& (Causal.zipWith UniFilterL.parameter <<< CausalClass.feedFst (piecewiseConstant reson) <<< (Causal.envelope $< piecewiseConstant index) <<< Causal.map Serial.subsample $& freq) &|& ((CausalPS.osci WaveL.saw $< zero) $& freq)) &|& freq in Trav.traverse chan stereoFreq resonantFMSynth :: IO (Real -> Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) resonantFMSynth = liftA2 (\osc env dec rel detune reson index depth vcsize fm sr vel freq dur -> pioApply (osc sr (reson, index, depth) vel (detune, fm, freq)) (env dec rel vcsize sr 0 dur)) (CausalRender.run $ wrapped $ \(Control reson, Control index, Control depth) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> Stereo.multiValue <$> Causal.envelopeStereo $> (resonantFMSynthProc reson index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) pingReleaseEnvelope phaserOsci :: (Exp Real -> Causal.T a VectorValue) -> Causal.T a (Stereo.T VectorValue) phaserOsci osci = CausalPS.amplifyStereo 0.25 <<< liftA2 Stereo.cons (sumNested $ map osci [1.0, -0.4, 0.5, -0.7]) (sumNested $ map osci [0.4, -1.0, 0.7, -0.5]) softStringDetuneFM :: IO (Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) softStringDetuneFM = liftA2 (\osc env att det fm sr vel freq dur -> pioApply (osc sr det (fm, freq)) (env att sr vel dur)) (let osci :: Exp Real -> Causal.T (VectorValue, VectorValue) VectorValue osci d = (CausalPS.osci WaveL.saw $< zero) <<< Causal.envelope <<< first (one + CausalPS.amplify d) in CausalRender.run $ wrapped $ \(Control det) (Modulation fm) -> constant frequency 5 $ \speed _sr -> Stereo.multiValue <$> (Causal.envelopeStereo $> (phaserOsci osci $< piecewiseConstantVector det $* frequencyFromBendModulation speed fm))) softStringReleaseEnvelope {- We might decouple the frequency of the enveloped tone from the frequency of the envelope, in order to get something like formants. -} softStringShapeFM, cosineStringStereoFM, arcSineStringStereoFM, arcTriangleStringStereoFM, arcSquareStringStereoFM, arcSawStringStereoFM :: IO (Real -> PC.T Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) softStringShapeFM = softStringShapeCore WaveL.rationalApproxSine1 cosineStringStereoFM = softStringShapeCore (\k p -> WaveL.approxSine2 =<< WaveL.replicate k p) arcSawStringStereoFM = arcStringStereoFM WaveL.saw arcSineStringStereoFM = arcStringStereoFM WaveL.approxSine2 arcSquareStringStereoFM = arcStringStereoFM WaveL.square arcTriangleStringStereoFM = arcStringStereoFM WaveL.triangle arcStringStereoFM :: (forall r. VectorValue -> LLVM.CodeGenFunction r VectorValue) -> IO (Real -> PC.T Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) arcStringStereoFM wave = softStringShapeCore (\k p -> M.liftJoin2 Frame.amplifyMono (WaveL.approxSine4 =<< WaveL.halfEnvelope p) (wave =<< WaveL.replicate k p)) softStringShapeCore :: (forall r. VectorValue -> VectorValue -> LLVM.CodeGenFunction r VectorValue) -> IO (Real -> PC.T Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) softStringShapeCore wave = liftA2 (\osc env att det dist fm sr vel freq dur -> pioApply (osc sr det dist (fm, freq)) (env att sr vel dur)) (let osci :: Exp Real -> Causal.T (VectorValue, {- wave shape parameter -} (VectorValue, VectorValue) {- detune, frequency modulation -}) VectorValue osci d = CausalPS.shapeModOsci wave <<< second (CausalClass.feedFst zero <<< Causal.envelope <<< first (one + CausalPS.amplify d)) in CausalRender.run $ wrapped $ \(Control det) (Control dist) (Modulation fm) -> constant frequency 5 $ \speed _sr -> Stereo.multiValue <$> (Causal.envelopeStereo $> (phaserOsci osci $< piecewiseConstantVector dist $< piecewiseConstantVector det $* frequencyFromBendModulation speed fm))) softStringReleaseEnvelope fmStringStereoFM :: IO (Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) fmStringStereoFM = liftA2 (\osc env att det depth dist fm sr vel freq dur -> pioApply (osc sr det depth dist (fm, freq)) (env att sr vel dur)) (let osci :: Exp Real -> Causal.T ((VectorValue, VectorValue) {- phase modulation depth, modulator distortion -}, (VectorValue, VectorValue) {- detune, frequency modulation -}) VectorValue osci d = CausalPS.osci WaveL.approxSine2 <<< (Causal.envelope <<< second (CausalPS.shapeModOsci WaveL.rationalApproxSine1 <<< second (CausalClass.feedFst zero)) <<^ (\((dp, ds), f) -> (dp, (ds, f)))) &&& arr snd <<< second (Causal.envelope <<< first (one + CausalPS.amplify d)) in CausalRender.run $ wrapped $ \(Control det) (Control depth) (Control dist) (Modulation fm) -> constant frequency 5 $ \speed _sr -> Stereo.multiValue <$> (Causal.envelopeStereo <<< (id &&& (phaserOsci osci <<< CausalClass.feedSnd (liftA2 (,) (piecewiseConstantVector det) (frequencyFromBendModulation speed fm)) <<< CausalClass.feedSnd (piecewiseConstantVector dist) <<< (Causal.envelope $< piecewiseConstantVector depth))))) softStringReleaseEnvelope stereoNoise :: SampleRate (Exp Real) -> Sig.T (Stereo.T VectorValue) stereoNoise = constant noiseReference 20000 $ \noiseRef _sr -> traverse (\uid -> SigPS.noise uid noiseRef) (Stereo.cons 13 14) windCore :: Sig.T (Const.T RealValue) -> Sig.T (Const.T (BM.T RealValue)) -> SampleRate (Exp Real) -> Sig.T (Stereo.T VectorValue) windCore reson fm = constant frequency 0.2 $ \speed sr -> Causal.stereoFromMonoControlled CtrlPS.process $< (Causal.zipWith (MoogL.parameter TypeNum.d8) $< piecewiseConstant reson $* (Causal.map Serial.subsample $* frequencyFromBendModulation speed fm)) $* stereoNoise sr wind :: IO (Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) wind = liftA2 (\osc env att reson fm sr vel freq dur -> pioApply (osc sr reson (fm, freq)) (env att sr vel dur)) (CausalRender.run $ wrapped $ \(Control reson) (Modulation fm) sr -> Stereo.multiValue <$> Causal.envelopeStereo $> windCore reson fm sr) softStringReleaseEnvelope fadeProcess :: (A.PseudoRing v, A.IntegerConstant v) => Causal.T a v -> Causal.T a v -> Causal.T (v, a) v fadeProcess proc0 proc1 = let k = arr fst a0 = proc0 <<^ snd a1 = proc1 <<^ snd in (one-k)*a0 + k*a1 windPhaser :: IO (Real -> PC.T Real -> PC.T Real -> PC.T Real -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) windPhaser = liftA2 (\osc env att phaserMix phaserFreq reson fm sr vel freq dur -> pioApply (osc sr phaserMix phaserFreq reson (fm, freq)) (env att sr vel dur)) (CausalRender.run $ wrapped $ \(Control phaserMix) (FrequencyControl phaserFreq) (Control reson) (Modulation fm) sr -> Stereo.multiValue <$> (Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled (fadeProcess (arr snd) CtrlPS.process <<< first (Causal.map Serial.upsample) <<^ (\((k,p),x) -> (k,(p,x)))) $< liftA2 (,) (piecewiseConstant phaserMix) (piecewiseConstant (Const.causalMap (Allpass.flangerParameter TypeNum.d8) $* phaserFreq))) $* windCore reson fm sr))) softStringReleaseEnvelope filterSawStereoFM :: IO (Real -> Real -> PC.T Real -> Real -> Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) filterSawStereoFM = liftA2 (\osc env dec rel detune bright brightDecay vcsize fm sr vel freq dur -> pioApply (osc sr bright brightDecay (detune, fm, freq)) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Frequency bright) (Time brightDec) (DetuneModulation fm) -> constant frequency 10 $ \speed -> constant frequency 100 $ \cutoff _sr -> (Stereo.multiValue <$> Causal.envelopeStereo $> (Causal.stereoFromMono (UniFilter.lowpass ^<< CtrlPS.processCtrlRate 100 (\k -> Causal.map (UniFilterL.parameter 10) $* {- bound control in order to avoid too low resonant frequency, which makes the filter instable -} Sig.exponentialBounded2 cutoff (brightDec/k) bright) <<< CausalPS.osci WaveL.saw $< zero) $* stereoFrequenciesFromDetuneBendModulation speed fm))) pingReleaseEnvelope {- | The ADSR curve is composed from three parts: Attack, Decay(+Sustain), Release. Attack starts when the key is pressed and lasts attackTime seconds where it reaches height attackPeak*amplitudeOfVelocity. It should be attackPeak>1 because in the following phase we want to approach 1 from above. Say the curve would approach the limit value L if it would continue after the end of the attack phase, the slope is determined by the halfLife with respect to this upper bound. That is, attackHalfLife is the time in seconds where the attack curve reaches or would reach L/2. After Attack the Decay part starts at the same level and decays to amplitudeOfVelocity. The slope is again a halfLife, that is, decayHalfLife is the time where the curve drops from attackPeak*amplitudeOfVelocity to (attackPeak+1)/2*amplitudeOfVelocity. This phase lasts as long as the key is pressed. If the key is released the curve decays with half life releaseHalfLife. -} {- 1 - 2^(-attackTime/attackHalfLife) = peak -} adsr :: IO (Real -> Real -> Real -> Real -> Real -> SigSt.ChunkSize -> SampleRate Real -> Real -> Ev.LazyTime -> SigSt.T Vector) adsr = liftA3 (\attack decay release attackTime attackPeak attackHalfLife decayHalfLife releaseHalfLife vcsize sr vel dur -> let amp = amplitudeFromVelocity vel (attackDur, decayDur) = CutG.splitAt (round (attackTime * vectorRate sr)) dur in SigStL.continuePacked (pioApplyToLazyTime (attack sr attackHalfLife (attackPeak * amp / (1 - 2^?(-attackTime/attackHalfLife)))) attackDur <> pioApplyToLazyTime (decay sr decayHalfLife ((attackPeak-1)*amp) amp) decayDur) (\x -> release vcsize sr releaseHalfLife x)) (CausalRender.run $ wrapped $ \(Time halfLife) (Number amplitude) (SampleRate _sr) -> Causal.fromSignal $ SigPS.constant amplitude - SigPS.exponential2 halfLife amplitude) (CausalRender.run $ wrapped $ \(Time halfLife) (Number amplitude) (Number saturation) (SampleRate _sr) -> Causal.fromSignal $ SigPS.constant saturation + SigPS.exponential2 halfLife amplitude) (Render.run $ wrapped $ \(Time releaseHL) (Number amplitude) (SampleRate _sr) -> let releaseTime = releaseHL * 5 / fromIntegral vectorSize in Causal.take (Expr.roundToIntFast releaseTime) $* SigPS.exponential2 releaseHL amplitude) brass :: IO (Real -> Real -> Real -> Real -> Real -> Real -> PC.T Real -> PC.T Real -> SigSt.ChunkSize -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) brass = liftA2 (\osc env attTime attPeak attHL dec rel emph det dist vcsize fm sr vel freq dur -> pioApply (osc sr det dist (fm, freq) (env attTime emph attHL dec rel vcsize sr vel dur)) (env attTime attPeak attHL dec rel vcsize sr vel dur)) (let osci :: Exp Real -> Causal.T (VectorValue, {- wave shrink/replication factor -} (VectorValue, VectorValue) {- detune, frequency modulation -}) VectorValue osci d = CausalPS.shapeModOsci WaveL.rationalApproxSine1 <<< second (CausalClass.feedFst zero <<< Causal.envelope <<< first (one + CausalPS.amplify d)) in CausalRender.run $ wrapped $ \(Control det) (Control dist) (Modulation fm) (Signal emph) -> constant frequency 5 $ \speed _sr -> Stereo.multiValue <$> Causal.envelopeStereo $> (phaserOsci osci <<< CausalClass.feedFst (piecewiseConstantVector dist) <<< CausalClass.feedSnd (frequencyFromBendModulation speed fm) <<< (Causal.envelope $< piecewiseConstantVector det) $* emph)) adsr sampledSound :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) sampledSound = liftA2 (\osc freqMod smp fm sr vel freq dur -> {- We split the frequency modulation signal in order to get a smooth frequency modulation curve. Without (periodic) frequency modulation we could just split the piecewise constant control curve @fm@. -} let fmSig :: SigSt.T Vector fmSig = pioApplyToLazyTime (freqMod sr (fm, freq * Sample.period pos)) (PC.duration fm) pos = Sample.positions smp amp = 2 * amplitudeFromVelocity vel (attack, sustain, release) = Sample.parts smp in (\cont -> pioApplyCont cont (osc sr amp (attack <> SVL.cycle (SigSt.take (Sample.loopLength pos) sustain)) (chunkSizesFromLazyTime dur)) fmSig) (pioApplyCont (const SigSt.empty) (osc sr amp release (NonNegChunky.fromChunks (repeat 1000))))) (CausalRender.run $ wrapped $ \(Number amp) (Signal smp) (Signal dur) (SampleRate _sr) -> Stereo.multiValue <$> CausalPS.amplifyStereo amp <<< Causal.stereoFromMono (CausalPS.pack (Causal.frequencyModulationLinear smp)) <<< liftA2 Stereo.cons (CausalPS.amplify 0.999) (CausalPS.amplify 1.001) <<< arr fst <<< CausalClass.feedSnd (Const.flatten dur)) (CausalRender.run $ wrapped $ \(Modulation fm) -> constant frequency 3 $ \speed _sr -> Causal.fromSignal $ frequencyFromBendModulation speed fm) _sampledSoundLeaky :: IO (Sample.T -> PC.T (BM.T Real) -> Instrument Real (Stereo.T Vector)) _sampledSoundLeaky = liftA2 (\osc freqMod smp fm sr vel freq dur -> {- We split the frequency modulation signal in order to get a smooth frequency modulation curve. Without (periodic) frequency modulation we could just split the piecewise constant control curve @fm@. -} let sustainFM, releaseFM :: SigSt.T Vector (sustainFM, releaseFM) = SVP.splitAt (chunkSizesFromLazyTime dur) $ pioApplyToLazyTime (freqMod sr (fm, freq * Sample.period pos)) (PC.duration fm) pos = Sample.positions smp amp = 2 * amplitudeFromVelocity vel (attack, sustain, release) = Sample.parts smp in pioApply (osc sr amp (attack <> SVL.cycle (SigSt.take (Sample.loopLength pos) sustain))) sustainFM <> pioApply (osc sr amp release) releaseFM) (CausalRender.run $ wrapped $ \(Number amp) (Signal smp) (SampleRate _sr) -> Stereo.multiValue <$> CausalPS.amplifyStereo amp <<< Causal.stereoFromMono (CausalPS.pack (Causal.frequencyModulationLinear smp)) <<< liftA2 Stereo.cons (CausalPS.amplify 0.999) (CausalPS.amplify 1.001)) (CausalRender.run $ wrapped $ \(Modulation fm) -> constant frequency 3 $ \speed _sr -> Causal.fromSignal $ frequencyFromBendModulation speed fm)