cerberus_moog_ladder_inlined   xtlang

;; inlined moog ladder for cerberus
;; type is LPF4, LPF2 only (this for use of cerberus synth)
;; rate is the minimum number of samples to allow between frq/res updates
(bind-func cerberus_moog_ladder_inlined
  (lambda (type)
    (let ((i:i64 0)
          (m_dK 0.0)
          (m_dAlpha_0 1.0)
          (m_dAlpha 0.0)
          (m_dGamma 0.0)
          (dSigma 0.0) (dU 0.0)
          (m_dA 0.0) (m_dB 0.0) (m_dC 0.0) (m_dD 0.0) (m_dE 1.0)
          ;; (dlpf1 0.0) (dlpf2 0.0) (dlpf3 0.0) (dlpf4 0.0)
          ;; op data
          (op_m_dAlpha:|4,SAMPLE|* (alloc))
          (op_m_dBeta:|4,SAMPLE|* (alloc))
          (op_m_dZ1:|4,SAMPLE|* (alloc))
          (op_fb_out:|4,SAMPLE|* (alloc))
          (op_out:|4,SAMPLE|* (alloc))
          (op_tmp:SAMPLE 0.0)
          (op_vn:SAMPLE 0.0)
          ;; op data out
          (feedback:SAMPLE 0.01)
          (saturation:SAMPLE 1.0) ;; range (1.0 - 3.0)
          (out:SAMPLE 0.0)
          (T (/ 1.0 SRs))
          (g:SAMPLE 0.0)
          (G:SAMPLE 0.0)
          (t2 (/ 2.0 T))
          (halfT (/ T 2.0))
          (oldfrq 0.0)
          (fconfig:|5,SAMPLE|* (alloc))
          (oldQ 0.0))
      (cond ((= type LPF4) (afill! fconfig 0.0 0.0 0.0 0.0 1.0))
            ((= type LPF2) (afill! fconfig 0.0 0.0 1.0 0.0 0.0))
            (else ;; default to LPF4
                  (afill! fconfig 0.0 0.0 0.0 0.0 1.0)))
      (lambda (in:SAMPLE frq:SAMPLE Q:SAMPLE)
        ;; update Q
        (if (or (<> oldQ Q) (<> oldfrq frq))
            (begin (if (< frq 0.0) (set! frq (fabs frq)))
                   (if (< Q 0.0) (set! Q (fabs Q)))
                   (set! oldQ Q)
                   (set! oldfrq frq)
                   (set! m_dK (* 4.0 Q))
                   (set! oldfrq frq)
                   (set! m_dAlpha (* t2 (tan (* STWOPI frq halfT))))
                   (set! g (* halfT m_dAlpha))
                   (set! G (/ g (+ 1.0 g)))
                   (afill! op_m_dAlpha G G G G)
                   (afill! op_m_dBeta
                          (* G G (/ G (+ 1.0 g)))
                          (* G (/ G (+ 1.0 g)))
                          (/ G (+ 1.0 g))
                          (/ 1.0 (+ 1.0 g)))
                   (set! m_dGamma (* G G G G))
                   (set! m_dAlpha_0 (/ 1.0 (+ 1.0 (* m_dK m_dGamma))))))
        (set! dSigma (+ (aref op_fb_out 0) (aref op_fb_out 1) (aref op_fb_out 2) (aref op_fb_out 3)))
        (set! in (* in (+ 1.0 m_dK)))
        (set! dU (* (- in (* m_dK dSigma)) m_dAlpha_0))
        (set! dU (tanh (* saturation dU)))
        ;; (inline cascade filters)
        (set! op_tmp dU)
        (set! out 0.0)
        (dotimes (i 4)
          (aset! op_fb_out i (* (aref op_m_dBeta i) (aref op_m_dZ1 i)))
          (set! op_vn (* (- op_tmp (aref op_m_dZ1 i)) (aref op_m_dAlpha i)))
          (set! op_tmp (+ op_vn (aref op_m_dZ1 i)))
          (aset! op_m_dZ1 i (+ op_vn op_tmp))
          (aset! op_out i op_tmp)
          (set! out (+ out (* (aref fconfig (+ i 1)) op_tmp))))
        out))))