fm-bass.lsp
 Version 1.00   31 October 2004
 Authors  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

 Another FM bass instrument.
 
 fm-bass is a 1 carrier 3 modulator bass instrument. The velocity
 parameter allows for a fairly wide range of timbres. At 0 velocity the tone
 is essentially sinusoidal.

function

 (fm-bass pch dur [:vel][:dis][:pos])
 An fm bass instriument
 
 pch    -  flonum. Pitch as MIDI key number
 
 dur    - flonum. Duration in seconds

 :vel   - flonum. Velocity  0 <= vel < 128, default 100

 :dis   - flonum. Effects modulation index. Default 1
 
 :pos   - flonum. Pan position, default 0.5

 return - vector. A 2 channel sound

;; fm-bass.lsp
;; Version 1.00   31 October 2004
;; Authors  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
;;
;; Another FM bass instrument.
;; 
;; fm-bass is a 1 carrier 3 modulator bass instrument. The velocity
;; parameter allows for a fairly wide range of timbres. At 0 velocity the tone
;; is essentially sinusoidal.
;; 

(require 'envelope)
(require 'wtab)
(require 'fmop)
(require 'square-16)
(provide 'fm-bass)
(current-file "fm-bass")


;; @doc function fm-bass 
;; (fm-bass pch dur [:vel][:dis][:pos])
;; An fm bass instriument
;; 
;; pch    -  flonum. Pitch as MIDI key number
;; 
;; dur    - flonum. Duration in seconds
;;
;; :vel   - flonum. Velocity  0 <= vel < 128, default 100
;;
;; :dis   - flonum. Effects modulation index. Default 1
;; 
;; :pos   - flonum. Pan position, default 0.5
;;
;; return - vector. A 2 channel sound
;;

(defun fm-bass  (pch dur &key vel dis pos)
  (let ((vscale (sqr (/ (or vel 100) 51.8)))
	(pos (or pos 0.5))
	(dis (or dis 1.0))
	(chz (step-to-hz pch)))
    (pan 
     (let ((r2    0.505)
	   (i2    (* vscale 0.50))
	   (r3    0.500)
	   (i3    (* vscale 0.50))
	   (t3    *square-16*)
	   (r4    5.998)
	   (i4    (* vscale (/ dis 3.0)))
	   (env1 (list 0.000 0.500 0.000 0.250 0.75 dur))
	   (env2 (list 0.050 0.000 0.750 0.000 0.75 dur))
	   (env3 (list 0.000 0.000 0.050))
	   (env4 (list 0.250 0.000 0.000 0.750 0.900)))
       (fmop:cc chz (apply #'adsr env1)
		(sum (fmop:mm chz r2 i2 (apply #'adsr  env2)(s-rest dur))
		     (fmop:mm chz r3 i3 (apply #'asd  env3)(s-rest dur) :tab t3)
		     (fmop:mm chz r4 i4 (apply #'adsr  env4)(s-rest dur)))))
     (or pos 0.5))))