path: root/clm23.scm

;;; these are (ancient!) CLM test instruments

(provide 'snd-clm23.scm)
(if (provided? 'snd)
    (require snd-ws.scm)
    (require sndlib-ws.scm))
(require snd-dsp.scm snd-jcrev.scm)


;;; definstrument -> define* (+ change open paren placement)
;;; *srate* -> *clm-srate*
;;; run loop ... -> (do...)
;;; aref -> [float-vector-ref or vector-ref use implicit indexing]
;;; setf -> set!
;;; remove declare
;;; double not needed
;;; array of gen -> vector (and setf aref to vector-set! in this case)
;;; nil -> #f, t -> #t
;;; incf, decf to explicit sets
;;; length sometimes length, vector-length etc
;;; make-filter in scm requires coeffs arrays
;;; &optional, &key -> define*
;;; two-pi -> (* 2 pi)
;;; open-input and close-input -> make-readin or use name directly (in make-readin)
;;; make-locsig channel arg is in a different place
;;; progn -> begin, dotimes -> do
;;; string= -> string=? (also string-equal)
;;; integerp -> integer? and others like it (null -> null? is the tricky one)
;;; sound-duration -> mus-sound-duration and similarly for others
;;; various array info procs like array-dimension
;;; #'(lambda ...) to just (lambda...), and if possible move the lambda out of the args
;;; nth -> list-ref
;;; loop -> do

(define (clm23-sine-bank amps phases len)
  (let ((sum 0.0))
    (do ((i 0 (+ 1 i)))
	((= i len))
      (set! sum (+ sum (* (amps i)
			  (sin (phases i))))))
    sum))

(define two-pi (* 2 pi))

(define (simple-out beg dur freq amp)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (oscil os))))))

(definstrument (simple-fm beg dur freq amp mc-ratio index amp-env index-env)
  (let ((fm-index (hz->radians (* index mc-ratio freq))))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (cr (make-oscil freq))                     ; carrier
	  (md (make-oscil (* freq mc-ratio)))        ; modulator
	  (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)))
      (do ((i start (+ i 1)))
	  ((= i end))
	(outa i (* (env ampf) (oscil cr (* (env indf) (oscil md)))))))))

(define (simple-outn beg dur freq ampa ampb ampc ampd reva revb)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (let ((val (oscil os)))
	(if (> ampa 0.0) (outa i (* ampa val)))
	(if (> ampb 0.0) (outb i (* ampb val)))
	(if (> ampc 0.0) (outc i (* ampc val)))
	(if (> ampd 0.0) (outd i (* ampd val)))
	(if (> reva 0.0) (outa i (* reva val) *reverb*))
	(if (> revb 0.0) (outb i (* revb val) *reverb*))))))

(define (simple-ssb beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(arr (make-vector 3)))
    (set! (arr 0) (make-ssb-am freq))
    (set! (arr 1) #f)
    (set! (arr 2) (make-ssb-am 660 40))
    (do ((k 0 (+ k 1)))
	((= k (length arr)))
      (let ((g (arr k)))
	(if (ssb-am? g)
	    (do ((i start (+ i 1))) 
		((= i end))
	      (outa i (ssb-am g amp))))))))

(define (simple-multiarr beg dur freq amp)
  ;; this won't work in CL because that version of CLM assumes all aref gens are the same type
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(arr (make-vector 3)))
    (set! (arr 0) (make-oscil freq))
    (set! (arr 1) (make-env '(0 0 1 1) :scaler amp :duration dur))
    (set! (arr 2) (make-oscil (* freq 2)))
    (do ((i start (+ i 1))) 
	((= i end))
      (outa i (* (env (vector-ref arr 1))
		 (oscil (arr 0)
			(* .1 (oscil (arr 2)))))))))

(define (simple-nsin beg dur amp)
  (let ((os (make-nsin 440 10))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (nsin os))))))

(define (simple-ncos beg dur freq amp)
  (let ((os (make-ncos freq 10))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (ncos os))))))

(define (simple-nrxysin beg dur amp)
  (let ((os (make-nrxysin 440 1.0 10))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (nrxysin os))))))

(define (simple-nrxycos beg dur freq amp)
  (let ((os (make-nrxycos freq 1.0 10))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (nrxycos os))))))

(define (simple-osc beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(freqs (make-float-vector 20))
	(fv (make-float-vector 20)))
    (do ((i 0 (+ i 1)))
	((= i 20))
      (set! (freqs i) (hz->radians (* (+ i 1) freq))))
    (let ((obank (make-oscil-bank freqs fv (make-float-vector 20 1.0) #t)))
      (set! amp (* 0.05 amp))
      (do ((i start (+ i 1))) 
	  ((= i end))
	(outa i (* amp (oscil-bank obank)))))))

(define (simple-asy beg dur amp)
  (let ((os (make-asymmetric-fm 440.0))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (asymmetric-fm os 1.0))))))

(define (simple-saw beg dur amp)
  (let ((os (make-sawtooth-wave 440.0 amp))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (sawtooth-wave os)))))

(define (simple-sqr beg dur amp)
  (let ((os (make-square-wave 440.0 amp))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (square-wave os)))))

(define (simple-tri beg dur amp)
  (let ((os (make-triangle-wave 440.0 amp))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (triangle-wave os)))))

(define (simple-pul beg dur amp)
  (let ((os (make-pulse-train 440.0 amp))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (pulse-train os)))))

(define (simple-oz beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-one-zero (* amp 0.4) (* amp 0.6))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (one-zero oz (oscil os))))))

(define (simple-op beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-one-pole (* amp 0.4) -0.6)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (one-pole oz (oscil os))))))

(define (simple-tz beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-two-zero (* amp 0.4) (* amp 0.3) (* amp 0.3))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (two-zero oz (oscil os))))))

(define (simple-tp beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-two-pole (* amp 0.3) -0.6 0.1)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (two-pole oz (oscil os))))))

(define (simple-frm beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-formant 1200.0 0.95)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (formant oz (oscil os)))))))

(define (simple-firm beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(oz (make-firmant 1200.0 0.95)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (firmant oz (oscil os)))))))

(define (simple-firm2 beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(frqf (make-env '(0 1200 1 2400) :scaler (hz->radians 1.0) :duration dur))
	(oz (make-firmant 1200.0 0.95)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (firmant oz (oscil os) (env frqf)))))))

					;(define w1 (make-polyshape :frequency 100.0 
					;			   :partials (let ((frqs ()))
					;				       (do ((i 1 (+ i 1)))
					;					   ((= i 10) (begin (format () frqs) (reverse frqs)))
					;					 (set! frqs (cons (/ 1.0 (* i i)) (cons i frqs)))))))

(define (simple-poly beg dur freq amp)
  (let ((w1 (make-polyshape freq :partials '(1 1 2 1 3 1)))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (polyshape w1 1.0))))))

(define (simple-polyw beg dur freq amp)
  (let ((w1 (make-polywave freq :partials (list 1 amp 2 amp 3 amp)))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (polywave w1)))))

(define (simple-dly beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-delay 100)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (delay buf (oscil os)))))))

(define (simple-cmb beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-comb .1 100)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (comb buf (oscil os)))))))

(define (simple-filtered-cmb beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-filtered-comb .1 100 :filter (make-one-zero .5 .5))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (filtered-comb buf (oscil os)))))))

(define (simple-not beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-notch .1 100)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (notch buf (oscil os)))))))

(define (simple-alp beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-all-pass .2 .8 100)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (all-pass buf (oscil os)))))))

(define (simple-ave beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(buf (make-moving-average 10)))
    (set! (mus-increment buf) (* amp (mus-increment buf)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (moving-average buf (oscil os))))))

(define (simple-tab beg dur freq amp)
  (let ((table-size 256))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (buf (make-table-lookup freq 0.0 :size table-size)))
      (let ((table (mus-data buf)))
	(do ((i 0 (+ i 1)))
	    ((= i table-size))
	  (set! (table i) (/ i table-size))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (table-lookup buf)))))))

(define (simple-flt beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
	(os (make-oscil freq)))
    (do ((i 0 (+ i 1)))
	((= i 8))
      (set! ((mus-xcoeffs flt) i) (/ i 16.0))
      (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (filter flt (oscil os)))))))

(define (simple-fir beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(flt (make-fir-filter 8 :xcoeffs (make-float-vector 8)))
	(os (make-oscil freq)))
    (do ((i 0 (+ i 1)))
	((= i 8))
      (set! ((mus-xcoeffs flt) i) (/ i 16.0)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (fir-filter flt (oscil os)))))))

(define (simple-iir beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(flt (make-iir-filter 8 :ycoeffs (make-float-vector 8)))
	(os (make-oscil freq)))
    (do ((i 0 (+ i 1)))
	((= i 8))
      (set! ((mus-ycoeffs flt) i) (/ i 16.0)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (iir-filter flt (oscil os)))))))

(define (simple-ran beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-rand freq amp)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (rand os)))))

(define (simple-ri beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-rand-interp freq amp)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (rand-interp os)))))

(define (simple-rndist beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-rand freq amp :distribution (inverse-integrate '(0 0 1 1)))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (rand os)))))

(define (simple-ridist beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-rand-interp freq amp :distribution (inverse-integrate '(0 1 1 0)))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (rand-interp os)))))

(define (simple-env beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq))
	(e (make-env '(0 0 1 1 2 1 3 0) :scaler amp :offset .1 :duration dur)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* (env e) (oscil os))))))

(define* (simple-fof beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
  (let ((foflen (if (= *clm-srate* 22050) 100 200)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (ampf (make-env :envelope (or ae '(0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
	  (frq0 (hz->radians f0))
	  (frq1 (hz->radians f1))
	  (frq2 (hz->radians f2))
	  (vibr (make-oscil 6))
	  (vibenv (make-env :envelope (or ve '(0 1 100 1)) :scaler vib :duration dur))
	  (win-freq (/ two-pi foflen))
	  (wt0 (make-wave-train :size foflen :frequency frq)))
      (let ((foftab (mus-data wt0)))
	(do ((i 0 (+ i 1))) ((= i foflen))
	  (set! (foftab i) ;; 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)))))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr)))))))))

(define (simple-amb beg dur freq amp)
  (let ((os ((if (> freq 1) make-oscil make-rand) freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (os))))))

(define (simple-rd beg dur amp file)
  (let ((rd (make-readin file))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (readin rd))))))

(define (simple-rd-start beg dur amp file channel start)
  (let ((rd (make-readin file :channel channel :start start))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (readin rd))))))

(define (simple-cnv beg dur amp file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(filt (make-float-vector 8)))
    (set! (filt 4) 1.0)
    (let ((ff (make-convolve :input (make-readin file) :filter filt)))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (convolve ff)))))))

(define (simple-cnf beg dur amp file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(filt (make-float-vector 8)))
    (set! (filt 4) 1.0)
    (let ((ff (make-convolve (make-readin file) :filter filt)))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (convolve ff)))))))

(define (simple-lrg beg dur amp file)
  (let ((rd (make-readin file)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (read-func (lambda (dir) (readin rd)))
	  (filt (make-float-vector 8)))
      (set! (filt 4) 1.0)
      (let ((ff (make-convolve :filter filt :input read-func)))
	(do ((i start (+ i 1))) ((= i end))
	  (outa i (* amp (convolve ff))))))))


(define (simple-cn2 beg dur amp file)
  (let ((rd (make-readin file)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (read-func (lambda (dir) (readin rd)))
	  (filt (make-float-vector 8)))
      (set! (filt 4) 1.0)
      (let ((ff (make-convolve :filter filt :input read-func))
	    (ff1 (make-convolve :filter filt :input (make-readin file))))
	(do ((i start (+ i 1))) ((= i end))
	  (outa i (* amp (+ (convolve ff)
			    (convolve ff1)))))))))

(define (simple-src beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-src :input (make-readin file) :srate speed)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (src sr))))))

(define (simple-src-f beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-src :input (make-readin file) :srate speed)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (src sr 0.0))))))

(define (simple-sr2 beg dur amp speed file)
  (let ((rd (make-readin file)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (sr (make-src :srate speed 
			:input (lambda (dir) (readin rd)))))
      (do ((i start (+ i 1))) 
	  ((= i end))
	(outa i (* amp (src sr)))))))

(define simple-sr2a simple-src)

(define (simple-sro beg dur amp speed freq)
  (let ((os (make-oscil freq)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (sr (make-src :srate speed :input (lambda (dir) (oscil os)))))
      (do ((i start (+ i 1)))
	  ((= i end))
	(outa i (* amp (src sr)))))))

(define (simple-grn beg dur amp speed freq)
  (let ((os (make-oscil freq)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (sr (make-granulate :expansion speed :input (lambda (dir) (oscil os)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (granulate sr)))))))

(define (simple-pvoc beg dur amp size file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-phase-vocoder :input (make-readin file) :fft-size size)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (phase-vocoder sr))))))

;;; (with-sound (:statistics #t) (simple-pvoc 0 2.0 .4 256 "oboe.snd"))

(define (simple-ina beg dur amp file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(fil (make-file->sample file)))
    (do ((i start (+ i 1))
	 (ctr 0 (+ ctr 1)))
	((= i end))
      (outa i (* amp (in-any ctr 0 fil))))))

(define (simple-in-rev beg dur ampa ampb)
  (if (or (> ampa 0.0) (> ampb 0.0))
      (let ((start (seconds->samples beg))
	    (end (seconds->samples (+ beg dur)))
	    (chns (mus-channels *reverb*)))
	(if (or (zero? ampb) (= chns 1))
	    (do ((i start (+ i 1))) ((= i end))
	      (outa i (* ampa (ina i *reverb*))))
	    (do ((i start (+ i 1))) ((= i end))
	      (outa i (* ampa (ina i *reverb*)))
	      (outb i (* ampb (inb i *reverb*))))))))

(define (simple-f2s beg dur amp file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(fil (make-file->sample file)))
    (do ((i start (+ i 1))
	 (ctr 0 (+ ctr 1)))
	((= i end))
      (outa i (* amp (file->sample fil ctr))))))

(define simple-rdf simple-rd)

(define (simple-loc beg dur freq amp)
  (let ((os (make-oscil freq))
	(loc (make-locsig :degree 0.0))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (locsig loc i (* amp (oscil os))))))

(define (simple-dloc beg dur freq amp)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (let ((loc (make-move-sound (list start end 1 0
				      (make-delay 32) (make-env '(0 0 1 1) :length 1000) (make-env '(0 0 1 1) :length 1000)
				      (vector (make-delay 32)) (vector (make-env '(0 0 1 1) :length 1000)) 
				      (vector (make-delay 32)) (vector 0 1)))))
      (do ((i start (+ i 1))) ((= i end))
	(move-sound loc i (* amp (oscil os)))))))

(define (simple-dloc-4 beg dur freq amp)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (let ((loc (make-move-sound (list start end 4 0
				      (make-delay 12) 
				      (make-env '(0 0 10 1) :duration dur)
				      #f
				      (make-vector 4 #f)
				      (vector (make-env '(0 0 1 1 2 0 3 0 4 0) :duration dur)
					      (make-env '(0 0 1 0 2 1 3 0 4 0) :duration dur)
					      (make-env '(0 0 1 0 2 0 3 1 4 0) :duration dur)
					      (make-env '(0 0 1 0 2 0 3 0 4 1) :duration dur))
				      #f
				      (vector 0 1 2 3)))))
      (do ((i start (+ i 1)))
	  ((= i end))
	(move-sound loc i (* amp (oscil os)))))))

					;(with-sound (:channels 4 :output "temp.snd") (simple-dloc-4 0 2 440 .5))

(define (simple-dup beg dur freq amp)
  (let ((os (make-oscil freq))
	(j 2)
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (let ((amp .3)
	    (j 4))
	(if (not (= j 4)) (format () "local j is ~D\n" j))
	(if (> (abs (- amp .3)) .001) (format () "local amp is ~F\n" amp)))
      (if (= j 2)
	  (outa i (* amp (oscil os)))))))

(define (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 (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (if (not (= j 2199023256786)) (format () "local j is ~A" j))
      (if (not (= jj -1099511632097)) (format () "local jj is ~A" jj))
      (if (= mj -3)
	  (outa i (* amp (oscil os)))
	  (format () "minus 3: ~D" mj)))))

(define (sample-desc beg dur freq amp)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(printed #f)
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) ((= i end))
      (if (not printed)
	  (begin
	    (if (not (string=? (mus-describe os) "oscil freq: 440.000Hz, phase: 0.000"))
		(format () "describe oscil: ~A~%" (mus-describe os)))
	    (if (> (abs (- (mus-frequency os) freq)) .001)
		(format () "osc freq: ~A (~A)~%" (mus-frequency os) freq))
	    (set! printed #t)))
      (outa i (* amp (oscil os))))))

(define (sample-mdat beg dur freq amp)
  (let ((table-size 256))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (buf (make-table-lookup freq 0.0 :size table-size)))
      (let ((table (mus-data buf)))
	(do ((i 0 (+ i 1)))
	    ((= i table-size))
	  (set! (table i) (/ i table-size))))
      (do ((i start (+ i 1))
	   (j 0 (modulo (+ j 1) table-size)))
	  ((= i end))
	(outa i (* amp ((mus-data buf) j) (table-lookup buf)))))))

(define (sample-xtab beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
	(os (make-oscil freq)))
    (do ((i 0 (+ i 1)))
	((= i 8))
      (set! ((mus-xcoeffs flt) i) (/ i 16.0))
      (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp
		 (+ ((mus-xcoeffs flt) 4)
		    ((mus-ycoeffs flt) 4))
		 (filter flt (oscil os)))))))

(define (sample-xts beg dur freq amp)
  (let ((vx (make-float-vector 8))
	(vy (make-float-vector 8)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (flt (make-filter 8 :xcoeffs vx :ycoeffs vy))
	  (os (make-oscil freq)))
      (do ((i 0 (+ i 1)))
	  ((= i 8))
	(set! ((mus-xcoeffs flt) i) (/ i 16.0))
	(set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
      (do ((i start (+ i 1))) 
	  ((= i end))
      (float-vector-set! vx 0 .5)
      (float-vector-set! vy 0 .5)       
      (outa i (* amp
		 (+ (vx 0)
		    (mus-ycoeff flt 0))
		 (filter flt (oscil os))))))))

(define (sample-srl2 beg dur amp speed freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os1 (make-oscil freq))
	(os2 (make-oscil (* freq 2))))
    (let ((sr1 (make-src :srate speed :input (lambda (dir) (oscil os1))))
	  (sr2 (make-src :srate speed :input (lambda (dir) (oscil os2)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (+ (src sr1) (src sr2))))))))

(define (sample-srll beg dur amp speed freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq)))
    (let ((sr1 (let ((sr2 (make-src :srate speed :input (lambda (dir) (oscil os)))))
		 (make-src :srate speed :input (lambda (dir) (src sr2))))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (src sr1)))))))

(define (sample-srl3 beg dur amp speed freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os1 (make-oscil freq))
	(os2 (make-oscil freq)))
    (let ((sr3 (make-src :srate speed :input (lambda (dir) (oscil os2))))
	  (sr2 (make-src :srate speed :input (lambda (dir) (oscil os1)))))
      (let ((sr1 (make-src :srate speed :input (lambda (dir) (src sr2)))))
	(do ((i start (+ i 1))) ((= i end))
	  (outa i (* amp (+ (src sr1) (src sr3)))))))))

(define (sample-grn2 beg dur amp speed freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq)))
    (let ((sr (make-granulate :expansion speed
			      :input (lambda (dir) (oscil os))
			      :edit (lambda (g) 0))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (granulate sr)))))))

(define (sample-grn3 beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-src (make-readin file) :srate speed)))
    (let ((gr (make-granulate :expansion speed :input (lambda (dir) (src sr)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (granulate gr)))))))

(define (sample-cnv beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-src (make-readin file) :srate speed))	 
	(filt (make-float-vector 8)))
    (set! (filt 4) 1.0)
    (let ((ff (make-convolve :filter filt :input (lambda (dir) (src sr)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (convolve ff)))))))

(define (sample-cnv1 beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-src :srate speed :input (make-readin file)))
	(filt (make-float-vector 8)))
    (set! (filt 4) 1.0)
    (let ((ff (make-convolve :filter filt :input (lambda (dir) (src sr)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (convolve ff)))))))

(define (sample-pvoc1 beg dur amp size file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-phase-vocoder (make-readin file) :fft-size size)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (phase-vocoder sr))))))

(define (sample-pvoc2 beg dur amp size file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-phase-vocoder (make-readin file) 
				:fft-size size
				:edit (lambda (pv)
					(if (not (= (mus-location pv) 0))
					    (format () "outctr: ~A" (mus-location pv)))
					#t))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (phase-vocoder sr))))))

(define (sample-pvoc3 beg dur amp size file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(N2 (/ size 2))
	(amps #f) (paincrs #f) (ppincrs #f) (phases #f) (freqs #f))
    (let ((sr (make-phase-vocoder (make-readin file) 
				  :fft-size size
				  :synthesize (lambda (pv)
						(float-vector-add! amps paincrs)
						(float-vector-add! ppincrs freqs)
						(float-vector-add! phases ppincrs)
						(clm23-sine-bank amps phases N2)))))
    (set! amps (phase-vocoder-amps sr))
    (set! paincrs (phase-vocoder-amp-increments sr))
    (set! ppincrs (phase-vocoder-phase-increments sr))
    (set! phases (phase-vocoder-phases sr))
    (set! freqs (phase-vocoder-freqs sr))
    (do ((i start (+ i 1))) 
	((= i end))
      (outa i (* amp (phase-vocoder sr)))))))

(define (sample-osc beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(arr (make-vector 20))
	(arrfrq (make-float-vector 20)))
    (set! amp (* amp 0.05))
    (do ((i 0 (+ i 1)))
	((= i 20))
      (set! (arrfrq i) (* (+ i 1) 100.0))
      (set! (arr i) (make-oscil (* (+ i 1) 100))))
    (do ((i 0 (+ i 1)))
	((= i 20))
      (let ((g (arr i))
	    (frq (arrfrq i)))
	(if (oscil? g)
	    (begin
	      (set! (mus-frequency g) frq)
	      (if (> (abs (- (mus-frequency g) frq)) .001)
		  (format () "oops ~A ~A" (mus-frequency g) frq))
	      (do ((k start (+ k 1))) 
		  ((= k end))
		(outa k (* amp (oscil g))))))))))

(define (sample-ardcl beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(amps (make-float-vector 3))
	(phases (make-float-vector 3))
	(freqs (make-float-vector 3))
	(ints (make-vector 3 32)))
    (do ((i 0 (+ i 1)))
	((= i 3))
      (set! (freqs i) (hz->radians (* freq (+ i 1))))
      (set! (amps i) (/ amp (+ i 2))))
    (do ((i start (+ i 1))) ((= i end))
      (do ((i 0 (+ i 1)))
	  ((= i (length phases)))
	(set! (phases i) (+ (phases i) (freqs i))))
      (if (not (= (ints 0) 32)) (format () "int array trouble"))
      (set! (ints 1) 3)
      (if (not (= (ints 1) 3)) (format () "set int array trouble"))
      (if (not (= (length amps) 3)) (format () "amps len: ~A" (length amps)))
      (outa i (clm23-sine-bank amps phases 3)))))

(define (sample-flt beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(fltdat (make-float-vector 3 3.14))
	(intdat (make-vector 3 3))
	(flt (make-filter 8 :xcoeffs (make-float-vector 8) :ycoeffs (make-float-vector 8)))
	(os (make-oscil freq)))
    (do ((i 0 (+ i 1)))
	((= i 8))
      (set! ((mus-xcoeffs flt) i) (/ i 16.0))
      (set! ((mus-ycoeffs flt) i) (- 0.5 (/ i 16.0))))
    (do ((i start (+ i 1))) ((= i end))
      (let ((xs (mus-xcoeffs flt)))
	(if (or (> (abs (- (xs 1) (mus-xcoeff flt 1))) .001)
		(> (abs (- (xs 1) 0.0625)) .001))
	    (format () "~A ~A~%" (xs 1) (mus-xcoeff flt 1))))
      (let ((data (mus-data flt)))
	(if (> (data 0) 1.0) (format () "data overflow? ~A~%" (data 0))))
      (if (not (= (intdat 1) 3))
          (format () "intdat let: ~A~%" (intdat 1)))
      (if (> (abs (- (fltdat 1) 3.14)) 0.001)
          (format () "fltdat let: ~A~%" (fltdat 1)))
      (outa i (* amp (filter flt (oscil os)))))))

(define (sample-arrintp beg dur freq amp)
  (let ((len (seconds->samples dur)))
    (let ((os (make-oscil freq))
	  (arr (make-float-vector 101))
	  (start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (loc-incr (/ 100.0 len)))
      (do ((i 0 (+ i 1))
	   (x 0.0 (+ x .01)))
	  ((= i 100))
	(set! (arr i) x))
      (do ((i start (+ i 1))
	   (loc 0.0 (+ loc loc-incr)))
	  ((= i end))
	(outa i (* amp (array-interp arr loc) (oscil os)))))))

(define (sample-arrfile beg dur freq amp)
  (let ((os (make-oscil freq))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(arr (make-float-vector 100)))
    (do ((i 0 (+ i 1)))
	((= i 100))
      (set! (arr i) (* amp (- (* i .01) 0.5))))
    (array->file "testx.data" arr 100 22050 1)
    (fill! arr 0.0)
    (file->array "testx.data" 0 0 100 arr)
    (do ((ctr 0)
	 (dir 1)
	 (i start (+ i 1))) 
	((= i end))
      (outa i (* (arr ctr) (oscil os)))
      (set! ctr (+ ctr dir))
      (if (>= ctr 99) (set! dir -1)
	  (if (<= ctr 0) (set! dir 1))))))

(define (simple-grn-f1 beg dur amp speed freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq)))
    (let ((sr (make-granulate :expansion speed :input (lambda (dir) (oscil os)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (granulate sr)))))))

					;(with-sound () (simple-grn-f1 0 1 .1 2 440))

(define (simple-grn-f2 beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-granulate :input (make-readin file) :expansion speed)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (granulate sr))))))

					;(with-sound () (simple-grn-f2 0 1 1 2 "oboe.snd"))
(define simple-grn-f3 simple-grn-f2)
					;(with-sound () (simple-grn-f3 0 1 1 2 "oboe.snd"))
(define simple-grn-f4 simple-grn-f2)
					;(with-sound () (simple-grn-f4 0 1 1 2 "oboe.snd"))

(define (simple-grn-f5 beg dur amp speed file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-granulate :input (make-readin file) 
			    :expansion speed
			    :edit (lambda (g) (float-vector-scale! (mus-data g) 2.0) 0))))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (granulate sr))))))
					;(with-sound (:statistics #t) (simple-grn-f5 0 1 1 2 "oboe.snd"))

(define (sample-pvoc5 beg dur amp size file freq)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(os (make-oscil freq)))
    (let ((sr (make-phase-vocoder (make-readin file) 
				  :fft-size size
				  :synthesize (lambda (pv) (oscil os)))))
      (do ((i start (+ i 1))) ((= i end))
	(outa i (* amp (phase-vocoder sr)))))))
;; (with-sound () (sample-pvoc5 0 1 .1 256 "oboe.snd" 440.0))


#|
(with-sound (:statistics #t)
  (simple-ssb 0 .2 440 .1)
  (simple-nsin .6 .2 .1)
  (simple-ncos 0.7 .2 440 .1)
  (simple-nrxysin .6 .2 .1)
  (simple-nrxycos 0.7 .2 440 .1)
  (simple-osc 0.75 .2 440 .1)
  (simple-asy 1.25 .2 .1)
  (simple-saw 1.5 .2 .1)
  (simple-tri 1.75 .2 .1)
  (simple-pul 2.0 .2 .1)
  (simple-sqr 2.25 .2 .1)
  (simple-oz 2.75 .2 440.0 .1)
  (simple-op 3.0 .2 440.0 .1)
  (simple-tz 3.25 .2 440.0 .1)
  (simple-tp 3.5 .2 440.0 .1)
  (simple-frm 3.75 .2 440.0 .1)
  (simple-buf 4.5 .2 440.0 .1)
  (simple-dly 4.75 .2 440.0 .1)
  (simple-cmb 5.0 .2 440.0 .1)
  (simple-not 5.25 .2 440.0 .1)
  (simple-alp 5.5 .2 440.0 .1)
  (simple-ave 5.75 .2 440.0 .1)
  (simple-tab 6.0 .2 440.0 .1)
  (simple-flt 6.25 .2 440.0 .1)
  (simple-fir 6.5 .2 440.0 .1)
  (simple-iir 6.5 .2 440.0 .3)
  (simple-ran 7.0 .2 440.0 .1)
  (simple-ri 7.25 .2 440.0 .1)
  (simple-env 7.5 .2 440.0 .1)
  (simple-amb 7.75 .2 440.0 .1)
  (simple-fof 8 1 270 .1 .001 730 .6 1090 .3 2440 .1) ;"Ahh"
  (simple-fof 9 4 270 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
	      '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
  (simple-fof 9 4 (* 6/5 540) .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
	      '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
  (simple-fof 9 4 135 .1 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
	      '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0))
  (simple-rd 13.5 .45 .75 "oboe.snd")
  (simple-cnv 14.0 .45 .75 "oboe.snd")
  (simple-cnf 14.5 .45 .75 "oboe.snd")
  (simple-lrg 15.0 .45 .75 "oboe.snd")
  (simple-cn2 15.5 .45 .4 "oboe.snd")
  (simple-src 16  .45 1.0 2.0 "oboe.snd")
  (simple-sr2 16.5 .45 1.0 2.0 "oboe.snd")
  (simple-sr2a 16.75 .45 1.0 2.0 "oboe.snd")
  (simple-rndist 17.0 .2 440.0 .1)
  (simple-ridist 17.25 .2 440.0 .1)
  (simple-sro 17.5 .45 .1 .5 440)
  (simple-grn 18 .2 .1 1.0 440)
  (simple-pvoc 18.25 .2 .4 256 "oboe.snd")
  (simple-ina 18.5 .45 1 "oboe.snd")
  (simple-rdf 19 .45 1 "oboe.snd")
  (simple-f2s 19.5 .45 1 "oboe.snd")
  (simple-loc 20 .2 440 .1)
  (simple-out 20.25 .2 440 .1)		  
  (simple-dup 20.5 .2 440 .1)
  (simple-du1 20.75 .2 440 .1)))

(with-sound (:statistics #t)
  (sample-desc 0 .2 440 .1)
  (sample-mdat .25 .2 440 .1)
  (sample-xtab .5 .2 440 .1)
  (sample-xts .75 .2 440 .1)
  (sample-srl2 1 .2 .2 .5 (* 440 2))
  (sample-srll 1.25 .2 .1 .5 (* 440 4))
  (sample-srl3 1.5 .2 .1 .5 880)
  (sample-grn2 1.75 .2 .1 .5 880)
  (sample-grn3 2 .45 1 1 "oboe.snd")
  (sample-cnv 2.5 .45 1 1 "oboe.snd")
  (sample-cnv1 3.0 .45 1 1 "oboe.snd")
  (sample-pvoc1 3.5 .45 1 512 "oboe.snd")
  (sample-pvoc2 4.0 .45 1 512 "oboe.snd")
  (sample-pvoc3 4.5 .001 1 512 "oboe.snd")
  (sample-osc 5.25 .2 440 .1)
  (sample-ardcl 5.5 .2 440 .1)
  (sample-flt 6 .2 440 .1)
  (sample-arrintp 6.25 .2 440 .1)
  (sample-arrfile 6.75 .2 440 .15)
  (sample-pvoc5 7 .2 .1 256 "oboe.snd" 440.0)
  )
|#

(define (pvoc-a beg dur amp size file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(sr (make-phase-vocoder :input (make-readin file) :fft-size size :interp (/ size 4) :overlap 4)))
    (do ((i start (+ i 1))) ((= i end))
      (outa i (* amp (phase-vocoder sr))))))

(define (pvoc-e beg dur amp size file)
  (let ((N2 (floor (/ size 2)))
	(rd (make-readin file)))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (lastphases (make-float-vector N2))
	  (in-data (make-float-vector size))
	  (filptr 0)
	  (window (make-fft-window hamming-window size 0.0))
	  (D (floor (/ size 4))) ; overlap = 4
	  (amps #f) (paincrs #f) (ppincrs #f) (phases #f) (freqs #f))
      (let ((sr (make-phase-vocoder rd 
				    :fft-size size 
				    :interp (/ size 4) 
				    :overlap 4
				    :analyze (lambda (pv input)
					       (let ((buf (modulo filptr size)))
						 (fill! freqs 0.0)
						 (if (= filptr 0)
						     (do ((k 0 (+ k 1)))
							 ((= k size))
						       (set! (in-data k) (readin rd)))
						     (begin
						       (do ((k 0 (+ k 1))
							    (j D (+ j 1)))
							   ((= j size))
							 (set! (in-data k) (in-data j)))
						       (do ((k (- size D) (+ k 1)))
							   ((= k size))
							 (set! (in-data k) (readin rd)))))
						 (do ((k 0 (+ k 1)))
						     ((= k size))
						   (float-vector-set! paincrs buf (* (in-data k) (window k)))
						   (set! buf (+ buf 1))
						   (if (>= buf size) (set! buf 0))))
					       (set! filptr (+ filptr D))
					       (mus-fft paincrs freqs size 1)
					       (rectangular->polar paincrs freqs)
					       #f)
				    :edit (lambda (pv)
					    (do ((pscl (/ 1.0 D))
						 (kscl (/ two-pi size))
						 (k 0 (+ k 1))
						 (ks 0.0 (+ ks kscl)))
						((= k N2) #f)
					      (let* ((freq (freqs k))
						     (diff (- freq (lastphases k))))
						(set! (lastphases k) freq)
						(if (> diff pi) (set! diff (- diff two-pi)))
						(if (< diff (- pi)) (set! diff (+ diff two-pi)))
						(float-vector-set! freqs k (+ (* diff  pscl) ks)))))
				    :synthesize (lambda (pv)
						  (float-vector-add! amps paincrs)
						  (float-vector-add! ppincrs freqs)
						  (float-vector-add! phases ppincrs)
						  (clm23-sine-bank amps phases N2)))))
      (set! amps (phase-vocoder-amps sr))
      (set! paincrs (phase-vocoder-amp-increments sr))
      (set! ppincrs (phase-vocoder-phase-increments sr))
      (set! phases (phase-vocoder-phases sr))
      (set! freqs (phase-vocoder-freqs sr))
      (float-vector-scale! window (/ 2.0 (* 0.54 size)))

      (do ((i start (+ i 1))) 
	  ((= i end))
	(outa i (* amp (phase-vocoder sr))))))))


;;; --------------------------------------------------------------------------------
;;;
;;; instruments and note lists from the documentation


;;; ins in docs + note lists

;;; fm.html

(define (fmdoc-pm beg end freq amp mc-ratio index)
  (let ((carrier-phase 0.0) ; set to pi/2 if someone tells you PM can't produce energy at 0Hz
        (carrier-phase-incr (hz->radians freq))
        (modulator-phase 0.0)
        (modulator-phase-incr (hz->radians (* mc-ratio freq))))
    (do ((i beg (+ i 1)))
	((= i end))
      (let ((pm-val (* amp (sin (+ carrier-phase (* index (sin modulator-phase)))))))
	;; no integration in phase modulation (it's a phase change)
	(set! carrier-phase (+ carrier-phase carrier-phase-incr))
	(set! modulator-phase (+ modulator-phase modulator-phase-incr))
	(outa i pm-val)))))

(define (fmdoc-fm beg end freq amp mc-ratio index)
  (let ((carrier-phase 0.0)
	(carrier-phase-incr (hz->radians freq))
	(modulator-phase-incr (hz->radians (* mc-ratio freq))))
    (let ((modulator-phase (* 0.5 (+ pi modulator-phase-incr)))
	  ;; (pi+incr)/2 to get (centered) sin after integration, to match pm case above
	  ;;   I believe this is what causes most of the confusion
	  (fm-index (hz->radians (* mc-ratio freq index))))
      ;; fix up fm index (it's a frequency change)
      (do ((i beg (+ i 1)))
	  ((= i end))
	(let ((modulation (* fm-index (sin modulator-phase)))
	      (fm-val (* amp (sin carrier-phase))))
	  (set! carrier-phase (+ carrier-phase modulation carrier-phase-incr))
	  (set! modulator-phase (+ modulator-phase modulator-phase-incr))
	  (outa i fm-val))))))

(define* (fmdoc-fm-1 beg dur freq amp mc-ratio index (index-env '(0 1 100 1)))
  (let ((fm-index (hz->radians (* index mc-ratio freq))))
    (let ((start (seconds->samples beg))
	  (end (seconds->samples (+ beg dur)))
	  (cr (make-oscil freq))
	  (md (make-oscil (* freq mc-ratio)))
	  (ampf (make-env index-env :scaler amp :duration dur)) 
	  (indf (make-env index-env :scaler fm-index :duration dur)))
      (do ((i start (+ i 1)))
	  ((= i end))
	(outa i (* (env ampf)                  ; amplitude env
		   (oscil cr (* (env indf)     ; carrier + modulation env
				(oscil md))))  ; modulation
	      )))))

(define (fmdoc-fm-2 beg dur freq amp mc-ratio index carrier-phase mod-phase)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(cr (make-oscil freq carrier-phase))
	(md (make-oscil (* freq mc-ratio) mod-phase))
	(fm-index (hz->radians (* index mc-ratio freq))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (oscil cr (* fm-index (oscil md))))))))

(define (fmdoc-fm-3 beg dur freq amp mc-ratio index car-phase mod-phase skew-func skew)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(cr (make-oscil freq car-phase))
	(md (make-oscil (* freq mc-ratio) mod-phase))
	(skewf (make-env skew-func :scaler (hz->radians (* skew mc-ratio freq)) :duration dur))
	(fm-index (hz->radians (* index mc-ratio freq))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (oscil cr (* fm-index (oscil md (env skewf)))))))))

(define (fmdoc-fm-4 beg dur freq amp mc-ratio index cr0p cr1p md0p md1p)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(cr0 (make-oscil 0 cr0p))
	(cr1 (make-oscil 0 cr1p))
	(md0 (make-oscil (* freq mc-ratio) md0p))
	(md1 (make-oscil (* freq mc-ratio) md1p))
	(am0 (make-oscil freq 0))
	(am1 (make-oscil freq (* .5 pi)))
	(fm-index (hz->radians (* index mc-ratio freq))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (+ (* (oscil am0) (oscil cr0 (* fm-index (oscil md0))))
			(* (oscil am1) (oscil cr1 (* fm-index (oscil md1))))))))))

(define (fmdoc-fm-5 beg dur freq amp mc-ratios indexes carrier-phase mod-phases)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(cr (make-oscil freq carrier-phase))
	(n (length mc-ratios))
	(interleave (lambda (a b)
		      (let ((lst ()))
			(for-each (lambda (x y) 
				    (set! lst (cons (hz->radians (* freq x y))
						    (cons x lst))))
				  a b)
			(reverse lst)))))
    (if (and (apply and (map integer? mc-ratios))
	     (apply and (map zero? mod-phases))) ; use polyoid if any not 0.0
	(let ((fm (make-polywave freq (interleave mc-ratios indexes) mus-chebyshev-second-kind)))
	  (do ((i start (+ i 1)))
	      ((= i end))
	    (outa i (* amp (oscil cr (polywave fm))))))
	(let ((modulators (make-float-vector n))
	      (fm-indices (make-float-vector n)))
	  (do ((i 0 (+ i 1)))
	      ((= i n))
	    (set! (modulators i) (hz->radians (* freq (mc-ratios i) (mod-phases i))))
	    (set! (fm-indices i) (hz->radians (* freq (indexes i) (mc-ratios i)))))
	  (let ((ob (make-oscil-bank modulators (make-float-vector n) fm-indices #t)))
	    (do ((i start (+ i 1)))
		((= i end))
	      (outa i (* amp (oscil cr (oscil-bank ob))))))))))


(define (fmdoc-violin beg dur frequency amplitude fm-index)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(frq-scl (hz->radians frequency)))
    (let ((maxdev (* frq-scl fm-index)))
      (let ((index1 (* maxdev (/ 5.0 (log frequency))))
	    (index2 (/ (* maxdev 3.0 (- 8.5 (log frequency))) (+ 3.0 (/ frequency 1000))))
	    (index3 (* maxdev (/ 4.0 (sqrt frequency))))
	    (carrier (make-oscil frequency))
	    (fmosc1 (make-oscil frequency))
	    (fmosc2 (make-oscil (* 3 frequency)))
	    (fmosc3 (make-oscil (* 4 frequency)))
	    (ampf  (make-env '(0 0 25 1 75 1 100 0) :scaler amplitude :duration dur)))
	(let ((indf1 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index1 :duration dur))
	      (indf2 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index2 :duration dur))
	      (indf3 (make-env '(0 1 25 .4 75 .6 100 0) :scaler index3 :duration dur))
	      (pervib (make-triangle-wave 5 :amplitude (* .0025 frq-scl)))
	      (ranvib (make-rand-interp 16 :amplitude (* .005 frq-scl))))
	  (do ((i start (+ i 1)))
	      ((= i end))
	    (let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
	      (outa i (* (env ampf)
			 (oscil carrier
				(+ vib 
				   (* (env indf1) (oscil fmosc1 vib))
				   (* (env indf2) (oscil fmosc2 (* 3.0 vib)))
				   (* (env indf3) (oscil fmosc3 (* 4.0 vib))))))))))))))

(define (fmdoc-cascade beg dur freq amp modrat modind casrat casind caspha)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(cr (make-oscil freq))
	(md (make-oscil (* freq modrat)))
	(ca (make-oscil (* freq casrat) caspha))
	(fm-ind0 (hz->radians (* modind modrat freq)))
	(fm-ind1 (hz->radians (/ (* casind casrat freq) modrat))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp 
		 (oscil cr (* fm-ind0 
			      (oscil md (* fm-ind1 
					   (oscil ca))))))))))

(define (fmdoc-feedbk beg dur freq amp index)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(y 0.0)
	(x-incr (hz->radians freq)))
    (do ((i start (+ i 1))
	 (x 0.0 (+ x x-incr)))
	((= i end))
      (set! y (+ x (* index (sin y))))
      (outa i (* amp (sin y))))))


(define* (fmdoc-vox beg dur freq amp (indices '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(car (make-oscil 0))
	(per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
	(ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02))))
    
    (let ((a0 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 0)) :duration dur))
	  (a1 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 1)) :duration dur))
	  (a2 (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps 2)) :duration dur))
	  (o0 (make-oscil 0.0))
	  (o1 (make-oscil 0.0))
	  (o2 (make-oscil 0.0))
	  (e0 (make-oscil 0.0))
	  (e1 (make-oscil 0.0))
	  (e2 (make-oscil 0.0))
	  (ind0 (indices 0))
	  (ind1 (indices 1))
	  (ind2 (indices 2))
	  (f0 (make-env '(0 520 100 490) :duration dur))
	  (f1 (make-env '(0 1190 100 1350) :duration dur))
	  (f2 (make-env '(0 2390 100 1690) :duration dur)))
      
      (do ((i start (+ i 1)))
	  ((= i end))
	(let* ((frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
	       (frq1 (hz->radians frq))
	       (carg (oscil car frq1))
	       (frm0 (/ (env f0) frq))
	       (frm1 (/ (env f1) frq))
	       (frm2 (/ (env f2) frq)))
	  
	  (outa i (+ 
		   (* (env a0) 
		      (+ (* (even-weight frm0) (oscil e0 (+ (* ind0 carg) (even-multiple frm0 frq1))))
			 (* (odd-weight frm0) (oscil o0 (+ (* ind0 carg) (odd-multiple frm0 frq1))))))
		   (* (env a1) 
		      (+ (* (even-weight frm1) (oscil e1 (+ (* ind1 carg) (even-multiple frm1 frq1))))
			 (* (odd-weight frm1) (oscil o1 (+ (* ind1 carg) (odd-multiple frm1 frq1))))))
		   (* (env a2) 
		      (+ (* (even-weight frm2) (oscil e2 (+ (* ind2 carg) (even-multiple frm2 frq1))))
			 (* (odd-weight frm2) (oscil o2 (+ (* ind2 carg) (odd-multiple frm2 frq1)))))))))))))
#|
(define* (fmdoc-vox beg dur freq amp (indexes '(.005 .01 .02)) (formant-amps '(.86 .13 .01)))
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(car-os (make-oscil 0))
	(evens (make-vector 3))
	(odds (make-vector 3))
	(ampfs (make-vector 3))
	(frmfs (make-vector 3))
	(indices (apply float-vector indexes))
	(per-vib (make-triangle-wave 6 :amplitude (* freq .03)))
	(ran-vib (make-rand-interp 20 :amplitude (* freq .5 .02)))
	(frq1 0.0) (frq 0.0) (carg 0.0) (frm0 0.0) (frm-int 0)
	(frac 0.0) (fracf 0.0))
    (do ((i 0 (+ i 1)))
	((= i 3))
      (set! (evens i) (make-oscil 0))
      (set! (odds i) (make-oscil 0))
      (set! (ampfs i) (make-env '(0 0 25 1 75 1 100 0) :scaler (* amp (formant-amps i)) :duration dur)))
    
    (set! (frmfs 0) (make-env '(0 520 100 490) :duration dur)) 
    (set! (frmfs 1) (make-env '(0 1190 100 1350) :duration dur)) 
    (set! (frmfs 2) (make-env '(0 2390 100 1690) :duration dur))
    
    (do ((i start (+ i 1)))
	((= i end))
      (set! frq (+ freq (triangle-wave per-vib) (rand-interp ran-vib)))
      (set! frq1 (hz->radians frq))
      (set! carg (oscil car-os frq1))
      (do ((k 0 (+ k 1)))
	  ((= k 3))
	(set! frm0 (/ (env (vector-ref frmfs k)) frq))
	(set! frm-int (floor frm0))
	(set! frac (- frm0 frm-int))
	(set! fracf (+ (* (float-vector-ref indices k) carg) (* frm-int frq1)))
	(if (even? frm-int)
	    (outa i (* (env (vector-ref ampfs k))
		       (+ (* (- 1.0 frac) (oscil (vector-ref evens k) fracf))
			  (* frac (oscil (vector-ref odds k) (+ fracf frq1))))))
	    (outa i (* (env (vector-ref ampfs k))
		       (+ (* frac (oscil (vector-ref evens k) (+ fracf frq1)))
			  (* (- 1.0 frac) (oscil (vector-ref odds k) fracf))))))))))
|#



;;; --------------------------------------------------------------------------------

;;; sndclm.html


(define (sndclmdoc-simp start end freq amp)
  (let ((os (make-oscil freq)))
    (do ((i start (+ i 1))) 
	((= i end))
      (outa i (* amp (oscil os))))))

(define sndclmdoc-simp-1 simple-out)
(define sndclmdoc-simp-2 simple-out)
(define sndclmdoc-simp-3 simple-out)

(define (sndclmdoc-telephone start telephone-number)
  (let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
	(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
    (do ((i 0 (+ i 1)))
	((= i (length telephone-number)))
      (let* ((num (telephone-number i))
	     (frq1 (touch-tab-1 num))
	     (frq2 (touch-tab-2 num)))
        (sndclmdoc-simp-3 (+ start (* i .4)) .3 frq1 .1)
        (sndclmdoc-simp-3 (+ start (* i .4)) .3 frq2 .1)))))

(definstrument (sndclmdoc-simp-4 beg dur freq amp envelope)
  (let ((os (make-oscil freq))
	(amp-env (make-env envelope :duration dur :scaler amp))
	(start (seconds->samples beg))
	(end (seconds->samples (+ beg dur))))
    (do ((i start (+ i 1))) 
	((= i end))
      (outa i (* (env amp-env) (oscil os))))))

(define (make-my-oscil frequency)       ; we want our own oscil!
  (float-vector 0.0 (hz->radians frequency)))    ; current phase and frequency-based phase increment

(define (my-oscil gen fm)     ; the corresponding generator
  (let ((result (sin (gen 0)))) ; return sin(current-phase)
    (set! (gen 0) (+ (gen 0)  ; increment current phase
		     (gen 1)  ;    by frequency
		     fm))     ;    and FM
    result))                  ; return sine wave

(define (sndclmdoc-simp-5 start end freq amp frq-env)
  (let ((os (make-oscil freq)) 
        (frqe (make-env frq-env :length (- end start) :scaler (hz->radians freq))))
    (do ((i start (+ i 1))) 
	((= i end))
      (outa i (* amp (oscil os (env frqe)))))))

(define (sndclmdoc-simple-add beg dur freq amp)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(harms (do ((i 1 (+ i 1)) (lst ()))
		   ((> i 20)
		    (reverse lst))
		 (set! lst (cons (* amp .05) (cons i lst))))))
    ;; we'll create a tone with 20 equal amplitude harmonics
    (let ((gen (make-polywave freq harms)))
      (do ((i start (+ i 1))) 
	  ((= i end))
	(outa i (polywave gen))))))

(definstrument (sndclmdoc-mapenv beg dur frq amp en)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(osc (make-oscil frq))
	(zv (make-env en 1.0 dur))
	(pi2 (* 0.5 pi)))
    (do ((i start (+ i 1)))
	((= i end))
      (let ((zval (env zv))) 
	(outa i 
	      (* amp 
		 (sin (* pi2 zval zval zval))
		 (oscil osc)))))))

(definstrument (sndclmdoc-simple-table dur)
  (let ((tab (make-table-lookup :wave (partials->wave '(1 .5  2 .5)))))
    (do ((i 0 (+ i 1))) ((= i dur))
      (outa i (* .3 (table-lookup tab))))))

(define (sndclmdoc-looper start dur sound freq amp)
  (let ((beg (seconds->samples start))
	(end (seconds->samples (+ start dur)))
	(loop-data (mus-sound-loop-info sound)))
    (if (or (null? loop-data)
	    (<= (cadr loop-data) (car loop-data)))
	(error 'no-loop-positions)
	(let ((tbl (let* ((loop-start (car loop-data))
			  (loop-length (- (+ (cadr loop-data) 1) loop-start))
			  (sound-section (float-vector-scale! (file->array sound 0 loop-start loop-length (make-float-vector loop-length)) amp)))
		     (make-table-lookup :frequency (/ (* freq (srate sound)) loop-length)
					:wave sound-section))))
	  ;; "freq" here is how fast we read (transpose) the sound -- 1.0 returns the original
	  (do ((i beg (+ i 1)))
	      ((= i end))
	    (outa i (table-lookup tbl)))))))

(definstrument (sndclmdoc-fm-table file start dur amp read-speed modulator-freq index-in-samples)
  (let ((table-length (framples file)))
    (let ((beg (seconds->samples start))
	  (end (seconds->samples (+ start dur)))
	  (tab (make-table-lookup :frequency (/ read-speed (mus-sound-duration file)) 
				  :wave (float-vector-scale! 
					 (file->array file 0 0 table-length (make-float-vector table-length))
					 amp)))
	  (osc (make-oscil modulator-freq))
	  (index (/ (* (hz->radians modulator-freq) 2 pi index-in-samples) table-length)))
      (do ((i beg (+ i 1)))
	  ((= i end))
	(outa i (table-lookup tab (* index (oscil osc))))))))

(definstrument (sndclmdoc-bigbird start duration frequency freqskew amplitude freq-env amp-env partials)
  (let ((beg (seconds->samples start))
	(end (seconds->samples (+ start duration)))
	(gls-env (make-env freq-env (hz->radians freqskew) duration))
	(polyos (make-polywave frequency :partials partials))
	(fil (make-one-pole .1 .9))
	(amp-env (make-env amp-env amplitude duration)))
    (do ((i beg (+ i 1)))
	((= i end))
      (outa i 
	    (one-pole fil   ; for distance effects
		      (* (env amp-env) 
			 (polywave polyos (env gls-env))))))))

(definstrument (sndclmdoc-pqw start dur spacing carrier partials)
  (let ((spacing-cos (make-oscil spacing (/ pi 2.0)))
	(spacing-sin (make-oscil spacing))
	(carrier-cos (make-oscil carrier (/ pi 2.0)))
	(carrier-sin (make-oscil carrier))
	(sin-coeffs (partials->polynomial
		     partials mus-chebyshev-second-kind))
	(cos-coeffs (partials->polynomial
		     partials mus-chebyshev-first-kind))
	(beg (seconds->samples start))
	(end (seconds->samples (+ start dur))))
    (do ((i beg (+ i 1))) ((= i end))
      (let ((ax (oscil spacing-cos)))
	(outa i (- (* (oscil carrier-sin) 
		      (oscil spacing-sin) 
		      (polynomial sin-coeffs ax))
		   (* (oscil carrier-cos) 
		      (polynomial cos-coeffs ax))))))))

(definstrument (sndclmdoc-bl-saw start dur frequency order)
  (let ((norm (cond ((assoc order '((1 . 1.0) (2 . 1.3)) =) => cdr)
		    ((< order 9) 1.7)
		    (else 1.9)))
	;; these peak amps were determined empirically
	;;   actual limit is supposed to be pi/2 (G&R 1.441)
	;;   but Gibbs phenomenon pushes it to 1.851
	;;   if order>25, numerical troubles -- use table-lookup
	(freqs ()))
    (do ((i 1 (+ i 1)))
	((> i order))
      (set! freqs (cons (/ 1.0 (* norm i)) (cons i freqs))))
    (let ((ccos (make-oscil frequency (/ pi 2.0)))
	  (csin (make-oscil frequency))
	  (coeffs (partials->polynomial (reverse freqs) mus-chebyshev-second-kind))
	  (beg (seconds->samples start))
	  (end (seconds->samples (+ start dur))))
      (do ((i beg (+ i 1))) 
	  ((= i end))
	(outa i (* (oscil csin) 
		   (polynomial coeffs (oscil ccos))))))))

(define (sndclmdoc-tritri start dur freq amp index mcr)
  (let ((beg (seconds->samples start))
	(end (seconds->samples (+ start dur)))
	(carrier (make-triangle-wave freq amp))
	(modulator (make-triangle-wave (* mcr freq) index)))
    (do ((i beg (+ i 1)))
	((= i end))
      (outa i (triangle-wave carrier (triangle-wave modulator))))))

(define* (sndclmdoc-make-sinc-train (frequency 440.0) width)
  (let ((range (or width (* pi (- (* 2 (floor (/ *clm-srate* (* 2.2 frequency)))) 1)))))
    ;; 2.2 leaves a bit of space before srate/2, (* 3 pi) is the minimum width, normally
    (list (- (* range 0.5))
	  range
	  (/ (* range frequency) *clm-srate*))))

(define* (sndclmdoc-sinc-train gen (fm 0.0))
  (let ((ang (car gen))
	(range (cadr gen))
	(frq (caddr gen)))
    (let ((top (* 0.5 range))
	  (val (if (= ang 0.0) 1.0 (/ (sin ang) ang)))
	  (new-ang (+ ang frq fm)))
      (set! (gen 0) (if (> new-ang top)
			(- new-ang range)
			new-ang))
      val)))

(define (sndclmdoc-make-sum-of-odd-sines frequency n)
  (float-vector 0.0 (hz->radians frequency) (* 1.0 n)))

(define (sndclmdoc-sum-of-odd-sines gen fm)
  (let ((result (let* ((a2 (* (gen 0) 0.5))
		       (n (gen 2))
		       (den (* n (sin a2))))
		  (if (< (abs den) 1.0e-9)
		      0.0
		      (/ (* (sin (* n a2)) 
			    (sin (* (+ 1 n) a2)))
			 den)))))
    (set! (gen 0) (+ (gen 0) (gen 1) fm))
    result))

(definstrument (sndclmdoc-shift-pitch beg dur file freq (order 40))
  (let ((st (seconds->samples beg))
	(nd (seconds->samples (+ beg dur)))
	(gen (make-ssb-am freq order))
	(rd (make-readin file)))
    (do ((i st (+ i 1))) 
	((= i nd))
      (outa i (ssb-am gen (readin rd))))))

(definstrument (sndclmdoc-repitch beg dur sound old-freq new-freq 
				  (amp 1.0) (pairs 10) (order 40) (bw 50.0))
  (let ((start (seconds->samples beg))
	(len (seconds->samples dur))
	(end (seconds->samples (+ beg dur)))
	(ssbs (make-vector pairs))
	(bands (make-vector pairs))
	(factor (/ (- new-freq old-freq) old-freq))
	(rd (make-readin sound)))
    (let ((in-data (make-float-vector len)))
      (do ((i 0 (+ i 1)))
	  ((= i len))
	(float-vector-set! in-data i (readin rd)))
      (float-vector-scale! in-data amp)
      (do ((i 1 (+ i 1)))
	  ((> i pairs))
	(let ((aff (* i old-freq))
	      (bwf (* bw (+ 1.0 (/ i (* 2 pairs))))))
	  (set! (ssbs (- i 1)) (make-ssb-am (* i factor old-freq)))
	  (set! (bands (- i 1)) (make-bandpass (hz->radians (- aff bwf)) 
					       (hz->radians (+ aff bwf)) 
					       order))))
      (do ((band 0 (+ 1 band)))
	  ((= band pairs))
	(let ((ssb (ssbs band))
	      (flt (bands band)))
	  (do ((i start (+ i 1))
	       (j 0 (+ j 1)))
	      ((= i end))
	    (outa i (ssb-am ssb (bandpass flt (float-vector-ref in-data j))))))))))

#|
(let* ((sound "oboe.snd") ; 1.8
	 (mx (maxamp sound))
	 (dur (mus-sound-duration sound)))
    (with-sound (:scaled-to mx :srate 22050 :statistics #t) 
      (sndclmdoc-repitch 0 dur sound 554 1000)))
|#

(definstrument (sndclmdoc-fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 ve ae)
  (let ((foflen (if (= *clm-srate* 22050) 100 200)))
    (let ((foftab (make-float-vector foflen)))
      (let ((start (seconds->samples beg))
	    (end (seconds->samples (+ beg dur)))
	    (ampf (make-env :envelope (or ae '(0 0 25 1 75 1 100 0)) :scaler amp :duration dur))
	    (frq0 (hz->radians f0))
	    (frq1 (hz->radians f1))
	    (frq2 (hz->radians f2))
	    (vibr (make-oscil 6))
	    (vibenv (make-env :envelope (or ve '(0 1 100 1)) :scaler vib :duration dur))
	    (win-freq (/ (* 2 pi) foflen))
	    (wt0 (make-wave-train :wave foftab :frequency frq)))
	(do ((i 0 (+ i 1)))
	    ((= i foflen))
	  (set! (foftab i) ;; 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))))))
	(do ((i start (+ i 1)))
	    ((= i end))
	  (outa i (* (env ampf) (wave-train wt0 (* (env vibenv) (oscil vibr))))))))))

(definstrument (sndclmdoc-echo beg dur scaler secs file)
  (let ((del (make-delay (seconds->samples secs)))
	(rd (make-sampler 0 file))
	(stop (+ beg dur)))
    (do ((i beg (+ i 1)))
	((= i stop))
      (let ((inval (read-sample rd)))
	(outa i (+ inval (delay del (* scaler (+ (tap del) inval)))))))))

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

(define* (sndclmdoc-make-moving-max (size 128))
  (let ((gen (make-delay size)))
    (set! (mus-scaler gen) 0.0)
    gen))

(define (sndclmdoc-moving-max gen y)
  (let* ((absy (abs y))
         (mx (delay gen absy)))
    (if (>= absy (mus-scaler gen))
	(set! (mus-scaler gen) absy)
	(if (>= mx (mus-scaler gen))
	    (set! (mus-scaler gen) (float-vector-peak (mus-data gen)))))
    (mus-scaler gen)))

(definstrument (sndclmdoc-zc time dur freq amp length1 length2 feedback)
  (let ((beg (seconds->samples time))
	(end (seconds->samples (+ time dur)))
	(s (make-pulse-train freq))  ; some raspy input so we can hear the effect easily
	(d0 (make-comb :size length1 :max-size (max length1 length2) :scaler feedback))
	(aenv (make-env '(0 0 .1 1 .9 1 1 0) :scaler amp :duration dur))
	(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :base 12.0 :duration dur)))
    (do ((i beg (+ i 1))) ((= i end))
      (outa i (* (env aenv) (comb d0 (pulse-train s) (env zenv)))))))

(define (sndclmdoc-fir+comb beg dur freq amp size)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(dly (make-comb :scaler .9 :size size)))
    (let ((flt (make-fir-filter :order size :xcoeffs (mus-data dly))) ; comb delay line as FIR coeffs
	  (r (make-rand freq)))                                       ; feed comb with white noise
      (do ((i start (+ i 1))) 
	  ((= i end)) 
	(outa i (* amp (fir-filter flt (comb dly (rand r)))))))))

(definstrument (sndclmdoc-simple-src start-time duration amp srt srt-env filename)
  (let ((senv (make-env :envelope srt-env :duration duration))
	(beg (seconds->samples start-time))
	(end (seconds->samples (+ start-time duration)))
	(src-gen (make-src :input (make-readin filename) :srate srt)))
    (do ((i beg (+ i 1)))
	((= i end))
      (outa i (* amp (src src-gen (env senv)))))))

(definstrument (sndclmdoc-srcer start-time duration amp srt fmamp fmfreq filename)
  (let ((os (make-oscil fmfreq))
	(beg (seconds->samples start-time))
	(end (seconds->samples (+ start-time duration)))
	(src-gen (make-src :input (make-readin filename) :srate srt)))
    (do ((i beg (+ i 1)))
	((= i end))
      (outa i (* amp (src src-gen (* fmamp (oscil os))))))))

;;; (with-sound () (sndclmdoc-srcer 0 2 1.0 0.5 1.0 300 "oboe.snd"))

(definstrument (sndclmdoc-convins beg dur filt file (size 128))
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(ff (make-convolve :input (make-readin file) :fft-size size :filter filt)))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (convolve ff)))))

(definstrument (sndclmdoc-granulate-sound file beg dur (orig-beg 0.0) (exp-amt 1.0))
  (let ((f (make-readin file :start (round (* (srate file) orig-beg))))
	(st (seconds->samples beg))
	(new-dur (or dur (- (mus-sound-duration file) orig-beg))))
    (let ((exA (make-granulate :input f :expansion exp-amt))
	  (nd (+ st (seconds->samples new-dur))))
      (do ((i st (+ i 1)))
	  ((= i nd))
	(outa i (granulate exA))))))

(definstrument (sndclmdoc-grev beg dur exp-amt file file-beg)
  (let ((exA (make-granulate :expansion exp-amt
			     :input (make-readin file 0 file-beg -1)))
	(stop (+ beg dur)))
    (do ((i beg (+ i 1)))
	((= i stop))
      (outa i (granulate exA)))))

(define sndclmdoc-simple-pvoc sample-pvoc1)

(definstrument (sndclmdoc-asy beg dur freq amp index (r 1.0) (ratio 1.0))
  (let ((st (seconds->samples beg))
	(nd (seconds->samples (+ beg dur)))
	(asyf (make-asymmetric-fm :r r :ratio ratio :frequency freq)))
    (do ((i st (+ i 1))) 
	((= i nd))
      (outa i (* amp (asymmetric-fm asyf index))))))

(define sndclmdoc-simple-f2s simple-f2s)

(definstrument (sndclmdoc-simple-ina beg dur amp file)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(fil (make-file->sample file)))
    (do ((i start (+ i 1))
	 (ctr 0 (+ ctr 1)))
	((= i end))
      (outa i (* amp (ina ctr fil))))))

(definstrument (sndclmdoc-env-sound file beg (amp 1.0) (amp-env '(0 1 100 1)))
  (let ((st (seconds->samples beg))
	(dur (mus-sound-framples file))
	(rev-amount .01)
	(rdA (make-readin file)))
    (let ((ampf (make-env amp-env amp :length dur))
	  (nd (+ st dur)))
      (if *reverb*
	  (do ((i st (+ i 1)))
	      ((= i nd))
	    (let ((outval (* (env ampf) (readin rdA))))
	      (outa i outval)
	      (outa i (* outval rev-amount) *reverb*)))
	  (do ((i st (+ i 1)))
	      ((= i nd))
	    (outa i (* (env ampf) (readin rdA))))))))

(definstrument (sndclmdoc-space file onset duration (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 (seconds->samples onset))
	(end (seconds->samples (+ onset 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 degree-env :scaler (/ 1.0 90.0) :duration duration))
	(dist-scaler 0.0)
	(degval 0.0)
	(stereo (> (channels *output*) 1)))
    (if (and stereo *reverb*)
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (set! degval (env deg-env))
	  (set! dist-scaler (/ 1.0 (env dist-env)))
	  (locsig-set! loc 0 (* (- 1.0 degval) dist-scaler))
	  (locsig-set! loc 1 (* degval dist-scaler))
	  (locsig-reverb-set! loc 0 (* reverb-amount (sqrt dist-scaler)))
	  (locsig loc i (* (env amp-env) (readin rdA))))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (set! degval (env deg-env))
	  (set! dist-scaler (/ 1.0 (env dist-env)))
	  (locsig-set! loc 0 (* (- 1.0 degval) dist-scaler))
	  (if stereo (locsig-set! loc 1 (* degval dist-scaler)))
	  (if *reverb* (locsig-reverb-set! loc 0 (* reverb-amount (sqrt dist-scaler))))
	  (locsig loc i (* (env amp-env) (readin rdA)))))))

(define sndclmdoc-simple-dloc simple-dloc-4)

(definstrument (when? start-time duration start-freq end-freq grain-file)
  (let ((beg (seconds->samples start-time))
	(len (seconds->samples duration))
	(end (seconds->samples (+ start-time duration)))
	(frqf (make-env '(0 0 1 1) :scaler (hz->radians (- end-freq start-freq)) :duration duration))
	(click-track (make-pulse-train start-freq))
	(grain-size (mus-sound-framples grain-file)))
    (let ((grains (make-wave-train :size grain-size :frequency start-freq))
	  (ampf (make-env '(0 1 1 0) :scaler .7 :offset .3 :duration duration :base 3.0))
	  (grain #f))
      (set! grain (mus-data grains))
      (file->array grain-file 0 0 grain-size grain)
      (let ((original-grain (copy grain)))
	(do ((i beg (+ i 1)))
	    ((= i end))
	  (let ((gliss (env frqf)))
	    (outa i (* (env ampf) (wave-train grains gliss)))
	    (if (> (pulse-train click-track gliss) 0.0)
		(let ((scaler (max 0.1 (* 1.0 (/ (- i beg) len))))
		      (comb-len 32)
		      (cs (make-vector 3)))
		  (vector-set! cs 0 (make-comb scaler comb-len))
		  (vector-set! cs 1 (make-comb scaler (floor (* comb-len .75))))
		  (vector-set! cs 2 (make-comb scaler (floor (* comb-len 1.25))))
		  (set! cs (make-comb-bank cs))
		  (do ((k 0 (+ k 1)))
		      ((= k grain-size))
		    (float-vector-set! grain k (comb-bank cs (float-vector-ref original-grain k))))))))))))

(definstrument (move-formants start file amp radius move-env num-formants)
  (let ((frms (make-vector num-formants))
	(beg (seconds->samples start))
	(dur (framples file)))
    (let ((end (+ beg dur))
	  (rd (make-readin file))
	  (menv (make-env move-env :length dur))
	  (amps (make-float-vector num-formants amp)))
      (let ((start-frq (env menv)))
	(do ((i 0 (+ i 1)))
	    ((= i num-formants))
	  (set! (frms i) (make-formant (* (+ i 1) start-frq) radius))))
      (let ((frms1 (make-formant-bank frms amps)))
	(do ((k beg (+ k 1)))
	    ((= k end))
	  (let ((frq (env menv)))
	    (outa k (formant-bank frms1 (readin rd)))
	    (do ((i 0 (+ i 1))
		 (gfrq frq (+ gfrq frq)))
		((= i num-formants))
	      (mus-set-formant-frequency (vector-ref frms i) gfrq))))))))

(define (test-filter flt)
  (let ((osc (make-oscil 0.0))
	(samps (seconds->samples 0.5)))
    (let ((rmp (make-env '(0 0 1 1) :scaler (hz->radians samps) :length samps)))
      (with-sound ()
	(do ((i 0 (+ i 1)))
	    ((= i samps))
	  (outa i (flt (oscil osc (env rmp)))))))))

(definstrument (flux start-time file frequency combs0 combs1 (scaler 0.99) (comb-len 32))
  (let ((beg (seconds->samples start-time))
	(len (framples file)))
    (let ((end (+ beg len))
	  (num-combs0 (length combs0))
	  (num-combs1 (length combs1)))
      (let ((cmbs0 (make-vector num-combs0))
	    (cmbs1 (make-vector num-combs1))
	    (osc (make-oscil frequency))
	    (rd (make-readin file)))

	(do ((k 0 (+ k 1)))
	    ((= k num-combs0))
	  (set! (cmbs0 k)
		(make-comb scaler 
			   (floor (* comb-len (combs0 k))))))
	(do ((k 0 (+ k 1)))
	    ((= k num-combs1))
	  (set! (cmbs1 k)
		(make-comb scaler 
			   (floor (* comb-len (combs1 k))))))
	
	(set! cmbs0 (make-comb-bank cmbs0))
	(set! cmbs1 (make-comb-bank cmbs1))

	(do ((i beg (+ i 1)))
	    ((= i end))
	  (let ((interp (oscil osc))
		(x (readin rd)))
	    (outa i (+ (* interp (comb-bank cmbs0 x))
		       (* (- 1.0 interp) (comb-bank cmbs1 x))))))))))



;;; ---------------- sndscm-osc ----------------

(defgenerator sndscm-osc freq phase fm res)

(define (sndscm-osc gen fm)
  (let-set! gen 'fm fm)
  (with-let gen
    (set! res (sin phase))
    (set! phase (+ phase freq fm))
    res))

(definstrument (sndscm-osc-fm beg dur freq amp mc-ratio fm-index)
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(carrier (make-sndscm-osc (hz->radians freq)))
	(modulator (make-sndscm-osc (hz->radians (* mc-ratio freq))))
	(index (hz->radians (* freq mc-ratio fm-index))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (sndscm-osc carrier (* index (sndscm-osc modulator 0.0))))))))




;;; ---------------- sndscm-osc1 ----------------

(defgenerator 
  (sndscm-osc1 :make-wrapper (lambda (gen)
			       (set! (gen 'freq) (hz->radians (gen 'freq)))
			       gen))
  freq phase fm res)

(define* (sndscm-osc1 gen fm)
  (sndscm-osc gen fm))

(definstrument (sndscm-osc1-fm beg dur freq amp mc-ratio (fm-index 1.0))
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(carrier (make-sndscm-osc1 freq))
	(modulator (make-sndscm-osc1 (* mc-ratio freq)))
	(index (hz->radians (* freq mc-ratio fm-index))))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (sndscm-osc1 carrier (* index (sndscm-osc1 modulator 0.0))))))))




;;; ---------------- sndscm-osc2 ----------------

(defgenerator (sndscm-osc2 :make-wrapper (lambda (gen)
					   (set! (gen 'freq) (hz->radians (gen 'freq)))
					   gen)
			   :methods (list
				     (cons 'mus-frequency 
					   (dilambda
					    (lambda (g) (radians->hz (g 'freq)))
					    (lambda (g val) (set! (g 'freq) (hz->radians val)))))
				     
				     (cons 'mus-phase 
					   (dilambda
					    (lambda (g) (g 'phase))
					    (lambda (g val) (set! (g 'phase) val))))
				     
				     (cons 'mus-describe 
					   (lambda (g) (format #f "sndscm-osc2 freq: ~A, phase: ~A" 
							       (mus-frequency g) 
							       (mus-phase g))))))
  freq phase fm res)

(define* (sndscm-osc2 gen fm)
  (sndscm-osc gen fm))

(definstrument (sndscm-osc2-fm beg dur freq amp mc-ratio (fm-index 1.0))
  (let ((start (seconds->samples beg))
	(end (seconds->samples (+ beg dur)))
	(carrier (make-sndscm-osc2 freq))
	(modulator (make-sndscm-osc2 (* mc-ratio freq)))
	(index (hz->radians (* freq mc-ratio fm-index))))
    (if (fneq (mus-frequency carrier) freq)
	(format () ";sndscm-osc2 (sclm23.scm) mus-frequency ~A: ~A ~A" (mus-describe carrier) (mus-frequency carrier) freq))
    (do ((i start (+ i 1)))
	((= i end))
      (outa i (* amp (sndscm-osc2 carrier (* index (sndscm-osc2 modulator 0.0))))))))



;;; -------- asymmetric FM (bes-i0 case)

(defgenerator (dsp-asyfm :make-wrapper (lambda (gen)
					 (set! (gen 'freq) (hz->radians (gen 'freq)))
					 (set! (gen 'r1) (* 0.5 (gen 'index) (+ (gen 'r) (/ (gen 'r)))))
					 (set! (gen 'r2) (* 0.5 (gen 'index) (- (gen 'r) (/ (gen 'r)))))
					 (set! (gen 'r3) (* 0.5 (log (bes-i0 (* 2.0 (gen 'r1))))))
					 gen))
  freq phase (ratio 1.0) (r 1.0) (index 1.0) input r1 r2 r3)

(define dsp-asyfm-J 
  (let ((+documentation+ "(dsp-asyfm-J gen input) is the same as the CLM asymmetric-fm generator, set r != 1.0 to get the asymmetric spectra"))
    (lambda (gen input)
      (let-set! gen 'input input)
      (with-let gen
	(let ((result (let ((modphase (* ratio phase)))
			(* (exp (* r2 (cos modphase)))
			   (sin (+ phase (* r1 (sin modphase))))))))
	  (set! phase (+ phase input freq))
	  result)))))

(define dsp-asyfm-I 
  (let ((+documentation+ "(dsp-asyfm-I gen input) is the I0 case of the asymmetric-fm generator (dsp.scm)"))
    (lambda (gen input)
      (let-set! gen 'input input)
      (with-let gen
	(let ((result (let ((modphase (* ratio phase)))
			(* (exp (- (* r1 (cos modphase)) r3))
			   (sin (+ phase (* r2 (sin modphase))))))))
	  (set! phase (+ phase input freq))
	  result)))))



(defgenerator (sndclm-expcs 
	       :make-wrapper (lambda (g)
			       (if (<= (g 'et) 0.0) (set! (g 'et) 0.00001))
			       (set! (g 'frequency) (hz->radians (g 'frequency)))
			       (set! (g 'sinht) (* 0.5 (sinh (g 'et))))
			       (set! (g 'cosht) (cosh (g 'et)))
			       g))
  frequency phase et sinht cosht fm)

(define (sndclm-expcs gen fm)
  (let-set! gen 'fm fm)
  (with-let gen
    (let ((result (- (/ sinht (- cosht (cos phase))) 0.5)))
    (set! phase (+ phase frequency fm))
    result)))



;;; --------------------------------------------------------------------------------

(define (simp-named-let beg dur freq amp)
  (let ((o (make-oscil freq))
	 (start (seconds->samples beg))
	 (end (seconds->samples (+ beg dur))))
    (let loop ((i start))
      (outa i (* amp (oscil o)))
      (if (< i end)
	  (loop (+ i 1))))))



;;; --------------------------------------------------------------------------------


(define (test-documentation-instruments)
  
  (with-sound (:channels 2) 
    (fmdoc-pm 0 10000 1000 .25 0.5 4)
    (fmdoc-fm 0 10000 1000 .25 0.5 4))
  (with-sound () 
    (fmdoc-fm-1 0 1.0 100 .5 1.0 4.0)
    (fmdoc-fm-1 1 1.0 400 .5 0.25 4.0)
    (fmdoc-fm-1 2 1.0 400 .5 1.1414 4.0)
    (fmdoc-fm-1 3 0.5 400 .5 1.0 5.0 '(0 0 20 1 40 .6 90 .5 100 0))
    (fmdoc-fm-1 4 1.0 900 .5 1/3 2.0 '(0 0 6 .5 10 1 90 1 100 0))
    (fmdoc-fm-1 5 1.0 500 .5 .2 1.5 '(0 0 6 .5 10 1 90 1 100 0))
    (fmdoc-fm-1 6 1.0 900 .5 2/3 2 '(0 0 25 1 75 1 100 0))
    (fmdoc-fm-2 7 1.0 100 .25 1.0 4 0 (* .5 pi))
    (fmdoc-fm-2 8 1.0 100 .25 1.0 4.0 (* .5 pi) (* .5 pi))
    (fmdoc-fm-3 9 2.0 100 .25 1.0 4.0 0 0 '(0 0 50 1 100 0) .02)
    (fmdoc-fm-4 10 1.0 1000 .25 .1 1.0 0 (* .5 pi) (* .5 pi) 0)
    (fmdoc-fm-5 11 2.0 440 .3 '(1 3 4) '(1.0 0.5 0.1) 0.0 '(0.0 0.0 0.0))
    (fmdoc-violin 12 1.0 440 .1 2.5))
  (with-sound ()
    (fmdoc-cascade 0 1.0 400 .25 1.0 1.0 1.0 1.0 0)
    (fmdoc-cascade 1.5 1.0 400 .25 1.0 1.0 1.0 1.0 (* .5 pi))
    (fmdoc-feedbk 2 1 100.0 1.0 1.0))
  (with-sound () ; 1.2
    (fmdoc-vox 0 1.0 220.0 0.5)
    (fmdoc-vox 1.5 1.0 110 .5 '(0.02 0.01 0.02) '(.9 .09 .01)))
  (with-sound (:srate 44100) 
    (sndclmdoc-simp 0 22050 330 .1)
    (sndclmdoc-simp-1 0 1.0 440.0 0.1)
    (sndclmdoc-telephone 1.0 '(7 2 3 4 9 7 1))
    (sndclmdoc-simp-4 2 2 440 .1 '(0 0  0.1 1.0  1.0 0.0)))
  (with-sound () 
    (let ((sqr (make-square-wave 100))) ; test a square-wave generator
      (do ((i 0 (+ i 1))) 
	  ((= i 10000)) 
	(outa i (square-wave sqr))))
    (let ((osc (make-my-oscil 440.0)))
      (do ((i 10000 (+ i 1))) 
	  ((= i 22050))
	(outa i (my-oscil osc 0.0)))))
  (with-sound () 
    (sndclmdoc-simp-5 0 10000 440 .1 '(0 0 1 1)) ; sweep up an octave
    (simple-fm 1 1 440 .1 2 1.0)
    (sndclmdoc-simple-add 2 1 220 .3)
    (sndclmdoc-mapenv 3 1 440 .4 '(0 0 50 1 75 0 86 .5 100 0)))
  (if (file-exists? "/home/bil/sf1/forest.aiff")
      (with-sound (:srate 44100) (sndclmdoc-looper 0 10 "/home/bil/sf1/forest.aiff" 1.0 0.5)))
  (with-sound ()
    (sndclmdoc-bigbird 0 .05 1800 1800 .2
		       '(.00 .00 .40 1.00 .60 1.00 1.00 .0)         ; freq env
		       '(.00 .00 .25 1.00 .60 .70 .75 1.00 1.00 .0) ; amp env
		       '(1 .5 2 1 3 .5 4 .1 5 .01)))                ; bird song spectrum
  (with-sound (:srate 44100) 
    (sndclmdoc-pqw 0 1 200.0 1000.0 '(2 .2  3 .3  6 .5))
    (sndclmdoc-tritri 0 1 1000.0 0.5 0.1 0.01) ; sci-fi laser gun
    (sndclmdoc-tritri 1 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
  (with-sound (:srate 22050) (sndclmdoc-shift-pitch 0 3 "oboe.snd" 1108.0)) ; 1.7
  (let ((sound "oboe.snd")) ; 1.8
    (let ((mx (maxamp sound))
	  (dur (mus-sound-duration sound)))
      (with-sound (:scaled-to mx :srate 22050) 
	(sndclmdoc-repitch 0 dur sound 554 1000))))
  (with-sound () (sndclmdoc-fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
  (with-sound () ; one of JC's favorite demos
    (sndclmdoc-fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
		      '(0 0 .5 1 3 .5 10 .2 20 .1 50 .1 60 .2 85 1 100 0))
    (sndclmdoc-fofins 0 4 648 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
		      '(0 0 .5 .5 3 .25 6 .1 10 .1 50 .1 60 .2 85 1 100 0))
    (sndclmdoc-fofins 0 4 135 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1) 
		      '(0 0 1 3 3 1 6 .2 10 .1 50 .1 60 .2 85 1 100 0)))
  (with-sound () (sndclmdoc-echo 0 60000 .5 1.0 "pistol.snd"))
  (with-sound () 
    (sndclmdoc-zc 0 3 100 .1 20 100 .5) 
    (sndclmdoc-zc 3.5 3 100 .1 90 100 .95))
  (with-sound (:srate 22050) ; .93
    (sndclmdoc-fir+comb 0 2 10000 .001 200)
    (sndclmdoc-fir+comb 2 2 1000 .0005 400)
    (sndclmdoc-fir+comb 4 2 3000 .001 300)
    (sndclmdoc-fir+comb 6 2 3000 .0005 1000))
  (with-sound (:srate 22050) ; 1.3
    (sndclmdoc-simple-src 0 4 1.0 0.5 '(0 1 1 2) "oboe.snd")
    (sndclmdoc-srcer 1 2 1.0   1 .3 20 "fyow.snd")
    (sndclmdoc-srcer 2 25 10.0   .01 1 10 "fyow.snd")
    (sndclmdoc-srcer 3 2 1.0   .9 .05 60 "oboe.snd")
    (sndclmdoc-srcer 4 2 1.0   1.0 .5 124 "oboe.snd")
    (sndclmdoc-srcer 5 10 10.0   .01 .2 8 "oboe.snd")
    (sndclmdoc-srcer 6 2 1.0   1 3 20 "oboe.snd")) 
  (with-sound () 
    (sndclmdoc-convins 0 2 (float-vector 1.0 0.5 0.25 0.125) "oboe.snd") ; same as fir-filter with those coeffs
    (sndclmdoc-granulate-sound "now.snd" 1 3.0 0 2.0)
    (sndclmdoc-grev 2 100000 2.0 "pistol.snd" 40000)
    (sndclmdoc-simple-pvoc 3 2.0 1.0 512 "oboe.snd")
    (sndclmdoc-simple-ina 4 1 .5 "oboe.snd")
    (sndclmdoc-env-sound "oboe.snd" 5 1.0 '(0 0 1 1 2 1 3 0)))
  (with-sound (:reverb jc-reverb :channels 2) 
    (sndclmdoc-space "pistol.snd" 0 1 :distance-env '(0 1 1 2) :degree-env '(0 0 1 90)))
  
  (with-sound ()
    (sndclmdoc-sum-of-odd-sines (sndclmdoc-make-sum-of-odd-sines 440.0 10) 0.0)
    (sndclmdoc-sinc-train (sndclmdoc-make-sinc-train 440.0))
    (sndclmdoc-moving-max (sndclmdoc-make-moving-max) 0.1)
    (sndclmdoc-asy 0 .1 440 .1 1.0)
    (sndclmdoc-simple-table 1000)
    (sndclmdoc-simple-f2s .1 .1 .1 "oboe.snd")
    (sndclmdoc-simp-2 .2 .1 440 .1)
    (sndclmdoc-fm-table "oboe.snd" .3 .1 .1 1.0 10.0 10)
    (sndclmdoc-bl-saw .5 .1 440 10))
  
  (with-sound (:channels 4)
    (let ((loc (make-locsig))
	  (osc (make-oscil 440.0)))
      (do ((i 0 (+ i 1)))
	  ((= i 360))
	(let ((start (* i 1000))
	      (stop (* (+ i 1) 1000)))
	  (do ((j start (+ j 1)))
	      ((= j stop))
	    (locsig loc j (* .5 (oscil osc)))))
	(move-locsig loc (* 1.0 i) 1.0))))
  (with-sound (:channels 4) (sndclmdoc-simple-dloc 0 2 440 .5))
  (with-sound () (when? 0 4 2.0 8.0 "1a.snd"))
  (with-sound () (move-formants 0 "oboe.snd" 2.0 0.99 '(0 1200 1.6 2400 2 1400) 4))

  (for-each test-filter (vector (make-one-zero 0.5 0.5) (make-one-pole 0.1 -0.9) (make-two-pole 0.1 0.1 0.9) (make-two-zero 0.5 0.2 0.3)))
  
  (with-sound (:scaled-to .5) ; .875
    (flux 0 "oboe.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6))
    (flux 2 "now.snd" 4.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0))
    (flux 4 "now.snd" 1.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.995 20)
    (flux 6 "now.snd" 10.0 '(1.0 1.25 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 10)
    (flux 8 "now.snd" 10.0 '(2.0) '(1.0 1.333 1.6 2.0 3.0) 0.99 120)
    (flux 10 "fyow.snd" .50 '(1.0 2.0 1.5) '(1.0 1.333 1.6 2.0 3.0) 0.99 120))
  
  (with-sound () 
    (sndscm-osc-fm 0 1 440 .1 1 1)
    (sndscm-osc1-fm 0 1 440 .1 1)
    (sndscm-osc2-fm 0 1 440.0 .1 1)
    (simp-named-let 0 .01 440 .1))
  
  (with-sound () 
    (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1))) 
      (do ((i 0 (+ i 1)))
	  ((= i 1000))
	(outa i (dsp-asyfm-J gen 0.0))))
    (let ((gen (make-dsp-asyfm :freq 2000 :ratio .1))) 
      (do ((i 1000 (+ i 1)))
	  ((= i 2000))
	(outa i (* 0.5 (dsp-asyfm-I gen 0.0)))))
    (let ((gen (make-sndclm-expcs :frequency 100 :et 1.0)))
      (do ((i 2000 (+ i 1)))
	  ((= i 12000))
	(outa i (sndclm-expcs gen 0.0))))
    (let ((gen (make-sndclm-expcs :frequency 100 :et 0.1))
	  (t-env (make-env '(0 .1 1 2) :length 10000)))
      (do ((i 12000 (+ i 1)))
	  ((= i 22000))
	(let ((et (env t-env)))
	  (set! (gen 'sinht) (* 0.5 (sinh et)))
	  (set! (gen 'cosht) (cosh et))
	  (outa i (sndclm-expcs gen 0.0))))))
  
  (for-each close-sound (sounds)))