/[cl-wav-synth]/cl-wav-synth/test.lisp
ViewVC logotype

Contents of /cl-wav-synth/test.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Sat Dec 13 20:53:28 2008 UTC (5 years, 4 months ago) by pbrochard
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +1 -0 lines
First libterminatorX commit
1 ;;; CL-Wav-Synth - Manipulate WAV files
2 ;;;
3 ;;; Copyright (C) 2006 Philippe Brochard (hocwp@free.fr)
4 ;;;
5 ;;; #Date#: Mon May 1 22:19:44 2006
6 ;;;
7 ;;; **********************************************
8 ;;; The authors grant you the rights to distribute
9 ;;; and use this software as governed by the terms
10 ;;; of the Lisp Lesser GNU Public License
11 ;;; (http://opensource.franz.com/preamble.html),
12 ;;; known as the LLGPL.
13 ;;; **********************************************
14
15
16 (in-package :cl-wav-synth)
17
18 ;;; This is in cl-wav-synth for compilation priority
19 ;;;(defparameter *wav-test-hash* (make-hash-table))
20
21 (defmacro define-wav-test (name args &body body)
22 `(progn
23 (setf (gethash ',name *wav-test-hash*) ',body)
24 (defun ,name ,args
25 ,@body)))
26
27
28
29
30 ;;; Tests functions
31 (define-wav-function list-all-test (&optional (stream *standard-output*))
32 "List all available tests"
33 (maphash #'(lambda (name v)
34 (declare (ignore v))
35 (when (fboundp name)
36 (format stream "~A: ~A~%" name (documentation name 'function))))
37 *wav-test-hash*)
38 (format stream "..................................................
39 Please, choose a test with the command
40 > (testN) where N is the test you want to start~%"))
41
42
43 (define-wav-function print-test (num &optional (stream *standard-output*))
44 "View the code for test 'num'"
45 (let ((name (intern (format nil "TEST~A" num))))
46 (when (fboundp name)
47 (pprint `(defun ,name ()
48 ,@(gethash name *wav-test-hash*))
49 stream))))
50
51
52
53
54
55 (defun set-fun (data new)
56 (declare (ignore data))
57 new)
58
59
60 (define-wav-test test1 ()
61 "Test read-sample, print-header and write-sample on a test WAV file"
62 (let ((sample (read-sample "test.wav")))
63 (print-header sample "test.wav")
64 (write-sample "toto.wav" sample)
65 (aud "test.wav toto.wav")))
66
67
68 (define-wav-test test2 ()
69 "Test read-sample, print-header and write-sample on another test WAV file"
70 (let ((sample (read-sample "arthur.wav")))
71 (print-header sample)
72 (write-sample "toto.wav" sample)
73 (aud "toto.wav")))
74
75
76
77 (define-wav-test test3 ()
78 "Test sample-make-noise on a one channel sample"
79 (let ((sample (make-instance 'sample :n-channels 1
80 :n-samples-per-sec 22050
81 :n-bits-per-sample 16
82 :time 10)))
83 (with-slots (max-ampl) sample
84 (sample-make-noise sample #'set-fun 0 0 10 440
85 (* max-ampl -0.8) (* max-ampl 0.8))
86 (play sample))))
87
88 (define-wav-test test4 ()
89 "Test sample-make-noise and sample-make-sin on a two channels sample"
90 (let ((sample (make-instance 'sample :n-channels 2
91 :n-samples-per-sec 44100
92 :n-bits-per-sample 32
93 :time 10)))
94 (with-slots (max-ampl) sample
95 (time (progn
96 (print-header sample)
97 (sample-make-noise sample #'set-fun 0 0 10 50
98 (* max-ampl -0.4) (* max-ampl 0.4))
99 (sample-make-noise sample #'+ 0 0 10 1000
100 (* max-ampl -0.9) (* max-ampl 0.9))
101 (dotimes (i 40)
102 (sample-make-sin sample #'set-fun 1 (* i 0.25) (+ (* i 0.25) 0.1) 440
103 (* max-ampl 0.8) #'sin)
104 (sample-make-sin sample #'+ 1 (+ (* i 0.25) 0.15) (+ (* i 0.25) 0.2) 1500
105 (* max-ampl 0.6) #'sin))))
106 (play sample))))
107
108
109 (define-wav-test test5 ()
110 "Test sample-make-square and sample-make-sin"
111 (let ((sample (make-instance 'sample :n-channels 1
112 :n-samples-per-sec 22050
113 :n-bits-per-sample 16
114 :time 10)))
115 (with-slots (max-ampl) sample
116 (sample-make-square sample #'set-fun 0 0 10 50
117 (* max-ampl -0.8) (* max-ampl 0.8))
118 (sample-make-sin sample #'+ 0 2 8 1000 (* max-ampl 0.2) #'sin)
119 (aud sample))))
120
121
122
123 (define-wav-test test6 ()
124 "Test sample-make-line*"
125 (let ((sample (make-instance 'sample :n-channels 1
126 :n-samples-per-sec 22050
127 :n-bits-per-sample 16
128 :time 10)))
129 (with-slots (max-ampl) sample
130 (sample-make-line* sample #'set-fun 0 0 10 100
131 (mapcar #'(lambda (x)
132 (list (first x)
133 (* max-ampl (second x))))
134 '((0 0.1) (0.2 1) (0.3 1) (0.4 0.8)
135 (0.5 -0.1) (0.6 -1) (0.7 -1) (1 -0.3))))
136 (snd sample))))
137
138
139 (define-wav-test test7 ()
140 "Test sample-make-line and sample-make-line*"
141 (let ((sample (make-instance 'sample :n-channels 1
142 :n-samples-per-sec 22050
143 :n-bits-per-sample 16
144 :time 10)))
145 (with-slots (max-ampl) sample
146 (sample-make-line sample #'set-fun 0 0 10 440
147 (* max-ampl -0.8) (* max-ampl 0.8))
148 (sample-make-line* sample #'* 0 2 8 1 '((0 0.1) (0.2 0.9) (0.3 1) (0.4 0.8)
149 (0.5 -0.1) (0.6 -0.8) (0.7 -0.9) (1 -0.1)))
150 (aud sample))))
151
152
153 (define-wav-test test8 ()
154 "Test four channels sample"
155 (let ((sample (make-instance 'sample :n-channels 4
156 :n-samples-per-sec 22050
157 :n-bits-per-sample 16
158 :time 10)))
159 (with-slots (max-ampl) sample
160 (sample-make-sin sample #'set-fun 0 0 10 440 max-ampl #'sin)
161 (sample-make-sin sample #'set-fun 1 1 10 880 max-ampl #'sin)
162 (sample-make-sin sample #'set-fun 2 2 10 770 max-ampl #'sin)
163 (sample-make-sin sample #'set-fun 3 3 10 600 max-ampl #'sin)
164 (aud sample))))
165
166 (define-wav-test test9 ()
167 "Test copy-sample -> selection of a small piece of sample"
168 (let* ((filename "arthur.wav")
169 (sample (read-sample filename))
170 (new-sample (copy-sample sample :start 10 :end 11)))
171 (print-header sample)
172 (print-header new-sample)
173 (write-sample "toto.wav" new-sample)
174 (play filename "toto.wav")))
175
176
177 (define-wav-test test1000 (n-chan &key (s-p-s 22050) (b-p-s 16) (time 3) name)
178 "Helper function to create sample test"
179 (let ((sample (make-instance 'sample :n-channels n-chan
180 :n-samples-per-sec s-p-s
181 :n-bits-per-sample b-p-s
182 :time time
183 :name name)))
184 (print-header sample)
185 (with-slots (max-ampl) sample
186 (when (> n-chan 0)
187 (sample-make-sin sample #'set-fun 0 1 2 1 max-ampl #'sin))
188 (when (> n-chan 1)
189 (sample-make-sin sample #'set-fun 1 0.5 1.5 2 (* max-ampl 0.5) #'cos))
190 (when (> n-chan 2)
191 (sample-make-sin sample #'set-fun 2 1.5 2.5 1 max-ampl #'sin))
192 (when (> n-chan 3)
193 (sample-make-sin sample #'set-fun 3 1.3 1.7 1 max-ampl #'cos)))
194 sample))
195
196
197
198 (define-wav-test test1005 (n-chan &key (s-p-s 22050) (b-p-s 16) (time 3))
199 "Helper function to test copy-sample"
200 (let ((sample (test1000 n-chan :s-p-s s-p-s :b-p-s b-p-s :time time
201 :name "original.wav")))
202 (play sample
203 (copy-sample sample :start 1 :end 2 :name "new1.wav")
204 (copy-sample sample :end 2 :name "new2.wav")
205 (copy-sample sample :start 1 :name "new3.wav"))))
206
207
208
209 (define-wav-test test10 ()
210 "Test copy-sample on a one channel sample"
211 (test1005 1))
212
213 (define-wav-test test11 ()
214 "Test copy-sample on a two channels / 32 bits sample"
215 (test1005 2 :s-p-s 44100 :b-p-s 32))
216
217 (define-wav-test test12 ()
218 "Test copy-sample on a three channels sample"
219 (test1005 3))
220
221 (define-wav-test test13 ()
222 "Test copy-sample on a four channels sample"
223 (test1005 4))
224
225 (define-wav-test test14 ()
226 "Test copy-sample on a five channels sample"
227 (test1005 5))
228
229
230 (define-wav-test test1010 (n-chan &key (s-p-s 22050) (b-p-s 16) (time 3))
231 "Helper function to test read-sample"
232 (let ((sample (test1000 n-chan :s-p-s s-p-s :b-p-s b-p-s :time time)))
233 (write-sample "original.wav" sample)
234 (play "original.wav"
235 (read-sample "original.wav" :start 1 :end 2 :name "new1.wav")
236 (read-sample "original.wav" :end 2 :name "new2.wav")
237 (read-sample "original.wav" :start 1 :name "new3.wav"))))
238
239 (define-wav-test test15 ()
240 "Test read-sample with start / end time on a one channel sample"
241 (test1010 1))
242
243 (define-wav-test test16 ()
244 "Test read-sample with start / end time on a two channel sample"
245 (test1010 2))
246
247 (define-wav-test test17 ()
248 "Test read-sample with start / end time on a three channel sample"
249 (test1010 3))
250
251 (define-wav-test test18 ()
252 "Test read-sample with start / end time on a four channel sample"
253 (test1010 4))
254
255 (define-wav-test test19 ()
256 "Test read-sample with start / end time on a five channel sample"
257 (test1010 5))
258
259
260 (define-wav-test test1015 (n-chan &key (s-p-s 22050) (b-p-s 16) (time 3))
261 "Helper function to test write sample"
262 (let ((sample (test1000 n-chan :s-p-s s-p-s :b-p-s b-p-s :time time))
263 (new-sample (copy-sample (test1000 n-chan :s-p-s s-p-s :b-p-s b-p-s :time time)
264 :start 1 :end 2)))
265 (when (probe-file "test.wav")
266 (delete-file "test.wav"))
267 (write-sample "old.wav" sample)
268 (write-sample "new.wav" new-sample)
269 (write-sample "test.wav" sample)
270 (play "test.wav" "old.wav" "new.wav")
271 (write-sample "test.wav" new-sample :start 0)
272 (play "test.wav" "old.wav" "new.wav")
273 (write-sample "test.wav" new-sample :start 0.5)
274 (play "test.wav" "old.wav" "new.wav")
275 (write-sample "test.wav" new-sample :start 2.5)
276 (play "test.wav" "old.wav" "new.wav")
277 (write-sample "test.wav" new-sample :start 4)
278 (play "test.wav" "old.wav" "new.wav")
279 (delete-file "old.wav")
280 (delete-file "new.wav")
281 (delete-file "test.wav")))
282
283 (define-wav-test test20 ()
284 "Test write-sample with start / end time on a one channel sample"
285 (test1015 1))
286
287 (define-wav-test test21 ()
288 "Test write-sample with start / end time on a two channel sample"
289 (test1015 2))
290
291 (define-wav-test test22 ()
292 "Test write-sample with start / end time on a three channel sample"
293 (test1015 3))
294
295 (define-wav-test test23 ()
296 "Test write-sample with start / end time on a four channel sample"
297 (test1015 4))
298
299 (define-wav-test test24 ()
300 "Test write-sample with start / end time on a five channel sample"
301 (test1015 5))
302
303 (define-wav-test test25 ()
304 "Test direct access to data sample"
305 (let ((sample (make-instance 'sample :n-channels 1
306 :n-samples-per-sec 22050
307 :n-bits-per-sample 16
308 :time 10)))
309 (with-slots (data) sample
310 (loop for i from 0 to 3000 do
311 (setf (aref data i) 20000))
312 (loop for i from 10000 to 30000 do
313 (setf (aref data i) 10000)))
314 (write-sample "toto.wav" sample)
315 (write-sample "toto.wav" sample :start 3)
316 (write-sample "toto.wav" sample :start 7)
317 (aud "toto.wav")
318 (delete-file "toto.wav")))
319
320 (define-wav-test test26 ()
321 "Test add channel on a sample"
322 (let ((bomb (read-sample "bomb.wav"))
323 new)
324 (play bomb)
325 (setf new (add-channel bomb 1 bomb))
326 (play new)
327 (setf new (add-channel new 2 bomb :start 1))
328 (play new)
329 (setf new (add-channel new 0 bomb :start 2))
330 (play new)
331 (setf new (add-channel new 1 bomb :start 1.5))
332 (play new)))
333
334 (define-wav-test test27 ()
335 "Test extract-channel from a sample"
336 (let ((arthur (read-sample "arthur.wav")))
337 (play arthur (extract-channel arthur 0))))
338
339 (define-wav-test test28 ()
340 "Test add-channel (with start time) and extract-channel"
341 (let ((bomb (read-sample "bomb.wav")))
342 (setf bomb (add-channel bomb 1 bomb :start 1))
343 (play bomb
344 (extract-channel bomb 0)
345 (extract-channel bomb 1))))
346
347
348 (define-wav-test test29 ()
349 "Test mix-sample"
350 (let ((synth (read-sample "synth.wav"))
351 (art (read-sample "arthur.wav")))
352 (setf (sample-n-samples-per-sec synth) 32000)
353 (setf synth (add-channel synth 1 synth :start 1))
354 (play (mix-sample art synth #'(lambda (index s1 s2 m1 m2)
355 (declare (ignorable index))
356 (+ (* s1 m1) (* s2 m2)))
357 :args '(1 0.8) :start 5))))
358
359 (define-wav-test test30 ()
360 "An other mix-sample test"
361 (labels ((mix (ind s1 s2 m1 m2)
362 (declare (ignorable ind))
363 (+ (* s1 m1) (* s2 m2))))
364 (let ((synth (read-sample "synth.wav"))
365 (art (read-sample "arthur.wav")))
366 (setf (sample-n-samples-per-sec synth) 32000)
367 (setf synth (add-channel synth 1 synth :start 1))
368 (write-sample "test.wav" art)
369 (mix-sample "test.wav" synth #'mix :args '(1 0.4) :start 2)
370 (mix-sample "test.wav" synth #'mix :args '(0.5 0.8) :start 8)
371 (loop for time from 15 by 6 to 30 do
372 (mix-sample "test.wav" synth #'mix :args '(1 0.5)
373 :start (+ time (random 0.5))))
374 (play "test.wav")
375 (delete-file "test.wav"))))
376
377
378
379
380 (define-wav-test test31 ()
381 "Test apply-on-sample"
382 (let ((art (read-sample "arthur.wav")))
383 (play art
384 (apply-on-sample art #'(lambda (index x)
385 (if (oddp index)
386 (* 5 x)
387 x))
388 :start 5 :end 20))))
389
390
391
392
393 (define-wav-test test32 ()
394 "An other apply-on-sample test -> distortion"
395 (let* ((test (read-sample "arthur.wav"))
396 (max-ampl (/ (sample-max-ampl test) 2)))
397 (play test
398 (apply-on-sample test #'(lambda (index x)
399 (declare (ignore index))
400 (setf x (* x 100))
401 (cond ((>= x max-ampl) max-ampl)
402 ((<= x (- max-ampl)) (- max-ampl))
403 (t x)))
404 :start 3 :end 23))))
405
406
407 (define-wav-test test33 ()
408 "Test pitch-up"
409 (let* ((synth (read-sample "synth.wav")))
410 (play synth
411 (pitch-up synth 2)
412 (pitch-up synth 3)
413 (pitch-up synth 4)
414 (pitch-up synth 10))))
415
416 (define-wav-test test34 ()
417 "Test pitch-down"
418 (let* ((synth (read-sample "synth.wav")))
419 (play synth
420 (pitch-down synth 2)
421 (pitch-down synth 3)
422 (pitch-down synth 4)
423 (pitch-down synth 10))))
424
425 (define-wav-test test35 ()
426 "Test pitch (a mix of pitch-down and pitch-up)"
427 (let* ((synth (read-sample "synth.wav")))
428 (play synth
429 (pitch synth 1.5)
430 (pitch synth 3.7)
431 (pitch synth 0.7)
432 (pitch synth 0.35))))
433
434
435
436 (define-wav-test test36 ()
437 "Test time<->freq convert sample to spectrum"
438 (let ((test (make-instance 'sample :n-channels 1
439 :n-bits-per-sample 16
440 :n-samples-per-sec 22050
441 :time 1))
442 spectrum)
443 (time
444 (with-slots (max-ampl) test
445 (sample-make-sin test #'set-fun 0 0 10 400 max-ampl #'sin)
446 (sample-make-sin test #'+ 0 0 10 800 (/ max-ampl 2) #'sin)))
447 (sample-view test :min 0.2 :max 0.21)
448 (time
449 (setf spectrum (time<->freq test)))
450 (sample-view spectrum :min 100 :max 900)
451 (sample-view spectrum :min 100 :max 900 :fun #'phase)))
452
453
454 (define-wav-test test40 ()
455 "Test build song"
456 (build-song "test-song.wav"
457 (list (make-instance 'song-sample :time -1
458 :form '(progn
459 (defparameter synth (read-sample "synth.wav"))
460 (defparameter bomb (read-sample "bomb.wav"))))
461 (make-instance 'song-sample :time -0.9
462 :form '(setf (sample-n-samples-per-sec bomb) 44100))
463 (make-instance 'song-sample :time 1 :form 'synth)
464 (make-instance 'song-sample :time 20 :form 'synth)
465 (make-instance 'song-sample :time 10 :form "synth.wav")
466 (make-instance 'song-sample :time 3 :form '(pitch-down synth 3))
467 (make-instance 'song-sample :time 7 :form '(pitch-up synth 2))
468 (make-instance 'song-sample :time 15 :form 'bomb)
469 (make-instance 'song-sample :time 17 :form '(pitch-down bomb 2))
470 (make-instance 'song-sample :time 0.5 :form '(pitch-down bomb 25))))
471 (aud "test-song.wav"))
472
473 (define-wav-test test41 ()
474 "Test build song (2)"
475 (let ((song (list (make-instance 'song-sample :time 1 :form 'synth)
476 (make-instance 'song-sample :time 10 :form "synth.wav")
477 (make-instance 'song-sample :time -1
478 :form '(progn
479 (defparameter synth (read-sample "synth.wav"))
480 (defparameter bomb (read-sample "bomb.wav"))))
481 (make-instance 'song-sample :time -0.9
482 :form '(setf (sample-n-samples-per-sec bomb) 44100)))))
483 (loop for i from 1 to 10 do
484 (push (make-instance 'song-sample :time i :form `(pitch bomb (/ ,i 5))) song))
485 (build-song "test-song.wav" song)
486 (aud "test-song.wav")))
487
488
489 (define-wav-test test42 ()
490 "Test build song (3)"
491 (build-song "test-song.wav"
492 (list (make-instance 'song-sample :time -1
493 :form '(defvar synth (read-sample "synth.wav")))
494 (make-instance 'song-sample :time -0.9
495 :form '(defvar bomb (read-sample "bomb.wav")))
496 (make-instance 'song-sample :time -0.8
497 :form '(setf (sample-n-samples-per-sec bomb) 44100))
498 (make-instance 'song-sample :time 1 :form 'synth)
499 (make-instance 'song-sample :time 20 :form 'synth)
500 (make-instance 'song-sample :time 10 :form "synth.wav")
501 (make-instance 'song-sample :time 3 :form '(pitch-down synth 3))
502 (make-instance 'song-sample :time 7 :form '(pitch-up synth 2))
503 (make-instance 'song-sample :time 15 :form 'bomb)
504 (make-instance 'song-sample :time 17 :form '(pitch-down bomb 2))
505 (make-instance 'song-sample :time 0.5 :form '(pitch-down bomb 25))))
506 (aud "test-song.wav"))
507
508
509
510 (define-wav-test test43 ()
511 "Test build song form list"
512 (build-song "test-song.wav"
513 (list-to-song '((-1 (defparameter synth (read-sample "synth.wav")))
514 (-0.9 (defparameter bomb (read-sample "bomb.wav")))
515 (-0.8 (setf (sample-n-samples-per-sec bomb) 44100) 1 (:plop :plip))
516 (1 synth)
517 (2 bomb))))
518 (aud "test-song.wav"))
519
520 (define-wav-test test44 ()
521 "Test with-build-song"
522 (with-build-song ("test-song.wav")
523 (-1 (defparameter synth (read-sample "synth.wav")))
524 (-0.9 (defparameter bomb (read-sample "bomb.wav")))
525 (-0.8 (setf (sample-n-samples-per-sec bomb) 44100) 1 (:plop :plip))
526 (1 (pitch-up synth 2))
527 (2 bomb)
528 (3 "synth.wav"))
529 (aud "test-song.wav"))
530
531 (define-wav-test test45 ()
532 "Test with-song"
533 (build-song "test-song.wav"
534 (with-list-song ()
535 (-1 (defparameter synth (read-sample "synth.wav")) 0 :pouf 100)
536 (-0.9 (defparameter bomb (read-sample "bomb.wav")))
537 (-0.8 (setf (sample-n-samples-per-sec bomb) 44100) 1 (:plop :plip))
538 (1 (pitch-up synth 2))
539 (2 bomb)
540 (3 "synth.wav")))
541 (aud "test-song.wav"))
542
543 (define-wav-test test46 ()
544 "Test write-song"
545 (write-song "test-song.song"
546 (with-list-song ()
547 (-1 (defparameter synth (read-sample "synth.wav")))
548 (-0.9 (defparameter bomb (read-sample "bomb.wav")))
549 (-0.8 (setf (sample-n-samples-per-sec bomb) 44100) 1 (:plop :plip))
550 (1 (pitch-up synth 2))
551 (2 bomb)
552 (3 "synth.wav"))))
553
554 (define-wav-test test47 ()
555 "Test read-song"
556 (read-song "test-song.song")
557 (build-song "test-song.wav" *current-song*)
558 (aud "test-song.wav"))
559
560
561

  ViewVC Help
Powered by ViewVC 1.1.5