20 files changed, 967 insertions, 0 deletions
diff --git a/demos/pmorales/a4.lsp b/demos/pmorales/a4.lsp
new file mode 100644
index 0000000..6c39f22
--- /dev/null
+++ b/demos/pmorales/a4.lsp
@@ -0,0 +1,25 @@
+;;; SIMPLE SYNTHESIS
+;;; Waveform + Envelope. Modulating the envelope with noise
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun shiver (dur frq noise-percent noise-frq)
+  (mult (osc frq dur)
+        (sum (pwlv 5e-2 300e-3 1.0 (- dur 300e-3) 1.0 dur 2e-3)
+             (mult (/ noise-percent 100.0) (randi1 noise-frq dur)))))
+
+; when noise-percent is too big (> 40), there is a click risk at the
+; beginning and the end of the note
+; this would be avoided if randi function were multiplied by a smooth envelope
+; WARNING: randi1 is defined in PJMG.LSP
+
+(defun shiver-demo ()
+  (ss (seq (shiver 1 c5 20 40)
+           (shiver 1 b4 50 40)
+           (shiver 1 a4 80 40)
+           (shiver 1 g4 20 300)
+           (shiver 1 f4 50 300)
+           (shiver 1 d4 80 300))))
diff --git a/demos/pmorales/a5.lsp b/demos/pmorales/a5.lsp
new file mode 100644
index 0000000..33ef37e
--- /dev/null
+++ b/demos/pmorales/a5.lsp
@@ -0,0 +1,20 @@
+;;; SIMPLE SYNTHESIS
+;;; Waveform + Envelope. Modulating the frequency
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun whiny (dur frq)
+  (let ((lfo-f (step-to-hz frq)))
+    (mult (pwl 0.1 1 (- dur 0.1) 1 dur)
+          (fmosc frq (pwl (* 0.1 dur) (/ lfo-f -2.0)
+                          (* 0.25 dur) (* lfo-f 2.0)
+                          (* 0.3 dur) (* lfo-f 1.5)
+                          (* 0.7 dur) (* lfo-f -7.0 (/ 8.0))
+                          dur (* lfo-f -15.0 (/ 16.0))
+                          ))))) 
+
+(defun whiny-demo () (ss (whiny 10 a5)))
+
diff --git a/demos/pmorales/a6.lsp b/demos/pmorales/a6.lsp
new file mode 100644
index 0000000..a50334f
--- /dev/null
+++ b/demos/pmorales/a6.lsp
@@ -0,0 +1,33 @@
+;;; SIMPLE SYNTHESIS
+;;; Waveform + Envelope. Modulating the frequency, 2
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun saw-table ()
+  (setf *saw-table* (pwlv 1.0 1.0 0.0))
+  (setf *saw-table* (list *saw-table* (hz-to-step 1) T)))
+
+(if (not (boundp '*saw-table*)) (saw-table))
+
+(defun cheap (frq-randi frq dur lfor lfoi)
+  (mult (randi1 frq-randi dur) 
+        (fmosc frq (mult (const lfoi dur)
+                         (osc (hz-to-step lfor) dur *saw-table*)))))
+
+
+(defun callas (dur frq vib-r vib-w)
+  (mult (pwl 0.1 1.0 (- dur 0.1) 1.0 dur)
+        (fmosc frq (mult (const vib-w dur)
+                         (sine (hz-to-step vib-r) dur)))))
+
+(defun callas-demo ()
+  (ss (seq (sim (at 0.0 (cheap 80 a4 6.5 3 1000))
+                (at 2.5 (cheap 150 a5 6.5 3 750)))
+           (callas 1 a4 5 24)
+           (callas 0.5 e5 5 24) (callas 0.5 f5 5 24) (callas 1 a5 5 24)
+           (callas 1 c6 5 24) (callas 1 e6 5 24)
+           (callas 1 g4 5 24) (callas 1 f4 5 24)
+          (callas 3 e4 5 24))))
diff --git a/demos/pmorales/b1.lsp b/demos/pmorales/b1.lsp
new file mode 100644
index 0000000..1938ad5
--- /dev/null
+++ b/demos/pmorales/b1.lsp
@@ -0,0 +1,60 @@
+;;; ADDITIVE SYNTHESIS
+;;; Gong like sounds
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+
+(defun add-partial (dur frq scal)
+  (amosc (hz-to-step frq) (pwev scal dur (* scal 1e-2))))
+
+(defun gong-1 ()
+    (sim (add-partial 4 240 3.0)
+         (add-partial 4 277 2.5)
+         (add-partial 4 385 2.0)
+         (add-partial 4 605 3.0)
+         (add-partial 4 340 1.0)
+         (add-partial 4 670 1.0)
+         (add-partial 4 812 1.0)))
+
+(defun add-partial-2 (frq scal)
+  (amosc (hz-to-step frq) (pwev scal (/ (* 6 240) frq) (* scal 1e-2))))
+
+(defun gong-2 ()
+  (sim (add-partial-2 240 3.0)
+       (add-partial-2 277 2.5)
+       (add-partial-2 385 2.0)
+       (add-partial-2 605 3.0)
+       (add-partial-2 340 1.0)
+       (add-partial-2 670 1.0)
+       (add-partial-2 812 1.0)))
+
+(defun add-partial-3 (frq fratio dur amp)
+  (amosc (hz-to-step (* frq fratio)) (pwev amp (/ dur fratio) (* amp 1e-2))))
+
+(defun gong-3 (frq dur)
+  (sim (add-partial-3 frq 1.0 dur 2.0)
+       (add-partial-3 frq 2.0 dur 2.0)
+       (add-partial-3 frq 2.4 dur 2.0)
+       (add-partial-3 frq 3.0 dur 2.0)
+       (add-partial-3 frq 4.5 dur 3.0)
+       (add-partial-3 frq 5.33 dur 3.0)
+       (add-partial-3 frq 6.0 dur 3.0)))
+
+
+(defun gong-3-melody ()
+  (sim (at 0.0 (gong-3 329 5))
+       (at 0.2 (gong-3 360 6))
+       (at 0.4 (gong-3 380 5))
+       (at 0.6 (gong-3 300 8))
+       (at 0.8 (gong-3 430 4))
+       (at 2.0 (gong-3 640 4))
+       (at 2.2 (gong-3 610 5))
+       (at 2.4 (gong-3 580 4))
+       (at 2.6 (gong-3 660 5))))
+
+(defun gong-3-demo () (ss (gong-3-melody)))
+
+
diff --git a/demos/pmorales/b10.lsp b/demos/pmorales/b10.lsp
new file mode 100644
index 0000000..70a6941
--- /dev/null
+++ b/demos/pmorales/b10.lsp
@@ -0,0 +1,63 @@
+;;; ADDITIVE SYNTHESIS
+;;; Sinus Chaos
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun env31 ()
+  (pwlv 0.99 25e-3 0.99 225e-3 0.318 275e-3 0.318 475e-3 0.99 500e-3 0.99))
+
+(defun env32 ()
+  (pwlv 0.377 250e-3 0.99 500e-3 0.377))
+
+(defun env33 ()
+  (pwlv 0.5 20e-3 0.5 225e-3 0.99 250e-3 0.99 480e-3 0.5 500e-3 0.5))
+
+(defun env34 ()
+  (pwlv 0.333 25e-3 0.333 225e-3 0.999 275e-3 0.999 475e-3 0.333 500e-3 0.333))
+
+(defun make-env31 ()
+  (setf *env31* (list (env31) (hz-to-step 2) T)))
+
+(defun make-env32 ()
+  (setf *env32* (list (env32) (hz-to-step 2) T)))
+
+(defun make-env33 ()
+  (setf *env33* (list (env33) (hz-to-step 2) T)))
+
+(defun make-env34 ()
+  (setf *env34* (list (env34) (hz-to-step 2) T)))
+
+(if (not (boundp '*env31*)) (make-env31))
+(if (not (boundp '*env32*)) (make-env32))
+(if (not (boundp '*env33*)) (make-env33))
+(if (not (boundp '*env34*)) (make-env34))
+
+(defun make-table12 ()
+  (setf *table12* (sim (build-harmonic 21.0 2048)
+                       (build-harmonic 29.0 2048)
+                       (build-harmonic 39.0 2048)))
+  (setf *table12* (list *table12* (hz-to-step 1) T)))
+
+(if (not (boundp '*table12*)) (make-table12))
+
+
+(defun chaos-partial (amp rate frq dur env &optional (table *table*))
+  (scale amp (fmosc (hz-to-step 1e-3)
+                    (scale frq (osc (hz-to-step rate) dur env)) table)))
+
+(defun partial2 (amp frandi rate frq dur env)
+  (mult (randi1 frandi dur)
+        (scale amp (fmosc (hz-to-step 1e-3)
+                          (scale frq (osc (hz-to-step rate) dur env))))))
+
+(ss
+ (sim
+   (chaos-partial 4.5 0.12 880.0  24 *env31*)
+   (partial2      4.0 200.0 0.17  1660.0 24 *env32*)
+   (chaos-partial 1.2 0.05 200.0  24 *env33*)
+   (chaos-partial 0.7 0.33 2400.0 24 *env34*)
+
+  ))
diff --git a/demos/pmorales/b2.lsp b/demos/pmorales/b2.lsp
new file mode 100644
index 0000000..c529cd1
--- /dev/null
+++ b/demos/pmorales/b2.lsp
@@ -0,0 +1,45 @@
+;;; ADDITIVE SYNTHESIS
+;;; Risset's Spectral Analysis of a Chord
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+; Probar con las dos envolventes
+;(defun sac-env (dur)
+;  (let ((xx (pwl (/ dur 2) 1.0 dur)))
+;    (mult xx xx)))
+
+(defun sac-env (dur)
+  (pwev 1.0 dur 5e-2))
+
+(defun attk-list (offset num-harms &optional (out-list (list 0.0)))
+  (if (= num-harms 0) (reverse out-list)
+      (attk-list offset (1- num-harms) (cons (+ offset (car out-list)) out-list))))
+
+  
+(defun sac (frq dur offset-entry num-harm)
+    (mapcar #'(lambda (xhrm xoff)
+                (at xoff (amosc (hz-to-step (* (step-to-hz frq) xhrm)) (sac-env dur))))
+           (attk-list -1 (1- num-harm) (list num-harm))
+           (attk-list offset-entry (1- num-harm))))
+
+(defun sac-left-right (l)
+  (do* ((i 0 (1+ i))
+        (left () (if (evenp i) (cons (nth i l) left) left))
+        (right () (if (oddp i) (cons (nth i l) right) right)))
+       ((= i  (1- (length l))) (vector (apply #'sim left) (apply #'sim right))))) 
+
+(defun st-sac (frq dur offset-entry num-harm)
+  (sac-left-right (sac frq dur offset-entry (1+ num-harm))))
+
+(defun st-sac-sequence ()
+  (scale 0.17 (sim (at 0.0 (st-sac as6 7.5 2.5 5))
+                   (at 0.01 (st-sac b5 7.5 2.5 5))
+                   (at 3.75 (st-sac e5 3.75 1.25 9))
+                   (at 3.76 (st-sac g5 3.75 1.25 9))
+                   (at 5.5 (st-sac d4 2 1.0 11))
+                   (at 5.51 (st-sac gs3 2 1.0 11)))))
+
+(defun st-sac-demo () (ss (st-sac-sequence)))
diff --git a/demos/pmorales/b3.lsp b/demos/pmorales/b3.lsp
new file mode 100644
index 0000000..c4c7b33
--- /dev/null
+++ b/demos/pmorales/b3.lsp
@@ -0,0 +1,40 @@
+;;; ADDITIVE SYNTHESIS
+;;; Risset Bell
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun bell-partial (amp dur frq)
+  (amosc (hz-to-step frq) (pwev amp dur (* amp 12e-5))))
+
+(defun risset-bell (amp dur frq)
+  (sim
+    (bell-partial amp dur (* frq .56))
+    (bell-partial (* amp .67) (* dur .9) (+ (* frq .56) 1))
+    (bell-partial (* amp 1.35) (* dur .65) (* frq .92))
+    (bell-partial (* amp 1.8) (* dur .55) (+ (* frq .92) 1.7))
+    (bell-partial (* amp 2.67) (* dur .325) (* frq 1.19))
+    (bell-partial (* amp 1.67) (* dur .35) (* frq 1.7))
+    (bell-partial (* amp 1.46) (* dur .25) (* frq 2.0))
+    (bell-partial (* amp 1.33) (* dur .2) (* frq 2.74))
+    (bell-partial (* amp 1.33) (* dur .15) (* frq 3.0))
+    (bell-partial amp (* dur .1) (* frq 3.76))
+    (bell-partial (* amp 1.33) (* dur .075) (* frq 4.07))))
+
+
+(defun risset-bell-sequence ()
+  (sim (at 0.0 (risset-bell 1.0 4.0 999.0))
+       (at 2.0 (risset-bell 1.0 4.0 633.0))
+       (at 4.0 (risset-bell 1.0 4.0 211.0))
+       (at 6.0 (risset-bell 1.0 4.0 999.0))
+       (at 8.0 (risset-bell 0.7 20.0 633.0))
+       (at 10.0 (risset-bell 0.7 20.0 211.0))
+       (at 12.0 (risset-bell 0.7 20.0 999.0))
+       (at 14.0 (risset-bell 0.7 20.0 80.0))))
+
+(defun risset-bell-demo () (ss (m)))
+  
+
+
diff --git a/demos/pmorales/b5.lsp b/demos/pmorales/b5.lsp
new file mode 100644
index 0000000..30e568d
--- /dev/null
+++ b/demos/pmorales/b5.lsp
@@ -0,0 +1,19 @@
+;;; ADDITIVE SYNTHESIS
+;;; Continuous pitch control by LFO
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun lfo-pitch-control ()
+  (pwlv 0.25 0.6 0.25 1.4 0.5 2.0 0.25 2.2 0.25 3.4 0.5 3.8 0.75 7.0 -0.2))
+
+(defun starship (frq scl)
+  (apply #'sim
+         (mapcar #'(lambda (offset)
+                     (fmosc (hz-to-step (+ frq offset))
+                            (scale scl (lfo-pitch-control))))
+                 '(0.0 4.5 9.4 23.0 39.0 84.0))))
+
+(defun starship-demo () (ss (starship 200.0 1000.0)) )
diff --git a/demos/pmorales/b7.lsp b/demos/pmorales/b7.lsp
new file mode 100644
index 0000000..4a0a2fe
--- /dev/null
+++ b/demos/pmorales/b7.lsp
@@ -0,0 +1,40 @@
+;;; ADDITIVE SYNTHESIS
+;;; Risset Tibetan
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun tibetan-wave ()
+  (setf *tibetan-table*
+    (sim (scale 0.3 (build-harmonic 1 2048))
+         (scale 0.1 (build-harmonic 5 2048))
+         (scale 0.1 (build-harmonic 6 2048))
+         (scale 0.1 (build-harmonic 7 2048))
+         (scale 0.1 (build-harmonic 6 2048))
+         (scale 0.1 (build-harmonic 8 2048))
+         (scale 0.1 (build-harmonic 9 2048))))
+  (setf *tibetan-table* (list *tibetan-table* (hz-to-step 1) T)))
+
+(if (not (boundp '*tibetan-table*)) (tibetan-wave))
+
+(defun tibetan (frq offset dur rise dec)
+  (mult (pwl rise 1.0 (- dur dec) 1.0 dur)
+    (apply #'sim
+      (mapcar #'(lambda (off)
+                  (osc (hz-to-step (+ frq (* off offset))) dur *tibetan-table*))
+               '(0 1 2 3 4 -1 -2 -3 -4)))))
+
+(defun tibetan-sequence ()
+    (scale 0.1 (vector (sim (at 0.0 (tibetan 110 0.03 35 0.07 21))
+                            (at 20.0 (tibetan 110 0.04 20 2 4))
+                            (at 28.0 (tibetan 220 0.04 30 3 6))
+                            (at 32.1 (tibetan 110 0.03 23 2.3 4.6)))
+                       (sim (at 5.0 (tibetan 55  0.02 20 0.04 12))
+                            (at 20.0 (tibetan 220 0.05 15  1.5 3))
+                            (at 32.0 (tibetan 110 0.025 26 2.6 5.2))
+                            (at 36.0 (tibetan 55 0.01 22 0.04 13))))))
+
+(defun tibetan-demo () (play (tibetan-sequence)))
+
diff --git a/demos/pmorales/b8.lsp b/demos/pmorales/b8.lsp
new file mode 100644
index 0000000..f4536a6
--- /dev/null
+++ b/demos/pmorales/b8.lsp
@@ -0,0 +1,51 @@
+;;; ADDITIVE SYNTHESIS
+;;; Risset Drum
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(defun drum-env (amp dur)
+  (pwev amp dur (* 12e-5 amp)))
+
+(defun noise-component (amp dur central-frq noise-frq)
+  (amosc (hz-to-step central-frq)
+         (mult (drum-env (/ amp 2) dur)
+               (randi1 noise-frq dur))))
+
+(defun fund-component (amp dur frq)
+  (amosc (hz-to-step frq)
+         (drum-env (/ amp 2.5) dur)))
+
+(defun drum-inh-wave ()
+  (setf *drum-inh-table*
+    (sim (build-harmonic 10 2048)
+         (scale 1.5 (build-harmonic 16 2048))
+         (scale 2.0 (build-harmonic 22 2048))
+         (scale 1.5 (build-harmonic 23 2048))))
+  (setf *drum-inh-table* (list *drum-inh-table* (hz-to-step 1) T)))
+
+(if (not (boundp '*drum-inh-table*)) (drum-inh-wave))
+
+(defun inh-component (amp dur frq)
+  (amosc (hz-to-step (/ frq 10))
+         (drum-env (/ amp 6.0) dur)
+         *drum-inh-table*))
+         
+(defun risset-drum (amp dur frq)
+  (sim (noise-component amp dur 500 400)
+       (inh-component amp dur frq)
+       (fund-component amp dur frq)))
+
+(defun risset-drum-sequence ()
+  (sim
+    (at 0.0 (risset-drum 1.0 3.0 100.0))
+    (at 0.5 (risset-drum 1.0 1.0 50.0))
+    (at 1.0 (risset-drum 1.0 1.0 75.0))
+    (at 1.2 (risset-drum 1.0 1.0 200.0))
+    (at 1.4 (risset-drum 1.0 3.0 300.0))
+    (at 1.8 (risset-drum 1.0 6.0 500.0))))
+
+(defun risset-drum-demo () (ss (risset-drum-sequence)))
+
diff --git a/demos/pmorales/b9.lsp b/demos/pmorales/b9.lsp
new file mode 100644
index 0000000..908ffaa
--- /dev/null
+++ b/demos/pmorales/b9.lsp
@@ -0,0 +1,42 @@
+;;; ADDITIVE SYNTHESIS
+;;; Risset Endless
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+(setf *twopi* (* 2 pi))
+
+(defun bell-table ()
+  (setf *bell-table* (make-array 512))
+  (dotimes (i 512)
+    (setf (aref *bell-table* i)
+      (exp (* -4.8283 (- 1 (cos (* *twopi* (- i 255.5) (/ 511.0))))))))
+  (setf *bell-table* (snd-from-array 0.0 512 *bell-table*))
+  (setf *bell-table* (list *bell-table* (hz-to-step 1.0) T)))
+
+(if (not (boundp '*bell-table*)) (bell-table))
+
+(defun frq-table ()
+  (setf *frq-table*
+    (list (sim (pwe 1.0 16e-4) (const -1.0 1.0)) (hz-to-step 1.0) T)))
+
+(if (not (boundp '*frq-table*)) (frq-table))
+
+(defun endless-partial ()
+  (mult (osc (hz-to-step 0.025) 40 *bell-table*)
+        (fmosc (hz-to-step 16000) (scale 16000
+                    (osc (hz-to-step 0.025) 40 *frq-table*)))))
+
+(setf *endless-partial* (endless-partial))
+
+(defun risset-endless ()
+  (scale 0.25 (apply #'sim (mapcar #'(lambda (x) 
+				       (at x (cue *endless-partial*)))
+            '(0.0 2.0 4.0 6.0 8.0 10.0 12.0
+             14.0 16.0 18.0 20.0)))))
+
+(defun risset-endless-demo () (ss (risset-endless)))
+
+
diff --git a/demos/pmorales/buzz.lsp b/demos/pmorales/buzz.lsp
new file mode 100644
index 0000000..90b8b96
--- /dev/null
+++ b/demos/pmorales/buzz.lsp
@@ -0,0 +1,88 @@
+;;; BUZZ generator for Nyquist
+;;; Pedro J. Morales. Albacete, Spain. Jule, 2001
+;;; pmorales@iele-ab.uclm.es
+
+; tested on Nyquist IDE 3.0 under Windows
+
+
+; Summation formula taken from F. Richard Moore "Elements of Computer Music"
+; section 3.4 page 273
+(defun buzz-aux (harm len)
+  (let ((frq (/ *sound-srate* len)))
+  (scale (/ 1.0 harm)
+    (mult (osc (hz-to-step (* (+ 1 harm) 0.5 frq)) (/ 1.0 frq))
+          (osc (hz-to-step (* harm 0.5 frq))(/ 1.0 frq))
+          (clip (recip (osc (hz-to-step (* 0.5 frq)) (/ 1.0 frq)))
+                 10000)))))
+
+; A table implies a constant spectrum.
+; If you need another spectrum try to change the number of harmonics
+(defun make-buzz-table (harm &optional (len 2047))
+  (list (buzz-aux harm len)
+        (hz-to-step (/ *sound-srate* len))
+        T))
+
+; This function calculates de maximun number of harmonics
+; without aliasing
+(defun num-harm (pitch)
+  (truncate (/ *sound-srate* 2.0 (step-to-hz pitch))))
+
+; Constant frequency buzz oscillator
+; Number of harmonics is optional. If it is not
+; specified then the waveform is calculated with maximum
+; number of harmonics without aliasing
+(defun buzz (pitch dur &optional harm)
+  (unless harm (setf harm (num-harm pitch)))
+  (osc pitch dur (make-buzz-table harm)))
+
+; vibrato buzz
+(defun vib-buzz (pitch dur &optional harm)
+  (unless harm (setf harm (num-harm pitch)))
+  (fmosc pitch (scale 10 (lfo 6 dur)) (make-buzz-table harm)))
+
+; buzz in fm oscillator form
+(defun fmbuzz (pitch modulator harm)
+  (fmosc pitch modulator (make-buzz-table harm)))
+
+; filter with three formants intended for vowel synthesis
+; (this synthesis algorithm may be improved by means of finer
+; control of parameters)
+
+(defun formants (beh f1 f2 f3)
+  (sim (reson beh f1 100 2)
+       (reson beh f2 100 2)
+       (reson beh f3 100 2)))
+
+; vowels formants data taken from John R. Pierce "Los sonidos de la Musica"
+; (Scientific American, spanish edition)
+(defun ah (pitch dur)  ; Hawed foneme
+  (mult (pwl 0.2 1 (- dur 0.4) 1 dur)
+        (formants (vib-buzz pitch dur) 570 840 2410)))
+
+(defun eh (pitch dur)  ; Head foneme
+  (mult (pwl 0.2 1 (- dur 0.4) 1 dur)
+        (formants (vib-buzz pitch dur) 530 1840 2480)))
+
+(defun eeh (pitch dur)  ; Heed foneme
+  (mult (pwl 0.2 1 (- dur 0.4) 1 dur)
+        (formants (vib-buzz pitch dur) 270 2290 3010)))
+
+(defun ooh (pitch dur)  ; Who'd foneme
+  (mult (pwl 0.2 1 (- dur 0.4) 1 dur)
+        (formants (vib-buzz pitch dur) 300 870 2240)))
+
+(defun buzz-demo ()
+  (seq (ah c3 1)(eeh c3 1)(ooh c3 1)
+       (ah c2 1)(eeh c2 1)(ooh c2 1)
+       (ah c4 1)(eeh c4 1)(ooh c4 1)
+       (ah d4 1)(eeh d4 1)(ooh d4 1)
+       (ah g4 1)(eeh g4 1)(ooh g4 1)
+       (ah c5 1)(eeh c5 1)(ooh c5 1)
+       (ah c4 1)(eh  b3 0.5)(ah c4 0.5)
+       (eeh e4 1)(eeh d4 1)(ah c4 3)))
+
+; TEST
+(defun buzz-test () (play (buzz-demo)))
+
+; (buzz-test)
+
diff --git a/demos/pmorales/c1.lsp b/demos/pmorales/c1.lsp
new file mode 100644
index 0000000..68177e8
--- /dev/null
+++ b/demos/pmorales/c1.lsp
@@ -0,0 +1,32 @@
+;;; ADDITIVE SYNTHESIS
+;;; Random Signals
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+
+(defun simple-noise ()
+  (mult (noise 4.0)
+        (pwl 0.4 1.0 3.6 1.0 4.0)))
+
+(defun simple-randi (frandi)
+  (mult (randi1 frandi 4.0)
+        (pwl 0.4 1.0 3.6 1.0 4.0)))
+
+(defun tenney (frandi frq dur)
+  (amosc (hz-to-step frq)
+         (mult (randi1 frandi dur) (pwl 0.4 1.0 (- dur 0.4) 1.0 dur))))
+
+
+
+;(ss (seq (simple-noise) (simple-randi 200) (simple-randi 400)))
+
+(defun tenny-sequence ()
+  (seq (tenney 200.0 400.0 4.0)
+       (tenney 800.0 300.0 2.0)
+       (tenney 400.0 1600.0 4.0)))
+
+(defun tenny-demo () (ss (tenny-sequence)))
+
diff --git a/demos/pmorales/d1.lsp b/demos/pmorales/d1.lsp
new file mode 100644
index 0000000..50ab42c
--- /dev/null
+++ b/demos/pmorales/d1.lsp
@@ -0,0 +1,43 @@
+;;; Simple KARPLUS-STRONG
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+
+; NYQUIST code for simple Karplus-Strong algorithm
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+
+(setf ks-class
+ (send class :new '(cnt total-cnt z-1output output delay-line len total-len)))
+
+(send ks-class :answer :isnew '(pitch dur)
+  '((setf len (round (/ *sound-srate* (step-to-hz pitch))))
+    (setf total-len (* *sound-srate* dur))
+    (setf delay-line (snd-samples (noise (/ (step-to-hz pitch))) len))
+    (setf cnt 0)
+    (setf total-cnt 0)
+    (setf z-1output 0.0)
+    (setf output 0.0)))
+
+(send ks-class :answer :next '()
+  '((setf output (aref delay-line cnt))
+    (setf (aref delay-line cnt) (/ (+ output z-1output) 2.0))
+    (setf z-1output output)
+    (setf cnt (if (= (1- len) cnt) 0 (1+ cnt)))
+    (setf total-cnt (1+ total-cnt))
+    (if (= total-cnt total-len) NIL output)))
+
+(defun ks (pitch dur)
+  (let (obj (d (get-duration dur)))
+    (setf obj (send ks-class :new pitch d))
+    (snd-fromobject *rslt* *sound-srate* obj)))
+
+(defun ks-env (pitch dur)
+  (mult (pwe dur 0.064)
+        (ks pitch dur)))
+
+;(ss (seq (ks a4 1.0) (ks b4 1.0) (ks c5 3.0)))
+
+(ss (seq (ks-env a3 1.0) (ks-env b3 1.0)))
diff --git a/demos/pmorales/e2.lsp b/demos/pmorales/e2.lsp
new file mode 100644
index 0000000..48c0dfa
--- /dev/null
+++ b/demos/pmorales/e2.lsp
@@ -0,0 +1,157 @@
+;;; FM
+;;; Chowning Dynamic Spectral Evolution
+;;; coded by Pedro Jose Morales
+;;; pmorales@iele-ab.uclm.es
+
+;;; WARNING: needs REVERB.LSP
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+(if (not (fboundp 'reverb)) (load "reverb"))
+
+
+; Chowning BELL -----------------------------------------------------
+(defun exp-env (amp dur)
+  (scale amp (pwe dur 64e-4)))
+
+(defun fm-bell (frq cm-ratio imax dur amp)
+  (mult (exp-env amp dur)
+        (fmosc (hz-to-step frq)
+               (mult (exp-env (* imax (/ frq cm-ratio)) dur)
+                     (osc (hz-to-step (/ frq cm-ratio)) dur)))))
+
+; Chowning WOOD-DRUM ------------------------------------------------
+(defun wood-env (amp dur)
+  (scale amp (pwev 0.8 (* dur 0.2) 1.0 (* dur 0.25) 1.0 dur 64e-4)))
+
+(defun wood-mod-env  (amp dur)
+  (scale amp (pwlv 1.0 (* 0.2 dur) 0.0 dur)))
+  
+(defun fm-wood-drum (frq cm-ratio imax dur amp)
+  (mult (wood-env amp dur)
+        (fmosc (hz-to-step frq)
+               (mult (wood-mod-env (* imax (/ frq cm-ratio)) dur)
+                     (osc (hz-to-step (/ frq cm-ratio)) dur)))))
+
+; Chowning BRASS ----------------------------------------------------
+(defun brass-env (amp dur)
+  (scale amp (pwl 0.1 1.0 0.2 0.8 (- dur 0.1) 0.7 dur)))
+
+(defun fm-brass (pitch cm-ratio imax dur amp)
+  (let ((frq (step-to-hz pitch)))
+    (mult (brass-env amp dur)
+          (fmosc pitch
+                 (mult (brass-env (* imax (/ frq cm-ratio)) dur)
+                       (osc (hz-to-step (/ frq cm-ratio)) dur))))))
+
+; Chowning CLARINET -------------------------------------------------
+(defun clar-env (amp dur)
+  (scale amp (pwev 64e-4 0.1 1.0 (- dur 0.1) 1.0 dur 64e-4)))
+
+(defun clar-mod-env (vmax vmin dur)
+  (pwev vmax (* dur 0.3) vmin dur vmin))
+
+(defun fm-clar (pitch cm-ratio imax imin dur amp)
+  (let ((frq (step-to-hz pitch)))
+    (mult (clar-env amp dur)
+          (fmosc pitch
+                 (mult (scale (/ frq cm-ratio) (clar-mod-env imax imin dur))
+                       (osc  (hz-to-step (/ frq cm-ratio)) dur))))))
+                       
+; Chowning VARIABLE FM INSTRUMENT -----------------------------------
+; este instrumento hay que mejorarlo
+
+(defun variable-fm-env (amp break mid dur)
+  (scale amp (pwev (* mid 64e-4) break mid dur (* mid 64e-4))))
+  
+(defun variable-mod-osc (index frq kdyn mid break dur)
+  (amosc (hz-to-step frq)
+         (scale (* index frq) (pwlv kdyn break mid dur))))
+
+(defun variable-fm-inst (amp break mid dur kdyn index frq cm-ratio)
+  (mult (variable-fm-env amp break mid dur)
+        (fmosc (hz-to-step frq)
+               (variable-mod-osc index (/ frq cm-ratio) kdyn mid break dur))))
+
+
+(defun variable-fm-rev-st (amp break mid dur kdyn index frq cm-ratio coefrev)
+  (let ((snd (variable-fm-inst amp break mid dur kdyn index frq cm-ratio)))
+    (sim (cue snd) (scale coefrev (reverb snd dur)))))
+
+;(ss (seq (fm-bell 100.0 (/ 5.0 7.0) 10 10 1.0)
+;         (fm-bell 150.0 (/ 5.0 7.0) 7  10 1.0)
+;         (fm-bell 200.0 (/ 5.0 7.0) 15 7 1.0)))
+
+(defun fm-w-d (pitch)
+  (fm-wood-drum (step-to-hz pitch) (/ 16.0 11.0) 25 0.2 1.0))
+
+;(ss (seq (fm-w-d a2) (fm-w-d b2) (fm-w-d c3) (fm-w-d d3) (fm-w-d e3)
+;         (fm-w-d f3) (fm-w-d g3) (fm-w-d a3)
+;         (fm-w-d a1) (fm-w-d b1) (fm-w-d c2) (fm-w-d d2) (fm-w-d e2)
+;         (fm-w-d f2) (fm-w-d g2) (fm-w-d a2)))
+
+(defun fm-br (pitch)
+  (fm-brass pitch 1.0 5 0.6 1.0))
+  
+;(ss (seq (fm-br c4) (fm-br d4) (fm-br e4) (fm-br f4) (fm-br g4)
+;         (fm-br a4) (fm-br b4) (fm-br c5)))
+
+(defun fm-c (pitch)
+  (fm-clar pitch (/ 3.0 2.0) 5 2 0.5 1.0))
+
+;(ss (seq (fm-c c5) (fm-c d5) (fm-c e5) (fm-c f5) (fm-c g5)
+;         (fm-c a5) (fm-c b5) (fm-c c6)))
+
+(defun v-fm (pitch break mid dur rev)
+  (variable-fm-rev-st 1.0 break mid dur 0.8 20.0 (step-to-hz pitch) (/ 7.0 5.0) rev))
+
+;(ss (sim (at 0.0 (v-fm a4 0.7 0.2 3.0 0.5))
+;         (at 1.5 (v-fm e6 0.2 0.3 3.0 0.4))
+;         (at 3.0 (v-fm d5 2.0 0.6 4.0 0.4))
+;         (at 6.0 (v-fm d6 0.01 0.7 3.0 0.5))))
+
+; Double Carrier Brass ----------------------------------------------
+
+(defun dc-env (dur)
+  (pwl (* dur 0.1) 1.0 (* dur 0.2) 0.8 (* dur 0.9) 0.7 dur))
+
+(defun dc-modulator (frq dur imax imin)
+  (amosc (hz-to-step frq)
+         (sim (scale (* frq (- imax imin)) (dc-env dur))
+              (const (* frq imin) dur))))
+
+(defun dc-fm1 (frq1 dur amp modulator)
+  (scale amp
+    (mult (dc-env dur)  
+          (fmosc (hz-to-step frq1) modulator))))
+
+(defun dc-fm2 (frq1 dur cm-ratio index-ratio amp amp-ratio modulator)
+  (scale (* amp amp-ratio)
+    (mult (dc-env dur)
+         (fmosc (hz-to-step (/ frq1 cm-ratio))
+                (scale index-ratio modulator)))))
+
+(defun double-carrier (dur frq cm-ratio amp amp-ratio imax imin index-ratio)
+  (let ((modulator (dc-modulator (/ frq cm-ratio) dur imax imin)))
+    (sim (dc-fm1 frq dur amp modulator)
+         (dc-fm2 frq dur cm-ratio index-ratio amp amp-ratio modulator))))
+
+;(ss (double-carrier 0.6 440.0 1.0 1.0 0.5 3 1 (/ 3.0 1.5)))
+
+; Double Carrier Trumpet --------------------------------------------
+
+(defun port-env (dur)
+  (pwlv -1.0 (* 0.25 dur) 0.1 (* 0.5 dur) 0.0 dur))
+
+
+(defun chowning-fm-demo ()
+  (ss (seq (fm-bell 100.0 (/ 5.0 7.0) 10 10 1.0)
+           (fm-bell 150.0 (/ 5.0 7.0) 7  10 1.0)
+           (fm-bell 200.0 (/ 5.0 7.0) 15 7 1.0)
+           (fm-w-d a2) (fm-w-d b2) (fm-w-d c3) (fm-w-d d3) (fm-w-d e3)
+           (fm-w-d f3) (fm-w-d g3) (fm-w-d a3)
+           (fm-w-d a1) (fm-w-d b1) (fm-w-d c2) (fm-w-d d2) (fm-w-d e2)
+           (fm-w-d f2) (fm-w-d g2) (fm-w-d a2)
+           (fm-br c4) (fm-br d4) (fm-br e4) (fm-br f4) (fm-br g4)
+           (fm-br a4) (fm-br b4) (fm-br c5)
+           (double-carrier 0.6 440.0 1.0 1.0 0.5 3 1 (/ 3.0 1.5)))))
diff --git a/demos/pmorales/ks.lsp b/demos/pmorales/ks.lsp
new file mode 100644
index 0000000..8000f32
--- /dev/null
+++ b/demos/pmorales/ks.lsp
@@ -0,0 +1,33 @@
+;;; DSP in Nyquist
+;;; Karplus-Strong Algorithm
+;;; Coded by Pedro J. Morales.
+;;; e-mail: pmorales@iele-ab.uclm.es
+
+(load "pjmg.lsp")
+
+(setf ks-class (send class :new
+                  '(cnt total-cnt last-output current-output string len total-len)))
+
+(send ks-class :answer :isnew '(pitch dur)
+  '((setf len (round (/ *sound-srate* (step-to-hz pitch))))
+    (setf total-len (* *sound-srate* dur))
+    (setf string (snd-samples (noise (/ (step-to-hz pitch))) len))
+    (setf cnt 0)
+    (setf total-cnt 0)
+    (setf last-output 0.0)
+    (setf current-output 0.0)))
+
+(send ks-class :answer :next '()
+  '((setf current-output (aref string cnt))
+    (setf (aref string cnt) (/ (+ current-output last-output) 2.0))
+    (setf last-output current-output)
+    (setf cnt (if (= (1- len) cnt) 0 (1+ cnt)))
+    (setf total-cnt (1+ total-cnt))
+    (if (= total-cnt total-len) NIL current-output)))
+
+(defun ks (pitch dur)
+  (let (obj)
+    (setf obj (send ks-class :new pitch dur))
+    (snd-fromobject 0.0 *sound-srate* obj)))
+
+(ss (seq (ks e2 2)(ks a2 2)(ks d3 2)(ks g3 2)(ks b3 2)(ks e4 2)))
diff --git a/demos/pmorales/partial.lsp b/demos/pmorales/partial.lsp
new file mode 100644
index 0000000..8619f8c
--- /dev/null
+++ b/demos/pmorales/partial.lsp
@@ -0,0 +1,30 @@
+;;; PARTIAL 
+
+(setf *pmorales-path* (current-path))
+(load (strcat *pmorales-path* "pjmg.lsp"))
+
+
+(defun klin (fr coef)
+  (mult (sine (hz-to-step (* 300.0 fr coef)) 2.0) (pwev 3.0  3.0 1e-2))) 
+
+(defun klines (coef)
+  (sim (at 0.0 (klin 6.0 coef))
+       (at 0.3 (klin 7.0 coef))
+       (at 0.5 (klin 5.5 coef))
+       (at 0.7 (klin 6.5 coef))))
+
+(defun bell-sequence ()
+  (sim (mult (sine (hz-to-step (* 300.0 (/ 3.14 5))) 6.0) (scale 4.0 (pwe 6.0 1e-2)))
+       (mult (sine (hz-to-step 300.0) 6.0) (pwl 2.0 0.75 3.0 1.0 4.0 0.75 5.0 0.2 6.0))
+       (mult (sine (hz-to-step (* 300.0 1.57)) 6.0) (pwl 3.0 0.75 4.0 0.5 5.0))
+       (mult (sine (hz-to-step (* 300.0 3.14)) 6.0) (pwl 2.5 0.5 4.0))
+       (at 0.5 (scale 2.0 (mult (sine (hz-to-step (* 300.0 6.3)) 6.0) (pwe 3.0 5e-3))))
+       (at 2.0 (scale 2.0 (mult (sine (hz-to-step (* 300.0 9.12)) 6.0) (pwe 3.0 1e-2))))
+       (at 0.7 (scale 2.0 (mult (sine (hz-to-step (* 300.0 15.7)) 6.0) (pwe 4.0 2e-2))))
+       (at 3.0 (klines 1.0))
+       (at 4.0 (klines 1.5))
+       (at 1.0 (mult (sine (hz-to-step (+ (* 300.0 6.3) 20.0)) 6.0)
+                     (scale 5e-3 (pwe 2.0 1000.0 4.0)))) 
+))
+
+(defun bell-demo () (ss (scale 0.1 (bell-sequence))))
diff --git a/demos/pmorales/phm.lsp b/demos/pmorales/phm.lsp
new file mode 100644
index 0000000..bd206d0
--- /dev/null
+++ b/demos/pmorales/phm.lsp
@@ -0,0 +1,79 @@
+;;; DSP in Nyquist
+;;; Flute Physical Modelling
+;;; Based on Nicky Hind CLM Tutorial
+;;; (Based on Perry Cook Flute Physical Modelling)
+;;; Coded by Pedro J. Morales
+;;; e-mail: pmorales @iele-ab.uclm.es
+
+(load "pjmg.lsp")
+
+;; DELAY LINE
+
+(setf dl-class (send class :new '(cnt line len output)))
+
+(send dl-class :answer :isnew '(init-len)
+  '((setf cnt 0)
+    (setf len init-len)
+    (setf line (make-array len))
+    (dotimes (i len) (setf (aref line i) 0.0))))
+
+(send dl-class :answer :next '(val)
+  '((setf output (aref line cnt))
+    (setf (aref line cnt) val)
+    (setf cnt (if (= cnt (1- len)) 0 (1+ cnt)))
+    output))
+
+(defun make-delay-line (len)
+  (send dl-class :new len))
+
+(defun delay-line (dl-obj val)
+  (send dl-obj :next val))
+
+; UNA EXCITACION
+
+(defun flute-exc (noise-lev vib-amount vib-rate atk dec dur)
+  (let ((current-flow (sim (pwl atk 0.55 (- dur dec) 0.55 dur) ;puede variar 0.5 .. 0.8
+                           (scale vib-amount (lfo vib-rate dur)))))
+    (sim current-flow
+         (scale noise-lev (mult current-flow (lp (noise dur) (/ *sound-srate* 2.0)))))))
+
+;; FLUTE PHYSICAL MODELLING
+(setf flute-class (send class :new '(sum1 sum1-output freq dur bore-delay emb-delay
+                                     period-samples out-sig last-sig current-bore)))
+
+(defun cubic-polynomial (x) (- x (expt x 3.0)))
+
+(send flute-class :answer :isnew '(exc emb-size ifreq idur)
+  '((setf sum1 exc)
+    (setf freq (step-to-hz ifreq))
+    (setf period-samples (round (/ *sound-srate* freq)))
+    (setf bore-delay (make-delay-line period-samples))
+    (setf emb-delay (make-delay-line (round (* emb-size period-samples))))
+    (setf last-sig 0.0)))
+
+(send flute-class :answer :next '()
+  '((setf sum1-output (snd-fetch sum1))
+    (when sum1-output
+      (progn
+        (setf current-bore (delay-line bore-delay last-sig))
+        (setf out-sig
+          (+ (* 0.7 (+ (* 0.55 current-bore)
+                       (cubic-polynomial (delay-line emb-delay (+ sum1-output
+                                                                (* 0.5 current-bore))))))
+             (* 0.3 last-sig)))
+        (setf last-sig out-sig)))))
+       
+
+(defun flute (freq dur &key (noise-lev 0.0356) (atk 0.05) (dec 0.1) (emb-size 0.5)
+                            (vib-amount 0.015) (vib-rate 5))
+  (let (obj)
+    (setf obj (send flute-class :new
+                (flute-exc noise-lev vib-amount vib-rate atk dec dur) emb-size freq dur))
+    (hp (snd-fromobject 0.0 *sound-srate* obj) 20.0)))
+
+(ss (seq (flute a4 0.5 :dec 0.01)
+         (flute b4 0.5 :dec 0.01)
+         (flute c5 0.5 :dec 0.01)
+         (flute gs4 1.0))) 
+ 
+
diff --git a/demos/pmorales/pjmg.lsp b/demos/pmorales/pjmg.lsp
new file mode 100644
index 0000000..b949dd6
--- /dev/null
+++ b/demos/pmorales/pjmg.lsp
@@ -0,0 +1,40 @@
+;;; PJMG.LSP
+;;; Rutinas para Nyquist
+
+; Some utilities and functions not defined in
+; the released version of Nyquist
+
+
+(defun set-current-file (cf)
+  (setf *CURRENT-FILE* cf))
+  
+(defun l () (load *CURRENT-FILE*))
+
+;; A comment by Dannenberg on the following function:
+;; This function takes an expression for a sound and 
+;; finds its peak value. This forces a computation of all
+;; samples, which are saved in memory (4 bytes per sample).
+;; The samples are then normalized and written to a file.
+;; This should be fine for short examples, but is not 
+;; recommended for general use because you may run out 
+;; of memory. See the manual for more notes on normalization.
+;;
+(defun ss (m) 
+  (let ((m-max (peak m NY:ALL)))
+    (s-save (scale (/ 1.0 m-max) m) NY:ALL *default-sound-file* 
+                 :play *soundenable*))) 
+
+(defun randi1 (fr dur)
+  (let ((d (get-duration dur)))
+       (snd-white *rslt* fr d)))
+
+(defun randi2 (fr dur)
+  (at 0.0 (snd-white 0.0 fr dur)))
+
+(defun randh1 (fr dur)
+  (let ((d (get-duration dur)))
+   (snd-compose (noise d) (quantize (ramp d) (round (* fr d))))))
+
+(defun rndh2 (fr dur)
+  (at 0.0 (snd-compose (noise dur)
+                       (quantize (ramp dur) (round (* fr dur))))))
diff --git a/demos/pmorales/readme.txt b/demos/pmorales/readme.txt
new file mode 100644
index 0000000..fc662f0
--- /dev/null
+++ b/demos/pmorales/readme.txt
@@ -0,0 +1,27 @@
+Here there are a few sounds for Nyquist that
+I have coded for learning. Mostly are based
+on examples from Amsterdam Catalogue of
+CSound Computer Instruments,and some others
+are based on Computer Music Journal
+articles, Dodge & Jerse and F. R. Moore
+books.
+
+Karplus-Strong and Physical Modelling are
+implemented in Lisp.
+
+Albacete, Spain, 2 June 2.000
+
+Pedro J. Morales.
+pmorales@iele-ab.uclm.es
+
+----------------------------------------
+
+Please see examples_home.htm in the parent
+folder for an index to these files.
+
+Note that there are "helper" functions in 
+pjmg.lsp that you may need to load before
+you run the code in these other files.
+
+Roger B. Dannenberg
+rbd@cs.cmu.edu