csound-expression-typed 0.0.9.3 → 0.1.0.0

raw patch · 34 files changed

+3278/−221 lines, 34 filesdep ~csound-expression-dynamicPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: csound-expression-dynamic

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +23/−5
• data/opcodes/adsr140.udo +111/−0
• data/opcodes/audaciouseq.udo +81/−0
• data/opcodes/diode.udo +342/−0
• data/opcodes/korg35.udo +385/−0
• data/opcodes/solina_chorus.udo +56/−0
• data/opcodes/tdf2.udo +166/−0
• data/opcodes/zdf.udo +540/−0
• data/opcodes/zero-delay-convolution.udo +31/−0
• src/Csound/Typed/Control/Api.hs +2/−2
• src/Csound/Typed/Control/Vco.hs +429/−1
• src/Csound/Typed/GlobalState.hs +1/−1
• src/Csound/Typed/GlobalState/Elements.hs +105/−27
• src/Csound/Typed/GlobalState/GE.hs +18/−7
• src/Csound/Typed/GlobalState/Opcodes.hs +13/−4
• src/Csound/Typed/GlobalState/Options.hs +1/−2
• src/Csound/Typed/Gui.hs +0/−1
• src/Csound/Typed/Gui/Cab.hs +25/−0
• src/Csound/Typed/Gui/Cabbage/Cabbage.hs +256/−0
• src/Csound/Typed/Gui/Cabbage/CabbageLang.hs +38/−0
• src/Csound/Typed/Gui/Widget.hs +1/−1
• src/Csound/Typed/Lib/StableMaps/Dynamic.hs +0/−77
• src/Csound/Typed/Lib/StableMaps/Dynamic/Map.hs +0/−88
• src/Csound/Typed/Plugins.hs +39/−0
• src/Csound/Typed/Plugins/Adsr140.hs +25/−0
• src/Csound/Typed/Plugins/Audaciouseq.hs +33/−0
• src/Csound/Typed/Plugins/Diode.hs +75/−0
• src/Csound/Typed/Plugins/Korg35.hs +99/−0
• src/Csound/Typed/Plugins/SolinaChorus.hs +60/−0
• src/Csound/Typed/Plugins/Zdf.hs +209/−0
• src/Csound/Typed/Plugins/ZeroDelayConvolution.hs +52/−0
• src/Csound/Typed/Render.hs +11/−3
• src/Csound/Typed/Types/Prim.hs +2/−2
• src/Csound/Typed/Types/Tuple.hs +49/−0

@@ -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,7 +26,16 @@     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 @@   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 @@     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 @@     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 

@@ -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

@@ -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++

@@ -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+

@@ -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

@@ -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

@@ -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+

@@ -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

@@ -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

@@ -57,9 +57,9 @@             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 

@@ -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 @@     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

@@ -5,7 +5,7 @@     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,

@@ -8,9 +8,10 @@     -- 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 @@     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 @@  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 @@ 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) -saveBandLimited :: BandLimited -> State (GenMap, BandLimitedMap) Int+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)++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 = 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))        +        userGen gen = state $ \blMap -> +            let genMap = vcoInitMap blMap+                (newId, genMap1) = runState (saveId gen) genMap+                blMap1 = blMap { vcoInitMap = genMap1 }                    +            in  (UserBandLimitedWave newId, 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,10 +293,23 @@         dummyVar = Var LocalVar Ir "ft"           toDummy = writeVar dummyVar+-} -readBandLimited :: Maybe E -> Int -> E -> E-readBandLimited mphase n cps = oscilikt 1 cps (vco2ft cps (int n)) mphase+readBandLimited :: Maybe E -> BandLimitedId -> E -> E+readBandLimited mphase n cps = oscilikt 1 cps (vco2ft cps (bandLimitedIdToExpr 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 @@  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

@@ -33,6 +33,8 @@     guiInstrExp,     listenKeyEvt, Key(..), KeyEvt(..), Guis(..),     getKeyEventListener,+    -- * Cabbage Guis+    cabbage,     -- * Hrtf pan     simpleHrtfmove, simpleHrtfstat,     -- * Udo plugins@@ -62,6 +64,8 @@ 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 @@     , 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 @@ 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 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 @@             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

@@ -12,6 +12,7 @@     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 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 @@     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 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@@ -300,6 +301,14 @@  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

@@ -34,7 +34,7 @@     , 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 @@ idSone     = "sone" idFarey    = "farey" idWave     = "wave"-

@@ -5,4 +5,3 @@  import Csound.Typed.Gui.Gui import Csound.Typed.Gui.Widget-

@@ -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

@@ -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]

@@ -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

@@ -370,7 +370,7 @@     where         instr ref = SE $ do             val <- readVar ref-            whens +            whens Kr                  [ (val ==* 0, writeVar ref 1)                 ] (writeVar ref 0)                         turnoff

@@ -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)

@@ -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 

@@ -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

@@ -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]

@@ -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]

@@ -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]

@@ -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]

@@ -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]

@@ -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]

@@ -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]

@@ -17,6 +17,8 @@ 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.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,16 +80,21 @@     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

@@ -612,7 +612,7 @@     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 @@     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)

@@ -164,6 +164,12 @@ 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 @@     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)