;;; -*- syntax: common-lisp; base: 10; mode: lisp -*-
;;;
;;; Michael McNabb's fm bell:

(definstrument fm-bell (start-time duration frequency amplitude 
			amp-env index-env index
		        &optional (degree 0.0)
				  (distance 1.0)
				  (reverb-amount 0.005))
  (multiple-value-bind (beg end) (get-beg-end start-time duration)
    (let* ((fmInd1 (in-hz (* 32.0 frequency)))
	   (fmInd2 (in-hz (* 4.0 (- 8.0 (/ frequency 50.0)))))
	   (fmInd3 (* fmInd2 0.705 (- 1.4 (/ frequency 250.0))))  
	   ;;(no in-hz because included in fmInd2)
	   (fmInd4 (in-hz (* 32.0 (- 20 (/ frequency 20)))))
	   (fmenv 0.0)
	   (loc (make-locsig :degree degree 
			     :distance distance 
			     :revscale reverb-amount))
	   (mod1 (make-oscil :frequency (* frequency 2)))
	   (mod2 (make-oscil :frequency (* frequency 1.41)))
	   (mod3 (make-oscil :frequency (* frequency 2.82)))
	   (mod4 (make-oscil :frequency (* frequency 2.4)))
	   (car1 (make-oscil :frequency frequency))
	   (car2 (make-oscil :frequency frequency))
	   (car3 (make-oscil :frequency (* frequency 2.4)))
	   (indf (make-env :envelope index-env :scaler index))
	   (ampf (make-env :envelope amp-env :scaler amplitude)))
      (run
       (loop for i from beg to end do
	     (setf fmenv (env indf))
	     (locsig loc i 
		     (* (env ampf)
			(+ (oscil car1 (* fmenv fmInd1 (oscil mod1)))
			   (* .15 (oscil car2 (* fmenv 
						 (+ (* fmInd2 (oscil mod2))
						    (* fmInd3 
						       (oscil mod3))))))
			   (* .15 (oscil car3 (* fmenv 
						 fmInd4 
						 (oscil mod4))))))))))))


#|
(with-sound ()
  (let ((fbell '(0 1 2 1.1 25 .75 75 .5 100 .2))
	(abell '(0 0 .1 1 10 .6 25 .3 50 .15 90 .1 100 0)))
    (fm-bell 0 5.000 233.046 .028 abell fbell .750)
    (fm-bell 5.912 2.000 205.641 .019 abell fbell .650)
    (fm-bell 6.085 5.000 207.152 .017 abell fbell .750)
    (fm-bell 6.785 7.000 205.641 .010 abell fbell .650)
    (fm-bell 15.000 .500  880    .060 abell fbell .500)
    (fm-bell 15.006 6.500 293.66 .1 abell fbell 0.500)
    (fm-bell 15.007 7.000 146.5  .1 abell fbell 1.000)
    (fm-bell 15.008 6.000 110    .1 abell fbell 1.000)
    (fm-bell 15.010 10.00 73.415 .028 abell fbell 0.500)
    (fm-bell 15.014 4.000 698.46 .068 abell fbell 0.500)))
|#