1\ effects.fs -- *effects*.scm -> effects.fs 2 3\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net> 4\ Created: 05/10/16 23:04:30 5\ Changed: 20/09/13 13:34:39 6\ 7\ @(#)effects.fs 1.63 9/13/20 8 9\ General (nogui/motif) 10\ 11\ effects-squelch-channel ( amount gate-size :optional snd chn -- ) 12\ effects-echo ( is dtime eamt :optional beg dur snd chn -- ) 13\ effects-flecho ( scl secs ismps :optional beg dur snd chn -- ) 14\ effects-zecho ( scl secs freq amp ismps :optional ... -- ) 15\ effects-bbp ( freq bw :optional beg dur snd chn -- res ) 16\ effects-bbr ( freq bw :optional beg dur snd chn -- res ) 17\ effects-bhp ( freq :optional beg dur snd chn -- res ) 18\ effects-blp ( freq :optional beg dur snd chn -- res ) 19\ effects-comb-filter ( scl size :optional beg dur snd chn -- res ) 20\ effects-comb-chord ( scl si amp :optional beg dur snd chn -- res ) 21\ effects-moog ( freq Q :optional beg dur snd chn -- res ) 22\ moog ( freq Q -- prc; inval self -- res ) 23\ effects-am ( freq en :optional beg dur snd chn -- res ) 24\ effects-rm ( freq en :optional beg dur snd chn -- res ) 25\ effects-jc-reverb ( samps volume -- prc; inval self -- res ) 26\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res ) 27\ effects-cnv ( snd0 amp snd chn -- res ) 28\ effects-position-sound ( mono-snd pos :optional snd chn -- res ) 29\ effects-place-sound ( mono-snd stereo-snd pan-env -- res ) 30\ effects-flange ( at spd ti :optional beg dur snd chn -- res ) 31\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res ) 32\ effects-cross-synthesis-1 ( csnd amp fftsize r :optional beg dur ... -- ) 33\ effects-fp ( sf amp frq :optional beg dur snd chn -- vct ) 34\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res ) 35\ effects-remove-clicks ( :optional snd chn -- res ) 36\ effects-remove-dc ( :optional snd chn -- res ) 37\ effects-compand ( :optional snd chn -- res ) 38\ 39\ Motif specific 40\ 41\ Requires --with-motif 42\ 43\ Tested with Snd 20.x 44\ Fth 1.4.x 45\ Motif 2.3.3 X11R6 46\ 47\ make-menu ( name parent -- gen ) 48\ menu-entry ( gen prc disp-prc -- ) 49\ make-main-menu ( name -- widget ) 50\ add-to-effects-menu ( name prc -- ) 51\ 52\ make-gain-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 53\ make-normalize-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 54\ make-gate-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 55\ 56\ make-echo-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 57\ make-flecho-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 58\ make-zecho-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 59\ 60\ make-band-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 61\ make-notch-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 62\ make-high-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 63\ make-low-pass-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 64\ make-comb-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 65\ make-comb-chord-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 66\ make-moog-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 67\ 68\ make-adsat-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 69\ make-src-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 70\ make-expsrc-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 71\ make-src-timevar-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 72\ 73\ make-am-effect-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 74\ make-rm-effect-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 75\ 76\ make-reverb-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 77\ make-jc-reverb-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 78\ make-convolve-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 79\ 80\ make-place-sound-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 81\ make-silence-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 82\ make-contrast-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 83\ make-cross-synth-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 84\ make-flange-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 85\ make-random-phase-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 86\ make-robotize-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 87\ make-rubber-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 88\ make-wobble-dialog ( name -- pc1 pc2; child self -- prc; self -- ) 89\ 90\ make-effects-menu ( -- ) 91\ init-effects-menu ( -- ) 92 93require clm 94require examp 95require env 96require dsp 97 98-1 value effects-menu \ for prefs 99#f value use-combo-box-for-fft-size 100 101\ effects-squelch-channel ( amount gate-size :optional snd chn -- ) 102 103hide 104: squelch-cb { f0 f1 amount -- prc; y self -- val } 105 1 proc-create amount , f1 , f0 , ( prc ) 106 does> { y self -- val } 107 self @ { amp } 108 self 1 cells + @ { f1 } 109 self 2 cells + @ { f0 } 110 f1 f0 y y f* moving-average amp f< if 111 0.0 112 else 113 1.0 114 then moving-average y f* 115; 116set-current 117 118: effects-squelch-channel <{ amount gate-size :optional snd #f chn #f -- val }> 119 :size gate-size make-moving-average { f0 } 120 :size gate-size :initial-element 1.0 make-moving-average { f1 } 121 "%s %s %s" #( amount gate-size get-func-name ) string-format { origin } 122 f0 f1 amount squelch-cb 0 #f snd chn #f origin map-channel 123; 124previous 125 126\ effects-echo ( in-samps delay-time echo-amount :optional beg dur snd chn -- ) 127\ effects-flecho ( scl secs input-samps :optional beg dur snd chn -- ) 128\ effects-zecho ( scl secs freq amp input-samps :optional beg dur snd chn -- ) 129 130hide 131: effects-echo-cb { samps amp del -- prc; inval self -- res } 132 1 proc-create 0 , del , amp , samps , ( prc ) 133 does> { inval self -- res } 134 self @ 1+ dup self ! { samp } 135 self cell+ @ { del } 136 self 2 cells + @ { amp } 137 self 3 cells + @ { samps } 138 del dup 0.0 tap samp samps <= if 139 inval f+ 140 then amp f* 0.0 delay inval f+ 141; 142 143: effects-flecho-cb ( amp samps flt del -- prc; inval self -- res ) 144 { amp samps flt del } 145 1 proc-create 0 , samps , flt , del , amp , ( prc ) 146 does> { inval self -- res } 147 self @ 1+ dup self ! { samp } 148 self cell+ @ { samps } 149 self 2 cells + @ { flt } 150 self 3 cells + @ { del } 151 self 4 cells + @ { scl } 152 del flt del 0.0 tap samp samps <= if 153 inval f+ 154 then scl f* fir-filter delay inval f+ 155; 156 157: effects-zecho-cb ( scaler amp samps os del -- prc; inval self -- res ) 158 { scaler amp samps os del } 159 1 proc-create 0 , samps , os , del , scaler , amp , ( prc ) 160 does> { inval self -- res } 161 self @ 1+ dup self ! { samp } 162 self cell+ @ { samps } 163 self 2 cells + @ { os } 164 self 3 cells + @ { del } 165 self 4 cells + @ { scl } 166 self 5 cells + @ { amp } 167 del 168 del 0.0 tap samp samps <= if 169 inval f+ 170 then scl f* 171 os 0.0 0.0 oscil amp f* 172 delay inval f+ 173; 174set-current 175 176: effects-echo 177 <{ input-samps del-time amp :optional beg 0 dur #f snd #f chn #f -- res }> 178 del-time snd srate f* fround->s make-delay { del } 179 input-samps number? if 180 input-samps 181 else 182 dur number? if 183 dur 184 else 185 snd chn undef framples 186 then 187 then { samps } 188 "%s %s %s %s %s %s" #( input-samps del-time amp beg dur get-func-name ) 189 string-format { orig } 190 samps amp del effects-echo-cb beg dur snd chn #f orig map-channel 191; 192 193: effects-flecho 194 <{ amp secs input-samps :optional beg 0 dur #f snd #f chn #f -- res }> 195 :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt } 196 secs snd srate f* fround->s make-delay { del } 197 input-samps number? if 198 input-samps 199 else 200 dur number? if 201 dur 202 else 203 snd chn undef framples 204 then 205 then { samps } 206 "%s %s %s %s %s %s" #( amp secs input-samps beg dur get-func-name ) 207 string-format { origin } 208 amp samps flt del effects-flecho-cb beg dur snd chn #f origin 209 map-channel 210; 211 212: effects-zecho 213 <{ scl secs freq amp input-samps :optional beg 0 dur #f snd #f chn #f -- r }> 214 freq make-oscil { os } 215 secs snd srate f* fround->s { len } 216 :size len :max-size len amp f>s 1 + + make-delay { del } 217 input-samps number? if 218 input-samps 219 else 220 dur number? if 221 dur 222 else 223 snd chn undef framples 224 then 225 then { samps } 226 "%s %s %s %s %s %s %s %s" 227 #( scl secs freq amp input-samps beg dur get-func-name ) 228 string-format { origin } 229 scl amp samps os del effects-zecho-cb beg dur snd chn #f origin 230 map-channel 231; 232previous 233 234\ effects-bbp ( freq bw :optional beg dur snd chn -- res ) 235\ effects-bbr ( freq bw :optional beg dur snd chn -- res ) 236\ effects-bhp ( freq :optional beg dur snd chn -- res ) 237\ effects-blp ( freq :optional beg dur snd chn -- res ) 238\ effects-comb-filter ( scl size :optional beg dur snd chn -- res ) 239\ effects-comb-chord ( scl size amp :optional beg dur snd chn -- res ) 240 241: effects-bbp <{ freq bw :optional beg 0 dur #f snd #f chn #f -- res }> 242 "%s %s %s %s %s" #( freq bw beg dur get-func-name ) 243 string-format { origin } 244 freq bw make-butter-band-pass beg dur snd chn #f #f origin clm-channel 245; 246 247: effects-bbr <{ freq bw :optional beg 0 dur #f snd #f chn #f -- res }> 248 "%s %s %s %s %s" #( freq bw beg dur get-func-name ) 249 string-format { origin } 250 freq bw make-butter-band-reject beg dur snd chn #f #f origin clm-channel 251; 252 253: effects-bhp <{ freq :optional beg 0 dur #f snd #f chn #f -- res }> 254 "%s %s %s %s" #( freq beg dur get-func-name ) string-format { origin } 255 freq make-butter-high-pass beg dur snd chn #f #f origin clm-channel 256; 257 258: effects-blp <{ freq :optional beg 0 dur #f snd #f chn #f -- res }> 259 "%s %s %s %s" #( freq beg dur get-func-name ) string-format { origin } 260 freq make-butter-low-pass beg dur snd chn #f #f origin clm-channel 261; 262 263: effects-comb-filter <{ scl size :optional beg 0 dur #f snd #f chn #f -- res }> 264 "%s %s %s %s %s" #( scl size beg dur get-func-name ) 265 string-format { origin } 266 scl size comb-filter beg dur snd chn #f origin map-channel 267; 268 269: effects-comb-chord 270 <{ scl size amp :optional beg 0 dur #f snd #f chn #f -- res }> 271 "%s %s %s %s %s %s" #( scl size amp beg dur get-func-name ) 272 string-format { origin } 273 scl size amp comb-chord beg dur snd chn #f origin map-channel 274; 275 276\ effects-moog ( freq Q :optional beg dur snd chn -- res ) 277 278hide 279: moog-cb ( gen -- prc; inval self -- res ) 280 1 proc-create swap , ( prc ) 281 does> { inval self -- res } 282 self @ ( gen ) inval moog-filter 283; 284set-current 285 286: effects-moog <{ freq Q :optional beg 0 dur #f snd #f chn #f -- res }> 287 "%s %s %s %s %s" #( freq Q beg dur get-func-name ) 288 string-format { origin } 289 freq Q make-moog-filter moog-cb beg dur snd chn #f origin map-channel 290; 291previous 292 293\ moog ( freq Q -- prc; inval self -- res ) 294 295: moog ( freq Q -- prc; inval self -- res ) 296 make-moog-filter { gen } 297 1 proc-create gen , ( prc ) 298 does> { inval self -- res } 299 self @ ( gen ) inval moog-filter 300; 301 302\ effects-am ( freq en :optional beg dur snd chn -- res ) 303\ effects-rm ( freq en :optional beg dur snd chn -- res ) 304 305hide 306: effects-am-env-cb { os e -- prc; x self -- res } 307 1 proc-create e , os , ( prc ) 308 does> { inval self -- res } 309 self @ { e } 310 self cell+ @ { os } 311 1.0 inval e env os 0.0 0.0 oscil f* amplitude-modulate 312; 313 314: effects-am-cb ( os -- prc; x self -- res ) 315 1 proc-create swap , ( prc ) 316 does> { inval self -- res } 317 self @ { os } 318 os 0.0 0.0 oscil inval f* 319; 320 321: effects-rm-env-cb { os e -- prc; x self -- res } 322 1 proc-create e , os , ( prc ) 323 does> { inval self -- res } 324 self @ { e } 325 self cell+ @ { os } 326 os 0.0 0.0 oscil e env f* inval f* 327; 328 329: effects-rm-cb ( os -- prc; x self -- res ) 330 1 proc-create swap , ( prc ) 331 does> { inval self -- res } 332 self @ { os } 333 1.0 inval os 0.0 0.0 oscil amplitude-modulate 334; 335set-current 336 337: effects-am <{ freq en :optional beg 0 dur #f snd #f chn #f -- res }> 338 freq make-oscil { os } 339 en array? if 340 :envelope en :length dur 1- make-env 341 else 342 #f 343 then { e } 344 "%s %s %s %s %s" #( freq en beg dur get-func-name ) 345 string-format { origin } 346 e if 347 os e effects-am-env-cb 348 else 349 os effects-am-cb 350 then beg dur snd chn #f origin map-channel 351; 352 353: effects-rm <{ freq en :optional beg 0 dur #f snd #f chn #f -- res }> 354 freq make-oscil { os } 355 en array? if 356 :envelope en :length dur 1- make-env 357 else 358 #f 359 then { e } 360 "%s %s %s %s %s" #( freq en beg dur get-func-name ) 361 string-format { origin } 362 e if 363 os e effects-rm-env-cb 364 else 365 os effects-rm-cb 366 then beg dur snd chn #f origin map-channel 367; 368previous 369 370\ effects-jc-reverb ( samps volume -- prc; inval self -- res ) 371\ effects-jc-reverb-1 ( volume :optional beg dur snd chn -- res ) 372 373: effects-jc-reverb ( samps volume -- prc; inval self -- res ) 374 { samps vol } 375 -0.7 0.7 1051 make-all-pass { all1 } 376 -0.7 0.7 337 make-all-pass { all2 } 377 -0.7 0.7 113 make-all-pass { all3 } 378 0.742 4799 make-comb { c1 } 379 0.733 4999 make-comb { c2 } 380 0.715 5399 make-comb { c3 } 381 0.697 5801 make-comb { c4 } 382 #f srate 0.013 f* fround->s make-delay { outdel } 383 1 proc-create 384 0 ( samp ), 385 samps , 386 vol , 387 0.0 ( comb-sum ) , 388 0.0 ( comb-sum-1 ) , 389 0.0 ( comb-sum-2 ) , 390 all1 , all2 , all3 , 391 c1 , c2 , c3 , c4 , 392 outdel , ( prc ) 393 does> { inval self -- res } 394 self @ ( samp++ ) 1+ self ! 395 self @ { samp } 396 self 1 cells + @ { samps } 397 self 2 cells + @ { volume } 398 self 3 cells + @ { comb-sum } 399 self 4 cells + @ { comb-sum-1 } 400 self 5 cells + @ { comb-sum-2 } 401 self 6 cells + @ { allpass1 } 402 self 7 cells + @ { allpass2 } 403 self 8 cells + @ { allpass3 } 404 self 9 cells + @ { comb1 } 405 self 10 cells + @ { comb2 } 406 self 11 cells + @ { comb3 } 407 self 12 cells + @ { comb4 } 408 self 13 cells + @ { outdel } 409 allpass3 allpass2 allpass1 410 samp samps <= if 411 inval 412 else 413 0.0 414 then 0.0 all-pass 0.0 all-pass 0.0 all-pass { allpass-sum } 415 comb-sum-1 self 5 cells + ! ( comb-sum-2 ) 416 comb-sum self 4 cells + ! ( comb-sum-1 ) 417 comb1 allpass-sum 0.0 comb 418 comb2 allpass-sum 0.0 comb f+ 419 comb3 allpass-sum 0.0 comb f+ 420 comb4 allpass-sum 0.0 comb f+ self 3 cells + ! ( comb-sum ) 421 outdel comb-sum 0.0 delay volume f* inval f+ 422; 423 424: effects-jc-reverb-1 <{ vol :optional beg 0 dur #f snd #f chn #f -- res }> 425 dur if 426 dur 427 else 428 snd chn #f framples 429 then { samps } 430 "%s %s %s %s" #( vol beg dur get-func-name ) string-format { origin } 431 samps vol effects-jc-reverb beg dur snd chn #f origin map-channel 432; 433 434\ effects-cnv ( snd0 amp snd chn -- res ) 435 436hide 437: cnv-cb ( sf -- prc; dir self -- res ) 438 1 proc-create swap , ( prc ) 439 does> { dir self -- res } 440 self @ ( sf ) next-sample 441; 442set-current 443 444: effects-cnv <{ snd0 amp :optional snd #f chn #f -- res }> 445 snd0 sound? unless 446 sounds 0 array-ref to snd0 447 then 448 snd0 #f #f framples { flt-len } 449 snd chn #f framples flt-len + { total-len } 450 :filter 0 flt-len snd0 #f #f channel->vct make-convolve { cnv } 451 0 snd chn 1 #f make-sampler { sf } 452 sf cnv-cb { cnv-func } 453 total-len 0.0 make-vct map! 454 cnv cnv-func convolve 455 end-map { out-data } 456 sf free-sampler drop 457 out-data amp vct-scale! drop 458 out-data vct-peak { max-samp } 459 out-data 0 total-len snd chn #f 460 "%s %s %s" #( snd0 amp get-func-name ) string-format 461 vct->channel drop 462 max-samp 1.0 f> if 463 #( max-samp fnegate max-samp ) snd chn set-y-bounds drop 464 then 465 max-samp 466; 467previous 468 469\ effects-position-sound ( mono-snd pos :optional snd chn -- res ) 470\ effects-place-sound ( mono-snd stereo-snd pan-env -- res ) 471 472hide 473: numb-cb { rd pos -- prc; y self -- res } 474 1 proc-create pos , rd , ( prc ) 475 does> { y self -- res } 476 self cell+ @ ( rd ) read-sample self @ ( pos ) f* y f+ 477; 478 479: env-numb-cb { rd en -- prc; y self -- res } 480 1 proc-create en , rd , ( prc ) 481 does> { y self -- res } 482 self cell+ @ ( rd ) read-sample self @ ( en ) env f* y f+ 483; 484 485: env-cb { rd en -- prc; y self -- res } 486 1 proc-create en , rd , ( prc ) 487 does> { y self -- res } 488 self cell+ @ ( rd ) read-sample 1.0 self @ ( en ) env f- f* y f+ 489; 490set-current 491 492: effects-position-sound <{ mono pos :optional snd #f chn #f -- res }> 493 mono #f #f framples { len } 494 0 mono #f 1 #f make-sampler { rd } 495 "%s %s %s" #( mono pos get-func-name ) string-format { origin } 496 pos number? if 497 rd pos numb-cb 0 len snd chn #f origin map-channel 498 else 499 :envelope pos :length len 1- make-env { e } 500 chn integer? 501 chn 1 = && if 502 rd e env-numb-cb 0 len snd chn #f origin map-channel 503 else 504 rd e env-cb 0 len snd chn #f origin map-channel 505 then 506 then 507; 508 509: effects-place-sound ( mono stereo pan -- res ) 510 doc" Mixes a mono sound into a stereo sound, \ 511splitting it into two copies whose amplitudes depend on the envelope PAN-ENV. \ 512If PAN-ENV is a number, the sound is split such that 0 is all in channel 0 \ 513and 90 is all in channel 1." 514 { mono stereo pan } 515 pan number? if 516 pan 90.0 f/ { pos } 517 mono pos stereo 1 effects-position-sound drop 518 mono 1.0 pos f- stereo 0 effects-position-sound 519 else 520 mono pan stereo 1 effects-position-sound drop 521 mono pan stereo 0 effects-position-sound 522 then 523; 524previous 525 526\ effects-flange ( amount speed time :optional beg dur snd chn -- res ) 527 528hide 529: flange-cb { ri del -- prc; inval self -- res } 530 1 proc-create del , ri , ( prc ) 531 does> { inval self -- res } 532 self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp 533 delay inval f+ 0.75 f* 534; 535set-current 536 537: effects-flange 538 <{ amnt speed time :optional beg 0 dur #f snd #f chn #f -- res}> 539 :frequency speed :amplitude amnt make-rand-interp { ri } 540 time snd srate f* fround->s { len } 541 :size len :max-size amnt f>s len 1 + + make-delay { del } 542 "%s %s %s %s %s %s" 543 #( amnt speed time beg 544 dur number? 545 snd chn #f framples dur <> && if 546 dur 547 else 548 #f 549 then get-func-name ) string-format { origin } 550 ri del flange-cb beg dur snd chn #f origin map-channel 551; 552previous 553 554\ effects-cross-synthesis ( snd amp fftsize r -- prc; inval self -- res ) 555\ effects-cross-synthesis-1 ( snd amp fft r :optional beg dur snd chn -- res ) 556 557\ cross-synthesis from examp.fs 558<'> cross-synthesis 559 alias effects-cross-synthesis ( snd amp fftsize r -- prc; y self -- res ) 560 561: effects-cross-synthesis-1 562 <{ csnd amp fftsize r :optional beg 0 dur #f snd #f chn #f -- res }> 563 { csnd amp fftsize r beg dur snd chn } 564 "%s %s %s %s %s %s %s" #( csnd amp fftsize r beg dur get-func-name ) 565 string-format { origin } 566 csnd sound? unless 567 sounds 0 array-ref to csnd 568 then 569 csnd amp fftsize r effects-cross-synthesis beg dur snd chn #f origin 570 map-channel 571; 572 573\ effects-fp ( srf amp freq :optional beg dur snd chn -- vct ) 574 575hide 576: src-fp-read-cb ( sf -- prc; dir self -- samp ) 577 1 proc-create swap , ( prc ) 578 does> { dir self -- samp } 579 self @ ( sf ) dir 0> if 580 next-sample 581 else 582 previous-sample 583 then 584; 585set-current 586 587: effects-fp <{ srf amp freq :optional beg 0 dur #f snd #f chn #f -- vct }> 588 freq make-oscil { os } 589 :srate srf make-src { sr } 590 beg snd chn 1 #f make-sampler { sf } 591 dur if 592 dur 593 else 594 snd chn #f framples 595 then { len } 596 sf src-fp-read-cb { src-cb } 597 len 0.0 make-vct map! 598 sr os 0.0 0.0 oscil amp f* src-cb src 599 end-map ( out-data ) beg len snd chn #f 600 "%s %s %s %s %s %s" #( srf amp freq beg dur get-func-name ) 601 string-format vct->channel 602; 603previous 604 605\ effects-hello-dentist ( freq amp :optional beg dur snd chn -- res ) 606 607hide 608: hello-src-cb { in-data idx -- prc; dir self -- samp } 609 1 proc-create idx , in-data , ( prc ) 610 does> { dir self -- samp } 611 self @ { idx } 612 self cell+ @ { in-data } 613 in-data idx range? if 614 in-data idx vct-ref 615 else 616 0.0 617 then ( val ) 618 idx dir + self ! ( idx ) 619; 620set-current 621 622: effects-hello-dentist 623 <{ freq amp :optional beg 0 dur #f snd #f chn #f -- res }> 624 :frequency freq :amplitude amp make-rand-interp { rn } 625 0 { idx } 626 dur if 627 dur 628 else 629 snd chn #f framples 630 then { len } 631 beg len snd chn #f channel->vct { in-data } 632 amp f2* 1.0 f+ len f* fround->s ( out-len ) 0.0 make-vct { out-data } 633 :srate 1.0 :input in-data idx hello-src-cb make-src { rd } 634 out-data map! 635 idx len = ?leave 636 rd rn 0.0 rand-interp #f src 637 end-map to out-data 638 "%s %s %s %s %s" #( freq amp beg dur get-func-name ) 639 string-format { origin } 640 out-data beg out-data vct-length snd chn #f origin vct->channel 641; 642previous 643 644\ effects-remove-clicks ( :optional snd chn -- res ) 645\ effects-remove-dc ( :optional snd chn -- res ) 646\ effects-compand ( :optional snd chn -- res ) 647 648hide 649: find-click { loc snd chn -- pos|#f } 650 loc snd chn 1 #f make-sampler { rd } 651 0.0 0.0 0.0 { samp0 samp1 samp2 } 652 10 0.0 make-vct { samps } 653 #f \ flag 654 snd chn #f framples loc ?do 655 samp1 to samp0 656 samp2 to samp1 657 rd next-sample to samp2 658 samps samp0 cycle-set! 659 samps vct-peak 0.1 fmax { local-max } 660 samp0 samp1 f- fabs local-max f> 661 samp1 samp2 f- fabs local-max f> && 662 samp0 samp2 f- fabs local-max f2/ f< && if 663 drop ( flag ) i leave 664 then 665 loop 666; 667 668: remove-click { loc snd chn -- } 669 loc snd chn find-click { click } 670 click if 671 click 2 - 4 snd chn smooth-sound drop 672 click 2 + snd chn recurse 673 then 674; 675 676: effects-remove-dc-cb ( -- prc; inval self -- res ) 677 1 proc-create 0.0 ( lastx ) , 0.0 ( lasty ) , ( prc ) 678 does> { inval self -- res } 679 self @ { lastx } 680 self cell+ @ { lasty } 681 0.999 lasty f* lastx f- inval f+ self cell+ ! ( lasty ) 682 inval self ! ( lastx ) 683 self cell+ @ ( lasty ) 684; 685 686: effects-compand-cb ( tbl -- prc; inval self -- res ) 687 1 proc-create swap , ( prc ) 688 does> { inval self -- res } 689 self @ { tbl } 690 tbl inval 8.0 f* 8.0 f+ tbl length array-interp 691; 692set-current 693 694: effects-remove-clicks <{ :optional snd #f chn #f -- res }> 695 0 snd chn remove-click 696 #f 697; 698 699: effects-remove-dc <{ :optional snd #f chn #f -- res }> 700 effects-remove-dc-cb 0 #f snd chn #f get-func-name map-channel 701; 702 703: effects-compand <{ :optional snd #f chn #f -- res }> 704 vct( -1.000 -0.960 -0.900 -0.820 -0.720 -0.600 -0.450 -0.250 705 0.000 0.250 0.450 0.600 0.720 0.820 0.900 0.960 1.000 ) { tbl } 706 tbl effects-compand-cb 0 #f snd chn #f get-func-name map-channel 707; 708previous 709 710'snd-nogui provided? [if] skip-file [then] 711 712require xm-enved 713require snd-xm 714require rubber 715 716\ === SND MENU === 717 718hide 719#( "menu-children" 720 "menu-parent" 721 "menu-name" 722 "menu-menu" 723 "menu-cascade" 724 "menu-display-cb" ) create-struct make-snd-menu-struct 725 726: menu-display ( gen -- ) 727 menu-display-cb@ #() run-proc drop 728; 729 730#( "eff_label" 731 "eff_dialog" 732 "eff_target" 733 "eff_target_widget" 734 "eff_trunc" 735 "eff_sliders" 736 "eff_scl" 737 "eff_freq" 738 "eff_amp" 739 "eff_delay" 740 "eff_amnt" 741 "eff_enved" 742 "eff_size" 743 "eff_omit_silence" 744 "eff_bp_bw" 745 "eff_notch_bw" 746 "eff_moog_reson" 747 "eff_time_scale" 748 "eff_hop_size" 749 "eff_ramp_scl" 750 "eff_pitch_scl" 751 "eff_seg_len" 752 "eff_rev_filter" 753 "eff_rev_fb" 754 "eff_rev_decay" 755 "eff_rev_vol" 756 "eff_conv_one" 757 "eff_conv_two" 758 "eff_m_snd" 759 "eff_s_snd" 760 "eff_pan_pos" 761 "eff_cs_snd" 762 "eff_cs_radius" 763 "eff_cs_wid" 764 "eff_fl_speed" 765 "eff_fl_time" 766 "eff_sr" 767 "eff_factor" ) create-struct make-effects-menu-struct 768set-current 769 770: make-base-effects { label -- gen } 771 make-effects-menu-struct { gen } 772 gen label eff_label! 773 gen #f eff_dialog! 774 gen 'sound eff_target! 775 gen #t eff_trunc! 776 gen #f eff_sliders! 777 gen 778; 779 780<'> noop 0 make-proc constant effects-noop 781 782"Go Away" constant eff-dismiss-string 783"Help" constant eff-help-string 784"DoIt" constant eff-okay-string 785"Reset" constant eff-reset-string 786 787\ log scaler widget 788 789500.0 constant log-scale-ticks 790 791: scale-log->linear ( lo val hi -- lin ) 792 { lo val hi } 793 2.0 flog { log2 } 794 lo 1.0 fmax flog log2 f/ { log-lo } 795 hi flog log2 f/ { log-hi } 796 val flog log2 f/ log-lo f- log-hi log-lo f- f/ log-scale-ticks 797 f* floor->s 798; 799 800: scale-linear->log ( lo val hi -- log ) 801 { lo val hi } 802 2.0 flog { log2 } 803 lo 1.0 fmax flog log2 f/ { log-lo } 804 hi flog log2 f/ { log-hi } 805 2.0 log-lo val log-scale-ticks f/ log-hi log-lo f- f* f+ f** 806; 807 808: scale-log-label ( lo val hi -- str ) 809 scale-linear->log "%.2f" swap 1 >array string-format 810; 811 812\ semitone scaler widget 813 81424 value semi-range 815 816: semi-scale-label ( val -- str ) 817 "semitones: %s" swap semi-range - 1 >array string-format 818; 819 820: semitones->ratio ( val -- r ) 821 2.0 swap 12.0 f/ f** 822; 823 824: ratio->semitones ( ratio -- n ) 825 12.0 swap flog 2.0 flog f/ f* fround->s 826; 827 828: marks-sort ( a b -- -1|0|1 ) 829 { a b } 830 a b < if 831 -1 832 else 833 a b = if 834 0 835 else 836 1 837 then 838 then 839; 840 841\ returns a list of points 842: plausible-mark-samples ( -- pts ) 843 selected-sound { snd } 844 snd selected-channel { chn } 845 #() { ms } 846 snd chn #f marks each 847 undef mark-sample ms swap array-push drop 848 end-each 849 ms length 2 < if 850 #f 851 else 852 ms <'> marks-sort array-sort! drop 853 ms length 2 = if 854 ms array->array 855 else 856 snd chn left-sample { lw } 857 snd chn right-sample { rw } 858 snd chn undef cursor { cw } 859 cw lw >= 860 cw rw <= && if 861 cw 862 else 863 lw rw + 2/ 864 then { favor } 865 #( ms first-ref ms second-ref ) { res } 866 ms each { p1 } 867 i ms length 2 - = if 868 #( p1 ms last-ref ) to res 869 leave 870 then 871 ms i 1+ array-ref { p2 } 872 ms i 2 + array-ref { p3 } 873 p1 favor - abs p3 favor - abs < if 874 #( p1 p2 ) to res 875 leave 876 then 877 end-each 878 res 879 then 880 then 881; 882 883: effect-frames { target -- frms } 884 target 'sound = if 885 #f #f #f framples 1- 886 else 887 target 'selection = if 888 #f #f selection-framples 889 else 890 plausible-mark-samples { pts } 891 pts if 892 pts 0 array-ref pts 1 nil array-subarray each 893 - 894 end-each abs 1+ 895 else 896 0 897 then 898 then 899 then 900; 901 902: effect-target-ok <{ target -- f }> 903 sounds empty? if 904 #f 905 else 906 target 'sound = if 907 #t 908 else 909 target 'selection = if 910 undef selection? 911 else 912 target 'marks = if 913 selected-sound dup 914 selected-channel #f marks length 2 >= 915 else 916 #f 917 then 918 then 919 then 920 then 921; 922 923: general-target-cb ( gen -- prc; self -- f ) 924 0 proc-create swap , ( prc ) 925 does> { self -- f } 926 self @ ( gen ) eff_target@ effect-target-ok 927; 928 929: set-default-target-cb { okay-button -- prc; self -- } 930 0 proc-create okay-button , ( prc ) 931 does> { self -- } 932 self @ ( okay-button ) sounds empty? not set-sensitive 933; 934 935: set-target-cb { okay-button target-prc -- prc; self -- } 936 0 proc-create okay-button , target-prc , ( prc ) 937 does> { self -- } 938 self @ ( okay ) self cell+ @ ( target ) #() run-proc set-sensitive 939; 940 941: help-cb { label message -- prc; w c i self -- x } 942 3 proc-create label , message , ( prc ) 943 does> { w c info self -- x } 944 self @ ( label ) self cell+ @ ( message ) info-dialog 945; 946 947: target-cb ( gen -- prc; target self -- ) 948 1 proc-create swap , ( prc ) 949 does> { target self -- } 950 self @ { gen } 951 gen target eff_target! 952 gen eff_target_widget@ target effect-target-ok set-sensitive 953; 954 955: truncate-cb ( gen -- prc; trunc self -- ) 956 1 proc-create swap , ( prc ) 957 does> { trunc self } 958 self @ ( gen ) trunc eff_trunc! 959; 960 961: map-chan-over-target-with-sync { func target origin-func decay -- } 962 sounds empty? if 963 "no sound" undef status-report drop 964 else 965 target 'selection = 966 undef selection? not && if 967 "no selection" undef status-report drop 968 else 969 #f sync { snc } 970 target 'marks = if 971 plausible-mark-samples 972 else 973 #() 974 then { pts } 975 target 'sound = if 976 0 977 else 978 target 'selection = if 979 #f #f selection-position 980 else 981 pts 0 array-ref 982 then 983 then { beg } 984 decay number? if 985 #f srate decay f* fround->s 986 else 987 0 988 then { overlap } 989 snc 0> if 990 all-chans 991 else 992 #( #( selected-sound dup selected-channel ) ) 993 then each { lst } 994 lst 0 array-ref { snd } 995 lst 1 array-ref { chn } 996 snd sync snc = if 997 target 'sound = if 998 snd chn undef framples 1- 999 else 1000 target 'selection = if 1001 #f #f selection-position 1002 #f #f selection-framples 1003 + 1004 else 1005 pts 1 array-ref 1006 then 1007 then { end } 1008 end beg - { dur } 1009 origin-func #( target dur ) 1010 run-proc { name-and-orig } 1011 "%s %s %s %s" 1012 #( name-and-orig 0 array-ref 1013 beg 1014 target 'sound = if 1015 #f 1016 else 1017 dur 1+ 1018 then 1019 name-and-orig 1 array-ref ) 1020 string-format { origin } 1021 func dur run-proc beg end overlap + 1+ 1022 snd chn #f origin map-channel drop 1023 then 1024 end-each 1025 then 1026 then 1027; 1028 1029: cascade-cb <{ w c i -- }> 1030 c each 1031 #() run-proc drop 1032 end-each 1033; 1034 1035: make-menu { name parent -- gen } 1036 make-snd-menu-struct { gen } 1037 parent name #( FXmNbackground basic-color ) undef 1038 FXmCreatePulldownMenu { menu } 1039 #() { lst } 1040 parent name 1041 #( FXmNsubMenuId menu FXmNbackground basic-color ) 1042 FXmVaCreateManagedCascadeButton { cas } 1043 cas FXmNcascadingCallback <'> cascade-cb lst FXtAddCallback drop 1044 gen parent menu-parent! 1045 gen name menu-name! 1046 gen menu menu-menu! 1047 gen cas menu-cascade! 1048 gen lst menu-children! 1049 gen 1050; 1051 1052: menu-entry { gen prc disp-prc -- } 1053 gen menu-children@ { lst } 1054 lst array? lst 1 "an array" assert-type 1055 gen menu-menu@ gen menu-name@ 1056 #( FXmNbackground basic-color ) 1057 FXmVaCreateManagedPushButton { child } 1058 child FXmNactivateCallback prc undef FXtAddCallback drop 1059 lst disp-prc #( child ) run-proc array-push drop 1060; 1061 1062: unmanage-cb <{ w c i -- f }> 1063 c FXtUnmanageChild 1064; 1065 1066[undefined] F_XEditResCheckMessages [if] 1067 : F_XEditResCheckMessages <{ w c i f -- x }> #f ; 1068[then] 1069 1070: make-effect-dialog { label ok-prc help-prc reset-prc target-prc -- d } 1071 eff-dismiss-string FXmStringCreateLocalized { xdismiss } 1072 eff-help-string FXmStringCreateLocalized { xhelp } 1073 eff-okay-string FXmStringCreateLocalized { xok } 1074 label FXmStringCreateLocalized { titlestr } 1075 main-widgets 1 array-ref label 1076 #( FXmNcancelLabelString xdismiss 1077 FXmNhelpLabelString xhelp 1078 FXmNokLabelString xok 1079 FXmNautoUnmanage #f 1080 FXmNdialogTitle titlestr 1081 FXmNresizePolicy FXmRESIZE_GROW 1082 FXmNnoResize #f 1083 FXmNbackground basic-color 1084 FXmNtransient #f ) undef 1085 FXmCreateTemplateDialog { d } 1086 xhelp FXmStringFree drop 1087 xok FXmStringFree drop 1088 xdismiss FXmStringFree drop 1089 titlestr FXmStringFree drop 1090 d 0 #t <'> F_XEditResCheckMessages #f 1091 FXtAddEventHandler drop 1092 #( FXmDIALOG_HELP_BUTTON 1093 FXmDIALOG_CANCEL_BUTTON 1094 FXmDIALOG_OK_BUTTON ) each { button } 1095 d button FXmMessageBoxGetChild 1096 #( FXmNarmColor selection-color 1097 FXmNbackground highlight-color ) 1098 FXtVaSetValues drop 1099 end-each 1100 d FXmNcancelCallback <'> unmanage-cb d FXtAddCallback drop 1101 d FXmNhelpCallback help-prc undef FXtAddCallback drop 1102 d FXmNokCallback ok-prc undef FXtAddCallback drop 1103 reset-prc if 1104 d eff-reset-string 1105 #( FXmNbackground highlight-color 1106 FXmNforeground black-pixel 1107 FXmNarmColor selection-color ) 1108 FXmVaCreateManagedPushButton ( reset ) 1109 FXmNactivateCallback reset-prc undef FXtAddCallback drop 1110 then 1111 effects-hook d dialog-ok-widget target-prc ?dup-if 1112 set-target-cb 1113 else 1114 set-default-target-cb 1115 then add-hook! 1116 d 1117; 1118 1119: scale-log-cb <{ w c info -- }> 1120 c 0 array-ref { label } 1121 c 1 array-ref { low } 1122 c 2 array-ref { high } 1123 label low info Fvalue high scale-log-label change-label 1124; 1125 1126: create-log-scale-widget { parent title low init high cb -- scale } 1127 parent "%.2f" #( init ) string-format 1128 #( FXmNbackground basic-color ) 1129 FXmVaCreateManagedLabel { label } 1130 parent "scale" 1131 #( FXmNorientation FXmHORIZONTAL 1132 FXmNshowValue #f 1133 FXmNminimum 0 1134 FXmNmaximum log-scale-ticks f>s 1135 FXmNvalue low init high scale-log->linear 1136 FXmNdecimalPoints 0 1137 FXmNtitleString title 1138 FXmNbackground basic-color ) 1139 FXmVaCreateManagedScale { scale } 1140 #( label low high ) { data } 1141 scale FXmNvalueChangedCallback <'> scale-log-cb data 1142 FXtAddCallback drop 1143 scale FXmNvalueChangedCallback cb undef FXtAddCallback drop 1144 scale FXmNdragCallback <'> scale-log-cb data FXtAddCallback drop 1145 scale FXmNdragCallback cb undef FXtAddCallback drop 1146 scale 1147; 1148 1149: scale-semi-cb <{ w c info -- }> 1150 c info Fvalue semi-scale-label change-label 1151; 1152 1153: create-semi-scale-widget { parent title init cb -- scale } 1154 "semitones: %s" #( init ratio->semitones ) string-format { str } 1155 parent str 1156 #( FXmNbackground basic-color ) 1157 FXmVaCreateManagedLabel { label } 1158 parent "scale" 1159 #( FXmNorientation FXmHORIZONTAL 1160 FXmNshowValue #f 1161 FXmNminimum 0 1162 FXmNmaximum semi-range 2* 1163 FXmNvalue semi-range init ratio->semitones + 1164 FXmNdecimalPoints 0 1165 FXmNtitleString title 1166 FXmNbackground basic-color ) 1167 FXmVaCreateManagedScale { scale } 1168 scale FXmNvalueChangedCallback <'> scale-semi-cb label 1169 FXtAddCallback drop 1170 scale FXmNvalueChangedCallback cb undef FXtAddCallback drop 1171 scale FXmNdragCallback <'> scale-semi-cb label 1172 FXtAddCallback drop 1173 scale FXmNdragCallback cb undef FXtAddCallback drop 1174 scale 1175; 1176 1177\ sliders: #( #( label low init high func scale [log] ) ... ) 1178: add-sliders { dialog sliders -- sliders-array } 1179 dialog "formd" 1180 #( FXmNleftAttachment FXmATTACH_FORM 1181 FXmNrightAttachment FXmATTACH_FORM 1182 FXmNtopAttachment FXmATTACH_FORM 1183 FXmNbottomAttachment FXmATTACH_WIDGET 1184 FXmNbottomWidget 1185 dialog FXmDIALOG_SEPARATOR FXmMessageBoxGetChild 1186 FXmNbackground highlight-color ) 1187 FXmVaCreateManagedForm { mainfrm } 1188 mainfrm "rcd" 1189 #( FXmNleftAttachment FXmATTACH_FORM 1190 FXmNrightAttachment FXmATTACH_FORM 1191 FXmNbackground highlight-color 1192 FXmNorientation FXmVERTICAL ) 1193 FXmVaCreateManagedRowColumn { mainform } 1194 sliders map 1195 *key* 0 array-ref FXmStringCreateLocalized { title } 1196 *key* 1 array-ref { low } 1197 *key* 2 array-ref { init } 1198 *key* 3 array-ref { high } 1199 *key* 4 array-ref { func } 1200 *key* 5 array-ref { scale } 1201 *key* length 7 = if 1202 *key* 6 array-ref 'log = if 1203 mainform title low init high func 1204 create-log-scale-widget 1205 else 1206 mainform title init func 1207 create-semi-scale-widget 1208 then ( scale ) 1209 else 1210 mainform *key* 0 array-ref 1211 #( FXmNorientation FXmHORIZONTAL 1212 FXmNshowValue #t 1213 FXmNminimum low scale f* fround->s 1214 FXmNmaximum high scale f* fround->s 1215 FXmNvalue init scale f* fround->s 1216 FXmNdecimalPoints 1217 scale 10000 = if 1218 4 1219 else 1220 scale 1000 = if 1221 3 1222 else 1223 scale 100 = if 1224 2 1225 else 1226 scale 10 = if 1227 1 1228 else 1229 0 1230 then 1231 then 1232 then 1233 then 1234 FXmNtitleString title 1235 FXmNleftAttachment FXmATTACH_FORM 1236 FXmNrightAttachment FXmATTACH_FORM 1237 FXmNbackground basic-color ) 1238 FXmVaCreateManagedScale ( sc ) 1239 then { new-slider } 1240 title FXmStringFree drop 1241 new-slider FXmNvalueChangedCallback func undef 1242 FXtAddCallback drop 1243 new-slider 1244 end-map 1245; 1246 1247: color->pixel ( color-str "name" --; self -- pixel ) 1248 { color-str } 1249 create #f , color-str , 1250 does> { self -- pixel } 1251 self @ ( color ) unless 1252 main-widgets 1 array-ref { shell } 1253 shell FXtDisplay { dpy } 1254 dpy FDefaultScreen { scr } 1255 dpy scr FDefaultColormap { cmap } 1256 undef undef undef undef undef undef FXColor { col } 1257 dpy cmap 1258 self cell+ @ ( color-str ) 1259 col col FXAllocNamedColor 0= if 1260 "can't allocate color!" snd-error drop 1261 else 1262 col Fpixel self ! 1263 then 1264 then 1265 self @ ( color ) 1266; 1267 1268"yellow" color->pixel yellow-pixel 1269 1270\ c == #( prc type ) 1271: target-arm-cb <{ w c info -- f }> 1272 c 0 array-ref #( c 1 array-ref ) run-proc 1273; 1274 1275: target-truncate-cb <{ w c info -- f }> 1276 c #( info Fset ) run-proc 1277; 1278 1279: add-target-main { mainform target-prc truncate-prc -- rc-wid } 1280 mainform "sep" 1281 #( FXmNorientation FXmHORIZONTAL 1282 FXmNseparatorType FXmSHADOW_ETCHED_OUT 1283 FXmNbackground basic-color ) 1284 FXmVaCreateManagedSeparator drop 1285 mainform "rc" 1286 #( FXmNorientation FXmHORIZONTAL 1287 FXmNbackground basic-color 1288 FXmNradioBehavior #t 1289 FXmNradioAlwaysOne #t 1290 FXmNbottomAttachment FXmATTACH_FORM 1291 FXmNleftAttachment FXmATTACH_FORM 1292 FXmNrightAttachment FXmATTACH_FORM 1293 FXmNentryClass FxmToggleButtonWidgetClass 1294 FXmNisHomogeneous #t ) 1295 FXmVaCreateManagedRowColumn { rc } 1296 #( #( "entire sound" 'sound #t ) 1297 #( "selection" 'selection #f ) 1298 #( "between marks" 'marks #f ) ) each { lst } 1299 lst 0 array-ref { name } 1300 lst 1 array-ref { typ } 1301 lst 2 array-ref { on } 1302 rc name 1303 #( FXmNbackground basic-color 1304 FXmNselectColor yellow-pixel 1305 FXmNSet on 1306 FXmNindicatorType FXmONE_OF_MANY_ROUND 1307 FXmNarmCallback 1308 #( <'> target-arm-cb #( target-prc typ ) ) ) 1309 FXmVaCreateManagedToggleButton drop 1310 end-each 1311 truncate-prc if 1312 mainform "trsep" 1313 #( FXmNorientation FXmHORIZONTAL ) 1314 FXmVaCreateManagedSeparator drop 1315 mainform "truncate at end" 1316 #( FXmNbackground basic-color 1317 FXmNset #t 1318 FXmNselectColor yellow-pixel ) 1319 FXmVaCreateManagedToggleButton ( trbut ) 1320 FXmNvalueChangedCallback <'> target-truncate-cb 1321 truncate-prc FXtAddCallback drop 1322 then 1323 rc 1324; 1325 1326: add-target { gen truncate-prc -- } 1327 gen gen eff_dialog@ dialog-ok-widget eff_target_widget! 1328 gen eff_sliders@ 0 array-ref FXtParent { mainform } 1329 truncate-prc if 1330 gen truncate-prc to truncate-prc 1331 then 1332 mainform gen target-cb truncate-prc add-target-main drop 1333; 1334 1335: get-slider-value { w info corr -- val } 1336 info Fvalue corr f/ 1337; 1338 1339: set-slider-value { w val corr -- } 1340 w #( FXmNvalue val corr f* f>s ) FXtVaSetValues drop 1341; 1342 1343: make-main-menu ( name -- wid ) 1344 effects-noop add-to-main-menu dup to effects-menu main-menu 1345; 1346 1347: add-to-effects-menu ( name prc -- ) 1348 effects-menu -rot undef add-to-menu drop 1349; 1350previous 1351 1352hide 1353\ reusable callbacks 1354: amplitude-slider-cb ( gen -- prc; w c i self -- ) 1355 3 proc-create swap , ( prc ) 1356 does> { w c info self -- } 1357 w info 100.0 get-slider-value { val } 1358 self @ ( gen ) val eff_amp! 1359; 1360 1361: frequency-slider-cb ( gen -- prc; w c i self -- ) 1362 3 proc-create swap , ( prc ) 1363 does> { w c info self -- } 1364 w info 100.0 get-slider-value { val } 1365 self @ ( gen ) val eff_freq! 1366; 1367 1368: log-freq-slider-cb ( gen -- prc; w c i self -- ) 1369 3 proc-create swap , ( prc ) 1370 does> { w c info self -- } 1371 20.0 w info 1.0 get-slider-value 22050.0 scale-linear->log { val } 1372 self @ ( gen ) val eff_freq! 1373; 1374 1375: scaler-slider-cb ( gen -- prc; w c i self -- ) 1376 3 proc-create swap , ( prc ) 1377 does> { w c info self -- } 1378 w info 100.0 get-slider-value { val } 1379 self @ ( gen ) val eff_scl! 1380; 1381 1382: size-slider-cb ( gen -- prc; w c i self -- ) 1383 3 proc-create swap , ( prc ) 1384 does> { w c info self -- } 1385 w info 1.0 get-slider-value { val } 1386 self @ ( gen ) val eff_size! 1387; 1388 1389\ === Effects Entries === 1390 1391\ === AMPLITUDE EFFECTS === 1392 1393\ === Gain (gain set by gain-amount) === 1394 1395: make-enved-widget { gen -- } 1396 gen gen eff_dialog@ dialog-ok-widget eff_target_widget! 1397 gen eff_sliders@ 0 array-ref FXtParent FXtParent { mainform } 1398 mainform "fr" 1399 #( FXmNheight 200 1400 FXmNleftAttachment FXmATTACH_FORM 1401 FXmNrightAttachment FXmATTACH_FORM 1402 FXmNtopAttachment FXmATTACH_WIDGET 1403 FXmNtopWidget gen eff_sliders@ last-ref 1404 FXmNshadowThickness 4 1405 FXmNshadowType FXmSHADOW_ETCHED_OUT ) 1406 FXmVaCreateManagedFrame { fr } 1407 mainform gen target-cb #f add-target-main { target-row } 1408 gen eff_dialog@ activate-dialog 1409 gen eff_label@ string-downcase fr 1410 :envelope #( 0.0 1.0 1.0 1.0 ) 1411 :axis-bounds #( 0.0 1.0 0.0 1.0 ) 1412 :args #( FXmNheight 200 ) make-xenved { en } 1413 gen en eff_enved! 1414 fr #( FXmNbottomAttachment FXmATTACH_WIDGET 1415 FXmNbottomWidget target-row ) FXtVaSetValues drop 1416; 1417 1418: gain-ok-cb ( gen -- prc; w c i self -- x ) 1419 3 proc-create swap , ( prc ) 1420 does> { w c info self -- x } 1421 self @ { gen } 1422 gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if 1423 #f 1424 else 1425 gen eff_enved@ xe-envelope gen eff_amnt@ scale-envelope 1426 then { with-env } 1427 gen eff_target@ 'sound = if 1428 with-env array? if 1429 with-env 0 undef 1.0 #f #f #f env-sound 1430 else 1431 gen eff_amnt@ #f #f scale-by 1432 then 1433 else 1434 gen eff_target@ 'selection = if 1435 undef selection? if 1436 with-env array? if 1437 with-env 1.0 env-selection 1438 else 1439 gen eff_amnt@ scale-selection-by 1440 then 1441 else 1442 "no selection" undef status-report 1443 then 1444 else 1445 plausible-mark-samples { pts } 1446 pts if 1447 with-env array? if 1448 with-env 1449 pts 0 array-ref 1450 pts 1 array-ref 1451 pts 0 array-ref - 1452 1.0 #f #f #f env-sound 1453 else 1454 gen eff_amnt@ 1455 pts 0 array-ref 1456 pts 1 array-ref 1457 pts 0 array-ref - 1458 #f #f #f normalize-channel 1459 then 1460 else 1461 "no marks" undef status-report 1462 then 1463 then 1464 then 1465; 1466 1467: gain-reset-cb { gen -- prc; w c i self -- } 1468 3 proc-create gen , gen eff_amnt@ , ( prc ) 1469 does> { w c info self -- } 1470 self @ { gen } 1471 self cell+ @ { init } 1472 gen init eff_amnt! 1473 gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope 1474 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 1475; 1476 1477: gain-slider-cb ( gen -- prc; w c i self -- ) 1478 3 proc-create swap , ( prc ) 1479 does> { w c info self -- } 1480 w info 100.0 get-slider-value { val } 1481 self @ ( gen ) val eff_amnt! 1482; 1483 1484: post-gain-dialog ( gen -- prc; w c i self -- ) 1485 3 proc-create swap , ( prc ) 1486 does> { w c info self -- } 1487 self @ { gen } 1488 gen eff_dialog@ widget? unless 1489 gen eff_label@ gen gain-ok-cb 1490 gen eff_label@ "\ 1491Move the slider to change the gain scaling amount." help-cb 1492 gen gain-reset-cb gen general-target-cb 1493 make-effect-dialog { d } 1494 gen d eff_dialog! 1495 d #( #( "gain" 0.0 gen eff_amnt@ 5.0 1496 gen gain-slider-cb 100 ) ) add-sliders ( sl ) 1497 gen swap eff_sliders! 1498 gen make-enved-widget 1499 else 1500 gen eff_dialog@ activate-dialog 1501 then 1502; 1503set-current 1504 1505: make-gain-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 1506 ( name ) make-base-effects { gen } 1507 gen 1.0 eff_amnt! 1508 gen #f eff_enved! 1509 gen post-gain-dialog ( prc1 ) 1510 1 proc-create gen , ( prc2 ) 1511 does> { child self -- prc; self -- } 1512 0 proc-create self @ ( gen ) , child , ( prc ) 1513 does> { self -- } 1514 self @ { gen } 1515 self cell+ @ ( child ) "%s (%.2f)" 1516 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 1517; 1518previous 1519 1520\ === Normalize === 1521 1522hide 1523: normalize-ok-cb ( gen -- prc; w c i self -- ) 1524 3 proc-create swap , ( prc ) 1525 does> { w c info self -- } 1526 self @ { gen } 1527 gen eff_target@ 'sound = if 1528 gen eff_amnt@ #f #f scale-to drop 1529 else 1530 gen eff_target@ 'selection = if 1531 undef selection? if 1532 gen eff_amnt@ scale-selection-to drop 1533 else 1534 "no selection" undef status-report drop 1535 then 1536 else 1537 plausible-mark-samples { pts } 1538 pts if 1539 gen eff_amnt@ 1540 pts 0 array-ref 1541 pts 1 array-ref 1542 pts 0 array-ref - 1543 #f #f #f normalize-channel drop 1544 else 1545 "no marks" undef status-report drop 1546 then 1547 then 1548 then 1549; 1550 1551: normalize-reset-cb { gen -- prc; w c i self -- } 1552 3 proc-create gen , gen eff_amnt@ , ( prc ) 1553 does> { w c info self -- } 1554 self @ { gen } 1555 self cell+ @ { init } 1556 gen init eff_amnt! 1557 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 1558; 1559 1560: normalize-slider-cb ( gen -- prc; w c i self -- ) 1561 3 proc-create swap , ( prc ) 1562 does> { w c info self -- } 1563 w info 100.0 get-slider-value { val } 1564 self @ ( gen ) val eff_amnt! 1565; 1566 1567: post-normalize-dialog ( gen -- prc; w c i self -- ) 1568 3 proc-create swap , ( prc ) 1569 does> { w c info self -- } 1570 self @ { gen } 1571 gen eff_dialog@ widget? unless 1572 gen eff_label@ gen normalize-ok-cb 1573 gen eff_label@ "\ 1574Normalize scales amplitude to the normalize amount. \ 1575Move the slider to change the scaling amount." help-cb 1576 gen normalize-reset-cb gen general-target-cb 1577 make-effect-dialog { d } 1578 gen d eff_dialog! 1579 d #( #( "normalize" 0.0 gen eff_amnt@ 1.0 1580 gen normalize-slider-cb 100 ) ) add-sliders ( sl ) 1581 gen swap eff_sliders! 1582 gen #f add-target 1583 then 1584 gen eff_dialog@ activate-dialog 1585; 1586set-current 1587 1588: make-normalize-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 1589 ( name ) make-base-effects { gen } 1590 gen 1.0 eff_amnt! 1591 gen post-normalize-dialog ( prc1 ) 1592 1 proc-create gen , ( prc2 ) 1593 does> { child self -- prc; self -- } 1594 0 proc-create self @ ( gen ) , child , ( prc ) 1595 does> { self -- } 1596 self @ { gen } 1597 self cell+ @ ( child ) "%s (%.2f)" 1598 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 1599; 1600previous 1601 1602\ === Gate (gate set by gate-amount) === 1603 1604hide 1605: gate-ok-cb ( gen -- prc; w c i self -- ) 1606 3 proc-create swap , ( prc ) 1607 does> { w c info self -- } 1608 self @ { gen } 1609 selected-sound sync { snc } 1610 snc 0> if 1611 all-chans each { lst } 1612 lst 0 array-ref { snd } 1613 snd sync snc = if 1614 lst 1 array-ref { chn } 1615 gen eff_amnt@ dup f* gen eff_size@ 1616 snd chn effects-squelch-channel drop 1617 then 1618 end-each 1619 else 1620 gen eff_amnt@ dup f* gen eff_size@ #f #f 1621 effects-squelch-channel drop 1622 then 1623; 1624 1625: gate-reset-cb { gen -- prc; w c i self -- } 1626 3 proc-create gen , gen eff_amnt@ , ( prc ) 1627 does> { w c info self -- } 1628 self @ { gen } 1629 self cell+ @ { init } 1630 gen init eff_amnt! 1631 gen eff_sliders@ 0 array-ref init 1000.0 set-slider-value 1632; 1633 1634: gate-slider-cb ( gen -- prc; w c i self -- ) 1635 3 proc-create swap , ( prc ) 1636 does> { w c info self -- } 1637 w info 1000.0 get-slider-value { val } 1638 self @ ( gen ) val eff_amnt! 1639; 1640 1641: gate-omit-cb <{ w gen info -- }> 1642 gen info Fset eff_omit_silence! 1643; 1644 1645: post-gate-dialog ( gen -- prc; w c i self -- ) 1646 3 proc-create swap , ( prc ) 1647 does> { w c info self -- } 1648 self @ { gen } 1649 gen eff_dialog@ widget? unless 1650 gen eff_label@ gen gate-ok-cb gen 1651 eff_label@ "\ 1652Move the slider to change the gate intensity. \ 1653Higher values gate more of the sound." help-cb 1654 gen gate-reset-cb #f make-effect-dialog { d } 1655 gen d eff_dialog! 1656 d #( #( "gate" 0.0 gen eff_amnt@ 0.1 1657 gen gate-slider-cb 1000 ) ) add-sliders ( sl ) 1658 gen swap eff_sliders! 1659 "Omit silence" FXmStringCreateLocalized { s1 } 1660 gen eff_sliders@ 0 array-ref FXtParent "Omit silence" 1661 #( FXmNbackground basic-color 1662 FXmNvalue gen eff_omit_silence@ if 1 else 0 then 1663 FXmNlabelString s1 ) 1664 FXmVaCreateManagedToggleButton ( toggle ) 1665 FXmNvalueChangedCallback <'> gate-omit-cb gen 1666 FXtAddCallback drop 1667 s1 FXmStringFree drop 1668 then 1669 gen eff_dialog@ activate-dialog 1670; 1671set-current 1672 1673: make-gate-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 1674 ( name ) make-base-effects { gen } 1675 gen 0.01 eff_amnt! 1676 gen 128 eff_size! 1677 gen #f eff_omit_silence! 1678 gen post-gate-dialog ( prc1 ) 1679 1 proc-create gen , ( prc2 ) 1680 does> ( child self -- prc; self -- ) 1681 { child self } 1682 0 proc-create self @ ( gen ) , child , ( prc ) 1683 does> { self -- } 1684 self @ { gen } 1685 self cell+ @ ( child ) "%s (%.4f)" 1686 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 1687; 1688previous 1689 1690\ === DELAY EFFECTS === 1691 1692\ === Echo (controlled by delay-time and echo-amount) === 1693 1694hide 1695: echo-func-cb ( gen -- prc; samps self -- prc; inval self -- res ) 1696 1 proc-create swap , ( prc ) 1697 does> { samps self -- prc } 1698 self @ { gen } 1699 gen eff_delay@ #f srate f* f>s make-delay { del } 1700 1 proc-create 0 , samps , del , gen , ( prc ) 1701 does> { inval self -- res } 1702 self @ 1+ dup self ! { samp } 1703 self 1 cells + @ { samps } 1704 self 2 cells + @ { del } 1705 self 3 cells + @ { gen } 1706 del dup 0.0 tap samp samps <= if 1707 inval f+ 1708 then gen eff_amnt@ f* 0.0 delay inval f+ 1709; 1710 1711: echo-origin-cb ( gen -- prc; target samps self -- name origin ) 1712 2 proc-create swap , ( prc ) 1713 does> { target samps self -- name origin } 1714 self @ { gen } 1715 "effects-echo" 1716 "%s %s %s" 1717 #( target 'sound = if 1718 #f 1719 else 1720 samps 1721 then gen eff_delay@ gen eff_amnt@ ) string-format 1722; 1723 1724: echo-ok-cb ( gen -- prc; w c i self -- ) 1725 3 proc-create swap , ( prc ) 1726 does> { w c info self -- } 1727 self @ { gen } 1728 gen echo-func-cb gen eff_target@ gen echo-origin-cb gen eff_trunc@ if 1729 #f 1730 else 1731 4.0 gen eff_delay@ f* 1732 then map-chan-over-target-with-sync 1733; 1734 1735: echo-reset-cb { gen -- prc; w c i self -- } 1736 3 proc-create gen , gen eff_amnt@ , gen eff_delay@ , ( prc ) 1737 does> { w c info self -- } 1738 self @ { gen } 1739 self 1 cells + @ { init-echo } 1740 self 2 cells + @ { init-delay } 1741 gen init-echo eff_amnt! 1742 gen init-delay eff_delay! 1743 gen eff_sliders@ 0 array-ref init-delay 100.0 set-slider-value 1744 gen eff_sliders@ 1 array-ref init-echo 100.0 set-slider-value 1745; 1746 1747: echo-delay-slider-cb ( gen -- prc; w c i self -- ) 1748 3 proc-create swap , ( prc ) 1749 does> { w c info self -- } 1750 w info 100.0 get-slider-value { val } 1751 self @ ( gen ) val eff_delay! 1752; 1753 1754: echo-amount-slider-cb ( gen -- prc; w c i self -- ) 1755 3 proc-create swap , ( prc ) 1756 does> { w c info self -- } 1757 w info 100.0 get-slider-value { val } 1758 self @ ( gen ) val eff_amnt! 1759; 1760 1761: post-echo-dialog ( gen -- prc; w c i self -- ) 1762 3 proc-create swap , ( prc ) 1763 does> { w c info self -- } 1764 self @ { gen } 1765 gen eff_dialog@ widget? unless 1766 gen eff_label@ gen echo-ok-cb gen eff_label@ "\ 1767The sliders change the delay time and echo amount." help-cb 1768 gen echo-reset-cb gen general-target-cb 1769 make-effect-dialog { d } 1770 gen d eff_dialog! 1771 d #( #( "delay time" 0.0 gen eff_delay@ 2.0 1772 gen echo-delay-slider-cb 100 ) 1773 #( "echo amount" 0.0 gen eff_amnt@ 1.0 1774 gen echo-amount-slider-cb 100 ) ) add-sliders ( sl ) 1775 gen swap eff_sliders! 1776 gen <'> truncate-cb add-target 1777 then 1778 gen eff_dialog@ activate-dialog 1779; 1780set-current 1781 1782: make-echo-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 1783 ( name ) make-base-effects { gen } 1784 gen 0.5 eff_delay! 1785 gen 0.2 eff_amnt! 1786 gen post-echo-dialog ( prc1 ) 1787 1 proc-create gen , ( prc2 ) 1788 does> { child self -- prc; self -- } 1789 0 proc-create self @ ( gen ) , child , ( prc ) 1790 does> { self -- } 1791 self @ { gen } 1792 self cell+ @ ( child ) "%s (%.2f %.2f)" 1793 #( gen eff_label@ gen eff_delay@ gen eff_amnt@ ) 1794 string-format change-label 1795; 1796previous 1797 1798\ === Filtered Echo === 1799 1800hide 1801: flecho-func-cb ( gen -- prc; samps self -- prc; inval self -- res ) 1802 1 proc-create swap , ( prc ) 1803 does> { samps self -- prc } 1804 self @ { gen } 1805 :order 4 :xcoeffs vct( 0.125 0.25 0.25 0.125 ) make-fir-filter { flt } 1806 gen eff_delay@ #f srate f* fround->s make-delay { del } 1807 1 proc-create 0 , samps , flt , del , gen eff_amnt@ , ( prc ) 1808 does> { inval self -- res } 1809 self @ 1+ dup self ! { samp } 1810 self 1 cells + @ { samps } 1811 self 2 cells + @ { flt } 1812 self 3 cells + @ { del } 1813 self 4 cells + @ { scl } 1814 del flt del 0.0 tap samp samps <= if 1815 inval f+ 1816 then scl f* fir-filter delay inval f+ 1817; 1818 1819: flecho-origin-cb ( gen -- prc; target samps self -- name origin ) 1820 2 proc-create swap , ( prc ) 1821 does> { target samps self -- name origin } 1822 self @ { gen } 1823 "effects-flecho" 1824 "%s %s %s" 1825 #( gen eff_amnt@ 1826 gen eff_delay@ 1827 target 'sound = if 1828 #f 1829 else 1830 samps 1831 then ) string-format 1832; 1833 1834: flecho-ok-cb ( gen -- prc; w c i self -- ) 1835 3 proc-create swap , ( prc ) 1836 does> { w c info self -- } 1837 self @ { gen } 1838 gen flecho-func-cb gen eff_target@ gen flecho-origin-cb 1839 gen eff_trunc@ if 1840 #f 1841 else 1842 4.0 gen eff_delay@ f* 1843 then map-chan-over-target-with-sync 1844; 1845 1846: flecho-reset-cb { gen -- prc; w c i self -- } 1847 3 proc-create gen , gen eff_amnt@ , gen eff_delay@ , ( prc ) 1848 does> { w c info self -- } 1849 self @ { gen } 1850 self 1 cells + @ { init-scaler } 1851 self 2 cells + @ { init-delay } 1852 gen init-scaler eff_amnt! 1853 gen init-delay eff_delay! 1854 gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value 1855 gen eff_sliders@ 1 array-ref init-delay 100.0 set-slider-value 1856; 1857 1858: post-flecho-dialog ( gen -- prc; w c i self -- ) 1859 3 proc-create swap , ( prc ) 1860 does> { w c info self -- } 1861 self @ { gen } 1862 gen eff_dialog@ widget? unless 1863 gen eff_label@ gen flecho-ok-cb gen eff_label@ "\ 1864Move the sliders to set the filter scaler \ 1865and the delay time in seconds." help-cb 1866 gen flecho-reset-cb gen general-target-cb 1867 make-effect-dialog { d } 1868 gen d eff_dialog! 1869 d #( #( "filter scaler" 0.0 gen eff_amnt@ 1.0 1870 gen echo-amount-slider-cb 100 ) 1871 #( "delay time (secs)" 0.0 gen eff_delay@ 3.0 1872 gen echo-delay-slider-cb 100 ) ) add-sliders ( sl ) 1873 gen swap eff_sliders! 1874 gen <'> truncate-cb add-target 1875 then 1876 gen eff_dialog@ activate-dialog 1877; 1878set-current 1879 1880: make-flecho-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 1881 ( name ) make-base-effects { gen } 1882 gen 0.9 eff_delay! 1883 gen 0.5 eff_amnt! 1884 gen post-flecho-dialog ( prc1 ) 1885 1 proc-create gen , ( prc2 ) 1886 does> { child self -- prc; self -- } 1887 0 proc-create self @ ( gen ) , child , ( prc ) 1888 does> { self -- } 1889 self @ { gen } 1890 self cell+ @ ( child ) "%s (%.2f %.2f)" 1891 #( gen eff_label@ gen eff_amnt@ gen eff_delay@ ) 1892 string-format change-label 1893; 1894previous 1895 1896\ === Modulated Echo === 1897 1898hide 1899: zecho-func-cb ( gen -- prc; samps self -- prc; inval self -- res ) 1900 1 proc-create swap , ( prc ) 1901 does> { samps self -- prc } 1902 self @ { gen } 1903 gen eff_freq@ make-oscil { os } 1904 gen eff_delay@ #f srate f* fround->s { len } 1905 :size len :max-size len gen eff_amp@ f>s 1+ + make-delay { del } 1906 1 proc-create ( prc ) 1907 0 , samps , os , del , gen eff_scl@ , gen eff_amp@ , 1908 does> { inval self -- res } 1909 self @ { samp } 1910 1 self +! ( samp++ ) 1911 self 1 cells + @ { samps } 1912 self 2 cells + @ { os } 1913 self 3 cells + @ { del } 1914 self 4 cells + @ { scl } 1915 self 5 cells + @ { amp } 1916 del ( del-gen ) del 0.0 tap samp samps < if 1917 inval f+ 1918 then scl f* ( input ) os 0.0 0.0 oscil amp f* ( pm ) delay inval f+ 1919; 1920 1921: zecho-origin-cb ( gen -- prc; target samps self -- name origin ) 1922 2 proc-create swap , ( prc ) 1923 does> { target samps self -- name origin } 1924 self @ { gen } 1925 "effects-zecho" 1926 "%s %s %s %s %s" 1927 #( gen eff_scl@ 1928 gen eff_delay@ 1929 gen eff_freq@ 1930 gen eff_amp@ 1931 target 'sound = if 1932 #f 1933 else 1934 samps 1935 then ) string-format 1936; 1937 1938: zecho-ok-cb ( gen -- prc; w c i self -- ) 1939 3 proc-create swap , ( prc ) 1940 does> { w c info self -- } 1941 self @ { gen } 1942 gen zecho-func-cb gen eff_target@ gen zecho-origin-cb gen eff_trunc@ if 1943 #f 1944 else 1945 4.0 gen eff_delay@ f* 1946 then map-chan-over-target-with-sync 1947; 1948 1949: zecho-reset-cb { gen -- prc; w c i self -- } 1950 3 proc-create ( prc ) 1951 gen , 1952 gen eff_scl@ , 1953 gen eff_delay@ , 1954 gen eff_freq@ , 1955 gen eff_amp@ , 1956 does> { w c info self -- } 1957 self @ { gen } 1958 self 1 cells + @ { init-scaler } 1959 self 2 cells + @ { init-delay } 1960 self 3 cells + @ { init-freq } 1961 self 4 cells + @ { init-amp } 1962 gen init-scaler eff_scl! 1963 gen init-delay eff_delay! 1964 gen init-freq eff_freq! 1965 gen init-amp eff_amp! 1966 gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value 1967 gen eff_sliders@ 1 array-ref init-delay 100.0 set-slider-value 1968 gen eff_sliders@ 2 array-ref init-freq 100.0 set-slider-value 1969 gen eff_sliders@ 3 array-ref init-amp 100.0 set-slider-value 1970; 1971 1972: zecho-del-slider-cb ( gen -- prc; w c i self -- ) 1973 3 proc-create swap , ( prc ) 1974 does> { w c info self -- } 1975 w info 100.0 get-slider-value self { val } 1976 @ ( gen ) val eff_delay! 1977; 1978 1979: post-zecho-dialog ( gen -- prc; w c i self -- ) 1980 3 proc-create swap , ( prc ) 1981 does> { w c info self -- } 1982 self @ { gen } 1983 gen eff_dialog@ widget? unless 1984 gen eff_label@ gen zecho-ok-cb gen eff_label@ " 1985Move the sliders to set the echo scaler, \ 1986the delay time in seconds, the modulation frequency, \ 1987and the echo amplitude." help-cb gen 1988 zecho-reset-cb gen general-target-cb 1989 make-effect-dialog { d } 1990 gen d eff_dialog! 1991 d #( #( "echo scaler" 0.0 gen eff_scl@ 1.0 1992 gen scaler-slider-cb 100 ) 1993 #( "delay time (secs)" 0.0 gen eff_delay@ 3.0 1994 gen zecho-del-slider-cb 100 ) 1995 #( "modulatio frequency" 0.0 gen eff_freq@ 100.0 1996 gen frequency-slider-cb 100 ) 1997 #( "modulatio amplitude" 0.0 gen eff_amp@ 100.0 1998 gen amplitude-slider-cb 100 ) ) add-sliders ( sl ) 1999 gen swap eff_sliders! 2000 gen <'> truncate-cb add-target 2001 then 2002 gen eff_dialog@ activate-dialog 2003; 2004set-current 2005 2006: make-zecho-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2007 ( name ) make-base-effects { gen } 2008 gen 0.50 eff_scl! 2009 gen 0.75 eff_delay! 2010 gen 6.00 eff_freq! 2011 gen 10.0 eff_amp! 2012 gen post-zecho-dialog ( prc1 ) 2013 1 proc-create gen , ( prc2 ) 2014 does> { child self -- prc; self -- } 2015 0 proc-create self @ ( gen ) , child , ( prc ) 2016 does> { self -- } 2017 self @ { gen } 2018 self cell+ @ ( child ) "%s (%.2f %.2f %.2f %.2f)" 2019 #( gen eff_label@ 2020 gen eff_scl@ 2021 gen eff_delay@ 2022 gen eff_freq@ 2023 gen eff_amp@ ) string-format change-label 2024; 2025previous 2026 2027\ === FILTER EFFECTS === 2028 2029\ === Butterworth band-pass filter === 2030 2031hide 2032: bp-ok-cb ( gen -- prc; w c i self -- x ) 2033 3 proc-create swap , ( prc ) 2034 does> { w c info self -- x } 2035 self @ { gen } 2036 gen eff_freq@ gen eff_bp_bw@ make-butter-band-pass { flt } 2037 gen eff_target@ 'sound = if 2038 "%s %s 0 #f effects-bbp" 2039 #( gen eff_freq@ gen eff_bp_bw@ ) 2040 string-format { origin } 2041 flt #f #f #f #f origin filter-sound 2042 else 2043 gen eff_target@ 'selection = if 2044 flt #f #f filter-selection 2045 else 2046 plausible-mark-samples { pts } 2047 pts 0 array-ref { bg } 2048 pts 1 array-ref bg - 1+ { nd } 2049 "%s %s %s %s effects-bbp" 2050 #( gen eff_freq@ gen eff_bp_bw@ bg nd ) 2051 string-format { origin } 2052 flt bg nd #f #f #f #f origin clm-channel 2053 then 2054 then 2055; 2056 2057: bp-reset-cb { gen -- prc; w c i self -- } 2058 3 proc-create gen , gen eff_freq@ , gen eff_bp_bw@ , ( prc ) 2059 does> { w c info self -- } 2060 self @ { gen } 2061 self 1 cells + @ { init-freq } 2062 self 2 cells + @ { init-bw } 2063 gen init-freq eff_freq! 2064 gen init-bw eff_bp_bw! 2065 gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0 2066 scale-log->linear 1.0 set-slider-value 2067 gen eff_sliders@ 1 array-ref init-bw 1.0 set-slider-value 2068; 2069 2070: bp-bw-slider-cb ( gen -- prc; w c i self -- ) 2071 3 proc-create swap , ( prc ) 2072 does> { w c info self -- } 2073 w info 1.0 get-slider-value { val } 2074 self @ ( gen ) val eff_bp_bw! 2075; 2076 2077: post-band-pass-dialog ( gen -- prc; w c i self -- ) 2078 3 proc-create swap , ( prc ) 2079 does> ( w c i self -- ) 2080 { w c info self } 2081 self @ { gen } 2082 gen eff_dialog@ widget? unless 2083 gen eff_label@ gen bp-ok-cb gen eff_label@ "\ 2084Butterworth band-pass filter. \ 2085Move the sliders to change the center frequency and bandwidth." help-cb 2086 gen bp-reset-cb gen general-target-cb 2087 make-effect-dialog { d } 2088 gen d eff_dialog! 2089 d #( #( "center frequency" 20.0 gen eff_freq@ 22050.0 2090 gen log-freq-slider-cb 1 'log ) 2091 #( "bandwidth" 0 gen eff_bp_bw@ 1000 2092 gen bp-bw-slider-cb 1 ) ) add-sliders ( sl ) 2093 gen swap eff_sliders! 2094 gen #f add-target 2095 then 2096 gen eff_dialog@ activate-dialog 2097; 2098set-current 2099 2100: make-band-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2101 ( name) make-base-effects { gen } 2102 gen 1000.0 eff_freq! 2103 gen 100 eff_bp_bw! 2104 gen post-band-pass-dialog ( prc1 ) 2105 1 proc-create gen , ( prc2 ) 2106 does> { child self -- prc; self -- } 2107 0 proc-create self @ ( gen ) , child , ( prc ) 2108 does> { self -- } 2109 self @ { gen } 2110 self cell+ @ ( child ) "%s (%.2f %d)" 2111 #( gen eff_label@ gen eff_freq@ gen eff_bp_bw@ ) 2112 string-format change-label 2113; 2114previous 2115 2116\ === Butterworth band-reject (notch) filter === 2117 2118hide 2119: br-ok-cb ( gen -- prc; w c i self -- x ) 2120 3 proc-create swap , ( prc ) 2121 does> { w c info self -- x } 2122 self @ { gen } 2123 gen eff_freq@ gen eff_notch_bw@ make-butter-band-reject { flt } 2124 gen eff_target@ 'sound = if 2125 "%s %s 0 #f effects-bbr" #( gen eff_freq@ gen eff_notch_bw@ ) 2126 string-format { origin } 2127 flt #f #f #f #f origin filter-sound 2128 else 2129 gen eff_target@ 'selection = if 2130 flt #f #f filter-selection 2131 else 2132 plausible-mark-samples { pts } 2133 pts 0 array-ref { bg } 2134 pts 1 array-ref bg - 1+ { nd } 2135 "%s %s %s %s effects-bbp" 2136 #( gen eff_freq@ gen eff_notch_bw@ bg nd ) 2137 string-format { orig } 2138 flt bg nd #f #f #f #f orig clm-channel 2139 then 2140 then 2141; 2142 2143: br-reset-cb { gen -- prc; w c i self -- } 2144 3 proc-create gen , gen eff_freq@ , gen eff_notch_bw@ , ( prc ) 2145 does> { w c info self -- } 2146 self @ { gen } 2147 self 1 cells + @ { init-freq } 2148 self 2 cells + @ { init-bw } 2149 gen init-freq eff_freq! 2150 gen init-bw eff_notch_bw! 2151 gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0 2152 scale-log->linear 1.0 set-slider-value 2153 gen eff_sliders@ 1 array-ref init-bw 1.0 set-slider-value 2154; 2155 2156: br-bw-slider-cb ( gen -- prc; w c i self -- ) 2157 3 proc-create swap , ( prc ) 2158 does> { w c info self -- } 2159 w info 1.0 get-slider-value { val } 2160 self @ ( gen ) val eff_notch_bw! 2161; 2162 2163: post-notch-dialog ( gen -- prc; w c i self -- ) 2164 3 proc-create swap , ( prc ) 2165 does> { w c info self -- } 2166 self @ { gen } 2167 gen eff_dialog@ widget? unless 2168 gen eff_label@ gen br-ok-cb gen eff_label@ "\ 2169Butterworth band-reject filter. \ 2170Move the sliders to change the center frequency and bandwidth." help-cb 2171 gen br-reset-cb gen general-target-cb 2172 make-effect-dialog { d } 2173 gen d eff_dialog! 2174 d #( #( "center frequency" 20.0 gen eff_freq@ 22050.0 2175 gen log-freq-slider-cb 1 'log ) 2176 #( "bandwidth" 0 gen eff_notch_bw@ 1000 2177 gen br-bw-slider-cb 1 ) ) add-sliders ( sl ) 2178 gen swap eff_sliders! 2179 gen #f add-target 2180 then 2181 gen eff_dialog@ activate-dialog 2182; 2183set-current 2184 2185: make-notch-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2186 ( name ) make-base-effects { gen } 2187 gen 100.0 eff_freq! 2188 gen 100 eff_notch_bw! 2189 gen post-notch-dialog ( prc1 ) 2190 1 proc-create gen , ( prc2 ) 2191 does> { child self -- prc; self -- } 2192 0 proc-create self @ ( gen ) , child , ( prc ) 2193 does> { self -- } 2194 self @ { gen } 2195 self cell+ @ ( child ) "%s (%.2f %d)" 2196 #( gen eff_label@ gen eff_freq@ gen eff_notch_bw@ ) 2197 string-format change-label 2198; 2199previous 2200 2201\ === Butterworth high-pass filter === 2202 2203hide 2204: hp-ok-cb ( gen -- prc; w c i self -- x ) 2205 3 proc-create swap , ( prc ) 2206 does> { w c info self -- x } 2207 self @ { gen } 2208 gen eff_freq@ make-butter-high-pass { flt } 2209 gen eff_target@ 'sound = if 2210 "%s 0 #f effects-bhp" 2211 #( gen eff_freq@ ) string-format { origin } 2212 flt #f #f #f #f origin filter-sound 2213 else 2214 gen eff_target@ 'selection = if 2215 flt #f #f filter-selection 2216 else 2217 plausible-mark-samples { pts } 2218 pts 0 array-ref { bg } 2219 pts 1 array-ref bg - 1+ { nd } 2220 "%s %s %s effects-bhp" 2221 #( gen eff_freq@ bg nd ) 2222 string-format { origin } 2223 flt bg nd #f #f #f #f origin clm-channel 2224 then 2225 then 2226; 2227 2228: hp-reset-cb { gen -- prc; w c i self -- } 2229 3 proc-create gen , gen eff_freq@ , ( prc ) 2230 does> { w c info self -- } 2231 self @ { gen } 2232 self cell+ @ { init-freq } 2233 gen init-freq eff_freq! 2234 gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0 2235 scale-log->linear 1.0 set-slider-value 2236; 2237 2238: post-high-pass-dialog ( gen -- prc; w c i self -- ) 2239 3 proc-create swap , ( prc ) 2240 does> { w c info self -- } 2241 self @ { gen } 2242 gen eff_dialog@ widget? unless 2243 gen eff_label@ gen hp-ok-cb gen eff_label@ "\ 2244Butterworth high-pass filter. \ 2245Move the slider to change the high-pass cutoff frequency." help-cb 2246 gen hp-reset-cb gen general-target-cb 2247 make-effect-dialog { d } 2248 gen d eff_dialog! 2249 d #( #( "high-pass cutoff frequency" 20.0 gen eff_freq@ 22050.0 2250 gen log-freq-slider-cb 1 'log ) ) add-sliders ( sl ) 2251 gen swap eff_sliders! 2252 gen #f add-target 2253 then 2254 gen eff_dialog@ activate-dialog 2255; 2256set-current 2257 2258: make-high-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2259 ( name ) make-base-effects { gen } 2260 gen 100.0 eff_freq! 2261 gen post-high-pass-dialog ( prc1 ) 2262 1 proc-create gen , ( prc2 ) 2263 does> { child self -- prc; self -- } 2264 0 proc-create self @ ( gen ) , child , ( prc ) 2265 does> { self -- } 2266 self @ { gen } 2267 self cell+ @ ( child ) "%s (%.2f)" 2268 #( gen eff_label@ gen eff_freq@ ) string-format change-label 2269; 2270previous 2271 2272\ === Butterworth low-pass filter === 2273 2274hide 2275: lp-ok-cb ( gen -- prc; w c i self -- x ) 2276 3 proc-create swap , ( prc ) 2277 does> { w c info self -- x } 2278 self @ { gen } 2279 gen eff_freq@ make-butter-low-pass { flt } 2280 gen eff_target@ 'sound = if 2281 "%s 0 #f effects-blp" gen eff_freq@ string-format { origin } 2282 flt #f #f #f #f origin filter-sound 2283 else 2284 gen eff_target@ 'selection = if 2285 flt #f #f filter-selection 2286 else 2287 plausible-mark-samples { pts } 2288 pts 0 array-ref { bg } 2289 pts 1 array-ref bg - 1+ { nd } 2290 "%s %s %s effects-blp" 2291 #( gen eff_freq@ bg nd ) string-format { origin } 2292 flt bg nd #f #f #f #f origin clm-channel 2293 then 2294 then 2295; 2296 2297: lp-reset-cb { gen -- prc; w c i self -- } 2298 3 proc-create gen , gen eff_freq@ , ( prc ) 2299 does> { w c info self -- } 2300 self @ { gen } 2301 self cell+ @ { init-freq } 2302 gen init-freq eff_freq! 2303 gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0 2304 scale-log->linear 1.0 set-slider-value 2305; 2306 2307: post-low-pass-dialog ( gen -- prc; w c i self -- ) 2308 3 proc-create swap , ( prc ) 2309 does> { w c info self -- } 2310 self @ { gen } 2311 gen eff_dialog@ widget? unless 2312 gen eff_label@ gen lp-ok-cb gen eff_label@ "\ 2313Butterworth low-pass filter. \ 2314Move the slider to change the low-pass cutoff frequency." help-cb 2315 gen lp-reset-cb gen general-target-cb 2316 make-effect-dialog { d } 2317 gen d eff_dialog! 2318 d #( #( "low-pass cutoff frequency" 20.0 gen eff_freq@ 22050.0 2319 gen log-freq-slider-cb 1 'log ) ) add-sliders ( sl ) 2320 gen swap eff_sliders! 2321 gen #f add-target 2322 then 2323 gen eff_dialog@ activate-dialog 2324; 2325set-current 2326 2327: make-low-pass-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2328 ( name ) make-base-effects { gen } 2329 gen 1000.0 eff_freq! 2330 gen post-low-pass-dialog ( prc1 ) 2331 1 proc-create gen , ( prc2 ) 2332 does> { child self -- prc; self -- } 2333 0 proc-create self @ ( gen ) , child , ( prc ) 2334 does> { self -- } 2335 self @ { gen } 2336 self cell+ @ ( child ) "%s (%.2f)" 2337 #( gen eff_label@ gen eff_freq@ ) string-format change-label 2338; 2339previous 2340 2341\ === Comb filter === 2342 2343hide 2344: comb-func-cb ( gen -- prc; samps self -- prc ) 2345 1 proc-create swap , ( prc ) 2346 does> { samps self -- prc } 2347 self @ { gen } 2348 gen eff_scl@ gen eff_size@ comb-filter 2349; 2350 2351: comb-origin-cb ( gen -- prc; target samps self -- name origin ) 2352 2 proc-create swap , ( prc ) 2353 does> { target samps self -- name origin } 2354 self @ { gen } 2355 "effects-comb-filter" 2356 "%s %s" #( gen eff_scl@ gen eff_size@ ) string-format 2357; 2358 2359: comb-ok-cb ( gen -- prc; w c i self -- ) 2360 3 proc-create swap , ( prc ) 2361 does> { w c info self -- } 2362 self @ { gen } 2363 gen comb-func-cb gen eff_target@ gen comb-origin-cb #f 2364 map-chan-over-target-with-sync 2365; 2366 2367: comb-reset-cb { gen -- prc; w c i self -- } 2368 3 proc-create gen , gen eff_scl@ , gen eff_size@ , ( prc ) 2369 does> { w c info self -- } 2370 self @ { gen } 2371 self 1 cells + @ { init-scaler } 2372 self 2 cells + @ { init-size } 2373 gen init-scaler eff_scl! 2374 gen init-size eff_size! 2375 gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value 2376 gen eff_sliders@ 1 array-ref init-size 1.0 set-slider-value 2377; 2378 2379: post-comb-dialog ( gen -- prc; w c i self -- ) 2380 3 proc-create swap , ( prc ) 2381 does> { w c info self -- } 2382 self @ { gen } 2383 gen eff_dialog@ widget? unless 2384 gen eff_label@ gen comb-ok-cb gen eff_label@ "\ 2385Move the slider to change the comb scaler and size." help-cb gen comb-reset-cb 2386 gen general-target-cb make-effect-dialog { d } 2387 gen d eff_dialog! 2388 d #( #( "scaler" 0.0 gen eff_scl@ 1.0 2389 gen scaler-slider-cb 100 ) 2390 #( "size" 0 gen eff_size@ 100 2391 gen size-slider-cb 1 ) ) add-sliders ( sl ) 2392 gen swap eff_sliders! 2393 gen #f add-target 2394 then 2395 gen eff_dialog@ activate-dialog 2396; 2397set-current 2398 2399: make-comb-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2400 ( name ) make-base-effects { gen } 2401 gen 0.1 eff_scl! 2402 gen 50 eff_size! 2403 gen post-comb-dialog ( prc1 ) 2404 1 proc-create gen , ( prc2 ) 2405 does> { child self -- prc; self -- } 2406 0 proc-create self @ ( gen ) , child , ( prc ) 2407 does> { self -- } 2408 self @ { gen } 2409 self cell+ @ ( child ) "%s (%.2f %d)" 2410 #( gen eff_label@ gen eff_scl@ gen eff_size@ ) 2411 string-format change-label 2412; 2413previous 2414 2415\ === Comb-chord filter === 2416 2417hide 2418: cc-func-cb ( gen -- prc; samps self -- prc ) 2419 1 proc-create swap , ( prc ) 2420 does> { samps self -- prc } 2421 self @ { gen } 2422 gen eff_scl@ gen eff_size@ gen eff_amp@ comb-chord 2423; 2424 2425: cc-origin-cb ( gen -- prc; target samps self -- name origin ) 2426 2 proc-create swap , ( prc ) 2427 does> { target samps self -- name origin } 2428 self @ { gen } 2429 "effects-comb-chord" 2430 "%s %s %s" #( gen eff_scl@ gen eff_size@ gen eff_amp@ ) string-format 2431; 2432 2433: cc-ok-cb ( gen -- prc; w c i self -- ) 2434 3 proc-create swap , ( prc ) 2435 does> { w c info self -- } 2436 self @ { gen } 2437 gen cc-func-cb gen eff_target@ gen cc-origin-cb #f 2438 map-chan-over-target-with-sync 2439; 2440 2441: cc-reset-cb { gen -- prc; w c i self -- } 2442 3 proc-create ( prc ) 2443 gen , gen eff_scl@ , gen eff_size@ , gen eff_amp@ , 2444 does> { w c info self -- } 2445 self @ { gen } 2446 self 1 cells + @ { init-scaler } 2447 self 2 cells + @ { init-size } 2448 self 3 cells + @ { init-amp } 2449 gen init-scaler eff_scl! 2450 gen init-size eff_size! 2451 gen init-amp eff_amp! 2452 gen eff_sliders@ 0 array-ref init-scaler 100.0 set-slider-value 2453 gen eff_sliders@ 1 array-ref init-size 1.0 set-slider-value 2454 gen eff_sliders@ 2 array-ref init-amp 100.0 set-slider-value 2455; 2456 2457: post-cc-dialog ( gen -- prc; w c i self -- ) 2458 3 proc-create swap , ( prc ) 2459 does> { w c info self -- } 2460 self @ { gen } 2461 gen eff_dialog@ widget? unless 2462 gen eff_label@ gen cc-ok-cb gen eff_label@ "\ 2463Creates chords by using filters at harmonically related sizes. \ 2464Move the sliders to set the comb chord parameters." help-cb gen cc-reset-cb 2465 gen general-target-cb make-effect-dialog { d } 2466 gen d eff_dialog! 2467 d #( #( "chord scaler" 0.0 gen eff_scl@ 1.0 2468 gen scaler-slider-cb 100 ) 2469 #( "chord size" 0 gen eff_size@ 100 2470 gen size-slider-cb 1 ) 2471 #( "amplitude" 0.0 gen eff_amp@ 1.0 2472 gen amplitude-slider-cb 100 ) ) add-sliders ( sl ) 2473 gen swap eff_sliders! 2474 gen #f add-target 2475 then 2476 gen eff_dialog@ activate-dialog 2477; 2478set-current 2479 2480: make-comb-chord-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2481 ( name ) make-base-effects { gen } 2482 gen 0.95 eff_scl! 2483 gen 60 eff_size! 2484 gen 0.3 eff_amp! 2485 gen post-cc-dialog ( prc1 ) 2486 1 proc-create gen , ( prc2 ) 2487 does> { child self -- prc; self -- } 2488 0 proc-create self @ ( gen ) , child , ( prc ) 2489 does> { self -- } 2490 self @ { gen } 2491 self cell+ @ ( child ) "%s (%.2f %d %.2f)" 2492 #( gen eff_label@ gen eff_scl@ gen eff_size@ gen eff_amp@ ) 2493 string-format change-label 2494; 2495previous 2496 2497\ === Moog filter === 2498 2499hide 2500: moog-func-cb ( gen -- prc; samps self -- prc ) 2501 1 proc-create swap , ( prc ) 2502 does> { samps self -- prc } 2503 self @ { gen } 2504 gen eff_freq@ gen eff_moog_reson@ moog 2505; 2506 2507: moog-origin-cb ( gen -- prc; target samps self -- name origin ) 2508 2 proc-create swap , ( prc ) 2509 does> { target samps self -- name origin } 2510 self @ { gen } 2511 "effects-moog" 2512 "%s %s" #( gen eff_freq@ gen eff_moog_reson@ ) string-format 2513; 2514 2515: moog-ok-cb ( gen -- prc; w c i self -- ) 2516 3 proc-create swap , ( prc ) 2517 does> { w c info self -- } 2518 self @ { gen } 2519 gen moog-func-cb gen eff_target@ gen moog-origin-cb #f 2520 map-chan-over-target-with-sync 2521; 2522 2523: moog-reset-cb { gen -- prc; w c i self -- } 2524 3 proc-create gen , gen eff_freq@ , gen eff_moog_reson@ , ( prc ) 2525 does> { w c info self -- } 2526 self @ { gen } 2527 self 1 cells + @ { init-freq } 2528 self 2 cells + @ { init-res } 2529 gen init-freq eff_freq! 2530 gen init-res eff_moog_reson! 2531 gen eff_sliders@ 0 array-ref 20.0 init-freq 22050.0 2532 scale-log->linear 1.0 set-slider-value 2533 gen eff_sliders@ 1 array-ref init-res 100.0 set-slider-value 2534; 2535 2536: moog-res-cb ( gen -- prc; w c i self -- ) 2537 3 proc-create swap , ( prc ) 2538 does> { w c info self -- } 2539 w info 100.0 get-slider-value { val } 2540 self @ ( gen ) val eff_moog_reson! 2541; 2542 2543: post-moog-dialog ( gen -- prc; w c i self -- ) 2544 3 proc-create swap , ( prc ) 2545 does> { w c info self -- } 2546 self @ { gen } 2547 gen eff_dialog@ widget? unless 2548 gen eff_label@ gen moog-ok-cb gen eff_label@ "\ 2549Moog-style 4-pole lowpass filter \ 2550with 24db/oct rolloff and variable resonance. \ 2551Move the sliders to set the filter \ 2552cutoff frequency and resonance." help-cb gen moog-reset-cb 2553 gen general-target-cb make-effect-dialog { d } 2554 gen d eff_dialog! 2555 d #( #( "cutoff frequency" 20.0 gen eff_freq@ 22050.0 2556 gen log-freq-slider-cb 1 'log ) 2557 #( "resonanze" 0.0 gen eff_moog_reson@ 1.0 2558 gen moog-res-cb 100 ) ) add-sliders ( sl ) 2559 gen swap eff_sliders! 2560 gen #f add-target 2561 then 2562 gen eff_dialog@ activate-dialog 2563; 2564set-current 2565 2566: make-moog-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2567 ( name ) make-base-effects { gen } 2568 gen 10000.0 eff_freq! 2569 gen 0.5 eff_moog_reson! 2570 gen post-moog-dialog ( prc1 ) 2571 1 proc-create gen , ( prc2 ) 2572 does> { child self -- prc; self -- } 2573 0 proc-create self @ ( gen ) , child , ( prc ) 2574 does> { self -- } 2575 self @ { gen } 2576 self cell+ @ ( child ) "%s (%.2f %.2f)" 2577 #( gen eff_label@ gen eff_freq@ gen eff_moog_reson@ ) 2578 string-format change-label 2579; 2580previous 2581 2582\ === FREQUENCY EFFECTS === 2583 2584\ === Adaptive saturation === 2585 2586hide 2587: adsat-func-cb ( gen -- prc; samps self -- prc; val self -- res ) 2588 1 proc-create swap , ( prc ) 2589 does> { samps self -- prc } 2590 self @ { gen } 2591 1 proc-create ( prc ) 2592 gen , gen eff_size@ 0.0 make-vct , 0.0 , 0.0 , 0 , 2593 does> { val self -- res } 2594 self @ { gen } 2595 self 1 cells + @ { vals } 2596 self 2 cells + @ { mn } 2597 self 3 cells + @ { mx } 2598 self 4 cells + @ { n } 2599 gen eff_size@ n = if 2600 vals each { x } 2601 vals i x f0>= if 2602 mx 2603 else 2604 mn 2605 then vct-set! drop 2606 0.0 self 2 cells + ! ( mn ) 2607 0.0 self 3 cells + ! ( mx ) 2608 0 self 4 cells + ! ( n ) 2609 end-each 2610 vals 2611 else 2612 vals n val vct-set! drop 2613 val mx f> if 2614 val self 3 cells + ! ( mx ) 2615 then 2616 val mn f< if 2617 val self 2 cells + ! ( mn ) 2618 then 2619 n 1+ self 4 cells + ! ( n++ ) 2620 #f 2621 then 2622; 2623 2624: adsat-origin-cb ( gen -- prc; target samps self -- name origin ) 2625 2 proc-create swap , ( prc ) 2626 does> { target samps self -- name origin } 2627 self @ { gen } 2628 "adsat" 2629 gen eff_size@ number->string 2630; 2631 2632: adsat-ok-cb ( gen -- prc; w c i self -- ) 2633 3 proc-create swap , ( prc ) 2634 does> { w c info self -- } 2635 self @ { gen } 2636 gen adsat-func-cb gen eff_target@ gen adsat-origin-cb #f 2637 map-chan-over-target-with-sync 2638; 2639 2640: adsat-reset-cb { gen -- prc; w c i self -- } 2641 3 proc-create gen , gen eff_size@ , ( prc ) 2642 does> { w c info self -- } 2643 self @ { gen } 2644 self cell+ @ { init-size } 2645 gen init-size eff_size! 2646 gen eff_sliders@ 0 array-ref init-size 1.0 set-slider-value 2647; 2648 2649: post-adsat-dialog ( gen -- prc; w c i self -- ) 2650 3 proc-create swap , ( prc ) 2651 does> { w c info self -- } 2652 self @ { gen } 2653 gen eff_dialog@ widget? unless 2654 gen eff_label@ gen adsat-ok-cb gen eff_label@ "\ 2655Move the slider to change the saturation scaling factor." help-cb 2656 gen adsat-reset-cb gen general-target-cb 2657 make-effect-dialog { d } 2658 gen d eff_dialog! 2659 d #( #( "adaptive saturation size" 0 gen eff_size@ 10 2660 gen size-slider-cb 1 ) ) add-sliders ( sl ) 2661 gen swap eff_sliders! 2662 gen #f add-target 2663 then 2664 gen eff_dialog@ activate-dialog 2665; 2666set-current 2667 2668: make-adsat-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2669 ( name ) make-base-effects { gen } 2670 gen 4 eff_size! 2671 gen post-adsat-dialog ( prc1 ) 2672 1 proc-create gen , ( prc2 ) 2673 does> { child self -- prc; self -- } 2674 0 proc-create self @ ( gen ) , child , ( prc ) 2675 does> { self -- } 2676 self @ { gen } 2677 self cell+ @ ( child ) "%s (%d)" 2678 #( gen eff_label@ gen eff_size@ ) string-format change-label 2679; 2680previous 2681 2682\ === Sample rate conversion (resample) === 2683 2684hide 2685: src-ok-cb ( gen -- prc; w c i self -- x ) 2686 3 proc-create swap , ( prc ) 2687 does> { w c info self -- x } 2688 self @ { gen } 2689 gen eff_target@ 'sound = if 2690 gen eff_amnt@ 1.0 undef undef undef src-sound 2691 else 2692 gen eff_target@ 'selection = if 2693 undef selection? if 2694 gen eff_amnt@ 1.0 src-selection 2695 else 2696 "no selection" undef status-report 2697 then 2698 else 2699 "can't apply src between marks yet" undef status-report 2700 then 2701 then 2702; 2703 2704: src-reset-cb { gen -- prc; w c i self -- } 2705 3 proc-create gen , gen eff_amnt@ , ( prc ) 2706 does> { w c info self -- } 2707 self @ { gen } 2708 self cell+ @ { init-amount } 2709 gen init-amount eff_amnt! 2710 gen eff_sliders@ 0 array-ref init-amount 100.0 set-slider-value 2711; 2712 2713: src-amount-cb ( gen -- prc; w c i self -- ) 2714 3 proc-create swap , ( prc ) 2715 does> { w c info self -- } 2716 w info 100.0 get-slider-value { val } 2717 self @ ( gen ) val eff_amnt! 2718; 2719 2720: post-src-dialog ( gen -- prc; w c i self -- ) 2721 3 proc-create swap , ( prc ) 2722 does> { w c info self -- } 2723 self @ { gen } 2724 gen eff_dialog@ widget? unless 2725 gen eff_label@ gen src-ok-cb gen eff_label@ "\ 2726Move the slider to change the sample rate. \ 2727Values greater than 1.0 speed up file play, \ 2728negative values reverse it." help-cb gen src-reset-cb 2729 gen general-target-cb make-effect-dialog { d } 2730 gen d eff_dialog! 2731 d #( #( "sample rate" -2.0 gen eff_amnt@ 2.0 2732 gen src-amount-cb 100 ) ) add-sliders ( sl ) 2733 gen swap eff_sliders! 2734 gen #f add-target 2735 then 2736 gen eff_dialog@ activate-dialog 2737; 2738set-current 2739 2740: make-src-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2741 ( name ) make-base-effects { gen } 2742 gen 0.0 eff_amnt! 2743 gen post-src-dialog ( prc1 ) 2744 1 proc-create gen , ( prc2 ) 2745 does> { child self -- prc; self -- } 2746 0 proc-create self @ ( gen ) , child , ( prc ) 2747 does> { self -- } 2748 self @ { gen } 2749 self cell+ @ ( child ) "%s (%.2f)" 2750 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 2751; 2752previous 2753 2754\ === Time and pitch scaling by granular synthesis and sampling rate conversion 2755 2756hide 2757: expsrc-ok-cb ( gen -- prc; w c i self -- x ) 2758 3 proc-create swap , ( prc ) 2759 does> { w c info self -- x } 2760 self @ { gen } 2761 selected-sound { snd } 2762 snd save-controls drop 2763 snd reset-controls drop 2764 gen eff_pitch_scl@ snd set-speed-control drop 2765 gen eff_pitch_scl@ gen eff_time_scale@ f* { new-time } 2766 new-time 1.0 f<> if 2767 #t snd set-expand-control? drop 2768 new-time snd set-expand-control drop 2769 gen eff_hop_size@ snd set-expand-control-hop drop 2770 gen eff_seg_len@ snd set-expand-control-length drop 2771 gen eff_ramp_scl@ snd set-expand-control-ramp drop 2772 then 2773 gen eff_target@ 'marks = if 2774 plausible-mark-samples { pts } 2775 pts if 2776 snd 0 2777 pts 0 array-ref 2778 pts 1 array-ref 2779 pts 0 array-ref - 1+ apply-controls 2780 else 2781 "no marks" undef status-report 2782 then 2783 else 2784 snd gen eff_target@ 'sound = if 2785 0 2786 else 2787 2 2788 then undef undef apply-controls 2789 then drop 2790 snd restore-controls 2791; 2792 2793: expsrc-reset-cb { gen -- prc; w c i self -- } 2794 3 proc-create ( prc ) 2795 gen , 2796 gen eff_time_scale@ , 2797 gen eff_hop_size@ , 2798 gen eff_seg_len@ , 2799 gen eff_ramp_scl@ , 2800 gen eff_pitch_scl@ , 2801 does> { w c info self -- } 2802 self @ { gen } 2803 self 1 cells + @ { init-time-scale } 2804 self 2 cells + @ { init-size } 2805 self 3 cells + @ { init-seg-len } 2806 self 4 cells + @ { init-ramp-scale } 2807 self 5 cells + @ { init-pitch-scale } 2808 gen init-time-scale eff_time_scale! 2809 gen init-size eff_hop_size! 2810 gen init-seg-len eff_seg_len! 2811 gen init-ramp-scale eff_ramp_scl! 2812 gen init-pitch-scale eff_pitch_scl! 2813 gen eff_sliders@ 0 array-ref gen init-time-scale 100.0 set-slider-value 2814 gen eff_sliders@ 1 array-ref gen init-size 100.0 set-slider-value 2815 gen eff_sliders@ 2 array-ref gen init-seg-len 100.0 set-slider-value 2816 gen eff_sliders@ 3 array-ref gen init-ramp-scale 100.0 set-slider-value 2817 gen eff_sliders@ 4 array-ref gen init-pitch-scale 100.0 set-slider-value 2818; 2819 2820: expsrc-ts-cb ( gen -- prc; w c i self -- ) 2821 3 proc-create swap , ( prc ) 2822 does> { w c info self -- } 2823 w info 100.0 get-slider-value { val } 2824 self @ ( gen ) val eff_time_scale! 2825; 2826 2827: expsrc-hs-cb ( gen -- prc; w c i self -- ) 2828 3 proc-create swap , ( prc ) 2829 does> { w c info self -- } 2830 w info 100.0 get-slider-value { val } 2831 self @ ( gen ) val eff_hop_size! 2832; 2833 2834: expsrc-sl-cb ( gen -- prc; w c i self -- ) 2835 3 proc-create swap , ( prc ) 2836 does> { w c info self -- } 2837 w info 100.0 get-slider-value { val } 2838 self @ ( gen ) val eff_seg_len! 2839; 2840 2841: expsrc-rs-cb ( gen -- prc; w c i self -- ) 2842 3 proc-create swap , ( prc ) 2843 does> { w c info self -- } 2844 w info 100.0 get-slider-value { val } 2845 self @ ( gen ) val eff_ramp_scl! 2846; 2847 2848: expsrc-ps-cb ( gen -- prc; w c i self -- ) 2849 3 proc-create swap , ( prc ) 2850 does> { w c info self -- } 2851 w info 100.0 get-slider-value { val } 2852 self @ ( gen ) val eff_pitch_scl! 2853; 2854 2855: post-expsrc-dialog ( gen -- prc; w c i self -- ) 2856 3 proc-create swap , ( prc ) 2857 does> { w c info self -- } 2858 self @ { gen } 2859 gen eff_dialog@ widget? unless 2860 gen eff_label@ gen expsrc-ok-cb gen eff_label@ "\ 2861Move the slider to change the time/pitch scaling parameter." help-cb 2862 gen expsrc-reset-cb gen general-target-cb 2863 make-effect-dialog { d } 2864 gen d eff_dialog! 2865 d #( #( "time scale" 0.0 gen eff_time_scale@ 5.0 2866 gen expsrc-ts-cb 100 ) 2867 #( "hop size" 0.0 gen eff_hop_size@ 1.0 2868 gen expsrc-hs-cb 100 ) 2869 #( "segment-length" 0.0 gen eff_seg_len@ 0.5 2870 gen expsrc-sl-cb 100 ) 2871 #( "ramp scale" 0.0 gen eff_ramp_scl@ 0.5 2872 gen expsrc-rs-cb 100 ) 2873 #( "pitch scale" 0.0 gen eff_pitch_scl@ 5.0 2874 gen expsrc-ps-cb 100 ) ) add-sliders ( sl ) 2875 gen swap eff_sliders! 2876 gen #f add-target 2877 then 2878 gen eff_dialog@ activate-dialog 2879; 2880set-current 2881 2882: make-expsrc-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2883 ( name ) make-base-effects { gen } 2884 gen 1.00 eff_time_scale! 2885 gen 0.05 eff_hop_size! 2886 gen 0.15 eff_seg_len! 2887 gen 0.50 eff_ramp_scl! 2888 gen 1.00 eff_pitch_scl! 2889 gen post-expsrc-dialog ( prc1 ) 2890 1 proc-create gen , ( prc2 ) 2891 does> { child self -- prc; self -- } 2892 0 proc-create self @ ( gen ) , child , ( prc ) 2893 does> { self -- } 2894 self @ { gen } 2895 self cell+ @ ( child ) "%s (%.2f %.2f)" 2896 #( gen eff_label@ gen eff_time_scale@ gen eff_pitch_scl@ ) 2897 string-format change-label 2898; 2899previous 2900 2901\ === Time-varying sample rate conversion (resample) === 2902\ (KSM) 2903 2904hide 2905: src-timevar-ok-cb ( gen -- prc; w c i self -- ) 2906 3 proc-create swap , ( prc ) 2907 does> { w c info self -- } 2908 self @ { gen } 2909 gen eff_enved@ xe-envelope gen eff_scl@ scale-envelope { en } 2910 gen eff_target@ 'sound = if 2911 en 1.0 #f #f #f src-sound drop 2912 else 2913 gen eff_target@ 'selection = if 2914 selected-sound #f selection-member? if 2915 en 1.0 src-selection drop 2916 else 2917 "no selection" undef status-report drop 2918 then 2919 else 2920 plausible-mark-samples { pts } 2921 pts if 2922 pts 0 array-ref { beg } 2923 pts 1 array-ref { end } 2924 end beg - { len } 2925 :envelope en :length len make-env beg len 2926 selected-sound #f #f src-channel drop 2927 else 2928 "no marks" undef status-report drop 2929 then 2930 then 2931 then 2932; 2933 2934: src-timevar-reset-cb { gen -- prc; w c i self -- } 2935 3 proc-create gen , gen eff_scl@ , ( prc ) 2936 does> { w c info self -- } 2937 self @ { gen } 2938 self cell+ @ { init } 2939 gen init eff_scl! 2940 gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope 2941 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 2942; 2943 2944: post-src-timevar-dialog ( gen -- prc; w c i self -- ) 2945 3 proc-create swap , ( prc ) 2946 does> { w c info self -- } 2947 self @ { gen } 2948 gen eff_dialog@ widget? unless 2949 gen eff_label@ gen src-timevar-ok-cb gen eff_label@ "\ 2950Move the slider to change the src-timevar scaling amount." help-cb 2951 gen src-timevar-reset-cb gen general-target-cb 2952 make-effect-dialog { d } 2953 gen d eff_dialog! 2954 d #( #( "Resample factor" 0.0 gen eff_scl@ 10.0 2955 gen scaler-slider-cb 100 ) ) add-sliders ( sl ) 2956 gen swap eff_sliders! 2957 gen make-enved-widget 2958 else 2959 gen eff_dialog@ activate-dialog 2960 then 2961; 2962set-current 2963 2964: make-src-timevar-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 2965 ( name ) make-base-effects { gen } 2966 gen 1.0 eff_scl! 2967 gen #f eff_enved! 2968 gen post-src-timevar-dialog ( prc1 ) 2969 1 proc-create gen , ( prc2 ) 2970 does> { child self -- prc; self -- } 2971 0 proc-create self @ ( gen ) , child , ( prc ) 2972 does> { self -- } 2973 self @ { gen } 2974 self cell+ @ ( child ) "Time-varying sample rate scaling" change-label 2975; 2976previous 2977 2978\ === MODULATION EFFECTS === 2979 2980\ === Amplitude modulation === 2981 2982hide 2983: am-func-cb ( gen -- prc; samps self -- prc ) 2984 1 proc-create swap , ( prc ) 2985 does> { samps self -- prc } 2986 self @ { gen } 2987 gen eff_amnt@ make-oscil { os } 2988 gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if 2989 #f 2990 else 2991 :envelope gen eff_enved@ xe-envelope :length gen eff_target@ 2992 effect-frames 1- make-env 2993 then { e } 2994 e if 2995 os e effects-am-env-cb 2996 else 2997 os effects-am-cb 2998 then 2999; 3000 3001: am-origin-cb ( gen -- prc; target samps self -- name origin ) 3002 2 proc-create swap , ( prc ) 3003 does> { target samps self -- name origin } 3004 self @ { gen } 3005 "effects-am" 3006 "%s %s" 3007 #( gen eff_amnt@ 3008 gen eff_enved@ 3009 xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if 3010 #f 3011 else 3012 gen eff_enved@ xe-envelope 3013 then ) string-format 3014; 3015 3016: am-ok-cb ( gen -- prc; w c i self -- ) 3017 3 proc-create swap , ( prc ) 3018 does> { w c info self -- } 3019 self @ { gen } 3020 gen am-func-cb gen eff_target@ gen am-origin-cb #f 3021 map-chan-over-target-with-sync 3022; 3023 3024: am-reset-cb { gen -- prc; w c i self -- } 3025 3 proc-create gen , gen eff_amnt@ , ( prc ) 3026 does> { w c info self -- } 3027 self @ { gen } 3028 self cell+ @ { init } 3029 gen init eff_amnt! 3030 gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope 3031 gen eff_sliders@ 0 array-ref init 1.0 set-slider-value 3032; 3033 3034: am-slider-cb ( gen -- prc; w c i self -- ) 3035 3 proc-create swap , ( prc ) 3036 does> { w c info self -- } 3037 w info 1.0 get-slider-value { val } 3038 self @ ( gen ) val eff_amnt! 3039; 3040 3041: post-am-effect-dialog ( gen -- prc; w c i self -- ) 3042 3 proc-create swap , ( prc ) 3043 does> { w c info self -- } 3044 self @ { gen } 3045 gen eff_dialog@ widget? unless 3046 gen eff_label@ gen am-ok-cb gen eff_label@ "\ 3047Move the slider to change the modulation amount." help-cb gen am-reset-cb 3048 gen general-target-cb make-effect-dialog { d } 3049 gen d eff_dialog! 3050 d #( #( "amplitude modulation" 0.0 gen eff_amnt@ 1000.0 3051 gen am-slider-cb 1 ) ) add-sliders ( sl ) 3052 gen swap eff_sliders! 3053 gen make-enved-widget 3054 else 3055 gen eff_dialog@ activate-dialog 3056 then 3057; 3058set-current 3059 3060: make-am-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3061 ( name ) make-base-effects { gen } 3062 gen 100.0 eff_amnt! 3063 gen #f eff_enved! 3064 gen post-am-effect-dialog ( prc1 ) 3065 1 proc-create gen , ( prc2 ) 3066 does> { child self -- prc; self -- } 3067 0 proc-create self @ ( gen ) , child , ( prc ) 3068 does> { self -- } 3069 self @ { gen } 3070 self cell+ @ ( child ) "%s (%.2f)" 3071 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 3072; 3073previous 3074 3075\ === Ring modulation === 3076 3077hide 3078: rm-func-cb ( gen -- prc; samps self -- prc ) 3079 1 proc-create swap , ( prc ) 3080 does> { samps self -- prc } 3081 self @ { gen } 3082 gen eff_freq@ make-oscil { os } 3083 gen eff_enved@ xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if 3084 #f 3085 else 3086 :envelope gen eff_enved@ xe-envelope 3087 :length gen eff_target@ effect-frames 1- make-env 3088 then { e } 3089 e if 3090 os e effects-rm-env-cb 3091 else 3092 os effects-rm-cb 3093 then 3094; 3095 3096: rm-origin-cb ( gen -- prc; target samps self -- name origin ) 3097 2 proc-create swap , ( prc ) 3098 does> { target samps self -- name origin } 3099 self @ { gen } 3100 "effects-rm" 3101 "%s %s" 3102 #( gen eff_freq@ 3103 gen eff_enved@ 3104 xe-envelope #( 0.0 1.0 1.0 1.0 ) equal? if 3105 #f 3106 else 3107 gen eff_enved@ xe-envelope 3108 then ) string-format 3109; 3110 3111: rm-ok-cb ( gen -- prc; w c i self -- ) 3112 3 proc-create swap , ( prc ) 3113 does> { w c info self -- } 3114 self @ { gen } 3115 gen rm-func-cb gen eff_target@ gen rm-origin-cb #f 3116 map-chan-over-target-with-sync 3117; 3118 3119: rm-reset-cb { gen -- prc; w c i self -- } 3120 3 proc-create gen , gen eff_freq@ , gen eff_scl@ , ( prc ) 3121 does> { w c info self -- } 3122 self @ { gen } 3123 self 1 cells + @ { init-freq } 3124 self 2 cells + @ { init-radians } 3125 gen init-freq eff_freq! 3126 gen init-radians eff_scl! 3127 gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope 3128 gen eff_sliders@ 0 array-ref init-freq 1.0 set-slider-value 3129 gen eff_sliders@ 1 array-ref init-radians 1.0 set-slider-value 3130; 3131 3132: rm-freq-cb ( gen -- prc; w c i self -- ) 3133 3 proc-create swap , ( prc ) 3134 does> { w c info self -- } 3135 w info 1.0 get-slider-value { val } 3136 self @ ( gen ) val eff_freq! 3137; 3138 3139: rm-radians-cb ( gen -- prc; w c i self -- ) 3140 3 proc-create swap , ( prc ) 3141 does> { w c info self -- } 3142 w info 1.0 get-slider-value { val } 3143 self @ ( gen ) val eff_scl! 3144; 3145 3146: post-rm-effect-dialog ( gen -- prc; w c i self -- ) 3147 3 proc-create swap , ( prc ) 3148 does> { w c info self -- } 3149 self @ { gen } 3150 gen eff_dialog@ widget? unless 3151 gen eff_label@ gen rm-ok-cb gen eff_label@ "\ 3152Move the slider to change ring modulation parameters." help-cb gen rm-reset-cb 3153 gen general-target-cb make-effect-dialog { d } 3154 gen d eff_dialog! 3155 d #( #( "modulation frequency" 0 gen eff_freq@ 1000 3156 gen rm-freq-cb 1 ) 3157 #( "modulation radians" 0 gen eff_scl@ 360 3158 gen rm-radians-cb 1 ) ) add-sliders ( sl ) 3159 gen swap eff_sliders! 3160 gen make-enved-widget 3161 else 3162 gen eff_dialog@ activate-dialog 3163 then 3164; 3165set-current 3166 3167: make-rm-effect-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3168 ( name ) make-base-effects { gen } 3169 gen 100.0 eff_freq! 3170 gen 100.0 eff_scl! 3171 gen #f eff_enved! 3172 gen post-rm-effect-dialog ( prc1 ) 3173 1 proc-create gen , ( prc2 ) 3174 does> { child self -- prc; self -- } 3175 0 proc-create self @ ( gen ) , child , ( prc ) 3176 does> { self -- } 3177 self @ { gen } 3178 self cell+ @ ( child ) "%s (%.2f %.2f)" 3179 #( gen eff_label@ gen eff_freq@ gen eff_scl@ ) 3180 string-format change-label 3181; 3182previous 3183 3184\ === REVERBS === 3185 3186\ === Reverb from Michael McNabb's Nrev === 3187 3188hide 3189: nrev-ok-cb ( gen -- prc; w c i self -- x ) 3190 3 proc-create swap , ( prc ) 3191 does> { w c info self -- x } 3192 self @ { gen } 3193 selected-sound { snd } 3194 snd save-controls drop 3195 snd reset-controls drop 3196 #t snd set-reverb-control? drop 3197 gen eff_amnt@ snd set-reverb-control-scale drop 3198 gen eff_rev_filter@ snd set-reverb-control-lowpass drop 3199 gen eff_rev_fb@ snd set-reverb-control-feedback drop 3200 gen eff_target@ 'marks = if 3201 plausible-mark-samples { pts } 3202 pts array? if 3203 snd 0 3204 pts 0 array-ref 3205 pts 1 array-ref 3206 pts 0 array-ref - 1+ apply-controls drop 3207 else 3208 "no marks" undef status-report drop 3209 then 3210 else 3211 snd gen eff_target@ 'sound = if 3212 0 3213 else 3214 2 3215 then undef undef apply-controls drop 3216 then 3217 snd restore-controls 3218; 3219 3220: nrev-reset-cb { gen -- prc; w c i self -- } 3221 3 proc-create ( prc ) 3222 gen , gen eff_amnt@ , gen eff_rev_filter@ , gen eff_rev_fb@ , 3223 does> { w c info self -- } 3224 self @ { gen } 3225 self 1 cells + @ { init-amount } 3226 self 2 cells + @ { init-filter } 3227 self 3 cells + @ { init-feedback } 3228 gen init-amount eff_amnt! 3229 gen init-filter eff_rev_filter! 3230 gen init-feedback eff_rev_fb! 3231 gen eff_sliders@ 0 array-ref init-amount 100.0 set-slider-value 3232 gen eff_sliders@ 1 array-ref init-filter 100.0 set-slider-value 3233 gen eff_sliders@ 2 array-ref init-feedback 100.0 set-slider-value 3234; 3235 3236: nrev-amount-cb ( gen -- prc; w c i self -- ) 3237 3 proc-create swap , ( prc ) 3238 does> { w c info self -- } 3239 w info 100.0 get-slider-value { val } 3240 self @ ( gen ) val eff_amnt! 3241; 3242 3243: nrev-filter-cb ( gen -- prc; w c i self -- ) 3244 3 proc-create swap , ( prc ) 3245 does> { w c info self -- } 3246 w info 100.0 get-slider-value { val } 3247 self @ ( gen ) val eff_rev_filter! 3248; 3249 3250: nrev-feedback-cb ( gen -- prc; w c i self -- ) 3251 3 proc-create swap , ( prc ) 3252 does> { w c info self -- } 3253 w info 100.0 get-slider-value { val } 3254 self @ ( gen ) val eff_rev_fb! 3255; 3256 3257: post-reverb-dialog ( gen -- prc; w c i self -- ) 3258 3 proc-create swap , ( prc ) 3259 does> { w c info self -- } 3260 self @ { gen } 3261 gen eff_dialog@ widget? unless 3262 gen eff_label@ gen nrev-ok-cb gen eff_label@ "\ 3263Reverberator from Michael McNabb. \ 3264Adds reverberation scaled by reverb amount, lowpass filtering, and feedback. \ 3265Move the sliders to change the reverb parameters." help-cb gen nrev-reset-cb 3266 gen general-target-cb make-effect-dialog { d } 3267 gen d eff_dialog! 3268 d #( #( "reverb amount" 0.0 gen eff_amnt@ 1.00 3269 gen nrev-amount-cb 100 ) 3270 #( "reverb filter" 0.0 gen eff_rev_filter@ 1.00 3271 gen nrev-filter-cb 100 ) 3272 #( "reverb feedback" 0.0 gen eff_rev_fb@ 1.25 3273 gen nrev-feedback-cb 100 ) ) add-sliders ( sl ) 3274 gen swap eff_sliders! 3275 gen #f add-target 3276 then 3277 gen eff_dialog@ activate-dialog 3278; 3279set-current 3280 3281: make-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3282 ( name ) make-base-effects { gen } 3283 gen 0.10 eff_amnt! 3284 gen 0.50 eff_rev_filter! 3285 gen 1.09 eff_rev_fb! 3286 gen post-reverb-dialog ( prc1 ) 3287 1 proc-create gen , ( prc2 ) 3288 does> { child self -- prc; self -- } 3289 0 proc-create self @ ( gen ) , child , ( prc ) 3290 does> { self -- } 3291 self @ { gen } 3292 self cell+ @ ( child ) "%s (%.2f %.2f %.2f)" 3293 #( gen eff_label@ 3294 gen eff_amnt@ 3295 gen eff_rev_filter@ 3296 gen eff_rev_fb@ ) string-format change-label 3297; 3298previous 3299 3300\ === Chowning reverb === 3301 3302hide 3303: jc-func-cb ( gen -- prc; samps self -- prc ) 3304 1 proc-create swap , ( prc ) 3305 does> { samps self -- prc } 3306 self @ { gen } 3307 samps gen eff_rev_vol@ effects-jc-reverb 3308; 3309 3310: jc-origin-cb ( gen -- prc; target samps self -- name origin ) 3311 2 proc-create swap , ( prc ) 3312 does> { target samps self -- name origin } 3313 self @ { gen } 3314 "effects-jc-reverb-1" 3315 gen eff_rev_vol@ number->string 3316; 3317 3318: jc-ok-cb ( gen -- prc; w c i self -- ) 3319 3 proc-create swap , ( prc ) 3320 does> { w c info self -- } 3321 self @ { gen } 3322 gen jc-func-cb gen eff_target@ gen jc-origin-cb gen eff_trunc@ if 3323 #f 3324 else 3325 gen eff_rev_decay@ 3326 then map-chan-over-target-with-sync 3327; 3328 3329: jc-reset-cb { gen -- prc; w c i self -- } 3330 3 proc-create ( prc ) 3331 gen , gen eff_rev_decay@ , gen eff_rev_vol@ , 3332 does> { w c info self -- } 3333 self @ { gen } 3334 self 1 cells + @ { init-decay } 3335 self 2 cells + @ { init-volume } 3336 gen init-decay eff_rev_decay! 3337 gen init-volume eff_rev_vol! 3338 gen eff_sliders@ 0 array-ref init-decay 100.0 set-slider-value 3339 gen eff_sliders@ 1 array-ref init-volume 100.0 set-slider-value 3340; 3341 3342: jc-decay-cb ( gen -- prc; w c i self -- ) 3343 3 proc-create swap , ( prc ) 3344 does> { w c info self -- } 3345 w info 100.0 get-slider-value { val } 3346 self @ ( gen ) val eff_rev_decay! 3347; 3348 3349: jc-volume-cb ( gen -- prc; w c i self -- ) 3350 3 proc-create swap , ( prc ) 3351 does> { w c info self -- } 3352 w info 100.0 get-slider-value { val } 3353 self @ ( gen ) val eff_rev_vol! 3354; 3355 3356: post-jc-reverb-dialog ( gen -- prc; w c i self -- ) 3357 3 proc-create swap , ( prc ) 3358 does> { w c info self -- } 3359 self @ { gen } 3360 gen eff_dialog@ widget? unless 3361 gen eff_label@ gen jc-ok-cb gen eff_label@ "\ 3362Nice reverb from John Chowning. \ 3363Move the sliders to set the reverb parameters." help-cb gen jc-reset-cb 3364 gen general-target-cb make-effect-dialog { d } 3365 gen d eff_dialog! 3366 d #( #( "decay duration" 0.0 gen eff_rev_decay@ 10.0 3367 gen jc-decay-cb 100 ) 3368 #( "reverb volume" 0.0 gen eff_rev_vol@ 1.00 3369 gen jc-volume-cb 100 ) ) add-sliders ( sl ) 3370 gen swap eff_sliders! 3371 gen <'> truncate-cb add-target 3372 then 3373 gen eff_dialog@ activate-dialog 3374; 3375set-current 3376 3377: make-jc-reverb-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3378 ( name ) make-base-effects { gen } 3379 gen 2.0 eff_rev_decay! 3380 gen 0.1 eff_rev_vol! 3381 gen post-jc-reverb-dialog ( prc1 ) 3382 1 proc-create gen , ( prc2 ) 3383 does> { child self -- prc; self -- } 3384 0 proc-create self @ ( gen ) , child , ( prc ) 3385 does> { self -- } 3386 self @ { gen } 3387 self cell+ @ ( child ) "%s (%.2f %.2f)" 3388 #( gen eff_label@ gen eff_rev_decay@ gen eff_rev_vol@ ) 3389 string-format change-label 3390; 3391previous 3392 3393\ === Convolution === 3394 3395hide 3396: cnv-ok-cb ( gen -- prc; w c i self -- x ) 3397 3 proc-create swap , ( prc ) 3398 does> { w c info self -- x } 3399 self @ { gen } 3400 gen eff_conv_one@ { snd1 } 3401 gen eff_conv_two@ { snd2 } 3402 snd1 sound? if 3403 snd2 sound? if 3404 snd1 gen eff_amp@ snd2 #f effects-cnv 3405 else 3406 "no such sound two: %S" #( snd2 ) 3407 string-format undef status-report 3408 then 3409 else 3410 "no such sound one: %S" 3411 #( snd1 ) string-format undef status-report 3412 then 3413; 3414 3415: cnv-reset-cb { gen -- prc; w c i self -- } 3416 3 proc-create ( prc ) 3417 gen , gen eff_conv_one@ , gen eff_conv_two@ , gen eff_amp@ , 3418 does> { w c info self -- } 3419 self @ { gen } 3420 self 1 cells + @ { init-one } 3421 self 2 cells + @ { init-two } 3422 self 3 cells + @ { init-amp } 3423 gen init-one eff_conv_one! 3424 gen init-two eff_conv_two! 3425 gen init-amp eff_amp! 3426 gen eff_sliders@ 0 array-ref init-one 1.0 set-slider-value 3427 gen eff_sliders@ 1 array-ref init-two 1.0 set-slider-value 3428 gen eff_sliders@ 2 array-ref init-amp 100.0 set-slider-value 3429; 3430 3431: cnv-one-cb ( gen -- prc; w c i self -- ) 3432 3 proc-create swap , ( prc ) 3433 does> { w c info self -- } 3434 w info 1.0 get-slider-value { val } 3435 self @ ( gen ) val eff_conv_one! 3436; 3437 3438: cnv-two-cb ( gen -- prc; w c i self -- ) 3439 3 proc-create swap , ( prc ) 3440 does> { w c info self -- } 3441 w info 1.0 get-slider-value { val } 3442 self @ ( gen ) val eff_conv_two! 3443; 3444 3445: post-convolve-dialog ( gen -- prc; w c i self -- ) 3446 3 proc-create swap , ( prc ) 3447 does> { w c info self -- } 3448 self @ { gen } 3449 gen eff_dialog@ widget? unless 3450 gen eff_label@ gen cnv-ok-cb gen eff_label@ "\ 3451Very simple convolution. \ 3452Move the sliders to set the reverb parameters the numbers of the soundfiles \ 3453to be convolved and the amount for the amplitude scaler. \ 3454Output will be scaled to floating-point values, \ 3455resulting in very large (but not clipped) amplitudes. \ 3456Use the Normalize amplitude effect to rescale the output. \ 3457The convolution data file typically defines a natural reverberation source, \ 3458and the output from this effect can provide very striking reverb effects. \ 3459You can find convolution data files on sites listed at \ 3460http://www.bright.net/~dlphilp/linux_csound.html under Impulse Response Data." 3461 help-cb gen cnv-reset-cb #f make-effect-dialog { d } 3462 gen d eff_dialog! 3463 d #( #( "impulse response file" 0 gen eff_conv_one@ 24 3464 gen cnv-one-cb 1 ) 3465 #( "sound file" 0 gen eff_conv_two@ 24 3466 gen cnv-two-cb 1 ) 3467 #( "amplitude" 0.0 gen eff_amp@ 0.10 3468 gen amplitude-slider-cb 100 ) ) add-sliders ( sl ) 3469 gen swap eff_sliders! 3470 then 3471 gen eff_dialog@ activate-dialog 3472; 3473set-current 3474 3475: make-convolve-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3476 ( name ) make-base-effects { gen } 3477 gen 0 eff_conv_one! 3478 gen 1 eff_conv_two! 3479 gen 0.01 eff_amp! 3480 gen post-convolve-dialog ( prc1 ) 3481 1 proc-create gen , ( prc2 ) 3482 does> { child self -- prc; self -- } 3483 0 proc-create self @ ( gen ) , child , ( prc ) 3484 does> { self -- } 3485 self @ { gen } 3486 self cell+ @ ( child ) "%s (%d %d %.2f)" 3487 #( gen eff_label@ gen eff_conv_one@ gen eff_conv_two@ gen eff_amp@ ) 3488 string-format change-label 3489; 3490previous 3491 3492\ === VARIOUS AND MISCELLANEOUS === 3493 3494\ === Place sound === 3495 3496hide 3497: ps-ok-cb ( gen -- prc; w c i self -- x ) 3498 3 proc-create swap , ( prc ) 3499 does> { w c info self -- x } 3500 self @ { gen } 3501 gen eff_enved@ xe-envelope { e } 3502 e #( 0.0 1.0 1.0 1.0 ) equal? if 3503 gen eff_m_snd@ gen eff_s_snd@ gen eff_pan_pos@ 3504 else 3505 gen eff_m_snd@ gen eff_s_snd@ e 3506 then effects-place-sound 3507; 3508 3509: ps-reset-cb { gen -- prc; w c i self -- } 3510 3 proc-create ( prc ) 3511 gen , gen eff_m_snd@ , gen eff_s_snd@ , gen eff_pan_pos@ , 3512 does> { w c info self -- } 3513 self @ { gen } 3514 self 1 cells + @ { init-mono } 3515 self 2 cells + @ { init-stereo } 3516 self 3 cells + @ { init-pos } 3517 gen init-mono eff_m_snd! 3518 gen init-stereo eff_s_snd! 3519 gen init-pos eff_pan_pos! 3520 gen eff_enved@ #( 0.0 1.0 1.0 1.0 ) set-xe-envelope 3521 gen eff_sliders@ 0 array-ref init-mono 1.0 set-slider-value 3522 gen eff_sliders@ 1 array-ref init-stereo 1.0 set-slider-value 3523 gen eff_sliders@ 2 array-ref init-pos 1.0 set-slider-value 3524; 3525 3526: ps-mono-cb ( gen -- prc; w c i self -- ) 3527 3 proc-create swap , ( prc ) 3528 does> { w c info self -- } 3529 w info 1.0 get-slider-value { val } 3530 self @ ( gen ) val eff_m_snd! 3531; 3532 3533: ps-stereo-cb ( gen -- prc; w c i self -- ) 3534 3 proc-create swap , ( prc ) 3535 does> { w c info self -- } 3536 w info 1.0 get-slider-value { val } 3537 self @ ( gen ) val eff_s_snd! 3538; 3539 3540: ps-pos-cb ( gen -- prc; w c i self -- ) 3541 3 proc-create swap , ( prc ) 3542 does> { w c info self -- } 3543 w info 1.0 get-slider-value { val } 3544 self @ ( gen ) val eff_pan_pos! 3545; 3546 3547: post-place-sound-dialog ( gen -- prc; w c i self -- ) 3548 3 proc-create swap , ( prc ) 3549 does> { w c info self -- } 3550 self @ { gen } 3551 gen eff_dialog@ widget? unless 3552 gen eff_label@ gen ps-ok-cb gen eff_label@ "\ 3553Mixes mono sound into stereo sound field." help-cb gen ps-reset-cb 3554 gen general-target-cb make-effect-dialog { d } 3555 gen d eff_dialog! 3556 d #( #( "mono sound" 0 gen eff_m_snd@ 50 3557 gen ps-mono-cb 1 ) 3558 #( "stereo sound" 0 gen eff_s_snd@ 50 3559 gen ps-stereo-cb 1 ) 3560 #( "pan position" 0 gen eff_pan_pos@ 90 3561 gen ps-pos-cb 1 ) ) add-sliders ( sl ) 3562 gen swap eff_sliders! 3563 gen make-enved-widget 3564 else 3565 gen eff_dialog@ activate-dialog 3566 then 3567; 3568set-current 3569 3570: make-place-sound-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3571 ( name ) make-base-effects { gen } 3572 gen 0 eff_m_snd! 3573 gen 1 eff_s_snd! 3574 gen 45 eff_pan_pos! 3575 gen post-place-sound-dialog ( prc1 ) 3576 1 proc-create gen , ( prc2 ) 3577 does> { child self -- prc; self -- } 3578 0 proc-create self @ ( gen ) , child , ( prc ) 3579 does> { self -- } 3580 self @ { gen } 3581 self cell+ @ ( child ) "%s (%d %d %d)" 3582 #( gen eff_label@ gen eff_m_snd@ gen eff_s_snd@ gen eff_pan_pos@ ) 3583 string-format change-label 3584; 3585previous 3586 3587\ === Insert silence (at cursor, silence-amount in secs) === 3588 3589hide 3590: silence-ok-cb ( gen -- prc; w c i self -- ) 3591 3 proc-create swap , ( prc ) 3592 does> { w c info self -- } 3593 self @ { gen } 3594 #f #f #f cursor #f srate gen eff_amnt@ f* f>s #f #f insert-silence drop 3595; 3596 3597: silence-reset-cb { gen -- prc; w c i self -- } 3598 3 proc-create gen , gen eff_amnt@ , ( prc ) 3599 does> { w c info self -- } 3600 self @ { gen } 3601 self 1 cells + @ { init } 3602 gen init eff_amnt! 3603 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 3604; 3605 3606: silence-amount-cb ( gen -- prc; w c i self -- ) 3607 3 proc-create swap , ( prc ) 3608 does> { w c info self -- } 3609 w info 100.0 get-slider-value { val } 3610 self @ ( gen ) val eff_amnt! 3611; 3612 3613: post-silence-dialog ( gen -- prc; w c i self -- ) 3614 3 proc-create swap , ( prc ) 3615 does> { w c info self -- } 3616 self @ { gen } 3617 gen eff_dialog@ widget? unless 3618 gen eff_label@ gen silence-ok-cb gen eff_label@ "\ 3619Move the slider to change the number of seconds \ 3620of silence added at the cursor position." help-cb gen silence-reset-cb 3621 #f make-effect-dialog { d } 3622 gen d eff_dialog! 3623 d #( #( "silence" 0.0 gen eff_amnt@ 5.0 3624 gen silence-amount-cb 100 ) ) add-sliders ( sl ) 3625 gen swap eff_sliders! 3626 then 3627 gen eff_dialog@ activate-dialog 3628; 3629set-current 3630 3631: make-silence-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3632 ( name ) make-base-effects { gen } 3633 gen 1.0 eff_amnt! 3634 gen post-silence-dialog ( prc1 ) 3635 1 proc-create gen , ( prc2 ) 3636 does> { child self -- prc; self -- } 3637 0 proc-create self @ ( gen ) , child , ( prc ) 3638 does> { self -- } 3639 self @ { gen } 3640 self cell+ @ ( child ) "%s (%.2f)" 3641 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 3642; 3643previous 3644 3645\ === Contrast (brightness control) === 3646 3647hide 3648: contrast-ok-cb ( gen -- prc; w c i self -- x ) 3649 3 proc-create swap , ( prc ) 3650 does> { w c info self -- x } 3651 self @ { gen } 3652 #f #f #f maxamp { peak } 3653 selected-sound { snd } 3654 snd save-controls drop 3655 snd reset-controls drop 3656 #t snd set-contrast-control? drop 3657 gen eff_amnt@ snd set-contrast-control drop 3658 peak 1/f snd set-contrast-control-amp drop 3659 peak snd #f set-amp-control drop 3660 gen eff_target@ 'marks = if 3661 plausible-mark-samples { pts } 3662 pts if 3663 snd 0 3664 pts 0 array-ref 3665 pts 1 array-ref 3666 pts 0 array-ref - 1+ apply-controls drop 3667 else 3668 "no marks" undef status-report drop 3669 then 3670 else 3671 snd gen eff_target@ 'sound = if 3672 0 3673 else 3674 2 3675 then 0 undef apply-controls drop 3676 then 3677 snd restore-controls 3678; 3679 3680: contrast-reset-cb { gen -- prc; w c i self -- } 3681 3 proc-create gen , gen eff_amnt@ , ( prc ) 3682 does> { w c info self -- } 3683 self @ { gen } 3684 self 1 cells + @ { init } 3685 gen init eff_amnt! 3686 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 3687; 3688 3689: contrast-amount-cb ( gen -- prc; w c i self -- ) 3690 3 proc-create swap , ( prc ) 3691 does> { w c info self -- } 3692 w info 100.0 get-slider-value { val } 3693 self @ ( gen ) val eff_amnt! 3694; 3695 3696: post-contrast-dialog ( gen -- prc; w c i self -- ) 3697 3 proc-create swap , ( prc ) 3698 does> { w c info self -- } 3699 self @ { gen } 3700 gen eff_dialog@ widget? unless 3701 gen eff_label@ gen contrast-ok-cb gen eff_label@ "\ 3702Move the slider to change the contrast intensity." help-cb 3703 gen contrast-reset-cb gen general-target-cb 3704 make-effect-dialog { d } 3705 gen d eff_dialog! 3706 d #( #( "contrast enhancement" 0.0 gen eff_amnt@ 10.0 3707 gen contrast-amount-cb 100 ) ) add-sliders ( sl ) 3708 gen swap eff_sliders! 3709 gen #f add-target 3710 then 3711 gen eff_dialog@ activate-dialog 3712; 3713set-current 3714 3715: make-contrast-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3716 ( name ) make-base-effects { gen } 3717 gen 1.0 eff_amnt! 3718 gen post-contrast-dialog ( prc1 ) 3719 1 proc-create gen , ( prc2 ) 3720 does> { child self -- prc; self -- } 3721 0 proc-create self @ ( gen ) , child , ( prc ) 3722 does> { self -- } 3723 self @ { gen } 3724 self cell+ @ ( child ) "%s (%.2f)" 3725 #( gen eff_label@ gen eff_amnt@ ) string-format change-label 3726; 3727previous 3728 3729\ === Cross synthesis === 3730 3731hide 3732: cs-func-cb ( gen -- prc; samps self -- prc ) 3733 1 proc-create swap , ( prc ) 3734 does> { samps self -- prc } 3735 self @ { gen } 3736 gen eff_cs_snd@ gen eff_amp@ gen eff_size@ gen eff_cs_radius@ 3737 effects-cross-synthesis 3738; 3739 3740: cs-origin-cb ( gen -- prc; target samps self -- name origin ) 3741 2 proc-create swap , ( prc ) 3742 does> { target samps self -- name origin } 3743 self @ { gen } 3744 "effects-cross-synthesis-1" 3745 "%s %s %s %s" 3746 #( gen eff_cs_snd@ gen eff_amp@ gen eff_size@ gen eff_cs_radius@ ) 3747 string-format 3748; 3749 3750: cs-ok-cb ( gen -- prc; w c i self -- ) 3751 3 proc-create swap , ( prc ) 3752 does> { w c info self -- } 3753 self @ { gen } 3754 gen cs-func-cb gen eff_target@ gen cs-origin-cb #f 3755 map-chan-over-target-with-sync 3756; 3757 3758: cs-set-state ( wid -- ) 3759 use-combo-box-for-fft-size if 3760 #( FXmNselectedPosition 1 ) FXtVaSetValues 3761 else 3762 #t #t FXmToggleButtonSetState 3763 then drop 3764; 3765 3766: cs-reset-cb { gen -- prc; w c i self -- } 3767 3 proc-create ( prc ) 3768 gen , gen eff_cs_snd@ , gen eff_amp@ , 3769 gen eff_size@ , gen eff_cs_radius@ , 3770 does> { w c info self -- } 3771 self @ { gen } 3772 self 1 cells + @ { init-snd } 3773 self 2 cells + @ { init-amp } 3774 self 3 cells + @ { init-size } 3775 self 4 cells + @ { init-rad } 3776 gen init-snd eff_cs_snd! 3777 gen init-amp eff_amp! 3778 gen init-size eff_size! 3779 gen init-rad eff_cs_radius! 3780 gen eff_sliders@ 0 array-ref init-snd 1.0 set-slider-value 3781 gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value 3782 gen eff_sliders@ 2 array-ref init-rad 100.0 set-slider-value 3783 gen eff_cs_wid@ cs-set-state 3784; 3785 3786: cs-snd-cb ( gen -- prc; w c i self -- ) 3787 3 proc-create swap , ( prc ) 3788 does> { w c info self -- } 3789 w info 1.0 get-slider-value { val } 3790 self @ ( gen ) val eff_cs_snd! 3791; 3792 3793: cs-rad-cb ( gen -- prc; w c i self -- ) 3794 3 proc-create swap , ( prc ) 3795 does> { w c info self -- } 3796 w info 100.0 get-slider-value { val } 3797 self @ ( gen ) val eff_cs_radius! 3798; 3799 3800: cs-sel-cb ( gen -- prc; w c i self -- ) 3801 3 proc-create swap , ( prc ) 3802 does> { w c info self -- } 3803 info Fitem_or_text ( selected ) #f FXmCHARSET_TEXT 3804 FXmCHARSET_TEXT #f 0 FXmOUTPUT_ALL 3805 FXmStringUnparse ( size-as-str ) string->number { val } 3806 self @ ( gen ) val eff_size! 3807; 3808 3809: cs-sel-changed-cb ( gen -- prc; w c i self -- ) 3810 3 proc-create swap , ( prc ) 3811 does> { w size info self -- } 3812 info Fset if 3813 self @ ( gen ) size eff_size! 3814 then 3815; 3816 3817: cs-sel-create-sel { gen -- } 3818 #( 64 128 256 512 1024 4096 ) { sizes } 3819 "FFT size" FXmStringCreateLocalized { s1 } 3820 gen eff_sliders@ 0 array-ref "frame" 3821 FXtParent 3822 #( FXmNborderWidth 1 FXmNshadowType 3823 FXmSHADOW_ETCHED_IN FXmNpositionIndex 2 ) 3824 FXmVaCreateManagedFrame { frame } 3825 frame "frm" 3826 #( FXmNleftAttachment FXmATTACH_FORM 3827 FXmNrightAttachment FXmATTACH_FORM 3828 FXmNtopAttachment FXmATTACH_FORM 3829 FXmNbottomAttachment FXmATTACH_FORM 3830 FXmNbackground basic-color ) 3831 FXmVaCreateManagedForm { frm } 3832 use-combo-box-for-fft-size if 3833 frm "FFT size" 3834 #( FXmNleftAttachment FXmATTACH_FORM 3835 FXmNrightAttachment FXmATTACH_NONE 3836 FXmNtopAttachment FXmATTACH_FORM 3837 FXmNbottomAttachment FXmATTACH_FORM 3838 FXmNlabelString s1 3839 FXmNbackground basic-color ) 3840 FXmVaCreateManagedLabel { lab } 3841 sizes map! 3842 *key* number->string FXmStringCreateLocalized 3843 end-map { fft-labels } 3844 frm "fftsize" 3845 #( FXmNleftAttachment FXmATTACH_WIDGET 3846 FXmNleftWidget lab 3847 FXmNrightAttachment FXmATTACH_FORM 3848 FXmNtopAttachment FXmATTACH_FORM 3849 FXmNbottomAttachment FXmATTACH_FORM 3850 FXmNitems fft-labels 3851 FXmNitemCount fft-labels length 3852 FXmNcomboBoxType FXmDROP_DOWN_COMBO_BOX 3853 FXmNbackground basic-color ) 3854 FXmVaCreateManagedComboBox { combo } 3855 gen combo eff_cs_wid! 3856 fft-labels each ( s ) 3857 FXmStringFree drop 3858 end-each 3859 combo #( FXmNselectedPosition 1 ) FXtVaSetValues drop 3860 combo FXmNselectionCallback gen cs-sel-cb undef 3861 FXtAddCallback drop 3862 else 3863 frm "rc" 3864 #( FXmNorientation FXmHORIZONTAL 3865 FXmNradioBehavior #t 3866 FXmNradioAlwaysOne #t 3867 FXmNentryClass FxmToggleButtonWidgetClass 3868 FXmNisHomogeneous #t 3869 FXmNleftAttachment FXmATTACH_FORM 3870 FXmNrightAttachment FXmATTACH_FORM 3871 FXmNtopAttachment FXmATTACH_FORM 3872 FXmNbottomAttachment FXmATTACH_NONE 3873 FXmNbackground basic-color ) 3874 FXmVaCreateManagedRowColumn { rc } 3875 frm "FFT size" 3876 #( FXmNleftAttachment FXmATTACH_FORM 3877 FXmNrightAttachment FXmATTACH_FORM 3878 FXmNtopAttachment FXmATTACH_WIDGET 3879 FXmNtopWidget rc 3880 FXmNbottomAttachment FXmATTACH_FORM 3881 FXmNlabelString s1 3882 FXmNalignment FXmALIGNMENT_BEGINNING 3883 FXmNbackground basic-color ) 3884 FXmVaCreateManagedLabel { lab } 3885 sizes each { size } 3886 rc size number->string 3887 #( FXmNbackground basic-color 3888 FXmNvalueChangedCallback 3889 #( gen cs-sel-changed-cb size ) 3890 FXmNset size gen eff_size@ = ) 3891 FXmVaCreateManagedToggleButton { button } 3892 size gen eff_size@ = if 3893 gen button eff_cs_wid! 3894 then 3895 end-each 3896 then 3897 s1 FXmStringFree drop 3898; 3899 3900: post-cross-synth-dialog ( gen -- prc; w c i self -- ) 3901 3 proc-create swap , ( prc ) 3902 does> { w c info self -- } 3903 self @ { gen } 3904 gen eff_dialog@ widget? unless 3905 gen eff_label@ gen cs-ok-cb gen eff_label@ "\ 3906The sliders set the number of the soundfile to be cross-synthesized, \ 3907the synthesis amplitude, the FFT size, and the radius value." help-cb 3908 gen cs-reset-cb gen general-target-cb 3909 make-effect-dialog { d } 3910 gen d eff_dialog! 3911 d #( #( "input sound" 0 gen eff_cs_snd@ 20 3912 gen cs-snd-cb 1 ) 3913 #( "amplitude" 0.0 gen eff_amp@ 1.0 3914 gen amplitude-slider-cb 100 ) 3915 #( "radius" 0.0 gen eff_cs_radius@ 360.0 3916 gen cs-rad-cb 100 ) ) add-sliders ( sl ) 3917 gen swap eff_sliders! 3918 gen cs-sel-create-sel 3919 gen #f add-target 3920 then 3921 gen eff_dialog@ activate-dialog 3922; 3923set-current 3924 3925: make-cross-synth-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 3926 ( name ) make-base-effects { gen } 3927 gen 1 eff_cs_snd! 3928 gen 0.5 eff_amp! 3929 gen 128 eff_size! 3930 gen 6.0 eff_cs_radius! 3931 gen #f eff_cs_wid! 3932 gen post-cross-synth-dialog ( prc1 ) 3933 1 proc-create gen , ( prc2 ) 3934 does> { child self -- prc; self -- } 3935 0 proc-create self @ ( gen ) , child , ( prc ) 3936 does> { self -- } 3937 self @ { gen } 3938 self cell+ @ ( child ) "%s (%d %.2f %d %.2f)" 3939 #( gen eff_label@ 3940 gen eff_cs_snd@ 3941 gen eff_amp@ 3942 gen eff_size@ 3943 gen eff_cs_radius@ ) string-format change-label 3944; 3945previous 3946 3947\ === Flange and phasing === 3948 3949hide 3950: flange-func-cb ( gen -- prc; samps self -- prc; self -- ) 3951 1 proc-create swap , ( prc ) 3952 does> { samps self -- prc } 3953 self @ { gen } 3954 :frequency gen eff_fl_speed@ 3955 :amplitude gen eff_amnt@ make-rand-interp { ri } 3956 gen eff_fl_time@ #f srate f* fround->s { len } 3957 :size len :max-size gen eff_amnt@ 1.0 len f+ f+ f>s make-delay { del } 3958 1 proc-create del , ri , ( prc ) 3959 does> { inval self -- res } 3960 self @ ( del ) inval self cell+ @ ( ri ) 0.0 rand-interp 3961 delay inval f+ 0.75 f* 3962; 3963 3964: flange-origin-cb ( gen -- prc; target samps self -- name origin ) 3965 2 proc-create swap , ( prc ) 3966 does> { target samps self -- name origin } 3967 self @ { gen } 3968 "effects-flange" 3969 "%s %s %s" 3970 #( gen eff_amnt@ gen eff_fl_speed@ gen eff_fl_time@ ) string-format 3971; 3972 3973: flange-ok-cb ( gen -- prc; w c i self -- ) 3974 3 proc-create swap , ( prc ) 3975 does> { w c info self -- } 3976 self @ { gen } 3977 gen flange-func-cb gen eff_target@ gen flange-origin-cb #f 3978 map-chan-over-target-with-sync 3979; 3980 3981: flange-reset-cb { gen -- prc; w c i self -- } 3982 3 proc-create ( prc ) 3983 gen , gen eff_fl_speed@ , gen eff_amnt@ , gen eff_fl_time@ , 3984 does> { w c info self -- } 3985 self @ { gen } 3986 self 1 cells + @ { init-speed } 3987 self 2 cells + @ { init-amount } 3988 self 3 cells + @ { init-time } 3989 gen init-speed eff_fl_speed! 3990 gen init-amount eff_amnt! 3991 gen init-time eff_fl_time! 3992 gen eff_sliders@ 0 array-ref init-speed 10.0 set-slider-value 3993 gen eff_sliders@ 1 array-ref init-amount 10.0 set-slider-value 3994 gen eff_sliders@ 2 array-ref init-time 100.0 set-slider-value 3995; 3996 3997: flange-speed-cb ( gen -- prc; w c i self -- ) 3998 3 proc-create swap , ( prc ) 3999 does> { w c info self -- } 4000 w info 10.0 get-slider-value { val } 4001 self @ ( gen ) val eff_fl_speed! 4002; 4003 4004: flange-amount-cb ( gen -- prc; w c i self -- ) 4005 3 proc-create swap , ( prc ) 4006 does> { w c info self -- } 4007 w info 10.0 get-slider-value { val } 4008 self @ ( gen ) val eff_amnt! 4009; 4010 4011: flange-time-cb ( gen -- prc; w c i self -- ) 4012 3 proc-create swap , ( prc ) 4013 does> { w c info self -- } 4014 w info 100.0 get-slider-value { val } 4015 self @ ( gen ) val eff_fl_time! 4016; 4017 4018: post-flange-dialog ( gen -- prc; w c i self -- ) 4019 3 proc-create swap , ( prc ) 4020 does> { w c info self -- } 4021 self @ { gen } 4022 gen eff_dialog@ widget? unless 4023 gen eff_label@ gen flange-ok-cb gen eff_label@ "\ 4024Move the slider to change the flange speed, amount, and time." help-cb 4025 gen flange-reset-cb gen general-target-cb 4026 make-effect-dialog { d } 4027 gen d eff_dialog! 4028 d #( #( "flange speed" 0.0 gen eff_fl_speed@ 100.0 4029 gen flange-speed-cb 10 ) 4030 #( "flange amount" 0.0 gen eff_amnt@ 100.0 4031 gen flange-amount-cb 10 ) 4032 #( "flange time" 0.0 gen eff_fl_time@ 1.0 4033 gen flange-time-cb 100 ) ) add-sliders ( sl ) 4034 gen swap eff_sliders! 4035 gen #f add-target 4036 then 4037 gen eff_dialog@ activate-dialog 4038; 4039set-current 4040 4041: make-flange-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 4042 ( name ) make-base-effects { gen } 4043 gen 2.000 eff_fl_speed! 4044 gen 5.000 eff_amnt! 4045 gen 0.001 eff_fl_time! 4046 gen post-flange-dialog ( prc1 ) 4047 1 proc-create gen , ( prc2 ) 4048 does> { child self -- prc; self -- } 4049 0 proc-create self @ ( gen ) , child , ( prc ) 4050 does> { self -- } 4051 self @ { gen } 4052 self cell+ @ ( child ) "%s (%.2f %.2f %.2f)" 4053 #( gen eff_label@ gen eff_fl_speed@ gen eff_amnt@ gen eff_fl_time@ ) 4054 string-format change-label 4055; 4056previous 4057 4058\ === Randomize phase === 4059 4060hide 4061: random-phase-cb ( scl -- prc; x self -- res ) 4062 1 proc-create swap , ( prc ) 4063 does> { x self -- res } 4064 self @ ( scl ) random 4065; 4066 4067: rp-ok-cb ( gen -- prc; w c i self -- res ) 4068 3 proc-create swap , ( prc ) 4069 does> { w c info self -- res } 4070 self @ { gen } 4071 gen eff_scl@ random-phase-cb { prc } 4072 \ edit-list->function needs a usable proc-source-string 4073 prc "%s random-phase-cb" gen eff_scl@ string-format proc-source-set! 4074 prc #f #f rotate-phase 4075; 4076 4077: rp-reset-cb { gen -- prc; w c i self -- } 4078 3 proc-create gen , gen eff_scl@ , ( prc ) 4079 does> { w c info self -- } 4080 self @ { gen } 4081 self 1 cells + @ { init } 4082 gen init eff_scl! 4083 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 4084; 4085 4086: post-random-phase-dialog ( gen -- prc; w c i self -- ) 4087 3 proc-create swap , ( prc ) 4088 does> { w c info self -- } 4089 self @ { gen } 4090 gen eff_dialog@ widget? unless 4091 gen eff_label@ gen rp-ok-cb gen eff_label@ "\ 4092Move the slider to change the randomization amplitude scaler." help-cb 4093 gen rp-reset-cb #f make-effect-dialog { d } 4094 gen d eff_dialog! 4095 d #( #( "amplitude scaler" 0.0 gen eff_scl@ 100.0 4096 gen scaler-slider-cb 100 ) ) add-sliders ( sl ) 4097 gen swap eff_sliders! 4098 then 4099 gen eff_dialog@ activate-dialog 4100; 4101set-current 4102 4103: make-random-phase-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 4104 ( name ) make-base-effects { gen } 4105 gen 3.14 eff_scl! 4106 gen post-random-phase-dialog ( prc1 ) 4107 1 proc-create gen , ( prc2 ) 4108 does> { child self -- prc; self -- } 4109 0 proc-create self @ ( gen ) , child , ( prc ) 4110 does> { self -- } 4111 self @ { gen } 4112 self cell+ @ ( child ) "%s (%.2f)" 4113 #( gen eff_label@ gen eff_scl@ ) string-format change-label 4114; 4115previous 4116 4117\ === Robotize === 4118 4119hide 4120: robotize-ok-cb ( gen -- prc; w c i self -- res ) 4121 3 proc-create swap , ( prc ) 4122 does> { w c info self -- res } 4123 self @ { gen } 4124 gen eff_sr@ gen eff_amp@ gen eff_freq@ \ beg dur follows 4125 gen eff_target@ 'sound = if 4126 0 #f #f #f framples 4127 else 4128 gen eff_target@ 'selection = if 4129 #f #f selection-position #f #f selection-framples 4130 else 4131 plausible-mark-samples { pts } 4132 pts if 4133 pts 0 array-ref 4134 pts 1 array-ref 4135 pts 0 array-ref - 4136 else 4137 'no-such-mark 4138 #( "%s: %s" get-func-name pts ) fth-throw 4139 then 4140 then 4141 then #f #f effects-fp 4142; 4143 4144: robotize-reset-cb { gen -- prc; w c i self -- } 4145 3 proc-create ( prc ) 4146 gen , gen eff_sr@ , gen eff_amp@ , gen eff_freq@ , 4147 does> { w c info self -- } 4148 self @ { gen } 4149 self 1 cells + @ { init-sr } 4150 self 2 cells + @ { init-amp } 4151 self 3 cells + @ { init-frq } 4152 gen init-sr eff_sr! 4153 gen init-amp eff_amp! 4154 gen init-frq eff_freq! 4155 gen eff_sliders@ 0 array-ref init-sr 100.0 set-slider-value 4156 gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value 4157 gen eff_sliders@ 2 array-ref init-frq 100.0 set-slider-value 4158; 4159 4160: robotize-sam-cb ( gen -- prc; w c i self -- ) 4161 3 proc-create swap , ( prc ) 4162 does> { w c info self -- } 4163 w info 100.0 get-slider-value { val } 4164 self @ ( gen ) val eff_sr! 4165; 4166 4167: post-robotize-dialog ( gen -- prc; w c i self -- ) 4168 3 proc-create swap , ( prc ) 4169 does> { w c info self -- } 4170 self @ { gen } 4171 gen eff_dialog@ widget? unless 4172 gen eff_label@ gen robotize-ok-cb gen eff_label@ "\ 4173Move the sliders to set the sample rate, \ 4174oscillator amplitude, and oscillator frequency." help-cb gen robotize-reset-cb 4175 gen general-target-cb make-effect-dialog { d } 4176 gen d eff_dialog! 4177 d #( #( "sample rate" 0.0 gen eff_sr@ 2.0 4178 gen robotize-sam-cb 100 ) 4179 #( "oscillator amplitude" 0.0 gen eff_amp@ 1.0 4180 gen amplitude-slider-cb 100 ) 4181 #( "oscillator frequency" 0.0 gen eff_freq@ 60.0 4182 gen frequency-slider-cb 100 ) ) add-sliders ( sl ) 4183 gen swap eff_sliders! 4184 gen #f add-target 4185 then 4186 gen eff_dialog@ activate-dialog 4187; 4188set-current 4189 4190: make-robotize-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 4191 ( name ) make-base-effects { gen } 4192 gen 1.0 eff_sr! 4193 gen 0.3 eff_amp! 4194 gen 20.0 eff_freq! 4195 gen post-robotize-dialog ( prc1 ) 4196 1 proc-create gen , ( prc2 ) 4197 does> { child self -- prc; self -- } 4198 0 proc-create self @ ( gen ) , child , ( prc ) 4199 does> { self -- } 4200 self @ { gen } 4201 self cell+ @ ( child ) "%s (%.2f %.2f %.2f)" 4202 #( gen eff_label@ gen eff_sr@ gen eff_amp@ gen eff_freq@ ) 4203 string-format change-label 4204; 4205previous 4206 4207\ === Rubber sound === 4208 4209hide 4210: rubber-ok-cb ( gen -- prc; w c i self -- res ) 4211 3 proc-create swap , ( prc ) 4212 does> { w c info self -- res } 4213 self @ ( gen ) eff_factor@ #f #f rubber-sound 4214; 4215 4216: rubber-reset-cb { gen -- prc; w c i self -- } 4217 3 proc-create gen , gen eff_factor@ , ( prc ) 4218 does> { w c info self -- } 4219 self @ { gen } 4220 self 1 cells + @ { init } 4221 gen init eff_factor! 4222 gen eff_sliders@ 0 array-ref init 100.0 set-slider-value 4223; 4224 4225: rubber-factor-cb ( gen -- prc; w c i self -- ) 4226 3 proc-create swap , ( prc ) 4227 does> { w c info self -- } 4228 w info 100.0 get-slider-value { val } 4229 self @ ( gen ) val eff_factor! 4230; 4231 4232: post-rubber-dialog ( gen -- prc; w c i self -- ) 4233 3 proc-create swap , ( prc ) 4234 does> { w c info self -- } 4235 self @ { gen } 4236 gen eff_dialog@ widget? unless 4237 gen eff_label@ gen rubber-ok-cb gen eff_label@ "\ 4238Stretches or contracts the time of a sound. \ 4239Move the slider to change the stretch factor." help-cb gen rubber-reset-cb 4240 gen general-target-cb make-effect-dialog { d } 4241 gen d eff_dialog! 4242 d #( #( "stretch factor" 0.0 gen eff_factor@ 5.0 4243 gen rubber-factor-cb 100 ) ) add-sliders ( sl ) 4244 gen swap eff_sliders! 4245 gen #f add-target 4246 then 4247 gen eff_dialog@ activate-dialog 4248; 4249set-current 4250 4251: make-rubber-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 4252 ( name ) make-base-effects { gen } 4253 gen 1.0 eff_factor! 4254 gen post-rubber-dialog ( prc1 ) 4255 1 proc-create gen , ( prc2 ) 4256 does> { child self -- prc; self -- } 4257 0 proc-create self @ ( gen ) , child , ( prc ) 4258 does> { self -- } 4259 self @ { gen } 4260 self cell+ @ ( child ) "%s (%.2f)" 4261 #( gen eff_label@ gen eff_factor@ ) string-format change-label 4262; 4263previous 4264 4265\ === Wobble === 4266 4267hide 4268: wobble-ok-cb ( gen -- prc; w c i self -- res ) 4269 3 proc-create swap , ( prc ) 4270 does> { w c info self -- res } 4271 self @ { gen } 4272 gen eff_freq@ gen eff_amp@ \ beg dur follows 4273 gen eff_target@ 'sound = if 4274 0 #f #f #f framples 4275 else 4276 gen eff_target@ 'selection = if 4277 #f #f selection-position #f #f selection-framples 4278 else 4279 plausible-mark-samples { pts } 4280 pts if 4281 pts 0 array-ref 4282 pts 1 array-ref 4283 pts 0 array-ref - 4284 else 4285 'no-such-mark 4286 #( "%s: %s" get-func-name pts ) fth-throw 4287 then 4288 then 4289 then #f #f effects-hello-dentist 4290; 4291 4292: wobble-reset-cb { gen -- prc; w c i self -- } 4293 3 proc-create gen , gen eff_freq@ , gen eff_amp@ , ( prc ) 4294 does> { w c info self -- } 4295 self @ { gen } 4296 self 1 cells + @ { init-frq } 4297 self 2 cells + @ { init-amp } 4298 gen init-frq eff_freq! 4299 gen init-amp eff_amp! 4300 gen eff_sliders@ 0 array-ref init-frq 100.0 set-slider-value 4301 gen eff_sliders@ 1 array-ref init-amp 100.0 set-slider-value 4302; 4303 4304: post-wobble-dialog ( gen -- prc; w c i self -- ) 4305 3 proc-create swap , ( prc ) 4306 does> { w c info self -- } 4307 self @ { gen } 4308 gen eff_dialog@ widget? unless 4309 gen eff_label@ gen wobble-ok-cb gen eff_label@ "\ 4310Move the sliders to set the wobble frequency and amplitude." help-cb 4311 gen wobble-reset-cb gen general-target-cb 4312 make-effect-dialog { d } 4313 gen d eff_dialog! 4314 d #( #( "wobble frequency" 0.0 gen eff_freq@ 100.0 4315 gen frequency-slider-cb 100 ) 4316 #( "wobble amplitude" 0.0 gen eff_amp@ 1.0 4317 gen amplitude-slider-cb 100 ) ) add-sliders ( sl ) 4318 gen swap eff_sliders! 4319 gen #f add-target 4320 then 4321 gen eff_dialog@ activate-dialog 4322; 4323set-current 4324 4325: make-wobble-dialog ( name -- prc1 prc2; child self -- prc; self -- ) 4326 ( name ) make-base-effects { gen } 4327 gen 50.0 eff_freq! 4328 gen 0.5 eff_amp! 4329 gen post-wobble-dialog ( prc1 ) 4330 1 proc-create gen , ( prc2 ) 4331 does> { child self -- prc; self -- } 4332 0 proc-create self @ ( gen ) , child , ( prc ) 4333 does> { self -- } 4334 self @ { gen } 4335 self cell+ @ ( child ) "%s (%.2f %.2f)" 4336 #( gen eff_label@ gen eff_freq@ gen eff_amp@ ) 4337 string-format change-label 4338; 4339previous 4340 4341: init-effects-menu ( name -- ) 4342 make-main-menu { main } 4343 "Amplitude Effects" main make-menu { menu } 4344 menu "Gain" make-gain-dialog menu-entry 4345 menu "Normalize" make-normalize-dialog menu-entry 4346 menu "Gate" make-gate-dialog menu-entry 4347 "Delay Effects" main make-menu to menu 4348 menu "Echo" make-echo-dialog menu-entry 4349 menu "Filtered echo" make-flecho-dialog menu-entry 4350 menu "Modulated echo" make-zecho-dialog menu-entry 4351 "Filter Effects" main make-menu to menu 4352 menu "Band-pass filter" make-band-pass-dialog menu-entry 4353 menu "Band-reject filter" make-notch-dialog menu-entry 4354 menu "High-pass filter" make-high-pass-dialog menu-entry 4355 menu "Low-pass filter" make-low-pass-dialog menu-entry 4356 menu "Comb filter" make-comb-dialog menu-entry 4357 menu "Comb chord filter" make-comb-chord-dialog menu-entry 4358 menu "Moog filter" make-moog-dialog menu-entry 4359 "Frequency Effects" main make-menu to menu 4360 menu "Adaptive saturation" make-adsat-dialog menu-entry 4361 menu "Sample rate conversion" make-src-dialog menu-entry 4362 menu "Time/pitch scaling" make-expsrc-dialog menu-entry 4363 menu "Src-Timevar" make-src-timevar-dialog menu-entry 4364 "Modulation Effects" main make-menu to menu 4365 menu "Amplitude modulation" make-am-effect-dialog menu-entry 4366 menu "Ring modulation" make-rm-effect-dialog menu-entry 4367 "Reverbs" main make-menu to menu 4368 menu "McNabb reverb" make-reverb-dialog menu-entry 4369 menu "Chowning reverb" make-jc-reverb-dialog menu-entry 4370 menu "Convolution" make-convolve-dialog menu-entry 4371 "Various" main make-menu to menu 4372 menu "Place sound" make-place-sound-dialog menu-entry 4373 menu "Add silence" make-silence-dialog menu-entry 4374 menu "Contrast enhancement" make-contrast-dialog menu-entry 4375 menu "Cross synthesis" make-cross-synth-dialog menu-entry 4376 menu "Flange" make-flange-dialog menu-entry 4377 menu "Randomize phase" make-random-phase-dialog menu-entry 4378 menu "Robotize" make-robotize-dialog menu-entry 4379 menu "Rubber sound" make-rubber-dialog menu-entry 4380 menu "Wobble" make-wobble-dialog menu-entry 4381; 4382 4383\ === Effects Menu === 4384"Effects" value effects-menu-label 4385 4386[undefined] effects-menu-exists? [if] 4387 #t value effects-menu-exists? 4388 effects-menu-label init-effects-menu 4389 #f effects-noop add-to-effects-menu \ separator 4390 4391 "Octave-down" lambda: <{ -- }> 4392 2 #f #f down-oct 4393 ; add-to-effects-menu 4394 4395 "Remove clicks" lambda: <{ -- }> 4396 #f #f effects-remove-clicks 4397 ; add-to-effects-menu 4398 4399 "Remove DC" lambda: <{ -- }> 4400 #f #f effects-remove-dc 4401 ; add-to-effects-menu 4402 4403 "Spiker" lambda: <{ -- }> 4404 #f #f spike 4405 ; add-to-effects-menu 4406 4407 "Compand" lambda: <{ -- }> 4408 #f #f effects-compand 4409 ; add-to-effects-menu 4410 4411 "Invert" lambda: <{ -- }> 4412 -1 #f #f scale-by 4413 ; add-to-effects-menu 4414 4415 "Reverse" lambda: <{ -- }> 4416 #f #f #f reverse-sound 4417 ; add-to-effects-menu 4418 4419 "Null phase" lambda: <{ -- }> 4420 #f #f zero-phase 4421 ; add-to-effects-menu 4422[then] 4423 4424\ effects.fs ends here 4425