1\ snd-test.fs -- Snd Forth code and tests 2 3\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net> 4\ Created: 2006/08/05 00:09:28 5\ Changed: 2020/11/29 03:22:06 6 7\ Tags: FIXME - something is wrong 8\ XXX - info marker 9\ 10\ Tested with: 11\ Snd 20.x 12\ Fth 1.4.x 13\ 14\ Reads init file ./.sndtest.fs or ~/.sndtest.fs for global variables, 15\ hooks, etc. 16\ 17\ Example: 18\ 19\ cat ./.sndtest.fs 20\ "/tmp" set-save-dir to original-save-dir 21\ save-dir set-temp-dir to original-temp-dir 22\ 23\ #t to with-big-file 24\ "/usr/opt/sound/SFiles/bigger.snd" to bigger-snd 25\ "/usr/opt/sound/sf1/" to sf-dir 26\ #t to all-args 27\ 2 to *tests* 28\ #t to *snd-test-verbose* 29\ 30\ lambda: <{ output -- }> 31\ "sox -qV1 %s -d" #( output ) string-format file-system unless 32\ "exit %d\n" #( exit-status ) fth-print 33\ then 34\ ; to *snd-test-ws-player* 35\ 36\ #t to *snd-test-ws-play* 37\ #t to *snd-test-ws-statistics* 38\ #t to *snd-test-ws-verbose* 39 40\ 41\ Start tests: 42\ 43\ snd -noinit -load snd-test.fs \ all tests 44\ snd -noinit -load snd-test.fs 10 15 19 \ test 10 15 19 45\ snd -noinit -load snd-test.fs -23 \ all tests except 23 46\ 47\ test 00: constants 48\ test 01: defaults 49\ test 02: headers 50\ test 03: variables 51\ test 04: sndlib 52\ test 05: simple overall checks 53\ test 08: clm 54\ test 10: marks 55\ test 15: chan-local vars 56\ test 19: save and restore 57\ test 23: with-sound 58\ test 27: general ( will be replaced in the future ) 59\ test 28: errors 60 61'alsa provided? constant *with-test-alsa* 62'complex provided? constant *with-test-complex* 63'gl provided? constant *with-test-gl* 64'gl2ps provided? constant *with-test-gl2ps* 65'gsl provided? constant *with-test-gsl* 66'snd-ladspa provided? constant *with-test-ladspa* 67'snd-motif provided? constant *with-test-motif* 68'snd-nogui provided? constant *with-test-nogui* 69*with-test-nogui* not constant *with-test-gui* 70 7124 set-object-print-length 72 73*with-test-complex* [unless] 74 -1 constant 0+i 75[then] 76 77*with-test-nogui* [if] 78 #f value stdout-io 79 #f value stderr-io 80[else] 81 \ Prints to Snd's listener and stdout/stderr. 82 83 \ The original CLM-PRINT uses only SND-PRINT but we want output 84 \ to stdout/stderr too. 85 : clm-print ( fmt :optional args -- ) 86 fth-format ( str ) snd-print ( str ) .stdout 87 ; 88 89 :port-name "sndout" 90 :write-line lambda: <{ line -- }> line snd-print ( line ) .stdout ; 91 make-soft-port value stdout-io 92 93 :port-name "snderr" 94 :write-line lambda: <{ line -- }> line snd-print ( line ) .stderr ; 95 make-soft-port value stderr-io 96[then] 97 98\ Output words: We can't use clm-print here if we want xterm output 99\ (clm-message uses clm-print). 100 101\ SND-TEST-MESSAGE: Puts a comment sign before output 102\ and terminates with a carriage return. 103: snd-test-message ( fmt args -- ) ." \ " fth-print cr ; 104 105\ SND-DISPLAY: Wraps text like snd-test-message and prepends text with 106\ current line number ("\ [102] text\n"). 107: (snd-display) { fmt args lno -- } 108 fmt args string-format { str } 109 "\\ [%d] %s\n" #( lno str ) fth-print 110; 111 112: snd-display ( fmt args -- ) 113 postpone *lineno* 114 postpone (snd-display) 115; immediate 116 117\ *SND-TEST-VERBOSE*: progress information in long tests 118\ 119\ test 19-save/restore: function names 120\ test 28-errors: prints proc-array length and progress information 121#f value *snd-test-verbose* 122 123\ WITH-SOUND control 124\ 125\ options for test 23-with-sound: 126\ :play 127\ :player 128\ :statistics 129\ :verbose (event (bird) and instrument names) 130#f value *snd-test-ws-play* 131lambda: <{ output -- }> 132 \ Snd's play doesn't complain about more than 2 chans, see 133 \ test23-balance 134 save-stack { s } 135 output play drop 136 s restore-stack 137; value *snd-test-ws-player* 138#f value *snd-test-ws-statistics* 139#f value *snd-test-ws-verbose* 140 141\ run snd-test.fs *tests* times 1421 value *tests* 143 144\ You may set them in .sndtest.fs. 145#f value my-snd-error-hook 146#f value my-mus-error-hook 147 148"HOME" getenv value *home* 149save-dir *home* "/zap/snd" $+ || value original-save-dir 150temp-dir *home* "/zap/tmp" $+ || value original-temp-dir 151listener-prompt value original-prompt 152mus-file-buffer-size value default-file-buffer-size 1538 value *info-array-print-length* 154 155"/home/bil/sf1/" value sf-dir 156"/home/bil/zap/sounds/bigger.snd" value bigger-snd 157#f value with-big-file 158#f value all-args 1591000 value base-length 160 161\ Global variables may be overridden in `pwd`/.sndtest.fs or ~/.sndtest.fs. 162".sndtest.fs" load-init-file 163 164\ default 1, can be reset in .sndtest.fs 165*tests* integer? [if] 166 *tests* 0> [if] 167 *tests* 168 [else] 169 1 170 [then] 171[else] 172 1 173[then] to *tests* 1740 value *clmtest* 175 176*with-test-nogui* [if] 177 '( 0.0 0.1 ) value x-bounds-value 178 : x-bounds <{ :optional snd 0 chn 0 axis 0 -- res }> 179 x-bounds-value 180 ; 181 182 : set-x-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- res }> 183 bounds number? if 184 '( bounds dup fnegate ) 185 else 186 bounds length 1 = if 187 '( bounds car dup fnegate ) 188 else 189 bounds 190 then 191 then dup to x-bounds-value 192 ; 193 194 '( -1.0 1.0 ) value y-bounds-value 195 : y-bounds <{ :optional snd 0 chn 0 axis 0 -- res }> 196 y-bounds-value 197 ; 198 199 : set-y-bounds <{ bounds :optional snd 0 chn 0 axis 0 -- res }> 200 bounds number? if 201 '( bounds dup fnegate ) 202 else 203 bounds length 1 = if 204 '( bounds car dup fnegate ) 205 else 206 bounds 207 then 208 then dup to y-bounds-value 209 ; 210 211 : position->x <{ val :optional snd 0 chn 0 ax time-graph -- res }> 212 #f 213 ; 214 <'> position->x alias position->y 215 216 : x->position <{ val :optional snd 0 chn 0 ax time-graph -- res }> 217 #f 218 ; 219 <'> x->position alias y->position 220 221 : channel-widgets <{ :optional snd 0 chn 0 -- res }> 222 #f 223 ; 224 225 #t value enved-filter-value 226 : enved-filter <{ -- res }> 227 enved-filter-value 228 ; 229 230 : set-enved-filter <{ val -- res }> 231 val dup to enved-filter-value 232 ; 233 234 34 value graph-cursor-value 235 : graph-cursor <{ -- res }> 236 graph-cursor-value 237 ; 238 239 : set-graph-cursor <{ val -- res }> 240 val dup to graph-cursor-value 241 ; 242 243 nil value enved-envelope-value 244 : enved-envelope <{ -- res }> 245 enved-envelope-value 246 ; 247 248 : set-enved-envelope <{ val -- res }> 249 val dup to enved-envelope-value 250 ; 251 252 hot-colormap value colormap-value 253 : colormap <{ -- res }> 254 colormap-value 255 ; 256 257 : set-colormap <{ val -- res }> 258 val positive? 259 val 20 <= && if 260 val to colormap-value 261 then 262 val 263 ; 264 265 : add-colormap <{ name func -- res }> 266 #f 267 ; 268 269 <'> noop alias integer->colormap ( n -- cm ) 270 <'> noop alias colormap->integer ( cm -- n ) 271 272 : make-graph-data <{ :optional snd 0 chn 0 edpos 0 low -1 high -1 -- res }> 273 #f 274 ; 275 276 : graph-data <{ data :optional snd 0 chn 0 cx 0 low -1 high -1 gs 0 cr 0 -- }> 277 #f 278 ; 279 280 : draw-line <{ x0 y0 x1 y1 :optional snd 0 chn 0 ax time-graph cr 0 -- res }> 281 #f 282 ; 283 284 : draw-axes <{ wid gc lab :optional x0 0 x1 0 y0 0 y1 0 st 0 axes 0 -- res }> 285 #f 286 ; 287 <'> noop alias axis-color 288 <'> noop alias foreground-color 289 <'> noop alias highlight-color 290 <'> noop alias snd-gcs 291 292 \ These are already created in snd-nogui.c 293 \ 294 \ 2 #f create-hook mouse-enter-graph-hook 295 \ 3 #f create-hook mouse-enter-label-hook 296 \ 1 #f create-hook mouse-enter-listener-hook 297 \ 1 #f create-hook mouse-enter-text-hook 298 \ 2 #f create-hook mouse-leave-graph-hook 299 \ 3 #f create-hook mouse-leave-label-hook 300 \ 1 #f create-hook mouse-leave-listener-hook 301 \ 1 #f create-hook mouse-leave-text-hook 302[then] 303 304require clm 305require clm-ins 306require examp 307require hooks 308require marks 309require extensions 310require env 311require mix 312require dsp 313require snd-xm 314require effects 315require bird.fsm 316 317*clm-search-list* file-pwd array-push to *clm-search-list* 318reset-all-hooks 319 320*with-test-motif* [if] 321 lambda: <{ dpy e -- }> 322 \ XGetErrorText's return code is '( id string ) 323 dpy e Ferror_code nil 1024 FXGetErrorText { res } 324 "Xlib error_code[%s]: %s" res fth-warning 325 dpy e Frequest_code nil 1024 FXGetErrorText to res 326 "Xlib request_code[%s]: %s" res fth-warning 327 dpy e Fminor_code nil 1024 FXGetErrorText to res 328 "Xlib minor_code[%s]: %s" res fth-warning 329 ; FXSetErrorHandler drop 330 331 lambda: <{ dpy -- }> 332 "Xlib IO Error dpy: %S" #( dpy ) fth-error 333 ; FXSetIOErrorHandler drop 334[then] 335 336: fneq-err ( r1 r2 err -- f ) -rot ( r1 r2 ) f- fabs f<= ; 337 338: fneq ( a b -- f ) 0.001 fneq-err ; 339: ffneq ( a b -- f ) 0.010 fneq-err ; 340: fffneq ( a b -- f ) 0.100 fneq-err ; 341 342: cneq-err ( c1 c2 err -- f ) 343 { c1 c2 err } 344 c1 real-ref c2 real-ref err fneq-err 345 c1 image-ref c2 image-ref err fneq-err || 346; 347 348: cneq ( a b -- f ) 0.001 cneq-err ; 349 350: fequal-err ( r1 r2 err -- f ) -rot ( err r1 r2 ) f- fabs f> ; 351 352: fequal? ( a b -- f ) 0.001 fequal-err ; 353 354: any->vct ( obj ) 355 { obj } 356 obj vct? if 357 obj 358 else 359 obj array? if 360 obj vector->vct 361 else 362 #f 363 then 364 then 365; 366 367: vequal-err ( v0 v1 err -- f ) 368 { val0 val1 err } 369 val0 any->vct { v0 } 370 val1 any->vct { v1 } 371 v0 372 v1 && 373 v0 length v1 length = && if 374 v0 vct-copy v1 vct-subtract! vct-peak err f<= 375 else 376 #f 377 then 378; 379 380: vequal? ( v0 v1 -- f ) 0.001 vequal-err ; 381 382: vvequal ( v0 v1 -- f ) 0.00002 vequal-err ; 383: vfequal ( v0 v1 -- f ) 0.01 vequal-err ; 384: vffequal ( v0 v1 -- f ) 0.1 vequal-err ; 385: vfffequal ( v0 v1 -- f ) 0.5 vequal-err ; 386 387<'> vequal? alias vequal 388 389: feql-err ( obj0 obj1 err -- f ) 390 { obj0 obj1 err } 391 obj0 object-length obj1 object-length = if 392 #t ( flag ) 393 obj0 each ( r0 ) 394 obj1 i object-ref ( r1 ) err fneq-err if 395 not ( toggle flag ) 396 leave 397 then 398 end-each ( flag ) 399 else 400 #f 401 then 402; 403 404: feql ( obj0 obj1 -- f ) 0.001 feql-err ; 405: ffeql ( obj0 obj1 -- f ) 0.01 feql-err ; 406: fffeql ( obj0 obj1 -- f ) 0.1 feql-err ; 407 408: fveql ( v1 v2 idx -- f) 409 { v1 v2 idx } 410 #t ( flag ) 411 v1 length v2 length min idx ?do 412 v1 i object-ref v2 i object-ref fneq if 413 not ( toggle flag ) 414 leave 415 then 416 loop 417; 418 419: list-equal? { obj1 obj2 -- f } 420 obj1 list? 421 obj2 list? && if 422 #t ( flag ) 423 obj1 each ( entry ) 424 obj2 i list-ref object-equal? unless 425 not ( toggle flag ) 426 leave 427 then 428 end-each 429 else 430 #f 431 then 432; 433 434\ arity: #( req opt rest ) 435: arity-ok <{ proc args -- f }> 436 proc proc? if 437 proc proc-arity { args-lst } 438 args-lst 0 array-ref { req } \ int 439 args-lst 1 array-ref { opt } \ int 440 args-lst 2 array-ref { rest } \ bool 441 opt 0> if 442 args req >= 443 args req opt + <= && 444 else 445 args req = 446 rest || 447 then 448 else 449 #f 450 then 451; 452 453: set-arity-ok <{ proc args -- f }> 454 proc set-xt args arity-ok 455; 456 457: symbol-defined? ( sym -- f ) 458 "defined? " swap symbol-name $+ string-eval 459; 460 461: vector? { obj -- f } 462 obj array? if 463 \ car doesn't raise an error if length == 0 464 obj car number? 465 else 466 #f 467 then 468; 469 470: snd-test-vector? { obj -- f } 471 obj vct? 472 obj vector? || 473; 474 475: snd-test-catch ( xt -- tag ) 476 #t nil fth-catch { tag } 477 stack-reset 478 tag 479; 480 481: snd-test-format { sndfmt res req fmt args -- str } 482 sndfmt #( res req ) string-format { str } 483 fmt empty? if 484 str 485 else 486 fmt args string-format ": " $+ str $+ 487 then 488; 489 490: snd-format { res req op fmt args -- str } 491 req snd-test-vector? if 492 mus-array-print-length { old-alen } 493 print-length { old-vlen } 494 *info-array-print-length* set-mus-array-print-length drop 495 *info-array-print-length* set-print-length drop 496 "res " op $+ " req?\n\\ => res %S\n\\ => req %S" $+ res req fmt args 497 snd-test-format ( str ) 498 old-alen set-mus-array-print-length drop 499 old-vlen set-print-length drop 500 ( str ) 501 else 502 "res %S " op $+ " req %S?" $+ res req fmt args snd-test-format ( str ) 503 then 504; 505 506: snd-test-equal? { res req -- f } 507 res number? 508 req number? && if 509 res req fequal? 510 else 511 req snd-test-vector? if 512 res req vequal? 513 else 514 res req equal? 515 then 516 then 517; 518 519: (snd-test-neq) { res req fmt args lno -- } 520 res req snd-test-equal? unless 521 res req "!=" fmt args snd-format { str } 522 "\\ [%d] %s\n" #( lno str ) fth-print 523 then 524; 525 526: (snd-test-eq) { res req fmt args lno -- } 527 res req snd-test-equal? if 528 res req "==" fmt args snd-format { str } 529 "\\ [%d] %s\n" #( lno str ) fth-print 530 then 531; 532 533: (snd-test-any-neq) { res req func fmt args lno -- } 534 res req func execute unless 535 res req func xt->name fmt args snd-format { str } 536 "\\ [%d] %s\n" #( lno str ) fth-print 537 then 538; 539 540: (snd-test-any-eq) { res req func fmt args lno -- } 541 res req func execute if 542 res req func xt->name fmt args snd-format { str } 543 "\\ [%d] %s\n" #( lno str ) fth-print 544 then 545; 546 547: snd-test-neq ( res req fmt args -- ) 548 postpone *lineno* 549 postpone (snd-test-neq) 550; immediate 551 552: snd-test-eq ( res req fmt args -- ) 553 postpone *lineno* 554 postpone (snd-test-eq) 555; immediate 556 557\ res req <'> ffeql "more info" #() snd-test-any-neq 558: snd-test-any-neq ( res req func fmt args -- ) 559 postpone *lineno* 560 postpone (snd-test-any-neq) 561; immediate 562 563\ res req <'> ffeql "more info" #() snd-test-any-eq 564: snd-test-any-eq ( res req func fmt args -- ) 565 postpone *lineno* 566 postpone (snd-test-any-eq) 567; immediate 568 569: check-file-name { name -- fsnd } 570 name file-exists? if 571 name 572 else 573 sf-dir name $+ 574 then 575; 576 5771 0 0 make-color constant safe-color 578 579: make-color-with-catch { c1 c2 c3 -- color } 580 c1 c2 c3 <'> make-color 'no-such-color nil fth-catch if 581 \ XXX: stack-reset <= wrong! 582 \ Only top, second, and third should be dropped! 583 \ The rest may be not of your business, 584 \ for example #( 'a 'b 'c 1 2 3 make-color-with-catch 'd 'e 'f ) 585 \ would return #( #( Pixel 0x1111 ) 'd 'e 'f ) 586 \ not #( 'a 'b 'c #( Pixel 0x1111 ) 'd 'e 'f ) 587 drop drop drop 588 safe-color 589 then 590; 591 592: reset-almost-all-hooks ( -- ) 593 reset-all-hooks 594 my-snd-error-hook proc? if 595 snd-error-hook my-snd-error-hook add-hook! 596 then 597 my-mus-error-hook proc? if 598 mus-error-hook my-mus-error-hook add-hook! 599 then 600; 601 602*with-test-nogui* [if] 603 <'> noop alias dismiss-all-dialogs 604[else] 605 : dismiss-all-dialogs ( -- ) 606 nil nil { dialog d } 607 dialog-widgets each to dialog 608 dialog if 609 dialog 0 array-ref symbol? if 610 dialog is-managed? if 611 dialog hide-widget drop 612 then 613 else \ not widget? 614 dialog each to d 615 d 0 array-ref symbol? if 616 d is-managed? if 617 d hide-widget drop 618 then 619 then 620 end-each 621 then \ widget? 622 then \ dialog 623 end-each 624 ; 625[then] 626 627#f value overall-start-time 628#() value test-numbers 629 630: run-fth-test ( xt -- ) 631 { xt } 632 xt xt->name { name } 633 name 0 2 string-substring { num } 634 num string->number to num 635 test-numbers num array-member? if 636 name #f snd-test-message 637 stack-reset 638 gc-run 639 make-timer { tm } 640 xt #t nil fth-catch drop 641 tm stop-timer 642 stack-reset 643 sounds if 644 "open sounds: %s" #( #t short-file-name ) snd-test-message 645 sounds each ( snd ) 646 close-sound drop 647 end-each 648 then 649 #f set-ask-about-unsaved-edits drop 650 #f set-remember-sound-state drop 651 "%s: %s" #( name tm ) snd-test-message 652 "" #f snd-test-message 653 .stack 654 then 655; 656 657: start-snd-test ( -- ) 658 *with-test-motif* if 659 "motif" 660 else 661 *with-test-nogui* if 662 #t set-with-mix-tags drop 663 "nogui" 664 else 665 "unknown" 666 then 667 then { kind } 668 stack-reset 669 "test.snd" file-exists? if 670 "test.snd" 0o644 file-chmod 671 then 672 "=== Snd version: %s (snd-%s)" #( snd-version kind ) snd-test-message 673 "=== Fth version: %s" #( fth-version ) snd-test-message 674 "" #f snd-test-message 675 date #f snd-test-message 676 "" #f snd-test-message 677 default-file-buffer-size set-mus-file-buffer-size to *clm-file-buffer-size* 678 #f set-with-background-processes drop 679 600 set-window-x drop 680 10 set-window-y drop 681 #t set-show-listener drop 682 reset-almost-all-hooks 683 44100 to *clm-srate* 684 stack-reset 685 make-timer to overall-start-time 686; 687 688: finish-snd-test ( -- ) 689 overall-start-time stop-timer 690 stack-reset 691 regions each ( r ) 692 forget-region drop 693 end-each 694 sounds if 695 stop-playing drop 696 then 697 reset-almost-all-hooks 698 #f set-ask-about-unsaved-edits drop 699 #f set-remember-sound-state drop 700 "all done!" #f snd-test-message 701 "" #f snd-test-message 702 "summary: %s" #( overall-start-time ) snd-test-message 703 0 nil nil { file-count path file } 704 #( original-save-dir original-temp-dir "/tmp" ) each to path 705 path file-directory? if 706 path file-dir each to file 707 /snd_/ file regexp-match if 708 file file-delete 709 1 +to file-count 710 then 711 end-each 712 then 713 end-each 714 "" #f snd-test-message 715 "%d files deleted" #( file-count ) snd-test-message 716 "" #f snd-test-message 717 "test.snd" file-exists? if 718 "test.snd" 0o644 file-chmod 719 then 720 #( "1" 721 "aaa.eps" 722 "accelmap" 723 "envs.save" 724 "fmv.snd" 725 "fmv.wav" 726 "fmv0.snd" 727 "fmv1.snd" 728 "fmv2.snd" 729 "fmv3.snd" 730 "fmv4.reverb" 731 "fmv4.snd" 732 "hiho.marks" 733 "hiho.snd" 734 "hiho.tmp" 735 "hiho.wave" 736 "ho" 737 "new.snd" 738 "oboe.marks" 739 "obtest.snd.stereo" 740 "remembered-oboe.snd.fs" 741 "s1.fsm" 742 "s1.snd" 743 "s6.fsm" 744 "s6.reverb" 745 "s6.snd" 746 "s7.fsm" 747 "s7.snd" 748 "saved-snd.fs" 749 "sec1.fsm" 750 "sec1.snd" 751 "sec2.fsm" 752 "sec2.reverb" 753 "sec2.snd" 754 "snd.eps" 755 "test-1.snd" 756 "test-2.snd" 757 "test-macros.scm" 758 "test.aiff" 759 "test.data" 760 "test.rev" 761 "test.reverb" 762 "test.snd" 763 "test.snd.snd" 764 "test.wav" 765 "test.xpm" 766 "test2.snd" 767 "test3.snd" 768 "tmp.snd" 769 "with-mix.snd" ) each ( file ) 770 file-delete 771 end-each 772 #( "bad_data_format.snd.snd" 773 "ce-c3.w02.snd" 774 "hcom-16.snd.snd" 775 "ieee-text-16.snd.snd" 776 "mus10.snd.snd" 777 "nasahal.avi.snd" 778 "nist-shortpack.wav.snd" 779 "o2_dvi.wave.snd" 780 "oboe.g721.snd" 781 "oboe.g723_24.snd" 782 "oboe.g723_40.snd" 783 "oki.wav.snd" 784 "trumps22.adp.snd" 785 "wood.sds.snd" ) each ( file ) 786 sf-dir swap $+ file-delete 787 end-each 788 #t set-show-listener drop 789 "test-forth.output" save-listener drop 790 original-prompt set-listener-prompt drop 791; 792 793SIGINT lambda: { sig -- } 794 stack-reset 795 backtrace 796 "" #f snd-test-message 797 "Interrupt received. Clean up %S." #( *filename* #f file-basename ) 798 snd-test-message 799 "" #f snd-test-message 800 finish-snd-test 801 0 snd-exit drop 802; signal drop 803 804\ snd-test.scm translations 805\ ---------------- test 00: constants ---------------- 806 807*with-test-motif* [if] 808 "6x12" 809[else] 810 "9x15" 811[then] constant tiny-font-string 812 813*with-test-motif* [if] 814 "9x15" 815[else] 816 "6x12" 817[then] constant tiny-font-set-string 818 819\ XXX: temp-dir, save-dir, ladspa-dir, peak-env-dir 820\ These variables default to NULL (snd.c/snd-0.h). 821\ snd-test.scm checks for #f 822\ snd-test.fs checks for "" 823 824: 00-constants ( -- ) 825 sounds { snds } 826 undef undef mixes { mxs } 827 undef undef undef marks { mks } 828 regions { rgns } 829 snds 830 mxs || 831 mks || 832 rgns || if 833 "start up sounds: %s, mixes: %s, marks: %s, regions: %s?" 834 #( snds mxs mks rgns ) snd-display 835 then 836 \ 837 nil nil nil nil { vals sym req res } 838 #( #( <'> enved-amplitude 0 ) 839 #( <'> bartlett-window 4 ) 840 #( <'> bartlett-hann-window 21 ) 841 #( <'> blackman2-window 6 ) 842 #( <'> blackman3-window 7 ) 843 #( <'> blackman4-window 8 ) 844 #( <'> blackman5-window 24 ) 845 #( <'> blackman6-window 25 ) 846 #( <'> blackman7-window 26 ) 847 #( <'> blackman8-window 27 ) 848 #( <'> blackman9-window 28 ) 849 #( <'> blackman10-window 29 ) 850 #( <'> bohman-window 22 ) 851 #( <'> cauchy-window 12 ) 852 #( <'> mlt-sine-window 33 ) 853 #( <'> papoulis-window 34 ) 854 #( <'> dpss-window 35 ) 855 #( <'> sinc-window 36 ) 856 #( <'> channels-combined 1 ) 857 #( <'> channels-separate 0 ) 858 #( <'> channels-superimposed 2 ) 859 #( <'> connes-window 18 ) 860 #( <'> cursor-in-middle 3 ) 861 #( <'> cursor-in-view 0 ) 862 #( <'> cursor-on-left 1 ) 863 #( <'> cursor-on-right 2 ) 864 #( <'> dolph-chebyshev-window 16 ) 865 #( <'> exponential-window 9 ) 866 #( <'> flat-top-window 23 ) 867 #( <'> sync-none 0 ) 868 #( <'> sync-all 1 ) 869 #( <'> sync-by-sound 2 ) 870 #( <'> zoom-focus-active 2 ) 871 #( <'> zoom-focus-left 0 ) 872 #( <'> zoom-focus-middle 3 ) 873 #( <'> zoom-focus-right 1 ) 874 #( <'> gaussian-window 14 ) 875 #( <'> graph-dots 1 ) 876 #( <'> graph-dots-and-lines 3 ) 877 #( <'> graph-filled 2 ) 878 #( <'> graph-lines 0 ) 879 #( <'> graph-lollipops 4 ) 880 #( <'> hamming-window 5 ) 881 #( <'> hann-window 1 ) 882 #( <'> hann-poisson-window 17 ) 883 #( <'> kaiser-window 11 ) 884 #( <'> keyboard-no-action 4 ) 885 #( <'> graph-once 0 ) 886 #( <'> parzen-window 3 ) 887 #( <'> poisson-window 13 ) 888 #( <'> rectangular-window 0 ) 889 #( <'> riemann-window 10 ) 890 #( <'> rv2-window 30 ) 891 #( <'> rv3-window 31 ) 892 #( <'> rv4-window 32 ) 893 #( <'> samaraki-window 19 ) 894 #( <'> ultraspherical-window 20 ) 895 #( <'> graph-as-sonogram 1 ) 896 #( <'> graph-as-spectrogram 2 ) 897 #( <'> graph-once 0 ) 898 #( <'> graph-as-wavogram 3 ) 899 #( <'> enved-spectrum 1 ) 900 #( <'> speed-control-as-float 0 ) 901 #( <'> speed-control-as-ratio 1 ) 902 #( <'> speed-control-as-semitone 2 ) 903 #( <'> enved-srate 2 ) 904 #( <'> tukey-window 15 ) 905 #( <'> welch-window 2 ) 906 #( <'> cursor-cross 0 ) 907 #( <'> cursor-line 1 ) 908 #( <'> dont-normalize 0 ) 909 #( <'> envelope-linear 0 ) 910 #( <'> envelope-exponential 1 ) 911 #( <'> normalize-by-channel 1 ) 912 #( <'> normalize-by-sound 2 ) 913 #( <'> normalize-globally 3 ) 914 #( <'> x-axis-in-samples 1 ) 915 #( <'> x-axis-in-beats 3 ) 916 #( <'> x-axis-in-measures 4 ) 917 #( <'> x-axis-in-seconds 0 ) 918 #( <'> x-axis-as-clock 5 ) 919 #( <'> x-axis-as-percentage 2 ) 920 #( <'> enved-add-point 0 ) 921 #( <'> enved-delete-point 1 ) 922 #( <'> enved-move-point 2 ) 923 #( <'> time-graph 0 ) 924 #( <'> transform-graph 1 ) 925 #( <'> lisp-graph 2 ) 926 #( <'> copy-context 0 ) 927 #( <'> cursor-context 3 ) 928 #( <'> selection-context 2 ) 929 #( <'> mark-context 4 ) 930 #( <'> show-no-axes 0 ) 931 #( <'> show-all-axes 1 ) 932 #( <'> show-x-axis 2 ) 933 #( <'> show-all-axes-unlabelled 3 ) 934 #( <'> show-x-axis-unlabelled 4 ) 935 #( <'> show-bare-x-axis 5 ) 936 \ sndlib constants 937 #( <'> mus-unknown-header 0 ) 938 #( <'> mus-next 1 ) 939 #( <'> mus-aifc 2 ) 940 #( <'> mus-riff 3 ) 941 #( <'> mus-nist 6 ) 942 #( <'> mus-raw 12 ) 943 #( <'> mus-ircam 15 ) 944 #( <'> mus-aiff 49 ) 945 #( <'> mus-bicsf 5 ) 946 #( <'> mus-voc 10 ) 947 #( <'> mus-svx 9 ) 948 #( <'> mus-soundfont 26 ) 949 #( <'> mus-rf64 4 ) 950 #( <'> mus-caff 60 ) 951 \ 952 #( <'> mus-interp-none 0 ) 953 #( <'> mus-interp-linear 1 ) 954 #( <'> mus-interp-sinusoidal 2 ) 955 #( <'> mus-interp-all-pass 3 ) 956 #( <'> mus-interp-lagrange 4 ) 957 #( <'> mus-interp-bezier 5 ) 958 #( <'> mus-interp-hermite 6 ) 959 \ 960 #( <'> mus-chebyshev-first-kind 1 ) 961 #( <'> mus-chebyshev-second-kind 2 ) 962 \ 963 #( <'> mus-unknown-sample 0 ) 964 #( <'> mus-bshort 1 ) 965 #( <'> mus-lshort 10 ) 966 #( <'> mus-mulaw 2 ) 967 #( <'> mus-alaw 6 ) 968 #( <'> mus-byte 3 ) 969 #( <'> mus-ubyte 7 ) 970 #( <'> mus-bfloat 4 ) 971 #( <'> mus-lfloat 12 ) 972 #( <'> mus-bint 5 ) 973 #( <'> mus-lint 11 ) 974 #( <'> mus-bintn 17 ) 975 #( <'> mus-lintn 18 ) 976 #( <'> mus-b24int 8 ) 977 #( <'> mus-l24int 16 ) 978 #( <'> mus-bdouble 9 ) 979 #( <'> mus-ldouble 13 ) 980 #( <'> mus-ubshort 14 ) 981 #( <'> mus-ulshort 15 ) 982 #( <'> mus-bfloat-unscaled 19 ) 983 #( <'> mus-lfloat-unscaled 20 ) 984 #( <'> mus-bdouble-unscaled 21 ) 985 #( <'> mus-ldouble-unscaled 22 ) ) { consts } 986 consts each to vals 987 vals 0 array-ref to sym 988 vals 1 array-ref to req 989 sym execute ( res ) req "%s" #( sym ) snd-test-neq 990 end-each 991 \ 992 temp-dir { old-dir } 993 #f set-temp-dir drop 994 #( #( <'> region-graph-style graph-lines ) 995 #( <'> ask-about-unsaved-edits #f ) 996 #( <'> show-full-duration #f ) 997 #( <'> show-full-range #f ) 998 #( <'> initial-beg 0.0 ) 999 #( <'> initial-dur 0.1 ) 1000 #( <'> ask-before-overwrite #f ) 1001 #( <'> auto-resize #t ) 1002 #( <'> auto-update #f ) 1003 #( <'> channel-style 1 ) 1004 #( <'> color-cutoff 0.003 ) 1005 #( <'> color-inverted #t ) 1006 #( <'> color-scale 1.0 ) 1007 #( <'> auto-update-interval 60.0 ) 1008 #( <'> cursor-update-interval 0.05 ) 1009 #( <'> cursor-location-offset 0 ) 1010 #( <'> dac-combines-channels #t ) 1011 #( <'> dac-size 256 ) 1012 #( <'> clipping #f ) 1013 #( <'> default-output-chans 1 ) 1014 #( <'> default-output-sample-type mus-lfloat ) 1015 #( <'> default-output-srate 44100 ) 1016 #( <'> default-output-header-type mus-next ) 1017 #( <'> dot-size 1 ) 1018 #( <'> cursor-size 15 ) 1019 #( <'> cursor-style cursor-cross ) 1020 #( <'> tracking-cursor-style cursor-line ) 1021 #( <'> enved-base 1.0 ) 1022 #( <'> enved-clip? #t ) 1023 #( <'> enved-filter #t ) 1024 #( <'> enved-filter-order 40 ) 1025 #( <'> enved-in-dB #f ) 1026 #( <'> enved-style envelope-linear ) 1027 #( <'> enved-power 3.0 ) 1028 #( <'> enved-target 0 ) 1029 #( <'> enved-wave? #f ) 1030 #( <'> enved-envelope nil ) 1031 #( <'> eps-file "snd.eps" ) 1032 #( <'> eps-bottom-margin 0.0 ) 1033 #( <'> eps-left-margin 0.0 ) 1034 #( <'> eps-size 1.0 ) 1035 #( <'> fft-window-alpha 0.0 ) 1036 #( <'> fft-window-beta 0.0 ) 1037 #( <'> fft-log-frequency #f ) 1038 #( <'> fft-log-magnitude #f ) 1039 #( <'> fft-with-phases #f ) 1040 #( <'> transform-size 512 ) 1041 #( <'> transform-graph-type graph-once ) 1042 #( <'> fft-window 6 ) 1043 #( <'> graph-cursor 34 ) 1044 #( <'> graph-style graph-lines ) 1045 #( <'> graphs-horizontal #t ) 1046 #( <'> html-dir "." ) 1047 #( <'> html-program "firefox" ) 1048 #( <'> just-sounds #t ) 1049 #( <'> listener-prompt ">" ) 1050 #( <'> max-transform-peaks 100 ) 1051 #( <'> max-regions 16 ) 1052 #( <'> min-dB -60.0 ) 1053 #( <'> log-freq-start 32.0 ) 1054 #( <'> selection-creates-region #t ) 1055 #( <'> transform-normalization normalize-by-channel ) 1056 #( <'> print-length 12 ) 1057 #( <'> play-arrow-size 10 ) 1058 #( <'> save-state-file "saved-snd.fs" ) 1059 #( <'> show-axes 1 ) 1060 #( <'> show-transform-peaks #f ) 1061 #( <'> show-indices #f ) 1062 #( <'> show-marks #t ) 1063 #( <'> show-mix-waveforms #t ) 1064 #( <'> show-selection-transform #f ) 1065 #( <'> show-y-zero #f ) 1066 #( <'> show-grid #f ) 1067 #( <'> grid-density 1.0 ) 1068 #( <'> show-sonogram-cursor #f ) 1069 #( <'> sinc-width 10 ) 1070 #( <'> spectrum-end 1.0 ) 1071 #( <'> spectro-hop 4 ) 1072 #( <'> spectrum-start 0.0 ) 1073 #( <'> spectro-x-angle *with-test-gl* if 300.0 else 90.0 then ) 1074 #( <'> spectro-x-scale *with-test-gl* if 1.5 else 1.0 then ) 1075 #( <'> spectro-y-angle *with-test-gl* if 320.0 else 0.0 then ) 1076 #( <'> spectro-y-scale 1.0 ) 1077 #( <'> spectro-z-angle *with-test-gl* if 0.0 else 358.0 then ) 1078 #( <'> spectro-z-scale *with-test-gl* if 1.0 else 0.1 then ) 1079 #( <'> temp-dir "" ) 1080 #( <'> ladspa-dir "" ) 1081 #( <'> peak-env-dir "" ) 1082 #( <'> tiny-font tiny-font-string ) 1083 #( <'> transform-type fourier-transform ) 1084 #( <'> with-file-monitor #t ) 1085 #( <'> clm-table-size 512 ) 1086 #( <'> with-verbose-cursor #f ) 1087 #( <'> with-inset-graph #f ) 1088 #( <'> with-interrupts #t ) 1089 #( <'> remember-sound-state #f ) 1090 #( <'> with-smpte-label #f ) 1091 #( <'> with-toolbar #f ) 1092 #( <'> with-tooltips #t ) 1093 #( <'> with-menu-icons #f ) 1094 #( <'> save-as-dialog-src #f ) 1095 #( <'> save-as-dialog-auto-comment #f ) 1096 #( <'> with-pointer-focus #f ) 1097 #( <'> wavelet-type 0 ) 1098 #( <'> time-graph-type graph-once ) 1099 #( <'> wavo-hop 3 ) 1100 #( <'> wavo-trace 64 ) 1101 #( <'> x-axis-style 0 ) 1102 #( <'> beats-per-minute 60.0 ) 1103 #( <'> beats-per-measure 4 ) 1104 #( <'> zero-pad 0 ) 1105 #( <'> zoom-focus-style 2 ) 1106 #( <'> sync-style sync-by-sound ) 1107 #( <'> mix-waveform-height 20 ) 1108 #( <'> mix-tag-width 6 ) 1109 #( <'> mix-tag-height 14 ) 1110 #( <'> mark-tag-width 10 ) 1111 #( <'> mark-tag-height 4 ) ) { vars } 1112 vars each to vals 1113 vals 0 array-ref to sym 1114 vals 1 array-ref to req 1115 sym execute ( val ) sym set-execute ( res ) req "set-%s" #( sym ) 1116 snd-test-neq 1117 end-each 1118 old-dir set-temp-dir drop 1119 \ 1120 -123 set-max-transform-peaks drop 1121 -123 set-zero-pad drop 1122 max-transform-peaks set-max-transform-peaks 100 "set-max-transform-peaks" #() 1123 snd-test-neq 1124 zero-pad set-zero-pad 0 "set-zero-pad" #() snd-test-neq 1125 #t #t zero-pad nil "#t #t zero-pad" #() snd-test-neq 1126 *with-test-motif* if 1127 #( <'> axis-label-font 1128 <'> axis-numbers-font 1129 <'> tiny-font 1130 <'> peaks-font 1131 <'> bold-peaks-font ) { fonts } 1132 fonts each to sym 1133 sym execute to req 1134 "8x123" sym set-execute ( res ) req "set-%s to bogus value" #( sym ) 1135 snd-test-neq 1136 end-each 1137 then 1138 #f set-ask-about-unsaved-edits drop 1139 #f set-remember-sound-state drop 1140; 1141 1142\ ---------------- test 01: defaults ---------------- 1143 1144hot-colormap constant *good-colormap* 1145black-and-white-colormap constant *better-colormap* 1146 1147: 01-defaults ( -- ) 1148 nil { res } 1149 *with-test-gui* if 1150 *good-colormap* colormap? unless 1151 #f to *good-colormap* 1152 21 1 do 1153 i integer->colormap to res 1154 res colormap? if 1155 res to *good-colormap* 1156 leave 1157 then 1158 loop 1159 then 1160 *better-colormap* colormap? unless 1161 #f to *better-colormap* 1162 21 *good-colormap* colormap->integer do 1163 i integer->colormap to res 1164 res colormap? if 1165 res to *better-colormap* 1166 leave 1167 then 1168 loop 1169 then 1170 then 1171 \ 1172 temp-dir { old-dir } 1173 #f set-temp-dir drop 1174 #( #( <'> ask-about-unsaved-edits #f ) 1175 #( <'> ask-before-overwrite #f ) 1176 #( <'> auto-resize #t ) 1177 #( <'> auto-update #f ) 1178 #( <'> auto-update-interval 60.0 ) 1179 #( <'> beats-per-measure 4 ) 1180 #( <'> beats-per-minute 60.0 ) 1181 #( <'> channel-style 1 ) 1182 #( <'> clipping #f ) 1183 #( <'> clm-table-size 512 ) 1184 #( <'> color-cutoff 0.003 ) 1185 #( <'> color-inverted #t ) 1186 #( <'> color-scale 1.0 ) 1187 #( <'> colormap *good-colormap* ) 1188 #( <'> contrast-control-amp 1.0 ) 1189 #( <'> with-tracking-cursor #f ) 1190 #( <'> cursor-location-offset 0 ) 1191 #( <'> cursor-size 15 ) 1192 #( <'> cursor-style cursor-cross ) 1193 #( <'> cursor-update-interval 0.05 ) 1194 #( <'> dac-combines-channels #t ) 1195 #( <'> dac-size 256 ) 1196 #( <'> default-output-chans 1 ) 1197 #( <'> default-output-sample-type mus-lfloat ) 1198 #( <'> default-output-header-type mus-next ) 1199 #( <'> default-output-srate 44100 ) 1200 #( <'> dot-size 1 ) 1201 #( <'> enved-base 1.0 ) 1202 #( <'> enved-clip? #t ) 1203 #( <'> enved-envelope nil ) 1204 #( <'> enved-filter #t ) 1205 #( <'> enved-filter-order 40 ) 1206 #( <'> enved-in-dB #f ) 1207 #( <'> enved-power 3.0 ) 1208 #( <'> enved-style envelope-linear ) 1209 #( <'> enved-target 0 ) 1210 #( <'> enved-wave? #f ) 1211 #( <'> eps-bottom-margin 0.0 ) 1212 #( <'> eps-file "snd.eps" ) 1213 #( <'> eps-left-margin 0.0 ) 1214 #( <'> eps-size 1.0 ) 1215 #( <'> expand-control-hop 0.05 ) 1216 #( <'> expand-control-jitter 0.1 ) 1217 #( <'> expand-control-length 0.15 ) 1218 #( <'> expand-control-ramp 0.4 ) 1219 #( <'> fft-log-frequency #f ) 1220 #( <'> fft-log-magnitude #f ) 1221 #( <'> fft-with-phases #f ) 1222 #( <'> fft-window 6 ) 1223 #( <'> fft-window-alpha 0.0 ) 1224 #( <'> fft-window-beta 0.0 ) 1225 #( <'> filter-control-in-dB #f ) 1226 #( <'> filter-control-in-hz #f ) 1227 #( <'> filter-control-order 20 ) 1228 #( <'> graph-cursor 34 ) 1229 #( <'> graph-style graph-lines ) 1230 #( <'> graphs-horizontal #t ) 1231 #( <'> grid-density 1.0 ) 1232 #( <'> html-dir "." ) 1233 #( <'> html-program "firefox" ) 1234 #( <'> initial-beg 0.0 ) 1235 #( <'> initial-dur 0.1 ) 1236 #( <'> just-sounds #t ) 1237 #( <'> ladspa-dir "" ) 1238 #( <'> peak-env-dir "" ) 1239 #( <'> listener-prompt ">" ) 1240 #( <'> log-freq-start 32.0 ) 1241 #( <'> mark-tag-height 4 ) 1242 #( <'> mark-tag-width 10 ) 1243 #( <'> max-regions 16 ) 1244 #( <'> max-transform-peaks 100 ) 1245 #( <'> min-dB -60.0 ) 1246 #( <'> mix-tag-height 14 ) 1247 #( <'> mix-tag-width 6 ) 1248 #( <'> mix-waveform-height 20 ) 1249 #( <'> mus-array-print-length 8 ) 1250 #( <'> mus-clipping #f ) 1251 #( <'> mus-float-equal-fudge-factor 0.0000001 ) 1252 #( <'> play-arrow-size 10 ) 1253 #( <'> print-length 12 ) 1254 #( <'> region-graph-style graph-lines ) 1255 #( <'> remember-sound-state #f ) 1256 #( <'> reverb-control-feedback 1.09 ) 1257 #( <'> reverb-control-lowpass 0.7 ) 1258 #( <'> save-as-dialog-auto-comment #f ) 1259 #( <'> save-as-dialog-src #f ) 1260 #( <'> save-state-file "saved-snd.fs" ) 1261 #( <'> selection-creates-region #t ) 1262 #( <'> show-axes 1 ) 1263 #( <'> show-controls #f ) 1264 #( <'> show-full-duration #f ) 1265 #( <'> show-full-range #f ) 1266 #( <'> show-grid #f ) 1267 #( <'> show-indices #f ) 1268 #( <'> show-marks #t ) 1269 #( <'> show-mix-waveforms #t ) 1270 #( <'> show-selection-transform #f ) 1271 #( <'> show-sonogram-cursor #f ) 1272 #( <'> show-transform-peaks #f ) 1273 #( <'> show-y-zero #f ) 1274 #( <'> sinc-width 10 ) 1275 #( <'> spectrum-end 1.0 ) 1276 #( <'> spectro-hop 4 ) 1277 #( <'> spectrum-start 0.0 ) 1278 #( <'> spectro-x-angle *with-test-gl* if 300.0 else 90.0 then ) 1279 #( <'> spectro-x-scale *with-test-gl* if 1.5 else 1.0 then ) 1280 #( <'> spectro-y-angle *with-test-gl* if 320.0 else 0.0 then ) 1281 #( <'> spectro-y-scale 1.0 ) 1282 #( <'> spectro-z-angle *with-test-gl* if 0.0 else 358.0 then ) 1283 #( <'> spectro-z-scale *with-test-gl* if 1.0 else 0.1 then ) 1284 #( <'> sync-style sync-by-sound ) 1285 #( <'> temp-dir "" ) 1286 #( <'> time-graph-type graph-once ) 1287 #( <'> tiny-font tiny-font-string ) 1288 #( <'> tracking-cursor-style cursor-line ) 1289 #( <'> transform-graph-type graph-once ) 1290 #( <'> transform-normalization normalize-by-channel ) 1291 #( <'> transform-size 512 ) 1292 #( <'> transform-type fourier-transform ) 1293 #( <'> wavelet-type 0 ) 1294 #( <'> wavo-hop 3 ) 1295 #( <'> wavo-trace 64 ) 1296 #( <'> with-mix-tags #t ) 1297 #( <'> with-relative-panes #t ) 1298 #( <'> with-tracking-cursor #f ) 1299 #( <'> with-verbose-cursor #f ) 1300 #( <'> with-inset-graph #f ) 1301 #( <'> with-interrupts #t ) 1302 #( <'> with-smpte-label #f ) 1303 #( <'> with-toolbar #f ) 1304 #( <'> with-tooltips #t ) 1305 #( <'> with-menu-icons #f ) 1306 #( <'> with-pointer-focus #f ) 1307 #( <'> x-axis-style 0 ) 1308 #( <'> zero-pad 0 ) 1309 #( <'> zoom-focus-style 2 ) ) { procs } 1310 nil nil nil nil { vals sym req res } 1311 procs each to vals 1312 vals 0 array-ref to sym 1313 vals 1 array-ref to req 1314 sym execute ( res ) req "%s" #( sym ) snd-test-neq 1315 end-each 1316 old-dir set-temp-dir drop 1317 \ without-errors 1318 #( <'> amp-control 1319 <'> contrast-control 1320 <'> contrast-control? 1321 <'> expand-control 1322 <'> expand-control? 1323 <'> filter-control-coeffs 1324 <'> filter-control-envelope 1325 <'> filter-control? 1326 <'> lisp-graph? 1327 <'> read-only 1328 <'> reverb-control-length 1329 <'> reverb-control-scale 1330 <'> reverb-control? 1331 <'> speed-control 1332 <'> sync 1333 <'> time-graph? 1334 <'> transform-graph? ) to procs 1335 'no-such-sound to req 1336 procs each to sym 1337 sym snd-test-catch car 'no-such-sound "%s" #( sym ) snd-test-neq 1338 end-each 1339 \ 1 array-ref 1340 #( #( <'> amp-control-bounds 8.0 ) 1341 #( <'> contrast-control-bounds 10.0 ) 1342 #( <'> expand-control-bounds 20.0 ) 1343 #( <'> reverb-control-length-bounds 5.0 ) 1344 #( <'> reverb-control-scale-bounds 4.0 ) 1345 #( <'> speed-control-bounds 20.0 ) ) to procs 1346 procs each to vals 1347 vals 0 array-ref to sym 1348 vals 1 array-ref to req 1349 sym execute 1 array-ref ( res ) req "%s" #( sym ) snd-test-neq 1350 end-each 1351 \ 1352 *snd-opened-sound* if 1353 "*snd-opened-sound*: %S" #( *snd-opened-sound* ) snd-display 1354 then 1355 #f set-ask-about-unsaved-edits drop 1356 #f set-remember-sound-state drop 1357; 1358 1359\ ---------------- test 02: headers ---------------- 1360 1361: test-header-check { res req lno name info -- } 1362 res req "%s: %s" #( name info ) lno (snd-test-neq) 1363; 1364 1365: (test-headers-with-loop) ( name chns sr dur typ frm loop-s loop-e lno -- ) 1366 { name chns sr dur typ frm loop-start loop-end lno -- } 1367 name check-file-name { file } 1368 file file-exists? if 1369 file mus-sound-chans { fchns } 1370 file mus-sound-srate { fsr } 1371 file mus-sound-duration { fdur } 1372 file mus-sound-sample-type { ffrm } 1373 file mus-sound-header-type { ftyp } 1374 file mus-sound-framples { fframples } 1375 file mus-sound-samples { fsamps } 1376 file mus-sound-length { flen } 1377 fchns chns lno name "chans" test-header-check 1378 fsr sr lno name "srate" test-header-check 1379 fdur dur lno name "duration" test-header-check 1380 file mus-sound-datum-size fdur f* fsr f* fchns f* floor f>s { fsize } 1381 ffrm mus-unknown-sample <> 1382 ftyp 27 <> && if 1383 flen 1+ fsize < if 1384 flen 1+ fsize lno name "length" test-header-check 1385 then 1386 then 1387 fframples fsr f/ fdur lno name "framples" test-header-check 1388 fframples fsamps fchns f/ f- floor fabs f>s { res } 1389 res 1 > if 1390 res 1 lno name "samples" test-header-check 1391 then 1392 ftyp mus-header-type-name typ lno name "type" test-header-check 1393 ffrm mus-sample-type-name frm lno name "format" test-header-check 1394 file mus-sound-loop-info { lst } 1395 loop-start if 1396 lst nil? if 1397 "[%d] %s loop info empty?" #( lno name ) snd-test-message 1398 else 1399 lst car loop-start lno name "loop-start" test-header-check 1400 lst cadr loop-end lno name "loop-end" test-header-check 1401 then 1402 else 1403 lst empty? unless 1404 "[%d] %s thinks it has loop info: %s?" 1405 #( lno name lst ) snd-test-message 1406 then 1407 then 1408 else \ not file-exists? 1409 *fth-debug* if 1410 "[%d] %s missing?" #( lno file ) snd-test-message 1411 then 1412 then \ file-exists? 1413; 1414 1415: test-headers-with-loop ( name chns sr dur typ frm loop-start loop-end -- ) 1416 postpone *lineno* 1417 postpone (test-headers-with-loop) 1418; immediate 1419 1420: test-headers ( name chns sr dur typ frm -- ) 1421 postpone #f 1422 postpone #f 1423 postpone *lineno* 1424 postpone (test-headers-with-loop) 1425; immediate 1426 1427: 02-headers ( -- ) 1428 "5_secs.aiff" 1 44100 5.303107 "AIFF" "big endian short (16 bits)" 1429 test-headers 1430 "8svx-8.snd" 1 22050 1.88766443729401 "SVX8" "signed byte (8 bits)" 1431 test-headers 1432 "Fnonull.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers 1433 "Pmiscck.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers 1434 "Pmiscck.wav" 1 8000 0.00112499995157123 "RIFF" "mulaw (8 bits)" test-headers 1435 "Poffset.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers 1436 "Porder.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers 1437 "Ptjunk.aif" 1 8000 0.00112499995157123 "AIFC" "mulaw (8 bits)" test-headers 1438 "Ptjunk.wav" 1 8000 0.00112499995157123 "RIFF" "mulaw (8 bits)" test-headers 1439 "SINE24-S.WAV" 2 44100 2.0 "RIFF" "little endian int (24 bits)" test-headers 1440 "a1.asf" 1 16000 3.736562 "asf" "unknown" test-headers 1441 "a2.asf" 1 8000 4.630625 "asf" "unknown" test-headers 1442 "addf8.afsp" 1 8000 2.9760000705719 "Sun/Next" "big endian short (16 bits)" 1443 test-headers 1444 "addf8.d" 1 8000 2.9760000705719 "SPPACK" "big endian short (16 bits)" 1445 test-headers 1446 "addf8.dwd" 1 8000 2.976000071 "DiamondWare" "little endian short (16 bits)" 1447 test-headers 1448 "addf8.nh" 2 44100 0.269931972 "raw (no header)" "big endian short (16 bits)" 1449 test-headers 1450 "addf8.sd" 1 8000 2.9760000705719 "ESPS" "big endian short (16 bits)" 1451 test-headers 1452 "addf8.sf_mipseb" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)" 1453 test-headers 1454 "addf8.sf_sun" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)" 1455 test-headers 1456 "addf8.sf_vax_b" 1 8000 2.9760000705719 "IRCAM" "big endian short (16 bits)" 1457 test-headers 1458 "addf8.wav" 1 8000 2.9760000705719 "RIFF" "little endian short (16 bits)" 1459 test-headers 1460 "aebass.krz" 1 44100 3.0 "Kurzweil 2000" "big endian short (16 bits)" 1461 test-headers 1462 "aiff-16.snd" 2 44100 0.746666669845581 "AIFF" "big endian short (16 bits)" 1463 test-headers 1464 "aiff-8.snd" 2 44100 0.746666669845581 "AIFF" "signed byte (8 bits)" 1465 test-headers 1466 "alaw.aifc" 1 44100 0.0367800444364548 "AIFC" "alaw (8 bits)" 1467 test-headers 1468 "alaw.wav" 1 11025 8.70666694641113 "RIFF" "alaw (8 bits)" 1469 test-headers 1470 "astor_basia.mp2" 2 44100 1.022 "raw (no header)" "big endian short (16 bits)" 1471 test-headers 1472 "c.asf" 1 8000 21.368126 "asf" "unknown" test-headers 1473 "ce-c3.w02" 1 33000 3.88848495483398 "TX-16W" "unknown" test-headers 1474 "ce-c4.w03" 1 33000 2.91618180274963 "TX-16W" "unknown" test-headers 1475 "ce-d2.w01" 1 33000 3.46439385414124 "TX-16W" "unknown" test-headers 1476 "clbonef.wav" 1 22050 2.57832193374634 "RIFF" "little endian float (32 bits)" 1477 test-headers 1478 "cranker.krz" 1 44100 3.48267579 "Kurzweil 2000" "big endian short (16 bits)" 1479 test-headers 1480 "d40130.aif" 1 10000 0.100000001490116 "AIFF" "big endian short (16 bits)" 1481 test-headers 1482 "d40130.au" 1 10000 0.100000001490116 "Sun/Next" "big endian short (16 bits)" 1483 test-headers 1484 "d40130.dsf" 1 8000 0.125 "Delusion" "little endian short (16 bits)" 1485 test-headers 1486 "d40130.fsm" 1 8000 0.12524999678 "Farandole" "little endian short (16 bits)" 1487 test-headers 1488 "d40130.iff" 1 10000 0.100000001490116 "SVX8" "signed byte (8 bits)" 1489 test-headers 1490 "d40130.pat" 1 10000 0.100000001490116 1491 "Gravis Ultrasound patch" "little endian short (16 bits)" test-headers 1492 "d40130.sds" 1 10000 0.100000001490116 "MIDI sample dump" "unknown" 1493 test-headers 1494 "d40130.sdx" 1 10000 0.100000001490116 1495 "Sample dump" "unsigned little endian short (16 bits)" test-headers 1496 "d40130.sf" 1 10000 0.100000001490116 1497 "IRCAM" "little endian short (16 bits)" test-headers 1498 "d40130.smp" 1 8000 0.125 "SMP" "little endian short (16 bits)" 1499 test-headers 1500 "d40130.sou" 1 8000 0.125 "SBStudioII" "little endian short (16 bits)" 1501 test-headers 1502 "d40130.st3" 1 8000 0.125 1503 "Digiplayer ST3" "unsigned little endian short (16 bits)" test-headers 1504 "d40130.uwf" 1 8000 0.1252499 1505 "Ultratracker" "little endian short (16 bits)" test-headers 1506 "d40130.voc" 1 10000 0.100100003182888 "VOC" "unsigned byte (8 bits)" 1507 test-headers 1508 "d40130.w00" 1 16000 0.0625 "TX-16W" "unknown" test-headers 1509 "d40130.wav" 1 10000 0.100000001490116 "RIFF" "little endian short (16 bits)" 1510 test-headers 1511 "d43.wav" 1 10000 0.100000001490116 "RIFF" "little endian short (16 bits)" 1512 test-headers 1513 "digit0v0.aiff" 1 8000 0.560000002384186 "AIFC" "big endian short (16 bits)" 1514 test-headers 1515 "esps-16.snd" 1 8000 3.09737491607666 "ESPS" "big endian short (16 bits)" 1516 test-headers 1517 "forest.aiff" 2 44100 3.907143 1518 "AIFF" "big endian short (16 bits)" 24981 144332 test-headers-with-loop 1519 "g721.au" 1 11025 4.35328817367554 "Sun/Next" "unknown" test-headers 1520 "g722.aifc" 1 44100 0.0184353739023209 "AIFC" "unknown" test-headers 1521 "gong.wve" 1 8000 3.96799993515015 "PSION" "alaw (8 bits)" test-headers 1522 "gsm610.wav" 1 11025 1.7687075138092 "RIFF" "unknown" test-headers 1523 "inrs-16.snd" 1 8000 2.46399998664856 "INRS" "little endian short (16 bits)" 1524 test-headers 1525 "kirk.wve" 1 8000 1.40799999237061 "PSION" "alaw (8 bits)" test-headers 1526 "loop.aiff" 1 44100 0.0367120169103146 1527 "AIFC" "big endian short (16 bits)" 12 23 test-headers-with-loop 1528 "m.asf" 1 8000 64.964622 "asf" "unknown" test-headers 1529 "mary-sun4.sig" 1 8000 4.47612476348877 "Comdisco SPW signal" 1530 "big endian double (64 bits)" test-headers 1531 "mocksong.wav" 1 11025 7.869569301605 "RIFF" "little endian short (16 bits)" 1532 test-headers 1533 "mono24.wav" 1 22050 1.98997735977173 "RIFF" "little endian int (24 bits)" 1534 test-headers 1535 "msadpcm.wav" 1 11025 4.43501138687134 "RIFF" "unknown" test-headers 1536 "n8.snd" 1 44100 0.0367800444364548 "Sun/Next" "signed byte (8 bits)" 1537 test-headers 1538 "nasahal.aif" 1 11025 9.89841270446777 "AIFF" "signed byte (8 bits)" 1539 test-headers 1540 "nasahal.avi" 1 11025 10.432744 "AVI" "little endian short (16 bits)" 1541 test-headers 1542 "nasahal.dig" 1 11025 9.8984 "Sound Designer 1" "big endian short (16 bits)" 1543 test-headers 1544 "nasahal.ivc" 2 44100 0.449 "raw (no header)" "big endian short (16 bits)" 1545 test-headers 1546 "nasahal.pat" 1 11025 3.95410442352295 "Gravis Ultrasound patch" 1547 "unsigned byte (8 bits)" test-headers 1548 "nasahal.snd" 1 11025 9.89841270446777 "SNDT" "unsigned byte (8 bits)" 1549 test-headers 1550 "nasahal.svx" 1 11025 9.89841270446777 "SVX8" "signed byte (8 bits)" 1551 test-headers 1552 "nasahal.v8" 1 8000 13.6412496566772 "Covox V8" "unsigned byte (8 bits)" 1553 test-headers 1554 "nasahal.voc" 1 11025 9.89941024780273 "VOC" "unsigned byte (8 bits)" 1555 test-headers 1556 "nasahal.vox" 2 44100 0.22444 "raw (no header)" "big endian short (16 bits)" 1557 test-headers 1558 "nasahal8.wav" 1 11025 9.89841270446777 "RIFF" "unsigned byte (8 bits)" 1559 test-headers 1560 "nasahalad.smp" 1 11025 4.94920635223389 "Goldwave sample" 1561 "little endian short (16 bits)" test-headers 1562 "next-16.snd" 1 22050 1.00004529953003 "Sun/Next" 1563 "big endian short (16 bits)" test-headers 1564 "next-8.snd" 1 22050 0.226757362484932 "Sun/Next" 1565 "signed byte (8 bits)" test-headers 1566 "next-dbl.snd" 1 22050 0.226757362484932 "Sun/Next" 1567 "big endian double (64 bits)" test-headers 1568 "oboe.ldbl" 1 22050 2.30512475967407 "RIFF" 1569 "little endian double (64 bits)" test-headers 1570 "next-flt.snd" 1 22050 0.226757362484932 "Sun/Next" 1571 "big endian float (32 bits)" test-headers 1572 "aifc-float.snd" 1 22050 0.2267573624849 "AIFC" 1573 "big endian float (32 bits)" test-headers 1574 "next-mulaw.snd" 1 8012 2.03295063972473 "Sun/Next" 1575 "mulaw (8 bits)" test-headers 1576 "next24.snd" 1 44100 0.0367800444364548 "Sun/Next" 1577 "big endian int (24 bits)" test-headers 1578 "nist-01.wav" 1 16000 2.26912498474121 "NIST" 1579 "little endian short (16 bits)" test-headers 1580 "nist-10.wav" 1 16000 2.26912498474121 "NIST" 1581 "big endian short (16 bits)" test-headers 1582 "nist-16.snd" 1 16000 1.02400004863739 "NIST" 1583 "big endian short (16 bits)" test-headers 1584 "nist-shortpack.wav" 1 16000 4.53824996948242 "NIST" "unknown" 1585 test-headers 1586 "none.aifc" 1 44100 0.0367800444364548 "AIFC" "big endian short (16 bits)" 1587 test-headers 1588 "nylon2.wav" 2 22050 1.14376413822174 "RIFF" "unknown" test-headers 1589 "o2.adf" 1 44100 0.036780 "CSRE adf" "little endian short (16 bits)" 1590 test-headers 1591 "o2.avr" 1 44100 0.0183900222182274 "AVR" "big endian short (16 bits)" 1592 test-headers 1593 "o2.bicsf" 1 44100 0.0367800444364548 "IRCAM" "big endian short (16 bits)" 1594 test-headers 1595 "o2.mpeg1" 2 44100 0.0070975 "raw (no header)" "big endian short (16 bits)" 1596 test-headers 1597 "o2.sd2" 2 44100 0.0183900222 "raw (no header)" "big endian short (16 bits)" 1598 test-headers 1599 "o2.sf2" 1 44100 0.036780044436 "SoundFont" "little endian short (16 bits)" 1600 test-headers 1601 "o2.smp" 1 8000 0.202749997377396 "SMP" "little endian short (16 bits)" 1602 test-headers 1603 "o2.voc" 1 44100 0.0368934236466885 "VOC" "little endian short (16 bits)" 1604 test-headers 1605 "o2.wave" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)" 1606 test-headers 1607 "o2_12bit.aiff" 1 44100 0.036780044436 "AIFF" "big endian short (16 bits)" 1608 test-headers 1609 "o2_18bit.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian int (24 bits)" 1610 test-headers 1611 "o2_711u.wave" 1 44100 0.0367800444364548 "RIFF" "mulaw (8 bits)" 1612 test-headers 1613 "o2_722.snd" 1 44100 0.0183900222182274 "Sun/Next" "unknown" test-headers 1614 "o2_726.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers 1615 "o2_726.snd" 1 44100 0.0230158735066652 "Sun/Next" "unknown" test-headers 1616 "o2_728.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers 1617 "o2_8.iff" 1 44100 0.0367800444364548 "SVX8" "signed byte (8 bits)" 1618 test-headers 1619 "o2_8.voc" 1 44100 0.0370294786989689 "VOC" "unsigned byte (8 bits)" 1620 test-headers 1621 "o2_dvi.wave" 1 44100 0.0232199542224407 "RIFF" "unknown" test-headers 1622 "o2_float.bicsf" 1 44100 0.0367800444 "IRCAM" "big endian float (32 bits)" 1623 test-headers 1624 "o2_gsm.aiff" 1 8000 0.0367499999701977 "AIFC" "unknown" test-headers 1625 "o2_u8.avr" 1 44100 0.0367800444364548 "AVR" "unsigned byte (8 bits)" 1626 test-headers 1627 "o2_u8.wave" 1 44100 0.0367800444364548 "RIFF" "unsigned byte (8 bits)" 1628 test-headers 1629 "o28.mpc" 1 44100 0.036780 "AKAI 4" "little endian short (16 bits)" 1630 test-headers 1631 "oboe.g721" 1 22050 1.15287983417511 "Sun/Next" "unknown" test-headers 1632 "oboe.g723_24" 1 22050 0.864761888980865 "Sun/Next" "unknown" test-headers 1633 "oboe.g723_40" 1 22050 1.44126987457275 "Sun/Next" "unknown" test-headers 1634 "oboe.kts" 1 22050 2.305125 "Korg" "big endian short (16 bits)" test-headers 1635 "oboe.its" 1 22050 2.305125 "Impulse Tracker" "little endian short (16 bits)" 1636 test-headers 1637 "oboe.sf2" 1 22050 2.305124759674 "SoundFont" "little endian short (16 bits)" 1638 test-headers 1639 "oboe.paf" 1 22050 2.305125 "Ensoniq Paris" "big endian short (16 bits)" 1640 test-headers 1641 "oboe.pf1" 1 22050 2.305125 "Ensoniq Paris" "little endian short (16 bits)" 1642 test-headers 1643 "oboe.smp" 1 22050 2.305125 "snack SMP" "little endian short (16 bits)" 1644 test-headers 1645 "oboe.rf64" 1 22050 2.305125 "rf64" "little endian short (16 bits)" 1646 test-headers 1647 "oboe-be32.caf" 1 22050 2.305125 "caff" "normalized big endian int (32 bits)" 1648 test-headers 1649 "oboe-bf64.caf" 1 22050 2.305125 "caff" "big endian double (64 bits)" 1650 test-headers 1651 "oboe-lf32.caf" 1 22050 2.305125 "caff" "little endian float (32 bits)" 1652 test-headers 1653 "oboe-ulaw.caf" 1 22050 2.305125 "caff" "mulaw (8 bits)" test-headers 1654 "oboe.nsp" 1 22050 2.305125 "CSL" "little endian short (16 bits)" 1655 test-headers 1656 "oboe-ulaw.voc" 1 22050 2.305669 "VOC" "mulaw (8 bits)" test-headers 1657 "oboe-lf32.sf" 1 22050 2.305669 "IRCAM" "little endian float (32 bits)" 1658 test-headers 1659 "oboe.wfp" 1 22050 2.305125 "Turtle Beach" "little endian short (16 bits)" 1660 test-headers 1661 "oboe.sox" 1 22050 2.305125 "Sox" "normalized little endian int (32 bits)" 1662 test-headers 1663 "oki.snd" 2 44100 0.004195011 "raw (no header)" "big endian short (16 bits)" 1664 test-headers 1665 "oki.wav" 1 44100 0.016780 "RIFF" "unknown" test-headers 1666 "orv-dvi-adpcm.wav" 1 44100 1.92725622653961 "RIFF" "unknown" test-headers 1667 "riff-16.snd" 1 22050 1.88766443729401 "RIFF" "little endian short (16 bits)" 1668 test-headers 1669 "riff-8-u.snd" 1 11025 0.506848096847534 "RIFF" "unsigned byte (8 bits)" 1670 test-headers 1671 "rooster.wve" 1 8000 2.04800009727478 "PSION" "alaw (8 bits)" test-headers 1672 "sd1-16.snd" 1 44100 0.40054 "Sound Designer 1" "big endian short (16 bits)" 1673 test-headers 1674 "sf-16.snd" 1 22050 1.88766443729401 "IRCAM" "big endian short (16 bits)" 1675 test-headers 1676 "si654.adc" 1 16000 6.71362495422363 "ADC/OGI" "big endian short (16 bits)" 1677 test-headers 1678 "smp-16.snd" 1 8000 5.2028751373291 "SMP" "little endian short (16 bits)" 1679 test-headers 1680 "sound.pat" 1 8000 1.95050001144409 "Gravis Ultrasound patch" 1681 "unsigned little endian short (16 bits)" test-headers 1682 "sound.sap" 1 8000 1.95050001144409 "Goldwave sample" 1683 "little endian short (16 bits)" test-headers 1684 "sound.sds" 1 8000 1.95050001144409 "MIDI sample dump" "unknown" test-headers 1685 "sound.sfr" 1 8000 1.95050001144409 "SRFS" "little endian short (16 bits)" 1686 test-headers 1687 "sound.v8" 1 8000 1.95050001144409 "Covox V8" "unsigned byte (8 bits)" 1688 test-headers 1689 "sound.vox" 2 44100 0.0442177 "raw (no header)" "big endian short (16 bits)" 1690 test-headers 1691 "step.omf" 1 11025 8.70666694641113 "OMF" "signed byte (8 bits)" test-headers 1692 "step.qt" 1 11025 8.70630359649658 "Quicktime" "unsigned byte (8 bits)" 1693 test-headers 1694 "sun-16-afsp.snd" 1 8000 2.9760000705719 "Sun/Next" 1695 "big endian short (16 bits)" test-headers 1696 "sun-mulaw.snd" 1 8000 4.61950016021729 "Sun/Next" "mulaw (8 bits)" 1697 test-headers 1698 "sw1038t_short.wav" 2 8000 6.0 "NIST" "mulaw (8 bits)" test-headers 1699 "swirl.pat" 1 22050 1.0619500875473 "Gravis Ultrasound patch" 1700 "unsigned little endian short (16 bits)" test-headers 1701 "sy85.snd" 1 8000 5.05600023269653 "Sy-85" "big endian short (16 bits)" 1702 test-headers 1703 "sy99.snd" 1 8000 4.54400014877319 "Sy-99" "big endian short (16 bits)" 1704 test-headers 1705 "telephone.wav" 1 16000 2.2788124084 "NIST" "little endian short (16 bits)" 1706 test-headers 1707 "trumps22.adp" 1 22050 3.092880 "RIFF" "unknown" test-headers 1708 "truspech.wav" 1 8000 1.1599999666214 "RIFF" "unknown" test-headers 1709 "ulaw.aifc" 1 44100 0.0367800444364548 "AIFC" "mulaw (8 bits)" test-headers 1710 "voc-8-u.snd" 1 8000 1.49937498569489 "VOC" "unsigned byte (8 bits)" 1711 test-headers 1712 "o28.voc" 1 44100 0.036893 "VOC" "little endian short (16 bits)" test-headers 1713 "voxware.wav" 1 8000 0.324000000953674 "RIFF" "unknown" test-headers 1714 "wd.w00" 1 8000 0.202749997377396 "Sy-99" "big endian short (16 bits)" 1715 test-headers 1716 "wd1.smp" 1 8000 0.202749997377396 "SMP" "little endian short (16 bits)" 1717 test-headers 1718 "wd1.wav" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)" 1719 test-headers 1720 "wheel.mat" 2 44100 0.14564626 "raw (no header)" "big endian short (16 bits)" 1721 test-headers 1722 "b8.pvf" 1 44100 0.036803 "Portable Voice Format" "signed byte (8 bits)" 1723 test-headers 1724 "b16.pvf" 1 44100 0.0368 "Portable Voice Format" "big endian short (16 bits)" 1725 test-headers 1726 "b32.pvf" 1 44100 0.036803 "Portable Voice Format" "big endian int (32 bits)" 1727 test-headers 1728 "water.voc" 2 32000 42.3463897705078 "VOC" "little endian short (16 bits)" 1729 test-headers 1730 "wood.dsf" 1 8000 0.202749997377 "Delusion" "little endian short (16 bits)" 1731 test-headers 1732 "wood.dvi" 1 22100 0.0278733037412167 "RIFF" "unknown" test-headers 1733 "wood.dwd" 1 22100 0.0733936652541161 "DiamondWare" "signed byte (8 bits)" 1734 test-headers 1735 "wood.fsm" 1 8000 0.2029999942 "Farandole" "little endian short (16 bits)" 1736 test-headers 1737 "wood.mad" 1 22100 0.0372398197650909 "RIFF" "unknown" test-headers 1738 "wood.maud" 1 44100 0.0183900222182274 "MAUD" "big endian short (16 bits)" 1739 test-headers 1740 "wood.pat" 1 22100 0.0733936652541161 "Gravis Ultrasound patch" 1741 "little endian short (16 bits)" test-headers 1742 "wood.riff" 1 44100 0.0367800444364548 "RIFF" "little endian short (16 bits)" 1743 test-headers 1744 "wood.rifx" 1 44100 0.0367800444364548 "RIFF" "big endian short (16 bits)" 1745 test-headers 1746 "wood.sds" 1 22100 0.0733936652541161 "MIDI sample dump" "unknown" 1747 test-headers 1748 "wood.sdx" 1 22100 0.0733936652541161 "Sample dump" 1749 "unsigned little endian short (16 bits)" test-headers 1750 "wood.sf" 1 44100 0.0367800444364548 "IRCAM" "big endian short (16 bits)" 1751 test-headers 1752 "wood.sndr" 2 44100 0.009229 "raw (no header)" "big endian short (16 bits)" 1753 test-headers 1754 "wood.sndt" 1 44100 0.0367800444364548 "SNDT" "unsigned byte (8 bits)" 1755 test-headers 1756 "wood.st3" 1 8000 0.202749997377396 "Digiplayer ST3" 1757 "unsigned little endian short (16 bits)" test-headers 1758 "wood.uwf" 1 8000 0.202999994 "Ultratracker" "little endian short (16 bits)" 1759 test-headers 1760 "wood.w00" 1 16000 0.101374998688698 "TX-16W" "unknown" test-headers 1761 "wood12.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian short (16 bits)" 1762 test-headers 1763 "wood16.dwd" 2 44100 0.03678004 "DiamondWare" "little endian short (16 bits)" 1764 test-headers 1765 "wood16.wav" 2 44100 0.03678004 "RIFF" "little endian short (16 bits)" 1766 test-headers 1767 "wood16.nsp" 2 44100 0.03678004 "CSL" "little endian short (16 bits)" 1768 test-headers 1769 "wood16.smp" 2 44100 0.03678004 "snack SMP" "little endian short (16 bits)" 1770 test-headers 1771 "wood24.aiff" 1 44100 0.0367800444364548 "AIFF" "big endian int (24 bits)" 1772 test-headers 1773 "woodblock.aiff" 1 44100 0.03678 "AIFF" "big endian short (16 bits)" 1774 test-headers 1775 "woodflt.snd" 1 44100 0.0367800444364548 "Sun/Next" 1776 "big endian float (32 bits)" test-headers 1777 "RealDrums.sf2" 1 44100 6.397256 "SoundFont" "little endian short (16 bits)" 1778 test-headers 1779 "32bit.sf" 1 44100 4.6 "IRCAM" "little endian float (32 bits, unscaled)" 1780 test-headers 1781 "PCM_48_8bit_m.w64" 1 48000 0.375 "SoundForge" "unsigned byte (8 bits)" 1782 test-headers 1783 "oboe.sf6" 1 22050 2.305125 "SoundForge" "little endian short (16 bits)" 1784 test-headers 1785 "addf8.24we" 1 8000 2.976000 "RIFF" "little endian int (24 bits)" 1786 test-headers 1787 "hybrid.snd" 1 44100 4.600000 "BICSF" "big endian float (32 bits)" 1788 test-headers 1789 "litmanna.sf" 1 44100 0.533 "IRCAM" "little endian short (16 bits)" 1790 test-headers 1791 "M1F1-float64C-AFsp.aif" 2 8000 2.9366 "AIFC" "big endian double (64 bits)" 1792 test-headers 1793 "MacBoing.wav" 1 11127 0.696 "RIFF" "unsigned byte (8 bits)" test-headers 1794 "t15.aiff" 2 44100 135.00 "AIFC" "little endian short (16 bits)" test-headers 1795 "tomf8.aud" 1 8000 2.016000 "INRS" "little endian short (16 bits)" 1796 test-headers 1797 "Xhs001x.nsp" 1 10000 6.017400 "CSL" "little endian short (16 bits)" 1798 test-headers 1799 "zulu_a4.w11" 1 33000 1.21987879276276 "TX-16W" "unknown" 23342 40042 1800 test-headers-with-loop 1801; 1802 1803\ ---------------- test 03: variables ---------------- 1804 1805: y>0.1-cb <{ y -- f }> y 0.1 f> ; 1806: y<0.0-cb <{ y -- f }> y f0< ; 1807 1808'( 0 0.0 50 0.5 100 1.0 ) value zero-to-one 1809'( 0 1.0 50 0.5 100 0.0 ) value mod-down 1810 1811: rm-ladspa <{ sym reg -- f }> reg sym symbol-name regexp= ; 1812 1813: 03-variables ( -- ) 1814 "oboe.snd" open-sound { ind } 1815 *home* "/test" $+ { test-dir } 1816 test-dir file-exists? if 1817 temp-dir { old-val } 1818 test-dir set-temp-dir test-dir "set-temp-dir" #() snd-test-neq 1819 old-val set-temp-dir drop 1820 then 1821 1000 sample 0.0328 "sample 1000" #() snd-test-neq 1822 \ 1823 #( output-comment-hook 1824 help-hook 1825 mark-drag-hook 1826 mix-drag-hook 1827 mouse-drag-hook 1828 mouse-click-hook 1829 mouse-press-hook 1830 start-playing-hook 1831 start-playing-selection-hook 1832 stop-playing-hook 1833 key-press-hook 1834 snd-error-hook 1835 snd-warning-hook 1836 name-click-hook 1837 after-apply-controls-hook 1838 enved-hook 1839 *with-test-motif* if 1840 mouse-enter-label-hook 1841 mouse-enter-graph-hook 1842 mouse-enter-listener-hook 1843 mouse-leave-label-hook 1844 mouse-leave-graph-hook 1845 mouse-leave-listener-hook 1846 then 1847 initial-graph-hook 1848 after-graph-hook 1849 graph-hook ) each { h } 1850 h hook? not 1851 h empty? not || if 1852 "%d: %s?" #( i h ) snd-display 1853 then 1854 end-each 1855 \ 1856 *with-test-gui* if 1857 show-controls { old-ctrl } 1858 #t set-show-controls drop 1859 enved-dialog { req } 1860 dialog-widgets 1 array-ref req "enved-dialog" #() snd-test-neq 1861 '( 0.0 0.0 1.0 1.0 2.0 0.0 ) to req 1862 req set-enved-envelope drop 1863 enved-envelope req "set-enved-envelope" #() snd-test-neq 1864 enved-envelope set-enved-envelope drop 1865 enved-envelope req "set-enved-envelope to self" #() snd-test-neq 1866 old-ctrl set-show-controls drop 1867 then 1868 \ 1869 #( #( <'> color-cutoff 0.003 0.01 ) 1870 #( <'> color-inverted #t #f ) 1871 #( <'> color-scale 1.0 0.5 ) 1872 #( <'> contrast-control? #f #t ) 1873 #( <'> enved-base 1.0 1.5 ) 1874 #( <'> enved-in-dB #f #t ) 1875 #( <'> enved-target 0 1 ) 1876 #( <'> enved-wave? #f #t ) 1877 #( <'> expand-control? #f #t ) 1878 #( <'> fft-log-frequency #f #t ) 1879 #( <'> fft-log-magnitude #f #t ) 1880 #( <'> fft-with-phases #f #t ) 1881 #( <'> enved-filter-order 40 20 ) 1882 #( <'> filter-control? #f #t ) 1883 #( <'> transform-normalization normalize-by-channel dont-normalize ) 1884 #( <'> reverb-control? #f #t ) 1885 #( <'> show-transform-peaks #f #t ) 1886 #( <'> show-selection-transform #f #t ) 1887 #( <'> spectrum-end 1.0 0.7 ) 1888 #( <'> spectro-hop 4 10 ) 1889 #( <'> spectrum-start 0.0 0.1 ) 1890 #( <'> spectro-x-angle *with-test-gl* if 300.0 else 90.0 then 60.0 ) 1891 #( <'> spectro-x-scale *with-test-gl* if 1.5 else 1.0 then 2.0 ) 1892 #( <'> spectro-y-angle *with-test-gl* if 320.0 else 0.0 then 60.0 ) 1893 #( <'> spectro-y-scale 1.0 2.0 ) 1894 #( <'> spectro-z-angle *with-test-gl* if 0.0 else 358.0 then 60.0 ) 1895 #( <'> spectro-z-scale *with-test-gl* if 1.0 else 0.1 then 0.2 ) 1896 ) { gui-lst } 1897 #( #( <'> amp-control 1.0 0.5 ) 1898 #( <'> amp-control-bounds '( 0.0 8.0 ) '( 1.0 5.0 ) ) 1899 #( <'> ask-about-unsaved-edits #f #t ) 1900 #( <'> ask-before-overwrite #f #t ) 1901 #( <'> auto-resize #t #f ) 1902 #( <'> auto-update #f #t ) 1903 #( <'> channel-style 0 1 ) 1904 #( <'> colormap *good-colormap* *better-colormap* ) 1905 #( <'> contrast-control 0.0 0.5 ) 1906 #( <'> contrast-control-bounds '( 0.0 10.0 ) '( 1.0 5.0 ) ) 1907 #( <'> contrast-control-amp 1.0 0.5 ) 1908 #( <'> auto-update-interval 60.0 120.0 ) 1909 #( <'> cursor-update-interval 0.05 0.1 ) 1910 #( <'> cursor-location-offset 0 32768 ) 1911 #( <'> with-tracking-cursor #f #t ) 1912 #( <'> cursor-size 15 30 ) 1913 #( <'> cursor-style cursor-cross cursor-line ) 1914 #( <'> tracking-cursor-style cursor-line cursor-cross ) 1915 #( <'> dac-combines-channels #t #f ) 1916 #( <'> dac-size 256 512 ) 1917 #( <'> clipping #f #t ) 1918 #( <'> default-output-chans 1 2 ) 1919 #( <'> default-output-sample-type 1 1 ) 1920 #( <'> default-output-srate 22050 44100 ) 1921 #( <'> default-output-header-type mus-next mus-aifc ) 1922 #( <'> dot-size 1 4 ) 1923 #( <'> enved-clip? #f #t ) 1924 #( <'> enved-style envelope-linear envelope-exponential ) 1925 #( <'> enved-power 3.0 3.5 ) 1926 #( <'> eps-file "snd.eps" "snd-1.eps" ) 1927 #( <'> eps-left-margin 0.0 72.0 ) 1928 #( <'> eps-size 1.0 2.0 ) 1929 #( <'> eps-bottom-margin 0.0 36.0 ) 1930 #( <'> expand-control 1.0 2.0 ) 1931 #( <'> expand-control-bounds '( 0.001 20.0 ) '( 1.0 2.0 ) ) 1932 #( <'> expand-control-hop 0.05 0.1 ) 1933 #( <'> expand-control-jitter 0.1 0.2 ) 1934 #( <'> expand-control-length 0.15 0.2 ) 1935 #( <'> expand-control-ramp 0.4 0.2 ) 1936 #( <'> fft-window-alpha 0.0 1.0 ) 1937 #( <'> fft-window-beta 0.0 0.5 ) 1938 #( <'> transform-size 512 1024 ) 1939 #( <'> transform-graph-type graph-once graph-as-sonogram ) 1940 #( <'> fft-window 6 5 ) 1941 #( <'> transform-graph? #f #t ) 1942 #( <'> filter-control-in-dB #f #t ) 1943 #( <'> filter-control-envelope '( 0.0 1.0 1.0 1.0 ) '( 0.0 1.0 1.0 0.0 ) ) 1944 #( <'> enved-filter #t #f ) 1945 #( <'> filter-control-in-hz #f #t ) 1946 #( <'> filter-control-order 20 40 ) 1947 #( <'> graph-cursor 34 32 ) 1948 #( <'> graph-style 0 1 ) 1949 #( <'> initial-beg 0.0 1.0 ) 1950 #( <'> initial-dur 0.1 1.0 ) 1951 #( <'> just-sounds #f #t ) 1952 #( <'> listener-prompt ">" ":" ) 1953 #( <'> max-transform-peaks 100 10 ) 1954 #( <'> max-regions 16 6 ) 1955 #( <'> min-dB -60.0 -90.0 ) 1956 #( <'> log-freq-start 32.0 10.0 ) 1957 #( <'> mix-waveform-height 20 40 ) 1958 #( <'> mix-tag-height 14 20 ) 1959 #( <'> mix-tag-width 6 20 ) 1960 #( <'> mark-tag-height 4 20 ) 1961 #( <'> mark-tag-width 10 20 ) 1962 #( <'> mus-clipping #f #t ) 1963 #( <'> selection-creates-region #t #f ) 1964 #( <'> play-arrow-size 10 16 ) 1965 #( <'> print-length 12 16 ) 1966 #( <'> region-graph-style graph-lines graph-lollipops ) 1967 #( <'> reverb-control-decay 1.0 2.0 ) 1968 #( <'> reverb-control-feedback 1.09 1.6 ) 1969 #( <'> reverb-control-length 1.0 2.0 ) 1970 #( <'> reverb-control-length-bounds '( 0.0 0.5 ) '( 1.0 2.0 ) ) 1971 #( <'> reverb-control-lowpass 0.7 0.9 ) 1972 #( <'> reverb-control-scale 0.0 0.2 ) 1973 #( <'> reverb-control-scale-bounds '( 0.0 4.0 ) '( 0.0 0.2 ) ) 1974 #( <'> show-axes 1 0 ) 1975 #( <'> show-full-duration #f #t ) 1976 #( <'> show-full-range #f #t ) 1977 #( <'> show-indices #f #t ) 1978 #( <'> show-marks #t #f ) 1979 #( <'> show-mix-waveforms #t #f ) 1980 #( <'> show-y-zero #f #t ) 1981 #( <'> show-grid #f #t ) 1982 #( <'> grid-density 1.0 0.5 ) 1983 #( <'> show-sonogram-cursor #f #t ) 1984 #( <'> sinc-width 10 40 ) 1985 #( <'> speed-control 1.0 0.5 ) 1986 #( <'> speed-control-bounds '( 0.05 20.0 ) '( 1.0 5.0 ) ) 1987 #( <'> speed-control-style 0 1 ) 1988 #( <'> speed-control-tones 12 18 ) 1989 #( <'> sync 0 1 ) 1990 #( <'> sync-style sync-by-sound sync-all ) 1991 #( <'> tiny-font tiny-font-string tiny-font-set-string ) 1992 #( <'> transform-type fourier-transform autocorrelation ) 1993 #( <'> with-verbose-cursor #f #t ) 1994 #( <'> wavelet-type 0 1 ) 1995 #( <'> time-graph? #f #t ) 1996 #( <'> time-graph-type graph-once graph-as-wavogram ) 1997 #( <'> wavo-hop 3 6 ) 1998 #( <'> wavo-trace 64 128 ) 1999 #( <'> with-mix-tags #t #f ) 2000 #( <'> with-relative-panes #t #f ) 2001 #( <'> with-gl *with-test-gl* #f ) 2002 #( <'> x-axis-style 0 1 ) 2003 #( <'> beats-per-minute 30.0 120.0 ) 2004 #( <'> beats-per-measure 1 120 ) 2005 #( <'> zero-pad 0 1 ) 2006 #( <'> zoom-focus-style 2 1 ) ) { lst } 2007 *with-test-gui* if 2008 lst gui-lst array-append to lst 2009 then 2010 nil nil nil nil nil { vals sym initval newval nowval } 2011 lst each to vals 2012 vals 0 array-ref to sym 2013 vals 1 array-ref to initval 2014 vals 2 array-ref to newval 2015 2 0 do 2016 newval sym set-execute drop 2017 sym execute to nowval 2018 nowval newval "set-%s[%d]" #( sym i ) snd-test-neq 2019 initval sym set-execute drop 2020 loop 2021 end-each 2022 \ 2023 #( *with-test-gui* if 2024 #( <'> amp-control 1.0 '( -1.0 123.123 ) ) 2025 then 2026 #( <'> amp-control-bounds '( 0.0 8.0 ) 2027 '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) ) 2028 #( <'> channel-style 0 '( 32 -1 1.0 ) ) 2029 #( <'> colormap *good-colormap* '( 321 -123 ) ) 2030 #( <'> color-cutoff 0.003 '( -1.0 123.123 ) ) 2031 #( <'> color-scale 1.0 '( -32.0 2000.0 ) ) 2032 *with-test-gui* if 2033 #( <'> contrast-control 0.0 '( -123.123 123.123 ) ) 2034 then 2035 #( <'> contrast-control-bounds '( 0.0 10.0 ) 2036 '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) ) 2037 #( <'> cursor-size 15 '( 1.123 -2.5 ) ) 2038 #( <'> dac-size 256 '( -1 0 -123 ) ) 2039 #( <'> dot-size 1 '( 0 -1 -123 ) ) 2040 #( <'> enved-target 0 '( 123 -321 ) ) 2041 #( <'> expand-control 1.0 '( -1.0 0.0 ) ) 2042 #( <'> expand-control-bounds '( 0.001 20.0 ) 2043 '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) ) 2044 #( <'> expand-control-hop 0.05 '( -1.0 ) ) 2045 #( <'> expand-control-length 0.15 '( -1.0 0.0 ) ) 2046 #( <'> expand-control-ramp 0.4 '( -1.0 1.0 123.123 ) ) 2047 #( <'> fft-window-alpha 0.0 '( -1.0 123.123 ) ) 2048 #( <'> fft-window-beta 0.0 '( -1.0 123.123 ) ) 2049 #( <'> transform-size 512 '( -1 0 ) ) 2050 #( <'> zero-pad 0 '( -1 -123 ) ) 2051 #( <'> cursor-style cursor-cross '( -1 ) ) 2052 #( <'> cursor-style cursor-line '( 2 123 ) ) 2053 #( <'> tracking-cursor-style cursor-line '( -1 ) ) 2054 #( <'> tracking-cursor-style cursor-line '( 2 123 ) ) 2055 #( <'> transform-graph-type graph-once '( -1 123 ) ) 2056 #( <'> fft-window 6 '( -1 123 ) ) 2057 #( <'> enved-filter-order 40 '( -1 0 ) ) 2058 #( <'> filter-control-order 20 '( -10 -1 0 ) ) 2059 #( <'> max-transform-peaks 100 '( -1 ) ) 2060 #( <'> max-regions 16 '( -1 -123 ) ) 2061 #( <'> reverb-control-length 1.0 '( -1.0 ) ) 2062 #( <'> show-axes 1 '( -1 123 ) ) 2063 #( <'> sinc-width 10 '( -10 ) ) 2064 #( <'> spectrum-end 1.0 '( -1.0 ) ) 2065 #( <'> spectro-hop 4 '( -10 -1 0 ) ) 2066 #( <'> spectrum-start 0.0 '( -1.0 ) ) 2067 #( <'> speed-control 1.0 '( 0.0 ) ) 2068 #( <'> speed-control-bounds '( 0.05 20.0 ) 2069 '( #f '( 0.0 ) '( 1.0 0.0 ) 2.0 ) ) 2070 #( <'> speed-control-style 0 '( -1 10 ) ) 2071 #( <'> sync-style sync-by-sound '( -1 123 ) ) 2072 #( <'> transform-type fourier-transform 2073 '( -1 integer->transform 123 integer->transform ) ) 2074 #( <'> wavelet-type 0 '( -1 123 ) ) 2075 #( <'> wavo-hop 1 '( 0 -123 ) ) 2076 #( <'> wavo-trace 1 '( 0 -123 ) ) 2077 #( <'> x-axis-style 0 '( -1 123 ) ) 2078 #( <'> zoom-focus-style 2 '( -1 123 ) ) ) to lst 2079 nil { newvals } 2080 lst each to vals 2081 vals 0 array-ref to sym 2082 vals 1 array-ref to initval 2083 vals 2 array-ref to newvals 2084 newvals each to newval 2085 newval sym <'> set-execute snd-test-catch drop 2086 sym execute to nowval 2087 nowval newval "set-%s (bad set)" #( sym ) snd-test-eq 2088 initval sym set-execute drop 2089 end-each 2090 end-each 2091 \ 2092 *with-test-gui* if 2093 sync-none set-sync-style drop 2094 300 set-window-width drop 2095 300 set-window-height drop 2096 window-width 300 "window-width" #() snd-test-neq 2097 window-height 300 "window-height" #() snd-test-neq 2098 color-scale { old-val } 2099 100.0 set-color-scale drop 2100 color-scale 100.0 "color-scale" #() snd-test-neq 2101 old-val set-color-scale drop 2102 then 2103 \ 2104 search-procedure proc? if 2105 "global search procedure: %s?" #( search-procedure ) snd-display 2106 then 2107 <'> y>0.1-cb set-search-procedure drop 2108 search-procedure proc? unless 2109 "set global search procedure: %s?" #( search-procedure ) snd-display 2110 then 2111 search-procedure #( 0.2 ) run-proc unless 2112 "search 0.1 > 0.2?" #() snd-display 2113 then 2114 search-procedure #( 0.02 ) run-proc if 2115 "search 0.1 > 0.02?" #() snd-display 2116 then 2117 <'> y<0.0-cb set-search-procedure drop 2118 search-procedure #( 0.02 ) run-proc if 2119 "search 0.0 < 0.02?" #() snd-display 2120 then 2121 #f set-search-procedure drop 2122 search-procedure proc? if 2123 "global search procedure after reset: %s?" #( search-procedure ) 2124 snd-display 2125 then 2126 <'> y>0.1-cb set-search-procedure drop 2127 search-procedure proc? unless 2128 "set global search procedure: %s?" #( search-procedure ) snd-display 2129 then 2130 #f set-search-procedure drop 2131 \ 2132 *with-test-gui* if 2133 enved-filter-order { old-val } 2134 5 set-enved-filter-order drop 2135 enved-filter-order 6 "set-enved-filter-order 5" #() snd-test-neq 2136 old-val set-enved-filter-order drop 2137 \ XXX: This works with global variables. [ms] 2138 'zero-to-one <'> set-enved-envelope snd-test-catch drop 2139 enved-envelope zero-to-one "set-enved-envelope (symbol)" #() snd-test-neq 2140 "mod-down" <'> set-enved-envelope snd-test-catch drop 2141 enved-envelope mod-down "set-enved-envelope (string)" #() snd-test-neq 2142 then 2143 ind close-sound drop 2144 dismiss-all-dialogs 2145 #() { undefined } 2146 \ XXX: changes from original snd-test.scm list [ms]: 2147 \ 2148 \ removed (Scheme specific): 2149 \ 'add-clm-field (run.c) 2150 \ 'run (macro in run.c) 2151 \ 'file->string (snd-utils.c) 2152 \ 2153 \ removed (Forth specific): 2154 \ 'abort (forth word) 2155 \ 2156 \ added: 2157 \ 'snd-exit (xen.c; in Forth exit is already in use) 2158 #( '*snd-opened-sound* 'add-colormap 'add-mark 2159 'add-player 'add-sound-file-extension 'add-source-file-extension 2160 'add-to-main-menu 'add-to-menu 'add-transform 'after-apply-controls-hook 2161 'after-edit-hook 'after-graph-hook 'after-lisp-graph-hook 'after-open-hook 2162 'after-save-as-hook 'after-save-state-hook 'after-transform-hook 2163 'all-pass 'all-pass? 'amp-control 'amp-control-bounds 'amplitude-modulate 2164 'analyse-ladspa 'apply-controls 'apply-ladspa 'array->file 'array-interp 2165 'as-one-edit 'ask-about-unsaved-edits 'ask-before-overwrite 2166 'asymmetric-fm 'asymmetric-fm? 2167 'auto-resize 'auto-update 'auto-update-interval 'autocorrelate 2168 'autocorrelation 'axis-color 2169 'axis-info 'axis-label-font 'axis-numbers-font 'bad-header-hook 2170 'bartlett-window 'bartlett-hann-window 'basic-color 'beats-per-measure 2171 'beats-per-minute 'before-close-hook 'before-exit-hook 2172 'before-save-as-hook 'before-save-state-hook 'before-transform-hook 2173 'bind-key 'blackman2-window 'blackman3-window 'blackman4-window 2174 'blackman5-window 'blackman6-window 'blackman7-window 'blackman8-window 2175 'blackman9-window 'blackman10-window 'bohman-window 'bold-peaks-font 2176 'cauchy-window 'mlt-sine-window 'cepstrum 'change-samples-with-origin 2177 'channel->vct 'channel-amp-envs 'channel-data 'channel-properties 2178 'channel-property 'channel-style 'channel-widgets 'channels 2179 'channels-combined 'channels-separate 'channels-superimposed 2180 'chans 'clear-listener 'clip-hook 2181 'clipping 'clm-channel 'clm-table-size 2182 'close-hook 'close-sound 'color->list 2183 'color-cutoff 'color-orientation-dialog 'color-hook 'color-inverted 2184 'color-scale 'color? 'colormap 'colormap-name 'colormap-ref 2185 'colormap-size 'colormap? 'comb 'comb? 'combined-data-color 2186 'comment 'connes-window 'continue-frample->file 'continue-sample->file 2187 'contrast-control 'contrast-control-amp 'contrast-control-bounds 2188 'contrast-control? 'contrast-enhancement 'controls->channel 2189 'convolution 'convolve 'convolve-files 'convolve-selection-with 2190 'convolve-with 'convolve? 'copy-context 'copy-sampler 2191 'current-edit-position 'current-font 'cursor 'cursor-color 2192 'cursor-context 'cursor-cross 'cursor-in-middle 'cursor-in-view 2193 'cursor-line 'cursor-location-offset 'cursor-on-left 'cursor-on-right 2194 'cursor-position 'cursor-size 'cursor-style 'cursor-update-interval 2195 'dac-combines-channels 'dac-size 'data-color 'sample-type 2196 'data-location 'data-size 'db->linear 'default-output-chans 2197 'default-output-sample-type 'default-output-header-type 2198 'default-output-srate 'define-envelope 'degrees->radians 'delay 2199 'delay-tick 'delay? 'delete-colormap 2200 'delete-mark 'delete-marks 'delete-sample 2201 'delete-samples 'delete-samples-and-smooth 'delete-selection 2202 'delete-selection-and-smooth 'delete-transform 'dialog-widgets 2203 'disk-kspace 'display-edits 'dolph-chebyshev-window 'dont-normalize 2204 'dot-product 'dot-size 'draw-axes 'draw-dot 'draw-dots 'draw-line 2205 'draw-lines 'draw-mark-hook 'draw-mix-hook 'draw-string 'drop-hook 2206 'during-open-hook 'edit-fragment 'edit-header-dialog 'edit-hook 2207 'edit-list->function 'edit-position 'edit-tree 'edits 'edot-product 2208 'env 'env-channel 'env-channel-with-base 'env-interp 'env-selection 2209 'env-sound 'env? 'enved-add-point 'enved-amplitude 'enved-base 2210 'enved-clip? 'enved-delete-point 'enved-dialog 'enved-envelope 2211 'enved-filter 'enved-filter-order 'enved-hook 'enved-in-dB 2212 'enved-move-point 'enved-power 'enved-spectrum 'enved-srate 2213 'enved-style 'enved-target 'enved-wave? 'enved-waveform-color 2214 'envelope-exponential 'envelope-linear 'eps-bottom-margin 'eps-file 2215 'eps-left-margin 'eps-size 'exit 'exit-hook 'expand-control 2216 'expand-control-bounds 'expand-control-hop 'expand-control-jitter 2217 'expand-control-length 'expand-control-ramp 'expand-control? 2218 'exponential-window 'fft 'fft-log-frequency 'fft-log-magnitude 2219 'fft-window 'fft-window-alpha 'fft-window-beta 'fft-with-phases 2220 'file->array 'file->frample 'file->frample? 'file->sample 'file->sample? 2221 'file-name 'file-write-date 'fill-polygon 'fill-rectangle 'filter 2222 'filtered-comb 'filtered-comb? 'filter-channel 'filter-control-coeffs 2223 'filter-control-envelope 'filter-control-in-dB 'filter-control-in-hz 2224 'filter-control-order 'filter-control-waveform-color 'filter-control? 2225 'filter-selection 'filter-sound 'filter? 'find-dialog 2226 'find-mark 'find-sound 'finish-progress-report 'fir-filter 'fir-filter? 2227 'flat-top-window 'focus-widget 'foreground-color 'forget-region 2228 'formant 'formant-bank 'formant-bank? 'formant? 'firmant 'firmant? 2229 'comb-bank 'comb-bank? 'all-pass-bank 'all-pass-bank? 'filtered-comb-bank 2230 'filtered-comb-bank? 'make-comb-bank 'make-all-pass-bank 2231 'make-filtered-comb-bank 'fourier-transform 2232 'frample->file 'frample->file? 'frample->frample 'framples 2233 'free-player 'free-sampler 'gaussian-window 'gc-off 'gc-on 2234 'gl-graph->ps 'glSpectrogram 'goto-listener-end 'granulate 'granulate? 2235 'graph 'graph->ps 'graph-as-sonogram 'graph-as-spectrogram 2236 'graph-as-wavogram 'graph-color 'graph-cursor 'graph-data 'graph-dots 2237 'graph-dots-and-lines 'graph-filled 'graph-hook 'graph-lines 2238 'graph-lollipops 'graph-once 'graph-style 'graphs-horizontal 2239 'grid-density 'haar-transform 'hamming-window 'hann-poisson-window 2240 'hann-window 'header-type 'help-dialog 'help-hook 'hide-widget 2241 'highlight-color 'html-dir 'html-program 'hz->radians 'iir-filter 2242 'iir-filter? 'in 'in-any 'ina 'inb 'info-dialog 2243 'init-ladspa 'initial-graph-hook 'insert-file-dialog 'insert-region 2244 'insert-sample 'insert-samples 'insert-samples-with-origin 2245 'insert-selection 'insert-silence 'insert-sound 'just-sounds 2246 'kaiser-window 'key 'key-binding 'key-press-hook 'keyboard-no-action 2247 'ladspa-activate 'ladspa-cleanup 'ladspa-connect-port 'ladspa-deactivate 2248 'ladspa-descriptor 'ladspa-dir 'peak-env-dir 'ladspa-instantiate 2249 'ladspa-run 'ladspa-run-adding 'ladspa-set-run-adding-gain 'left-sample 2250 'linear->db 'lisp-graph 'lisp-graph-hook 'lisp-graph-style 'lisp-graph? 2251 'list->vct 'list-ladspa 'listener-click-hook 'listener-color 2252 'listener-font 'listener-prompt 'listener-selection 2253 'listener-text-color 'little-endian? 'locsig 'locsig-ref 2254 'locsig-reverb-ref 'locsig-reverb-set! 'locsig-set! 'locsig-type 2255 'locsig? 'log-freq-start 'main-menu 'main-widgets 'make-all-pass 2256 'make-asymmetric-fm 'make-moving-average 'make-moving-max 2257 'make-bezier 'make-color 'make-comb 'make-filtered-comb 'make-convolve 2258 'make-delay 'make-env 'make-fft-window 'make-file->frample 2259 'make-file->sample 'make-filter 'make-fir-coeffs 'make-fir-filter 2260 'make-formant 'make-firmant 'make-formant-bank 2261 'make-frample->file 'make-granulate 'make-graph-data 2262 'make-iir-filter 'make-locsig 'make-mix-sampler 2263 'make-move-sound 'make-notch 'make-one-pole 2264 'make-one-pole-all-pass 'make-one-zero 2265 'make-oscil 'make-phase-vocoder 'make-player 'make-polyshape 2266 'make-polywave 'make-pulse-train 'make-rand 'make-rand-interp 2267 'make-readin 'make-region 'make-region-sampler 'make-sample->file 2268 'make-sampler 'make-sawtooth-wave 'make-nrxysin 2269 'make-nrxycos 'make-rxyk!cos 'make-rxyk!sin 2270 'make-snd->sample 'make-square-wave 2271 'make-src 'make-ssb-am 'make-ncos 'make-nsin 'make-table-lookup 2272 'make-triangle-wave 'make-two-pole 'make-two-zero 2273 'make-variable-graph 'make-vct 'make-wave-train 'map-chan 2274 'map-channel 'mark-click-hook 'mark-color 'mark-context 2275 'mark-drag-hook 'mark-home 'mark-hook 'mark-name 'mark-properties 2276 'mark-property 'mark-sample 'mark-sync 'mark-sync-max 2277 'mark-tag-height 'mark-tag-width 'mark? 'marks 'max-regions 2278 'max-transform-peaks 'maxamp 'maxamp-position 'menu-widgets 2279 'min-dB 'mix 'mix-amp 'mix-amp-env 'mix-click-hook 'mix-color 2280 'mix-dialog-mix 'mix-drag-hook 'mix-file-dialog 'mix-length 2281 'mix-home 'mix-name 'mix-position 'mix-properties 'mix-property 2282 'mix-region 'mix-release-hook 'mix-sync 'mix-sync-max 'mix-sampler? 2283 'mix-selection 'mix-speed 'mix-tag-height 'mix-tag-width 'mix-tag-y 2284 'mix-vct 'mix-waveform-height 'mix? 'mixes 'mouse-click-hook 2285 'mouse-drag-hook 'mouse-enter-graph-hook 'mouse-enter-label-hook 2286 'mouse-enter-listener-hook 'mouse-enter-text-hook 2287 'mouse-leave-graph-hook 'mouse-leave-label-hook 2288 'mouse-leave-listener-hook 'mouse-leave-text-hook 2289 'mouse-press-hook 'move-locsig 'move-sound 'move-sound? 2290 'moving-average 'moving-average? 'moving-max 'moving-max? 2291 'mus-aifc 'mus-aiff 'mus-alaw 'mus-alsa-buffer-size 2292 'mus-alsa-buffers 'mus-alsa-capture-device 'mus-alsa-device 2293 'mus-alsa-playback-device 'mus-alsa-squelch-warning 'mus-apply 2294 'mus-array-print-length 'mus-float-equal-fudge-factor 'mus-b24int 2295 'mus-bdouble 'mus-bdouble-unscaled 'mus-bfloat 'mus-bfloat-unscaled 2296 'mus-bicsf 'mus-bint 'mus-bintn 'mus-bshort 'mus-byte 2297 'mus-bytes-per-sample 'mus-caff 'mus-channel 'mus-channels 2298 'mus-chebyshev-first-kind 'mus-chebyshev-second-kind 2299 'mus-clipping 'mus-close 'mus-data 'mus-sample-type->string 2300 'mus-sample-type-name 'mus-describe 'mus-error-hook 2301 'mus-error-type->string 'mus-expand-filename 'mus-feedback 2302 'mus-feedforward 'mus-fft 'mus-file-buffer-size 'mus-file-clipping 2303 'mus-file-name 'mus-frequency 'mus-generator? 2304 'mus-header-raw-defaults 'mus-header-type->string 2305 'mus-header-type-name 'mus-hop 'mus-increment 'mus-input? 2306 'mus-interp-all-pass 'mus-interp-bezier 'mus-interp-hermite 2307 'mus-interp-lagrange 'mus-interp-linear 'mus-interp-none 2308 'mus-interp-sinusoidal 'mus-interp-type 'mus-interpolate 2309 'mus-ircam 'mus-l24int 'mus-ldouble 'mus-ldouble-unscaled 2310 'mus-length 'mus-lfloat 'mus-lfloat-unscaled 'mus-lint 'mus-lintn 2311 'mus-location 'mus-lshort 'mus-max-malloc 'mus-max-table-size 2312 'mus-mulaw 'mus-name 'mus-next 'mus-nist 'mus-offset 2313 'mus-order 'mus-oss-set-buffers 'mus-out-format 'mus-output? 2314 'mus-phase 'mus-ramp 'mus-rand-seed 'mus-random 2315 'mus-raw 'mus-reset 'mus-riff 'mus-run 'mus-scaler 2316 'mus-set-formant-radius-and-frequency 'mus-sound-chans 2317 'mus-sound-comment 2318 'mus-sound-sample-type 'mus-sound-data-location 2319 'mus-sound-datum-size 'mus-sound-duration 'mus-sound-forget 2320 'mus-sound-framples 'mus-sound-header-type 'mus-sound-length 2321 'mus-sound-loop-info 'mus-sound-mark-info 'mus-sound-maxamp 2322 'mus-sound-maxamp-exists? 2323 'mus-sound-prune 2324 'mus-sound-report-cache 'mus-sound-samples 2325 'mus-sound-srate 'mus-sound-type-specifier 2326 'mus-sound-write-date 'mus-soundfont 'mus-srate 'mus-svx 'mus-ubshort 2327 'mus-ubyte 'mus-ulshort 'mus-unknown-sample 'mus-unknown-header 2328 'mus-voc 'mus-width 'mus-xcoeff 'mus-xcoeffs 'mus-ycoeff 2329 'mus-ycoeffs 'name-click-hook 'new-sound 'new-sound-dialog 'new-sound-hook 2330 'new-widget-hook 'next-sample 'normalize-by-channel 'normalize-by-sound 2331 'normalize-channel 'normalize-globally 'notch 'notch? 'one-pole 2332 'one-pole? 'one-pole-all-pass 'one-pole-all-pass? 2333 'one-zero 'one-zero? 'open-file-dialog 2334 'open-file-dialog-directory 'open-hook 'open-raw-sound 2335 'open-raw-sound-hook 'open-sound 'orientation-hook 'oscil 2336 'oscil? 'out-any 'outa 'outb 'outc 'outd 'output-comment-hook 2337 'override-samples-with-origin 'pad-channel 2338 'partials->polynomial 'partials->wave 'parzen-window 'pausing 2339 'peaks 'peaks-font 'phase-partials->wave 2340 'phase-vocoder 'phase-vocoder-amp-increments 'phase-vocoder-amps 2341 'phase-vocoder-freqs 'phase-vocoder-phase-increments 2342 'phase-vocoder-phases 'phase-vocoder? 'play 'play-arrow-size 2343 'play-hook 'player-home 'player? 'players 'playing 2344 'poisson-window 'polar->rectangular 'polynomial 'polyshape 2345 'polywave 'polyshape? 'polywave? 'position->x 'position->y 2346 'position-color 'preferences-dialog 'previous-sample 'print-dialog 2347 'print-length 'progress-report 'pulse-train 'pulse-train? 2348 'radians->degrees 'radians->hz 'ramp-channel 'rand 'rand-interp 2349 'rand-interp? 'rand? 'read-mix-sample 'read-only 2350 'read-region-sample 'read-sample 'readin 'readin? 2351 'rectangular->magnitudes 'rectangular->polar 'rectangular-window 2352 'redo 'redo-edit 'region->vct 'region-chans 'region-home 2353 'region-framples 'region-graph-style 'region-maxamp 'region-maxamp-position 2354 'region-position 'region-sample 'region-sampler? 'region-srate 'region? 2355 'regions 'remember-sound-state 'remove-from-menu 'reset-controls 2356 'reset-listener-cursor 'restore-controls 'restore-region 2357 'reverb-control-decay 'reverb-control-feedback 'reverb-control-length 2358 'reverb-control-length-bounds 'reverb-control-lowpass 'reverb-control-scale 2359 'reverb-control-scale-bounds 'reverb-control? 'reverse-channel 2360 'reverse-selection 'reverse-sound 'revert-sound 'riemann-window 2361 'right-sample 'ring-modulate 'rv2-window 'rv3-window 'rv4-window 2362 'samaraki-window 'sample 'sample->file 'sample->file? 2363 'sampler-at-end? 'sampler-home 'sampler-position 'sampler? 'samples 2364 'samples->seconds 'sash-color 'save-controls 'save-dir 'save-edit-history 2365 'save-envelopes 'save-hook 'save-listener 'save-marks 'save-region 2366 'save-region-dialog 'save-selection 'save-selection-dialog 'save-sound 2367 'save-sound-as 'save-sound-dialog 'save-state 'save-state-file 2368 'save-state-hook 'sawtooth-wave 'sawtooth-wave? 'scale-by 'scale-channel 2369 'scale-selection-by 'scale-selection-to 'scale-to 2370 'scan-channel 'script-arg 'script-args 'search-procedure 2371 'seconds->samples 'select-all 'select-channel 'select-channel-hook 2372 'select-sound 'select-sound-hook 'selected-channel 'selected-data-color 2373 'selected-graph-color 'selected-sound 'selection-chans 'selection-color 2374 'selection-context 'selection-creates-region 'selection-framples 2375 'selection-maxamp 'selection-maxamp-position 'selection-member? 2376 'selection-position 'selection-srate 'selection? 'short-file-name 2377 'show-all-axes 'show-all-axes-unlabelled 'show-bare-x-axis 'show-axes 2378 'show-controls 'show-grid 'show-indices 'show-full-duration 2379 'show-full-range 'initial-beg 'initial-dur 'show-listener 'show-marks 2380 'show-mix-waveforms 'show-no-axes 'show-selection 2381 'show-selection-transform 'show-sonogram-cursor 'show-transform-peaks 2382 'show-widget 'show-x-axis 'show-x-axis-unlabelled 'show-y-zero 2383 'sinc-width 'nrxysin 'nrxysin? 'nrxycos 'nrxycos? 'rxyk!cos 'rxyk!cos? 2384 'rxyk!sin 'rxyk!sin? 'smooth-channel 2385 'smooth-selection 'smooth-sound 'snd->sample 'snd->sample? 'snd-error 2386 'snd-error-hook 'snd-exit ( added ) 'snd-gcs 'snd-help 'snd-font 2387 'snd-color 'snd-print 'snd-spectrum 'snd-tempnam 'snd-url 'snd-urls 2388 'snd-version 'snd-warning 'snd-warning-hook 2389 'sound-file-extensions 'sound-file? 2390 'sound-files-in-directory 'sound-loop-info 'sound-properties 2391 'sound-property 'sound-widgets 'sound? 'soundfont-info 'sounds 2392 'spectrum-end 'spectro-hop 'spectrum-start 'spectro-x-angle 2393 'spectro-x-scale 'spectro-y-angle 'spectro-y-scale 'spectro-z-angle 2394 'spectro-z-scale 'spectrum 'speed-control 'speed-control-as-float 2395 'speed-control-as-ratio 'speed-control-as-semitone 'speed-control-bounds 2396 'speed-control-style 'speed-control-tones 'square-wave 'square-wave? 2397 'squelch-update 'srate 'src 'src-channel 'src-selection 'src-sound 2398 'src? 'ssb-am 'ssb-am? 'start-playing 'start-playing-hook 2399 'start-playing-selection-hook 'start-progress-report 'status-report 2400 'stop-player 'stop-playing 'stop-playing-hook 2401 'stop-playing-selection-hook 'ncos 'ncos? 'nsin 'nsin? 'swap-channels 2402 'sync 'sync-style 'sync-none 'sync-all 'sync-by-sound 'sync-max 2403 'syncd-marks 'table-lookup 'table-lookup? 'tap 'tap? 'temp-dir 2404 'text-focus-color 'time-graph 'time-graph-style 'time-graph-type 2405 'time-graph? 'tiny-font 'tracking-cursor-style 'transform->vct 2406 'transform-dialog 'transform-framples 'transform-graph 2407 'transform-graph-style 'transform-graph-type 'transform-graph? 2408 'transform-normalization 'transform-sample 'transform-size 'transform-type 2409 'transform? 'triangle-wave 'triangle-wave? 'tukey-window 2410 'two-pole 'two-pole? 'two-zero 'two-zero? 'ultraspherical-window 2411 'unbind-key 'undo 'undo-edit 'undo-hook 'unselect-all 'update-hook 2412 'update-lisp-graph 'update-sound 'update-time-graph 2413 'update-transform-graph 'variable-graph? 'vct 'vct* 'vct+ 2414 'vct->channel 'vct->list 'vct->string 'vct->vector 2415 'vct-add! 'vct-length 'vct-max 'vct-min 'vct-move! 2416 'vct-multiply! 'vct-offset! 'vct-peak 'vct-ref 'vct-reverse! 'vct-scale! 2417 'vct-set! 'vct-subseq 'vct-subtract! 'vct? 'vector->vct 'walsh-transform 2418 'wave-train 'wave-train? 'wavelet-transform 'wavelet-type 'wavo-hop 2419 'wavo-trace 'welch-window 'widget-position 'widget-size 'widget-text 2420 'window-height 'window-width 'window-x 'window-y 2421 'with-background-processes 'with-file-monitor 'with-gl 'with-mix-tags 2422 'with-relative-panes 'with-tracking-cursor 'with-verbose-cursor 2423 'with-inset-graph 'with-interrupts 'with-pointer-focus 'with-smpte-label 2424 'with-toolbar 'with-tooltips 'with-menu-icons 'save-as-dialog-src 2425 'save-as-dialog-auto-comment 'x->position 'x-axis-as-clock 2426 'x-axis-as-percentage 'x-axis-in-beats 'x-axis-in-measures 2427 'x-axis-in-samples 'x-axis-in-seconds 'x-axis-label 'x-axis-style 2428 'x-bounds 'x-position-slider 'x-zoom-slider 'xramp-channel 2429 'y->position 'y-axis-label 'y-bounds 'y-position-slider 'y-zoom-slider 2430 'zero-pad 'zoom-color 'zoom-focus-active 'zoom-focus-left 2431 'zoom-focus-middle 'zoom-focus-right 'zoom-focus-style ) each to sym 2432 sym symbol-defined? unless 2433 undefined sym array-push to undefined 2434 then 2435 end-each 2436 *with-test-ladspa* unless 2437 undefined <'> rm-ladspa #( /ladspa/ ) array-reject! to undefined 2438 then 2439 *with-test-gl* unless 2440 undefined 'glSpectrogram array-delete-key drop 2441 then 2442 *with-test-gl2ps* unless 2443 undefined 'gl-graph->ps array-delete-key drop 2444 then 2445 undefined empty? unless 2446 "undefined[%d]: %s" #( undefined length undefined ) snd-display 2447 then 2448; 2449 2450\ ---------------- test 04: sndlib ---------------- 2451 2452: sndlib-check-it { snd typ fmt samp -- } 2453 snd header-type typ "save-as %s" #( typ mus-header-type-name ) snd-test-neq 2454 "test.snd" mus-sound-header-type { ntyp } 2455 ntyp 2456 typ 2457 "save-as %s -> %s" 2458 #( typ mus-header-type-name 2459 ntyp mus-header-type-name ) snd-test-neq 2460 snd sample-type fmt "save-as %s" #( fmt mus-sample-type-name ) snd-test-neq 2461 "test.snd" mus-sound-sample-type { nfmt } 2462 nfmt 2463 fmt 2464 "save-as %s -> %s" 2465 #( fmt mus-sample-type-name 2466 nfmt mus-sample-type-name ) snd-test-neq 2467 1000 snd sample samp "%s[1000]" #( typ mus-header-type-name ) snd-test-neq 2468; 2469 2470: sndlib-check-string <{ string -- str }> string " [written by me]" $+ ; 2471 2472: sndlib-true-cb <{ n -- f }> #t ; 2473 2474: sndlib-raw-hook-cb <{ file choice -- lst }> '( 1 22050 mus-bshort ) ; 2475 2476: sndlib-check-bad-file <{ n -- }> 2477 n open-sound { ind } 2478 ind number? 2479 ind sound? && if 2480 ind close-sound drop 2481 then 2482; 2483 2484: sndlib-test-map-10-times-cb <{ y -- y' }> y 10.0 f* ; 2485 2486: sndlib-test-map-add-cb { mx -- prc; y self -- y' } 2487 1 proc-create 1.001 mx f- , ( prc ) 2488 does> { y self -- y' } 2489 y self @ ( mx ) f+ 2490; 2491 24920 value big-file-framples 2493 2494: sndlib-test-map-x-cb { x incr -- prc; n self -- y } 2495 1 proc-create x , incr , ( prc ) 2496 does> { n self -- y } 2497 self @ ( x ) { val } 2498 val self cell+ @ ( incr ) f+ self ( x ) ! 2499 val 2500; 2501 2502: sndlib-test-scan-x-cb { x incr -- prc; n self -- f } 2503 1 proc-create x , incr , ( prc ) 2504 does> { n self -- f } 2505 self @ ( x ) { val } 2506 val self cell+ @ ( incr ) f+ self ( x ) ! 2507 val n fneq 2508; 2509 2510: sndlib-test-map-set-1.0 <{ n -- n' }> 1.0 ; 2511 2512: (04-sndlib-01) ( -- ) 2513 "oboe.snd" { oboe-snd } 2514 oboe-snd mus-sound-chans { chns } 2515 oboe-snd mus-sound-data-location { dl } 2516 oboe-snd mus-sound-framples { fr } 2517 oboe-snd mus-sound-samples { smps } 2518 oboe-snd mus-sound-length { len } 2519 oboe-snd mus-sound-datum-size { size } 2520 oboe-snd mus-sound-comment { com } 2521 oboe-snd mus-sound-srate { sr } 2522 oboe-snd mus-sound-maxamp-exists? { m1 } 2523 oboe-snd mus-sound-maxamp { mal } 2524 "z.snd" mus-sound-maxamp { mz } 2525 oboe-snd mus-sound-sample-type mus-bytes-per-sample { bytes } 2526 mz car 0 "mus-sound-maxamp z.snd" #() snd-test-neq 2527 mz cadr 0.0 "mus-sound-maxamp z.snd" #() snd-test-neq 2528 \ 2529 #( #( mus-bshort 2 ) 2530 #( mus-lshort 2 ) 2531 #( mus-mulaw 1 ) 2532 #( mus-alaw 1 ) 2533 #( mus-byte 1 ) 2534 #( mus-ubyte 1 ) 2535 #( mus-bfloat 4 ) 2536 #( mus-lfloat 4 ) 2537 #( mus-bint 4 ) 2538 #( mus-lint 4 ) 2539 #( mus-bintn 4 ) 2540 #( mus-lintn 4 ) 2541 #( mus-b24int 3 ) 2542 #( mus-l24int 3 ) 2543 #( mus-bdouble 8 ) 2544 #( mus-ldouble 8 ) 2545 #( mus-ubshort 2 ) 2546 #( mus-ulshort 2 ) 2547 #( mus-bdouble-unscaled 8 ) 2548 #( mus-ldouble-unscaled 8 ) 2549 #( mus-bfloat-unscaled 4 ) 2550 #( mus-lfloat-unscaled 4 ) ) { formats } 2551 nil nil nil { vals frm siz } 2552 formats each to vals 2553 vals 0 array-ref to frm 2554 vals 1 array-ref to siz 2555 frm mus-bytes-per-sample siz "mus-bytes-per-sample" #() snd-test-neq 2556 end-each 2557 mus-bshort mus-sample-type->string "mus-bshort" 2558 "mus-sample-type->string" #() snd-test-neq 2559 mus-aifc mus-header-type->string "mus-aifc" 2560 "mus-header-type->string" #() snd-test-neq 2561 \ 2562 "hiho.tmp" { hiho } 2563 hiho mus-sound-report-cache drop 2564 hiho readlines { res } 2565 res 0 array-ref string-chomp "sound table:" "print-cache 1" #() snd-test-neq 2566 hiho file-delete 2567 10 { req } 2568 chns 1 "oboe: mus-sound-chans" #() snd-test-neq 2569 dl 28 "oboe: mus-sound-data-location" #() snd-test-neq 2570 fr 50828 "oboe: mus-sound-framples" #() snd-test-neq 2571 smps 50828 "oboe: mus-sound-samples" #() snd-test-neq 2572 len 50828 2* 28 + "oboe: mus-sound-length" #() snd-test-neq 2573 size 2 "oboe: mus-sound-datum-size" #() snd-test-neq 2574 bytes 2 "oboe: mus-sound-bytes" #() snd-test-neq 2575 sr 22050 "oboe: mus-sound-srate" #() snd-test-neq 2576 m1 2577 *clmtest* 0= && if 2578 "oboe: mus-sound-maxamp-exists before maxamp: %s" #( m1 ) snd-display 2579 then 2580 oboe-snd mus-sound-maxamp-exists? to res 2581 res unless 2582 "oboe: not mus-sound-maxamp-exists after maxamp: %s" #( res ) snd-display 2583 then 2584 *clmtest* 0= if 2585 mus-header-raw-defaults to res 2586 res length 3 = if 2587 res 0 array-ref ( sr ) 44100 "mus-header-raw-defaults srate" 2588 #() snd-test-neq 2589 res 1 array-ref ( chns ) 2 "mus-header-raw-defaults chans" 2590 #() snd-test-neq 2591 res 2 array-ref ( frm ) mus-bshort "mus-header-raw-defaults format" 2592 #() snd-test-neq 2593 else 2594 res object-length 3 "mus-header-raw-defaults %s" #( res ) snd-test-neq 2595 then 2596 then 2597 '( 12345 3 mus-bdouble-unscaled ) set-mus-header-raw-defaults drop 2598 mus-header-raw-defaults to res 2599 res length 3 = if 2600 res 0 array-ref ( sr ) 12345 "set-mus-header-raw-defaults srate" 2601 #() snd-test-neq 2602 res 1 array-ref ( chns ) 3 "set-mus-header-raw-defaults chans" 2603 #() snd-test-neq 2604 res 2 array-ref ( frm ) mus-bdouble-unscaled 2605 "set-mus-header-raw-defaults format" #() snd-test-neq 2606 else 2607 res object-length 3 "set-mus-header-raw-defaults %s" #( res ) snd-test-neq 2608 then 2609 '( 44100 2 mus-bshort ) set-mus-header-raw-defaults drop 2610 \ 2611 "%d-%b %H:%M" oboe-snd mus-sound-write-date strftime 2612 "15-Oct 04:34" 2613 "mus-sound-write-date oboe.snd" #() snd-test-neq 2614 "%d-%b %H:%M" "pistol.snd" mus-sound-write-date strftime 2615 "01-Jul 22:06" 2616 "mus-sound-write-date pistol.snd" #() snd-test-neq 2617 \ 2618 oboe-snd open-sound { ind } 2619 "test" { long-file-name } 2620 10 0 do 2621 long-file-name "-test" string-push drop 2622 loop 2623 long-file-name ".snd" string-push drop 2624 ind variable-graph? if 2625 "variable-graph thinks anything is a graph..." #() snd-display 2626 then 2627 ind player? if 2628 "player? thinks anything is a player..." #() snd-display 2629 then 2630 ind sound? unless 2631 "%s is not a sound?" #( ind ) snd-display 2632 then 2633 #f sound? if 2634 "sound? #f -> #t?" #() snd-display 2635 then 2636 #t sound? if 2637 "sound? #t -> #f?" #() snd-display 2638 then 2639 long-file-name ind save-sound-as drop 2640 ind close-sound drop 2641 long-file-name open-sound to ind 2642 ind sound? unless 2643 "can't find test...snd" #() snd-display 2644 then 2645 long-file-name string-length { lfnlen } 2646 ind file-name string-length { fnlen } 2647 ind short-file-name string-length { sfnlen } 2648 fnlen lfnlen < 2649 sfnlen lfnlen < || if 2650 "file-name lengths: long-file-name %d, file-name %d, short-file-name %d" 2651 #( lfnlen fnlen sfnlen ) snd-display 2652 then 2653 ind close-sound drop 2654 long-file-name mus-sound-forget drop 2655 long-file-name file-delete 2656 \ 2657 "forest.aiff" check-file-name { fsnd } 2658 fsnd file-exists? if 2659 fsnd "fmv.snd" file-copy 2660 "fmv.snd" open-sound to ind 2661 ind sound-loop-info fsnd mus-sound-loop-info "loop-info" #() snd-test-neq 2662 ind '( 12000 14000 1 2 3 4 ) set-sound-loop-info drop 2663 ind sound-loop-info '( 12000 14000 1 2 3 4 1 1 ) "set-loop-info" 2664 #() snd-test-neq 2665 "fmv1.snd" ind :header-type mus-aifc save-sound-as drop 2666 ind close-sound drop 2667 "fmv1.snd" mus-sound-loop-info '( 12000 14000 1 2 3 4 1 1 ) 2668 "saved-loop-info" #() snd-test-neq 2669 then 2670 \ 2671 oboe-snd open-sound to ind 2672 "fmv.snd" ind :header-type mus-aifc save-sound-as drop 2673 ind close-sound drop 2674 "fmv.snd" open-sound to ind 2675 ind sound-loop-info '() "null loop-info" #() snd-test-neq 2676 ind '( 1200 1400 4 3 2 1 ) set-sound-loop-info drop 2677 ind sound-loop-info '( 1200 1400 4 3 2 1 1 1 ) "set null loop-info" #() 2678 snd-test-neq 2679 "fmv1.snd" ind :header-type mus-aifc save-sound-as drop 2680 "fmv1.snd" mus-sound-loop-info '( 1200 1400 4 3 2 1 1 1 ) 2681 "saved null loop-info" #() snd-test-neq 2682 ind close-sound drop 2683 "fmv.snd" open-sound to ind 2684 '( 1200 1400 4 3 2 1 1 0 ) set-sound-loop-info drop 2685 ind sound-loop-info '( 1200 1400 0 0 2 1 1 0 ) 2686 "set null loop-info (no mode1)" #() snd-test-neq 2687 "fmv1.snd" ind :header-type mus-aifc save-sound-as drop 2688 ind close-sound drop 2689 "fmv1.snd" mus-sound-loop-info '( 1200 1400 0 0 2 1 1 0 ) 2690 "saved null loop-info (no mode1)" #() snd-test-neq 2691 \ 2692 com empty? unless 2693 "oboe: mus-sound-comment %S?" #( com ) snd-display 2694 then 2695 #( #( "nasahal8.wav" 2696 "ICRD: 1997-02-22\nIENG: Paul R. Roger\nISFT: Sound Forge 4.0\n" ) 2697 #( "8svx-8.snd" "File created by Sound Exchange " ) 2698 #( "sun-16-afsp.snd" "AFspdate:1981/02/11 23:03:34 UTC" ) 2699 #( "smp-16.snd" "Converted using Sox. " ) 2700 #( "d40130.au" "1994 Jesus Villena" ) 2701 #( "wood.maud" "file written by SOX MAUD-export " ) 2702 #( "addf8.sf_mipseb" 2703 "date=\"Feb 11 18:03:34 1981\" info=\"Original recorded at 20 kHz, 15-bit D/A, digitally filtered and resampled\" speaker=\"AMK female\" text=\"Add the sum to the product of these three.\" " ) 2704 #( "mary-sun4.sig" "MARY HAD A LITTLE LAMB\n" ) 2705 #( "nasahal.pat" "This patch saved with Sound Forge 3.0." ) 2706 #( "next-16.snd" 2707 ";Written on Mon 1-Jul-91 at 12:10 PDT at localhost (NeXT) using Allegro CL and clm of 25-June-91" ) 2708 #( "wood16.nsp" "Created by Snack " ) 2709 #( "wood.sdx" "1994 Jesus Villena" ) 2710 #( "clmcom.aif" "this is a comment" ) 2711 #( "anno.aif" "1994 Jesus Villena\n" ) 2712 #( "telephone.wav" 2713 "sample_byte_format -s2 01\nchannel_count -i 1\nsample_count -i 36461\nsample_rate -i 16000\nsample_n_bytes -i 2\nsample_sig_bits -i 16\n" ) ) { comms } 2714 comms each to vals 2715 vals 0 array-ref check-file-name to fsnd 2716 fsnd file-exists? if 2717 fsnd mus-sound-comment ( res ) 2718 vals 1 array-ref ( req ) 2719 "mus-sound-comment %s" #( fsnd ) snd-test-neq 2720 then 2721 end-each 2722 \ 2723 "traffic.aiff" check-file-name to fsnd 2724 fsnd file-exists? if 2725 fsnd mus-sound-comment to res 2726 res string? unless 2727 "mus-sound-comment traffic: %s?" #( res ) snd-display 2728 then 2729 then 2730 \ 2731 *clmtest* 0= if 2732 mal cadr 0.14724 "oboe: mus-sound-maxamp" #() snd-test-neq 2733 mal car 24971 "oboe: mus-sound-maxamp at" #() snd-test-neq 2734 then 2735 \ 2736 oboe-snd mus-sound-type-specifier to res 2737 \ 0x646e732e little endian reader 2738 \ 0x2e736e64 big endian reader 2739 res 0x646e732e d<> 2740 res 0x2e736e64 d<> && if 2741 "oboe: mus-sound-type-specifier: %#x?" #( res ) snd-display 2742 then 2743 "%d-%b-%Y %H:%M" oboe-snd file-write-date strftime 2744 "15-Oct-2006 04:34" 2745 "oboe: file-write-date" #() snd-test-neq 2746 \ 2747 0 { lasth } 2748 begin 2749 lasth 1+ to lasth 2750 lasth mus-header-type-name "unknown" string= 2751 until 2752 lasth 50 < if 2753 "header-type[%d] = %s?" #( lasth dup mus-header-type-name ) snd-display 2754 then 2755 0 to lasth 2756 begin 2757 lasth 1+ to lasth 2758 lasth mus-sample-type-name "unknown" string= 2759 until 2760 lasth 10 < if 2761 "sample-type[%d] = %s?" #( lasth dup mus-sample-type-name ) snd-display 2762 then 2763 nil { name } 2764 #( 'dont-normalize 2765 'normalize-globally 2766 'normalize-by-channel ) each symbol-name to name 2767 name string-eval to req 2768 req set-transform-normalization drop 2769 transform-normalization req 2770 "set-transform-normalization %s" #( name ) snd-test-neq 2771 end-each 2772 \ 2773 "fmv.snd" 1 22050 mus-bshort mus-next "set-samples test" 100 new-sound to ind 2774 10 3 3 0.1 make-vct set-samples drop 2775 0 20 ind 0 channel->vct 2776 vct( 0 0 0 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) 2777 "1 set samples 0 for 0.1" #() snd-test-neq 2778 20 3 3 0.1 make-vct ind 0 set-samples drop 2779 10 20 ind 0 channel->vct 2780 vct( 0.1 0.1 0.1 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) 2781 "2 set samples 10 for 0.1" #() snd-test-neq 2782 30 3 3 0.1 make-vct ind 0 #f "a name" set-samples drop 2783 20 20 ind 0 channel->vct 2784 vct( 0.1 0.1 0.1 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) 2785 "3 set samples 20 for 0.1" #() snd-test-neq 2786 0 3 3 0.2 make-vct ind 0 #f "a name" 0 1 set-samples drop 2787 0 20 ind 0 channel->vct 2788 vct( 0.2 0.2 0.2 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) 2789 "4 set samples 0 at 1 for 0.1" #() snd-test-neq 2790 20 20 ind 0 channel->vct 2791 20 0.0 make-vct 2792 "5 set samples 20 at 1 for 0.1" #() snd-test-neq 2793 "fmv1.snd" :channels 2 new-sound { nd } 2794 10 0.5 make-vct 0 10 nd 0 vct->channel drop 2795 10 0.3 make-vct 0 10 nd 1 vct->channel drop 2796 "fmv1.snd" nd save-sound-as drop 2797 nd close-sound drop 2798 "fmv1.snd" file-exists? unless 2799 "fmv1.snd not saved??" #() snd-display 2800 then 2801 0 10 "fmv1.snd" ind 0 #f "another name" 1 set-samples drop 2802 0 20 ind 0 channel->vct 2803 vct( 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.1 0.1 0.1 0 0 0 0 0 0 0 ) 2804 "6 set samples 0 at 1 for 0.1" #() snd-test-neq 2805 5 6 "fmv1.snd" ind 0 #f "another name 7" 0 set-samples drop 2806 0 20 ind 0 channel->vct 2807 vct( 0.3 0.3 0.3 0.3 0.3 0.5 0.5 0.5 0.5 0.5 0.5 0.1 0.1 0 0 0 0 0 0 0 ) 2808 "7 set samples 0 at 1 for 0.1" #() snd-test-neq 2809 0 10 "fmv1.snd" ind 0 #f "another name 8" 1 0 #f set-samples drop 2810 0 20 ind 0 channel->vct 2811 vct( 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0.3 0 0 0 0 0 0 0 0 0 0 ) 2812 "8 set samples 0 at 1 for 0.1" #() snd-test-neq 2813 10 10 "fmv1.snd" ind 0 #f "another name 9" 0 0 set-samples drop 2814 0 20 ind 0 channel->vct 2815 vct( 0 0 0 0 0 0 0 0 0 0 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ) 2816 "9 set samples 0 at 1 for 0.1" #() snd-test-neq 2817 20 10 "fmv1.snd" set-samples drop 2818 10 20 ind 0 channel->vct 2819 20 0.5 make-vct 2820 "10 set samples 0 at 1 for 0.1" #() snd-test-neq 2821 0 10 "fmv1.snd" ind 0 #t "another name" 1 0 #f set-samples drop 2822 ind 0 framples 10 "11 set samples truncate" #() snd-test-neq 2823 ind revert-sound drop 2824 "fmv1.snd" file-delete 2825 \ ;; now try to confuse it 2826 0 10 "fmv1.snd" ind 0 <'> set-samples snd-test-catch to res 2827 res car 'no-such-file "set-samples, no such file" #() snd-test-neq 2828 "fmv1.snd" :channels 1 new-sound to nd 2829 "fmv1.snd" nd save-sound-as drop 2830 nd close-sound drop 2831 0 10 "fmv1.snd" ind 0 #f "another name" 1 <'> set-samples 2832 snd-test-catch to res 2833 res car 'no-such-channel "set-samples no such channel" #() snd-test-neq 2834 0 10 "fmv1.snd" ind 0 #f "another name" -1 <'> set-samples 2835 snd-test-catch to res 2836 res car 'no-such-channel "set-samples no such channel (-1)" #() snd-test-neq 2837 0 -10 "fmv1.snd" <'> set-samples snd-test-catch to res 2838 res car 'wrong-type-arg "set-samples (-10)" #() snd-test-neq 2839 -10 10 "fmv1.snd" <'> set-samples snd-test-catch to res 2840 res car 'no-such-sample "set-samples (beg -10)" #() snd-test-neq 2841 ind close-sound drop 2842 \ 2843 100 { len } 2844 #( #( mus-bshort 2 -15 f** ) 2845 #( mus-lshort 2 -15 f** ) 2846 #( mus-mulaw 0.02 ) 2847 #( mus-alaw 0.02 ) 2848 #( mus-byte 2 -7 f** ) 2849 #( mus-lfloat 2 -23 f** ) 2850 #( mus-bint 2 -23 f** ) 2851 #( mus-lint 2 -23 f** ) 2852 #( mus-b24int 2 -23 f** ) 2853 #( mus-l24int 2 -23 f** ) 2854 #( mus-ubshort 2 -15 f** ) 2855 #( mus-ulshort 2 -15 f** ) 2856 #( mus-ubyte 2 -7 f** ) 2857 #( mus-bfloat 2 -23 f** ) 2858 #( mus-bdouble 2 -23 f** ) 2859 #( mus-ldouble 2 -23 f** ) ) { types } 2860 nil nil nil nil nil nil { v v0 v1 diff maxdiff maxpos } 2861 nil nil nil { typ allowed-diff val } 2862 types each to vals 2863 vals 0 array-ref to typ 2864 vals 1 array-ref to allowed-diff 2865 "test.snd" 1 22050 mus-bfloat mus-next new-sound to ind 2866 len 0.0 make-vct to v 2867 0.0 to maxdiff 2868 #f to maxpos 2869 v 0 0.999 vct-set! drop 2870 v 1 -1.000 vct-set! drop 2871 v 2 0.100 vct-set! drop 2872 v 3 -0.100 vct-set! drop 2873 v 4 0.010 vct-set! drop 2874 v 5 -0.010 vct-set! drop 2875 v 6 0.001 vct-set! drop 2876 v 7 -0.001 vct-set! drop 2877 v 8 0.000 vct-set! drop 2878 len 7 do 2879 1.9999 random to val 2880 val 2.0 f> 2881 val 0.0 f< || if 2882 "random 2.0 -> %s?" #( val ) snd-display 2883 then 2884 v i 1.0 val f- vct-set! drop 2885 loop 2886 v 0 len ind 0 vct->channel drop 2887 "test1.snd" ind :header-type mus-next :sample-type typ save-sound-as drop 2888 ind close-sound drop 2889 "test1.snd" open-sound to ind 2890 0 len ind 0 channel->vct to v1 2891 len 0 do 2892 v i vct-ref v1 i vct-ref f- fabs to diff 2893 diff maxdiff f> if 2894 diff to maxdiff 2895 i to maxpos 2896 then 2897 loop 2898 maxdiff allowed-diff f> if 2899 "%s: %s at %d (%s %s)?" 2900 #( typ mus-sample-type-name 2901 maxdiff 2902 maxpos 2903 v maxpos vct-ref 2904 v1 maxpos vct-ref ) snd-display 2905 then 2906 ind close-sound drop 2907 end-each 2908 \ 2909 oboe-snd view-sound { ob } 2910 1000 ob sample { samp } 2911 oboe-snd mus-sound-comment { old-comment } 2912 "written %s" #( "%a %d-%b-%Y %H:%M %Z" current-time strftime ) 2913 string-format { str } 2914 ob str set-comment drop 2915 "test.snd" ob :header-type mus-aifc :sample-type mus-bdouble 2916 <'> save-sound-as snd-test-catch to res 2917 res car 'cannot-save "save-sound-as test.snd write trouble" #() snd-test-eq 2918 #t set-filter-control-in-hz drop 2919 "test.snd" open-sound { ab } 2920 ab mus-aifc mus-bdouble samp sndlib-check-it 2921 "test.snd" mus-sound-comment str "output-comment" #() snd-test-neq 2922 ab comment str "output-comment (comment)" #() snd-test-neq 2923 ab close-sound drop 2924 oboe-snd mus-sound-comment old-comment "set-comment overwrote current" #() 2925 snd-test-neq 2926 #f set-filter-control-in-hz drop 2927 \ 2928 "test.snd" ob :header-type mus-raw save-sound-as drop 2929 "test.snd" 1 22050 mus-bshort open-raw-sound to ab 2930 ab mus-raw mus-bshort samp sndlib-check-it 2931 ab close-sound drop 2932 \ 2933 "test.snd" ob :header-type mus-nist :sample-type mus-bint save-sound-as drop 2934 "test.snd" open-sound to ab 2935 ab mus-nist mus-bint samp sndlib-check-it 2936 ab close-sound drop 2937 \ 2938 output-comment-hook reset-hook! 2939 output-comment-hook <'> sndlib-check-string add-hook! 2940 "test.snd" ob :header-type mus-riff :sample-type mus-lfloat save-sound-as drop 2941 output-comment-hook reset-hook! 2942 "test.snd" open-sound to ab 2943 ab mus-riff mus-lfloat samp sndlib-check-it 2944 ab comment str " [written by me]" $+ "output-comment-hook" #() snd-test-neq 2945 ab close-sound drop 2946 #( #( mus-aiff mus-b24int ) 2947 #( mus-ircam mus-mulaw ) 2948 #( mus-next mus-alaw ) 2949 #( mus-next mus-ldouble ) ) to types 2950 nil { fmt } 2951 types each to vals 2952 vals 0 array-ref to typ 2953 vals 1 array-ref to fmt 2954 "test.snd" ob :header-type typ :sample-type fmt save-sound-as drop 2955 "test.snd" open-sound to ab 2956 ab typ fmt samp sndlib-check-it 2957 ab close-sound drop 2958 end-each 2959 "test.snd" ob :header-type mus-next :sample-type mus-bshort save-sound-as drop 2960 "test.snd" open-sound to ab 2961 ab mus-next mus-bshort samp sndlib-check-it 2962 update-hook reset-hook! 2963 '( -3.0 3.0 ) ab 0 set-y-bounds drop 2964 ab mus-lshort set-sample-type drop 2965 \ ; these set!'s can change the index via update-sound 2966 "test.snd" find-sound to ab 2967 ab sample-type to fmt 2968 fmt mus-lshort "set-sample-type %s" #( fmt mus-sample-type-name ) snd-test-neq 2969 ab 0 y-bounds '( -3.0 3.0 ) "set data format y-bounds" #() snd-test-neq 2970 '( 2.0 ) ab 0 set-y-bounds drop 2971 ab 0 y-bounds '( -2.0 2.0 ) "set data format y-bounds 1" #() snd-test-neq 2972 '( -2.0 ) ab 0 set-y-bounds drop 2973 ab 0 y-bounds '( -2.0 2.0 ) "set data format y-bounds -2" #() snd-test-neq 2974 ab mus-aifc set-header-type drop 2975 "test.snd" find-sound to ab 2976 ab header-type mus-aifc "set-header-type" #() snd-test-neq 2977 ab 3 set-channels drop 2978 "test.snd" find-sound to ab 2979 ab channels 3 "set-channels" #() snd-test-neq 2980 ab 1234 set-data-location drop 2981 "test.snd" find-sound to ab 2982 ab data-location 1234 "set-data-location" #() snd-test-neq 2983 ab data-size { old-size } 2984 ab 1234 set-data-size drop 2985 "test.snd" find-sound to ab 2986 ab data-size 1234 "set-data-size" #() snd-test-neq 2987 ab old-size set-data-size drop 2988 ab 12345 set-srate drop 2989 "test.snd" find-sound to ab 2990 ab srate 12345 "set-srate" #() snd-test-neq 2991 ab close-sound drop 2992 \ 2993 "test.snd" ob :header-type mus-next :sample-type mus-bfloat save-sound-as drop 2994 "test.snd" open-sound to ab 2995 ab mus-next mus-bfloat samp sndlib-check-it 2996 ab close-sound drop 2997 \ 2998 "test.snd" ob :header-type mus-next :sample-type mus-bshort save-sound-as drop 2999 ob close-sound drop 3000 "test.snd" open-sound to ab 3001 mus-lshort set-sample-type drop 3002 "test.snd" find-sound to ab 3003 sample-type mus-lshort "set-sample-type" #() snd-test-neq 3004 mus-aifc set-header-type drop 3005 "test.snd" find-sound to ab 3006 header-type mus-aifc "set-header-type" #() snd-test-neq 3007 3 set-channels drop 3008 "test.snd" find-sound to ab 3009 channels 3 "set-channels" #() snd-test-neq 3010 1234 set-data-location drop 3011 "test.snd" find-sound to ab 3012 data-location 1234 "set-data-location" #() snd-test-neq 3013 12345 set-srate drop 3014 "test.snd" find-sound to ab 3015 srate 12345 "set-srate" #() snd-test-neq 3016 ab close-sound drop 3017 \ 3018 "2a.snd" open-sound to ind 3019 "test.snd" :sample-type mus-l24int :header-type mus-riff 3020 :channel 0 save-sound-as drop 3021 "test.snd" open-sound { ind0 } 3022 ind0 channels 1 "save-sound-as :channel 0 chans" #() snd-test-neq 3023 ind0 sample-type mus-l24int "save-sound-as :channel 0 sample-type" #() 3024 snd-test-neq 3025 ind0 header-type mus-riff "save-sound-as :channel 0 header-type" #() 3026 snd-test-neq 3027 ind0 srate ind srate "save-sound-as :channel 0 srates" #() snd-test-neq 3028 ind0 framples ind 0 undef framples "save-sound-as :channel 0 framples" #() 3029 snd-test-neq 3030 ind0 maxamp ind 0 undef maxamp "save-sound-as :channel 0 maxamps" #() 3031 snd-test-neq 3032 ind0 close-sound drop 3033 \ 3034 "test.snd" :sample-type mus-bfloat :header-type mus-aifc :channel 1 3035 :srate 12345 save-sound-as drop 3036 "test.snd" open-sound to ind0 3037 ind0 channels 1 "save-sound-as :channel 1 chans" #() snd-test-neq 3038 ind0 sample-type mus-bfloat "save-sound-as :channel 1 sample-type" #() 3039 snd-test-neq 3040 ind0 header-type mus-aifc "save-sound-as :channel 1 header-type" #() 3041 snd-test-neq 3042 ind0 srate 12345 "save-sound-as :channel 1 srates" #() snd-test-neq 3043 ind0 framples ind 1 undef framples "save-sound-as :channel 1 framples" #() 3044 snd-test-neq 3045 ind0 maxamp ind 1 undef maxamp "save-sound-as :channel 1 maxamps" #() 3046 snd-test-neq 3047 ind0 close-sound drop 3048 \ 3049 "test.snd" :channel 1 :comment "this is a test" save-sound-as drop 3050 "test.snd" open-sound to ind0 3051 ind0 channels 1 "save-sound-as :channel 1 (1) chans" #() snd-test-neq 3052 ind0 sample-type ind sample-type 3053 "save-sound-as :channel 1 (1) sample-type" #() snd-test-neq 3054 ind0 header-type ind header-type 3055 "save-sound-as :channel 1 (1) header-type" #() snd-test-neq 3056 ind0 srate ind srate "save-sound-as :channel 1 (1) srates" #() snd-test-neq 3057 ind0 framples ind 1 undef framples 3058 "save-sound-as :channel 1 (1) framples" #() snd-test-neq 3059 ind0 0 maxamp ind 1 undef maxamp 3060 "save-sound-as :channel 1 (1) maxamps" #() snd-test-neq 3061 ind0 comment "this is a test" 3062 "save-sound-as :channel 1 (1) comment" #() snd-test-neq 3063 ind0 close-sound drop 3064 ind close-sound drop 3065 \ 3066 "t15.aiff" check-file-name to fsnd 3067 fsnd file-exists? if 3068 fsnd open-sound to ind 3069 132300 ind 0 sample 0.148 "aifc sowt trouble (0)" #() snd-test-neq 3070 132300 ind 1 sample 0.126 "aifc sowt trouble (1)" #() snd-test-neq 3071 ind close-sound drop 3072 then 3073 "M1F1-float64C-AFsp.aif" check-file-name to fsnd 3074 fsnd file-exists? if 3075 fsnd open-sound to ind 3076 8000 ind 0 sample -0.024 "aifc fl64 trouble (0)" #() snd-test-neq 3077 8000 ind 1 sample 0.021 "aifc fl64 trouble (1)" #() snd-test-neq 3078 ind close-sound drop 3079 then 3080 \ 3081 #( #( "bad_chans.snd" 0 22050 0 ) 3082 #( "bad_srate.snd" 1 0 0 ) 3083 #( "bad_data_format.snd" 1 22050 4411 ) 3084 #( "bad_chans.aifc" 0 22050 0 ) 3085 #( "bad_srate.aifc" 1 0 0 ) 3086 #( "bad_length.aifc" 1 22050 -10 ) 3087 #( "bad_chans.riff" 0 22050 0 ) 3088 #( "bad_srate.riff" 1 0 0 ) 3089 #( "bad_chans.nist" 0 22050 0 ) 3090 #( "bad_srate.nist" 1 0 0 ) 3091 #( "bad_length.nist" 1 22050 -10 ) ) { files } 3092 nil nil nil { fc fs fr } 3093 files each to vals 3094 vals 0 array-ref check-file-name to fsnd 3095 vals 1 array-ref to fc 3096 vals 2 array-ref to fs 3097 vals 3 array-ref to fr 3098 fsnd file-exists? if 3099 fsnd <'> mus-sound-chans #t nil fth-catch ?dup-if 3100 car 'mus-error <> if 3101 "%s: chans %d (%s)" #( fsnd fc res ) snd-display 3102 then 3103 else 3104 fc <> if 3105 "%s: chans %d (%s)" #( fsnd fc res ) snd-display 3106 then 3107 stack-reset 3108 then 3109 \ 3110 fsnd <'> mus-sound-srate #t nil fth-catch ?dup-if 3111 car 'mus-error <> if 3112 "%s: srate %d (%s)" #( fsnd fs res ) snd-display 3113 then 3114 stack-reset 3115 else 3116 fs <> if 3117 "%s: srate %d (%s)" #( fsnd fs res ) snd-display 3118 then 3119 then 3120 \ 3121 fsnd <'> mus-sound-framples #t nil fth-catch ?dup-if 3122 car 'mus-error <> if 3123 "%s: framples %d (%s)" #( fsnd fr res ) snd-display 3124 then 3125 stack-reset 3126 else 3127 fr <> if 3128 "%s: framples %d (%s)" #( fsnd fr res ) snd-display 3129 then 3130 then 3131 then \ file-exists? 3132 end-each 3133 \ 3134 "/usr/include/sys/" file-pwd $+ "/oboe.snd" $+ 3135 <'> open-sound #t nil fth-catch ?dup-if 3136 1 >list "open-sound with slashes: %s" swap snd-display 3137 stack-reset 3138 else \ open-sound with slashes 3139 to ind 3140 ind sound? if 3141 ind short-file-name "oboe.snd" string<> if 3142 "open-sound with slashes: %s" #( ind short-file-name ) snd-display 3143 then 3144 else 3145 "open-sound with slashes: %s" #( ind ) snd-display 3146 then 3147 bad-header-hook <'> sndlib-true-cb add-hook! 3148 #( "bad_chans.snd" 3149 "bad_srate.snd" 3150 "bad_chans.aifc" 3151 "bad_srate.aifc" 3152 "bad_length.aifc" 3153 "bad_chans.riff" 3154 "bad_srate.riff" 3155 "bad_chans.nist" 3156 "bad_location.nist" 3157 "bad_field.nist" 3158 "bad_srate.nist" 3159 "bad_length.nist" ) each check-file-name to fsnd 3160 fsnd file-exists? if 3161 fsnd <'> insert-sound snd-test-catch drop 3162 fsnd <'> convolve-with snd-test-catch drop 3163 fsnd <'> mix snd-test-catch drop 3164 fsnd <'> sndlib-check-bad-file snd-test-catch drop 3165 then 3166 end-each 3167 ind close-sound drop 3168 then \ open-sound with slashes 3169 sounds each ( snd ) 3170 close-sound 3171 end-each 3172 \ 3173 #( "trunc.snd" 3174 "trunc.aiff" 3175 "trunc.wav" 3176 "trunc.sf" 3177 "trunc.voc" 3178 "trunc.nist" 3179 "bad.wav" 3180 "trunc1.aiff" 3181 "badform.aiff" ) each check-file-name to fsnd 3182 fsnd file-exists? if 3183 fsnd <'> open-sound snd-test-catch to res 3184 res car 'mus-error "open-sound" #() snd-test-neq 3185 then 3186 end-each 3187 open-raw-sound-hook <'> sndlib-raw-hook-cb add-hook! 3188 "empty.snd" check-file-name to fsnd 3189 fsnd file-exists? if 3190 fsnd open-sound to ind 3191 ind sample-type mus-bshort "open raw sample-type" #() snd-test-neq 3192 ind chans 1 "open raw chans" #() snd-test-neq 3193 ind srate 22050 "open raw srate" #() snd-test-neq 3194 ind data-location 0 "open raw data-location" #() snd-test-neq 3195 ind framples 0 "open raw framples" #() snd-test-neq 3196 ind close-sound drop 3197 then 3198 open-raw-sound-hook reset-hook! 3199 \ 3200 #f set-clipping drop 3201 "test.snd" :sample-type mus-lshort new-sound { snd } 3202 0 10 pad-channel drop 3203 1 1.0000 set-sample drop 3204 2 -1.0000 set-sample drop 3205 3 0.9999 set-sample drop 3206 4 2.0000 set-sample drop 3207 5 -2.0000 set-sample drop 3208 6 1.3000 set-sample drop 3209 7 -1.3000 set-sample drop 3210 8 1.8000 set-sample drop 3211 9 -1.8000 set-sample drop 3212 snd save-sound drop 3213 snd close-sound drop 3214 "test.snd" open-sound to snd 3215 0 10 channel->vct 3216 vct( 0.000 1.000 -1.000 1.000 0.000 0.000 -0.700 0.700 -0.200 0.200 ) 3217 "unclipped 1" #() snd-test-neq 3218 snd close-sound drop 3219 "test.snd" mus-sound-forget drop 3220 \ 3221 #t set-clipping drop 3222 "test.snd" :sample-type mus-lshort new-sound to snd 3223 0 10 pad-channel drop 3224 1 1.0000 set-sample drop 3225 2 -1.0000 set-sample drop 3226 3 0.9999 set-sample drop 3227 4 2.0000 set-sample drop 3228 5 -2.0000 set-sample drop 3229 6 1.3000 set-sample drop 3230 7 -1.3000 set-sample drop 3231 8 1.8000 set-sample drop 3232 9 -1.8000 set-sample drop 3233 snd save-sound drop 3234 snd close-sound drop 3235 "test.snd" open-sound to snd 3236 0 10 channel->vct 3237 vct( 0.000 1.000 -1.000 1.000 1.000 -1.000 1.000 -1.000 1.000 -1.000 ) 3238 "clipped" #() snd-test-neq 3239 snd close-sound drop 3240 \ 3241 #( #( "next-dbl.snd" 10 10 3242 vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) ) 3243 #( "oboe.ldbl" 1000 10 3244 vct( 0.033 0.035 0.034 0.031 0.026 0.020 0.013 0.009 0.005 0.004 ) ) 3245 #( "next-flt.snd" 10 10 3246 vct( 0.475 0.491 0.499 0.499 0.492 0.476 0.453 0.423 0.387 0.344 ) ) 3247 #( "clbonef.wav" 1000 10 3248 vct( 0.111 0.101 0.07 0.032 -0.014 -0.06 -0.085 -0.108 -0.129 -0.152 ) ) 3249 #( "next-8.snd" 10 10 3250 vct( 0.898 0.945 0.977 0.992 0.992 0.977 0.945 0.906 0.844 0.773 ) ) 3251 #( "o2_u8.wave" 1000 10 3252 vct( -0.164 -0.219 -0.258 -0.242 -0.18 -0.102 -0.047 0.0 0.039 0.055 ) ) 3253 #( "next-16.snd" 1000 10 3254 vct( -0.026 -0.022 -0.024 -0.03 -0.041 3255 -0.048 -0.05 -0.055 -0.048 -0.033 ) ) 3256 #( "o2.wave" 1000 10 3257 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3258 -0.102 -0.042 0.005 0.041 0.059 ) ) 3259 #( "o2_18bit.aiff" 1000 10 3260 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3261 -0.102 -0.042 0.005 0.041 0.059 ) ) 3262 #( "o2_12bit.aiff" 1000 10 3263 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3264 -0.102 -0.042 0.005 0.041 0.059 ) ) 3265 #( "next24.snd" 1000 10 3266 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3267 -0.102 -0.042 0.005 0.041 0.059 ) ) 3268 #( "mono24.wav" 1000 10 3269 vct( 0.005 0.010 0.016 0.008 -0.007 3270 -0.018 -0.025 -0.021 -0.005 0.001 ) ) 3271 #( "o2_711u.wave" 1000 10 3272 vct( -0.164 -0.219 -0.254 -0.242 -0.172 3273 -0.103 -0.042 0.005 0.042 0.060 ) ) 3274 #( "alaw.wav" 1000 10 3275 vct( -0.024 -0.048 -0.024 0.0 0.008 0.008 0.000 -0.040 -0.064 -0.024 ) ) 3276 \ ;; it is not a bug if these don't match if MUS_SAMPLE_BITS is not 24 3277 #( "b32.pvf" 1000 10 3278 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3279 -0.102 -0.042 0.005 0.041 0.059 ) ) 3280 #( "b32.wave" 1000 10 3281 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3282 -0.102 -0.042 0.005 0.041 0.059 ) ) 3283 #( "b32.snd" 1000 10 3284 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3285 -0.102 -0.042 0.005 0.041 0.059 ) ) 3286 #( "32bit.sf" 1000 10 3287 vct( 0.016 0.014 0.013 0.011 0.010 0.010 0.010 0.010 0.012 0.014 ) ) 3288 #( "nist-shortpack.wav" 10000 10 3289 vct( 0.021 0.018 0.014 0.009 0.004 3290 -0.001 -0.004 -0.006 -0.007 -0.008 ) ) 3291 #( "wood.sds" 1000 10 3292 vct( -0.160 -0.216 -0.254 -0.239 -0.175 3293 -0.102 -0.042 0.005 0.041 0.059 ) ) 3294 #( "mus10.snd" 10000 10 3295 vct( 0.004 0.001 0.005 0.009 0.017 0.015 0.008 0.011 0.009 0.012 ) ) 3296 #( "ieee-text-16.snd" 1000 10 3297 vct( -0.052 -0.056 -0.069 -0.077 -0.065 3298 -0.049 -0.054 -0.062 -0.066 -0.074 ) ) 3299 #( "hcom-16.snd" 10000 10 3300 vct( 0.000 0.000 0.000 0.008 0.000 -0.016 -0.016 -0.016 -0.008 0.000 ) ) 3301 #( "ce-c3.w02" 1000 10 3302 vct( 0.581 0.598 0.596 0.577 0.552 0.530 0.508 0.479 0.449 0.425 ) ) 3303 #( "nasahal.avi" 20000 10 3304 vct( 0.390 0.120 -0.399 -0.131 0.464 0.189 -0.458 -0.150 0.593 0.439 ) ) 3305 #( "oki.wav" 100 10 3306 vct( 0.396 0.564 0.677 0.779 0.761 0.540 0.209 -0.100 -0.301 -0.265 ) ) 3307 #( "trumps22.adp" 5000 10 3308 vct( 0.267 0.278 0.309 0.360 0.383 0.414 0.464 0.475 0.486 0.495 ) ) 3309 ) to files 3310 nil nil nil nil { file beg dur data } 3311 files each to vals 3312 vals 0 array-ref to file 3313 vals 1 array-ref to beg 3314 vals 2 array-ref to dur 3315 vals 3 array-ref to data 3316 file check-file-name to fsnd 3317 fsnd file-exists? if 3318 fsnd open-sound to ind 3319 beg dur ind 0 channel->vct data "%s" #( file ) snd-test-neq 3320 ind close-sound drop 3321 then 3322 end-each 3323 \ 3324 #( "no error" 3325 "no frequency method" 3326 "no phase method" 3327 "null gen arg to method" 3328 "no length method" 3329 "no describe method" 3330 "no data method" 3331 "no scaler method" 3332 "memory allocation failed" 3333 "can't open file" 3334 "no sample input" 3335 "no sample output" 3336 "no such channel" 3337 "no file name provided" 3338 "no location method" 3339 "no channel method" 3340 "no such fft window" 3341 "unknown sample type" 3342 "header read failed" 3343 "unknown header type" 3344 "file descriptors not initialized" 3345 "not a sound file" 3346 "file closed" 3347 "write error" 3348 "header write failed" 3349 "can't open temp file" 3350 "interrupted" 3351 "bad envelope" 3352 "audio channels not available" 3353 "audio srate not available" 3354 "audio sample type not available" 3355 "no audio input available" 3356 "audio configuration not available" 3357 "audio write error" 3358 "audio size not available" 3359 "audio device not available" 3360 "can't close audio" 3361 "can't open audio" 3362 "audio read error" 3363 "can't write audio" 3364 "can't read audio" 3365 "no audio read permission" 3366 "can't close file" 3367 "arg out of range" 3368 "no channels method" 3369 "no hop method" 3370 "no width method" 3371 "no file-name method" 3372 "no ramp method" 3373 "no run method" 3374 "no increment method" 3375 "no offset method" 3376 "no xcoeff method" 3377 "no ycoeff method" 3378 "no xcoeffs method" 3379 "no ycoeffs method" 3380 "no reset" 3381 "bad size" 3382 "can't convert" 3383 "read error" 3384 "no feedforward method" 3385 "no feedback method" 3386 "no interp-type method" 3387 "no position method" 3388 "no order method" 3389 "no copy method" 3390 "can't translate" ) each 3391 ( err ) i mus-error-type->string "mus-error-type->string[%d]" #( i ) 3392 snd-test-neq 3393 end-each 3394 \ 3395 "oboe.snd" mus-sound-srate { cur-srate } 3396 "oboe.snd" mus-sound-chans { cur-chans } 3397 "oboe.snd" mus-sound-sample-type { cur-format } 3398 "oboe.snd" mus-sound-header-type { cur-type } 3399 "oboe.snd" mus-sound-data-location { cur-loc } 3400 "oboe.snd" mus-sound-samples { cur-samps } 3401 "oboe.snd" cur-srate 2* set-mus-sound-srate drop 3402 "oboe.snd" mus-sound-srate cur-srate 2* "set-mus-sound-srate" #() 3403 snd-test-neq 3404 "oboe.snd" cur-samps 2* set-mus-sound-samples drop 3405 "oboe.snd" mus-sound-samples cur-samps 2* "set-mus-sound-samples" #() 3406 snd-test-neq 3407 "oboe.snd" cur-chans 2* set-mus-sound-chans drop 3408 "oboe.snd" mus-sound-chans cur-chans 2* "set-mus-sound-chans" #() 3409 snd-test-neq 3410 "oboe.snd" cur-loc 2* set-mus-sound-data-location drop 3411 "oboe.snd" mus-sound-data-location cur-loc 2* 3412 "set-mus-sound-data-location" #() snd-test-neq 3413 "oboe.snd" mus-nist set-mus-sound-header-type drop 3414 "oboe.snd" mus-sound-header-type mus-nist "set-mus-sound-header-type" #() 3415 snd-test-neq 3416 "oboe.snd" mus-lintn set-mus-sound-sample-type drop 3417 "oboe.snd" mus-sound-sample-type mus-lintn "set-mus-sound-sample-type" #() 3418 snd-test-neq 3419 "oboe.snd" cur-srate set-mus-sound-srate drop 3420 "oboe.snd" cur-samps set-mus-sound-samples drop 3421 "oboe.snd" cur-chans set-mus-sound-chans drop 3422 "oboe.snd" cur-loc set-mus-sound-data-location drop 3423 "oboe.snd" cur-type set-mus-sound-header-type drop 3424 "oboe.snd" cur-format set-mus-sound-sample-type drop 3425 \ 3426 "oboe.snd" open-sound to ind 3427 "test.wave" ind :header-type mus-riff save-sound-as drop 3428 "test.rf64" ind :header-type mus-rf64 save-sound-as drop 3429 "test.aifc" ind :header-type mus-aifc save-sound-as drop 3430 ind close-sound drop 3431 \ 3432 #( "test.wave" "test.rf64" "test.aifc" ) each to file 3433 file mus-sound-srate to cur-srate 3434 file mus-sound-chans to cur-chans 3435 file mus-sound-sample-type to cur-format 3436 file mus-sound-header-type to cur-type 3437 file mus-sound-data-location to cur-loc 3438 file mus-sound-samples to cur-samps 3439 file cur-srate 2* set-mus-sound-srate drop 3440 file mus-sound-srate cur-srate 2* "%s set-mus-sound-srate" #( file ) 3441 snd-test-neq 3442 file cur-samps 2* set-mus-sound-samples drop 3443 file mus-sound-samples cur-samps 2* "%s set-mus-sound-samples" #( file ) 3444 snd-test-neq 3445 file cur-chans 2* set-mus-sound-chans drop 3446 file mus-sound-chans cur-chans 2* "%s set-mus-sound-chans" #( file ) 3447 snd-test-neq 3448 file cur-loc 2* set-mus-sound-data-location drop 3449 file mus-sound-data-location cur-loc 2* 3450 "%s set-mus-sound-data-location" #( file ) snd-test-neq 3451 file mus-nist set-mus-sound-header-type drop 3452 file mus-sound-header-type mus-nist 3453 "%s set-mus-sound-header-type" #( file ) snd-test-neq 3454 file mus-lintn set-mus-sound-sample-type drop 3455 file mus-sound-sample-type mus-lintn 3456 "%s set-mus-sound-sample-type" #( file ) snd-test-neq 3457 file cur-srate set-mus-sound-srate drop 3458 file cur-samps set-mus-sound-samples drop 3459 file cur-chans set-mus-sound-chans drop 3460 file cur-loc set-mus-sound-data-location drop 3461 file cur-type set-mus-sound-header-type drop 3462 file cur-format set-mus-sound-sample-type drop 3463 end-each 3464 #( "test.wave" "test.rf64" "test.aifc" ) each to file 3465 file open-sound to ind 3466 ind srate to cur-srate 3467 ind chans to cur-chans 3468 ind sample-type to cur-format 3469 ind header-type to cur-type 3470 ind data-location to cur-loc 3471 ind framples to cur-samps 3472 ind cur-srate 2* set-srate drop 3473 ind srate cur-srate 2* "%s set-srate" #( ind file-name ) snd-test-neq 3474 cur-samps 2* ind set-framples drop 3475 ind framples cur-samps 2* "%s set-framples" #( ind file-name ) snd-test-neq 3476 ind cur-chans 2* set-chans drop \ ; this can change the index 3477 file find-sound to ind 3478 ind chans cur-chans 2* "%s set-chans" #( ind file-name ) snd-test-neq 3479 ind cur-loc 2* set-data-location drop 3480 ind data-location cur-loc 2* "%s set-data-location" #( ind file-name ) 3481 snd-test-neq 3482 ind mus-nist set-header-type drop 3483 ind header-type mus-nist "%s set-header-type" #( ind file-name ) 3484 snd-test-neq 3485 ind mus-lintn set-sample-type drop 3486 ind sample-type mus-lintn "%s set-sample-type" #( ind file-name ) 3487 snd-test-neq 3488 ind cur-srate set-srate drop 3489 cur-samps ind set-framples drop 3490 ind cur-chans set-chans drop 3491 ind cur-loc set-data-location drop 3492 ind cur-type set-header-type drop 3493 ind cur-format set-sample-type drop 3494 ind close-sound drop 3495 file file-delete 3496 end-each 3497 with-big-file if 3498 bigger-snd file-exists? if 3499 \ ; silence as last .9 secs, so it probably wasn't written 3500 44100 71999.1 f* floor f>d { probable-framples } 3501 3175160310 { our-framples } 3502 6350320648 { our-length } 3503 bigger-snd mus-sound-samples our-framples "bigger samples" 3504 #() snd-test-neq 3505 bigger-snd mus-sound-framples our-framples "bigger framples" 3506 #() snd-test-neq 3507 bigger-snd mus-sound-framples probable-framples <'> d= 3508 "bigger framples (probable)" #() snd-test-any-neq 3509 bigger-snd mus-sound-length our-length "bigger bytes" #() snd-test-neq 3510 bigger-snd mus-sound-duration 71999.1015 "bigger dur" #() snd-test-neq 3511 bigger-snd open-sound to ind 3512 ind framples our-framples "bigger framples" #() snd-test-neq 3513 ind framples to big-file-framples 3514 big-file-framples probable-framples <'> d= "bigger framples (probable)" 3515 #() snd-test-any-neq 3516 big-file-framples ind 0 0 framples "bigger edpos-framples" 3517 #() snd-test-neq 3518 44100 50000 d* ind add-mark to m1 3519 m1 mark-sample 44100 50000 d* "bigger mark at" #() snd-test-neq 3520 m1 44100 66000 d* set-mark-sample drop 3521 m1 mark-sample 44100 66000 d* "bigger mark to" #() snd-test-neq 3522 "oboe.snd" 44100 60000 d* mix-sound car { mx } 3523 mx mix? if 3524 mx mix-position 44100 60000 d* "bigger mix at" #() snd-test-neq 3525 mx 44100 61000 d* set-mix-position drop 3526 mx mix-position 44100 61000 d* "bigger mix to" #() snd-test-neq 3527 else 3528 "no mix tag from mix-sound" #() snd-display 3529 then 3530 2 undo drop 3531 <'> f0<> 1 make-proc find-channel to res 3532 res false? 3533 res 100 > || if 3534 "bigger find not 0.0: %s" #( res ) snd-display 3535 then 3536 selection-creates-region { old-select } 3537 #f set-selection-creates-region drop 3538 ind select-all drop 3539 selection-framples ind 0 undef framples "bigger select all" 3540 #() snd-test-neq 3541 44100 50000 d* set-selection-position drop 3542 selection-position 44100 50000 d* "bigger select pos" #() snd-test-neq 3543 0 set-selection-position drop 3544 44100 65000 d* set-selection-framples drop 3545 selection-framples 44100 65000 d* "bigger select len" #() snd-test-neq 3546 old-select set-selection-creates-region drop 3547 44100 50000 d* ind set-cursor drop 3548 ind cursor 44100 50000 d* "bigger cursor" #() snd-test-neq 3549 44123 51234 d* ind add-mark to m1 3550 m1 mark-sample 44123 51234 d* "bigger mark at" #() snd-test-neq 3551 44123 51234 d* find-mark { mid } 3552 mid m1 "bigger mark seach" #() snd-test-neq 3553 "oboe.snd" 44123 61234 d* mix-sound car to mx 3554 44123 61234 d* find-mix { mxd } 3555 mxd mx "bigger find-mix" #() snd-test-neq 3556 44123 51234 d* ind set-cursor drop 3557 ind cursor 44123 51234 d* "bigger cursor 123" #() snd-test-neq 3558 ind close-sound drop 3559 else \ bigger-snd not file-exists? 3560 "no such bigger file %s" #( bigger-snd ) snd-display 3561 then \ bigger-snd file-exists? 3562 then \ with-big-file 3563 \ 3564 "tmp.snd" 1 22050 mus-l24int mus-riff :size 100000 new-sound to ind 3565 selection-creates-region { old-selection-creates-region } 3566 #t set-selection-creates-region drop 3567 undef undef undef framples to len 3568 len 1/f { incr } 3569 -0.5 ( x ) 3570 len 0.0 make-vct map! 3571 ( x ) incr f+ dup 3572 end-map ( data ) 0 len undef undef undef "" vct->channel drop ( x ) drop 3573 save-sound drop 3574 ind close-sound drop 3575 "tmp.snd" open-sound to ind 3576 select-all { reg } 3577 "tmp1.snd" 22050 mus-l24int mus-next save-selection drop 3578 "tmp1.snd" open-sound { ind1 } 3579 -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1 3580 scan-channel to res 3581 res #f "l24 (next) selection not saved correctly" #() snd-test-neq 3582 ind1 close-sound drop 3583 "tmp1.snd" 22050 mus-l24int mus-aifc save-selection drop 3584 "tmp1.snd" open-sound to ind1 3585 -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1 3586 scan-channel to res 3587 res #f "l24 (aifc) selection not saved correctly" #() snd-test-neq 3588 ind1 close-sound drop 3589 reg "tmp1.snd" mus-l24int mus-next save-region drop 3590 "tmp1.snd" open-sound to ind1 3591 -0.5 undef undef undef framples 1/f sndlib-test-scan-x-cb 0 100000 ind1 3592 scan-channel to res 3593 res #f "l24 (next) region not saved correctly" #() snd-test-neq 3594 ind1 close-sound drop 3595 "tmp1.snd" file-delete 3596 ind close-sound drop 3597 "tmp.snd" file-delete 3598 old-selection-creates-region set-selection-creates-region drop 3599 \ 3600 "tmp.snd" 1 22050 mus-bfloat mus-next :size 10 :comment #f new-sound to ind 3601 <'> sndlib-test-map-set-1.0 map-channel drop 3602 '( 0 0 0.1 0.1 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 3603 0.6 0.6 0.7 0.7 0.8 0.8 0.9 0.9 ) env-channel drop 3604 channel->vct 3605 vct( 0.000 0.100 0.200 0.300 0.400 0.500 0.600 0.700 0.800 0.900 ) 3606 "ramp env by 0.1" #() snd-test-neq 3607 ind close-sound drop 3608; 3609 3610: sndlib-hook-2-t#-cb <{ a b -- f }> #t ; 3611: sndlib-hook-1-t#-cb <{ a -- f }> #t ; 3612 3613: make-aifc-file { frms auth-lo bits -- } 3614 "test.aif" make-file-output-port { io } 3615 io "FORM" port-write 3616 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o146 port-putc \ len 3617 io "AIFCFVER" port-write 3618 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ version chunk size 3619 io 0o242 port-putc io 0o200 port-putc io 0o121 port-putc io 0o100 port-putc \ version 3620 io "COMM" port-write 3621 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 3622 io 0o000 port-putc io 0o001 port-putc \ 1 chan 3623 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io frms port-putc \ framples 3624 io 0o000 port-putc io bits port-putc \ bits 3625 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 3626 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3627 \ srate as 80-bit float (sheesh) 3628 io "NONE" port-write \ compression 3629 io 0o016 port-putc \ pascal string len 3630 io "not compressed" port-write 3631 io 0o000 port-putc 3632 io "AUTH" port-write 3633 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io auth-lo port-putc \ AUTH chunk size 3634 io "bil" port-write 3635 io 0o000 port-putc 3636 io "SSND" port-write 3637 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 3638 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 3639 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 3640 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 3641 io port-close 3642; 3643 3644: (04-sndlib-02) ( -- ) 3645 open-raw-sound-hook reset-hook! 3646 open-raw-sound-hook <'> sndlib-hook-2-t#-cb add-hook! 3647 bad-header-hook reset-hook! 3648 bad-header-hook <'> sndlib-hook-1-t#-cb add-hook! 3649 open-raw-sound-hook empty? if 3650 "add-hook open-raw-sound-hook failed??" #() snd-display 3651 then 3652 bad-header-hook empty? if 3653 "add-hook bad-header-hook failed??" #() snd-display 3654 then 3655 #( ".snd" "FORM" "AIFF" "AIFC" "COMM" "COMT" "INFO" "INST" "inst" "MARK" 3656 "SSND" "FVER" "NONE" "ULAW" "ulaw" "ima4" "raw " "sowt" "in32" "in24" 3657 "ni23" "fl32" "FL32" "fl64" "twos" "ALAW" "alaw" "APPL" "CLM " "RIFF" 3658 "RIFX" "WAVE" "fmt " "data" "fact" "clm " "NIST" "8SVX" "16SV" "Crea" 3659 "tive" "SOUN" "D SA" "MPLE" "BODY" "VHDR" "CHAN" "ANNO" "NAME" "2BIT" 3660 "HCOM" "FSSD" "%//\n" "%---" "ALaw" "Soun" "MAUD" "MHDR" "MDAT" "mdat" 3661 "MThd" "sfbk" "sdta" "shdr" "pdta" "LIST" "GF1P" "ATCH" "$SIG" "NAL_" 3662 "GOLD" " SAM" "SRFS" "Diam" "ondW" "CSRE" "SND " "SNIN" "SNDT" "DDSF" 3663 "FSMu" "UWFD" "LM89" "SY80" "SY85" "SCRS" "DSPL" "AVI " "strf" "movi" 3664 "PRAM" " paf" "fap " "DS16" "HEDR" "HDR8" "SDA_" "SDAB" "SD_B" "NOTE" 3665 "file" "=sam" "SU7M" "SU7R" "PVF1" "PVF2" "AUTH" "riff" "TWIN" "IMPS" 3666 "SMP1" "Maui" "SDIF" "NVF " ) { magic-words } 3667 magic-words length { len } 3668 nil nil nil nil { magic io res ind } 3669 magic-words each to magic 3670 open-raw-sound-hook empty? if 3671 "open-raw-sound-hook cleared??" #() snd-display 3672 then 3673 bad-header-hook empty? if 3674 "bad-header-hook cleared??" #() snd-display 3675 then 3676 "test.snd" file-delete 3677 "test.snd" mus-sound-forget drop 3678 \ ;; try random garbage 3679 "test.snd" make-file-output-port to io 3680 io magic port-write 3681 128 0 do 3682 io "%f" #( 1.0 random ) port-write-format 3683 loop 3684 io port-close 3685 "test.snd" <'> open-sound #t nil fth-catch if 3686 stack-reset 3687 else 3688 to res 3689 res number? if 3690 res sound? if 3691 "open-sound garbage: %s %s" #( magic res ) snd-display 3692 res close-sound drop 3693 then 3694 then 3695 then 3696 "test.snd" file-delete 3697 "test.snd" mus-sound-forget drop 3698 \ ;; try plausible garbage 3699 "test.snd" make-file-output-port to io 3700 io magic port-write 3701 128 0 do 3702 io "%d" #( 128 random f>s ) port-write-format 3703 loop 3704 io port-close 3705 "test.snd" <'> open-sound #t nil fth-catch if 3706 stack-reset 3707 else 3708 to res 3709 res number? if 3710 res sound? if 3711 "open-sound plausible garbage: %s %s" #( magic res ) snd-display 3712 res close-sound drop 3713 then 3714 then 3715 then 3716 "test.snd" file-delete 3717 "test.snd" mus-sound-forget drop 3718 \ ;; write very plausible garbage 3719 "test.snd" make-file-output-port to io 3720 io magic port-write 3721 12 1 do 3722 io magic-words 3723 j ( ctr ) i + len < if 3724 j i + 3725 else 3726 i 3727 then array-ref port-write 3728 loop 3729 io port-close 3730 "test.snd" <'> open-sound #t nil fth-catch if 3731 stack-reset 3732 else 3733 to res 3734 res number? if 3735 res sound? if 3736 "open-sound very plausible garbage: %s %s" #( magic res ) snd-display 3737 res close-sound drop 3738 then 3739 then 3740 then 3741 end-each \ magic-words 3742 "test.snd" file-delete 3743 "test.snd" mus-sound-forget drop 3744 \ 3745 "test.snd" make-file-output-port to io 3746 io ".snd" port-write 3747 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o034 port-putc \ location 3748 io 0o000 port-putc io 0o001 port-putc io 0o215 port-putc io 0o030 port-putc \ nominal size 3749 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o022 port-putc \ format 3750 io 0o000 port-putc io 0o000 port-putc io 0o126 port-putc io 0o042 port-putc \ srate 3751 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ chans 3752 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ comment 3753 io 0o000 port-putc io 0o001 port-putc \ samp 1 3754 io port-close 3755 "test.snd" mus-sound-sample-type mus-bshort "next 18" #() snd-test-neq 3756 "test.snd" file-delete 3757 "test.snd" mus-sound-forget drop 3758 \ 3759 "test.snd" make-file-output-port to io 3760 io ".snd" port-write 3761 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ location 3762 io 0o000 port-putc io 0o001 port-putc io 0o215 port-putc io 0o030 port-putc \ nominal size 3763 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o022 port-putc \ format 3764 io 0o000 port-putc io 0o000 port-putc io 0o126 port-putc io 0o042 port-putc \ srate 3765 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ chans 3766 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ comment 3767 io 0o000 port-putc io 0o001 port-putc \ samp 1 3768 io port-close 3769 "test.snd" <'> open-sound #t nil fth-catch if 3770 stack-reset 3771 else 3772 to res 3773 res number? if 3774 res sound? if 3775 "open-sound next bad location %d: %s" 3776 #( res data-location res ) snd-display 3777 res close-sound drop 3778 then 3779 then 3780 then 3781 "test.snd" file-delete 3782 "test.snd" mus-sound-forget drop 3783 \ 3784 \ XXX: Opening this file triggers "not quoted: `pwd`/test.snd" from 3785 \ snd-file.c, function quoted_filename() (via translate). 3786 \ 3787 "test.snd" make-file-output-port to io 3788 io ".snd" port-write 3789 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o034 port-putc \ location 3790 io 0o000 port-putc io 0o001 port-putc io 0o215 port-putc io 0o030 port-putc \ nominal size 3791 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o122 port-putc \ format 3792 io 0o000 port-putc io 0o000 port-putc io 0o126 port-putc io 0o042 port-putc \ srate 3793 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ chans 3794 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ comment 3795 io 0o000 port-putc io 0o001 port-putc \ samp 1 3796 io port-close 3797 "test.snd" <'> open-sound #t nil fth-catch if 3798 stack-reset 3799 else 3800 to res 3801 res sound? if 3802 "open-sound next bad format %s: %s" #( res sample-type res ) snd-display 3803 res close-sound drop 3804 then 3805 then 3806 "test.snd" file-delete 3807 "test.snd" mus-sound-forget drop 3808 "test.aif" file-delete 3809 "test.aif" mus-sound-forget drop 3810 \ ;;correct (make-aifc-file #o002 #o004 #o020) 3811 0o102 0o004 0o020 make-aifc-file 3812 "test.aif" open-sound to ind 3813 ind framples 2 "bad framples in header" #() snd-test-neq 3814 ind close-sound drop 3815 "test.aif" file-delete 3816 "test.aif" mus-sound-forget drop 3817 \ 3818 0o002 0o150 0o020 make-aifc-file 3819 "test.aif" <'> open-sound #t nil fth-catch if 3820 stack-reset 3821 else 3822 to res 3823 res sound? if 3824 "open-sound aifc no ssnd chunk %d: %s" 3825 #( res data-location res ) snd-display 3826 res close-sound drop 3827 then 3828 then 3829 "test.aif" file-delete 3830 "test.aif" mus-sound-forget drop 3831 \ 3832 0o002 0o000 0o020 make-aifc-file 3833 "test.aif" <'> open-sound #t nil fth-catch if 3834 stack-reset 3835 else 3836 to res 3837 res sound? if 3838 "open-sound aifc 0-len auth chunk %d: %s" 3839 #( res data-location res ) snd-display 3840 res close-sound drop 3841 then 3842 then 3843 "test.aif" file-delete 3844 "test.aif" mus-sound-forget drop 3845 \ 3846 0o002 0o150 0o120 make-aifc-file 3847 "test.aif" <'> open-sound #t nil fth-catch if 3848 stack-reset 3849 else 3850 to res 3851 res sound? if 3852 "open-sound bits 80 %s: %s" #( res sample-type res ) snd-display 3853 res close-sound drop 3854 then 3855 then 3856 "test.aif" file-delete 3857 "test.aif" mus-sound-forget drop 3858 \ 3859 "test.aif" make-file-output-port to io 3860 io "FORM" port-write 3861 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o176 port-putc \ len 3862 io "AIFCFVER" port-write 3863 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ version chunk size 3864 io 0o242 port-putc io 0o200 port-putc io 0o121 port-putc io 0o100 port-putc \ version 3865 io "COMM" port-write 3866 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 3867 io 0o000 port-putc io 0o001 port-putc \ 1 chan 3868 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples 3869 io 0o000 port-putc io 0o020 port-putc \ bits 3870 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 3871 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3872 \ srate as 80-bit float (sheesh) 3873 io "NONE" port-write \ compression 3874 io 0o016 port-putc \ pascal string len 3875 io "not compressed" port-write 3876 io 0o000 port-putc 3877 io "AUTH" port-write 3878 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 3879 io "bil" port-write 3880 io 0o000 port-putc 3881 io "ANNO" port-write 3882 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 3883 io "cat" port-write 3884 io 0o000 port-putc 3885 io "NAME" port-write 3886 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 3887 io "dog" port-write 3888 io 0o000 port-putc 3889 io "SSND" port-write 3890 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 3891 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 3892 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 3893 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 3894 io port-close 3895 "test.aif" mus-sound-comment length 15 "aifc 3 aux comments" #() snd-test-neq 3896 "test.aif" file-delete 3897 "test.aif" mus-sound-forget drop 3898 \ 3899 "test.aif" make-file-output-port to io 3900 io "FORM" port-write 3901 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o142 port-putc \ len 3902 io "AIFC" port-write 3903 io "SSND" port-write 3904 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 3905 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 3906 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 3907 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 3908 io "COMM" port-write 3909 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 3910 io 0o000 port-putc io 0o001 port-putc \ 1 chan 3911 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples 3912 io 0o000 port-putc io 0o020 port-putc \ bits 3913 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 3914 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3915 \ srate as 80-bit float (sheesh) 3916 io "NONE" port-write \ compression 3917 io 0o016 port-putc \ pascal string len 3918 io "not compressed" port-write 3919 io 0o000 port-putc 3920 io "COMT" port-write 3921 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc 3922 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3923 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3924 io "bil" port-write 3925 io 0o000 port-putc 3926 io port-close 3927 "test.aif" mus-sound-comment 0 3 string-substring "bil" 3928 "aifc trailing comt comments" #() snd-test-neq 3929 "test.aif" mus-sound-framples 2 "aifc trailing comt framples" 3930 #() snd-test-neq 3931 "test.aif" open-sound to ind 3932 0 sample { s0 } 3933 1 sample { s1 } 3934 2 sample { s2 } 3935 3 sample { s3 } 3936 vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 ) 3937 "aifc trailing comt samps" #() snd-test-neq 3938 ind close-sound drop 3939 "test.aif" file-delete 3940 "test.aif" mus-sound-forget drop 3941 \ 3942 "test.aif" make-file-output-port to io 3943 io "FORM" port-write 3944 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o142 port-putc \ len 3945 io "AIFC" port-write 3946 io "SSND" port-write 3947 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 3948 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 3949 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 3950 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 3951 io "COMM" port-write 3952 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 3953 io 0o000 port-putc io 0o001 port-putc \ 1 chan 3954 io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ framples 3955 io 0o000 port-putc io 0o020 port-putc \ bits 3956 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 3957 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3958 \ srate as 80-bit float (sheesh) 3959 io "NONE" port-write \ compression 3960 io 0o016 port-putc \ pascal string len 3961 io "not compressed" port-write 3962 io 0o000 port-putc 3963 io "COMT" port-write 3964 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc 3965 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3966 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 3967 io "bil" port-write 3968 io 0o000 port-putc 3969 io port-close 3970 "test.aif" mus-sound-comment 0 3 string-substring "bil" 3971 "aifc trailing comt comments" #() snd-test-neq 3972 "test.aif" mus-sound-framples 2 "aifc trailing comt (bogus) framples" 3973 #() snd-test-neq 3974 "test.aif" open-sound to ind 3975 0 sample to s0 3976 1 sample to s1 3977 2 sample to s2 3978 3 sample to s3 3979 vct( s0 s1 s2 s3 ) vct( 0.00198 0.00195 0.0 0.0 ) 3980 "aifc trailing comt samps (bogus frame setting)" #() snd-test-neq 3981 ind close-sound drop 3982 "test.aif" file-delete 3983 "test.aif" mus-sound-forget drop 3984 \ 3985 "test.aif" make-file-output-port to io 3986 io "FORM" port-write 3987 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o142 port-putc \ len 3988 io "AIFC" port-write 3989 io "SSND" port-write 3990 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 3991 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 3992 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 3993 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 3994 io "COMM" port-write 3995 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 3996 io 0o000 port-putc io 0o001 port-putc \ 1 chan 3997 io 0o000 port-putc io 0o000 port-putc io 0o100 port-putc io 0o102 port-putc \ framples 3998 io 0o000 port-putc io 0o020 port-putc \ bits 3999 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 4000 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 4001 \ srate as 80-bit float (sheesh) 4002 io "NONE" port-write \ compression 4003 io 0o016 port-putc \ pascal string len 4004 io "not compressed" port-write 4005 io 0o000 port-putc 4006 io "SSND" port-write 4007 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 4008 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 4009 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 4010 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 4011 io port-close 4012 "test.aif" <'> open-sound #t nil fth-catch if 4013 stack-reset 4014 else 4015 to res 4016 res sound? if 4017 "open-sound aifc 2 ssnd chunks %d: %s" 4018 #( res data-location res ) snd-display 4019 res close-sound drop 4020 then 4021 then 4022 "test.aif" file-delete 4023 "test.aif" mus-sound-forget drop 4024 \ 4025 "test.aif" make-file-output-port to io 4026 io "FORM" port-write 4027 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o040 port-putc \ len 4028 io "AIFC" port-write 4029 io "SSND" port-write 4030 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 4031 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 4032 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 4033 io 0o000 port-putc io 0o101 port-putc io 0o000 port-putc io 0o100 port-putc \ two samples 4034 io port-close 4035 "test.aif" <'> open-sound snd-test-catch to res 4036 res car 'mus-error "open-sound aifc no comm chunk: %s" #( res ) snd-test-neq 4037 sounds each ( snd ) 4038 close-sound drop 4039 end-each 4040 "test.aif" file-delete 4041 "test.aif" mus-sound-forget drop 4042 \ 4043 "test.aif" make-file-output-port to io 4044 \ write AIFC with trailing chunks to try to confuse file->sample 4045 io "FORM" port-write 4046 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o176 port-putc \ len 4047 io "AIFCFVER" port-write 4048 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ version chunk size 4049 io 0o242 port-putc io 0o200 port-putc io 0o121 port-putc io 0o100 port-putc \ version 4050 io "COMM" port-write 4051 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 4052 io 0o000 port-putc io 0o001 port-putc \ 1 chan 4053 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples 4054 io 0o000 port-putc io 0o020 port-putc \ bits 4055 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 4056 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 4057 \ srate as 80-bit float (sheesh) 4058 io "NONE" port-write \ compression 4059 io 0o016 port-putc \ pascal string len 4060 io "not compressed" port-write 4061 io 0o000 port-putc 4062 io "SSND" port-write 4063 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 4064 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 4065 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 4066 io 0o170 port-putc io 0o101 port-putc io 0o100 port-putc io 0o100 port-putc \ two samples 4067 io "AUTH" port-write 4068 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 4069 io "bil" port-write 4070 io 0o000 port-putc 4071 io "ANNO" port-write 4072 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 4073 io "cat" port-write 4074 io 0o000 port-putc 4075 io "NAME" port-write 4076 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ AUTH chunk size 4077 io "dog" port-write 4078 io 0o000 port-putc 4079 io port-close 4080 "test.aif" make-file->sample { gen } 4081 gen #( 0 ) object-apply 0.93948 "file->sample chunked 0" #() snd-test-neq 4082 gen #( 1 ) object-apply 0.50195 "file->sample chunked 1" #() snd-test-neq 4083 gen #( 2 ) object-apply 0.0 "file->sample chunked eof" #() snd-test-neq 4084 gen #( 3 ) object-apply 0.0 "file->sample chunked eof+1" #() snd-test-neq 4085 "test.aif" open-sound to ind 4086 ind framples 2 "chunked framples" #() snd-test-neq 4087 0 sample 0.93948 "file chunked 0" #() snd-test-neq 4088 1 sample 0.50195 "file chunked 1" #() snd-test-neq 4089 2 sample 0.0 "file chunked eof" #() snd-test-neq 4090 3 sample 0.0 "file chunked eof+1" #() snd-test-neq 4091 ind close-sound drop 4092 "test.aif" mus-sound-framples 2 "chunked mus-sound-framples" #() snd-test-neq 4093 "test.aif" file-delete 4094 "test.aif" mus-sound-forget drop 4095 \ 4096 "test.aif" make-file-output-port to io 4097 \ write AIFC with trailing chunks to try to confuse file->sample 4098 io "FORM" port-write 4099 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o176 port-putc \ len 4100 io "AIFCFVER" port-write 4101 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ version chunk size 4102 io 0o242 port-putc io 0o200 port-putc io 0o121 port-putc io 0o100 port-putc \ version 4103 io "SSND" port-write 4104 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 4105 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 4106 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 4107 io 0o170 port-putc io 0o101 port-putc io 0o100 port-putc io 0o100 port-putc \ two samples 4108 io "COMM" port-write 4109 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 4110 io 0o000 port-putc io 0o001 port-putc \ 1 chan 4111 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o002 port-putc \ framples 4112 io 0o000 port-putc io 0o020 port-putc \ bits 4113 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 4114 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 4115 \ srate as 80-bit float (sheesh) 4116 io "NONE" port-write \ compression 4117 io 0o016 port-putc \ pascal string len 4118 io "not compressed" port-write 4119 io 0o000 port-putc 4120 io "APPL" port-write 4121 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io <char> h port-putc 4122 io "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write 4123 io 0o000 port-putc 4124 io port-close 4125 "test.aif" make-file->sample to gen 4126 gen #( 0 ) object-apply 0.93948 "file->sample chunked 0" #() snd-test-neq 4127 gen #( 1 ) object-apply 0.50195 "file->sample chunked 1" #() snd-test-neq 4128 gen #( 2 ) object-apply 0.0 "file->sample chunked eof" #() snd-test-neq 4129 gen #( 3 ) object-apply 0.0 "file->sample chunked eof+1" #() snd-test-neq 4130 "test.aif" open-sound to ind 4131 ind framples 2 "chunked framples" #() snd-test-neq 4132 0 sample 0.93948 "file chunked 0" #() snd-test-neq 4133 1 sample 0.50195 "file chunked 1" #() snd-test-neq 4134 2 sample 0.0 "file chunked eof" #() snd-test-neq 4135 3 sample 0.0 "file chunked eof+1" #() snd-test-neq 4136 comment ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" 4137 "chunked appl comment" #() snd-test-neq 4138 ind close-sound drop 4139 "test.aif" file-delete 4140 "test.aif" mus-sound-forget drop 4141 \ 4142 "test.aif" make-file-output-port to io 4143 \ write AIFC with trailing chunks to try to confuse file->sample 4144 io "FORM" port-write 4145 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o176 port-putc \ len 4146 io "AIFCFVER" port-write 4147 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o004 port-putc \ version chunk size 4148 io 0o242 port-putc io 0o200 port-putc io 0o121 port-putc io 0o100 port-putc \ version 4149 io "SSND" port-write 4150 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o014 port-putc \ SSND chunk size 4151 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ SSND data loc 4152 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc \ block size? 4153 io 0o170 port-putc io 0o101 port-putc io 0o100 port-putc io 0o100 port-putc \ two samples 4154 io "COMM" port-write 4155 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o046 port-putc \ COMM chunk size 4156 io 0o000 port-putc io 0o002 port-putc \ 2 chans 4157 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o001 port-putc \ framples 4158 io 0o000 port-putc io 0o020 port-putc \ bits 4159 io 0o100 port-putc io 0o016 port-putc io 0o254 port-putc io 0o104 port-putc io 0o000 port-putc 4160 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc 4161 \ srate as 80-bit float (sheesh) 4162 io "NONE" port-write \ compression 4163 io 0o016 port-putc \ pascal string len 4164 io "not compressed" port-write 4165 io 0o000 port-putc 4166 io "APPL" port-write 4167 io 0o000 port-putc io 0o000 port-putc io 0o000 port-putc io <char> h port-putc 4168 io "CLM ;Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" port-write 4169 io 0o000 port-putc 4170 io port-close 4171 "test.aif" make-file->sample to gen 4172 gen #( 0 0 ) object-apply 0.93948 "file->sample chunked 0 0" #() snd-test-neq 4173 gen #( 0 1 ) object-apply 0.50195 "file->sample chunked 0 1" #() snd-test-neq 4174 gen #( 1 0 ) object-apply 0.0 "file->sample chunked eof (stereo)" #() 4175 snd-test-neq 4176 gen #( 1 1 ) object-apply 0.0 "file->sample chunked eof+1 (stereo)" #() 4177 snd-test-neq 4178 "test.aif" open-sound to ind 4179 ind framples 1 "chunked framples (1)" #() snd-test-neq 4180 0 ind 0 sample 0.93948 "file chunked 0 0" #() snd-test-neq 4181 0 ind 1 sample 0.50195 "file chunked 0 1" #() snd-test-neq 4182 1 ind 0 sample 0.0 "file chunked eof (stereo)" #() snd-test-neq 4183 1 ind 1 sample 0.0 "file chunked eof+1 (stereo)" #() snd-test-neq 4184 comment ";Written Mon 02-Nov-98 01:44 CST by root at ockeghem (Linux/X86) using Allegro CL, clm of 20-Oct-98" 4185 "chunked appl comment (stereo)" #() snd-test-neq 4186 ind close-sound drop 4187 "test.aif" file-delete 4188 "test.aif" mus-sound-forget drop 4189 \ 4190 file-pwd sound-files-in-directory { files } 4191 files empty? if 4192 "no sound files in %s?" #( file-pwd ) snd-display 4193 then 4194 sound-files-in-directory { files1 } 4195 files files1 "different sound files in %s and default" #( file-pwd ) 4196 snd-test-neq 4197 "." sound-files-in-directory { files2 } 4198 files1 files2 "sound-files-in-directory dot" #() snd-test-neq 4199 files files2 "sound-files-in-directory dot" #() snd-test-neq 4200 \ 4201 bad-header-hook reset-hook! 4202 open-raw-sound-hook reset-hook! 4203 sounds each ( snd ) 4204 close-sound drop 4205 end-each 4206 \ 4207 :size 0 new-sound to ind 4208 ind framples 0 "new-sound :size 0 framples" #() snd-test-neq 4209 0 sample 0.0 "new-sound :size 0 sample 0" #() snd-test-neq 4210 ind file-name { new-file-name } 4211 ind close-sound drop 4212 new-file-name file-delete 4213 :size 1 new-sound to ind 4214 ind framples 1 "new-sound :size 1 framples" #() snd-test-neq 4215 0 sample 0.0 "new-sound :size 1 sample 0" #() snd-test-neq 4216 ind file-name to new-file-name 4217 ind close-sound drop 4218 new-file-name file-delete 4219 :size -1 <'> new-sound snd-test-catch to res 4220 res car 'out-of-range "new-sound :size -1: %s" #( res ) snd-test-neq 4221 \ 4222 "caruso.asc" check-file-name { fsnd } 4223 fsnd file-exists? if 4224 fsnd read-ascii to ind 4225 ind sound? if 4226 ind 0 maxamp 0.723 "read-ascii maxamp" #() snd-test-neq 4227 ind 0 framples 50000 "read-ascii framples" #() snd-test-neq 4228 ind srate 44100 "read-ascii srate" #() snd-test-neq 4229 ind 8000 set-srate drop 4230 ind 0 maxamp 0.723 "set srate clobbered new sound (maxamp)" 4231 #() snd-test-neq 4232 ind 0 framples 50000 "set srate clobbered new sound (framples)" 4233 #() snd-test-neq 4234 ind close-sound drop 4235 else 4236 "read-ascii can't find %s?" #( fsnd ) snd-display 4237 then 4238 then 4239 \ 4240 "oboe.snd" open-sound to ind 4241 "test space.snd" save-sound-as drop 4242 ind close-sound drop 4243 "test space.snd" open-sound to ind 4244 ind short-file-name "test space.snd" "file name with space" #() snd-test-neq 4245 ind framples "test space.snd" mus-sound-framples "spaced filename framples" 4246 #() snd-test-neq 4247 1234 ind 0 add-mark drop 4248 ind save-marks drop \ ; should write "test space.marks" 4249 ind close-sound drop 4250 "test space.snd" open-sound to ind 4251 file-pwd "/" $+ "test space.marks" $+ file-eval 4252 1234 ind find-mark unless 4253 "space file name save marks?" #() snd-display 4254 then 4255 :file "test space.snd" make-readin { rd } 4256 rd mus-file-name "test space.snd" "file name with space readin" #() 4257 snd-test-neq 4258 ind close-sound drop 4259 "test space.snd" file-delete 4260 "test space.marks" file-delete 4261 \ XXX: S7 specific tests skipped 4262; 4263 4264: 04-sndlib ( -- ) 4265 *tests* 0 ?do 4266 i to *clmtest* 4267 *snd-test-verbose* 4268 *tests* 1 > && if 4269 "clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message 4270 then 4271 clear-listener drop 4272 (04-sndlib-01) 4273 loop 4274 (04-sndlib-02) 4275; 4276 4277\ ---------------- test 05: simple overall checks ---------------- 4278 4279: ccvp-01-cb { y data forward -- r } 4280 data 0 vct-ref { angle } 4281 data 1 vct-ref { incr } 4282 angle fcos y f* { val } 4283 data 0 angle incr forward if f+ else f- then vct-set! drop 4284 val 4285; 4286 4287half-pi fnegate constant -half-pi 4288 4289: ccvp-02-cb { frag-beg frag-dur -- v } 4290 pi frag-dur f/ { incr } 4291 -half-pi frag-beg incr f* f+ 4292 incr 2 >vct 4293; 4294 42950 value a-ctr 42960 value g-init-val 4297 4298: append-sound { fname -- } 4299 fname undef undef undef framples insert-sound drop 4300; 4301 4302: cc-01-cb { incr -- prc; y self -- r } 4303 1 proc-create incr , -half-pi ( angle ) , ( prc ) 4304 does> { y self -- r } 4305 self @ { incr } 4306 self cell+ @ { angle } 4307 y angle f* { val } 4308 angle incr f+ self cell+ ! ( angle += incr ) 4309 val 4310; 4311 4312: cosine-channel <{ :optional beg 0 dur #f snd #f chn #f edpos #f -- }> 4313 pi dur if 4314 dur 4315 else 4316 snd chn undef framples 4317 then f/ ( incr ) cc-01-cb beg dur snd chn edpos map-channel drop 4318; 4319 4320: (05-simple-check-01) ( -- ) 4321 playing if 4322 "dac is running??" #() snd-display 4323 then 4324 "oboe.snd" open-sound { ind } 4325 #t ind 0 set-transform-graph? drop 4326 graph-as-sonogram ind 0 set-transform-graph-type drop 4327 "hiho" ind 0 1 <'> y-axis-label 'no-such-axis nil fth-catch if 4328 "no fft axis?" #() snd-display 4329 then 4330 stack-reset 4331 #t ind 0 set-fft-log-frequency drop 4332 ind 0 update-transform-graph drop 4333 ind close-sound drop 4334; 4335 4336: 05-simple-check ( -- ) 4337 *tests* 0 ?do 4338 i to *clmtest* 4339 *snd-test-verbose* 4340 *tests* 1 > && if 4341 "clmtest %d of %d" #( *clmtest* 1+ *tests* ) snd-test-message 4342 then 4343 (05-simple-check-01) 4344 loop 4345; 4346 4347\ ---------------- test 08: clm ---------------- 4348 4349\ xen-mus-apply (using mus-run): 4350\ args are optional, defaulting to 0.0 4351\ S7: (gen arg1 arg2) 4352\ Ruby: gen.call(arg1, arg2) 4353\ Forth: gen '( arg1 arg2 ) apply 4354\ 4355\ mus-apply ( args -- res ) args => gen arg1=0.0 arg2=0.0 4356\ mus-apply ( -- 0.0 ) if gen is omitted, 0.0 is returned 4357\ mus-run ( gen :optional arg1 0.0 arg2 0.0 -- res ) 4358 4359lambda: <{ -- r }> 0.0 ; value 08-clm-lambda-0.0 4360lambda: <{ dir -- r }> 1.0 ; value 08-clm-lambda-dir-1.0 4361lambda: <{ a b c -- r }> 1.0 ; value 08-clm-lambda-a-b-c-1.0 436232 make-delay constant make-delay-32 4363 4364: random-gen-run ( ?? make-prc random-args -- ) 4365 { make-prc random-args } 4366 make-prc #t nil fth-catch if 4367 #f 4368 then { gen } 4369 stack-reset 4370 nil { arg } 4371 gen if 4372 random-args each to arg 4373 \ ~438.780s apply 4374 \ ~513.470s mus-run 4375 \ ~499.570s mus-apply 4376 gen '( arg 0.0 ) <'> apply #t nil fth-catch 4377 \ gen arg 0.0 <'> mus-run #t nil fth-catch 4378 \ gen arg 0.0 <'> mus-apply #t nil fth-catch 4379 stack-reset 4380 end-each 4381 then 4382; 4383 4384: random-gen ( -- ) 4385 #( 2.0 21.5 f** 4386 2.0 -18.0 f** 4387 1.5 4388 "/hiho" 4389 list( 0 1 ) 4390 1234 4391 vct( 0 0 0 ) 4392 0.1 0.2 0.3 make-color-with-catch 4393 #( 0 1 ) 4394 3/4 4395 0+i 4396 make-delay-32 4397 08-clm-lambda-0.0 4398 08-clm-lambda-dir-1.0 4399 08-clm-lambda-a-b-c-1.0 4400 0 4401 1 4402 -1 4403 #f 4404 #t 4405 <char> c 4406 0.0 4407 1.0 4408 -1.0 4409 '() 4410 32 4411 '( 1 2 ) ) { random-args } 4412 #( <'> make-all-pass <'> make-asymmetric-fm <'> make-moving-average 4413 <'> make-moving-max <'> make-moving-norm <'> make-table-lookup 4414 <'> make-triangle-wave <'> make-comb <'> make-delay <'> make-env 4415 <'> make-fft-window <'> make-filter <'> make-filtered-comb 4416 <'> make-fir-filter <'> make-formant <'> make-iir-filter <'> make-locsig 4417 <'> make-notch <'> make-one-pole <'> make-one-pole-all-pass 4418 <'> make-one-zero <'> make-oscil <'> make-pulse-train 4419 <'> make-rand <'> make-rand-interp <'> make-sawtooth-wave 4420 <'> make-polyshape <'> make-polywave <'> make-square-wave 4421 <'> make-two-pole <'> make-two-zero <'> make-wave-train 4422 <'> make-ssb-am ) { gen-make-procs } 4423 nil { make-prc } 4424 nil nil nil nil { arg1 arg2 arg3 arg4 } 4425 gen-make-procs each to make-prc 4426 make-prc random-args random-gen-run 4427 end-each 4428 random-args each to arg1 4429 gen-make-procs each to make-prc 4430 arg1 make-prc random-args random-gen-run 4431 end-each 4432 random-args each to arg2 4433 gen-make-procs each to make-prc 4434 arg1 arg2 make-prc random-args random-gen-run 4435 end-each 4436 random-args each to arg3 4437 gen-make-procs each to make-prc 4438 arg1 arg2 arg3 make-prc random-args random-gen-run 4439 end-each 4440 all-args if 4441 random-args each to arg4 4442 gen-make-procs each to make-prc 4443 arg1 arg2 arg3 arg4 make-prc random-args random-gen-run 4444 end-each 4445 end-each 4446 then 4447 end-each 4448 end-each 4449 end-each 4450; 4451 4452: 08-clm ( -- ) 4453 random-gen 4454 \ XXX: asymmetric-fm brings fth out of sync resulting in 4455 \ #<undefined-word in interpret: 10>. 4456 \ With this trick we are in sync again. 4457 "0" <'> string->number 'undefined-word nil fth-catch 4458 stack-reset 4459; 4460 4461\ ---------------- test 10: marks ---------------- 4462 4463: 10-marks ( -- ) 4464 "oboe.snd" open-sound { ind } 4465 123 add-mark drop 4466 234 ind 0 "hiho" 1 add-mark drop 4467 345 ind 0 #f 1 add-mark drop 4468 456 ind 0 "a mark" 2 add-mark drop 4469 567 ind 0 #f 1 add-mark drop 4470 ind "oboe.marks" save-marks drop 4471 ind close-sound drop 4472 "oboe.snd" open-sound to ind 4473 1 ind 0 "new mark" 1 add-mark drop 4474 "oboe.marks" file-eval 4475 123 ind 0 find-mark { m } 4476 m mark? if 4477 m mark-name length zero? unless 4478 "saved mark 123 name: %s?" #( m mark-name ) snd-display 4479 then 4480 m mark-sync zero? unless 4481 "saved mark 123 sync: %s?" #( m mark-sync ) snd-display 4482 then 4483 else 4484 "saved marks missed 123: %s?" #( m ) snd-display 4485 then 4486 234 ind 0 find-mark to m 4487 m mark? if 4488 m mark-name "hiho" string<> if 4489 "saved mark 234 name: %s?" #( m mark-name ) snd-display 4490 then 4491 m mark-sync { m2sync } 4492 m2sync 0= m2sync 1 = || if 4493 "saved mark 234 sync: %s?" #( m mark-sync ) snd-display 4494 then 4495 m mark-sync 4496 else 4497 "saved marks missed 234: %s?" #( m ) snd-display 4498 0 4499 then { m1-sync } 4500 345 ind 0 find-mark to m 4501 m mark? if 4502 m mark-name length zero? unless 4503 "saved mark 345 name: %s?" #( m mark-name ) snd-display 4504 then 4505 m mark-sync m1-sync <> if 4506 "saved mark 345 sync: %s %s?" #( m mark-sync m1-sync ) snd-display 4507 then 4508 else 4509 "saved marks missed 345: %s?" #( m ) snd-display 4510 then 4511 456 ind 0 find-mark to m 4512 m mark? if 4513 m mark-name "a mark" string<> if 4514 "saved mark 456 name: %s?" #( m mark-name ) snd-display 4515 then 4516 m mark-sync { m4sync } 4517 m4sync m1-sync = m4sync 0= || m4sync 1 = || if 4518 "saved mark 456 sync: %s %s?" #( m mark-sync m1-sync ) snd-display 4519 then 4520 else 4521 "saved marks missed 456: %s?" #( m ) snd-display 4522 then 4523 567 ind 0 find-mark to m 4524 m mark? if 4525 m mark-name length zero? unless 4526 "saved mark 567 name: %s?" #( m mark-name ) snd-display 4527 then 4528 m mark-sync m1-sync <> if 4529 "saved mark 567 sync: %s %s?" #( m mark-sync m1-sync ) snd-display 4530 then 4531 else 4532 "saved marks missed 567: %s?" #( m ) snd-display 4533 then 4534 ind close-sound drop 4535; 4536 4537\ ---------------- test 15: chan-local vars ---------------- 4538 4539: interpolated-peak-offset ( r1 r2 r3 -- r4 ) 4540 { la ca ra } 4541 la ca fmax ra fmax 0.001 f+ { pk } 4542 la 0.0000001 fmax pk f/ flog 10 flog f/ { logla } 4543 ca 0.0000001 fmax pk f/ flog 10 flog f/ { logca } 4544 ra 0.0000001 fmax pk f/ flog 10 flog f/ { logra } 4545 logla logra f- f2/ 4546 logla logra f+ 4547 logca f2* f- f/ 4548; 4549 4550: freq-peak { beg ind size -- lst } 4551 beg size ind 0 channel->vct { data } 4552 data blackman2-window size #t 0.0 #f #t snd-spectrum { spectr } 4553 0.0 { peak0 } 4554 0 { pk0loc } 4555 size 2/ 0 ?do 4556 spectr i vct-ref peak0 f> if 4557 spectr i vct-ref to peak0 4558 i to pk0loc 4559 then 4560 loop 4561 pk0loc 0> if 4562 spectr pk0loc 1- vct-ref spectr pk0loc vct-ref spectr pk0loc 1+ vct-ref 4563 interpolated-peak-offset 4564 else 4565 0.0 4566 then pk0loc f+ #f srate f* size f/ peak0 2 >array 4567; 4568 4569: src-test15-cb ( os -- proc; y self -- val ) 4570 1 proc-create swap , 4571 does> { y self -- val } 4572 self @ ( os ) 0.0 0.0 oscil f2/ 4573; 4574 4575: f3neq ( a b -- f ) f- fabs 10.0 f> ; 4576: f4neq ( a b -- f ) f- fabs 1.0 f> ; 4577: f5neq ( a b -- f ) { a b } a b f- fabs 10.0 a b fmax 0.05 f* f> ; 4578 4579*with-test-complex* [if] 4580 \ dolph/dolph-1 are only defined if complex numbers available 4581 : dolph-test ( -- ) 4582 16 1.0 dolph { val1 } 4583 dolph-chebyshev-window 16 1.0 make-fft-window { val2 } 4584 val1 val2 vequal? unless 4585 "dolph/dolph 1: %s %s" #( val1 val2 ) snd-display 4586 then 4587 16 1.0 dolph-1 to val1 4588 val1 val2 vequal? unless 4589 "dolph-1/dolph 1: %s %s" #( val1 val2 ) snd-display 4590 then 4591 ; 4592[else] 4593 <'> noop alias dolph-test 4594[then] 4595 4596: 15-chan-local-vars ( -- ) 4597 mus-srate f>s { old-srate } 4598 22050 to *clm-srate* 4599 \ dsp.fs 4600 "test.snd" 1 22050 mus-bfloat mus-next "src-* tests" 10000 new-sound { ind } 4601 \ src-duration tests 4602 #( 0 1 1 2 ) src-duration { d1 } 4603 #( 0 2 1 1 ) src-duration { d2 } 4604 #( 0 1 0.5 2 ) src-duration { d3 } 4605 #( 0.5 1 0.75 2 ) src-duration { d4 } 4606 d1 0.693147180559945 fneq 4607 d2 d1 fneq || 4608 d3 d1 fneq || 4609 d4 d1 fneq || if 4610 "src-duration test1: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display 4611 then 4612 #( 0 1 1 0.5 ) src-duration to d1 4613 #( 0 0.5 1 1 ) src-duration to d2 4614 #( 0 1 0.5 0.5 ) src-duration to d3 4615 #( 0.5 1 0.75 0.5 ) src-duration to d4 4616 d1 1.38629436111989 fneq 4617 d2 d1 fneq || 4618 d3 d1 fneq || 4619 d4 d1 fneq || if 4620 "src-duration test2: %f %f %f %f" #( d1 d2 d3 d4 ) snd-display 4621 then 4622 #( 0 1 1 1 ) src-duration to d1 4623 #( 0 2 1 2 ) src-duration to d2 4624 d1 1.0 fneq 4625 d2 0.5 fneq || if 4626 "src-duration test3: %f %f" #( d1 d2 ) snd-display 4627 then 4628 #( 0 0.5 0.5 3 0.6 1 0.7 0.1 0.8 1.5 1 1 ) src-duration to d1 4629 d1 1.02474349685432 fneq if 4630 "src-duration test4: %f" #( d1 ) snd-display 4631 then 4632 #( 0 1 1 2 2 1 ) src-duration to d1 4633 d1 0.693147180559945 fneq if 4634 "src-duration test5: %f" #( d1 ) snd-display 4635 then 4636 500.0 0.0 make-oscil src-test15-cb map-channel drop 4637 0 ind 8192 freq-peak { vals } 4638 500.0 vals 0 array-ref f4neq 4639 1.0 vals 1 array-ref fneq || if 4640 "src no-test: %s" #( vals ) snd-display 4641 then 4642 ind close-sound drop 4643 \ 4644 dolph-test 4645 \ env.fs 4646 \ envelope-interp 4647 0.1 #( 0 0 1 1 ) 1.0 envelope-interp dup 0.1 fneq if 4648 "envelope-interp 0.1: %s?" swap snd-display 4649 else 4650 drop 4651 then 4652 0.1 #( 0 0 1 1 ) 32.0 envelope-interp dup 0.01336172 fneq if 4653 "envelope-interp 0.013: %s?" swap snd-display 4654 else 4655 drop 4656 then 4657 0.1 #( 0 0 1 1 ) 0.012 envelope-interp dup 0.36177473 fneq if 4658 "envelope-interp 0.361: %s?" swap snd-display 4659 else 4660 drop 4661 then 4662 0.3 #( 0 0 0.5 1 1 0 ) 1.0 envelope-interp dup 0.6 fneq if 4663 "envelope-interp 0.3 #( 0 0 0.5 1 1 0 ): %s?" swap snd-display 4664 else 4665 drop 4666 then 4667 \ window-envelope 4668 1.0 3.0 #( 0.0 0.0 5.0 1.0 ) window-envelope dup #( 1.0 0.2 3.0 0.6 ) feql if 4669 drop 4670 else 4671 1 >array "window-envelope: %s?" swap snd-display 4672 then 4673 \ multiply-envelopes 4674 #( 0 0 1 1 ) #( 0 0 1 1 2 0 ) multiply-envelopes dup 4675 #( 0 0 0.5 0.5 1 0 ) feql if 4676 drop 4677 else 4678 1 >array "multiply-envelopes: %s?" swap snd-display 4679 then 4680 \ max-envelope 4681 #( 0 0 1 1 2 3 4 0 ) max-envelope dup 3.0 fneq if 4682 "max-envelopes (0): %s?" swap snd-display 4683 else 4684 drop 4685 then 4686 #( 0 1 ) max-envelope dup 1.0 fneq if 4687 "max-envelopes (1): %s?" swap snd-display 4688 else 4689 drop 4690 then 4691 #( 0 1 1 1 2 2 ) max-envelope dup 2.0 fneq if 4692 "max-envelopes (2): %s?" swap snd-display 4693 else 4694 drop 4695 then 4696 #( 0 -1 1 -2 ) max-envelope dup -1.0 fneq if 4697 "max-envelopes (3): %s?" swap snd-display 4698 else 4699 drop 4700 then 4701 #( 0 -2 1 -1 ) max-envelope dup -1.0 fneq if 4702 "max-envelopes (4): %s?" swap snd-display 4703 else 4704 drop 4705 then 4706 \ min-envelope 4707 #( 0 0 1 1 2 3 4 0 ) min-envelope dup 0.0 fneq if 4708 "min-envelopes (0): %s?" swap snd-display 4709 else 4710 drop 4711 then 4712 #( 0 1 ) min-envelope dup 1.0 fneq if 4713 "min-envelopes (1): %s?" swap snd-display 4714 else 4715 drop 4716 then 4717 #( 0 1 1 1 2 2 ) min-envelope dup 1.0 fneq if 4718 "min-envelopes (2): %s?" swap snd-display 4719 else 4720 drop 4721 then 4722 #( 0 -1 1 -2 ) min-envelope dup -2.0 fneq if 4723 "min-envelopes (3): %s?" swap snd-display 4724 else 4725 drop 4726 then 4727 #( 0 -2 1 -1 ) min-envelope dup -2.0 fneq if 4728 "min-envelopes (4): %s?" swap snd-display 4729 else 4730 drop 4731 then 4732 \ integrate-envelope 4733 #( 0 0 1 1 ) integrate-envelope dup 0.5 fneq if 4734 "integrate-envelopes (0): %s?" swap snd-display 4735 else 4736 drop 4737 then 4738 #( 0 1 1 1 ) integrate-envelope dup 1.0 fneq if 4739 "integrate-envelopes (1): %s?" swap snd-display 4740 else 4741 drop 4742 then 4743 #( 0 0 1 1 2 0.5 ) integrate-envelope dup 1.25 fneq if 4744 "integrate-envelopes (2): %s?" swap snd-display 4745 else 4746 drop 4747 then 4748 \ stretch-envelope 4749 #( 0 0 1 1 ) 0.1 0.2 #f #f stretch-envelope dup #( 0 0 0.2 0.1 1.0 1 ) 4750 feql if 4751 drop 4752 else 4753 1 >array "stretch-envelope att: %s?" swap snd-display 4754 then 4755 #( 0 0 1 1 2 0 ) 0.1 0.2 1.5 1.6 stretch-envelope 4756 dup #( 0 0 0.2 0.1 1.1 1 1.6 0.5 2 0 ) feql if 4757 drop 4758 else 4759 1 >array "stretch-envelope dec: %s?" swap snd-display 4760 then 4761 \ add-envelopes 4762 #( 0 0 1 1 2 0 ) #( 0 0 1 1 ) add-envelopes 4763 dup #( 0 0 0.5 1.5 1 1 ) feql if 4764 drop 4765 else 4766 1 >array "add-envelopes: %s?" swap snd-display 4767 then 4768 \ scale-envelope 4769 #( 0 0 1 1 ) 2 0 scale-envelope dup #( 0 0 1 2 ) feql if 4770 drop 4771 else 4772 1 >array "scale-envelope: %s?" swap snd-display 4773 then 4774 #( 0 0 1 1 ) 2 1 scale-envelope dup #( 0 1 1 3 ) feql if 4775 drop 4776 else 4777 1 >array "scale-envelope off: %s?" swap snd-display 4778 then 4779 \ reverse-envelope 4780 #( 0 0 1 1 ) reverse-envelope dup #( 0 1 1 0 ) feql if 4781 drop 4782 else 4783 1 >array "reverse-envelope ramp: %s?" swap snd-display 4784 then 4785 #( 0 0 0.5 1 2 0 ) reverse-envelope dup #( 0 0 1.5 1 2 0 ) feql if 4786 drop 4787 else 4788 1 >array "reverse-envelope ramp 2: %s?" swap snd-display 4789 then 4790 #( 0 0 0.5 1 2 1 ) reverse-envelope dup #( 0 1 1.5 1 2 0 ) feql if 4791 drop 4792 else 4793 1 >array "reverse-envelope ramp 2: %s?" swap snd-display 4794 then 4795 \ concatenate-envelopes (from snd/env.scm) 4796 #( 0 0 1 1 ) #( 0 1 1 0 ) 2 concatenate-envelopes 4797 dup #( 0.0 0 1.0 1 2.0 0 ) feql if 4798 drop 4799 else 4800 1 >array "concatenate-envelopes (0): %s?" swap snd-display 4801 then 4802 #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 concatenate-envelopes 4803 dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if 4804 drop 4805 else 4806 1 >array "concatenate-envelopes (1): %s?" swap snd-display 4807 then 4808 \ envelope-concatenate (from clm/env.lisp) 4809 #( 0 0 1 1 ) #( 0 1 1 0 ) 2 envelope-concatenate 4810 dup #( 0.0 0 1.0 1 1.01 1 2.01 0 ) feql if 4811 drop 4812 else 4813 1 >array "envelope-concatenate (0): %s?" swap snd-display 4814 then 4815 #( 0 0 1 1.5 ) #( 0 1 1 0 ) 2 envelope-concatenate 4816 dup #( 0.0 0 1.0 1.5 1.01 1 2.01 0 ) feql if 4817 drop 4818 else 4819 1 >array "envelope-concatenate (1): %s?" swap snd-display 4820 then 4821 \ repeat-envelope 4822 #( 0 0 1 100 ) 2 #f #f repeat-envelope 4823 dup #( 0 0 1 100 1.01 0 2.01 100 ) feql if 4824 drop 4825 else 4826 1 >array "repeat-envelope (0): %s?" swap snd-display 4827 then 4828 #( 0 0 1.5 1 2 0 ) 2 #f #f repeat-envelope 4829 dup #( 0 0 1.5 1 2.0 0 3.5 1 4.0 0 ) feql if 4830 drop 4831 else 4832 1 >array "repeat-envelope (1): %s?" swap snd-display 4833 then 4834 #( 0 0 1.5 1 2 0 ) 2 #f #t repeat-envelope 4835 dup #( 0.0 0 0.75 1 1.0 0 1.75 1 2.0 0 ) feql if 4836 drop 4837 else 4838 1 >array "repeat-envelope (2): %s?" swap snd-display 4839 then 4840 #( 0 0 1.5 1 2 0 ) 2 #t #f repeat-envelope 4841 dup #( 0 0 1.5 1 2.0 0 2.5 1 4.0 0 ) feql if 4842 drop 4843 else 4844 1 >array "repeat-envelope (3): %s?" swap snd-display 4845 then 4846 #( 0 0 1.5 1 2 0 ) 3 #f #f repeat-envelope dup 4847 #( 0 0 1.5 1 2.0 0 3.5 1 4.0 0 5.5 1 6.0 0 ) feql if 4848 drop 4849 else 4850 1 >array "repeat-envelope (4): %s?" swap snd-display 4851 then 4852 \ normalize-envelope 4853 #( 0 0 1 1.5 2.0 1.0 ) normalize-envelope dup #( 0 0.0 1 1.0 2.0 0.667 ) 4854 feql if 4855 drop 4856 else 4857 1 >array "normalize-envelope (0): %s?" swap snd-display 4858 then 4859 #( 0 0 1 0.5 2 -0.8 ) normalize-envelope dup #( 0 0.0 1 0.625 2 -1.0 ) 4860 feql if 4861 drop 4862 else 4863 1 >array "normalize-envelope (1): %s?" swap snd-display 4864 then 4865 \ envelope-exp 4866 #( 0 0 1 1 ) 2.0 10 envelope-exp dup 4867 #( 0 0 0.1 0.01 0.2 0.04 0.3 0.09 0.4 0.16 4868 0.5 0.25 0.6 0.36 0.7 0.49 0.8 0.64 0.9 0.81 1 1 ) 4869 feql if 4870 drop 4871 else 4872 1 >array "envelope-exp (0): %s?" swap snd-display 4873 then 4874 #( 0 0 1 1 2 0 ) 1.0 10 envelope-exp dup 4875 #( 0 0 0.2 0.2 0.4 0.4 0.6 0.6 0.8 0.8 1 1 4876 1.2 0.8 1.4 0.6 1.6 0.4 1.8 0.2 2 0 ) 4877 feql if 4878 drop 4879 else 4880 1 >array "envelope-exp (1): %s?" swap snd-display 4881 then 4882 old-srate to *clm-srate* 4883; 4884 4885\ ---------------- test 19: save and restore ---------------- 4886 4887: clm-channel-test <{ :optional snd #f chn #f -- gen }> 4888 1 -1 make-two-zero 0 #f snd chn #f #f get-func-name clm-channel 4889; 4890 4891: random-pi-func <{ x -- y }> pi random ; 4892 4893#( #( lambda: <{ -- val }> vct( 1.0 0.5 ) 0 2 #f #f #f insert-vct ; 4894 "lambda: <{ snd chn -- val }> vct( 1.000 0.500 ) 0 2 snd chn insert-vct drop ;" 4895 "insert-vct" ) 4896 #( lambda: <{ -- val }> #f #f clm-channel-test ; 4897 "lambda: <{ snd chn -- val }> snd chn clm-channel-test drop ;" 4898 "clm-channel-test" ) 4899 ( examp.fs ) 4900 #( lambda: <{ -- val }> 1000 3000 #f #f fft-edit ; 4901 "lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-edit drop ;" 4902 "fft-edit" ) 4903 #( lambda: <{ -- val }> 0.01 #f #f fft-squelch ; 4904 "lambda: <{ snd chn -- val }> 0.01 snd chn fft-squelch drop ;" 4905 "fft-sqelch" ) 4906 #( lambda: <{ -- val }> 1000 3000 #f #f fft-cancel ; 4907 "lambda: <{ snd chn -- val }> 1000 3000 snd chn fft-cancel drop ;" 4908 "fft-cancel" ) 4909 #( lambda: <{ -- val }> #f #f squelch-vowels ; 4910 "lambda: <{ snd chn -- val }> snd chn squelch-vowels drop ;" 4911 "squelch-vowels" ) 4912 #( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) #f #f fft-env-edit ; 4913 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn fft-env-edit drop ;" 4914 "fft-env-edit" ) 4915 #( lambda: <{ -- val }> 4916 #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) #f #f fft-env-interp 4917 ; 4918 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) #( 0 1 1 0 2 0 ) #( 0 0 1 1 ) snd chn fft-env-interp drop ;" 4919 "fft-env-interp" ) 4920 #( lambda: <{ -- val }> 10 0.1 #f #f hello-dentist ; 4921 "lambda: <{ snd chn -- val }> 10 0.1 snd chn hello-dentist drop ;" 4922 "hello-dentist" ) 4923 #( lambda: <{ -- val }> 1 0.3 20 #f #f fp ; 4924 "lambda: <{ snd chn -- val }> 1 0.3 20 snd chn fp drop ;" 4925 "fp" ) 4926 #( lambda: <{ -- val }> #( 0 1 1 2 ) #f #f expsnd ; 4927 "lambda: <{ snd chn -- val }> #( 0 1 1 2 ) snd chn expsnd drop ;" 4928 "expsnd" ) 4929 #( lambda: <{ -- val }> 1 256 2 2 #f #f voiced->unvoiced ; 4930 "lambda: <{ snd chn -- val }> 1 256 2 2 snd chn voiced->unvoiced drop ;" 4931 "voiced->unvoiced" ) 4932 #( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) 2 #f #f env-sound-interp ; 4933 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) 2 snd chn env-sound-interp drop ;" 4934 "env-sound-interp" ) 4935 #( lambda: <{ -- val }> #( #( "1a.snd" ) #( "pistol.snd" 1 2 ) ) #f #f add-notes ; 4936 "lambda: <{ snd chn -- val }> #( #( \"1a.snd\" ) #( \"pistol.snd\" 1 2 ) ) snd chn add-notes drop ;" 4937 "add-notes" ) 4938 #( lambda: <{ -- val }> #( 0 0 1 1 2 0 ) #f #f filtered-env ; 4939 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 0 ) snd chn filtered-env drop ;" 4940 "filtered-env" ) 4941 #( lambda: <{ -- val }> 0.1 #f #f reverse-by-blocks ; 4942 "lambda: <{ snd chn -- val }> 0.1 snd chn reverse-by-blocks drop ;" 4943 "reverse-by-blocks" ) 4944 #( lambda: <{ -- val }> 0.1 #f #f reverse-within-blocks ; 4945 "lambda: <{ snd chn -- val }> 0.1 snd chn reverse-within-blocks drop ;" 4946 "reverse-within-blocks" ) 4947 ( extensions.fs ) 4948 #( lambda: <{ -- val }> "1a.snd" 1200 #f #f #f #f mix-channel ; 4949 "lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn mix-channel drop ;" 4950 "mix-channel" ) 4951 #( lambda: <{ -- val }> "1a.snd" 1200 #f #f #f #f insert-channel ; 4952 "lambda: <{ snd chn -- val }> \"1a.snd\" 1200 #f snd chn insert-channel drop ;" 4953 "insert-channel" ) 4954 #( lambda: <{ -- val }> "1a.snd" 0.5 0.9 0 #f #f #f #f sine-ramp ; 4955 "lambda: <{ snd chn -- val }> 0.5 0.9 0 #f snd chn sine-ramp drop ;" 4956 "sine-ramp" ) 4957 #( lambda: <{ -- val }> 4958 #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f sine-env-channel 4959 ; 4960 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn sine-env-channel drop ;" 4961 "sine-env-channel" ) 4962 #( lambda: <{ -- val }> 0 1 0 #f #f #f #f blackman4-ramp ; 4963 "lambda: <{ snd chn -- val }> 0 1 0 #f snd chn blackman4-ramp drop ;" 4964 "blackman4-ramp" ) 4965 #( lambda: <{ -- val }> 4966 #( 0 0 1 1 2 -0.5 3 1 ) 0 #f #f #f #f blackman4-env-channel 4967 ; 4968 "lambda: <{ snd chn -- val }> #( 0 0 1 1 2 -0.5 3 1 ) 0 #f snd chn blackman4-env-channel drop ;" 4969 "blackman4-env-channel" ) 4970 #( lambda: <{ -- val }> 0.2 0.8 #t 0 #f #f #f #f ramp-squared ; 4971 "lambda: <{ snd chn -- val }> 0.2 0.8 #t 0 #f snd chn ramp-squared drop ;" 4972 "ramp-squared" ) 4973 #( lambda: <{ -- val }> #( 0 0 1 1 ) #t 0 #f #f #f #f env-squared-channel ; 4974 "lambda: <{ snd chn -- val }> #( 0 0 1 1 ) #t 0 #f snd chn env-squared-channel drop ;" 4975 "env-squared-channel" ) 4976 #( lambda: <{ -- val }> 0.2 0.8 32 #t 0 #f #f #f #f ramp-expt ; 4977 "lambda: <{ snd chn -- val }> 0.2 0.8 32 #t 0 #f snd chn ramp-expt drop ;" 4978 "ramp-expt" ) 4979 #( lambda: <{ -- val }> #( 0 0 1 1 ) 32 #t 0 #f #f #f #f env-expt-channel ; 4980 "lambda: <{ snd chn -- val }> #( 0 0 1 1 ) 32 #t 0 #f snd chn env-expt-channel drop ;" 4981 "env-expt-channel" ) 4982 #( lambda: <{ -- val }> 0.1 0 #f #f #f #f offset-channel ; 4983 "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn offset-channel drop ;" 4984 "offset-channel" ) 4985 #( lambda: <{ -- val }> 0.1 0 #f #f #f #f dither-channel ; 4986 "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn dither-channel drop ;" 4987 "dither-channel" ) 4988 #( lambda: <{ -- val }> 0.1 0 #f #f #f #f contrast-channel ; 4989 "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn contrast-channel drop ;" 4990 "contrast-channel" ) 4991 ( dsp.fs ) 4992 #( lambda: <{ -- val }> 550 600 10 40 50 0 #f #f #f #f ssb-bank ; 4993 "lambda: <{ snd chn -- val }> 550 600 10 40 50 0 #f snd chn ssb-bank drop ;" 4994 "ssb-bank" ) 4995 #( lambda: <{ -- val }> 4996 550 600 #( 0 1 1 2 ) 10 40 50 0 #f #f #f #f ssb-bank-env 4997 ; 4998 "lambda: <{ snd chn -- val }> 550 600 #( 0 1 1 2 ) 10 40 50 0 #f snd chn ssb-bank-env drop ;" 4999 "ssb-bank-env" ) 5000 #( lambda: <{ -- val }> 1 #f #f down-oct ; 5001 "lambda: <{ snd chn -- val }> 1 snd chn down-oct drop ;" 5002 "donw-oct" ) 5003 #( lambda: <{ -- val }> 8 #f #f freqdiv ; 5004 "lambda: <{ snd chn -- val }> 8 snd chn freqdiv drop ;" 5005 "freqdiv" ) 5006 #( lambda: <{ -- val }> 8 0 #f #f #f adsat ; 5007 "lambda: <{ snd chn -- val }> 8 0 #f snd chn adsat drop ;" 5008 "adsat" ) 5009 #( lambda: <{ -- val }> #f #f spike ; 5010 "lambda: <{ snd chn -- val }> snd chn spike drop ;" 5011 "spike" ) 5012 #( lambda: <{ -- val }> #f #f zero-phase ; 5013 "lambda: <{ snd chn -- val }> snd chn zero-phase drop ;" 5014 "zero-phase" ) 5015 #( lambda: <{ -- val }> <'> random-pi-func #f #f rotate-phase ; 5016 "lambda: <{ snd chn -- val }> <'> random-pi-func snd chn rotate-phase drop ;" 5017 "rotate-phase" ) 5018 #( lambda: <{ -- val }> 0.5 #f #f brighten-slightly ; 5019 "lambda: <{ snd chn -- val }> 0.5 snd chn brighten-slightly drop ;" 5020 "brighten-slightly" ) 5021 #( lambda: <{ -- val }> 100 40 0 #f #f #f #f shift-channel-pitch ; 5022 "lambda: <{ snd chn -- val }> 100 40 0 #f snd chn shift-channel-pitch drop ;" 5023 "shift-channel-pitch" ) 5024 #( lambda: <{ -- val }> vct( 0.0 0.5 ) #f #f channel-polynomial ; 5025 "lambda: <{ snd chn -- val }> vct( 0.000 0.500 ) snd chn channel-polynomial drop ;" 5026 "channel-polynomial" ) 5027 #( lambda: <{ -- val }> vct( 0.0 1.0 ) #f #f spectral-polynomial ; 5028 "lambda: <{ snd chn -- val }> vct( 0.000 1.000 ) snd chn spectral-polynomial drop ;" 5029 "spectral-polynomial" ) 5030 #( lambda: <{ -- val }> 5031 #( 60.0 120.0 240.0 ) #f 0 #f #f #f #f #t 2 notch-channel 5032 ; 5033 "lambda: <{ snd chn -- val }> #( 60.0 120.0 240.0 ) #f 0 #f snd chn notch-channel drop ;" 5034 "notch-channel" ) 5035 ( effects.fs ) 5036 #( lambda: <{ -- val }> 0.1 128 effects-squelch-channel ; 5037 "lambda: <{ snd chn -- val }> 0.1 128 snd chn effects-squelch-channel drop ;" 5038 "effects-sqelch-channel" ) 5039 #( lambda: <{ -- val }> #f 0.5 0.1 0 #f #f #f effects-echo ; 5040 "lambda: <{ snd chn -- val }> #f 0.5 0.1 0 #f snd chn effects-echo drop ;" 5041 "effects-echo" ) 5042 #( lambda: <{ -- val }> 0.5 0.1 #f 0 #f #f #f effects-flecho ; 5043 "lambda: <{ snd chn -- val }> 0.5 0.1 #f 0 #f snd chn effects-flecho drop ;" 5044 "effects-flecho" ) 5045 #( lambda: <{ -- val }> 0.75 0.75 6.0 10.0 #f 0 #f #f #f effects-zecho ; 5046 "lambda: <{ snd chn -- val }> 0.75 0.75 6.0 10.0 #f 0 #f snd chn effects-zecho drop ;" 5047 "effects-zecho" ) 5048 #( lambda: <{ -- val }> 0.1 50 0 #f #f #f effects-comb-filter ; 5049 "lambda: <{ snd chn -- val }> 0.1 50 0 #f snd chn effects-comb-filter drop ;" 5050 "effects-comb-filter" ) 5051 #( lambda: <{ -- val }> 10000 0.5 0 #f #f #f effects-moog ; 5052 "lambda: <{ snd chn -- val }> 10000 0.5 0 #f snd chn effects-moog drop ;" 5053 "effects-moog" ) 5054 #( lambda: <{ -- val }> #f #f effects-remove-dc ; 5055 "lambda: <{ snd chn -- val }> snd chn effects-remove-dc drop ;" 5056 "effects-remove-dc" ) 5057 #( lambda: <{ -- val }> #f #f effects-compand ; 5058 "lambda: <{ snd chn -- val }> snd chn effects-compand drop ;" 5059 "effects-compand" ) 5060 #( lambda: <{ -- val }> 100.0 #f 0 #f #f #f effects-am ; 5061 "lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-am drop ;" 5062 "effects-am" ) 5063 #( lambda: <{ -- val }> 100.0 #f 0 #f #f #f effects-rm ; 5064 "lambda: <{ snd chn -- val }> 100.0 #f 0 #f snd chn effects-rm drop ;" 5065 "effects-rm" ) 5066 #( lambda: <{ -- val }> 1000.0 100.0 0 #f #f #f effects-bbp ; 5067 "lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbp drop ;" 5068 "effects-bbp" ) 5069 #( lambda: <{ -- val }> 1000.0 100.0 0 #f #f #f effects-bbr ; 5070 "lambda: <{ snd chn -- val }> 1000.0 100.0 0 #f snd chn effects-bbr drop ;" 5071 "effects-bbr" ) 5072 #( lambda: <{ -- val }> 1000.0 0 #f #f #f effects-bhp ; 5073 "lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-bhp drop ;" 5074 "effects-bhp" ) 5075 #( lambda: <{ -- val }> 1000.0 0 #f #f #f effects-blp ; 5076 "lambda: <{ snd chn -- val }> 1000.0 0 #f snd chn effects-blp drop ;" 5077 "effects-blp" ) 5078 #( lambda: <{ -- val }> 50.0 0.5 0 #f #f #f effects-hello-dentist ; 5079 "lambda: <{ snd chn -- val }> 50.0 0.5 0 #f snd chn effects-hello-dentist drop ;" 5080 "effects-hello-dentist" ) 5081 #( lambda: <{ -- val }> 1.0 0.3 20.0 0 #f #f #f effects-fp ; 5082 "lambda: <{ snd chn -- val }> 1.0 0.3 20.0 0 #f snd chn effects-fp drop ;" 5083 "effects-fp" ) 5084 #( lambda: <{ -- val }> 5.0 2.0 0.001 0 #f #f #f effects-flange ; 5085 "lambda: <{ snd chn -- val }> 5.0 2.0 0.001 0 #f snd chn effects-flange drop ;" 5086 "effects-flange" ) 5087 #( lambda: <{ -- val }> 0.1 0 #f #f #f effects-jc-reverb-1 ; 5088 "lambda: <{ snd chn -- val }> 0.1 0 #f snd chn effects-jc-reverb-1 drop ;" 5089 "effects-jc-reverb-1" ) ) value test19-*.fs 5090 5091: 19-save/restore ( -- ) 5092 "oboe.snd" open-sound { ind } 5093 nil nil nil nil nil nil { vals func1 descr name func str } 5094 test19-*.fs each to vals 5095 vals 0 array-ref to func1 5096 vals 1 array-ref to descr 5097 vals 2 array-ref to name 5098 *snd-test-verbose* if 5099 name #f snd-test-message 5100 then 5101 func1 #() run-proc drop 5102 ind #f undef undef edit-list->function to func 5103 func proc-source-ref to str 5104 str descr "edit-list->function %s [%d]" #( name i ) snd-test-neq 5105 ind revert-sound drop 5106 func #( ind 0 ) run-proc drop 5107 ind revert-sound drop 5108 end-each 5109 ind close-sound drop 5110; 5111 5112\ ---------------- test 23: with-sound ---------------- 5113 5114: test23-notehook { ins start dur -- } 5115 "%7.3f %0.3f %s" #( start dur ins ) snd-test-message 5116; 5117 5118: test23-balance ( -- ) 5119 make-rmsgain { rg } 5120 40 make-rmsgain { rg1 } 5121 2 make-rmsgain { rg2 } 5122 #( 0 0 1 1 2 0 ) :length base-length make-env { e } 5123 #( 0 0 1 1 ) :length base-length make-env { e1 } 5124 #( 0 0 1 1 2 0 10 0 ) :length base-length make-env { e2 } 5125 440.0 make-oscil { o } 5126 *output* sound? if 5127 *output* channels make-array map! 5128 base-length 0.0 make-vct 5129 end-map 5130 else 5131 *output* 5132 then { gen } 5133 nil { sig } 5134 base-length 0 do 5135 e env to sig 5136 i rg sig e2 env rmsgain-balance gen ws-outa 5137 i rg1 sig e1 env rmsgain-balance gen ws-outb 5138 i rg2 o 0.0 0.0 oscil 0.1 f* e2 env rmsgain-balance gen ws-outc 5139 loop 5140 gen array? if 5141 gen each ( v ) 5142 0 *output* i #f undef mix-vct drop 5143 end-each 5144 then 5145 *clm-srate* 22050 = if 5146 0.98402 5147 else 5148 1.4227 ( 44100 ) 5149 then { req } 5150 rg rmsgain-gain-avg { res } 5151 res req "rmsgain gain-avg" #() snd-test-neq 5152 base-length to req 5153 rg2 rmsgain-avgc to res 5154 res req "rmsgain count" #() snd-test-neq 5155; 5156 5157: test23-ssb-fm ( gen mg -- proc; y self -- val ) 5158 1 proc-create { prc } ( mg ) , ( gen ) , prc 5159 does> { y self -- val } 5160 self @ { mg } 5161 self cell+ @ { gen } 5162 gen mg 0.0 0.0 oscil 0.02 f* ssb-fm 5163; 5164 5165\ CLM examples (see clm.html) and their Snd/Forth counterparts: 5166 5167\ (with-sound () 5168\ (mix (with-sound (:output "hiho.snd") 5169\ (fm-violin 0 1 440 .1)) 5170\ :amplitude .5)) 5171 5172: test23-clm-examp-1 ( -- ) 5173 0.0 1.0 440 0.1 <'> fm-violin 5174 :output "hiho.snd" with-sound ws-output { fname } 5175 fname :scaler 2.0 clm-mix 5176 fname ws-close-snd 5177; 5178 5179\ (with-sound () 5180\ (with-mix () "s1" 0 5181\ (sound-let ((tmp () (fm-violin 0 1 440 .1))) 5182\ (mix tmp)))) 5183 5184: test23-clm-examp-2 ( -- ) 5185 " 5186 '( '( '() 0.0 1.0 440 0.1 <'> fm-violin ) ) 5187 lambda: <{ tmp -- }> 5188 tmp clm-mix 5189 ; sound-let 5190 " '() "s1" 0 with-mix 5191; 5192 5193\ (with-sound (:verbose t) 5194\ (with-mix () "s6" 0 5195\ (sound-let ((tmp () (fm-violin 0 1 440 .1)) 5196\ (tmp1 (:reverb nrev) (mix "oboe.snd"))) 5197\ (mix tmp1) 5198\ (mix tmp :amplitude .2 :output-frame *srate*)) 5199\ (fm-violin .5 .1 330 .1))) 5200 5201: test23-clm-examp-3 ( -- ) 5202 " 5203 '( '( '() 0.0 1.0 440 0.1 <'> fm-violin ) 5204 '( '( :reverb <'> nrev ) \"oboe.snd\" <'> clm-mix ) ) 5205 lambda: <{ tmp tmp1 -- }> 5206 tmp1 clm-mix 5207 tmp :scaler 5.0 :output-frame 1.0 seconds->samples clm-mix 5208 ; sound-let 5209 0.5 0.1 330 0.1 fm-violin 5210 " '() "s6" 0 with-mix 5211; 5212 5213\ (with-sound (:verbose t) 5214\ (sound-let ((tmp () (with-mix () "s7" 0 5215\ (sound-let ((tmp () (fm-violin 0 1 440 .1)) 5216\ (tmp1 () (mix "oboe.snd"))) 5217\ (mix tmp1) 5218\ (mix tmp :output-frame *srate*)) 5219\ (fm-violin .5 .1 330 .1)))) 5220\ (mix tmp :amplitude .5))) 5221 5222: test23-clm-4-cb <{ tmp -- }> 5223 tmp :scaler 2.0 clm-mix 5224; 5225 5226: test23-clm-examp-4 ( -- ) 5227 '( '( '() " 5228 '( '( '() 0.0 1.0 440 0.1 <'> fm-violin ) 5229 '( '() \"oboe.snd\" <'> clm-mix ) ) 5230 lambda: <{ tmp tmp1 -- }> 5231 tmp1 clm-mix 5232 tmp :output-frame 1.0 seconds->samples clm-mix 5233 ; sound-let 5234 0.5 0.1 330 0.1 fm-violin 5235 " '() "s7" 0 <'> with-mix ) ) 5236 <'> test23-clm-4-cb sound-let 5237; 5238 5239: test23-sl-cb <{ tmp1 tmp2 tmp3 -- }> 5240 *snd-test-ws-verbose* if 5241 tmp1 . cr 5242 tmp2 . cr 5243 tmp3 . cr 5244 then 5245 tmp1 clm-mix 5246 tmp2 clm-mix 5247; 5248 5249: test23-sound-let ( -- ) 5250 '( '( '( :reverb <'> jc-reverb ) 0.0 1.0 220 0.2 <'> fm-violin ) 5251 '( '() 0.5 1 440 0.3 <'> fm-violin ) 5252 '( '() '( 10 'a ) ) ) 5253 <'> test23-sl-cb sound-let 5254; 5255 5256: test23-with-mix ( -- ) 5257 0.0 0.1 440 0.1 fm-violin 5258 " 5259 0.0 0.2 550 0.1 fm-violin 5260 0.1 0.1 660 0.1 fm-violin 5261 " #() "sec1" 0.5 with-mix 5262 " 5263 0.0 0.1 880 0.1 :reverb-amount 0.2 fm-violin 5264 0.1 0.1 1320 0.1 :reverb-amount 0.2 fm-violin 5265 " #( :reverb <'> jc-reverb ) "sec2" 1.0 with-mix 5266 2.0 0.1 220 0.1 fm-violin 5267; 5268 5269\ examples from sndclm.html 5270: sndclm-oscil-test ( -- ) 5271 440.0 make-oscil { gen } 5272 0.0 1.0 nil run-instrument 5273 gen 0.0 0.0 oscil f2/ 5274 end-run 5275; 5276 5277: sndclm-env-test ( -- ) 5278 440.0 make-oscil { gen } 5279 '( 0 0 0.01 1 0.25 0.1 0.5 0.01 1 0 ) 5280 :scaler 0.5 :length 44100 make-env { ampf } 5281 0.0 1.0 nil run-instrument 5282 gen 0.0 0.0 oscil ampf env f* 5283 end-run 5284; 5285 5286: sndclm-table-lookup-test ( -- ) 5287 440.0 :wave '( 1 0.5 2 0.5 ) #f #f partials->wave make-table-lookup { gen } 5288 0.0 1.0 nil run-instrument 5289 gen 0.0 table-lookup f2/ 5290 end-run 5291; 5292 5293: sndclm-polywave-test ( -- ) 5294 440.0 :partials '( 1 0.5 2 0.5 ) make-polywave { gen } 5295 0.0 1.0 nil run-instrument 5296 gen 0.0 polywave f2/ 5297 end-run 5298; 5299 5300: sndclm-triangle-wave-test ( -- ) 5301 440.0 make-triangle-wave { gen } 5302 0.0 1.0 nil run-instrument 5303 gen 0.0 triangle-wave f2/ 5304 end-run 5305; 5306 5307: sndclm-ncos-test ( -- ) 5308 440.0 10 make-ncos { gen } 5309 0.0 1.0 nil run-instrument 5310 gen 0.0 ncos f2/ 5311 end-run 5312; 5313 5314: sndclm-nrxycos-test ( -- ) 5315 440.0 :n 10 make-nrxycos { gen } 5316 0.0 1.0 nil run-instrument 5317 gen 0.0 nrxycos f2/ 5318 end-run 5319; 5320 5321: sndclm-ssb-am-test ( -- ) 5322 440.0 20 make-ssb-am { shifter } 5323 440.0 make-oscil { osc } 5324 0.0 1.0 nil run-instrument 5325 shifter osc 0.0 0.0 oscil 0.0 ssb-am f2/ 5326 end-run 5327; 5328 5329: sndclm-wave-train-test ( -- ) 5330 400 10 make-ncos { g } 5331 g -0.5 pi f* set-mus-phase drop 5332 64 make-vct map! 5333 g 0.0 ncos 5334 end-map { v } 5335 440.0 :wave v make-wave-train { gen } 5336 0.0 1.0 nil run-instrument 5337 gen 0.0 wave-train f2/ 5338 end-run 5339; 5340 5341: sndclm-rand-test ( -- ) 5342 5.0 220.0 hz->radians make-rand { ran1 } 5343 5.0 330.0 hz->radians make-rand-interp { ran2 } 5344 440.0 make-oscil { osc1 } 5345 1320.0 make-oscil { osc2 } 5346 2.0 seconds->samples { len } 5347 *output* sound? if 5348 2 make-array map! 5349 len 0.0 make-vct 5350 end-map 5351 else 5352 *output* 5353 then { gen } 5354 len 0 do 5355 i osc1 ran1 0.0 rand 0.0 oscil f2/ gen ws-outa 5356 i osc2 ran2 0.0 rand-interp 0.0 oscil f2/ gen ws-outb 5357 loop 5358 gen array? if 5359 gen each ( v ) 5360 0 *output* i #f undef mix-vct drop 5361 end-each 5362 then 5363; 5364 5365: sndclm-two-pole-test ( -- ) 5366 1000.0 0.999 make-two-pole { flt } 5367 10000.0 0.002 make-rand { ran1 } 5368 0.0 1.0 nil run-instrument 5369 flt ran1 0.0 rand two-pole f2/ 5370 end-run 5371; 5372 5373: sndclm-firmant-test ( -- ) 5374 1000.0 0.999 make-firmant { flt } 5375 10000.0 5.0 make-rand { ran1 } 5376 0.0 1.0 nil run-instrument 5377 flt ran1 0.0 rand 0.0 firmant f2/ 5378 end-run 5379; 5380 5381: sndclm-iir-filter-test ( -- ) 5382 3 vct( 0.0 -1.978 0.998 ) make-iir-filter { flt } 5383 10000.0 0.002 make-rand { ran1 } 5384 0.0 1.0 nil run-instrument 5385 flt ran1 0.0 rand iir-filter f2/ 5386 end-run 5387; 5388 5389: sndclm-delay-test ( -- ) 5390 0.5 seconds->samples make-delay { dly } 5391 440.0 make-oscil { osc1 } 5392 660.0 make-oscil { osc2 } 5393 0.0 1.0 nil run-instrument 5394 osc1 0.0 0.0 oscil 5395 dly osc2 0.0 0.0 oscil 0.0 delay f+ 5396 f2/ 5397 end-run 5398; 5399 5400: sndclm-comb-test ( -- ) 5401 0.4 0.4 seconds->samples make-comb { cmb } 5402 440.0 make-oscil { osc } 5403 '( 0 0 1 1 2 1 3 0 ) :length 4410 make-env { ampf } 5404 0.0 2.0 nil run-instrument 5405 cmb ( gen ) 5406 ampf env osc 0.0 0.0 oscil f* ( val ) 5407 0.0 ( pm ) comb f2/ 5408 end-run 5409; 5410 5411: sndclm-all-pass-test ( -- ) 5412 -0.4 0.4 0.4 seconds->samples make-all-pass { alp } 5413 440.0 make-oscil { osc } 5414 '( 0 0 1 1 2 1 3 0 ) :length 4410 make-env { ampf } 5415 0.0 2.0 nil run-instrument 5416 alp ( gen ) 5417 ampf env osc 0.0 0.0 oscil f* ( val ) 5418 0.0 ( pm ) 5419 all-pass f2/ 5420 end-run 5421; 5422 5423: sndclm-moving-average-test ( -- ) 5424 4410 make-moving-average { avg } 5425 440.0 make-oscil { osc } 5426 1.0 0.1 f- { stop } 5427 0.0 { val } 5428 0.0 stop nil run-instrument 5429 osc 0.0 0.0 oscil to val 5430 avg val fabs moving-average val f* 5431 end-run 5432 stop 1.0 nil run-instrument 5433 avg 0.0 moving-average osc 0.0 0.0 oscil f* 5434 end-run 5435; 5436 5437: sndclm-src1-test ( -- ) 5438 "oboe.snd" make-readin { rd } 5439 rd 0.5 make-src { sr } 5440 "oboe.snd" mus-sound-duration f2* { dur } 5441 0.0 dur nil run-instrument 5442 sr 0.0 #f src 5443 end-run 5444; 5445 5446: make-src-proc { osc -- prc; dir self -- val } 5447 1 proc-create osc , ( prc ) 5448 does> { dir self -- val } 5449 self @ ( osc ) 0.0 0.0 oscil 5450; 5451 5452: sndclm-src2-test ( -- ) 5453 440.0 make-oscil { osc } 5454 osc make-src-proc { prc } 5455 :srate 2.0 make-src { sr } 5456 0.0 1.0 nil run-instrument 5457 sr 0.0 prc src 5458 end-run 5459; 5460 5461: sndclm-convolve1-test ( -- ) 5462 "pistol.snd" make-readin ( rd ) 5463 "oboe.snd" file->vct ( v ) make-convolve { cnv } 5464 0.0 2.0 nil run-instrument 5465 cnv #f convolve 0.25 f* 5466 end-run 5467; 5468 5469: sndclm-convolve2-test ( -- ) 5470 "oboe.snd" "pistol.snd" 0.5 "convolved.snd" convolve-files { tempfile } 5471 tempfile make-readin { reader } 5472 tempfile mus-sound-duration { dur } 5473 0.0 dur nil run-instrument 5474 reader readin 5475 end-run 5476 tempfile file-delete 5477; 5478 5479: sndclm-granulate1-test ( -- ) 5480 "oboe.snd" make-readin 2.0 make-granulate { grn } 5481 0.0 1.0 nil run-instrument 5482 grn #f #f granulate 5483 end-run 5484; 5485 5486: make-granulate-proc { osc sweep -- prc; dir self -- val } 5487 1 proc-create osc , sweep , ( prc ) 5488 does> { dir self -- val } 5489 self @ ( osc ) self cell+ @ ( sweep ) env 0.0 oscil 0.2 f* 5490; 5491 5492: sndclm-granulate2-test ( -- ) 5493 440.0 make-oscil { osc } 5494 '( 0 0 1 1 ) :scaler 440.0 hz->radians :length 44100 make-env { sweep } 5495 osc sweep make-granulate-proc :expansion 2.0 :length 0.5 5496 make-granulate { grn } 5497 0.0 2.0 nil run-instrument 5498 grn #f #f granulate 5499 end-run 5500; 5501 5502: sndclm-phase-vocoder1-test ( -- ) 5503 "oboe.snd" make-readin :pitch 2.0 make-phase-vocoder { pv } 5504 0.0 1.0 nil run-instrument 5505 pv #f #f #f #f phase-vocoder 5506 end-run 5507; 5508 5509: sndclm-phase-vocoder2-test ( -- ) 5510 "oboe.snd" make-readin :interp 256 make-phase-vocoder { pv } 5511 "oboe.snd" mus-sound-duration f2* { dur } 5512 0.0 dur nil run-instrument 5513 pv #f #f #f #f phase-vocoder 5514 end-run 5515; 5516 5517: sndclm-asymmetric-fm-test ( -- ) 5518 440.0 0.0 0.9 0.5 make-asymmetric-fm { fm } 5519 0.0 1.0 nil run-instrument 5520 fm 1.0 0.0 asymmetric-fm f2/ 5521 end-run 5522; 5523 5524: sndclm-file->frample->file-test ( -- ) 5525 "stereo.snd" make-file->frample { input } 5526 2 0.0 make-vct { frm } 5527 "stereo.snd" mus-sound-framples { len } 5528 *output* channels { chans } 5529 *output* sound? if 5530 *output* short-file-name { fname } 5531 "frample-" fname $+ to fname 5532 fname chans undef undef undef make-frample->file 5533 else 5534 *output* 5535 then { gen } 5536 0.0 0.0 { val0 val1 } 5537 len 0 ?do 5538 input i frm file->frample to frm 5539 frm 0 vct-ref to val0 5540 frm 1 vct-ref to val1 5541 frm 0 val1 vct-set! drop 5542 frm 1 val0 vct-set! drop 5543 gen i frm frample->file drop 5544 loop 5545 *output* sound? if 5546 gen mus-close drop 5547 chans 0 do 5548 0 len fname *output* i #f undef i #f #f set-samples drop 5549 loop 5550 fname file-delete 5551 then 5552; 5553 5554: sndclm-readin-test ( -- ) 5555 "oboe.snd" make-readin { reader } 5556 0.0 1.0 nil run-instrument 5557 reader readin f2/ 5558 end-run 5559; 5560 5561: sndclm-in-out-any-test ( -- ) 5562 "oboe.snd" make-file->sample { infile } 5563 0.0 1.0 nil run-instrument 5564 i 0 infile in-any 5565 end-run 5566; 5567 5568: sndclm-locsig-test ( -- ) 5569 44100 { len } 5570 *output* channels { chans } 5571 *output* sound? if 5572 *output* short-file-name { fname } 5573 "frample-" fname $+ to fname 5574 fname chans undef undef undef make-frample->file 5575 else 5576 *output* 5577 then { gen } 5578 60.0 :output gen make-locsig { loc } 5579 440.0 make-oscil { osc } 5580 len 0 do 5581 loc i osc 0.0 0.0 oscil f2/ locsig drop 5582 loop 5583 *output* sound? if 5584 gen mus-close drop 5585 chans 0 do 5586 0 len fname *output* i #f undef i #f #f set-samples drop 5587 loop 5588 fname file-delete 5589 then 5590; 5591 5592: sndclm-amplitude-modulate-test ( -- ) 5593 440.0 make-oscil { osc1 } 5594 220.0 make-oscil { osc2 } 5595 0 1 nil run-instrument 5596 0.3 ( car ) 5597 osc1 0.0 0.0 oscil ( in1 ) 5598 osc2 0.0 0.0 oscil ( in2 ) amplitude-modulate f2/ 5599 end-run 5600; 5601 5602: ws-test-close-sound { ws -- } 5603 ws ws-output 0 find-sound { ind } 5604 ind sound? if 5605 ind close-sound drop 5606 then 5607; 5608 5609: check-maxamp { ind req name lno -- } 5610 ind 0 #f maxamp { res } 5611 res req <'> f> "%s (%s)[%s]: maxamp" 5612 #( name ind short-file-name lno ) snd-test-any-eq 5613; 5614 5615: (ws-test-close-sound-check) { ws req lno -- } 5616 ws ws-output 0 find-sound { ind } 5617 ind sound? if 5618 ws :statistics ws-ref unless 5619 ind req ws :comment ws-ref lno check-maxamp 5620 then 5621 ind close-sound drop 5622 then 5623; 5624 5625: ws-test-close-sound-check ( ws req -- ) 5626 postpone *lineno* 5627 postpone (ws-test-close-sound-check) 5628; immediate 5629 5630: (23-with-sound) ( -- ) 5631 1024 1024 * to *clm-file-buffer-size* 5632 *clm-play* { old-play } 5633 *clm-player* { old-player } 5634 *clm-statistics* { old-stats } 5635 *snd-test-ws-play* to *clm-play* 5636 *snd-test-ws-player* to *clm-player* 5637 *snd-test-ws-statistics* to *clm-statistics* 5638 \ from clm.fs 5639 <'> test23-clm-examp-1 5640 :comment over object->string with-sound ws-test-close-sound 5641 <'> test23-clm-examp-2 5642 :comment over object->string with-sound ws-test-close-sound 5643 <'> test23-clm-examp-3 5644 :comment over object->string with-sound ws-test-close-sound 5645 <'> test23-clm-examp-4 5646 :comment over object->string with-sound ws-test-close-sound 5647 <'> test23-sound-let 5648 :comment over object->string with-sound ws-test-close-sound 5649 <'> test23-with-mix 5650 :comment over object->string with-sound ws-test-close-sound 5651 <'> run-test 5652 :comment over object->string with-sound ws-test-close-sound 5653 <'> src-test 5654 :comment over object->string with-sound ws-test-close-sound 5655 <'> conv1-test 5656 :comment over object->string with-sound ws-test-close-sound 5657 <'> conv2-test 5658 :comment over object->string with-sound ws-test-close-sound 5659 <'> inst-test 5660 :comment over object->string with-sound ws-test-close-sound 5661 <'> arpeggio-test 5662 :comment over object->string with-sound ws-test-close-sound 5663 \ from bird.fsm 5664 <'> bird-test 5665 :comment over object->string 5666 :verbose *snd-test-ws-verbose* 5667 :channels 2 with-sound ws-test-close-sound 5668 \ from clm-ins.fs 5669 0.0 0.3 <'> clm-ins-test 5670 :comment over object->string 5671 :notehook *snd-test-ws-verbose* if 5672 <'> test23-notehook 5673 else 5674 #f 5675 then 5676 :channels 2 with-sound 1.2 ws-test-close-sound-check 5677 <'> test23-balance 5678 :comment over object->string 5679 :srate 22050 5680 :channels 3 with-sound ws-output 0 find-sound { ind } 5681 ind sound? if 5682 ind close-sound drop 5683 else 5684 "with-sound balance?" snd-display 5685 then 5686 "tmp.snd" 1 22050 mus-bfloat mus-next new-sound to ind 5687 0 1000 ind 0 pad-channel drop 5688 100.0 make-oscil { mg } 5689 1000 make-ssb-fm { gen } 5690 gen mg test23-ssb-fm <'> map-channel snd-test-catch drop 5691 ind close-sound drop 5692 \ examples from sndclm.html 5693 <'> sndclm-oscil-test 5694 :comment over object->string with-sound ws-test-close-sound 5695 <'> sndclm-env-test 5696 :comment over object->string with-sound ws-test-close-sound 5697 <'> sndclm-table-lookup-test 5698 :comment over object->string with-sound ws-test-close-sound 5699 <'> sndclm-polywave-test 5700 :comment over object->string with-sound ws-test-close-sound 5701 <'> sndclm-triangle-wave-test 5702 :comment over object->string with-sound ws-test-close-sound 5703 <'> sndclm-ncos-test 5704 :comment over object->string with-sound ws-test-close-sound 5705 <'> sndclm-nrxycos-test 5706 :comment over object->string with-sound ws-test-close-sound 5707 <'> sndclm-ssb-am-test 5708 :comment over object->string with-sound ws-test-close-sound 5709 <'> sndclm-wave-train-test 5710 :comment over object->string with-sound ws-test-close-sound 5711 <'> sndclm-rand-test 5712 :comment over object->string :channels 2 with-sound ws-test-close-sound 5713 <'> sndclm-two-pole-test 5714 :comment over object->string with-sound ws-test-close-sound 5715 <'> sndclm-firmant-test 5716 :comment over object->string with-sound ws-test-close-sound 5717 <'> sndclm-iir-filter-test 5718 :comment over object->string with-sound ws-test-close-sound 5719 <'> sndclm-delay-test 5720 :comment over object->string with-sound ws-test-close-sound 5721 <'> sndclm-comb-test 5722 :comment over object->string with-sound ws-test-close-sound 5723 <'> sndclm-all-pass-test 5724 :comment over object->string with-sound ws-test-close-sound 5725 <'> sndclm-moving-average-test 5726 :comment over object->string with-sound ws-test-close-sound 5727 <'> sndclm-src1-test 5728 :comment over object->string :srate 22050 with-sound ws-test-close-sound 5729 <'> sndclm-src2-test 5730 :comment over object->string with-sound ws-test-close-sound 5731 <'> sndclm-convolve1-test 5732 :comment over object->string with-sound ws-test-close-sound 5733 <'> sndclm-convolve2-test 5734 :comment over object->string with-sound ws-test-close-sound 5735 <'> sndclm-granulate1-test 5736 :comment over object->string with-sound ws-test-close-sound 5737 <'> sndclm-granulate2-test 5738 :comment over object->string with-sound ws-test-close-sound 5739 <'> sndclm-phase-vocoder1-test 5740 :comment over object->string with-sound ws-test-close-sound 5741 <'> sndclm-phase-vocoder2-test 5742 :comment over object->string :srate 22050 with-sound ws-test-close-sound 5743 <'> sndclm-asymmetric-fm-test 5744 :comment over object->string with-sound ws-test-close-sound 5745 <'> sndclm-file->frample->file-test 5746 :comment over object->string :channels 2 with-sound ws-test-close-sound 5747 <'> sndclm-readin-test 5748 :comment over object->string with-sound ws-test-close-sound 5749 <'> sndclm-in-out-any-test 5750 :comment over object->string with-sound ws-test-close-sound 5751 <'> sndclm-locsig-test 5752 :comment over object->string :channels 2 with-sound ws-test-close-sound 5753 <'> sndclm-amplitude-modulate-test 5754 :comment over object->string with-sound ws-test-close-sound 5755 old-play to *clm-play* 5756 old-player to *clm-player* 5757 old-stats to *clm-statistics* 5758; 5759 5760: 23-with-sound ( -- ) 5761 #f to *clm-to-snd* 5762 (23-with-sound) 5763 #t to *clm-to-snd* 5764 (23-with-sound) 5765; 5766 5767\ ---------------- test 27: general ---------------- 5768 5769*with-test-complex* [if] 5770 : complex-test ( -- ) 5771 \ edot-product (test008) 5772 0.0 vct( 1.0 ) edot-product dup 1.0 fneq if 5773 "edot 1.0: %s?" swap snd-display 5774 else 5775 drop 5776 then 5777 0.0 vct( 0.0 ) edot-product dup 0.0 fneq if 5778 "edot 0.0: %s?" swap snd-display 5779 else 5780 drop 5781 then 5782 0.0 #( 1.0 ) edot-product dup 1.0 fneq if 5783 "edot 1.0: %s?" swap snd-display 5784 else 5785 drop 5786 then 5787 0.0 #( 0+1i ) edot-product dup 0+1i cneq if 5788 "edot i: %s?" swap snd-display 5789 else 5790 drop 5791 then 5792 0.25 two-pi f* vct( 1.0 1.0 1.0 1.0 ) edot-product 5793 0.00 two-pi f* fexp 5794 0.25 two-pi f* fexp f+ 5795 0.50 two-pi f* fexp f+ 5796 0.75 two-pi f* fexp f+ over over fneq if 5797 2 >array "edot 4: %s %s?" swap snd-display 5798 else 5799 2drop 5800 then 5801 0.25 two-pi f* 0-1i c* #( 1.0 2.0 3.0 4.0 ) edot-product 5802 0.00 two-pi f* 0-1i c* cexp 1 c* 5803 0.25 two-pi f* 0-1i c* cexp 2 c* c+ 5804 0.50 two-pi f* 0-1i c* cexp 3 c* c+ 5805 0.75 two-pi f* 0-1i c* cexp 4 c* c+ over over cneq if 5806 2 >array "edot 4 -i: %s %s?" swap snd-display 5807 else 5808 2drop 5809 then 5810 0.25 two-pi f* 0-1i c* #( 1+1i 2+1i 3+1i 4+1i ) edot-product 5811 0.00 two-pi f* 0-1i c* cexp 1+1i c* 5812 0.25 two-pi f* 0-1i c* cexp 2+1i c* c+ 5813 0.50 two-pi f* 0-1i c* cexp 3+1i c* c+ 5814 0.75 two-pi f* 0-1i c* cexp 4+1i c* c+ over over cneq if 5815 2 >array "edot 4 -i * i: %s %s?" swap snd-display 5816 else 5817 2drop 5818 then 5819 ; 5820[else] 5821 <'> noop alias complex-test 5822[then] 5823 5824: print-and-check ( gen name desc -- ) 5825 { gen name desc } 5826 gen mus-name name string<> if 5827 "mus-name %s: %s?" #( name gen mus-name ) snd-display 5828 then 5829 gen mus-describe desc string<> if 5830 "mus-describe %s: %s?" #( name gen ) snd-display 5831 then 5832 gen { egen } 5833 gen egen object-equal? unless 5834 "equal? %s: %s %s?" #( name gen egen ) snd-display 5835 then 5836; 5837 5838: test-gen-equal ( g0 g1 g2 -- ) 5839 { g0 g1 g2 } 5840 \ g0 g1 = 5841 \ g0 g2 <> at start 5842 g0 { g3 } 5843 g0 g3 object-equal? unless 5844 "let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display 5845 then 5846 g0 g1 object-equal? unless 5847 "%s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display 5848 then 5849 g0 g2 object-equal? if 5850 "%s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display 5851 then 5852 g0 0.0 0.0 mus-apply drop 5853 g3 #( 0.0 0.0 ) object-apply drop 5854 g3 0.0 0.0 mus-apply drop 5855 g0 g3 object-equal? unless 5856 "run let %s: %s equal? %s?" #( g0 mus-name g0 g3 ) snd-display 5857 then 5858 g0 g1 object-equal? if 5859 "run %s: %s equal? %s?" #( g0 mus-name g0 g1 ) snd-display 5860 then 5861 g0 g2 object-equal? if 5862 "run %s: %s equal? %s?" #( g0 mus-name g0 g2 ) snd-display 5863 then 5864; 5865 5866\ bind-key proc 5867: C-xC-c <{ -- }> 0 snd-exit ; 5868 5869\ hooks 5870: my-test1-proc <{ fname -- f }> #f ; 5871<'> my-test1-proc alias my-test2-proc 5872<'> my-test1-proc alias my-test3-proc 5873<'> my-test1-proc alias my-test4-proc 5874<'> my-test1-proc alias my-test5-proc 5875 5876: my-local-thunk <{ -- }> 5877 open-hook object-length 3 <> if 5878 "add-hook! local length: %d?" #( open-hook object-length ) snd-display 5879 then 5880 open-hook "my-test3-proc" hook-member? unless 5881 "local3 add-hook!: %s" #( open-hook ) snd-display 5882 then 5883 open-hook "my-test4-proc" hook-member? unless 5884 "local4 add-hook!: %s" #( open-hook ) snd-display 5885 then 5886 open-hook "my-test5-proc" hook-member? unless 5887 "local5 add-hook!: %s" #( open-hook ) snd-display 5888 then 5889; 5890 5891#f value my-se 5892#f value my-sw 5893#f value my-me 5894 5895: my-error-prc <{ msg -- f }> 5896 #t to my-se 5897 #t 5898; 5899 5900: my-warning-prc <{ msg -- f }> 5901 #t to my-sw 5902 #t 5903; 5904 5905: my-mus-error-prc <{ tp msg -- f }> 5906 #t to my-me 5907 #t 5908; 5909 5910: my-error-warning-hooks ( -- ) 5911 snd-error-hook reset-hook! 5912 snd-warning-hook reset-hook! 5913 mus-error-hook reset-hook! 5914 snd-error-hook <'> my-error-prc add-hook! 5915 snd-warning-hook <'> my-warning-prc add-hook! 5916 mus-error-hook <'> my-mus-error-prc add-hook! 5917 "uhoh" snd-error drop 5918 "hiho" snd-warning drop 5919 "/bad/baddy" mus-sound-samples drop 5920 my-se #t "snd-error-hook not called?" #f snd-test-neq 5921 my-sw #t "snd-warning-hook not called?" #f snd-test-neq 5922 my-me #t "mus-error-hook not called?" #f snd-test-neq 5923 snd-error-hook reset-hook! 5924 snd-warning-hook reset-hook! 5925 mus-error-hook reset-hook! 5926; 5927 5928: 27-sel-from-snd ( -- ) 5929 \ play etc (from test 5) 5930 "oboe.snd" open-sound { ind } 5931 ind x-bounds { bnds } 5932 x-position-slider { xp } 5933 y-position-slider { yp } 5934 x-zoom-slider { xz } 5935 y-zoom-slider { yz } 5936 " open-so" snd-completion " open-sound" "completion (1)" #() snd-test-neq 5937 " zoom-focus-r" snd-completion " zoom-focus-right" "completion (2)" 5938 #() snd-test-neq 5939 "oboe.snd" :wait #t play drop 5940 "oboe.snd" :start 12000 :wait #t play drop 5941 "oboe.snd" :start 1200 :end 15000 :wait #t play drop 5942 ind :edit-position #f #f edit-position 1- :wait #t play drop 5943 ind close-sound drop 5944 \ hooks 5945 open-hook reset-hook! 5946 open-hook <'> my-test1-proc add-hook! 5947 open-hook <'> my-test2-proc add-hook! 5948 open-hook object-length 2 <> if 5949 "add-hook! global length: %d?" #( open-hook object-length ) snd-display 5950 then 5951 open-hook "my-test1-proc" hook-member? unless 5952 "global1 add-hook!: %s" #( open-hook ) snd-display 5953 then 5954 open-hook <'> my-test2-proc hook-member? unless 5955 "global2 add-hook!: %s" #( open-hook ) snd-display 5956 then 5957 open-hook 5958 #( <'> my-test3-proc 5959 <'> my-test4-proc 5960 <'> my-test5-proc ) <'> my-local-thunk with-local-hook 5961 open-hook object-length 2 <> if 5962 "add-hook! reset length: %d?" #( open-hook object-length ) snd-display 5963 then 5964 open-hook <'> my-test1-proc hook-member? unless 5965 "reset1 add-hook!: %s" #( open-hook ) snd-display 5966 then 5967 open-hook "my-test2-proc" hook-member? unless 5968 "reset2 add-hook!: %s" #( open-hook ) snd-display 5969 then 5970 my-error-warning-hooks 5971 \ bind-key 5972 <'> C-xC-c { prc } 5973 "c" 4 #t key-binding { old-prc } 5974 "c" 4 prc #t bind-key { prc1 } 5975 "c" 4 #t key-binding { prc2 } 5976 prc prc1 <> if 5977 "bind-key: %s %s?" #( prc prc1 ) snd-display 5978 then 5979 prc prc2 <> if 5980 "key-binding: %s %s?" #( prc prc2 ) snd-display 5981 then 5982 old-prc proc? if 5983 "c" 4 old-prc #t bind-key drop 5984 else 5985 "c" 4 #t unbind-key drop 5986 then 5987 "fmv.snd" 1 22050 mus-bshort mus-next "set-samples test" 100 new-sound to ind 5988 \ new-sound 5989 10 3 3 0.1 make-vct set-samples drop 5990 0 20 ind 0 channel->vct { res } 5991 res vct( 0 0 0 0 0 0 0 0 0 0 0.1 0.1 0.1 0 0 0 0 0 0 0 ) vequal? unless 5992 "1 set samples 0 for 0.1: %s?" #( res ) snd-display 5993 then 5994 ind close-sound drop 5995 \ x-axis-label (test005) 5996 *with-test-gui* if 5997 "oboe.snd" open-sound to ind 5998 #t set-transform-graph? drop 5999 #t set-time-graph? drop 6000 x-axis-label to res 6001 res "time" string<> if 6002 "get time x-axis-label: %s?" #( res ) snd-display 6003 then 6004 "hiho1" ind 0 time-graph set-x-axis-label drop 6005 x-axis-label to res 6006 res "hiho1" string<> if 6007 "set time x-axis-label: %s?" #( res ) snd-display 6008 then 6009 update-transform-graph drop 6010 ind 0 transform-graph x-axis-label to res 6011 res "frequency" string<> if 6012 "get fft x-axis-label: %s?" #( res ) snd-display 6013 then 6014 "hiho2" ind 0 transform-graph set-x-axis-label drop 6015 update-transform-graph drop 6016 ind 0 transform-graph x-axis-label to res 6017 res "hiho2" string<> if 6018 "set fft x-axis-label: %s?" #( res ) snd-display 6019 then 6020 "frequency" ind 0 transform-graph set-x-axis-label drop 6021 '( 0 0 1 1 2 0 ) "lisp" graph drop 6022 update-lisp-graph drop 6023 ind 0 lisp-graph x-axis-label to res 6024 res "lisp" string<> if 6025 "get lisp x-axis-label: %s?" #( res ) snd-display 6026 then 6027 "hiho3" ind 0 lisp-graph set-x-axis-label drop 6028 ind 0 lisp-graph x-axis-label to res 6029 res "hiho3" string<> if 6030 "set lisp x-axis-label: %s?" #( res ) snd-display 6031 then 6032 "hiho4" ind 0 time-graph set-y-axis-label drop 6033 y-axis-label to res 6034 res "hiho4" string<> if 6035 "set time y-axis-label: %s?" #( res ) snd-display 6036 then 6037 "hiho5" ind 0 lisp-graph set-y-axis-label drop 6038 ind 0 lisp-graph y-axis-label to res 6039 res "hiho5" string<> if 6040 "set lisp y-axis-label: %s?" #( res ) snd-display 6041 then 6042 #f set-y-axis-label drop 6043 "hiho6" ind 0 set-y-axis-label drop 6044 ind 0 y-axis-label to res 6045 res "hiho6" string<> if 6046 "set time y-axis-label (time): %s?" #( res ) snd-display 6047 then 6048 #f set-y-axis-label drop 6049 ind close-sound drop 6050 then \ *with-test-gui* 6051 \ edot-product (test008) 6052 complex-test 6053 \ delay (test008) 6054 3 make-delay { gen } 6055 3 make-delay { gen2 } 6056 4 :initial-contents #( 1.0 0.5 0.25 0.0 ) make-delay { gen1 } 6057 4 :initial-contents vct( 1.0 0.5 0.25 0.0 ) make-delay { gen3 } 6058 gen "delay" "delay line[3, step]: [0 0 0]" print-and-check 6059 10 0.0 make-vct map 6060 gen i 0.0 delay 6061 end-map { v0 } 6062 10 0.0 make-vct map 6063 gen2 delay? if 6064 gen2 i 0.0 delay 6065 else 6066 -1.0 6067 then 6068 end-map { v1 } 6069 v0 v1 vequal? unless 6070 "map delay: %s %s?" #( v0 v1 ) snd-display 6071 then 6072 gen delay? unless 6073 "%s not a delay?" #( gen ) snd-display 6074 then 6075 gen mus-length 3 <> if 6076 "delay length: %d?" #( gen mus-length ) snd-display 6077 then 6078 v0 1 vct-ref 0.0 fneq 6079 v0 4 vct-ref 1.0 fneq || 6080 v0 8 vct-ref 5.0 fneq || if 6081 "delay output: %s?" #( v0 ) snd-display 6082 then 6083 gen1 0.0 0.0 delay 1.0 fneq 6084 gen1 0.0 0.0 delay 0.5 fneq || 6085 gen1 0.0 0.0 delay 0.25 fneq || 6086 gen1 0.0 0.0 delay 0.0 fneq || 6087 gen1 0.0 0.0 delay 0.0 fneq || if 6088 "delay with list initial-contents confused" #f snd-display 6089 then 6090 gen3 0.0 0.0 delay 1.0 fneq 6091 gen3 0.0 0.0 delay 0.5 fneq || 6092 gen3 0.0 0.0 delay 0.25 fneq || 6093 gen3 0.0 0.0 delay 0.0 fneq || 6094 gen3 0.0 0.0 delay 0.0 fneq || if 6095 "delay with vct initial-contents confused" #f snd-display 6096 then 6097 :size #f <'> make-delay snd-test-catch to res 6098 res 0 array-ref 'wrong-type-arg object-equal? unless 6099 "make-delay bad size false: %s" #( res ) snd-display 6100 then 6101 make-oscil { osc } 6102 3 :initial-element osc <'> make-delay snd-test-catch to res 6103 res 0 array-ref 'wrong-type-arg object-equal? unless 6104 "make-delay bad initial element: %s" #( res ) snd-display 6105 then 6106 -3 <'> make-delay snd-test-catch to res 6107 res 0 array-ref 'out-of-range object-equal? unless 6108 "make-delay bad size: %s" #( res ) snd-display 6109 then 6110 3 make-delay { d1 } 6111 3 make-delay { d2 } 6112 4 make-delay { d3 } 6113 d1 1.0 0.0 delay drop 6114 d2 1.0 0.0 delay drop 6115 d3 1.0 0.0 delay drop 6116 d1 d2 d3 test-gen-equal 6117 3 :initial-element 1.0 make-delay to d1 6118 3 :initial-element 1.0 make-delay to d2 6119 3 :initial-element 0.5 make-delay to d3 6120 d1 d2 d3 test-gen-equal 6121 3 :initial-contents #( 1.0 0.0 0.0 ) make-delay to d1 6122 3 :initial-contents #( 1.0 0.0 0.0 ) make-delay to d2 6123 3 :initial-contents #( 1.0 1.0 1.0 ) make-delay to d3 6124 d1 d2 d3 test-gen-equal 6125 \ mix (test009) 6126 "hiho.wave" 1 22050 mus-bshort mus-next new-sound { new-index } 6127 new-index select-sound drop 6128 0 new-index 0 find-mix to res 6129 res if 6130 "found non-existent mix: %s?" #( res ) snd-display 6131 then 6132 "pistol.snd" 100 mix car { mix-id } 6133 mix-id mix? unless 6134 "%s not mix?" #( mix-id ) snd-display 6135 then 6136 view-mixes-dialog drop 6137 mix-id mix-position { pos } 6138 mix-id mix-length { len } 6139 mix-id mix-speed { spd } 6140 mix-id mix-home { home-lst } 6141 home-lst 0 array-ref { snd } 6142 home-lst 1 array-ref { chn } 6143 mix-id mix-amp { amp } 6144 mix-id make-mix-sampler { mr } 6145 mr mix-sampler? unless 6146 "%s is not mix-sampler?" #( mr ) snd-display 6147 then 6148 mr region-sampler? if 6149 "mix-sampler: region %s?" #( mr ) snd-display 6150 then 6151 mr sampler-position to res 6152 res 0<> if 6153 "mix sampler-position: %d?" #( res ) snd-display 6154 then 6155 mr sampler-at-end? if 6156 "mix sampler-at-end: %s?" #( mr ) snd-display 6157 then 6158 mr sampler-home to res 6159 mix-id res object-equal? unless 6160 "mix sampler-home: %d %s?" #( res mr ) snd-display 6161 then 6162 mr object->string 0 16 string-substring to res 6163 res "#<mix-sampler mi" string<> if 6164 "mix sampler actually got: [%s]?" #( res ) snd-display 6165 then 6166 0.0 0.0 { mx sx } 6167 99 0 do 6168 \ XXX: i odd? if mr read-mix-sample else mr read-mix-sample then to mx 6169 mr read-mix-sample to mx 6170 100 i + sample to sx 6171 mx sx fneq if 6172 "read-mix-sample: %s %s?" #( mx sx ) snd-display 6173 then 6174 loop 6175 \ Scheme: (mr) 6176 \ Ruby: mr.call 6177 \ Forth: mr #() apply 6178 mr #() object-apply to mx 6179 199 sample to sx 6180 mx sx fneq if 6181 "read-mix-sample 100: %s %s?" #( mx sx ) snd-display 6182 then 6183 mr free-sampler drop 6184 \ 6185 100 pos <> if 6186 "mix-position: %d?" #( pos ) snd-display 6187 then 6188 41623 len <> if 6189 "mix-length: %d?" #( len ) snd-display 6190 then 6191 snd new-index object-equal? unless 6192 "snd mix-home: %s?" #( snd ) snd-display 6193 then 6194 chn 0<> if 6195 "chn mix-home: %d?" #( chn ) snd-display 6196 then 6197 amp 1.0 fneq if 6198 "mix-amp: %s?" #( amp ) snd-display 6199 then 6200 spd 1.0 fneq if 6201 "mix-speed: %s?" #( spd ) snd-display 6202 then 6203 mix-id <'> play #t nil fth-catch if 6204 drop \ on stack: mix-id 6205 "cannot play mix" #() snd-display 6206 else 6207 drop \ on stack: play's return value 6208 then 6209 stack-reset 6210 mix-id :start 1000 <'> play #t nil fth-catch if 6211 stack-reset \ on stack: mix-id :start 1000 6212 "cannot play mix from 1000" #() snd-display 6213 else 6214 drop \ on stack: play's return value 6215 stack-reset 6216 then 6217 \ 6218 mix-id 200 set-mix-position drop 6219 mix-id 0.5 set-mix-amp drop 6220 mix-id 2.0 set-mix-speed drop 6221 mix-id #( 0 0 1 1 ) set-mix-amp-env drop 6222 mix-id mix-amp-env to res 6223 mix-id res set-mix-amp-env drop 6224 mix-id mix-amp-env { res1 } 6225 res res1 vequal? unless 6226 "set-mix-amp-env to self: %s %s?" #( res res1 ) snd-display 6227 then 6228 mix-id 20 set-mix-tag-y drop 6229 mix-id mix-position to pos 6230 mix-id mix-speed to spd 6231 mix-id mix-amp to amp 6232 mix-id mix-tag-y { my } 6233 200 pos <> if 6234 "set-mix-position: %d?" #( pos ) snd-display 6235 then 6236 spd 2.0 fneq if 6237 "set-mix-speed: %s?" #( spd ) snd-display 6238 then 6239 my 20 <> if 6240 "set-mix-tag-y: %d?" #( my ) snd-display 6241 then 6242 amp 0.5 fneq if 6243 "set-mix-amp: %s?" #( amp ) snd-display 6244 then 6245 mix-id mix-amp-env to res 6246 res #( 0.0 0.0 1.0 1.0 ) array= unless 6247 "set-mix-amp-env: %s?" #( res ) snd-display 6248 then 6249 \ 6250 3 0.1 make-vct 100 #f #f #t "" mix-vct drop 6251 0 set-cursor drop 6252 100 #f #f find-mix { nid } 6253 nid mix? false? unless 6254 nid mix-position 100 <> if 6255 new-index 0 mixes map 6256 *key* mix-position 6257 end-map { mx-pos } 6258 "100 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display 6259 then 6260 else 6261 "100 find-mix: not a mix %s?" #( nid ) snd-display 6262 then 6263 200 #f #f find-mix to nid 6264 nid mix? false? unless 6265 nid mix-position 200 <> if 6266 new-index 0 mixes map 6267 *key* mix-position 6268 end-map { mx-pos } 6269 "200 find-mix: %s %s %s?" #( nid dup mix-position mx-pos ) snd-display 6270 then 6271 else 6272 "200 find-mix: not a mix %s?" #( nid ) snd-display 6273 then 6274 \ 6275 "oboe.snd" 100 mix car to mix-id 6276 40 set-mix-waveform-height drop 6277 'hiho mix-id 123 set-mix-property 6278 'hiho mix-id mix-property to res 6279 res 123 <> if 6280 "mix-property: %s?" #( res ) snd-display 6281 then 6282 'not-here mix-id mix-property to res 6283 res if 6284 "mix-property not-here: %s?" #( res ) snd-display 6285 then 6286 #f #f update-time-graph drop 6287 20 set-mix-waveform-height drop 6288 new-index revert-sound drop 6289 new-index close-sound drop 6290 \ envelopes (lists, vcts, arrays) (test015) 6291 1.0 vct( 0.0 0.0 2.0 1.0 ) 1.0 envelope-interp dup 0.5 fneq if 6292 "envelope-interp 0.5: %s?" swap snd-display 6293 else 6294 drop 6295 then 6296 1.0 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 1.0 envelope-interp dup 1.0 fneq if 6297 "envelope-interp 1.0: %s?" swap snd-display 6298 else 6299 drop 6300 then 6301 2.0 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if 6302 "envelope-interp 1.0: %s?" swap snd-display 6303 else 6304 drop 6305 then 6306 0.0 #( 1.0 0.5 2.0 0.0 ) 1.0 envelope-interp dup 0.5 fneq if 6307 "envelope-interp 0.5: %s?" swap snd-display 6308 else 6309 drop 6310 then 6311 0.0 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 1.0 fneq if 6312 "envelope-interp 1.0; %s?" swap snd-display 6313 else 6314 drop 6315 then 6316 -0.5 #( -1.0 0.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 0.5 fneq if 6317 "envelope-interp 0.5: %s?" swap snd-display 6318 else 6319 drop 6320 then 6321 -0.5 #( -1.0 -1.0 0.0 1.0 1.0 -1.0 ) 1.0 envelope-interp dup 0.0 fneq if 6322 "envelope-interp 0.0: %s?" swap snd-display 6323 else 6324 drop 6325 then 6326 -0.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -0.5 fneq if 6327 "envelope-interp -0.5: %s?" swap snd-display 6328 else 6329 drop 6330 then 6331 -1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup -1.0 fneq if 6332 "envelope-interp -1.0: %s?" swap snd-display 6333 else 6334 drop 6335 then 6336 1.5 #( -1.0 -1.0 1.0 1.0 ) 1.0 envelope-interp dup 1.0 fneq if 6337 "envelope-interp 1.0: %s?" swap snd-display 6338 else 6339 drop 6340 then 6341 0.1 #( 0.0 0.0 1.0 1.0 ) 1.0 envelope-interp dup 0.1 fneq if 6342 "envelope-interp 0.1: %s?" swap snd-display 6343 else 6344 drop 6345 then 6346 0.1 #( 0.0 0.0 1.0 1.0 ) 32.0 envelope-interp dup 0.01336172 fneq if 6347 "envelope-interp (exp 32): %s?" swap snd-display 6348 else 6349 drop 6350 then 6351 0.1 #( 0.0 0.0 1.0 1.0 ) 0.012 envelope-interp dup 0.36177473 fneq if 6352 "envelope-interp (exp 0.012): %s?" swap snd-display 6353 else 6354 drop 6355 then 6356 0.3 #( 0.0 0.0 0.5 1.0 1.0 0.0 ) 1.0 envelope-interp dup 0.6 fneq if 6357 "envelope-interp 0.6: %s?" swap snd-display 6358 else 6359 drop 6360 then 6361 #( 0.0 0.0 0.5 0.5 1.0 0.5 ) { v0 } 6362 #( 0.0 0.0 2.0 0.5 ) #( 0.0 0.0 1.0 2.0 2.0 1.0 ) 6363 multiply-envelopes dup v0 0 fveql unless 6364 "multiply-envelopes: %s?" swap snd-display 6365 else 6366 drop 6367 then 6368 #( 0.0 0.0 0.5 0.5 1.0 0.0 ) to v0 6369 #( 0.0 0.0 1.0 1.0 ) #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 6370 multiply-envelopes dup v0 0 fveql unless 6371 "multiply-envelopes: %s?" swap snd-display 6372 else 6373 drop 6374 then 6375 #( 0.0 0.0 1.0 1.0 2.0 3.0 4.0 0.0 ) max-envelope dup 3.0 fneq if 6376 "0 max-envelope: %s?" swap snd-display 6377 else 6378 drop 6379 then 6380 #( 0.0 1.0 ) max-envelope dup 1.0 fneq if 6381 "1 max-envelope: %s?" swap snd-display 6382 else 6383 drop 6384 then 6385 #( 0.0 1.0 1.0 1.0 2.0 2.0 ) max-envelope dup 2.0 fneq if 6386 "2 max-envelope: %s?" swap snd-display 6387 else 6388 drop 6389 then 6390 #( 0.0 -1.0 1.0 -2.0 ) max-envelope dup -1.0 fneq if 6391 "3 max-envelope: %s?" swap snd-display 6392 else 6393 drop 6394 then 6395 #( 0.0 -2.0 1.0 -1.0 ) max-envelope dup -1.0 fneq if 6396 "4 max-envelope: %s?" swap snd-display 6397 else 6398 drop 6399 then 6400 #( 0.0 0.0 1.0 1.0 2.0 3.0 4.0 0.0 ) min-envelope dup 0.0 fneq if 6401 "0 min-envelope: %s?" swap snd-display 6402 else 6403 drop 6404 then 6405 #( 0.0 1.0 ) min-envelope dup 1.0 fneq if 6406 "1 min-envelope: %s?" swap snd-display 6407 else 6408 drop 6409 then 6410 #( 0.0 1.0 1.0 1.0 2.0 2.0 ) min-envelope dup 1.0 fneq if 6411 "2 min-envelope: %s?" swap snd-display 6412 else 6413 drop 6414 then 6415 #( 0.0 -1.0 1.0 -2.0 ) min-envelope dup -2.0 fneq if 6416 "3 min-envelope: %s?" swap snd-display 6417 else 6418 drop 6419 then 6420 #( 0.0 -2.0 1.0 -1.0 ) min-envelope dup -2.0 fneq if 6421 "4 min-envelope: %s?" swap snd-display 6422 else 6423 drop 6424 then 6425 #( 0.0 0.0 0.2 0.1 1.0 1.0 ) to v0 6426 #( 0.0 0.0 1.0 1.0 ) 0.1 0.2 #f #f stretch-envelope dup v0 0 fveql unless 6427 "stretch-envelope att: %s?" swap snd-display 6428 else 6429 drop 6430 then 6431 #( 0.0 0.0 0.2 0.1 1.1 1.0 1.6 0.5 2.0 0.0 ) to v0 6432 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6 6433 stretch-envelope dup v0 0 fveql unless 6434 "stretch-envelope dec: %s?" swap snd-display 6435 else 6436 drop 6437 then 6438 #( 0.0 0.0 0.2 0.1 1.1 1.0 1.6 0.5 2.0 0.0 ) to v0 6439 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) 0.1 0.2 1.5 1.6 6440 stretch-envelope dup v0 0 fveql unless 6441 "stretch-envelope: %s?" swap snd-display 6442 else 6443 drop 6444 then 6445 #( 0.0 0.0 0.5 1.5 1.0 1.0 ) to v0 6446 #( 0.0 0.0 1.0 1.0 2.0 0.0 ) #( 0.0 0.0 1.0 1.0 ) 6447 add-envelopes dup v0 0 fveql unless 6448 "add-envelopes: %s?" swap snd-display 6449 else 6450 drop 6451 then 6452 #( 0.0 0.0 1.0 2.0 ) to v0 6453 #( 0.0 0.0 1.0 1.0 ) 2.0 scale-envelope dup v0 0 fveql unless 6454 "scale-envelope: %s?" swap snd-display 6455 else 6456 drop 6457 then 6458 #( 0.0 1.0 1.0 0.0 ) to v0 6459 #( 0.0 0.0 1.0 1.0 ) reverse-envelope dup v0 0 fveql unless 6460 "reverse-envelope: %s?" swap snd-display 6461 else 6462 drop 6463 then 6464 #( 0.0 0.0 1.5 1.0 2.0 0.0 ) to v0 6465 #( 0.0 0.0 0.5 1.0 2.0 0.0 ) reverse-envelope dup v0 0 fveql unless 6466 "reverse-envelope: %s?" swap snd-display 6467 else 6468 drop 6469 then 6470 #( 0.0 1.0 1.5 1.0 2.0 0.0 ) to v0 6471 #( 0.0 0.0 0.5 1.0 2.0 1.0 ) reverse-envelope dup v0 0 fveql unless 6472 "reverse-envelope: %s?" swap snd-display 6473 else 6474 drop 6475 then 6476; 6477 6478\ ---------------- test 28: errors ---------------- 6479 6480: check-error-tag { xt expected-tag -- } 6481 xt snd-test-catch { tag } 6482 tag if \ we ignore #f 6483 tag car expected-tag <> if 6484 "%s: expected %s from %s, got %s?" 6485 #( get-func-name expected-tag xt tag ) snd-display 6486 then 6487 then 6488; 6489 6490*with-test-motif* [if] 6491 : snd-motif-error-checks ( -- ) 6492 '( 'Widget 0 ) <'> widget-position 'no-such-widget check-error-tag 6493 '( 'Widget 0 ) <'> widget-size 'no-such-widget check-error-tag 6494 '( 'Widget 0 ) <'> widget-text 'no-such-widget check-error-tag 6495 '( 'Widget 0 ) #( 0 0 ) <'> set-widget-position 'no-such-widget 6496 check-error-tag 6497 '( 'Widget 0 ) #( 10 10 ) <'> set-widget-size 'no-such-widget 6498 check-error-tag 6499 '( 'Widget 0 ) "hiho" <'> set-widget-text 'no-such-widget check-error-tag 6500 nil nil { prc tag } 6501 #( <'> widget-position <'> widget-size <'> widget-text 6502 <'> hide-widget <'> show-widget <'> focus-widget ) each to prc 6503 '( 'Widget 0 ) prc snd-test-catch to tag 6504 tag if 6505 tag car 'no-such-widget <> if 6506 "%s of null widget -> %s" #( prc tag ) snd-display 6507 then 6508 then 6509 end-each 6510 ; 6511[else] 6512 <'> noop alias snd-motif-error-checks 6513[then] 6514[ifundef] mus-audio-reinitialize 6515 : mus-audio-reinitialize ( -- n ) 0 ; 6516[then] 6517 6518: pt-test-1 <{ a -- f }> #f ; 6519: pt-test-2 <{ a b -- f }> #f ; 6520: pt-test-3 <{ a b c -- f }> #f ; 6521 6522#( 1 2 3 ) constant color-95 6523440 make-oscil constant delay-32 65240 make-array constant vector-0 65253 0.0 make-vct constant vct-3 65265 0.0 make-vct constant vct-5 6527 6528#( <'> make-all-pass <'> make-asymmetric-fm <'> make-snd->sample 6529 <'> make-moving-average <'> make-comb <'> make-filtered-comb 6530 <'> make-convolve <'> make-delay <'> make-env <'> make-fft-window 6531 <'> make-file->frample <'> make-file->sample <'> make-filter 6532 <'> make-fir-filter <'> make-formant <'> make-firmant 6533 <'> make-frample->file <'> make-granulate <'> make-iir-filter 6534 <'> make-locsig <'> make-notch <'> make-one-pole 6535 <'> make-one-zero <'> make-oscil <'> make-pulse-train <'> make-rand 6536 <'> make-rand-interp <'> make-readin <'> make-sample->file 6537 <'> make-sawtooth-wave <'> make-nrxysin <'> make-nrxycos 6538 <'> make-square-wave <'> make-src <'> make-ncos <'> make-nsin 6539 <'> make-table-lookup <'> make-triangle-wave <'> make-two-pole 6540 <'> make-two-zero <'> make-wave-train <'> make-phase-vocoder 6541 <'> make-ssb-am <'> make-polyshape <'> make-polywave 6542 <'> make-player <'> make-region ) constant make-procs 6543 6544#( :frequency :initial-phase :wave :cosines :amplitude :ratio :size 6545 :a0 :a1 :a2 :b1 :b2 :input :srate :file :channel :start 6546 :initial-contents :initial-element :scaler :feedforward 6547 :feedback :max-size :radius :gain :partials :r :a :n :fill-time 6548 :order :xcoeffs :ycoeffs :envelope :base :duration :offset :end 6549 :direction :degree :distance :reverb :output :fft-size :expansion 6550 :length :hop :ramp :jitter :type :format :comment :channels :filter 6551 :revout :width :edit :synthesize :analyze :interp :overlap :pitch 6552 :distribution :sines :dur ) constant keyargs 6553 6554#( <'> add-mark <'> add-sound-file-extension <'> add-source-file-extension 6555 <'> sound-file-extensions <'> sound-file? <'> add-to-main-menu 6556 <'> add-to-menu <'> add-transform <'> amp-control 6557 <'> ask-about-unsaved-edits <'> as-one-edit <'> ask-before-overwrite 6558 <'> auto-resize 6559 <'> auto-update <'> autocorrelate <'> axis-info <'> apply-controls 6560 <'> change-samples-with-origin <'> channel-style <'> channels 6561 <'> chans <'> close-sound <'> combined-data-color <'> comment 6562 <'> contrast-control <'> contrast-control-amp <'> contrast-control? 6563 <'> convolve-selection-with <'> convolve-with <'> channel-properties 6564 <'> channel-property <'> amp-control-bounds <'> speed-control-bounds 6565 <'> expand-control-bounds <'> contrast-control-bounds 6566 <'> reverb-control-length-bounds <'> reverb-control-scale-bounds 6567 <'> cursor-update-interval <'> cursor-location-offset 6568 <'> auto-update-interval <'> cursor 6569 <'> with-tracking-cursor <'> cursor-size <'> cursor-style 6570 <'> tracking-cursor-style <'> dac-combines-channels <'> dac-size 6571 <'> clipping <'> sample-type <'> data-location <'> data-size 6572 <'> default-output-chans <'> default-output-sample-type 6573 <'> default-output-srate <'> default-output-header-type 6574 <'> define-envelope <'> delete-mark <'> delete-marks 6575 <'> forget-region <'> delete-sample <'> delete-samples 6576 <'> delete-samples-and-smooth <'> delete-selection 6577 <'> delete-selection-and-smooth <'> display-edits 6578 <'> edit-fragment <'> edit-position <'> edit-tree <'> edits 6579 <'> env-selection <'> env-sound <'> enved-envelope <'> enved-base 6580 <'> enved-clip? <'> enved-in-dB <'> enved-style <'> enved-power 6581 <'> enved-target <'> enved-wave? <'> eps-file <'> eps-left-margin 6582 <'> eps-bottom-margin <'> eps-size <'> expand-control 6583 <'> expand-control-hop <'> expand-control-jitter 6584 <'> expand-control-length <'> expand-control-ramp 6585 <'> expand-control? <'> fft <'> fft-window-alpha 6586 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 6587 <'> transform-size <'> disk-kspace <'> transform-graph-type 6588 <'> fft-window <'> transform-graph? <'> file-name <'> filter-sound 6589 <'> filter-control-in-dB <'> filter-control-envelope 6590 <'> enved-filter-order <'> enved-filter <'> filter-control-in-hz 6591 <'> filter-control-order <'> filter-selection <'> filter-channel 6592 <'> filter-control? <'> find-mark <'> find-sound 6593 <'> finish-progress-report <'> framples <'> free-sampler <'> graph 6594 <'> transform? <'> delete-transform <'> graph-cursor <'> graph->ps 6595 <'> gl-graph->ps <'> graph-style <'> lisp-graph? <'> graphs-horizontal 6596 <'> header-type <'> in <'> insert-region <'> insert-sample 6597 <'> insert-samples <'> insert-samples-with-origin <'> insert-selection 6598 <'> insert-silence <'> insert-sound <'> just-sounds <'> left-sample 6599 <'> listener-prompt <'> make-mix-sampler <'> make-player 6600 <'> make-region <'> make-region-sampler <'> make-sampler 6601 <'> map-chan <'> mark-name <'> mark-properties <'> mark-property 6602 <'> mark-sample <'> mark-sync <'> mark-sync-max <'> mark-home 6603 <'> marks <'> mark? <'> max-transform-peaks <'> max-regions 6604 <'> maxamp <'> maxamp-position <'> min-dB <'> log-freq-start 6605 <'> mix <'> mixes <'> mix-amp <'> mix-amp-env <'> mix-length 6606 <'> mix? <'> mix-position <'> mix-properties <'> mix-property 6607 <'> mix-name <'> mix-region <'> mix-sampler? <'> mix-selection 6608 <'> mix-sound <'> mix-home <'> mix-speed <'> mix-tag-height 6609 <'> mix-tag-width <'> mark-tag-height <'> mark-tag-width 6610 <'> mix-tag-y <'> mix-vct <'> mix-waveform-height <'> time-graph-style 6611 <'> lisp-graph-style <'> transform-graph-style <'> read-mix-sample 6612 <'> next-sample <'> show-full-duration <'> show-full-range 6613 <'> initial-beg <'> initial-dur <'> transform-normalization 6614 <'> open-raw-sound <'> open-sound <'> previous-sample <'> peaks 6615 <'> player? <'> players <'> print-length <'> progress-report 6616 <'> read-only <'> redo <'> region-chans <'> region-home 6617 <'> region-graph-style <'> region-framples <'> region-position 6618 <'> region-maxamp <'> region-maxamp-position <'> remember-sound-state 6619 <'> selection-maxamp <'> selection-maxamp-position <'> region-sample 6620 <'> region->vct <'> region-srate <'> regions <'> region? 6621 <'> remove-from-menu <'> reset-controls <'> restore-controls 6622 <'> restore-region <'> reverb-control-decay 6623 <'> reverb-control-feedback <'> reverb-control-length 6624 <'> reverb-control-lowpass <'> reverb-control-scale 6625 <'> reverb-control? <'> reverse-sound <'> reverse-selection 6626 <'> revert-sound <'> right-sample <'> sample <'> sampler-at-end? 6627 <'> sampler? <'> samples <'> sampler-position <'> save-controls 6628 <'> peak-env-dir <'> save-dir <'> save-edit-history 6629 <'> save-envelopes <'> save-listener <'> save-marks 6630 <'> save-region <'> save-selection <'> save-sound <'> save-sound-as 6631 <'> save-state <'> save-state-file <'> scale-by <'> scale-selection-by 6632 <'> scale-selection-to <'> scale-to <'> search-procedure 6633 <'> select-all <'> select-channel <'> select-sound <'> selected-channel 6634 <'> selected-sound <'> selection-position <'> selection-creates-region 6635 <'> selection-framples <'> selection-member? <'> selection? 6636 <'> short-file-name <'> show-axes <'> show-controls 6637 <'> show-transform-peaks <'> show-indices <'> show-listener 6638 <'> show-selection <'> unselect-all <'> show-marks 6639 <'> show-mix-waveforms <'> show-selection-transform 6640 <'> show-y-zero <'> sinc-width <'> show-grid <'> show-sonogram-cursor 6641 <'> grid-density <'> smooth-sound <'> smooth-selection <'> snd-spectrum 6642 <'> snd-tempnam <'> snd-version <'> sound-files-in-directory 6643 <'> sound-loop-info <'> sound? <'> sounds <'> spectrum-end 6644 <'> spectro-hop <'> spectrum-start <'> spectro-x-angle 6645 <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale 6646 <'> spectro-z-angle <'> spectro-z-scale <'> speed-control 6647 <'> speed-control-style <'> speed-control-tones <'> squelch-update 6648 <'> srate <'> src-sound <'> src-selection <'> start-progress-report 6649 <'> stop-player <'> stop-playing <'> swap-channels <'> syncd-marks 6650 <'> sync <'> sync-max <'> sound-properties <'> sound-property 6651 <'> temp-dir <'> region-sampler? <'> transform-sample 6652 <'> transform->vct <'> transform-framples <'> transform-type 6653 <'> with-file-monitor <'> undo 6654 <'> update-transform-graph <'> update-time-graph 6655 <'> update-lisp-graph <'> update-sound <'> clm-table-size 6656 <'> with-verbose-cursor <'> view-sound <'> wavelet-type 6657 <'> with-inset-graph <'> with-interrupts <'> with-pointer-focus 6658 <'> with-smpte-label <'> with-toolbar <'> with-tooltips 6659 <'> with-menu-icons <'> save-as-dialog-src 6660 <'> save-as-dialog-auto-comment <'> time-graph? 6661 <'> time-graph-type <'> wavo-hop <'> wavo-trace <'> window-height 6662 <'> window-width <'> window-x <'> window-y <'> with-mix-tags 6663 <'> with-relative-panes <'> with-gl <'> x-axis-style 6664 <'> beats-per-measure <'> beats-per-minute <'> x-bounds 6665 <'> x-position-slider <'> x-zoom-slider <'> mus-header-type->string 6666 <'> mus-sample-type->string <'> y-bounds <'> y-position-slider 6667 <'> y-zoom-slider <'> zero-pad <'> zoom-focus-style <'> sync-style 6668 <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration 6669 <'> mus-sound-datum-size <'> mus-sound-data-location <'> data-size 6670 <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type 6671 <'> mus-sound-sample-type <'> mus-sound-length 6672 <'> mus-sound-type-specifier <'> mus-header-type-name 6673 <'> mus-sample-type-name <'> mus-sound-comment 6674 <'> mus-sound-write-date <'> mus-bytes-per-sample 6675 <'> mus-sound-loop-info <'> mus-alsa-squelch-warning 6676 <'> mus-sound-maxamp <'> mus-sound-maxamp-exists? 6677 <'> mus-clipping 6678 <'> mus-file-clipping <'> mus-header-raw-defaults <'> moving-average 6679 <'> moving-average? <'> make-moving-average <'> mus-expand-filename 6680 <'> all-pass <'> all-pass? <'> amplitude-modulate 6681 <'> array->file <'> array-interp <'> mus-interpolate <'> asymmetric-fm 6682 <'> asymmetric-fm? <'> comb 6683 <'> comb? <'> filtered-comb <'> filtered-comb? <'> contrast-enhancement 6684 <'> convolution <'> convolve <'> convolve? <'> db->linear 6685 <'> degrees->radians <'> delay <'> delay? <'> dot-product <'> env 6686 <'> env-interp <'> env? <'> file->array <'> file->frample <'> file->frample? 6687 <'> file->sample <'> file->sample? <'> filter <'> filter? <'> fir-filter 6688 <'> fir-filter? <'> formant <'> formant-bank <'> formant? 6689 <'> frample->file <'> frample->file? <'> frample->frample 6690 <'> granulate <'> granulate? <'> hz->radians <'> iir-filter 6691 <'> iir-filter? <'> in-any <'> ina <'> inb <'> linear->db <'> locsig 6692 <'> locsig-ref <'> locsig-reverb-ref <'> locsig-reverb-set! 6693 <'> locsig-set! <'> locsig? <'> make-all-pass <'> make-asymmetric-fm 6694 <'> make-comb <'> make-filtered-comb <'> make-convolve <'> make-delay 6695 <'> make-env <'> make-fft-window <'> make-file->frample 6696 <'> make-file->sample <'> make-filter <'> make-fir-filter 6697 <'> make-formant <'> make-frample->file <'> make-granulate 6698 <'> make-iir-filter <'> make-locsig <'> move-locsig 6699 <'> make-notch <'> make-one-pole <'> make-one-zero <'> make-oscil 6700 <'> make-pulse-train <'> make-rand <'> make-rand-interp <'> make-readin 6701 <'> make-sample->file <'> make-sawtooth-wave <'> make-square-wave 6702 <'> make-src <'> make-ssb-am <'> make-table-lookup <'> make-triangle-wave 6703 <'> make-two-pole <'> make-two-zero <'> make-wave-train <'> move-sound 6704 <'> make-move-sound <'> move-sound? <'> mus-float-equal-fudge-factor 6705 <'> mus-array-print-length <'> mus-channel 6706 <'> mus-channels <'> make-polyshape <'> polyshape? <'> mus-close 6707 <'> mus-data <'> mus-feedback <'> mus-feedforward <'> mus-fft 6708 <'> mus-frequency <'> mus-hop <'> mus-increment <'> mus-input? 6709 <'> mus-file-name <'> mus-length <'> mus-location 6710 <'> mus-order <'> mus-output? <'> mus-phase <'> mus-ramp <'> mus-random 6711 <'> mus-scaler <'> mus-srate <'> mus-xcoeffs <'> mus-ycoeffs <'> notch 6712 <'> notch? <'> one-pole <'> one-pole? <'> one-zero <'> one-zero? 6713 <'> oscil <'> oscil? <'> out-any <'> outa <'> outb <'> outc <'> outd 6714 <'> partials->polynomial <'> partials->wave <'> phase-partials->wave 6715 <'> polynomial <'> pulse-train <'> pulse-train? <'> radians->degrees 6716 <'> radians->hz <'> rand <'> rand-interp <'> rand-interp? <'> rand? 6717 <'> readin <'> readin? <'> rectangular->polar <'> rectangular->magnitudes 6718 <'> ring-modulate <'> sample->file <'> sample->file? 6719 <'> sawtooth-wave <'> sawtooth-wave? <'> spectrum <'> square-wave 6720 <'> square-wave? <'> src <'> src? <'> ssb-am <'> ssb-am? 6721 <'> table-lookup <'> table-lookup? <'> tap <'> triangle-wave 6722 <'> triangle-wave? <'> two-pole <'> two-pole? <'> two-zero 6723 <'> two-zero? <'> wave-train <'> wave-train? <'> make-vct 6724 <'> vct-add! <'> vct-subtract! <'> vct-length 6725 <'> vct-multiply! <'> vct-offset! <'> vct-ref <'> vct-scale! 6726 <'> vct-set! <'> vct-peak <'> vct? <'> list->vct 6727 <'> vct->list <'> vector->vct <'> vct->vector <'> vct-move! 6728 <'> vct-reverse! <'> vct-subseq <'> vct <'> little-endian? 6729 <'> vct->string <'> clm-channel <'> env-channel <'> map-channel 6730 <'> scan-channel <'> reverse-channel <'> seconds->samples 6731 <'> samples->seconds <'> smooth-channel <'> vct->channel 6732 <'> channel->vct <'> src-channel <'> scale-channel <'> ramp-channel 6733 <'> pad-channel <'> normalize-channel <'> cursor-position 6734 <'> show-listener <'> mus-sound-prune <'> mus-sound-forget 6735 <'> xramp-channel <'> snd->sample <'> snd->sample? <'> make-snd->sample 6736 <'> beats-per-minute <'> beats-per-measure 6737 <'> channel-amp-envs <'> convolve-files <'> filter-control-coeffs 6738 <'> locsig-type <'> make-phase-vocoder <'> mus-describe 6739 <'> mus-error-type->string <'> mus-file-buffer-size <'> mus-name 6740 <'> mus-offset <'> mus-out-format <'> mus-reset <'> mus-rand-seed 6741 <'> mus-width <'> phase-vocoder? <'> polar->rectangular 6742 <'> phase-vocoder-amp-increments <'> phase-vocoder-amps 6743 <'> phase-vocoder-freqs <'> phase-vocoder-phase-increments 6744 <'> phase-vocoder-phases <'> mus-generator? <'> read-sample 6745 <'> reset-listener-cursor <'> goto-listener-end <'> sampler-home 6746 <'> selection-chans <'> selection-srate <'> snd-warning 6747 <'> channel-data <'> x-axis-label <'> variable-graph? <'> y-axis-label 6748 <'> snd-url <'> snd-urls <'> free-player <'> delete-mix <'> delay-tick 6749 <'> playing <'> pausing <'> copy-sampler <'> html-dir <'> html-program 6750 <'> make-fir-coeffs <'> mus-interp-type 6751 <'> mus-run <'> phase-vocoder <'> player-home <'> redo-edit 6752 <'> undo-edit ) constant procs 6753 6754#( <'> amp-control <'> ask-before-overwrite <'> auto-update <'> channel-style 6755 <'> sound-file-extensions <'> show-full-duration <'> show-full-range 6756 <'> initial-beg <'> initial-dur <'> contrast-control 6757 <'> contrast-control-amp <'> combined-data-color <'> amp-control-bounds 6758 <'> speed-control-bounds <'> expand-control-bounds 6759 <'> contrast-control-bounds <'> reverb-control-length-bounds 6760 <'> reverb-control-scale-bounds <'> cursor-update-interval 6761 <'> cursor-location-offset <'> contrast-control? 6762 <'> auto-update-interval <'> cursor <'> channel-properties 6763 <'> channel-property <'> with-tracking-cursor <'> cursor-size 6764 <'> cursor-style <'> tracking-cursor-style <'> dac-combines-channels 6765 <'> dac-size <'> clipping <'> default-output-chans 6766 <'> default-output-sample-type <'> default-output-srate 6767 <'> default-output-header-type <'> dot-size <'> enved-envelope 6768 <'> enved-base <'> enved-clip? <'> enved-in-dB <'> enved-style 6769 <'> enved-power <'> enved-target <'> enved-wave? <'> eps-file 6770 <'> eps-left-margin <'> eps-bottom-margin <'> eps-size <'> expand-control 6771 <'> expand-control-hop <'> expand-control-jitter <'> expand-control-length 6772 <'> expand-control-ramp <'> expand-control? <'> fft-window-alpha 6773 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 6774 <'> transform-size <'> transform-graph-type <'> fft-window 6775 <'> transform-graph? <'> filter-control-in-dB <'> filter-control-envelope 6776 <'> enved-filter-order <'> enved-filter <'> filter-control-in-hz 6777 <'> filter-control-order <'> filter-control? <'> graph-cursor 6778 <'> graph-style <'> lisp-graph? <'> graphs-horizontal <'> just-sounds 6779 <'> left-sample <'> listener-prompt <'> mark-name <'> mark-properties 6780 <'> mark-property <'> mark-sample <'> mark-sync <'> max-transform-peaks 6781 <'> min-dB <'> log-freq-start <'> mix-amp <'> mix-amp-env <'> mix-name 6782 <'> mix-position <'> mix-properties <'> mix-property <'> mix-speed 6783 <'> mix-tag-height <'> mix-tag-width <'> mix-tag-y <'> mark-tag-width 6784 <'> mark-tag-height <'> mix-waveform-height <'> transform-normalization 6785 <'> print-length <'> play-arrow-size 6786 <'> region-graph-style <'> reverb-control-decay <'> reverb-control-feedback 6787 <'> reverb-control-length <'> reverb-control-lowpass 6788 <'> reverb-control-scale <'> time-graph-style <'> lisp-graph-style 6789 <'> transform-graph-style <'> reverb-control? <'> ladspa-dir 6790 <'> peak-env-dir <'> save-dir <'> save-state-file 6791 <'> selection-creates-region <'> show-axes <'> show-controls 6792 <'> show-transform-peaks <'> show-indices <'> show-marks 6793 <'> show-mix-waveforms <'> show-selection-transform <'> show-y-zero 6794 <'> show-grid <'> show-sonogram-cursor <'> sinc-width <'> spectrum-end 6795 <'> spectro-hop <'> spectrum-start <'> spectro-x-angle <'> grid-density 6796 <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale 6797 <'> spectro-z-angle <'> spectro-z-scale <'> speed-control 6798 <'> speed-control-style <'> speed-control-tones <'> squelch-update 6799 <'> sync <'> sound-properties <'> sound-property <'> temp-dir 6800 <'> y-bounds <'> transform-type <'> with-file-monitor 6801 <'> with-verbose-cursor <'> with-inset-graph <'> with-interrupts 6802 <'> with-pointer-focus <'> wavelet-type <'> x-bounds <'> with-smpte-label 6803 <'> with-toolbar <'> with-tooltips <'> with-menu-icons 6804 <'> save-as-dialog-src <'> save-as-dialog-auto-comment <'> time-graph? 6805 <'> wavo-hop <'> wavo-trace <'> with-gl <'> with-mix-tags 6806 <'> x-axis-style <'> beats-per-minute <'> zero-pad <'> zoom-focus-style 6807 <'> sync-style <'> with-relative-panes <'> window-x <'> window-y 6808 <'> window-width <'> window-height <'> beats-per-measure <'> channels 6809 <'> chans <'> comment <'> sample-type <'> data-location <'> data-size 6810 <'> edit-position <'> framples <'> header-type <'> maxamp <'> read-only 6811 <'> right-sample <'> sample <'> samples <'> selected-channel 6812 <'> selected-sound <'> selection-position <'> selection-framples 6813 <'> selection-member? <'> sound-loop-info <'> srate <'> time-graph-type 6814 <'> x-position-slider <'> x-zoom-slider <'> y-position-slider 6815 <'> y-zoom-slider <'> mus-array-print-length 6816 <'> mus-float-equal-fudge-factor <'> mus-data <'> mus-feedback 6817 <'> mus-feedforward <'> mus-frequency <'> mus-hop <'> mus-increment 6818 <'> mus-length <'> mus-location <'> mus-phase <'> mus-ramp 6819 <'> mus-scaler <'> vct-ref <'> x-axis-label <'> filter-control-coeffs 6820 <'> locsig-type <'> mus-file-buffer-size <'> mus-rand-seed 6821 <'> mus-width <'> clm-table-size <'> mus-offset <'> mus-reset 6822 <'> phase-vocoder-amp-increments <'> phase-vocoder-amps 6823 <'> phase-vocoder-freqs <'> phase-vocoder-phase-increments 6824 <'> phase-vocoder-phases <'> html-dir <'> html-program 6825 <'> mus-interp-type <'> locsig-ref 6826 <'> locsig-reverb-ref <'> mus-clipping <'> mus-file-clipping 6827 <'> mus-header-raw-defaults ) constant set-procs 6828 6829: arity-not-ok <{ prc args -- f }> prc args arity-ok not ; 6830: set-arity-not-ok <{ prc args -- f }> prc args set-arity-ok not ; 6831 6832procs <'> arity-not-ok 0 array-reject constant procs00 6833procs <'> arity-not-ok 1 array-reject constant procs01 6834procs <'> arity-not-ok 2 array-reject constant procs02 6835procs <'> arity-not-ok 3 array-reject constant procs03 6836procs <'> arity-not-ok 4 array-reject constant procs04 6837procs <'> arity-not-ok 5 array-reject constant procs05 6838procs <'> arity-not-ok 6 array-reject constant procs06 6839procs <'> arity-not-ok 7 array-reject constant procs07 6840procs <'> arity-not-ok 8 array-reject constant procs08 6841procs <'> arity-not-ok 10 array-reject constant procs10 6842set-procs <'> set-arity-not-ok 1 array-reject constant set-procs00 6843set-procs <'> set-arity-not-ok 2 array-reject constant set-procs01 6844set-procs <'> set-arity-not-ok 3 array-reject constant set-procs02 6845set-procs <'> set-arity-not-ok 4 array-reject constant set-procs03 6846set-procs <'> set-arity-not-ok 5 array-reject constant set-procs04 6847 6848: close-sound-mc-cb { -- prc; y self -- val } 6849 1 proc-create "oboe.snd" open-sound , ( prc ) 6850 does> { y self -- val } 6851 self @ { ind } 6852 ind sound? if 6853 ind close-sound drop 6854 then 6855 0.0 6856; 6857 6858: close-sound-aoe-1-cb { -- prc; self -- val } 6859 0 proc-create "oboe.snd" open-sound , "pistol.snd" open-sound , 6860 does> { self -- val } 6861 self @ ( ind1 ) close-sound drop 6862 self cell+ @ ( ind2 ) close-sound 6863; 6864 6865: close-sound-aoe-2b-cb { ind1 ind2 -- prc; self -- val } 6866 0 proc-create ind1 , ind2 , ( prc ) 6867 does> { self -- val } 6868 self @ ( ind1 ) close-sound drop 6869 self cell+ @ ( ind2 ) close-sound 6870; 6871 6872: close-sound-aoe-2a-cb { -- prc; self -- val } 6873 0 proc-create "oboe.snd" open-sound , "pistol.snd" open-sound , 6874 does> { self -- val } 6875 self @ { ind1 } 6876 self cell+ @ { ind2 } 6877 100 0.1 ind1 0 set-sample drop 6878 100 0.1 ind2 0 set-sample drop 6879 ind1 ind2 close-sound-aoe-2b-cb "inner-edit" as-one-edit 6880; 6881 6882: close-sound-fc-cb { -- prc; y self -- f } 6883 1 proc-create "oboe.snd" open-sound , ( prc ) 6884 does> { y self -- f } 6885 self @ { ind } 6886 ind sound? if 6887 ind close-sound drop 6888 then 6889 #f 6890; 6891 6892: sc-1-cb { mx -- prc; x self -- f } 6893 1 proc-create mx , ( prc ) 6894 does> { x self -- f } 6895 x fabs self @ @ ( mx ) fmax self @ ! 6896 #f 6897; 6898 6899: mc-2-cb { ind -- prc; y self -- val } 6900 1 proc-create ind , ( prc ) 6901 does> { y self -- val } 6902 y 0.4 f> if 6903 1 self @ ( ind ) 0 set-framples drop 6904 then 6905 y 6906; 6907 6908*with-test-complex* [if] 6909 : mc-3-cb <{ y -- val }> y 0.0+1.0i c* ; 6910[else] 6911 <'> noop alias mc-3-cb 6912[then] 6913 6914: edpos-1-cb { ind -- prc; self -- edpos } 6915 0 proc-create ind , ( prc ) 6916 does> { self -- edpos } 6917 self @ ( ind ) close-sound drop 6918 current-edit-position 6919; 6920 6921: edpos-2-cb <{ snd chn -- edpos }> 6922 snd close-sound drop 6923 current-edit-position 6924; 6925 6926: check-args-progress-info { msg -- } 6927 *snd-test-verbose* if 6928 msg #f snd-test-message 6929 then 6930; 6931 6932: 28-errors ( -- ) 6933 #t set-with-background-processes drop 6934 reset-almost-all-hooks 6935 nil nil { prc tag } 6936 #( <'> amp-control <'> comment 6937 <'> contrast-control <'> amp-control-bounds <'> speed-control-bounds 6938 <'> expand-control-bounds <'> contrast-control-bounds 6939 <'> reverb-control-length-bounds <'> reverb-control-scale-bounds 6940 <'> contrast-control-amp <'> contrast-control? <'> sample-type 6941 <'> data-location <'> data-size <'> expand-control 6942 <'> expand-control-hop <'> expand-control-jitter 6943 <'> expand-control-length <'> expand-control-ramp 6944 <'> expand-control? <'> filter-control-in-dB 6945 <'> filter-control-in-hz <'> filter-control-envelope 6946 <'> filter-control-order <'> filter-control? 6947 <'> finish-progress-report <'> header-type <'> read-only 6948 <'> reset-controls <'> restore-controls <'> reverb-control-decay 6949 <'> reverb-control-feedback <'> reverb-control-length 6950 <'> reverb-control-lowpass <'> reverb-control-scale <'> reverb-control? 6951 <'> save-controls <'> select-sound <'> short-file-name 6952 <'> sound-loop-info <'> soundfont-info 6953 <'> speed-control <'> speed-control-style 6954 <'> speed-control-tones <'> srate <'> channel-style 6955 <'> start-progress-report <'> sync <'> swap-channels ) { prcs-1 } 6956 prcs-1 #( 6957 <'> apply-controls <'> close-sound <'> channels <'> chans 6958 <'> file-name <'> framples <'> progress-report 6959 <'> sound-property <'> sound-properties ) array-append each to prc 6960 123 integer->sound prc snd-test-catch to tag 6961 tag if 6962 tag car 'wrong-type-arg <> 6963 tag car 'no-such-sound <> && if 6964 "snd no-such-sound %s: %s" #( prc tag ) snd-display 6965 then 6966 then 6967 end-each 6968 #( 1 make-array "hiho" 0+i 1.5 '( 1 0 ) #( 0 1 ) ) { args-1 } 6969 #( vct-5 1+i "hiho" delay-32 ) { args-2 } 6970 nil { arg } 6971 args-1 each to arg 6972 prcs-1 #( <'> apply-controls 6973 <'> close-sound <'> sound-properties ) array-append each to prc 6974 arg prc snd-test-catch to tag 6975 tag if 6976 tag car 'wrong-type-arg <> 6977 tag car 'mus-error <> && if 6978 "snd wrong-type-arg %s: %s (%s)" #( prc tag arg ) snd-display 6979 then 6980 then 6981 end-each 6982 end-each 6983 args-2 each to arg 6984 prcs-1 #( <'> channels <'> chans <'> framples ) array-append each to prc 6985 \ XXX: snd/chn val | val snd/chn 6986 \ snd/chn before value 6987 \ g_set_channels(snd, val) arg 0 6988 \ snd/chn after value 6989 \ g_set_amp_control(val, snd, chn) 0 arg 6990 prc <'> channels = 6991 prc <'> chans = || 6992 prc <'> sample-type = || 6993 prc <'> data-location = || 6994 prc <'> data-size = || 6995 prc <'> header-type = || 6996 prc <'> srate = || 6997 prc <'> comment = || if 6998 arg 0 6999 else 7000 0 arg 7001 then prc set-xt snd-test-catch to tag 7002 tag if 7003 tag car 'wrong-type-arg <> 7004 tag car 'syntax-error <> && 7005 tag car 'error <> && if 7006 "snd set wrong-type-arg set-%s [%s]: %s" #( prc arg tag ) snd-display 7007 then 7008 then 7009 end-each 7010 end-each 7011 "obtest.snd" open-sound { ind } 7012 #( <'> amp-control <'> contrast-control <'> contrast-control-amp 7013 <'> contrast-control? <'> expand-control <'> amp-control-bounds 7014 <'> speed-control-bounds <'> expand-control-bounds 7015 <'> contrast-control-bounds <'> reverb-control-length-bounds 7016 <'> reverb-control-scale-bounds <'> expand-control-hop 7017 <'> expand-control-jitter <'> expand-control-length 7018 <'> expand-control-ramp <'> expand-control? <'> filter-control-in-dB 7019 <'> filter-control-in-hz <'> filter-control-envelope 7020 <'> filter-control-order <'> filter-control? <'> reverb-control-decay 7021 <'> reverb-control-feedback <'> reverb-control-length 7022 <'> reverb-control-lowpass <'> reverb-control-scale <'> reverb-control? 7023 <'> speed-control <'> speed-control-style <'> speed-control-tones 7024 <'> channel-style <'> sync ) { prcs-2 } 7025 args-2 each to arg 7026 prcs-2 each to prc 7027 arg ind prc set-xt snd-test-catch to tag 7028 tag if 7029 tag car 'wrong-type-arg <> if 7030 "snd safe set wrong-type-arg set-%s [%s]: %s" 7031 #( prc arg tag ) snd-display 7032 then 7033 then 7034 end-each 7035 end-each 7036 ind close-sound drop 7037 args-1 each to arg 7038 #( <'> make-vct <'> vct-length <'> vct->list <'> vct-peak ) each to prc 7039 arg prc snd-test-catch to tag 7040 tag if 7041 tag car 'wrong-type-arg <> if 7042 "vct 0 wrong-type-arg %s [%s]: %s" #( prc arg tag ) snd-display 7043 then 7044 then 7045 end-each 7046 end-each 7047 #( <'> vct-add! <'> vct-subtract! <'> vct-multiply! 7048 <'> vct-ref <'> vct-scale! ) { vct-prcs-2 } 7049 nil nil { arg1 arg2 } 7050 args-1 each to arg1 7051 args-1 each to arg2 7052 vct-prcs-2 each to prc 7053 arg1 arg2 prc snd-test-catch to tag 7054 tag if 7055 tag car 'wrong-type-arg <> 7056 tag car 'wrong-number-of-args <> && 7057 tag car 'mus-error <> && if 7058 "vct 1 wrong-whatever %s [%s %s]: %s" 7059 #( prc arg1 arg2 tag ) snd-display 7060 then 7061 then 7062 end-each 7063 end-each 7064 end-each 7065 args-1 each to arg 7066 vct-prcs-2 each to prc 7067 arg vct-3 prc snd-test-catch to tag 7068 tag if 7069 tag car 'wrong-type-arg <> if 7070 "vct 2 wrong-whatever %s [%s]: %s" #( prc arg tag ) snd-display 7071 then 7072 then 7073 end-each 7074 end-each 7075 -23 <'> make-vct snd-test-catch to tag 7076 tag car 'out-of-range <> if 7077 "make-vct -23: %s" #( tag ) snd-display 7078 then 7079 vct-3 { v } 7080 v 12 <'> vct-ref snd-test-catch to tag 7081 tag car 'out-of-range <> if 7082 "vct[12]: %s" #( tag ) snd-display 7083 then 7084 #( <'> all-pass? <'> asymmetric-fm? <'> comb? <'> filtered-comb? 7085 <'> convolve? <'> delay? <'> env? <'> file->frample? <'> file->sample? 7086 <'> snd->sample? <'> filter? <'> fir-filter? <'> formant? <'> firmant? 7087 <'> frample->file? <'> granulate? <'> iir-filter? 7088 <'> locsig? <'> move-sound? <'> mus-input? <'> mus-output? 7089 <'> notch? <'> one-pole? <'> one-zero? <'> oscil? <'> phase-vocoder? 7090 <'> pulse-train? <'> rand-interp? <'> rand? <'> readin? 7091 <'> sample->file? <'> sawtooth-wave? <'> nrxysin? <'> nrxycos? 7092 <'> square-wave? <'> src? <'> ncos? <'> nsin? <'> table-lookup? 7093 <'> triangle-wave? <'> two-pole? <'> two-zero? <'> wave-train? 7094 <'> color? <'> mix-sampler? <'> moving-average? <'> ssb-am? 7095 <'> sampler? <'> region-sampler? <'> vct? ) { ?prcs } 7096 args-1 each to arg 7097 ?prcs each to prc 7098 arg prc snd-test-catch to tag 7099 tag if 7100 tag car 'wrong-type-arg <> if 7101 "?proc %s [%s]: %s" #( prc arg tag ) snd-display 7102 then 7103 then 7104 end-each 7105 end-each 7106 ?prcs each to prc 7107 440 make-oscil prc snd-test-catch to tag 7108 tag if 7109 "oscil?proc %s [440 make-oscil]: %s" #( prc tag ) snd-display 7110 then 7111 end-each 7112 #( <'> reverse-selection <'> selection-position <'> selection-framples 7113 <'> smooth-selection <'> scale-selection-to <'> insert-selection 7114 <'> delete-selection <'> delete-selection-and-smooth 7115 <'> mix-selection ) each to prc 7116 prc snd-test-catch to tag 7117 tag if 7118 tag car 'no-active-selection <> if 7119 "0 selection %s: %s" #( prc tag ) snd-display 7120 then 7121 then 7122 end-each 7123 #( <'> src-selection <'> filter-selection <'> env-selection ) each to prc 7124 0.0 prc snd-test-catch to tag 7125 tag if 7126 tag car 'no-active-selection <> if 7127 "1 selection %s: %s" #( prc tag ) snd-display 7128 then 7129 then 7130 end-each 7131 #( <'> all-pass <'> asymmetric-fm <'> comb 7132 <'> filtered-comb <'> convolve <'> db->linear <'> moving-average 7133 <'> degrees->radians <'> delay <'> env <'> formant <'> firmant 7134 <'> granulate <'> hz->radians <'> linear->db 7135 <'> make-all-pass <'> make-asymmetric-fm <'> make-comb 7136 <'> make-filtered-comb <'> make-convolve <'> make-delay 7137 <'> make-env <'> make-file->frample <'> make-file->sample 7138 <'> make-filter <'> make-fir-filter <'> make-formant 7139 <'> make-firmant <'> make-granulate 7140 <'> make-iir-filter <'> make-locsig <'> make-notch 7141 <'> make-one-pole <'> make-one-zero <'> make-oscil 7142 <'> make-pulse-train <'> make-rand <'> make-rand-interp 7143 <'> make-readin <'> make-sawtooth-wave <'> make-nrxysin 7144 <'> make-nrxycos <'> make-square-wave <'> make-src <'> make-ncos 7145 <'> make-nsin <'> make-table-lookup <'> make-triangle-wave 7146 <'> make-two-pole <'> make-two-zero <'> make-wave-train 7147 <'> make-ssb-am <'> mus-channel <'> mus-channels <'> make-polyshape 7148 <'> make-polywave <'> mus-data <'> mus-feedback <'> mus-feedforward 7149 <'> mus-frequency <'> mus-hop <'> mus-increment <'> mus-length 7150 <'> mus-file-name <'> mus-location <'> mus-name <'> mus-order 7151 <'> mus-phase <'> mus-ramp <'> mus-random <'> mus-run <'> mus-scaler 7152 <'> mus-xcoeffs <'> mus-ycoeffs <'> notch <'> one-pole <'> one-zero 7153 <'> make-moving-average <'> seconds->samples <'> samples->seconds 7154 <'> oscil <'> partials->polynomial <'> partials->wave 7155 <'> phase-partials->wave <'> phase-vocoder <'> pulse-train 7156 <'> radians->degrees <'> radians->hz <'> rand <'> rand-interp 7157 <'> readin <'> sawtooth-wave <'> nrxysin <'> nrxycos <'> square-wave 7158 <'> src <'> ncos <'> nsin <'> table-lookup <'> tap <'> triangle-wave 7159 <'> two-pole <'> two-zero <'> wave-train <'> ssb-am ) { clm-prcs-1 } 7160 #( 1 make-array color-95 '( 1.0 ) ) each to arg 7161 clm-prcs-1 each to prc 7162 arg prc snd-test-catch to tag 7163 tag if 7164 tag car 'wrong-type-arg <> 7165 tag car 'no-data <> && 7166 tag car 'no-such-method <> && 7167 tag car 'bad-type <> && 7168 tag car 'error <> && 7169 tag car 'arg-error <> && if 7170 "clm %s [%s]: %s" #( prc arg tag ) snd-display 7171 then 7172 then 7173 end-each 7174 end-each 7175 #( <'> all-pass <'> array-interp <'> asymmetric-fm <'> comb 7176 <'> filtered-comb <'> contrast-enhancement <'> convolution 7177 <'> convolve <'> moving-average <'> convolve-files 7178 <'> delay <'> dot-product <'> env-interp <'> file->sample 7179 <'> snd->sample <'> filter <'> fir-filter <'> formant <'> firmant 7180 <'> formant-bank <'> granulate <'> iir-filter <'> ina <'> inb 7181 <'> locsig-ref <'> locsig-reverb-ref <'> make-all-pass 7182 <'> make-asymmetric-fm <'> make-comb <'> make-filtered-comb 7183 <'> make-delay <'> make-env <'> make-fft-window <'> make-filter 7184 <'> make-fir-filter <'> make-formant <'> make-firmant 7185 <'> make-granulate <'> make-iir-filter <'> make-locsig <'> make-notch 7186 <'> make-one-pole <'> make-one-zero <'> make-oscil <'> make-phase-vocoder 7187 <'> make-pulse-train <'> make-rand <'> make-rand-interp 7188 <'> make-readin <'> make-sawtooth-wave <'> make-moving-average 7189 <'> make-nrxysin <'> make-nrxycos <'> make-square-wave <'> make-src 7190 <'> make-ncos <'> make-nsin <'> make-table-lookup <'> make-triangle-wave 7191 <'> make-two-pole <'> make-two-zero <'> make-wave-train 7192 <'> notch <'> one-pole <'> one-zero 7193 <'> oscil <'> partials->polynomial <'> partials->wave 7194 <'> make-polyshape <'> make-polywave <'> phase-partials->wave 7195 <'> phase-vocoder <'> polynomial <'> pulse-train <'> rand <'> rand-interp 7196 <'> rectangular->polar <'> rectangular->magnitudes <'> ring-modulate 7197 <'> sawtooth-wave <'> nrxysin <'> nrxycos 7198 <'> square-wave <'> src <'> ncos <'> nsin <'> table-lookup <'> tap 7199 <'> triangle-wave <'> two-pole <'> two-zero <'> wave-train <'> ssb-am 7200 <'> make-ssb-am ) each to prc 7201 make-oscil vct-5 prc snd-test-catch to tag 7202 tag if 7203 tag car 'wrong-type-arg <> 7204 tag car 'bad-arity <> && 7205 tag car 'error <> && 7206 tag car 'mus-error <> && if 7207 "clm-1 %s [make-oscil]: %s" #( prc tag ) snd-display 7208 then 7209 then 7210 end-each 7211 #( <'> mus-channel <'> mus-channels <'> mus-data <'> mus-feedback 7212 <'> mus-feedforward <'> mus-frequency <'> mus-hop <'> mus-increment 7213 <'> mus-length <'> mus-location <'> mus-name <'> mus-order 7214 <'> mus-phase <'> mus-ramp <'> mus-random <'> mus-run <'> mus-scaler 7215 <'> mus-xcoeffs <'> mus-ycoeffs ) each to prc 7216 make-oscil vector-0 prc snd-test-catch to tag 7217 tag if 7218 tag car 'wrong-type-arg <> 7219 tag car 'syntax-error <> && 7220 tag car 'error <> && if 7221 "mus-gen %s [make-oscil]: %s" #( prc tag ) snd-display 7222 then 7223 then 7224 end-each 7225 #( <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration 7226 <'> mus-sound-datum-size <'> mus-sound-data-location <'> mus-sound-chans 7227 <'> mus-sound-srate <'> mus-sound-header-type <'> mus-sound-sample-type 7228 <'> mus-sound-length <'> mus-sound-type-specifier 7229 <'> mus-header-type-name <'> mus-sample-type-name <'> mus-sound-comment 7230 <'> mus-sound-write-date <'> mus-bytes-per-sample 7231 <'> mus-sound-loop-info <'> mus-sound-mark-info 7232 <'> mus-sound-maxamp <'> mus-sound-maxamp-exists? 7233 <'> mus-header-type->string 7234 <'> mus-sample-type->string ) { mus-snd-prcs-1 } 7235 mus-snd-prcs-1 each to prc 7236 vct-5 prc snd-test-catch to tag 7237 tag if 7238 tag car 'wrong-type-arg <> if 7239 "mus-sound %s: %s" #( prc tag ) snd-display 7240 then 7241 then 7242 end-each 7243 mus-snd-prcs-1 each to prc 7244 prc snd-test-catch to tag 7245 tag if 7246 tag car 'wrong-number-of-args <> 7247 tag car 'error <> && if 7248 "no arg mus-sound %s: %s" #( prc tag ) snd-display 7249 then 7250 then 7251 end-each 7252 #( <'> mus-sound-samples <'> mus-sound-framples <'> mus-sound-duration 7253 <'> mus-sound-datum-size <'> mus-sound-data-location 7254 <'> mus-sound-chans <'> mus-sound-srate <'> mus-sound-header-type 7255 <'> mus-sound-sample-type <'> mus-sound-length 7256 <'> mus-sound-type-specifier <'> mus-sound-comment 7257 <'> mus-sound-write-date <'> mus-sound-maxamp 7258 <'> mus-sound-maxamp-exists? ) each to prc 7259 "/bad/baddy" prc snd-test-catch to tag 7260 tag if 7261 tag car 'mus-error <> if 7262 "bad file mus-sound %s: %s" #( prc tag ) snd-display 7263 then 7264 then 7265 end-each 7266 "/bad/baddy" mus-sound-forget drop 7267 #( <'> channel-widgets <'> cursor <'> channel-properties 7268 <'> channel-property <'> cursor-position 7269 <'> cursor-size <'> cursor-style <'> tracking-cursor-style 7270 <'> delete-sample <'> display-edits <'> dot-size <'> edit-fragment 7271 <'> edit-position <'> edit-tree <'> edits <'> fft-window-alpha 7272 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 7273 <'> fft-with-phases <'> transform-size <'> transform-graph-type 7274 <'> fft-window <'> transform-graph? <'> graph 7275 <'> graph-style <'> lisp-graph? <'> insert-sound <'> time-graph-style 7276 <'> lisp-graph-style <'> transform-graph-style 7277 <'> left-sample <'> make-graph-data <'> map-chan <'> max-transform-peaks 7278 <'> maxamp-position <'> min-dB <'> mix-region 7279 <'> transform-normalization <'> peaks <'> position->x <'> position->y 7280 <'> reverse-sound <'> revert-sound <'> right-sample <'> sample 7281 <'> save-sound <'> save-sound-as <'> select-channel 7282 <'> show-axes <'> show-transform-peaks <'> show-marks 7283 <'> show-mix-waveforms <'> show-y-zero <'> show-grid 7284 <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop 7285 <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale 7286 <'> spectro-y-angle <'> grid-density <'> spectro-y-scale 7287 <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update 7288 <'> transform-sample <'> transform->vct <'> transform-framples 7289 <'> transform-type <'> update-transform-graph <'> update-time-graph 7290 <'> update-lisp-graph <'> update-sound <'> wavelet-type <'> time-graph? 7291 <'> time-graph-type <'> wavo-hop <'> wavo-trace <'> x-bounds 7292 <'> x-position-slider <'> x-zoom-slider <'> x-axis-label <'> y-axis-label 7293 <'> y-bounds <'> y-position-slider <'> y-zoom-slider 7294 <'> zero-pad ) { chn-prcs } 7295 chn-prcs each to prc 7296 vct-5 prc snd-test-catch to tag 7297 tag if 7298 tag car 'wrong-type-arg <> 7299 tag car 'error <> && 7300 tag car 'no-such-sound <> && if 7301 "chn (no snd) procs %s: %s" #( prc tag ) snd-display 7302 then 7303 then 7304 end-each 7305 chn-prcs <'> combined-data-color array-push each to prc 7306 0 vct-5 prc snd-test-catch to tag 7307 tag if 7308 tag car 'wrong-type-arg <> if 7309 "chn (no chn) procs %s: %s" #( prc tag ) snd-display 7310 then 7311 then 7312 end-each 7313 #( <'> channel-widgets <'> cursor <'> channel-properties 7314 <'> cursor-position <'> cursor-size <'> cursor-style 7315 <'> tracking-cursor-style <'> display-edits <'> dot-size <'> edit-position 7316 <'> edit-tree <'> edits <'> env-sound <'> fft-window-alpha 7317 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 7318 <'> fft-with-phases <'> transform-size <'> transform-graph-type 7319 <'> fft-window <'> transform-graph? <'> filter-sound <'> graph-data 7320 <'> graph-style <'> lisp-graph? <'> left-sample <'> time-graph-style 7321 <'> lisp-graph-style <'> transform-graph-style <'> make-graph-data 7322 <'> max-transform-peaks <'> maxamp <'> maxamp-position <'> min-dB 7323 <'> transform-normalization <'> reverse-sound <'> revert-sound 7324 <'> right-sample <'> save-sound <'> scale-by <'> scale-to 7325 <'> show-axes <'> show-transform-peaks <'> show-marks 7326 <'> show-mix-waveforms <'> show-y-zero <'> show-grid 7327 <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop 7328 <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale 7329 <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle 7330 <'> spectro-z-scale <'> squelch-update <'> grid-density <'> src-sound 7331 <'> transform->vct <'> transform-framples <'> transform-type 7332 <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph 7333 <'> update-sound <'> wavelet-type <'> time-graph? <'> time-graph-type 7334 <'> wavo-hop <'> wavo-trace <'> x-bounds <'> x-position-slider 7335 <'> x-zoom-slider <'> y-bounds <'> y-position-slider <'> x-axis-label 7336 <'> y-axis-label <'> y-zoom-slider <'> zero-pad ) each to prc 7337 1234 integer->sound prc snd-test-catch to tag 7338 tag if 7339 tag car 'no-such-sound <> if 7340 "chn procs %s: %s" #( prc tag ) snd-display 7341 then 7342 then 7343 end-each 7344 #( <'> delete-sample <'> edit-fragment <'> graph-data <'> graph-style 7345 <'> play <'> position->x <'> position->y <'> redo 7346 <'> time-graph-style <'> lisp-graph-style <'> transform-graph-style 7347 <'> scale-by <'> scale-to <'> undo <'> x->position <'> y->position 7348 <'> x-axis-label ) each to prc 7349 0 1234 prc snd-test-catch to tag 7350 tag if 7351 tag car 'no-such-sound <> if 7352 "snd(1) chn procs %s: %s" #( prc tag ) snd-display 7353 then 7354 then 7355 end-each 7356 "oboe.snd" open-sound to ind 7357 #( <'> delete-sample <'> edit-fragment <'> graph-data <'> position->x 7358 <'> position->y <'> redo <'> scale-by <'> scale-to <'> undo 7359 <'> x->position <'> y->position ) each to prc 7360 prc proc-name "x-axis-label" string<> if 7361 0 ind 1234 prc snd-test-catch to tag 7362 tag if 7363 tag car 'no-such-channel <> if 7364 "snd(1 1234) chn procs %s: %s" #( prc tag ) snd-display 7365 then 7366 then 7367 then 7368 end-each 7369 ind close-sound drop 7370 "oboe.snd" find-sound sound? if 7371 "oboe.snd is still open?" #() snd-display 7372 then 7373 "oboe.snd" open-sound to ind 7374 #( <'> channel-widgets <'> cursor <'> cursor-position <'> cursor-size 7375 <'> cursor-style <'> tracking-cursor-style <'> display-edits <'> dot-size 7376 <'> edit-position <'> edit-tree <'> edits <'> fft-window-alpha 7377 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 7378 <'> fft-with-phases <'> transform-size <'> transform-graph-type 7379 <'> fft-window <'> transform-graph? <'> graph-style <'> lisp-graph? 7380 <'> left-sample <'> time-graph-style <'> lisp-graph-style 7381 <'> transform-graph-style <'> combined-data-color <'> make-graph-data 7382 <'> max-transform-peaks <'> maxamp <'> maxamp-position <'> min-dB 7383 <'> transform-normalization <'> reverse-sound <'> right-sample 7384 <'> show-axes <'> show-transform-peaks <'> show-marks 7385 <'> show-mix-waveforms <'> show-y-zero <'> show-grid 7386 <'> show-sonogram-cursor <'> grid-density <'> spectrum-end 7387 <'> spectro-hop <'> spectrum-start <'> spectro-x-angle 7388 <'> spectro-x-scale <'> spectro-y-angle <'> spectro-y-scale 7389 <'> spectro-z-angle <'> spectro-z-scale <'> squelch-update 7390 <'> transform->vct <'> transform-framples <'> transform-type 7391 <'> update-transform-graph <'> update-time-graph <'> update-lisp-graph 7392 <'> wavelet-type <'> time-graph? <'> time-graph-type <'> wavo-hop 7393 <'> wavo-trace <'> x-bounds <'> x-position-slider <'> x-axis-label 7394 <'> x-zoom-slider <'> y-bounds <'> y-position-slider <'> y-zoom-slider 7395 <'> zero-pad <'> channel-properties <'> channel-property ) each to prc 7396 ind 1234 prc snd-test-catch to tag 7397 tag if 7398 tag car 'no-such-channel <> 7399 tag car 'no-such-sound <> && if 7400 "chn (2) procs %s: %s" #( prc tag ) snd-display 7401 then 7402 then 7403 end-each 7404 ind close-sound drop 7405 "oboe.snd" find-sound sound? if 7406 "oboe.snd is still open?" #() snd-display 7407 then 7408 "oboe.snd" open-sound to ind 7409 #( <'> channel-widgets <'> cursor <'> cursor-position <'> display-edits 7410 <'> dot-size <'> edit-tree <'> edits <'> fft-window-alpha 7411 <'> fft-window-beta <'> fft-log-frequency <'> fft-log-magnitude 7412 <'> fft-with-phases <'> transform-size <'> transform-graph-type 7413 <'> fft-window <'> transform-graph? <'> graph-style <'> lisp-graph? 7414 <'> left-sample <'> make-graph-data <'> max-transform-peaks <'> maxamp 7415 <'> maxamp-position <'> lisp-graph-style <'> transform-graph-style 7416 <'> make-graph-data <'> combined-data-color <'> min-dB 7417 <'> transform-normalization <'> reverse-sound <'> right-sample 7418 <'> show-axes <'> grid-density <'> show-transform-peaks <'> show-marks 7419 <'> show-mix-waveforms <'> show-y-zero <'> show-grid 7420 <'> show-sonogram-cursor <'> spectrum-end <'> spectro-hop 7421 <'> spectrum-start <'> spectro-x-angle <'> spectro-x-scale 7422 <'> spectro-y-angle <'> spectro-y-scale <'> spectro-z-angle 7423 <'> spectro-z-scale <'> squelch-update <'> transform->vct 7424 <'> transform-framples <'> transform-type <'> update-transform-graph 7425 <'> update-time-graph <'> update-lisp-graph <'> wavelet-type 7426 <'> time-graph? <'> time-graph-type <'> wavo-hop <'> wavo-trace 7427 <'> x-bounds <'> x-position-slider <'> x-zoom-slider <'> y-bounds 7428 <'> y-position-slider <'> y-zoom-slider <'> zero-pad 7429 <'> x-axis-label ) each to prc 7430 vct-5 ind 0 prc set-xt snd-test-catch to tag 7431 tag if 7432 tag car 'wrong-type-arg <> 7433 tag car 'syntax-error <> && 7434 tag car 'error <> && if 7435 "set chn procs %s: %s" #( prc tag ) snd-display 7436 then 7437 then 7438 end-each 7439 ind close-sound drop 7440 "oboe.snd" find-sound sound? if 7441 "oboe.snd is still open?" #() snd-display 7442 then 7443 #( <'> mix-amp <'> mix-length <'> mix-name 7444 <'> mix-position <'> mix-home <'> mix-speed <'> mix-tag-y ) { mix-prcs } 7445 mix-prcs #( <'> mix-amp-env ) array-append each to prc 7446 vct-5 prc snd-test-catch to tag 7447 tag if 7448 tag car 'wrong-type-arg <> 7449 tag car 'syntax-error <> && 7450 tag car 'error <> && if 7451 "[0] mix procs %s: %s" #( prc tag ) snd-display 7452 then 7453 then 7454 end-each 7455 #( <'> mix-name <'> mix-position <'> mix-home <'> mix-speed 7456 <'> mix-tag-y ) { mix-set-prcs } 7457 mix-set-prcs each to prc 7458 1234 integer->mix vct-5 prc set-xt snd-test-catch to tag 7459 tag if 7460 tag car 'wrong-type-arg <> 7461 tag car 'syntax-error <> && 7462 tag car 'error <> && 7463 tag car 'no-such-mix <> && if 7464 "[2] set mix procs %s: %s" #( prc tag ) snd-display 7465 then 7466 then 7467 end-each 7468 "oboe.snd" open-sound to ind 7469 "oboe.snd" 10 mix-sound { id } 7470 mix-set-prcs each to prc 7471 id vct-5 prc set-xt snd-test-catch to tag 7472 tag if 7473 tag car 'wrong-type-arg <> 7474 tag car 'syntax-error <> && 7475 tag car 'error <> && if 7476 "[3] set mix procs %s: %s" #( prc tag ) snd-display 7477 then 7478 then 7479 end-each 7480 ind close-sound drop 7481 "oboe.snd" find-sound sound? if 7482 "oboe.snd is still open?" #() snd-display 7483 then 7484 #( <'> add-mark <'> mark-name <'> mark-sample <'> mark-sync 7485 <'> mark-home <'> delete-mark <'> delete-marks <'> find-mark ) each to prc 7486 vct-5 prc snd-test-catch to tag 7487 tag if 7488 tag car 'wrong-type-arg <> if 7489 "mark procs %s: %s" #( prc tag ) snd-display 7490 then 7491 then 7492 end-each 7493 "oboe.snd" open-sound to ind 7494 0 ind 0 add-mark to id 7495 #( <'> mark-name <'> mark-sample <'> mark-sync ) each to prc 7496 id vct-5 prc set-xt snd-test-catch to tag 7497 tag if 7498 tag car 'wrong-type-arg <> if 7499 "set mark procs %s: %s" #( prc tag ) snd-display 7500 then 7501 then 7502 end-each 7503 ind close-sound drop 7504 "oboe.snd" find-sound sound? if 7505 "oboe.snd is still open?" #() snd-display 7506 then 7507 #( <'> region-chans <'> region-home <'> region-framples 7508 <'> region-position <'> region-maxamp <'> region-maxamp-position 7509 <'> region-srate <'> forget-region ) { reg-prcs-1 } 7510 #( vct-5 #( 0 1 ) 0+i "hiho" '( 0 1 ) ) each to arg 7511 reg-prcs-1 #( <'> region-sample <'> region->vct ) array-append each to prc 7512 arg prc snd-test-catch to tag 7513 tag if 7514 tag car 'wrong-type-arg <> 7515 tag car 'wrong-number-of-args <> && if 7516 "region procs %s [%s]: %s" #( prc arg tag ) snd-display 7517 then 7518 then 7519 end-each 7520 end-each 7521 #( <'> axis-color <'> enved-filter-order <'> enved-filter 7522 <'> filter-control-waveform-color <'> ask-before-overwrite 7523 <'> ask-about-unsaved-edits <'> auto-resize <'> auto-update 7524 <'> axis-label-font <'> axis-numbers-font <'> basic-color <'> bind-key 7525 <'> show-full-duration <'> show-full-range <'> initial-beg <'> initial-dur 7526 <'> channel-style <'> color-cutoff <'> color-orientation-dialog 7527 <'> color-inverted <'> color-scale <'> cursor-color 7528 <'> dac-combines-channels <'> dac-size <'> clipping <'> data-color 7529 <'> default-output-chans <'> default-output-sample-type 7530 <'> default-output-srate <'> default-output-header-type 7531 <'> enved-envelope <'> enved-base <'> enved-clip? <'> enved-in-dB 7532 <'> enved-dialog <'> enved-style <'> enved-power <'> enved-target 7533 <'> enved-waveform-color <'> enved-wave? <'> eps-file <'> eps-left-margin 7534 <'> eps-bottom-margin <'> eps-size <'> foreground-color <'> graph-color 7535 <'> graph-cursor <'> highlight-color <'> just-sounds <'> key-binding 7536 <'> listener-color <'> listener-font <'> listener-prompt 7537 <'> listener-text-color <'> max-regions <'> mix-waveform-height 7538 <'> region-graph-style <'> position-color <'> time-graph-style 7539 <'> lisp-graph-style <'> transform-graph-style <'> peaks-font 7540 <'> bold-peaks-font <'> print-length 7541 <'> play-arrow-size <'> sash-color <'> ladspa-dir <'> peak-env-dir 7542 <'> save-dir <'> save-state-file <'> selected-channel 7543 <'> selected-data-color <'> selected-graph-color <'> selected-sound 7544 <'> selection-creates-region <'> show-controls <'> show-indices 7545 <'> show-listener <'> show-selection-transform <'> sinc-width <'> temp-dir 7546 <'> text-focus-color <'> tiny-font <'> with-file-monitor 7547 <'> unbind-key <'> with-verbose-cursor 7548 <'> with-inset-graph <'> with-interrupts <'> with-pointer-focus 7549 <'> window-height <'> beats-per-measure <'> with-smpte-label 7550 <'> with-toolbar <'> with-tooltips <'> with-menu-icons 7551 <'> remember-sound-state <'> save-as-dialog-src 7552 <'> save-as-dialog-auto-comment <'> window-width <'> window-x 7553 <'> window-y <'> with-gl <'> with-mix-tags <'> x-axis-style 7554 <'> beats-per-minute <'> zoom-color <'> mix-tag-height <'> mix-tag-width 7555 <'> with-relative-panes <'> clm-table-size 7556 <'> mark-tag-width <'> mark-tag-height ) each to prc 7557 vct-5 prc set-xt snd-test-catch to tag 7558 tag if 7559 tag car 'wrong-type-arg <> 7560 tag car 'syntax-error <> && 7561 tag car 'error <> && if 7562 "misc procs %s: %s" #( prc tag ) snd-display 7563 then 7564 then 7565 end-each 7566 nil { hook } 7567 snd-hooks each to hook 7568 hook <'> noop 0 make-proc <'> add-hook! snd-test-catch to tag 7569 tag if 7570 \ XXX: FTH special 'bad-arity (add-hook!) [ms] 7571 tag car 'bad-arity <> 7572 tag car 'wrong-type-arg <> && if 7573 "[0] hooks %s: %s" #( hook hook-name tag ) snd-display 7574 then 7575 then 7576 end-each 7577 reset-almost-all-hooks 7578 #( <'> exit-hook <'> stop-playing-selection-hook 7579 <'> color-hook <'> orientation-hook 7580 <'> start-playing-selection-hook ) each to hook 7581 hook <'> noop 3 make-proc <'> add-hook! #t nil fth-catch to tag 7582 stack-reset 7583 tag if 7584 \ XXX: FTH special 'bad-arity (add-hook!) [ms] 7585 tag car 'bad-arity <> 7586 tag car 'wrong-type-arg <> && if 7587 "[1] hooks %s: %s" #( hook hook-name tag ) snd-display 7588 then 7589 then 7590 end-each 7591 reset-almost-all-hooks 7592 #f set-ask-about-unsaved-edits drop 7593 #f set-remember-sound-state drop 7594 "not-an-env" <'> set-enved-envelope 'no-such-envelope check-error-tag 7595 "/bad/baddy" <'> save-envelopes 'cannot-save check-error-tag 7596 "/bad/baddy" <'> mus-sound-report-cache 'cannot-save check-error-tag 7597 <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag 7598 0 "oboe.snd" 1 <'> make-sampler 'no-such-channel check-error-tag 7599 0 "oboe.snd" -1 <'> make-sampler 'no-such-channel check-error-tag 7600 <char> p 0 <'> noop 2 make-proc <'> bind-key 'bad-arity check-error-tag 7601 <'> noop 1 make-proc <'> set-zoom-focus-style 'bad-arity check-error-tag 7602 123 #( 0 0 1 1 ) <'> set-sound-loop-info 'no-such-sound check-error-tag 7603 "fmv.snd" 2 22050 mus-bfloat mus-nist "comment" <'> new-sound 'bad-header 7604 check-error-tag 7605 123 <'> player-home 'wrong-type-arg check-error-tag 7606 "/hiho" <'> set-temp-dir 'no-such-file check-error-tag 7607 "/hiho" <'> set-save-dir 'no-such-file check-error-tag 7608 sf-dir "bad_chans.snd" $+ <'> mus-sound-maxamp 'bad-header check-error-tag 7609 :order 32 :ycoeffs 4 0.0 make-vct <'> make-iir-filter 'mus-error 7610 check-error-tag 7611 :coeffs 4 0 make-vct :ycoeffs 4 0 make-vct <'> make-iir-filter 'mus-error 7612 check-error-tag 7613 :coeffs 4 0 make-vct :xcoeffs 4 0 make-vct <'> make-fir-filter 'mus-error 7614 check-error-tag 7615 :size 123456789 <'> make-table-lookup 'out-of-range check-error-tag 7616 :ramp -0.5 <'> make-granulate 'out-of-range check-error-tag 7617 :ramp 1.5 <'> make-granulate 'out-of-range check-error-tag 7618 :expansion 32000.0 <'> make-granulate 'mus-error check-error-tag 7619 "test.snd" :channels 0 <'> new-sound 'out-of-range check-error-tag 7620 "test.snd" :srate 0 <'> new-sound 'out-of-range check-error-tag 7621 "test.snd" :size -1 <'> new-sound 'out-of-range check-error-tag 7622 "test.snd" :size 0 <'> make-readin 'out-of-range check-error-tag 7623 "test.snd" :size -1 <'> make-readin 'out-of-range check-error-tag 7624 "oboe.snd" 0 <'> make-file->sample 'out-of-range check-error-tag 7625 "oboe.snd" -1 <'> make-file->sample 'out-of-range check-error-tag 7626 "oboe.snd" 0 <'> make-file->frample 'out-of-range check-error-tag 7627 "oboe.snd" -1 <'> make-file->frample 'out-of-range check-error-tag 7628 -1 <'> set-default-output-sample-type 'out-of-range check-error-tag 7629 mus-soundfont <'> set-default-output-header-type 'out-of-range check-error-tag 7630 sf-dir "bad_location.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag 7631 sf-dir "bad_field.nist" $+ <'> mus-sound-chans 'mus-error check-error-tag 7632 snd-motif-error-checks 7633 -1 <'> main-menu 'no-such-menu check-error-tag 7634 111 <'> main-menu 'no-such-menu check-error-tag 7635 "hiho" :header-type 123 <'> new-sound 'out-of-range check-error-tag 7636 "hiho" :header-type mus-nist :sample-type 123 <'> new-sound 'out-of-range check-error-tag 7637 "hiho" :header-type mus-nist :sample-type mus-bfloat <'> new-sound 'bad-header check-error-tag 7638 -1 <'> set-mus-array-print-length 'out-of-range check-error-tag 7639 -1 <'> set-print-length 'out-of-range check-error-tag 7640 -1 <'> set-play-arrow-size 'out-of-range check-error-tag 7641 12 <'> set-enved-style 'out-of-range check-error-tag 7642 1.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag 7643 -0.5 0.0 0.0 <'> make-color 'out-of-range check-error-tag 7644 #f <'> make-variable-graph 'wrong-type-arg check-error-tag 7645 <'> graph->ps 'cannot-print check-error-tag 7646 "oboe.snd" open-sound to ind 7647 #t set-selection-creates-region drop 7648 select-all drop 7649 "sel0.snd" :not-a-key 3 <'> save-selection 'mus-error check-error-tag 7650 '( ind ) <'> read-only 'wrong-type-arg check-error-tag 7651 ind '( 0 ) <'> framples 'wrong-type-arg check-error-tag 7652 0 -10 <'> smooth-sound 'wrong-type-arg check-error-tag 7653 0 ind 123 <'> mix-selection 'no-such-channel check-error-tag 7654 0 ind 123 <'> insert-selection 'no-such-channel check-error-tag 7655 ind 0 <'> set-channels 'out-of-range check-error-tag 7656 ind -1 <'> set-channels 'wrong-type-arg check-error-tag 7657 ind 12340 <'> set-channels 'out-of-range check-error-tag 7658 ind 12340 <'> set-sample-type 'out-of-range check-error-tag 7659 ind 12340 <'> set-header-type 'out-of-range check-error-tag 7660 ind 0 <'> set-srate 'out-of-range check-error-tag 7661 ind -1 <'> set-data-location 'wrong-type-arg check-error-tag 7662 ind -1 <'> set-data-size 'wrong-type-arg check-error-tag 7663 -1 -1 <'> set-sample 'no-such-sample check-error-tag 7664 -1 <'> sample 'no-such-sample check-error-tag 7665 -10 <'> set-framples 'out-of-range check-error-tag 7666 0.0 <'> set-min-dB 'out-of-range check-error-tag 7667 0.0 ind 0 <'> set-min-dB 'out-of-range check-error-tag 7668 1 -22 <'> start-playing 'out-of-range check-error-tag 7669 1 0 <'> start-playing 'out-of-range check-error-tag 7670 #( 0.0 1.0 0.1 -0.1 1.0 0.0 ) ind <'> set-filter-control-envelope 7671 'out-of-range check-error-tag 7672 #( 0.0 1.0 0.1 1.1 1.0 0.0 ) ind <'> set-filter-control-envelope 7673 'out-of-range check-error-tag 7674 #( 0 0 0.1 0.1 0.05 0.1 1 1 ) 32 <'> filter-sound 'env-error check-error-tag 7675 ind 123 <'> apply-controls 'out-of-range check-error-tag 7676 #( 0.0 2.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag 7677 #( 0.0 2.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag 7678 #( 2.0 0.0 ) <'> set-speed-control-bounds 'out-of-range check-error-tag 7679 #( 2.0 0.0 ) <'> set-expand-control-bounds 'out-of-range check-error-tag 7680 sf-dir "bad_chans.snd" $+ <'> insert-sound 'bad-header check-error-tag 7681 sf-dir "bad_chans.snd" $+ <'> convolve-with 'IO-error check-error-tag 7682 "hiho.snd" ind -12 <'> save-sound-as 'cannot-save check-error-tag 7683 "hiho.snd" ind :header-type mus-next :sample-type -12 7684 <'> save-sound-as 'cannot-save check-error-tag 7685 "test.snd" ind :header-type mus-nist :sample-type mus-bdouble 7686 <'> save-sound-as 'cannot-save check-error-tag 7687 "test.snd" ind :header-type mus-aifc :sample-type mus-lfloat 7688 <'> save-sound-as 'cannot-save check-error-tag 7689 "test.snd" ind :header-type mus-riff :sample-type mus-bshort 7690 <'> save-sound-as 'cannot-save check-error-tag 7691 "test.snd" ind :header-type mus-voc :sample-type mus-bshort 7692 <'> save-sound-as 'cannot-save check-error-tag 7693 "test.snd" 22050 mus-bshort mus-riff 7694 <'> save-selection 'cannot-save check-error-tag 7695 "test.snd" 22050 mus-bshort mus-voc 7696 <'> save-selection 'cannot-save check-error-tag 7697 #( 0 0 1 1 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag 7698 #( 0 1 1 0 ) :length 11 make-env <'> src-channel 'out-of-range check-error-tag 7699 #( 0 1 1 -1 ) :length 11 make-env <'> src-channel 'out-of-range 7700 check-error-tag 7701 #( 0 -1 1 1 ) :length 11 make-env <'> src-channel 'out-of-range 7702 check-error-tag 7703 #( 0 0 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag 7704 #( 0 1 1 0 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag 7705 #( 0 1 1 -1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag 7706 #( 0 -1 1 1 ) :length 11 make-env <'> src-sound 'out-of-range check-error-tag 7707 0.0 0.0 0.0 0.0 0.0 0.0 0.0 <'> make-readin 'mus-error check-error-tag 7708 vct-3 32 <'> filter-sound 'out-of-range check-error-tag 7709 #( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag 7710 ind 0 12345 0 <'> swap-channels 'no-such-sound check-error-tag 7711 vct( 0.1 0.2 0.3 ) -1 ind 0 #t "" <'> mix-vct 'no-such-sample check-error-tag 7712 8 0.0 make-vct 0 -123 <'> snd-spectrum 'out-of-range check-error-tag 7713 8 0.0 make-vct 0 0 <'> snd-spectrum 'out-of-range check-error-tag 7714 "/baddy/hiho" <'> play 'no-such-file check-error-tag 7715 sf-dir "nist-shortpack.wav" $+ <'> play 'bad-sample-type check-error-tag 7716 ind 123 <'> make-player 'no-such-channel check-error-tag 7717 "/baddy/hiho" <'> mix 'no-such-file check-error-tag 7718 "oboe.snd" 0 2 <'> mix 'no-such-channel check-error-tag 7719 "/baddy/hiho" 0 <'> mix-sound 'no-such-file check-error-tag 7720 "/baddy/hiho.snd" <'> insert-sound 'no-such-file check-error-tag 7721 0 10 "/baddy/hiho.snd" <'> insert-samples 'no-such-file check-error-tag 7722 '() ind <'> set-filter-control-envelope 'no-data check-error-tag 7723 ind 123 <'> set-sample-type 'out-of-range check-error-tag 7724 ind 123 <'> set-header-type 'out-of-range check-error-tag 7725 ind 123 <'> set-selected-channel 'no-such-channel check-error-tag 7726 <'> noop 3 make-proc <'> set-search-procedure 'bad-arity check-error-tag 7727 <'> noop 3 make-proc <'> map-chan 'bad-arity check-error-tag 7728 <'> noop 1 make-proc ind 0 <'> set-cursor-style 'bad-arity check-error-tag 7729 0 0 1 1 ind 0 1234 <'> draw-line 'no-such-graphics-context check-error-tag 7730 ind 0 1234 <'> foreground-color 'no-such-graphics-context check-error-tag 7731 ind 0 1234 <'> current-font 'no-such-graphics-context check-error-tag 7732 '( vct-3 vct-3 ) ind 0 1234 0 1 0 <'> graph-data 'no-such-graphics-context 7733 check-error-tag 7734 100 ind 0 1234 <'> position->x 'no-such-axis check-error-tag 7735 100 ind 0 1234 <'> position->y 'no-such-axis check-error-tag 7736 100 ind 0 1234 <'> x->position 'no-such-axis check-error-tag 7737 100 ind 0 1234 <'> y->position 'no-such-axis check-error-tag 7738 ind 0 1234 <'> axis-info 'no-such-axis check-error-tag 7739 *with-test-gui* if 7740 channel-widgets car snd-gcs car "hiho" 0.0 1.0 -1.0 1.0 x-axis-in-seconds 7741 1234 <'> draw-axes 'out-of-range check-error-tag 7742 channel-widgets car snd-gcs car "hiho" 0.0 1.0 -1.0 1.0 7743 1234 <'> draw-axes 'out-of-range check-error-tag 7744 ind 1234 <'> axis-info 'no-such-channel check-error-tag 7745 1234 <'> axis-info 'no-such-sound check-error-tag 7746 then 7747 graph-once set-time-graph-type drop 7748 #( 0.1 -0.1 ) <'> set-x-bounds 'out-of-range check-error-tag 7749 100 0 <'> make-region 'out-of-range check-error-tag 7750 -1 <'> delete-sample 'no-such-sample check-error-tag 7751 ind framples 2* <'> delete-sample 'no-such-sample check-error-tag 7752 "/bad/baddy.snd" <'> play 'no-such-file check-error-tag 7753 1234 0 <'> play 'no-such-sound check-error-tag 7754 regions empty? if 7755 0 100 make-region 7756 then 7757 regions car 0 1234 <'> region-sample 'no-such-channel check-error-tag 7758 regions car 1234 <'> region-framples 'no-such-channel check-error-tag 7759 regions car 1234 <'> region-position 'no-such-channel check-error-tag 7760 "/bad/baddy.snd" <'> save-sound-as 'cannot-save check-error-tag 7761 0 1 1234 <'> transform-sample 'no-such-sound check-error-tag 7762 0 1 ind 1234 <'> transform-sample 'no-such-channel check-error-tag 7763 vct( 0 1 ) "hi" 0 1 0 1 1234 <'> graph 'no-such-sound check-error-tag 7764 vct( 0 1 ) "hi" 0 1 0 1 ind 1234 <'> graph 'no-such-channel check-error-tag 7765 #f #t set-selection-member? drop 7766 vct( 0 0 1 1 ) 4 <'> filter-selection 'no-active-selection check-error-tag 7767 "/bad/baddy.snd" <'> save-selection 'no-active-selection check-error-tag 7768 #( 0 0 1 1 ) <'> env-selection 'no-active-selection check-error-tag 7769 0 100 ind 0 make-region drop 7770 "/bad/baddy.snd" <'> save-selection 'cannot-save check-error-tag 7771 regions car "/bad/baddy.snd" <'> save-region 'cannot-save check-error-tag 7772 0 12 1234 #t <'> make-region 'no-such-sound check-error-tag 7773 #t ind set-read-only drop 7774 \ XXX: snd-nogui and set-read-only 7775 \ Snd-nogui has no widget and therefore the sound will not be 7776 \ write-protected according to snd-snd.c. 7777 ind read-only if 7778 ind '( 0 0 1 1 ) <'> set-sound-loop-info 'cannot-save check-error-tag 7779 else 7780 *with-test-nogui* unless 7781 "%s is not read-only?" #( ind ) snd-display 7782 then 7783 then 7784 0 ind 0 123 <'> make-sampler 'no-such-direction check-error-tag 7785 0 ind 0 0 <'> make-sampler 'no-such-direction check-error-tag 7786 0 ind 0 -2 <'> make-sampler 'no-such-direction check-error-tag 7787 '() <'> scale-by 'no-data check-error-tag 7788 '() <'> scale-to 'no-data check-error-tag 7789 -999 ind 0 <'> set-selection-position 'no-such-sample check-error-tag 7790 -999 ind 0 <'> set-selection-framples 'wrong-type-arg check-error-tag 7791 0 ind 0 <'> set-selection-framples 'wrong-type-arg check-error-tag 7792 -1 <'> edit-fragment 'no-such-edit check-error-tag 7793 101 ind 0 <'> edit-fragment 'no-such-edit check-error-tag 7794 ind 0 -2 <'> edit-tree 'no-such-edit check-error-tag 7795 ind 0 101 <'> edit-tree 'no-such-edit check-error-tag 7796 -1 <'> add-mark 'no-such-sample check-error-tag 7797 framples 2* <'> add-mark 'no-such-sample check-error-tag 7798 "/bad/baddy" <'> convolve-with 'no-such-file check-error-tag 7799 "/bad/baddy" <'> mix 'no-such-file check-error-tag 7800 ind 0 123 <'> swap-channels 'no-such-sound check-error-tag 7801 123 ind 0 <'> set-show-axes 'out-of-range check-error-tag 7802 -123 ind 0 <'> set-show-axes 'out-of-range check-error-tag 7803 123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag 7804 -123 ind 0 <'> set-x-axis-style 'out-of-range check-error-tag 7805 123 ind 0 <'> set-graph-style 'out-of-range check-error-tag 7806 -123 ind 0 <'> set-graph-style 'out-of-range check-error-tag 7807 '( 0 0 1 1 ) 0 #f -1.5 <'> env-sound 'out-of-range check-error-tag 7808 0.0 1.0 -1.6 <'> xramp-channel 'out-of-range check-error-tag 7809 0 2 -1 <'> set-samples 'wrong-type-arg check-error-tag 7810 '( 0 ) <'> left-sample 'wrong-type-arg check-error-tag 7811 '( 0 ) <'> amp-control 'wrong-type-arg check-error-tag 7812 '( 0 ) <'> sound-loop-info 'wrong-type-arg check-error-tag 7813 123 '( 0 ) <'> add-mark 'wrong-type-arg check-error-tag 7814 '( 0 0 1 1 ) 100 #f #f 1234 0 <'> filter-channel 'no-such-sound 7815 check-error-tag 7816 '( 0 0 1 1 ) 100 #f #f ind 1 <'> filter-channel 'no-such-channel 7817 check-error-tag 7818 vct( 0 0 1 1 ) 4 #f #f ind 1 <'> filter-channel 'no-such-channel 7819 check-error-tag 7820 vct( 0 0 1 1 ) 0 <'> filter-sound 'out-of-range check-error-tag 7821 vct( 0 0 1 1 ) 10 <'> filter-sound 'out-of-range check-error-tag 7822 selected-sound 0 :stop <'> noop 0 make-proc <'> play 'bad-arity 7823 check-error-tag 7824 '( 0.1 0.01 ) ind <'> set-reverb-control-length-bounds 'out-of-range 7825 check-error-tag 7826 '( 0.1 0.01 ) ind <'> set-reverb-control-scale-bounds 'out-of-range 7827 check-error-tag 7828 #f <'> scale-by 'wrong-type-arg check-error-tag 7829 3.0 1.0 #t <'> src-sound 'wrong-type-arg check-error-tag 7830 3.0 1.0 ind #t <'> src-sound 'wrong-type-arg check-error-tag 7831 ind 0 123 <'> display-edits 'no-such-edit check-error-tag 7832 ind 0 123 <'> marks 'no-such-edit check-error-tag 7833 "test.snd" :edit-position 123 <'> save-sound-as 'no-such-edit check-error-tag 7834 "1a.snd" 0 0 ind 0 0 123 <'> insert-sound 'no-such-auto-delete-choice 7835 check-error-tag 7836 ind close-sound drop 7837 "hiho" "time" 0 1 <'> noop 0 make-proc <'> add-transform 'bad-arity 7838 check-error-tag 7839 "/bad/baddy" <'> save-state 'cannot-save check-error-tag 7840 1234 "hi" <'> noop 0 make-proc <'> add-to-menu 'no-such-menu check-error-tag 7841 "hi" <'> noop 2 make-proc <'> add-to-main-menu 'bad-arity check-error-tag 7842 1 "hi" <'> noop 2 make-proc <'> add-to-menu 'bad-arity check-error-tag 7843 '( 0 1 ) "hiho" <'> help-dialog 'wrong-type-arg check-error-tag 7844 '( 0 1 ) "hiho" <'> info-dialog 'wrong-type-arg check-error-tag 7845 1234 <'> edit-header-dialog 'no-such-sound check-error-tag 7846 "/bad/baddy.snd" <'> open-sound 'no-such-file check-error-tag 7847 "/bad/baddy.snd" 1 22050 mus-lshort <'> open-raw-sound 'no-such-file 7848 check-error-tag 7849 "/bad/baddy.snd" <'> view-sound 'no-such-file check-error-tag 7850 0 "/bad/baddy.snd" <'> make-sampler 'no-such-file check-error-tag 7851 -1 0 #f <'> bind-key 'no-such-key check-error-tag 7852 12 17 #f <'> bind-key 'no-such-key check-error-tag 7853 12 -1 #f <'> bind-key 'no-such-key check-error-tag 7854 12345678 0 <'> key-binding 'no-such-key check-error-tag 7855 -1 0 <'> key-binding 'no-such-key check-error-tag 7856 12 17 <'> key-binding 'no-such-key check-error-tag 7857 12 -1 <'> key-binding 'no-such-key check-error-tag 7858 sf-dir "bad_chans.snd" $+ 0 0 123 123 0.0 make-vct <'> file->array 7859 'bad-header check-error-tag 7860 sf-dir "bad_chans.snd" $+ <'> make-readin 'bad-header check-error-tag 7861 30 3 0 make-vct <'> make-iir-filter 'mus-error check-error-tag 7862 :size 2 30 f** f>s <'> make-wave-train 'out-of-range check-error-tag 7863 0.0 <'> set-mus-srate 'out-of-range check-error-tag 7864 -1000 <'> set-mus-srate 'out-of-range check-error-tag 7865 3 0 make-vct 3 0 make-vct -1 <'> dot-product 'out-of-range check-error-tag 7866 3 :initial-element 0.0 :initial-contents vct( 0.1 0.2 0.3 ) <'> make-delay 7867 'out-of-range check-error-tag 7868 3 :max-size 100 :initial-contents vct( 0.1 0.2 0.3 ) <'> make-delay 7869 'out-of-range check-error-tag 7870 :size 100 :wave 3 0 make-vct <'> make-table-lookup 'out-of-range 7871 check-error-tag 7872 :size 100 :wave 3 0 make-vct <'> make-wave-train 'out-of-range check-error-tag 7873 100 12345678 <'> make-ssb-am 'out-of-range check-error-tag 7874 :envelope '( 0 0 1 1 ) :distribution 10 0 make-vct <'> make-rand 7875 'mus-error check-error-tag 7876 :envelope '( 0 0 1 ) <'> make-rand 'mus-error check-error-tag 7877 :envelope '( 0 0 1 1 ) :size -2 <'> make-rand 'out-of-range check-error-tag 7878 :envelope '( 0 0 1 1 ) :size 1234567890 <'> make-rand 'out-of-range 7879 check-error-tag 7880 make-granulate #f <'> noop 3 make-proc <'> granulate 'bad-arity 7881 check-error-tag 7882 make-phase-vocoder #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity 7883 check-error-tag 7884 make-phase-vocoder #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity 7885 check-error-tag 7886 make-phase-vocoder #f #f #f <'> noop 0 make-proc <'> phase-vocoder 'bad-arity 7887 check-error-tag 7888 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-xcoeff 'mus-error 7889 check-error-tag 7890 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 <'> mus-ycoeff 'mus-error 7891 check-error-tag 7892 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-xcoeff 7893 'mus-error check-error-tag 7894 3 :xcoeffs vct-3 :ycoeffs vct-3 make-filter 4 1.0 <'> set-mus-ycoeff 7895 'mus-error check-error-tag 7896 :ycoeffs 4 0 make-vct :order 12 <'> make-filter 'mus-error check-error-tag 7897 make-oscil 1 <'> set-mus-offset 'mus-error check-error-tag 7898 :channels 2 30 f** f>s <'> make-locsig 'out-of-range check-error-tag 7899 :width 3000 <'> make-src 'out-of-range check-error-tag 7900 *with-test-gui* if 7901 "baddy" <'> noop 0 make-proc <'> add-colormap 'bad-arity check-error-tag 7902 "baddy" <'> noop 3 make-proc <'> add-colormap 'bad-arity check-error-tag 7903 then 7904 :input <'> noop 1 make-proc make-src 2000000.0 <'> src 'out-of-range 7905 check-error-tag 7906 '( 1 1 ) -1 <'> partials->polynomial 'out-of-range check-error-tag 7907 '( 1 1 ) 3 <'> partials->polynomial 'out-of-range check-error-tag 7908 :partials '( 1 1 ) :kind -1 <'> make-polyshape 'out-of-range check-error-tag 7909 :partials '( 1 1 ) :kind 3 <'> make-polyshape 'out-of-range check-error-tag 7910 32 <'> normalize-partials 'wrong-type-arg check-error-tag 7911 '() <'> normalize-partials 'wrong-type-arg check-error-tag 7912 '( 1 2 3 ) <'> normalize-partials 'bad-type check-error-tag 7913 vct( 3 ) <'> normalize-partials 'bad-type check-error-tag 7914 440.0 :partials vct( 1 1 -2 1 ) <'> make-polyshape 'no-data check-error-tag 7915 440.0 :partials list( 1 1 -2 1 ) <'> make-polyshape 'no-data check-error-tag 7916 440.0 :partials '() <'> make-polyshape 'no-data check-error-tag 7917 1234 <'> set-mus-header-raw-defaults 'wrong-type-arg check-error-tag 7918 '( 44100 2.123 "hi" ) <'> set-mus-header-raw-defaults 'wrong-type-arg 7919 check-error-tag 7920 123 <'> set-with-toolbar 'wrong-type-arg check-error-tag 7921 123 <'> set-with-tooltips 'wrong-type-arg check-error-tag 7922 123 <'> set-with-menu-icons 'wrong-type-arg check-error-tag 7923 123 <'> set-save-as-dialog-src 'wrong-type-arg check-error-tag 7924 123 <'> set-save-as-dialog-auto-comment 'wrong-type-arg check-error-tag 7925 123 <'> set-with-smpte-label 'wrong-type-arg check-error-tag 7926 123 <'> set-ask-about-unsaved-edits 'wrong-type-arg check-error-tag 7927 sounds empty? unless 7928 "sounds after error checks: %s" #( sounds ) snd-display 7929 then 7930 mus-audio-reinitialize drop 7931 10 set-window-y drop 7932 dismiss-all-dialogs 7933 "test.snd" file-exists? if 7934 "test.snd" 0o644 file-chmod 7935 "test.snd" file-delete 7936 then 7937 "oboe.snd" "test.snd" file-copy 7938 "test.snd" open-sound to ind 7939 "test.snd" file-delete 7940 ind <'> update-sound #t nil fth-catch to tag 7941 stack-reset 7942 tag if 7943 tag car 'cant-update-file <> if 7944 "update-sound after deletion: %s" #( tag ) snd-display 7945 then 7946 then 7947 ind <'> save-sound #t nil fth-catch to tag 7948 stack-reset 7949 tag if 7950 tag car 'cannot-save <> if 7951 "save file deleted: %s" #( tag ) snd-display 7952 then 7953 then 7954 ind close-sound drop 7955 \ 7956 "oboe.snd" "test.snd" file-copy 7957 "test.snd" open-sound to ind 7958 select-all drop 7959 "test.snd" file-delete 7960 view-regions-dialog drop 7961 ind close-sound drop 7962 dismiss-all-dialogs 7963 \ 7964 "oboe.snd" "test.snd" file-copy 7965 "test.snd" open-sound to ind 7966 "test.snd" 0o400 file-chmod 7967 10 delete-sample drop 7968 ind <'> save-sound #t nil fth-catch to tag 7969 stack-reset 7970 tag if 7971 tag car 'cannot-save <> if 7972 "save protected sound msg: %s" #( tag ) snd-display 7973 then 7974 then 7975 ind close-sound drop 7976 \ 7977 "test.snd" 0o644 file-chmod 7978 "test.snd" file-delete 7979 "oboe.snd" "test.snd" file-copy 7980 "test.snd" 0o200 file-chmod 7981 "test.snd" <'> open-sound #t nil fth-catch to tag 7982 stack-reset 7983 tag if 7984 tag car 'no-such-file = 7985 tag car 'mus-error = || unless 7986 "open read-protected sound worked!: %s" #( tag ) snd-display 7987 then 7988 then 7989 "test.snd" 0o644 file-chmod 7990 "test.snd" file-delete 7991 ind sound? if 7992 ind close-sound drop 7993 then 7994 \ 7995 "oboe.snd" "test.snd" file-copy 7996 "test.snd" 0o400 file-chmod 7997 "test.snd" open-sound to ind 7998 10 delete-sample drop 7999 "test.snd" <'> save-sound-as #t nil fth-catch to tag 8000 stack-reset 8001 tag if 8002 tag car 'cannot-save <> if 8003 "save-as write-protected sound msg: %s" #( tag ) snd-display 8004 then 8005 then 8006 ind close-sound drop 8007 "test.snd" 0o644 file-chmod 8008 "test.snd" file-delete 8009 \ 8010 close-sound-mc-cb <'> map-channel #t nil fth-catch to tag 8011 stack-reset 8012 tag if 8013 tag car 'no-such-channel <> if 8014 "map-channel closing own chan: %s" #( tag ) snd-display 8015 then 8016 then 8017 \ 8018 close-sound-aoe-1-cb "snd-test" as-one-edit drop 8019 close-sound-aoe-2a-cb "outer-edit" as-one-edit drop 8020 close-sound-fc-cb find-channel drop 8021 \ 8022 "oboe.snd" open-sound to ind 8023 0 make-sampler { rd } 8024 ind close-sound drop 8025 10 0 do 8026 rd read-sample drop 8027 loop 8028 rd sampler-home { home } 8029 home array-length 0> if 8030 home 0 array-ref sound? if 8031 "reader-home of closed sound: %s %s?" #( home sounds ) snd-display 8032 then 8033 then 8034 rd sampler-position { loc } 8035 loc 0<> if 8036 "closed reader position: %s?" #( loc ) snd-display 8037 then 8038 rd sampler-at-end? { at-end } 8039 at-end false? if 8040 "closed sampler at end: %s?" #( at-end ) snd-display 8041 then 8042 \ 8043 "oboe.snd" open-sound to ind 8044 vct( 0.1 0.2 0.3 ) mix-vct { mx } 8045 mx make-mix-sampler to rd 8046 ind close-sound drop 8047 10 0 do 8048 rd read-mix-sample drop 8049 loop 8050 \ 8051 8 max-regions max set-max-regions drop 8052 "oboe.snd" open-sound to ind 8053 0 100 ind 0 make-region { reg } 8054 reg 0 make-region-sampler to rd 8055 ind close-sound drop 8056 reg forget-region drop 8057 10 0 do 8058 rd read-sample drop 8059 loop 8060 \ 8061 "oboe.snd" open-sound to ind 8062 100 0.5 ind 0 set-sample drop 8063 100 ind 0 sample { s100 } 8064 ind mc-2-cb map-channel drop 8065 100 ind 0 sample to s100 8066 s100 0.5 fneq if 8067 "map + reset framples: %s" #( s100 ) snd-display 8068 then 8069 ind 0 framples { frms } 8070 frms 50828 <> if 8071 "map + reset framples, framples: %s" #( frms ) snd-display 8072 then 8073 1 ind 0 undo drop 8074 ind 0 framples to frms 8075 frms 1 <> if 8076 "map + reset framples, undo framples: %s" #( frms ) snd-display 8077 then 8078 ind revert-sound drop 8079 \ 8080 100 0.5 ind 0 set-sample drop 8081 \ XXX: 'wrong-type-arg instead of 'wrong-number-of-args 8082 \ 8083 \ (set! (framples ind 0 1) 1) => too many arguments 8084 \ 1 ind 0 1 set-framples => wrong type arg 1 (<sound 0>) 8085 \ 8086 \ With Fth this doesn't work as expected. If stack has more values than 8087 \ needed by the next word, no 'wrong-number-of-args exception can be 8088 \ raised because no one knows who will take the other values. That's 8089 \ why the first exception is 'wrong-type-arg because sound IND is not 8090 \ a number. 8091 \ 8092 \ framples ( snd chn edpos -- frms ) /* g_framples(snd, chn, edpos) */ 8093 \ set-framples ( on snd chn -- val ) /* g_set_framples(on, snd, chn) */ 8094 1 ind 0 1 <'> set-framples #t nil fth-catch to tag 8095 stack-reset 8096 tag if 8097 tag car 'wrong-number-of-args <> 8098 tag car 'wrong-type-arg <> && if 8099 "set framples + edpos: %s" #( tag ) snd-display 8100 then 8101 then 8102 ind revert-sound drop 8103 *with-test-complex* if 8104 <'> mc-3-cb <'> map-channel #t nil fth-catch to tag 8105 then 8106 stack-reset 8107 tag if 8108 tag car 'bad-type <> if 8109 "map-channel rtn complex: %s" #( tag ) snd-display 8110 then 8111 then 8112 0 make-sampler to rd 8113 10 0 do 8114 rd #() apply drop 8115 loop 8116 rd copy-sampler { crd } 8117 ind close-sound drop 8118 10 0 do 8119 crd read-sample drop 8120 loop 8121 crd sampler-home to home 8122 home array-length 0> if 8123 home 0 array-ref sound? if 8124 "copy reader-home of closed sound: %s %s?" #( home sounds ) snd-display 8125 then 8126 then 8127 crd sampler-position to loc 8128 loc 0<> if 8129 "closed copy reader position: %s?" #( loc ) snd-display 8130 then 8131 crd sampler-at-end? to at-end 8132 at-end false? if 8133 "closed copy sampler at end: %s?" #( at-end ) snd-display 8134 then 8135 \ 8136 ind <'> revert-sound #t nil fth-catch to tag 8137 stack-reset 8138 tag if 8139 tag car 'no-such-sound <> if 8140 "revert-sound of closed sound: %s" #( tag ) snd-display 8141 then 8142 then 8143 \ 8144 set-procs04 length 2 = if 8145 "(%s %s)" set-procs04 8146 else 8147 "%s" #( set-procs04 ) 8148 then string-format { set04fncs } 8149 procs10 length 2 = if 8150 "(%s %s)" procs10 8151 else 8152 "%s" #( procs10 ) 8153 then string-format { 10fncs } 8154 *snd-test-verbose* if 8155 "procs prcs/set-prcs" #f snd-test-message 8156 "=====================" #f snd-test-message 8157 "procs00: %3d/%3d" #( procs00 length set-procs00 length ) snd-test-message 8158 "procs01: %3d/%3d" #( procs01 length set-procs01 length ) snd-test-message 8159 "procs02: %3d/%3d" #( procs02 length set-procs02 length ) snd-test-message 8160 "procs03: %3d/%3d" #( procs03 length set-procs03 length ) snd-test-message 8161 set-procs04 length 10 <= if 8162 "procs04: %3d/%3d %s" 8163 #( procs04 length set-procs04 length set04fncs ) snd-test-message 8164 else 8165 "procs04: %3d/%3d" #( procs04 length set-procs04 length ) snd-test-message 8166 then 8167 "procs05: %3d" #( procs05 length ) snd-test-message 8168 "procs06: %3d" #( procs06 length ) snd-test-message 8169 "procs07: %3d" #( procs07 length ) snd-test-message 8170 "procs08: %3d" #( procs08 length ) snd-test-message 8171 procs10 length 10 <= if 8172 "procs10: %3d %s" #( procs10 length 10fncs ) snd-test-message 8173 else 8174 "procs10: %3d" #( procs10 length ) snd-test-message 8175 then 8176 then 8177 #( 1.5 #( 0 1 ) 1234 #t ) { random-args } 8178 #( 1.5 #( 0 1 ) 1234 vct-3 color-95 0+i delay-32 :feedback #f ) { main-args } 8179 #( 1.5 #( 0 1 ) 1234 0+i delay-32 #t ) { few-args } 8180 #( 1.5 vct-3 0+i ) { fewer-args } 8181 all-args if 8182 main-args 8183 else 8184 few-args 8185 then { less-args } 8186 nil nil nil nil nil nil nil { arg1 arg2 arg3 arg4 tm prc tag } 8187 gc-run 8188 "keyargs-2-args" check-args-progress-info 8189 keyargs each to arg1 8190 random-args each to arg2 8191 make-procs each to prc 8192 arg1 arg2 prc #t nil fth-catch stack-reset 8193 end-each 8194 end-each 8195 end-each 8196 dismiss-all-dialogs 8197 gc-run 8198 all-args if 8199 "keyargs-3-args" check-args-progress-info 8200 random-args each to arg1 8201 keyargs each to arg2 8202 random-args each to arg3 8203 make-procs each to prc 8204 arg1 arg2 arg3 prc #t nil fth-catch stack-reset 8205 end-each 8206 end-each 8207 end-each 8208 end-each 8209 dismiss-all-dialogs 8210 gc-run 8211 "keyargs-4-args" check-args-progress-info 8212 keyargs each to arg1 8213 random-args each to arg2 8214 keyargs each to arg3 8215 random-args each to arg4 8216 make-procs each to prc 8217 arg1 arg2 arg3 arg4 prc #t nil fth-catch stack-reset 8218 end-each 8219 end-each 8220 end-each 8221 end-each 8222 end-each 8223 dismiss-all-dialogs 8224 gc-run 8225 then 8226 "no-args" check-args-progress-info 8227 procs00 each to prc 8228 prc #t nil fth-catch to tag 8229 stack-reset 8230 tag car 'wrong-number-of-args = if 8231 "procs00: %s %s" #( prc tag ) snd-display 8232 then 8233 end-each 8234 dismiss-all-dialogs 8235 gc-run 8236 "set-no-args" check-args-progress-info 8237 main-args each to arg 8238 set-procs00 each to prc 8239 arg prc set-xt #t nil fth-catch to tag 8240 stack-reset 8241 tag car 'wrong-number-of-args = if 8242 "set-procs00: (%s) %s %s" #( arg prc tag ) snd-display 8243 then 8244 end-each 8245 end-each 8246 dismiss-all-dialogs 8247 gc-run 8248 "1-arg" check-args-progress-info 8249 nil { arg } 8250 main-args each to arg 8251 procs01 each to prc 8252 arg prc #t nil fth-catch to tag 8253 stack-reset 8254 tag car 'wrong-number-of-args = if 8255 "procs01 wna: (%s) %s %s" #( arg prc tag ) snd-display 8256 then 8257 end-each 8258 end-each 8259 dismiss-all-dialogs 8260 gc-run 8261 "set-1-arg" check-args-progress-info 8262 main-args each to arg1 8263 main-args each to arg2 8264 set-procs01 each to prc 8265 prc proc-name "widget-size" string<> if 8266 arg1 arg2 prc set-xt #t nil fth-catch to tag 8267 stack-reset 8268 tag car 'wrong-number-of-args = if 8269 "set-procs01: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display 8270 then 8271 then 8272 end-each 8273 end-each 8274 end-each 8275 dismiss-all-dialogs 8276 gc-run 8277 "2-args" check-args-progress-info 8278 main-args each to arg1 8279 main-args each to arg2 8280 procs02 each to prc 8281 arg1 arg2 prc #t nil fth-catch to tag 8282 stack-reset 8283 tag car 'wrong-number-of-args = if 8284 "procs02: (%s %s) %s %s" #( arg1 arg2 prc tag ) snd-display 8285 then 8286 end-each 8287 end-each 8288 end-each 8289 dismiss-all-dialogs 8290 gc-run 8291 "set-2-args" check-args-progress-info 8292 less-args each to arg1 8293 less-args each to arg2 8294 less-args each to arg3 8295 set-procs02 each to prc 8296 arg1 arg2 arg3 prc set-xt #t nil fth-catch to tag 8297 stack-reset 8298 tag car 'wrong-number-of-args = if 8299 "set-procs02: (%s %s %s) %s %s" 8300 #( arg1 arg2 arg3 prc tag ) snd-display 8301 then 8302 end-each 8303 end-each 8304 end-each 8305 end-each 8306 dismiss-all-dialogs 8307 gc-run 8308 nil nil nil nil nil nil { arg5 arg6 arg7 arg8 arg9 arg0 } 8309 "3-args" check-args-progress-info 8310 less-args each to arg1 8311 less-args each to arg2 8312 less-args each to arg3 8313 procs03 each to prc 8314 arg1 arg2 arg3 prc #t nil fth-catch to tag 8315 stack-reset 8316 tag car 'wrong-number-of-args = if 8317 "procs03: (%s %s %s) %s %s" #( arg1 arg2 arg3 prc tag ) snd-display 8318 then 8319 end-each 8320 end-each 8321 end-each 8322 end-each 8323 dismiss-all-dialogs 8324 gc-run 8325 "set-3-args" check-args-progress-info 8326 less-args each to arg1 8327 less-args each to arg2 8328 less-args each to arg3 8329 less-args each to arg4 8330 set-procs03 each to prc 8331 arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag 8332 stack-reset 8333 tag car 'wrong-number-of-args = if 8334 "set-procs03: (%s %s %s %s) %s %s" 8335 #( arg1 arg2 arg3 arg4 prc tag ) snd-display 8336 then 8337 end-each 8338 end-each 8339 end-each 8340 end-each 8341 end-each 8342 dismiss-all-dialogs 8343 gc-run 8344 "4-args" check-args-progress-info 8345 few-args each to arg1 8346 few-args each to arg2 8347 few-args each to arg3 8348 few-args each to arg4 8349 procs04 each to prc 8350 arg1 arg2 arg3 arg4 prc #t nil fth-catch to tag 8351 stack-reset 8352 tag car 'wrong-number-of-args = if 8353 "procs04: (%s %s %s %s) %s %s" 8354 #( arg1 arg2 arg3 arg4 prc tag ) snd-display 8355 then 8356 end-each 8357 end-each 8358 end-each 8359 end-each 8360 end-each 8361 dismiss-all-dialogs 8362 gc-run 8363 "set-4-args" check-args-progress-info 8364 few-args each to arg1 8365 few-args each to arg2 8366 few-args each to arg3 8367 few-args each to arg4 8368 few-args each to arg5 8369 set-procs04 each to prc 8370 arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag 8371 stack-reset 8372 tag car 'wrong-number-of-args = if 8373 "set-procs04: (%s %s %s %s %s) %s %s" 8374 #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display 8375 then 8376 end-each 8377 end-each 8378 end-each 8379 end-each 8380 end-each 8381 end-each 8382 stop-playing drop 8383 dismiss-all-dialogs 8384 gc-run 8385 "5-args" check-args-progress-info 8386 fewer-args each to arg1 8387 fewer-args each to arg2 8388 fewer-args each to arg3 8389 fewer-args each to arg4 8390 fewer-args each to arg5 8391 procs05 each to prc 8392 arg1 arg2 arg3 arg4 arg5 prc #t nil fth-catch to tag 8393 stack-reset 8394 tag car 'wrong-number-of-args = if 8395 "procs05: (%s %s %s %s %s) %s %s" 8396 #( arg1 arg2 arg3 arg4 arg5 prc tag ) snd-display 8397 then 8398 end-each 8399 end-each 8400 end-each 8401 end-each 8402 end-each 8403 end-each 8404 dismiss-all-dialogs 8405 gc-run 8406 "6-args" check-args-progress-info 8407 fewer-args each to arg1 8408 fewer-args each to arg2 8409 fewer-args each to arg3 8410 fewer-args each to arg4 8411 fewer-args each to arg5 8412 fewer-args each to arg6 8413 procs06 each to prc 8414 arg1 arg2 arg3 arg4 arg5 arg6 prc #t nil fth-catch to tag 8415 stack-reset 8416 tag car 'wrong-number-of-args = if 8417 "procs06: (%s %s %s %s %s %s) %s %s" 8418 #( arg1 arg2 arg3 arg4 arg5 arg6 prc tag ) snd-display 8419 then 8420 end-each 8421 end-each 8422 end-each 8423 end-each 8424 end-each 8425 end-each 8426 end-each 8427 dismiss-all-dialogs 8428 gc-run 8429 "8-args" check-args-progress-info 8430 fewer-args each to arg1 8431 fewer-args each to arg2 8432 fewer-args each to arg3 8433 fewer-args each to arg4 8434 fewer-args each to arg5 8435 fewer-args each to arg6 8436 fewer-args each to arg7 8437 fewer-args each to arg8 8438 procs08 each to prc 8439 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc #t nil 8440 fth-catch to tag 8441 stack-reset 8442 tag car 'wrong-number-of-args = if 8443 "procs08: (%s %s %s %s %s %s %s %s) %s %s" 8444 #( arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 prc tag ) 8445 snd-display 8446 then 8447 end-each 8448 end-each 8449 end-each 8450 end-each 8451 end-each 8452 end-each 8453 end-each 8454 end-each 8455 end-each 8456 dismiss-all-dialogs 8457 gc-run 8458 "10-args" check-args-progress-info 8459 fewer-args each to arg1 8460 fewer-args each to arg2 8461 fewer-args each to arg3 8462 fewer-args each to arg4 8463 fewer-args each to arg5 8464 fewer-args each to arg6 8465 fewer-args each to arg7 8466 fewer-args each to arg8 8467 fewer-args each to arg9 8468 fewer-args each to arg0 8469 procs10 each to prc 8470 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 arg0 8471 prc #t nil fth-catch 8472 to tag 8473 stack-reset 8474 tag car 'wrong-number-of-args = if 8475 "procs10: (%s %s %s %s %s %s %s %s %s %s) %s %s" 8476 #( arg1 arg2 arg3 arg4 arg5 arg6 arg7 8477 arg8 arg9 arg0 prc tag ) snd-display 8478 then 8479 end-each 8480 end-each 8481 end-each 8482 end-each 8483 end-each 8484 end-each 8485 end-each 8486 end-each 8487 end-each 8488 end-each 8489 end-each 8490 dismiss-all-dialogs 8491 gc-run 8492 #f set-ask-about-unsaved-edits drop 8493; 8494 8495: 30-test 8496 \ from clm-ins.fs 8497 <'> test23-balance 8498 :comment over object->string 8499 :srate 22050 8500 :channels 3 with-sound ws-output 0 find-sound { ind } 8501 ind sound? if 8502 ind close-sound drop 8503 else 8504 "with-sound balance?" snd-display 8505 then 8506 \ 0.0 0.3 <'> clm-ins-test 8507 \ :comment over object->string 8508 \ :notehook *snd-test-ws-verbose* if <'> test23-notehook else #f then 8509 \ :channels 2 with-sound ws-test-close-sound 8510; 8511 8512let: ( -- ) 8513 #() { numbs } 8514 script-arg 0> if 8515 script-args length script-arg 1+ ?do 8516 script-args i list-ref string->number { n } 8517 script-arg 1+ set-script-arg drop 8518 n 0< if 8519 numbs n array-push to numbs \ negative number means exclude this test 8520 else 8521 test-numbers n array-push to test-numbers 8522 then 8523 loop 8524 then 8525 test-numbers empty? if 8526 29 -1 do 8527 test-numbers i array-push to test-numbers 8528 loop 8529 then 8530 numbs each abs { n } 8531 test-numbers test-numbers n array-index array-delete! drop 8532 end-each 8533 .stack 8534 start-snd-test 8535 <'> 00-constants run-fth-test 8536 <'> 01-defaults run-fth-test 8537 mus-ldouble set-default-output-sample-type drop 8538 <'> 02-headers run-fth-test 8539 <'> 03-variables run-fth-test 8540 <'> 04-sndlib run-fth-test 8541 <'> 05-simple-check run-fth-test 8542 <'> 08-clm run-fth-test 8543 <'> 10-marks run-fth-test 8544 <'> 15-chan-local-vars run-fth-test 8545 <'> 19-save/restore run-fth-test 8546 <'> 23-with-sound run-fth-test 8547 <'> 27-sel-from-snd run-fth-test 8548 <'> 28-errors run-fth-test 8549 <'> 30-test run-fth-test \ local fragment test 8550 finish-snd-test 8551 0 snd-exit drop 8552;let 8553 8554\ snd-test.fs ends here 8555