hammond.lsp
 Version 1.00   28 March 05
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 Create wave tables using Hammond organ registrations.

function

 (hammond:register [r0 [r1 [r2 ... [r8]]]])
 
 ri     - Integer. Position of drawboard i. 0 <= ri <= 8.
          i     Length     Harmonic
         --------------------------
          0     16'        01
	    1     5 2/3'     03
	    2	  8'	     02
	    3	  4'	     04
	    4	  2 2/3'     06
	    5	  2'	     08
	    6	  1 3/5'     10
	    7	  1 1/3'     12
	    8	  1'	     16

 return - Table. A wave table built from registration.

;; hammond.lsp
;; Version 1.00   28 March 05
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; Create wave tables using Hammond organ registrations.
;;

(require 'wtab)
(provide 'hammond)
(current-file "hammond")


(setf hammond:*relative-register-frequencies* (list 1 3 2 4 6 8 10 12 16))
(setf hammond:*max-register* (length hammond:*relative-register-frequencies*))


;; Ensure list is at least n elements long
;;

(defun hammond:pad-list (lst n)
  (if (< (length lst) n)
      (hammond:pad-list (append lst (list 0)) n)
    lst))


;; Ensure every number n in list is in interval
;; 0 < n < hammond:*max-register*
;;

(defun hammond:check-register-list-amplitude (lst)
  (if lst
      (cons (clamp (car lst) 0 hammond:*max-register*)
	    (hammond:check-register-list-amplitude (cdr lst)))
    nil))


;; Convert register list in the form (r1 r2 r3 ... r9) where 0 <= r <= 8 for
;; each r, to a list of partials suitable for use with wtab:make
;;

(defun hammond:register-to-partial-list (reglist)
  (let (acc)
    (setf reglist (hammond:check-register-list-amplitude
		   (hammond:pad-list reglist hammond:*max-register*)))
    (setf acc '())
    (dotimes (i hammond:*max-register*)
      (push (list (nth i hammond:*relative-register-frequencies*)
		  (nth i reglist))
	    acc))
    (wtab:normalize acc)))


;; @doc function hammond:register
;; (hammond:register [r0 [r1 [r2 ... [r8]]]])
;; 
;; ri     - Integer. Position of drawboard i. 0 <= ri <= 8.
;;          i     Length     Harmonic
;;         --------------------------
;;          0     16'        01
;;	    1     5 2/3'     03
;;	    2	  8'	     02
;;	    3	  4'	     04
;;	    4	  2 2/3'     06
;;	    5	  2'	     08
;;	    6	  1 3/5'     10
;;	    7	  1 1/3'     12
;;	    8	  1'	     16
;;
;; return - Table. A wave table built from registration.
;;

(defun hammond:register (&rest args)
  (wtab:make (hammond:register-to-partial-list args)))