ice9.lsp 
 Version 1.00 17 April 2005
 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

 A slow attack "glacial" instrument. Named after similar DX7 patch and Kurt
 Vonnegut

function

 (ice9 step gate [:vel])
 A glacial instrument.
 
 step   - MIDI key. 
 gate   - Flonum. The "key down" time. Actual tone's duration is longer 
          then gate time.
 vel    - MIDI velocity. Default 64
 return - Sound.

function

 (ice99 step gate [:vel][:r][:spread])
 A two channel/detuned version of ice9

 step    - MIDI key number.
 gate    - Flonum. Key down time. Actual tones duration greater then 
           gate time.
 :vel    - MIDI velocity. Default 64.
 :r      - Flonum. Frequency ration between two instances of ice9. 
           Default 1.010
 :spread - Flonum. Stereo field spread. 0 <= spread <= 1, default 0.9
 return  - Sound vector.

;; ice9.lsp 
;; Version 1.00 17 April 2005
;; 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
;;
;; A slow attack "glacial" instrument. Named after similar DX7 patch and Kurt
;; Vonnegut
;;

(require 'map)
(require 'map-vel6)
(require 'xenvelope)

(provide 'ice9)
(current-file "ice9")


(setf ice9:*vmap* map:*vel6*)


(defun ice9:env (gate a r)
  (let  (d)
    (setf d (max (* 0.25 a)(- gate a)))
    (xadsr a d 0 r 0.25)))


;; rc     - flonum, carrier freq ratio, default 1.00
;; rm     - flonum, modulator freq ratio, default 1.00
;; i      - flonum, modulation index, default 1.00
;; catt   - flonum, carrier attack time
;; cdcy   - flonum, carrier decay time
;; matt   - flonum, modulator attack time
;; cdcy   - flonum, modulator decay time
;; ctab   - wtab, carrier wave table
;; mtab   - mtab, modulator wave table
;;

(defun ice9:stack (step gate &key rc rm i catt cdcy matt mdcy ctab mtab)
  (let (hz chz msig hold)
    (setf catt (or catt 1.00))
    (setf cdcy (or cdcy 3.00))
    (setf matt (or matt 2.50))
    (setf mdcy (or mdcy 8.00))
    
    (setf hz (step-to-hz step))
    (setf chz (* (or rc 1.00) hz))
    (setf hold (* 2 (+ gate cdcy)))
    (setf msig (mult (osc (hz-to-step (* (or rm 1.00) hz)) hold (or mtab *sine-table*))
		     (scale (* chz (or i 1.00))(ice9:env gate matt mdcy))))

    (mult (fmosc (hz-to-step chz) msig (or ctab *sine-table*))
	  (ice9:env gate catt cdcy))
    ))


;; @doc function ice9 
;; (ice9 step gate [:vel])
;; A glacial instrument.
;; 
;; step   - MIDI key. 
;; gate   - Flonum. The "key down" time. Actual tone's duration is longer 
;;          then gate time.
;; vel    - MIDI velocity. Default 64
;; return - Sound.
;;

(defun ice9 (step gate &rest args)
  (let (vel)
    (setf vel (get-keyword-value ':vel args 64))
  (sum 
   (ice9:stack step gate 
	       :rc 4.9734 
	       :rm 15.046 :i 0.06 
	       :catt .84 :cdcy 2.72 
	       :matt 2.42 :mdcy 8.00)
   (ice9:stack step gate 
	       :rc 4.9962 
	       :rm 28.085 :i 0.11 
	       :catt .39 :cdcy 1.56 
	       :matt 0.66 :mdcy 4.20)
   (scale-db (send ice9:*vmap* :get vel)
	     (ice9:stack step gate 
			 :rc 5.0228 
			 :rm 28.000 :i 0.53 
			 :catt .56 :cdcy 4.17 
			 :matt 0.56 :mdcy 4.17)))))


;; @doc function ice99
;; (ice99 step gate [:vel][:r][:spread])
;; A two channel/detuned version of ice9
;;
;; step    - MIDI key number.
;; gate    - Flonum. Key down time. Actual tones duration greater then 
;;           gate time.
;; :vel    - MIDI velocity. Default 64.
;; :r      - Flonum. Frequency ration between two instances of ice9. 
;;           Default 1.010
;; :spread - Flonum. Stereo field spread. 0 <= spread <= 1, default 0.9
;; return  - Sound vector.
;;

(defun ice99 (step gate &rest args)
  (let (r spread)
    (setf r (get-keyword-value ':r args 1.010))
    (setf spread (clamp (get-keyword-value ':spread args 0.9) 0 1))
    (sum (pan (apply #'ice9 (append (list step gate) args)) spread)
	 (pan (apply #'ice9 (append (list (hz-to-step (* r (step-to-hz step)))
					  gate) args))(- 1 spread)))))