;;; clm.html examples (if not already included elsewhere)

(definstrument doc-1 (start-time duration frequency amplitude)
  (let* ((beg (floor (* start-time *srate*)))
	 (end (+ beg (floor (* duration *srate*))))
	 (j 0))
    (run
      (loop for i from beg below end do
        (outa i (* amplitude (sin (* j 2.0 pi (/ frequency *srate*)))))
	(incf j)))))

;(with-sound () (doc-1 0 0.25 440.0 0.2))

(definstrument doc-2 (start-time duration frequency amplitude &optional (amp-env '(0 0 .5 1.0 1.0 0)))
  (multiple-value-bind (beg end) (times->samples start-time duration)
    (let ((osc (make-oscil :frequency frequency))
	  (amp-env (make-env :envelope amp-env :scaler amplitude :duration duration)))
      (run 
       (loop for i from beg below end do
	 (outa i (* (env amp-env) (oscil osc))))))))

;(with-sound () (doc-2 0 0.25 440.0 0.2))
;(with-sound () (doc-2 0 0.25 440.0 0.2 '(0 0 1 1 2 .2 5 0)))

(definstrument doc-3 (beg dur freq amp mc-ratio index &optional amp-env index-env)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (cr (make-oscil freq))                     ; our carrier
         (md (make-oscil (* freq mc-ratio)))        ; our modulator
         (fm-index (hz->radians (* index mc-ratio freq)))
         (ampf (make-env (or amp-env '(0 0 .5 1 1 0)) :scaler amp :duration dur))
         (indf (make-env (or index-env '(0 0 .5 1 1 0)) :scaler fm-index :duration dur)))
    (run
      (loop for i from start to end do
        (outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))
;(with-sound () (doc-3 0 1 440 .1 2 1.0))
;(with-sound () (doc-3 0 1 440 .1 3 .5 '(0 0 1 1 2 .2 5 0) '(0 0 1 1)))

(definstrument doc-4 (beg dur frq amp en)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (osc (make-oscil frq))
         (half-pi (* pi 0.5))
	 (zv (make-env en 1.0 dur)))
    (run
     (loop for i from start below end do
       (let ((zval (env zv))) ;zval^3 is [0.0..1.0], as is sin between 0 and half-pi.
	 (outa i (* amp (sin (* half-pi zval zval zval)) (oscil osc))))))))

(definstrument doc-5 (beg dur env-dur)
  (let* ((os (make-oscil 440.0))
	 (e (make-env '(0 0 50 1 100 0) :length env-dur :scaler .1)))
    (run
     (loop for i from beg below (+ beg dur) do 
       (if (> (mus-location e) (mus-length e))
           (mus-reset e))
       (outa i (* (env e) (oscil os)))))))

(definstrument doc-6 (dur)
  (let ((tab (make-table-lookup :wave (partials->wave '(1 .5 2 .5)))))
    (run
     (loop for i from 0 to dur do
       (outa i (* .3 (table-lookup tab)))))))

(definstrument doc-7 (start duration frequency freqskew amplitude freq-env amp-env partials)
  (multiple-value-bind (beg end) (times->samples start duration)
    (let* ((gls-env (make-env freq-env (hz->radians freqskew) duration))
           (os (make-oscil frequency))
           (fil (make-one-pole .1 .9))
           (coeffs (partials->polynomial (normalize-partials partials)))
           (amp-env (make-env amp-env amplitude duration)))
      (run
        (loop for i from beg below end do
          (outa i 
            (one-pole fil 
              (* (env amp-env) 
                 (polynomial coeffs (oscil os (env gls-env)))))))))))

(definstrument doc-8 (beg dur file1 file2 amp &optional (fftsize 128) (r two-pi) (lo 2) (hi nil))
  ;; file1: input sound, file2: gives spectral shape
  ;; r: controls width of formants (1.0 is another good value here)
  ;; lo and hi: which of the formants are active (a sort of filter on top of the filter)
  ;; we use the on-going spectrum of file2 to scale the outputs of the formant array
  (let* ((fil1 (open-input* file1))
	 (fil2 (and fil1 (open-input* file2))))
    (when fil1
      (if (not fil2)
          (close-input fil1)
        (unwind-protect
	  (let* ((start (floor (* beg *srate*)))
	         (end (+ start (floor (* dur *srate*))))
	         (freq-inc (floor fftsize 2))
	         (fdr (make-double-float-array fftsize))
	         (fdi (make-double-float-array fftsize))
	         (diffs (make-double-float-array freq-inc))
	         (spectrum (make-double-float-array freq-inc))
	         (filptr 0)
	         (ctr freq-inc)
	         (radius (- 1.0 (/ r fftsize)))
	         (bin (float (/ *srate* fftsize)))
	         (fs (make-array freq-inc)))
	    (if (null hi) (setf hi freq-inc))
	    (loop for k from lo below hi do 
              (setf (aref fs k) (make-formant (* k bin) radius)))
	    (run
	     (loop for i from start below end do
	       (when (= ctr freq-inc)
	         (dotimes (k fftsize)
		   (setf (aref fdr k) (ina filptr fil2))
		   (incf filptr))
	         (clear-array fdi)
	         (decf filptr freq-inc)
	         (fft fdr fdi fftsize 1)
	         (rectangular->magnitudes fdr fdi)
	         (dotimes (k freq-inc) 
                   (setf (aref diffs k) 
                     (/ (- (aref fdr k) (aref spectrum k)) freq-inc)))
	         (setf ctr 0))
	       (incf ctr)
	       (dotimes (k freq-inc) 
                 (incf (aref spectrum k) (aref diffs k)))
	       (let ((outval 0.0)
		     (inval (ina i fil1)))
		 (do ((k lo (1+ k)))
		     ((= k hi))
                   (incf outval (* (aref spectrum k) (formant (aref fs k) inval))))
	         (outa i (* amp outval))))))
        (progn
	  (close-input fil1)
	  (close-input fil2)))))))

;(with-sound () (cross-synthesis 0 1 "oboe" "fyow" .5 256 1.0 3 100))

(definstrument doc-9 (beg dur amp &key xcoeffs)
  (let* ((st (floor (* beg *srate*)))
         (noi (make-rand :frequency (* .5 *srate*) :amplitude amp))
         (flA (make-filter :xcoeffs xcoeffs))
         (nd (+ st (floor (* *srate* dur)))))
    (run
      (loop for i from st below nd do
        (outa i (filter flA (rand noi)))))))

;(with-sound () 
;  (filter-noise 0 1 .2 
;    :xcoeffs (envelope->coeffs :order 12 :envelope '(0 0.0 .125 0.5 .2 0.0 .3 1.0 .5 0.0 1.0 0.0))))


(definstrument doc-1-0 (beg dur scaler secs file)
  (let ((del (make-delay (round (* secs *srate*))))
	(inf (open-input file))
	(j 0))
    (run
     (loop for i from beg below (+ beg dur) do
       (let ((inval (ina j inf)))
	 (outa i (+ inval (delay del (* scaler (+ (tap del) inval)))))
	 (incf j))))
    (close-input inf)))

;;; (with-sound () (echo 0 60000 .5 1.0 "pistol.snd"))

(definstrument doc-1-1 (start-time duration amp srt srt-env filename)
  (let* ((senv (make-env :envelope srt-env :duration duration))
         (beg (floor (* start-time *srate*)))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :input filename :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (env senv))))))))

(definstrument doc-1-2 (start-time duration amp srt fmamp fmfreq filename)
  (let* ((os (make-oscil :frequency fmfreq))
         (beg (floor (* start-time *srate*)))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :input filename :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (* fmamp (oscil os)))))))))

;(with-sound () (doc-12 0 2 1.0   1 .3 20 "fyow.snd"))   
;(with-sound () (doc-12 0 25 10.0   .01 1 10 "fyow.snd"))
;(with-sound () (doc-12 0 2 1.0   .9 .05 60 "oboe.snd")) 
;(with-sound () (doc-12 0 2 1.0   1.0 .5 124 "oboe.snd"))
;(with-sound () (doc-12 0 10 10.0   .01 .2 8 "oboe.snd"))
;(with-sound () (doc-12 0 2 1.0   1 3 20 "oboe.snd"))    

(definstrument doc-1-3 (beg dur file frq amp)
  (let ((rd (make-src :input file))
        (rn (make-rand-interp :frequency frq :amplitude amp))
        (end (+ beg dur)))
    (run
      (loop for i from beg below end do
        (outa i (src rd (rand-interp rn)))))))

(definstrument doc-1-4 (start-time duration amp srt srt-env filename)
  (let* ((senv (make-env :envelope srt-env :duration duration))
         (beg (floor (* start-time *srate*)))
	 (rd (make-readin filename))
         (end (+ beg (floor (* duration *srate*))))
         (src-gen (make-src :srate srt)))
    (run
      (loop for i from beg below end do
        (outa i (* amp (src src-gen (env senv) #'(lambda (dir) (readin rd)))))))))

(definstrument doc-1-5 (beg dur filter file &optional (size 128))
  (let* ((start (floor (* beg *srate*)))
         (end (+ start (floor (* dur *srate*))))
         (ff (make-convolve :input file :fft-size size :filter filter)))
    (run
      (loop for i from start below end do (outa i (convolve ff))))))

(definstrument doc-1-6 (file beg &optional dur (orig-beg 0.0) (exp-amt 1.0))
  (let* ((f-srate (sound-srate file))
	 (f-start (round (* f-srate orig-beg)))
         (f (open-input file :start f-start))
	 (st (floor (* beg *srate*)))
	 (new-dur (or dur (- (sound-duration file) orig-beg)))
	 (exA (make-granulate :input f :expansion exp-amt))
	 (nd (+ st (floor (* *srate* new-dur)))))
    (run
     (loop for i from st below nd do
       (outa i (granulate exA))))
    (close-input f)))

(definstrument doc-1-7 (beg dur exp-amt file file-beg)
  (let* ((exA (make-granulate :expansion exp-amt))
	 (fil (open-input* file file-beg))
	 (ctr file-beg))
    (run
     (loop for i from beg to (+ beg dur) do
       (outa i (granulate exA
			  #'(lambda (dir)
			      (let ((inval (ina ctr fil)))
				(if (> ctr 0) (setf ctr (1- ctr)))
				inval))))))))

;(with-sound () (grev 0 100000 2.0 "pistol.snd" 40000))

(definstrument doc-2-0 (beg dur freq amp index &optional (r 1.0) (ratio 1.0))
  (let* ((st (floor (* beg *srate*)))
         (nd (+ st (floor (* dur *srate*))))
         (asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
    (run
     (loop for i from st below nd do
       (outa i (* amp (asymmetric-fm asyf index 0.0)))))))

(definstrument doc-2-1 (onset duration file src-ratio)
  ;; read file forwards and backwards until dur is used up
  ;; a slightly improved version is 'scratch' in ug1.ins
  (let* ((last-sample (sound-frames file))
         (beg (floor (* *srate* onset)))
         (end (+ beg (floor (* *srate* duration))))
	 (input (make-readin file))
         (s (make-src :srate src-ratio))
         (cs 0))
    (run
     (loop for i from beg below end do
       (declare (type :integer cs last-sample)
		(type :float src-ratio))
       (if (>= cs last-sample) (setf (mus-increment s) (- src-ratio)))
       (if (<= cs 0) (setf (mus-increment s) src-ratio))
       (outa i (src s 0.0 #'(lambda (dir)
			      (incf cs dir)
			      (setf (mus-increment input) dir)
			      (readin input))))))))

;;; (with-sound () (backandforth 0 10 "pistol.snd" .5))

(definstrument doc-2-3 (beg dur freq amp shift)
  (let* ((os (make-oscil freq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (am (make-ssb-am shift)))
    (run
     (loop for i from start to end do
       (outa i (* amp (ssb-am am (oscil os))))))))

(definstrument doc-2-4 (file beg &optional (amp 1.0) (amp-env '(0 1 100 1)))
  (let* ((st (floor (* beg *srate*)))
         (dur (sound-duration file))
         (rev-amount .01)
         (rdA (make-readin file))
         (ampf (make-env amp-env amp dur))
         (nd (+ st (floor (* *srate* dur)))))
    (run
      (loop for i from st below nd do
        (let ((outval (* (env ampf) (readin rdA))))
  	  (outa i outval)
	  (if *reverb* (outa i (* outval rev-amount) *reverb*)))))))

(definstrument doc-2-5 (file onset duration &key (distance-env '(0 1 100 10)) (amplitude-env '(0 1 100 1))
		     (degree-env '(0 45 50 0 100 90)) (reverb-amount .05))
  (let* ((beg (floor (* onset *srate*)))
	 (end (+ beg (floor (* *srate* duration))))
         (loc (make-locsig :degree 0 :distance 1 :reverb reverb-amount))
         (rdA (make-readin :file file))
         (dist-env (make-env distance-env :duration duration))
         (amp-env (make-env amplitude-env :duration duration))
         (deg-env (make-env (scale-envelope degree-env (/ 1.0 90.0)) :duration duration))
         (dist-scaler 0.0))
    (run
      (loop for i from beg below end do
        (let ((rdval (* (readin rdA) (env amp-env)))
	      (degval (env deg-env))
	      (distval (env dist-env)))
          (setf dist-scaler (/ 1.0 distval))
          (setf (locsig-ref loc 0) (* (- 1.0 degval) dist-scaler))
          (if (> (mus-channels *output*) 1) (setf (locsig-ref loc 1) (* degval dist-scaler)))
          (when *reverb* (setf (locsig-reverb-ref loc 0) (* reverb-amount (sqrt dist-scaler))))
          (locsig loc i rdval))))))

(definstrument doc-2-6 (start dur freq amp &key (degree 0) (dist 1.0) (reverb 0))
  (let* ((beg (floor (* start *srate*)))
         (end (+ beg (floor (* dur *srate*))) )
         (car (make-oscil :frequency freq))
         (loc (make-locsig :degree degree :distance dist :channels 2))
	 (pan-env (make-env '(0 0 1 90) :duration dur)))
    (run
     (loop for i from beg to end do
       (let ((ut (* amp (oscil car))))
	 (move-locsig loc (env pan-env) dist)
         (locsig loc i ut))))))

(definstrument doc-2-7 (beg dur file amp lo hi &optional (fftsize 1024))
  ;; fft overlap-add (and buffer), but the fft bins between lo and hi are reversed
  (let ((fil (open-input* file)))
    (when fil
      (unwind-protect
        (let* ((start (floor (* beg *srate*)))
               (end (+ start (floor (* dur *srate*))))
               (fdr (make-double-float-array fftsize))
               (fdi (make-double-float-array fftsize))
               (wtb (make-double-float-array fftsize))
               (filptr 0)
               (fft2 (floor fftsize 2))
               (fft4 (floor fftsize 4))
               (ctr fft2)
               (fftn (/ 1.0 fftsize))
               (first-time 1)
               (mid (* .5 (+ hi lo))))
	  (when (zerop lo) (setf lo 1))
          (run
           (loop for i from start below end do
             (when (= ctr fft2)
               (clear-array fdr)
               (clear-array fdi)
               (dotimes (k fft2)
                 (setf (aref fdr (+ k fft4)) (* (ina filptr fil) fftn))
                 (incf filptr))
               (fft fdr fdi fftsize 1)
               (let ((j1 hi) ;now reverse bins between lo and hi
                     (k0 (- fftsize lo))
                     (k1 (- fftsize hi)))
		 (do ((j0 lo (1+ j0)))
		     ((> j0 mid))
                   (let ((tmprj (aref fdr j0))
                         (tmprk (aref fdr k0))
                         (tmpij (aref fdi j0))
                         (tmpik (aref fdi k0)))
                     (setf (aref fdr j0) (aref fdr j1))
                     (setf (aref fdr j1) tmprj)
                     (setf (aref fdr k0) (aref fdr k1))
                     (setf (aref fdr k1) tmprk)
                     (setf (aref fdi j0) (aref fdi j1))
                     (setf (aref fdi j1) tmpij)
                     (setf (aref fdi k0) (aref fdi k1))
                     (setf (aref fdi k1) tmpik)
                     (incf k1)
                     (decf k0)
                     (decf j1))))
               (fft fdr fdi fftsize -1)
               (dotimes (k fft2)
                 (setf (aref wtb k) (aref wtb (+ k fft2)))
                 (setf (aref wtb (+ k fft2)) 0.0))
               (if (= first-time 1)
                   (progn
                     (dotimes (k fftsize) (setf (aref wtb k) (aref fdr k)))
                     (setf first-time 0)
		     (setf ctr fft4))
                 (progn
                   (dotimes (k fft2) (incf (aref wtb k) (aref fdr k)))
                   (dotimes (k fft2) (setf (aref wtb (+ k fft2)) (aref fdr (+ k fft2))))
		   (setf ctr 0))))
             (outa i (* amp (aref wtb ctr)))
             (incf ctr))))
        (close-input fil)))))

;(with-sound () (inside-out 0 1.0 "fyow" 1.0 3 8))

#-clisp
(definstrument doc-2-8 (beg dur)
  (let ((o (make-oscil 660)))
    (run 
     (let ((j beg)) 
       (loop for i from 0 below dur do
	 (outa (+ i j) (* .1 (oscil o))))))))

(definstrument doc-2-9 (beg dur)
  (let ((o (make-oscil 440)))
    (run
     (dotimes (k dur)
       (outa (+ k beg) (* .1 (oscil o)))))))

(definstrument doc-3-0 (beg dur)
  (run
   (dotimes (i dur)
     (dotimes (k (random 10))
       (outa (+ beg (floor (random dur))) (centered-random .01))))))

(definstrument msnd (beg dur freq amp)
  (let ((os (make-oscil freq)))
    (run
     (loop for i from beg below (+ beg dur) do
       (outa i (* amp (oscil os)))))))

#-sbcl
(definstrument doc-3-1 (beg dur sr amp)
  (let* ((temp-file (with-sound (:output "temp.snd") (msnd 0 dur 440.0 .1)))
	 (reader (make-src :input temp-file :srate sr))
	 (new-dur (/ dur sr)))
    (run
     (loop for i from beg below (+ beg new-dur) do
       (outa i (* amp (src reader)))))
    (delete-file temp-file)))

#-clisp
(definstrument doc-3-2 (beg dur frq amp)
  (let* ((s (make-oscil frq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (hi 0.0))
    (run* (amp hi)
      (loop for i from start below end do
	(incf hi .001)
	(outa i (* amp (oscil s)))))
    (print (format nil "~A ~A" hi amp))))

(defstruct fmins carrier modulator)

#-clisp
(definstrument doc-3-3 (beg dur frq amp ind &optional previous-oscils)
  (let* ((start (floor (* *srate* beg)))
	 (end (+ start (floor (* *srate* dur))))
	 (carrier (if previous-oscils
		      (fmins-carrier previous-oscils)
		    (make-oscil 440.0)))
	 (modulator (if previous-oscils
			(fmins-modulator previous-oscils)
		      (make-oscil 440.0))))
    (setf (mus-frequency carrier) frq)
    (setf (mus-frequency modulator) frq)
    (run* (carrier modulator)
     (loop for i from start below end do
       (outa i (* amp (oscil carrier (* ind (oscil modulator)))))))
    (if previous-oscils
	(progn
	  (setf (fmins-carrier previous-oscils) carrier)
	  (setf (fmins-modulator previous-oscils) modulator)))))

;;; (defvar oscs (make-fmins :carrier (make-oscil 440.0) :modulator (make-oscil 440.0)))
;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0 oscs) (fmsimp 1.01 1 660 .1 0.0 oscs))
;;; (with-sound () (fmsimp 0 1.01 440 .1 0.0) (fmsimp 1.01 1 660 .1 0.0))
;;;     the 1.01 (as opposed to 1.0) is needed because the phases line up just by chance in the 1.0 case
;;;     for portamento, the instrument could notice an in-coming osc set and
;;;     change the frequency envelope accordingly

#-clisp
(definstrument or1 ()
  (let ((e1 (make-env '(0 0 1 1) :length 11))
	(e2 (make-env '(0 1 1 0) :length 11))
	(e3 nil)
	(ok1 0))
    (run* (ok1)
     (loop for i from 0 to 1 do
       (if (or e1 e2)
	   (incf ok1 (env e1)))
       (if (not (or e1 e2))
	   (print "or1 1"))
       (if (and e1 e2)
	   (incf ok1 (env e2)))
       (if (not (and e1 e2))
	   (print "or1 2"))
       (if (or e3 e1 e2)
	   (mus-reset e2)) ; resets e2 -> 1.0
       (if (and e1 e3 e2)
	   (print "or1 3"))
       (if (not e1)
	   (print "or1 4"))))
    (if (> (abs (- 2.1 ok1)) .001)
	(print (format nil "or1 ok1: ~A~%" ok1)))))

#-clisp
(definstrument or2 ()
  (let ((e1 (make-env '(0 0 1 1) :length 11))
	(e2 (make-env '(0 1 1 0) :length 11))
	(e3 nil)
	(ok1 0.0)
	(oki 0)
	(okb nil))
    (run* (ok1 oki okb)
     (loop for i from 0 to 1 do
       (declare (type :mus-any e1 e2 e3)
		(type :float ok1)
		(type :integer oki)
		(type :boolean okb))
       (incf oki)
       (setf okb t)
       (if (or e1 e2)
	   (incf ok1 (env e1)))
       (if (not (or e1 e2))
	   (print "or2 1"))
       (if (and e1 e2)
	   (incf ok1 (env e2)))
       (if (not (and e1 e2))
	   (print "or2 2"))
       (if (or e3 e1 e2)
	   (mus-reset e2)) ; resets e2 -> 1.0
       (if (and e1 e3 e2)
	   (print "or2 3"))
       (if (not e1)
	   (print "or2 4"))))
    (if (not okb)
	(print (format nil "or2 okb: ~A~%" okb)))
    (if (not (= oki 2))
	(print (format nil "or2 oki: ~A~%" oki)))
    (if (> (abs (- 2.1 ok1)) .001)
	(print (format nil "or2 ok1: ~A~%" ok1)))))

#-clisp
(definstrument or3 ()
  (let ((e1 (make-env '(0 0 1 1) :length 11))
	(i1 (make-integer-array 3 :initial-element 32))
	(f1 (make-double-array 3 :initial-element 3.14))
	(i2 (make-integer-array 3 :initial-element 3))
	(f2 (make-double-array 3 :initial-element 1.5))
	(ok1 0)
	(oki 0))
    (run* (ok1 oki)
     (loop for i from 0 to 1 do
       (declare (type :integer* i1 i2)
		(type :float* f1 f2)
		(type :integer oki)
		(type :float ok1))
       (cond (e1 (incf ok1 (env e1)))
	     (t (print "or3 1")))
       (if (or f1 f2)
	   (incf ok1 (aref f2 0)))
       (if (not (or f2 f1))
	   (print "or3 2"))
       (if (and f2 f1)
	   (incf ok1 (aref f1 1)))
       (if (or i1 i2)
	   (incf oki (aref i2 0)))
       (if (not (or i2 i1))
	   (print "or3 3"))
       (if (and i2 i1)
	   (incf oki (aref i1 1)))))
    (if (not (= oki 70))
	(print (format nil "or3 oki: ~A~%" oki)))
    (if (> (abs (- 9.38 ok1)) .001)
	(print (format nil "or3 ok1: ~A~%" ok1)))))

#-clisp
(definstrument or4 ()
  (let ((e1 (make-env '(0 0 1 1) :length 11))
	(e2 (make-env '(0 1 1 0) :length 11))
  	(i1 (make-integer-array 3 :initial-element 32))
	(f1 (make-double-array 3 :initial-element 3.14))
	(i2 (make-integer-array 3 :initial-element 3))
	(f2 (make-double-array 3 :initial-element 1.5))
	(oki 0))
    (run* (oki)
     (loop for i from 0 to 1 do
       (if (or (and e1 e2)
	       (and f1 f2)
	       (and i1 i2))
	   (incf oki))
       (if (and (or f1 f2)
		(not (or i1 i2))
		(or e1 e2))
	   (print "or4 1"))
       (if f1
	   (if e1
	       (if (not e2)
		   (print "or4 2")
		 (incf oki))
	     (print "or4 3"))
	 (print "or4 4"))))
    (if (not (= oki 4))
	(print (format nil "or4 oki: ~A~%" oki)))))

#-clisp
(definstrument if1 ()
  (let ((s "hi")
	(v (make-double-array 3 :initial-element 3.0))
	(vi (make-integer-array 3 :initial-element 32))
	(g (make-oscil 440.0))
	(i2 0)
	(ch #\c)
	(i1 32)
	(f 0.0)
	(f1 3.14)
	(ok 0)
	)
    (run* (ok)
      (loop for i from 0 to 1 do
	(if s (setf ok (1+ ok)) (clm-print ";if direct s"))
	(if v (setf ok (1+ ok)) (clm-print ";if direct v"))
	(if vi (setf ok (1+ ok)) (clm-print ";if direct vi"))
	(if g (setf ok (1+ ok)) (clm-print ";if direct g"))
	(if ch (setf ok (1+ ok)) (clm-print ";if direct ch"))
	(if 0 (setf ok (1+ ok)) (clm-print ";if direct 0"))
	(if i2 (setf ok (1+ ok)) (clm-print ";if direct i2"))
	(if i1 (setf ok (1+ ok)) (clm-print ";if direct i1"))
	(if 0.0 (setf ok (1+ ok)) (clm-print ";if direct 0.0"))
	(if f (setf ok (1+ ok)) (clm-print ";if direct f"))
	(if f1 (setf ok (1+ ok)) (clm-print ";if direct f1"))
	(cond ((not s) (clm-print ";cond direct s"))
	      ((not v) (clm-print ";cond direct v"))
	      ((not vi) (clm-print ";cond direct vi"))
	      ((not g) (clm-print ";cond direct g"))
	      ((not ch) (clm-print ";cond direct ch"))
	      ((not i) (clm-print ";cond direct i"))
	      ((not i1) (clm-print ";cond direct i1"))
	      ((not f) (clm-print ";cond direct f"))
	      ((not f1) (clm-print ";cond direct f1")))))
    (if (not (= ok 22)) (print (format nil ";ok: ~A" ok)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;      file: noisetone.ins
;;;;

(definstrument noisetone (start dur amp ampfunc  ;; amplitude envelope (must be envelope)
                                freqfunc bwfunc  ;; frequency and bandwidth (can envelopes or scalar)
                                &key
                                (bwbase 0.0)
                                (ampbase 10)  ;; base for amplitude envelope
                                (mix 1.0) ;; control mix between noisy sinusoid = 1.0 ---> 0.0 = pure sinusoid
                                (degree 45.0)
                                (distance 1.0)
                                (reverb 0.1)  ;; how much signal to send to reverberator
                                )
  (let* ((beg (floor (* start *srate*)))
         (end (+ beg (floor (* dur *srate*))))
         (ampenv (if ampbase
                   (make-env :envelope ampfunc :duration dur :scaler amp :base ampbase)
                   (make-env :envelope ampfunc :duration dur :scaler amp)))

         (noise (make-rand-interp (if (numberp bwfunc) (+ bwfunc bwbase) bwbase)))
         (bwenv (if (listp bwfunc)
                  (make-env :envelope bwfunc :duration dur :scaler (hz->radians 1.0))
                  nil))
         (freqenv (if (listp freqfunc)
                    (make-env :envelope freqfunc :duration dur :scaler (hz->radians 1.0))
                    nil))
         (mixenv (if (listp mix)
                   (make-env :envelope mix :duration dur)))
         (mixscaler (if (listp mix) 0.0 mix))
         (sine (make-oscil (if (numberp freqfunc) freqfunc 0.0) (centered-random pi)))  ;; random phase on oscilator
         ;;
         ;; locsig stuff follows:
         ;;
         (update-rate 10)
         (degree-env (if (listp degree)
                       (make-env :envelope degree :duration (/ dur update-rate))
                       nil))
         (distance-env (if (listp distance)
                         (make-env :envelope distance :duration (/ dur update-rate))))
         (place (make-locsig :degree (if (numberp degree) degree 45.0)
                             :distance (if (numberp distance) distance 1.0)
                             :reverb (if (numberp reverb) reverb 0.0)
                             :type mus-sinusoidal))
         )
    (run
     (loop for i fixnum from beg to end do
           (let (deg dist wave freqmod bwmod mixmod)
             (declare (type :integer beg end update-rate)
		      (type :mus-any ampenv noise bwenv freqenv mixenv sine
			    degree-env distance-env place)
		      (type :float mixscaler deg degree distance dist wave freqmod bwmod mixmod mixscaler))
             (when (or degree-env distance-env)
               (when (= 0 (mod (- i beg) update-rate))
		 (setf deg (if degree-env (env degree-env) degree))
		 (setf dist (if distance-env (env distance-env) distance)))
	       (move-locsig place deg dist))
             (setf freqmod (if freqenv (env freqenv) 0.0))
             (setf bwmod (if bwenv (env bwenv) 0.0))
             ;; mix is not equal power
             (setf mixmod (if mixenv (env mixenv) mixscaler))
             (setf wave (oscil sine freqmod))
             (locsig place i (* (env ampenv)
                                (+ (* mixmod wave (rand-interp noise bwmod))
                                   (* (- 1.0 mixmod) wave)))))
           ))))

#-clisp
(definstrument let1 ()
  (let ((osc (make-oscil 440.0))
	(val 0.0))
    (run* (val)
      (loop for i from 0 to 1 do
        (let ((val1 (oscil osc))
	      (g1 osc))
	  (setf val (oscil g1)))
	(outa i val *output*)))
    (if (> (abs (- val .3673)) 0.001)
	(format t ";let1 val is ~A~%" val))))


(definstrument simple-multiarr ()
  (let* ((os (make-oscil 440.0))
	 (arr (make-array (list 3 5) :element-type 'double-float :initial-element (coerce 0.0 'double-float))))
    (do ((i 0 (1+ i)))
	((= i 3))
      (do ((j 0 (1+ j)))
	  ((= j 5))
	(setf (aref arr i j) (coerce (+ j (* i 10)) 'double-float))))
    (run
     (loop for i from 0 to 1 do
       (do ((i 0 (1+ i)))
	   ((= i 3))
	 (do ((j 0 (1+ j)))
	     ((= j 5))
	   (let ((ij (+ j (* i 10))))
	     (if (not (= ij (floor (aref arr i j))))
		 (clm-print "multi arr bad")))))
       (outa i (* .1 (oscil os)))))))

(definstrument gen-multiarr (start end)
  (let* ((arr (make-array (list 3 5))))
    (do ((i 0 (1+ i)))
	((= i 3))
      (do ((j 0 (1+ j)))
	  ((= j 5))
	(setf (aref arr i j) (make-oscil (* 100 (+ j (* 5 i)))))))
    (run
     (loop for i from start to end do
       (let ((sum 0.0))
	 (do ((i 0 (1+ i)))
	     ((= i 3))
	   (do ((j 0 (1+ j)))
	       ((= j 5))
	     (setf sum (+ sum (oscil (aref arr i j))))))
	 (outa i (* .01 sum)))))))
