;;; -*- syntax: common-lisp; package: clm; base: 10; mode:lisp -*-
;;;
;;; Moog style four pole filter
;;;   low pass, 24db/Oct, variable resonance, warm, analog sound ;-)
;;;   [all this digital wizardry and we're back where we started!]
;;; by Fernando Lopez-Lezcano, nando@ccrma.stanford.edu
;;; (translation into clm of Tim Stilson's c moog filter implementation)
;;;

(defmacro saturate(x)
  (let* ((xs (gensym)))
    `(let* ((,xs ,x))
       (if (> ,xs 0.95) 0.95
	 (if (< ,xs -0.95) -0.95
	   ,xs)))))

(defparameter moog-gaincoeffs
    '(0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.924866 0.916077 
      0.90741 0.898865 0.890442 0.882141  0.873962 0.865906 0.857941 0.850067 0.842346 0.834686
      0.827148 0.819733 0.812378 0.805145 0.798004 0.790955 0.783997 0.77713 0.770355 0.763672
      0.75708  0.75058 0.744141 0.737793 0.731537 0.725342 0.719238 0.713196 0.707245 0.701355
      0.695557 0.689819 0.684174 0.678558 0.673035 0.667572 0.66217 0.65686 0.651581 0.646393
      0.641235 0.636169 0.631134 0.62619 0.621277 0.616425 0.611633 0.606903 0.602234 0.597626
      0.593048 0.588531 0.584045 0.579651 0.575287  0.570953 0.566681 0.562469 0.558289 0.554169
      0.550079 0.546051 0.542053 0.538116 0.53421 0.530334 0.52652 0.522736 0.518982 0.515289
      0.511627 0.507996  0.504425 0.500885 0.497375 0.493896 0.490448 0.487061 0.483704 0.480377
      0.477081 0.473816 0.470581 0.467377 0.464203 0.46109 0.457977 0.454926 0.451874 0.448883
      0.445892 0.442932 0.440033 0.437134 0.434265 0.431427 0.428619 0.425842 0.423096 0.42038
      0.417664 0.415009 0.412354 0.409729 0.407135 0.404572 0.402008 0.399506 0.397003 0.394501
      0.392059 0.389618 0.387207 0.384827 0.382477 0.380127 0.377808 0.375488 0.37323 0.370972
      0.368713 0.366516 0.364319 0.362122 0.359985 0.357849 0.355713 0.353607 0.351532 0.349457
      0.347412 0.345398 0.343384 0.34137 0.339417 0.337463 0.33551 0.333588 0.331665 0.329773
      0.327911 0.32605 0.324188 0.322357 0.320557 0.318756 0.316986 0.315216 0.313446 0.311707
      0.309998 0.308289 0.30658 0.304901 0.303223 0.301575 0.299927 0.298309 0.296692 0.295074
      0.293488 0.291931 0.290375 0.288818 0.287262 0.285736 0.284241 0.282715 0.28125 0.279755
      0.27829 0.276825 0.275391 0.273956 0.272552 0.271118 0.269745 0.268341 0.266968 0.265594
      0.264252 0.262909 0.261566 0.260223 0.258911 0.257599 0.256317 0.255035 0.25375))

(defparameter moog-gaintable
    (make-array (length moog-gaincoeffs) 
		:element-type 'short-float 
		:initial-contents moog-gaincoeffs))

(defparameter moog-rawdata 
    '((1.00 730.1)
      (2.00 1423.8)
      (3.00 2117.4)
      (4.00 2811.0)
      (4.99 3541.1)
      (5.99 4234.8)
      (6.99 5001.4)
      (7.99 5768.0)
      (8.99 6571.2)
      (9.99 7337.8)
      (10.99 8177.5)
      (11.99 9017.1)
      (12.99 10002.8)
      (14.01 11025.0)
      (15.01 12047.2)
      (16.00 13105.9)
      (17.00 14456.6)
      (18.00 15916.9)
      (19.00 17851.7)
      (19.50 19385.0)
      (19.85 21904.0)))

(defun create-moog-freqtable (&optional (data moog-rawdata))
  (loop for set in data 
      collect (/ (second set) 22050) 
      collect (if (< (first set) 10)
		  (- (/ (first set) 10) 1)
		(/ (- (first set) 10) 10))))

(defparameter moog-freqtable
    '(0 -1
      0.03311111 -0.9
      0.06457143 -0.8
      0.0960272 -0.7
      0.127483 -0.6
      0.1605941 -0.5
      0.1920544 -0.4
      0.22682086 -0.3
      0.2615873 -0.2
      0.29801363 -0.1
      0.33278003 -0.0
      0.37086168 0.1
      0.40893877 0.2
      0.4536417 0.3
      0.5 0.4
      0.5463583 0.5
      0.5943719 0.6
      0.6556281 0.7
      0.72185487 0.8
      0.8096009 0.9
      0.87913835 0.95
      0.9933787 1
      1 1))

(def-clm-struct moog
    (s array real)
    (A 0.0)
    (frequency 440.0)
    (Q 0.9))

;;; Create a ug structure. 
;;;   freq: cutoff frequency in Hertz
;;;   Q: resonance, 0->no resonance, 1->oscilates at freq
;;;
;;; Note: the relation between freq and the actual cutoff is not exactly linear but
;;;       I prefered to translate Hz into the internal parameter rather than controlling
;;;       the cutoff frequency in terms of a number that goes between -1 and 1. 

(defun make-moog-filter (&key
			 (frequency 440)
			 (Q 0.9))
  (make-moog :frequency frequency
	     :Q Q
	     :s (make-array 4 :initial-contents '(0 0 0 0))
	     :A 0.0))

;;; Do the filtering
(defmacro moog-filter (m sig)
  ;; generate symbols so there's no name collision
  (let* ((st (gensym))
	 (cell (gensym))
	 (fc (gensym))
	 (ix (gensym))
	 (ixint (gensym))
	 (ixfrac (gensym))
	 (A (gensym))
	 (out (gensym)))
    ;; and now the real macro
    `(let* ((,st 0.0)
	    (,fc (eref moog-freqtable (/ (moog-frequency ,m) ,sampling-rate 0.5)))
	    (,ix 0)
	    (,ixint 0.0)
	    (,ixfrac 0.0)
	    (,A (moog-A ,m)))
       (setf ,A (* 0.25 (- ,sig ,A)))
       (loop for ,cell from 0 below 4 do
	     (setf ,st (aref (moog-s ,m) ,cell)
		   ,A (saturate (+ ,A (* ,fc (- ,A ,st))))
		   (aref (moog-s ,m) ,cell) ,A
		   ,A (saturate (+ ,A ,st))))
       (let* ((,out ,A))
	 (setf ,ix (* ,fc 99.0)
	       ,ixint (floor ,ix)
	       ,ixfrac (- ,ix ,ixint)
	       ,A (* ,A (moog-Q ,m) 
		     (+ (* (- 1 ,ixfrac)(aref moog-gaintable (+ ,ixint 99)))
			(* ,ixfrac (aref moog-gaintable (+ ,ixint 100)))))
	       (moog-A ,m) ,A)
	 ,out))))