diff options
Diffstat (limited to 'test')
46 files changed, 3251 insertions, 0 deletions
diff --git a/test/alex.lsp b/test/alex.lsp new file mode 100644 index 0000000..9749147 --- /dev/null +++ b/test/alex.lsp @@ -0,0 +1,292 @@ +; SOUNDS + +(defun mkwave () + (setf *s-table* (scale 0.5 (sim (scale 1 (build-harmonic 1.41 2048)) + (scale 0.7 (build-harmonic 3.1 2048)) + (scale 0.9 (build-harmonic 6.3 2048)) + (scale 0.4 (build-harmonic 9.12 2048))))) + (setf *s-table* (list *s-table* (hz-to-step 1) T))) + +(if (not (boundp '*s-table*)) (mkwave)) + +(defun mk-voc1-table() + (if (not (boundp 'voc-snd1)) (setf voc-snd1 (s-read "./test/voc1.snd"))) + (setf *voc-table1* (list voc-snd1 16 T))) + +(defun mod(dur) + (mult + (stretch dur (pwl 0 1000 .2 200 .5 8000 1 100 1)) + (fmosc c4 (stretch dur (pwl 0 1 .5 3.25 1 .74 1))))) + +(defun mod2(dur) + (mult + (stretch dur (pwl 0 5000 0.6 3000 1 50 1)) + (fmosc c4 (stretch dur (pwl 0 10 0.5 50 0.65 1060 0.75 200 0.8 8400 1 5 1))))) + +(defun envl(dur) (stretch dur (env 0.15 0.15 0.2 1 .6 .5 1))) + +(defun blurp(dur) (fmosc c3 (mult (osc 07 dur) (mod dur)))) + +(defun bleerp(&optional (dur 4)) (fmosc 02 (mult (fmosc 23 (stretch dur (pwl 0 15000 .3 5600 .8 1500 1 380 1))) (mod dur)))) + +(defun ther(freq amp &optional (vib 6)) + (mult (sum amp (lfo vib)) (fmosc 0 (sum freq (lfo (* vib 0.7)))) )) + +(defun fizz(scl &optional (dur 2) (pch 40)) + (scale scl + ( mult + (stretch dur (env 0.02 0.08 0.01 1 0.6 0.8 1)) (fmosc pch (mod2 dur)) + ( at 0.1 ( mult (envl dur) (fmosc (* pch 1.414) (mod2 dur)))) + ( at 0.2 (mult (envl dur) (fmosc (* pch 0.57) (mod2 dur)))) ))) + +(defun warble(&optional (dur 1) (pch 60)) + (sum (mult + (stretch dur (env 0.017 0.1 0.004 1 0.7 0.8 1)) + (amosc pch (fmosc (hz-to-step 8) (stretch dur (pwl 0 4 0.2 -4 0.56 9 0.7 0 1 -8 1)))) + + (mult (stretch (* dur 0.96) (env 0.2 0.09 0.07 0.92 0.8 0.6 1)) + (amosc pch (fmosc (* pch 1.414) (stretch dur (pwl 0.2 80 0.5 4 0.9 1120 1 200 1)) ) ) )) )) + +(defun bell(dur pch) (mult + (stretch dur (env 0.01 0.1 0.2 1 0.6 0.24 1)) + (fmosc pch (sum + (mult (stretch dur (pwl 0.07 1800 0.15 1000 0.4 680 0.8 240 1 100 1)) + (osc (hz-to-step (* (step-to-hz pch) (sqrt 2.0))) dur)) + + (scale 1.57 (mult (stretch dur (pwl 0.001 1000 0.007 450 0.01)) + (osc (hz-to-step (* (step-to-hz pch) (sqrt 11.0)))))) + + (scale 1.3 (mult (stretch dur (pwl 0.002 921 0.009 600 0.012)) + (osc (hz-to-step (* (step-to-hz pch) (sqrt 71.0))))))) ))) + +(defun ring(dur pch scl) (mult + (stretch dur (env 0.05 0.1 0.2 1 0.6 0.24 1)) + (fmosc pch (mult + (stretch dur (pwl 0.07 1800 0.15 1000 0.4 680 0.8 240 1 100 1)) + (mult (osc (hz-to-step (* (step-to-hz pch) (sqrt 2.0))) dur) + (scale scl (osc (hz-to-step (* (step-to-hz pch) (sqrt 11.0))) dur)) ))))) + +(defun wind(&optional (dur 3) (scal 3) (cps 590) (bw 40)) + (mult (stretch dur (env 0.07 0.08 0.1 1 0.6 0.8 1)) + (sum + (stretch dur (reson (scale scal (noise)) cps bw 2)) + (stretch dur (reson (scale (mult scal 1.13) (noise)) (mult cps (pwl 0 0.74 0.2 0.96 0.5 0.8 0.75 1.16 0.9 0.97 1 0.74 1)) (mult bw 1.042) 2)))) ) + +(defun suck(dur) + (stretch dur (hp (noise) (pwl 0 15 0.2 6000 0.6 15000 0.75 7)))) + +(defun vocrap(&optional (pch 16) (dur 1)) + (if (not (boundp '*voc-table1*)) (mk-voc1-table)) + (fmosc pch (stretch dur(pwl 0 3 0.1 -20 0.2 20 0.3 30 0.4 -10 0.5 15 0.6 0 0.8 -30 1 60 1)) *voc-table1*)) + +(defun voc1(baspch varpch &optional (dur 1)) + (display "duration" dur) + (if (not (boundp '*voc-table1*)) (mk-voc1-table)) + (fmosc baspch (stretch dur varpch) *voc-table1*)) + +(defun sparkle() + +) + +;______________________________________________________________________________________ +;UTILITIES + +(defun pl(exp) + (setf the_max (snd-max exp 10000000)) + (display "Max" the_max) + (play (scale (/ 1.0 the_max) exp))) + + +(defun ster(sound pan) + (vector (mult sound pan) + (mult sound (sum 1 (mult -1 pan))))) + + +(defun echo (sound &optional (delay 0.2) (reps 12)) + (seqrep (i reps) (scale (- 1 (* (+ i 1) (/ 1.0 reps))) (seq sound (s-rest delay)) ))) + +;------------------------------------------------------------ +(defun ster-echo (sound &optional (delay 0.2) (reps 12)) + (vector + (seqrep (i reps) (scale (- 0.95 (* (+ i 1) (/ 1.0 reps))) (seq (aref (cond ((oddp i) (ster sound 0.1)) (T (ster sound 0.9))) 0) (s-rest delay)))) + (seqrep (i reps) (scale (- 1.0 (* (+ i 1) (/ 1.0 reps))) (seq (aref (cond ((oddp i) (ster sound 0.1)) (T (ster sound 0.9))) 1) (s-rest delay)))) +)) + + +(defun ster-echo (sound &optional (delay 0.2) (reps 12)) + (vector + (seqrep (i reps) (scale (- 0.95 (* (+ i 1) (/ 1.0 reps))) (seq (cond ((oddp i) sound) (T (scale 0 sound))) (s-rest delay)))) + (seqrep (i reps) (scale (- 1.0 (* (+ i 1) (/ 1.0 reps))) (seq (cond ((not (oddp i)) sound) (T (scale 0 sound))) (s-rest delay)))) +)) + +;------------------------------------------------------------ + +(defun loop(exp &optional (rep 5)) + (simrep (i rep) (at (- (* i (snd-stop-time exp)) 0.15) exp ))) + +;______________________________________________________________________________________ +;RANDOM LOOKUP + +(defun pch-table(oct) + (setf pch-t (vector (+ 12 (* oct 12)) (+ 13 (* oct 12)) (+ 14 (* oct 12)) (+ 15 (* oct 12)) (+ 16 (* oct 12)) (+ 17 (* oct 12)) (+ 18 (* oct 12)) (+ 19 (* oct 12)) (+ 20 (* oct 12)) (+ 21 (* oct 12)) (+ 22 (* oct 12)) (+ 23 (* oct 12)) ))) + +(defun dur-table() + (setf dur-t (vector 1 1.5 1.25 1.75 2 3))) + +(defun time-table() + (setf time-t (vector 0.1 0.2 0.4 0.8))) + +(defun rand-sel(v) + ;;;(if (not (boundp v)) (pch-table oct)) + (setf v (symbol-value v)) + (aref v (random (- (length v) 1)))) + +(pch-table 5) +(dur-table) +(time-table) + +(defun chimes (n) + (simrep (i n) (at (* i (rand-sel time-t)) (bell (rand-sel dur-t) (step-to-hz (rand-sel 'pch-t)))))) + +;_______________________________________________________________________________________ +; SCORE SECTIONS + +(defun bellpat1() (scale 0.6 (sim + (scale 0.7 (at 0.0 (bell 1 90))) + (scale 0.6 (at 0.25 (bell 1.2 78))) + (scale 0.7 (at 0.5 (bell 0.8 85))) + (scale 0.55 (at 0.675 (bell 0.7 87))) + (scale 0.6 (at 0.75 (bell 0.6 88))) + (scale 0.7 (at 1 (bell 1 86))) +))) + +(defun bellpat2() (scale 0.6 (sim + (scale 0.7 (at 0.0 (bell 1.2 67))) + (scale 0.55 (at 0.125 (bell 0.8 74))) + (scale 0.65 (at 0.25 (bell 1.3 67))) + (scale 0.5 (at 0.5 (bell 0.5 79))) + (scale 0.7 (at 0.75 (bell 1.5 74))) +))) + +(defun ringpat1() (scale 0.8 (sim + (scale 0.6 (at 0.0 (ring 0.6 45 2))) + (scale 0.5 (at 0.2 (ring 0.8 40 1.5))) + (scale 0.8 (at 0.6 (ring 1 44 1))) + (scale 0.7 (at 0.8 (ring 1.2 32 0.8))) +))) + +(defun ringpat2() (scale 0.65 (sim + (scale 0.8 (at 0.0 (ring 1 39 1.95))) + (scale 0.7 (at 0.45 (ring 0.7 27 1.7))) + (scale 0.9 (at 0.6 (ring 0.9 32 1.88))) + (scale 0.75 (at 1.05 (ring 0.7 36 1.6))) + (scale 0.8 (at 1.2 (ring 0.8 37 1.78))) + (scale 0.7 (at 1.5 (ring 0.8 34 1.8))) + (scale 0.75 (at 1.8 (ring 2 32 2.6))) +))) + +(defun techno(rep) (seqrep (i rep) (scale 0.8 (sim + (scale 0.8 (at 0.0 (ring 0.4 30 1.2))) + (scale 0.6 (at 0.2 (ring 0.2 30 0.9))) + (scale 0.7 (at 0.3 (ring 0.1 30 1.1))) +)))) + +(defun suckpat(&optional (rep 16)) + (seqrep (i rep) (stretch 0.2 (scale (* i 0.1) (seq (suck 1) (suck 1) (suck 2) (suck 2)))))) + +(defun tribal(rep) (scale 0.8 (simrep (i rep) (at (* i 0.9) (sim + (at 0.0 (bell 0.2 72)) + (scale 0.7 (at 0.15 (bell 0.2 72))) + (scale 0.8 (at 0.3 (bell 0.2 60))) + (scale 0.6 (at 0.45 (bell 0.2 65))) + (scale 0.9 (at 0.6 (bell 0.2 69))) + (scale 0.7 (at 0.75 (bell 0.2 60))) +))))) + + +(defun bells(rep) (scale 0.4 (sim + (bell 0.9 72) + (at 0.3 (simrep (i rep) (at (* i 0.9 ) (sim + (scale 0.7 (at 0.0 (bell 0.85 67))) + (scale 0.8 (at 0.15 (bell 0.85 69))) + (scale 0.9 (at 0.3 (bell 0.8 71))) + (scale 0.8 (at 0.45 (bell 1.2 67))) + (at 0.6 (bell 1.2 72 )) +))))))) + +(defun rings (&optional (rep 12) (init_del 0.1) (sep 0.12) (lenfac 0.2)) + (scale 0.12 (simrep (i rep) (at (- 4 (+ init_del (* sep i))) (ring (* i lenfac) 24 (+ 1 (* i 0.4)) ))))) + +(defun rings2 (&optional (rep 8)) + (simrep (i rep) (at (* 0.02 i) (vocrap)))) + +(defun bleerps (&optional (rep 12) (init_del 0.1) (sep 0.12) (lenfac 0.2)) + (scale 0.12 (simrep (i rep) (at (- 4 (+ init_del (* sep i))) (bleerp (* i lenfac)))))) + + +(defun accel_bleerps() (sim + + (scale 0.4 (at 0.0 (bleerp 4.5))) + (scale 0.1 (at 0.6 (bleerp 1))) + (scale 0.12 (at 1.3 (bleerp 0.8))) + (scale 0.16 (at 1.9 (bleerp 0.7))) + (scale 0.20 (at 2.3 (bleerp 0.6))) + (scale 0.24 (at 2.7 (bleerp 0.5))) + (scale 0.28 (at 3.0 (bleerp 0.4))) + (scale 0.32 (at 3.2 (bleerp 0.3))) + (scale 0.25 (at 3.4 (bleerp 0.2))) + (scale 0.14 (at 3.55 (bleerp 0.2))) + (scale 0.10 (at 3.7 (bleerp 0.2))) + (scale 0.06 (at 3.8 (bleerp 0.2))) + (scale 0.03 (at 3.9 (bleerp 0.2))) +)) + + +(defun sect1() (sim + (scale 3 (at 0.0 (simrep(i 4) (at (* i 2.9) (wind))))) + (scale 0.5 (at 2 (warble 8 48))) + (scale 0.3 (at 2.05 (warble 8.05 47.9))) + (scale 0.15 (at 2.9 (ring 7.1 (hz-to-step 1) 1.2))) + (scale 0.175 (at 4.9 (ring 5.1 (hz-to-step 2) 1.414))) + (scale 0.2 (at 6.9 (ring 3.1 (hz-to-step 4) 1.8))) + (scale 0.7 (at 9.9 (suck 3.5))) + (scale 0.28 (at 9.9 (blurp 3.1))) + (scale 0.7 (at 12.4 (stretch 0.5 (suckpat 17)))) + (scale 0.4 (at 13.8 (seqrep (i 2) (seq (techno 2) (transpose 5 (techno 2)) (transpose -2 (techno 1)) (transpose 3 (techno 1)) (techno 2))))) + (scale 0.2 (at 13.9 (seqrep (i 2) (seq (transpose 2 (techno 2)) (transpose 7 (techno 2)) (transpose -4 (techno 1)) (transpose 5 (techno 1)) (transpose -2 (techno 2)))))) + (scale 0.5 (at 15.75 (seqrep (i 4) (vocrap)) )) + (scale 0.35 (at 21.5 (ring 4 1 1))) + (scale 0.325 (at 24 (ring 4 4 2))) + (scale 0.3 (at 27.5 (ring 4 10 4))) + (scale 0.85 (at 23 (seqrep (i 17) (lp (scale (+ (* i 0.05 ) 0.3) (seq (transpose -4 (ring 0.1 32 0.6)) (transpose -5 (ring 0.05 20 0.2)) (transpose (* 2 i) (ring 0.1 27 0.5)) (transpose -3 (ring 0.05 22 0.1)) (transpose (* i 3) (ring 0.1 28 0.4)) (ring 0.05 31 0.7))) (* 100 i))))) + (scale 0.75 (at 23.025 (seqrep (i 17) (scale (+ (* i 0.05 ) 0.3) (seq (ring 0.1 32 1.2) (transpose -10 (ring 0.05 20 0.4)) (transpose (* 0.66 i) (ring 0.1 27 1)) (transpose -13 (ring 0.05 22 0.2)) (transpose (* i 1.5) (ring 0.1 28 0.7)) (transpose -2 (ring 0.05 31 0.9))))))) + (scale 1.0 (at 20.0 (ringpat1))) + (scale 0.7 (at 20.05 (stretch 1.5 (ringpat1)))) +)) + +(defun segfault () + (seqrep (i 17) (scale (+ (* i 0.05 ) 0.3) (seq (ring 0.1 32 1.2) (transpose -10 (ring 0.05 20 0.4)) (transpose (* 0.66 i) (ring 0.1 27 1)) (transpose -13 (ring 0.05 22 0.2)) (transpose (* i 1.5) (ring 0.1 28 0.7)) (transpose -2 (ring 0.05 31 0.9)))))) + +; the following does clicks +(defun sect1() (sim + (scale 3 (at 0.0 (simrep(i 4) (at (* i 2.9) (wind))))) + (scale 0.5 (at 2 (warble 8 48))) + (scale 0.3 (at 2.05 (warble 8.05 47.9))) + (scale 0.15 (at 2.9 (ring 7.1 (hz-to-step 1) 1.2))) + (scale 0.175 (at 4.9 (ring 5.1 (hz-to-step 2) 1.414))) + (scale 0.2 (at 6.9 (ring 3.1 (hz-to-step 4) 1.8))) + (scale 0.7 (at 9.9 (suck 3.5))) + (scale 0.28 (at 9.9 (blurp 3.1))) + (scale 0.7 (at 12.4 (stretch 0.5 (suckpat 17)))) + (scale 0.4 (at 13.8 (seqrep (i 2) (seq (techno 2) (transpose 5 (techno 2)) (transpose -2 (techno 1)) (transpose 3 (techno 1)) (techno 2))))) + (scale 0.2 (at 13.9 (seqrep (i 2) (seq (transpose 2 (techno 2)) (transpose 7 (techno 2)) (transpose -4 (techno 1)) (transpose 5 (techno 1)) (transpose -2 (techno 2)))))) + (scale 0.5 (at 15.75 (seqrep (i 4) (vocrap)) )) + (scale 0.35 (at 21.5 (ring 4 1 1))) + (scale 0.325 (at 24 (ring 4 4 2))) + (scale 0.3 (at 27.5 (ring 4 10 4))) + (scale 0.85 (at 23 (seqrep (i 17) (lp (scale (+ (* i 0.05 ) 0.3) (seq (transpose -4 (ring 0.1 32 0.6)) (transpose -5 (ring 0.05 20 0.2)) (transpose (* 2 i) (ring 0.1 27 0.5)) (transpose -3 (ring 0.05 22 0.1)) (transpose (* i 3) (ring 0.1 28 0.4)) (ring 0.05 31 0.7))) (* 100 i))))) + (scale 0.75 (at 23.025 (seqrep (i 17) (scale (+ (* i 0.05 ) 0.3) (seq (ring 0.1 32 1.2) (transpose -10 (ring 0.05 20 0.4)) (transpose (* 0.66 i) (ring 0.1 27 1)) (transpose -13 (ring 0.05 22 0.2)) (transpose (* i 1.5) (ring 0.1 28 0.7)) (transpose -2 (ring 0.05 31 0.9))))))) + (scale 1.0 (at 20.0 (ringpat1))) + (scale 0.7 (at 20.05 (stretch 1.5 (ringpat1)))) + )) + diff --git a/test/alpass.lsp b/test/alpass.lsp new file mode 100644 index 0000000..d2fa34b --- /dev/null +++ b/test/alpass.lsp @@ -0,0 +1,88 @@ +;; tests for alpass filters + +(autonorm-off) + +;; create a sum of sine tones signal, every 3rd harmonic to get some bw +(defun sine-src () + (scale 0.1 + (simrep (i 5) + (let () + ;(display "simrep" *warp*) + (osc (hz-to-step (* (1+ i) (step-to-hz c4)))))))) + +(defun osc-src () + (scale 0.5 (osc c4))) + +(defun s-rest-d () + (let () + ; (display "s-rest-d" *warp*) + (setf *srest* (s-rest)))) + +; (play (sine-src)) + +(defun source () (seq (stretch 2 (sine-src)) (s-rest-d))) + +; (play (source)) +;(play (seq (source) (source) (source) (source))) + +; play sound followed by alpassed sound with different parameters + +(defun test1 () + (seq (source) + (alpass (source) 0.05 100) + (alpass (source) 0.5 100) + (alpass (source) 0.05 1000) + (alpass (source) 0.5 1000))) + +;(play (test1)) + +(defun test2 () + (seq (source) + (alpass (source) 0.05 (pwlv 50 3 200) 50) + (alpass (source) 0.5 (pwlv 50 3 200) 50) + (alpass (source) 0.05 (pwlv 250 3 1000) 250) + (alpass (source) 0.5 (pwlv 250 3 1000) 250))) + +;(play (test2)) + +(defun test2b () + (seq (source) + (setf xxx (comb (source) (pwlv 0.02 3 0.1) 100)) + (setf yyy (comb (source) (pwlv 0.2 3 1.0) 100)) + (setf zzz (comb (setf www (source)) + (setf vvv (pwlv 0.02 3 0.1)) 1000)) + (alpass (source) (pwlv 0.2 3 1.0) 1000))) + +;(play (test2b)) + + +(defun test3 () + (seq (source) + (setf xxx (alpass (source) (pwlv 0.02 3 0.1) 100)) + (setf yyy (alpass (source) (pwlv 0.2 3 1.0) 100)) + (setf zzz (alpass (setf www (source)) + (setf vvv (pwlv 0.02 3 0.1)) 1000)) + (alpass (source) (pwlv 0.2 3 1.0) 1000))) + +;(play (test3)) + +(defun test4 () + (seq (source) + (alpass (source) (pwlv 0.02 3 0.1) (pwlv 50 3 200) 50) + (alpass (source) (pwlv 0.2 3 1.0) (pwlv 50 3 200) 50) + (alpass (source) (pwlv 0.02 3 0.1) (pwlv 500 3 2000) 500) + (alpass (source) (pwlv 0.2 3 1.0) (pwlv 500 3 2000) 500))) + +(play (test4)) + +(defun pulses () (scale 0.5 (stretch 3 (buzz 400 (hz-to-step 2) (pwl 1))))) +;(play (pulses)) + +(defun test4 () + (comb (pulses) (pwlv 0.6 3 0.1) 1000)) + +;(play (test4)) + + + + diff --git a/test/arraystream.lsp b/test/arraystream.lsp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/arraystream.lsp diff --git a/test/articulator1.txt b/test/articulator1.txt new file mode 100644 index 0000000..7144002 --- /dev/null +++ b/test/articulator1.txt @@ -0,0 +1,275 @@ +;--------------------------------------------------------------------------- +; Nyquist voice synthesis instrument by Eduardo Reck Miranda +; +; Implements a geometrical articulator for tongue position (h p) and +; lips rouding (r) +; +;--------------------------------------------------------------------------- +; Geometrical articulator: the following FORMx functions estimates the formant +; values from the positions of the three articulators p h and r, where: +; p = horizontal position of the tongue: 0.0 = front and 1.0 = back +; h = vertical position of the tongue: 0.0 = low and 1.0 = high +; r = rounding of the lips: 0.0 = spread -> 1.0 rounded +;--------------------------------------------------------------------------- +; FORM1: converts p-h-r articulators to first formant frequency +;--------------------------------------------------------------------------- +(defmacro form1 (p h r) + `(+ (* (+ (* (+ (- 392) (* 392 ,r)) (expt ,h 2)) + (* (- 596 (* 668 ,r)) ,h) + (+ (- 146) (* 166 ,r))) + (expt ,p 2)) + + (* (+ (* (- 348 (* 348 ,r)) (expt ,h 2)) + (* (+ (- 494) (* 606 ,r)) ,h) + (- 141 (* 175 ,r))) + ,p) + + (+ (* (- 340 (* 72 ,r)) (expt ,h 2)) + (* (+ (- 796) (* 108 ,r)) ,h) + (- 708 (* 38 ,r))) + )) + +;--------------------------------------------------------------------------- +; FORM2: converts p-h-r articulators to second formant frequency +;--------------------------------------------------------------------------- +(defmacro form2 (p h r) + `(+ (* (+ (* (+ (- 1200) (* 1208 ,r)) (expt ,h 2)) + (* (- 1320 (* 1328 ,r)) ,h) + (- 118 (* 158 ,r))) + (expt ,p 2)) + + (* (+ (* (- 1864 (* 1488 ,r)) (expt ,h 2)) + (* (+ (- 2644) (* 1510 ,r)) ,h) + (+ (- 561) (* 221 ,r))) + ,p) + + (+ (* (+ (- 670) (* 490 ,r)) (expt ,h 2)) + (* (- 1355 (* 697 ,r)) ,h) + (- 1517 (* 117 ,r))) + )) + +;--------------------------------------------------------------------------- +; FORM3: converts p-h-r articulators to third formant frequency +;--------------------------------------------------------------------------- +(defmacro form3 (p h r) + `(+ (* (+ (* (- 604 (* 604 ,r)) (expt ,h 2)) + (* (- 1038 (* 1178 ,r)) ,h) + (+ 246 (* 566 ,r))) + (expt ,p 2)) + + (* (+ (* (+ (- 1150) (* 1262 ,r)) (expt ,h 2)) + (* (+ (- 1443) (* 1313 ,r)) ,h) + (- (- 317) (* 483 ,r))) + ,p) + + (+ (* (- 1130 (* 836 ,r)) (expt ,h 2)) + (* (+ (- 315) (* 44 ,r)) ,h) + (- 2427 (* 127 ,r))) + )) + + +;--------------------------------------------------------------------------- +; FORM4: converts p-h-r articulators to fourth formant frequency +;--------------------------------------------------------------------------- +(defmacro form4 (p h r) + `(+ (* (+ (* (+ (- 1120) (* 16 ,r)) (expt ,h 2)) + (* (- 1696 (* 180 ,r)) ,h) + (+ 500 (* 522 ,r))) + (expt ,p 2)) + + (* (+ (* (+ (- 140) (* 240 ,r)) (expt ,h 2)) + (* (+ (- 578) (* 214 ,r)) ,h) + (- (- 692) (* 419 ,r))) + ,p) + + (+ (* (- 1480 (* 602 ,r)) (expt ,h 2)) + (* (+ (- 1220) (* 289 ,r)) ,h) + (- 3678 (* 178 ,r))) + )) + +;--------------------------------------------------------------------------- +; ADSR-SMOOTH: a standard ADSR envelope +;--------------------------------------------------------------------------- +(defun adsr-smooth (signal dur) + (mult signal (env 0.1 0.2 0.5 1.0 0.8 0.4 dur))) +;--------------------------------------------------------------------------- +; VIBRATO: generates vibrato +; vib-rate = vibrato rate in Hz +; dur = duration in seconds +;--------------------------------------------------------------------------- +(defun vibrato (vib-rate dur) + (osc (hz-to-step vib-rate) dur)) + +;--------------------------------------------------------------------------- +; PULSE-TABLE: build table for generating a pulse signal +; harm = number of harmonics +;--------------------------------------------------------------------------- +(defun pulse-table (harm) + (abs-env ;prevent any timewarping in the following + (let ((table (build-harmonic 1 2048))) + (cond ((> harm 1) ;sum remaining harmonics + (setf harm (- harm 1)) + (dotimes (i harm) + (setf table (sum table (build-harmonic (1+ i) 2048)))))) + table))) + +;--------------------------------------------------------------------------- +; PULSE-WITH-VIBRATO: generate pulse with vibrato +; step = pitch in steps +; duration = duration in seconds +; vib-rate = vibrato rate in Hz +;--------------------------------------------------------------------------- +(defun pulse-with-vibrato (step duration vib-rate) + (let (harm freq) + (setf freq (step-to-hz step)) + (setf harm (truncate (/ 22050 (* 2 freq)))) + (setf table (scale (/ 1.0 harm) (pulse-table harm))) + (fmosc step (vibrato vib-rate duration) (list table (hz-to-step 1) t)))) + +;--------------------------------------------------------------------------- +; VOICING-SOURCE: generate voicing source: pulse with vibrato + LPFs +; step = pitch in steps +; duration = duration in seconds +; vib-rate = vibrato rate in Hz +;--------------------------------------------------------------------------- +(defun voicing-source (step duration vib-rate) + (lp + (lp + (pulse-with-vibrato step duration vib-rate) + (* 1.414 (* 2 (step-to-hz step)))) + (* 1.414 (* 4 (step-to-hz step))))) + +;--------------------------------------------------------------------------- +; NOISE-SOURCE: generate noise source: noise + offset oscillator + LPF +; step = pitch in steps +; duration = duration in seconds +; vib-rate = vibrato rate in Hz +;--------------------------------------------------------------------------- +(defun noise-source (step duration vib-rate) + (lp + (sum + (noise duration) + (fmosc step (vibrato vib-rate duration))) 8000)) + +;--------------------------------------------------------------------------- +; SOURCE: generate source signal: voicing + noise sources +; freq = fundamental frequency in Hz +; duration = duration in seconds +; vib-rate = vibrato rate in Hz +; voicing-scale = percentage of voicing in the resulting signal (0.0 -> 1.0) +; noise-scale = percentage of noise in the resulting signal (0.0 -> 1.0) +;--------------------------------------------------------------------------- +(defun source (freq duration vib-rate voicing-scale noise-scale) + (sum + (scale voicing-scale (voicing-source (hz-to-step freq) duration vib-rate)) + (scale noise-scale (noise-source (hz-to-step freq) duration vib-rate)))) + + +;--------------------------------------------------------------------------- +; MAKE-SPECTRUM: formant filters +; freq = fundamental frequency in Hz +; dur = duration in seconds +; vib-rate = vibrato rate in Hz +; v-scale = amplitude scaling for the voicing source +; n-scale = amplitude scaling for the noise source +; p = horizontal position of the tongue (0.0 = front -> 1.0 = back) +; h = vertical position of the tongue (0.0 = low -> 1.0 = high) +; r = rouding of the lips (0.0 = spread -> 1.0 = rounded) +;--------------------------------------------------------------------------- +(defun make-spectrum (freq dur vib-rate v-scale n-scale p h r) + (let ((src (source freq dur vib-rate v-scale n-scale))) + (setf spectrum + (sim + (reson src (form1 p h r) 50 1) + (reson (scale-db (- 10) src) (form2 p h r) 70 1) + (reson (scale-db (- 14) src) (form3 p h r) 110 1) + (reson (scale-db (- 20) src) (form4 p h r) 250 1))))) + +;--------------------------------------------------------------------------- +; SYNTHESISE: the synthesise function +; Simplified version of the instrument used by the agents discussed in Chapter 6. +; f0 = pitch frequency +; w1 = amplitude of voicing source (min = 0.0 max = 1.0) +; w2 = amplitude of noise source (min = 0.0 max = 1.0) +; a = horizontal position of the tongue (0.0 = front -> 1.0 = back) +; b = vertical position of the tongue (0.0 = low -> 1.0 = high) +; c = rouding of the lips (0.0 = spread -> 1.0 = rounded) +; fm = vibrato rate (in Hz) +; h = duration in seconds +;--------------------------------------------------------------------------- +(defun synthesise (f0 w1 w2 a b c fm h) + (adsr-smooth (make-spectrum f0 h fm w1 w2 a b c) h)) + +;=== The code for the instrument ends here === + +;--------------------------------------------------------------------------- +; Test the SYNTHESISE function with different positions of the articulators +; +; Running steps: +; 1 - run Nyquist +; 2 - load "articulator.lsp" +; 3 - type (play (vowel-1)) to synthesise the first test, and so on +;--------------------------------------------------------------------------- +(defun vowel-1 () + (synthesise 220 1.0 0.005 0.0 0.0 0.0 5.6 1.0)) + +(defun vowel-2 () + (synthesise 220 1.0 0.005 0.0 0.0 1.0 5.6 1.0)) + +(defun vowel-3 () + (synthesise 220 1.0 0.005 0.5 0.0 0.0 5.6 1.0)) + +(defun vowel-4 () + (synthesise 220 1.0 0.005 0.5 0.0 1.0 5.6 1.0)) + +(defun vowel-5 () + (synthesise 220 1.0 0.005 1.0 0.0 0.0 5.6 1.0)) + +(defun vowel-6 () + (synthesise 220 1.0 0.005 1.0 0.0 1.0 5.6 1.0)) + +(defun vowel-7 () + (synthesise 220 1.0 0.005 0.0 0.5 0.0 5.6 1.0)) + +(defun vowel-8 () + (synthesise 220 1.0 0.005 0.0 0.5 1.0 5.6 1.0)) + +(defun vowel-9 () + (synthesise 220 1.0 0.005 0.5 0.5 0.0 5.6 1.0)) + +(defun vowel-10 () + (synthesise 220 1.0 0.005 0.5 0.5 1.0 5.6 1.0)) + +(defun vowel-11 () + (synthesise 220 1.0 0.005 1.0 0.5 0.0 5.6 1.0)) + +(defun vowel-12 () + (synthesise 220 1.0 0.005 1.0 0.5 1.0 5.6 1.0)) + +(defun vowel-13 () + (synthesise 220 1.0 0.005 0.0 1.0 0.0 5.6 1.0)) + +(defun vowel-14 () + (synthesise 220 1.0 0.005 0.0 1.0 1.0 5.6 1.0)) + +(defun vowel-15 () + (synthesise 220 1.0 0.005 0.5 1.0 0.0 5.6 1.0)) + +(defun vowel-16 () + (synthesise 220 1.0 0.005 0.5 1.0 1.0 5.6 1.0)) + +(defun vowel-17 () + (synthesise 220 1.0 0.005 1.0 1.0 0.0 5.6 1.0)) + +(defun vowel-18 () + (synthesise 220 1.0 0.005 1.0 1.0 1.0 5.6 1.0)) + +;; play everything +(defun vowel-n (n) (funcall (intern (format nil "VOWEL-~A" n)))) + +(defun play-all-vowels () + (autonorm-off) + (dotimes (i 18) (play (scale 20 (vowel-n (1+ i))))) + (autonorm-on)) + +; (play-all-vowels) will play everything in sequence diff --git a/test/audio.lsp b/test/audio.lsp new file mode 100644 index 0000000..770ed9a --- /dev/null +++ b/test/audio.lsp @@ -0,0 +1,9 @@ +;; audio.lsp +;; +;; simple audio output debugging test +;; +(defun test () (stretch (/ 3.0 44100) (control-srate-abs 44100.0 (ramp))))) +(play (vector (test) (test))) + +(play (test)) + diff --git a/test/cnvl.lsp b/test/cnvl.lsp new file mode 100644 index 0000000..d08c2c2 --- /dev/null +++ b/test/cnvl.lsp @@ -0,0 +1,18 @@ +;; cnvl.lsp -- convolve test + +;; original bug: convolve truncated the result to the duration of the +;; first parameter. +;; the fix: convolve.c was hand-modified to set the logical stop to +;; the end of the first parameter but the terminate time to the sum +;; of durations. + +(set-sound-srate 10.0) +(set-control-srate 10.0) + +(defun impulse () (snd-from-array 0.0 *default-sound-srate* (vector 1.0))) + +(defun train () (sim (impulse) (at 1.0 (impulse)) (at 2.0 (impulse)))) + + +(s-plot (train)) + diff --git a/test/comb.lsp b/test/comb.lsp new file mode 100644 index 0000000..49547bc --- /dev/null +++ b/test/comb.lsp @@ -0,0 +1,75 @@ +(load "rbd") + +(defun comb-test () + ;(comb (seq (noise) (s-rest 10)) 500 5)) + (sim + (setf dur 5) + (comb (seq (noise) (s-rest dur)) (step-to-hz c4) dur) + (comb (seq (noise) (s-rest dur)) (step-to-hz e4) dur) + (comb (seq (noise) (s-rest dur)) (step-to-hz d5) dur))) + +(setf bf3hz (step-to-hz bf3)) +(setf c4hz (step-to-hz c4)) +(setf bf4hz (step-to-hz bf4)) +(setf c5hz (step-to-hz c5)) +(setf d5hz (step-to-hz d5)) +(setf f5hz (step-to-hz f5)) +(setf g5hz (step-to-hz g5)) +(setf a5hz (step-to-hz a5)) +(setf b5hz (step-to-hz b5)) + +(defun pwl-step (fr to) + (pwl 0 fr 15 fr 16 to 35 to 35)) + +(defun reson-test () + (setf dur 4) + (let (center (snd (s-read "./test/snd/test2.snd"))) + (setf snd (seq (cue snd) (s-rest 5))) + (setf center (scale 0.01 (at 0.05 (cue snd)))) + (vector + (sim + (scale 0.01 snd) + center + (reson snd (pwl-step b5hz a5hz) 1) + (reson snd (pwl-step c5hz bf4hz) 1)) + (sim + (scale 0.01 (at 0.11 (cue snd))) + center + (scale 0.1 (reson snd (pwl-step c4hz bf3hz) 0.5)) + (reson snd (pwl-step g5hz f5hz) 1) + (reson snd (pwl-step d5hz c5hz) 1))))) + + +(defun reson-test-1 () + (setf dur 4) + (sim + (reson (seq (noise) (s-rest dur)) (step-to-hz c5) 1) + (reson (seq (noise) (s-rest dur)) (step-to-hz g5) 1) + (reson (seq (noise) (s-rest dur)) (step-to-hz d5) 1))) + +(defun convert-file () + (s-save (force-srate 22050 (jam-srate (aref (s-read "./test/snd/test1.snd") 0) 48000)) + 1000000 "./test/snd/test2.snd")) + +(defun jam-srate (snd rate) + (snd-xform snd rate (snd-time snd) + MIN-START-TIME MAX-STOP-TIME 1.0)) + +;(setf xxx (comb-test)) +(defun g () + (setf xxx (reson-test)) + (play-xxx)) + +(defun play-xxx () + (cond ((soundp xxx) (setf scale-factor (s-max xxx 1000000))) + ((arrayp xxx) + (setf scale-factor 0) + (dotimes (i (length xxx)) + (setf scale-factor + (max scale-factor + (s-max (aref xxx i) 1000000))))) + (t (error "bad type" xxx))) + (format t "Maximum amplitude before scaling: ~A~%" scale-factor) + (play (scale (/ scale-factor) xxx))) + +(g) diff --git a/test/convolve.lsp b/test/convolve.lsp new file mode 100644 index 0000000..2e94f9e --- /dev/null +++ b/test/convolve.lsp @@ -0,0 +1,31 @@ +; Here is some LISP code that was used to test the function: + +(setf testArray (make-array 10)) ; an array with 10 elements +(dotimes (i 10) + (setf (aref testArray i) (float i))) ; fill array with i +(display "convolve test" testArray) +(setf h (snd-from-array 0.0 100.0 testArray)) ; make a sound x from testArray + +(setf xArray (make-array 20)) ; an array with 10 elements +(dotimes (i 20) + (setf (aref xArray i) 0.0)) ; fill array with 0.0 +(setf (aref xArray 0) 1.0) ; set first element to 1 +(setf (aref xArray 15) 1.0) +(display "convolve test" xArray) +(setf x (snd-from-array 0.0 100.0 xArray)) ; make a sound h from xArray + +(setf output (snd-convolve x h)) ; perform convolution + +; convert output to an array and print: +(display "convolve test" (snd-samples output 100)) + +(print "Verify proper logical stop time using seq to add samples") +(setf yArray (make-array 10)) +(dotimes (i 10) + (setf (aref yArray i) 10.0)) +(setf y (snd-from-array 0.0 100.0 yArray)) +(display "test" (snd-samples (seq (cue output) (cue y)) 100)) + + + + diff --git a/test/delaytest.lsp b/test/delaytest.lsp new file mode 100644 index 0000000..c3c0007 --- /dev/null +++ b/test/delaytest.lsp @@ -0,0 +1,12 @@ +; test delay using seq and s-rest + +(setf *vc-score* '((0 1 (pluck c4)))) + +(defun long-delay (in) + (sum in (seq (s-rest 0.3) (cue in)))) + +;(play (timed-seq *vc-score*)) + +;(play (long-delay (timed-seq *vc-score*))) + +;(play (sim (timed-seq *vc-score*) (at 2 (timed-seq *vc-score*)))) diff --git a/test/envtest.lsp b/test/envtest.lsp new file mode 100644 index 0000000..1faf75f --- /dev/null +++ b/test/envtest.lsp @@ -0,0 +1,15 @@ +(defun pwltest () + (define-env 'bar (make-big-envelope))) + +(defun make-big-envelope () + (let (tim val lis (n 500)) + (dotimes (i n) + (setf tim (* (1+ i) 0.01)) + (setf val (rrandom)) + (setf lis (cons val (cons tim lis)))) + (setf lis (cons (* (1+ n) 0.01) lis)) + (cons 'pwl (reverse lis)))) + +;(print (make-big-envelope)) + +(pwltest)
\ No newline at end of file diff --git a/test/eq.lsp b/test/eq.lsp new file mode 100644 index 0000000..e1a7036 --- /dev/null +++ b/test/eq.lsp @@ -0,0 +1,33 @@ +;; test file for eq-band function + +;; NOTE: eq-band is happy if you give it all numerical arguments or if you give +;; it a set of time-varying arguments. It will not run with a mixture of scalar +;; and SOUND arguments. Use the Nyquist function CONST to coerce a scalar into +;; a constant-valued SOUND. Be careful to note that CONST returns to zero at the +;; default stop time, e.g. (const 5) lasts 1 second, (stretch 2 (const 5)) lasts +;; 2 seconds, etc. + +(play (eq-band (scale 0.1 (noise)) 1000 30 0.3)) ;; 20 dB gain + +(play (eq-band (scale 0.1 (noise)) (const 1000) (const 30) (const 0.3))) + +; different code is executed if the source has no scale factor... +(play (scale 0.1 (eq-band (noise) (const 1000) (const 30) (const 0.3)))) + +(play (eq-band (scale 0.1 (noise)) + (pwlv 800 1 1200) ; center frequency + (const 30) + (const 0.3))) + +(play (stretch 5 + (eq-band (scale 0.1 (noise)) + (const 1000) + (pwlv -30 1 30) ; gain + (const 0.3)))) + +(play (stretch 5 + (eq-band (scale 0.1 (noise)) + (const 1000) + (const 30) + (pwev 2 1 0.1)))) ; bandwidth in octaves + diff --git a/test/fft.lsp b/test/fft.lsp new file mode 100644 index 0000000..e1aea16 --- /dev/null +++ b/test/fft.lsp @@ -0,0 +1,211 @@ +;; this sample code is described in fft_tutorial.htm + +(setf fft1-class (send class :new '(sound length skip))) + +(send fft1-class :answer :next '() '( + (snd-fft sound length skip nil))) + +(send fft1-class :answer :isnew '(snd len skp) '( + (setf sound snd) + (setf length len) + (setf skip skp))) + +(defun make-fft1-iterator (sound length skip) + (send fft1-class :new (snd-copy sound) length skip)) + +;; create a 1-second sinusoid with points samples at cycles hz: +(defun short-sine (points cycles) + (control-srate-abs points (lfo cycles))) + +(defun fft-test () + (let (fft-iter) + ;; signal will have 4 cycles in 32 points: + (setf fft-iter (make-fft1-iterator (short-sine 32 4) 32 32)) + (display "fft-test" (send fft-iter :next)))) + +(defun ifft-test () + (let (fft-iter ifft-snd) + (setf fft-iter (make-fft1-iterator (short-sine 32 4) 32 32)) + (setf ifft-snd (snd-ifft 0 32 fft-iter 32 NIL)) + (display "fft-ifft" (snd-length ifft-snd 200)) + (display "fft-ifft" (snd-samples ifft-snd 200)) )) + + +; Test fft-test and ifft-test on a cosine using this redefinition: +; +; (defun short-sine (points cycles) +; (control-srate-abs points (lfo cycles 1.0 *sine-table* 90.0))) + + +(defun file-fft1 (filename frame-length skip) + (make-fft1-iterator (s-read filename) frame-length skip)) + + +(defun play-fft1 (iterator skip) + (play (snd-ifft 0 *sound-srate* iterator skip NIL))) + +;; a convenient sound file name (change this to one of your soundfiles): +(setf sfn "D:\\brain\\outro\\soup.wav") + +(defun file-test () (play-fft1 (file-fft1 sfn 512 512) 512)) + + +(setf fft-hp-class (send class :new '(source bins))) + + +(send fft-hp-class :answer :next '() '( + (let ((frame (send source :next))) + (cond (frame + (dotimes (i bins) + (setf (aref frame i) 0.0)))) + frame))) + + +(send fft-hp-class :answer :isnew '(s b) '( + (setf source s) + (setf bins b))) + + +(defun make-fft-hp (source bins) + (send fft-hp-class :new source bins)) + + +(defun hp-test () + (play-fft1 (make-fft-hp (file-fft sfn 512 512) 11) 512)) + + +(defun fm-tone (step mi1 mi2 mi3) + (let ((hz (step-to-hz step))) + (setf mi1 (* mi1 hz)) + (setf mi2 (* mi2 hz)) + (setf mi3 (* mi3 hz)) + (fmosc c4 (partial step + (control-srate-abs *sound-srate* + (pwl 0 mi1 0.5 mi2 1 mi3 1)))))) + + +(defun mod-snd () (fm-tone c3 5 7 5)) ;; adjust FM parameters here + + +(setf fft-modulator-class (send class :new '(src1 src2))) + + +(send fft-modulator-class :answer :isnew '(s1 s2) '( + (setf src1 s1) + (setf src2 s2))) + + +(send fft-modulator-class :answer :next '() '( + (let ((frame1 (send src1 :next)) + (frame2 (send src2 :next)) + n half_n) + (cond ((and frame1 frame2) + ; multiply frame2 by the amplitude coefficients of frame1 + (setf (aref frame2 0) (* (aref frame2 0) (aref frame1 0))) ;; DC + (setf n (- (length frame1) 1)) + ; Subtracted 1 because we already took care of DC component + (setf half_n (/ n 2)) ; integer divide + (dotimes (i half_n) + (let* ((i2 (+ i i 2)) + (i2m1 (- i2 1)) + (amp (sqrt (+ (* (aref frame1 i2m1) (aref frame1 i2m1)) + (* (aref frame1 i2) (aref frame1 i2)))))) (setf (aref frame2 i2m1) (* (aref frame2 i2m1) amp)) + (setf (aref frame2 i2) (* (aref frame2 i2) amp)))) + (cond ((= n (+ half_n half_n 2)) ;; n is even -> nyquist component + (setf (aref frame2 n) (* (aref frame2 n) (aref frame1 n))))) + frame2) + (t nil))))) + + +(defun make-fft-modulator (src1 src2) + (send fft-modulator-class :new src1 src2)) + + +(defun mod-test () + (let ((fs 512)) ;; frame size + (play-fft1 (make-fft-modulator + (make-fft1-iterator (mod-snd) fs fs) + (file-fft1 sfn fs fs)) + fs))) + + +(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))) + + +(defun play-fft (iterator frame-size skip) + (play (snd-ifft 0 *sound-srate* iterator + skip (fft-window frame-size)))) + + +(defun mod-test-w () + (let ((fs 512)) ;; frame size + (play-fft (make-fft-modulator + (make-fft1-iterator (mod-snd) fs (/ fs 2)) + (file-fft1 sfn fs (/ fs 2))) + fs (/ fs 2)))) + + +(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)) + +(defun file-fft (filename frame-length skip) + (make-fft-iterator (s-read filename) frame-length skip)) + +(defun mod-test-ww () + (let ((fs 512)) ;; frame size + (play-fft (make-fft-modulator + (make-fft-iterator (mod-snd) fs (/ fs 2)) + (file-fft sfn fs (/ fs 2))) + fs (/ fs 2)))) + +(defun fft-test-w () + (let (fft-iter) + ;; signal will have 4 cycles in 32 points: + (setf fft-iter (make-fft-iterator (short-sine 32 4) 32 32)) + (display "fft-test-w" (send fft-iter :next)))) + +(defun ifft-test-w () + (let (fft-iter ifft-snd) + ;; this will generate two frames rather than one as before, and + ;; with a higher harmonic to help detect the window: + (setf fft-iter (make-fft1-iterator (short-sine 64 8) 32 32)) + ;; window the result: + (setf ifft-snd (snd-ifft 0 32 fft-iter 24 (fft-window 32))) + (display "fft-ifft" (snd-length ifft-snd 200)) + (display "fft-ifft" (snd-samples ifft-snd 200)) + ifft-snd )) + + +(defun mod-snd-2 () (fm-tone d3 15 27 15)) ;; adjust FM parameters here + + +(defun mod-test-wwst () + (let ((fs 1024)) ;; frame size + (play-fft (make-fft-modulator + (file-fft sfn fs (/ fs 8)) + (make-fft1-iterator (transpose 2 (mod-snd-2)) fs (/ fs 8))) + fs (/ fs 2)))) + +;; do analysis synthesis +;; +(defun fft-ifft (sound) + (play-fft (make-fft-iterator sound 1024 512) 1024 512)) + diff --git a/test/fmfb-test.lsp b/test/fmfb-test.lsp new file mode 100644 index 0000000..6a6cd0d --- /dev/null +++ b/test/fmfb-test.lsp @@ -0,0 +1,14 @@ +; SND-FMFB ARGS: t0 hz sr index dur + +(defun feedback-fm (pitch index d) + (let ((hz (step-to-hz (+ pitch (get-transpose)))) + (dur (get-duration d))) + (snd-fmfb (local-to-global 0) hz *sound-srate* index dur))) + + +(play (feedback-fm a4 1.1 1)) + +(exit) + + + diff --git a/test/fmfbv-test.lsp b/test/fmfbv-test.lsp new file mode 100644 index 0000000..9497ba0 --- /dev/null +++ b/test/fmfbv-test.lsp @@ -0,0 +1,19 @@ +; SND-FMFBV ARGS: t0 hz sr index-sound + +; index > 1.1 gets noisy + +(defun feedbackv-fm (pitch index-sound) + (let ((hz (step-to-hz (+ pitch (get-transpose))))) + (snd-fmfbv (local-to-global 0) hz *sound-srate* index-sound))) + + +(play (seq + (mult (pwl 5.0 1.0 10.0) + (feedbackv-fm a4 (pwl 10 1.1 10.01))) + (mult (pwl 5.0 1.0 10.0) + (feedbackv-fm a3 (pwlv 1.1 10 0.0))))) + +(exit) + + + diff --git a/test/gab.lsp b/test/gab.lsp new file mode 100644 index 0000000..3544d63 --- /dev/null +++ b/test/gab.lsp @@ -0,0 +1,951 @@ +(setf ts (/ s 2.0)) + +(defun trumpet (p) + (double-carrier 0.6 (step-to-hz p) 1.0 1.0 0.5 3 1 (/ 3.0 1.5)) + + +(defun tI_1 () + (transpose -2 + (seq + (loud lmf + (seq + ;; measure 1 + (s-rest h) + (sustain 1.3 (stretch i (trumpet d5))) + (stretch i (trumpet g4)) + (stretch i (trumpet d5)) + (stretch i (trumpet e5)) + ;; measure 2 + (sustain .9 (stretch qd (trumpet f5))) + (stretch i (trumpet f5)) + (sustain 1.4 (stretch s (trumpet e5))) + (stretch s (trumpet d5)) + (stretch s (trumpet c5)) + (stretch s (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet a5)) + ;; measure 3 + (stretch i (trumpet g5)) + (stretch i (trumpet f5)) + (sustain 1.1 (stretch q (trumpet e5))) + (stretch h (trumpet d5)) + ;; measure 4 + (s-rest w) + ;; measure 5 + (s-rest w) + ;; measure 6 + (s-rest w))) + (loud lf + (seq + ;; measure 7 + (sustain 1.3 (stretch i (trumpet d5))) + (stretch i (trumpet g4)) + (stretch i (trumpet d5)) + (stretch i (trumpet e5)) + (sustain .9 (stretch qd (trumpet f5))) + (stretch i (trumpet f5)) + ;; measure 8 + (sustain 1.4 (stretch s (trumpet e5))) + (stretch s (trumpet d5)) + (stretch s (trumpet c5)) + (stretch s (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet a5)) + (stretch i (trumpet g5)) + (stretch i (trumpet f5)) + (sustain 1.1 (stretch q (trumpet e5))) + ;; measure 9 + (stretch w (trumpet d5)) + ;; measure 10 + (s-rest w) + ;; measure 11 + (sustain 1.3 (stretch i (trumpet d5))) + (stretch i (trumpet g4)) + (stretch i (trumpet d5)) + (stretch i (trumpet e5)) + (sustain .9 (stretch qd (trumpet f5))) + (stretch i (trumpet f5)) + ;; measure 12 + (sustain 1.4 (stretch s (trumpet e5))) + (stretch s (trumpet d5)) + (stretch s (trumpet c5)) + (stretch s (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet a5)) + (stretch i (trumpet g5)) + (stretch i (trumpet f5)) + (sustain 1.1 (stretch q (trumpet e5))) + ;; measure 13 + (sustain .9 (stretch qd (trumpet d5))) + (stretch i (trumpet d5)) + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (sustain 1.1 (stretch q (trumpet a4))) + ;; measure 14 + (stretch w (trumpet g4))))))) + + +(defun tII_1 () + (transpose -2 + (seq + (loud lmf + (seq + ;; measure 1 + (sustain 1.3 (stretch i (trumpet g4))) + (stretch i (trumpet d4)) + (stretch i (trumpet g4)) + (stretch i (trumpet a4)) + (sustain .9 (stretch qd (trumpet bf4))) + (stretch i (trumpet bf4)) + ;; measure 2 + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet e4)) + (stretch i (trumpet d4)) + (stretch i (trumpet d5)) + (sustain 1.4 (stretch s (trumpet c5))) + (stretch s (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch s (trumpet g4)) + (stretch q (trumpet f4)) + ;; measure 3 + (stretch s (trumpet bf4)) + (stretch s (trumpet c5)) + (stretch q (trumpet d5)) + (stretch i (trumpet cs5)) + (stretch h (trumpet d5)) + ;; measure 4 + (s-rest w))) + (loud lf + (seq + ;; measure 5 + (sustain 1.3 (stretch i (trumpet g4))) + (stretch i (trumpet d4)) + (stretch i (trumpet g4)) + (stretch i (trumpet a4)) + (sustain .9 (stretch qd (trumpet bf4))) + (stretch i (trumpet bf4)) + ;; measure 6 + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet e4)) + (stretch i (trumpet d4)) + (stretch i (trumpet d5)) + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch q (trumpet a4)) + ;; meaure 7 + (stretch qd (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch s (trumpet g4)) + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet e4)) + (stretch i (trumpet d4)) + (stretch i (trumpet d5)) + ;; measure 8 + (sustain 1.4 (stretch s (trumpet c5))) + (stretch s (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch s (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet a4)) + (stretch s (trumpet b4)) + (stretch s (trumpet cs5)) + (stretch q (trumpet d5)) + (stretch i (trumpet c5)) + ;; measure 9 + (stretch h (trumpet d5)) + (s-rest h) + ;; measure 10 + (s-rest h) + (sustain 1.3 (stretch i (trumpet g4))) + (stretch i (trumpet d4)) + (stretch i (trumpet g4)) + (stretch i (trumpet a4)) + ;; measure 11 + (sustain .9 (stretch qd (trumpet bf4))) + (stretch i (trumpet bf4)) + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet e4)) + (stretch i (trumpet d4)) + (stretch i (trumpet d5)) + ;; measure 12 + (sustain 1.4 (stretch s (trumpet c5))) + (stretch s (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch s (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet a4)) + (stretch s (trumpet b4)) + (stretch s (trumpet cs5)) + (stretch q (trumpet d5)) + (stretch i (trumpet c5)) + ;; measure 13 + (sustain .9 (stretch qd (trumpet d5))) + (stretch i (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (stretch i (trumpet fs4)) + ;; measure 14 + (stretch w (trumpet g4))))))) + +(defun h_1 () + (transpose -7 (seq + (loud lmf + (seq + ;; measure 1 + (s-rest w) + ;; measure 2 + (s-rest w) + ;; measure 3 + (s-rest h) + (sustain 1.3 (stretch i (trumpet g4))) + (stretch i (trumpet c4)) + (stretch i (trumpet g4)) + (stretch i (trumpet a4)) + ;; measure 4 + (sustain .9 (stretch qd (trumpet bf4))) + (stretch i (trumpet bf4)) + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet ef4)) + (stretch i (trumpet d4)) + (stretch i (trumpet g4)) + ;; measure 5 + (stretch i (trumpet fs4)) + (stretch q (trumpet g4)) + (stretch i (trumpet fs4)) + (sustain .9 (stretch qd (trumpet g4))) + (stretch i (trumpet ef4)) + ;; measure 6 + (stretch q (trumpet f4)) + (stretch i (trumpet ef4)) + (stretch i (trumpet g4)) + (stretch s (trumpet a4)) + (stretch s (trumpet b4)) + (stretch q (trumpet c5)) + (stretch i (trumpet b4)) + ;; measure 7 + (sustain 1.1 (stretch qd (trumpet c5))) + (sustain 1.4 (stretch s (trumpet bf4))) + (sustain 1.4 (stretch s (trumpet a4))) + (stretch h (trumpet g4)) + ;; measure 8 + (s-rest qd) + (stretch i (trumpet bf4)) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch i (trumpet ef5)) + (stretch i (trumpet c5)) + (stretch i (trumpet d5)) + ;; measure 9 + (stretch h (trumpet g4)))) + (loud lf + (seq + (sustain 1.3 (stretch i (trumpet g4))) + (stretch i (trumpet c4)) + (stretch i (trumpet g4)) + (stretch i (trumpet a4)) + ;; measure 10 + (sustain .9 (stretch qd (trumpet bf4))) + (stretch i (trumpet bf4)) + (sustain 1.1 (stretch qd (trumpet a4))) + (sustain 1.4 (stretch s (trumpet g4))) + (sustain 1.4 (stretch s (trumpet f4))) + ;; measure 11 + (stretch h (trumpet g4)) + (stretch h (trumpet g4)) + ;; measure 12 + (s-rest qd) + (stretch i (trumpet bf4)) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch i (trumpet ef5)) + (stretch i (trumpet c5)) + (stretch i (trumpet d5)) + ;; measure 13 + (sustain .9 (stretch qd (trumpet g4))) + (stretch i (trumpet bf4)) + (stretch i (trumpet af4)) + (stretch q (trumpet af4)) + (stretch i (trumpet g4)) + ;; measure 14 + (stretch w (trumpet e4))))))) + +(defun b_1 () + (seq + (loud lmf + (seq + ;; measure 1 + (s-rest w) + ;; measure 2 + (s-rest w) + ;; measure 3 + (sustain 1.3 (stretch i (trumpet f3))) + (stretch i (trumpet c3)) + (stretch i (trumpet f3)) + (stretch i (trumpet g3)) + (sustain .9 (stretch qd (trumpet af3))) + (stretch i (trumpet af3)) + ;; measure 4 + (sustain 1.4 (stretch s (trumpet g3))) + (stretch s (trumpet f3)) + (stretch s (trumpet ef3)) + (stretch s (trumpet d3)) + (stretch i (trumpet c3)) + (stretch i (trumpet c4)) + (sustain 1.4 (stretch s (trumpet bf3))) + (stretch s (trumpet af3)) + (stretch s (trumpet g3)) + (stretch s (trumpet f3)) + (stretch i (trumpet ef3)) + (stretch s (trumpet d3)) + (stretch s (trumpet c3)) + ;; measure 5 + (stretch i (trumpet d3)) + (stretch i (trumpet ef3)) + (stretch q (trumpet d3)) + (sustain 1.4 (stretch s (trumpet c3))) + (stretch s (trumpet bf2)) + (stretch s (trumpet af2)) + (stretch s (trumpet g2)) + (stretch i (trumpet f2)) + (stretch i (trumpet f3)) + ;; measure 6 + (stretch q (trumpet ef3)) + (stretch i (trumpet f3)) + (stretch i (trumpet af3)) + (stretch s (trumpet bf3)) + (stretch s (trumpet c4)) + (stretch i (trumpet df4)) + (stretch i (trumpet bf3)) + (stretch i (trumpet c4)) + ;; measure 7 + (stretch h (trumpet f3)) + (s-rest h) + ;; measure 8 + (s-rest w))) + ;; measure 9 + (loud lf + (seq + (sustain 1.3 (stretch i (trumpet f3))) + (stretch i (trumpet c3)) + (stretch i (trumpet f3)) + (stretch i (trumpet g3)) + (sustain .9 (stretch qd (trumpet af3))) + (stretch i (trumpet af3)) + ;; measure 10 + (sustain 1.4 (stretch s (trumpet g3))) + (stretch s (trumpet f3)) + (stretch s (trumpet ef3)) + (stretch s (trumpet d3)) + (stretch i (trumpet c3)) + (stretch i (trumpet c4)) + (sustain 1.1 (stretch qd (trumpet bf3))) + (sustain 1.4 (stretch s (trumpet af3))) + (sustain 1.4 (stretch s (trumpet g3))) + ;; measure 11 + (stretch h (trumpet f3)) + (s-rest h) + ;; meausre 12 + (s-rest w) + ;; measure 13 + (s-rest qd) + (stretch i (trumpet af2)) + (stretch s (trumpet bf2)) + (stretch s (trumpet c3)) + (stretch i (trumpet df3)) + (stretch i (trumpet bf2)) + (stretch i (trumpet c3)) + ;; measure 14 + (stretch w (trumpet f2)))))) + +(defun tI_2 () + (transpose -2 + (loud lp + (seq + ;; measure 15 + (sustain 1.1 (stretch qd (trumpet bf4))) + (sustain 1.3 (stretch i (trumpet c5))) + (stretch q (trumpet d5)) + (stretch q (trumpet bf4)) + (stretch q (trumpet g4)) + (stretch q (trumpet bf4)) + ;; measure 16 + (sustain 1.1 (stretch qd (trumpet a4))) + (sustain 1.3 (stretch i (trumpet bf4))) + (stretch q (trumpet c5)) + (stretch h (trumpet d5)) + (stretch q (trumpet cs5)) + ;; measure 17 + (stretch wd (trumpet d5)) + ;; measure 18 + (s-rest wd) + ;; measure 19 + (s-rest wd) + ;; measure 20 + (s-rest wd) + ;; measure 21 + (sustain 1.1 (stretch qd (trumpet bf4))) + (sustain 1.3 (stretch i (trumpet c5))) + (stretch q (trumpet d5)) + (stretch q (trumpet bf4)) + (stretch q (trumpet g4)) + (stretch q (trumpet bf4)) + ;; meausre 22 + (sustain 1.1 (stretch qd (trumpet a4))) + (sustain 1.3 (stretch i (trumpet bf4))) + (stretch q (trumpet c5)) + (stretch h (trumpet d5)) + (stretch q (trumpet cs5)))))) + +(defun tII_2 () + (transpose -2 + (loud lp + (seq + ;; measure 15 + (stretch w (trumpet g4)) + (stretch h (trumpet g4)) + ;; measure 16 + (stretch hd (trumpet f4)) + (stretch q (trumpet d4)) + (stretch h (trumpet e4)) + ;; measure 17 + (stretch wd (trumpet d4)) + ;; measure 18 + (s-rest wd) + ;; meausre 19 + (sustain 1.1 (stretch qd (trumpet f4))) + (sustain 1.3 (stretch i (trumpet g4))) + (stretch q (trumpet a4)) + (stretch q (trumpet f4)) + (stretch q (trumpet d4)) + (stretch q (trumpet f4)) + ;; measure 20 + (sustain 1.1 (stretch qd (trumpet e4))) + (sustain 1.3 (stretch i (trumpet d4))) + (stretch q (trumpet e4)) + (stretch h (trumpet g4)) + (stretch q (trumpet fs4)) + ;; measure 21 + (sustain 1.1 (stretch qd (trumpet g4))) + (sustain 1.3 (stretch i (trumpet a4))) + (stretch q (trumpet bf4)) + (stretch q (trumpet g4)) + (stretch q (trumpet d4)) + (stretch q (trumpet ef4)) + ;; measure 22 + (sustain 1.1 (stretch qd (trumpet f4))) + (sustain 1.3 (stretch i (trumpet g4))) + (stretch q (trumpet a4)) + (stretch q (trumpet a4)) + (sustain 1.1 (stretch h (trumpet a4))))))) + +(defun h_2 () + (transpose -7 + (loud lp + (seq + ;; measure 15 + (s-rest wd) + ;; measure 16 + (s-rest wd) + ;; measure 17 + (sustain 1.1 (stretch qd (trumpet ef4))) + (sustain 1.3 (stretch i (trumpet f4))) + (stretch q (trumpet g4)) + (stretch q (trumpet ef4)) + (stretch q (trumpet c4)) + (stretch q (trumpet ef4)) + ;; measure 18 + (sustain 1.1 (stretch qd (trumpet d4))) + (sustain 1.3 (stretch i (trumpet ef4))) + (stretch q (trumpet f4)) + (stretch h (trumpet g4)) + (stretch q (trumpet fs4)) + ;; measure 19 + (stretch wd (trumpet g4)) + ;; measure 20 + (stretch hd (trumpet f4)) + (stretch q (trumpet ef4)) + (stretch h (trumpet d4)) + ;; measure 21 + (stretch w (trumpet g4)) + (stretch h (trumpet ef4)) + ;; measure 22 + (stretch hd (trumpet f4)) + (stretch q (trumpet bf4)) + (sustain 1.1 (stretch h (trumpet a4))))))) + + +(defun b_2 () + (loud lp + (seq + ;; measure 15 + (s-rest wd) + ;; measure 16 + (s-rest wd) + ;; measure 17 + (stretch w (trumpet f3)) + (stretch h (trumpet f3)) + ;; meausre 18 + (stretch hd (trumpet ef3)) + (stretch q (trumpet c3)) + (stretch h (trumpet d3)) + ;; measure 19 + (stretch wd (trumpet c3)) + ;; measure 20 + (s-rest wd) + ;; measure 21 + (stretch w (trumpet f3)) + (stretch h (trumpet f3)) + ;; measure 22 + (stretch hd (trumpet ef3)) + (stretch q (trumpet c3)) + (stretch h (trumpet g3))))) + + +(defun tI_3 () + (transpose -2 + (loud lmf + (seq + ;; measure 23 + (stretch i (trumpet d5)) + (stretch i (trumpet a4)) + (sustain 1.4 (stretch s (trumpet bf4))) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch s (trumpet f5)) + (stretch i (trumpet e5)) + (stretch i (trumpet d5)) + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + ;; measure 24 + (stretch i (trumpet a4)) + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (s-rest q) + ;; measure 25 + (s-rest qd) + (stretch i (trumpet a4)) + (sustain 1.4 (stretch s (trumpet bf4))) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch s (trumpet f5)) + (stretch i (trumpet e5)) + (stretch i (trumpet d5)) + ;; measure 26 + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch q (trumpet a4)) + (stretch q (trumpet g4)) + (s-rest q) + ;; measure 27 [C] + (s-rest i) + (stretch i (trumpet c5)) + (sustain 1.4 (stretch s (trumpet c5))) + (stretch s (trumpet e5)) + (stretch s (trumpet f5)) + (stretch s (trumpet a5)) + (stretch i (trumpet g5)) + (stretch i (trumpet f5)) + (stretch i (trumpet e5)) + (stretch q (trumpet d5)) + ;; meausre 28 + (stretch i (trumpet cs5)) + (stretch id (trumpet d5)) + (stretch s (trumpet a4)) + (sustain 1.4 (stretch s (trumpet bf4))) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch s (trumpet f5)) + (stretch i (trumpet ef5)) + (stretch i (trumpet d5)) + ;; measure 29 + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + (stretch i (trumpet fs4)) + (stretch q (trumpet g4)) + (stretch i (trumpet fs4)))))) + + +(defun tII_3 () + (transpose -2 + (loud lmf + (seq + ;; measure 23 + (stretch q (trumpet f4)) + (s-rest i) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet e4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + ;; measure 24 + (stretch i (trumpet f4)) + (stretch i (trumpet e4)) + (stretch q (trumpet d4)) + (s-rest i) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet e4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + ;; measure 25 + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (stretch i (trumpet fs4)) + (stretch i (trumpet g4)) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet e4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + ;; measure 26 + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (stretch i (trumpet fs4)) + (stretch i (trumpet g4)) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet e4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + ;; measure 27 [C] + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (stretch s (trumpet f4)) + (stretch s (trumpet f4)) + (sustain 1.4 (stretch s (trumpet bf4))) + (stretch s (trumpet c5)) + (stretch s (trumpet d5)) + (stretch s (trumpet a4)) + (stretch i (trumpet c5)) + (stretch i (trumpet g4)) + ;; measure 28 + (stretch id (trumpet a4)) + (stretch s (trumpet e4)) + (sustain 1.4 (stretch s (trumpet f4))) + (stretch s (trumpet g4)) + (stretch s (trumpet a4)) + (stretch s (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + (stretch i (trumpet bf4)) + ;; measure 29 + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + (stretch i (trumpet ef4)) + (stretch i (trumpet d4)) + (sustain 1.1 (stretch h (trumpet d4))))))) + + +(defun h_3 () + (transpose -7 + (loud lmf + (seq + ;; measure 23 + (stretch q (trumpet g4)) + (s-rest hd) + ;; measure 24 + (s-rest i) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet ef4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet ef4)) + ;; measure 25 + (stretch id (trumpet f4)) + (stretch s (trumpet c4)) + (stretch i (trumpet ef4)) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet c4))) + (stretch s (trumpet d4)) + (stretch s (trumpet ef4)) + (stretch s (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet ef4)) + ;; measure 26 + (stretch q (trumpet f4)) + (stretch i (trumpet g4)) + (stretch i (trumpet g4)) + (sustain 1.4 (stretch s (trumpet c4))) + (stretch s (trumpet d4)) + (stretch s (trumpet ef4)) + (stretch s (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet ef4)) + ;; measure 27 [C] + (stretch id (trumpet f4)) + (stretch s (trumpet c4)) + (stretch i (trumpet ef4)) + (stretch s (trumpet d4)) + (stretch s (trumpet g4)) + (stretch i (trumpet c4)) + (s-rest s) + (stretch s (trumpet g4)) + (sustain 1.4 (stretch s (trumpet a4))) + (stretch s (trumpet bf4)) + (stretch s (trumpet c5)) + (stretch s (trumpet g4)) + ;; measure 28 + (stretch i (trumpet bf4)) + (stretch i (trumpet a4)) + (stretch q (trumpet g4)) + (s-rest i) + (stretch i (trumpet d4)) + (sustain 1.4 (stretch s (trumpet ef4))) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + ;; meausre 29 + (stretch i (trumpet af4)) + (stretch i (trumpet g4)) + (stretch i (trumpet f4)) + (stretch i (trumpet ef4)) + (stretch i (trumpet d4)) + (stretch i (trumpet c4)) + (sustain 1.1 (stretch q (trumpet d4))))))) + + +(defun b_3 () + (loud lmf + (seq + ;; measure 23 + (stretch h (trumpet c3)) + (s-rest h) + ;; measure 24 + (s-rest qd) + (stretch i (trumpet c3)) + (sustain 1.4 (stretch s (trumpet d3))) + (stretch s (trumpet ef3)) + (stretch s (trumpet f3)) + (stretch s (trumpet af3)) + (stretch i (trumpet g3)) + (stretch i (trumpet f3)) + ;; measure 25 + (stretch i (trumpet ef3)) + (stretch i (trumpet d3)) + (stretch q (trumpet c3)) + (stretch q (trumpet f3)) + (s-rest q) + ;; measure 26 + (s-rest qd) + (stretch i (trumpet c3)) + (sustain 1.4 (stretch s (trumpet d3))) + (stretch s (trumpet ef3)) + (stretch s (trumpet f3)) + (stretch s (trumpet af3)) + (stretch i (trumpet g3)) + (stretch i (trumpet f3)) + ;; measure 27 [C] + (stretch i (trumpet ef3)) + (stretch i (trumpet d3)) + (stretch i (trumpet c3)) + (stretch i (trumpet c3)) + (sustain 1.4 (stretch s (trumpet f3))) + (stretch s (trumpet g3)) + (stretch s (trumpet af3)) + (stretch s (trumpet c4)) + (stretch i (trumpet bf3)) + (stretch i (trumpet af3)) + ;; measure 28 + (stretch q (trumpet g3)) + (stretch i (trumpet c3)) + (stretch i (trumpet e3)) + (stretch i (trumpet f3)) + (stretch i (trumpet ef3)) + (stretch q (trumpet f3)) + ;; measure 29 + (stretch h (trumpet bf2)) + (stretch h (trumpet c3))))) + + +(defun tI_4 () + (transpose -2 + (seqrep (i 1) + (seq + (loud lpp + (seq + ;; measure 30 + (stretch s (trumpet g4)) + (stretch s (trumpet g4)) + (stretch s (trumpet bf4)) + (stretch s (trumpet c5)) + (sustain 1.1 (stretch q (trumpet d5))) + (stretch i (trumpet d5)) + (stretch i (trumpet bf4)) + (sustain 1.1 (stretch q (trumpet c5))) + ;; measure 31 + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch i (trumpet bf4)) + (sustain 1.4 (stretch s (trumpet a4))) + (sustain 1.4 (stretch s (trumpet g4))) + (stretch i (trumpet a4)) + (stretch q (trumpet bf4)) + (stretch i (trumpet a4)) + ;; measure 32 + (stretch q (trumpet bf4)) + (sustain 1.1 (stretch q (trumpet d5))) + (stretch i (trumpet d5)) + (stretch i (trumpet d5)) + (sustain 1.1 (stretch q (trumpet d5))) + ;; measure 33 + (stretch i (trumpet d5)) + (stretch i (trumpet d5)) + (stretch i (trumpet d5)) + (stretch i (trumpet f5)) + (sustain 1.3 (stretch i (trumpet ef4))) + (stretch i (trumpet d4)) + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + ;; measure 34 [D] + (stretch i (trumpet a4)) + (stretch i (trumpet d5)) + (stretch i (trumpet a4)) + (stretch i (trumpet bf4)) + (stretch qd (trumpet fs4)) + (stretch i (trumpet d5)) + ;; measure 35 + (stretch i (trumpet a4)) + (stretch i (trumpet bf4)) + (stretch i (trumpet fs4)) + (stretch i (trumpet g4)) + (sustain 1.3 (stretch i (trumpet a4))) + (stretch i (trumpet bf4)) + (stretch i (trumpet c5)) + (stretch i (trumpet d5)) + ;; meausre 36 + (stretch i (trumpet e5)) + (stretch i (trumpet f5)) + (stretch s (trumpet e5)) + (stretch i (trumpet d5)) + (stretch s (trumpet cs5)) + (stretch s (trumpet d5)) + (stretch s (trumpet a4)) + (stretch s (trumpet f4)) + (stretch s (trumpet g4)) + (stretch i (trumpet a4)) + (stretch i (trumpet bf4)) + ;; measure 37 + (stretch i (trumpet a4)) + (stretch i (trumpet g4)) + (stretch s (trumpet fs4)) + (stretch i (trumpet g4)) + (stretch s (trumpet fs4)) + (stretch s (trumpet g4)) + (stretch s (trumpet d5)) + (stretch s (trumpet bf4)) + (stretch s (trumpet c5)) + (stretch i (trumpet d5)) + (stretch i (trumpet ef5)) + ;; measure 38 + (stretch i (trumpet d5)) + (stretch i (trumpet c5)) + (stretch s (trumpet b4)) + (stretch i (trumpet c5)) + (stretch s (trumpet b4)) + (stretch s (trumpet c5)) + (stretch s (trumpet g5)) + (stretch s (trumpet e5)) + (stretch s (trumpet f5)) + (stretch i (trumpet g5)) + (stretch i (trumpet a5)) + ;; measure 39 + (stretch i (trumpet g5)) + (stretch i (trumpet f5)) + (stretch s (trumpet e5)) + (stretch i (trumpet f5)) + (stretch s (trumpet e5)) + (stretch s (trumpet f5)) + (stretch s (trumpet c5)) + (stretch s (trumpet a4)) + (stretch s (trumpet bf4)) + (stretch i (trumpet c5)) + (stretch i (trumpet d5)) + ;; measure 40 + (stretch i (trumpet c5)) + (stretch i (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch i (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch s (trumpet bf4)) + (stretch s (trumpet f4)) + (stretch s (trumpet d4)) + (stretch s (trumpet e4)) + (stretch i (trumpet f4)) + (stretch i (trumpet g4)) + ;; measure 41.1 + (stretch i (trumpet a4)) + (stretch i (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch i (trumpet g4)) + (stretch s (trumpet fs4)) + ;; measure 41.2 + (stretch i (trumpet a4)) + (stretch i (trumpet bf4)) + (stretch s (trumpet a4)) + (stretch i (trumpet g4)) + (stretch s (trumpet fs4)) +(stretch q (trumpet g4)) +(s-rest s) +(stretch s (trumpet d5)) +(stretch s (trumpet b4)) +(stretch s (trumpet c5)) +;; measure 42 +(stretch i (trumpet d5)) +(stretch i (trumpet ef5)) +(stretch i (trumpet d5)) +(stretch i (trumpet c5)) +(stretch i (trumpet b4)) +(stretch i (trumpet c5)) +(s-rest ts) +(sustain 1.1 (stretch ts (trumpet g5))) +(sustain 1.1 (stretch ts (trumpet f5))) +(stretch s (trumpet ef5)) +(stretch s (trumpet c5)) +;; measure 43 +(stretch i (trumpet b4)) +(stretch i (trumpet c5)) +(s-rest ts) +(sustain 1.1 (stretch ts (trumpet g5))) +(sustain 1.1 (stretch ts (trumpet f5))) +(stretch s (trumpet ef5)) +(stretch s (trumpet c5)) +(stretch i (trumpet b4)) +(stretch i (trumpet c5)) +(stretch q (trumpet e5)) +;; measure 44 +(stretch w (trumpet d5)))))))) + + + +;; stretch .75 because q = 60 corresponds to a stretch of 1, so +;; q = 80 corresponds to 60/80 = .75 + + +(defun gabrieli () + (loud lp (sim + (seq (stretch .75 (tI_1)) (stretch .25 (tI_2)) (stretch .75 (tI_3))) + (seq (stretch .75 (tII_1)) (stretch .25 (tII_2)) (stretch .75 (tII_3))) + (seq (stretch .75 (h_1)) (stretch .25 (h_2)) (stretch .75 (h_3))) + (seq (stretch .75 (b_1)) (stretch .25 (b_2)) (stretch .75 (b_3))) + ))) diff --git a/test/gatetest.lsp b/test/gatetest.lsp new file mode 100644 index 0000000..891233c --- /dev/null +++ b/test/gatetest.lsp @@ -0,0 +1,24 @@ +(defun gate-test () + (setf yy (gate xx 1.0 0.1 2.0 0.1 0.5)) + (s-plot yy)) + +(set-control-srate 100) +(set-sound-srate 100) + +(setf xx (pwl 0 1 0.1 0 3 0 3 1 4 0 5)) + +(setf zz (pwl 0 1 0.02 0 1.99 0 2.0 1 2.01 0 2.09 0 2.1 1 2.11 0 + 2.99 0 3 1 3.01 0 3.09 0 3.1 1 3.11 0 3.19 0 3.2 1 3.21 0 5)) + +(defun noise-gate (snd &optional (lookahead 0.5) (risetime 0.02) (falltime 0.5) + (floor 0.01) (threshold 0.01)) + (let ((rms (lp (mult snd snd) (/ *control-srate* 10.0)))) + (setf save-rms rms) + (setf threshold (* threshold threshold)) + (mult snd (gate rms lookahead risetime falltime floor threshold)))) + +(defun ngtest () + (setf xx (mult (stretch 5 (lfo 40)) (pwl 0 1 0.5 0 2 0 2 1 2.5 1 2.5 0 5))) + (setf xx (sum xx (scale 0.01 (stretch 5 (noise))))) + (setf yy (noise-gate xx)) + (s-plot (vector xx yy))) diff --git a/test/gr.lsp b/test/gr.lsp new file mode 100644 index 0000000..744376b --- /dev/null +++ b/test/gr.lsp @@ -0,0 +1,35 @@ +(defun gr () + (show-graphics) + (showpen) + (moveto 0 0) + (lineto 20 20)) + +(setf graph-width 600) +(setf graph-height 220) + +(defun array-max-abs (points) + (let ((m 0.0)) + (dotimes (i (length points)) + (setf m (max m (abs (aref points i))))) + m)) + +(defun s-plot (snd &optional (n 1000)) + (prog ((points (snd-samples snd n)) + maxpoint y-offset horizontal-scale vertical-scale) + (show-graphics) + (clear-graphics) + (setf maxpoint (array-max-abs points)) + (setf y-offset (/ graph-height 2)) + (moveto 0 y-offset) + (lineto graph-width y-offset) + (moveto 0 y-offset) + (setf horizontal-scale (/ (float graph-width) (length points))) + (setf vertical-scale (- (/ (float y-offset) maxpoint))) + (dotimes (i (length points)) + (lineto (truncate (* horizontal-scale i)) + (+ y-offset (truncate (* vertical-scale (aref points i)))))) + (format t "X Axis: ~A to ~A (seconds)\n" (snd-t0 snd) (/ (length points) (snd-srate snd))) + (format t "Y Axis: ~A to ~A\n" (- maxpoint) maxpoint) + (format t "~A samples plotted.\n" (length points)) + )) + diff --git a/test/ifft.lsp b/test/ifft.lsp new file mode 100644 index 0000000..0460554 --- /dev/null +++ b/test/ifft.lsp @@ -0,0 +1,142 @@ +;; test code for ifft framework + +; The interface to SND-IFFT is: +; (snd-ifft t0 sr iterator) +; where t0 is the starting time, +; sr is the sample rate, and +; iterator is an XLisp object + +; the iterator object must return an array of samples when :next is sent +; or return NIL to end the sound +; The sound returned by SND-IFFT (for now) is simply the concatenation +; of all samples returned in arrays returned from :next. + +; TEST IT.... + +; first, make a class: + +(setf iter-class (send class :new '(count len))) + +; now define some methods +; for this test, we'll return "count" arrays of length "len" and +; we'll fill the arrays with a ramp from -1 to +1 so that the final +; result will be a sawtooth wave + +(send iter-class :answer :set-count '(c) '((setf count c))) +(send iter-class :answer :set-len '(l) '((setf len l))) +(send iter-class :answer :next '() '( + (format t "iter-class got :next\n") + (cond ((<= count 0) nil) + (t + (setf count (- count 1)) + (make-ramp-array len))))) + +(defun make-ramp-array (len) + (let (ar) + (setf ar (make-array len)) + (dotimes (i len) + (setf (aref ar i) (+ -1 (* i (/ 2.0 len))))) + ar)) + +; now try calling SND-IFFT with an object +(setf iter (send iter-class :new)) +(send iter :set-count 10) +(send iter :set-len 20) + +(print "Select SPLIT SCREEN item in CONTROL menu on Macs for good screen layout") + +(defun ifft-test () + ;(s-plot (snd-ifft 0.0 100 iter nil))) + (play (snd-ifft 0.0 44100.0 iter 20 nil))) + + +;; fft code: make an object that returns ffts when called with :NEXT +;; +(setf fft-class (send class :new '(sound length skip))) + +(send fft-class :answer :next '() '((snd-fft sound length skip nil))) +; there's a way to do this with new, but I forgot how... +(send fft-class :answer :init '(snd len skp) '( + (setf sound snd) + (setf length len) + (setf skip skp))) + +(defun make-fft-iterator (sound length skip) + (let (iter) + (setf iter (send fft-class :new)) + ; make a copy because the snd-fft will modify the sound: + (send iter :init (snd-copy sound) length skip) + iter)) + +;; print ffts of a short ramp: +(defun fft-test () + (let (fft-iter) + (setf fft-iter (control-srate-abs 100 + (make-fft-iterator (pwl 1 1 1 0) 32 32))) + (dotimes (i 5) (print (list 'fft (send fft-iter :next)))))) + +;; now try running the ffts through the ifft: +(defun fft-ifft-test () + (let (fft-iter ifft-snd) + (setf fft-iter (control-srate-abs 100 + (make-fft-iterator (pwl 1 1 1 0) 32 32))) + (setf ifft-snd (snd-ifft 0 100 fft-iter)) + (display "fft-ifft" (snd-length ifft-snd 200)) + (display "fft-ifft" (snd-samples ifft-snd 200)) + (s-plot ifft-snd))) + +;(fft-ifft-test) + +(defun square (x) (* x x)) + +(defun amplitude-spectrum (spectrum) + (let ((result (make-array (+ 1 (/ (length spectrum) 2))))) + (setf (aref result 0) (aref spectrum 0)) + (dotimes (i (/ (- (length spectrum) 1) 2)) + (setf (aref result (1+ i)) (sqrt (+ (square (aref spectrum (+ 1 (* 2 i)))) + (square (aref spectrum (+ 2 (* 2 i)))) )))) + (cond ((evenp (length spectrum)) + (setf (aref result (/ (length spectrum) 2)) + (aref spectrum (- (length spectrum) 1))))) + result)) + + +;; test fft on sinusoids +;; +;; length 32 ffts, lfo has period 16 +;; should show as 2nd harmonic +;; +(defun sin-test () + (let (fft-iter) + (setf fft-iter (control-srate-abs 32 + (make-fft-iterator (stretch 4 (lfo 2)) 32 32))) + (dotimes (i 5) (print (list 'fft-sin-test-amplitude-spectrum + (amplitude-spectrum + (cadr (print (list 'sin-test-spectrum + (send fft-iter :next)))))))))) + +(setf spectrum (vector 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) +(dotimes (i 32) (setf (aref spectrum i) (float (aref spectrum i)))) + +(setf sine-class (send class :new '(count len))) + +; now define some methods +; for this test, we'll return "count" arrays of length "len" + +(send sine-class :answer :set-count '(c) '((setf count c))) +(send sine-class :answer :set-len '(l) '((setf len l))) +(send sine-class :answer :next '() '( + (format t "sine-class got :next\n") + (cond ((<= count 0) nil) + (t + (setf count (- count 1)) + spectrum)))) + +(setf sin-iter (send sine-class :new)) +(send sin-iter :set-count 10) +(send sin-iter :set-len 20) + +(defun sin-gen-test () + (play (snd-ifft 0.0 44100.0 sin-iter 20 nil))) + +;;TODO: (sin-gen-test) should generate a sinusoid tone with a period of 16 samples diff --git a/test/ifftnt.lsp b/test/ifftnt.lsp new file mode 100644 index 0000000..fcac837 --- /dev/null +++ b/test/ifftnt.lsp @@ -0,0 +1,90 @@ +;; test code for ifft framework + +; The interface to SND-IFFT is: +; (snd-ifft t0 sr iterator) +; where t0 is the starting time, +; sr is the sample rate, and +; iterator is an XLisp object + +; the iterator object must return an array of samples when :next is sent +; or return NIL to end the sound +; The sound returned by SND-IFFT (for now) is simply the concatenation +; of all samples returned in arrays returned from :next. + +; TEST IT.... + +; first, make a class: + +(setf iter-class (send class :new '(count len))) + +; now define some methods +; for this test, we'll return "count" arrays of length "len" and +; we'll fill the arrays with a ramp from -1 to +1 so that the final +; result will be a sawtooth wave + +(send iter-class :answer :set-count '(c) '((setf count c))) +(send iter-class :answer :set-len '(l) '((setf len l))) +(send iter-class :answer :next '() '( + (format t "iter-class got :next\n") + (cond ((<= count 0) nil) + (t + (let (res) + (setf count (- count 1)) + (setf res (make-ramp-array len)) + (display "iter-class returns" res) + res))))) + +(defun make-ramp-array (len) + (let (ar) + (setf ar (make-array len)) + (dotimes (i len) + (setf (aref ar i) (+ -1 (* i (/ 2.0 len))))) + ar)) + +; now try calling SND-IFFT with an object +(setf iter (send iter-class :new)) +(send iter :set-count 10) +(send iter :set-len 20) + +(print "Select SPLIT SCREEN item in CONTROL menu on Macs for good screen layout") + +(defun ifft-test () + (s-save (snd-ifft 0.0 100 iter) ny:all "test.wav")) + + +;; fft code: make an object that returns ffts when called with :NEXT +;; +(setf fft-class (send class :new '(sound length skip))) + +(send fft-class :answer :next '() '((snd-fft sound length skip))) +; there's a way to do this with new, but I forgot how... +(send fft-class :answer :init '(snd len skp) '( + (setf sound snd) + (setf length len) + (setf skip skp))) + +(defun make-fft-iterator (sound length skip) + (let (iter) + (setf iter (send fft-class :new)) + ; make a copy because the snd-fft will modify the sound: + (send iter :init (snd-copy sound) length skip) + iter)) + +;; print ffts of a short ramp: +(defun fft-test () + (let (fft-iter) + (setf fft-iter (control-srate-abs 100 + (make-fft-iterator (pwl 1 1 1 0) 32 32))) + (dotimes (i 5) (print (send fft-iter :next))))) + +;; now try running the ffts through the ifft: +(defun fft-ifft-test () + (let (fft-iter ifft-snd) + (setf fft-iter (control-srate-abs 100 + (make-fft-iterator (pwl 1 1 1 0) 32 32))) + (setf ifft-snd (snd-ifft 0 100 fft-iter)) + (display "fft-ifft" (snd-length ifft-snd 200)) + (display "fft-ifft" (snd-samples ifft-snd 200)) + (s-save ifft-snd ny:all "test.wav"))) + + diff --git a/test/init.lsp b/test/init.lsp new file mode 100644 index 0000000..533da0a --- /dev/null +++ b/test/init.lsp @@ -0,0 +1,24 @@ +; init.lsp -- default Nyquist startup file +(load "nyinit.lsp") + +; add your customizations here: +; e.g. (setf *default-sf-dir* "...") +(setf *default-sf-dir* "/space/rbd/tmp/") +;(load "tp") + +;(load "gab") + +; here's where the error occurs: +;(play (trumpet c4)) + + +(set-sound-srate 4) +(set-control-srate 4) +(Defun xx () (snd-samples (sum (set-logical-stop (osc c4 3) 2) (const 10)) 20)) +(defun yy () (snd-samples (sum (osc c4 2) (const 10)) 20)) +(defun zz () (snd-samples (snd-prod (set-logical-stop (osc c4 3) 2) (stretch 3 (const 10))) 20)) +(defun ww () (snd-samples (snd-prod (osc c4 3) (stretch 3 (const 10))) 20)) + +; here's where the error occurs (at sample rate of 4) +;(play (trumpet c4)) +(load "natbug") diff --git a/test/linux-segfault.lsp b/test/linux-segfault.lsp new file mode 100644 index 0000000..b9eec54 --- /dev/null +++ b/test/linux-segfault.lsp @@ -0,0 +1,40 @@ + +(setf *maintable* (sim (scale 0.9 (build-harmonic 1 2048)) + (scale 0.2 (build-harmonic 2 2048)) + (scale 0.3 (build-harmonic 3 2048)) + (scale 0.3 (build-harmonic 4 2048)) + (scale 0.2 (build-harmonic 5 2048)) + (scale 0.2 (build-harmonic 6 2048)))) + +(setf *maintable* (list *maintable* (hz-to-step 1.0) T)) + +(setf *overtable* (sim (scale 1 (build-harmonic 1 2048)))) + +(setf *overtable* (list *overtable* (hz-to-step 1.0) T)) + +(defun maintone (note vibe) + (fmosc note (scale 0.3 (lfo vibe)) *maintable* 0.0) +) + +(defun overtone (note vibe vol) + (scale vol (mult (fmosc note (scale 0.2 (lfo 16)) *overtable* 0.1) + (sum (const 1) (scale 0.2 (lfo vibe)))))) + + +(defun bandsweep (low hi) + (hp (lp (noise) (pwev (+ low 5) 1 (+ hi 5))) (pwev low 1 hi))) + +(play (timed-seq `( + (0 30 (overtone ef7 .75 0.4)) + (1 30 (overtone ds7 1.3 .3)) + (1 30 (overtone cs7 .36 .3)) + (1 30 (overtone gs7 .8 .5)) + (1.5 5 (scale 0.7 (bandsweep 200 2000))) + (1 7 (scale 0.7 (bandsweep 500 8000))) + (2 2 (pluck c4)) + (5 5 (pluck e4)) + (7 10 (pluck g4)) + ) + ) + ) + diff --git a/test/midi2.lsp b/test/midi2.lsp new file mode 100644 index 0000000..90abb6b --- /dev/null +++ b/test/midi2.lsp @@ -0,0 +1,94 @@ +(defun midi2 () ; this was original test file, here wrapped in + ; defun so that it doesn't execute + +;(set-sound-srate 22050.0) + +(setf *default-plot-file* "/tmp/points.dat") + +(setf my-seq (seq-create)) +(setf midifile (open "/afs/andrew.cmu.edu/usr15/sr4r/public/testmidi.mid")) + +(seq-read-smf my-seq midifile) + +(close midifile) + +) + + +(defun my-note-2 (p) + (display "my-note-2" p (get-duration 1.0) (local-to-global 0.0)) + (scale 0.2 (osc p))) + +(defun my-note (p) + (display "my-note" p (get-duration 1.0) (local-to-global 0.0)) + (scale 0.2 (mult (pwl 0.1 1 0.9 1 1) (osc p)))) + +(defun ss () (seq-midi my-seq + (note (chan pitch velocity) (my-note pitch)))) + +(defun ss1 () (seq-midi my-seq + (note (chan pitch velocity) (my-note-2 (- pitch 84))))) + +(defun ss2 () + (sim (at .75 (Stretch .333 (my-note-2 -19))) + (at 1.0 (stretch .333 (my-note-2 -15))) + (at 1.5 (stretch .333 (my-note-2 -12))) + (at 2.0 (stretch .333 (my-note-2 -12))) + (at 2.75 (stretch .333 (my-note-2 -10))) + (at 3.625 (stretch .333 (my-note-2 -7))))) + +(defun ss3 () + (sim (at .75 (Stretch .333 (my-note-2 -19))) + (at 1.0 (stretch .333 (my-note-2 -15))))) + + +(defun ss4 () + (sim (at .75 (Stretch .333 (my-note 65))) + (at 1.0 (stretch .333 (my-note 69))) + (at 1.5 (stretch .333 (my-note 72))) + (at 2.0 (stretch .333 (my-note 72))) + (at 2.75 (stretch .333 (my-note 74))) + (at 3.625 (stretch .333 (my-note 77))))) + +(defun ss5 () + (seq + (set-logical-stop (stretch .333 (my-note 65)) .25) + (set-logical-stop (stretch .333 (my-note 69)) .5) + (set-logical-stop (stretch .333 (my-note 72)) .5) + (set-logical-stop (stretch .333 (my-note 72)) .75) + (set-logical-stop (stretch .333 (my-note 74)) .875) + (stretch .333 (my-note 77)))) + +(defun ss6 () + (seq (set-logical-stop (stretch .333 (my-note 65)) .5) + (stretch .333 (my-note 77)))) + +(defun ss7 () + (seq (set-logical-stop (stretch .333 (my-note -19)) .5) + (stretch .333 (my-note -7)))) + +(defun lowrates () +(set-sound-srate 100) +(set-control-srate 100) +) + + +(defun pulse () + (display "pulse" (local-to-global 0.0) (get-duration 1.0)) + (pwl 0 1 1)) + +(defun t1 () (seq-midi my-seq + (note (chan pitch velocity) (pulse)))) + + +;=============================new test for Windows================== + + +(defun wt () + + (setf my-seq (seq-create)) + (setf midifile (open "..\\test\\test.gio")) + (seq-read my-seq midifile) + (close midifile) + (seq-midi my-seq (note (chan pitch vel) (my-note pitch))) +) diff --git a/test/ms2.lsp b/test/ms2.lsp new file mode 100644 index 0000000..69d6533 --- /dev/null +++ b/test/ms2.lsp @@ -0,0 +1,7 @@ +;This causes a memory allocate/free bug, possibly related to multiseq: + +(load "rbd") +(load "alex") +(play (seqrep (i 10) (scale 0.5 (ster (osc 46 0.5) (* i 0.1))))) +(play (seqrep (i 10) (scale 0.5 (ster (osc 46 0.5) (* i 0.1))))) +(play (seqrep (i 10) (scale 0.5 (ster (osc 46 0.5) (* i 0.1))))) diff --git a/test/multiseq.lsp b/test/multiseq.lsp new file mode 100644 index 0000000..ea65361 --- /dev/null +++ b/test/multiseq.lsp @@ -0,0 +1,88 @@ + +(defun mst () + (setf xxx (seq (vector (osc c4) (osc g4)) (vector (osc c3) (osc e4)))) + (play xxx)) + +(defun mst1 () + (setf xxx (seq (vector (const 1) (const 2)) (vector (const 3) (const 4)))) + (play xxx)) + +(defun mst2 () + (setf xxx (seq (vector (ramp) (ramp)) (vector (ramp) (ramp)))) + (play xxx)) + +(defun mst3 () + (setf xxx (seq (vector (ramp) (at 0.5 (const 1))) + (vector (ramp) (at 0.8 (const 2)))))) + +(defun mst4 () + (setf xxx (seq (vector (ramp) (ramp)) + (vector (at 0.5 (const 1)) (at 0.8 (const 2))) + (vector (ramp) (ramp)) ))) + +(defun sh () (dotimes (i 2) (print (snd-samples (aref xxx i) 100)))) + +(defun lsr () + (set-sound-srate 10) + (set-control-srate 10)) + +(defun hsr () + (set-sound-srate 22050) + (set-control-srate 2205)) + +;crash: (load "test/rbd") (lsr) (mst1) + +(defun msr1 () + (seqrep (i 3) + (vector (osc (+ c4 i)) (osc (+ e4 i))))) + +(defun ster (sound pan) + (vector (mult sound pan) + (mult sound (sum 1 (mult -1 pan))))) + +(defun ster (sound pan) + (vector (snd-normalize (mult sound pan)) + (snd-normalize (mult sound (sum 1 (mult -1 pan)))))) + +(defun msr2 () + (seqrep (i 10) (ster (osc 46 0.2) (* i 0.1)))) + +; The next 4 lines crash nyquist if sound_types are allocated from the +; freelist. They just don't work if sound_types are always allocated +; from the pool. I guess something is getting on the freelist early. +; bad ref count? +(lsr) +(play (msr2)) +(play (msr2)) +;(play (msr2)) +;(play (msr2)) +;(play (msr2)) + + +;(play (stretch 0.2 (ster (osc c4) 0.1))) +'( +(hsr) +(play (stretch 0.2 (seq (ster (osc c4) 0.9) (ster (osc c4) 0.1)))) + +(lsr) +(setf xxx (stretch 0.2 (ster (const 1) 0.9))) +(setf xxx (stretch 0.2 (seq (ster (const 1) 0.9) (ster (const 2) 0.1)))) +(setf xxx (seq (ster (const 1) 0.9) (ster (const 2) 0.1))) +(sx) +) +(defun sx () + (list (snd-samples (aref xxx 0) 100) (snd-samples (aref xxx 1) 100))) + +;(lsr) + +;(msr1) + +;(mst1) +;(sh) +;(mst4) +;(sh) +;(snd-print (seq (vector (ramp) (ramp)) +; (vector (at 0.5 (const 1)) (at 0.8 (const 2))) +; (vector (ramp) (ramp)) ) +; 100) + diff --git a/test/natbug.lsp b/test/natbug.lsp new file mode 100644 index 0000000..2131f71 --- /dev/null +++ b/test/natbug.lsp @@ -0,0 +1,112 @@ +(defun n2b2 () + (scale 2 (sim + (at .3 (stretch .2 (osc (hz-to-step 1616)))) + (at .5 (stretch .3 (osc (hz-to-step 1611)))) + (at .6 (stretch .2 (osc (hz-to-step 1605)))) + (at .8 (stretch .5 (osc (hz-to-step 1600))))))) + +(defun n2b2R () + (scale 2 (sim + (at .3 (stretch .2 (osc (hz-to-step 1600)))) + (at .5 (stretch .3 (osc (hz-to-step 1605)))) + (at .6 (stretch .2 (osc (hz-to-step 1611)))) + (at .8 (stretch .5 (osc (hz-to-step 1616))))))) + + +(defun hph1b () + (seq + (n2b2) + (s-rest .02) + (stretch .2 + (at .5 + (sim + (osc (hz-to-step 200)) + (osc (hz-to-step 206)) + (s-rest .1)))))) + +(defun ply () + (scale .1 + (sim + (hph1b) + (at .9 + (n2b2R))))) + +(defun Plystrm () + (scale .1 + (sim + (seqrep (i 10) (ply)) + (seq + (stretch 2 + (hph1b)) + (s-rest .01) + (stretch 2 + (n2b2)) + (stretch 3 (n2b2)))))) + +(defun drum () + (scale .2 + (stretch .5 + (sim + (pan (Plystrm)1) + (at .4 (pan(Plystrm)0)) + (at 1.5 (pan (Plystrm)1)) + (at 3.5 (pan (Plystrm)0)))))) + +(play (scale 10.5 (drum))) + +(defun n2b2 () + (scale 2 (sim + (at .3 (stretch .2 (osc (hz-to-step 1616)))) + (at .5 (stretch .3 (osc (hz-to-step 1611)))) + (at .6 (stretch .2 (osc (hz-to-step 1605)))) + (at .8 (stretch .5 (osc (hz-to-step 1600))))))) + +(defun n2b2R () + (scale 2 (sim + (at .3 (stretch .2 (osc (hz-to-step 1600)))) + (at .5 (stretch .3 (osc (hz-to-step 1605)))) + (at .6 (stretch .2 (osc (hz-to-step 1611)))) + (at .8 (stretch .5 (osc (hz-to-step 1616))))))) + + +(defun hph1b () + (seq + (n2b2) + (s-rest .02) + (stretch .2 + (at .5 + (sim + (osc (hz-to-step 200)) + (osc (hz-to-step 206)) + (s-rest .1)))))) + +(defun ply () + (scale .1 + (sim + (hph1b) + (at .9 + (n2b2R))))) + +(defun Plystrm () + (scale .1 + (sim + (seqrep (i 10) (ply)) + (seq + (stretch 2 + (hph1b)) + (s-rest .01) + (stretch 2 + (n2b2)) + (stretch 3 (n2b2)))))) + +(defun drum () + (scale .2 + (stretch .5 + (sim + (pan (Plystrm)1) + (at .4 (pan(Plystrm)0)) + (at 1.5 (pan (Plystrm)1)) + (at 3.5 (pan (Plystrm)0)))))) + +(play (scale 10.5 (drum))) + diff --git a/test/nonewline.lsp b/test/nonewline.lsp new file mode 100644 index 0000000..cc358fd --- /dev/null +++ b/test/nonewline.lsp @@ -0,0 +1,3 @@ +;no newline at end of file test + +(print "hello world") diff --git a/test/overwrite.lsp b/test/overwrite.lsp new file mode 100644 index 0000000..ec29716 --- /dev/null +++ b/test/overwrite.lsp @@ -0,0 +1,118 @@ +;; overwrite test + +;; 1) add sine to existing sine +;; +(defun ow-test-1 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite1.wav" :format snd-head-wave + :mode snd-mode-pcm :bits 16) + (print "called s-save with overwrite1.wav") + (s-add-to (scale 0.5 (osc bf4)) ny:all "overwrite1.wav") + (print "called s-add-to with overwrite1.wav") + (play-file "overwrite1.wav") + ) + +;; 2) add sine to existing sine, extend beyond previous duration +;; +(defun ow-test-2 () + (print "calling s-save with overwrite2.wav") + (s-save (scale 0.5 (osc c4)) ny:all "overwrite2.wav" :format snd-head-wave + :mode snd-mode-pcm :bits 16) + (print "called s-save with overwrite2.wav") + (s-add-to (scale 0.5 (osc bf4 2)) ny:all "overwrite2.wav") + (play-file "overwrite2.wav") + ) + + +;; 3) add sine to existing sine, end within existing sound +(defun ow-test-3 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite3.wav" :format snd-head-wave + :mode snd-mode-pcm :bits 16) + (s-add-to (mult (pwl 0 1 0.5 1 0.51) 0.5 + (osc bf4)) ny:all "overwrite3.wav" 0.25) + (play-file "overwrite3.wav") + ) + + +;; 4) add sine beyond previous duration (extend by adding zeros first) +(defun ow-test-4 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite4.wav" :format snd-head-wave + :mode snd-mode-pcm :bits 16) + (s-add-to (s-rest 3) ny:all "overwrite4.wav") + (s-add-to (mult (pwl 0 0.5 0.5 0.5 0.51) + (osc bf4)) ny:all "overwrite4.wav" 2) + (play-file "overwrite4.wav") + ) + + +;; 5) (1) with offset, and extend beyond previous duration +(defun ow-test-5 () + (s-save (mult (pwl 0 0.5 0.99 0.5 1.0) (osc c4)) + ny:all "overwrite5.wav" :format snd-head-wave + :mode snd-mode-pcm :bits 16) + (s-add-to (mult (pwl 0.01 0.5 0.99 0.5 1) (osc bf4)) + ny:all "overwrite5.wav" 0.5) + (play-file "overwrite5.wav") + ) + +;; 6) (1) with floats +(defun ow-test-6 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite6.wav" :format snd-head-wave + :mode snd-mode-float) + (s-add-to (scale 0.5 (osc bf4)) ny:all "overwrite6.wav") + (play-file "overwrite6.wav") + ) + +;; 7) (2) with floats +;; add sine to existing sine, extend beyond previous duration +;; +(defun ow-test-7 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite7.wav" :format snd-head-wave + :mode snd-mode-float) + (s-add-to (scale 0.5 (osc bf4 2)) ny:all "overwrite7.wav") + (play-file "overwrite7.wav") + ) + +;; 8) (3) with raw floats +;; add sine to existing sine, end within existing sound +(defun ow-test-8() + (s-save (scale 0.5 (osc c4)) ny:all "overwrite8.wav" :format snd-head-wave + :mode snd-mode-float) + (s-add-to (mult (pwl 0 1 0.5 1 0.51) 0.5 + (osc bf4)) ny:all "overwrite8.wav" 0.25) + (play-file "overwrite8.wav") + ) + +;; 9) (4) with floats +;; add sine beyond previous duration (extend by adding zeros first) +(defun ow-test-9 () + (s-save (scale 0.5 (osc c4)) ny:all "overwrite9.wav" :format snd-head-wave + :mode snd-mode-float) + (s-add-to (s-rest 3) ny:all "overwrite9.wav") + (s-add-to (mult (pwl 0 0.5 0.5 0.5 0.51) + (osc bf4)) ny:all "overwrite9.wav" 2) + (play-file "overwrite9.wav") + ) + + +;; 10) (5) wtih floats +;; overwrite with offset, and extend beyond previous duration +(defun ow-test-10 () + (s-save (mult (pwl 0 0.5 0.99 0.5 1.0) (osc c4)) + ny:all "overwrite10.wav" :format snd-head-wave + :mode snd-mode-float) + (s-add-to (mult (pwl 0.01 0.5 0.99 0.5 1) (osc bf4)) + ny:all "overwrite10.wav" 0.5) + (play-file "overwrite10.wav") + ) + +;; 11) overwrite to a raw file of floats +(defun ow-test-11 () + (s-save (scale 0.5 (osc c4)) + ny:all "overwrite11.raw" :format snd-head-raw + :mode snd-mode-float :bits 32) + (print (snd-overwrite '(scale 0.5 (osc bf4 0.4)) + ny:all "/tmp/overwrite11.raw" 0.3 + SND-HEAD-RAW SND-MODE-FLOAT 32 0)) + (display "ow-test-11" *rslt*) + (play (s-read "overwrite11.raw" :format snd-head-raw + :mode snd-mode-float :bits 32))) diff --git a/test/product.lsp b/test/product.lsp new file mode 100644 index 0000000..4d687fb --- /dev/null +++ b/test/product.lsp @@ -0,0 +1,30 @@ +; this test should display a plot of x^2 +; it gives an example of constructing a DSP primitive +; (in this case, product) using Lisp rather than C +; for the computation + +(setf product-class (send class :new '(s1 s2))) + +(send product-class :answer :next '() + '((let ((f1 (snd-fetch s1)) + (f2 (snd-fetch s2))) + (cond ((and f1 f2) + (* f1 f2)) + (t nil))))) + +(send product-class :answer :isnew '(p1 p2) + '((setf s1 (snd-copy p1)) + (setf s2 (snd-copy p2)))) + +(defun snd-product (s1 s2) + (let (obj) + (setf obj (send product-class :new s1 s2)) + (snd-fromobject (snd-t0 s1) (snd-srate s1) obj))) + +(set-control-srate 100) + +(s-plot (snd-product (ramp) (ramp))) + + + + diff --git a/test/rbd.lsp b/test/rbd.lsp new file mode 100644 index 0000000..413749b --- /dev/null +++ b/test/rbd.lsp @@ -0,0 +1,23 @@ +;(setf *default-plot-file* "/afs/cs/usr/rbd/tmp/points.dat") +;(setf *default-sf-dir* "/afs/cs.cmu.edu/user/rbd/tmp/") +;(setf *default-sound-file* "test") + +(setf *default-plot-file* "/space/rbd/tmp/points.dat") +(setf *default-sf-dir* "/space/rbd/tmp/") +(setf *default-sound-file* "rbd-temp.snd") + +(set-sound-srate 22050) +(set-control-srate 2205) + +(defun ask (string default) + (let (inp) + (format t "~A: [~A]" string default) + (setf inp (read-line)) + (cond ((equal inp "") default) + (t (intern inp))))) + +(if (ask "turn off audio?" t) + (defun r () t) ; turn off audio output + (print "!!!AUDIO OUTPUT TURNED OFF!!!")) + + diff --git a/test/readme b/test/readme new file mode 100644 index 0000000..a8f08ef --- /dev/null +++ b/test/readme @@ -0,0 +1,3 @@ +running ../ny from test causes a 0 block length error. + +fix: I'm not sure how this is supposed to work. I'm recompiling with small block size. Make a sample that terminates and/or logical stops on a block boundary (1 input) and see how this is handled. It looks like prod has a special "break" command to get out of the inner loop and terminate the signal when this happens. diff --git a/test/s-add-to.lsp b/test/s-add-to.lsp new file mode 100644 index 0000000..471cf2e --- /dev/null +++ b/test/s-add-to.lsp @@ -0,0 +1,19 @@ +;; s-add-to.lsp -- a test program to explore a bug report + +(print "loading s-add-to.lsp") + +(load "/Users/rbd/nyquist/sys/unix/osx/system.lsp") + +; make a file to add to +(s-save (mult 0.1 (vector (osc c4) (osc g4))) ny:all "deleteme.wav") + +; play it to make sure +(play-file "deleteme.wav") + + +; add to it +(s-add-to (mult 0.1 (vector (osc e4) (osc b4))) ny:all "deleteme.wav") + +; play the result +(play-file "deleteme.wav") + diff --git a/test/save-float.lsp b/test/save-float.lsp new file mode 100644 index 0000000..aef8556 --- /dev/null +++ b/test/save-float.lsp @@ -0,0 +1,19 @@ +;; save-float.lsp -- a test program to explore a bug report + +(print "loading save-float.lsp") + +(load "/Users/rbd/nyquist/sys/unix/osx/system.lsp") + +(autonorm-off) + +; write file +(s-save (mult (osc c4) 10) ny:all "/Users/rbd/tmp/deleteme.rawfloat" + :mode snd-mode-float :bits 32 :format snd-head-raw :play nil) + +; read file +(play (mult 0.1 (s-read "/Users/rbd/tmp/deleteme.rawfloat" + :mode snd-mode-float :bits 32 :format snd-head-raw :nchans 1))) + + + + diff --git a/test/seqmiditest.lsp b/test/seqmiditest.lsp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/seqmiditest.lsp diff --git a/test/shape.lsp b/test/shape.lsp new file mode 100644 index 0000000..1a4cc8a --- /dev/null +++ b/test/shape.lsp @@ -0,0 +1,29 @@ +;; there was a reported problem with shape reading 1 beyond the +;; end of the table -- this is a test to check it out + +;; 20-Jun-97 + +; make sample rates low enough to look at by hand +(set-sound-srate 10) +(set-control-srate 10) + +; make a table +(setf shape-signal (scale 2 (ramp 2))) +(print (snd-samples shape-signal 25)) + +; try it out +(setf input (scale 1.2 (stretch 3 (lfo .1)))) +;(s-plot input) +(setf result (shape input shape-signal 1.0)) +(print (snd-samples result 50)) +;(s-plot result) + +; conclusion : +; The shape must be defined all the way to the origin + 1.0, +; in this case, the origin is 1, so the shape must go to 2.0. +; Initially, I used (pwl 2 2 2 0) for the shape and had +; problems because this function is zero at 2.0! I assume +; this is the source of the reported problem. By using ramp, +; which actually extends to it's duration + 1 sample, we +; get the right result. + diff --git a/test/snd-fetch-array.lsp b/test/snd-fetch-array.lsp new file mode 100644 index 0000000..fa455fe --- /dev/null +++ b/test/snd-fetch-array.lsp @@ -0,0 +1,19 @@ +;; snd-fetch-array.lsp -- a test program to explore a new feature + +(print "loading snd-fetch-array.lsp") + +(load "/Users/rbd/nyquist/sys/unix/osx/system.lsp") + +(autonorm-off) + +;; make short sound +(setf s (osc c4 0.001)) ; about 44 samples + +(dotimes (i 100) ; limited iterations in case of problems + (setf samps (snd-fetch-array s 10 10)) + (display "after snd-fetch-array" i samps *rslt*) + (if (null samps) (return 'done))) + + + + diff --git a/test/sr.lsp b/test/sr.lsp new file mode 100644 index 0000000..692eb46 --- /dev/null +++ b/test/sr.lsp @@ -0,0 +1,17 @@ +;; scott raymond's midi code + +(set-sound-srate 22050.0) + +(setf my-seq (seq-create)) +(setf midifile (open "/afs/andrew.cmu.edu/usr15/sr4r/public/testmidi.mid")) + +(seq-read-smf my-seq midifile) + +(close midifile) + +(defun my-note (p) (scale 0.2(osc p))) + +(play (seq-midi my-seq + (note (chan pitch velocity) (my-note pitch)))) + +(defun (srl) () (load "test/sr")) diff --git a/test/stktest.lsp b/test/stktest.lsp new file mode 100644 index 0000000..0858f35 --- /dev/null +++ b/test/stktest.lsp @@ -0,0 +1,101 @@ +;; stktest.lsp -- test the STK instruments, currently clarinet and saxophony + +(autonorm-off) + +;; simple clarinet sound +(defun clarinet-example-1 () + (clarinet bf3 (clarinet-breath-env 1 0.2 0.1))) + +;; clarinet sound with frequency sweep (glissando) +(defun clarinet-example-2 () + (clarinet-freq bf3 (clarinet-breath-env 3 0.2 0.1) (pwl 1.5 80 3 80 3))) + +;; clarinet sound with change in breath pressure +(defun clarinet-example-3 () + (clarinet bf3 (prod (pwl 0 1 1.5 0.9 3 1 3) (clarinet-breath-env 3 0.2 0.1)))) + +;; clarinet sound using initial frequency sweep and built-in vibrato effect +(defun clarinet-example-4 () + (clarinet-all bf3 (clarinet-breath-env 3 0.5 0.05) (pwl 0.3 80 3 80 3) 5.7 0.5 0 0)) + +;; clarinet sound with increasing then decreasing reed stiffness +(defun clarinet-example-5 () + (clarinet-all bf3 (clarinet-breath-env 3 0.5 0.05) 0 0 0 (pwl 1.5 0.75 3) 0)) + +;; clarinet sound with increasing noise, with vibrato +(defun clarinet-example-6 () + (clarinet-all bf3 (clarinet-breath-env 3 0.5 0.05) 0 5.7 0.5 0 (pwl 3 1 3))) + +(print "clarinet-example-1") +(play (clarinet-example-1)) +(print "clarinet-example-2") +(play (clarinet-example-2)) +(print "clarinet-example-3") +(play (clarinet-example-3)) +(print "clarinet-example-4") +(play (clarinet-example-4)) +(print "clarinet-example-5") +(play (clarinet-example-5)) +(print "clarinet-example-6") +(play (clarinet-example-6)) + + +(defun sax-example-1 () + (scale 0.5 + (timed-seq '( + (0.0 1 (sax g3 (sax-breath-env 2 0.2 0.2 0.6))) + (2.0 1 (sax-freq c4 (sax-breath-env 4 0.6 0.6) + (scale 100 (mult (pwl 0 0.95 4 1.3 4))))) + ))) +) + +(defun sax-example-2 () + (let (fade stacenv genenv) + (defun fade (dur env) (prod (pwl 0 0 0.005 1 (- dur 0.005) 1 dur 0 dur) env)) + (defun stacenv (dur amp) (scale (* 0.8 amp) (fade (* 0.9 dur) (sax-breath-env (* 0.9 dur) 1.0 0.9)))) + (defun genenv (dur amp) (scale amp (sax-breath-env dur 1.0 1.0 0.75))) + + (scale 0.5 + (timed-seq + '( + (0.0 1 (sax-freq + bf3 + (mult (envbreaks 1 (list 0.125 0.25 0.375 0.5 0.625 0.75 0.875)) + (genenv 1 1)) + (freqenv 1 bf3 (list 0 bf3 0.125 af4 0.25 g4 0.375 d4 + 0.5 f4 0.625 ef4 0.75 d4 0.875 ef4)) + )) + + (1.0 1 (sax-freq + e4 + (mult (envbreaks 1 (list 0.125 0.25 0.375 0.5 0.625 0.75 0.875)) + (genenv 1 1)) + (freqenv 1 e4 (list 0 e4 0.125 c4 0.25 a3 0.375 e3 + 0.5 fs3 0.625 e3 0.75 fs3 0.875 e4)) + )) + + (2.0 1 (sax-freq + d4 + (mult (envbreaks 1 (list 0.125 0.25 0.375 0.5 0.625 0.75 0.875)) + (genenv 1 1)) + (freqenv 1 d4 (list 0 d4 0.125 c4 0.25 b3 0.375 a3 + 0.5 g3 0.625 a3 0.75 b3 0.875 d4)) + )) + + (3.0 1 (sax-freq + ef4 + (mult (envbreaks 1 (list 0.125 0.25 0.375 0.5 0.625 0.75 0.875)) + (genenv 1 1)) + (freqenv 1 ef4 (list 0 ef4 0.125 cs4 0.25 b3 0.375 bf3 + 0.625 gf3 0.75 af3 0.875 bf4)) + )) + ) + )) + ) +) + +(print "sax-example-1") +(play (sax-example-1)) +(print "sax-example-2") +(play (sax-example-2)) + diff --git a/test/str.lsp b/test/str.lsp new file mode 100644 index 0000000..defec12 --- /dev/null +++ b/test/str.lsp @@ -0,0 +1,25 @@ +(defun test () + (stretch 3 + (sim (at 0 (mynote)) + (at 1 (mynote)) + (at 2 (mynote))))) + +(defun mynote () + (display "mynote" (local-to-global 0)) + (stretch-abs 1 + (snd-compose (s-read "tri.snd") + (ramp)))) + +(set-sound-srate 100) +(set-control-srate 100) + +(setf *plotscript-file* "../sys/unix/rs6k/plotscript") + + +(defun kuu-up (dur rate) + (stretch-abs 1 + (snd-compose (kuu dur) + (scale (* 0.5 rate) + (sum + (pwe 7 7 7) + (control-srate-abs 22050 (pwl 7 7 7))))))) diff --git a/test/temp.gio b/test/temp.gio new file mode 100644 index 0000000..6b762a5 --- /dev/null +++ b/test/temp.gio @@ -0,0 +1,19 @@ +!msec +V3 c4 U600 T0 +d4 U600 T600 +e4 U600 T1200 +Z3 T1800 +f4 U300 T1800 +V4 g4 U300 T2100 +~10(15) T2400 +~10(20) T2700 +~10(30) T3000 +Y100 T3300 +Y200 T3600 +Y0 T3900 +Y128 T4200 +Y16 T4500 +O0 T4800 +O20 T4950 +O50 T5100 +c0 U2400 T5250 diff --git a/test/temp2.gio b/test/temp2.gio new file mode 100644 index 0000000..8ab48be --- /dev/null +++ b/test/temp2.gio @@ -0,0 +1,19 @@ +!msec +V3 c4 U600 N600 +d4 U600 N600 +e4 U600 N600 +Z3 N0 +f4 U300 N300 +V4 g4 U300 N300 +~10(15) N300 +~10(20) N300 +~10(30) N300 +Y100 N300 +Y200 N300 +Y0 N300 +Y128 N300 +Y16 N300 +O0 N150 +O20 N150 +O50 N150 +c0 U2400 diff --git a/test/temp3.gio b/test/temp3.gio new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/temp3.gio diff --git a/test/test.gio b/test/test.gio new file mode 100644 index 0000000..de98044 --- /dev/null +++ b/test/test.gio @@ -0,0 +1,3 @@ +a +b +c diff --git a/test/tp.lsp b/test/tp.lsp new file mode 100644 index 0000000..2c168da --- /dev/null +++ b/test/tp.lsp @@ -0,0 +1,71 @@ +;;; Single Carriar Trumpet Algorithm based on a design by Dexter Morrill +;;; Computer Music Journal, February 1997, pgs 46-52 +;;; +;;; Naming changes: (Morill's name = my name) +;;; u.g.1 = envelope p2 -> ignored p13 = *** +;;; u.g.2 = cf_deviation p3 -> ignored p14 = *** +;;; u.g.3 = vibrato p4 = freq (pitch) p15 = modIndex1 +;;; u.g.4 = fm_env p5 = peak_amp (scaled) p16 = modIndex2 +;;; u.g.5 = random p6 -> ignored p17 = *** +;;; u.g.6 = fmod p7 = amp_rise p18 = *** +;;; u.g.7 = main p8 = amp_decay p19 = fm_rise +;;; p9 = *** p20 = fm_decay +;;; p10 = cfd_rise p21 = *** +;;; p11 = cfd_decay p22 = *** +;;; p12 -> ignored p23 -> ignored + +;;; NOTES: +;;; P9 has been completely ignored!!! +;;; Look at p13 and p14 + +(defun trumpet (pitch &key (peak_amp (/ 500.0 2048.0)) + (amp_rise .02) (amp_decay .15) + (cfd_rise .06) (cfd_decay .06) + (modIndex1 3.523) (modIndex2 0.0) + (vib_dev .33) + (fm_rise .02) (fm_decay .01)) + (let* ((freq (float (step-to-hz pitch))) + (p4 freq) + (p13 freq) + (p14 1.0) + (p18 (hz-to-step 7)) + (p21 0.5) + (p22 (/ freq 4)) + + ;; main envelope + (envelope (mult peak_amp (env amp_rise 0 amp_decay 1 1 .9))) + ; 1,1,.9 need to be parameters? + + ;; center frequency deviation + (my_dur (local-to-global 1)) + (cf_deviation (stretch-abs 1 (pwl 0 -1 cfd_rise .1 + (+ cfd_rise cfd_decay) + 0 my_dur 0))) + + (m1_f (sum p4 cf_deviation)) + + ;; vibrato generator + (vibrato (mult (mult m1_f (* vib_dev .01)) (osc p18))) + + (n1 (sum (* p13 p14) cf_deviation)) + + ;; envelope for fmod +;;; WARNING: This generator needs to be scaled by 1/2048 ??? + (fm_env (mult (sum (mult modIndex1 n1) (mult modIndex2 n1)) + (env fm_rise 0 fm_decay 1 1 .9))) + + ;; random frequency modulation + (random (mult (mult (sum m1_f vibrato) (* p21 .01)) + (sound-srate-abs p22 (noise)))) + + ;; frequency modulation + (fmod_pitch (hz-to-step (* p13 p14))) + (fmod_mod (sum (sum cf_deviation vibrato) random)) + (fmod_amp (sum (sum (sum fm_env (mult n1 modIndex2)) vibrato) random)) + (fmod (mult fmod_amp (fmosc fmod_pitch fmod_mod))) + + ;; main generator + (main_mod (sum(sum (sum cf_deviation vibrato) random) fmod)) + (main (mult envelope (fmosc pitch main_mod)))) + + main)) diff --git a/test/trigger.lsp b/test/trigger.lsp new file mode 100644 index 0000000..33d7105 --- /dev/null +++ b/test/trigger.lsp @@ -0,0 +1,13 @@ +'(print + (control-srate-abs 20 + (snd-samples + (snd-trigger (lfo 2) '(lambda (t0) (at-abs t0 (const 0.5 0.2)))) + 100))) + +(print + (control-srate-abs 20 + (snd-samples + (trigger (lfo 2) (const 0.5 0.2)) + 100))) + + diff --git a/test/variable-resample.lsp b/test/variable-resample.lsp new file mode 100644 index 0000000..3dccf4c --- /dev/null +++ b/test/variable-resample.lsp @@ -0,0 +1,9 @@ +;; variable resample test + +(set-sound-srate 200.0) + +(defun test () + (sound-warp (pwl 10 10 10) (stretch 10 (hzosc 5)) 10.0)) + +(play (test)) + diff --git a/test/warp.lsp b/test/warp.lsp new file mode 100644 index 0000000..b76d06c --- /dev/null +++ b/test/warp.lsp @@ -0,0 +1,12 @@ +(defun line () (seqrep (i 20) (pluck1 (+ 24 (random 12))))) + +(defun pluck1 (p) + (display "pluck1" (local-to-global 0) (local-to-global 1)) + (pluck p)) + +(play (warp (mult (pwl 21 2.5) (pwl 21 2.5)) (line))) + +(s-plot (mult (pwl 11 2.5) (pwl 11 2.5))) + + + |