;;; -*- Lisp -*-

;;; FM NOISE ------------------------------------------------------------------------
;;; The "noise" instrument (useful for Oceanic Music):

(defun attack-point (duration attack decay &optional (total-x 100.0))
  (* total-x (/ (if (= 0.0 attack)
		    (if (= 0.0 decay)
			(/ duration 4)
		      (/ (- duration decay) 4))
		  attack)
		duration)))

(defvar fm-noise-degree 0.0)
(defvar fm-noise-distance 1.0)
(defvar fm-noise-reverb-amount 0.005)

(definstrument FM-Noise (start-time duration freq0 amp ampfun ampat ampdc
			 freq1 glissfun freqat freqdc rfreq0 rfreq1 rfreqfun rfreqat rfreqdc
			 dev0 dev1 devfun devat devdc
			 &key (degree fm-noise-degree)
			      (distance fm-noise-distance)
			      (reverb-amount fm-noise-reverb-amount))
  
  ;; ampat = amp envelope attack time, and so on -- this instrument assumes your envelopes go
  ;; from 0 to 100 on the x-axis, and that the "attack" portion ends at 25, the "decay" portion
  ;; starts at 75.  "rfreq" is the frequency of the random number generator -- if below about
  ;; 25 Hz you get automatic composition, above that you start to get noise.  Well, you get
  ;; a different kind of noise.  "dev" is the bandwidth of the noise -- very narrow gives a 
  ;; whistle, very broad more of a whoosh.  This is basically "simple FM", but the modulating
  ;; signal is white noise.
  
  (let* ((beg (floor (* start-time sampling-rate)))
	 (end (+ beg (floor (* duration sampling-rate))))
	 (carrier (make-oscil :frequency freq0))
	 (modulator (make-randh :frequency rfreq0 :amplitude 1.0))
	 (loc (make-locsig :degree degree :distance distance :revscale reverb-amount))
	 (dev-0 (in-Hz dev0))
	 
	 ;; next fix-up troubles in attack and decay times (there are lots of ways to handle this --
	 ;; the basic problem is that these durned instruments end up having way too many parameters.
	 ;; Rick Taube's Common Music replacement for Pla should help, but just for old time's sake,
	 ;; we'll do it the way the ancients did it.  (We could also package up this stuff in our
	 ;; own function, somewhat like the Allvln function in vln.clm, leaving the instrument code
	 ;; to apply envelopes and other data to some patch).
	 
	 (amp-attack (attack-point duration ampat ampdc))
	 (amp-decay (- 100.0 (attack-point duration ampdc ampat)))
	 (freq-attack (attack-point duration freqat freqdc))
	 (freq-decay (- 100.0 (attack-point duration freqdc freqat)))
	 (dev-attack (attack-point duration devat devdc))
	 (dev-decay (- 100.0 (attack-point duration devdc devat)))
	 (rfreq-attack (attack-point duration rfreqat rfreqdc))
	 (rfreq-decay (- 100.0 (attack-point duration rfreqdc rfreqat)))
	 
	 ;; now make the actual envelopes -- these all assume we are thinking in terms of
	 ;; the "value when the envelope is 1" (i.e. dev1 and friends), and the "value when
	 ;; the envelope is 0" (i.e. dev0 and friends) -- over the years this seemed to make
	 ;; beginners happier than various other ways of describing the y-axis behaviour of
	 ;; the envelope.  All this boiler-plate for envelopes might seem overly elaborate
	 ;; when our basic instrument is really simple, but in most cases, and this one in
	 ;; particular, nearly all the musical interest comes from the envelopes, not the
	 ;; somewhat dull spectrum generated by the basic patch.
	 
	 (dev-f (make-func :envelope (divseg devfun 25 dev-attack 75 dev-decay) 
			   :scaler (in-Hz (- dev1 dev0))
			   :start-time start-time :duration duration))
	 (amp-f (make-func :envelope (divseg ampfun 25 amp-attack 75 amp-decay)
			   :scaler amp :start-time start-time :duration duration))
	 (freq-f (make-func :envelope (divseg glissfun 25 freq-attack 75 freq-decay)
			    :scaler (in-Hz (- freq1 freq0))
			    :start-time start-time :duration duration))
	 (rfreq-f (make-func :envelope (divseg rfreqfun 25 rfreq-attack 75 rfreq-decay)
			     :scaler (in-Hz (- rfreq1 rfreq0))
			     :start-time start-time :duration duration)))
    
    (Run
     (loop for i from beg to end do
       (locsig loc i (* (env amp-f)
			(oscil carrier (+ (env freq-f)
					  (* (+ dev-0 (env dev-f)) 
					     (randh modulator (env rfreq-f)))))))))))

; (fm-noise 0 2.0 500 .25 '(0 0 25 1 75 1 100 0) .1 .1 1000 '(0 0 100 1) .1 .1 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0)
