;; these are CLM test instruments

(definstrument simple-out (beg dur freq amp)
  (let* ((os (make-oscil freq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (oscil os)))))))

(definstrument simple-ssb (beg dur freq amp)
  (let* ((os (make-ssb-am freq))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (arr (make-array 3)))
    (setf (aref arr 0) os)
    (setf (aref arr 1) nil)
    (setf (aref arr 2) (make-ssb-am 660 40))
    (run
     (loop for i from start to end do
       (let* ((sum 0.0))
	 (do ((i 0 (1+ i)))
	     ((= i (length arr)))
	   (if (ssb-am? (aref arr i))
	       (incf sum (ssb-am (aref arr i) 1.0))))
	 (outa i (* amp sum)))))))

(definstrument simple-nsin (beg dur amp)
  (let* ((os (make-nsin 440 10))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (nsin os)))))))

(definstrument simple-ncos (beg dur freq amp)
  (let* ((os (make-ncos freq 10))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (ncos os)))))))

(definstrument simple-nrxysin (beg dur amp)
  (let* ((os (make-nrxysin 440 1.0 10))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (nrxysin os)))))))

(definstrument simple-nrxycos (beg dur freq amp)
  (let* ((os (make-nrxycos freq 1.0 10))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (nrxycos os)))))))

(definstrument simple-osc (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (arr (make-array 20)))
    (do ((i 0 (1+ i)))
	((= i 20))
      (setf (aref arr i) (make-oscil (* (1+ i) 100))))
    (run
     (loop for i from start to end do
       (let ((sum 0.0))
	 (do ((i 0 (1+ i)))
	     ((= i (length arr)))
	   (if (oscil? (aref arr i))
	       (incf sum (oscil (aref arr i)))))
	 (outa i (* amp .05 sum)))))))

(definstrument simple-osc-1 (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (arr nil)
	 (osc (make-oscil freq)))
    (run
     (loop for i from start to end do
       (declare (type :mus-any* arr))
       (let ((sum 0.0))
	 (if arr
	     (do ((i 0 (1+ i)))
		 ((= i (length arr)))
	       (if (oscil? (aref arr i))
		   (incf sum (oscil (aref arr i)))))
	   (setf sum (oscil osc)))
	 (outa i (* amp .05 sum)))))))

(definstrument simple-asy (beg dur amp)
  (let* ((os (make-asymmetric-fm 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (asymmetric-fm os 1.0)))))))

(definstrument simple-saw (beg dur amp)
  (let* ((os (make-sawtooth-wave 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (sawtooth-wave os)))))))

(definstrument simple-sqr (beg dur amp)
  (let* ((os (make-square-wave 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (square-wave os)))))))

(definstrument simple-tri (beg dur amp)
  (let* ((os (make-triangle-wave 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (triangle-wave os)))))))

(definstrument simple-pul (beg dur amp)
  (let* ((os (make-pulse-train 440.0))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (pulse-train os)))))))

(definstrument simple-oz (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-one-zero 0.4 0.6)))
    (run
     (loop for i from start to end do
       (outa i (* amp (one-zero oz (oscil os))))))))

(definstrument simple-op (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-one-pole 0.4 -0.6)))
    (run
     (loop for i from start to end do
       (outa i (* amp (one-pole oz (oscil os))))))))

(definstrument simple-tz (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-two-zero 0.4 0.3 0.3)))
    (run
     (loop for i from start to end do
       (outa i (* amp (two-zero oz (oscil os))))))))

(definstrument simple-tp (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-two-pole 0.3 -0.6 0.1)))
    (run
     (loop for i from start to end do
       (outa i (* amp (two-pole oz (oscil os))))))))

(definstrument simple-frm (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-formant 1200.0 .95)))
    (run
     (loop for i from start to end do
       (outa i (* amp (formant oz (oscil os))))))))

(definstrument simple-firm (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (oz (make-firmant 1200.0 .95)))
    (run
     (loop for i from start to end do
       (outa i (* amp (firmant oz (oscil os))))))))

(definstrument simple-firm2 (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (frqf (make-env '(0 1200 1 2400) :scaler (hz->radians 1.0) :duration dur))
	 (oz (make-firmant 1200.0 .95)))
    (run
     (loop for i from start to end do
       (outa i (* amp (firmant oz (oscil os) (env frqf))))))))

(definstrument simple-poly (beg dur freq amp)
  (let* ((w1 (make-polyshape :frequency freq :partials (list 1 .5 2 .3 3 .2)))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (polyshape w1 1.0)))))))

(definstrument simple-polyw (beg dur freq amp)
  (let* ((w1 (make-polywave freq (list 1 .5 2 .3 3 .2)))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (polywave w1)))))))

(definstrument simple-dly (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (buf (make-delay 100)))
    (run
     (loop for i from start to end do
       (outa i (delay buf (* amp (oscil os))))))))

(definstrument simple-cmb (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (buf (make-comb .1 100)))
    (run
     (loop for i from start to end do
       (outa i (comb buf (* amp (oscil os))))))))

(definstrument simple-not (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (buf (make-notch .1 100)))
    (run
     (loop for i from start to end do
       (outa i (notch buf (* amp (oscil os))))))))

(definstrument simple-alp (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (buf (make-all-pass .2 .8 100)))
    (run
     (loop for i from start to end do
       (outa i (all-pass buf (* amp (oscil os))))))))

(definstrument simple-ave (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (buf (make-moving-average 10)))
    (run
     (loop for i from start to end do
       (outa i (moving-average buf (* amp (oscil os))))))))

(definstrument simple-tab (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (table-size 256)
	 (table (make-double-array table-size))
	 (buf (make-table-lookup freq 0.0 table table-size)))
    (do ((i 0 (1+ i)))
	((= i table-size))
      (setf (aref table i) (double (/ i table-size))))
    (run
     (loop for i from start to end do
       (outa i (* amp (table-lookup buf)))))))

(definstrument simple-flt (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (flt (make-filter 8))
	 (os (make-oscil freq)))
    (do ((i 0 (1+ i)))
	((= i 8))
      (setf (aref (mus-xcoeffs flt) i) (double (/ i 16)))
      (setf (aref (mus-ycoeffs flt) i) (- 0.5 (double (/ i 16)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (filter flt (oscil os))))))))

(definstrument simple-fir (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (flt (make-fir-filter 8))
	 (os (make-oscil freq)))
    (do ((i 0 (1+ i)))
	((= i 8))
      (setf (aref (mus-xcoeffs flt) i) (double (/ i 16))))
    (run
     (loop for i from start to end do
       (outa i (* amp (fir-filter flt (oscil os))))))))

(definstrument simple-iir (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (flt (make-iir-filter 8))
	 (os (make-oscil freq)))
    (do ((i 0 (1+ i)))
	((= i 8))
      (setf (aref (mus-ycoeffs flt) i) (double (/ i 16))))
    (run
     (loop for i from start to end do
       (outa i (* amp (iir-filter flt (oscil os))))))))

(definstrument simple-f (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (frm (make-frame 2 .7 .3))
	 (smp (make-empty-frame 2))
	 (os (make-oscil freq)))
    (run
     (loop for i from start to end do
       (let ((val (oscil os)))
	 (frame-set! smp 0 val)
	 (setf (frame-ref smp 1) val)
	 (outa i (* amp (frame->sample frm smp))))))))

(definstrument simple-ran (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-rand freq)))
    (run
     (loop for i from start to end do
       (outa i (* amp (rand os)))))))

(definstrument simple-ri (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-rand-interp freq)))
    (run
     (loop for i from start to end do
       (outa i (* amp (rand-interp os)))))))

(definstrument simple-rndist (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-rand freq :distribution (inverse-integrate '(0 0 1 1)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (rand os)))))))

(definstrument simple-ridist (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-rand-interp freq :distribution (inverse-integrate '(0 1 1 0)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (rand-interp os)))))))

(definstrument simple-env (beg dur freq amp)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (e (make-env '(0 0 1 1 2 1 3 0) :scaler amp :offset .1 :duration dur)))
    (run
     (loop for i from start to end do
       (outa i (* (env e) (oscil os)))))))

(definstrument simple-fof (beg dur frq amp vib f0 a0 f1 a1 f2 a2 &optional ve ae)
  (let* ((start (floor (* beg *srate*)))
         (end (+ start (floor (* dur *srate*))))
         (ampf (make-env :envelope (or ae (list 0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
         (frq0 (hz->radians f0))
         (frq1 (hz->radians f1))
         (frq2 (hz->radians f2))
         (foflen (if (= *srate* 22050) 100 200))
         (vibr (make-oscil :frequency 6))
	 (vibenv (make-env :envelope (or ve (list 0 1 100 1)) :scaler vib :duration dur))
         (win-freq (/ two-pi foflen))
         (foftab (make-double-float-array foflen))
         (wt0 (make-wave-train :wave foftab :frequency frq)))
    (setf foftab (mus-data wt0))
    (loop for i from 0 below foflen do
      (setf (aref foftab i) (double
        ;; this is not the pulse shape used by B&R
            (* (+ (* a0 (sin (* i frq0))) 
                  (* a1 (sin (* i frq1))) 
                  (* a2 (sin (* i frq2)))) 
               .5 (- 1.0 (cos (* i win-freq)))))))
    (run
     (loop for i from start below end do
       (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))

(definstrument simple-amb (beg dur freq amp)
  (let* ((os (if (> freq 1) (make-oscil freq) (make-rand freq)))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (if (oscil? os) (oscil os) (rand os))))))))

(definstrument simple-rd (beg dur amp file)
  (let* ((fd (open-input file))
	 (rd (make-readin fd))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (readin rd)))))
    (close-input fd)))

(definstrument simple-rd-start (beg dur amp file channel start)
  (let* ((fd (open-input file :channel channel :start start))
	 (rd (make-readin fd))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (readin rd)))))
    (close-input fd)))

(definstrument simple-cnv (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (filt (make-double-array 8)))
    (do ((i 0 (1+ i))) ((= i 8)) (setf (aref filt i) (double 0.0)))
    (setf (aref filt 4) (double 1.0))
    (let ((ff (make-convolve :input fil :filter filt)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (convolve ff)))))
      (close-input fil))))

(definstrument simple-cnf (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (rd (make-readin fil))
	 (filt (make-double-array 8)))
    (do ((i 0 (1+ i))) ((= i 8)) (setf (aref filt i) (double 0.0)))
    (setf (aref filt 4) (double 1.0))
    (let ((ff (make-convolve :filter filt)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (convolve ff #'(lambda (dir) (readin rd)))))))
      (close-input fil))))

(definstrument simple-lrg (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (rd (make-readin fil))
	 (filt (make-double-array 8)))
    (do ((i 0 (1+ i))) ((= i 8)) (setf (aref filt i) (double 0.0)))
    (setf (aref filt 4) (double 1.0))
    (let ((ff (make-convolve :filter filt)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (convolve ff #'(lambda (dir)
					 (if (= dir 1)
					     (readin rd)
					   0.0)))))))
      (close-input fil))))

(definstrument simple-cn2 (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (fil1 (open-input file))
	 (rd (make-readin fil))
	 (filt (make-double-array 8)))
    (do ((i 0 (1+ i))) ((= i 8)) (setf (aref filt i) (double 0.0)))
    (setf (aref filt 4) (double 1.0))
    (let ((ff (make-convolve :filter filt))
	  (ff1 (make-convolve :filter filt :input fil1)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (+ (convolve ff #'(lambda (dir)
					    (if (= dir 1)
						(readin rd)
					      0.0)))
			   (convolve ff1))))))
      (close-input fil)
      (close-input fil1))))

(definstrument simple-src (beg dur amp speed file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (sr (make-src :input fil :srate speed)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (src sr)))))
      (close-input fil)))

(definstrument simple-sr2 (beg dur amp speed file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (rd (make-readin fil))
	 (sr (make-src :srate speed)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (src sr 0.0 #'(lambda (dir) (if (= dir 1) (readin rd))))))))
      (close-input fil)))

(definstrument simple-sr2a (beg dur amp speed file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (rd (make-readin file))
	 (sr (make-src :input rd :srate speed)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (src sr)))))))

(definstrument simple-sro (beg dur amp speed freq)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (sr (make-src :srate speed)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (src sr 0.0 #'(lambda (dir)
					(oscil os)))))))))

(definstrument simple-grn (beg dur amp speed freq)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (os (make-oscil freq))
	 (sr (make-granulate :expansion speed)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (granulate sr #'(lambda (dir) (oscil os)))))))))

(definstrument simple-pvoc (beg dur amp size file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (sr (make-phase-vocoder fil :fft-size size)))
      (run
       (loop for i from start to end do
	 (outa i (* amp (phase-vocoder sr)))))
      (close-input fil)))

(definstrument simple-ina (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (open-input file))
	 (ctr 0))
    (run
     (loop for i from start to end do
       (outa i (* amp (in-any ctr 0 fil)))
       (incf ctr)))
    (close-input fil)))

(definstrument simple-f2s (beg dur amp file)
  (let* ((start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*))))
	 (fil (make-file->sample file))
	 (ctr 0))
    (run
     (loop for i from start to end do
       (outa i (* amp (file->sample fil ctr 0)))
       (incf ctr)))))

(definstrument simple-rdf (beg dur amp file)
  (let* ((rd (make-readin file))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (outa i (* amp (readin rd)))))))

(definstrument simple-loc (beg dur freq amp)
  (let* ((os (make-oscil freq))
	 (loc (make-locsig :degree 0.0 :channels 1))
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (locsig loc i (* amp (oscil os)))))))

(definstrument simple-dup (beg dur freq amp)
  (let* ((os (make-oscil freq))
	 (j 2)
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (declare (type float amp) (type integer j))
       (let ((amp .3)
	     (j 4))
	 (if (not (= j 4)) (clm-print "local j is ~D\n" j))
	 (if (> (abs (- amp .3)) .001) (clm-print "local amp is ~F\n" amp)))
       (if (= j 2)
	   (outa i (* amp (oscil os))))))))

#|
(definstrument simple-du1 (beg dur freq amp)
  (let* ((os (make-oscil freq))
	 (j (+ (expt 2 41) 1234)) ; 2199023256786
	 (mj -3)
	 (jj (- (+ (expt 2 40) 4321))) ; -1099511632097
	 (start (floor (* beg *srate*)))
	 (end (+ start (floor (* dur *srate*)))))
    (run
     (loop for i from start to end do
       (declare (type bignum j jj))
       (if (not (= j 2199023256786)) (clm-print "local j is ~A" j))
       (if (not (= jj -1099511632097)) (clm-print "local jj is ~A" jj))
       (if (= mj -3)
	   (outa i (* amp (oscil os)))
	 (clm-print "minus 3: ~D" mj))))))
|#
