66 files changed, 5359 insertions, 0 deletions

diff --git a/lib/bandfx.lsp b/lib/bandfx.lsp
new file mode 100644
index 0000000..a5b724c
--- /dev/null
+++ b/lib/bandfx.lsp
@@ -0,0 +1,153 @@
+;; bandfx -- audio effects based on separate frequency bands
+;;
+;; by Michael Mishkin and Roger B. Dannenberg
+
+;; SEPARATE-INTO-BANDS -- separate sound s into frequency bands with
+;; exponential spacing from p to p + inc * n. Filteres have a bandwidth
+;; of inc and there are n bands.
+;; The last band is not filtered.
+;;
+(defun separate-into-bands (s p inc n)
+  (let (bands width low-freq high-freq)
+    (setf bands (make-array n))
+    (setf high-freq (step-to-hz p))
+    (dotimes (i (1- n))
+      (setf low-freq high-freq)
+      (setf p (+ p inc))
+      (setf high-freq (step-to-hz p))
+      (setf width (- high-freq low-freq))
+      (setf (aref bands i) (reson s (+ low-freq (* 0.5 width)) width 1))
+      (setf s (areson s (+ low-freq (* 0.5 width)) width 1)))
+    (setf (aref bands (1- n)) s)
+    bands))
+
+
+;; SEPARATE-INTO-BANDS-RANGE -- separate signal s into num-bands bands
+;; from the low to high step
+;;
+(defun separate-into-bands-range (s low high num-bands)
+  (let ((inc (/ (- high low) num-bands)))
+    (separate-into-bands s low inc num-bands)))
+
+
+;; RECONSTRUCT-FROM-BANDS -- reconstruct a signal from bands
+;;
+(defun reconstruct-from-bands (bands)
+  (let ((result (aref bands 0)))
+    (dotimes (i (1- (length bands)))
+      (setf result (sum result (aref bands (1+ i)))))
+    result))
+
+;; BANDED-DELAY -- apply different delay to each band (channel) of bands.
+;;  del is the delay for the first band, and inc is the difference in
+;;  delay for each successive band. fb is the feedback for all delays.
+;;
+(defun banded-delay (bands del inc fb wet)
+  (let ((result (make-array (length bands))))
+    (dotimes (i (length bands))
+      (setf (aref result i) 
+            (sum (mult (- 1 wet) (aref bands i))
+                 (mult wet (feedback-delay (aref bands i) del fb))))
+      (setf del (+ del inc)))
+    result))
+
+;; APPLY-BANDED-DELAY -- apply banded delay effect to a sound
+;;   s is the sound to be processed
+;;   lowp, highp is the pitch range for the bands
+;;   num-bands is the number of bands
+;;   lowd, highd is the range of delays
+;;   fb is the feedback (same for all bands)
+;;   (note that if lowd > highd, delay decreases with increasing frequency)
+;;
+(defun apply-banded-delay (s lowp highp num-bands lowd highd fb wet)
+  (let (bands inc)
+    (reconstruct-from-bands
+      (banded-delay (separate-into-bands-range s lowp highp num-bands)
+                    lowd (/ (- highd lowd) num-bands) fb wet))))
+
+(defun banded-bass-boost (bands num-boost gain)
+  (let ((result (make-array (length bands))))
+    (dotimes (i (length bands))
+      (setf (aref result i)
+            (scale (if (< i num-boost) gain 1.0) 
+                   (aref bands i))))
+    result))
+
+
+(defun apply-banded-bass-boost (s lowp highp num-bands num-boost gain)
+  (reconstruct-from-bands 
+    (banded-bass-boost 
+      (separate-into-bands-range s lowp highp num-bands) 
+      num-boost gain)))
+
+(defun banded-treble-boost (bands num-boost gain)
+  (let ((result (make-array (length bands)))
+        (num-unity (- (length bands) num-boost)))
+    (dotimes (i (length bands))
+      (setf (aref result i)
+            (scale (if (< i num-unity) 1.0 gain) 
+                   (aref bands i))))
+    result))
+
+
+(defun apply-banded-treble-boost (s lowp highp num-bands num-boost gain)
+  (reconstruct-from-bands 
+    (banded-treble-boost 
+      (separate-into-bands-range s lowp highp num-bands) 
+      num-boost gain)))
+
+
+;; EXAMPLES
+
+;; First, a few helper functions
+
+;; CHECK-PIANO -- make sure pianosyn.lsp is loaded
+;;
+(defun check-piano ()
+  (cond ((not (boundp '*pianosyn-path*))
+         (load "pianosyn"))))
+
+;; PN-RIFF -- make a sound to which we can add effects
+;;
+(defun pn-riff ()
+  (seq
+    (seqrep (i 20)
+      (set-logical-stop 
+        (piano-note 0.1 (+ (rem (* i 5) 48) c2) 100)
+        0.2))
+    (s-rest)))
+
+;; Examples start with band-2. You can run examples in the IDE after
+;; loading this file using the F2, F3, ... buttons in the IDE.
+
+(defun band-2 ()
+  (check-piano)
+  (play (apply-banded-delay (pn-riff) c2 120 28 1.0 0.0 0.0 0.2)))
+
+(setfn f2 band-2)
+
+(defun band-3 ()
+  (check-piano)
+  (play (apply-banded-delay (pn-riff) c2 120 28 0.0 1.0 0.0 0.2)))
+
+(setfn f3 band-3)
+
+(defun band-4 ()
+  (check-piano)
+  (play (scale 0.4 (apply-banded-bass-boost (pn-riff) c2 120 28 5 10))))
+
+(setfn f4 band-4)
+
+(defun band-5 ()
+  (check-piano)
+  (play (scale 0.4 (apply-banded-treble-boost (pn-riff) c2 120 28 5 10))))
+
+(setfn f5 band-5)
+
+(print "bandfx.lsp has been loaded. Try (f2) through (f5) for examples.")
+
+
+
+
+
+
diff --git a/lib/compress.lsp b/lib/compress.lsp
new file mode 100644
index 0000000..e1f0c49
--- /dev/null
+++ b/lib/compress.lsp
@@ -0,0 +1,310 @@
+; This code implements a compressor for noisy speech audio.
+; There are actually two compressors that can be used in 
+; series. The first is
+; a fairly standard one: it detects signal level with an RMS
+; detector and used table-lookup to determine how much gain
+; to place on the original signal at that point. One bit of
+; cleverness here is that the RMS envelope is "followed" or
+; enveloped using SND-FOLLOW, which does look-ahead to anticipate
+; peaks before they happen.
+;
+; The other piece of high-tech is COMPRESS-MAP, which builds 
+; a map in terms of compression and expansion. What I recommend
+; is figure out the noise floor on the signal you are compressing.
+; Use a compression map that leaves the noise alone and boosts
+; signals that are well above the noise floor. Alas, the COMPRESS-MAP
+; function is not written in these terms, so some head-scratching is
+; involved. Maybe I'll write another map generator if someone has a
+; good application to test with.
+
+; COMPRESS-MAP -- constructs a map for the compress function
+;
+; The map consists of two parts: a compression part and an expansion part.
+; The intended use is to compress everything above compress-threshold by
+; compress-ratio, and to downward expand everything below expand-ratio
+; by expand-ratio.  Thresholds are in dB and ratios are dB-per-dB.
+; 0dB corresponds to a peak amplitude of 1.0 or rms amplitude of 0.7
+; If the input goes above 0dB, the output can optionally be limited
+; by setting :limit (a keyword parameter) to T. This effectively changes 
+; the compression ratio to infinity at 0dB.  If :limit is NIL
+; (the default), then the compression-ratio continues to apply above 0dB.
+; 
+; Another keyword parameter, :transition, sets the amount below the
+; thresholds (in dB) that a smooth transition starts. The default is 0,
+; meaning that there is no smooth transition.
+; 
+; It is assumed that expand-threshold <= compress-threshold <= 0
+; The gain is unity at 0dB so if compression-ratio > 1, then gain
+; will be greater than unity below 0dB
+
+; RETURNS: a sound for use in the SHAPE function. The sound maps input
+; dB to gain. Time 1.0 corresponds to 0dB, and Time 0.0 corresponds to
+; -100 dB, and Time 2.0 corresponds to +100dB, so this is a 
+; 100hz "sample rate" sound. The sound gives gain in dB.
+
+; Smooth transition equations: this is a parabola that makes a
+; transition between two intersecting straight lines. The parabola 
+; matches the slope of the lines where it intersects them, and
+; it intersects the first (left) line at location (u, v). The equation
+; is:
+;     y = v + m(x-u) + d(s-m)((x-u)/d - (x-u)^2/(2d^2))
+;       = v + m(x-u) + (s-m)((x-u) - (x-u)^2/(2d))
+;       = v + m(x-u) + (s-m)((x-u) - (x-u)^2(s-m)/(4(b-v)))
+; 
+; where s is the slope of the left line, the right line is expressed by
+;     y = mx+b, and
+; d is the duration of the transition = 2(b-v)/(s-m)
+;
+; To show this is correct, show that (1) at the left intersection, the left 
+; line and the transition both pass through u,v and (2) have the same slope s,
+; and show that (3) at the right intersection, the right line and the 
+; transition both meet at u+d and (4) have the same slope m.
+;
+; transition runs from u,v on left line to u+d on right line
+; d = 2(v - mu - f)/(m - s), 
+; where right line is described by y = mx + f and left line slope = s
+; c = (m - s)/2d
+; b = s - 2cu
+; a = v - bu - cu^2
+;
+; transition is y = a + bx + cx^2
+;
+; Now, show that curve meets left line at x = u
+; (1) a + bx + cx^2 = v at x = u
+; a + bu + cuu = v - bu - cuu + bu + cuu = v
+;
+; (2) slope at x = u is s:
+; b + 2cu = s - 2cu + 2cu = s
+;
+; (3) curve meets right line at x = u + d
+; a + b(u + d) + c(uu + 2ud + dd) =
+; v - bu - cuu + bu + bd + cuu + 2cud + cdd =
+; v + bd +2cud + cdd =
+; v + (s - 2cu)d + 2cud + cdd =
+; v + sd + cdd =
+; v + sd + dd(m-s)/2d =
+; v + sd + d(m-s)/2 =
+
+; v + s(2(v - mu - f)/(m - s)) + (2(v - mu - f)/(m - s))(m-s)/2 =
+; v + 2sv/(m-s) -2smu/(m-s) -2sf/(m-s) + v - mu - f =
+; 2v + (2sv - 2smu - 2sf)/(m-s) - mu - f = 
+; 2v + 2s(v - mu - f)/(m-s) - mu - f =
+; 2v + sd - mu - f
+; try subtracting mx + b':
+; 2v + sd - mu - f - m(u + d) - f =
+; 2v + sd - 2mu - 2f - md = 
+; 2v + (s - m)d - 2mu - 2f =
+; 2v + (s - m)2(v - mu - f) / (m - s) - 2mu - 2f =
+; 0 
+;   
+(defun compress-map (compress-ratio compress-threshold expand-ratio 
+                     expand-threshold &key (limit nil) (transition 0.0))
+  (display "compress-map" compress-ratio compress-threshold expand-ratio 
+                     expand-threshold limit transition)
+  (let (m s			; see equations above
+        eupd 			; eu + d
+        cupd			; ct1 + d
+        lim			; 0dB or infinity, depends on limit
+        b2			; y-intercept of the 1:1 part
+        ea eb ec ca cb cc	; polynomial coefficients
+        eu ev cu cv		; intersection points (u,v)
+        ed cd			; d values
+        lower-db upper-db	; function to compute
+        map			;  samples for map
+        x			; loop value
+        den			; denominator
+        )
+    ; check input for good values:
+    (cond ((> expand-threshold compress-threshold)
+           (error "expand-threshold must be lower than compress threshold"))
+          ((> compress-threshold 0)
+           (error "compress-threshold must be at or below 0dB"))
+          ((<= compress-ratio 0.0)
+           (error "negative compress-ratio"))
+          ((< expand-ratio 0.0)
+           (error "negative expand-ratio"))
+    )
+    ; set some constants
+    (setf eu (- expand-threshold transition))
+    (setf cu (- compress-threshold transition))
+    (setf m (/ 1.0 compress-ratio))
+    (setf s expand-ratio)	; rename to match equations
+    ; point where compression line intersects non-compression
+    ; line is (* m compress-threshold), and cv is this point
+    ; minus transition (since slope is one)
+    (setf cv (- (* m compress-threshold) transition))
+    ; slope is 1 from compress-threshold to expand-threshold 
+    (setf ev (+ (* m compress-threshold)
+                (- expand-threshold compress-threshold)
+                (* s (- transition))))	
+    ; the 1:1 part passes through cu,cv with slope of 1, so the y-intercept
+    ; is cv-cu
+    (setf b2 (- cv cu))
+    ; d = 2(v - mu - f)/(m - s)	--note m = s, s = 1, f = 0
+    (setf den (- m 1.0))
+    (cond ((< (abs den) .001)
+               (setf cd 0.0))
+          (t
+           (setf cd (* 2 (- cv (* cu m)) (/ den)))))
+    (setf cupd (+ cu cd))
+
+    (setf den (- 1.0 s))
+    (cond ((< (abs den) .001)
+               (setf ed 0.0))
+          (t
+           (setf ed (* 2 (- ev eu b2) (/ den)))))
+    (setf eupd (+ eu ed))
+
+    ; ec = (1.0 - s)/(2*ed)
+    (cond ((< (abs ed) 0.001)
+           (setf ec 0.0))
+          (t
+           (setf ec (/ (- 1.0 s) (* 2.0 ed)))))
+    ; eb = s - 2*ec*eu
+    (setf eb (- s (* 2.0 ec eu)))
+    ; ea = ev - eb*eu - ec*eu*eu
+    (setf ea (- ev (* eb eu) (* ec eu eu)))
+
+    ; cc = (m - 1.0)/(2*cd)
+    (cond ((< (abs cd) 0.001)
+           (setf cc 0.0))
+          (t
+           (setf cc (/ (- m 1.0) (* 2.0 cd)))))
+    ; cb = s - 2*cc*cu
+    (setf cb (- 1.0 (* 2.0 cc cu)))
+    ; ca = cv - cb*cu - cc*cu*cu
+    (setf ca (- cv (* cb cu) (* cc cu cu)))
+
+
+    (cond (limit ; hard limit to 0dB
+               (setf lim 0.0))
+          (t 	 ; no hard limit, set limit to effectively infinity
+           (setf lim 10000.0)))
+
+    (display "compress-map" 
+        m s			; see equations above
+        eupd 			; et1 + d
+        cupd			; ct1 + d
+        lim			; 0dB or infinity, depends on limit
+        b2			; y-intercept of the 1:1 part
+        ea eb ec ca cb cc	; polynomial coefficients
+        eu ev cu cv		; intersection points (u,v)
+        ed cd)			; d values
+
+    ; now create function that goes 100dB below expansion threshold
+    ; and up to 100dB
+    (setf lower-db -100.0)
+    (setf upper-db 100.0)
+    (setf map (make-array 201))
+    (setf x lower-db)	; this should be an even integer
+    (dotimes (i (length map))
+        (setf (aref map i) 
+              (cond ((< x eu) (+ ev (* s (- x eu))))
+                  ((< x eupd) (+ ea (* eb x) (* ec x x)))
+                  ((< x cu) (+ cv (- x cu)))
+                  ((< x cupd) (+ ca (* cb x) (* cc x x)))
+                  ((< x lim) (* m x))
+                  (t 0)))
+        ; map[i] has the desired output dB, so subtract input dB to
+        ; get gain:
+        (setf (aref map i) (- (aref map i) x))
+        (cond ((and (> x (- eu 3)) (< x 0))
+               (format t "~A -> ~A~%" x (aref map i))))
+        (setf x (+ x 1)))
+    ; return a sound
+    (snd-from-array 0.0 100.0 map)))
+
+
+(defun db-average (input)
+  (let (y)
+    (setf y (mult input input)) ; first square input
+    (setf y (snd-avg y 1000 500 op-average)) ; then time average
+    (setf y (snd-log (scale 2.0 y))) ; peak normalization, then take log
+    (setf y (scale (/ 10.0 (log 10.0)) y))  ; see below for scaling explanation
+    y))
+
+
+(defun compress (input map rise-time fall-time &optional (lookahead 0.0))
+  ; take the square of the input to get power
+  (let ((in-squared (mult input input))
+        window avg env gain)
+    (cond ((zerop lookahead) (setf lookahead rise-time)))
+    ; compute the time-average (sort of a low-pass) of the square
+    ; parameters give 50ms window and a 25ms step
+    (setf window (round (* (snd-srate input) 0.05)))
+    (setf avg (snd-avg in-squared window (/ window 2) op-average))
+    ; use follower to anticipate rise and trail off smoothly
+    ; N.B.: the floor (2nd argument to snd-follow) should be the
+    ; square of the noise floor, e.g. for a noise floor of 1/2^16,
+    ; use 1/2^32 = about 4E-9. If the number is too small, you will
+    ; not get expansion below the square root of the floor parameter.
+    ; set lookahead to be number of samples in rise time:
+    (setf lookahead (round (* lookahead (snd-srate avg)))) 
+    (setf env (snd-follow avg 0.000001 rise-time fall-time lookahead))
+    ; take logarithm to get dB instead of linear, also adjust for
+    ; peak vs. average as follows: a sinusoid with peak of 1.0 has
+    ; an average amplitude of 1/sqrt(2), we squared the signal, so
+    ; the average amplitude should be 1/2, so multiply by 2 so
+    ; that a sine with peak amplitude of 1 will get an average of 1
+    ; which will convert to 0dB
+    (setf logenv (snd-log (scale 2.0 env)))
+    ; tricky part: map converts dB of input to desired gain in dB
+    ; this defines the character of the compressor
+    ; map is scaled so that (0,2) corresponds to (-100dB, 100dB)
+    ; so you need to scale input by .01. But first, we need to get dB:
+    ; we have log(avg(x^2)), and we want dB = 20log10(sqrt(avg(x^2)))
+    ; simplify dB to 10log10(avg(x^2)) = 10log(avg(x^2))/log(10),
+    ; so scale by 10/log(10) * 0.01 = 0.1/log(10)
+    (setf shaped-env (shape (setf gle (scale (/ 0.1 (log 10.0)) logenv)) map 1.0))
+    ; Go back to linear. To get from dB to linear, use:
+    ; 20log(linear) = dB
+    ; linear = exp(dB/20),
+    ; so scale the result by 1/20 = 0.05
+    (setf gain (snd-exp (scale 0.05 shaped-env)))
+    ; return the scaled input sound,
+    ; another trick: avg signal will be delayed. Also, snd-follow
+    ; has a delayed response because it's looking ahead in sound
+    ; 20 = the number of samples of lookahead from snd-follow
+    ; 88.2 = 44,100 (sample rate) / 500 (the step-size in avg)
+    ; in other words, 44100/500 is the sample rate of the control
+    ; signal looked at by follow
+    ; "44100" should be replaced by the signal's sample rate
+    ; = (snd-srate input)
+    ; (setf gg gain)
+    (sound-srate-abs (snd-srate input) ; set default sample rate for s-rest
+      (mult (seq (s-rest (/ 20.0 (/ (snd-srate input) 500.0))) (cue input)) gain))))
+
+
+ ; this is an automatic gain control using peak detection for 
+ ; gain control -- the range parameter gives the maximum gain in dB
+ ; the agc will attenuate peaks to 1.0.
+ ;
+ (defun agc (input range rise-time fall-time &optional (lookahead 0.0))
+  ; take the square of the input to get power
+  (let (window avg env gain lookahead-samples)
+    (cond ((zerop lookahead) (setf lookahead rise-time)))
+    ; compute the time-average (sort of a low-pass) of the square
+    ; parameters give 50ms window and a 25ms step
+    (setf window (round (* (snd-srate input) 0.05)))
+    (setf avg (snd-avg input window (/ window 2) op-peak))
+    ; use follower to anticipate rise and trail off smoothly
+    ; set lookahead to be number of samples in rise time:
+    (setf lookahead-samples (round (* lookahead (snd-srate avg)))) 
+    (setf env (snd-follow avg (db-to-linear (- range))
+                          rise-time fall-time lookahead-samples))
+    (setf gain (snd-recip env))
+    ; return the scaled input sound,
+    ; another trick: avg signal will be delayed. Also, snd-follow
+    ; has a delayed response because it's looking ahead in sound
+    ; 20 = the number of samples of lookahead from snd-follow
+    ; 88.2 = 44,100 (sample rate) / 500 (the step-size in avg)
+    ; in other words, 44100/500 is the sample rate of the control
+    ; signal looked at by follow
+    (sound-srate-abs (snd-srate input) ; set default sample rate for s-rest
+      (mult (seq (s-rest lookahead) (cue input)) gain))
+      ;(vector ; (seq (s-rest lookahead) (cue input))
+      ;	      (mult (seq (s-rest lookahead) (cue input)) gain) 
+      ;        (force-srate (snd-srate input) (scale 0.3 gain))))
+    ))
+
+
diff --git a/lib/dist-test.lsp b/lib/dist-test.lsp
new file mode 100644
index 0000000..a8a0c1e
--- /dev/null
+++ b/lib/dist-test.lsp
@@ -0,0 +1,193 @@
+;; Examples of how to use distributions.lsp
+
+;;1.  Altered granulate methods based on distribution
+
+(load "gran")
+
+;;The deviatons in pitch and grainlength of the standard granular synthesis
+;;functions in are based on the uniform random distribution.  With simple
+;;modifications, these can be made to take in a distribution generator
+;;function as a variable. 
+
+;; filename -- name of the file
+;; grain-dur -- the duration of a grain
+;; grain-dev -- grain dur is actually grain-dur + random(0, grain-dev)
+;; ioi -- the basic inter-onset-interval for grains
+;; ioi-dev -- ioi is actually: ioi + random(0, ioi-dev)
+;; pitch-dist -- the distribution of the alteration in pitch to the grains
+;;	       the distribution values should be > 1.
+;; file-start -- when to start reading the file (an offset from start)
+;; file-end -- when to stop reading the file (an offset from end)
+
+(defun pitch-dist-granulate (filename grain-dur grain-dev ioi ioi-dev
+	pitch-dist &optional (file-start 0) (file-end 0))
+(let (orig n env actual-grain-dur step-size
+        (avg-ioi (+ ioi (/ ioi-dev 2.0)))
+        (file-dur (sf-dur filename))
+        (dur (get-duration 1)))
+    (setf n (truncate (/ dur avg-ioi)))
+    (cond ((< file-dur file-start)
+           (error "sf-granulate: file-start is after end of file!"))
+          ((< file-dur file-end)
+           (error "sf-granulate: file-end (offset) exceeds file duration!"))
+          ((< file-dur (+ file-start file-end))
+           (error "sf-granulate: file-start + file-end > file duration!")))
+    (setf file-dur (- file-dur file-start file-end))
+    (setf step-size (/ file-dur n))
+    (stretch-abs 1.0 (let ()
+      (seqrep (i n) (let ()
+        (setf actual-grain-dur (real-random grain-dur (+ grain-dur grain-dev)))
+        (setf env (stretch actual-grain-dur (one-minus-cosine)))
+        (force-srate *sound-srate*
+          (stretch (funcall pitch-dist)
+            (sound2
+             (set-logical-stop
+              (mult (cue env)
+                    (s-read filename 
+                            :time-offset (+ file-start (* step-size i))
+                            :dur actual-grain-dur))
+              (real-random ioi (+ ioi ioi-dev))))))))))))
+
+
+;; filename -- name of the file
+;; dist -- the distribution function that the grain sizes should follow
+;; ioi -- the basic inter-onset-interval for grains
+;; ioi-dev -- ioi is actually: ioi + random(0, ioi-dev)
+;; pitch-dev -- grains are resampled at rate between 1 and pitch-dev
+;; file-start -- when to start reading the file (an offset from start)
+;; file-end -- when to stop reading the file (an offset from end)
+
+(defun len-dist-granulate (filename dist ioi ioi-dev pitch-dev 
+                     &optional (file-start 0) (file-end 0))
+  (let (orig n env actual-grain-dur step-size
+        (avg-ioi (+ ioi (/ ioi-dev 2.0)))
+        (file-dur (sf-dur filename))
+        (dur (get-duration 1)))
+    (setf n (truncate (/ dur avg-ioi)))
+    (cond ((< file-dur file-start)
+           (error "sf-granulate: file-start is after end of file!"))
+          ((< file-dur file-end)
+           (error "sf-granulate: file-end (offset) exceeds file duration!"))
+          ((< file-dur (+ file-start file-end))
+           (error "sf-granulate: file-start + file-end > file duration!")))
+    (setf file-dur (- file-dur file-start file-end))
+    (setf step-size (/ file-dur n))
+    (stretch-abs 1.0 (let ()
+      (seqrep (i n) (let ()
+        (setf actual-grain-dur (funcall dist))
+        (setf env (stretch actual-grain-dur (one-minus-cosine)))
+        (force-srate *sound-srate*
+          (stretch (real-random 1.0 pitch-dev)
+            (sound2
+             (set-logical-stop
+              (mult (cue env)
+                    (s-read filename 
+                            :time-offset (+ file-start (* step-size i))
+                            :dur actual-grain-dur))
+              (real-random ioi (+ ioi ioi-dev))))))))))))
+
+;; How to use these granular-synthesis functions
+
+;; First, make a continuation out of the distribution functions
+(defun make-gauss (xmu sigma low high)
+	(lambda () (gauss-dist xmu sigma low high)))
+
+;; Second, Plug in that continuation as a variable to the granular-synthesis function
+(defun try-len-dist ()
+  (play (stretch 4
+          (simrep (i 2)
+            (len-dist-granulate "samples.wav" 
+		(make-gauss 0.0 1.0 0.1 .5) 0.02 0.001 2.0 0 0)))))
+
+;; Here's an example of changing the pitch distribution
+(defun make-gamma (nu high)
+	(lambda () (gamma-dist nu high)))
+
+(defun try-pitch-dist ()
+  (play (stretch 4
+          (simrep (i 4)
+            (pitch-dist-granulate "samples.wav" 0.04 0.0 0.02 0.001 
+		(make-gamma 2.0 5.0) 0 0)))))
+
+
+;; 2. Simple methods of usuing probability distribution generators
+;; In general, a probability distribution generator can substitue for a
+;; uniform ranom generator which is (real-random min max)
+
+;; Use a continuous distribution generator to alter the time between sounds
+(defun try-exponential ()
+	(play (seqrep (i 20)
+		(pluck c4 (* 0.5 (exponential-dist .25 2.0))))))
+
+;; Use a discrete generator to alter the pitch by a whole number.
+(defun try-binomial ()
+	(play (seqrep (i 20)
+		(pluck (+ (binomial-dist 6 .5) c4) 0.1))))
+
+
+(defun dist-hist (fn n nbins low high &rest params)
+  (let ((bins (make-array nbins))
+        (step (/ (- high low) (float (- nbins 2)))))
+    (dotimes (i nbins)
+      (setf (aref bins i) 0.0))
+    (dotimes (i n)
+      (let ((x (apply fn params)) i)
+        (cond ((< x low) (incf (aref bins 0)))
+              ((>= x high) (incf (aref bins (1- nbins))))
+              (t
+               (setf i (truncate (1+ (/ (- x low) step))))
+               (if (or (< i 1) (>= i (1- nbins)))
+                   (error "unexpected bin number"))
+               (incf (aref bins i))))))
+    bins))
+
+
+; test LINEAR-DIST
+;(setf hist (dist-hist #'linear-dist 10000 100 0 4 4))
+;(s-plot (scale 0.001 (snd-from-array 0.0 100 hist)))
+
+; test EXPONENTIAL-DIST
+; (setf hist (dist-hist #'exponential-dist 10000 100 0 3 1 3))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test GAMMA-DIST
+;(setf hist (dist-hist #'gamma-dist 10000 100 0 10 3 4))
+;(s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test BILATERAL-EXPONENTIAL-DIST
+; (setf hist (dist-hist #'bilateral-exponential-dist 10000 100 0 10 4.0 1.1 0 10))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test CAUCHY-DIST
+; (setf hist (dist-hist #'cauchy-dist 100000 100 -10 10 1.0 -9 6))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test HYPERBOLIC-COSINE-DIST
+; (setf hist (dist-hist #'hyperbolic-cosine-dist 1000000 500 -10 10))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test LOGISTIC-DIST
+; (setf hist (dist-hist #'logistic-dist 10000 100 -10 10 0.5 2 -5 1))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test GAUSSIAN-DIST
+; (setf hist (dist-hist #'gaussian-dist 100000 100 0 10 5 1 2 8))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test BETA-DIST
+; (setf hist (dist-hist #'beta-dist 100000 100 -0.1 1.1 0.5 0.25))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test BERNOULLI-DIST
+; (setf hist (dist-hist #'bernoulli-dist 10000 100 -0.1 1.1 0.75 0.1 0.9))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test GEOMETRIC-DIST
+; (setf hist (dist-hist #'geometric-dist 100000 100 0 10 0.7))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+; test POISSON-DIST
+; (setf hist (dist-hist #'poisson-dist 10000 100 0 20 4))
+; (s-plot (scale 1.0 (snd-from-array 0.0 100 hist)))
+
+
diff --git a/lib/distributions.lsp b/lib/distributions.lsp
new file mode 100644
index 0000000..2821c31
--- /dev/null
+++ b/lib/distributions.lsp
@@ -0,0 +1,155 @@
+;; Andreas Pfenning, 26 Apr 05
+;; modified by Roger B. Dannenberg, 25 Jun 05
+
+;; Probability distribution functions and demo
+
+#|
+This is a library of various probability distribution generators.
+The functions output values based on the probability distributions
+and the input parameters that scale the distributions.  Plots 
+of the various distributions are shown in the documentation.
+The user has option of adding bounds to the output values,
+especially in the cases where high or low outliers are expected.
+When a distribution returns a value outside of the given bounds,
+the value is rejected and another value is generated. Both
+discrete (whole number) and continuous distributions are
+available. For continous distributions, the probability of
+outputing a value between any two points on the x axis is equal
+to the area under the curve between those two points. Essentially,
+the higher the curve is for a an area of the x axis, the more
+likely it is that the generator will output a value in that area.
+Discrete generators output values based on how high the "bar" is
+at that location. The documentation shows the behavior generated
+by 100 trials of discrete probability distributioin generators.
+|#
+
+;;Library of Continuous Probability Distribution Generators
+
+(defun linear-dist (g)
+  (* g (- 1.0 (sqrt (rrandom)))))
+
+(defun exponential-dist (delta &optional high)
+  (cond ((and high (<= high 0))
+         (error "exponential-dist: high value must be positive")))
+  (loop 
+    (let ((expv (* (/ -1.0 delta) (log (rrandom)))))
+      (cond ((or (null high)
+                 (<= expv high))
+             (return expv))))))
+
+(defun gamma-dist (nu &optional high)
+  (cond ((and high (<= high 0)
+         (error "gamma-dist: high value must be positive"))))
+  (loop
+    (let* ((summ 1)
+           (summ2 (dotimes (count nu summ)
+	          (setf summ (* summ (rrandom)))))
+           (gamv (* -1.0 (log summ2))))
+      (cond ((or (null high)
+                 (<= gamv high))
+             (return gamv))))))
+
+
+(defun bilateral-exponential-dist (xmu tau &optional low high)
+  (cond ((and high low (<= high low)) 
+         (error "bilateral-exponential-dist: high must be greater than low")))
+  (loop
+    (let* ((u (* (rrandom) 2.0))
+           (bev (if (> u 1.0) 
+                    (+ (* -1.0 tau (log (- u 1.0))) xmu)
+                    (+ (* tau (log u)) xmu))))
+      (cond ((and (or (null high) (< bev high))
+                  (or (null low) (> bev low)))
+             (return bev)))))) 
+
+
+(defun cauchy-dist (tau &optional low high)
+  (cond ((and high low (<= high low))
+         (error "cauchy-dist: high must be greater than low")))
+  (loop
+    (let* ((u (* PI (rrandom)))
+	 (cauv (* tau (/ (sin u) (cos u)))))
+      (cond ((and (or (null high) (< cauv high))
+                  (or (null low) (> cauv low)))
+             (return cauv))))))
+
+
+(defun hyperbolic-cosine-dist (&optional low high)
+  (cond ((and high low (<= high low))
+         (error "hyperbolic-cosine-dist: high must be greater than low")))
+  (loop
+    (let* ((hcv (log (tan (/ (* PI (rrandom)) 2.0)))))
+      (cond ((and (or (null high) (< hcv high))
+                  (or (null low) (> hcv low)))
+             (return hcv))))))
+
+
+(defun logistic-dist (alpha beta &optional low high)
+  (cond ((and high low (<= high low))
+         (error "logistic-dist: high must be greater than low")))
+  (loop
+    (let (rand lgv)
+      (setf rand (rrandom))
+      (cond ((zerop rand)) ; try again -- do not use zero
+            (t
+             (setf rand (- (/ rand) 1.0))
+             (cond ((zerop rand)) ; try again -- do not use zero
+                   (t
+                    (setf lgv (/ (- (+ beta (log rand))) 
+                               alpha))
+                    (cond ((and (or (null high) (< lgv high))
+                                (or (null low) (> lgv low)))
+                           (return lgv))))))))))
+
+
+(defun gaussian-dist (xmu sigma &optional low high)
+  (cond ((and high low (<= high low))
+         (error "gauss-dist: high must be greater than low")))
+  (loop
+    (let* ((s 0.0)
+           (s2 (dotimes (i 12 s)
+                        (setq s (+ s (rrandom)))))
+           (gsv (+ (* sigma (- s2 6.0)) xmu)))
+      (cond ((and (or (null high) (< gsv high))
+                  (or (null low) (> gsv low)))
+             (return gsv))))))
+
+
+(defun beta-help (ea eb)
+  (loop
+    (let ((y1 (power (rrandom) ea))
+          (y2 (power (rrandom) eb)))
+      (if (<= (+ y1 y2) 1.0)
+          (return (/ y1 (+ y1 y2)))))))
+
+
+(defun beta-dist (a b)
+  (let ((ea (/ 1.0 a)) (eb (/ 1.0 b)))
+    (beta-help ea eb)))
+
+
+;;Library of Discrete Probability Distribution Generators
+
+(defun bernoulli-dist (px1 &optional (x1 1) (x2 0))
+  (let ((u (rrandom)))
+    (if (< u px1) x1 x2)))
+
+(defun binomial-dist (n p)
+  (let ((suc 0))
+    (dotimes (count n suc)
+      (setf suc (+ suc (bernoulli-dist p))))))
+
+(defun geometric-dist (p &optional (count 0))
+  (loop
+    (cond ((= (bernoulli-dist p) 1) 
+           (return count)))
+    (setf count (1+ count))))
+
+(defun poisson-dist (delta)
+  (let ((x 0) (t 0.0))
+    (loop
+      (setf t (- t (/ (log (rrandom)) delta)))
+      (cond ((> t 1) (return x)))
+      (setf x (1+ x)))))
+
+
diff --git a/lib/dtmf.lsp b/lib/dtmf.lsp
new file mode 100644
index 0000000..4e9615d
--- /dev/null
+++ b/lib/dtmf.lsp
@@ -0,0 +1,46 @@
+;; dtmf.lsp -- DTMF encoding functions
+;; Rob Rost and Roger B. Dannenberg
+
+;; This library takes a list of DTMF (touch-tone) digits and 
+;; synthesizes the correct audio. Example:
+;;   (speed-dial '(1 2 3 pound 5 6 star 7))
+;; Note how pound and star keys are entered.
+
+
+(setf dtmf-freqs
+  '((star 941 1209) (0 941 1336) (pound 941 1477)
+    (1 697 1209)    (2 697 1336) (3 697 1477)
+    (4 770 1209)    (5 770 1336) (6 770 1477)
+    (7 852 1209)    (8 852 1336) (9 852 1477)))
+
+(defun dtmf-freq1 (key)
+  (cadr (assoc key dtmf-freqs)))
+
+(defun dtmf-freq2 (key)
+  (caddr (assoc key dtmf-freqs)))
+
+(defun dtmf-tone (key len space)
+  (scale 0.5 
+    (seq
+      (stretch len
+        (sim (hzosc (dtmf-freq1 key))
+             (hzosc (dtmf-freq2 key))))
+      (s-rest space))))
+
+
+; send it a list of digits and it returns the
+; Sound object to dial that number
+(defun speed-dial (thelist)
+  (cond ((null thelist) (s-rest 0))
+	(t 
+         (seq (dtmf-tone (car thelist) 0.2 0.1)
+	      (speed-dial (cdr thelist))))))
+
+
+(defun dtmf-example ()
+  (play (speed-dial (list 4 1 2 5 5 5 1 2 1 2))))
+
+(print "DTMF library loaded. Run (dtmf-example) for a sample output.")
+
+
+
diff --git a/lib/gran.lsp b/lib/gran.lsp
new file mode 100644
index 0000000..7e41d6f
--- /dev/null
+++ b/lib/gran.lsp
@@ -0,0 +1,149 @@
+;; GRAN.LSP -- granular synthesis example by Roger B. Dannenberg
+;;
+;; This is not the ultimate granular synthesis package, so do not
+;; consider this to be a stable, permanent addition to the Nyquist
+;; library. You can use it as is, or use it as the basis for your
+;; own custom variations.
+
+;; ==================================================================
+;; Grains are windowed with "raised cosine pulse functions." These
+;; are smooth envelopes based on the function (1-cos(2*pi*t))/2.
+;; To speed up computation, I save three functions with 20, 200, and
+;; 2205 samples. The function one-minus-cosine selects an appropriate
+;; envelope based on the duration (stretch) currently in effect.
+
+(defun cos-pulse () (scale 0.5 (sum 1 (lfo 1 1 *sine-table* 270.0))))
+
+;; this will be a 2205 point smooth 1-cos(x) curve:
+;;
+(setf *cos-pulse-2205* (cos-pulse))
+
+;; this will be a 200 point smooth 1-cos(x) curve:
+;;
+(setf *cos-pulse-200* (control-srate-abs 200 (cos-pulse)))
+(setf *cos-pulse-20*  (control-srate-abs 20 (cos-pulse)))
+
+
+;; one-minus-cosine -- an envelope based on (1-cos(2pi*t))/2
+;;
+(defun one-minus-cosine ()
+  (let ((max-samps (* *sound-srate* (get-duration 1))))
+    (cond ((> max-samps 2205) (sound *cos-pulse-2205*))
+          ((> max-samps 200) (sound *cos-pulse-200*))
+          (t (sound *cos-pulse-20*)))))
+
+'  (let ((duration (get-duration 1)))
+    (scale 0.5 (sum 1 (lfo (/ duration) 1 *sine-table* 270.0))))
+
+;; ==================================================================
+;; The granulation is applied to a sound file rather than a sound.
+;; This gives us the ability to access the sound file at any point
+;; in time, although is is a bit less efficient because we have to
+;; reopen the file hundreds or thousands of times. (On the other hand
+;; the file data is likely to be cached by the OS, so it goes pretty
+;; fast.)
+;; Here, we define some functions for getting file information.
+
+(defun sf-srate (filename)
+  (s-read filename) ; s-read returns list of info in *rslt*
+  (s-read-srate *rslt*))
+
+
+(defun sf-dur (filename)
+  (s-read filename)
+  (s-read-dur *rslt*))
+
+;; ============================================================
+;; Define some other handy support functions
+
+;; real-random -- pick a random real from a range
+;;
+(defun real-random (from to)
+  (cond ((= from to) from)
+          (t
+         (+ from 
+           (* (random 10000)
+              0.0001
+              (- to from))))))
+
+
+;; sound2 -- like SOUND but operates on stereo signal
+;;
+(defun sound2 (a)
+  (cond ((eq (type-of a) 'array)
+         (vector (sound (aref a 0)) (sound (aref a 1))))
+        (t
+         (sound a))))
+
+
+(defun monoize (v)
+ (cond ((eq (type-of v) 'array) (aref v 0))
+       (t v)))
+
+;; ==================================================================
+;; sf-granulate -- granular synthesis applied to file
+;;
+;; filename -- name of the file
+;; grain-dur -- the duration of a grain
+;; grain-dev -- grain dur is actually grain-dur + random(0, grain-dev)
+;; ioi -- the basic inter-onset-interval for grains
+;; ioi-dev -- ioi is actually: ioi + random(0, ioi-dev)
+;; pitch-dev -- grains are resampled at rate between 1 and pitch-dev
+;; file-start -- when to start reading the file (an offset from start)
+;; file-end -- when to stop reading the file (an offset from end)
+;; 
+;; NOTES: the number of grains is based on an average grain spacing
+;;  of (ioi + ioi-dev/2). The step through the file is computed
+;;  by dividing the duration (file-start - file-end) by number of
+;;  grains.
+;;
+(defun sf-granulate (filename grain-dur grain-dev ioi ioi-dev pitch-dev 
+                     &optional (file-start 0) (file-end 0))
+  (let (orig n step-size
+        (avg-ioi (+ ioi (/ ioi-dev 2.0)))
+        (file-dur (sf-dur filename))
+        (dur (get-duration 1)))
+    (setf n (truncate (/ dur avg-ioi)))
+    (cond ((< file-dur file-start)
+           (error "sf-granulate: file-start is after end of file!"))
+          ((< file-dur file-end)
+           (error "sf-granulate: file-end (offset) exceeds file duration!"))
+          ((< file-dur (+ file-start file-end))
+           (error "sf-granulate: file-start + file-end > file duration!")))
+    (setf file-dur (- file-dur file-start file-end))
+    (setf step-size (/ file-dur n))
+    ;(display "sf-granulate" step-size file-dur n)
+    (stretch-abs 1.0
+     (set-logical-stop
+      (seqrep (i n)
+        (let* ((actual-grain-dur
+               (real-random grain-dur (+ grain-dur grain-dev)))
+              (env (stretch actual-grain-dur (one-minus-cosine)))
+              (pitch-ratio (real-random 1.0 pitch-dev)))
+        ;(display "gran" (local-to-global 0) i pitch-ratio)
+        (set-logical-stop
+          (force-srate *sound-srate*
+            (stretch pitch-ratio
+              (sound2
+                (mult (cue env)
+                      (s-read filename 
+                              :time-offset (+ file-start (* step-size i))
+                              :dur actual-grain-dur)))))
+          (real-random ioi (+ ioi ioi-dev)))))
+      dur))))
+
+;;============================================================================
+;; Here is a sample application of sf-granulate.
+;; Notice that I am using simrep to mix four copies of sf-granulate output.
+;; Since there are random timings involved, the layers are not identical.
+;;
+(setf *granfile* "../demos/demo-snd.aiff")
+
+(defun gran-test ()
+  (play (stretch 4
+          (simrep (i 4)
+            (sf-granulate *granfile* 0.04 0.0 0.02 0.001 2.0 0 0)))))
+
+
+(print "Set *granfile* and then call gran-test for an example")
+
diff --git a/lib/grapheq.lsp b/lib/grapheq.lsp
new file mode 100644
index 0000000..413056b
--- /dev/null
+++ b/lib/grapheq.lsp
@@ -0,0 +1,74 @@
+; basic 4 band equalizer with cuts at 4k, 2k, 1k, and 630 hertz.
+; designed as a test
+;(defun 4band (s f630 f1k f2k f4k) 
+;  (eq-band 
+;   (eq-band 
+;    (eq-band 
+;     (eq-band s 
+;	      630 f630 0.33) 
+;     1000 f1k 0.33) 
+;    2000 f2k 0.33)
+;   4000 f4k 0.33))
+
+(setf *grapheq-loaded* t)
+
+;; inf-const -- stretch a number into an "infinite" signal
+;; Nyquist does not have infinite signals, so just make it very long
+;; ny:all is a large number of samples, so use it as the length in samples
+;;
+(defun inf-const (x)
+  (stretch-abs (/ ny:all *default-sound-srate*)
+               (const x)))
+
+; n-band graphic eq with variable range.
+; sig - input signal
+; gains - vector of gain changes in dB
+; lowf - lower eq band limit
+; highf - upper eq band limit
+(defun nband-range (sig gains lowf highf)
+  (let ((bandsep ;; bandwidth of each channel in steps
+	     (/ (- (hz-to-step highf) (hz-to-step lowf)) (length gains)))
+	    lowstep ;; low frequency in steps
+	    (newsnd sig)
+        (chans (length gains)))
+    (setf lowstep (+ (hz-to-step lowf) (* 0.5 bandsep)))
+    (cond ((< bandsep 0)
+	       (error "band width must be greater than 0"))
+      	  (t
+           (dotimes (i chans newsnd)
+             ;; gains[i] can be either a number or a signal
+             (cond ((numberp (aref gains i))
+		            (cond ((not (zerop (aref gains i)))
+				           (setf newsnd
+				                 ;; note: gain in dB
+                                 (eq-band newsnd
+                                          (step-to-hz (+
+                                                       (* i bandsep)
+                                                       lowstep))
+                                          (aref gains i)
+                                          (/ bandsep 12))))))
+                   (t
+                    (setf newsnd
+                          (eq-band newsnd
+	                               (inf-const (step-to-hz (+
+					                                       (* i bandsep)
+		                                                   lowstep)))
+                                   (aref gains i)
+					               (inf-const (/ bandsep 12)))))))))))
+
+
+; nband eq without variable range
+; wraps around nband-vl with standard limits
+(defun nband (sig gains)
+  (nband-range sig gains 20 20000)
+)	
+       
+
+; simple test demo
+;(play (nband-vl (noise 1) '(-6 0 0 0 0 0 0 6 0 0 0 0 0 0 0 0 0 0 0 0) 20 20000))
+
+; variable gain demo
+;(play (nband-vl (noise 1) '(0 0 0 0 0 0 (pwl 0 0 .9 10 1) 0 0 0 0 0 0 0 0 0 0 (pwl 0 -10 .9 10 1) (pwl 0 -10 .9 10 1) (pwl 0 -10 .9 10 1) (pwl 0 -10 .9 10 1) 0 0 0 0) 20 20000))
+
+; test of adjacent band cuts
+;(play (nband-vl (noise 1) '(0 0 0 0 0 0 0 0 0 0 6 6 6 0 0 0 -6 -6 0 0 0 0) 20 20000))
diff --git a/lib/instruments.txt b/lib/instruments.txt
new file mode 100644
index 0000000..f0f5d09
--- /dev/null
+++ b/lib/instruments.txt
@@ -0,0 +1,249 @@
+Tones:shiver(float dur = 1.0 (0.1:9.9),
+                     int pitch = 72 (48:96),
+		     int noise-percent = 50 (0:100),
+		     float noise-freq = 100 (20:480))
+REQUIRE "../demos/pmorales/a4.lsp"
+END-SOUND
+
+Tones:cheap(float frq-randi = 100 (0.0:1000.0),
+                   int pitch = 69 (48:96),
+		   float dur = 2.0 (0.1:9.9),
+                   float rate = 3.0 (0.1:9.9),
+		   float amount = 1000.0 (100.0:9900.0))
+REQUIRE "../demos/pmorales/a6.lsp"
+END-SOUND
+
+Percussion:gong-1()
+REQUIRE "../demos/pmorales/b1.lsp"
+END-SOUND
+
+
+Percussion:gong-2()
+REQUIRE "../demos/pmorales/b1.lsp"
+END-SOUND
+
+
+Percussion:gong-3(int freq = 440 (200:800),
+                          float dur = 5.0 (2.0:10.0))
+REQUIRE "../demos/pmorales/b1.lsp"
+END-SOUND
+
+
+Percussion:gong-3-melody()
+REQUIRE "../demos/pmorales/b1.lsp"
+END-SOUND
+
+Percussion:plight-drum-example()
+LISP-SOURCE
+(if (not (boundp ' *plight-drum-path*))
+    (cond ((not (load "../demos/plight/drum.lsp"))
+           (princ "COULD NOT FIND DRUM.LSP -- THE PLIGHT-DRUM PACKAGE IS
+NOT PART OF THE BASIC NYQUIST DISTRIBUTION, BUT
+YOU CAN DOWNLOAD IT")
+           nil)))
+SAL-SOURCE
+if ! boundp(quote(*plight-drum-path*)) then
+  if ! #load("../demos/plight/drum.lsp") then
+    exec princ("COULD NOT FIND DRUM.LSP -- THE PLIGHT-DRUM PACKAGE IS
+NOT PART OF THE BASIC NYQUIST DISTRIBUTION, BUT
+YOU CAN DOWNLOAD IT")
+END-SOUND
+
+Tones:st-sac(int pitch = 67 (48:96),
+                     float dur = 4.0 (0.1:9.9),
+		     float offset-entry = 1.25 (0.1:3.9),
+                     int num-harmonics = 8 (1:16))
+REQUIRE "../demos/pmorales/b2.lsp"
+END-SOUND
+
+
+Tones:st-sac-sequence()
+REQUIRE "../demos/pmorales/b2.lsp"
+END-SOUND
+
+
+Percussion:risset-bell(float amp = 1.0 (0.0:1.0),
+		       float dur = 4.0 (0.1:9.9),
+		       float frq = 440.0 (50.0:1950.0))
+REQUIRE "../demos/pmorales/b3.lsp"
+END-SOUND
+
+
+Percussion:risset-bell-sequence()
+REQUIRE "../demos/pmorales/b3.lsp"
+END-SOUND
+
+
+Tones:starship(float freq = 200.0 (100.0:900.0),
+	       float scale = 1000.0 (0.0:4000.0))
+REQUIRE "../demos/pmorales/b5.lsp"
+END-SOUND
+
+
+Tones:tibetan(float freq = 110 (25.0:575.0),
+              float offset = 0.03 (0.0:0.1),
+	      float dur = 10.0 (1.0:29.0),
+	      float rise = 1.0 (0.02:4.98),
+	      float dec = 4.0 (0.01:19.99))
+REQUIRE "../demos/pmorales/b7.lsp"
+END-SOUND
+
+
+Tones:tibetan-sequence()
+REQUIRE "../demos/pmorales/b7.lsp"
+END-SOUND
+
+
+Percussion:risset-drum(float amp = 1.0 (0.0:1.0),
+		       float dur = 1.0 (0.1:9.9),
+		       float freq = 100 (25.0:775.0))
+REQUIRE "../demos/pmorales/b8.lsp"
+END-SOUND
+
+
+Percussion:risset-drum-sequence()
+REQUIRE "../demos/pmorales/b8.lsp"
+END-SOUND
+
+
+Tones:risset-endless()
+REQUIRE "../demos/pmorales/b9.lsp"
+END-SOUND
+
+
+Vocal:buzz-ah[ah](int pitch = 36 (24:72),
+		  float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Vocal:buzz-ah[ah](int pitch = 36 (24:72),
+		  float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Vocal:buzz-eh[eh](int pitch = 36 (24:72),
+		  float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Vocal:buzz-eeh[eeh](int pitch = 36 (24:72),
+		    float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Vocal:buzz-ooh[ooh](int pitch = 36 (24:72),
+		    float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Vocal:buzz-demo[buzz-demo]()
+REQUIRE "../demos/pmorales/buzz.lsp"
+END-SOUND
+
+
+Tones:tenney(float frandi = 400 (100.0:1900.0),
+             float freq = 440 (100.0:1900.0),
+   	     float dur = 1 (0.1:9.9))
+REQUIRE "../demos/pmorales/c1.lsp"
+END-SOUND
+
+
+Tones:tenney-demo()
+REQUIRE "../demos/pmorales/c1.lsp"
+END-SOUND
+
+
+Tones:pluck(int pitch = 36 (24:72),
+	    float dur = 1 (0.1:9.9))
+END-SOUND
+
+
+FM:fm-bell(float freq = 150.0 (50.0:350.0),
+           float cm-ratio = 0.714286 (0.1:1.9),
+	   float imax = 10.0 (3.0:37.0),
+	   float dur = 5.0 (0.1:9.9),
+	   float amp = 1.0 (0.0:1.0))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+FM:fm-wood-drum[fm-w-d](int pitch = 62 (48:72))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+FM:fm-brass[fm-br](int pitch = 62 (48:84))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+FM:fm-clarinet[fm-c](int pitch = 67 (48:84))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+FM:double-carrier(float dur = 1.0 (0.1:9.9),
+	          float freq = 440.0 (60.0:1940.0),
+		  float cm-ratio = 1.0 (0.1:3.9),
+		  float amp = 1.0 (0.0:10.0),
+		  float amp-ratio = 0.5 (0.0:10.0),
+		  float imax = 3.0 (0.1:3.9),
+		  float imin = 1.0 (0.1:3.9),
+		  float modulator = 2.0 (0.0:10.0))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+FM:v-fm(int pitch = 67 (48:84),
+	float break = 0.3 (0.0:1.0),
+	float dur = 3.0 (1.0:10.0),
+	float rev = 0.5 (0.0:1.0))
+REQUIRE "../demos/pmorales/e2.lsp"
+END-SOUND
+
+
+Tones:bell-sequence()
+REQUIRE "../demos/pmorales/partial.lsp"
+END-SOUND
+
+
+Keyboard:dmhm-organ(int pitch = 70 (48:96))
+REQUIRE "../demos/mateos/organ.lsp"
+END-SOUND
+
+
+Keyboard:dmhm-organ-test()
+REQUIRE "../demos/mateos/organ.lsp"
+END-SOUND
+
+
+Percussion:dmhm-gong[dmhm-gong](int pitch = 57 (40:80))
+REQUIRE "../demos/mateos/gong.lsp"
+END-SOUND
+
+
+Brass:dmhm-tuba(float freq = 70 (30:170))
+REQUIRE "../demos/mateos/tuba.lsp"
+END-SOUND
+
+
+Percussion:dmhm-bell(int bell = 31 (24:60))
+REQUIRE "../demos/mateos/bell.lsp"
+END-SOUND
+
+
+Keyboard:piano[piano-note](float duration = 2 (0.1:9.9), 
+	                   int pitch = 70 (60:100),
+                           int dynamic = 50 (0:100))
+REQUIRE "pianosyn.lsp"
+END-SOUND
+
+
+Music:cellular-automation-demo[cell-aut-demo]()
+REQUIRE "../demos/allewis/cell_aut.lsp"
+END-SOUND
diff --git a/lib/lpc.lsp b/lib/lpc.lsp
new file mode 100644
index 0000000..5edecf7
--- /dev/null
+++ b/lib/lpc.lsp
@@ -0,0 +1,178 @@
+;---------------------------------------------------------------------
+; LPANAL. Performs LPC analysis
+;
+; snd        sound for analysis
+; an-dur     duration of analysis (= duration of sound)
+; skiptime   step frame to frame
+; npoles     number of poles
+;
+; RESULT:    analysis data in list format.
+;            Every element of the list is a list of the form
+;
+;            (RMS1 RMS2 ERR FILTER-COEFS)
+;
+;             RMS1  Energy (not rms value) of input signal
+;             RMS2  Energy (not rms value) of residual signal
+;             ERR   = sqrt(RMS2/RMS1) If it is small then VOICED sound,
+;                                     else UNVOICED
+;             FILTER-COEFS Array of filter coefs.
+;
+;
+;                The z transform of filter is  H(z) = 1/A(z)
+;                 
+;                where A(z) is a polynome of the form:
+;
+;
+;                A(z) = 1 + a1 z + a2 z^2 + a3 z^3 + ... + aP z^P
+;
+;             FILTER-COEFS is the array
+;
+;                  #(-aP -aP-1 -aP-2 ... a3 a2 a1)
+;
+;                 (this format is suited for the filter ALLPOLES)
+;
+
+(setfn lpc-frame-rms1 car)
+(setfn lpc-frame-rms2 cadr)
+(setfn lpc-frame-err caddr)
+(setfn lpc-frame-filter-coefs cadddr) 
+
+;; LPANAL-CLASS -- does lpc analysis. Frames are returned
+;;   from an iterator object
+
+(setf lpanal-class (send class :new '(sound framesize skipsize npoles)))
+
+(send lpanal-class :answer :isnew '(snd framedur skiptime np) '(
+  (let ((sr (snd-srate snd)))
+    (setf sound snd)
+    (setf framesize (round (* sr framedur)))
+    (setf skipsize (round (* sr skiptime)))
+    (setf npoles np))))
+
+(send lpanal-class :answer :next '() '(
+  (let ((samps (snd-fetch-array sound framesize skipsize)))
+    (cond ((null samps) nil)
+          (t 
+           (snd-lpanal samps npoles))))))
+
+(defun make-lpanal-iterator (sound framedur skiptime npoles)
+  (send lpanal-class :new (snd-copy sound) framedur skiptime npoles))
+  
+;; LPC-FILE-CLASS -- iterator returns frames from file
+;;
+(setf lpc-file-class (send class :new '(file)))
+
+(send lpc-file-class :answer :isnew '(filename) '(
+  (setf file (open filename))))
+
+(send lpc-file-class :answer :next '() '(
+  (read file)))
+
+(defun make-lpc-file-iterator (filename)
+  (send lpc-file-class :new filename))
+
+
+;; SAVE-LPC-FILE -- create a file from an iterator. This file can
+;; be turned back into an iterator using make-lpc-file-iterator.
+;;
+(defun save-lpc-file (lpc-iterator filename)
+  (let ((fp (open filename :direction :output))
+        (frame t))
+    (while frame
+      (setf frame (send lpc-iterator :next))
+      (if frame (format fp "~A~%" frame)))
+    (close fp)))
+
+
+
+;; SHOW-LPC-DATA. Show values of LPC analysis frames from interator.
+;;
+(defun show-lpc-data (lpc-iterator iniframe endframe &optional (poles? NIL))
+  (dotimes (i iniframe) (send lpc-iterator :next))
+  (dotimes (i (- endframe iniframe))
+    (let ((frame (send lpc-iterator :next)))
+      (cond ((null frame) (return))
+            (poles?
+             (format t "FRM ~A : ~A\n" (+ i iniframe) frame))
+            (t
+             (format t "FRM ~A : ~A\n" (+ i iniframe) 
+                     (reverse (cdr (reverse frame)))))))))
+                         
+
+;----------------------------------------------------------------------
+; LPC-FREQ. Show frequency response of ALLPOLES filter.
+;           NEEDS MATLAB or OCTAVE
+;
+;
+; HELPER FUNS :  GET-FILTER-COEFS from a LPC analysis data
+;                       lpc-data:   data generated by LPCANAL
+;                       numframe:   index of frame data
+;
+;                LPC-COEFS-TO-MATLAB : transforms LPC coefs format to Matlab format
+;
+; LPC-FREQ.
+;
+;           varname : the name of variable that holds coef array in MATLAB
+;           lpc-data : as above
+;           numframe : as above
+;
+
+
+; THIS CODE TO GET FREQUENCY ASSUMES AN ARRAY OF LPC FRAMES AND REQUIRES
+; MATLAB OR OCTAVE. I HAVE NOT ADAPTED THIS TO USE THE STREAM OF FRAMES
+; APPROACH. -RBD
+;
+;(defun get-filter-coefs (lpc-data numframe)
+;  (nth 3 (aref lpc-data numframe)))
+;
+;
+;(defun lpc-coefs-to-matlab (lpc-data numframe)
+;  (let* ((lpc-coefs (get-filter-coefs lpc-data numframe))
+;         (lencoefs (length lpc-coefs))
+;         (result (make-array (1+ lencoefs))))
+;    (setf (aref result 0) 1.0)
+;    (dotimes (i lencoefs)
+;      (setf (aref result (1+ i))
+;            (- (aref lpc-coefs (- lencoefs i 1)))))
+;    result))
+;
+;
+;(defun lpc-freq (varname lpc-data numframe)
+;  (octave (list (list (lpc-coefs-to-matlab lpc-data numframe) varname 'ARR))))
+
+ 
+;----------------------------------------------------------------------------
+; ALLPOLES
+;
+; THIS VERSION IS FOR ARRAY OF FRAMES
+;
+;(defun get-allpoles-gain (lpc-data numframe)
+;  (nth 2 (aref lpc-data numframe)))      ; se toma ERR para que la amplitud de
+;                                         ; la salida se aproxime a 1
+;
+;(defun allpoles-from-lpc (snd lpc-data numframe)
+;   (snd-allpoles snd (get-filter-coefs lpc-data numframe) (get-allpoles-gain lpc-data numframe)))
+
+; ALLPOLES USES A SINGLE FRAME TO CREATE A FILTER
+;
+; We introduce two functions: 
+;   NTH-FRAME runs the interator to get the nth frame;
+;   ALLPOLES-FROM-LPC filters a sound given a frame from an iterator
+
+;; NTH-FRAME - get the nth frame from lpc iterator, 
+;;    first frame is numbered zero
+(defun nth-frame (lpc-iterator numframe)
+  (dotimes (i numframe) (send lpc-iterator :next))
+  (send lpc-iterator :next))
+
+
+;; ALLPOLES-FROM-LPC -- filter a sound using an LPC frame
+;;
+(defun allpoles-from-lpc (snd lpc-frame)
+  (snd-allpoles snd (lpc-frame-filter-coefs lpc-frame) 
+                    (lpc-frame-err lpc-frame))) ;; use ERR for gain
+
+;-------------------------------------------------------------------------------
+; LPRESON
+
+(setfn lpreson snd-lpreson)
diff --git a/lib/midishow.lsp b/lib/midishow.lsp
new file mode 100644
index 0000000..d33d004
--- /dev/null
+++ b/lib/midishow.lsp
@@ -0,0 +1,48 @@
+(defun midi-show-file (score-name &optional (out-file t))
+  (let ((infile (open-binary score-name :direction :input)))
+    (setf my-seq (seq-create))
+    (seq-read-smf my-seq infile)
+    (close infile)
+    (midi-show my-seq out-file)))
+
+
+;iterate over midi sequence and prints events
+;
+(defun midi-show (the-seq &optional (out-file t))
+  (prog (event)
+    (seq-reset the-seq)
+loop
+    (setf event (seq-get the-seq))
+    (if (eq (car event) seq-done-tag)
+        (go exit))
+    (midi-show-event event out-file)
+    (seq-next the-seq)
+    (go loop)
+exit
+  ))
+
+; midi-show-event -- ascii format an event
+;
+(defun midi-show-event (ev file)
+  (let ((tag (seq-tag ev)))
+    (cond ((= tag seq-note-tag)
+               (format file "Note@~A ch:~A pitch:~A vel:~A line:~A dur:~A~%"
+                           (seq-time ev) (seq-channel ev) (seq-pitch ev) (seq-velocity ev)
+                           (seq-line ev) (seq-duration ev)))
+              ((= tag seq-ctrl-tag)
+               (format file "Ctrl@~A ch:~A num:~A val:~A line:~A~%"
+                                  (seq-time ev) (seq-channel ev) (seq-control ev)
+                                  (seq-value ev) (seq-line ev)))
+              ((= tag seq-touch-tag)
+               (format file "Aftr@~A ch:~A val:~A line:~A~%"
+                                  (seq-time ev) (seq-channel ev) (seq-touch ev) (seq-line ev)))
+              ((= tag seq-bend-tag)
+               (format file "Bend@~A ch:~A val:~A line:~A~%"
+                                  (seq-time ev) (seq-channel ev) (seq-bend ev) (seq-line ev)))
+              ((= tag seq-prgm-tag)
+               (format file "Prgm@~A ch:~A num:~A line:~A~%"
+                                  (seq-time ev) (seq-channel ev) (seq-program ev) (seq-line ev)))
+              ((= tag seq-other-tag)
+               (format file "Othr~%"))
+              (t
+               (format file "????: ~A~%" ev)))))
diff --git a/lib/moog.lsp b/lib/moog.lsp
new file mode 100644
index 0000000..25d4f71
--- /dev/null
+++ b/lib/moog.lsp
@@ -0,0 +1,146 @@
+;Stephen Mangiat
+;15-392 Final Project
+;Moog Instrument
+
+
+;Moog Instrument: Main Function
+(defun moog (s &key
+	(range-osc1 2)
+	(range-osc2 1)
+	(range-osc3 3)
+	(detun2 -.035861)
+	(detun3 .0768)
+	(noiselevel .05)
+	(filter-cutoff 768)
+	(Q 2)
+	(contour .65)
+	(filter-attack .0001)
+	(filter-decay .5)
+	(filter-sustain .8)
+	(shape-osc1 *saw-table*)
+	(shape-osc2 *saw-table*)
+	(shape-osc3 *saw-table*)
+	(volume-osc1 1)
+	(volume-osc2 1)
+	(volume-osc3 1)
+	(amp-attack .01)
+	(amp-decay 1)
+	(amp-sustain 1)
+	(amp-release 0)
+	(glide 0))
+
+	(cond ((eq glide 0)	(setf cv (score-to-cv s)))
+	(t (setf cv (lp (score-to-cv s) (+ .1 (recip glide))))))
+
+	(cond ((< range-osc1 2) (setf freq1 cv))
+	(t (setf freq1 (mult cv (mult (- range-osc1 1) 2)))))
+
+	(cond ((< range-osc2 2) (setf freq2temp cv))
+	(t (setf freq2temp (mult cv (mult (- range-osc2 1) 2)))))
+
+	(cond ((< range-osc3 2) (setf freq3temp cv))
+	(t (setf freq3temp (mult cv (mult (- range-osc3 1) 2)))))
+
+	(setf freq2 (mult freq2temp (1+ (mult detun2 .0596))))
+	(setf freq3 (mult freq3temp (1+ (mult detun3 .0596))))
+
+	(setf osc1 (hzosc freq1 shape-osc1))
+	(setf osc2 (hzosc freq2 shape-osc2))
+	(setf osc3 (hzosc freq3 shape-osc3))
+
+	(setf mix1 (sum (scale volume-osc1 osc1) 
+		(scale volume-osc2 osc2) (scale volume-osc3 osc3)))
+
+	(setf ampenv (score-to-env-trig s 0 0 0 amp-attack amp-decay 	amp-sustain amp-release))
+	; noise should be infinite. I hope 10000s is close enough.
+	(setf mix2 (sum mix1 (scale noiselevel (noise 10000))))
+
+	(setf durSum 0)
+	(setf cutoffenv (score-to-filter-trig s 0 0 0 
+		filter-cutoff Q contour filter-attack filter-decay filter-sustain))
+	(setf bandwidth (mult (recip Q) cutoffenv))
+
+	(setf mix3 (reson mix2 cutoffenv bandwidth 2))
+	(setf mix4 (mult mix3 ampenv))
+)
+
+; Convert input list into Control Voltages
+(defun score-to-cv (s) 
+	(cond ((cdr s)
+	(seq (const (step-to-hz (caar s)) (cadar s)) (score-to-cv (cdr s))))
+	(t (const (step-to-hz (caar s)) (cadar s))))
+)
+
+; Helper functions used to maintain continuity in envelopes
+(defun last-value (env1 info)
+	(sref env1 (- (cadr info) (recip 2205))))
+(defun last-value-2 (env1 info)
+	(sref env1 (- info (recip 2205))))
+
+
+; Create filter cutoff frequencies for Control Voltages
+(defun score-to-filter-trig (s start dur-prev art-prev filter-cutoff Q contour attack decay sust)
+	(let (env1 finish)
+	(cond ((cdr s) (setf env1
+	(make-filter start (car s) dur-prev art-prev filter-cutoff Q contour attack decay sust))
+	(setf finish (last-value env1 (car s)))
+	(seq (mult env1 (const 1 (cadar s)))
+	(score-to-filter-trig (cdr s) finish (cadar s) (caddr (car s)) filter-cutoff Q contour attack decay sust)))
+	(t (make-filter start (car s) dur-prev art-prev filter-cutoff Q contour attack decay sust)))))
+
+(defun make-filter (start info dur-prev art-prev filter-cutoff Q contour attack decay sust)
+	(let ((dur (cadr info)) (art (caddr info)))
+	(setf highF (sum (mult 10000 contour) filter-cutoff))
+	(setf sust1 (mult sust filter-cutoff))
+	(cond ((eq art-prev 1)
+		(setf durSum (+ durSum dur-prev))
+		(cond ((> attack durSum)
+		(mult (const 1 dur) (pwl 0 start (- attack durSum) highF (+ (- attack dur-prev) decay) sust1 dur 		sust1)))
+
+	((> (+ attack decay) durSum)
+		(mult (const 1 dur) (pwl 0 start (- (+ attack decay) durSum) sust1 dur sust1)))
+	
+		(t (const sust1 dur))))
+	(t (setf durSum 0) (mult (const 1 dur) (pwl 0 0 attack highF (+ decay attack) sust1 dur sust1))))))
+
+; Create amplitude envelope for Control Voltages
+(defun score-to-env-trig (s start dur-prev art-prev attack decay sust release)
+	(let (env1 finish)
+	(cond ((cdr s) (setf env1
+		(make-env-trig start (car s) dur-prev art-prev attack decay sust release))
+		(setf finish (last-value env1 (car s)))
+		(seq (mult env1 (const 1 (cadar s)))
+	(score-to-env-trig (cdr s) finish (cadar s) (caddr (car s)) attack decay sust release)))
+	(t (make-env-trig start (car s) dur-prev art-prev attack decay sust release)))))
+
+; Make individual amplitude envelopes. Case checking needed if attack/decay are longer than notes.
+(defun make-env-trig (start info dur-prev art-prev attack decay sust release)
+	(let ((dur (cadr info)) (art (caddr info)))
+
+	(cond ((eq art-prev 1)
+		(cond ((> (+ attack decay) dur-prev)
+			(cond ((> (- (+ attack decay) dur-prev) (* dur art))
+				(setf art-cutoff (seq (const 1 (* dur art)) (const 0 (- dur (* dur art)))))
+				(setf env1 (mult (const 1 dur) (pwl 0 start (- (+ attack decay)
+				 dur-prev) sust (* dur art) sust (+ (* dur art) release) 0 dur 0)))
+				(setf env2 (mult art-cutoff env1))
+				(mult (const 1 dur)
+				(sum env2 (pwl 0 0 (* dur art) 0 (+ (* dur art) .00001) 
+				(last-value-2 env2 (* dur art)) (+ (* dur art) release) 0 dur 0))))
+	
+			(t (mult (const 1 dur)
+			 (pwl 0 start (- (+ attack decay) dur-prev)
+	 		sust (* dur art) sust (+ (* dur art) release) 0 dur 0)))))
+		(t  (mult (const 1 dur) (pwl 0 start (* dur art) sust (+(* dur art) release) 0 dur 0)))))
+
+	(t  (cond ((> (+ attack decay) (* dur art))
+		(setf art-cutoff (seq (const 1 (* dur art)) (const 0 (- dur (* dur art)))))
+		(setf env1 (pwl 0 start attack 1 (+ attack decay) sust (* dur art) sust 
+		(+(* dur art) release) 0 dur 0))
+		(setf env2 (mult art-cutoff env1))
+		(mult (const 1 dur)
+		(sum env2 (pwl 0 0 (* dur art) 0 (+ (* dur art) .00001) 
+		(last-value-2 env2 (* dur art)) (+ (* dur art) release) 0 dur 0))))
+		(t (mult  (const 1 dur)
+		(pwl 0 start attack 1 (+ attack decay) sust (* dur art) 
+		sust (+(* dur art) release) 0 dur 0))))))))
\ No newline at end of file
diff --git a/lib/piano/att11025.pcm b/lib/piano/att11025.pcm
new file mode 100644
index 0000000..683834f
--- /dev/null
+++ b/lib/piano/att11025.pcm
diff --git a/lib/piano/att16000.pcm b/lib/piano/att16000.pcm
new file mode 100644
index 0000000..60d8e68
--- /dev/null
+++ b/lib/piano/att16000.pcm
diff --git a/lib/piano/att22050.pcm b/lib/piano/att22050.pcm
new file mode 100644
index 0000000..9e0e037
--- /dev/null
+++ b/lib/piano/att22050.pcm
diff --git a/lib/piano/att32000.pcm b/lib/piano/att32000.pcm
new file mode 100644
index 0000000..06f9818
--- /dev/null
+++ b/lib/piano/att32000.pcm
diff --git a/lib/piano/att44100.pcm b/lib/piano/att44100.pcm
new file mode 100644
index 0000000..17030ea
--- /dev/null
+++ b/lib/piano/att44100.pcm
diff --git a/lib/piano/att48000.pcm b/lib/piano/att48000.pcm
new file mode 100644
index 0000000..3482270
--- /dev/null
+++ b/lib/piano/att48000.pcm
diff --git a/lib/piano/att8000.pcm b/lib/piano/att8000.pcm
new file mode 100644
index 0000000..4956f72
--- /dev/null
+++ b/lib/piano/att8000.pcm
diff --git a/lib/piano/demo.mid b/lib/piano/demo.mid
new file mode 100644
index 0000000..472dc6b
--- /dev/null
+++ b/lib/piano/demo.mid
diff --git a/lib/piano/demo.mp3 b/lib/piano/demo.mp3
new file mode 100644
index 0000000..b4a84d9
--- /dev/null
+++ b/lib/piano/demo.mp3
diff --git a/lib/piano/dur.tab b/lib/piano/dur.tab
new file mode 100644
index 0000000..fff61a9
--- /dev/null
+++ b/lib/piano/dur.tab
diff --git a/lib/piano/gmax.tab b/lib/piano/gmax.tab
new file mode 100644
index 0000000..8c586ac
--- /dev/null
+++ b/lib/piano/gmax.tab
diff --git a/lib/piano/pn00.cod b/lib/piano/pn00.cod
new file mode 100644
index 0000000..0f3d840
--- /dev/null
+++ b/lib/piano/pn00.cod
diff --git a/lib/piano/pn01.cod b/lib/piano/pn01.cod
new file mode 100644
index 0000000..f099282
--- /dev/null
+++ b/lib/piano/pn01.cod
diff --git a/lib/piano/pn02.cod b/lib/piano/pn02.cod
new file mode 100644
index 0000000..139c77d
--- /dev/null
+++ b/lib/piano/pn02.cod
diff --git a/lib/piano/pn03.cod b/lib/piano/pn03.cod
new file mode 100644
index 0000000..5ed165d
--- /dev/null
+++ b/lib/piano/pn03.cod
diff --git a/lib/piano/pn04.cod b/lib/piano/pn04.cod
new file mode 100644
index 0000000..0cb4665
--- /dev/null
+++ b/lib/piano/pn04.cod
diff --git a/lib/piano/pn05.cod b/lib/piano/pn05.cod
new file mode 100644
index 0000000..36087cc
--- /dev/null
+++ b/lib/piano/pn05.cod
diff --git a/lib/piano/pn06.cod b/lib/piano/pn06.cod
new file mode 100644
index 0000000..5ed27a4
--- /dev/null
+++ b/lib/piano/pn06.cod
diff --git a/lib/piano/pn07.cod b/lib/piano/pn07.cod
new file mode 100644
index 0000000..11933b8
--- /dev/null
+++ b/lib/piano/pn07.cod
diff --git a/lib/piano/pn08.cod b/lib/piano/pn08.cod
new file mode 100644
index 0000000..37c13f3
--- /dev/null
+++ b/lib/piano/pn08.cod
diff --git a/lib/piano/pn09.cod b/lib/piano/pn09.cod
new file mode 100644
index 0000000..60c000d
--- /dev/null
+++ b/lib/piano/pn09.cod
diff --git a/lib/piano/pn10.cod b/lib/piano/pn10.cod
new file mode 100644
index 0000000..03dcad3
--- /dev/null
+++ b/lib/piano/pn10.cod
diff --git a/lib/piano/pn11.cod b/lib/piano/pn11.cod
new file mode 100644
index 0000000..4e77387
--- /dev/null
+++ b/lib/piano/pn11.cod
diff --git a/lib/piano/pn12.cod b/lib/piano/pn12.cod
new file mode 100644
index 0000000..c345aac
--- /dev/null
+++ b/lib/piano/pn12.cod
diff --git a/lib/piano/pn13.cod b/lib/piano/pn13.cod
new file mode 100644
index 0000000..473d1e4
--- /dev/null
+++ b/lib/piano/pn13.cod
diff --git a/lib/piano/pn14.cod b/lib/piano/pn14.cod
new file mode 100644
index 0000000..64cce3b
--- /dev/null
+++ b/lib/piano/pn14.cod
diff --git a/lib/piano/pn15.cod b/lib/piano/pn15.cod
new file mode 100644
index 0000000..732cc99
--- /dev/null
+++ b/lib/piano/pn15.cod
diff --git a/lib/piano/pn16.cod b/lib/piano/pn16.cod
new file mode 100644
index 0000000..54c0cdb
--- /dev/null
+++ b/lib/piano/pn16.cod
diff --git a/lib/piano/pn17.cod b/lib/piano/pn17.cod
new file mode 100644
index 0000000..6e2c4b6
--- /dev/null
+++ b/lib/piano/pn17.cod
diff --git a/lib/piano/pn18.cod b/lib/piano/pn18.cod
new file mode 100644
index 0000000..a1120a7
--- /dev/null
+++ b/lib/piano/pn18.cod
diff --git a/lib/piano/pn19.cod b/lib/piano/pn19.cod
new file mode 100644
index 0000000..45a08d8
--- /dev/null
+++ b/lib/piano/pn19.cod
diff --git a/lib/piano/pn20.cod b/lib/piano/pn20.cod
new file mode 100644
index 0000000..dbef4ac
--- /dev/null
+++ b/lib/piano/pn20.cod
diff --git a/lib/piano/pn21.cod b/lib/piano/pn21.cod
new file mode 100644
index 0000000..e6a4cb2
--- /dev/null
+++ b/lib/piano/pn21.cod
diff --git a/lib/piano/pn22.cod b/lib/piano/pn22.cod
new file mode 100644
index 0000000..b485ba0
--- /dev/null
+++ b/lib/piano/pn22.cod
diff --git a/lib/piano/rls11025.pcm b/lib/piano/rls11025.pcm
new file mode 100644
index 0000000..a1ff3b2
--- /dev/null
+++ b/lib/piano/rls11025.pcm
diff --git a/lib/piano/rls16000.pcm b/lib/piano/rls16000.pcm
new file mode 100644
index 0000000..cef5c5a
--- /dev/null
+++ b/lib/piano/rls16000.pcm
diff --git a/lib/piano/rls22050.pcm b/lib/piano/rls22050.pcm
new file mode 100644
index 0000000..28f94c6
--- /dev/null
+++ b/lib/piano/rls22050.pcm
diff --git a/lib/piano/rls32000.pcm b/lib/piano/rls32000.pcm
new file mode 100644
index 0000000..83f313d
--- /dev/null
+++ b/lib/piano/rls32000.pcm
diff --git a/lib/piano/rls44100.pcm b/lib/piano/rls44100.pcm
new file mode 100644
index 0000000..7529631
--- /dev/null
+++ b/lib/piano/rls44100.pcm
diff --git a/lib/piano/rls48000.pcm b/lib/piano/rls48000.pcm
new file mode 100644
index 0000000..a92c93d
--- /dev/null
+++ b/lib/piano/rls48000.pcm
diff --git a/lib/piano/rls8000.pcm b/lib/piano/rls8000.pcm
new file mode 100644
index 0000000..3fd2591
--- /dev/null
+++ b/lib/piano/rls8000.pcm
diff --git a/lib/piano/rlsrate.tab b/lib/piano/rlsrate.tab
new file mode 100644
index 0000000..2497478
--- /dev/null
+++ b/lib/piano/rlsrate.tab
diff --git a/lib/pianosyn.lsp b/lib/pianosyn.lsp
new file mode 100644
index 0000000..9bcdfa6
--- /dev/null
+++ b/lib/pianosyn.lsp
@@ -0,0 +1,579 @@
+;; ================================================
+;; Show Program Information
+;; ================================================
+(princ "\n\nPiano Synthesizer V1.2 (Feb 2004)\n")
+(princ "    Original algorithm and program by Zheng (Geoffrey) Hua\n")
+(princ "    and Jim Beauchamp, University of Illinois. Any publication\n")
+(princ "    or notes on any composition that utilizes this software\n")
+(princ "    should credit the original creators. Any software based on\n")
+(princ "    this algorithm should carry a similar notice and restriction.\n")
+(princ "    Ported to Nyquist from source code in M4C program by\n")
+(princ "    Ning Hu and Roger Dannenberg, Carnegie Mellon University\n")
+(princ "    School of Computer Science\n\n")
+(princ "    Program Initializing...\n")
+
+(setf *pianosyn-path* (current-path))
+
+;; ================================================
+;; Function definition
+;; ================================================
+(defun readdat (filename dim data)
+  (setf filename (strcat *pianosyn-path* "piano" 
+                         (string *file-separator*) filename))
+  (setq fp (open-binary filename :direction :input))
+  (dotimes (count 4) 
+    (setf (aref dim count) (read-int fp)))
+  (dotimes (count (aref dim 3))
+    (setf (aref data count) (read-float fp)))
+  (close fp))
+
+(defun build-harmonic-phase (n phase size)
+  (sound-srate-abs size (osc (hz-to-step n) 1 *sine-table* phase)))
+
+
+;; ******************************************
+;; *	Build envelope                      *
+;; ******************************************
+
+; after the initial envelope, which is stored in a table,
+; envelopes are extended by splicing together final segments
+; of the real envelope. The final segment is approximately
+; exponential, and so each copy of the segments that is
+; spliced is scaled by the amount of decay during the segment.
+; The long term shape will therefore be exactly exponential, but
+; we thought that a bit of variation rather than a perfectly 
+; smooth exponential decay might be better.
+;
+; This function takes a segment, the amount of decay in the
+; segment (the scale factor for the next segment) and a count
+; and builds an envelope
+;
+(defun decay-env (segment decay count)
+  (cond ((<= count 1) (cue segment))
+        (t (seq (cue segment) 
+                (scale decay (decay-env segment decay (1- count)))))))
+
+; PIANO-ENVELOPE builds the amplitude envelope for a group of partials.
+; igroup is the index of the group
+; sc-duration is the score duration
+; attack is the sampled portion of the envelope with a duration of 
+;     gmagendtime
+; seg-array is the repeating portion of the envelope tacked onto 
+;     attack to make the envelope longer. The duration of a segment
+;     in seg-array is gmagendtimemini
+; the amount by which seg-array[igroup] decays is scalemag1[igroup]
+;
+; Algorithm:
+;   figure out how many repetitions of the seq-array[igroup] to
+;   add onto the attack to make the envelope long enough. Multiply
+;   by an exponential decay starting at the duration -- effectively
+;   the damper hits the string at sc-duration.
+;
+(defun piano-envelope (igroup sc-duration gmagendtime gmagendtimemini 
+                       attack seg-array scalegmag1)
+  (let ((decaycount (1+ (truncate (/ (- (+ sc-duration endingtime) gmagendtime)
+                                     gmagendtimemini))))
+        pianoenv )
+  
+    (setf pianoenv 
+          (sim (at 0 (cue attack))
+               (at gmagendtime (decay-env (aref seg-array igroup) 
+                                          (aref scalegmag1 igroup) 
+                                          decaycount))))
+    ;; For ending time 
+    (mult (scale (aref scale1 igroup) pianoenv) 
+          (pwlv 1 sc-duration
+		; decay to 1/1000: about 60dB
+                1 (+ sc-duration endingtime) 0.001))))
+  
+ 
+;; ******************************************
+;; *	Build wavetable                     *
+;; ******************************************  
+(defun piano-group (jgroup sc-duration freq table)
+  (sound-srate-abs *piano-srate*
+    (osc (hz-to-step freq) sc-duration 
+         (aref table jgroup))))         
+
+;; ******************************************
+;; *	Produce single piano note           *
+;; ******************************************
+(defun piano-note (duration pitch dynamic)
+  (let ((ioi (get-duration duration))
+        (full-pitch (+ (get-transpose) pitch))
+        (full-dynamic (+ (get-loud) dynamic))
+        ;; note: the "loud" is nominally in dB, but
+        ;; piano-note-abs uses something akin to midi velocity
+        ;; we should probably work out a better conversion
+        (start-time (local-to-global 0))
+        on-dur)
+    (setf on-dur (* ioi (get-sustain)))
+    (set-logical-stop
+      (abs-env (at start-time 
+                   (piano-note-abs on-dur full-pitch full-dynamic)))
+      ioi)))
+
+
+;; PIANO-NOTE-ABS -- private function to do the work; assumes 
+;;    stretch factor of 1, etc.
+(defun piano-note-abs (sc-duration sc-pitch sc-dynamic)
+  (let (attnamp freq key whichone whichone1 ngroup1 ngroup2 dyna smax
+        dur gmagendtime gmagendtimemini k j envpoint)
+    ;; ******************************************
+    ;; *	Initilization for each note         *
+    ;; ******************************************
+    (setq attnamp 0.03) 
+    
+    ; key is midi pitch number 
+    (setq key (truncate (+ sc-pitch 0.000001)))
+    (cond ((< key 21) ;; 21 is A0, lowest pitch on this piano
+	   (break "piano-note-abs pitch is too low" sc-pitch)
+	   ;; continued -- transpose up to lowest octave
+	   (while (< key 21)
+             (setf sc-pitch (+ sc-pitch 12))
+	     (setf key (truncate (+ sc-pitch 0.000001)))))
+          ((> key 108) ;; 108 is c9, highest pitch on this piano
+	   (break "piano-note-abs pitch is too high" sc-pitch)
+	   ;; continued -- transpose down to highest octave
+           (while (> key 108)
+	     (setf sc-pitch (- sc-pitch 12))
+	     (setf key (truncate (+ sc-pitch 0.000001))))))
+    (setq freq (step-to-hz sc-pitch))
+	   
+    (setq whichone -2)
+    (dotimes (i GROUPCON)  
+        (if (and (= whichone -2)
+                 (< freq (- (aref fa i) 0.001)))
+            (setq whichone (- i 1))))
+    ;; Have to use (- (aref fa i) 0.001) because of the calculation precision of Nyquist
+           
+    (setq whichone1 (1+ whichone))
+    (setq ngroup2 (aref ngroup whichone1))
+
+    (setq dyna (truncate sc-dynamic))
+    (setq smax 0.25)
+        
+    ; (setq attnpretime (/ (+ (* 0.018 dyna dyna) (* -3.9588 dyna) 244.8139) 1000.0))
+    (setq dur (aref durtab (+ (* key 128) dyna)))
+    (setq ngroup1 (aref ngroup whichone))
+    (setq gmagendtime (* (nth whichone hkframe) (aref dt whichone))) 
+    (setq gmagendtimemini (* (aref nptsmini whichone) (aref dtmini whichone))) 
+
+    (setq k (* (aref gmaxtabdim 1) (aref gmaxtabdim 2)))
+    (setq j (+ (* whichone k) (* dyna (aref gmaxtabdim 2))))
+    (dotimes (i (aref gmaxtabdim 2))
+      (setf (aref gmax1 i) (aref gmaxtab j))
+      (incf j))
+
+    (dotimes (i ngroup1)
+      (setq envpoint (sref (aref (aref gmagmini whichone) i) 0))
+      (if (/= envpoint 0) 
+          (setf (aref scalegmag1 i) 
+                (/ (sref (aref (aref gmagmini  whichone) i)
+                         (- gmagendtimemini (aref dtmini whichone)))
+                   envpoint))        
+          (setf (aref scalegmag1 i) 0.0))
+      (setf (aref scale1 i) (* smax (aref gmax1 i))))
+    (if (> ngroup2 ngroup1) (setf ngroup2 ngroup1))
+
+    (if (< dur sc-duration) (setq sc-duration dur))
+    ;; **********************
+    ;; * now sum the groups *
+    ;; **********************      
+    (scale 0.5 
+        (sim (at 0 (set-logical-stop (cue (scale attnamp attsound)) sc-duration))
+            (at 0 (cue (simrep (i ngroup2)
+                            (mult (piano-envelope i sc-duration gmagendtime 
+                                   gmagendtimemini (aref (aref gmag whichone) i) 
+                                   (aref gmagmini whichone) scalegmag1)
+                                  (piano-group i (+ sc-duration endingtime) freq 
+                                   (aref wavetab whichone1)))))))) ))
+;;;;; This is for debugging -- replace synthesis with a sine tone to study envelope
+;             (at 0 (cue (mult (piano-envelope 0 sc-duration gmagendtime 
+;                                    gmagendtimemini (aref (aref gmag whichone) 0) 
+;                                    (aref gmagmini whichone) scalegmag1)
+;                              (osc c4 2.0))))))))
+
+       
+(defun piano-note-2 (sc-pitch sc-dynamic)
+  (let ((dur (get-duration 1)))
+    (stretch-abs 1 (piano-note dur sc-pitch sc-dynamic))))
+
+
+(defun piano-midi (midiin)
+  (let (midi-seq midifile)
+    (setf midi-seq (seq-create))
+    (setf midifile (open-binary midiin))
+    (seq-read-smf midi-seq midifile)
+    (close midifile)
+    (seq-midi midi-seq
+        (note (channel pitch velocity)
+          (piano-note-2 pitch velocity)))))
+
+
+;; ******************************************
+;; *Produce wave file according to MIDI file*
+;; ******************************************
+(defun piano-midi2file (midiin out-name)
+    (princ "\nBegin sound production\n")
+    (princ "=============================================\n")
+    (s-save (piano-midi midiin) 
+            ny:all (string out-name) :play T) 
+    (princ "=============================================\n")
+    (princ "End sound production\n"))
+ 
+
+;; ====================================
+;; Main Program       
+;; ====================================
+(if (not (boundp '*piano-srate*)) ;; if pianosyn.lsp wasn't loaded already
+    (expand 70)) ;; we'll allocate a lot of nodes for data, so expand now
+(setf *pianosyn-save-gc-flag* *gc-flag*)
+(setf *gc-flag* nil) ;; we'll do a lot of gc, so turn off messages
+;; Definite some constant
+(setq NPITCH 22 GROUPCON 23)
+(setq MAXAMP 32767.0)
+(setq TWOPI (+ pi pi))
+(setq *piano-srate* *default-sound-srate*)
+(setq bits 32)
+;; 512 gives pretty good SNR for interpolated sines
+;; some tables will be larger: 512 is just the minimum
+(setq tabsize 512)
+
+;; For ending time, use 30 msec. (This was originally 0.1 msec, 
+;;    about 4 samples, but that's too short to avoid clicks.)
+;;    This not only must avoid clicks but it simulates the damper.
+;;    This is the time to decay to 0.001 of the original, so it's
+;;    actually quite a rapid decay.
+(setq endingtime 0.03)
+
+(setf hkframe (list 66 73 82 90 99 108 116 123 130 135 138 140 138 
+                    133 126 117 107 102 105 127 153 187 200))
+(setf attsratelist (list 8000 11025 16000 22050 32000 44100 48000))                     
+(setf gmax1 (make-array GROUPCON))
+(setf scalegmag1 (make-array GROUPCON))
+(setf scale1 (make-array GROUPCON))
+(setf wavetab (make-array GROUPCON))
+(setf ti (make-array GROUPCON))
+(setf tstep (make-array GROUPCON))
+(setf gmaxtabdim (make-array 4))
+(setf gmaxtab (make-array 64768))
+(setf durtabdim (make-array 4))
+(setf durtab (make-array 16384))
+(setf rlsratetabdim (make-array 4))
+(setf rlsratetab (make-array 11392))
+(setf fa (make-array GROUPCON))
+(setf dt (make-array GROUPCON))
+(setf ngroup (make-array GROUPCON))
+(setf npts (make-array GROUPCON))
+(setf gmag (make-array GROUPCON))
+(setf nhar (make-array GROUPCON))
+
+(setf gmagmini (make-array GROUPCON))
+(setf dtmini (make-array GROUPCON))
+(setf nptsmini (make-array GROUPCON))
+
+(setf cw (make-array GROUPCON))
+(setf phase (make-array GROUPCON))
+(setf hfrom (make-array GROUPCON))
+(setf hto (make-array GROUPCON))
+
+(setf *zero-table* (scale 0 (build-harmonic 1 tabsize)))
+
+;; =================================================
+;; run-once initilization: pianoActor construction  
+;; =================================================  
+(princ "\nBegin Instrument-wise initialization...\n")
+(princ "=======================================\n")
+(princ "Reading source files:\n")
+
+
+;; Read gmax.tab
+(readdat "gmax.tab" gmaxtabdim gmaxtab)
+
+;; Read dur.tab
+(readdat "dur.tab" durtabdim durtab)
+
+;; Read rlsrate.tab
+(readdat "rlsrate.tab" rlsratetabdim rlsratetab)
+
+;; Read cwxx.cwd
+(dotimes (pncount GROUPCON)
+  (format t "~A " pncount)
+  (setq filename (strcat "pn" 
+                         (string (int-char (+ (truncate (/ pncount 10)) 48)))
+                         (string (int-char (+ (rem pncount 10) 48)))
+                         ".cod"))
+  (setq filename (strcat *pianosyn-path* "piano"
+                         (string *file-separator*) filename))
+  (setq fp (open-binary filename))
+
+  ;; Read cwdHdr in cwxx.cwd
+  (setq cwdHdr-ckID (read-int fp) cwdHdr-type (read-int fp))  
+  ;; "CNDN" == 1129202766
+
+  ;; That is for "FORM"==cwdHdr-ckID
+  ;;(if (and (= cwdHdr-ckID 1179603533) (= cwdHdr-type 1129202766))
+  ;;    ()
+  ;;    (error "Error in reading chunk header."))  
+
+  ;;That is for "SYNC"==cwdHdr-ckID
+  (if (and (= cwdHdr-ckID 1398361667) (= cwdHdr-type 1129202766))
+      () 
+      (error "Error in reading chunk header."))
+
+  ;; Read COMMCK in cwxx.cwd
+  (setq COMMCK-ckID (read-int fp))
+  (if (= COMMCK-ckID 1129270605) () (error "COMMCK chunk not found."))
+  (setq COMMCK-fa (read-float fp) COMMCK-dt (read-float fp))
+  (setf (aref fa pncount) COMMCK-fa)
+  (setf (aref dt pncount) COMMCK-dt)
+  (setf (aref dtmini pncount) (* 10 COMMCK-dt))
+  (setq COMMCK-npts (read-int fp) COMMCK-ngroup (read-int fp))
+  (setf (aref npts pncount) COMMCK-npts)
+  (setf (aref nptsmini pncount) 
+        (truncate (/ (+ 9 (- COMMCK-npts (nth pncount hkframe))) 10)))
+  (setf (aref ngroup pncount) COMMCK-ngroup)
+
+  ;; Read DATACK in cwxx.cwd
+  (setq DATACK-ckID (read-int fp))  
+  (if (= DATACK-ckID 1346458196) () (error "DATACK chunk not found."))
+  (setf (aref nhar pncount) (read-int fp))
+  (setf (aref cw pncount) (make-array (aref nhar pncount)))
+  (setf (aref phase pncount) (make-array (aref nhar pncount)))
+  (dotimes (count (aref nhar pncount)) 
+           (setf (aref (aref cw pncount) count) (read-float fp)))
+  (dotimes (count (aref nhar pncount)) 
+           (setf (aref (aref phase pncount) count) (read-float fp)))
+
+  ;; Read GRUPCK in cwxx.cwd
+  (setq GRUPCK-ckID (read-int fp))  
+  (if (= GRUPCK-ckID 1196578128) () (error "GRUPCK chunk not found."))
+  (setf (aref hfrom pncount) (make-array (aref ngroup pncount)))
+  (setf (aref hto pncount) (make-array (aref ngroup pncount)))  
+  ;(display "reading grupck" (aref ngroup pncount) (aref nhar pncount) pncount)
+  (dotimes (count (aref ngroup pncount))   
+    (setf (aref (aref hfrom pncount) count)
+	  (read-float fp)))
+  (dotimes (count (aref ngroup pncount)) 
+    (setf (aref (aref hto pncount) count) (read-float fp)))
+
+  ;; Read GMAGCK in cwxx.cwd
+  (setq GMAGCK-ckID (read-int fp))  
+  (if (= GMAGCK-ckID 1196245319) 
+      ()
+      (error "GMAGCK chunk not found."))
+  (setq gmaghead (read-int fp))
+  (close fp)
+  (setf (aref gmag pncount) (make-array (aref ngroup pncount)))
+  (setq gmagrate (/ 1 (aref dt pncount)))  
+  (setq gmagdur (/ (nth pncount hkframe) gmagrate))
+
+  ; (display "gmagmini" pncount (aref ngroup pncount))
+  (setf (aref gmagmini pncount) (make-array (aref ngroup pncount)))  
+  (setq gmagratemini (/ 1 (aref dtmini pncount)))
+  (setq gmagdurmini (/ (aref nptsmini pncount) gmagratemini))
+
+  (dotimes (i (aref ngroup pncount))
+    (let (gmaghead1 samps gmaghead1mini)
+      (setf gmaghead1 (/ (float gmaghead) (* gmagrate (/ bits 8))))
+      ;(display "gmag read" i gmaghead1 gmagrate filename)
+      (setf samps (s-read filename :time-offset gmaghead1 :srate gmagrate 
+                  :dur gmagdur :mode snd-mode-float 
+                  :format snd-head-raw :bits bits :endian :big))
+      (if samps (snd-length samps ny:all)) ; force read into memory
+      (setf (aref (aref gmag pncount) i) samps)
+      (setq gmaghead (+ gmaghead (* 4 (nth pncount hkframe))))
+      (setq gmaghead1mini (/ (float gmaghead) (* gmagratemini (/ bits 8))))  
+      ;(display "gmag read mini" i gmaghead1mini gmagratemini filename)
+      (setf samps (s-read filename :time-offset gmaghead1mini :srate gmagratemini 
+            :dur gmagdurmini :mode snd-mode-float :format snd-head-raw
+            :bits bits :endian :big))
+      (if samps (snd-length samps ny:all)) ; force read into memory
+      ;(display "read gmagmini" filename pncount i
+      ;         (if samps (snd-length samps ny:all)))
+      (setf (aref (aref gmagmini pncount) i) samps)
+      (setq gmaghead (+ gmaghead (* 4 (aref nptsmini pncount))))
+    ))
+)
+
+(setq maxfreq (aref fa (1- GROUPCON)))
+(dotimes (i GROUPCON) 
+  (setq ngrouptemp -1)
+  (dotimes (j (aref ngroup i))
+    (if (and (= ngrouptemp -1) 
+             (>= (* (aref (aref hto i) j) (aref fa i)) 
+                 (/ *piano-srate* 2)))
+        (setq ngrouptemp j)))  
+  (if (>= ngrouptemp 0) (setf (aref ngroup i) ngrouptemp)))
+
+(princ "\nGenerating wavetables...\n")
+(setq tempi (/ (* 360 tabsize) (* TWOPI TWOPI)))
+(dotimes (h GROUPCON)    
+  (setf (aref wavetab h) (make-array (aref ngroup h)))
+  (dotimes (i (aref ngroup h))
+    ;(FORMAT T "WAVE ~A OF GROUP ~A~%" i h)
+    (let ((low (aref (aref hfrom h) i))
+          (high (aref (aref hto h) i))
+          tempphase tempcw
+          (len tabsize))
+      ; table size must be more than twice greatest harmonic number
+      ; use a factor of three so we have a wider margin of oversampling
+      (setf len (max len (* 3 high)))
+      (setf sumwave *zero-table*)  
+      (do ((k (truncate low) (incf k)))
+           ((> k high))
+         (cond ((< k (aref nhar h))
+                (setq tempphase (aref (aref phase h) k))
+                (setq tempcw (aref (aref cw h) k)))
+               (t
+                (setq tempphase 0)
+                (setq tempcw 0)))
+         (setf sumwave (sum sumwave (scale tempcw (build-harmonic-phase k
+                                                   (+ (* tempphase tempi) 90.0) 
+                                                   len))))))
+    ;(PRINT "FORCE SUMMATION OF WAVE")
+    (snd-length sumwave ny:all) ; force summation
+    ;( "END SUMMATION OF WAVE")
+    (setf (aref (aref wavetab h) i) (list sumwave (hz-to-step 1) T))))
+
+;; Read in attack sound    
+(princ "\nRead in attack sound...\n")
+(setq attndur 0.5)
+(setq attnth -1)
+(dotimes (count (length attsratelist))
+    (if (and (= attnth -1) (<= *piano-srate* (nth count attsratelist))) (setq attnth count)))
+(if (or (= attnth -1) (/= (nth attnth attsratelist) *piano-srate*))
+    (princ "No attack sound rate corresponds to current sound rate, use the nearest one\n"))   
+(if (> attnth 0)
+    (if (<= (- (nth attnth attsratelist) *piano-srate*) (- *piano-srate* (nth (1- attnth) attsratelist)))
+        (setq attsrate (nth attnth attsratelist)) (setq attsrate (nth (1- attnth) attsratelist)))    	
+    (case attnth
+        (-1 (setq attsrate (last attsratelist)))
+        (0 (setq attsrate (nth 0 attsratelist)))))
+(setq filename (format nil "att~A.pcm" (truncate attsrate)))
+(setf filename (strcat *pianosyn-path* "piano" 
+                        (string *file-separator*) filename))
+(setf attsound 
+    (s-read filename :srate attsrate :dur attndur :format snd-head-raw
+            :mode snd-mode-pcm :bits 16 :endian :big))                         
+
+(princ "=============================================\n")
+(princ "End instrument-wise initialization\n")
+(princ "\n\n=============================================\n")
+(princ "Piano Synthesizer function definition:\n")
+(princ "(piano-note-2 step dynamic)\n")
+(princ "(piano-note duration step dynamic)\n")
+(princ "(piano-midi midi-file-name)\n")
+(princ "(piano-midi2file midi-file-name sound-file-name)\n\n")
+(princ "=============================================\n")
+(setf *gc-flag* *pianosyn-save-gc-flag*) ;; restore original value
+
+
+#|
+
+;;================= DEBUGGING CODE =========================
+;;
+;; run (show-cn-file n) to dump some data from pn??.cod
+;; 
+;;==========================================================
+
+
+;; INT-HEX -- convert integer to hex string
+;;
+(defun int-hex (int)
+  (let ((result "") ch)
+    (while (/= int 0)
+      (setf ch (char "0123456789ABCDEF" (logand int 15)))
+      (setf result (strcat (string ch) result))
+      (setf int (/ int 16)))
+    (if (equal result "") "0" result)))
+
+(defun int-4char (int)
+  (strcat (string (int-char (logand 255 (/ int (* 256 256 256)))))
+	  (string (int-char (logand 255 (/ int (* 256 256)))))
+	  (string (int-char (logand 255 (/ int 256))))
+	  (string (int-char (logand 255 int)))))
+
+(defun show-cn-file (pncount)
+  (let (filename fp cwdhdr-ckid cwdhdr-type)
+    (setq filename (strcat "pn" 
+			   (string (int-char (+ (truncate (/ pncount 10)) 48)))
+			   (string (int-char (+ (rem pncount 10) 48)))
+			   ".cod"))
+    (setf filename (strcat *pianosyn-path* "piano" 
+			   (string *file-separator*) filename))
+    (format t "SHOW-CN-FILE ~A (~A)~%" pncount filename)
+    (setf fp (open-binary filename))
+    ;; Read cwdHdr in cwxx.cwd
+    (setq cwdHdr-ckID (read-int fp) cwdHdr-type (read-int fp))
+    (format t "header ckID: ~A (~A)~%" (int-hex cwdhdr-ckid)
+	                             (int-4char cwdhdr-ckid))
+    (format t "header type: ~A (~A)~%" (int-hex cwdhdr-type)
+	                             (int-4char cwdhdr-type))
+    (setq COMMCK-ckID (read-int fp))
+    (format t "header ckID: ~A (~A)~%" (int-hex commck-ckid)
+	                               (int-4char commck-ckid))
+    (setq COMMCK-fa (read-float fp) COMMCK-dt (read-float fp))
+    (format t "commck-fa ~A commck-dt ~A~%" commck-fa commck-dt)
+    (setq COMMCK-npts (read-int fp) COMMCK-ngroup (read-int fp))
+    (format t "commck-npts ~A commck-ngroup ~A~%" commck-npts commck-ngroup)
+    (setq DATACK-ckID (read-int fp))  
+    (format t "header ckID: ~A (~A)~%" (int-hex datack-ckid)
+	                               (int-4char datack-ckid))
+    (setf datack-nhar (read-int fp))
+    (format t "datack-nhar ~A~%cw data:" datack-nhar)
+    (dotimes (i datack-nhar) 
+      (if (and (zerop (rem i 10)) (or (< i 10) (> i (- datack-nhar 10))))
+	  (format t "~%  ~A:" i))
+      (setf data-cw (read-float fp))
+      (if (or (< i 10) (>= i (* (/ datack-nhar 10) 10)))
+          (format t " ~A" data-cw)))
+    (format t "~%phase data:")
+    (dotimes (i datack-nhar)
+      (if (and (zerop (rem i 10)) (or (< i 10) (> i (- datack-nhar 10))))
+	  (format t "~%  ~A:" i))
+      (setf data-phase (read-float fp))
+      (if (or (< i 10) (> i (- datack-nhar 10))) (format t " ~A" data-cw)))
+    (format t "~%")
+    (setf grupck-ckid (read-int fp))
+    (format t "header ckID: ~A (~A)~%hfrom data:" 
+	    (int-hex grupck-ckid) (int-4char grupck-ckid))
+    (dotimes (count commck-ngroup)
+      (setf data-hfrom (read-float fp))
+      (if (zerop (rem count 10))
+	  (format t "~%  ~A:" count))
+      (format t " ~A" data-hfrom))
+    (format t "~%hto data:")
+    (dotimes (count commck-ngroup)
+      (setf data-hto (read-float fp))
+      (if (zerop (rem count 10))
+	  (format t "~%  ~A:" count))
+      (format t " ~A" data-hto))
+    (setf gmagck-ckid (read-int fp))
+    (format t "~%header ckID: ~A (~A)~%"
+	    (int-hex gmagck-ckid) (int-4char gmagck-ckid))
+    (setf gmaghead (read-int fp))
+    (format t "gmaghead ~A" gmaghead)
+    (format t "~%")
+    ;; compute range of data to be read
+    (setf offset gmaghead)
+    (dotimes (i commck-ngroup)
+      (format t "gmag: group ~A offset ~A length ~A end ~A~%"
+	      i offset (* 4 (nth pncount hkframe))
+	      (+ offset (* 4 (nth pncount hkframe))))
+      (setf offset (+ offset (* 4 (nth pncount hkframe))))
+      (format t "gmagmini: group ~A offset ~A length ~A end ~A~%"
+	      i offset (* 4 (aref nptsmini pncount))
+	      (+ offset (* 4 (aref nptsmini pncount))))
+      (setf offset (+ offset (* 4 (aref nptsmini pncount)))))
+      
+    (close fp)
+
+    (setf gmag-and-gmagmini 
+     (s-read filename 
+	     :time-offset (* (float gmaghead) 0.25 commck-dt)
+	     :srate (/ 1.0 commck-dt)
+	     :mode snd-mode-float :format snd-head-raw
+	     :bits 32 :endian :big))))
+|#
diff --git a/lib/plugin-test.lsp b/lib/plugin-test.lsp
new file mode 100644
index 0000000..5e78342
--- /dev/null
+++ b/lib/plugin-test.lsp
@@ -0,0 +1,184 @@
+;; plugin-test -- simulate Audacity interface to Nyquist plugins
+;;
+;; Roger B. Dannenberg, Dec 2005
+;;
+;; This program runs an Audacity plugin from within Nyquist, where
+;; more debugging tools are available.
+;; There are two functions:
+;;
+;;  (PLUGIN-TEST "plugin-file-name") -- full emulation of Audacity,
+;;     prompts for parameters and audio file. The ".ny" extension
+;;     is optional.
+;;
+;;  (PLUGIN-AUTO-TEST "plugin-file-name" bindings ["audio-file-name"]) -- load
+;;     and run the plugin. Bindings is a list of bindings, e.g.
+;;     ((amp 1.0) (n 3)), setting the controls of the plugin.
+;;     This version does not prompt for values.
+;;
+
+
+;; ADD-EXTENSION -- if filename does not end in ext, append ext to 
+;;    filename ext should include the ".", e.g. ".ny"
+;;
+(defun add-extension (filename ext)
+  (cond ((equal (subseq filename (- (length filename) (length ext)))
+		ext)
+	 filename)
+	(t
+	 (strcat filename ext))))
+
+(defun string-to-number (str)
+  (read (make-string-input-stream str)))
+
+
+(defun parse-control-spec (line)
+  (let ((stream (make-string-input-stream (subseq line 8))))
+    (list (read stream)
+	  (read stream)
+	  (read stream)
+	  (read stream)
+	  (read stream)
+	  (read stream)
+	  (read stream))))
+
+
+(defun describe-sound (snd)
+  (let ((typ (type-of snd)) sr)
+    (cond ((eq typ 'sound)
+	   (setf typ "single-channel sound")
+	   (setf sr (snd-srate snd)))
+	  ((and (eq typ 'VECTOR) (eq (type-of (aref snd 0)) 'SOUND))
+	   (setf typ "multi-channel sound")
+	   (setf sr (snd-srate (aref snd 0)))))
+    (cond ((stringp typ)
+	   (format t "=== Plugin result is a ~A at sample rate ~A ===~%"
+		   typ sr)
+	   snd)
+	  (t
+	   (format t "=== Plugin result is of type ~A ===~%" typ)
+	   (pprint snd) ;; print result of plugin if it's not a sound
+	   (s-rest 0.1))))) ;; return silence to make play happy
+	  
+
+(defun read-file-expressions (filename)
+  (let (file expr exprs)
+    (setf file (open filename))
+    (while (setf expr (read file))
+      (push expr exprs))
+    (reverse exprs)))
+
+
+;; AUDIO-FILE-TO-BINDINGS -- convert audio filename to pair of bindings:
+;;    ((s (s-read <filename>)) (len <length-of-audio-file>))
+;; return nil if filename is invalid
+;;
+(defun audio-file-to-bindings (audio-file)
+  (let (source)
+    (if (> (length audio-file) 0)
+	(setf source (s-read audio-file)))
+    (cond (source 
+	   (setf len (* (nth 5 *rslt*) (nth 6 *rslt*)))
+	   (list `(len ,len)
+		 `(s (s-read ,audio-file))))
+	  (t nil))))
+
+
+(defun plugin-test (filename)
+  (let (file controls bindings description plug-type
+	     value audio-file source exprs len)
+    ;; first, check for filename extension
+    (setf filename (add-extension filename ".ny"))
+    ;; see if we can open the file
+    (setf file (open filename))
+    (if (null file)
+	(error (strcat "Could not open " filename)))
+    ;; parse the file
+         ;sym  init             step
+    (do ((line (read-line file) (read-line file)))
+	((null line))
+	;(display "pass 1" line)
+	(cond ((eql 0 (string-search ";control" line))
+	       (push (parse-control-spec line) controls))
+	      ((or (eql 0 (string-search ";nyquist" line))
+		   (eql 0 (string-search ";version" line))
+		   (eql 0 (string-search ";name" line))
+		   (eql 0 (string-search ";action" line))
+		   (eql 0 (string-search ";info" line)))
+	       (push line description))
+	      ((eql 0 (string-search ";type" line))
+	       (cond ((string-search "process" line)
+		      (setf plug-type 'process))
+		     ((string-search "generate")
+		      (setf plug-type 'generate))
+		     ((string-search "analyze")
+		      (setf plug-type 'analyze))
+		     (t
+		      (error (strcat "unexpected specification: " line)))))))
+    (close file)
+    ;; print description
+    (dolist (line description)
+      (format t "~A~%" line))
+    ;; get control values and set them as global variables
+    (setf controls (reverse controls))
+    (read-line) ;; read the newline after the expression that called this fn
+       ;; (otherwise, we'll read in unintended new-line for first control)
+    (dolist (control controls)
+      ;; control is (symbol description type units default minimum maximum)
+      (let ((sym (car control))
+	    (desc (cadr control))
+	    (ctrl-type (caddr control))
+	    (units (cadddr control))
+	    (default (nth 4 control))
+	    (minimum (nth 5 control))
+	    (maximum (nth 6 control)))
+	(loop
+          (format t "~A (~A) [~A]: " desc units default)
+	  (setf value (read-line))
+	  (if (equal value "")
+	      (setf value default)
+	      (setf value (string-to-number value)))
+	  (if (equal ctrl-type 'int)
+	      (setf value (round value))
+	      (setf value (float value)))
+	  (if (and (<= minimum value) (<= value maximum))
+	      (return))	; break from loop
+	  (format t "Try again, value must be between ~A and ~A.~%"
+		  minimum maximum))
+	(push (list sym value) bindings)))
+    (setf bindings (reverse bindings))
+    ;; determine the sound file name to process, if any, and open it
+    (cond ((member plug-type '(process analyze))
+	   (loop
+	     (format t "Audio input file: ")
+	     (setf audio-file (read-line))
+	     (setf source (audio-file-to-bindings audio-file))
+	     (if source (return))
+	     (format t "Could not open ~A. Try again.~%" audio-file))
+	   (setf bindings (append source bindings))))
+    ;; now we're ready to read the plug-in as expressions
+    (setf exprs (read-file-expressions filename))
+    ;; turn expression list into a let and evaluate
+    (run-plugin exprs bindings)))
+
+
+(defun plugin-auto-test (filename bindings &optional audio-file)
+  (setf filename (add-extension filename ".ny"))
+  (let ((exprs (read-file-expressions filename))
+	source)
+    (cond (audio-file
+	   (setf source (audio-file-to-bindings audio-file))))
+    (cond (source
+	   (setf bindings (append source bindings)))
+	  (t
+	   (error (strcat "audio file not valid: " audio-file))))
+    (run-plugin exprs bindings)))
+
+(defun run-plugin (exprs bindings)
+  (setf exprs `(let (,@bindings) ,@exprs))
+  (pprint exprs)
+  (play (describe-sound (eval exprs))))
+
+
+    
+    
+	      
diff --git a/lib/reverb.lsp b/lib/reverb.lsp
new file mode 100644
index 0000000..32da1ad
--- /dev/null
+++ b/lib/reverb.lsp
@@ -0,0 +1,45 @@
+(defun reverb (x time) 
+  (multichan-expand #'reverb-mono x time))
+
+(defun reverb-mono (ga irevfactor)
+  (let (sr ilowpass idel ihz icsc acomball allp1 allp2 allp3 alow allp4 allp5
+        arevout)
+    (setf sr (snd-srate ga))
+
+    (setf ilowpass 9000.000)       ; frequency of lowpass filter
+
+    (setf idel (list ; list of frequency/delay values
+                    (/ 1237.000 sr) (/  1381.000 sr) (/ 1607.000 sr)
+                    (/ 1777.000 sr) (/ 1949.000 sr) (/  2063.000 sr)
+                    (/ 307.000 sr) (/ 97.000 sr) (/ 71.000 sr)
+                    (/ 53.000 sr) (/ 47.000 sr) (/ 37.000 sr)
+                    (/ 31.000 sr)))
+    ; Nyquist's comb filter uses Hz rather than delay as parameter,
+    ; so take reciprocals to get Hz:
+    (setf ihz (mapcar #'/ idel))
+
+    (setf icsc (list ; list of delay times
+                    (* irevfactor 0.822) (* irevfactor 0.802)
+                    (* irevfactor 0.773) (* irevfactor 0.753)
+                    (* irevfactor 0.753) (* irevfactor 0.753)
+                    (* irevfactor 0.7)))
+
+    (setf acomball (sum
+                        (comb ga (nth 0 icsc) (nth 0 ihz))
+                        (comb ga (nth 1 icsc) (nth 1 ihz))
+                        (comb ga (nth 2 icsc) (nth 2 ihz))
+                        (comb ga (nth 3 icsc) (nth 3 ihz))
+                        (comb ga (nth 4 icsc) (nth 4 ihz))
+                        (comb ga (nth 5 icsc) (nth 5 ihz))))
+
+    (setf allp1 (alpass acomball (nth 6 icsc) (nth 6 ihz)))
+    (setf allp2 (alpass allp1 (nth 6 icsc) (nth 7 ihz)))
+    (setf allp3 (alpass allp2 (nth 6 icsc) (nth 8 ihz)))
+    (setf alow  (lp allp3 ilowpass))
+    (setf allp4 (alpass alow (nth 6 icsc) (nth 9 ihz)))
+    (setf allp5 (alpass allp4 (nth 6 icsc) (nth 11 ihz)))
+
+    allp5
+    ; acomball
+    ))
+
diff --git a/lib/reverse.lsp b/lib/reverse.lsp
new file mode 100644
index 0000000..f2f8e3a
--- /dev/null
+++ b/lib/reverse.lsp
@@ -0,0 +1,117 @@
+;; reverse.lsp -- reverse sounds and files
+;;
+
+(setf *max-reverse-samples* 25000000) ;; about 100MB of memory
+(setf *reverse-blocksize* 10000) ;; how many to reverse at a time
+
+(defun s-reverse (snd) (multichan-expand #'nyq:s-reverse snd))
+
+(defun nyq:s-reverse (snd)
+  (let ((now (local-to-global 0)))
+    (setf len (snd-length snd *max-reverse-samples*))
+    (cond ((= len *max-reverse-samples*)
+           (error 
+            "s-reverse cannot reverse a sound longer than *max-reverse-samples*")))
+    (abs-env (at-abs now (nyq:s-reverse-from snd len)))))
+
+(defun nyq:s-reverse-from (snd len)
+  (cond ((> len *reverse-blocksize*)
+         (seq (nyq:reverse-some-samples snd (- len *reverse-blocksize*) 
+                                    *reverse-blocksize*)
+              (nyq:s-reverse-from snd (- len *reverse-blocksize*))))
+        (t
+         (nyq:reverse-some-samples snd 0 len))))
+
+(defun nyq:reverse-some-samples (snd offset len)
+  (display "reverse-some-samples" (snd-length snd 20000) offset len)
+  (let ((samps (snd-samples  (nyq:extract-samples snd offset len) len))
+        (i2 (1- len)))
+    (display "reverse-some-samples" (length samps))
+    (dotimes (i1 (/ len 2))
+      (let ((s1 (aref samps i1))
+            (s2 (aref samps i2)))
+        (setf (aref samps i1) s2)
+        (setf (aref samps i2) s1)
+        (setf i2 (1- i2))))
+    (snd-from-array (local-to-global 0) (snd-srate snd) samps)))
+
+(defun nyq:extract-samples (snd offset len)
+  (let (start stop)
+    (setf start (/ offset (snd-srate snd)))
+    (setf stop (+ start (/ len (snd-srate snd))))
+    (display "nyq:extract-samples" start stop (snd-t0 snd))
+    (extract-abs start stop snd)))
+
+;(play (s-reverse (s-read "sample.wav")))
+
+(defun s-read-reverse (filename &key (time-offset 0) (srate *sound-srate*)
+                       (dur 10000) (nchans 1) (format *default-sf-format*)
+                       (mode *default-sf-mode*) (bits *default-sf-bits*)
+                       (endian nil))
+  (let (fsrate fdur channels rslt)
+    ;; first, read the sound just to get the duration and rate of the file
+    (setf rslt (s-read filename :time-offset time-offset :srate srate :dur dur 
+                     :nchans nchans :format format :mode mode 
+                     :bits bits :endian endian))
+    (if (null rslt) (error "s-read-reverse could not open file" filename))
+    (setf channels (cadr *rslt*))
+    (setf *rslt* (cddddr *rslt*))
+    (setf fsrate (cadr *rslt*))
+    (display "s-read-reverse" filename srate channels)
+    (setf fdur (caddr *rslt*))
+    (setf time-offset (max 0 (min fdur time-offset)))
+    (setf dur (max 0 (min (- fdur time-offset) dur)))
+    (cond ((> channels 1)
+           (setf rslt (make-array channels))
+           (dotimes (i channels)
+             (setf (aref rslt i)
+                   (nyq:s-reverse-file filename time-offset fsrate dur 
+                                       channels format mode bits endian i)))
+           rslt)
+          (t (nyq:s-reverse-file filename time-offset fsrate dur
+                                 channels format mode bits endian nil)))))
+
+
+;; nyq:s-reverse-file -- do the work of reversing one channel of a file
+;; 
+;; if nchans > 1, chan is the channel number to read
+;;
+(defun nyq:s-reverse-file (filename time-offset srate dur nchans
+                           format mode bits endian chan)
+  (let ((blockdur (/ *reverse-blocksize* srate)))
+    (if (> dur blockdur)
+        (seq (nyq:reverse-some-samples 
+              (nyq:s-read-chan filename
+                    (+ time-offset dur (- blockdur))
+                    srate (/ *reverse-blocksize* srate)
+                    nchans format mode bits endian chan)
+              0 *reverse-blocksize*)
+             (nyq:s-reverse-file filename time-offset srate (- dur blockdur)
+                      nchans format mode bits endian chan))
+        (nyq:s-read-chan filename time-offset srate dur nchans format
+                 mode bits endian chan))))
+
+
+;; nyq:s-read-chan -- grab some samples from one channel of a file
+;;
+(defun nyq:s-read-chan (filename time-offset srate dur nchans format
+                        mode bits endian chan)
+  (let (rslt)
+    (setf rslt 
+          (if (= nchans 1)
+              (s-read filename :time-offset time-offset :srate srate
+                       :dur dur :nchans nchans :format format :mode mode
+                        :bits bits :endian endian)
+              (aref (s-read filename :time-offset time-offset :srate srate
+                       :dur dur :nchans nchans :format format :mode mode
+                        :bits bits :endian endian)
+                    chan)))
+    (if (not rslt) (error "nyq:s-read-chan could not read part of file" filename))
+    rslt))
+
+
+;(play (s-read-reverse "sample.wav"))
+;(play (s-read-reverse "test.wav"))
+
+            
+         
\ No newline at end of file
diff --git a/lib/sdl.lsp b/lib/sdl.lsp
new file mode 100755
index 0000000..ea22071
--- /dev/null
+++ b/lib/sdl.lsp
@@ -0,0 +1,402 @@
+;;; Score Description Library. v 1.0 
+;;; pmorales. Junio, 2007
+
+
+; NOTAS:
+;  - es obligatorio definir un instrumento al menos y asignarlo desde el principio
+;  - en su lugar hay que utilizar TF (time factor) que tiene un efecto similar al de Cakewalk
+;  - los atributos ATTR solo tienen efecto sobre el instrumento que estan definidos.
+;    los atributos estan asociados a un instrumento en particular
+
+; a helper function ------------------------------------------
+
+(defun floor (x)
+  (round (- x 0.5)))
+
+
+; this code is imported from pmorales lambda music 
+
+(defun sdl:pitch-lex (pitch)
+  "ARGS: pitch
+DEVUELVE: Cadena con el valor del argumento convertido a pitch-midi"
+  (case (type-of pitch)
+	(fixnum pitch)
+	(flonum pitch (round pitch))
+	(symbol (sdl:pitch-name->step (let ((str (symbol-name pitch))) (if (equal (char str 0) #\:) (subseq str 1) str))))
+	(string (sdl:pitch-name->step pitch))
+	(t (error "PITCH-LEX: Error lexico en especificacion de pitch"))))
+
+
+(defun sdl:digit-char-p (chr)
+  (char>= #\9 chr #\0))
+
+(defun sdl:code-pitch-p-1 (chr)
+  (or (char>= #\g chr #\a) (char>= #\G chr #\A)))
+
+(defun sdl:code-pitch-p-2 (chr)
+  (or (eq chr #\#) (eq chr #\b)(eq chr #\B)(eq chr #\s)(eq chr #\f) (sdl:digit-char-p chr)))
+
+(defun sdl:pitch-p (str)
+  "Detecta si el argumento es un simbolo que representa un pitch"
+  (case (length str)
+     (1 (sdl:code-pitch-p-1 (aref str 0)))
+     (2 (and (sdl:code-pitch-p-1 (char str 0)) (sdl:code-pitch-p-2 (char str 1))))
+     (3 (and (sdl:code-pitch-p-1 (char str 0)) (sdl:code-pitch-p-2 (char str 1))
+             (sdl:digit-char-p (char str 2))))
+     (4 (and (sdl:code-pitch-p-1 (char str 0)) (sdl:code-pitch-p-2 (char str 1))
+             (sdl:digit-char-p (char str 2)) (sdl:digit-char-p (char str 3))))))
+
+
+(defun sdl:b-or-# (pname)
+  (let ((chrom (char pname 1)))
+    (case chrom
+      ((#\b #\B #\f) -1)
+      ((#\# #\s) 1)
+      (t 0))))
+
+(defun sdl:pitch-name-category (pname)
+  (let ((first-char (char pname 0)))
+    (case first-char
+      ((#\C #\c) 0)
+      ((#\D #\d) 2)
+      ((#\E #\e) 4)
+      ((#\F #\f) 5)
+      ((#\G #\g) 7)
+      ((#\A #\a) 9)
+      ((#\B #\b) 11)
+      (t (error (strcat "Improper pitch name " pname))))))
+
+(defun sdl:char-to-val (char)
+  (- (char-code char) 48))
+
+(defun sdl:string-to-val (string)
+  (let ((len (1- (length string))))
+    (do* ((i -1 (1+ i))
+          (suma 0 (+ suma (* (sdl:char-to-val (char string i)) (expt 10 (float (- len i)))))))
+         ((= i len) suma))))
+
+(defun sdl:pitch-name->step (pname)
+  (when (symbolp pname) (setf pname (string-trim ":" (symbol-name pname))))
+  (let ((chrom (sdl:b-or-# pname))
+        (category (sdl:pitch-name-category pname))
+        (octave (sdl:string-to-val (string-left-trim "AaBbCcDdEeFfGg#s" pname))))
+    (+ chrom category (* 12 (- octave 4)) 60)))
+
+
+(defun sdl:one-of-twelve-to-string (number)
+  (case number
+    (0 "C")
+    (1 "C#")
+    (2 "D")
+    (3 "D#")
+    (4 "E")
+    (5 "F")
+    (6 "F#")
+    (7 "G")
+    (8 "G#")
+    (9 "A")
+    (10 "A#")
+    (11 "B")))
+
+(defun step->pitch-name (midi-number)
+  (let ((one-of-twelve (rem midi-number 12))
+        (octave (1- (floor (/ midi-number 12)))))
+    (format nil "~A~A" (sdl:one-of-twelve-to-string one-of-twelve) octave)))
+
+(defun step->hz (midi)
+  (* 440.0 (expt 2.0 (/ (- midi 69.0) 12.0))))
+
+(defun pitch-name->hz (name)
+  (step->hz (pitch-name->step name)))
+
+(defun pitch-name->step (pn) 
+   (if (numberp pn)
+       pn
+     (sdl:pitch-name->step pn)))
+
+
+
+
+
+;;; functions for SYMBOL PROPERTY LIST processing 
+
+
+(defun sdl:iterate-on-symbol-plist (fun plist &optional result)
+  (if plist
+      (sdl:iterate-on-symbol-plist fun (cddr plist) (cons (funcall fun (car plist) (second plist)) result))
+      result))
+ 
+      
+(defun sdl:sort-pwl (plist)
+  (sdl:iterate-on-symbol-plist
+   #'(lambda (sym pwl-list)
+       (list sym (sort pwl-list  #'(lambda (x y) (< (car x)(car y))))))
+   plist))      
+ 
+
+               
+; ATENCION: los calculos se hacen sobre pulsos, no sobre segundos               
+(defun sdl:calcule-pwl-val (tm plist)
+  (apply #'append 
+	(sdl:iterate-on-symbol-plist
+	 #'(lambda (prop-sym prop-val) 
+	     (list prop-sym (sdl:pwl-val tm prop-val)))
+	 plist)))                             
+                    
+
+   
+; this function compute variable attributes           
+          
+(defun sdl:pwl-val (x points)
+  (labels
+   ((pwl-interpolate (x x1 y1 x2 y2)
+		     (let* ((a (/ (- y1 y2) (- x1 (float x2))))
+			    (b (- y1 (* a x1))))
+		       (+ b (* a x))))
+    (search-points (x points &optional (result 0))
+		   (if (or (null points) (< x (caar points)))
+		       result
+		     (search-points x (cdr points) (+ 1 result))))
+    (points-xval (n points) (car (nth n points)))
+    (points-yval (n points) (cadr (nth n points))))          
+   (let ((len (length points))
+	 (index (search-points x points)))
+     (cond
+      ((= 0 index) (points-yval 0 points))
+      ((= len index) (points-yval (- len 1) points))
+      (t (pwl-interpolate x (points-xval (- index 1) points) (points-yval (- index 1) points)
+			  (points-xval index points) (points-yval index points)))))))       
+
+
+; macros in SDL--------------------------------------------------------------              
+      
+(defun sdl:is-event-macro? (ev)
+  (and (listp ev) (equal (car ev) 'MAC)))
+
+(defun sdl:score-has-macros? (sdl-sco)
+  (do ((i 0 (+ 1 i))
+       result)
+      ((cond 
+	((sdl:is-event-macro? (nth i sdl-sco)) (setf result T) T)
+	 ((= i (length sdl-sco)) T))
+       result)))
+     
+(defun sdl:expand-macros (sdl-sco)
+  (apply #'append
+	 (mapcar #'(lambda (ev)
+		     (cond
+		      ((not (listp ev)) (list ev))
+		      ((and (listp ev) (not (equal (car ev) 'MAC))) (list ev))
+		      (t (apply (second ev) (cddr ev)))))
+		 sdl-sco)))
+                  
+
+; main functions for SDL -------------------------------------------------------
+
+; this is a BIG function
+                            
+(defun sdl:sdl->score-aux (score-data &optional time-marks)
+  (let ((tf 1.0)  ; global time factor
+	sc-instr
+        chords
+        (sc-time 0)
+        (sc-dur   1))
+    (unless time-marks (setf time-marks (gensym)))
+    (labels ((filter-name (ky l &optional xresult)
+			  (if l
+			      (if (not (member (car l) ky :test #'equal))                   
+				  (let () (push (car l) xresult)
+				       (push (cadr l) xresult)
+				       (filter-name ky (cddr l) xresult))
+				(filter-name ky (cddr l) xresult))
+			    (reverse xresult)))
+	     (attrs-vals () (symbol-plist sc-instr))
+	     (scale-score-time (event scale)
+			       (list (* scale (car event)) (* scale (cadr event)) (caddr event)))
+	     (make-sc-note (p) (list sc-time sc-dur
+				     (append (list (get sc-instr :name) :pitch (sdl:pitch-lex p))
+					     (sdl:calcule-pwl-val sc-time (get sc-instr :pwl))
+					     (filter-name (list :name :pwl) (attrs-vals)))))
+	     (calcula-dur (datum) (if (listp datum) (eval datum) datum))
+	     (setdur (dur) (setf sc-dur (calcula-dur (car dur))))
+	     (setinstr (instr) (setf sc-instr (intern (car instr))))
+	     (init-instr (instr instr-name)
+			 (setf sc-instr (intern instr))
+			 (setf (symbol-plist sc-instr) NIL)
+			 (putprop sc-instr (gensym) :pwl)
+			 (putprop sc-instr instr-name :name))
+	     (set-attr (prop val) (putprop sc-instr val prop))
+	     (set-pwl-point (prop val)  
+			    (push (list sc-time val) (get (get sc-instr :pwl) prop)))
+	     (set-mrk (mrk-symbol) (if (get time-marks mrk-symbol)
+				       (error "sdl->score: time mark ~A already set" mrk-symbol)
+				     (putprop time-marks sc-time mrk-symbol)))
+	     (set-time-mrk (mrk-symbol) 
+			   (let ((mrk-time (get time-marks mrk-symbol)))
+			     (if mrk-time (setf sc-time mrk-time)
+			       (error (format nil "sdl->score: time mark ~A does not exists" mrk-symbol))))) 
+	     
+                                              
+             (proc-elt-for-pwl (elt)
+			       (if (not (listp elt))
+				   (cond ((numberp elt) (setf sc-time (+ sc-time elt)) NIL)
+					 (t (setf sc-time (+ sc-time sc-dur)) NIL))
+				 (case (car elt)
+				       ((KEY TS CHN PATCH LM TN MRK NTR) NIL) ; filter out all these
+					; for compatibility with lambda music
+				       ((TF) (setf tf (calcula-dur (cadr elt))) NIL)
+				       ((LABEL SET-MRK) NIL)
+				       ((AT-LABEL AT-MRK)  NIL)
+				       ((TIME-IN-SECONDS) (setf tf 0.25) NIL) ; with mm = 60
+				       ((DUR) (setdur (cdr elt)) NIL)
+				       ((INSTRUMENT) (setinstr  (cdr elt)) NIL)
+				       ((INIT-INSTR) (init-instr (second elt)(third elt)) NIL)
+				       ((ATTR) NIL)
+				       ((PWL-POINT) (set-pwl-point (second elt) (calcula-dur (third elt))) NIL)
+				       ((FUN) (apply (eval (cadr elt)) (cddr elt)))
+				       ((DELTA PAU) (setf sc-time (+ sc-time (calcula-dur (second elt)))) NIL) ; pause positive or negative
+				       ((CH)  (setf sc-time (+ sc-time sc-dur)) NIL)
+				       ((CH1) (setf sc-dur (calcula-dur (third elt))) ; pitch dur
+					(setf sc-time (+ sc-time sc-dur)) NIL)
+				       (t     (setf sc-dur (calcula-dur (cadr elt)))
+					      (setf sc-time (+ sc-time sc-dur))
+					      NIL))))                                              
+	     
+	     
+	     
+	     
+	     (proc-elt (elt)
+		       (if (not (listp elt))
+			   (cond ((numberp elt) (setf sc-time (+ sc-time elt)) NIL)
+				 (t     (let ((ret-note (make-sc-note elt)))
+					  (setf sc-time (+ sc-time sc-dur))
+					  ret-note)))
+			 (case (car elt)
+			       ((KEY TS CHN PATCH LM TN MRK NTR) NIL) ; filter out all these
+					; for compatibility with lambda music
+			       ((TF) (setf tf (calcula-dur (cadr elt))) NIL)
+			       ((LABEL SET-MRK) (set-mrk (second elt)) NIL)
+			       ((AT-LABEL AT-MRK)  (set-time-mrk (second elt)) NIL)
+			       ((TIME-IN-SECONDS) (setf tf 0.25) NIL)
+			       ((DUR) (setdur (cdr elt)) NIL)
+			       ((INSTRUMENT) (setinstr  (cdr elt)) NIL)
+			       ((INIT-INSTR) NIL) ;(init-instr (second elt)(third elt)) NIL)
+			       ((ATTR) (set-attr (second elt) (calcula-dur (third elt))) NIL)
+			       ((PWL-POINT)  NIL)
+			       ((FUN) (apply (eval (cadr elt)) (cddr elt)))
+			       ((DELTA PAU) (setf sc-time (+ sc-time (calcula-dur (second elt)))) NIL) ; pause positive or negative
+			       ((CH) (dolist (n (cdr elt)) (push (make-sc-note n) chords)) NIL)
+			       ((CH1) (setf sc-dur (calcula-dur (third elt))) ; pitch dur
+				(make-sc-note (second elt)))
+			       (t     (setf sc-dur (calcula-dur (cadr elt)))
+				      (let ((ret-note (make-sc-note (car elt))))
+					(setf sc-time (+ sc-time sc-dur))
+					ret-note))))))
+	    
+					; first sets pwl data
+	    (dolist (ev score-data NIL)
+	      (proc-elt-for-pwl ev))
+	    
+					; sort pwl data
+	    (dolist (elt score-data NIL)
+	      (when
+		  (and (listp elt) (equal (car elt) 'INIT-INSTR))
+		
+		(putprop (intern (second elt)) 
+                         (apply #'append (sdl:sort-pwl (symbol-plist (get (intern (second elt)) :pwl))))
+                         :pwl)))
+	    
+	    
+					; then process score
+	    
+	    (setf sc-time 0.0)       
+	    
+	    (do ((data score-data (cdr data))
+		 (result '()))
+		((null data) (list (sort (mapcar #'(lambda (ev) (scale-score-time ev tf)) result)
+					 #'(lambda (x y) (< (car x) (car y)))) time-marks))
+		(let ((proced-elt (proc-elt (car data))))
+		  (when proced-elt (push proced-elt result)))
+		(setf result (append result chords))))))
+
+
+(defun sdl:get-key (l k)
+  (when l
+    (if (equal (car l) k)
+	(second l)
+      (sdl:get-key (cdr l) k))))
+
+        
+(defun sdl:apply-mm-to-score (sco)
+  (let (current-time current-dur end-last-note gap current-mm result)
+    (setf current-mm (sdl:get-key (caddar sco) :mm)) 
+    (setf current-time (* (/ 15.0 current-mm) (caar sco))) 
+    (setf end-last-note (caar sco))
+    (dolist (ev sco)
+      (setf gap (- (car ev) end-last-note))
+      (setf end-last-note (+ (car ev) (second ev)))
+      (setf current-mm (sdl:get-key (caddr ev) :mm))
+      (setf current-dur (* (/ 15.0 current-mm) (cadr ev)))
+      (push (list  (+ current-time (* (/ 15.0 current-mm) gap))  current-dur (caddr ev)) result)
+      (setf current-time (+ current-time (* (/ 15.0 current-mm) gap) current-dur)))
+    (reverse result)))
+
+
+(defun sdl:normalize-score-duration (sco)
+ (mapcar #'(lambda (ev) (list (car ev) 1 (third ev))) sco))
+
+          
+; main functions interface -------
+
+;(defun sdl->score (score-data &optional time-marks)
+;  (when (sdl:score-has-macros? score-data)
+;    (setf score-data (sdl:expand-macros score-data)))
+;  (car (sdl:sdl->score-aux score-data time-marks)))
+
+(defun sdl->score (score-data &optional time-marks)
+  (when (sdl:score-has-macros? score-data)
+    (setf score-data (sdl:expand-macros score-data)))
+  (sdl:apply-mm-to-score
+   (car (sdl:sdl->score-aux score-data time-marks))))
+	
+(defun sdl->timelabels (score-data &optional time-marks)
+  (when (sdl:score-has-macros? score-data)
+    (setf score-data (sdl:expand-macros score-data)))
+  (second (sdl:sdl->score-aux score-data time-marks)))
+
+	
+#|
+
+; PRUEBAS
+
+
+(defun sdl-repeat (n quoted-event)
+  (let (result)
+    (dotimes (i n (apply #'append result))
+      (push quoted-event result))))
+
+
+(setf *score* '((TF 1.0)
+		(INIT-INSTR "i1" xx)(INIT-INSTR "i2" yy)
+		(INSTRUMENT "i1")(ATTR :at1 2)(ATTR :mm 60) 4 (:e4 2) 2 (:d4 4) 10 (LABEL :t1)
+		(INSTRUMENT "i2") (ATTR :mm 60)(:f4 8) 
+		(LABEL :vuelta) (AT-LABEL :t1) (:f5 4) 
+		(AT-LABEL :vuelta) (:f6 8)
+))
+
+
+(setf *score2* '((TF 1.0)
+		 (INIT-INSTR "i1" xx2)(INSTRUMENT "i1")(ATTR :mm 60)
+		 (AT-LABEL :t1) (:e4 4) (MAC sdl-repeat 4 (:f4 :g4)) ))
+
+;(print  (sdl:apply-mm-to-score (car (sdl:sdl->score-aux *score*))))
+;(print (car (sdl:sdl->score-aux *score*)))
+
+(setf *tlabels* (sdl->timelabels *score*))
+
+(print (sdl->score *score*))
+(print (sdl->score *score2* *tlabels*))
+
+|#
+
+
diff --git a/lib/soften.lsp b/lib/soften.lsp
new file mode 100644
index 0000000..ad5c2ab
--- /dev/null
+++ b/lib/soften.lsp
@@ -0,0 +1,45 @@
+;; soften.lsp -- this is code to "soften" harsh clipping
+;
+; it works by detecting peaks that exceed an absolute amplitude of 126/127
+; using SND-ONESHOT. Then the envelope is smoothed using SND-CHASE
+; to produce a smooth cross-fade envelope. The envelope picks out the loud
+; stuff to be filtered (try 4K) and an inverted envelope grabs the soft 
+; stuff which is unmodified except where the loud regions are clipped out.
+; The sum of soft and filtered loud components is returned.
+;
+; Since clipping tends to generate harsh aliasing, the low-pass filter
+; eliminates a lot of the problem, and the filter is usually on so
+; briefly that you don't notice it.
+
+(defun square (x) (* x x))
+
+;; region for low-pass will be *soften-width* wide, with
+;; *soften-crossfade* seconds of cross-fade
+(setf *soften-width* 0.02)
+(setf *soften-crossfade* 0.002)
+
+(defun soften-clipping (snd cutoff)
+  (let (clip-region snd2 loud-stuff soft-stuff filtered-stuff)
+    (setf clip-region (snd-oneshot (prod snd snd) 
+                                        (square (/ 126.0 127.0)) *soften-width*))
+    (setf clip-region (snd-chase clip-region 
+                                     *soften-crossfade* *soften-crossfade*))
+    ; s-rest needs a sample rate:
+    (sound-srate-abs (snd-srate snd)
+      (setf snd2 (seq (s-rest (/ *soften-width* 2)) 
+                          (cue (scale 0.99 snd))) ))
+    (setf loud-stuff (prod snd2 clip-region))
+    (setf soft-stuff (prod snd2 (sum 1 (scale -1 clip-region))))
+    (setf filtered-stuff (lp loud-stuff cutoff))
+    ; (vector filtered-stuff loud-stuff)
+    (sum filtered-stuff soft-stuff)
+  ))
+
+    
+;(defun tes ()
+;  (sound-off)
+;  (let (snd)
+;    (setf snd (s-read "..\\..\\intro.aif"))
+;    (s-save (soften-clipping snd 4000) ny:all "temp.wav" :bits 16)))
+
+; (tes)
diff --git a/lib/spatial.lsp b/lib/spatial.lsp
new file mode 100644
index 0000000..bef95da
--- /dev/null
+++ b/lib/spatial.lsp
@@ -0,0 +1,506 @@
+; SPATIAL.LSP 
+; created by Adam Hartman and Roger B. Dannenberg
+; 2005
+; stereo manipulation and spatialization functions
+
+; EMPHIGH -- use four equalizer bands to emphasize
+;    the higher frequencies in an input sound
+;
+(defun emphigh (base) 
+  (eq-band 
+   (eq-band 
+    (eq-band 
+     (eq-band base 31 -3 1)
+                  62 -3 1)
+                8000 3 1)
+              16000 3 1))
+
+; EMPLOW -- use four equalizer bands to emphasize
+;    the lower frequencies in an input sound
+;
+(defun emplow (base)
+  (eq-band
+   (eq-band
+    (eq-band
+     (eq-band base 31 3 1)
+                  62 3 1)
+              8000 -3 1)
+            16000 -3 1))
+
+; LEFTIN -- apply low frequency emphasis to a sound
+(defun leftin (inl) (emplow inl))
+
+; RIGHTIN - apply high frequency emphasis and
+;    a very slight delay to a sound
+;
+(defun rightin (inr) (seq (s-rest 0.02) (emphigh inr)))
+
+; STEREOIZE -- create a stereo sound from a monaural source
+;
+(defun stereoize (monoin) 
+  (vector (leftin monoin) (rightin monoin)))
+
+; EXTRACTLEFT -- extract the left channel of a stereo sound
+(defun extractleft (inl) (aref inl 0))
+
+; EXTRACTRIGHT -- extract the right channel of a stereo sound
+(defun extractright (inr) (aref inr 1))
+
+
+; WSUM -- weighted sum of two monaural sounds
+;
+;   inl: first monaural sound
+;   inr: second monaural sound
+;   amtl: multiplier for the first monaural sound
+;   amtr: multiplier for the second monaural sound
+;
+(defun wsum (inl inr amtl amtr)
+  (sum (mult inl amtl) (mult inr amtr)))
+
+
+; SMIXER -- remix a stereo signal
+;
+;   in: original stereo sound
+;   lamtl: amount in new left channel from the original left channel
+;   lamtr: amount in new left channel from the original right channel
+;   ramtl: amount in new right channel from the original left channel
+;   ramtr: amount in new right channel from the original right channel
+;  Note: lamtl, lamtr, ramtl, ramtr should have values in the 
+;  range of -1 to 1 and may be static numbers or sounds
+;
+(defun smixer (in lamtl lamtr ramtl ramtr)
+   (let ((eleft (extractleft in)) (eright (extractright in)))
+    (vector (wsum eleft eright lamtl lamtr) 
+	    (wsum eleft eright ramtl ramtr))))
+
+
+; WIDEN -- widen the field of a stereo sound
+;
+;   in: original stereo sound
+;   amt: a value between 0 and 1 which represents a widening factor
+;      0 will leave the sound unchanged while 1 indicates the widest
+;      possible stereo field
+; Note: amt may be a static number or a sound
+;
+(defun widen (in amt) 
+   (let ((widenamt (mult -1 amt)))
+    (smixer in 1 widenamt widenamt 1)))
+
+; SPAN -- pan the virtual center channel of a stereo sound
+;
+;   in: original stereo sound
+;   amt: a value between 0 and 1 which represents the panning location
+;        0 pans the center channel all the way to the left while 1 pans
+;        it all the way to the right
+; Note: amt may be a static number or a sound
+;
+(defun span (in amt)
+   (let ((leftc (sum 0.5 (mult -1 amt))) (rightc (sum -0.5 amt)))
+    (smixer in 0.5 leftc rightc 0.5)))
+
+; SWAPCHANNELS -- swap the two channels in a stereo sound
+(defun swapchannels (in) (vector (aref in 1) (aref in 0)))
+
+#| NOTE: there's nothing wrong with the code that is commented out here.
+These functions were in the original library, but I have commented them
+out because they are very simple and not very general. Perhaps they
+can be incorporated in an expanded form in a future version of Nyquist.
+For example, some general 3-D positioning with Doppler effects, etc., 
+and some more elaborate HRTF code would be very interesting. Feel free
+to give these a try. -RBD
+
+; IID -- position a monaural sound source by attenuating the volume
+; of the sound at each ear point based on the distance between the
+; two ear points and the distance of the sound source from the listener
+;
+;   in: monaural source sound
+;   dist: lateral distance of the sound source from the listener in meters
+;   headwidth: width of the listener's head (i.e. the distance between
+;     the two ears) in meters
+;   rorl: a value of either 0 or 1 which represents whether the sound 
+;     source is to the left or to the right of the listener 
+;
+(defun iid (in dist headWidth RorL)
+  (let ((nearmult (/ 1.0 (mult dist dist)))
+        (farmult (/ 1.0 (mult (sum dist headWidth) 
+			      (sum dist headWidth)))))
+  (if (eq rorl 0)
+    ; sound source is to the left of listener 
+    (vector (mult in nearmult) (mult in farmult))
+    ; sound source is to the right of listener
+    (vector (mult in farmult) (mult in nearmult)))))
+
+; ITD -- position a monaural sound source by delaying the arrival
+;        of the sound at each ear point based on the distance 
+;        between the two ear points and the distance of the sound
+;        source from the listener
+;  in: monaural source sound
+;  dist: lateral distance of the sound source from the listener in meters
+;  headwidth: width of the listener's head (i.e. the distance
+;    between the two ears) in meters
+;  rorl: a value of either 0 or 1 which represents whether the sound
+;    source is to the left or to the right of the listener
+;
+(defun itd (in dist headWidth RorL)
+  (let ((neardel (mult 0.0029387 dist))
+        (fardel (mult 0.0029387 (sum dist headWidth))))
+  (if (eq rorl 0)
+    ; sound source is to the left of listener
+    (vector (seq (s-rest neardel) in ) (seq (s-rest fardel) in))
+    ; sound source is to the right of listener
+    (vector (seq (s-rest fardel) in) (seq (s-rest neardel) in))))) 
+
+
+; CFSPATIALIZATION -- a spatialization effect based on a cross-feed network
+;
+(defun cfspatialization (in)
+  (let ((shadowLeft (lp (seq (s-rest 0.0004) (aref in 0)) 265))
+        (shadowRight (lp (seq (s-rest 0.0004) (aref in 1)) 265)))
+  (vector (sum (aref in 0) shadowRight) (sum (aref in 1) shadowLeft))))
+
+; CUSTBP -- a helper function that creates a custom bandpass filter
+;           for use in the hrtfapprox function
+(defun custbp (in) (lp (sum (hp in 4980) (mult in 0.75)) 7900))
+
+; HRTFAPPROX -- a spatialization effect based on an approximated HRTF
+;
+(defun hrtfapprox (in)
+  (let ((filteredLeft (seq (s-rest 0.00025) (custbp (aref in 0))))
+        (filteredRight (seq (s-rest 0.00025) (custbp (aref in 1)))))
+  (vector (sum (aref in 0) (lp filteredRight 10200)) 
+	  (sum (aref in 0) (lp filteredLeft 1020)))))
+|#
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Dolby Pro-Logic encoding and a 
+;; 2D Sound Positioning Scheme
+;;
+;;     Dave Borel (dborel) with minor changes by
+;;     Roger B. Dannenberg
+;;
+;;     Features:
+;;       -Dolby Pro-Logic panning
+;;       -Doppler for moving sounds
+;;       -Distance attenuation
+;;       -Atmospheric damping of high frequencies
+;;       -Progagation delay
+;;       -Test programs
+
+(setf config 1) ;Distance between listener and speakers
+
+;---------------------------------------------------
+;                  Math Helpers
+;---------------------------------------------------
+
+;
+; Distance between two points
+;
+(defun dist (x0 y0 x1 y1)
+  (let* ( (rx (sum x1 (mult -1.0 x0)))
+          (ry (sum y1 (mult -1.0 y0))) )
+    (s-sqrt (sum (mult rx rx) (mult ry ry)))))
+
+;
+; Raise x to each sample of snd
+;
+(defun s-expt (x snd)
+  (s-exp (mult (s-log x) snd)))
+
+
+;;
+;; SPATIALIZATION HELPERS:
+;;
+
+;
+; Doppler effect
+;
+(defun pl-doppler (snd r)
+  (let* ( (v (mult -1 (slope r)))
+          (ratio (recip (sum 1 (mult v (recip 344.31)))))
+          (map (integrate ratio)) )
+
+    (sound-warp map snd) ))
+
+
+;
+; Distance-based low-pass filter
+; (see report)
+;
+(defun absorb (snd r-m)
+  (lp snd (mult 14763.67 (s-expt 0.97895 r-m))))
+
+
+;
+; Distance-based attenuation
+; (see report)
+;
+(defun atten (snd r)
+
+;  (let* ( (log2-r (mult (s-log r) (recip (log 10.0))))
+;          (db-ratio (mult 20 log2-r))
+;          (ratio (db-to-linear db-ratio)) )
+;
+;    (mult (clip ratio 1.0) snd)))
+  (mult snd (clip (recip (mult r r)) 1)))
+
+;
+; Top-level spatializer
+; sound source at (x,y)
+; speaker at (xs, ys)
+; assumes listener at (0,0)
+;
+; You could use this with
+; configurations other than
+; pro-logic (e.g. 6.1, 7.1, etc)
+;
+(defun stage (snd x y xs ys)
+  (let* ( (r (dist x y 0 0))
+          (rs (dist xs ys 0 0))
+          (x-hat (mult x (recip r)))
+          (y-hat (mult y (recip r)))
+          (xs-hat (mult xs (recip rs)))
+          (ys-hat (mult ys (recip rs)))
+
+          (dot (sum (mult x-hat xs-hat) (mult y-hat ys-hat)))
+          (overlap (mult 0.5 (sum dot (s-abs dot)))) )
+    (mult overlap snd)))
+
+
+;---------------------------------------------------
+;                  Speaker Mixing
+;---------------------------------------------------
+;
+; Dolby Pro-Logic Encoder
+;
+(defun prologic (left center right surround)
+  (let* ( (c (scale 0.5 center))
+          (s (highpass2 (lowpass2 (scale 0.5 surround) 7000) 100) )
+          (slfe (scale 0.25 (lp surround 100)))
+          (l (sim left  center (mult -1.0 s) slfe))
+          (r (sim right center            s  slfe)) )
+    (vector l r)))
+
+
+;
+; Direct-to-speaker playback
+;
+(defun pl-left   (snd) (let ((s (mult 0 snd))) (prologic snd s s s)))
+(defun pl-center (snd) (let ((s (mult 0 snd))) (prologic s snd s s)))
+(defun pl-right  (snd) (let ((s (mult 0 snd))) (prologic s s snd s)))
+(defun pl-rear   (snd) (let ((s (mult 0 snd))) (prologic s s s snd)))
+            
+;
+; Pans a sound across the surround speakers
+; (no realistic imaging or attenuation)
+; Works like pan but y specifies depth
+(defun pl-pan2d (s-in x y)
+  (let ((snd (scale 0.5 s-in)))
+    (prologic (mult snd (sum 1.0 (mult -1.0 x)
+                             (sum 1 (mult -1.0 y))) );left
+              (mult snd 0.0)                         ;center(null)
+              (mult snd x (sum 1.0 (mult -1.0 y) ))  ;right
+              (mult snd y 0.5))))                    ;rear
+
+;
+; Position a sound in the 2D soundstage
+; Includes spatialization effects
+; 
+; (x,y) may be (flonum, flonum) or (behavior, behavior)
+;
+(defun pl-position (s-in x y config)
+  (let* ( (r-m (dist x y 0 0))
+          (r (mult r-m (recip config)))
+          (spd-snd (/ 344.31 config))
+          (offset (if (soundp r-m)
+                      (/ (aref (snd-samples r 1) 0) spd-snd)
+                      (/ r spd-snd)))
+          (snd (seq (s-rest offset)
+                    (if (soundp r-m)
+                        (atten (absorb (pl-doppler s-in r-m) r-m) r)
+                        (atten (absorb s-in r-m) r)))) )
+    
+    ; Two Notes:
+    ; 1.) The center channel is automatically imaged correctly
+    ;     because sounds placed between the left-and-right channels
+    ;     distribute linearly between the two channels.
+    ;
+    ; 2.) Although the below settings assume that all speakers are
+    ;     equidistant from the listener, you can easily assume a
+    ;     different layout by modifying the xs and ys values in
+    ;     each channel's call to the stage function.
+    ;
+    (prologic (stage snd x y -.1913  -.4619)       ;left
+              (scale 0.0 snd)                        ;center (null)
+              (stage snd x y  .1913  -.4619)       ;right
+              (stage snd x y 0.0     .5    ))))    ;rear
+
+
+;---------------------------------------------------
+;                   Diagnostics
+;---------------------------------------------------
+
+;
+; Pro-Logic Channel Test Tones
+;
+(defun pl-test ()
+  (play (prologic
+         (                   osc-note a3 )
+         (seq (s-rest 1.25) (osc-note b3))
+         (seq (s-rest 2.5 ) (osc-note c4))
+         (seq (s-rest 3.75) (osc-note d4)) )))
+
+
+;
+; Pan Test
+;
+(defun pan-test ()
+  (play (pl-pan2d
+         (seq
+          (s-rest .25) (osc a3 .75)
+          (s-rest .25) (osc b3 .75)
+          (s-rest .25) (osc c4 .75)
+          (s-rest .25) (osc d4 .75))
+
+         (pwl
+          0    0
+          0.99 0
+
+          1    1
+          2.99 1
+
+          3    0
+          4    0
+          4    )
+
+         (pwl
+          0    0
+          1.99 0
+
+          2    1 
+          4    1
+          4    ))))
+
+
+;
+; Doppler test
+;
+(defun dop ()
+  (play (pl-doppler (osc c4 10) (pwl .25 0 .5 100 .75 100 1.0))))
+
+;
+; Attenuation test
+;
+(defun att ()
+  (play (atten (osc-note c4 4) 
+               (pwl 0 2
+                    1 2 
+                    2 100
+                    3 100
+                    4 2 
+                    4 ))))
+
+
+;
+; Doppler positioning test (ambulance)
+;
+(defun ambulance ()
+  (play (scale 0.2
+               (pl-position
+
+                (stretch 16 (fmosc c4 (mult 1000 (lfo 2))))
+                
+                (pwl
+                 0  -20
+                 8   20
+                 8   )
+                
+                (pwl
+                 0    0
+                 8    )
+
+                config))))
+
+
+;
+; Position test
+;
+
+; Make a sound orbit the listener
+(defun orbit-x (r t times)
+  (let (k)
+    (seqrep (k times)
+            (pwl
+             0.0               0.0
+             (/ t 4)           r
+             (/ t 2)           0.0
+             (/ (* t 3) 4)     (* -1 r)
+             t                 0.0
+             t                 ) )))
+(defun orbit-y (r t times)
+  (let (k)
+    (seqrep (k times)
+            (pwl
+             0.0               (* -1 r)
+             (/ t 4.0)         0.0
+             (/ t 2.0)         r
+             (/ (* t 3.0)4.0)  0.0
+             t                 (* -1 r)
+             t                 ) )))
+(defun orbit (snd r t times)
+  (pl-position snd
+            (orbit-x r t times)
+            (orbit-y r t times)
+            config))
+
+
+; Play some tones
+(defun pos-1 ()
+  (play (pl-position
+         (seq
+          (s-rest .125) (osc a3 1.75)
+          (s-rest .25)  (osc b3 1.75)
+          (s-rest .25)  (osc c4 1.75)
+          (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+         (pwl
+          0    -5
+          1    5
+          2    5
+          3    -5
+          4    -5
+          5    5
+          6    5
+          7    -5
+          8    -5
+          8    )
+
+         (pwl
+          0    -5
+          1    -5
+          2    5
+          3    5
+          4    -5
+          5    -5
+          6    5
+          7    5
+          8    -5
+          8    )
+
+         config)))
+
+(defun pos-2 ()
+  (play (seq
+         (orbit (seq
+                (s-rest .125) (osc a3 1.75)
+                (s-rest .25)  (osc b3 1.75)
+                (s-rest .25)  (osc c4 1.75)
+                (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+               5 8 1)
+         (orbit (seq
+                (s-rest .125) (osc a3 1.75)
+                (s-rest .25)  (osc b3 1.75)
+                (s-rest .25)  (osc c4 1.75)
+                (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+               5 8 1))))
diff --git a/lib/spectrum.lsp b/lib/spectrum.lsp
new file mode 100644
index 0000000..668c310
--- /dev/null
+++ b/lib/spectrum.lsp
@@ -0,0 +1,135 @@
+;; spectrum.lsp -- operations on spectral frames
+
+(defun raised-cosine ()
+  (scale 0.5 
+    (sum (const 1) 
+         (lfo (/ 1.0 (get-duration 1)) 1 *sine-table* 270))))
+
+(defun fft-window (frame-size)
+  (control-srate-abs frame-size (raised-cosine)))
+
+;; fft-class -- an iterator converting sound to sequence of frames
+;;
+(setf fft-class (send class :new '(sound length skip window)))
+
+(send fft-class :answer :next '() '(
+    (snd-fft sound length skip window)))
+
+(send fft-class :answer :isnew '(snd len skp) '(
+    (setf sound snd)
+    (setf length len)
+    (setf skip skp)
+    (setf window (fft-window len)) ))
+
+
+(defun make-fft-iterator (sound length skip)
+  (send fft-class :new (snd-copy sound) length skip))
+
+
+;; conversions -- assumes frame length is even
+
+(defun spectrum-to-amplitude (frame)
+  (let* ((n (length frame))
+         (half-n (/ n 2))
+         (amps (make-array (1+ half-n))))
+    (setf (aref amps 0) (abs (aref frame 0)))
+    (dotimes (i (1- half-n))
+      (let* ((i2 (+ i i))
+             (c (aref frame (1+ i2)))
+             (s (aref frame (+ 2 i2))))
+        (setf (aref amps (1+ i))
+              (sqrt (+ (* c c) (* s s))))))
+    (setf (aref amps half-n) (abs (aref frame (1- n))))
+    amps))
+
+(defun spectrum-by-amplitude (frame amps)
+  (let* ((n (length frame))
+         (half-n (/ n 2)))
+    (setf (aref frame 0) (* (aref frame 0) (aref amps 0)))
+    (dotimes (i (1- half-n))
+      (let* ((ip1 (1+ i))
+             (i2 (+ i i))
+             (i2p1 (1+ i2))
+             (i2p2 (1+ i2p1)))
+        (setf (aref frame i2p1) (* (aref frame i2p1)
+                                   (aref amps ip1)))
+        (setf (aref frame i2p2) (* (aref frame i2p2)
+                                   (aref amps ip1)))))
+    (setf (aref frame (1- n)) (* (aref frame (1- n))
+                                 (aref amps half-n)))))
+
+
+(defun spectrum-rms (frame)
+  (let* ((n (length frame))
+         (half-n (/ n 2))
+         (sum (* (aref frame 0) (aref frame 0))))
+    (dotimes (i (1- half-n))
+      (let* ((i2 (+ i i))
+             (c (aref frame (1+ i2)))
+             (s (aref frame (+ 2 i2))))
+        (setf sum (+ sum (* c c) (* s s)))))
+    (setf sum (+ sum (* (aref frame (1- n)) (aref frame (1- n)))))
+    (sqrt sum)))
+
+
+(defun amplitude-rms (frame)
+  (let* ((n (length frame))
+         (sum 0))
+    (dotimes (i n)
+      (setf sum (+ sum (* (aref frame i) (aref frame i)))))
+    (sqrt sum)))
+
+;; SMOOTH-AMPLITUDE -- simple local averaging to smooth out
+;;   an amplitude spectrum. This might be useful to broaden
+;;   spectral peaks from partials to better represent vocal 
+;;   formants. It would be nice to have a "width" parameter,
+;;   but instead, the filter is fixed at (0.25, .5, 0.25)
+;;
+(defun smooth-amplitude (frame)
+  (let* ((len (length frame))
+         (lenm1 (1- len))
+         (lenm2 (1- lenm1))
+         (rslt (make-array (length frame))))
+    (setf (aref rslt 0) (+ (* 0.75 (aref frame 0))
+                           (* 0.25 (aref frame 1))))
+    (dotimes (i lenm2)
+      (let* ((ip1 (1+ i))
+             (ip2 (1+ ip1)))
+        (setf (aref rslt ip1) (+ (* 0.25 (aref frame i))
+                                 (* 0.5 (aref frame ip1))
+                                 (* 0.25 (aref frame ip2))))))
+    (setf (aref rslt lenm1) (+ (* 0.25 (aref frame lenm2))
+                               (* 0.75 (aref frame lenm1))))
+    rslt))
+
+;; ARRAY-SCALE -- multiply a spectral frame or amplitude frame
+;;  by a scale factor
+;;
+(defun array-scale (frame x)
+  (dotimes (i (length frame))
+    (setf (aref frame i) (* (aref frame i) x))))
+
+
+(defun array-copy (frame)
+  (let* ((len (length frame))
+         (copy (make-array len)))
+    (dotimes (i len)
+      (setf (aref copy i) (aref frame i)))
+    copy))
+
+
+
+
+(defun amplitude-plot (frame)
+  (s-plot (snd-from-array 0 
+            (/ (float (1- (length frame)))
+               *default-sound-srate*) 
+            frame)))
+
+
+(defun spectrum-plot (frame)
+  (amplitude-plot (spectrum-to-amplitude frame)))
+
+
+(defun spectrum-ifft (iterator len skip)
+  (snd-ifft (local-to-global 0.0) *sound-srate* iterator skip (fft-window len)))
diff --git a/lib/statistics.lsp b/lib/statistics.lsp
new file mode 100644
index 0000000..b805351
--- /dev/null
+++ b/lib/statistics.lsp
@@ -0,0 +1,428 @@
+;; statistics.lsp -- simple statistics functions
+
+;; to compute statistics, create an object:
+;;    (setf stats (send statistics-class :new t))
+;; use t to retain the data and nil to not retain the data
+;; then call (send stats :point x) for each x in the data set
+;; call (send stats :print-stats) to print some statistics
+;; see methods below for other methods, e.g. :get-mean
+;;
+;; to compute histograms, see comments below
+
+(setf statistics-class (send class :new '(count sum sum-sqr max min retain data)))
+
+(send statistics-class :answer :isnew '(ret) '((send self :init ret)))
+
+(send statistics-class :answer :init '(ret) '(
+    (setf count 0 sum 0 sum-sqr 0 data nil 
+          max nil min nil retain ret data nil)))
+
+(send statistics-class :answer :point '(x) '(
+    (incf count)
+    (setf sum (+ sum x))
+    (setf sum-sqr (+ sum-sqr (* x x)))
+    (setf max (if max (max max x) x))
+    (setf min (if min (min min x) x))
+    (if retain (push x data))))
+
+(send statistics-class :answer :get-count '() '(count))
+(send statistics-class :answer :get-data '() '(data))
+(send statistics-class :answer :get-min '() '(min))
+(send statistics-class :answer :get-max '() '(max))
+
+(send statistics-class :answer :get-mean '() '(
+    (if (> count 0) (/ (float sum) count)
+                    nil)))
+
+
+(send statistics-class :answer :get-stddev '() '(
+  (if (> count 1) (sqrt (send self :get-variance)) nil)))
+
+
+(send statistics-class :answer :get-variance '() '(
+  (if (> count 1)
+      (/ (- sum-sqr
+            (/ (* sum sum) (float count)))
+         (1- count))
+      nil)))
+
+
+(send statistics-class :answer :print-stats '() '(
+    (format t "Number of points: ~A~%Max: ~A~%Min: ~A~%" count max min)
+    (if retain
+        (format t "Median: ~A~%" (send self :get-median)))
+    (format t "Mean: ~A~%Std.Dev.: ~A~%"
+              (send self :get-mean) (send self :get-stddev))
+    ))
+
+
+(send statistics-class :answer :get-data '() '(data))
+                                               
+
+(send statistics-class :answer :get-median '() '(
+  (let (i)
+    (cond ((not retain) nil) ;; no data retained to examine
+          ((< count 1) nil) ;; no data to compute from
+          (t
+           (setf data (bigsort data '<))
+           (cond ((oddp count)
+                  (nth (/ count 2) data))
+                 (t
+                  (setf i (/ count 2))
+                  (* 0.5 (+ (nth i data) (nth (1- i) data))))))))))
+
+;; This is the "usual estimator of the population kurtosis" based
+;; on Wikipedia. In order for this to work, the statistics object
+;; must be initialized to *retain* the data
+;;
+(send statistics-class :answer :get-kurtosis '() '(
+  (let ((x4 0) x2
+        (n (float count)) ; "n" is just a new name for count
+        (mean (send self :get-mean))
+        (variance (send self :get-variance)))
+    (dolist (x data)
+      (setf x2 (* (- x mean) (- x mean)))
+      (setf x4 (+ x4 (* x2 x2))))
+    (display "kurtosis" x4 (* variance variance) n)
+    (if (> n 3)
+        (- (* (/ (* (1+ n) n)
+                 (* (1- n) (- n 2) (- n 3)))
+              (/ x4 (* variance variance)))
+           (/ (* 3 (1- n) (1- n))
+              (* (- n 2) (- n 3))))
+        nil))))
+
+;; :FRACTION-IN-RANGE -- proportion of values in a range
+;;
+(send statistics-class :answer :fraction-in-range '(low high) '(
+  (let ((n 0))
+    (dolist (d data)
+      (if (and (<= low d) (< d high)) (setf n (1+ n))))
+    (/ (float n) count))))
+
+            
+;; The histogram-class. Make a histogram from data.
+;;
+;; To use histogram-class, first make an instance:
+;;    (setf my-histogram (send histogram-class :new))
+;; Then add points to the histogram. For each point x:
+;;    (send my-histogram :point x)
+;; You can make a default histogram by calling:
+;;    (send my-histogram :configure-bins)
+;; This will create the square root of N bins where N is the
+;; number of points. The bins are evenly distributed across
+;; the range of the data.
+;; Alternatively, you can provide your own thresholds to
+;; determine the bins by calling:
+;;    (send my-histogram :set-thresholds an-array)
+;; Each element of an-array represents the lower bound for
+;; elements in that bin. E.g. if x is a point, it goes in
+;; bin 3 if (aref an-array 3) <= x < (aref an-array 4)
+;; Note that nothing goes into bin L-1 where L is the length
+;; of an-array.
+;; To actually compute the histogram, call
+;;    (send my-histogram :make-hist)
+;; And then you can print or plot it with:
+;;    (send my-histogram :print-hist) or
+;;    (send my-histogram :plot-hist)
+;; You can change the thresholds with :set-thresholds or
+;; :configure-bins without re-inserting all the points.
+;; You can start over by calling
+;;    (send my-histogram :init)
+;; but this probably has no advantage over making a new
+;; instance.
+
+(setf histogram-class (send class :new '(stats counts thresholds)))
+
+(send histogram-class :answer :isnew '() '((send self :init)))
+
+(send histogram-class :answer :init '() '(
+    (setf counts nil thresholds nil)
+    ; create stats object and tell it to retain points
+    (setf stats (send statistics-class :new t))))
+
+(send histogram-class :answer :point '(x) '(
+    (send stats :point x)))
+
+(send histogram-class :answer :configure-bins '() '(
+    (let* ((nbins (round (sqrt (float (send stats :get-count)))))
+           (minthreshold (send stats :get-min))
+           (step (/ (- (send stats :get-max) (send stats :get-min)) nbins)))
+      (setf thresholds (make-array (1+ nbins)))
+      (dotimes (i (1+ nbins))
+        (setf (aref thresholds i) (+ minthreshold (* i step)))))
+      thresholds))
+
+(send histogram-class :answer :set-thresholds '(array) '(
+    (setf counts nil)
+    (setf thresholds array)))
+
+
+(send histogram-class :answer :make-hist '(&key (verbose t)) '(
+    (let* ((data (send stats :get-data))
+           (counter 0) (data-position 0))
+      (if (null thresholds)
+          (send self :configure-bins))
+      (cond ((null counts)
+             (setf counts (make-array (1- (length thresholds))))
+             (dotimes (i (length counts))
+                      (setf (aref counts i) 0))))
+      (dolist (x data)
+        (cond ((and verbose (> counter 100000))
+               (format t "make-hist ~A% done\n"
+                         (* 100
+                            (/ data-position (float (send stats :get-count)))))
+               (setf counter 0)))
+        ; increment the right bin -- allows different bin sizes but
+        ; could use a binary search for the right bin
+        (dotimes (i (length counts))
+          (incf counter)
+          (cond ((and (< x (aref thresholds (1+ i)))
+                      (>= x (aref thresholds i)))
+                 (incf (aref counts i))
+                 (return))))
+        (incf data-position)) )))
+
+
+(send histogram-class :answer :print-hist '() '(
+    (if (null counts) (send self :make-hist))
+    (dotimes (i (length counts))
+             (format t "~A to ~A: ~A~%" 
+                     (aref thresholds i) (aref thresholds (1+ i))
+                     (aref counts i)))))
+
+(send histogram-class :answer :plot-hist '(&optional (offset 0)) '(
+    (if (null counts) (send self :make-hist))
+    (s-plot (snd-from-array 0
+                            (/ (- (aref thresholds 1)
+                                  (aref thresholds 0))) 
+                            counts))))
+
+(send histogram-class :answer :get-min '() '(
+    (send stats :get-min)))
+
+(send histogram-class :answer :get-max '() '(
+    (send stats :get-max)))
+
+(send histogram-class :answer :get-count '() '(
+    (send stats :get-count)))
+
+(send histogram-class :answer :get-counts '() '(
+    counts))
+
+(send histogram-class :answer :get-thresholds '() '(
+    thresholds))
+
+      
+;; Pearson correlation - direct (unstable) algorithm
+;;
+;; I created this to get the "true" answer when I was trying to
+;; debug the more complex version below. All three algorithms here
+;; now agree (within numerical roundoff), and I believe the
+;; pearson-class below is the best implementation. -RBD
+;;
+;(setf upearson-class (send class :new '(sumxy sumx sumy sumxx sumyy n)))
+;
+;(send upearson-class :answer :isnew '() '((send self :init)))
+;(send upearson-class :answer :init '() '(
+;      (setf sumxy 0 sumx 0 sumy 0 sumxx 0 sumyy 0 n 0)))
+;(send upearson-class :answer :points '(x y) '(
+;      (setf sumxy (+ sumxy (* x y)))
+;      (setf sumx (+ sumx x))
+;      (setf sumy (+ sumy y))
+;      (setf sumxx (+ sumxx (* x x)))
+;      (setf sumyy (+ sumyy (* y y)))
+;      (setf n (+ n 1))))
+;(send upearson-class :answer :correlation '() '(
+;      (/ (- (* n sumxy) (* sumx sumy))
+;         (* (sqrt (- (* n sumxx) (* sumx sumx)))
+;            (sqrt (- (* n sumyy) (* sumy sumy)))))))
+
+;; Pearson correlation
+;;
+(setf pearson-class (send class :new '(sum-sq-x sum-sq-y sum-coproduct
+                                       mean-x mean-y n)))
+(send pearson-class :answer :isnew '() '((send self :init)))
+(send pearson-class :answer :init '() '(
+    (setf n 0)
+    (setf sum-sq-x 0 sum-sq-y 0 sum-coproduct 0)))
+
+(send pearson-class :answer :points '(x y) '(
+    (cond ((zerop n)
+           (setf mean-x x mean-y y n 1))
+          (t
+           (setf n (1+ n))
+           (let* ((sweep (/ (- n 1.0) n))
+                  (delta-x (- x mean-x))
+                  (delta-y (- y mean-y)))
+             (setf sum-sq-x (+ sum-sq-x (* delta-x delta-x sweep)))
+             (setf sum-sq-y (+ sum-sq-y (* delta-y delta-y sweep)))
+             (setf sum-coproduct (+ sum-coproduct (* delta-x delta-y sweep)))
+             (setf mean-x (+ mean-x (/ delta-x n)))
+             (setf mean-y (+ mean-y (/ delta-y n))))))))
+
+(send pearson-class :answer :correlation '() '(
+    (let* ((pop-sd-x (sqrt (/ sum-sq-x n)))
+           (pop-sd-y (sqrt (/ sum-sq-y n)))
+           (cov-x-y (/ sum-coproduct n)))
+      (/ cov-x-y (* pop-sd-x pop-sd-y)))))
+
+;; This is a very direct implementation of the algorithm below,
+;; but it stores the points -- I created this for debugging but
+;; I don't see any reason to use it now. -RBD
+;(setf npearson-class (send class :new '(pts)))
+;(send npearson-class :answer :isnew '() '((send self :init)))
+;(send npearson-class :answer :init '() '((setf pts nil)))
+;(send npearson-class :answer :points '(x y) '(
+;      (setf pts (cons (cons x y) pts))))
+;(send npearson-class :answer :correlation '() '(
+;  (setf pts (reverse pts))
+;  (let ((sum-sq-x 0) (sum-sq-y 0) (sum-coproduct 0) (mean-x (caar pts))
+;        (mean-y (cdar pts)) i (n (length pts)))
+;    (dotimes (j (1- n))
+;      (let* ((i (+ j 2))
+;             (sweep (/ (- i 1.0) i))
+;             (delta-x (- (car (nth (1- i) pts)) mean-x))
+;             (delta-y (- (cdr (nth (1- i) pts)) mean-y)))
+;        (setf sum-sq-x (+ sum-sq-x (* delta-x delta-x sweep)))
+;        (setf sum-sq-y (+ sum-sq-y (* delta-y delta-y sweep)))
+;        (setf sum-coproduct (+ sum-coproduct (* delta-x delta-y sweep)))
+;        (setf mean-x (+ mean-x (/ delta-x i)))
+;        (setf mean-y (+ mean-y (/ delta-y i)))))
+;    (let ((pop-sd-x (sqrt (/ sum-sq-x n)))
+;          (pop-sd-y (sqrt (/ sum-sq-y n)))
+;          (cov-x-y (/ sum-coproduct n)))
+;      (/ cov-x-y (* pop-sd-x pop-sd-y))))))
+
+;; the algorithm (from Wikipedia)
+;sum_sq_x = 0
+;sum_sq_y = 0
+;sum_coproduct = 0
+;mean_x = x[1]
+;mean_y = y[1]
+;for i in 2 to N:
+;    sweep = (i - 1.0) / i
+;    delta_x = x[i] - mean_x
+;    delta_y = y[i] - mean_y
+;    sum_sq_x += delta_x * delta_x * sweep
+;    sum_sq_y += delta_y * delta_y * sweep
+;    sum_coproduct += delta_x * delta_y * sweep
+;    mean_x += delta_x / i
+;    mean_y += delta_y / i 
+;pop_sd_x = sqrt( sum_sq_x / N )
+;pop_sd_y = sqrt( sum_sq_y / N )
+;cov_x_y = sum_coproduct / N
+;correlation = cov_x_y / (pop_sd_x * pop_sd_y)
+
+;; Welch's t-test to test the null hypothesis that 2 population means are
+;; equal when the variances might be unequal
+;;
+;; returns list: (welchs-t degrees-of-freedom)
+;;
+(defun welchs-t-test (mean1 stddev1 n1 mean2 stddev2 n2)
+  (let* ((var1 (* stddev1 stddev1))
+         (var2 (* stddev2 stddev2))
+         (num (- mean1 mean2))
+         (den (sqrt (+ (/ var1 n1)
+                       (/ var2 n2))))
+         (welchs-t (/ num den))
+         (dof-a (+ (/ var1 n1) (/ var2 n2)))
+         (dof-num (* dof-a dof-a))
+         (dof-den (+ (/ (* var1 var1) (* n1 n1 (- n1 1)))
+                     (/ (* var2 var2) (* n2 n2 (- n2 1)))))
+         (dof (/ dof-num dof-den)))
+    (list welchs-t dof)))
+
+;; Levene's test to assess the equality of variances in different samples
+;; based on Wikipedia article. This implementation is for 2 groups. If the
+;; 2 groups can be assumed to be normal (Gaussian), then the F-test should
+;; be considered.
+;;
+;; A variation on Levene's test is the Brown-Forsythe test, which uses
+;; medians instead of means. The optional parameter, brown-forsythe can
+;; be set to true to get a Browne-Forsythe test instead of Levene's test.
+;;
+;; The verbose flag defaults to t and prints some useful information
+;;
+;; The input to levenes-test is a pair of lists of samples. The return
+;; value is W (see Wikipedia for details)
+;;
+(defun levenes-test (y1 y2 &optional brown-forsythe (verbose t))
+  (let* ((n1 (float (length y1)))
+         (n2 (float (length y2)))
+         (n (+ n1 n2))
+         m1 m2 z1 z2 z.. z1. z2. stat (den 0) w)
+    ;; compute means or medians
+    (cond (brown-forsythe
+           (setf m1 (vector-median y1))
+           (setf m2 (vector-median y2)))
+          (t
+           (setf m1 (vector-mean y1))
+           (setf m2 (vector-mean y2))))
+    ;; compute zij (lists z1 and z2)
+    (dolist (y1j y1) (push (abs (- y1j m1)) z1))
+    (dolist (y2j y2) (push (abs (- y2j m2)) z2))
+
+    ;; compute zi. sums
+    (setf z1. (vector-sum-elements z1))
+    (setf z2. (vector-sum-elements z2))
+
+    ;; compute z..
+    (setf z.. (/ (+ z1. z2.) n))
+
+    ;; convert zi. variables from sums to means
+    (setf z1. (/ z1. n1))
+    (setf z2. (/ z2. n2))
+
+    ;; compute the big denominator term
+    (dolist (z1j z1)
+      (let ((diff (- z1j z1.)))
+        (setf den (+ den (* diff diff)))))
+    (dolist (z2j z2)
+      (let ((diff (- z2j z2.)))
+        (setf den (+ den (* diff diff)))))
+
+    ;; compute w
+    (setf w (* (- n 2) (/ (+ (* n1 (* (- z1. z..) (- z1. z..)))
+                             (* n2 (* (- z2. z..) (- z2. z..))))
+                          den)))
+    ;; print info if verbose
+    (cond (verbose
+           (format t "Summary of ~A test results:
+    Size of group 1: ~A, ~A: ~A
+    Size of group 2: ~A, ~A: ~A
+    W (result): ~A
+    The significance of W is tested against F(alpha, 1, ~A),
+    where alpha is the level of significance (usually 0.05 or
+    0.01), and ~A is N-2.~%"
+                   (if brown-forsythe "Brown-Forsythe" "Levene's")
+                   n1 (if brown-forsythe "Median" "Mean") m1
+                   n2 (if brown-forsythe "Median" "Mean") m2
+                   w
+                   (- n 2) (- n 2))))
+    w))
+
+
+;; a simple test for levenes-test
+;; this program uses distributions.lsp, which must be explicitly loaded
+;;
+(defun levenes-test-test ()
+  (let (y1 y2 y3)
+    ;; make some data with sigma 0.1 and 0.2
+    (dotimes (i 50)
+      (push (gaussian-dist 1.0 0.1) y1))
+    (dotimes (i 75)
+      (push (gaussian-dist 1.0 0.2) y2))
+    (dotimes (i 75)
+      (push (gaussian-dist 1.0 0.1) y3))
+    (format t "\nTHE FOLLOWING HAVE UNEQUAL VARIANCE\n")
+    (levenes-test y1 y2) ;; levene's test
+    (format t "\n")
+    (levenes-test y1 y2 t) ;; brown-forsythe test
+    (format t "\nTHE FOLLOWING HAVE EQUAL VARIANCE\n")
+    (levenes-test y1 y3) ;; levene's test
+    (format t "\n")
+    (levenes-test y1 y3 t) ;; brown-forsythe test
+    (format t "\n")
+    'done
+  ))
diff --git a/lib/surround.lsp b/lib/surround.lsp
new file mode 100644
index 0000000..b4198f9
--- /dev/null
+++ b/lib/surround.lsp
@@ -0,0 +1,368 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SURROUND.LSP -- Implements Dolby Pro-Logic encoding
+;                  and a 2D Sound Positioning Scheme
+;;
+;;     Dave Borel (dborel) with minor changes by
+;;     Roger B. Dannenberg
+;;
+;;     Features:
+;;       -Dolby Pro-Logic panning
+;;       -Doppler for moving sounds
+;;       -Distance attenuation
+;;       -Atmospheric damping of high frequencies
+;;       -Progagation delay
+;;       -Test programs
+
+(setf config 1) ;Distance between listener and speakers
+
+;---------------------------------------------------
+;                  Math Helpers
+;---------------------------------------------------
+
+;
+; Distance between two points
+;
+(defun dist (x0 y0 x1 y1)
+  (let* ( (rx (sum x1 (mult -1.0 x0)))
+          (ry (sum y1 (mult -1.0 y0))) )
+    (s-sqrt (sum (mult rx rx) (mult ry ry)))))
+
+;
+; Raise x to each sample of snd
+;
+(defun s-expt (x snd)
+  (s-exp (mult (s-log x) snd)))
+
+
+;---------------------------------------------------
+;                Signal Processing
+;---------------------------------------------------
+
+;;
+;; DOLBY HELPERS:
+;;
+
+;
+; Smooth FFT Frame Iterator
+; (Inspired by Dannenberg's fft example)
+;
+(defun raised-cosine ()
+  (scale 0.5 
+    (sum (const 1) 
+         (lfo (/ 1.0 (get-duration 1)) 1 *sine-table* 270))))
+
+(defun fft-window (frame-size)
+  (control-srate-abs frame-size (raised-cosine)))
+
+(setf fft-class (send class :new '(sound length skip window)))
+
+(send fft-class :answer :next '() '(
+    (snd-fft sound length skip window)))
+
+(send fft-class :answer :isnew '(snd len skp) '(
+    (setf sound snd)
+    (setf length len)
+    (setf skip skp)
+    (setf window (fft-window len)) ))
+
+(defun make-fft-iterator (sound length skip)
+  (send fft-class :new (snd-copy sound) length skip))
+
+
+;;
+;; SPATIALIZATION HELPERS:
+;;
+
+;
+; Doppler effect
+;
+(defun doppler (snd r)
+  (let* ( (v (mult -1 (slope r)))
+          (ratio (recip (sum 1 (mult v (recip 344.31)))))
+          (map (integrate ratio)) )
+
+    (sound-warp map snd) ))
+
+
+;
+; Distance-based low-pass filter
+; (see report)
+;
+(defun absorb (snd r_m)
+  (lp snd (mult 14763.67 (s-expt 0.97895 r_m))))
+
+
+;
+; Distance-based attenuation
+; (see report)
+;
+(defun atten (snd r)
+
+;  (let* ( (log2_r (mult (s-log r) (recip (log 10.0))))
+;          (db_ratio (mult 20 log2_r))
+;          (ratio (db-to-linear db_ratio)) )
+;
+;    (mult (clip ratio 1.0) snd)))
+  (mult snd (clip (recip (mult r r)) 1)))
+
+;
+; Top-level spatializer
+; sound source at (x,y)
+; speaker at (xs, ys)
+; assumes listener at (0,0)
+;
+; You could use this with
+; configurations other than
+; pro-logic (e.g. 6.1, 7.1, etc)
+;
+(defun stage (snd x y xs ys)
+  (let* ( (r (dist x y 0 0))
+          (rs (dist xs ys 0 0))
+          (x_hat (mult x (recip r)))
+          (y_hat (mult y (recip r)))
+          (xs_hat (mult xs (recip rs)))
+          (ys_hat (mult ys (recip rs)))
+
+          (dot (sum (mult x_hat xs_hat) (mult y_hat ys_hat)))
+          (overlap (mult 0.5 (sum dot (s-abs dot)))) )
+    (mult overlap snd)))
+
+
+;---------------------------------------------------
+;                  Speaker Mixing
+;---------------------------------------------------
+;
+; Dolby Pro-Logic Encoder
+;
+(defun prologic (left center right surround)
+  (let* ( (c (scale 0.5 center))
+          (s (highpass2 (lowpass2 (scale 0.5 surround) 7000) 100) )
+          (slfe (scale 0.25 (lp surround 100)))
+          (l (sim left  center (mult -1.0 s) slfe))
+          (r (sim right center            s  slfe)) )
+    (vector l r)))
+
+
+;
+; Direct-to-speaker playback
+;
+(defun pl_left   (snd) (let ((s (mult 0 snd))) (prologic snd s s s)))
+(defun pl_center (snd) (let ((s (mult 0 snd))) (prologic s snd s s)))
+(defun pl_right  (snd) (let ((s (mult 0 snd))) (prologic s s snd s)))
+(defun pl_rear   (snd) (let ((s (mult 0 snd))) (prologic s s s snd)))
+            
+;
+; Pans a sound across the surround speakers
+; (no realistic imaging or attenuation)
+; Works like pan but y specifies depth
+(defun pan2d (s_in x y)
+  (let ((snd (scale 0.5 s_in)))
+    (prologic (mult snd (sum 1.0 (mult -1.0 x)
+                             (sum 1 (mult -1.0 y))) );left
+              (mult snd 0.0)                         ;center(null)
+              (mult snd x (sum 1.0 (mult -1.0 y) ))  ;right
+              (mult snd y 0.5))))                    ;rear
+
+;
+; Position a sound in the 2D soundstage
+; Includes spatialization effects
+; 
+; (x,y) may be (flonum, flonum) or (behavior, behavior)
+;
+(defun position (s_in x y config)
+  (let* ( (r_m (dist x y 0 0))
+          (r (mult r_m (recip config)))
+          (spd_snd (/ 344.31 config))
+          (offset (if (soundp r_m)
+                      (/ (aref (snd-samples r 1) 0) spd_snd)
+                      (/ r spd_snd)))
+          (snd (seq (s-rest offset)
+                    (if (soundp r_m)
+                        (atten (absorb (doppler s_in r_m) r_m) r)
+                        (atten (absorb s_in r_m) r)))) )
+    
+    ; Two Notes:
+    ; 1.) The center channel is automatically imaged correctly
+    ;     because sounds placed between the left-and-right channels
+    ;     distribute linearly between the two channels.
+    ;
+    ; 2.) Although the below settings assume that all speakers are
+    ;     equidistant from the listener, you can easily assume a
+    ;     different layout by modifying the xs and ys values in
+    ;     each channel's call to the stage function.
+    ;
+    (prologic (stage snd x y -.1913  -.4619)       ;left
+              (scale 0.0 snd)                        ;center (null)
+              (stage snd x y  .1913  -.4619)       ;right
+              (stage snd x y 0.0     .5    ))))    ;rear
+
+
+;---------------------------------------------------
+;                   Diagnostics
+;---------------------------------------------------
+
+;
+; Pro-Logic Channel Test Tones
+;
+(defun pl_test ()
+  (play (prologic
+         (                   osc-note a3 )
+         (seq (s-rest 1.25) (osc-note b3))
+         (seq (s-rest 2.5 ) (osc-note c4))
+         (seq (s-rest 3.75) (osc-note d4)) )))
+
+
+;
+; Pan Test
+;
+(defun pan_test ()
+  (play (pan2d
+         (seq
+          (s-rest .25) (osc a3 .75)
+          (s-rest .25) (osc b3 .75)
+          (s-rest .25) (osc c4 .75)
+          (s-rest .25) (osc d4 .75))
+
+         (pwl
+          0    0
+          0.99 0
+
+          1    1
+          2.99 1
+
+          3    0
+          4    0
+          4    )
+
+         (pwl
+          0    0
+          1.99 0
+
+          2    1 
+          4    1
+          4    ))))
+
+
+;
+; Doppler test
+;
+(defun dop ()
+  (play (doppler (osc c4 10) (pwl .25 0 .5 100 .75 100 1.0))))
+
+;
+; Attenuation test
+;
+(defun att ()
+  (play (atten (osc-note c4 4) 
+               (pwl 0 2
+                    1 2 
+                    2 100
+                    3 100
+                    4 2 
+                    4 ))))
+
+
+;
+; Doppler positioning test (ambulance)
+;
+(defun ambulance ()
+  (play (scale 0.2
+               (position
+
+                (stretch 16 (fmosc c4 (mult 1000 (lfo 2))))
+                
+                (pwl
+                 0  -20
+                 8   20
+                 8   )
+                
+                (pwl
+                 0    0
+                 8    )
+
+                config))))
+
+
+;
+; Position test
+;
+
+; Make a sound orbit the listener
+(defun orbit_x (r t times)
+  (let (k)
+    (seqrep (k times)
+            (pwl
+             0.0               0.0
+             (/ t 4)           r
+             (/ t 2)           0.0
+             (/ (* t 3) 4)     (* -1 r)
+             t                 0.0
+             t                 ) )))
+(defun orbit_y (r t times)
+  (let (k)
+    (seqrep (k times)
+            (pwl
+             0.0               (* -1 r)
+             (/ t 4.0)         0.0
+             (/ t 2.0)         r
+             (/ (* t 3.0)4.0)  0.0
+             t                 (* -1 r)
+             t                 ) )))
+(defun orbit (snd r t times)
+  (position snd
+            (orbit_x r t times)
+            (orbit_y r t times)
+            config))
+
+
+; Play some tones
+(defun pos_1 ()
+  (play (position
+         (seq
+          (s-rest .125) (osc a3 1.75)
+          (s-rest .25)  (osc b3 1.75)
+          (s-rest .25)  (osc c4 1.75)
+          (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+         (pwl
+          0    -5
+          1    5
+          2    5
+          3    -5
+          4    -5
+          5    5
+          6    5
+          7    -5
+          8    -5
+          8    )
+
+         (pwl
+          0    -5
+          1    -5
+          2    5
+          3    5
+          4    -5
+          5    -5
+          6    5
+          7    5
+          8    -5
+          8    )
+
+         config)))
+
+(defun pos_2 ()
+  (play (seq
+         (orbit (seq
+                (s-rest .125) (osc a3 1.75)
+                (s-rest .25)  (osc b3 1.75)
+                (s-rest .25)  (osc c4 1.75)
+                (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+               5 8 1)
+         (orbit (seq
+                (s-rest .125) (osc a3 1.75)
+                (s-rest .25)  (osc b3 1.75)
+                (s-rest .25)  (osc c4 1.75)
+                (s-rest .25)  (osc d4 1.75) (s-rest .125))
+
+               5 8 1))))
diff --git a/lib/time-delay-fns.lsp b/lib/time-delay-fns.lsp
new file mode 100644
index 0000000..551ac36
--- /dev/null
+++ b/lib/time-delay-fns.lsp
@@ -0,0 +1,90 @@
+;; a library of simple time delay functions (chorus, phaser, etc.)
+;;
+;; by Kathy Drye and Roger Dannenberg
+
+
+;; phaser
+;;       The phaser uses all-pass filter to create the delay
+
+(defun phaser (s) (sim s (alpass s 1 20)))
+
+;; an example
+;(play (phaser (s-read "example1.wav")))
+
+
+;; nyq:snd-tapv -- handles multichannel input sounds
+;;
+(defun nyq:snd-tapv (sound offset modulation maxdepth)
+  (multichan-expand #'snd-tapv sound offset modulation maxdepth))
+
+
+(defun delay-tapv (sound maxdelay delay depth rate saturation 
+                   &optional (phase 0.0))
+  ;; delay a signal by delay plus a time-varying amount controlled 
+  ;; by an LFO (sine) and add to the original sound
+  ;; delay + depth must be greater than zero and less than maxdelay
+  ;; maxdelay is a scalar
+  ;; rate is the frequency of the LFO
+  ;; saturation is the amount of modulated signal added to the
+  ;; original (normally 0 to 1)
+  ;; 
+  (let ((modulation (sum delay 
+                         (prod depth
+                               (lfo rate 10000.0 *sine-table* phase)))))
+    ;; add sound with variable delay to sound with fixed delay
+    (hp (sum (prod (nyq:snd-tapv sound 0.0 modulation maxdelay)
+                   saturation)
+             sound)
+        10)))
+
+
+;; flanger:
+;;         The flanging effect uses a time-varied delay
+;;         This version uses 0-20ms delay modulated at 0.2Hz,
+;;         with a saturation of 0.8. This flange does not use
+;;         feedback.
+
+(defun flange (input-sound)
+  (delay-tapv input-sound .02 .01 .01 0.2 0.9))
+
+
+       
+;; chorus effect
+;;
+;; chorus:
+;;        The chorus effect uses a time-varied delay
+;;        The delay is generally a longer delay with an lfo controlling
+;;        the delay operating around 0.3Hz
+
+
+(defun chorus (input-sound &key (delay 0.03) (depth 0.003) 
+                                (rate 0.3) (saturation 1.0)
+                                (phase 0.0)) 
+  (delay-tapv input-sound (+ delay depth) 
+              delay depth rate saturation phase))
+
+
+(defun stereo-chorus (input-sound &key (delay 0.03) (depth 0.003) 
+                                       (rate1 0.3) (rate2 0.1)
+                                       (saturation 1.0))
+   (sim
+       (pan (chorus input-sound :delay delay :depth depth :rate rate1
+                    :saturation saturation) .3)
+       (pan (chorus input-sound :delay delay :depth depth :rate rate1
+                    :saturation saturation :phase 180.0) .7)))
+
+
+;; examples
+;(play (chorus (aref (s-read "example1.wav") 0)))
+;
+; you can apply different parameters to each channel using delay-tapv, 
+; e.g. here the rate is different on the left and right channels 
+; (works with mono or stereo input!)
+;(play (delay-tapv (s-read "example1.wav") 0.1 0.05 0.005 (vector 0.4 0.1) 0.8))
+;
+; the STEREO-CHORUS is intended for mono input.
+;(play (stereo-chorus (mono-sound))
+
+
+
+
diff --git a/lib/vectors.lsp b/lib/vectors.lsp
new file mode 100644
index 0000000..4a930d1
--- /dev/null
+++ b/lib/vectors.lsp
@@ -0,0 +1,137 @@
+;; vectors.lsp -- a small simple vector package
+;;
+;; vectors are lists, not arrays
+;; probably one should be able to use either form (list or array)
+;; and functions should accept either
+
+(defun vector-from-array (x)
+  (let (v (n (length x)))
+    (dotimes (i n)
+      (setf v (cons (aref x (- n i 1)) v)))
+    v))
+
+(defun vector-cosine (x y)
+  (/ (vector-dot x y) (vector-norm x) (vector-norm y)))
+
+(defun vector-dot (x y)
+  (let ((d 0))
+    (dolist (e x)
+      (setf d (+ d (* e (car y))))
+      (setf y (cdr y)))
+    d))
+
+;; VECTOR-NORM -- also Euclidean distance
+;;
+(defun vector-norm (x)
+  (sqrt (float (vector-sum-elements (vector-square x)))))
+
+
+(defun vector-sum-elements (x)
+  (let ((sum 0))
+    (dolist (e x)
+      (setf sum (+ sum e)))
+    sum))
+
+(defun vector-sum (a b)
+  (let (v)
+    (dolist (e a)
+      (setf v (cons (+ e (car b)) v))
+      (setf b (cdr b)))
+    (reverse v)))
+
+(defun vector-mean (x)
+  (/ (vector-sum-elements x) (length x)))
+
+
+;; vector-median uses statistics.lsp -- you must load this explicitly
+;; before calling vector-median
+;;
+(defun vector-median (x)
+  (let ((stats (send statistics-class :new t)))
+    (dolist (e x) (send stats :point e))
+    (send stats :get-median)))
+
+
+(defun vector-offset (x c)
+  (let (v)
+    (dolist (e x)
+      (setf v (cons (+ e c) v)))
+    (reverse v)))
+
+(defun vector-difference (a b)
+  (let (v)
+    (dolist (e a)
+      (setf v (cons (- e (car b)) v))
+      (setf b (cdr b)))
+    (reverse v)))
+
+
+(defun vector-divide (a b)
+  (let (v)
+    (dolist (e a)
+      (setf v (cons (/ e (car b)) v))
+      (setf b (cdr b)))
+    (reverse v)))
+
+
+(defun vector-scale (x c)
+  (let (v)
+    (dolist (e x)
+      (setf v (cons (* e c) v)))
+    (reverse v)))
+
+
+(defun vector-zero (len)
+  (let (v)
+    (dotimes (i len) (setf v (cons 0.0 v)))))
+
+
+(defun vector-square (a)
+  (let (v)
+    (dolist (e a)
+      (setf v (cons (* e e) v)))
+    (reverse v)))
+
+
+(defun vector-variance (x)
+  (let ((n (length x))
+        (sum 0.0)
+        (sum-sqr 0.0))
+    (dotimes (i n)
+      (setf sum (+ sum (car x)))
+      (setf sum-sqr (+ sum-sqr (* (car x) (car x))))
+      (setf x (cdr x)))
+    (/ (- sum-sqr (/ (* sum sum) n)) (1- n))))
+    
+
+(defun vector-stddev (x)
+  (sqrt (vector-variance x)))
+
+;; compute autocorrelation with lag1 <= lag < lag2
+;; note that because of different overlap, the autocorrelation
+;; will be over different numbers of points (but normalized
+;; by dividing by the length). Note: It should be true that
+;; 0 <= lag1 < lag2 < length(x)
+;; Otherwise, nil is returned.
+;;
+;; Algorithm notes: len is length of input,
+;; rsltlen is length of result. The range of lags is
+;; from 0 to len - 1.
+;;
+(defun vector-autocorrelation (x lag1 lag2)
+  (prog ((len (length x)) rsltlen rslt y)
+    ;; return nil if lag conditions are not satisfied
+    (if (and (<= 0 lag1) (< lag1 lag2) (< lag2 len))
+        'ok (return nil))
+    (setf rsltlen (- lag2 lag1))
+    (setf y (nthcdr lag1 x))
+    (dotimes (i rsltlen)
+      (let ((xp x) (yp y) (sum 0.0)
+            (alen (- len (+ lag1 i))))
+        (dotimes (j alen)
+          (setf sum (+ sum (* (car xp) (car yp))))
+          (setf xp (cdr xp) yp (cdr yp)))
+        (setf rslt (cons (/ sum alen) rslt))
+        (setf y (cdr y))))
+    (return (reverse rslt))))
+
diff --git a/lib/xm-test.lsp b/lib/xm-test.lsp
new file mode 100644
index 0000000..8fb34ff
--- /dev/null
+++ b/lib/xm-test.lsp
@@ -0,0 +1,622 @@
+;; xm-test.lsp
+;;
+;; ============== some test code for xm.lsp ===============
+;;
+
+;(load "xm")
+
+'(setf pat (make-heap '(a b c d e)))
+'(dotimes (i 10) (print (next pat)))
+'(print "heap test done: ")
+'(read)
+
+
+(defun about-equal (x y)
+  (cond ((null x) (null y))
+	((consp x)
+	 (and  (consp y)
+	       (about-equal (car x) (car y))
+	       (about-equal (cdr x) (cdr y))))
+	((numberp x)
+	 (and (numberp y)
+	      (< (abs (- x y)) 0.000001)))
+	(t
+	 (equal x y))))
+
+
+(defun test (name &rest pairs)
+  (format t "TEST ~A : " name)
+  (loop
+    (cond ((or (null pairs) (null (cdr pairs)))
+	   (format t " --PASSED--~%")
+	   (return))
+	  ((not (about-equal (car pairs) (cadr pairs)))
+	   (format t " --FAILED-- ~A returned instead of ~A~%"
+		   (car pairs) (cadr pairs))
+	   (break "a test failed")
+	   (return)))
+    (setf pairs (cddr pairs))))
+      
+
+
+(setf xx (make-cycle '(x y z) :name "xx" :trace nil))
+
+(test "test" (next xx) 'x (next xx) 'y (next xx t) '(z) (next xx t) '(x y z))
+
+(setf aa (make-cycle '(a b) :name "aa" :trace nil))
+
+(setf zz (make-cycle (list xx aa)))
+
+(test "test2" (next zz) 'x (next zz) 'y (next zz t) '(z) (next zz t) '(a b))
+
+(setf zz1 (make-cycle (list xx aa) :for 1 :name "zz1"))
+
+(setf zz10 (make-cycle (list xx aa) :for 10 :name "zz10" :trace nil))
+
+(test "test3" (next zz1 t) '(x y z) (next zz1 t) '(a b) 
+      (next zz10 t) '(x y z)
+      (next zz10 t) '(a b))
+
+(setf aa1 (make-cycle '(a b) :for 1 :name "aa1"))
+
+(setf zza1 (make-cycle (list xx aa1) :name "zza1"))
+
+(test "test4" (next zza1 t) '(x y z) (next zza1 t) '(a)
+      (next zza1 t) '(x y z) (next zza1 t) '(b))
+
+
+(setf zz2 (make-cycle (list xx aa) :for 1 :name "zz2"))
+(setf zzz (make-cycle (list zz2 'q) :name "zzz"))
+
+(test "test5" (next zzz t) '(x y z) (next zzz t) '(q)
+      (next zzz t) '(a b) (next zzz t) '(q)
+      (next zzz t) '(x y z) (next zzz t) '(q))
+
+ ; test using cpat as items list
+(setf cpat (make-cycle '(a b) :name "cpat" :trace nil))
+(setf recycpat (make-cycle cpat :for 3 :name "recycpat" :trace nil))
+
+(test "test6" (next recycpat t) '(a b a)
+              (next recycpat t) '(a b a))
+
+; test length-class
+(setf lpat (make-length (make-cycle '(a b c)) 2))
+(test "length test 1" (next lpat t) '(a b) (next lpat t) '(c a))
+
+(setf lpat2 (make-length (make-cycle '(a b c)) (make-cycle '(2 1 0))))
+(test "length test 2" (next lpat2 t) '(a b) (next lpat2 t) '(c)
+      (next lpat2 t) '() (next lpat2 t) '(a b))
+
+
+(setf pp1 (make-palindrome '(a b c) 
+	   :elide (make-cycle '(:first :last t nil) :name "pp1-elide-pattern")
+	   :name "pp1"))
+(test "palindrome test" (next pp1 t) '(a b c c b) (next pp1 t) '(a b c b a)
+      (next pp1 t) '(a b c b) (next pp1 t) '(a b c c b a) 
+      (next pp1 1) '(a b c c b))
+
+
+(setf pp2 (make-palindrome '(a b c) 
+			   :elide (make-cycle '(:first :last t)) :for 3))
+(test "palindrome test 2" (next pp2 t) '(a b c) (next pp2 t) '(c b a)
+      (next pp2 t) '(a b c) (next pp2 t) '(b a b))
+
+
+(setf pp3 (make-palindrome '(a) :elide (make-cycle '(:first :last t nil))))
+(test "palindrome test 3" (next pp3 t) '(a) (next pp3 t) '(a)
+      (next pp3 t) nil (next pp3 t) '(a a))
+
+
+(setf pp4 (make-palindrome '(a b c) :elide (make-cycle '(:first :last)) 
+			   :for 6))
+(test "palindrome test 4" (next pp4 t) '(a b c c b a)
+      (next pp4 t) '(b c b a a b))
+
+(setf ll1 (make-line '(a b c d)))
+(test "line test" (next ll1 t) '(a b c d) (next ll1 t) '(d d d d))
+
+(setf nn1 (make-cycle (list 
+                       (make-cycle (list
+                                    (make-cycle '(a b) :name "ab")
+                                    (make-cycle '(c) :name "c"))
+                                    :name "ab-c")
+                       (make-cycle (list
+                                    (make-cycle '(x y) :name "xy")
+                                    (make-cycle '(u v) :name "uv"))
+                                    :name "xy-uv"))
+                       :name "ab-c-xy-uv"))
+
+(test "nested test" (next nn1 t) '(a b) (next nn1 t) '(c) (next nn1 t) '(x y)
+      (next nn1 t) '(u v) (next nn1 t) '(a b) (next nn1 t) '(c))
+
+(setf win1 (make-window (make-cycle '(a b c)) 3 1))
+
+(test "window test 1" (next win1 t) '(a b c)
+      (next win1 t) '(b c a) (next win1 t) '(c a b))
+
+(setf win2 (make-window (make-cycle '(a b c)) ; source
+			(make-cycle '(3 1))   ; length
+			(make-cycle '(1 1 3)))) ; skip
+
+(test "window test 2" (next win2 t) '(a b c)
+      (next win2 t) '(b)  ; skip 1 length 1
+      (next win2 t) '(a b c) ; skip 1 length 3
+      (next win2 t) '(a) ; skip 3 length 1
+      (next win2 t) '(b c a) ; skip 1 length 3
+      (next win2 t) '(c)  ; skip 1 length 1
+      (next win2 t) '(a b c)  ; skip 3 length 3
+      (next win2 t) '(b) ; skip 1 length 1
+      (next win2 t) '(a b c))   ; skip 1 length 3
+
+(defun only-abc-n (lis n)
+  (and (= (length lis) n)
+       (dolist (item lis t)
+	 (cond ((not (member item '(a b c)))
+		(return nil))))))
+
+(defun abc2 (lis) (only-abc-n lis 2))
+
+(defun abc3 (lis) (only-abc-n lis 3))
+
+(setf rr1 (make-random '(a b c) :name "rr1"))
+(display "rr1" (next rr1 t))
+(test "random 1" (abc3 (next rr1 t)) t (abc3 (next rr1 t)) t)
+
+(setf rr2 (make-random '(a b c) :for 2 :name "rr2" :trace nil))
+(test "random 2" (abc2 (next rr2 t)) t (abc2 (next rr2 t)) t)
+
+
+; random using weights
+(setf rr3 (make-random '((a :weight 1) (b :weight 10))))
+(setf a-count 0 b-count 0)
+(setf *num-trials* 10000) ;; NORMALLY, SET THIS TO 10000
+(setf rr3-all nil)
+(dotimes (i *num-trials*) 
+  ;(display "weight test" i)
+  (if (eq (setf rr3-out (next rr3)) 'a) (incf a-count) (incf b-count))
+  (push rr3-out rr3-all))
+;(print (reverse rr3-all))
+
+(setf rr-ratio  (/ (float a-count) b-count))
+(format t "test rr3 a/b should be 0.091, actual ratio is ~A~%" rr-ratio)
+(test "weight test" (and (< rr-ratio 0.12) (> rr-ratio 0.08)) t)
+
+
+; random using :min
+(setf rr4 (make-random '((a :weight 1 :min 2) (b :weight 10 :min 1))))
+(setf sum 0)
+(setf a-count 0 b-count 0)
+(dotimes (i *num-trials*) 
+    ;(display "min test" (next rr4))
+    (if (eq (next rr4) 'a) (incf a-count) (incf b-count))
+)
+(setf rr-ratio  (/ (float a-count) b-count))
+(format t "test rr4 a/b should be about 0.191, actual ratio is ~A~%" rr-ratio)
+(test "min test" (and (< rr-ratio 0.22) (> rr-ratio 0.16)) t)
+
+
+; random using :max
+(setf rr5 (make-random '((a :weight 1 :min 2) (b :weight 10 :max 5))))
+(setf sum 0)
+(setf rr5-all nil)
+(setf a-count 0 b-count 0)
+(dotimes (i *num-trials*) 
+    ;(display "max test" (next rr5))
+    (if (eq (setf rr5-out (next rr5)) 'a) (incf a-count) (incf b-count))
+    (push rr5-out rr5-all))
+(setf rr5-all (reverse rr5-all))
+(setf rr5-state 'a2)
+(setf rr5-count 0)
+(dolist (s rr5-all)
+  (incf rr5-count)
+  (cond ((and (eq rr5-state 'a1) (eq s 'a))
+	 (setf rr5-state 'a2))
+	((and (eq rr5-state 'a2) (eq s 'a)))
+	((and (eq rr5-state 'a2) (eq s 'b))
+	 (setf rr5-state 'b1))
+	((and (eq rr5-state 'b1) (eq s 'b))
+	 (setf rr5-state 'b2))
+	((and (eq rr5-state 'b2) (eq s 'b))
+	 (setf rr5-state 'b3))
+	((and (eq rr5-state 'b3) (eq s 'b))
+	 (setf rr5-state 'b4))
+	((and (eq rr5-state 'b4) (eq s 'b))
+	 (setf rr5-state 'b5))
+	((and (eq rr5-state 'b1) (eq s 'a))
+	 (setf rr5-state 'a1))
+	((and (eq rr5-state 'b2) (eq s 'a))
+	 (setf rr5-state 'a1))
+	((and (eq rr5-state 'b3) (eq s 'a))
+	 (setf rr5-state 'a1))
+	((and (eq rr5-state 'b4) (eq s 'a))
+	 (setf rr5-state 'a1))
+	((and (eq rr5-state 'b5) (eq s 'a))
+	 (setf rr5-state 'a1))
+	(t
+	 (error "bad state"))))
+
+(setf rr-ratio  (/ (float a-count) b-count))
+(format t "test rr5 a/b should be 0.503613, actual ratio is ~A~%" rr-ratio)
+(test "max test" (and (> rr-ratio 0.4) (< rr-ratio 0.6)) t)
+
+
+(setf hh1 (make-heap '(a b c)))
+(test "heap 1" (abc3 (next hh1 t)) t (abc3 (next hh1 t)) t)
+
+(setf hh2 (make-heap '(a b c) :for 2 :name "hh2" :trace nil))
+(test "heap 2" (abc2 (next hh2 t)) t (abc2 (next hh2 t)) t)
+
+(setf xx (make-markov `((a -> a (b ,(make-cycle '(1 2)))) (b -> a))
+                      :past '(b)
+                      :produces `(a ,(make-cycle '(0))
+                                  b ,(make-cycle '(1 2 3 4) 
+                                      :trace nil :name "b-produces"))
+                      :is-nested t
+                      :trace nil :name "markov"))
+(setf xx-out nil)
+(dotimes (i 12) (push (next xx) xx-out))
+(setf xx-out (reverse xx-out))
+(print xx-out)
+;; this is a special test to see if the output is plausible
+(defun markov-test-xx (lis)
+  (let (a b)
+    (setf a (car lis))
+    (setf lis (cdr lis))
+    (cond ((null lis) t)
+          ((and (setf b (car lis))
+                (eq a 0) (member b '(0 1)))
+           (markov-test-xx lis))
+          ((and (eq a 1) (eq b 2))
+           (markov-test-xx lis))
+          ((and (eq a 2) (eq b 3))
+           (markov-test-xx lis))
+          ((and (eq a 3) (eq b 4))
+           (markov-test-xx lis))
+          ((and (= a 4) (= b 0))
+           (markov-test-xx lis))
+          (t nil))))
+(format t "TEST markov test :  ~A~%" (if (markov-test-xx xx-out) "--PASSED--"
+                                       (break "markov test failed")))
+
+
+(setf cc (make-copier (make-cycle '(a b) :name "ab" :trace nil) 
+                      :repeat 3 :name "copier" :trace nil :merge t))
+
+(test "copier test 1" (next cc t) '(a b a b a b) (next cc t) '(a b a b a b))
+
+(setf cc2 (make-copier (make-cycle '(a b) :name "ab" :trace nil) 
+                      :repeat 3 :name "copier" :trace nil))
+
+(test "copier test 2" (next cc2 t) '(a b) (next cc2 t) '(a b) (next cc2 t) '(a b))
+
+(setf cc3 (make-copier (make-cycle (list (make-cycle '(a)) (make-cycle '(b))))
+                       :repeat 3 :merge t))
+
+(test "copier test 3" (next cc3 t) '(a a a) (next cc3 t) '(b b b)
+                      (next cc3 t) '(a a a))
+
+(setf cc4 (make-copier (make-cycle '(a b c d) :for 1)
+		       :repeat (make-cycle '(2 -2 3 -3)) 
+		       :merge t))
+(test "copier test 4" (next cc4 t) '(a a) (next cc4 t) '(d d d)
+      (next cc4 t) '(d d) (next cc4 t) '(c c c))
+
+(setf cc5 (make-copier (make-cycle '(a b c d) :for 1)
+		       :repeat 3))
+(test "compier test 5" (next cc5 t) '(a) (next cc5 t) '(a)
+      (next cc5 t) '(a) (next cc5 t) '(b) (next cc5 t) '(b)
+      (next cc5 t) '(b) (next cc5 t) '(c) (next cc5 t) '(c)
+      (next cc5 t) '(c) (next cc5 t) '(d) (next cc5 t) '(d) 
+      (next cc5 t) '(d) (next cc5 t) '(a) (next cc5 t) '(a))
+
+
+(setf acc1 (make-accumulate (make-cycle '(1 2 -3))))
+
+(test "accumulate test 1" (next acc1 t) '(1 3 0) (next acc1 t) '(1 3 0))
+
+(setf acc2 (make-accumulate (make-cycle '(1 2 -3) :for 2)))
+
+(test "accumulate test 2" (next acc2 t) '(1 3) (next acc2 t) '(0 1)
+      (next acc2 t) '(3 0))
+
+(setf sum1 (make-sum (make-cycle '(1 2)) (make-cycle '(3 4 5))))
+
+(test "sum test 1" (next sum1 t) '(4 6) (next sum1 t) '(6 5)
+                   (next sum1 t) '(5 7))
+
+(setf sum2 (make-sum (make-cycle '(1 2)) (make-cycle '(3 4 5)) :for 4))
+
+(test "sum test 2" (next sum2 t) '(4 6 6 5) (next sum2 t) '(5 7 4 6))
+
+(setf prod1 (make-product (make-cycle '(1 2)) (make-cycle '(3 4 5))))
+
+(test "prod test 1" (next prod1 t) '(3 8) (next prod1 t) '(5 6)
+                    (next prod1 t) '(4 10))
+
+(setf prod2 (make-product (make-cycle '(1 2)) (make-cycle '(3 4 5)) :for 4))
+
+(test "prod test 2" (next prod2 t) '(3 8 5 6) (next prod2 t) '(4 10 3 8))
+
+(setf eval1 (make-eval '(+ 1 2) :for 3))
+
+(test "eval test 1" (next eval1 t) '(3 3 3))
+
+#|
+
+(setf testscore '((0 0 (score-begin-end 0 10))
+		  (0.1 1 (note :pitch 60 :vel 100))
+		  (1 1 (note :pitch 61 :vel 91))
+		  (1 0.5 (note :pitch 68 :vel 92))
+		  (1.5 0.5 (note :pitch 67 :vel 93))
+		  (2  1 (note :pitch 62 :vel 94))))
+
+(test "basic1" (score-get-begin testscore) 0)
+(test "basic2" (score-get-end testscore) 10)
+(test "basic3" (score-set-begin testscore 1) 
+               (cons '(0 0 (score-begin-end 1 10)) (cdr testscore)))
+(test "basic4" (score-set-end testscore 4)
+               (cons '(0 0 (score-begin-end 0 4)) (cdr testscore)))
+(test "basic5" (score-get-begin (cdr testscore)) 0.1)
+(test "basic6" (score-get-end (cdr testscore)) 3)
+
+(test "score-shift" (score-shift testscore 5)
+      '((0 0 (SCORE-BEGIN-END 0 15))
+	(5.1 1 (NOTE :PITCH 60 :VEL 100))
+	(6 0.5 (NOTE :PITCH 68 :VEL 92))
+	(6 1 (NOTE :PITCH 61 :VEL 91))
+	(6.5 0.5 (NOTE :PITCH 67 :VEL 93))
+	(7 1 (NOTE :PITCH 62 :VEL 94))
+	))
+
+(test "score-stretch1" (setf xx (score-stretch testscore 2))
+      (setf yy '((0 0 (SCORE-BEGIN-END 0 20))
+	(0.2 2 (NOTE :PITCH 60 :VEL 100))
+	(2 2 (NOTE :PITCH 61 :VEL 91))
+	(2 1 (NOTE :PITCH 68 :VEL 92))
+	(3 1 (NOTE :PITCH 67 :VEL 93))
+	(4 2 (NOTE :PITCH 62 :VEL 94))
+	)))
+
+(test "score-stretch2" (score-stretch testscore 2 :dur nil)
+      '((0 0 (SCORE-BEGIN-END 0 20))
+	(0.2 1 (NOTE :PITCH 60 :VEL 100))
+	(2 1 (NOTE :PITCH 61 :VEL 91))
+	(2 0.5 (NOTE :PITCH 68 :VEL 92))
+	(3 0.5 (NOTE :PITCH 67 :VEL 93))
+	(4 1 (NOTE :PITCH 62 :VEL 94))
+	))
+
+(test "score-stretch3" (score-stretch testscore 2 :from-index 2 :to-index 3)
+      '((0 0 (SCORE-BEGIN-END 0 10.5))
+	(0.1 1.1 (NOTE :PITCH 60 :VEL 100))
+	(1 1.5 (NOTE :PITCH 61 :VEL 91))
+	(1 1 (NOTE :PITCH 68 :VEL 92))
+	(2 0.5 (NOTE :PITCH 67 :VEL 93))
+	(2.5 1 (NOTE :PITCH 62 :VEL 94))
+	))
+
+(test "score-stretch4" (score-stretch testscore 2 :from-time 1.5 :to-time 2.5)
+      '((0 0 (SCORE-BEGIN-END 0 11))
+	(0.1 1 (NOTE :PITCH 60 :VEL 100))
+	(1 1.5 (NOTE :PITCH 61 :VEL 91))
+	(1 0.5 (NOTE :PITCH 68 :VEL 92))
+	(1.5 1 (NOTE :PITCH 67 :VEL 93))
+	(2.5 1.5 (NOTE :PITCH 62 :VEL 94))
+	))
+
+
+(test "score-transpose1" (score-transpose testscore :pitch 5)
+      '((0 0 (score-begin-end 0 10))
+	(0.1 1 (note :pitch 65 :vel 100))
+	(1 1 (note :pitch 66 :vel 91))
+	(1 0.5 (note :pitch 73 :vel 92))
+	(1.5 0.5 (note :pitch 72 :vel 93))
+	(2  1 (note :pitch 67 :vel 94))))
+
+(test "score-transpose1" (score-transpose testscore :pitch 5 
+					  :from-index 2 :to-index 3)
+      '((0 0 (score-begin-end 0 10))
+	(0.1 1 (note :pitch 60 :vel 100))
+	(1 1 (note :pitch 66 :vel 91))
+	(1 0.5 (note :pitch 73 :vel 92))
+	(1.5 0.5 (note :pitch 67 :vel 93))
+	(2  1 (note :pitch 62 :vel 94))))
+
+(test "score-scale1" (score-scale testscore :vel 0.5)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+	(0.1 1 (NOTE :PITCH 60 :VEL 50))
+	(1 1 (NOTE :PITCH 61 :VEL 45.5))
+	(1 0.5 (NOTE :PITCH 68 :VEL 46))
+	(1.5 0.5 (NOTE :PITCH 67 :VEL 46.5))
+	(2 1 (NOTE :PITCH 62 :VEL 47))
+	))
+
+(test "score-scale2" (score-scale testscore :vel 0.5
+				 :from-time 1 :to-time 1.5)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+	(0.1 1 (NOTE :PITCH 60 :VEL 100))
+	(1 1 (NOTE :PITCH 61 :VEL 45.5))
+	(1 0.5 (NOTE :PITCH 68 :VEL 46))
+	(1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+	(2 1 (NOTE :PITCH 62 :VEL 94))
+	))
+
+(test "score-sustain1" (score-sustain testscore 2) 
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+	(0.1 2 (NOTE :PITCH 60 :VEL 100)) 
+	(1 2 (NOTE :PITCH 61 :VEL 91))
+	(1 1 (NOTE :PITCH 68 :VEL 92)) 
+	(1.5 1 (NOTE :PITCH 67 :VEL 93)) 
+	(2 2 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-sustain2" (score-sustain testscore 2
+				      :from-index 0 :to-index 1)
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+	(0.1 2 (NOTE :PITCH 60 :VEL 100)) 
+	(1 1 (NOTE :PITCH 61 :VEL 91))
+	(1 0.5 (NOTE :PITCH 68 :VEL 92)) 
+	(1.5 0.5 (NOTE :PITCH 67 :VEL 93)) 
+	(2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-voice1" (score-voice testscore '((note violin)))
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+	(0.1 1 (VIOLIN :PITCH 60 :VEL 100)) 
+	(1 1 (VIOLIN :PITCH 61 :VEL 91))
+	(1 0.5 (VIOLIN :PITCH 68 :VEL 92)) 
+	(1.5 0.5 (VIOLIN :PITCH 67 :VEL 93)) 
+	(2 1 (VIOLIN :PITCH 62 :VEL 94))))
+
+(test "score-voice2" (score-voice testscore '((flute horn) (note violin))
+				      :from-index 0 :to-index 10)
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+	(0.1 1 (VIOLIN :PITCH 60 :VEL 100)) 
+	(1 1 (VIOLIN :PITCH 61 :VEL 91))
+	(1 0.5 (VIOLIN :PITCH 68 :VEL 92)) 
+	(1.5 0.5 (VIOLIN :PITCH 67 :VEL 93)) 
+	(2 1 (VIOLIN :PITCH 62 :VEL 94))))
+
+'(score-print (score-merge testscore 
+				  (score-shift 
+				   (score-voice testscore '((note violin)))
+				   0.1)))
+
+
+(test "score-merge1" (score-merge testscore 
+				  (score-shift 
+				   (score-voice testscore '((note violin)))
+				   0.1))
+      '((0 0 (SCORE-BEGIN-END 0 10.1))
+	(0.1 1 (NOTE :PITCH 60 :VEL 100))
+	(0.2 1 (VIOLIN :PITCH 60 :VEL 100))
+	(1 1 (NOTE :PITCH 61 :VEL 91))
+	(1 0.5 (NOTE :PITCH 68 :VEL 92))
+	(1.1 0.5 (VIOLIN :PITCH 68 :VEL 92))
+	(1.1 1 (VIOLIN :PITCH 61 :VEL 91))
+	(1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+	(1.6 0.5 (VIOLIN :PITCH 67 :VEL 93))
+	(2 1 (NOTE :PITCH 62 :VEL 94))
+	(2.1 1 (VIOLIN :PITCH 62 :VEL 94))
+	))
+
+(test "score-merge2" (score-merge 
+                       '((0 0 (SCORE-BEGIN-END 0 10))
+                         (0 1 (NOTE :PITCH 60 :VEL 100)))
+                       '((0 0 (SCORE-BEGIN-END 0 10))
+                         (1 1 (NOTE :PITCH 61 :VEL 91)))
+                       '((0 0 (SCORE-BEGIN-END 0 10))
+                         (2 1 (NOTE :PITCH 62 :VEL 94))))
+      '((0 0 (SCORE-BEGIN-END 0 10))
+        (0 1 (NOTE :PITCH 60 :VEL 100))
+        (1 1 (NOTE :PITCH 61 :VEL 91))
+        (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-append1" 
+      (score-append testscore testscore) 
+      '((0 0 (SCORE-BEGIN-END 0 20))
+        (0.1 1 (NOTE :PITCH 60 :VEL 100))
+        (1 1 (NOTE :PITCH 61 :VEL 91))
+        (1 0.5 (NOTE :PITCH 68 :VEL 92))
+        (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (2 1 (NOTE :PITCH 62 :VEL 94))
+        (10.1 1 (NOTE :PITCH 60 :VEL 100))
+        (11 1 (NOTE :PITCH 61 :VEL 91))
+        (11 0.5 (NOTE :PITCH 68 :VEL 92))
+        (11.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (12 1 (NOTE :PITCH 62 :VEL 94))))
+
+
+(test "score-select1"
+      (score-select testscore t :from-time 1 :to-time 1.5)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+        (1 1 (NOTE :PITCH 61 :VEL 91))
+        (1 0.5 (NOTE :PITCH 68 :VEL 92))))
+
+(test "score-select2"
+      (score-select testscore 
+          '(lambda (time dur expr) (eql (expr-get-attr expr :pitch) 61))
+          :from-time 1 :to-time 1.5)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+        (1 1 (NOTE :PITCH 61 :VEL 91))))
+
+(test "score-select3"
+      (score-select testscore 
+        '(lambda (time dur expr) (eql (expr-get-attr expr :pitch) 61))
+        :reject t)
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+        (0.1 1 (NOTE :PITCH 60 :VEL 100)) 
+        (1 0.5 (NOTE :PITCH 68 :VEL 92)) 
+        (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-filter-length"
+      (score-filter-length testscore 1.5)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+        (0.1 1 (NOTE :PITCH 60 :VEL 100))
+        (1 0.5 (NOTE :PITCH 68 :VEL 92))))
+
+(test "score-repeat"
+      (score-repeat testscore 3)
+      '((0 0 (SCORE-BEGIN-END 0 30))
+        (0.1 1 (NOTE :PITCH 60 :VEL 100))
+        (1 0.5 (NOTE :PITCH 68 :VEL 92))
+        (1 1 (NOTE :PITCH 61 :VEL 91))
+        (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (2 1 (NOTE :PITCH 62 :VEL 94))
+        (10.1 1 (NOTE :PITCH 60 :VEL 100))
+        (11 1 (NOTE :PITCH 61 :VEL 91))
+        (11 0.5 (NOTE :PITCH 68 :VEL 92))
+        (11.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (12 1 (NOTE :PITCH 62 :VEL 94))
+        (20.1 1 (NOTE :PITCH 60 :VEL 100))
+        (21 1 (NOTE :PITCH 61 :VEL 91))
+        (21 0.5 (NOTE :PITCH 68 :VEL 92))
+        (21.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (22 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-stretch-to-length"
+      (score-stretch-to-length testscore 20)
+      '((0 0 (SCORE-BEGIN-END 0 20))
+        (0.2 2 (NOTE :PITCH 60 :VEL 100))
+        (2 2 (NOTE :PITCH 61 :VEL 91))
+        (2 1 (NOTE :PITCH 68 :VEL 92))
+        (3 1 (NOTE :PITCH 67 :VEL 93))
+        (4 2 (NOTE :PITCH 62 :VEL 94))
+        ))
+
+(test "score-filter-overlap"
+      (score-filter-overlap testscore)
+      '((0 0 (SCORE-BEGIN-END 0 10))
+        (0.1 1 (NOTE :PITCH 60 :VEL 100))
+        (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-adjacent-events1"
+      (score-adjacent-events testscore #'(lambda (a b c) b))
+      testscore)
+
+(test "score-adjacent-events2"
+      (score-adjacent-events testscore
+         #'(lambda (a b c) 
+            (if (eql (event-get-attr b :pitch) 61)
+	      nil b))) ; remove pitches with 61
+      '((0 0 (SCORE-BEGIN-END 0 10)) 
+        (0.1 1 (NOTE :PITCH 60 :VEL 100)) 
+        (1 0.5 (NOTE :PITCH 68 :VEL 92)) 
+        (1.5 0.5 (NOTE :PITCH 67 :VEL 93))
+        (2 1 (NOTE :PITCH 62 :VEL 94))))
+
+(test "score-indexof"
+      (score-indexof testscore #'(lambda (time dur expr)
+                                  (eql (expr-get-attr expr :pitch) 61)))
+      2)
+
+(test "score-last-indexof"
+      (score-last-indexof testscore #'(lambda (time dur expr)
+                                  (> (expr-get-attr expr :pitch) 65)))
+      4)
+
+
+|#
+
+
+