diff --git a/csound-expression.cabal b/csound-expression.cabal --- a/csound-expression.cabal +++ b/csound-expression.cabal @@ -1,5 +1,5 @@ Name: csound-expression -Version: 4.9.1 +Version: 5.0.0 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -30,6 +30,12 @@ Hozan Yamamoto, Tony Scott and Shinichi Yuize. . * ideas: Conal Elliott, Oleg Kiselyov, Paul Hudak, Gabriel Gonzalez, Rich Hickey and Csound's community. + + * Thanks a lot to all who patiently answered my questions and provided skillful solutions, encouragement and ideas: + . + Iain McCurdy, Victor Lazarini, Rory Walsh, Steven Yi, John Ffitch, Joachim Heintz, Peter Burgess, Dr. Richard Boulanger, Michael Gogins, Oeyvind Brandtsegg, + Richard Dobson, Partev Barr Sarkissian, Dave Phillips, Guillermo Senna, Art Hunkins, + Ben McAllister, Michael Rhoades, Gleb Rogozinsky, Eugene Cherny, Brian Merchant, Wolf Peuker, Hlöðver Sigurðsson, Aaron Krister Johnson, Andy Fillebrown and friends :) Extra-Source-Files : examples/README.txt @@ -53,6 +59,14 @@ examples/Gui/Key.hs examples/Gui/Waves.hs + examples/Api/message.py + examples/Api/Message.hs + examples/Api/oscil.py + examples/Api/Oscil.hs + examples/Api/player.py + examples/Api/Player.hs + + Homepage: https://github.com/anton-k/csound-expression Bug-Reports: https://github.com/anton-k/csound-expression/issues @@ -65,8 +79,8 @@ Ghc-Options: -Wall Build-Depends: base >= 4, base < 5, process, data-default, Boolean >= 0.1.0, colour >= 2.0, transformers >= 0.3, containers, - csound-expression-typed >= 0.0.9.1, csound-expression-dynamic >= 0.1.5, temporal-media >= 0.6.1, - csound-expression-opcodes >= 0.0.3 + csound-expression-typed >= 0.0.9.2, csound-expression-dynamic >= 0.1.6, temporal-media >= 0.6.1, + csound-expression-opcodes >= 0.0.3.1 Hs-Source-Dirs: src/ Exposed-Modules: Csound.Base @@ -76,6 +90,7 @@ Csound.Air.Granular Csound.Air.Envelope Csound.Air.Filter + Csound.Air.ModArg Csound.Air.Wav Csound.Air.Spec Csound.Air.Fx @@ -87,13 +102,15 @@ Csound.Air.Misc Csound.Air.Hvs Csound.Air.Fm - Csound.Air.Pan + Csound.Air.Pan + Csound.Air.Padsynth Csound.Types Csound.Tab Csound.SigSpace Csound.IO Csound.Options + Csound.Tuning Csound.Control Csound.Control.Evt diff --git a/examples/Api/Message.hs b/examples/Api/Message.hs new file mode 100644 --- /dev/null +++ b/examples/Api/Message.hs @@ -0,0 +1,8 @@ +module Main where + +import Csound.Base + +instr :: (D, D) -> SE Sig +instr (amp, cps) = return $ (sig amp) * fades 0.01 0.1 * osc (sig cps) + +main = writeCsd "message.csd" $ trigByName "osc" instr diff --git a/examples/Api/Oscil.hs b/examples/Api/Oscil.hs new file mode 100644 --- /dev/null +++ b/examples/Api/Oscil.hs @@ -0,0 +1,13 @@ +module Main where + +import Csound.Base + +volume = text "volume" +frequency = text "frequency" + +instr = do + vol <- chnGetCtrl volume + cps <- chnGetCtrl frequency + return (vol * osc cps) + +main = writeCsd "osc.csd" instr diff --git a/examples/Api/Player.hs b/examples/Api/Player.hs new file mode 100644 --- /dev/null +++ b/examples/Api/Player.hs @@ -0,0 +1,24 @@ +module Main where + +import Csound.Base + +declick :: Sig2 -> Sig2 +declick = mul (fades 0.01 0.1) + +playWav :: Str -> SE Sig2 +playWav file = return $ declick $ diskin2 file 1 + +playMp3 :: Str -> SE Sig2 +playMp3 file = return $ declick $ mp3in file + +stop :: Unit -> SE () +stop _ = do + turnoffByName "wav" 0 0.1 + turnoffByName "mp3" 0 0.1 + turnoff + +main = writeCsd "player.csd" $ do + wavs <- trigByName "wav" playWav + mp3s <- trigByName "mp3" playMp3 + trigByName_ "stop" stop + return $ wavs + mp3s diff --git a/examples/Api/message.py b/examples/Api/message.py new file mode 100644 --- /dev/null +++ b/examples/Api/message.py @@ -0,0 +1,21 @@ +import csnd6 + +class Audio: + def __init__(self): + engine = csnd6.Csound() + engine.SetOption("-odac") + engine.Compile("message.csd") + + thread = csnd6.CsoundPerformanceThread(engine) + thread.Play() + + self.engine = engine + self.thread = thread + + def play(self, delay, duration, volume, frequency): + self.thread.InputMessage("i \"%s\" %f %f %f %f" % ("osc", delay, duration, volume, frequency)) + + def close(self): + self.thread.Stop() + self.thread.Join() + diff --git a/examples/Api/oscil.py b/examples/Api/oscil.py new file mode 100644 --- /dev/null +++ b/examples/Api/oscil.py @@ -0,0 +1,28 @@ +import csnd6 + +class Ctrl: + def __init__(self, volume, frequency): + engine = csnd6.Csound() + engine.SetOption("-odac") + engine.Compile("osc.csd") + + thread = csnd6.CsoundPerformanceThread(engine) + thread.Play() + + self.engine = engine + self.thread = thread + + self.set_volume(volume) + self.set_frequency(frequency) + + def set_volume(self, volume): + self.engine.SetChannel("volume", volume) + + def set_frequency(self, frequency): + self.engine.SetChannel("frequency", frequency) + + def close(self): + self.thread.Stop() + self.thread.Join() + self.engine.Stop() + diff --git a/examples/Api/player.py b/examples/Api/player.py new file mode 100644 --- /dev/null +++ b/examples/Api/player.py @@ -0,0 +1,36 @@ +import csnd6, os.path, time + +def is_mp3(filename): + filename, file_extension = os.path.splitext(filename) + return file_extension == '.mp3' + +class Player: + def __init__(self): + engine = csnd6.Csound() + engine.SetOption("-odac") + engine.Compile("player.csd") + + thread = csnd6.CsoundPerformanceThread(engine) + thread.Play() + + self.engine = engine + self.thread = thread + + def play_file_by_ext(self, ext, file): + self.thread.InputMessage("i \"%s\" 0 -1 \"%s\"" % (ext, file)) + + def stop(self): + self.thread.InputMessage("i \"stop\" 0 0.01") + time.sleep(0.02) + + def play(self, file): + self.stop() + if is_mp3(file): + self.play_file_by_ext("mp3", file) + else: + self.play_file_by_ext("wav", file) + + def close(self): + self.thread.Stop() + self.thread.Join() + diff --git a/src/Csound/Air.hs b/src/Csound/Air.hs --- a/src/Csound/Air.hs +++ b/src/Csound/Air.hs @@ -7,8 +7,11 @@ module Csound.Air.Envelope, -- | Filters - module Csound.Air.Filter, + module Csound.Air.Filter, + -- | Argument modifiers + module Csound.Air.ModArg, + -- | Sound file playback module Csound.Air.Wav, @@ -42,6 +45,9 @@ -- | FM synth module Csound.Air.Fm, + -- | Padsynth + module Csound.Air.Padsynth, + -- | Other usefull stuff. module Csound.Air.Misc ) where @@ -49,6 +55,7 @@ import Csound.Air.Wave import Csound.Air.Envelope import Csound.Air.Filter +import Csound.Air.ModArg import Csound.Air.Wav import Csound.Air.Granular import Csound.Air.Spec @@ -60,5 +67,6 @@ import Csound.Air.Sampler import Csound.Air.Pan import Csound.Air.Fm +import Csound.Air.Padsynth import Csound.Air.Misc diff --git a/src/Csound/Air/Envelope.hs b/src/Csound/Air/Envelope.hs --- a/src/Csound/Air/Envelope.hs +++ b/src/Csound/Air/Envelope.hs @@ -7,7 +7,7 @@ onDur, lindurBy, expdurBy, linendurBy, -- * Faders - fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades, + fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades, slope, expSlope, -- * Humanize HumanizeValue(..), HumanizeTime(..), HumanizeValueTime(..), @@ -125,7 +125,18 @@ -- | Fades out with the given attack time. fadeOut :: D -> Sig fadeOut dec = linsegr [1] dec 0 - + +-- | Slope envelope. It stays at zero for a given time then it raises to 1 for thre given time. +-- The function is usefull to delay the LFO. +-- +-- > slope zeroTime rizeTime +slope :: D -> D -> Sig +slope dt1 dt2 = linseg [0, dt1, 0, dt2, 1 ] + +-- | Exponential slope (See the function @slope@). +expSlope :: D -> D -> Sig +expSlope dt1 dt2 = linseg [0.001, dt1, 0.001, dt2, 1 ] + -- | Fades in by exponent with the given attack time. expFadeIn :: D -> Sig expFadeIn att = expseg [0.0001, att, 1] diff --git a/src/Csound/Air/Filter.hs b/src/Csound/Air/Filter.hs --- a/src/Csound/Air/Filter.hs +++ b/src/Csound/Air/Filter.hs @@ -25,14 +25,24 @@ formant, singA, singO, singE, singU, singO2, -- * Making the smooth lines - smooth, slide + smooth, slide, + -- * Analog filters + -- | Requires Csound 6.07 or higher + + alp1, alp2, alp3, alp4, ahp, + + -- ** Low level analog filters + mvchpf, mvclpf1, mvclpf2, mvclpf3, mvclpf4 ) where import Csound.Typed import Csound.SigSpace(bat) import Csound.Typed.Opcode +import Control.Monad.Trans.Class +import Csound.Dynamic + -- | Low-pass filter. -- -- > lp cutoff resonance sig @@ -94,7 +104,7 @@ -- -- > mlp centerFrequency qResonance signal mlp :: Sig -> Sig -> Sig -> Sig -mlp cf q asig = moogladder asig cf q +mlp cf q asig = moogvcf asig cf q -- | Makes slides between values in the signals. -- The first value defines a duration in seconds for a transition from one @@ -138,10 +148,10 @@ lp18 :: Sig -> Sig -> Sig -> Sig -> Sig lp18 dist cfq q asig = lpf18 asig cfq q dist --- | Another implementation of moog low pass filter (it's moogvcf in Csound). +-- | Another implementation of moog low pass filter (it's moogladder in Csound). -- The arguments have are just like in the @mlp@ filter. mlp2 :: Sig -> Sig -> Sig -> Sig -mlp2 cfq q asig = moogvcf asig cfq q +mlp2 cfq q asig = moogladder asig cfq q -- | Mooglowpass filter with 18 dB. mlp3 :: Sig -> Sig -> Sig -> Sig @@ -206,3 +216,85 @@ anE = [(500, 50), (1750, 50), (2450, 50), (3350, 50), (5000, 50)] anIY = [(330, 50), (2000, 50), (2800, 50), (3650, 50), (5000, 50)] anO2 = [(400, 50), (840, 50), (2800, 50), (3250, 50), (4500, 50)] + +------------------------------------------------------- +-- new filters + +-- | Analog-like low-pass filter +-- +-- > alpf1 centerFrequency resonance asig +alp1 :: Sig -> Sig -> Sig -> Sig +alp1 freq reson asig = mvclpf1 asig freq reson + +-- | Analog-like low-pass filter +-- +-- > alpf2 centerFrequency resonance asig +alp2 :: Sig -> Sig -> Sig -> Sig +alp2 freq reson asig = mvclpf2 asig freq reson + +-- | Analog-like low-pass filter +-- +-- > alpf3 centerFrequency resonance asig +alp3 :: Sig -> Sig -> Sig -> Sig +alp3 freq reson asig = mvclpf3 asig freq reson + +-- | Analog-like low-pass filter +-- +-- > alpf4 centerFrequency resonance asig +alp4 :: Sig -> Sig -> Sig -> Sig +alp4 freq reson asig = mvclpf4 asig freq reson + +-- | Analog-like high-pass filter +-- +-- > ahp centerFrequency asig +ahp :: Sig -> Sig -> Sig +ahp freq asig = mvchpf asig freq + +-- | +-- Moog ladder lowpass filter. +-- +-- Moogladder is an new digital implementation of the Moog ladder filter based on +-- the work of Antti Huovilainen, described in the paper "Non-Linear Digital +-- Implementation of the Moog Ladder Filter" (Proceedings of DaFX04, Univ of Napoli). +-- This implementation is probably a more accurate digital representation of +-- the original analogue filter. +-- +-- > asig moogladder ain, kcf, kres[, istor] +-- +-- csound doc: + + +-- | Emulator of analog high pass filter. +-- +-- > mvchpf asig xfreq +mvchpf :: Sig -> Sig -> Sig +mvchpf b1 b2 = Sig $ f <$> unSig b1 <*> unSig b2 + where f a1 a2 = opcs "mvchpf" [(Ar,[Ar,Xr,Ir])] [a1,a2] + +-- | Emulators of analog filters (requires Csound >= 6.07). +-- +-- > mvclpf1 asig xfreq xresonance +mvclpf1 :: Sig -> Sig -> Sig -> Sig +mvclpf1 = genMvclpf "mvclpf1" + +-- | Emulators of analog filters. +-- +-- > mvclpf2 asig xfreq xresonance +mvclpf2 :: Sig -> Sig -> Sig -> Sig +mvclpf2 = genMvclpf "mvclpf2" + +-- | Emulators of analog filters. +-- +-- > mvclpf3 asig xfreq xresonance +mvclpf3 :: Sig -> Sig -> Sig -> Sig +mvclpf3 = genMvclpf "mvclpf3" + +-- | Emulators of analog filters. +-- +-- > mvclpf4 asig xfreq xresonance +mvclpf4 :: Sig -> Sig -> Sig -> Sig +mvclpf4 = genMvclpf "mvclpf4" + +genMvclpf :: String -> Sig -> Sig -> Sig -> Sig +genMvclpf name b1 b2 b3 = Sig $ f <$> unSig b1 <*> unSig b2 <*> unSig b3 + where f a1 a2 a3 = opcs name [(Ar,[Ar,Xr,Xr,Ir])] [a1,a2,a3] diff --git a/src/Csound/Air/Fx.hs b/src/Csound/Air/Fx.hs --- a/src/Csound/Air/Fx.hs +++ b/src/Csound/Air/Fx.hs @@ -8,6 +8,7 @@ -- * Delays MaxDelayTime, DelayTime, Feedback, Balance, echo, fdelay, fvdelay, fvdelays, funDelays, tabDelay, + PingPongSpec(..), pingPong, pingPong', csdPingPong, -- * Distortion distortion, @@ -35,6 +36,7 @@ ) where import Data.Boolean +import Data.Default import Csound.Typed import Csound.Tab(sines4, startEnds, setSize, elins, newTab, tabSizeSecondsPower2, tablewa, sec2rel) @@ -185,6 +187,63 @@ return $ (1 - kbalance) * asig + kbalance * awet where tabLen = tabSizeSecondsPower2 maxLength + +-- | Aux parameters for ping pong delay. +-- They are maximum delay time, low pass filter center frequency and Pan width. +-- The defaults are @(5 sec, 3500, 0.3)@. +data PingPongSpec = PingPongSpec { + pingPongMaxTime :: MaxDelayTime, + pingPongDamp :: Sig, + pingPongWidth :: Sig + } + +instance Default PingPongSpec where + def = PingPongSpec { + pingPongMaxTime = 5, + pingPongDamp = 3500, + pingPongWidth = 0.3 + } + +-- | Ping-pong delay. +-- +-- > pingPong delayTime feedback mixLevel +pingPong :: DelayTime -> Feedback -> Balance -> Sig2 -> SE Sig2 +pingPong delTime feedback mixLevel (ainL, ainR) = pingPong' def delTime feedback mixLevel (ainL, ainR) + +-- | Ping-pong delay with miscellaneous arguments. +-- +-- > pingPong' spec delayTime feedback mixLevel +pingPong' :: PingPongSpec -> DelayTime -> Feedback -> Balance -> Sig2 -> SE Sig2 +pingPong' (PingPongSpec maxTime damp width) delTime feedback mixLevel (ainL, ainR) = + csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR) + +-- | Ping-pong delay defined in csound style. All arguments are present (nothing is hidden). +-- +-- > csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR) +csdPingPong :: MaxDelayTime -> DelayTime -> Sig -> Feedback -> Sig -> Balance -> Sig2 -> SE Sig2 +csdPingPong maxTime delTime damp feedback width mixLevel (ainL, ainR) = do + afirst <- offsetDelay ainL + atapL <- channelDelay afirst + atapR <- channelDelay ainR + return $ mixControl $ widthControl afirst (atapL, atapR) + where + offsetDelay ain = do + abuf <- delayr maxTime + afirst <- deltap3 delTime + let afirst1 = tone afirst damp + delayw ain + return afirst1 + + channelDelay ain = do + abuf <- delayr (2 * maxTime) + atap <- deltap3 (2 * delTime) + let atap1 = tone atap damp + delayw (ain + atap1 * feedback) + return atap1 + + widthControl afirst (atapL, atapR) = (afirst + atapL + (1 - width) * atapR, atapR + (1 - width) * atapL) + + mixControl (atapL ,atapR) = (cfd mixLevel ainL atapL, cfd mixLevel ainR atapR) type DepthSig = Sig type RateSig = Sig diff --git a/src/Csound/Air/ModArg.hs b/src/Csound/Air/ModArg.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Air/ModArg.hs @@ -0,0 +1,952 @@ +{-# Language TypeFamilies, TypeSynonymInstances, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} +-- | Argument modifiers. Functions to transform arguments of the function with flexibility. +module Csound.Air.ModArg( + -- * Basic class + ModArg1(..), ModArg2(..), ModArg3(..), ModArg4(..), + -- ** Delayed + delModArg1, delModArg2, delModArg3, delModArg4, + + -- * Oscillators + oscArg1, oscArg2, oscArg3, oscArg4, + triArg1, triArg2, triArg3, triArg4, + sqrArg1, sqrArg2, sqrArg3, sqrArg4, + sawArg1, sawArg2, sawArg3, sawArg4, + + -- ** Random phase + rndOscArg1, rndOscArg2, rndOscArg3, rndOscArg4, + rndTriArg1, rndTriArg2, rndTriArg3, rndTriArg4, + rndSqrArg1, rndSqrArg2, rndSqrArg3, rndSqrArg4, + rndSawArg1, rndSawArg2, rndSawArg3, rndSawArg4, + + -- ** Delayed + delOscArg1, delOscArg2, delOscArg3, delOscArg4, + delTriArg1, delTriArg2, delTriArg3, delTriArg4, + delSqrArg1, delSqrArg2, delSqrArg3, delSqrArg4, + delSawArg1, delSawArg2, delSawArg3, delSawArg4, + + -- ** Delayed with Random phase + delRndOscArg1, delRndOscArg2, delRndOscArg3, delRndOscArg4, + delRndTriArg1, delRndTriArg2, delRndTriArg3, delRndTriArg4, + delRndSqrArg1, delRndSqrArg2, delRndSqrArg3, delRndSqrArg4, + delRndSawArg1, delRndSawArg2, delRndSawArg3, delRndSawArg4, + + -- * Noise + noiseArg1, noiseArg2, noiseArg3, noiseArg4, + jitArg1, jitArg2, jitArg3, jitArg4, + gaussArg1, gaussArg2, gaussArg3, gaussArg4, + gaussiArg1, gaussiArg2, gaussiArg3, gaussiArg4, + + -- ** Delayed + delNoiseArg1, delNoiseArg2, delNoiseArg3, delNoiseArg4, + delJitArg1, delJitArg2, delJitArg3, delJitArg4, + delGaussArg1, delGaussArg2, delGaussArg3, delGaussArg4, + delGaussiArg1, delGaussiArg2, delGaussiArg3, delGaussiArg4, + + -- * Envelopes + adsrArg1, adsrArg2, adsrArg3, adsrArg4, + xadsrArg1, xadsrArg2, xadsrArg3, xadsrArg4, + + -- ** Delayed + delAdsrArg1, delAdsrArg2, delAdsrArg3, delAdsrArg4, + delXadsrArg1, delXadsrArg2, delXadsrArg3, delXadsrArg4 + +) where + +import Csound.Typed +import Csound.Typed.Opcode(gauss, gaussi, jitter, linseg, linsegr, expsegr) +import Csound.Air.Wave +import Csound.Air.Envelope +import Csound.SigSpace + +-- trumpet: +-- dac $ mul 1.3 $ mixAt 0.15 largeHall2 $ midi $ onMsg (\cps -> (mul (linsegr [0,0.01, 1, 3, 0.2] 0.2 0) . at (jitterArg1 (0.15 + 0.05 * uosc 0.2) 3 20 alp1 (mul (fades 0.2 0.2) $ 2700 + 0.6 * cps) 0.2) . gaussArg1 0.03 (\x -> return (saw x) + mul (0.12 * expseg [1, 2, 0.1]) (bat (alp1 cps 0.4) white))) cps) + +delEnv :: SigSpace a => D -> D -> a -> a +delEnv delTime riseTime asig = mul (linseg [0, delTime, 0, riseTime, 1]) asig + +delModArg1 :: (SigSpace a, ModArg1 a b) => D -> D -> Sig -> a -> b -> ModArgOut1 a b +delModArg1 delTime riseTime depth modSig f = modArg1 (delEnv delTime riseTime depth) modSig f + +delModArg2 :: (SigSpace a, ModArg2 a b) => D -> D -> Sig -> a -> b -> ModArgOut2 a b +delModArg2 delTime riseTime depth modSig f = modArg2 (delEnv delTime riseTime depth) modSig f + +delModArg3 :: (SigSpace a, ModArg3 a b) => D -> D -> Sig -> a -> b -> ModArgOut3 a b +delModArg3 delTime riseTime depth modSig f = modArg3 (delEnv delTime riseTime depth) modSig f + +delModArg4 :: (SigSpace a, ModArg4 a b) => D -> D -> Sig -> a -> b -> ModArgOut4 a b +delModArg4 delTime riseTime depth modSig f = modArg4 (delEnv delTime riseTime depth) modSig f + +-- adsr mod + +adsrArg1 :: (ModArg1 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut1 Sig b +adsrArg1 depth a d s r f = modArg1 depth (leg a d s r) f + +adsrArg2 :: (ModArg2 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut2 Sig b +adsrArg2 depth a d s r f = modArg2 depth (leg a d s r) f + +adsrArg3 :: (ModArg3 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut3 Sig b +adsrArg3 depth a d s r f = modArg3 depth (leg a d s r) f + +adsrArg4 :: (ModArg4 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut4 Sig b +adsrArg4 depth a d s r f = modArg4 depth (leg a d s r) f + +-- delayed adsr mod + +delLeg :: D -> D -> D -> D -> D -> Sig +delLeg delTime a d s r = linsegr [0, delTime, 0, a, 1, d, s] r 0 + +delAdsrArg1 :: (ModArg1 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut1 Sig b +delAdsrArg1 delTime depth a d s r f = modArg1 depth (delLeg delTime a d s r) f + +delAdsrArg2 :: (ModArg2 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut2 Sig b +delAdsrArg2 delTime depth a d s r f = modArg2 depth (delLeg delTime a d s r) f + +delAdsrArg3 :: (ModArg3 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut3 Sig b +delAdsrArg3 delTime depth a d s r f = modArg3 depth (delLeg delTime a d s r) f + +delAdsrArg4 :: (ModArg4 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut4 Sig b +delAdsrArg4 delTime depth a d s r f = modArg4 depth (delLeg delTime a d s r) f + +-- expon adsr mod + +xadsrArg1 :: (ModArg1 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut1 Sig b +xadsrArg1 depth a d s r f = modArg1 depth (xeg a d s r) f + +xadsrArg2 :: (ModArg2 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut2 Sig b +xadsrArg2 depth a d s r f = modArg2 depth (xeg a d s r) f + +xadsrArg3 :: (ModArg3 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut3 Sig b +xadsrArg3 depth a d s r f = modArg3 depth (xeg a d s r) f + +xadsrArg4 :: (ModArg4 Sig b) => Sig -> D -> D -> D -> D -> b -> ModArgOut4 Sig b +xadsrArg4 depth a d s r f = modArg4 depth (xeg a d s r) f + +-- delayed expon adsr mod + +delXeg :: D -> D -> D -> D -> D -> Sig +delXeg delTime a d s r = expsegr [0.001, delTime, 0.001, a, 1, d, s] r 0.001 + +delXadsrArg1 :: (ModArg1 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut1 Sig b +delXadsrArg1 delTime depth a d s r f = modArg1 depth (delXeg delTime a d s r) f + +delXadsrArg2 :: (ModArg2 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut2 Sig b +delXadsrArg2 delTime depth a d s r f = modArg2 depth (delXeg delTime a d s r) f + +delXadsrArg3 :: (ModArg3 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut3 Sig b +delXadsrArg3 delTime depth a d s r f = modArg3 depth (delXeg delTime a d s r) f + +delXadsrArg4 :: (ModArg4 Sig b) => D -> Sig -> D -> D -> D -> D -> b -> ModArgOut4 Sig b +delXadsrArg4 delTime depth a d s r f = modArg4 depth (delXeg delTime a d s r) f + +-- oscil lfo + +oscArg1 :: (ModArg1 Sig b) => Sig -> Sig -> b -> ModArgOut1 Sig b +oscArg1 depth rate f = modArg1 depth (osc rate) f + +oscArg2 :: (ModArg2 Sig b) => Sig -> Sig -> b -> ModArgOut2 Sig b +oscArg2 depth rate f = modArg2 depth (osc rate) f + +oscArg3 :: (ModArg3 Sig b) => Sig -> Sig -> b -> ModArgOut3 Sig b +oscArg3 depth rate f = modArg3 depth (osc rate) f + +oscArg4 :: (ModArg4 Sig b) => Sig -> Sig -> b -> ModArgOut4 Sig b +oscArg4 depth rate f = modArg4 depth (osc rate) f + +-- delayed oscil lfo + +delOscArg1 :: (ModArg1 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 Sig b +delOscArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (osc rate) f + +delOscArg2 :: (ModArg2 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 Sig b +delOscArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (osc rate) f + +delOscArg3 :: (ModArg3 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 Sig b +delOscArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (osc rate) f + +delOscArg4 :: (ModArg4 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 Sig b +delOscArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (osc rate) f + +-- tri lfo + +triArg1 :: (ModArg1 Sig b) => Sig -> Sig -> b -> ModArgOut1 Sig b +triArg1 depth rate f = modArg1 depth (tri rate) f + +triArg2 :: (ModArg2 Sig b) => Sig -> Sig -> b -> ModArgOut2 Sig b +triArg2 depth rate f = modArg2 depth (tri rate) f + +triArg3 :: (ModArg3 Sig b) => Sig -> Sig -> b -> ModArgOut3 Sig b +triArg3 depth rate f = modArg3 depth (tri rate) f + +triArg4 :: (ModArg4 Sig b) => Sig -> Sig -> b -> ModArgOut4 Sig b +triArg4 depth rate f = modArg4 depth (tri rate) f + +-- delayed tri lfo + +delTriArg1 :: (ModArg1 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 Sig b +delTriArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (tri rate) f + +delTriArg2 :: (ModArg2 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 Sig b +delTriArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (tri rate) f + +delTriArg3 :: (ModArg3 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 Sig b +delTriArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (tri rate) f + +delTriArg4 :: (ModArg4 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 Sig b +delTriArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (tri rate) f + +-- sqr lfo + +sqrArg1 :: (ModArg1 Sig b) => Sig -> Sig -> b -> ModArgOut1 Sig b +sqrArg1 depth rate f = modArg1 depth (sqr rate) f + +sqrArg2 :: (ModArg2 Sig b) => Sig -> Sig -> b -> ModArgOut2 Sig b +sqrArg2 depth rate f = modArg2 depth (sqr rate) f + +sqrArg3 :: (ModArg3 Sig b) => Sig -> Sig -> b -> ModArgOut3 Sig b +sqrArg3 depth rate f = modArg3 depth (sqr rate) f + +sqrArg4 :: (ModArg4 Sig b) => Sig -> Sig -> b -> ModArgOut4 Sig b +sqrArg4 depth rate f = modArg4 depth (sqr rate) f + +-- sqr lfo + +delSqrArg1 :: (ModArg1 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 Sig b +delSqrArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (sqr rate) f + +delSqrArg2 :: (ModArg2 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 Sig b +delSqrArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (sqr rate) f + +delSqrArg3 :: (ModArg3 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 Sig b +delSqrArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (sqr rate) f + +delSqrArg4 :: (ModArg4 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 Sig b +delSqrArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (sqr rate) f + +-- saw lfo + +sawArg1 :: (ModArg1 Sig b) => Sig -> Sig -> b -> ModArgOut1 Sig b +sawArg1 depth rate f = modArg1 depth (saw rate) f + +sawArg2 :: (ModArg2 Sig b) => Sig -> Sig -> b -> ModArgOut2 Sig b +sawArg2 depth rate f = modArg2 depth (saw rate) f + +sawArg3 :: (ModArg3 Sig b) => Sig -> Sig -> b -> ModArgOut3 Sig b +sawArg3 depth rate f = modArg3 depth (saw rate) f + +sawArg4 :: (ModArg4 Sig b) => Sig -> Sig -> b -> ModArgOut4 Sig b +sawArg4 depth rate f = modArg4 depth (saw rate) f + +-- delayed saw lfo + +delSawArg1 :: (ModArg1 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 Sig b +delSawArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (saw rate) f + +delSawArg2 :: (ModArg2 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 Sig b +delSawArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (saw rate) f + +delSawArg3 :: (ModArg3 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 Sig b +delSawArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (saw rate) f + +delSawArg4 :: (ModArg4 Sig b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 Sig b +delSawArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (saw rate) f + +-- oscil lfo rnd phase + +rndOscArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +rndOscArg1 depth rate f = modArg1 depth (rndOsc rate) f + +rndOscArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +rndOscArg2 depth rate f = modArg2 depth (rndOsc rate) f + +rndOscArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +rndOscArg3 depth rate f = modArg3 depth (rndOsc rate) f + +rndOscArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +rndOscArg4 depth rate f = modArg4 depth (rndOsc rate) f + +-- delayed oscil lfo rnd phase + +delRndOscArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delRndOscArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (rndOsc rate) f + +delRndOscArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delRndOscArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (rndOsc rate) f + +delRndOscArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delRndOscArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (rndOsc rate) f + +delRndOscArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delRndOscArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (rndOsc rate) f + +-- tri lfo rnd phase + +rndTriArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +rndTriArg1 depth rate f = modArg1 depth (rndTri rate) f + +rndTriArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +rndTriArg2 depth rate f = modArg2 depth (rndTri rate) f + +rndTriArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +rndTriArg3 depth rate f = modArg3 depth (rndTri rate) f + +rndTriArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +rndTriArg4 depth rate f = modArg4 depth (rndTri rate) f + +-- delayed tri lfo rnd phase + +delRndTriArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delRndTriArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (rndTri rate) f + +delRndTriArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delRndTriArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (rndTri rate) f + +delRndTriArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delRndTriArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (rndTri rate) f + +delRndTriArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delRndTriArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (rndTri rate) f + +-- sqr lfo rnd phase + +rndSqrArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +rndSqrArg1 depth rate f = modArg1 depth (rndSqr rate) f + +rndSqrArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +rndSqrArg2 depth rate f = modArg2 depth (rndSqr rate) f + +rndSqrArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +rndSqrArg3 depth rate f = modArg3 depth (rndSqr rate) f + +rndSqrArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +rndSqrArg4 depth rate f = modArg4 depth (rndSqr rate) f + +-- sqr lfo rnd phase + +delRndSqrArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delRndSqrArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (rndSqr rate) f + +delRndSqrArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delRndSqrArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (rndSqr rate) f + +delRndSqrArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delRndSqrArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (rndSqr rate) f + +delRndSqrArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delRndSqrArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (rndSqr rate) f + +-- sqr lfo rnd phase + +rndSawArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +rndSawArg1 depth rate f = modArg1 depth (rndSaw rate) f + +rndSawArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +rndSawArg2 depth rate f = modArg2 depth (rndSaw rate) f + +rndSawArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +rndSawArg3 depth rate f = modArg3 depth (rndSaw rate) f + +rndSawArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +rndSawArg4 depth rate f = modArg4 depth (rndSaw rate) f + +-- delayed sqr lfo rnd phase + +delRndSawArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delRndSawArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (rndSaw rate) f + +delRndSawArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delRndSawArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (rndSaw rate) f + +delRndSawArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delRndSawArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (rndSaw rate) f + +delRndSawArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delRndSawArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (rndSaw rate) f + +-- white noise + +noiseArg1 :: (ModArg1 (SE Sig) b) => Sig -> b -> ModArgOut1 (SE Sig) b +noiseArg1 depth f = modArg1 depth white f + +noiseArg2 :: (ModArg2 (SE Sig) b) => Sig -> b -> ModArgOut2 (SE Sig) b +noiseArg2 depth f = modArg2 depth white f + +noiseArg3 :: (ModArg3 (SE Sig) b) => Sig -> b -> ModArgOut3 (SE Sig) b +noiseArg3 depth f = modArg3 depth white f + +noiseArg4 :: (ModArg4 (SE Sig) b) => Sig -> b -> ModArgOut4 (SE Sig) b +noiseArg4 depth f = modArg4 depth white f + +-- delayed white noise + +delNoiseArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut1 (SE Sig) b +delNoiseArg1 delTime riseTime depth f = delModArg1 delTime riseTime depth white f + +delNoiseArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut2 (SE Sig) b +delNoiseArg2 delTime riseTime depth f = delModArg2 delTime riseTime depth white f + +delNoiseArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut3 (SE Sig) b +delNoiseArg3 delTime riseTime depth f = delModArg3 delTime riseTime depth white f + +delNoiseArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut4 (SE Sig) b +delNoiseArg4 delTime riseTime depth f = delModArg4 delTime riseTime depth white f + +-- pink noise + +pinkArg1 :: (ModArg1 (SE Sig) b) => Sig -> b -> ModArgOut1 (SE Sig) b +pinkArg1 depth f = modArg1 depth pink f + +pinkArg2 :: (ModArg2 (SE Sig) b) => Sig -> b -> ModArgOut2 (SE Sig) b +pinkArg2 depth f = modArg2 depth pink f + +pinkArg3 :: (ModArg3 (SE Sig) b) => Sig -> b -> ModArgOut3 (SE Sig) b +pinkArg3 depth f = modArg3 depth pink f + +pinkArg4 :: (ModArg4 (SE Sig) b) => Sig -> b -> ModArgOut4 (SE Sig) b +pinkArg4 depth f = modArg4 depth pink f + +-- pink noise + +delPinkArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut1 (SE Sig) b +delPinkArg1 delTime riseTime depth f = delModArg1 delTime riseTime depth pink f + +delPinkArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut2 (SE Sig) b +delPinkArg2 delTime riseTime depth f = delModArg2 delTime riseTime depth pink f + +delPinkArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut3 (SE Sig) b +delPinkArg3 delTime riseTime depth f = delModArg3 delTime riseTime depth pink f + +delPinkArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut4 (SE Sig) b +delPinkArg4 delTime riseTime depth f = delModArg4 delTime riseTime depth pink f + + +-- jitter noise + +jitArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +jitArg1 depth cpsMin cpsMax f = modArg1 depth (jitter 1 cpsMin cpsMax) f + +jitArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +jitArg2 depth cpsMin cpsMax f = modArg2 depth (jitter 1 cpsMin cpsMax) f + +jitArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +jitArg3 depth cpsMin cpsMax f = modArg3 depth (jitter 1 cpsMin cpsMax) f + +jitArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +jitArg4 depth cpsMin cpsMax f = modArg4 depth (jitter 1 cpsMin cpsMax) f + +-- jitter noise + +delJitArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delJitArg1 delTime riseTime depth cpsMin cpsMax f = delModArg1 delTime riseTime depth (jitter 1 cpsMin cpsMax) f + +delJitArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delJitArg2 delTime riseTime depth cpsMin cpsMax f = delModArg2 delTime riseTime depth (jitter 1 cpsMin cpsMax) f + +delJitArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delJitArg3 delTime riseTime depth cpsMin cpsMax f = delModArg3 delTime riseTime depth (jitter 1 cpsMin cpsMax) f + +delJitArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delJitArg4 delTime riseTime depth cpsMin cpsMax f = delModArg4 delTime riseTime depth (jitter 1 cpsMin cpsMax) f + +-- gauss noise + +gaussArg1 :: (ModArg1 (SE Sig) b) => Sig -> b -> ModArgOut1 (SE Sig) b +gaussArg1 depth f = modArg1 depth (gauss 1) f + +gaussArg2 :: (ModArg2 (SE Sig) b) => Sig -> b -> ModArgOut2 (SE Sig) b +gaussArg2 depth f = modArg2 depth (gauss 1) f + +gaussArg3 :: (ModArg3 (SE Sig) b) => Sig -> b -> ModArgOut3 (SE Sig) b +gaussArg3 depth f = modArg3 depth (gauss 1) f + +gaussArg4 :: (ModArg4 (SE Sig) b) => Sig -> b -> ModArgOut4 (SE Sig) b +gaussArg4 depth f = modArg4 depth (gauss 1) f + +-- delayed gauss noise + +delGaussArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut1 (SE Sig) b +delGaussArg1 delTime riseTime depth f = delModArg1 delTime riseTime depth (gauss 1) f + +delGaussArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut2 (SE Sig) b +delGaussArg2 delTime riseTime depth f = delModArg2 delTime riseTime depth (gauss 1) f + +delGaussArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut3 (SE Sig) b +delGaussArg3 delTime riseTime depth f = delModArg3 delTime riseTime depth (gauss 1) f + +delGaussArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> b -> ModArgOut4 (SE Sig) b +delGaussArg4 delTime riseTime depth f = delModArg4 delTime riseTime depth (gauss 1) f + +-- gauss noise with frequency + +gaussiArg1 :: (ModArg1 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +gaussiArg1 depth rate f = modArg1 depth (gaussi 1 1 rate) f + +gaussiArg2 :: (ModArg2 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +gaussiArg2 depth rate f = modArg2 depth (gaussi 1 1 rate) f + +gaussiArg3 :: (ModArg3 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +gaussiArg3 depth rate f = modArg3 depth (gaussi 1 1 rate) f + +gaussiArg4 :: (ModArg4 (SE Sig) b) => Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +gaussiArg4 depth rate f = modArg4 depth (gaussi 1 1 rate) f + +-- delayed gauss noise with frequency + +delGaussiArg1 :: (ModArg1 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut1 (SE Sig) b +delGaussiArg1 delTime riseTime depth rate f = delModArg1 delTime riseTime depth (gaussi 1 1 rate) f + +delGaussiArg2 :: (ModArg2 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut2 (SE Sig) b +delGaussiArg2 delTime riseTime depth rate f = delModArg2 delTime riseTime depth (gaussi 1 1 rate) f + +delGaussiArg3 :: (ModArg3 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut3 (SE Sig) b +delGaussiArg3 delTime riseTime depth rate f = delModArg3 delTime riseTime depth (gaussi 1 1 rate) f + +delGaussiArg4 :: (ModArg4 (SE Sig) b) => D -> D -> Sig -> Sig -> b -> ModArgOut4 (SE Sig) b +delGaussiArg4 delTime riseTime depth rate f = delModArg4 delTime riseTime depth (gaussi 1 1 rate) f + +-------------------------------------------- +-------------------------------------------- +-- modArg1 + +class ModArg1 a b where + type ModArgOut1 a b :: * + modArg1 :: Sig -> a -> b -> ModArgOut1 a b + +-------------------------------------------- +-- pure in, pure mono out + +instance ModArg1 Sig (Sig -> Sig) where + type ModArgOut1 Sig (Sig -> Sig) = Sig -> Sig + modArg1 depth a f = \x -> f (x * (1 + depth * a)) + +instance ModArg1 Sig (Sig -> a -> Sig) where + type ModArgOut1 Sig (Sig -> a -> Sig) = Sig -> a -> Sig + modArg1 depth a f = \x1 x2 -> f (x1 * (1 + depth * a)) x2 + +instance ModArg1 Sig (Sig -> a -> b -> Sig) where + type ModArgOut1 Sig (Sig -> a -> b -> Sig) = Sig -> a -> b -> Sig + modArg1 depth a f = \x1 x2 x3 -> f (x1 * (1 + depth * a)) x2 x3 + +instance ModArg1 Sig (Sig -> a -> b -> c -> Sig) where + type ModArgOut1 Sig (Sig -> a -> b -> c -> Sig) = Sig -> a -> b -> c -> Sig + modArg1 depth a f = \x1 x2 x3 x4 -> f (x1 * (1 + depth * a)) x2 x3 x4 + +-------------------------------------------- +-- pure in, pure stereo out + +instance ModArg1 Sig (Sig -> Sig2) where + type ModArgOut1 Sig (Sig -> Sig2) = Sig -> Sig2 + modArg1 depth a f = \x -> f (x * (1 + depth * a)) + +instance ModArg1 Sig (Sig -> a -> Sig2) where + type ModArgOut1 Sig (Sig -> a -> Sig2) = Sig -> a -> Sig2 + modArg1 depth a f = \x1 x2 -> f (x1 * (1 + depth * a)) x2 + +instance ModArg1 Sig (Sig -> a -> b -> Sig2) where + type ModArgOut1 Sig (Sig -> a -> b -> Sig2) = Sig -> a -> b -> Sig2 + modArg1 depth a f = \x1 x2 x3 -> f (x1 * (1 + depth * a)) x2 x3 + +instance ModArg1 Sig (Sig -> a -> b -> c -> Sig2) where + type ModArgOut1 Sig (Sig -> a -> b -> c -> Sig2) = Sig -> a -> b -> c -> Sig2 + modArg1 depth a f = \x1 x2 x3 x4 -> f (x1 * (1 + depth * a)) x2 x3 x4 + +-------------------------------------------- +-- pure in, dirty mono out + +instance ModArg1 Sig (Sig -> SE Sig) where + type ModArgOut1 Sig (Sig -> SE Sig) = Sig -> SE Sig + modArg1 depth a f = \x -> f (x * (1 + depth * a)) + +instance ModArg1 Sig (Sig -> a -> SE Sig) where + type ModArgOut1 Sig (Sig -> a -> SE Sig) = Sig -> a -> SE Sig + modArg1 depth a f = \x1 x2 -> f (x1 * (1 + depth * a)) x2 + +instance ModArg1 Sig (Sig -> a -> b -> SE Sig) where + type ModArgOut1 Sig (Sig -> a -> b -> SE Sig) = Sig -> a -> b -> SE Sig + modArg1 depth a f = \x1 x2 x3 -> f (x1 * (1 + depth * a)) x2 x3 + +instance ModArg1 Sig (Sig -> a -> b -> c -> SE Sig) where + type ModArgOut1 Sig (Sig -> a -> b -> c -> SE Sig) = Sig -> a -> b -> c -> SE Sig + modArg1 depth a f = \x1 x2 x3 x4 -> f (x1 * (1 + depth * a)) x2 x3 x4 + +-------------------------------------------- +-- pure in, dirty stereo out + +instance ModArg1 Sig (Sig -> SE Sig2) where + type ModArgOut1 Sig (Sig -> SE Sig2) = Sig -> SE Sig2 + modArg1 depth a f = \x -> f (x * (1 + depth * a)) + +instance ModArg1 Sig (Sig -> a -> SE Sig2) where + type ModArgOut1 Sig (Sig -> a -> SE Sig2) = Sig -> a -> SE Sig2 + modArg1 depth a f = \x1 x2 -> f (x1 * (1 + depth * a)) x2 + +instance ModArg1 Sig (Sig -> a -> b -> SE Sig2) where + type ModArgOut1 Sig (Sig -> a -> b -> SE Sig2) = Sig -> a -> b -> SE Sig2 + modArg1 depth a f = \x1 x2 x3 -> f (x1 * (1 + depth * a)) x2 x3 + +instance ModArg1 Sig (Sig -> a -> b -> c -> SE Sig2) where + type ModArgOut1 Sig (Sig -> a -> b -> c -> SE Sig2) = Sig -> a -> b -> c -> SE Sig2 + modArg1 depth a f = \x1 x2 x3 x4 -> f (x1 * (1 + depth * a)) x2 x3 x4 + +-------------------------------------------- +-- dirty in, pure mono out + +instance ModArg1 (SE Sig) (Sig -> Sig) where + type ModArgOut1 (SE Sig) (Sig -> Sig) = Sig -> SE Sig + modArg1 depth ma f = \x -> fmap (\a -> f (x * (1 + depth * a))) ma + +instance ModArg1 (SE Sig) (Sig -> a -> Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> Sig) = Sig -> a -> SE Sig + modArg1 depth ma f = \x1 x2 -> fmap (\a -> f (x1 * (1 + depth * a)) x2) ma + +instance ModArg1 (SE Sig) (Sig -> a -> b -> Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> Sig) = Sig -> a -> b -> SE Sig + modArg1 depth ma f = \x1 x2 x3 -> fmap (\a -> f (x1 * (1 + depth * a)) x2 x3) ma + +instance ModArg1 (SE Sig) (Sig -> a -> b -> c -> Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> c -> Sig) = Sig -> a -> b -> c -> SE Sig + modArg1 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f (x1 * (1 + depth * a)) x2 x3 x4) ma + +-------------------------------------------- +-- dirty in, pure stereo out + +instance ModArg1 (SE Sig) (Sig -> Sig2) where + type ModArgOut1 (SE Sig) (Sig -> Sig2) = Sig -> SE Sig2 + modArg1 depth ma f = \x -> fmap (\a -> f (x * (1 + depth * a))) ma + +instance ModArg1 (SE Sig) (Sig -> a -> Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> Sig2) = Sig -> a -> SE Sig2 + modArg1 depth ma f = \x1 x2 -> fmap (\a -> f (x1 * (1 + depth * a)) x2) ma + +instance ModArg1 (SE Sig) (Sig -> a -> b -> Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> Sig2) = Sig -> a -> b -> SE Sig2 + modArg1 depth ma f = \x1 x2 x3 -> fmap (\a -> f (x1 * (1 + depth * a)) x2 x3) ma + +instance ModArg1 (SE Sig) (Sig -> a -> b -> c -> Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> c -> Sig2) = Sig -> a -> b -> c -> SE Sig2 + modArg1 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f (x1 * (1 + depth * a)) x2 x3 x4) ma + +-------------------------------------------- +-- dirty in, dirty mono out + +instance ModArg1 (SE Sig) (Sig -> SE Sig) where + type ModArgOut1 (SE Sig) (Sig -> SE Sig) = Sig -> SE Sig + modArg1 depth ma f = \x -> ma >>= (\a -> f (x * (1 + depth * a))) + +instance ModArg1 (SE Sig) (Sig -> a -> SE Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> SE Sig) = Sig -> a -> SE Sig + modArg1 depth ma f = \x1 x2 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2) + +instance ModArg1 (SE Sig) (Sig -> a -> b -> SE Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> SE Sig) = Sig -> a -> b -> SE Sig + modArg1 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2 x3) + +instance ModArg1 (SE Sig) (Sig -> a -> b -> c -> SE Sig) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> c -> SE Sig) = Sig -> a -> b -> c -> SE Sig + modArg1 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2 x3 x4) + +-------------------------------------------- +-- dirty in, dirty stereo out + +instance ModArg1 (SE Sig) (Sig -> SE Sig2) where + type ModArgOut1 (SE Sig) (Sig -> SE Sig2) = Sig -> SE Sig2 + modArg1 depth ma f = \x -> ma >>= (\a -> f (x * (1 + depth * a))) + +instance ModArg1 (SE Sig) (Sig -> a -> SE Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> SE Sig2) = Sig -> a -> SE Sig2 + modArg1 depth ma f = \x1 x2 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2) + +instance ModArg1 (SE Sig) (Sig -> a -> b -> SE Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> SE Sig2) = Sig -> a -> b -> SE Sig2 + modArg1 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2 x3) + +instance ModArg1 (SE Sig) (Sig -> a -> b -> c -> SE Sig2) where + type ModArgOut1 (SE Sig) (Sig -> a -> b -> c -> SE Sig2) = Sig -> a -> b -> c -> SE Sig2 + modArg1 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f (x1 * (1 + depth * a)) x2 x3 x4) + +-------------------------------------------- +-------------------------------------------- +-- modArg2 + +class ModArg2 a b where + type ModArgOut2 a b :: * + modArg2 :: Sig -> a -> b -> ModArgOut2 a b + +-------------------------------------------- +-- pure in, pure mono out + +instance ModArg2 Sig (a -> Sig -> Sig) where + type ModArgOut2 Sig (a -> Sig -> Sig) = a -> Sig -> Sig + modArg2 depth a f = \x1 x2 -> f x1 (x2 * (1 + depth * a)) + +instance ModArg2 Sig (a -> Sig -> b -> Sig) where + type ModArgOut2 Sig (a -> Sig -> b -> Sig) = a -> Sig -> b -> Sig + modArg2 depth a f = \x1 x2 x3 -> f x1 (x2 * (1 + depth * a)) x3 + +instance ModArg2 Sig (a -> Sig -> b -> c -> Sig) where + type ModArgOut2 Sig (a -> Sig -> b -> c -> Sig) = a -> Sig -> b -> c -> Sig + modArg2 depth a f = \x1 x2 x3 x4 -> f x1 (x2 * (1 + depth * a)) x3 x4 + +-------------------------------------------- +-- pure in, pure stereo out + +instance ModArg2 Sig (a -> Sig -> Sig2) where + type ModArgOut2 Sig (a -> Sig -> Sig2) = a -> Sig -> Sig2 + modArg2 depth a f = \x1 x2 -> f x1 (x2 * (1 + depth * a)) + +instance ModArg2 Sig (a -> Sig -> b -> Sig2) where + type ModArgOut2 Sig (a -> Sig -> b -> Sig2) = a -> Sig -> b -> Sig2 + modArg2 depth a f = \x1 x2 x3 -> f x1 (x2 * (1 + depth * a)) x3 + +instance ModArg2 Sig (a -> Sig -> b -> c -> Sig2) where + type ModArgOut2 Sig (a -> Sig -> b -> c -> Sig2) = a -> Sig -> b -> c -> Sig2 + modArg2 depth a f = \x1 x2 x3 x4 -> f x1 (x2 * (1 + depth * a)) x3 x4 + +-------------------------------------------- +-- pure in, dirty mono out + +instance ModArg2 Sig (a -> Sig -> SE Sig) where + type ModArgOut2 Sig (a -> Sig -> SE Sig) = a -> Sig -> SE Sig + modArg2 depth a f = \x1 x2 -> f x1 (x2 * (1 + depth * a)) + +instance ModArg2 Sig (a -> Sig -> b -> SE Sig) where + type ModArgOut2 Sig (a -> Sig -> b -> SE Sig) = a -> Sig -> b -> SE Sig + modArg2 depth a f = \x1 x2 x3 -> f x1 (x2 * (1 + depth * a)) x3 + +instance ModArg2 Sig (a -> Sig -> b -> c -> SE Sig) where + type ModArgOut2 Sig (a -> Sig -> b -> c -> SE Sig) = a -> Sig -> b -> c -> SE Sig + modArg2 depth a f = \x1 x2 x3 x4 -> f x1 (x2 * (1 + depth * a)) x3 x4 + +-------------------------------------------- +-- pure in, dirty stereo out + +instance ModArg2 Sig (a -> Sig -> SE Sig2) where + type ModArgOut2 Sig (a -> Sig -> SE Sig2) = a -> Sig -> SE Sig2 + modArg2 depth a f = \x1 x2 -> f x1 (x2 * (1 + depth * a)) + +instance ModArg2 Sig (a -> Sig -> b -> SE Sig2) where + type ModArgOut2 Sig (a -> Sig -> b -> SE Sig2) = a -> Sig -> b -> SE Sig2 + modArg2 depth a f = \x1 x2 x3 -> f x1 (x2 * (1 + depth * a)) x3 + +instance ModArg2 Sig (a -> Sig -> b -> c -> SE Sig2) where + type ModArgOut2 Sig (a -> Sig -> b -> c -> SE Sig2) = a -> Sig -> b -> c -> SE Sig2 + modArg2 depth a f = \x1 x2 x3 x4 -> f x1 (x2 * (1 + depth * a)) x3 x4 + +-------------------------------------------- +-- dirty in, pure mono out + +instance ModArg2 (SE Sig) (a -> Sig -> Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> Sig) = a -> Sig -> SE Sig + modArg2 depth ma f = \x1 x2 -> fmap (\a -> f x1 (x2 * (1 + depth * a))) ma + +instance ModArg2 (SE Sig) (a -> Sig -> b -> Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> Sig) = a -> Sig -> b -> SE Sig + modArg2 depth ma f = \x1 x2 x3 -> fmap (\a -> f x1 (x2 * (1 + depth * a)) x3) ma + +instance ModArg2 (SE Sig) (a -> Sig -> b -> c -> Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> c -> Sig) = a -> Sig -> b -> c -> SE Sig + modArg2 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 (x2 * (1 + depth * a)) x3 x4) ma + +-------------------------------------------- +-- dirty in, pure stereo out + +instance ModArg2 (SE Sig) (a -> Sig -> Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> Sig2) = a -> Sig -> SE Sig2 + modArg2 depth ma f = \x1 x2 -> fmap (\a -> f x1 (x2 * (1 + depth * a))) ma + +instance ModArg2 (SE Sig) (a -> Sig -> b -> Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> Sig2) = a -> Sig -> b -> SE Sig2 + modArg2 depth ma f = \x1 x2 x3 -> fmap (\a -> f x1 (x2 * (1 + depth * a)) x3) ma + +instance ModArg2 (SE Sig) (a -> Sig -> b -> c -> Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> c -> Sig2) = a -> Sig -> b -> c -> SE Sig2 + modArg2 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 (x2 * (1 + depth * a)) x3 x4) ma + +-------------------------------------------- +-- dirty in, dirty mono out + +instance ModArg2 (SE Sig) (a -> Sig -> SE Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> SE Sig) = a -> Sig -> SE Sig + modArg2 depth ma f = \x1 x2 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a))) + +instance ModArg2 (SE Sig) (a -> Sig -> b -> SE Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> SE Sig) = a -> Sig -> b -> SE Sig + modArg2 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a)) x3) + +instance ModArg2 (SE Sig) (a -> Sig -> b -> c -> SE Sig) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> c -> SE Sig) = a -> Sig -> b -> c -> SE Sig + modArg2 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a)) x3 x4) + +-------------------------------------------- +-- dirty in, dirty stereo out + +instance ModArg2 (SE Sig) (a -> Sig -> SE Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> SE Sig2) = a -> Sig -> SE Sig2 + modArg2 depth ma f = \x1 x2 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a))) + +instance ModArg2 (SE Sig) (a -> Sig -> b -> SE Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> SE Sig2) = a -> Sig -> b -> SE Sig2 + modArg2 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a)) x3) + +instance ModArg2 (SE Sig) (a -> Sig -> b -> c -> SE Sig2) where + type ModArgOut2 (SE Sig) (a -> Sig -> b -> c -> SE Sig2) = a -> Sig -> b -> c -> SE Sig2 + modArg2 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 (x2 * (1 + depth * a)) x3 x4) + +-------------------------------------------- +-------------------------------------------- +-- modArg3 + +class ModArg3 a b where + type ModArgOut3 a b :: * + modArg3 :: Sig -> a -> b -> ModArgOut3 a b + +-------------------------------------------- +-- pure in, pure mono out + +instance ModArg3 Sig (a -> b -> Sig -> Sig) where + type ModArgOut3 Sig (a -> b -> Sig -> Sig) = a -> b -> Sig -> Sig + modArg3 depth a f = \x1 x2 x3 -> f x1 x2 (x3 * (1 + depth * a)) + +instance ModArg3 Sig (a -> b -> Sig -> c -> Sig) where + type ModArgOut3 Sig (a -> b -> Sig -> c -> Sig) = a -> b -> Sig -> c -> Sig + modArg3 depth a f = \x1 x2 x3 x4 -> f x1 x2 (x3 * (1 + depth * a)) x4 + +-------------------------------------------- +-- pure in, pure stereo out + +instance ModArg3 Sig (a -> b -> Sig -> Sig2) where + type ModArgOut3 Sig (a -> b -> Sig -> Sig2) = a -> b -> Sig -> Sig2 + modArg3 depth a f = \x1 x2 x3 -> f x1 x2 (x3 * (1 + depth * a)) + +instance ModArg3 Sig (a -> b -> Sig -> c -> Sig2) where + type ModArgOut3 Sig (a -> b -> Sig -> c -> Sig2) = a -> b -> Sig -> c -> Sig2 + modArg3 depth a f = \x1 x2 x3 x4 -> f x1 x2 (x3 * (1 + depth * a)) x4 + +-------------------------------------------- +-- pure in, dirty mono out + +instance ModArg3 Sig (a -> b -> Sig -> SE Sig) where + type ModArgOut3 Sig (a -> b -> Sig -> SE Sig) = a -> b -> Sig -> SE Sig + modArg3 depth a f = \x1 x2 x3 -> f x1 x2 (x3 * (1 + depth * a)) + +instance ModArg3 Sig (a -> b -> Sig -> c -> SE Sig) where + type ModArgOut3 Sig (a -> b -> Sig -> c -> SE Sig) = a -> b -> Sig -> c -> SE Sig + modArg3 depth a f = \x1 x2 x3 x4 -> f x1 x2 (x3 * (1 + depth * a)) x4 + +-------------------------------------------- +-- pure in, dirty stereo out + +instance ModArg3 Sig (a -> b -> Sig -> SE Sig2) where + type ModArgOut3 Sig (a -> b -> Sig -> SE Sig2) = a -> b -> Sig -> SE Sig2 + modArg3 depth a f = \x1 x2 x3 -> f x1 x2 (x3 * (1 + depth * a)) + +instance ModArg3 Sig (a -> b -> Sig -> c -> SE Sig2) where + type ModArgOut3 Sig (a -> b -> Sig -> c -> SE Sig2) = a -> b -> Sig -> c -> SE Sig2 + modArg3 depth a f = \x1 x2 x3 x4 -> f x1 x2 (x3 * (1 + depth * a)) x4 + +-------------------------------------------- +-- dirty in, pure mono out + +instance ModArg3 (SE Sig) (a -> b -> Sig -> Sig) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> Sig) = a -> b -> Sig -> SE Sig + modArg3 depth ma f = \x1 x2 x3 -> fmap (\a -> f x1 x2 (x3 * (1 + depth * a))) ma + +instance ModArg3 (SE Sig) (a -> b -> Sig -> c -> Sig) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> c -> Sig) = a -> b -> Sig -> c -> SE Sig + modArg3 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 x2 (x3 * (1 + depth * a)) x4) ma + +-------------------------------------------- +-- dirty in, pure stereo out + +instance ModArg3 (SE Sig) (a -> b -> Sig -> Sig2) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> Sig2) = a -> b -> Sig -> SE Sig2 + modArg3 depth ma f = \x1 x2 x3 -> fmap (\a -> f x1 x2 (x3 * (1 + depth * a))) ma + +instance ModArg3 (SE Sig) (a -> b -> Sig -> c -> Sig2) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> c -> Sig2) = a -> b -> Sig -> c -> SE Sig2 + modArg3 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 x2 (x3 * (1 + depth * a)) x4) ma + +-------------------------------------------- +-- dirty in, dirty mono out + +instance ModArg3 (SE Sig) (a -> b -> Sig -> SE Sig) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> SE Sig) = a -> b -> Sig -> SE Sig + modArg3 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f x1 x2 (x3 * (1 + depth * a))) + +instance ModArg3 (SE Sig) (a -> b -> Sig -> c -> SE Sig) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> c -> SE Sig) = a -> b -> Sig -> c -> SE Sig + modArg3 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 x2 (x3 * (1 + depth * a)) x4) + +-------------------------------------------- +-- dirty in, dirty stereo out + +instance ModArg3 (SE Sig) (a -> b -> Sig -> SE Sig2) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> SE Sig2) = a -> b -> Sig -> SE Sig2 + modArg3 depth ma f = \x1 x2 x3 -> ma >>= (\a -> f x1 x2 (x3 * (1 + depth * a))) + +instance ModArg3 (SE Sig) (a -> b -> Sig -> c -> SE Sig2) where + type ModArgOut3 (SE Sig) (a -> b -> Sig -> c -> SE Sig2) = a -> b -> Sig -> c -> SE Sig2 + modArg3 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 x2 (x3 * (1 + depth * a)) x4) + +-------------------------------------------- +-------------------------------------------- +-- modArg4 + +class ModArg4 a b where + type ModArgOut4 a b :: * + modArg4 :: Sig -> a -> b -> ModArgOut4 a b + +-------------------------------------------- +-- pure in, pure mono out + +instance ModArg4 Sig (a -> b -> c -> Sig -> Sig) where + type ModArgOut4 Sig (a -> b -> c -> Sig -> Sig) = a -> b -> c -> Sig -> Sig + modArg4 depth a f = \x1 x2 x3 x4 -> f x1 x2 x3 (x4 * (1 + depth * a)) + +-------------------------------------------- +-- pure in, pure stereo out + +instance ModArg4 Sig (a -> b -> c -> Sig -> Sig2) where + type ModArgOut4 Sig (a -> b -> c -> Sig -> Sig2) = a -> b -> c -> Sig -> Sig2 + modArg4 depth a f = \x1 x2 x3 x4 -> f x1 x2 x3 (x4 * (1 + depth * a)) + +-------------------------------------------- +-- pure in, dirty mono out + +instance ModArg4 Sig (a -> b -> c -> Sig -> SE Sig) where + type ModArgOut4 Sig (a -> b -> c -> Sig -> SE Sig) = a -> b -> c -> Sig -> SE Sig + modArg4 depth a f = \x1 x2 x3 x4 -> f x1 x2 x3 (x4 * (1 + depth * a)) + +-------------------------------------------- +-- pure in, dirty stereo out + +instance ModArg4 Sig (a -> b -> c -> Sig -> SE Sig2) where + type ModArgOut4 Sig (a -> b -> c -> Sig -> SE Sig2) = a -> b -> c -> Sig -> SE Sig2 + modArg4 depth a f = \x1 x2 x3 x4 -> f x1 x2 x3 (x4 * (1 + depth * a)) + +-------------------------------------------- +-- dirty in, pure mono out + +instance ModArg4 (SE Sig) (a -> b -> c -> Sig -> Sig) where + type ModArgOut4 (SE Sig) (a -> b -> c -> Sig -> Sig) = a -> b -> c -> Sig -> SE Sig + modArg4 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 x2 x3 (x4 * (1 + depth * a))) ma + +-------------------------------------------- +-- dirty in, pure stereo out + +instance ModArg4 (SE Sig) (a -> b -> c -> Sig -> Sig2) where + type ModArgOut4 (SE Sig) (a -> b -> c -> Sig -> Sig2) = a -> b -> c -> Sig -> SE Sig2 + modArg4 depth ma f = \x1 x2 x3 x4 -> fmap (\a -> f x1 x2 x3 (x4 * (1 + depth * a))) ma + +-------------------------------------------- +-- dirty in, dirty mono out + +instance ModArg4 (SE Sig) (a -> b -> c -> Sig -> SE Sig) where + type ModArgOut4 (SE Sig) (a -> b -> c -> Sig -> SE Sig) = a -> b -> c -> Sig -> SE Sig + modArg4 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 x2 x3 (x4 * (1 + depth * a))) + +-------------------------------------------- +-- dirty in, dirty stereo out + +instance ModArg4 (SE Sig) (a -> b -> c -> Sig -> SE Sig2) where + type ModArgOut4 (SE Sig) (a -> b -> c -> Sig -> SE Sig2) = a -> b -> c -> Sig -> SE Sig2 + modArg4 depth ma f = \x1 x2 x3 x4 -> ma >>= (\a -> f x1 x2 x3 (x4 * (1 + depth * a))) diff --git a/src/Csound/Air/Padsynth.hs b/src/Csound/Air/Padsynth.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Air/Padsynth.hs @@ -0,0 +1,236 @@ +-- | Padsynth algorithm. See the details at: +-- +-- csound docs: +-- +-- original description: +-- +-- more detailed description: +-- +-- An example: +-- +-- > harms = [ +-- > 1, 0.7600046992, 0.6199994683, 0.9399998784, 0.4400023818, 0.0600003302, +-- > 0.8499968648, 0.0899999291, 0.8199964762, 0.3199984133, +-- > 0.9400014281, 0.3000001907, 0.120003365, 0.1799997687, 0.5200006366] +-- > +-- > spec = defPadsynthSpec 42.2 harms +-- > +-- > main = dac $ mul 0.4 $ mixAt 0.35 largeHall2 $ mixAt 0.45 (echo 0.25 0.75) $ +-- > midi $ onMsg $ mul (fades 0.5 0.7) . padsynthOsc2 spec + +module Csound.Air.Padsynth ( + -- * Generic padsynth oscillators + padsynthOsc, padsynthOsc2, + -- * Simple padsynth oscillators + bwOscBy, bwOddOscBy, bwOscBy2, bwOddOscBy2, + bwOsc, bwTri, bwSqr, bwSaw, bwOsc2, bwTri2, bwSqr2, bwSaw2, + -- * Layered padsynth + padsynthOscMultiCps, padsynthOscMultiCps2, + padsynthOscMultiVol, padsynthOscMultiVol2, + padsynthOscMultiVolCps, padsynthOscMultiVolCps2 +) where + +import Data.List +import Control.Arrow + +import Csound.Typed +import Csound.Tab +import Csound.Air.Wave +import Csound.Typed.Opcode(poscil) + +-- | Padsynth oscillator. +-- +-- padsynthOsc spec frequency +-- +-- It makes it easy to create padsynth sound waves (see Tab.padsynth). +-- It creates a padsynth table and reads it with poscil at the right speed. +padsynthOsc :: PadsynthSpec -> Sig -> SE Sig +padsynthOsc spec freq = padsynthOscByTab (double $ padsynthFundamental spec) (padsynth spec) freq + +padsynthOscByTab :: D -> Tab -> Sig -> SE Sig +padsynthOscByTab baseFreq tab freq = ares + where + len = ftlen tab + wave = rndPhs (\phs freq -> poscil 1 freq tab `withD` phs) + ares = wave (freq * (sig $ (getSampleRate / len) / baseFreq)) + +toStereoOsc :: (a -> SE Sig) -> (a -> SE Sig2) +toStereoOsc f x = do + left <- f x + right <- f x + return (left, right) + +-- | Stereo padsynth oscillatro. It creates two padsynth ftables for left and right channels. +padsynthOsc2 :: PadsynthSpec -> Sig -> SE Sig2 +padsynthOsc2 spec freq = toStereoOsc (padsynthOsc spec) freq + +layeredPadsynthSpec :: D -> [(D, PadsynthSpec)] -> SE (D, Tab) +layeredPadsynthSpec val specs = do + refTab <- newCtrlRef lastTab + refBaseFreq <- newCtrlRef lastBaseFreq + + compareWhenD val (fmap (second $ toCase refTab refBaseFreq) specs) + + tab <- readRef refTab + baseFreq <- readRef refBaseFreq + + return (baseFreq, tab) + where + toCase refTab refBaseFreq spec = do + writeRef refTab (padsynth spec) + writeRef refBaseFreq (double $ padsynthFundamental spec) + + lastTab = padsynth $ snd $ last specs + lastBaseFreq = double $ padsynthFundamental $ snd $ last specs + +toThreshholdCond :: D -> (Double, PadsynthSpec) -> (BoolD, PadsynthSpec) +toThreshholdCond val (thresh, spec) = (val `lessThanEquals` double thresh, spec) + +-- | It uses several padsynth tables. Each table is responsible for specific interval of frequencies. +-- The list of pairs specifies the threshhold value and padsynth specification. +-- The padsynth table is active for all frequencies that lie below the given threshold. +-- +-- > padsynthOscMultiCps thresholdSpecPairs frequency = ... +padsynthOscMultiCps :: [(Double, PadsynthSpec)] -> D -> SE Sig +padsynthOscMultiCps specs freq = do + (baseFreq, tab) <- layeredPadsynthSpec freq (fmap (first double) specs) + padsynthOscByTab baseFreq tab (sig freq) + +-- | Stereo version of @padsynthOscMultiCps@. +padsynthOscMultiCps2 :: [(Double, PadsynthSpec)] -> D -> SE Sig2 +padsynthOscMultiCps2 specs freq = do + (baseFreq, tab) <- layeredPadsynthSpec freq (fmap (first double) specs) + toStereoOsc (padsynthOscByTab baseFreq tab) (sig freq) + +-- | It behaves just like @padsynthOscMultiCps@ but it spreads the padsynth tables among amplitude values. +-- So the last input argument is a pair of amplitude and frequency: +-- +-- > padsynthOscMultiVol thresholdSpecPairs (amplitude, frequency) = ... +padsynthOscMultiVol :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig +padsynthOscMultiVol specs (amp, freq) = do + (baseFreq, tab) <- layeredPadsynthSpec amp (fmap (first double) specs) + fmap (sig amp * ) $ padsynthOscByTab baseFreq tab freq + +-- | Stereo version of @padsynthOscMultiVol@. +padsynthOscMultiVol2 :: [(Double, PadsynthSpec)] -> (D, Sig) -> SE Sig2 +padsynthOscMultiVol2 specs (amp, freq) = do + (baseFreq, tab) <- layeredPadsynthSpec amp (fmap (first double) specs) + toStereoOsc (fmap (sig amp * ) . padsynthOscByTab baseFreq tab) freq + +-- | TODO (undefined function) +-- +-- With this function we can create square zones in the domain of @(amplitude, frequency)@. +-- We can assign a separate padsynth table for each zone. +-- The list of pairs contains a pair of two threshold values @(amplitude, frequency)@ and dedicated padsynth specification. +-- +-- > padsynthOscMultiVolCps thresholdSpecPairs (amplitude, frequency) = ... +padsynthOscMultiVolCps :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig +padsynthOscMultiVolCps specs (amp, freq) = undefined + +-- | TODO (undefined function) +-- +-- Stereo version of @padsynthOscMultiVolCps@. +padsynthOscMultiVolCps2 :: [((Double, Double), PadsynthSpec)] -> (D, D) -> SE Sig2 +padsynthOscMultiVolCps2 specs x = toStereoOsc (padsynthOscMultiVolCps specs) x + +---------------------------------------------------- +-- + +whenElseD :: BoolD -> SE () -> SE () -> SE () +whenElseD cond ifDo elseDo = whenDs [(cond, ifDo)] elseDo + +compareWhenD :: D -> [(D, SE ())] -> SE () +compareWhenD val conds = case conds of + [] -> return () + [(cond, ifDo)] -> ifDo + (cond1, do1):(cond2, do2): [] -> whenElseD (val `lessThan` cond1) do1 do2 + _ -> whenElseD (val `lessThan` rootCond) (compareWhenD val less) (compareWhenD val more) + where + (less, more) = splitAt (length conds `div` 2) conds + rootCond = fst $ last less + +---------------------------------------------------- +-- waves + +-- | Creates padsynth oscillator with given harmonics. +-- +-- > bwOscBy harmonics bandwidth frequency +bwOscBy :: [Double] -> Double -> Sig -> SE Sig +bwOscBy harmonics bandwidth = padsynthOsc (defPadsynthSpec bandwidth harmonics) + +-- | Stereo version of @bwOscBy@. +bwOscBy2 :: [Double] -> Double -> Sig -> SE Sig2 +bwOscBy2 harmonics bandwidth = toStereoOsc (bwOscBy harmonics bandwidth) + +-- | Creates padsynth oscillator with given odd harmonics. +-- +-- > bwOddOscBy harmonics bandwidth frequency +bwOddOscBy :: [Double] -> Double -> Sig -> SE Sig +bwOddOscBy harmonics bandwidth = padsynthOsc ((defPadsynthSpec bandwidth harmonics) { padsynthHarmonicStretch = 2 }) + +-- | Stereo version of @bwOddOscBy@. +bwOddOscBy2 :: [Double] -> Double -> Sig -> SE Sig2 +bwOddOscBy2 harmonics bandwidth = toStereoOsc (bwOddOscBy harmonics bandwidth) + +limit = 15 + +triCoeff = intersperse 0 $ zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x * x)) $ [1, 3 ..] +sqrCoeff = intersperse 0 $ zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x)) $ [1, 3 ..] +sawCoeff = zipWith (*) (iterate (* (-1)) (1)) $ fmap (\x -> 1 / (x)) $ [1, 2 ..] + +-- | Pure sine wave with padsynth wave table: +-- +-- > bwOsc bandwidth frequency +bwOsc :: Double -> Sig -> SE Sig +bwOsc = bwOscBy [1] + +-- | Triangle wave with padsynth wave table: +-- +-- > bwTri bandwidth frequency +bwTri :: Double -> Sig -> SE Sig +bwTri = bwOscBy (take limit triCoeff) + +-- | Square wave with padsynth wave table: +-- +-- > bwSqr bandwidth frequency +bwSqr :: Double -> Sig -> SE Sig +bwSqr = bwOscBy (take limit sqrCoeff) + +-- | Saw-tooth wave with padsynth wave table: +-- +-- > bwSaw bandwidth frequency +bwSaw :: Double -> Sig -> SE Sig +bwSaw = bwOscBy (take limit sawCoeff) + + +-- | Stereo version of @bwOsc@. +bwOsc2 :: Double -> Sig -> SE Sig2 +bwOsc2 bandwidth = toStereoOsc (bwOsc bandwidth) + +-- | Stereo version of @bwTri@. +bwTri2 :: Double -> Sig -> SE Sig2 +bwTri2 bandwidth = toStereoOsc (bwTri bandwidth) + +-- | Stereo version of @bwSqr@. +bwSqr2 :: Double -> Sig -> SE Sig2 +bwSqr2 bandwidth = toStereoOsc (bwSqr bandwidth) + +-- | Stereo version of @bwSaw@. +bwSaw2 :: Double -> Sig -> SE Sig2 +bwSaw2 bandwidth = toStereoOsc (bwSaw bandwidth) + +-- Interesting algorithms / examples + +-- harms = [ 1, 1, 0.7600046992, 0.6199994683, 0.9399998784, 0.4400023818, 0.0600003302, 0.8499968648, 0.0899999291, 0.8199964762, 0.3199984133, 0.9400014281, 0.3000001907, 0.120003365, 0.1799997687, 0.5200006366] +-- spec = defPadsynthSpec 82.2 harms +-- dac $ mul 0.4 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.45 (echo 0.25 0.75) $ midi $ onMsg $ (\cps -> (at (mlp (200 + (cps + 3000)) 0.15) . mul (fades 0.5 0.7) . padsynthOsc2 spec) cps) + + +-- noisy +-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.5 (echo 0.25 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) pink) + padsynthOsc2 spec x + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps) +-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.35 largeHall2 $ mixAt 0.5 (echo 0.25 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 5) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3]) 14) white) + padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps) +-- dac $ mul 0.24 $ at (bhp 30) $ mixAt 0.15 magicCave2 $ mixAt 0.43 (echo 0.35 0.85) $ midi $ onMsg $ (\cps -> (bat (lp (200 + (cps + 3000)) 45) . mul (fades 0.5 0.7) . (\x -> (at (mul 0.3 . fromMono . bat (bp (x * 11) 23) . lp (300 + 2500 * linseg [0, 0.73, 0, 8, 3] * uosc (expseg [0.25, 5, 8])) 14) white) + padsynthOsc2 spec x + mul 0.15 (padsynthOsc2 spec (x * 5)) + mul 0.5 (padsynthOsc2 spec (x / 2)))) cps) + +-- an idea ^ to crossfade between noises 4 knobs and to crossfade between harmonics other 4 knobs +-- for a synth + diff --git a/src/Csound/Air/Patch.hs b/src/Csound/Air/Patch.hs --- a/src/Csound/Air/Patch.hs +++ b/src/Csound/Air/Patch.hs @@ -1,3 +1,4 @@ +{-# Language ScopedTypeVariables #-} -- | Patches. module Csound.Air.Patch( CsdNote, Instr, Fx, Fx1, Fx2, FxSpec(..), DryWetRatio, @@ -34,7 +35,16 @@ withMagicCave, withMagicCave', -- * Sound font patches - sfPatch, sfPatchHall + sfPatch, sfPatchHall, + + -- * Csound API + patchByNameMidi, monoPatchByNameMidi, monoSharpPatchByNameMidi, monoPatchByNameMidi', + + -- * Custom temperament + -- ** Midi + atMidiTemp, atMonoTemp, atMonoSharpTemp, atMonoTemp', atHoldMidiTemp, + -- ** Csound API + patchByNameMidiTemp, monoPatchByNameMidiTemp, monoSharpPatchByNameMidiTemp, monoPatchByNameMidiTemp' ) where import Control.Monad @@ -46,6 +56,8 @@ import Csound.Control.Instr import Csound.Control.Sf import Csound.Air.Fx +import Csound.Typed.Opcode(cpsmidinn, ampdb) +import Csound.Tuning -- | A simple csound note (good for playing with midi-keyboard). -- It's a pair of amplitude (0 to 1) and freuqncy (Hz). @@ -135,26 +147,51 @@ atMidi :: (SigSpace a, Sigs a) => Patch D a -> SE a atMidi a = getPatchFx a =<< midi (patchInstr a . ampCps) +-- | Plays a patch with midi. Supplies a custom value for mixing effects (dry/wet). +-- The 0 is a dry signal, the 1 is a wet signal. +atMidiTemp :: (SigSpace a, Sigs a) => Temp -> Patch D a -> SE a +atMidiTemp tm a = getPatchFx a =<< midi (patchInstr a . ampCps' tm) + -- | Simplified monosynth patch atMono :: (SigSpace a, Sigs a) => Patch Sig a -> SE a atMono = atMono' ChnAll 0.01 0.1 +-- | Simplified monosynth patch with custom temperament. +atMonoTemp :: (SigSpace a, Sigs a) => Temp -> Patch Sig a -> SE a +atMonoTemp tm = atMonoTemp' tm ChnAll 0.01 0.1 + -- | Simplified monosynth patch (sharp attack and transitions) atMonoSharp :: (SigSpace a, Sigs a) => Patch Sig a -> SE a atMonoSharp = atMono' ChnAll 0.005 0.05 +-- | Simplified monosynth patch (sharp attack and transitions) with custom temperament. +atMonoSharpTemp :: (SigSpace a, Sigs a) => Temp -> Patch Sig a -> SE a +atMonoSharpTemp tm = atMonoTemp' tm ChnAll 0.005 0.05 + -- | Monosynth patch. Plays the patch with function @monoMsg@ -- -- > atMonoMidi midiChn portamentotime releaseTime patch atMono' :: (SigSpace a, Sigs a) => MidiChn -> D -> D -> Patch Sig a -> SE a atMono' chn port rel a = getPatchFx a =<< patchInstr a =<< monoMsg chn port rel +-- | Monosynth patch with custom temperament. Plays the patch with function @monoMsgTemp@ +-- +-- > atMonoMidi midiChn portamentotime releaseTime patch +atMonoTemp' :: (SigSpace a, Sigs a) => Temp -> MidiChn -> D -> D -> Patch Sig a -> SE a +atMonoTemp' tm chn port rel a = getPatchFx a =<< patchInstr a =<< monoMsgTemp tm chn port rel + -- | Monosynth patch. Plays the patch with function @holdMsg@ -- -- > atMonoMidi midiChn portamentotime patch atHoldMidi :: (SigSpace a, Sigs a) => MidiChn -> D -> Patch Sig a -> SE a atHoldMidi chn port a = getPatchFx a =<< patchInstr a =<< holdMsg chn port +-- | Monosynth patch with custom temperament. Plays the patch with function @holdMsgTemp@ +-- +-- > atMonoMidi midiChn portamentotime patch +atHoldMidiTemp :: (SigSpace a, Sigs a) => Temp -> MidiChn -> D -> Patch Sig a -> SE a +atHoldMidiTemp tm chn port a = getPatchFx a =<< patchInstr a =<< holdMsgTemp tm chn port + -------------------------------------------------------------- -- sched @@ -254,3 +291,80 @@ sfPatch sf = Patch { patchInstr = \(amp, cps) -> return $ sfCps sf 0.5 amp cps , patchFx = [] } + +------------------------------------------------ +-- Csound API + +-- | Triggers patch with Csound API. +-- It creates a named instruement with given name (first argument). +-- +-- It simulates the midi-like instrument. Notes are encoded with messages: +-- +-- > i "givenName" 1 pitchKey volumeKey -- note on +-- > i "givenName" 0 pitchKey volumeKey -- note off +patchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch D a -> SE a +patchByNameMidi = genPatchByNameMidi cpsmidinn + +-- | Triggers patch with Csound API. +-- It creates a named instruement with given name (second argument). +-- It behaves like the function @patchByNameMidi@ but we can specify custom temperament. +patchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch D a -> SE a +patchByNameMidiTemp tm = genPatchByNameMidi (cpsmidi'D tm) + +-- | Wrapper for function @trigByNameMidi@. +genPatchByNameMidi :: forall a . (SigSpace a, Sigs a) => (D -> D) -> String -> Patch D a -> SE a +genPatchByNameMidi key2cps name p = getPatchFx p =<< trigByNameMidi name go + where + go :: (D, D, Unit) -> SE a + go (pitch, vol, _) = patchInstr p (vel2amp vol, key2cps pitch) + + +-- | Triggers patch with Csound API. +-- It creates a named instruement with given name (first argument). +-- +-- It simulates the midi-like instrument. Notes are encoded with messages: +-- +-- > i "givenName" 1 pitchKey volumeKey -- note on +-- > i "givenName" 0 pitchKey volumeKey -- note off +-- +-- It behaves just like the function @patchByNameMidi@ but it's defined for +-- monophonic patches. For instruments that take in continuous signals not messages/notes. +monoPatchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch Sig a -> SE a +monoPatchByNameMidi name p = monoPatchByNameMidi' 0.01 0.1 name p + +-- | Triggers patch with Csound API. +-- It creates a named instruement with given name (first argument). +-- It behaves like the function @monoPatchByNameMidi@ but we can specify custom temperament. +monoPatchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch Sig a -> SE a +monoPatchByNameMidiTemp tm name p = monoPatchByNameMidiTemp' tm 0.01 0.1 name p + +-- | The monophonic patch with sharper transition from note to note. +monoSharpPatchByNameMidi :: (SigSpace a, Sigs a) => String -> Patch Sig a -> SE a +monoSharpPatchByNameMidi name p = monoPatchByNameMidi' 0.005 0.05 name p + +-- | The monophonic patch with sharper transition from note to note. +-- We can specify a custom temperament. +monoSharpPatchByNameMidiTemp :: (SigSpace a, Sigs a) => Temp -> String -> Patch Sig a -> SE a +monoSharpPatchByNameMidiTemp tm name p = monoPatchByNameMidiTemp' tm 0.005 0.05 name p + +-- | Generic function fr invocation of monophonic instrument with Csound API. +-- We can specify portamento and release times. +monoPatchByNameMidi' :: (SigSpace a, Sigs a) => D -> D -> String -> Patch Sig a -> SE a +monoPatchByNameMidi' = genMonoPatchByNameMidi' cpsmidinn + +-- | Generic function fr invocation of monophonic instrument with Csound API. +-- We can specify portamento and release times. Also we can specify a temperament. +monoPatchByNameMidiTemp' :: (SigSpace a, Sigs a) => Temp -> D -> D -> String -> Patch Sig a -> SE a +monoPatchByNameMidiTemp' tm = genMonoPatchByNameMidi' (cpsmidi'Sig tm) + +-- | Wrapper for function @trigByNameMidi@ for mono synth. +genMonoPatchByNameMidi' :: forall a . (SigSpace a, Sigs a) => (Sig -> Sig) -> D -> D -> String -> Patch Sig a -> SE a +genMonoPatchByNameMidi' key2cps portTime relTime name p = getPatchFx p =<< patchInstr p =<< fmap convert (trigNamedMono portTime relTime name) + where + convert (vol, pch) = (vel2ampSig vol, key2cps pch) + +vel2amp :: D -> D +vel2amp vol = ((vol / 64) ** 2) / 2 + +vel2ampSig :: Sig -> Sig +vel2ampSig vol = ((vol / 64) ** 2) / 2 diff --git a/src/Csound/Air/Wave.hs b/src/Csound/Air/Wave.hs --- a/src/Csound/Air/Wave.hs +++ b/src/Csound/Air/Wave.hs @@ -9,6 +9,7 @@ -- ** With random phase rndOsc, rndOscBy, rndSaw, rndIsaw, rndPulse, rndSqr, rndPw, rndTri, rndRamp, rndBlosc, + rndPhs, -- * Unipolar unipolar, bipolar, uosc, uoscBy, usaw, uisaw, upulse, usqr, upw, utri, uramp, ublosc, @@ -180,6 +181,7 @@ -------------------------------------------------------------------------- -- random phase +-- | Generic random phase oscil rndPhs :: (D -> Sig -> Sig) -> (Sig -> SE Sig) rndPhs f cps = fmap (\x -> f x cps) $ rnd 1 diff --git a/src/Csound/Base.hs b/src/Csound/Base.hs --- a/src/Csound/Base.hs +++ b/src/Csound/Base.hs @@ -11,6 +11,7 @@ module Csound.IO, module Csound.Air, module Csound.Tab, + module Csound.Tuning, module Csound.Options, module Csound.SigSpace, @@ -29,6 +30,7 @@ import Csound.Air import Csound.Tab +import Csound.Tuning import Csound.Types import Csound.Control import Csound.IO diff --git a/src/Csound/Control/Gui/Widget.hs b/src/Csound/Control/Gui/Widget.hs --- a/src/Csound/Control/Gui/Widget.hs +++ b/src/Csound/Control/Gui/Widget.hs @@ -186,7 +186,7 @@ genNumbers :: ([Gui] -> Gui) -> [Double] -> Source Sig genNumbers gx as@(d:ds) = source $ do - ref <- newGlobalRef (sig $ double d) + ref <- newGlobalCtrlRef (sig $ double d) (gs, evts) <- fmap unzip $ mapM (button . show) as zipWithM_ (\x e -> runEvt e $ \_ -> writeRef ref (sig $ double x)) as evts res <- readRef ref @@ -278,7 +278,7 @@ radioGroupSig :: ([Gui] -> Gui) -> [String] -> Int -> Source Sig radioGroupSig gcat names initVal = source $ do (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names - curRef <- newGlobalRef (sig $ int initVal) + curRef <- newGlobalCtrlRef (sig $ int initVal) current <- readRef curRef zipWithM_ (\w i -> w $ ifB (current ==* i) 1 0) writes ids zipWithM_ (\r i -> runEvt (snaps r) $ \x -> do @@ -453,7 +453,7 @@ radioGroupSig' :: ([Gui] -> Gui) -> Sig -> [String] -> Int -> Source Sig radioGroupSig' gcat ctrl names initVal = source $ do (guis, writes, reads) <- fmap unzip3 $ mapM (\(i, tag) -> flip setToggleSig (i == initVal) tag) $ zip [0 ..] names - curRef <- newGlobalRef (sig $ int initVal) + curRef <- newGlobalCtrlRef (sig $ int initVal) when1 (changed [ctrl] ==* 1) $ writeRef curRef ctrl @@ -475,7 +475,7 @@ ctrlSig :: D -> Sig -> SinkSource Sig -> Source Sig ctrlSig initVal ctrl v = source $ do (gui, output, input) <- v - ref <- newGlobalRef (sig initVal) + ref <- newGlobalCtrlRef (sig initVal) when1 (changed [ctrl] ==* 1) $ writeRef ref ctrl when1 (changed [input] ==* 1) $ writeRef ref input res <- readRef ref diff --git a/src/Csound/Control/Instr.hs b/src/Csound/Control/Instr.hs --- a/src/Csound/Control/Instr.hs +++ b/src/Csound/Control/Instr.hs @@ -86,6 +86,16 @@ schedBy, schedHarpBy, withDur, + -- * Api + -- | We can create named instruments. then we can trigger the named instruments with Csound API. + -- Csound can be used not as a text to audio converter but also as a shared C-library. There are + -- many bindings to many languages. For example we can use Python or Android SDK to create UI + -- and under the hood we can use the audio engine created with Haskell. The concept of named instruments + -- is the bridge for other lnguages to use our haskell-generated code. + trigByName, trigByName_, + trigByNameMidi, trigByNameMidi_, + turnoffByName, + -- ** Misc alwaysOn, playWhen, @@ -94,6 +104,9 @@ Outs(..), onArg, AmpInstr(..), CpsInstr(..) ) where +import Control.Monad.Trans.Class +import Csound.Dynamic hiding (str, Sco(..), when1, alwaysOn) + import Csound.Typed import Csound.Typed.Opcode hiding (initc7) import Csound.Control.Overload @@ -168,3 +181,27 @@ -- | Executes some procedure for the whole lifespan of the program, alwaysOn :: SE () -> SE () alwaysOn proc = sched_ (const $ proc) $ withDur (infiniteDur) $ loadbang + +-------------------------------------------------------------- + +-- | Turns off named instruments. +-- +-- > turnoffNamedInstr name kmode krelease +-- +-- name of the instrument (should be defined with @trigByName@ or smth like that). +-- +-- kmode -- sum of the following values: +-- +-- 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2) +-- +-- 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part +-- +-- 8: only turn off notes with indefinite duration (p3 < 0 or MIDI) +-- +-- krelease -- if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks) +turnoffByName :: String -> Sig -> Sig -> SE () +turnoffByName name kmode krelease = strTurnoff2 (text name) kmode krelease + +strTurnoff2 :: Str -> Sig -> Sig -> SE () +strTurnoff2 b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unStr b1 <*> unSig b2 <*> unSig b3 + where f a1 a2 a3 = opcs "turnoff2" [(Xr,[Sr,Kr,Kr])] [a1,a2,a3] diff --git a/src/Csound/Control/Midi.hs b/src/Csound/Control/Midi.hs --- a/src/Csound/Control/Midi.hs +++ b/src/Csound/Control/Midi.hs @@ -5,14 +5,21 @@ Msg, Channel, midi, midin, pgmidi, ampCps, midi_, midin_, pgmidi_, -- * Mono-midi synth - monoMsg, holdMsg, + monoMsg, holdMsg, trigNamedMono, + + -- ** Custom temperament + monoMsgTemp, holdMsgTemp, -- * Midi event streams midiKeyOn, midiKeyOff, -- * Reading midi note parameters - cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl, + cpsmidi, ampmidi, initc7, ctrl7, midiCtrl7, midiCtrl, umidiCtrl, + ampmidinn, + -- ** Custom temperament + ampCps', cpsmidi', cpsmidi'D, cpsmidi'Sig, + -- * Overload - tryMidi, MidiInstr(..) + tryMidi, tryMidi', MidiInstr(..), MidiInstrTemp(..) ) where import Data.Boolean @@ -23,6 +30,8 @@ import Csound.Control.Instr(alwaysOn) import Csound.Control.Evt(Tick) +import Csound.Tuning + -- | Specifies the midi channel or programm. data MidiChn = ChnAll | Chn Int | Pgm (Maybe Int) Int deriving (Show, Eq) @@ -44,6 +53,29 @@ ampCps :: Msg -> (D, D) ampCps msg = (ampmidi msg 1, cpsmidi msg) +-- | Converts midi velocity number to amplitude. +-- The first argument is dynamic range in decibels. +-- +-- > ampmidinn (volMinDb, volMaxDb) volumeKey = amplitude +ampmidinn :: (D, D) -> D -> D +ampmidinn (volMin, volMax) volKey = ampdbfs (volMin + ir (ampmidid volKey (volMax - volMin))) + +-- | Midi message convertion with custom temperament. +ampCps' :: Temp -> Msg -> (D, D) +ampCps' temp msg = (ampmidi msg 1, cpsmidi' temp msg) + +-- | Midi message convertion to Hz with custom temperament. +cpsmidi' :: Temp -> Msg -> D +cpsmidi' (Temp t) msg = cpstmid msg t + +-- | Midi pitch key convertion to Hz with custom temperament. It works on constants. +cpsmidi'D :: Temp -> D -> D +cpsmidi'D (Temp t) key = cpstuni key t + +-- | Midi pitch key convertion to Hz with custom temperament. It works on signals. +cpsmidi'Sig :: Temp -> Sig -> Sig +cpsmidi'Sig (Temp t) key = cpstun 1 key t + ----------------------------------------------------------------------- -- Midi addons @@ -57,8 +89,21 @@ -- -- > monoMsg channel portamentoTime releaseTime monoMsg :: MidiChn -> D -> D -> SE (Sig, Sig) -monoMsg chn portTime relTime = do - (amp, cps, status) <- genAmpCpsSig (toMidiFun chn) +monoMsg = genMonoMsg cpsmidi + +-- | Produces midi amplitude and frequency as a signal. +-- The signal fades out when nothing is pressed. +-- It can be used in mono-synths. Arguments are custom temperament, midi channel, portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > monoMsgTemp temperament channel portamentoTime releaseTime +monoMsgTemp :: Temp -> MidiChn -> D -> D -> SE (Sig, Sig) +monoMsgTemp tm = genMonoMsg (cpsmidi' tm) + +genMonoMsg :: (Msg -> D) -> MidiChn -> D -> D -> SE (Sig, Sig) +genMonoMsg key2cps chn portTime relTime = do + (amp, cps, status) <- genAmpCpsSig key2cps (toMidiFun chn) return (port amp portTime * port status relTime, port cps portTime) -- | Produces midi amplitude and frequency as a signal and holds the @@ -69,13 +114,26 @@ -- -- > holdMsg portamentoTime holdMsg :: MidiChn -> D -> SE (Sig, Sig) -holdMsg channel portTime = do - (amp, cps) <- genHoldAmpCpsSig (toMidiFun_ channel) +holdMsg = genHoldMsg cpsmidi + +-- | Produces midi amplitude and frequency as a signal and holds the +-- last value till the next one is present. +-- It can be used in mono-synths. Arguments are portamento time +-- and release time. A portamento time is time it takes for transition +-- from one note to another. +-- +-- > holdMsg portamentoTime +holdMsgTemp :: Temp -> MidiChn -> D -> SE (Sig, Sig) +holdMsgTemp tm = genHoldMsg (cpsmidi' tm) + +genHoldMsg :: (Msg -> D) -> MidiChn -> D -> SE (Sig, Sig) +genHoldMsg key2cps channel portTime = do + (amp, cps) <- genHoldAmpCpsSig key2cps (toMidiFun_ channel) return (port amp portTime, port cps portTime) -genAmpCpsSig :: ((Msg -> SE Sig) -> SE Sig) -> SE (Sig, Sig, Sig) -genAmpCpsSig midiFun = do +genAmpCpsSig :: (Msg -> D) -> ((Msg -> SE Sig) -> SE Sig) -> SE (Sig, Sig, Sig) +genAmpCpsSig key2cps midiFun = do ref <- newGlobalRef ((0, 0) :: (Sig, Sig)) status <- midiFun (instr ref) let resStatus = ifB (downsamp status ==* 0) 0 1 @@ -84,11 +142,11 @@ where instr :: Ref (Sig, Sig) -> Msg -> SE Sig instr hNote msg = do - writeRef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) + writeRef hNote (sig $ ampmidi msg 1, sig $ key2cps msg) return 1 -genHoldAmpCpsSig :: ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig) -genHoldAmpCpsSig midiFun = do +genHoldAmpCpsSig :: (Msg -> D) -> ((Msg -> SE ()) -> SE ()) -> SE (Sig, Sig) +genHoldAmpCpsSig key2cps midiFun = do ref <- newGlobalRef ((0, 0) :: (Sig, Sig)) midiFun (instr ref) (amp, cps) <- readRef ref @@ -96,9 +154,39 @@ where instr :: Ref (Sig, Sig) -> Msg -> SE () instr hNote msg = do - writeRef hNote (sig $ ampmidi msg 1, sig $ cpsmidi msg) + writeRef hNote (sig $ ampmidi msg 1, sig $ key2cps msg) +-- | Creates a named instrument that can be triggered with Csound API. +-- This way we can create a csd file that can be used inside another program/language. +-- +-- It simulates the input for monophonic midi-like instrument. Notes are encoded with messages: +-- +-- > i "givenName" 1 pitchKey volumeKey -- note on +-- > i "givenName" 0 pitchKey volumeKey -- note off +-- +-- The output is a pair of signals @(midiVolume, midiPitch)@. +trigNamedMono :: D -> D -> String -> SE (Sig, Sig) +trigNamedMono portTime relTime name = namedMonoMsg portTime relTime name +namedAmpCpsSig:: String -> SE (Sig, Sig, Sig) +namedAmpCpsSig name = do + ref <- newGlobalRef ((0, 0) :: (Sig, Sig)) + statusRef <- newGlobalRef (0 :: Sig) + status <- trigByNameMidi name (instr statusRef ref) + writeRef statusRef status + let resStatus = ifB (downsamp status ==* 0) 0 1 + (amp, cps) <- readRef ref + return (downsamp amp, downsamp cps, resStatus) + where + instr :: Ref Sig -> Ref (Sig, Sig) -> (D, D, Unit) -> SE Sig + instr statusRef hNote (pitchKey, volKey, _) = do + curId <- readRef statusRef + myIdRef <- newRef (ir curId) + myId <- readRef myIdRef + when1 (curId ==* (sig $ myId + 1)) $ do + writeRef hNote (sig volKey, sig pitchKey) + return 1 + -------------------------------------------------------------- -- | Listens to midi on event on the given key as event stream. @@ -173,3 +261,10 @@ -- > dac $ tryMidi (mul (fades 0.01 0.1) . tri) tryMidi :: (MidiInstr a, Sigs (MidiInstrOut a)) => a -> SE (MidiInstrOut a) tryMidi x = midi $ onMsg x + +-- | Invokes ooverloaded instruments with midi and custom temperament. +-- Example: +-- +-- > dac $ tryMidi' youngTemp2 (mul (fades 0.01 0.1) . tri) +tryMidi' :: (MidiInstrTemp a, Sigs (MidiInstrOut a)) => Temp -> a -> SE (MidiInstrOut a) +tryMidi' tm x = midi $ onMsg' tm x diff --git a/src/Csound/Control/Overload.hs b/src/Csound/Control/Overload.hs --- a/src/Csound/Control/Overload.hs +++ b/src/Csound/Control/Overload.hs @@ -1,5 +1,5 @@ module Csound.Control.Overload( - Outs(..), onArg, MidiInstr(..), AmpInstr(..), CpsInstr(..) + Outs(..), onArg, MidiInstr(..), MidiInstrTemp(..), AmpInstr(..), CpsInstr(..) ) where import Csound.Control.Overload.Outs diff --git a/src/Csound/Control/Overload/MidiInstr.hs b/src/Csound/Control/Overload/MidiInstr.hs --- a/src/Csound/Control/Overload/MidiInstr.hs +++ b/src/Csound/Control/Overload/MidiInstr.hs @@ -1,14 +1,23 @@ {-# Language TypeFamilies, FlexibleInstances, FlexibleContexts #-} module Csound.Control.Overload.MidiInstr( - MidiInstr(..) + MidiInstr(..), MidiInstrTemp(..) ) where import Csound.Typed import Csound.Typed.Opcode +import Csound.Tuning + ampCps :: Msg -> (D, D) ampCps msg = (ampmidi msg 1, cpsmidi msg) +-- | Midi message convertion to Hz with custom temperament. +cpsmidi' :: Temp -> Msg -> D +cpsmidi' (Temp t) msg = cpstmid msg t + +ampCps' :: Temp -> Msg -> (D, D) +ampCps' temp msg = (ampmidi msg 1, cpsmidi' temp msg) + ------------------------------------------------------------------------------- -- | Converts a value to the midi-instrument. It's used with the functions 'Csound.Base.midi', 'Csound.Base.midin'. @@ -359,4 +368,212 @@ (a1, a2, a3, a4) <- f ((cpsmidi msg)) return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4) +------------------------------------------------------------------------------- +-- Custom temperament +-- | Converts a value to the midi-instrument with custom temperament. +-- It's used with the functions 'Csound.Base.midi', 'Csound.Base.midin'. +class MidiInstr a => MidiInstrTemp a where + onMsg' :: Temp -> a -> Msg -> SE (MidiInstrOut a) + +-- by (Sig, Sig) + +sig2' :: Temp -> Msg -> (Sig, Sig) +sig2' tm msg = (sig amp, sig cps) + where (amp, cps) = ampCps' tm msg + +instance MidiInstrTemp ((Sig, Sig) -> Sig) where + onMsg' tm f = return . f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> (Sig, Sig)) where + onMsg' tm f = return . f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> (Sig, Sig, Sig)) where + onMsg' tm f = return . f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f = return . f . sig2' tm + +-- se sig + +instance MidiInstrTemp ((Sig, Sig) -> SE Sig) where + onMsg' tm f = f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> SE (Sig, Sig)) where + onMsg' tm f = f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> SE (Sig, Sig, Sig)) where + onMsg' tm f = f . sig2' tm + +instance MidiInstrTemp ((Sig, Sig) -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f = f . sig2' tm + +-- by Sig / D + +dsig' :: Temp -> Msg -> (D, Sig) +dsig' tm msg = (amp, sig cps) + where (amp, cps) = ampCps' tm msg + +instance MidiInstrTemp ((D, Sig) -> Sig) where + onMsg' tm f = return . f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> (Sig, Sig)) where + onMsg' tm f = return . f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> (Sig, Sig, Sig)) where + onMsg' tm f = return . f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f = return . f . dsig' tm + +-- se sig + +instance MidiInstrTemp ((D, Sig) -> SE Sig) where + onMsg' tm f = f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> SE (Sig, Sig)) where + onMsg' tm f = f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> SE (Sig, Sig, Sig)) where + onMsg' tm f = f . dsig' tm + +instance MidiInstrTemp ((D, Sig) -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f = f . dsig' tm + +-- by Sig / D + +sigd' :: Temp -> Msg -> (Sig, D) +sigd' tm msg = (sig amp, cps) + where (amp, cps) = ampCps' tm msg + +instance MidiInstrTemp ((Sig, D) -> Sig) where + onMsg' tm f = return . f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> (Sig, Sig)) where + onMsg' tm f = return . f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> (Sig, Sig, Sig)) where + onMsg' tm f = return . f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f = return . f . sigd' tm + +-- se sig + +instance MidiInstrTemp ((Sig, D) -> SE Sig) where + onMsg' tm f = f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> SE (Sig, Sig)) where + onMsg' tm f = f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> SE (Sig, Sig, Sig)) where + onMsg' tm f = f . sigd' tm + +instance MidiInstrTemp ((Sig, D) -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f = f . sigd' tm + +-- d2 + +d2' :: Temp -> Msg -> (D, D) +d2' tm = ampCps' tm + +instance MidiInstrTemp ((D, D) -> Sig) where + onMsg' tm f = return . f . d2' tm + +instance MidiInstrTemp ((D, D) -> (Sig, Sig)) where + onMsg' tm f = return . f . d2' tm + +instance MidiInstrTemp ((D, D) -> (Sig, Sig, Sig)) where + onMsg' tm f = return . f . d2' tm + +instance MidiInstrTemp ((D, D) -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f = return . f . d2' tm + +-- se sig + +instance MidiInstrTemp ((D, D) -> SE Sig) where + onMsg' tm f = f . d2' tm + +instance MidiInstrTemp ((D, D) -> SE (Sig, Sig)) where + onMsg' tm f = f . d2' tm + +instance MidiInstrTemp ((D, D) -> SE (Sig, Sig, Sig)) where + onMsg' tm f = f . d2' tm + +instance MidiInstrTemp ((D, D) -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f = f . d2' tm + +-- sig + +instance MidiInstrTemp (Sig -> Sig) where + onMsg' tm f msg = return $ sig (ampmidi msg 1) * f (sig (cpsmidi' tm msg)) + +instance MidiInstrTemp (Sig -> (Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2) + where (a1, a2) = f (sig (cpsmidi' tm msg)) + +instance MidiInstrTemp (Sig -> (Sig, Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3) + where (a1, a2, a3) = f (sig (cpsmidi' tm msg)) + +instance MidiInstrTemp (Sig -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4) + where (a1, a2, a3, a4) = f (sig (cpsmidi' tm msg)) + + +instance MidiInstrTemp (Sig -> SE Sig) where + onMsg' tm f msg = do + a1 <- f (sig (cpsmidi' tm msg)) + return $ sig (ampmidi msg 1) * a1 + +instance MidiInstrTemp (Sig -> SE (Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2) <- f (sig (cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2) + +instance MidiInstrTemp (Sig -> SE (Sig, Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2, a3) <- f (sig (cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3) + +instance MidiInstrTemp (Sig -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2, a3, a4) <- f (sig (cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4) + +-- d + +instance MidiInstrTemp (D -> Sig) where + onMsg' tm f msg = return $ sig (ampmidi msg 1) * f (cpsmidi' tm msg) + +instance MidiInstrTemp (D -> (Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2) + where (a1, a2) = f (cpsmidi' tm msg) + +instance MidiInstrTemp (D -> (Sig, Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3) + where (a1, a2, a3) = f (cpsmidi' tm msg) + +instance MidiInstrTemp (D -> (Sig, Sig, Sig, Sig)) where + onMsg' tm f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4) + where (a1, a2, a3, a4) = f (cpsmidi' tm msg) + +instance MidiInstrTemp (D -> SE Sig) where + onMsg' tm f msg = do + a1 <- f ((cpsmidi' tm msg)) + return $ sig (ampmidi msg 1) * a1 + +instance MidiInstrTemp (D -> SE (Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2) <- f ((cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2) + +instance MidiInstrTemp (D -> SE (Sig, Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2, a3) <- f ((cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3) + +instance MidiInstrTemp (D -> SE (Sig, Sig, Sig, Sig)) where + onMsg' tm f msg = do + (a1, a2, a3, a4) <- f ((cpsmidi' tm msg)) + return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4) diff --git a/src/Csound/Control/SE.hs b/src/Csound/Control/SE.hs --- a/src/Csound/Control/SE.hs +++ b/src/Csound/Control/SE.hs @@ -1,5 +1,6 @@ module Csound.Control.SE( - SE, Ref, writeRef, readRef, modifyRef, mixRef, newRef, sensorsSE, newGlobalRef, globalSensorsSE + SE, Ref, writeRef, readRef, modifyRef, mixRef, newRef, sensorsSE, newGlobalRef, globalSensorsSE, + newCtrlRef, newGlobalCtrlRef, newClearableGlobalRef, newTab, newGlobalTab ) where import Csound.Typed.Control diff --git a/src/Csound/Control/Sf.hs b/src/Csound/Control/Sf.hs --- a/src/Csound/Control/Sf.hs +++ b/src/Csound/Control/Sf.hs @@ -10,9 +10,11 @@ -- The functions with suffix @m@ produce mono outputs. -- The loopers play samples in loops. module Csound.Control.Sf( - Sf(Sf), sf2, + Sf(Sf), sf2, sfTemp, -- * Midi message sfMsg, sfMsg3, sfMsgm, sfMsg3m, sfMsgLooper, + -- ** Custom temperament + sfMsgTemp, sfMsgTemp3, sfMsgTempm, sfMsgTemp3m, sfMsgLooperTemp, -- * Midi note sfKey, sfKey3, sfKeym, sfKey3m, sfKeyLooper, -- * Frequency in Hz @@ -23,6 +25,9 @@ import Csound.Typed.Opcode import Csound.SigSpace +import Csound.Tuning +import Csound.Control.Midi + -- | Creates a midi instrument from sf2 sound font. -- Midi listens on all channels. It's useful to quickly -- test a sound font. The second argument is a sustain in seconds. @@ -30,6 +35,13 @@ sf2 :: Sf -> D -> SE (Sig, Sig) sf2 sf sust = midi $ sfMsg3 sf sust +-- | Creates a midi instrument from sf2 sound font. +-- Midi listens on all channels. It's useful to quickly +-- test a sound font. The second argument is a sustain in seconds. +-- How long it takes for the sound to decay. +sfTemp :: Temp -> Sf -> D -> SE (Sig, Sig) +sfTemp tm sf sust = midi $ sfMsgTemp3 tm sf sust + ----------------------------------- -- | Creates a midi instrument from sf2 sound font file. @@ -64,6 +76,41 @@ sfMsgLooper start end crossfade = genSfMsg $ \vel key amp cps sf -> sflooper vel key amp cps sf start end crossfade +----------------------------------- +-- custom temperament + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with linear interpolation. +sfMsgTemp :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig) +sfMsgTemp = genSfMsgTemp sfplay + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with cubic interpolation. +sfMsgTemp3 :: Temp -> Sf -> D -> Msg -> SE (Sig, Sig) +sfMsgTemp3 = genSfMsgTemp sfplay3 + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with linear interpolation. +-- Produces mono output. +sfMsgTempm :: Temp -> Sf -> D -> Msg -> SE Sig +sfMsgTempm = genSfMsgTemp sfplaym + +-- | Creates a midi instrument from sf2 sound font file. +-- The second argument is sustain in seconds. +-- Reads samples with cubic interpolation. +-- Produces mono output. +sfMsgTemp3m :: Temp -> Sf -> D -> Msg -> SE Sig +sfMsgTemp3m = genSfMsgTemp sfplay3m + +-- | Midi looper of the sf2 samples. +-- The first arguments are: start, end, crossfade of the loop. +sfMsgLooperTemp :: Sig -> Sig -> Sig -> Temp -> Sf -> D -> Msg -> SE (Sig, Sig) +sfMsgLooperTemp start end crossfade = genSfMsgTemp $ + \vel key amp cps sf -> sflooper vel key amp cps sf start end crossfade + ----------------------------------------- -- | Reads sf2 samples at given midi velocity and key (both are from 0 to 127). @@ -126,11 +173,14 @@ ---------------------------------------------- -type SfFun a = D -> D -> Sig -> Sig -> Sf -> a +type SfFun a = D -> D -> Sig -> Sig -> Sf -> a genSfMsg :: (SigSpace a, Sigs a) => SfFun a -> Sf -> D -> Msg -> SE a genSfMsg play sf sustain msg = return $ mul env $ play (veloc msg) (notnum msg) 1 1 sf where env = sfEnv sustain (veloc msg / 127) + +genSfMsgTemp :: (SigSpace a, Sigs a) => SfFun a -> Temp -> Sf -> D -> Msg -> SE a +genSfMsgTemp play tm sf sustain msg = return $ genSfCps play sf sustain (ampmidi msg 1) (cpsmidi' tm msg) genSfKey :: SigSpace a => SfFun a -> Sf -> D -> D -> D -> a genSfKey play sf sustain vel key = mul env $ play vel key 1 1 sf diff --git a/src/Csound/IO.hs b/src/Csound/IO.hs --- a/src/Csound/IO.hs +++ b/src/Csound/IO.hs @@ -167,6 +167,14 @@ panel gui asig +instance RenderCsd (Source ()) where + renderCsdBy opt src = renderCsdBy opt $ do + (ui, _) <- src + panel ui + +instance RenderCsd (Source (SE ())) where + renderCsdBy opt src = renderCsdBy opt (joinSource src) + -- | Renders Csound file. renderCsd :: RenderCsd a => a -> IO String renderCsd = renderCsdBy def diff --git a/src/Csound/Options.hs b/src/Csound/Options.hs --- a/src/Csound/Options.hs +++ b/src/Csound/Options.hs @@ -34,7 +34,6 @@ Config(..) ) where -import Data.Monoid import Data.Default import Csound.Typed diff --git a/src/Csound/SigSpace.hs b/src/Csound/SigSpace.hs --- a/src/Csound/SigSpace.hs +++ b/src/Csound/SigSpace.hs @@ -5,7 +5,7 @@ FlexibleInstances, FlexibleContexts #-} module Csound.SigSpace( - SigSpace(..), BindSig(..), mul, on, uon, At(..), mixAt, bat, + SigSpace(..), BindSig(..), mul, on, uon, At(..), MixAt(..), bat, bmixAt, cfd, cfd4, cfds, cfdSpec, cfdSpec4, cfdsSpec, wsum ) where @@ -312,12 +312,6 @@ bat :: At Sig a b => (Sig -> a) -> b -> AtOut Sig a b bat f = at (\x -> mapSig ( `balance` x) $ f x) --- | It applies an effect and mixes the processed signal with original one. --- The first argument is for proportion of dry/wet (original/processed). --- It's like @at@ but it allows to balance processed signal with original one. -mixAt :: (At a b c, c ~ AtOut a b c, SigSpace c, Num c) => Sig -> (a -> b) -> c -> c -mixAt k f a = cfd k a (at f a) - instance SigSpace a => At Sig Sig a where type AtOut Sig Sig a = a at f a = mapSig f a @@ -418,4 +412,157 @@ type AtOut Sig2 (SE Sig2) (SE Sig2) = SE Sig2 at f a = f =<< a +----------------------------------------------------------------------- +----------------------------------------------------------------------- +-- MixAt + +-- | It applies an effect and mixes the processed signal with original one. +-- The first argument is for proportion of dry/wet (original/processed). +-- It's like @at@ but it allows to balance processed signal with original one. +class (SigSpace b, At a b c) => MixAt a b c where + mixAt :: Sig -> (a -> b) -> c -> AtOut a b c + +-- | It applies an effect and balances the processed signal by original one. +-- Also it applies an effect and mixes the processed balanced signal with original one. +bmixAt :: MixAt Sig a b => Sig -> (Sig -> a) -> b -> AtOut Sig a b +bmixAt k f = mixAt k (\x -> mapSig ( `balance` x) $ f x) + +--------------------------------------------------- + +instance SigSpace a => MixAt Sig Sig a where + mixAt k f a = mapSig (\x -> cfd k x (f x)) a + +------------------------------------------------------ +-- for (Sig -> SE Sig) + +instance MixAt Sig (SE Sig) Sig where + mixAt k f dry = do + wet <- f dry + return $ cfd k dry wet + +instance MixAt Sig (SE Sig) Sig2 where + mixAt k f (dry1, dry2) = do + wet1 <- f dry1 + wet2 <- f dry2 + return $ cfd k (dry1, dry2) (wet1, wet2) + +instance MixAt Sig (SE Sig) Sig3 where + mixAt k f (dry1, dry2, dry3) = do + wet1 <- f dry1 + wet2 <- f dry2 + wet3 <- f dry3 + return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3) + +instance MixAt Sig (SE Sig) Sig4 where + mixAt k f (dry1, dry2, dry3, dry4) = do + wet1 <- f dry1 + wet2 <- f dry2 + wet3 <- f dry3 + wet4 <- f dry4 + return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4) + +instance MixAt Sig (SE Sig) (SE Sig) where + mixAt k f dry = do + dry1 <- dry + wet1 <- f dry1 + return $ cfd k dry1 wet1 + +instance MixAt Sig (SE Sig) (SE Sig2) where + mixAt k f dry = do + (dry1, dry2) <- dry + wet1 <- f dry1 + wet2 <- f dry2 + return $ cfd k (dry1, dry2) (wet1, wet2) + +instance MixAt Sig (SE Sig) (SE Sig3) where + mixAt k f dry = do + (dry1, dry2, dry3) <- dry + wet1 <- f dry1 + wet2 <- f dry2 + wet3 <- f dry3 + return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3) + +instance MixAt Sig (SE Sig) (SE Sig4) where + mixAt k f dry = do + (dry1, dry2, dry3, dry4) <- dry + wet1 <- f dry1 + wet2 <- f dry2 + wet3 <- f dry3 + wet4 <- f dry4 + return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4) + +----------------------------------------------------- +-- mono to stereo + +instance MixAt Sig Sig2 Sig where + mixAt k f dry = cfd k (dry, dry) wet + where wet = f dry + +instance MixAt Sig Sig2 (SE Sig) where + mixAt k f dry = fmap (\x -> cfd k (x, x) (f x)) dry + +instance MixAt Sig Sig2 Sig2 where + mixAt k f dry = cfd k dry wet + where wet = 0.5 * (f (fst dry) + f (snd dry)) + +instance MixAt Sig Sig2 (SE Sig2) where + mixAt k f dry = do + (dry1, dry2) <- dry + let wet = 0.5 * (f dry1 + f dry2) + return $ cfd k (dry1, dry2) wet + --------------------------------------------------------- + +--------------------------------------------------------- +-- Sig2 -> Sig2 + +instance MixAt Sig2 Sig2 Sig where + mixAt k f dry1 = cfd k dry wet + where + dry = fromMono dry1 + wet = f dry + +instance MixAt Sig2 Sig2 Sig2 where + mixAt k f dry = cfd k dry wet + where + wet = f dry + +instance MixAt Sig2 Sig2 (SE Sig) where + mixAt k f dry1 = do + dry <- fmap fromMono dry1 + let wet = f dry + return $ cfd k dry wet + +instance MixAt Sig2 Sig2 (SE Sig2) where + mixAt k f drySe = do + dry <- drySe + let wet = f dry + return $ cfd k dry wet + + +--------------------------------------------- +-- Sig2 -> SE Sig2 + +instance MixAt Sig2 (SE Sig2) Sig where + mixAt k f dry1 = do + wet <- f dry + return $ cfd k dry wet + where + dry = fromMono dry1 + +instance MixAt Sig2 (SE Sig2) Sig2 where + mixAt k f dry = do + wet <- f dry + return $ cfd k dry wet + +instance MixAt Sig2 (SE Sig2) (SE Sig) where + mixAt k f dry1 = do + dry <- fmap fromMono dry1 + wet <- f dry + return $ cfd k dry wet + +instance MixAt Sig2 (SE Sig2) (SE Sig2) where + mixAt k f drySe = do + dry <- drySe + wet <- f dry + return $ cfd k dry wet diff --git a/src/Csound/Tab.hs b/src/Csound/Tab.hs --- a/src/Csound/Tab.hs +++ b/src/Csound/Tab.hs @@ -26,7 +26,8 @@ -- * (In)Harmonic series PartialStrength, PartialNumber, PartialPhase, PartialDC, - sines, sines3, sines2, sines1, sines4, buzzes, + sines, sines3, sines2, sines1, sines4, buzzes, bwSines, bwOddSines, + -- ** Special cases sine, cosine, sigmoid, tanhSigmoid, @@ -68,6 +69,9 @@ winHamming, winHanning, winBartlett, winBlackman, winHarris, winGaussian, winKaiser, winRectangle, winSync, + -- * Padsynth + padsynth, PadsynthSpec(..), PadsynthShape(..), defPadsynthSpec, + -- * Low level Csound definition. gen, @@ -81,9 +85,10 @@ -- * Identifiers for GEN-routines -- | Low level Csound integer identifiers for tables. These names can be used in the function 'Csound.Base.fineFi' - idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2 - , idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes - , idExps, idSplines, idStartEnds, idPolys, idChebs1, idChebs2, idBessels, idWins, + idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2, + idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes, + idExps, idSplines, idStartEnds, idPolys, idChebs1, idChebs2, idBessels, idWins, + idPadsynth, idTanh, idExp, idSone, idFarey, idWave, -- * Tabular opcodes tablewa, sec2rel, @@ -104,6 +109,7 @@ noTab :: Tab noTab = fromE (-1) +{- -- | Creates a new table. The Tab could be used while the instrument -- is playing. When the instrument is retriggered the new tab is allocated. -- @@ -122,6 +128,7 @@ tabId <- ftgenonce 0 (int identifier) size 7 0 [size, 0] writeRef ref (fromGE $ toGE tabId) fmap (fromGE . toGE) $ readRef ref +-} -- | Calculates the number of samples needed to store the given amount of seconds. -- It multiplies the value by the current sample rate. @@ -396,6 +403,19 @@ sines4 :: [(PartialNumber, PartialStrength, PartialPhase, PartialDC)] -> Tab sines4 xs = plains idSines4 [a | (pn, strength, phs, dc) <- xs, a <- [pn, strength, phs, dc]] +-- | Sines with bandwidth (simplified padsynth generator) +-- +-- bwSines harmonics bandwidth +bwSines :: [Double] -> Double -> Tab +bwSines harmonics bandwidth = padsynth (defPadsynthSpec bandwidth harmonics) + +-- | Sines with bandwidth (simplified padsynth generator). Only odd harmonics are present +-- +-- bwOddSines harmonics bandwidth +bwOddSines :: [Double] -> Double -> Tab +bwOddSines harmonics bandwidth = padsynth ((defPadsynthSpec bandwidth harmonics) { padsynthHarmonicStretch = 2 }) + + -- | Table for pure sine wave. sine :: Tab sine = sines [1] @@ -500,6 +520,48 @@ wins :: WinType -> [Double] -> Tab wins ty params = gen idWins (winTypeId ty : params) +-- | Padsynth parameters. +-- +-- see for details: +data PadsynthSpec = PadsynthSpec + { padsynthFundamental :: Double + , padsynthBandwidth :: Double + , padsynthPartialScale :: Double + , padsynthHarmonicStretch :: Double + , padsynthShape :: PadsynthShape + , padsynthShapeParameter :: Double + , padsynthHarmonics :: [Double] + } deriving (Show, Eq) + +data PadsynthShape = GaussShape | SquareShape | ExpShape + deriving (Show, Eq, Ord, Enum) + +padsynthShapeId :: PadsynthShape -> Double +padsynthShapeId shape = fromIntegral $ 1 + (fromEnum shape) + +-- | Specs for padsynth algorithm: +-- +-- > defPadsynthSpec partialBandwidth harmonics +-- +-- * partialBandwidth -- bandwidth of the first partial. +-- +-- * harmonics -- the list of amplitudes for harmonics. +defPadsynthSpec :: Double -> [Double] -> PadsynthSpec +defPadsynthSpec partialBW harmonics = PadsynthSpec 261.625565 partialBW 1 1 GaussShape 1 harmonics + +-- | Creates tables for the padsynth algorithm (described at ). +-- The table size should be very big the default is 18 power of 2. +-- +-- csound docs: +padsynth :: PadsynthSpec -> Tab +padsynth (PadsynthSpec fundamentalFreq partialBW partialScale harmonicStretch shape shapeParameter harmonics) = + plainStringTab idPadsynth ([fundamentalFreq, partialBW, partialScale, harmonicStretch, padsynthShapeId shape, shapeParameter] ++ harmonics) + + -- 261.625565 25.0 1.0 1.0 2.0 1.0 1.0 0.5 0.0 0.2 + +plainStringTab :: String -> [Double] -> Tab +plainStringTab genId as = preStringTab def genId (ArgsPlain as) + -- | Creates a table of doubles (It's f-table in Csound). -- Arguments are: -- @@ -548,7 +610,6 @@ hifi = setDegree 1 hhifi = setDegree 2 hhhifi = setDegree 3 - -- | Writes tables in sequential locations. -- diff --git a/src/Csound/Tuning.hs b/src/Csound/Tuning.hs new file mode 100644 --- /dev/null +++ b/src/Csound/Tuning.hs @@ -0,0 +1,177 @@ +module Csound.Tuning( + -- * Temperament + Temp(..), genTemp, genTempRatio, + tempC, tempRatioC, stdTemp, stdTempRatio, barTemp, barTempRatio, concertA, ratioConcertA, + + -- * Specific temperaments + equal1, just1, meantone, pythagor, + werckmeister, young1, young2, young3, + + -- ** In cents + equalCents1, justCents1, meantoneCents, pythagorCents, + werckmeisterCents, youngCents1, youngCents2, youngCents3, + + -- * List of temperaments + TempList(..), tempList, fromTempList, fromTempListD, + + -- * Utility functions + cent2ratio, ratio2cent +) where + +import Data.Default + +import Csound.Types +import Csound.Tab +import Csound.Typed.Opcode + +-- | Creates a temperament. Arguments are +-- +-- > genTemp interval baseHz baseMidiPitch cents +-- +-- For example: +-- +-- > genTemp 2 261.63 60 [0, 100, 200 .. more cents .. , 1200] +-- +-- Cent list should include the first note from the next octave(interval of temperament repetition). +genTemp :: Double -> Double -> Double -> [Double] -> Temp +genTemp tempInterval tempBase tempKey tempCents = genTempRatio tempInterval tempBase tempKey (fmap cent2ratio tempCents) + +-- | Creates a temperament. Arguments are +-- +-- > genTempCent interval baseHz baseMidiPitch ratios +-- +-- For example: +-- +-- > genTempRatio 2 261.63 60 [1, .. more ratios .. , 2] +-- +-- Cent list should include the first note from the next octave(interval of temperament repetition). +genTempRatio :: Double -> Double -> Double -> [Double] -> Temp +genTempRatio tempInterval tempBase tempKey tempRatios = Temp $ doubles vals + where vals = [fromIntegral $ (length tempRatios) - 1, tempInterval, tempBase, tempKey] ++ tempRatios + +-- | Temperament with base note at note C (261.63 Hz) and an octave as interval (2). +-- The argument is the list of ratios. +tempRatioC :: [Double] -> Temp +tempRatioC = genTempRatio 2 261.63 60 + +-- | Temperament with base note at note C (261.63 Hz) and an octave as interval (2). +-- The argument is the list of cents. +tempC :: [Double] -> Temp +tempC = genTemp 2 261.63 60 + +-- | Temperament with 9th note tuned to 440 Hz (Concert A). +-- The argument is the list of ratios. +stdTempRatio :: [Double] -> Temp +stdTempRatio = ratioConcertA 440 + +-- | Temperament with 9th note tuned to 440 Hz (Concert A). +-- The argument is the list of cents. +stdTemp :: [Double] -> Temp +stdTemp = concertA 440 + +-- | Baroque Temperament with 9th note tuned to 415 Hz (Concert A). +-- The argument is the list of ratios. +barTempRatio :: [Double] -> Temp +barTempRatio = ratioConcertA 415 + +-- | Baroque Temperament with 9th note tuned to 415 Hz (Concert A). +-- The argument is the list of cents. +barTemp :: [Double] -> Temp +barTemp = concertA 415 + +-- | Temperament with 9th note tuned to 440 Hz (Concert A). +-- The argument is the list of ratios. +ratioConcertA :: Double -> [Double] -> Temp +ratioConcertA hz ratios = genTempRatio 2 (hz / (ratios !! 9)) 60 ratios + +-- | Temperament with 9th note tuned to 440 Hz (Concert A). +-- The argument is the list of cents. +concertA :: Double -> [Double] -> Temp +concertA hz cents = ratioConcertA hz (fmap cent2ratio cents) + + +-- | Data structure for musical temperament. +-- The value can be created with constructors @genTemp@ and @genTempCent@. +-- It can be passed as an argument to the instrument (it can be a part of the note). +newtype Temp = Temp { unTemp :: Tab } + +instance Default Temp where + def = equal1 + +-- | List of temperaments (or more precisely f-table of temperaments). +-- It can be passed as an argument to the instrument (it can be a part of the note). +newtype TempList = TempList { unTempList :: TabList } + +instance Tuple Temp where + tupleMethods = makeTupleMethods Temp unTemp + +instance Arg Temp where + +instance Tuple TempList where + tupleMethods = makeTupleMethods TempList unTempList + +instance Arg TempList where + +-- | Creates a list of temperaments. +tempList :: [Temp] -> TempList +tempList xs = TempList $ tabList $ fmap unTemp xs + +-- | Selects one of the temperaments by index. +fromTempList :: TempList -> Sig -> Temp +fromTempList (TempList tab) asig = Temp $ fromTabList tab asig + +-- | Selects one of the temperaments by index. Works at the time of instrument initialization (remains constant). +fromTempListD :: TempList -> D -> Temp +fromTempListD (TempList tab) a = Temp $ fromTabListD tab a + +-- | Converts cents to ratios. +cent2ratio :: Floating a => a -> a +cent2ratio x = 2 ** (x / 1200) + +-- | Converts ratios to cents. +ratio2cent :: Floating a => a -> a +ratio2cent x = 1200 * logBase 2 x + +equalCents1 = fmap (* 100) [0 .. 12] +justCents1 = fmap ratio2cent [1/1, 16/15, 9/8, 6/5, 5/4, 4/3, 45/32, 3/2, 8/5, 5/3, 9/5, 15/8, 2/1] +meantoneCents = [0, 76.0, 193.2, 310.3, 386.3, 503.4, 579.5, 696.8, 772.6, 889.7, 1006.8, 1082.9, 1200] +pythagorCents = [0, 113.7, 203.9, 294.1, 407.8, 498, 611.7, 702, 792.2, 905.9, 996.1, 1109.8, 1200] +werckmeisterCents = [0, 90.225, 192.18, 294.135, 390.225, 498.045, 588.27, 696.09, 792.18, 888.27, 996.09, 1092.18, 1200] + +youngCents1 = [0, 93.9, 195.8, 297.8, 391.7, 499.9, 591.9, 697.9, 795.8, 893.8, 999.8, 1091.8, 1200] +youngCents2 = zipWith (+) equalCents1 [0, 0.1, 2.1, 4, -2.1, 6.1, -1.8, 4.2, 2.1, 0, 6, -2, 0] +youngCents3 = zipWith (+) equalCents1 [0, -3.9, 2, 0, -2, 3.9, -5.9, 3.9, -2, 0, 2, -3.9, 0] + +toTemp = tempC + +-- | Equal temperament +equal1 :: Temp +equal1 = toTemp equalCents1 + +-- | Just intonation +just1 :: Temp +just1 = toTemp justCents1 + +-- | Meantone temperament +meantone :: Temp +meantone = toTemp meantoneCents + +-- | Pythagorean tuning +pythagor :: Temp +pythagor = toTemp pythagorCents + +-- | Werckmeister III temperament. Probably it was temperament of the Bach musical era. +werckmeister :: Temp +werckmeister = toTemp werckmeisterCents + +-- | Tomas Young temperament +young1 :: Temp +young1 = toTemp youngCents1 + +-- | Tomas Young temperament 1 (aligned with ET by C and A) +young2 :: Temp +young2 = toTemp youngCents2 + +-- | Tomas Young temperament 2 (aligned with ET by C and A) +young3 :: Temp +young3 = toTemp youngCents3 diff --git a/src/Csound/Types.hs b/src/Csound/Types.hs --- a/src/Csound/Types.hs +++ b/src/Csound/Types.hs @@ -42,7 +42,7 @@ quot', rem', div', mod', ceil', floor', round', int', frac', -- ** Logic functions - boolSig, when1, whens, whileDo, untilDo, + boolSig, when1, whens, whenD1, whenDs, whileDo, untilDo, whileDoD, untilDoD, equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals, -- ** Aliases