Csound Csound-dev Csound-tekno Search About

a modern waveguide built-in opcode?

Date2007-08-22 19:12
From"Michael Mossey"
Subjecta modern waveguide built-in opcode?
What's the chance that a future version of csound could include include
the "modern waveguide" that Victor wrote several years back? Right now
there are no waveguides which are both tuned to fractional samples and
have minimal filtering. 'waveguide' is not tuned (the last time I checked)
and 'streson' has a lot of filtering so that high pitches have very fast
decay.

I don't have time to learn csound and write it myself, otherwise I would.

The csound opcode version is

; ------------------------------------------------------------
; User-defined opcode implmenting a wave guide model.
; ------------------------------------------------------------
;
; aout modern_waveguide ain, ifreq, idec, kpkpos
;
;  ifreq: frequency
;  idec: decary factor in dB/sec
;  kpkpos: pick-up position (assuming a string)
;
opcode modern_waveguide, a, aiik

/* now we combine the modern waveguide model
with the ideas developed with the KS model */

ain, ifun, idec, kpkpos xin

ipi = -4*taninv(-1)

idts = sr/ifun      /* total delay time (samples) */
idtt = int(sr/ifun) /* truncated delay time */
idel = idts/sr      /* delay time (secs) */


ifac init 1          /* decay shortening factor (fdb gain) */
is   init 0.5        /* loss filter coefficient */

igf pow 10, -idec/(20*ifun) /* gain required for a certain decay */
ig  = cos(ipi*ifun/sr)      /* unitary gain with s=0.5 */

if igf > ig igoto stretch /* if decay needs lengthening */
ifac = igf/ig             /* if decay needs shortening */
goto continue

stretch:
icosfun = cos(2*ipi*ifun/sr)
ia = 2 - 2*icosfun
ib = 2*icosfun - 2
ic = 1 - igf*igf
id = sqrt(ib*ib - 4*ia*ic)
is1 = (-ib + id)/(ia*2)
is2 = (-ib - id)/(ia*2)
is = (is1 < is2 ? is1 : is2)

continue:
ax1  init 0         /* filter delay variable */
apx1  init 0         /* allpass fwd delay variable */
apy1  init 0         /* allpass fdb delay variable */

idtt = ((idtt+is) > (idts) ? idtt - 1: idtt)
ifd = (idts - (idtt + is))  /* fractional delay */
icoef = (1-ifd)/(1+ifd)  /* allpass coefficient */

atmp    delayr 1.0

adel    deltapn idtt

   aflt = (adel*(1-is) + ax1*is)*ifac /* LP filter   */
   ax1 = adel
   alps  = icoef*(aflt - apy1) + apx1  /* AP filter  */
   apx1 = aflt
   apy1 = alps

;;;      tablew alps, awp, itab1, 0 ,0 ,1

atap1   deltapn    (1-kpkpos) * idtt / 2
atap2   deltapn    kpkpos * idtt / 2
        delayw alps + ain

       aout = atap1 + atap2
   xout aout
endop