summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAntonKholomiov <>2016-11-30 23:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-11-30 23:32:00 (GMT)
commit758f76314f0c34ed2630ddef162476285eef86ca (patch)
treee92e854625c2c22eee65c5b54ad5266a8d4c8e07
parent9f36d9fb4284a5e7992d05fffa2fdd6f68bf64af (diff)
version 0.1.0.00.1.0.0
-rw-r--r--csound-expression-typed.cabal28
-rw-r--r--data/opcodes/adsr140.udo111
-rw-r--r--data/opcodes/audaciouseq.udo81
-rw-r--r--data/opcodes/diode.udo342
-rw-r--r--data/opcodes/korg35.udo385
-rw-r--r--data/opcodes/solina_chorus.udo56
-rw-r--r--data/opcodes/tdf2.udo166
-rw-r--r--data/opcodes/zdf.udo540
-rw-r--r--data/opcodes/zero-delay-convolution.udo31
-rw-r--r--src/Csound/Typed/Control/Api.hs6
-rw-r--r--src/Csound/Typed/Control/Vco.hs430
-rw-r--r--src/Csound/Typed/GlobalState.hs2
-rw-r--r--src/Csound/Typed/GlobalState/Elements.hs132
-rw-r--r--src/Csound/Typed/GlobalState/GE.hs25
-rw-r--r--src/Csound/Typed/GlobalState/Opcodes.hs17
-rw-r--r--src/Csound/Typed/GlobalState/Options.hs3
-rw-r--r--src/Csound/Typed/Gui.hs1
-rw-r--r--src/Csound/Typed/Gui/Cab.hs25
-rw-r--r--src/Csound/Typed/Gui/Cabbage/Cabbage.hs256
-rw-r--r--src/Csound/Typed/Gui/Cabbage/CabbageLang.hs38
-rw-r--r--src/Csound/Typed/Gui/Widget.hs2
-rw-r--r--src/Csound/Typed/Lib/StableMaps/Dynamic.hs77
-rw-r--r--src/Csound/Typed/Lib/StableMaps/Dynamic/Map.hs88
-rw-r--r--src/Csound/Typed/Plugins.hs39
-rw-r--r--src/Csound/Typed/Plugins/Adsr140.hs25
-rw-r--r--src/Csound/Typed/Plugins/Audaciouseq.hs33
-rw-r--r--src/Csound/Typed/Plugins/Diode.hs75
-rw-r--r--src/Csound/Typed/Plugins/Korg35.hs99
-rw-r--r--src/Csound/Typed/Plugins/SolinaChorus.hs60
-rw-r--r--src/Csound/Typed/Plugins/Zdf.hs209
-rw-r--r--src/Csound/Typed/Plugins/ZeroDelayConvolution.hs52
-rw-r--r--src/Csound/Typed/Render.hs14
-rw-r--r--src/Csound/Typed/Types/Prim.hs4
-rw-r--r--src/Csound/Typed/Types/Tuple.hs49
34 files changed, 3279 insertions, 222 deletions
diff --git a/csound-expression-typed.cabal b/csound-expression-typed.cabal
index e9ff3c1..dc434b2 100644
--- a/csound-expression-typed.cabal
+++ b/csound-expression-typed.cabal
@@ -1,5 +1,5 @@
Name: csound-expression-typed
-Version: 0.0.9.3
+Version: 0.1.0.0
Cabal-Version: >= 1.22
License: BSD3
License-file: LICENSE
@@ -26,6 +26,15 @@ Data-Files :
data/opcodes/tabQueue.udo
data/opcodes/tabQueue2.udo
+ data/opcodes/zdf.udo
+ data/opcodes/solina_chorus.udo
+ data/opcodes/adsr140.udo
+ data/opcodes/audaciouseq.udo
+ data/opcodes/tdf2.udo
+ data/opcodes/diode.udo
+ data/opcodes/korg35.udo
+ data/opcodes/zero-delay-convolution.udo
+
Homepage: https://github.com/anton-k/csound-expression-typed
Bug-Reports: https://github.com/anton-k/csound-expression-typed/issues
@@ -39,7 +48,7 @@ Library
Ghc-Options: -Wall
Build-Depends:
base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq,
- wl-pprint, csound-expression-dynamic >= 0.1.6, temporal-media >= 0.6.0, hashable
+ wl-pprint, csound-expression-dynamic >= 0.2.0, temporal-media >= 0.6.0, hashable
Hs-Source-Dirs: src/
Exposed-Modules:
Csound.Typed
@@ -49,12 +58,15 @@ Library
Csound.Typed.Render
Csound.Typed.Gui
+ Csound.Typed.Gui.Cab
Csound.Typed.Types.Prim
Csound.Typed.Types.Evt
Csound.Typed.Types.Tuple
Csound.Typed.Types.Lift
+ Csound.Typed.Plugins
+
Other-Modules:
Csound.Typed.GlobalState
Csound.Typed.GlobalState.Options
@@ -82,14 +94,20 @@ Library
Csound.Typed.Gui.Gui
Csound.Typed.Gui.Widget
Csound.Typed.Gui.BoxModel
+ Csound.Typed.Gui.Cabbage.CabbageLang
+ Csound.Typed.Gui.Cabbage.Cabbage
Csound.Typed.Constants
Csound.Typed.Misc
- Csound.Typed.Lib.StableMaps.Dynamic
- Csound.Typed.Lib.StableMaps.Dynamic.Map
-
Csound.Typed.Plugins.TabQueue
+ Csound.Typed.Plugins.Zdf
+ Csound.Typed.Plugins.Diode
+ Csound.Typed.Plugins.Korg35
+ Csound.Typed.Plugins.Adsr140
+ Csound.Typed.Plugins.Audaciouseq
+ Csound.Typed.Plugins.SolinaChorus
+ Csound.Typed.Plugins.ZeroDelayConvolution
Paths_csound_expression_typed
diff --git a/data/opcodes/adsr140.udo b/data/opcodes/adsr140.udo
new file mode 100644
index 0000000..162ad11
--- /dev/null
+++ b/data/opcodes/adsr140.udo
@@ -0,0 +1,111 @@
+; Gated, Retriggerable Envelope Generator UDO (adsr140)
+; Based on design of Doepfer A-140 Envelope Generator Module
+; Code based on ADSR code by Nigel Redmon
+; (http://www.earlevel.com/main/2013/06/03/envelope-generators-adsr-code/)
+; Example by Steven Yi (2015.02.08)
+
+opcode adsr140_calc_coef, k, kk
+
+ knum_samps, kratio xin
+ xout exp( -log((1.0 + kratio) / kratio) / knum_samps)
+
+endop
+
+/* Gated, Re-triggerable ADSR modeled after the Doepfer A-140 */
+opcode adsr140, a, aakkkk
+
+agate, aretrig, kattack, kdecay, ksustain, krelease xin
+
+kstate init 0 ; 0 = attack, 1 = decay, 2 = sustain
+klasttrig init -1
+kval init 0.0
+asig init 0
+kindx = 0
+
+kattack_base init 0
+kdecay_base init 0
+krelease_base init 0
+
+kattack_samps init 0
+kdecay_samps init 0
+krelease_samps init 0
+
+kattack_coef init 0
+kdecay_coef init 0
+ksustain_coef init 0
+
+klast_attack init -1
+klast_decay init -1
+klast_release init -1
+
+if (klast_attack != kattack) then
+ klast_attack = kattack
+ kattack_samps = kattack * sr
+ kattack_coef = adsr140_calc_coef(kattack_samps, 0.3)
+ kattack_base = (1.0 + 0.3) * (1 - kattack_coef)
+endif
+
+if (klast_decay != kdecay) then
+ klast_decay = kdecay
+ kdecay_samps = kdecay * sr
+ kdecay_coef = adsr140_calc_coef(kdecay_samps, 0.0001)
+ kdecay_base = (ksustain - 0.0001) * (1.0 - kdecay_coef)
+endif
+
+if (klast_release != krelease) then
+ klast_release = krelease
+ krelease_samps = krelease * sr
+ krelease_coef = adsr140_calc_coef(krelease_samps, 0.0001)
+ krelease_base = -0.0001 * (1.0 - krelease_coef)
+endif
+
+
+while (kindx < ksmps) do
+ if (agate[kindx] > 0) then
+ kretrig = aretrig[kindx]
+ if (kretrig > 0 && klasttrig <= 0) then
+ kstate = 0
+ endif
+ klasttrig = kretrig
+
+ if (kstate == 0) then
+ kval = kattack_base + (kval * kattack_coef)
+ if(kval >= 1.0) then
+ kval = 1.0
+ kstate = 1
+ endif
+ asig[kindx] = kval
+
+ elseif (kstate == 1) then
+ kval = kdecay_base + (kval * kdecay_coef)
+ if(kval <= ksustain) then
+ kval = ksustain
+ kstate = 2
+ endif
+ asig[kindx] = kval
+
+ else
+ asig[kindx] = ksustain
+ endif
+
+ else ; in a release state
+ kstate = 0
+ if (kval == 0.0) then
+ asig[kindx] = 0
+ else
+ ; releasing
+ kval = krelease_base + (kval * krelease_coef)
+ if(kval <= 0.0) then
+ kval = 0.0
+ endif
+ asig[kindx] = kval
+ endif
+
+ endif
+
+ kindx += 1
+od
+
+xout asig
+
+endop
diff --git a/data/opcodes/audaciouseq.udo b/data/opcodes/audaciouseq.udo
new file mode 100644
index 0000000..350a905
--- /dev/null
+++ b/data/opcodes/audaciouseq.udo
@@ -0,0 +1,81 @@
+/* audaciouseq - multi-band equalizer
+
+ A Csound UDO implementation of Audacious' EQ:
+
+ https://github.com/audacious-media-player/audacious/blob/master/src/libaudcore/equalizer.cc
+
+*/
+
+
+/* Q value for band-pass filters 1.2247 = (3/2)^(1/2)
+ * Gives 4 dB suppression at Fc*2 and Fc/2 */
+
+#define Q # 1.2247449 #
+
+/* single-sample, 2nd order IIR filter */
+opcode audacious_bp2, k, kik
+kin, ifC, kgain xin
+
+;; Calc Coefficients
+ith = 2 * $M_PI * (ifC / sr)
+iC = (1 - tan(ith * $Q / 2)) / (1 + tan(ith * $Q / 2))
+
+ia0 = (1 + iC) * cos(ith)
+ia1 = -iC
+ib0 = (1 - iC) / 2
+ib1 = -1.005
+
+kout init 0
+kwq0 init 0
+kwq1 init 0
+
+kG = pow(10, kgain / 20) - 1
+
+;; Filter Code
+kyt = kin
+kw = kyt * ib0 + kwq0 * ia0 + kwq1 * ia1
+kyt += (kw + kwq1 * ib1) * kG
+
+;; Memory
+kwq1 = kwq0
+kwq0 = kw
+
+xout kyt
+endop
+
+/* 10-band EQ
+ Input: asig, kgain1, kgain2, ...
+ Output: aout
+
+ 10 kgain arguments maps to each band
+ Bands are: 31.25, 52.6, 125, 500, 1000,
+ 2000, 4000, 8000, 16000
+*/
+opcode audaciouseq, a, akkkkkkkkkk
+
+ain, kgain1, kgain2, kgain3, kgain4, kgain5,
+ kgain6, kgain7, kgain8, kgain9, kgain10 xin
+
+aout = 0
+kndx = 0
+
+while (kndx < ksmps) do
+ ksamp audacious_bp2 ain[kndx], 31.25, kgain1
+ ksamp audacious_bp2 ksamp, 62.5, kgain2
+ ksamp audacious_bp2 ksamp, 125, kgain3
+ ksamp audacious_bp2 ksamp, 250, kgain4
+ ksamp audacious_bp2 ksamp, 500, kgain5
+ ksamp audacious_bp2 ksamp, 1000, kgain6
+ ksamp audacious_bp2 ksamp, 2000, kgain7
+ ksamp audacious_bp2 ksamp, 4000, kgain8
+ ksamp audacious_bp2 ksamp, 8000, kgain9
+ aout[kndx] audacious_bp2 ksamp, 16000, kgain10
+
+ kndx += 1
+od
+
+xout aout
+
+endop
+
+
diff --git a/data/opcodes/diode.udo b/data/opcodes/diode.udo
new file mode 100644
index 0000000..cc62a6c
--- /dev/null
+++ b/data/opcodes/diode.udo
@@ -0,0 +1,342 @@
+;; Diode Ladder Filter
+;;
+;; Based on code by Will Pirkle, presented in:
+;;
+;; http://www.willpirkle.com/Downloads/AN-6DiodeLadderFilter.pdf
+;;
+;; and in his book "Designing software synthesizer plug-ins in C++ : for
+;; RackAFX, VST3, and Audio Units"
+;;
+;; UDO version by Steven Yi (2016.xx.xx)
+
+;; ARGS
+;; ain - signal to filter
+;; acf/kcf - cutoff frequency
+;; ak/kk - k-value that controls resonance, self-resonance occurs at k=17;
+;; knlp - use non-linear processing:
+;; 0 - none
+;; 1 - normalized (outputs to range +-1.0)
+;; 2 - non-normalized (less expensive than normalized, range +-0.8)
+;; ksaturation - saturation amount for non-linear processing
+;; (default: 1.0, greater values lead to higher saturation)
+
+
+opcode diode_ladder, a, aKKKK
+
+ ain, kcf, kk, knlp, ksaturation xin
+
+ ;; initialization
+ aout init 0
+
+ ka1 init 1.0
+ ka2 init 0.5
+ ka3 init 0.5
+ ka4 init 0.5
+
+ ;; state for each 1-pole's integrator
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kz4 init 0
+
+ ;; coefficients
+ kG1 init 0
+ kG2 init 0
+ kG3 init 0
+ kG4 init 0
+
+ kbeta1 init 0
+ kbeta2 init 0
+ kbeta3 init 0
+ kbeta4 init 0
+
+ kdelta1 init 0
+ kdelta2 init 0
+ kdelta3 init 0
+
+ kepsilon1 init 0
+ kepsilon2 init 0
+ kepsilon3 init 0
+
+ kSG1 init 0
+ kSG2 init 0
+ kSG3 init 0
+ kSG4 init 0
+
+ kSIGMA init 0
+ kGAMMA init 0
+
+ klastcut init -1
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ kG4 = 0.5 * kg / (1.0 + kg)
+ kG3 = 0.5 * kg / (1.0 + kg - 0.5 * kg * kG4)
+ kG2 = 0.5 * kg / (1.0 + kg - 0.5 * kg * kG3)
+ kG1 = kg / (1.0 + kg - kg * kG2)
+
+ kGAMMA = kG4 * kG3 * kG2 * kG1
+
+ kSG1 = kG4 * kG3 * kG2
+ kSG2 = kG4 * kG3
+ kSG3 = kG4
+ kSG4 = 1.0
+
+ kalpha = kg / (1.0 + kg)
+
+ kbeta1 = 1.0 / (1.0 + kg - kg * kG2)
+ kbeta2 = 1.0 / (1.0 + kg - 0.5 * kg * kG3)
+ kbeta3 = 1.0 / (1.0 + kg - 0.5 * kg * kG4)
+ kbeta4 = 1.0 / (1.0 + kg)
+
+ kgamma1 = 1.0 + kG1 * kG2
+ kgamma2 = 1.0 + kG2 * kG3
+ kgamma3 = 1.0 + kG3 * kG4
+
+ kdelta1 = kg
+ kdelta2 = 0.5 * kg
+ kdelta3 = 0.5 * kg
+
+ kepsilon1 = kG2
+ kepsilon2 = kG3
+ kepsilon3 = kG4
+
+ endif
+
+ klastcut = kcf
+
+ kindx = 0
+
+ while kindx < ksmps do
+
+ kin = ain[kindx]
+
+ ;; feedback inputs
+ kfb4 = kbeta4 * kz4
+ kfb3 = kbeta3 * (kz3 + kfb4 * kdelta3)
+ kfb2 = kbeta2 * (kz2 + kfb3 * kdelta2)
+
+ ;; feedback process
+
+ kfbo1 = (kbeta1 * (kz1 + kfb2 * kdelta1))
+ kfbo2 = (kbeta2 * (kz2 + kfb3 * kdelta2))
+ kfbo3 = (kbeta3 * (kz3 + kfb4 * kdelta3))
+ kfbo4 = kfb4
+
+ kSIGMA = kSG1 * kfbo1 +
+ kSG2 * kfbo2 +
+ kSG3 * kfbo3 +
+ kSG4 * kfbo4
+
+ ;; non-linear processing
+ if (knlp == 1) then
+ kin = (1.0 / tanh(ksaturation)) * tanh(ksaturation * kin)
+ elseif (knlp == 2) then
+ kin = tanh(ksaturation * kin)
+ endif
+
+ ;; form input to loop
+ kun = (kin - kk * kSIGMA) / (1.0 + kk * kGAMMA)
+
+ ;; 1st stage
+ kxin = (kun * kgamma1 + kfb2 + kepsilon1 * kfbo1)
+ kv = (ka1 * kxin - kz1) * kalpha
+ klp = kv + kz1
+ kz1 = klp + kv
+
+ ;; 2nd stage
+ kxin = (klp * kgamma2 + kfb3 + kepsilon2 * kfbo2)
+ kv = (ka2 * kxin - kz2) * kalpha
+ klp = kv + kz2
+ kz2 = klp + kv
+
+ ;; 3rd stage
+ kxin = (klp * kgamma3 + kfb4 + kepsilon3 * kfbo3)
+ kv = (ka3 * kxin - kz3) * kalpha
+ klp = kv + kz3
+ kz3 = klp + kv
+
+ ;; 4th stage
+ kv = (ka4 * klp - kz4) * kalpha
+ klp = kv + kz4
+ kz4 = klp + kv
+
+ aout[kindx] = klp
+
+ kindx += 1
+ od
+
+ xout aout
+
+endop
+
+
+opcode diode_ladder, a, aaaKK
+
+ ain, acf, ak, knlp, ksaturation xin
+
+ ;; initialization
+ aout init 0
+
+ ka1 init 1.0
+ ka2 init 0.5
+ ka3 init 0.5
+ ka4 init 0.5
+
+ ;; state for each 1-pole's integrator
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kz4 init 0
+
+ ;; coefficients
+ kG1 init 0
+ kG2 init 0
+ kG3 init 0
+ kG4 init 0
+
+ kbeta1 init 0
+ kbeta2 init 0
+ kbeta3 init 0
+ kbeta4 init 0
+
+ kdelta1 init 0
+ kdelta2 init 0
+ kdelta3 init 0
+
+ kepsilon1 init 0
+ kepsilon2 init 0
+ kepsilon3 init 0
+
+ kSG1 init 0
+ kSG2 init 0
+ kSG3 init 0
+ kSG4 init 0
+
+ kSIGMA init 0
+ kGAMMA init 0
+
+ klastcut init 0
+
+ kindx = 0
+
+ while kindx < ksmps do
+
+ kin = ain[kindx]
+ kcf = acf[kindx]
+ kk = ak[kindx]
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ kG4 = 0.5 * kg / (1.0 + kg)
+ kG3 = 0.5 * kg / (1.0 + kg - 0.5 * kg * kG4)
+ kG2 = 0.5 * kg / (1.0 + kg - 0.5 * kg * kG3)
+ kG1 = kg / (1.0 + kg - kg * kG2)
+
+ kGAMMA = kG4 * kG3 * kG2 * kG1
+
+ kSG1 = kG4 * kG3 * kG2
+ kSG2 = kG4 * kG3
+ kSG3 = kG4
+ kSG4 = 1.0
+
+ kalpha = kg / (1.0 + kg)
+
+ kbeta1 = 1.0 / (1.0 + kg - kg * kG2)
+ kbeta2 = 1.0 / (1.0 + kg - 0.5 * kg * kG3)
+ kbeta3 = 1.0 / (1.0 + kg - 0.5 * kg * kG4)
+ kbeta4 = 1.0 / (1.0 + kg)
+
+ kgamma1 = 1.0 + kG1 * kG2
+ kgamma2 = 1.0 + kG2 * kG3
+ kgamma3 = 1.0 + kG3 * kG4
+
+ kdelta1 = kg
+ kdelta2 = 0.5 * kg
+ kdelta3 = 0.5 * kg
+
+ kepsilon1 = kG2
+ kepsilon2 = kG3
+ kepsilon3 = kG4
+
+ endif
+
+ klastcut = kcf
+
+ ;; feedback inputs
+ kfb4 = kbeta4 * kz4
+ kfb3 = kbeta3 * (kz3 + kfb4 * kdelta3)
+ kfb2 = kbeta2 * (kz2 + kfb3 * kdelta2)
+
+ ;; feedback process
+
+ kfbo1 = (kbeta1 * (kz1 + kfb2 * kdelta1))
+ kfbo2 = (kbeta2 * (kz2 + kfb3 * kdelta2))
+ kfbo3 = (kbeta3 * (kz3 + kfb4 * kdelta3))
+ kfbo4 = kfb4
+
+ kSIGMA = kSG1 * kfbo1 +
+ kSG2 * kfbo2 +
+ kSG3 * kfbo3 +
+ kSG4 * kfb4
+
+ ;; non-linear processing
+ if (knlp == 1) then
+ kin = (1.0 / tanh(ksaturation)) * tanh(ksaturation * kin)
+ elseif (knlp == 2) then
+ kin = tanh(ksaturation * kin)
+ endif
+
+ ;; form input to loop
+ kun = (kin - kk * kSIGMA) / (1.0 + kk * kGAMMA)
+
+ ;; 1st stage
+ kxin = (kun * kgamma1 + kfb2 + kepsilon1 * kfbo1)
+ kv = (ka1 * kxin - kz1) * kalpha
+ klp = kv + kz1
+ kz1 = klp + kv
+
+ ;; 2nd stage
+ kxin = (klp * kgamma2 + kfb3 + kepsilon2 * kfbo2)
+ kv = (ka2 * kxin - kz2) * kalpha
+ klp = kv + kz2
+ kz2 = klp + kv
+
+ ;; 3rd stage
+ kxin = (klp * kgamma3 + kfb4 + kepsilon3 * kfbo3)
+ kv = (ka3 * kxin - kz3) * kalpha
+ klp = kv + kz3
+ kz3 = klp + kv
+
+ ;; 4th stage
+ kv = (ka4 * klp - kz4) * kalpha
+ klp = kv + kz4
+ kz4 = klp + kv
+
+ aout[kindx] = klp
+
+ kindx += 1
+ od
+
+ xout aout
+
+endop
+
+opcode diode_ladder, a, aaKKK
+
+ ain, acf, kk, knlp, ksaturation xin
+ ares diode_ladder ain, acf, a(kk), knlp, ksaturation
+
+ xout ares
+endop
+
diff --git a/data/opcodes/korg35.udo b/data/opcodes/korg35.udo
new file mode 100644
index 0000000..3e125be
--- /dev/null
+++ b/data/opcodes/korg35.udo
@@ -0,0 +1,385 @@
+;; 12db/oct low-pass filter based on Korg 35 module
+;; (found in MS-10 and MS-20).
+;;
+;; Based on code by Will Pirkle, presented in:
+;;
+;; http://www.willpirkle.com/Downloads/AN-5Korg35_V3.pdf
+;;
+;; [ARGS]
+;;
+;; ain - audio input
+;; acutoff - frequency of cutoff
+;; kQ - filter Q [1, 10.0] (k35-lpf will clamp to boundaries)
+;; knonlinear - use non-linear processing
+;; ksaturation - saturation for tanh distortion
+opcode k35_lpf, a, aKKKK
+
+ ain, kcutoff, kQ, knonlinear, ksaturation xin
+
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kv1 init 0
+ kv2 init 0
+ kv3 init 0
+ aout init 0
+
+ kg init 0
+ kG init 0
+ kK init 0
+ klastcut init -1
+ klastQ init -1
+ kS35 init 0
+ kalpha init -1
+ klpf2_beta init -1
+ khpf1_beta init -1
+
+ kindx = 0
+ kQ = limit(kQ, 1.0, 10.0)
+ kcf = kcutoff
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+ kG = kg / (1 + kg)
+
+ endif
+
+ if (klastQ != kQ) then
+ kK = 0.01 + ((2.0 - 0.01) * (kQ / 10.0))
+ endif
+
+ if ((klastcut != kcf) || (klastQ != kQ)) then
+ klpf2_beta = (kK - (kK * kG)) / (1.0 + kg)
+ khpf1_beta = -1.0 / (1.0 + kg)
+ kalpha = 1.0 / (1.0 - (kK * kG) + (kK * kG * kG))
+ endif
+
+ klastcut = kcf
+ klastQ = kQ
+
+ while (kindx < ksmps) do
+ ksig = ain[kindx]
+
+ ;; lpf1
+ kv1 = (ksig - kz1) * kG
+ klp1 = kv1 + kz1
+ kz1 = klp1 + kv1
+
+ ku = kalpha * (klp1 + kS35)
+
+ if (knonlinear == 1) then
+ ku = tanh(ku * ksaturation)
+ endif
+
+ ;; lpf2
+ kv2 = (ku - kz2) * kG
+ klp2 = kv2 + kz2
+ kz2 = klp2 + kv2
+ ky = kK * klp2
+
+ ;; hpf1
+ kv3 = (ky - kz3) * kG
+ klp3 = kv3 + kz3
+ kz3 = klp3 + kv3
+ khp1 = ky - klp3
+
+ kS35 = (klpf2_beta * kz2) + (khpf1_beta * kz3)
+
+ kout = (kK > 0) ? (ky / kK) : ky
+
+ aout[kindx] = kout
+
+ kindx += 1
+ od
+
+ xout aout
+
+endop
+
+
+
+opcode k35_lpf, a, aaKKK
+
+ ain, acutoff, kQ, knonlinear, ksaturation xin
+
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kv1 init 0
+ kv2 init 0
+ kv3 init 0
+ aout init 0
+
+ kg init 0
+ kG init 0
+ kK init 0
+ klastcut init -1
+ klastQ init -1
+ kS35 init 0
+ kalpha init -1
+ klpf2_beta init -1
+ khpf1_beta init -1
+
+ kindx = 0
+ kQ = limit(kQ, 1.0, 10.0)
+
+ if (klastQ != kQ) then
+ kK = 0.01 + ((2.0 - 0.01) * (kQ / 10.0))
+ endif
+
+ klastQ = kQ
+
+ while (kindx < ksmps) do
+ kcf = acutoff[kindx]
+ ksig = ain[kindx]
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+ kG = kg / (1 + kg)
+
+ endif
+
+ if ((klastcut != kcf) || (klastQ != kQ)) then
+ klpf2_beta = (kK - (kK * kG)) / (1.0 + kg)
+ khpf1_beta = -1.0 / (1.0 + kg)
+ kalpha = 1.0 / (1.0 - (kK * kG) + (kK * kG * kG))
+ endif
+
+ ;; lpf1
+ kv1 = (ksig - kz1) * kG
+ klp1 = kv1 + kz1
+ kz1 = klp1 + kv1
+
+ ku = kalpha * (klp1 + kS35)
+
+ if (knonlinear == 1) then
+ ku = tanh(ku * ksaturation)
+ endif
+
+ ;; lpf2
+ kv2 = (ku - kz2) * kG
+ klp2 = kv2 + kz2
+ kz2 = klp2 + kv2
+ ky = kK * klp2
+
+ ;; hpf1
+ kv3 = (ky - kz3) * kG
+ klp3 = kv3 + kz3
+ kz3 = klp3 + kv3
+ khp1 = ky - klp3
+
+ kS35 = (klpf2_beta * kz2) + (khpf1_beta * kz3)
+
+ kout = (kK > 0) ? (ky / kK) : ky
+
+ aout[kindx] = kout
+
+ klastcut = kcf
+ kindx += 1
+ od
+
+ xout aout
+
+endop
+
+;; 6db/oct high-pass filter based on Korg 35 module
+;; (found in MS-10 and MS-20).
+;;
+;; Based on code by Will Pirkle, presented in:
+;;
+;; http://www.willpirkle.com/Downloads/AN-7Korg35HPF_V2.pdf
+;;
+;; [ARGS]
+;;
+;; ain - audio input
+;; acutoff - frequency of cutoff
+;; kQ - filter Q [1, 10.0] (k35_hpf will clamp to boundaries)
+;; knonlinear - use non-linear processing
+;; ksaturation - saturation for tanh distortion
+
+opcode k35_hpf, a, aKKKK
+
+ ain, kcutoff, kQ, knonlinear, ksaturation xin
+
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kv1 init 0
+ kv2 init 0
+ kv3 init 0
+ aout init 0
+
+ kg init 0
+ kG init 0
+ kK init 0
+ klastcut init -1
+ klastQ init -1
+ kS35 init 0
+ kalpha init -1
+ khpf2_beta init -1
+ klpf1_beta init -1
+
+ kindx = 0
+ kQ = limit(kQ, 1.0, 10.0)
+ kcf = kcutoff
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+ kG = kg / (1 + kg)
+
+ endif
+
+ if (klastQ != kQ) then
+ kK = 0.01 + ((2.0 - 0.01) * (kQ / 10.0))
+ endif
+
+ if ((klastcut != kcf) || (klastQ != kQ)) then
+ khpf2_beta = -kG / (1.0 + kg)
+ klpf1_beta = 1.0 / (1.0 + kg)
+ kalpha = 1.0 / (1.0 - (kK * kG) + (kK * kG * kG))
+ endif
+
+ klastcut = kcf
+ klastQ = kQ
+
+ while (kindx < ksmps) do
+ ksig = ain[kindx]
+
+ ;; hpf1
+ kv1 = (ksig - kz1) * kG
+ klp1 = kv1 + kz1
+ kz1 = klp1 + kv1
+ ky1 = ksig - klp1
+
+ ku = kalpha * (ky1 + kS35)
+ ky = kK * ku
+
+ if (knonlinear == 1) then
+ ky = tanh(ky * ksaturation)
+ endif
+
+ ;; hpf2
+ kv2 = (ky - kz2) * kG
+ klp2 = kv2 + kz2
+ kz2 = klp2 + kv2
+ khp2 = ky - klp2
+
+ ;; lpf1
+ kv3 = (khp2 - kz3) * kG
+ klp3 = kv3 + kz3
+ kz3 = klp3 + kv3
+
+ kS35 = (khpf2_beta * kz2) + (klpf1_beta * kz3)
+
+ kout = (kK > 0) ? (ky / kK) : ky
+
+ aout[kindx] = kout
+
+ kindx += 1
+ od
+
+ xout aout
+
+endop
+
+
+opcode k35_hpf, a, aaKKK
+
+ ain, acutoff, kQ, knonlinear, ksaturation xin
+
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kv1 init 0
+ kv2 init 0
+ kv3 init 0
+ aout init 0
+
+ kg init 0
+ kG init 0
+ kK init 0
+ klastcut init -1
+ klastQ init -1
+ kS35 init 0
+ kalpha init -1
+ khpf2_beta init -1
+ klpf1_beta init -1
+
+ kindx = 0
+ kQ = limit(kQ, 1.0, 10.0)
+
+ if (klastQ != kQ) then
+ kK = 0.01 + ((2.0 - 0.01) * (kQ / 10.0))
+ endif
+
+ klastQ = kQ
+
+ while (kindx < ksmps) do
+ kcf = acutoff[kindx]
+ ksig = ain[kindx]
+
+ if (klastcut != kcf) then
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+ kG = kg / (1 + kg)
+
+ endif
+
+ if ((klastcut != kcf) || (klastQ != kQ)) then
+ khpf2_beta = -kG / (1.0 + kg)
+ klpf1_beta = 1.0 / (1.0 + kg)
+ kalpha = 1.0 / (1.0 - (kK * kG) + (kK * kG * kG))
+ endif
+
+ ;; hpf1
+ kv1 = (ksig - kz1) * kG
+ klp1 = kv1 + kz1
+ kz1 = klp1 + kv1
+ ky1 = ksig - klp1
+
+ ku = kalpha * (ky1 + kS35)
+ ky = kK * ku
+
+ if (knonlinear == 1) then
+ ky = tanh(ky * ksaturation)
+ endif
+
+ ;; hpf2
+ kv2 = (ky - kz2) * kG
+ klp2 = kv2 + kz2
+ kz2 = klp2 + kv2
+ khp2 = ky - klp2
+
+ ;; lpf1
+ kv3 = (khp2 - kz3) * kG
+ klp3 = kv3 + kz3
+ kz3 = klp3 + kv3
+
+ kS35 = (khpf2_beta * kz2) + (klpf1_beta * kz3)
+
+ kout = (kK > 0) ? (ky / kK) : ky
+
+ aout[kindx] = kout
+
+ klastcut = kcf
+ kindx += 1
+ od
+
+ xout aout
+
+endop
diff --git a/data/opcodes/solina_chorus.udo b/data/opcodes/solina_chorus.udo
new file mode 100644
index 0000000..da6595f
--- /dev/null
+++ b/data/opcodes/solina_chorus.udo
@@ -0,0 +1,56 @@
+/* Solina Chorus, based on Solina String Ensemble Chorus Module
+
+ based on:
+
+ J. Haible: Triple Chorus
+ http://jhaible.com/legacy/triple_chorus/triple_chorus.html
+
+ Hugo Portillo: Solina-V String Ensemble
+ http://www.native-instruments.com/en/reaktor-community/reaktor-user-library/entry/show/4525/
+
+ Parabola tabled shape borrowed from Iain McCurdy delayStereoChorus.csd:
+ http://iainmccurdy.org/CsoundRealtimeExamples/Delays/delayStereoChorus.csd
+
+ Author: Steven Yi
+ Date: 2016.05.22
+
+ */
+
+
+gi_solina_parabola ftgen 0, 0, 65537, 19, 0.5, 1, 180, 1
+
+;; 3 sine wave LFOs, 120 degrees out of phase
+opcode sol_lfo_3, aaa, KK
+ kfreq, kamp xin
+
+ aphs phasor kfreq
+
+ a0 = tablei(aphs, gi_solina_parabola, 1, 0, 1)
+ a120 = tablei(aphs, gi_solina_parabola, 1, 0.333, 1)
+ a240 = tablei(aphs, gi_solina_parabola, 1, -0.333, 1)
+
+ xout (a0 * kamp), (a120 * kamp), (a240 * kamp)
+endop
+
+opcode solina_chorus, a, aKKKK
+
+ aLeft, klfo_freq1, klfo_amp1, klfo_freq2, klfo_amp2 xin
+
+ imax = 100
+
+ ;; slow lfo
+ as1, as2, as3 sol_lfo_3 klfo_freq1, klfo_amp1
+
+ ;; fast lfo
+ af1, af2, af3 sol_lfo_3 klfo_freq2, klfo_amp2
+
+ at1 = limit(as1 + af1 + 5, 0.0, imax)
+ at2 = limit(as2 + af2 + 5, 0.0, imax)
+ at3 = limit(as3 + af3 + 5, 0.0, imax)
+
+ a1 vdelay3 aLeft, at1, imax
+ a2 vdelay3 aLeft, at2, imax
+ a3 vdelay3 aLeft, at3, imax
+
+xout (a1 + a2 + a3) / 3
+endop
diff --git a/data/opcodes/tdf2.udo b/data/opcodes/tdf2.udo
new file mode 100644
index 0000000..8f9e069
--- /dev/null
+++ b/data/opcodes/tdf2.udo
@@ -0,0 +1,166 @@
+
+
+/*
+ Transposed Direct Form II Biquad
+
+ Based on C++ code by Nigel Redmon:
+ http://www.earlevel.com/main/2012/11/26/biquad-c-source-code/
+
+
+ OUTPUT
+ aout - filtered signal
+
+ INPUT
+ asig - input signal
+ ifilter_type - filter type:
+ 0 - Low Pass
+ 1 - High Pass
+ 2 - Band Pass
+ 3 - Notch
+ 4 - Peaking
+ 5 - Low Shelf
+ 6 - High Shelf
+ acutoff - cutoff frequency
+ aQ - Q value
+ again - gain (used by peaking, low shelf, and high shelf)
+
+*/
+opcode tdf2, a, aiaaa
+
+asig, ifilter_type, acutoff, aQ, again xin
+
+/* Memory */
+kz1 init 0
+kz2 init 0
+
+klast_Fc init 0
+klast_Q init 0
+klast_gain init 0
+
+ka0 init 0
+ka1 init 0
+ka2 init 0
+kb1 init 0
+kb2 init 0
+
+aout init 0
+
+
+kndx = 0
+while (kndx < ksmps) do
+ kcut = acutoff[kndx]
+ kQ = aQ[kndx]
+ kgain = again[kndx]
+
+ if(kcut != klast_Fc || kQ != klast_Q || kgain != klast_gain) then
+
+ kK = tan($M_PI * (kcut / sr))
+ kV = pow(10, abs(kgain) / 20.0)
+ kK2 = kK * kK
+
+ if (ifilter_type == 0) then ;; LPF
+ knorm = 1 / (1 + kK / kQ + kK2)
+ ka0 = kK2 * knorm
+ ka1 = 2 * ka0
+ ka2 = ka0
+ kb1 = 2 * (kK2 - 1) * knorm
+ kb2 = (1 - kK / kQ + kK2) * knorm
+
+ elseif (ifilter_type == 1) then ;; HPF
+ knorm = 1 / (1 + kK / kQ + kK2)
+ ka0 = 1 * knorm
+ ka1 = -2 * ka0
+ ka2 = ka0
+ kb1 = 2 * (kK2 - 1) * knorm
+ kb2 = (1 - kK / kQ + kK2) * knorm
+
+ elseif (ifilter_type == 2) then ;; BPF
+ knorm = 1 / (1 + kK / kQ + kK2)
+ ka0 = kK / kQ * knorm
+ ka1 = 0
+ ka2 = -ka0
+ kb1 = 2 * (kK2 - 1) * knorm
+ kb2 = (1 - kK / kQ + kK2) * knorm
+
+ elseif (ifilter_type == 3) then ;; Notch
+ knorm = 1 / (1 + kK / kQ + kK2)
+ ka0 = (1 + kK2) * knorm
+ ka1 = 2 * (kK2 - 1) * knorm
+ ka2 = ka0
+ kb1 = ka1
+ kb2 = (1 - kK / kQ + kK2) * knorm
+
+ elseif (ifilter_type == 4) then ;; Peaking
+ if (kgain >= 0) then ;; boost
+ knorm = 1 / (1 + kK/kQ + kK2);
+ ka0 = (1 + kV/kQ * kK + kK2) * knorm;
+ ka1 = 2 * (kK2 - 1) * knorm;
+ ka2 = (1 - kV/kQ * kK + kK2) * knorm;
+ kb1 = ka1;
+ kb2 = (1 - 1/kQ * kK + kK2) * knorm;
+ else ;; cut
+ knorm = 1 / (1 + kV/kQ * kK + kK2)
+ ka0 = (1 + kK/kQ + kK2) * knorm
+ ka1 = 2 * (kK2 - 1) * knorm
+ ka2 = (1 - kK/kQ + kK2) * knorm
+ kb1 = ka1
+ kb2 = (1 - kV/kQ * kK + kK2) * knorm
+ endif
+
+ elseif (ifilter_type == 5) then ;; Low Shelf
+ if (kgain >= 0) then ;; boost
+ knorm = 1 / (1 + sqrt(2) * kK + kK2)
+ ka0 = (1 + sqrt(2*kV) * kK + kV * kK2) * knorm
+ ka1 = 2 * (kV * kK2 - 1) * knorm
+ ka2 = (1 - sqrt(2*kV) * kK + kV * kK2) * knorm
+ kb1 = 2 * (kK2 - 1) * knorm
+ kb2 = (1 - sqrt(2) * kK + kK2) * knorm
+ else ;; cut
+ knorm = 1 / (1 + sqrt(2*kV) * kK + kV * kK2)
+ ka0 = (1 + sqrt(2) * kK + kK2) * knorm
+ ka1 = 2 * (kK2 - 1) * knorm
+ ka2 = (1 - sqrt(2) * kK + kK2) * knorm
+ kb1 = 2 * (kV * kK2 - 1) * knorm
+ kb2 = (1 - sqrt(2*kV) * kK + kV * kK2) * knorm
+ endif
+
+ elseif (ifilter_type == 6) then ;; High Shelf
+ if (kgain >= 0) then ;; boost
+ knorm = 1 / (1 + sqrt(2) * kK + kK2)
+ ka0 = (kV + sqrt(2*kV) * kK + kK2) * knorm
+ ka1 = 2 * (kK2 - kV) * knorm
+ ka2 = (kV - sqrt(2*kV) * kK + kK2) * knorm
+ kb1 = 2 * (kK2 - 1) * knorm
+ kb2 = (1 - sqrt(2) * kK + kK2) * knorm
+ else ;; cut
+ knorm = 1 / (kV + sqrt(2*kV) * kK + kK2)
+ ka0 = (1 + sqrt(2) * kK + kK2) * knorm
+ ka1 = 2 * (kK2 - 1) * knorm
+ ka2 = (1 - sqrt(2) * kK + kK2) * knorm
+ kb1 = 2 * (kK2 - kV) * knorm
+ kb2 = (kV - sqrt(2*kV) * kK + kK2) * knorm
+ endif
+
+ endif
+ endif
+
+ kin = asig[kndx]
+
+ /* TDF2 Biquad Calculation */
+ kout = kin * ka0 + kz1
+ kz1 = kin * ka1 + kz2 - kb1 * kout
+ kz2 = kin * ka2 - kb2 * kout
+
+ /* Output, state saving for next pass */
+ aout[kndx] = kout
+
+ klast_Fc = kcut
+ klast_Q = kQ
+
+ kndx += 1
+od
+
+xout aout
+
+endop
+
diff --git a/data/opcodes/zdf.udo b/data/opcodes/zdf.udo
new file mode 100644
index 0000000..e4abe83
--- /dev/null
+++ b/data/opcodes/zdf.udo
@@ -0,0 +1,540 @@
+
+; Zero Delay Feedback Filters
+;
+; Based on code by Will Pirkle, presented in:
+;
+; http://www.willpirkle.com/Downloads/AN-4VirtualAnalogFilters.2.0.pdf
+;
+; and in his book "Designing software synthesizer plug-ins in C++ : for
+; RackAFX, VST3, and Audio Units"
+;
+; ZDF using Trapezoidal integrator by Vadim Zavalishin, presented in "The Art
+; of VA Filter Design" (https://www.native-instruments.com/fileadmin/ni_media/
+; downloads/pdf/VAFilterDesign_1.1.1.pdf)
+;
+; UDO versions by Steven Yi (2016.xx.xx)
+
+
+;; 1-pole (6dB) lowpass/highpass filter
+;; takes in a a-rate signal and cutoff value in frequency
+opcode zdf_1pole, aa, ak
+ ain, kcf xin
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ ; big combined value
+ kG = kg / (1.0 + kg)
+
+ ahp init 0
+ alp init 0
+
+ ;; state for integrators
+ kz1 init 0
+
+ kindx = 0
+ while kindx < ksmps do
+ ; do the filter, see VA book p. 46
+ ; form sub-node value v(n)
+ kin = ain[kindx]
+ kv = (kin - kz1) * kG
+
+ ; form output of node + register
+ klp = kv + kz1
+ khp = kin - klp
+
+ ; z1 register update
+ kz1 = klp + kv
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ kindx += 1
+ od
+
+ xout alp, ahp
+endop
+
+
+;; 1-pole (6dB) lowpass/highpass filter
+;; takes in a a-rate signal and cutoff value in frequency
+opcode zdf_1pole, aa, aa
+ ain, acf xin
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ iT = 1/sr
+
+ ahp init 0
+ alp init 0
+
+ ;; state for integrators
+ kz1 init 0
+
+ kindx = 0
+ while kindx < ksmps do
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * acf[kindx]
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ ; big combined value
+ kG = kg / (1.0 + kg)
+
+ ; do the filter, see VA book p. 46
+ ; form sub-node value v(n)
+ kin = ain[kindx]
+ kv = (kin - kz1) * kG
+
+ ; form output of node + register
+ klp = kv + kz1
+ khp = kin - klp
+
+ ; z1 register update
+ kz1 = klp + kv
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ kindx += 1
+ od
+
+ xout alp, ahp
+endop
+
+;; 1-pole allpass filter
+;; takes in an a-rate signal and corner frequency where input
+;; phase is shifted -90 degrees
+opcode zdf_allpass_1pole, a, ak
+ ain, kcf xin
+ alp, ahp zdf_1pole ain, kcf
+ aout = alp - ahp
+ xout aout
+endop
+
+
+;; 1-pole allpass filter
+;; takes in an a-rate signal and corner frequency where input
+;; phase is shifted -90 degrees
+opcode zdf_allpass_1pole, a, aa
+ ain, acf xin
+ alp, ahp zdf_1pole ain, acf
+ aout = alp - ahp
+ xout aout
+endop
+
+
+;; 2-pole (12dB) lowpass/highpass/bandpass filter
+;; takes in a a-rate signal, cutoff value in frequency, and
+;; Q factor for resonance
+opcode zdf_2pole,aaa,aKK
+
+ ain, kcf, kQ xin
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kG = kwa * iT/2
+ kR = 1 / (2 * kQ)
+
+ ;; output signals
+ alp init 0
+ ahp init 0
+ abp init 0
+
+ ;; state for integrators
+ kz1 init 0
+ kz2 init 0
+
+ ;;
+ kindx = 0
+ while kindx < ksmps do
+ khp = (ain[kindx] - (2 * kR + kG) * kz1 - kz2) / (1 + (2 * kR * kG) + (kG * kG))
+ kbp = kG * khp + kz1
+ klp = kG * kbp + kz2
+
+ ; z1 register update
+ kz1 = kG * khp + kbp
+ kz2 = kG * kbp + klp
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ abp[kindx] = kbp
+ kindx += 1
+ od
+
+ xout alp, abp, ahp
+
+endop
+
+
+;; 2-pole (12dB) lowpass/highpass/bandpass filter
+;; takes in a a-rate signal, cutoff value in frequency, and
+;; Q factor for resonance
+opcode zdf_2pole,aaa,aaa
+
+ ain, acf, aQ xin
+
+ iT = 1/sr
+
+ ;; output signals
+ alp init 0
+ ahp init 0
+ abp init 0
+
+ ;; state for integrators
+ kz1 init 0
+ kz2 init 0
+
+ ;;
+ kindx = 0
+ while kindx < ksmps do
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * acf[kindx]
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kG = kwa * iT/2
+
+ kR = 1 / (2 * aQ[kindx])
+
+ khp = (ain[kindx] - (2 * kR + kG) * kz1 - kz2) / (1 + (2 * kR * kG) + (kG * kG))
+ kbp = kG * khp + kz1
+ klp = kG * kbp + kz2
+
+ ; z1 register update
+ kz1 = kG * khp + kbp
+ kz2 = kG * kbp + klp
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ abp[kindx] = kbp
+ kindx += 1
+ od
+
+ xout alp, abp, ahp
+
+endop
+
+;; 2-pole (12dB) lowpass/highpass/bandpass/notch filter
+;; takes in a a-rate signal, cutoff value in frequency, and
+;; Q factor for resonance
+opcode zdf_2pole_notch,aaaa,aKK
+
+ ain, kcf, kQ xin
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kG = kwa * iT/2
+ kR = 1 / (2 * kQ)
+
+ ;; output signals
+ alp init 0
+ ahp init 0
+ abp init 0
+ anotch init 0
+
+ ;; state for integrators
+ kz1 init 0
+ kz2 init 0
+
+ ;;
+ kindx = 0
+ while kindx < ksmps do
+ kin = ain[kindx]
+ khp = (kin - (2 * kR + kG) * kz1 - kz2) / (1 + (2 * kR * kG) + (kG * kG))
+ kbp = kG * khp + kz1
+ klp = kG * kbp + kz2
+ knotch = kin - (2 * kR * kbp)
+
+ ; z1 register update
+ kz1 = kG * khp + kbp
+ kz2 = kG * kbp + klp
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ abp[kindx] = kbp
+ anotch[kindx] = knotch
+ kindx += 1
+ od
+
+ xout alp, abp, ahp, anotch
+
+endop
+
+;; 2-pole (12dB) lowpass/highpass/bandpass/notch filter
+;; takes in a a-rate signal, cutoff value in frequency, and
+;; Q factor for resonance
+opcode zdf_2pole_notch,aaaa,aaa
+
+ ain, acf, aQ xin
+
+ iT = 1/sr
+
+ ;; output signals
+ alp init 0
+ ahp init 0
+ abp init 0
+ anotch init 0
+
+ ;; state for integrators
+ kz1 init 0
+ kz2 init 0
+
+ ;;
+ kindx = 0
+ while kindx < ksmps do
+
+ ; pre-warp the cutoff- these are bilinear-transform filters
+ kwd = 2 * $M_PI * acf[kindx]
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kG = kwa * iT/2
+
+ kR = 1 / (2 * aQ[kindx])
+
+ kin = ain[kindx]
+ khp = (kin - (2 * kR + kG) * kz1 - kz2) / (1 + (2 * kR * kG) + (kG * kG))
+ kbp = kG * khp + kz1
+ klp = kG * kbp + kz2
+ knotch = kin - (2 * kR * kbp)
+
+ ; z1 register update
+ kz1 = kG * khp + kbp
+ kz2 = kG * kbp + klp
+
+ alp[kindx] = klp
+ ahp[kindx] = khp
+ abp[kindx] = kbp
+ anotch[kindx] = knotch
+ kindx += 1
+ od
+
+ xout alp, abp, ahp, anotch
+
+endop
+
+;; moog ladder
+
+opcode zdf_ladder, a, akk
+
+ ain, kcf, kres xin
+ aout init 0
+
+ kR = limit(1 - kres, 0.025, 1)
+
+ kQ = 1 / (2 * kR)
+
+ kwd = 2 * $M_PI * kcf
+ iT = 1/sr
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ kk = 4.0*(kQ - 0.707)/(25.0 - 0.707)
+
+ kg_2 = kg * kg
+ kg_3 = kg_2 * kg
+
+ ; big combined value
+ ; for overall filter
+ kG = kg_2 * kg_2
+ ; for individual 1-poles
+ kG_pole = kg/(1.0 + kg)
+
+ ;; state for each 1-pole's integrator
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kz4 init 0
+
+ kindx = 0
+ while kindx < ksmps do
+ ;; processing
+ kin = ain[kindx]
+
+ kS = kg_3 * kz1 + kg_2 * kz2 + kg * kz3 + kz4
+ ku = (kin - kk * kS) / (1 + kk * kG)
+
+ ;; 1st stage
+ kv = (ku - kz1) * kG_pole
+ klp = kv + kz1
+ kz1 = klp + kv
+
+ ;; 2nd stage
+ kv = (klp - kz2) * kG_pole
+ klp = kv + kz2
+ kz2 = klp + kv
+
+ ;; 3rd stage
+ kv = (klp - kz3) * kG_pole
+ klp = kv + kz3
+ kz3 = klp + kv
+
+ ;; 4th stage
+ kv = (klp - kz4) * kG_pole
+ klp = kv + kz4
+ kz4 = klp + kv
+
+ aout[kindx] = klp
+
+ kindx += 1
+ od
+
+ xout aout
+endop
+
+
+opcode zdf_ladder, a, aaa
+
+ ain, acf, ares xin
+ aout init 0
+
+ iT = 1/sr
+
+ ;; state for each 1-pole's integrator
+ kz1 init 0
+ kz2 init 0
+ kz3 init 0
+ kz4 init 0
+
+ kindx = 0
+ while kindx < ksmps do
+
+ kR = limit(1 - ares[kindx], 0.025, 1)
+
+ kQ = 1 / (2 * kR)
+
+ kwd = 2 * $M_PI * acf[kindx]
+ kwa = (2/iT) * tan(kwd * iT/2)
+ kg = kwa * iT/2
+
+ kk = 4.0*(kQ - 0.707)/(25.0 - 0.707)
+
+ kg_2 = kg * kg
+ kg_3 = kg_2 * kg
+
+ ; big combined value
+ ; for overall filter
+ kG = kg_2 * kg_2
+ ; for individual 1-poles
+ kG_pole = kg/(1.0 + kg)
+
+ ;; processing
+ kin = ain[kindx]
+
+ kS = kg_3 * kz1 + kg_2 * kz2 + kg * kz3 + kz4
+ ku = (kin - kk * kS) / (1 + kk * kG)
+
+ ;; 1st stage
+ kv = (ku - kz1) * kG_pole
+ klp = kv + kz1
+ kz1 = klp + kv
+
+ ;; 2nd stage
+ kv = (klp - kz2) * kG_pole
+ klp = kv + kz2
+ kz2 = klp + kv
+
+ ;; 3rd stage
+ kv = (klp - kz3) * kG_pole
+ klp = kv + kz3
+ kz3 = klp + kv
+
+ ;; 4th stage
+ kv = (klp - kz4) * kG_pole
+ klp = kv + kz4
+ kz4 = klp + kv
+
+ aout[kindx] = klp
+
+ kindx += 1
+ od
+
+ xout aout
+endop
+
+;; 4-pole
+
+opcode zdf_4pole, aaaaaa, akk
+ ain, kcf, kres xin
+
+ alp2, abp2, ahp2 zdf_2pole ain, kcf, kres
+
+ abp4 init 0
+ abl4 init 0
+ alp4 init 0
+
+ xout alp2, abp2, ahp2, alp4, abl4, abp4
+endop
+
+opcode zdf_4pole, aaaaaa, aaa
+ ain, acf, ares xin
+
+ alp2, abp2, ahp2 zdf_2pole ain, acf, ares
+ abp4 init 0
+ abl4 init 0
+ alp4 init 0
+
+ xout alp2, abp2, ahp2, alp4, abl4, abp4
+endop
+
+
+opcode zdf_4pole_hp, aaaaaa, akk
+ ain, kcf, kres xin
+
+ alp2, abp2, ahp2 zdf_2pole ain, kcf, kres
+
+ ahp4 init 0
+ abh4 init 0
+ abp4 init 0
+
+ xout alp2, abp2, ahp2, abp4, abh4, ahp4
+endop
+
+opcode zdf_4pole_hp, aaaaaa, aaa
+ ain, acf, ares xin
+
+ alp2, abp2, ahp2 zdf_2pole ain, acf, ares
+
+ ahp4 init 0
+ abh4 init 0
+ abp4 init 0
+
+ xout alp2, abp2, ahp2, abp4, abh4, ahp4
+endop
+
+;; TODO - implement
+opcode zdf_peak_eq, a, akkk
+ ain, kcf, kres, kdB xin
+
+ aout init 0
+
+ xout aout
+endop
+
+opcode zdf_high_shelf_eq, a, akk
+ ain, kcf, kdB xin
+
+ ;; TODO - convert db to K, check if reusing zdf_1pole is sufficient
+ kK init 0
+
+ alp, ahp zdf_1pole ain, kcf
+
+ aout = ain + kK * ahp
+
+ xout aout
+endop
+
+opcode zdf_low_shelf_eq, a, akk
+ ain, kcf, kdB xin
+
+ ;; TODO - convert db to K, check if reusing zdf_1pole is sufficient
+ kK init 0
+
+ alp, ahp zdf_1pole ain, kcf
+
+ aout = ain + kK * alp
+
+ xout aout
+endop
diff --git a/data/opcodes/zero-delay-convolution.udo b/data/opcodes/zero-delay-convolution.udo
new file mode 100644
index 0000000..cc301ab
--- /dev/null
+++ b/data/opcodes/zero-delay-convolution.udo
@@ -0,0 +1,31 @@
+; Here’s a UDO for zero-latency partitioned convolution
+
+;/**************************************************
+;asig ZConv ain,ipart,irat,inp,ifn
+;ain - input signal
+;ipart - first partition size in samples
+;irat - partition growth ratio
+;inp - total number of partition sizes
+;ifn - function table number containing the IR
+;**************************************************/
+opcode ZConv,a,aiiiio
+ asig,iprt,irat,inp,ifn,icnt xin
+ if icnt < inp-1 then
+ acn ZConv asig,iprt,irat,inp,ifn,icnt+1
+ endif
+ if icnt == 0 then
+ a1 dconv asig,iprt,ifn
+ elseif icnt < inp-1 then
+ ipt = iprt*irat^(icnt-1)
+ isiz = ipt*(irat-1)
+ print ipt
+ print isiz
+ a1 ftconv asig,ifn,ipt,ipt,isiz
+ else
+ ipt = iprt*irat^(icnt-1)
+ a1 ftconv asig,ifn,ipt,ipt
+ endif
+ xout a1 + acn
+endop
+
+; a1 ZConv asig,64,4,6,1 \ No newline at end of file
diff --git a/src/Csound/Typed/Control/Api.hs b/src/Csound/Typed/Control/Api.hs
index 837a662..f2a45e6 100644
--- a/src/Csound/Typed/Control/Api.hs
+++ b/src/Csound/Typed/Control/Api.hs
@@ -57,9 +57,9 @@ trigByNameMidi_ name instr = do
noteFlagExpr <- toGE noteFlag
args <- fromTuple (pch, vol, other)
return $ do
- D.when1 (noteFlagExpr ==* 1) $ do
+ D.when1 D.Ir (noteFlagExpr ==* 1) $ do
eventi (Event instrIdExpr 0 (-1) args)
- D.when1 (noteFlagExpr ==* 0) $ do
+ D.when1 D.Ir (noteFlagExpr ==* 0) $ do
eventi (Event (negate instrIdExpr) 0 0 args)
turnoff
@@ -175,4 +175,4 @@ tabw b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unTab
-- csound doc: <http://www.csounds.com/manual/html/tab.html>
tab :: Sig -> Tab -> Sig
tab b1 b2 = Sig $ f <$> unSig b1 <*> unTab b2
- where f a1 a2 = opcs "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2] \ No newline at end of file
+ where f a1 a2 = opcs "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2]
diff --git a/src/Csound/Typed/Control/Vco.hs b/src/Csound/Typed/Control/Vco.hs
index cf0f00f..098c1e3 100644
--- a/src/Csound/Typed/Control/Vco.hs
+++ b/src/Csound/Typed/Control/Vco.hs
@@ -1,12 +1,37 @@
-- | Band-limited oscillators
module Csound.Typed.Control.Vco(
saw, isaw, pulse, tri, sqr, blosc,
- saw', isaw', pulse', tri', sqr', blosc'
+ saw', isaw', pulse', tri', sqr', blosc',
+
+ -- * Hard sync
+ SyncSmooth(..),
+
+ sawSync, isawSync, pulseSync, triSync, sqrSync, bloscSync,
+ sawSync', isawSync', pulseSync', triSync', sqrSync', bloscSync',
+
+ -- ** Hard sync with absolute frequency for slave oscillator
+ sawSyncAbs, isawSyncAbs, pulseSyncAbs, triSyncAbs, sqrSyncAbs, bloscSyncAbs,
+ sawSyncAbs', isawSyncAbs', pulseSyncAbs', triSyncAbs', sqrSyncAbs', bloscSyncAbs',
+
+ -- ** Hard sync with custom smoothing algorythm
+ sawSyncBy, isawSyncBy, pulseSyncBy, triSyncBy, sqrSyncBy, bloscSyncBy,
+ sawSyncBy', isawSyncBy', pulseSyncBy', triSyncBy', sqrSyncBy', bloscSyncBy',
+
+ -- ** Hard sync with absolute frequency for slave oscillator
+ sawSyncAbsBy, isawSyncAbsBy, pulseSyncAbsBy, triSyncAbsBy, sqrSyncAbsBy, bloscSyncAbsBy,
+ sawSyncAbsBy', isawSyncAbsBy', pulseSyncAbsBy', triSyncAbsBy', sqrSyncAbsBy', bloscSyncAbsBy'
+
+
) where
+import Data.Default
+
+import Csound.Dynamic(Gen(..), GenId(..))
import Csound.Typed.GlobalState
import Csound.Typed.Types
+import Csound.Typed.GlobalState
+
--------------------------------------------------------------
-- no phase
@@ -79,3 +104,406 @@ withPhaseWave waveType phs cps = fromGE $ do
phsExpr <- toGE phs
waveId <- saveBandLimitedWave waveType
return $ readBandLimited (Just phsExpr) waveId expr
+
+--------------------------------------------------------------
+-- no phase relative sync
+
+relativeSync :: (Sig -> Sig -> Sig) -> (Sig -> Sig -> Sig)
+relativeSync f ratioCps masterCps = f (ratioCps * masterCps) masterCps
+
+-- | Sawtooth oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > sawSync ratio cps
+sawSync :: Sig -> Sig -> Sig
+sawSync = relativeSync sawSyncAbs
+
+-- | Integrated sawtooth oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > isawSync ratio cps
+isawSync :: Sig -> Sig -> Sig
+isawSync = relativeSync isawSyncAbs
+
+
+-- | Triangle oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > triSync ratio cps
+triSync :: Sig -> Sig -> Sig
+triSync = relativeSync triSyncAbs
+
+-- | Pulse oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > pulseSync ratio cps
+pulseSync :: Sig -> Sig -> Sig
+pulseSync = relativeSync pulseSyncAbs
+
+-- | Square oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > sqrSync ratio cps
+sqrSync :: Sig -> Sig -> Sig
+sqrSync = relativeSync sqrSyncAbs
+
+-- | Band-limited oscillator with hard-sync.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > bloscSync tab ratio cps
+bloscSync :: Tab -> Sig -> Sig -> Sig
+bloscSync t = relativeSync (bloscSyncAbs t)
+
+--------------------------------------------------------------
+
+
+relativeSync' :: (D -> Sig -> Sig -> Sig) -> (D -> Sig -> Sig -> Sig)
+relativeSync' f phase ratioCps masterCps = f phase (ratioCps * masterCps) masterCps
+
+-- | Sawtooth oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > sawSync' phase ratio cps
+sawSync' :: D -> Sig -> Sig -> Sig
+sawSync' = relativeSync' sawSyncAbs'
+
+-- | Integrated sawtooth oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > isawSync' phase ratio cps
+isawSync' :: D -> Sig -> Sig -> Sig
+isawSync' = relativeSync' isawSyncAbs'
+
+-- | Triangle oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > triSync' phase ratio cps
+triSync' :: D -> Sig -> Sig -> Sig
+triSync' = relativeSync' triSyncAbs'
+
+-- | Pulse oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > pulseSync' phase ratio cps
+pulseSync' :: D -> Sig -> Sig -> Sig
+pulseSync' = relativeSync' pulseSyncAbs'
+
+-- | Square oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > sqrSync' phase ratio cps
+sqrSync' :: D -> Sig -> Sig -> Sig
+sqrSync' = relativeSync' sqrSyncAbs'
+
+-- | Band-limited oscillator with hard-sync with phase.
+-- The second argument is a ration between slave and master oscillators.
+--
+-- > bloscSync' phase tab ratio cps
+bloscSync' :: Tab -> D -> Sig -> Sig -> Sig
+bloscSync' t = relativeSync' (bloscSyncAbs' t)
+
+--------------------------------------------------------------
+-- no phase relative sync
+
+relativeSyncBy :: (SyncSmooth -> Sig -> Sig -> Sig) -> (SyncSmooth -> Sig -> Sig -> Sig)
+relativeSyncBy f smoothType ratioCps masterCps = f smoothType (ratioCps * masterCps) masterCps
+
+-- | Sawtooth oscillator with hard-sync. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > sawSyncBy spec ratio cps
+sawSyncBy :: SyncSmooth -> Sig -> Sig -> Sig
+sawSyncBy = relativeSyncBy sawSyncAbsBy
+
+-- | Integrated sawtooth oscillator with hard-sync. We can specify the smoothness type.
+-- The first argument is a ration between slave and master oscillators.
+--
+-- > isawSyncB specy ratio cps
+isawSyncBy :: SyncSmooth -> Sig -> Sig -> Sig
+isawSyncBy = relativeSyncBy isawSyncAbsBy
+
+-- | Triangle oscillator with hard-sync. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > triSyncBy spec ratio cps
+triSyncBy :: SyncSmooth -> Sig -> Sig -> Sig
+triSyncBy = relativeSyncBy triSyncAbsBy
+
+-- | Pulse oscillator with hard-sync. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > pulseSyncBy spec ratio cps
+pulseSyncBy :: SyncSmooth -> Sig -> Sig -> Sig
+pulseSyncBy = relativeSyncBy pulseSyncAbsBy
+
+-- | Square oscillator with hard-sync. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > sawSyncBy spec ratio cps
+sqrSyncBy :: SyncSmooth -> Sig -> Sig -> Sig
+sqrSyncBy = relativeSyncBy sqrSyncAbsBy
+
+-- | Bandlimited table oscillator with hard-sync. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > bloscSyncBy spec tab ratio cps
+bloscSyncBy :: SyncSmooth -> Tab -> Sig -> Sig -> Sig
+bloscSyncBy smoothType t = relativeSyncBy (\smoothType -> bloscSyncAbsBy smoothType t) smoothType
+
+------------------------------------------------------------
+-- phase
+
+relativeSyncBy' :: (SyncSmooth -> D -> Sig -> Sig -> Sig) -> (SyncSmooth -> D -> Sig -> Sig -> Sig)
+relativeSyncBy' f smoothType phase ratioCps masterCps = f smoothType phase (ratioCps * masterCps) masterCps
+
+-- | Sawtooth oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > sawSyncBy' spec phase ratio cps
+sawSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+sawSyncBy' = relativeSyncBy' sawSyncAbsBy'
+
+-- | Integrated sawtooth oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > isawSyncBy' spec phase ratio cps
+isawSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+isawSyncBy' = relativeSyncBy' isawSyncAbsBy'
+
+-- | Triangle oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > triSyncBy' spec phase ratio cps
+triSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+triSyncBy' = relativeSyncBy' triSyncAbsBy'
+
+-- | Pulse oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > pulseSyncBy' spec phase ratio cps
+pulseSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+pulseSyncBy' = relativeSyncBy' pulseSyncAbsBy'
+
+-- | Square oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > sawSyncBy' spec phase ratio cps
+sqrSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+sqrSyncBy' = relativeSyncBy' sqrSyncAbsBy'
+
+-- | Bandlimited table oscillator with hard-sync with phase. We can specify the smoothness type.
+-- The @ratio@ argument is a ration between slave and master oscillators.
+--
+-- > bloscSyncBy' spec phase tab ratio cps
+bloscSyncBy' :: SyncSmooth -> Tab -> D -> Sig -> Sig -> Sig
+bloscSyncBy' smoothType t = relativeSyncBy' (\smoothType -> bloscSyncAbsBy' smoothType t) smoothType
+
+------------------------------------------------------------
+
+-- | Sawtooth oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > sawSyncAbs freq slaveCps masterCps
+sawSyncAbs :: Sig -> Sig -> Sig
+sawSyncAbs = sawSyncAbsBy def
+
+-- | Integrated sawtooth oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > isawSyncAbs freq slaveCps masterCps
+isawSyncAbs :: Sig -> Sig -> Sig
+isawSyncAbs = isawSyncAbsBy def
+
+-- | Triangle oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > triSyncAbs freq slaveCps masterCps
+triSyncAbs :: Sig -> Sig -> Sig
+triSyncAbs = triSyncAbsBy def
+
+-- | Pulse oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > pulseSyncAbs freq slaveCps masterCps
+pulseSyncAbs :: Sig -> Sig -> Sig
+pulseSyncAbs = pulseSyncAbsBy def
+
+-- | Square oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > sqrSyncAbs freq slaveCps masterCps
+sqrSyncAbs :: Sig -> Sig -> Sig
+sqrSyncAbs = sqrSyncAbsBy def
+
+-- | Bandlimited table oscillator with hard-sync.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > bloscSyncAbs tab freq slaveCps masterCps
+bloscSyncAbs :: Tab -> Sig -> Sig -> Sig
+bloscSyncAbs = bloscSyncAbsBy def
+
+-----------------------------------------------------------
+
+-- | Sawtooth oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > sawSyncAbs' phase freq slaveCps masterCps
+sawSyncAbs' :: D -> Sig -> Sig -> Sig
+sawSyncAbs' = sawSyncAbsBy' def
+
+-- | Integrated sawtooth oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > isawSyncAbs' phase freq slaveCps masterCps
+isawSyncAbs' :: D -> Sig -> Sig -> Sig
+isawSyncAbs' = isawSyncAbsBy' def
+
+-- | Triangle oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > triSyncAbs' phase freq slaveCps masterCps
+triSyncAbs' :: D -> Sig -> Sig -> Sig
+triSyncAbs' = triSyncAbsBy' def
+
+-- | Pulse oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > pulseSyncAbs' phase freq slaveCps masterCps
+pulseSyncAbs' :: D -> Sig -> Sig -> Sig
+pulseSyncAbs' = pulseSyncAbsBy' def
+
+-- | Square oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > sqrSyncAbs' phase freq slaveCps masterCps
+sqrSyncAbs' :: D -> Sig -> Sig -> Sig
+sqrSyncAbs' = sqrSyncAbsBy' def
+
+-- | Bandlimited table oscillator with hard-sync with phase.
+-- The @freq@ argument is an absolute frequency of a slave oscillator.
+--
+-- > bloscSyncAbs' phase tab freq slaveCps masterCps
+bloscSyncAbs' :: Tab -> D -> Sig -> Sig -> Sig
+bloscSyncAbs' = bloscSyncAbsBy' def
+
+--------------------------------------------------------------
+-- no phase
+
+-- | A hard sync for sawtooth with absolute slave frequency.
+--
+-- > sawSyncAbs syncType salveCps masterCps
+sawSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig
+sawSyncAbsBy = noPhaseWaveHardSync Saw
+
+-- | A hard sync for integrated sawtooth: 4 * x * (1 - x) with absolute slave frequency.
+--
+-- > isawSyncAbs syncType salveCps masterCps
+isawSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig
+isawSyncAbsBy = noPhaseWaveHardSync IntegratedSaw
+
+-- | A hard sync for triangle wave with absolute slave frequency.
+--
+-- > triSyncAbs syncType salveCps masterCps
+triSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig
+triSyncAbsBy = noPhaseWaveHardSync Triangle
+
+-- | A hard sync for pulse wave with absolute slave frequency.
+--
+-- > pulseSyncAbs syncType salveCps masterCps
+pulseSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig
+pulseSyncAbsBy = noPhaseWaveHardSync Pulse
+
+-- | A hard sync for square wave with absolute slave frequency.
+--
+-- > sqrSyncAbs syncType salveCps masterCps
+sqrSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig
+sqrSyncAbsBy = noPhaseWaveHardSync Square
+
+-- | A hard sync for band-limited oscillator with user defined waveform (it's stored in the table) woth absolute frequency.
+--
+-- > bloscSyncAbs syncType ftable salveCps masterCps
+bloscSyncAbsBy :: SyncSmooth -> Tab -> Sig -> Sig -> Sig
+bloscSyncAbsBy smoothType tab ratioCps cps = hideGE $ do
+ gen <- fromPreTab $ getPreTabUnsafe "blosc: tab should be primitive, not an expression." tab
+ return $ noPhaseWaveHardSync (UserGen gen) smoothType ratioCps cps
+
+--------------------------------------------------------------
+-- with phase
+
+-- | A sawtooth.
+sawSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+sawSyncAbsBy' = withPhaseWaveHardSync Saw
+
+-- | Integrated sawtooth: 4 * x * (1 - x).
+isawSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+isawSyncAbsBy' = withPhaseWaveHardSync IntegratedSaw
+
+-- | A triangle wave.
+triSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+triSyncAbsBy' = withPhaseWaveHardSync Triangle
+
+-- | Pulse (not normalized).
+pulseSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+pulseSyncAbsBy' = withPhaseWaveHardSync Pulse
+
+-- | A square wave.
+sqrSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig
+sqrSyncAbsBy' = withPhaseWaveHardSync Square
+
+-- | A band-limited oscillator with user defined waveform (it's stored in the table).
+bloscSyncAbsBy' :: SyncSmooth -> Tab -> D -> Sig -> Sig -> Sig
+bloscSyncAbsBy' smoothType tab phs ratioCps cps = hideGE $ do
+ gen <- fromPreTab $ getPreTabUnsafe "blosc: tab should be primitive, not an expression." tab
+ return $ withPhaseWaveHardSync (UserGen gen) smoothType phs ratioCps cps
+
+-----------------------------------------------
+
+-- | Type of smooth shape to make smooth transitions on retrigger.
+-- Available types are:
+--
+-- * No smooth: @RawSync@
+--
+-- * Ramp smooth: @SawSync@
+--
+-- * Triangular smooth: @TriSync@
+--
+-- * User defined shape: @UserSync@
+data SyncSmooth = RawSync | SawSync | TriSync | TrapSync | UserSync Tab
+
+instance Default SyncSmooth where
+ def = TrapSync
+
+getSyncShape :: SyncSmooth -> GE (Maybe BandLimited)
+getSyncShape x = case x of
+ RawSync -> return $ Nothing
+ SawSync -> gen7 4097 [1, 4097, 0]
+ TriSync -> gen7 4097 [0, 2048, 1, 2049, 0]
+ TrapSync -> gen7 4097 [1, 2048, 1, 2049, 0]
+ UserSync tab -> do
+ gen <- fromPreTab $ getPreTabUnsafe "blosc: tab should be primitive, not an expression." tab
+ return $ Just $ UserGen gen
+ where
+ gen7 size args = return $ Just $ UserGen $ Gen { genSize = size, genId = IntGenId 7, genArgs = args, genFile = Nothing }
+
+noPhaseWaveHardSync :: BandLimited -> SyncSmooth -> Sig -> Sig -> Sig
+noPhaseWaveHardSync waveType smoothWaveType slaveCps cps = fromGE $ do
+ smoothWave <- getSyncShape smoothWaveType
+ exprSlaveCps <- toGE slaveCps
+ exprCps <- toGE cps
+ waveId <- saveBandLimitedWave waveType
+ smoothWaveId <- case smoothWave of
+ Nothing -> return Nothing
+ Just wave -> fmap Just $ saveBandLimitedWave wave
+ return $ readHardSyncBandLimited smoothWaveId Nothing waveId exprSlaveCps exprCps
+
+withPhaseWaveHardSync :: BandLimited -> SyncSmooth -> D -> Sig -> Sig -> Sig
+withPhaseWaveHardSync waveType smoothWaveType phs slaveCps cps = fromGE $ do
+ smoothWave <- getSyncShape smoothWaveType
+ phsExpr <- toGE phs
+ exprSlaveCps <- toGE slaveCps
+ exprCps <- toGE cps
+ waveId <- saveBandLimitedWave waveType
+ smoothWaveId <- case smoothWave of
+ Nothing -> return Nothing
+ Just wave -> fmap Just $ saveBandLimitedWave wave
+ return $ readHardSyncBandLimited smoothWaveId (Just phsExpr) waveId exprSlaveCps exprCps
diff --git a/src/Csound/Typed/GlobalState.hs b/src/Csound/Typed/GlobalState.hs
index ffa35bd..b68bdf9 100644
--- a/src/Csound/Typed/GlobalState.hs
+++ b/src/Csound/Typed/GlobalState.hs
@@ -5,7 +5,7 @@ module Csound.Typed.GlobalState (
module Csound.Typed.GlobalState.Instr,
module Csound.Typed.GlobalState.Cache,
-- * Reexports dynamic
- BandLimited(..), readBandLimited, renderBandLimited,
+ BandLimited(..), readBandLimited, readHardSyncBandLimited, renderBandLimited,
Instrs(..), IdMap(..), getInstrIds,
getIn, chnUpdateUdo, renderGlobals, turnoff, turnoff2, exitnow,
oscListen, oscInit, oscSend,
diff --git a/src/Csound/Typed/GlobalState/Elements.hs b/src/Csound/Typed/GlobalState/Elements.hs
index 1c5c24d..fad0c58 100644
--- a/src/Csound/Typed/GlobalState/Elements.hs
+++ b/src/Csound/Typed/GlobalState/Elements.hs
@@ -8,9 +8,10 @@ module Csound.Typed.GlobalState.Elements(
-- Sf2
SfFluid(..), SfSpec(..), SfMap, newSf, sfVar, renderSf,
-- ** Band-limited waveforms
- BandLimited(..), BandLimitedMap,
+ BandLimited(..), BandLimitedMap(..), BandLimitedId(..),
saveBandLimited, renderBandLimited,
- readBandLimited,
+ readBandLimited, readHardSyncBandLimited,
+
-- ** String arguments
StringMap, newString,
-- * Midi
@@ -29,7 +30,9 @@ module Csound.Typed.GlobalState.Elements(
subinstr, subinstr_, event_i, event, safeOut, autoOff, changed,
-- * Udo plugins
UdoPlugin, addUdoPlugin, getUdoPluginNames,
- tabQueuePlugin, tabQueue2Plugin
+ tabQueuePlugin, tabQueue2Plugin,
+ zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin,
+ diodePlugin, korg35Plugin, zeroDelayConvolutionPlugin
) where
import Data.List
@@ -51,7 +54,8 @@ import Csound.Typed.GlobalState.Opcodes
data IdMap a = IdMap
{ idMapContent :: M.Map a Int
- , idMapNewId :: Int }
+ , idMapNewId :: Int
+ } deriving (Eq, Ord)
instance Default (IdMap a) where
def = IdMap def 1
@@ -187,36 +191,85 @@ renderSf (SfSpec name bank prog) n = verbatim $
data BandLimited = Saw | Pulse | Square | Triangle | IntegratedSaw | UserGen Gen
deriving (Eq, Ord)
-type BandLimitedMap = M.Map BandLimited Int
+data BandLimitedId = SimpleBandLimitedWave Int | UserBandLimitedWave Int
+ deriving (Eq, Ord)
+
+bandLimitedIdToExpr :: BandLimitedId -> E
+bandLimitedIdToExpr x = case x of
+ SimpleBandLimitedWave simpleId -> int simpleId
+ UserBandLimitedWave userId -> noRate $ ReadVar $ bandLimitedVar userId
+
+bandLimitedVar userId = Var GlobalVar Ir ("BandLim" ++ show userId)
-saveBandLimited :: BandLimited -> State (GenMap, BandLimitedMap) Int
+data BandLimitedMap = BandLimitedMap
+ { simpleBandLimitedMap :: M.Map BandLimited BandLimitedId
+ , vcoInitMap :: GenMap
+ } deriving (Eq, Ord)
+
+instance Default BandLimitedMap where
+ def = BandLimitedMap def def
+
+saveBandLimited :: BandLimited -> State BandLimitedMap BandLimitedId
saveBandLimited x = case x of
Saw -> simpleWave 1 0
IntegratedSaw -> simpleWave 2 1
Pulse -> simpleWave 4 2
Square -> simpleWave 8 3
Triangle -> simpleWave 16 4
- UserGen _ -> userGen
+ UserGen gen -> userGen gen
where
- simpleWave writeId readId = state $ \s@(genMap, blMap) ->
- if (M.member x blMap)
- then (readId, s)
- else (readId, (genMap, M.insert x writeId blMap))
+ simpleWave writeId readId = state $ \blMap ->
+ if (M.member x (simpleBandLimitedMap blMap))
+ then (SimpleBandLimitedWave readId, blMap)
+ else (SimpleBandLimitedWave readId, blMap { simpleBandLimitedMap = M.insert x (SimpleBandLimitedWave writeId) (simpleBandLimitedMap blMap) })
+
+ userGen gen = state $ \blMap ->
+ let genMap = vcoInitMap blMap
+ (newId, genMap1) = runState (saveId gen) genMap
+ blMap1 = blMap { vcoInitMap = genMap1 }
+ in (UserBandLimitedWave newId, blMap1)
- userGen = state $ \s@(genMap, blMap) -> case M.lookup x blMap of
- Just n -> (n, s)
- Nothing ->
- let (newId, genMap1) = runState newGenId genMap
- blMap1 = M.insert x newId blMap
- in (negate newId, (genMap1, blMap1))
renderBandLimited :: Monad m => GenMap -> BandLimitedMap -> DepT m ()
-renderBandLimited genMap blMap = case M.toList blMap of
- [] -> return ()
- as -> render (idMapNewId genMap) (getUserGens as) as
+renderBandLimited genMap blMap =
+ if isEmptyBlMap blMap
+ then return ()
+ else render (idMapNewId genMap) (M.toList $ idMapContent $ vcoInitMap blMap) (M.toList $ simpleBandLimitedMap blMap)
where
- render n gens vcos = do
- mapM_ renderGen gens
+ isEmptyBlMap m = (M.null $ simpleBandLimitedMap m) && (M.null $ idMapContent $ vcoInitMap m)
+
+ render lastGenId gens vcos = do
+ writeVar freeVcoVar $ int (lastGenId + length gens + 100)
+ mapM_ (renderGen lastGenId) gens
+ mapM_ renderVco vcos
+
+ renderGen :: Monad m => Int -> (Gen, Int) -> DepT m ()
+ renderGen lastGenId (gen, genId) = do
+ renderFtgen lastGenId (gen, genId)
+ renderVcoGen genId
+ renderVcoVarAssignment genId
+
+ freeVcoVar = Var GlobalVar Ir "free_vco"
+ ftVar n = Var GlobalVar Ir $ "vco_table_" ++ show n
+
+ renderFtgen lastGenId (g, n) = writeVar (ftVar n) $ ftgen (int $ lastGenId + n) g
+
+ renderVcoGen ftId = do
+ ft <- readVar (ftVar ftId)
+ free <- readVar freeVcoVar
+ writeVar freeVcoVar $ vco2init [-ft, free, 1.05, -1, -1, ft]
+
+ renderVcoVarAssignment n = writeVar (bandLimitedVar n) =<< (fmap negate $ readVar (ftVar n))
+
+ renderVco :: Monad m => (BandLimited, BandLimitedId) -> DepT m ()
+ renderVco (bandLimited, blId) = case blId of
+ SimpleBandLimitedWave waveId -> do
+ free <- readVar freeVcoVar
+ writeVar freeVcoVar $ vco2init [int waveId, free]
+ UserBandLimitedWave _ -> return ()
+
+
+{-
renderFirstVco n (head vcos)
mapM_ renderTailVco (tail vcos)
@@ -240,9 +293,22 @@ renderBandLimited genMap blMap = case M.toList blMap of
dummyVar = Var LocalVar Ir "ft"
toDummy = writeVar dummyVar
+-}
+
+readBandLimited :: Maybe E -> BandLimitedId -> E -> E
+readBandLimited mphase n cps = oscilikt 1 cps (vco2ft cps (bandLimitedIdToExpr n)) mphase
-readBandLimited :: Maybe E -> Int -> E -> E
-readBandLimited mphase n cps = oscilikt 1 cps (vco2ft cps (int n)) mphase
+readHardSyncBandLimited :: Maybe BandLimitedId -> Maybe E -> BandLimitedId -> E -> E -> E
+readHardSyncBandLimited msmoothShape mphase n slaveCps masterCps = smoothWave * readShape n phasorSlave slaveCps
+ where
+ (phasorMaster, syncMaster) = syncphasor masterCps 0 Nothing
+ (phasorSlave, syncSlave) = syncphasor slaveCps syncMaster mphase
+
+ smoothWave = case msmoothShape of
+ Nothing -> 1
+ Just shape -> readShape shape phasorMaster masterCps
+
+ readShape shapeId phasor freq = tableikt phasor (vco2ft freq (bandLimitedIdToExpr shapeId))
----------------------------------------------------------
-- Midi
@@ -431,12 +497,24 @@ chnPargId arityIns = 4 + arityIns
newtype UdoPlugin = UdoPlugin { unUdoPlugin :: String }
-tabQueuePlugin = UdoPlugin "tabQueue"
-tabQueue2Plugin = UdoPlugin "tabQueue2"
-
addUdoPlugin :: UdoPlugin -> State [UdoPlugin] ()
addUdoPlugin a = modify (a :)
getUdoPluginNames :: [UdoPlugin] -> [String]
getUdoPluginNames xs = nub (fmap unUdoPlugin xs)
+-- tabQueue
+
+tabQueuePlugin = UdoPlugin "tabQueue"
+tabQueue2Plugin = UdoPlugin "tabQueue2"
+
+----------------------------------------------------------
+-- Steven Yi wonderful UDOs
+
+zdfPlugin = UdoPlugin "zdf" -- Zero delay filters
+solinaChorusPlugin = UdoPlugin "solina_chorus" -- solina chorus
+audaciouseqPlugin = UdoPlugin "audaciouseq" -- audacious 10 band EQ
+adsr140Plugin = UdoPlugin "adsr140" -- adsr with retriggering
+diodePlugin = UdoPlugin "diode" -- diode ladder filter
+korg35Plugin = UdoPlugin "korg35" -- korg 35 filter
+zeroDelayConvolutionPlugin = UdoPlugin "zero-delay-convolution" -- zero delay convolutio by Victor Lazzarini
diff --git a/src/Csound/Typed/GlobalState/GE.hs b/src/Csound/Typed/GlobalState/GE.hs
index 8d91125..7daa84b 100644
--- a/src/Csound/Typed/GlobalState/GE.hs
+++ b/src/Csound/Typed/GlobalState/GE.hs
@@ -33,6 +33,8 @@ module Csound.Typed.GlobalState.GE(
guiInstrExp,
listenKeyEvt, Key(..), KeyEvt(..), Guis(..),
getKeyEventListener,
+ -- * Cabbage Guis
+ cabbage,
-- * Hrtf pan
simpleHrtfmove, simpleHrtfstat,
-- * Udo plugins
@@ -62,6 +64,8 @@ import Csound.Typed.Constants(infiniteDur)
import Csound.Typed.GlobalState.Opcodes(hrtfmove, hrtfstat, primInstrId)
import Csound.Typed.Gui.Gui(Panel(..), Win(..), GuiNode, GuiHandle(..), restoreTree, guiMap, mapGuiOnPanel, defText)
+import qualified Csound.Typed.Gui.Cabbage.CabbageLang as Cabbage
+import qualified Csound.Typed.Gui.Cabbage.Cabbage as Cabbage
import qualified Csound.Typed.GlobalState.Elements as E(saveNamedInstr, addUdoPlugin)
@@ -112,10 +116,11 @@ data History = History
, userInstr0 :: Dep ()
, bandLimitedMap :: BandLimitedMap
, cache :: Cache GE
- , guis :: Guis }
+ , guis :: Guis
+ , cabbageGui :: Maybe Cabbage.Lang }
instance Default History where
- def = History def def def def def def def def def def def def def def def (return ()) def def def
+ def = History def def def def def def def def def def def def def def def (return ()) def def def def
data Msg = Msg
data MidiAssign = MidiAssign MidiType Channel InstrId
@@ -194,11 +199,12 @@ saveSf = onSfMap . newSf
sfTable :: History -> [(SfSpec, Int)]
sfTable = M.toList . idMapContent . sfMap
-saveBandLimitedWave :: BandLimited -> GE Int
+saveBandLimitedWave :: BandLimited -> GE BandLimitedId
saveBandLimitedWave = onBandLimitedMap . saveBandLimited
where onBandLimitedMap = onHistory
- (\a -> (genMap a, bandLimitedMap a))
- (\(gm, blm) h -> h { genMap = gm, bandLimitedMap = blm})
+ (\a -> (bandLimitedMap a))
+ (\(blm) h -> h { bandLimitedMap = blm})
+
setTotalDur :: TotalDur -> GE ()
setTotalDur = onTotalDur . modify . const . Just
where onTotalDur = onHistory totalDur (\a h -> h { totalDur = a })
@@ -491,8 +497,8 @@ keyEventInstrBody :: KeyCodeMap -> GE InstrBody
keyEventInstrBody keyMap = execDepT $ do
let keys = flKeyIn
isChange = changed keys ==* 1
- when1 isChange $ do
- whens (fmap (uncurry $ listenEvt keys) events) doNothing
+ when1 Kr isChange $ do
+ whens Kr (fmap (uncurry $ listenEvt keys) events) doNothing
where
doNothing = return ()
@@ -513,6 +519,11 @@ getKeyEventListener = do
body <- keyEventInstrBody $ guiKeyEvents $ guis h
return $ Just (Instr keyEventInstrId body)
+-----------------------------------------------
+-- cabbage
+
+cabbage :: Cabbage.Cab -> GE ()
+cabbage cab = modifyHistory $ \h -> h { cabbageGui = Just $ Cabbage.runCab cab }
-----------------------------------------------
-- head pan
diff --git a/src/Csound/Typed/GlobalState/Opcodes.hs b/src/Csound/Typed/GlobalState/Opcodes.hs
index 5fa073e..07f0d80 100644
--- a/src/Csound/Typed/GlobalState/Opcodes.hs
+++ b/src/Csound/Typed/GlobalState/Opcodes.hs
@@ -12,6 +12,7 @@ module Csound.Typed.GlobalState.Opcodes(
out, outs, safeOut, autoOff, turnoff, turnoff2, exitnow,
-- * vco2
oscili, oscilikt, vco2ft, vco2ift, vco2init, ftgen,
+ syncphasor, tableikt,
-- * OSC
oscInit, oscListen, oscSend,
-- * channels
@@ -84,7 +85,7 @@ servantUpdateChnAlive :: Monad m => Int -> DepT m ()
servantUpdateChnAlive pargId = do
let sName = chnAliveName (pn pargId)
kAlive <- chngetK sName
- when1 (kAlive <* -10) $ do
+ when1 Kr (kAlive <* -10) $ do
turnoff
chnsetK (kAlive - 1) sName
@@ -96,7 +97,7 @@ servantUpdateChnRetrig pargId = do
let sName = chnRetrigName (pn pargId)
let retrigVal = pn $ pargId + 1
kRetrig <- chngetK sName
- when1 (kRetrig /=* retrigVal) $ do
+ when1 Kr (kRetrig /=* retrigVal) $ do
turnoff
servantUpdateChnEvtLoop :: Monad m => Int -> DepT m ()
@@ -219,12 +220,12 @@ safeOut :: Double -> [E] -> [E]
safeOut gainLevel = fmap (( * double gainLevel) . limiter)
limiter :: E -> E
-limiter x = opcs "compress" [(Ar, [Ar, Ar, Kr, Kr, Kr, Kr, Kr, Kr, Ir])] [x, 1, 0, 89, 89, 100, 0, 0, 0]
+limiter x = opcs "compress" [(Ar, [Ar, Ar, Kr, Kr, Kr, Kr, Kr, Kr, Ir])] [x, 1, 0, 90, 90, 100, 0, 0, 0]
autoOff :: Monad m => E -> [E] -> DepT m [E]
autoOff dt a = do
ihold
- when1 (trig a)
+ when1 Kr (trig a)
turnoff
return a
where
@@ -301,6 +302,14 @@ genIdE genId = case genId of
vco2init :: [E] -> E
vco2init = opcs "vco2init" [(Ir, repeat Ir)]
+syncphasor :: E -> E -> Maybe E -> (E, E)
+syncphasor xcps asyncin mphase = getPair $ mopcs "syncphasor" ([Ar, Ar], [Xr, Ar, Ir]) $ case mphase of
+ Nothing -> [xcps, asyncin]
+ Just phase -> [xcps, asyncin, phase]
+
+tableikt :: E -> E -> E
+tableikt xndx kfn = opcs "tableikt" [(Ar, [Xr, Kr, Ir, Ir, Ir])] [xndx, kfn, 1]
+
-----------------------------------------------------------
-- OSC
diff --git a/src/Csound/Typed/GlobalState/Options.hs b/src/Csound/Typed/GlobalState/Options.hs
index 9be6b3f..c866c7e 100644
--- a/src/Csound/Typed/GlobalState/Options.hs
+++ b/src/Csound/Typed/GlobalState/Options.hs
@@ -34,7 +34,7 @@ data Options = Options
, csdSampleRate :: Maybe Int -- ^ The sample rate
, csdBlockSize :: Maybe Int -- ^ The number of audio samples in one control step
, csdGain :: Maybe Double -- ^ A gain of the final output
- , csdTabFi :: Maybe TabFi -- ^ Default fidelity of the arrays
+ , csdTabFi :: Maybe TabFi -- ^ Default fidelity of the arrays
}
instance Default Options where
@@ -134,4 +134,3 @@ idExp = "exp"
idSone = "sone"
idFarey = "farey"
idWave = "wave"
-
diff --git a/src/Csound/Typed/Gui.hs b/src/Csound/Typed/Gui.hs
index 12687dc..ab00b80 100644
--- a/src/Csound/Typed/Gui.hs
+++ b/src/Csound/Typed/Gui.hs
@@ -5,4 +5,3 @@ module Csound.Typed.Gui (
import Csound.Typed.Gui.Gui
import Csound.Typed.Gui.Widget
-
diff --git a/src/Csound/Typed/Gui/Cab.hs b/src/Csound/Typed/Gui/Cab.hs
new file mode 100644
index 0000000..eed4ea5
--- /dev/null
+++ b/src/Csound/Typed/Gui/Cab.hs
@@ -0,0 +1,25 @@
+module Csound.Typed.Gui.Cab(
+ Cab, CabProp, Col(..), cabbage,
+
+ -- * Widgets
+ button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,
+ hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,
+ rslider, soundfiler, signaldisplay, textbox, texteditor, xypad,
+
+ -- * Properties
+ bounds, channel, text1, text2, value, colour, colour0, colour1, backgroundcolour, textcolour, trackercolour, outlinecolour,
+ fontcolour, fontcolour0, fontcolour1, latched, identchannel, rotate, alpha, visible, caption, widgetarray, popuptext,
+ active, svgfile, populate, mode, file, shape, corners, channeltype, align, sliderincr, max, min, textbox', trackerthickness,
+ linethickness, range, range2, size, pluginid, guirefresh, plant, child, show, middlec, keywidth, scrollbars, fontstyle,
+ scrubberpos, zoom, displaytype, updaterate, wrap
+) where
+
+import Prelude hiding (show, min, max)
+
+import Csound.Typed.Gui.Cabbage.Cabbage
+
+import qualified Csound.Typed.GlobalState as G
+import Csound.Typed.GlobalState(SE)
+
+cabbage :: Cab -> SE ()
+cabbage = G.geToSe . G.cabbage
diff --git a/src/Csound/Typed/Gui/Cabbage/Cabbage.hs b/src/Csound/Typed/Gui/Cabbage/Cabbage.hs
new file mode 100644
index 0000000..e93594e
--- /dev/null
+++ b/src/Csound/Typed/Gui/Cabbage/Cabbage.hs
@@ -0,0 +1,256 @@
+{-# Language GeneralizedNewtypeDeriving #-}
+module Csound.Typed.Gui.Cabbage.Cabbage(
+ Cab, CabProp, Col(..), runCab,
+
+ -- * Widgets
+ button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,
+ hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,
+ rslider, soundfiler, signaldisplay, textbox, texteditor, xypad,
+
+ -- * Properties
+ bounds, channel, text1, text2, value, colour, colour0, colour1, backgroundcolour, textcolour, trackercolour, outlinecolour,
+ fontcolour, fontcolour0, fontcolour1, latched, identchannel, rotate, alpha, visible, caption, widgetarray, popuptext,
+ active, svgfile, populate, mode, file, shape, corners, channeltype, align, sliderincr, max, min, textbox', trackerthickness,
+ linethickness, range, range2, size, pluginid, guirefresh, plant, child, show, middlec, keywidth, scrollbars, fontstyle,
+ scrubberpos, zoom, displaytype, updaterate, wrap
+
+) where
+
+import Prelude hiding (show, min, max)
+
+import Data.Maybe
+import Control.Monad.Trans.Writer.Strict
+
+import Csound.Typed.Gui.Cabbage.CabbageLang
+
+type Cab = Cab' ()
+type CabProp = CabProp' ()
+
+-- | The Cab is a monad for Cabbage markup language.
+-- The markup description can be constructed in the same way as blaze-html markup.
+newtype Cab' a = Cab' { unCab' :: Writer [Line] a }
+ deriving (Functor, Applicative, Monad)
+
+runCab :: Cab -> [Line]
+runCab = snd . runWriter . unCab'
+
+newtype CabProp' a = CabProp' { unCabProp' :: Writer [Property] a }
+ deriving (Functor, Applicative, Monad)
+
+runCabProp :: CabProp -> [Property]
+runCabProp = snd . runWriter . unCabProp'
+
+---------------------------------------
+-- widgets
+
+widget :: String -> CabProp -> Cab
+widget name props = Cab' $ tell [Line name $ runCabProp props]
+
+---------------------------------------
+
+button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,
+ hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,
+ rslider, soundfiler, signaldisplay, textbox, texteditor, xypad :: CabProp -> Cab
+
+button = widget "button"
+filebutton = widget "filebutton"
+infobutton = widget "infobutton"
+checkbox = widget "checkbox"
+combobox = widget "combobox"
+csoundoutput = widget "csoundoutput"
+encoder = widget "encoder"
+gentable = widget "gentable"
+hrange = widget "hrange"
+vrange = widget "vrange"
+form = widget "form"
+groupbox = widget "groupbox"
+image = widget "image"
+keyboard = widget "keyboard"
+label = widget "label"
+hslider = widget "hslider"
+vslider = widget "vslider"
+rslider = widget "rslider"
+soundfiler = widget "soundfiler"
+signaldisplay = widget "signaldisplay"
+textbox = widget "textbox"
+texteditor = widget "texteditor"
+xypad = widget "xypad"
+
+---------------------------------------
+-- properties
+
+mkProperty :: String -> [Arg] -> CabProp
+mkProperty name args = CabProp' $ tell [Property name args]
+
+data Col = Hash String | Rgb Int Int Int
+
+colProp x = case x of
+ Hash a -> [StringArg a]
+ Rgb r g b -> fmap IntArg [r, g, b]
+
+boolProp x = IntArg $ if x then 1 else 0
+
+bounds :: Int -> Int -> Int -> Int -> CabProp
+bounds x y w h = mkProperty "bounds" (fmap IntArg [x, y, w, h])
+
+channel :: String -> CabProp
+channel name = mkProperty "channel" [StringArg name]
+
+text1 :: String -> CabProp
+text1 name = mkProperty "text" [StringArg name]
+
+text2 :: String -> String -> CabProp
+text2 name1 name2 = mkProperty "text" [StringArg name1, StringArg name2]
+
+value :: Float -> CabProp
+value x = mkProperty "value" [FloatArg x]
+
+colour :: Col -> CabProp
+colour col = mkProperty "colour" (colProp col)
+
+colour0 :: Col -> CabProp
+colour0 col = mkProperty "colour:0" (colProp col)
+
+colour1 :: Col -> CabProp
+colour1 col = mkProperty "colour:1" (colProp col)
+
+backgroundcolour :: Col -> CabProp
+backgroundcolour col = mkProperty "backgroundcolour" (colProp col)
+
+textcolour :: Col -> CabProp
+textcolour col = mkProperty "textcolour" (colProp col)
+
+trackercolour :: Col -> CabProp
+trackercolour col = mkProperty "trackercolour" (colProp col)
+
+outlinecolour :: Col -> CabProp
+outlinecolour col = mkProperty "outlinecolour" (colProp col)
+
+fontcolour :: Col -> CabProp
+fontcolour col = mkProperty "fontcolour" (colProp col)
+
+fontcolour0 :: Col -> CabProp
+fontcolour0 col = mkProperty "fontcolour:0" (colProp col)
+
+fontcolour1 :: Col -> CabProp
+fontcolour1 col = mkProperty "fontcolour:1" (colProp col)
+
+latched :: Bool -> CabProp
+latched b = mkProperty "latched" [boolProp b]
+
+identchannel :: String -> CabProp
+identchannel s = mkProperty "identchannel" [StringArg s]
+
+rotate :: Float -> Float -> Float -> CabProp
+rotate radians pivotx pivoty = mkProperty "rotate" $ fmap FloatArg [radians, pivotx, pivoty]
+
+alpha :: Float -> CabProp
+alpha a = mkProperty "alpha" [FloatArg a]
+
+visible :: Bool -> CabProp
+visible a = mkProperty "visible" [boolProp a]
+
+caption :: String -> CabProp
+caption a = mkProperty "caption" [StringArg a]
+
+widgetarray :: String -> Int -> CabProp
+widgetarray name n = mkProperty "widgetarray" [StringArg name, IntArg n]
+
+popuptext :: String -> CabProp
+popuptext a = mkProperty "popuptext" [StringArg a]
+
+active :: Bool -> CabProp
+active a = mkProperty "active" [boolProp a]
+
+svgfile :: String -> String -> CabProp
+svgfile ty file = mkProperty "svgfile" (fmap StringArg [ty, file])
+
+populate :: String -> String -> CabProp
+populate filetype dir = mkProperty "populate" (fmap StringArg [filetype, dir])
+
+mode :: String -> CabProp
+mode a = mkProperty "mode" [StringArg a]
+
+file :: String -> CabProp
+file a = mkProperty "file" [StringArg a]
+
+shape :: String -> CabProp
+shape a = mkProperty "shape" [StringArg a]
+
+corners :: Float -> CabProp
+corners a = mkProperty "corners" [FloatArg a]
+
+channeltype :: String -> CabProp
+channeltype a = mkProperty "channeltype" [StringArg a]
+
+align :: String -> CabProp
+align a = mkProperty "align" [StringArg a]
+
+sliderincr :: Float -> CabProp
+sliderincr a = mkProperty "sliderincr" [FloatArg a]
+
+max :: Float -> CabProp
+max a = mkProperty "max" [FloatArg a]
+
+min :: Float -> CabProp
+min a = mkProperty "min" [FloatArg a]
+
+textbox' :: Bool -> CabProp
+textbox' a = mkProperty "textbox" [boolProp a]
+
+trackerthickness :: Float -> CabProp
+trackerthickness a = mkProperty "trackerthickness" [FloatArg a]
+
+linethickness :: Float -> CabProp
+linethickness a = mkProperty "linethickness" [FloatArg a]
+
+range :: Float -> Float -> (Float, Float) -> CabProp
+range min max value = range2 min max value Nothing Nothing
+
+range2 :: Float -> Float -> (Float, Float) -> Maybe Float -> Maybe Float -> CabProp
+range2 min max value mskew mincr = mkProperty "range" $ catMaybes [Just $ FloatArg min, Just $ FloatArg max, Just $ (uncurry ColonArg) value, fmap FloatArg mskew, fmap FloatArg mincr]
+
+size :: Int -> Int -> CabProp
+size w h = mkProperty "size" (fmap IntArg [w, h])
+
+pluginid :: String -> CabProp
+pluginid a = mkProperty "pluginid" [StringArg a]
+
+guirefresh :: Int -> CabProp
+guirefresh a = mkProperty "guirefresh" [IntArg a]
+
+plant :: String -> CabProp
+plant a = mkProperty "plant" [StringArg a]
+
+child :: Bool -> CabProp
+child a = mkProperty "child" [boolProp a]
+
+show :: Bool -> CabProp
+show a = mkProperty "show" [boolProp a]
+
+middlec :: Int -> CabProp
+middlec a = mkProperty "middlec" [IntArg a]
+
+keywidth :: Int -> CabProp
+keywidth a = mkProperty "keywidth" [IntArg a]
+
+scrollbars :: Bool -> CabProp
+scrollbars a = mkProperty "scrollbars" [boolProp a]
+
+fontstyle :: String -> CabProp
+fontstyle a = mkProperty "fontstyle" [StringArg a]
+
+scrubberpos :: Int -> CabProp
+scrubberpos a = mkProperty "scrubberpos" [IntArg a]
+
+zoom :: Float -> CabProp
+zoom a = mkProperty "zoom" [FloatArg a]
+
+displaytype :: String -> CabProp
+displaytype a = mkProperty "displaytype" [StringArg a]
+
+updaterate :: Int -> CabProp
+updaterate a = mkProperty "updaterate" [IntArg a]
+
+wrap :: Bool -> CabProp
+wrap a = mkProperty "wrap" [boolProp a]
diff --git a/src/Csound/Typed/Gui/Cabbage/CabbageLang.hs b/src/Csound/Typed/Gui/Cabbage/CabbageLang.hs
new file mode 100644
index 0000000..032dfeb
--- /dev/null
+++ b/src/Csound/Typed/Gui/Cabbage/CabbageLang.hs
@@ -0,0 +1,38 @@
+module Csound.Typed.Gui.Cabbage.CabbageLang(
+ Lang, Line(..), Property(..), Arg(..), ppCabbage
+) where
+
+import Text.PrettyPrint.Leijen
+
+type Lang = [Line]
+
+data Line = Line
+ { lineDef :: String
+ , lineProperties :: [Property]
+ }
+
+data Property = Property
+ { propertyName :: String
+ , propertyArgs :: [Arg]
+ }
+
+data Arg = StringArg String | FloatArg Float | IntArg Int | ColonArg Float Float
+
+--------------------------------------------------
+-- pretty print
+
+ppCabbage :: Lang -> Doc
+ppCabbage xs = vcat $ fmap ppLine xs
+
+ppLine :: Line -> Doc
+ppLine (Line name props) = text name <+> hcat (punctuate comma (fmap ppProp props))
+
+ppProp :: Property -> Doc
+ppProp (Property name args) = text name <> tupled (fmap ppArg args)
+
+ppArg :: Arg -> Doc
+ppArg x = case x of
+ StringArg s -> dquotes (text s)
+ FloatArg a -> float a
+ IntArg a -> int a
+ ColonArg a b -> float a <> colon <> float b \ No newline at end of file
diff --git a/src/Csound/Typed/Gui/Widget.hs b/src/Csound/Typed/Gui/Widget.hs
index e5b1f8d..c59d210 100644
--- a/src/Csound/Typed/Gui/Widget.hs
+++ b/src/Csound/Typed/Gui/Widget.hs
@@ -370,7 +370,7 @@ button name = setLabelSource name $ source $ do
where
instr ref = SE $ do
val <- readVar ref
- whens
+ whens Kr
[ (val ==* 0, writeVar ref 1)
] (writeVar ref 0)
turnoff
diff --git a/src/Csound/Typed/Lib/StableMaps/Dynamic.hs b/src/Csound/Typed/Lib/StableMaps/Dynamic.hs
deleted file mode 100644
index 7be550e..0000000
--- a/src/Csound/Typed/Lib/StableMaps/Dynamic.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-{-# LANGUAGE TypeFamilies, Rank2Types #-}
------------------------------------------------------------------------------
--- |
--- Module : System.Mem.StableName.Dynamic
--- Copyright : (c) Edward Kmett 2010
--- License : BSD3
--- Maintainer : ekmett@gmail.com
--- Stability : experimental
--- Portability : GHC only
---
--- Dynamic stable names are a way of performing fast (O(1)), not-quite-exact comparison between objects.
---
--- Dynamic stable names solve the following problem: suppose you want to build a hash table with Haskell objects as keys, but you want to use pointer equality for comparison; maybe because the keys are large and hashing would be slow, or perhaps because the keys are infinite in size. We can't build a hash table using the address of the object as the key, because objects get moved around by the garbage collector, meaning a re-hash would be necessary after every garbage collection.
------------------------------------------------------------------------------
-
-module Csound.Typed.Lib.StableMaps.Dynamic
- ( DynamicStableName(..)
- , hashDynamicStableName
- , makeDynamicStableName
- , wrapStableName
- ) where
-
-import GHC.Prim
-
-import System.Mem.StableName (StableName, makeStableName, hashStableName)
-import Unsafe.Coerce (unsafeCoerce)
-
-{-|
- An abstract name for an object, that supports equality and hashing.
-
- Dynamic stable names have the following property:
-
- * If @sn1 :: DynamicStableName@ and @sn2 :: DynamicStableName@ and @sn1 == sn2@
- then @sn1@ and @sn2@ were created by calls to @makeStableName@ on
- the same object.
-
- The reverse is not necessarily true: if two dynamic stable names are not
- equal, then the objects they name may still be equal. Note in particular
- that `makeDynamicStableName` may return a different `DynamicStableName`
- after an object is evaluated.
-
- Dynamic Stable Names are similar to Stable Pointers ("Foreign.StablePtr"),
- but differ in the following ways:
-
- * There is no @freeDynamicStableName@ operation, unlike "Foreign.StablePtr"s.
- Dynamic Stable Names are reclaimed by the runtime system when they are no
- longer needed.
-
- * There is no @deRefDynamicStableName@ operation. You can\'t get back from
- a dynamic stable name to the original Haskell object. The reason for
- this is that the existence of a stable name for an object does not
- guarantee the existence of the object itself; it can still be garbage
- collected.
-
--}
-
-newtype DynamicStableName = DynamicStableName (StableName Any)
-
--- | Makes a 'DynamicStableName' for an arbitrary object. The object passed as
--- the first argument is not evaluated by 'makeDynamicStableName'.
-makeDynamicStableName :: t -> IO DynamicStableName
-makeDynamicStableName a = do
- s <- makeStableName a
- return (wrapStableName s)
-
--- | Convert a 'DynamicStableName' to an 'Int'. The 'Int' returned is not
--- necessarily unique; several 'DynamicStableName's may map to the same 'Int'
--- (in practice however, the chances of this are small, so the result
--- of 'hashDynamicStableName' makes a good hash key).
-hashDynamicStableName :: DynamicStableName -> Int
-hashDynamicStableName (DynamicStableName sn) = hashStableName sn
-
-instance Eq DynamicStableName where
- DynamicStableName sn1 == DynamicStableName sn2 = sn1 == sn2
-
-wrapStableName :: StableName a -> DynamicStableName
-wrapStableName s = DynamicStableName (unsafeCoerce s)
diff --git a/src/Csound/Typed/Lib/StableMaps/Dynamic/Map.hs b/src/Csound/Typed/Lib/StableMaps/Dynamic/Map.hs
deleted file mode 100644
index 700023f..0000000
--- a/src/Csound/Typed/Lib/StableMaps/Dynamic/Map.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Unsafe #-}
-#endif
-module Csound.Typed.Lib.StableMaps.Dynamic.Map
- ( Map
- , empty
- , null
- , singleton
- , member
- , notMember
- , insert
- , insertWith
- , insertWith'
- , lookup
- , find
- , findWithDefault
- ) where
-
-import qualified Prelude
-import Prelude hiding (lookup, null)
-import Csound.Typed.Lib.StableMaps.Dynamic
-import qualified Data.IntMap as IntMap
-import Data.IntMap (IntMap)
-
-newtype Map a = Map { getMap :: IntMap [(DynamicStableName, a)] }
-
-empty :: Map a
-empty = Map IntMap.empty
-
-null :: Map a -> Bool
-null (Map m) = IntMap.null m
-
-singleton :: DynamicStableName -> a -> Map a
-singleton k v = Map $ IntMap.singleton (hashDynamicStableName k) [(k,v)]
-
-member :: DynamicStableName -> Map a -> Bool
-member k m = case lookup k m of
- Nothing -> False
- Just _ -> True
-
-notMember :: DynamicStableName -> Map a -> Bool
-notMember k m = not $ member k m
-
-insert :: DynamicStableName -> a -> Map a -> Map a
-insert k v = Map . IntMap.insertWith (++) (hashDynamicStableName k) [(k,v)] . getMap
-
--- | /O(log n)/. Insert with a function for combining the new value and old value.
--- @'insertWith' f key value mp@
--- will insert the pair (key, value) into @mp@ if the key does not exist
--- in the map. If the key does exist, the function will insert the pair
--- @(key, f new_value old_value)@
-insertWith :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a
-insertWith f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap
- where
- go _ ((k',v'):kvs)
- | k == k' = (k', f v v') : kvs
- | otherwise = (k',v') : go undefined kvs
- go _ [] = []
-
--- | Same as 'insertWith', but with the combining function applied strictly.
-insertWith' :: (a -> a -> a) -> DynamicStableName -> a -> Map a -> Map a
-insertWith' f k v = Map . IntMap.insertWith go (hashDynamicStableName k) [(k,v)] . getMap
- where
- go _ ((k',v'):kvs)
- | k == k' = let v'' = f v v' in v'' `seq` (k', v'') : kvs
- | otherwise = (k', v') : go undefined kvs
- go _ [] = []
-
--- | /O(log n)/. Lookup the value at a key in the map.
---
--- The function will return the corresponding value as a @('Just' value)@
--- or 'Nothing' if the key isn't in the map.
-lookup :: DynamicStableName -> Map v -> Maybe v
-lookup k (Map m) = do
- pairs <- IntMap.lookup (hashDynamicStableName k) m
- Prelude.lookup k pairs
-
-find :: DynamicStableName -> Map v -> v
-find k m = case lookup k m of
- Nothing -> error "Map.find: element not in the map"
- Just x -> x
-
--- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
--- the value at key @k@ or returns the default value @def@
--- when the key is not in the map.
-findWithDefault :: v -> DynamicStableName -> Map v -> v
-findWithDefault dflt k m = maybe dflt id $ lookup k m
diff --git a/src/Csound/Typed/Plugins.hs b/src/Csound/Typed/Plugins.hs
new file mode 100644
index 0000000..fbc9483
--- /dev/null
+++ b/src/Csound/Typed/Plugins.hs
@@ -0,0 +1,39 @@
+module Csound.Typed.Plugins(
+ adsr140,
+ audaciousEq,
+
+ -- Solina chorus
+ solinaChorus, testSolinaChorus,
+
+ -- One pole filters
+ zdf1, zlp1, zhp1, zap1,
+
+ -- Two pole filters
+ zdf2, zlp, zbp, zhp, zdf2_notch, zbr,
+
+ -- Ladder filter
+ zladder,
+
+ -- Four poles filters
+ zdf4, zlp4, zbp4, zhp4,
+
+ -- Eq-filters
+ peakEq, highShelf, lowShelf,
+
+ -- Diode ladder filters
+ diode, linDiode, noNormDiode,
+
+ -- Korg 35 filters
+ linKorg_lp, linKorg_hp, korg_lp, korg_hp,
+
+ -- zero delay convolution
+ ZConvSpec(..), zconv, zconv'
+) where
+
+import Csound.Typed.Plugins.Adsr140
+import Csound.Typed.Plugins.Zdf
+import Csound.Typed.Plugins.Diode
+import Csound.Typed.Plugins.Audaciouseq
+import Csound.Typed.Plugins.Korg35
+import Csound.Typed.Plugins.SolinaChorus
+import Csound.Typed.Plugins.ZeroDelayConvolution \ No newline at end of file
diff --git a/src/Csound/Typed/Plugins/Adsr140.hs b/src/Csound/Typed/Plugins/Adsr140.hs
new file mode 100644
index 0000000..75fefaa
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Adsr140.hs
@@ -0,0 +1,25 @@
+module Csound.Typed.Plugins.Adsr140(
+ adsr140
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(adsr140Plugin)
+
+
+-------------------------------------------------------------------------------
+
+-- | Gated, Re-triggerable ADSR modeled after the Doepfer A-140
+-- opcode adsr140, a, aakkkk
+--
+-- inputs: agate, aretrig, kattack, kdecay, ksustain, krelease
+adsr140 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+adsr140 agate aretrig kattack kdecay ksustain krelease = fromGE $ do
+ addUdoPlugin E.adsr140Plugin
+ f <$> toGE agate <*> toGE aretrig <*> toGE kattack <*> toGE kdecay <*> toGE ksustain <*> toGE krelease
+ where f agate aretrig kattack kdecay ksustain krelease = opcs "adsr140" [(Ar, [Ar, Ar, Kr, Kr, Kr, Kr])] [agate, aretrig, kattack, kdecay, ksustain, krelease]
diff --git a/src/Csound/Typed/Plugins/Audaciouseq.hs b/src/Csound/Typed/Plugins/Audaciouseq.hs
new file mode 100644
index 0000000..d35b33c
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Audaciouseq.hs
@@ -0,0 +1,33 @@
+module Csound.Typed.Plugins.Audaciouseq(
+ audaciousEq
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(audaciouseqPlugin)
+
+-------------------------------------------------------------------------------
+
+-- | opcode audaciouseq, a, kkkkkkkkkka
+--
+-- inputs: kgain1, kgain2, kgain3, kgain4, kgain5,
+-- kgain6, kgain7, kgain8, kgain9, kgain10 ain
+--
+-- 10-band EQ
+-- Input: kgain1, kgain2, ... kgain10, asig
+-- Output: aout
+--
+-- 10 kgain arguments maps to each band
+-- Bands are: 31.25, 52.6, 125, 500, 1000,
+-- 2000, 4000, 8000, 16000
+--
+audaciousEq :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+audaciousEq kgain1 kgain2 kgain3 kgain4 kgain5 kgain6 kgain7 kgain8 kgain9 kgain10 ain = fromGE $ do
+ addUdoPlugin E.audaciouseqPlugin
+ f <$> toGE ain <*> toGE kgain1 <*> toGE kgain2 <*> toGE kgain3 <*> toGE kgain4 <*> toGE kgain5 <*> toGE kgain6 <*> toGE kgain7 <*> toGE kgain8 <*> toGE kgain9 <*> toGE kgain10
+ where f ain kgain1 kgain2 kgain3 kgain4 kgain5 kgain6 kgain7 kgain8 kgain9 kgain10 = opcs "audaciouseq" [(Ar, [Ar, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr])] [ain, kgain1, kgain2, kgain3, kgain4, kgain5, kgain6, kgain7, kgain8, kgain9, kgain10]
diff --git a/src/Csound/Typed/Plugins/Diode.hs b/src/Csound/Typed/Plugins/Diode.hs
new file mode 100644
index 0000000..81d46dd
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Diode.hs
@@ -0,0 +1,75 @@
+module Csound.Typed.Plugins.Diode(
+ diode, linDiode, noNormDiode
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(diodePlugin)
+
+-- | Linear diode ladder filter.
+--
+-- > linDiode centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+linDiode :: Sig -> Sig -> Sig -> Sig
+linDiode cfq res ain = diodeLadder ain cfq (normReson res) 0 1
+
+-- | Non-Linear normalized diode ladder filter.
+--
+-- > diode saturation centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+--
+-- saturation ranges from 1 and higher (typical value: 4)
+diode :: Sig -> Sig -> Sig -> Sig -> Sig
+diode ksaturation cfq res ain = diodeLadder ain cfq (normReson res) 1 ksaturation
+
+-- | Non-Linear not normalized diode ladder filter.
+--
+-- > noNormDiode saturation centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+--
+-- saturation ranges from 1 and higher (typical value: 4)
+noNormDiode :: Sig -> Sig -> Sig -> Sig -> Sig
+noNormDiode ksaturation cfq res ain = diodeLadder ain cfq (normReson res) 2 ksaturation
+
+normReson :: Sig -> Sig
+normReson res = res * 17
+
+-------------------------------------------------------------------------------
+
+-- | Diode Ladder Filter
+--
+-- Based on code by Will Pirkle, presented in:
+--
+-- http://www.willpirkle.com/Downloads/AN-6DiodeLadderFilter.pdf
+--
+-- and in his book "Designing software synthesizer plug-ins in C++ : for
+-- RackAFX, VST3, and Audio Units"
+--
+-- UDO version by Steven Yi (2016.xx.xx)
+--
+-- ARGS
+-- ain - signal to filter
+-- acf/kcf - cutoff frequency
+-- ak/kk - k-value that controls resonance, self-resonance occurs at k=17;
+-- knlp - use non-linear processing:
+-- 0 - none
+-- 1 - normalized (outputs to range +-1.0)
+-- 2 - non-normalized (less expensive than normalized, range +-0.8)
+-- ksaturation - saturation amount for non-linear processing
+-- (default: 1.0, greater values lead to higher saturation)
+diodeLadder :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+diodeLadder ain xcf xk knlp ksaturation = fromGE $ do
+ addUdoPlugin E.diodePlugin
+ f <$> toGE ain <*> toGE xcf <*> toGE xk <*> toGE knlp <*> toGE ksaturation
+ where f ain xcf xk knlp ksaturation = opcs "diode_ladder" [(Ar, [Ar, Xr, Xr, Kr, Kr])] [ain, xcf, xk, knlp, ksaturation]
diff --git a/src/Csound/Typed/Plugins/Korg35.hs b/src/Csound/Typed/Plugins/Korg35.hs
new file mode 100644
index 0000000..6395db9
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Korg35.hs
@@ -0,0 +1,99 @@
+module Csound.Typed.Plugins.Korg35(
+ linKorg_lp, linKorg_hp, korg_lp, korg_hp
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(korg35Plugin)
+
+-- | Linear korg 35 low pass filter (12 dB).
+--
+-- > linDiode centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+linKorg_lp :: Sig -> Sig -> Sig -> Sig
+linKorg_lp cfq res ain = k35_lpf ain cfq (normReson res) 0 1
+
+-- | Linear korg 35 high pass filter (6 dB).
+--
+-- > linDiode centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+linKorg_hp :: Sig -> Sig -> Sig -> Sig
+linKorg_hp cfq res ain = k35_hpf ain cfq (normReson res) 0 1
+
+
+-- | Korg 35 low pass filter (12 dB).
+--
+-- > diode saturation centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+--
+-- saturation ranges from 1 and higher (typical value: 4)
+korg_lp :: Sig -> Sig -> Sig -> Sig -> Sig
+korg_lp ksaturation cfq res ain = k35_lpf ain cfq (normReson res) 1 ksaturation
+
+-- | Korg 35 high pass filter (6 dB).
+--
+-- > diode saturation centerFrequency resonance asig
+--
+-- resonance ranges in the interval [0, 1] and higher.
+-- self-resonance occurs at 1.
+--
+-- saturation ranges from 1 and higher (typical value: 4)
+korg_hp :: Sig -> Sig -> Sig -> Sig -> Sig
+korg_hp ksaturation cfq res ain = k35_hpf ain cfq (normReson res) 1 ksaturation
+
+normReson :: Sig -> Sig
+normReson res = res * 10
+
+-------------------------------------------------------------------------------
+
+-- 12db/oct low-pass filter based on Korg 35 module
+-- (found in MS-10 and MS-20).
+--
+-- Based on code by Will Pirkle, presented in:
+--
+-- http://www.willpirkle.com/Downloads/AN-5Korg35_V3.pdf
+--
+-- [ARGS]
+--
+-- ain - audio input
+-- acutoff - frequency of cutoff
+-- kQ - filter Q [1, 10.0] (k35-lpf will clamp to boundaries)
+-- knonlinear - use non-linear processing
+-- ksaturation - saturation for tanh distortion
+k35_lpf :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+k35_lpf ain acutoff kQ knonlinear ksaturation = fromGE $ do
+ addUdoPlugin E.korg35Plugin
+ f <$> toGE ain <*> toGE acutoff <*> toGE kQ <*> toGE knonlinear <*> toGE ksaturation
+ where f ain acutoff kQ knonlinear ksaturation = opcs "k35_lpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain, acutoff, kQ, knonlinear, ksaturation]
+
+
+-- 6db/oct high-pass filter based on Korg 35 module
+-- (found in MS-10 and MS-20).
+--
+-- Based on code by Will Pirkle, presented in:
+--
+-- http://www.willpirkle.com/Downloads/AN-7Korg35HPF_V2.pdf
+--
+-- [ARGS]
+--
+-- ain - audio input
+-- acutoff - frequency of cutoff
+-- kQ - filter Q [1, 10.0] (k35_hpf will clamp to boundaries)
+-- knonlinear - use non-linear processing
+-- ksaturation - saturation for tanh distortion
+k35_hpf :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+k35_hpf ain acutoff kQ knonlinear ksaturation = fromGE $ do
+ addUdoPlugin E.korg35Plugin
+ f <$> toGE ain <*> toGE acutoff <*> toGE kQ <*> toGE knonlinear <*> toGE ksaturation
+ where f ain acutoff kQ knonlinear ksaturation = opcs "k35_hpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain, acutoff, kQ, knonlinear, ksaturation]
diff --git a/src/Csound/Typed/Plugins/SolinaChorus.hs b/src/Csound/Typed/Plugins/SolinaChorus.hs
new file mode 100644
index 0000000..80bc046
--- /dev/null
+++ b/src/Csound/Typed/Plugins/SolinaChorus.hs
@@ -0,0 +1,60 @@
+module Csound.Typed.Plugins.SolinaChorus(
+ solinaChorus, testSolinaChorus
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(solinaChorusPlugin)
+
+-- Solina Chorus, based on Solina String Ensemble Chorus Module
+--
+-- based on:
+--
+-- J. Haible: Triple Chorus
+-- http://jhaible.com/legacy/triple_chorus/triple_chorus.html
+--
+-- > solinaChorus (lfo_amp1, lfo_freq1) (lfo_amp2, lfo_freq2)
+--
+-- Author: Steven Yi
+-- Date: 2016.05.22
+--
+-- Example
+--
+-- > x = solinaChorus (0.6, 0.18) (0.2, 6) x
+solinaChorus :: (Sig, Sig) -> (Sig, Sig) -> Sig -> Sig
+solinaChorus (amp1, cps1) (amp2, cps2) ain = solina_chorus ain cps1 amp1 cps2 amp2
+
+testSolinaChorus :: Sig -> Sig
+testSolinaChorus x = solinaChorus (0.6, 0.18) (0.2, 6) x
+
+-------------------------------------------------------------------------------
+
+-- Solina Chorus, based on Solina String Ensemble Chorus Module
+--
+-- based on:
+--
+-- J. Haible: Triple Chorus
+-- http://jhaible.com/legacy/triple_chorus/triple_chorus.html
+--
+-- Hugo Portillo: Solina-V String Ensemble
+-- http://www.native-instruments.com/en/reaktor-community/reaktor-user-library/entry/show/4525/
+--
+-- Parabola tabled shape borrowed from Iain McCurdy delayStereoChorus.csd:
+-- http://iainmccurdy.org/CsoundRealtimeExamples/Delays/delayStereoChorus.csd
+--
+-- Author: Steven Yi
+-- Date: 2016.05.22
+--
+-- opcode solina_chorus, a, aKKKK
+--
+-- aLeft, klfo_freq1, klfo_amp1, klfo_freq2, klfo_amp2 xin
+solina_chorus :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig
+solina_chorus aLeft klfo_freq1 klfo_amp1 klfo_freq2 klfo_amp2 = fromGE $ do
+ addUdoPlugin E.solinaChorusPlugin
+ f <$> toGE aLeft <*> toGE klfo_freq1 <*> toGE klfo_amp1 <*> toGE klfo_freq2 <*> toGE klfo_amp2
+ where f aLeft klfo_freq1 klfo_amp1 klfo_freq2 klfo_amp2 = opcs "solina_chorus" [(Ar, [Ar, Kr, Kr, Kr, Kr])] [aLeft, klfo_freq1, klfo_amp1, klfo_freq2, klfo_amp2]
diff --git a/src/Csound/Typed/Plugins/Zdf.hs b/src/Csound/Typed/Plugins/Zdf.hs
new file mode 100644
index 0000000..b071647
--- /dev/null
+++ b/src/Csound/Typed/Plugins/Zdf.hs
@@ -0,0 +1,209 @@
+-- Zero delay filters (implemented in Csound by Steven Yi)
+module Csound.Typed.Plugins.Zdf(
+ -- One pole filters
+ zdf1, zlp1, zhp1, zap1,
+
+ -- Two pole filters
+ zdf2, zlp, zbp, zhp, zdf2_notch, zbr,
+
+ -- Ladder filter
+ zladder,
+
+ -- Four poles filters
+ zdf4, zlp4, zbp4, zhp4,
+
+ -- Eq-filters
+ peakEq, highShelf, lowShelf
+) where
+
+import Data.Boolean
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(zdfPlugin)
+
+-------------------------------------------------------------------------------
+-- Haskell way (reorder arguments, split some funs)
+
+-- zdf_1pole
+
+zdf1 :: Sig -> Sig -> (Sig, Sig)
+zdf1 cfq asig = zdf_1pole asig cfq
+
+zlp1 :: Sig -> Sig -> Sig
+zlp1 cfq asig = lows
+ where (lows, _) = zdf_1pole asig cfq
+
+zhp1 :: Sig -> Sig -> Sig
+zhp1 cfq asig = highs
+ where (_, highs) = zdf_1pole asig cfq
+
+-- zdf_allpass_1pole
+
+zap1 :: Sig -> Sig -> Sig
+zap1 cfq asig = zdf_allpass_1pole asig cfq
+
+-- zdf_2pole
+
+-- outs: lp, bp, hp
+zdf2 :: Sig -> Sig -> Sig -> (Sig, Sig, Sig)
+zdf2 cfq q asig = zdf_2pole asig cfq q
+
+zlp :: Sig -> Sig -> Sig -> Sig
+zlp cfq q asig = lows
+ where (lows, _, _) = zdf2 cfq q asig
+
+zbp :: Sig -> Sig -> Sig -> Sig
+zbp cfq q asig = mids
+ where (_, mids, _) = zdf2 cfq q asig
+
+zhp :: Sig -> Sig -> Sig -> Sig
+zhp cfq q asig = highs
+ where (_, _, highs) = zdf2 cfq q asig
+
+zdf2_notch :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig)
+zdf2_notch cfq q asig = zdf_2pole_notch asig cfq q
+
+zbr cfq q asig = notch
+ where (_, _, _, notch) = zdf2_notch cfq q asig
+
+-- ladder
+
+zladder :: Sig -> Sig -> Sig -> Sig
+zladder cfq q asig = zdf_ladder asig cfq q
+
+-- zdf_4pole
+
+zdf4 :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig, Sig, Sig)
+zdf4 cfq q asig = zdf_4pole asig cfq q
+
+zlp4 :: Sig -> Sig -> Sig -> Sig
+zlp4 cfq q asig = lows
+ where (_, _, _, lows, _, _) = zdf4 cfq q asig
+
+zbp4 :: Sig -> Sig -> Sig -> Sig
+zbp4 cfq q asig = mids
+ where (_, _, _, _, mids, _) = zdf4 cfq q asig
+
+zhp4 :: Sig -> Sig -> Sig -> Sig
+zhp4 cfq q asig = highs
+ where (_, _, _, _, _, highs) = zdf4 cfq q asig
+
+-- zdf_peak_eq
+peakEq :: Sig -> Sig -> Sig -> Sig -> Sig
+peakEq kcf kres kdB ain = zdf_peak_eq ain kcf kres kdB
+
+-- zdf_high_shelf_eq
+highShelf :: Sig -> Sig -> Sig -> Sig
+highShelf kcf kres ain = zdf_high_shelf_eq ain kcf kres
+
+-- zdf_low_shelf_eq
+lowShelf :: Sig -> Sig -> Sig -> Sig
+lowShelf kcf kres ain = zdf_low_shelf_eq ain kcf kres
+
+-------------------------------------------------------------------------------
+-- Steven implementation
+
+-- 1-pole (6dB) lowpass/highpass filter
+-- takes in a a-rate signal and cutoff value in frequency
+--
+-- xout alp, ahp
+zdf_1pole :: Sig -> Sig -> (Sig, Sig)
+zdf_1pole asig cfq = toTuple $ fmap ($ 2) $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq
+ where f asig cfq = mopcs "zdf_1pole" ([Ar, Ar], [Ar, Ar]) [asig, cfq]
+
+-- 1-pole allpass filter
+-- takes in an a-rate signal and corner frequency where input
+-- phase is shifted -90 degrees
+zdf_allpass_1pole :: Sig -> Sig -> Sig
+zdf_allpass_1pole asig cfq = fromGE $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq
+ where f asig cfq = opcs "zdf_allpass_1pole" [(Ar, [Ar, Ar])] [asig, cfq]
+
+-- 2-pole (12dB) lowpass/highpass/bandpass filter
+-- takes in a a-rate signal, cutoff value in frequency, and
+-- Q factor for resonance
+--
+-- xout alp, abp, ahp
+zdf_2pole :: Sig -> Sig -> Sig -> (Sig, Sig, Sig)
+zdf_2pole asig cfq q = toTuple $ fmap ($ 3) $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE q
+ where f asig cfq q = mopcs "zdf_2pole" ([Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, q]
+
+-- 2-pole (12dB) lowpass/highpass/bandpass/notch filter
+-- takes in a a-rate signal, cutoff value in frequency, and
+-- Q factor for resonance
+--
+-- xout alp, abp, ahp, anotch
+zdf_2pole_notch :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig)
+zdf_2pole_notch asig cfq q = toTuple $ fmap ($ 4) $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE q
+ where f asig cfq q = mopcs "zdf_2pole_notch" ([Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, q]
+
+-- moog ladder
+--
+-- opcode zdf_ladder, a, akk
+--
+-- ain, kcf, kres xin
+zdf_ladder :: Sig -> Sig -> Sig -> Sig
+zdf_ladder asig cfq res = fromGE $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE res
+ where f asig cfq res = opcs "zdf_ladder" [(Ar, [Ar, Ar, Ar])] [asig, cfq, res]
+
+-- 4-pole
+--
+-- opcode zdf_4pole, aaaaaa, akk
+-- ain, kcf, kres xin
+--
+-- xout alp2, abp2, ahp2, alp4, abl4, abp4
+zdf_4pole :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig, Sig, Sig)
+zdf_4pole asig cfq res = toTuple $ fmap ($ 6) $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE res
+ where f asig cfq res = mopcs "zdf_4pole" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, res]
+
+-- 4-pole
+--
+-- opcode zdf_4pole_hp, aaaaaa, akk
+-- ain, kcf, kres xin
+--
+-- xout alp2, abp2, ahp2, alp4, abl4, abp4
+zdf_4pole_hp :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig, Sig, Sig)
+zdf_4pole_hp asig cfq res = toTuple $ fmap ($ 6) $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE res
+ where f asig cfq res = mopcs "zdf_4pole_hp" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, res]
+
+-- ;; TODO - implement
+-- opcode zdf_peak_eq, a, akkk
+-- ain, kcf, kres, kdB xin
+zdf_peak_eq :: Sig -> Sig -> Sig -> Sig -> Sig
+zdf_peak_eq ain kcf kres kdB = fromGE $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE ain <*> toGE kcf <*> toGE kres <*> toGE kdB
+ where f ain kcf kres kdB = opcs "zdf_peak_eq" [(Ar, [Ar, Kr, Kr, Kr])] [ain, kcf, kres, kdB]
+
+-- opcode zdf_high_shelf_eq, a, akk
+-- ain, kcf, kdB xin
+zdf_high_shelf_eq :: Sig -> Sig -> Sig -> Sig
+zdf_high_shelf_eq asig cfq res = fromGE $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE res
+ where f asig cfq res = opcs "zdf_high_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig, cfq, res]
+
+-- opcode zdf_low_shelf_eq, a, akk
+-- ain, kcf, kdB xin
+zdf_low_shelf_eq :: Sig -> Sig -> Sig -> Sig
+zdf_low_shelf_eq asig cfq res = fromGE $ do
+ addUdoPlugin E.zdfPlugin
+ f <$> toGE asig <*> toGE cfq <*> toGE res
+ where f asig cfq res = opcs "zdf_low_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig, cfq, res]
diff --git a/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs b/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs
new file mode 100644
index 0000000..75f37ce
--- /dev/null
+++ b/src/Csound/Typed/Plugins/ZeroDelayConvolution.hs
@@ -0,0 +1,52 @@
+module Csound.Typed.Plugins.ZeroDelayConvolution(
+ ZConvSpec(..), zconv, zconv'
+) where
+
+import Data.Boolean
+import Data.Default
+import Control.Monad.Trans.Class
+
+import Csound.Dynamic
+
+import Csound.Typed.Types
+import Csound.Typed.GlobalState
+import qualified Csound.Typed.GlobalState.Elements as E(zeroDelayConvolutionPlugin)
+
+
+-- | Zero convolution specification
+data ZConvSpec = ZConvSpec
+ { zconvPartSize :: D -- ^ first partition size in samples
+ , zconvRatio :: D -- ^ partition growth ratio
+ , zconvNp :: D -- ^ total number of partition sizes
+ }
+
+instance Default ZConvSpec where
+ def = ZConvSpec 64 4 6
+
+-------------------------------------------------------------------------------
+
+-- | Zero delay convolution with default parameters.
+--
+-- > zconv tabIR ain = ...
+zconv :: Tab -> Sig -> Sig
+zconv = zconv' def
+
+-- | zero delay convolution.
+--
+-- > zconv' (ZConvSpec ipart irat inp) ifn ain
+--
+-- Original UDO code by Victor Lazzarini.
+--
+-- /**************************************************
+-- asig ZConv ain,ipart,irat,inp,ifn
+-- ain - input signal
+-- ipart - first partition size in samples
+-- irat - partition growth ratio
+-- inp - total number of partition sizes
+-- ifn - function table number containing the IR
+-- **************************************************/
+zconv' :: ZConvSpec -> Tab -> Sig -> Sig
+zconv' (ZConvSpec ipart irat inp) ifn ain = fromGE $ do
+ addUdoPlugin E.zeroDelayConvolutionPlugin
+ f <$> toGE ain <*> toGE ipart <*> toGE irat <*> toGE inp <*> toGE ifn
+ where f ain ipart irat inp ifn = opcs "ZConv" [(Ar, [Ar, Ir, Ir, Ir, Ir])] [ain, ipart, irat, inp, ifn]
diff --git a/src/Csound/Typed/Render.hs b/src/Csound/Typed/Render.hs
index 1a325e8..df22da3 100644
--- a/src/Csound/Typed/Render.hs
+++ b/src/Csound/Typed/Render.hs
@@ -17,6 +17,8 @@ import Data.List(sortBy, groupBy)
import qualified Data.IntMap as IM
import Control.Monad.IO.Class
+import Text.PrettyPrint.Leijen(displayS, renderPretty)
+
import Csound.Dynamic hiding (csdFlags)
import Csound.Typed.Types
import Csound.Typed.GlobalState
@@ -27,6 +29,7 @@ import Csound.Typed.Control(getIns)
import Csound.Dynamic.Types.Flags
import Csound.Typed.Gui.Gui(guiStmt, panelIsKeybdSensitive)
+import Csound.Typed.Gui.Cabbage.CabbageLang(ppCabbage)
toCsd :: Tuple a => Maybe Int -> Options -> SE a -> GE Csd
@@ -77,17 +80,22 @@ renderHistory mnchnls_i nchnls opt = do
hist2 <- getHistory
let namedIntruments = fmap (\(name, body) -> Instr (InstrLabel name) body) $ unNamedInstrs $ namedInstrs hist2
let orc = Orc instr0 ((namedIntruments ++ ) $ maybeAppend keyEventListener $ fmap (uncurry Instr) $ instrsContent $ instrs hist2)
- hist3 <- getHistory
+ hist3 <- getHistory
let flags = reactOnMidi hist3 $ csdFlags opt
sco = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3)
(renderGens (genMap hist3) (writeGenMap hist3)) $
- ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3))
- return $ Csd flags orc sco
+ ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3))
+ let plugins = getPlugins opt hist3
+ return $ Csd flags orc sco plugins
where
renderGens gens writeGens = (fmap swap $ M.toList $ idMapContent gens) ++ writeGens
maybeAppend ma = maybe id (:) ma
getNoteEvents = fmap $ \(instrId, evt) -> (instrId, [evt])
+ getPlugins opt hist = case cabbageGui hist of
+ Nothing -> []
+ Just x -> [(Plugin "Cabbage" (displayS (renderPretty 1 10000 $ ppCabbage x) ""))]
+
getInstr0 :: Maybe Int -> Int -> Options -> Dep () -> History -> Dep ()
getInstr0 mnchnls_i nchnls opt udos hist = do
globalConstants
diff --git a/src/Csound/Typed/Types/Prim.hs b/src/Csound/Typed/Types/Prim.hs
index 3ac2e0b..5782da5 100644
--- a/src/Csound/Typed/Types/Prim.hs
+++ b/src/Csound/Typed/Types/Prim.hs
@@ -612,7 +612,7 @@ whens bodies el = case bodies of
where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBegin p >> body)
ifBegin :: BoolSig -> SE ()
-ifBegin a = fromDep_ $ D.ifBegin =<< lift (toGE a)
+ifBegin a = fromDep_ $ D.ifBegin Kr =<< lift (toGE a)
ifEnd :: SE ()
ifEnd = fromDep_ D.ifEnd
@@ -644,7 +644,7 @@ whenDs bodies el = case bodies of
where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBeginD p >> body)
ifBeginD :: BoolD -> SE ()
-ifBeginD a = fromDep_ $ D.ifBegin =<< lift (toGE a)
+ifBeginD a = fromDep_ $ D.ifBegin Ir =<< lift (toGE a)
-- elseIfBegin :: BoolSig -> SE ()
-- elseIfBegin a = fromDep_ $ D.elseIfBegin =<< lift (toGE a)
diff --git a/src/Csound/Typed/Types/Tuple.hs b/src/Csound/Typed/Types/Tuple.hs
index eaf2237..e5d766a 100644
--- a/src/Csound/Typed/Types/Tuple.hs
+++ b/src/Csound/Typed/Types/Tuple.hs
@@ -164,6 +164,12 @@ instance Sigs Sig4
instance Sigs Sig6
instance Sigs Sig8
+instance Sigs (Sig2, Sig2)
+instance Sigs (Sig2, Sig2, Sig2)
+instance Sigs (Sig2, Sig2, Sig2, Sig2)
+instance Sigs (Sig2, Sig2, Sig2, Sig2, Sig2)
+instance Sigs (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2)
+
instance Sigs (Sig8, Sig8)
instance Sigs (Sig8, Sig8, Sig8, Sig8)
@@ -354,4 +360,47 @@ instance Num (Sig8, Sig8, Sig8, Sig8) where
signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
+instance Num (Sig2, Sig2) where
+ (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)
+ (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)
+ negate (a1, a2) = (negate a1, negate a2)
+ fromInteger n = (fromInteger n, fromInteger n)
+ signum (a1, a2) = (signum a1, signum a2)
+ abs (a1, a2) = (abs a1, abs a2)
+
+instance Num (Sig2, Sig2, Sig2) where
+ (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)
+ (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)
+ negate (a1, a2, a3) = (negate a1, negate a2, negate a3)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3) = (signum a1, signum a2, signum a3)
+ abs (a1, a2, a3) = (abs a1, abs a2, abs a3)
+
+instance Num (Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)
+ (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)
+ negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)
+ abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)
+
+instance Num (Sig2, Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)
+ (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)
+ negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)
+ abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)
+
+instance Num (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where
+ (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)
+ (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)
+ negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)
+
+ fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)
+ signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)
+ abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)