; My FM instrument based on Chowning's two-oscillator algorithm
(definstrument fm (start-time duration amplitude freq freq-ratio 
                              &key
			      (car-env '(0 1 50 .2 100 0))
			      (car-env-base 1)
			      (mod-env '(0 1 50 .2 100 0))
			      (mod-env-base 1)
			      (mod-index1 0)
			      (mod-index2 1))
   (multiple-value-bind (beg end) (get-beg-end start-time duration)
     (let* ((mod-freq (* freq freq-ratio))
	    (car-osc (make-oscil :frequency freq))  
	    (mod-osc (make-oscil :frequency mod-freq))
	    (car-amp (make-env :envelope car-env 
			       :scaler (* amplitude 0.1)
			       :base car-env-base
			       :duration duration))
	    (mod-amp (make-env :envelope mod-env 
			       :scaler (* (- mod-index2 mod-index1) mod-freq .001)
			       :base mod-env-base
			       :duration duration)))
       (run 
        (loop for i from beg to end do
          (outa i (* (env car-amp) 
		     (oscil car-osc (* (+ (env mod-amp) (* mod-index1 mod-freq))
				       (oscil mod-osc)))))
	  )))))

;;; Jan Mattox's fm drum:
(definstrument fm-drum (start-time duration frequency amplitude index 
                        &optional (high nil) (degree 0.0) (distance 1.0) (reverb-amount 0.01))
  (let* ((beg (floor (* start-time sampling-rate)))
         (end (+ beg (floor (* duration sampling-rate))))
         ;; many of the following variables were originally passed as arguments
         (casrat (if high 8.525 3.515))
         (fmrat (if high 3.414 1.414))
         (glsfun '(0 0  25 0  75 1  100 1))
         (glsf (make-env :envelope glsfun :scaler (if high (in-hz 66) 0.0)))
         (ampfun '(0 0  3 .05  5 .2  7 .8  8 .95  10 1.0  12 .95  20 .3  30 .1  100 0))
         (atdrpt (* 100 (/ (if high .01 .015) duration)))
         (ampf (make-env :envelope (divseg ampfun 
                                           10 atdrpt 
                                           15 (max (+ atdrpt 1) 
                                                   (- 100 (* 100 (/ (- duration .2) duration)))))
                  :scaler amplitude))
         (indxfun '(0  0     5  .014  10 .033  15 .061  20 .099  
                    25 .153  30 .228  35 .332  40 .477  
                    45 .681  50 .964  55 .681  60 .478  65 .332  
                    70 .228  75 .153  80 .099  85 .061  
                    90 .033  95 .0141 100 0))
         (indxpt (- 100 (* 100 (/ (- duration .1) duration))))
         (divindxf (divseg indxfun 50 atdrpt 65 indxpt))
         (indxf (make-env :envelope divindxf :scaler (min (in-hz (* index fmrat frequency)) pi)))
         (mindxf (make-env :envelope divindxf :scaler (min (in-hz (* index casrat frequency)) pi)))
         (devf (make-env :envelope (divseg ampfun 
                                           10 atdrpt 
                                           90 (max (+ atdrpt 1) 
                                                   (- 100 (* 100 (/ (- duration .05) duration)))))
                         :scaler (min pi (in-hz 7000))))
         (loc (make-locsig :degree degree :distance distance :revscale reverb-amount))
         (rn (make-randh :frequency 7000 :amplitude 1.0))
         (carrier (make-oscil :frequency frequency))
         (fmosc (make-oscil :frequency (* frequency fmrat)))
         (cascade (make-oscil :frequency (* frequency casrat))))
    (run
     (loop for i from beg to end do
       (let ((gls (env glsf)))
         (locsig loc i (* (env ampf) 
                          (oscil carrier 
                                 (+ gls 
                                    (* (env indxf)
                                       (oscil fmosc 
                                              (+ (* gls fmrat)
                                                 (* (env mindxf) (oscil cascade 
                                                           (+ (* gls casrat)
                                                              (* (env devf) (randh rn)
))))))))))))))))



#|
; Sounds made with Chowning's Algorithm:

; Bell
(with-sound () (fm 0 10 1 200 1.4 :car-env '(0 1 50 .2 100 0)
		   :mod-env '(0 1 50 .2 100 0) :mod-index2 1))

; Metallic Chime
(with-sound () (fm 0 1 .5 1000 2.005 :car-env '(0 1 50 .2 100 0)
		   :mod-env '(0 1 25 .2 100 0) :mod-index2 1))
; Wind Chimes
(with-sound ()
  (loop for i from 0 to 4 by .15 do
    (let ((r1 (random .2)) (r2 (random 5)) (r3 (random 5)))
      (fm (+ r1 i) 1 .6 (+ 800 (* 100 r2)) 2.005 :car-env '(0 1 50 .2 100 0)
	  :mod-env '(0 1 25 .2 100 0) :mod-index2 1)
      (fm (+ r1 i) 1 .4 (+ 900 (* 100 r3)) 2.005 :car-env '(0 1 50 .2 100 0)
	  :mod-env '(0 1 25 .2 100 0) :mod-index2 1)
      )))


; Wood Drum
(with-sound () (fm 0 .2 1 200 1.4 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 .2))
(with-sound () (fm 0 .2 1 300 1.4 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 .2))
(with-sound () (fm 0 .2 1 400 1.4 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 .2))
(with-sound () (fm 0 .2 1 200 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 .2))

; Marimba
(with-sound () (fm 0 .2 1 400 2.4 :car-env '(0 0.8 10 1 50 .2 100 0)
		   :mod-env '(0 1 50 .2 100 0) :mod-index2 .2))
(with-sound () (fm 0 .2 1 610 2.4 :car-env '(0 0.8 10 1 50 .2 100 0)
		   :mod-env '(0 1 50 .2 100 0) :mod-index2 .2))
(with-sound () (fm 0 .2 1 800 2.4 :car-env '(0 0.8 10 1 50 .2 100 0)
		   :mod-env '(0 1 50 .2 100 0) :mod-index2 .2))

; Dance Bass
(with-sound () 
  (loop for i from 1 to 4 by 0.8 do
  (fm (+ i 0.0) .4 5 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.1) .4 3 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.2) .4 3 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.3) .4 5 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.5) .4 3 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.6) .4 3 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)
  (fm (+ i 0.7) .4 4 80 0.6875 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 2.5)))
(with-sound () (fm 0 .5 5 50 1.4 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 1 12 0 100 0) :mod-index2 .2))

; Brushed Snare
(with-sound () (fm 0 .3 .5 200 1.4 :car-env '(0 1 10 1 50 .2 100 0)
		   :mod-env '(0 1 50 .2 100 0) :mod-index1 2 :mod-index2 1))

; Sheet Metal
(with-sound () (fm 0 1 1 40 2.2 :car-env '(0 .8 20 1 50 .2 100 0)
		   :mod-env '(0 0 12 1 100 0) :mod-index2 2))



; Sounds made with Jan Mattox's FM Drum:

; Bass Drum
(with-sound () (fm-drum 0 1 40 .2 5))
(with-sound () (fm-drum 0 4 20 .4 5))

; Electronic Snare
(with-sound () (fm-drum 0 .3 100 .1 10000))

; Electronic Tom Tom
(with-sound () (fm-drum 0 .3 240 .1 4))
(with-sound () (fm-drum 0 .3 220 .1 4))
(with-sound () (fm-drum 0 .3 200 .1 4))
(with-sound () (fm-drum 0 .3 180 .1 4))


|#