1\ clm-ins.fs -- clm-ins.scm|rb -> clm-ins.fs 2 3\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net> 4\ Created: 06/02/03 10:36:51 5\ Changed: 17/12/22 07:52:33 6\ 7\ @(#)clm-ins.fs 1.51 12/22/17 8 9\ jc-reverb ( keyword-args -- ) 10\ violin ( start dur freq amp keyword-args -- ) 11\ fm-violin ( start dur freq amp keyword-args -- ) 12\ 13\ clm-ins.scm|rb instruments 14\ 15\ pluck ( start dur freq amp :optional weighting lossfact -- ) 16\ vox ( start dur freq amp ampfun freqfun freqscl ... -- ) 17\ fofins ( start dur freq amp vib f0 a0 f1 a1 f2 a2 :optional ae ve -- ) 18\ fm-trumpet ( start dur keyword-args -- ) 19\ pqw-vox ( start dur freq spacing-freq amp ampfun freqfun ... -- ) 20\ stereo-flute ( start dur freq flow keyword-args -- ) 21\ fm-bell ( start dur freq amp :optional amp-env index-env index -- ) 22\ fm-insect ( start dur freq amp amp-env ... -- ) 23\ fm-drum ( start dur freq amp index :optional high degr dist rev-amt -- ) 24\ gong ( start dur freq amp -- ) 25\ attract ( start dur amp c -- ) 26\ pqw ( start dur sfreq cfreq amp ampfun indexfun parts -- ) 27\ tubebell ( start dur freq amp :optional base --) 28\ wurley ( start dur freq amp -- ) 29\ rhodey ( start dur freq amp :optional base -- ) 30\ hammondoid ( start dur freq amp -- ) 31\ metal ( start dur freq amp -- ) 32\ drone ( start dur freq amp ampfun synth ampat ampdc ... -- ) 33\ canter ( start dur pitch amp ampfun ranfun skewfun ... -- ) 34\ nrev ( keyword-args -- ) 35\ reson ( start dur pitch amp indxfun skewfun ... -- ) 36\ cellon ( start dur pitch0 amp ampfun betafun ... -- ) 37\ jl-reverb ( keyword-args -- ) 38\ gran-synth ( start dur freq grain-dur interval amp -- ) 39\ touch-tone ( numbers keyword-args -- ) 40\ spectra ( start dur freq amp :optional ... -- ) 41\ two-tab ( start dur freq amp :optional ... -- ) 42\ lbj-piano ( start dur freq amp -- ) 43\ resflt ( start dur driver ... -- ) 44\ scratch-ins ( start file src-ratio turntable -- ) 45\ pins ( file start dur keyword-args -- ) 46\ zc ( start dur freq amp len1 len2 feedback -- ) 47\ zn ( start dur freq amp len1 len2 feedforward -- ) 48\ za ( start dur freq amp len1 len2 fb ffw -- ) 49\ clm-expsrc ( start dur in-file exp-ratio src-ratio amp :optional ... -- ) 50\ exp-snd ( file start dur amp :optional ... -- ) 51\ expfil ( start dur hopsecs rampsecs steadysecs file1 file2 -- ) 52\ graph-eq ( file start dur keyword-args -- ) 53\ anoi ( fname start dur :optional fftsize amp-scaler R -- ) 54\ fullmix ( in-file :optional ... -- ) 55\ bes-fm ( start dur freq amp ratio index -- ) 56 57require clm 58require env 59 60\ General input function for src, granulate etc. 61: readin-cb { gen -- prc; dir self -- val } 62 1 proc-create ( prc ) 63 gen , 64 does> { dir self -- val } 65 self @ ( gen ) readin 66; 67 68hide 69: (jc-reverb-simple) { flts allpasses combs volume dur -- } 70 flts length 1 = if 71 flts 0 array-ref { gen } 72 dur run-reverb ( in-val ) 73 allpasses swap all-pass-bank ( val ) 74 combs swap comb-bank ( val ) 75 volume f* ( val ) 76 gen swap 0.0 delay ( samp ) 77 end-run-reverb-out-1 78 else 79 flts 0 array-ref { gen1 } 80 flts 1 array-ref { gen2 } 81 0.0 { val } 82 dur run-reverb ( in-val ) 83 allpasses swap all-pass-bank ( val ) 84 combs swap comb-bank ( val ) 85 volume f* to val 86 gen2 val 0.0 delay ( samp2 ) 87 gen1 val 0.0 delay ( samp1 samp2 ) 88 end-run-reverb-out-2 89 then 90; 91 92: (jc-reverb-env) { envA flts allpasses combs volume dur -- } 93 flts length 1 = if 94 flts 0 array-ref { gen } 95 dur run-reverb ( in-val ) 96 allpasses swap all-pass-bank ( val ) 97 combs swap comb-bank ( val ) 98 envA env f* ( val ) 99 gen swap 0.0 delay ( samp ) 100 end-run-reverb-out-1 101 else 102 flts 0 array-ref { gen1 } 103 flts 1 array-ref { gen2 } 104 0.0 { val } 105 dur run-reverb ( in-val ) 106 allpasses swap all-pass-bank ( val ) 107 combs swap comb-bank ( val ) 108 envA env f* to val 109 gen2 val 0.0 delay ( samp2 ) 110 gen1 val 0.0 delay ( samp1 samp2 ) 111 end-run-reverb-out-2 112 then 113; 114 115: (jc-reverb-fir) { flt envA flts allpasses combs volume dur -- } 116 flts length 1 = if 117 flts 0 array-ref { gen } 118 dur run-reverb ( in-val ) 119 allpasses swap all-pass-bank ( val ) 120 combs swap comb-bank ( val ) 121 flt swap fir-filter ( val ) 122 envA env f* ( val ) 123 gen swap 0.0 delay ( samp ) 124 end-run-reverb-out-1 125 else 126 flts 0 array-ref { gen1 } 127 flts 1 array-ref { gen2 } 128 0.0 { val } 129 dur run-reverb ( in-val ) 130 allpasses swap all-pass-bank ( val ) 131 combs swap comb-bank ( val ) 132 flt swap fir-filter ( val ) 133 envA env f* to val 134 gen2 val 0.0 delay ( samp2 ) 135 gen1 val 0.0 delay ( samp1 samp2 ) 136 end-run-reverb-out-2 137 then 138; 139set-current 140 141\ clm/jcrev.ins and snd/jcrev.scm 142instrument: jc-reverb <{ :key low-pass #f volume 1.0 amp-env #f -- }> 143 doc" The Chowning reverb.\n\ 1440 1 440 0.2 <'> fm-violin :reverb <'> jc-reverb with-sound\n\ 1450 1 440 0.2 <'> fm-violin\n\ 146:reverb-data #( :low-pass #t ) :reverb <'> jc-reverb :channels 2 with-sound." 147 :feedback -0.7 :feedforward 0.7 :size 1051 make-all-pass { allpass1 } 148 :feedback -0.7 :feedforward 0.7 :size 337 make-all-pass { allpass2 } 149 :feedback -0.7 :feedforward 0.7 :size 113 make-all-pass { allpass3 } 150 :scaler 0.742 :size 4799 make-comb { comb1 } 151 :scaler 0.733 :size 4999 make-comb { comb2 } 152 :scaler 0.715 :size 5399 make-comb { comb3 } 153 :scaler 0.697 :size 5801 make-comb { comb4 } 154 *output* channels { chans } 155 *reverb* ws-framples samples->seconds *decay-time* f+ { dur } 156 chans 1 = if 157 \ XXX: Building arrays like this 158 \ #( :size 0.013 seconds->samples make-delay ) 159 \ doesn't work well with keyword functions. 160 :size 0.013 seconds->samples make-delay { dl } 161 #( dl ) 162 else 163 :size 0.013 seconds->samples make-delay { dl1 } 164 :size 0.011 seconds->samples make-delay { dl2 } 165 #( dl1 dl2 ) 166 then { flts } 167 #( comb1 comb2 comb3 comb4 ) make-comb-bank { combs } 168 #( allpass1 allpass2 allpass3 ) make-all-pass-bank { allpasses } 169 amp-env low-pass || if 170 amp-env unless 171 '( 0 1 1 1 ) to amp-env 172 then 173 :envelope amp-env :scaler volume :duration dur make-env { envA } 174 low-pass if 175 3 vct( 0.25 0.5 0.25 ) make-fir-filter ( flt ) 176 envA flts allpasses combs volume dur (jc-reverb-fir) 177 else 178 envA flts allpasses combs volume dur (jc-reverb-env) 179 then 180 else 181 flts allpasses combs volume dur (jc-reverb-simple) 182 then 183;instrument 184previous 185 186\ snd/fm.html 187instrument: violin <{ start dur freq amp :key 188 fm-index 1.0 189 amp-env #( 0 0 25 1 75 1 100 0 ) 190 index-env #( 0 1 25 0.4 75 0.6 100 0 ) 191 degree 0.0 192 distance 1.0 193 reverb-amount 0.01 -- }> 194 doc" Violin example from snd/fm.html.\n\ 1950 3 440 0.5 :fm-index 0.5 <'> violin with-sound" 196 freq hz->radians { frq-scl } 197 frq-scl fm-index f* { maxdev } 198 5.0 freq flog f/ maxdev f* { index1 } 199 8.5 freq flog f- 3.0 freq 1000.0 f/ f+ f/ maxdev 3.0 f* f* { index2 } 200 4.0 freq fsqrt f/ maxdev f* { index3 } 201 :frequency freq make-oscil { carrier } 202 :frequency freq make-oscil { fmosc1 } 203 :frequency freq 3.0 f* make-oscil { fmosc2 } 204 :frequency freq 4.0 f* make-oscil { fmosc3 } 205 :envelope amp-env :scaler amp :duration dur make-env { ampf } 206 :envelope index-env :scaler index1 :duration dur make-env { indf1 } 207 :envelope index-env :scaler index2 :duration dur make-env { indf2 } 208 :envelope index-env :scaler index3 :duration dur make-env { indf3 } 209 :frequency 5.0 210 :amplitude 0.0025 frq-scl f* make-triangle-wave { pervib } 211 :frequency 16.0 212 :amplitude 0.005 frq-scl f* make-rand-interp { ranvib } 213 start dur 214 #{ :degree degree :distance distance :reverb reverb-amount } 215 run-instrument 216 pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib } 217 carrier vib 218 fmosc1 vib 0.0 oscil indf1 env f* f+ 219 fmosc2 3.0 vib f* 0.0 oscil indf2 env f* f+ 220 fmosc3 4.0 vib f* 0.0 oscil indf3 env f* f+ 221 0.0 oscil ampf env f* 222 end-run 223;instrument 224 225: violin-test <{ :optional start 0.0 dur 1.0 -- }> 226 start now! 227 now@ dur 440 0.5 violin 228 dur 0.2 f+ step 229; 230 231\ === FM-Violin (clm/v.ins, snd/v.scm|rb) === 232instrument: fm-violin <{ start dur freq amp :key 233 fm-index 1.0 234 amp-env #( 0 0 25 1 75 1 100 0 ) 235 periodic-vibrato-rate 5.0 236 periodic-vibrato-amplitude 0.0025 237 random-vibrato-rate 16.0 238 random-vibrato-amplitude 0.005 239 noise-freq 1000.0 240 noise-amount 0.0 241 ind-noise-freq 10.0 242 ind-noise-amount 0.0 243 amp-noise-freq 20.0 244 amp-noise-amount 0.0 245 gliss-env #( 0 0 100 0 ) 246 glissando-amount 0.0 247 fm1-env #( 0 1 25 0.4 75 0.6 100 0 ) 248 fm2-env #( 0 1 25 0.4 75 0.6 100 0 ) 249 fm3-env #( 0 1 25 0.4 75 0.6 100 0 ) 250 fm1-rat 1.0 251 fm2-rat 3.0 252 fm3-rat 4.0 253 fm1-index #f 254 fm2-index #f 255 fm3-index #f 256 base 1.0 257 degree 0.0 258 distance 1.0 259 reverb-amount 0.01 260 index-type 'violin -- }> 261 doc" FM-Violin from clm/v.ins|snd/v.scm|rb.\n\ 2620 3 440 0.5 :fm-index 0.5 <'> fm-violin with-sound." 263 freq fabs 1.0 f<= if 264 "freq = %s? reset to 440.0" #( freq ) fth-warning 265 440.0 to freq 266 then 267 freq hz->radians { frq-scl } 268 fm-index f0<> { modulate } 269 frq-scl fm-index f* { maxdev } 270 index-type 'violin = { vln } 271 freq flog { logfreq } 272 freq fsqrt { sqrtfreq } 273 fm1-index unless 274 maxdev vln if 275 5.0 276 else 277 7.5 278 then logfreq f/ f* pi fmin to fm1-index 279 then 280 fm2-index unless 281 maxdev 3.0 f* vln if 282 8.5 logfreq f- 3.0 freq 0.001 f* f+ f/ 283 else 284 15.0 sqrtfreq f/ 285 then f* pi fmin to fm2-index 286 then 287 fm3-index unless 288 maxdev vln if 289 4.0 290 else 291 8.0 292 then sqrtfreq f/ f* pi fmin to fm3-index 293 then 294 noise-amount f0= 295 fm1-env fm2-env equal? && 296 fm1-env fm3-env equal? && 297 fm1-rat fm1-rat floor f- f0= && 298 fm2-rat fm1-rat floor f- f0= && 299 fm2-rat fm2-rat floor f- f0= && 300 fm3-rat fm1-rat floor f- f0= && 301 fm3-rat fm3-rat floor f- f0= && { easy-case } 302 easy-case modulate && 1.0 && fm1-index || { norm } 303 :frequency freq make-oscil { carrier } 304 :envelope amp-env :scaler amp :duration dur :base base make-env { ampf } 305 #f #f #f { fmosc1 fmosc2 fmosc3 } 306 #f #f #f { indf1 indf2 indf3 } 307 modulate if 308 easy-case if 309 :frequency freq fm1-rat f* 310 :coeffs #( fm1-rat f>s fm1-index 311 fm2-rat fm1-rat f/ fround->s fm2-index 312 fm3-rat fm1-rat f/ fround->s fm3-index ) 313 1 partials->polynomial make-polyshape 314 else 315 :frequency freq fm1-rat f* make-oscil 316 then to fmosc1 317 easy-case unless 318 :frequency freq fm2-rat f* make-oscil to fmosc2 319 :frequency freq fm3-rat f* make-oscil to fmosc3 320 :envelope fm1-env 321 :scaler norm 322 :duration dur make-env to indf1 323 :envelope fm2-env 324 :scaler fm2-index 325 :duration dur make-env to indf2 326 :envelope fm3-env 327 :scaler fm3-index 328 :duration dur make-env to indf3 329 then 330 then 331 :envelope gliss-env 332 :scaler glissando-amount frq-scl f* 333 :duration dur make-env { frqf } 334 :frequency periodic-vibrato-rate 335 :amplitude periodic-vibrato-amplitude frq-scl f* 336 make-triangle-wave { pervib } 337 :frequency random-vibrato-rate 338 :amplitude random-vibrato-amplitude frq-scl f* 339 make-rand-interp { ranvib } 340 #f #f #f { fm-noi ind-noi amp-noi } 341 noise-amount f0<> if 342 :frequency noise-freq 343 :amplitude noise-amount pi f* 344 make-rand to fm-noi 345 then 346 ind-noise-freq f0<> 347 ind-noise-amount f0<> && if 348 :frequency ind-noise-freq 349 :amplitude ind-noise-amount 350 make-rand-interp to ind-noi 351 then 352 amp-noise-freq f0<> 353 amp-noise-amount f0<> && if 354 :frequency amp-noise-freq 355 :amplitude amp-noise-amount 356 make-rand-interp to amp-noi 357 then 358 0.0 0.0 1.0 1.0 { vib fuzz ind-fuzz amp-fuzz } 359 modulate if 360 easy-case if 361 start dur 362 #{ :degree degree 363 :distance distance 364 :reverb reverb-amount } run-instrument 365 fm-noi if 366 fm-noi 0.0 rand to fuzz 367 then 368 frqf env pervib 0.0 triangle-wave f+ 369 ranvib 0.0 rand-interp f+ to vib 370 ind-noi if 371 ind-noi 0.0 rand-interp 372 1.0 f+ to ind-fuzz 373 then 374 amp-noi if 375 amp-noi 0.0 rand-interp 376 1.0 f+ to amp-fuzz 377 then 378 carrier ( gen ) 379 fmosc1 1.0 vib polyshape 380 ind-fuzz f* vib f+ ( fm ) 381 0.0 ( pm ) oscil 382 ampf env f* amp-fuzz f* 383 end-run 384 else 385 start dur 386 #{ :degree degree 387 :distance distance 388 :reverb reverb-amount } run-instrument 389 fm-noi if 390 fm-noi 0.0 rand to fuzz 391 then 392 frqf env pervib 0.0 triangle-wave f+ 393 ranvib 0.0 rand-interp f+ to vib 394 ind-noi if 395 ind-noi 0.0 rand-interp 396 1.0 f+ to ind-fuzz 397 then 398 amp-noi if 399 amp-noi 0.0 rand-interp 400 1.0 f+ to amp-fuzz 401 then 402 carrier ( gen ) 403 fmosc1 fm1-rat vib f* fuzz f+ 0.0 oscil 404 indf1 env f* 405 fmosc2 fm2-rat vib f* fuzz f+ 0.0 oscil 406 indf2 env f* f+ 407 fmosc3 fm3-rat vib f* fuzz f+ 0.0 oscil 408 indf3 env f* f+ 409 ind-fuzz f* vib f+ ( fm ) 410 0.0 ( pm ) oscil 411 ampf env f* amp-fuzz f* 412 end-run 413 then 414 else 415 start dur 416 #{ :degree degree :distance distance :reverb reverb-amount } 417 run-instrument 418 fm-noi if 419 fm-noi 0.0 rand to fuzz 420 then 421 frqf env pervib 0.0 triangle-wave f+ 422 ranvib 0.0 rand-interp f+ to vib 423 ind-noi if 424 ind-noi 0.0 rand-interp 1.0 f+ to ind-fuzz 425 then 426 amp-noi if 427 amp-noi 0.0 rand-interp 1.0 f+ to amp-fuzz 428 then 429 carrier vib 0.0 oscil ampf env f* amp-fuzz f* 430 end-run 431 then 432; 433 434: fm-violin-test <{ :optional start 0.0 dur 1.0 -- }> 435 start now! 436 now@ dur 440 0.5 fm-violin 437 dur 0.2 f+ step 438; 439 440\ === CLM-INS.(RB|SCM) === 441\ (with original comments from clm-ins.scm) 442 443hide 444: get-optimum-c { s o p -- t c } 445 o 1/f s o fsin f* 1.0 s f- s o fcos f* f+ fatan2 f* { pa } 446 p pa f- f>s { tmp_int } 447 tmp_int unless 448 1 to tmp_int 449 then 450 p pa f- tmp_int f- { pc } 451 begin 452 pc 0.1 f< 453 while 454 tmp_int 1 - to tmp_int 455 pc 1.0 f+ to pc 456 repeat 457 tmp_int ( t ) 458 o fsin o pc f* fsin f- o o pc f* f+ fsin f/ ( c ) 459; 460 461: tune-it { f s1 -- s c t } 462 mus-srate f f/ { p } 463 s1 f0= if 464 0.5 465 else 466 s1 467 then { s } 468 f hz->radians { o } 469 s o p get-optimum-c { t1 c1 } 470 1.0 s f- o p get-optimum-c { t2 c2 } 471 s 0.5 f<> 472 c1 fabs c2 fabs f< && if 473 1.0 s f- c1 t1 474 else 475 s c2 t2 476 then 477; 478set-current 479 480\ PLUCK 481\ 482\ The Karplus-Strong algorithm as extended by David Jaffe and Julius 483\ Smith -- see Jaffe and Smith, "Extensions of the Karplus-Strong 484\ Plucked-String Algorithm" CMJ vol 7 no 2 Summer 1983, reprinted in 485\ "The Music Machine". translated from CLM's pluck.ins 486instrument: pluck <{ start dur freq amp :optional 487 weighting 0.5 488 lossfact 0.9 -- }> 489 doc" Implement the Jaffe-Smith plucked string physical model. \ 490WEIGHTING is the ratio of the once-delayed to the twice-delayed samples. \ 491It defaults to 0.5 = shortest decay. \ 492Anything other than 0.5 = longer decay. \ 493Must be between 0 and less than 1.0. \ 494LOSSFACT can be used to shorten decays. \ 495Most useful values are between 0.8 and 1.0.\n\ 4960 1 330 0.3 0.95 0.95 <'> pluck with-sound" 497 freq weighting tune-it { wt0 c dlen } 498 lossfact f0= if 499 1.0 500 else 501 1.0 lossfact fmin 502 then { lf } 503 wt0 f0= if 504 0.5 505 else 506 1.0 wt0 fmin 507 then { wt } 508 lf 1.0 wt f- f* lf wt f* make-one-zero { allp } 509 c 1.0 make-one-zero { feedb } 510 dlen 0.0 make-vct map 511 1.0 2.0 mus-random f- 512 end-map { tab } 513 start dur #{ :degree 90.0 random } run-instrument 514 tab cycle-ref { val } 515 tab i dlen mod 1.0 c f- 516 feedb allp val one-zero one-zero f* vct-set! drop 517 amp val f* 518 end-run 519;instrument 520previous 521 522: pluck-test <{ :optional start 0.0 dur 1.0 -- }> 523 start now! 524 now@ dur 330 0.3 0.95 0.95 pluck 525 dur 0.2 f+ step 526; 527 528\ formant center frequencies for a male speaker (vox and pqw-vox) 529#{ :I: #( 390.0 1990.0 2550.0 ) 530 :UH: #( 520.0 1190.0 2390.0 ) 531 :U: #( 440.0 1020.0 2240.0 ) 532 :W: #( 300.0 610.0 2200.0 ) 533 :Y: #( 300.0 2200.0 3065.0 ) 534 :L: #( 300.0 1300.0 3000.0 ) 535 :D: #( 300.0 1700.0 2600.0 ) 536 :N: #( 280.0 1700.0 2600.0 ) 537 :T: #( 200.0 1700.0 2600.0 ) 538 :TH: #( 200.0 1400.0 2200.0 ) 539 :V: #( 175.0 1100.0 2400.0 ) 540 :ZH: #( 175.0 1800.0 2000.0 ) 541 :E: #( 530.0 1840.0 2480.0 ) 542 :A: #( 730.0 1090.0 2440.0 ) 543 :OO: #( 300.0 870.0 2240.0 ) 544 :LL: #( 380.0 880.0 2575.0 ) 545 :EE: #( 260.0 3500.0 3800.0 ) 546 :I2: #( 350.0 2300.0 3340.0 ) 547 :G: #( 250.0 1350.0 2000.0 ) 548 :NG: #( 280.0 2300.0 2750.0 ) 549 :K: #( 350.0 1350.0 2000.0 ) 550 :S: #( 200.0 1300.0 2500.0 ) 551 :THE: #( 200.0 1600.0 2200.0 ) 552 :ZZ: #( 900.0 2400.0 3800.0 ) 553 :AE: #( 660.0 1720.0 2410.0 ) 554 :OW: #( 570.0 840.0 2410.0 ) 555 :ER: #( 490.0 1350.0 1690.0 ) 556 :R: #( 420.0 1300.0 1600.0 ) 557 :LH: #( 280.0 1450.0 1600.0 ) 558 :B: #( 200.0 800.0 1750.0 ) 559 :M: #( 280.0 900.0 2200.0 ) 560 :P: #( 300.0 800.0 1750.0 ) 561 :F: #( 175.0 900.0 4400.0 ) 562 :SH: #( 200.0 1800.0 2000.0 ) 563 :Z: #( 200.0 1300.0 2500.0 ) 564 :VV: #( 565.0 1045.0 2400.0 ) } value clm-ins-formants 565 566\ MLBVOI 567\ 568\ translation from MUS10 of Marc LeBrun's waveshaping voice instrument 569\ (using FM here) this version translated (and simplified slightly) 570\ from CLM's mlbvoi.ins 571instrument: vox <{ start dur freq amp ampfun freqfun freqscl voxfun index 572 :optional vibscl 0.1 -- }> 573 voxfun length { size } 574 size make-array { f1 } 575 size make-array { f2 } 576 size make-array { f3 } 577 size 1- 0 ?do 578 clm-ins-formants voxfun i 1+ object-ref hash-ref { phon } 579 voxfun i object-ref { n } 580 f1 i n array-set! 581 phon 0 array-ref f1 i 1+ rot array-set! 582 f2 i n array-set! 583 phon 1 array-ref f2 i 1+ rot array-set! 584 f3 i n array-set! 585 phon 2 array-ref f3 i 1+ rot array-set! 586 2 +loop 587 :frequency 0.0 make-oscil { car-os } 588 6 make-array map 589 :frequency 0.0 make-oscil 590 end-map { ofs } 591 :envelope ampfun :scaler amp :duration dur make-env { ampf } 592 :envelope f1 :duration dur make-env { frmf1 } 593 :envelope f2 :duration dur make-env { frmf2 } 594 :envelope f3 :duration dur make-env { frmf3 } 595 :envelope freqfun 596 :duration dur 597 :scaler freqscl freq f* 598 :offset freq make-env { freqf } 599 :frequency 6.0 :amplitude freq vibscl f* make-triangle-wave { per-vib } 600 :frequency 20.0 :amplitude freq 0.01 f* make-rand-interp { ran-vib } 601 6 0.0 make-vct { freqs } 602 6 0.0 make-vct { amps } 603 start dur #{ :degree 90.0 random } run-instrument 604 freqf env per-vib 0.0 triangle-wave f+ 605 ran-vib 0.0 rand-interp f+ { frq } 606 frmf1 env { frm } 607 frm frq f/ { frm0 } 608 frm0 floor dup f>s { frm-fint frm-int } 609 frm-int 2 mod unless 610 freqs 0 frm-fint frq f* hz->radians vct-set! drop 611 freqs 1 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 612 amps 1 frm0 frm-fint f- vct-set! drop 613 amps 0 1.0 amps 1 vct-ref f- vct-set! drop 614 else 615 freqs 1 frm-fint frq f* hz->radians vct-set! drop 616 freqs 0 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 617 amps 0 frm0 frm-fint f- vct-set! drop 618 amps 1 1.0 amps 0 vct-ref f- vct-set! drop 619 then 620 frmf2 env to frm 621 frm frq f/ to frm0 622 frm0 floor to frm-fint 623 frm-fint f>s to frm-int 624 frm-int 2 mod unless 625 freqs 2 frm-fint frq f* hz->radians vct-set! drop 626 freqs 3 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 627 amps 3 frm0 frm-fint f- vct-set! drop 628 amps 2 1.0 amps 3 vct-ref f- vct-set! drop 629 else 630 freqs 3 frm-fint frq f* hz->radians vct-set! drop 631 freqs 2 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 632 amps 2 frm0 frm-fint f- vct-set! drop 633 amps 3 1.0 amps 2 vct-ref f- vct-set! drop 634 then 635 frmf3 env to frm 636 frm frq f/ to frm0 637 frm0 floor to frm-fint 638 frm-fint f>s to frm-int 639 frm-int 2 mod unless 640 freqs 4 frm-fint frq f* hz->radians vct-set! drop 641 freqs 5 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 642 amps 5 frm0 frm-fint f- vct-set! drop 643 amps 4 1.0 amps 5 vct-ref f- vct-set! drop 644 else 645 freqs 5 frm-fint frq f* hz->radians vct-set! drop 646 freqs 4 frm-fint 1.0 f+ frq f* hz->radians vct-set! drop 647 amps 4 frm0 frm-fint f- vct-set! drop 648 amps 5 1.0 amps 4 vct-ref f- vct-set! drop 649 then 650 car-os frq hz->radians 0.0 oscil index f* { caros } 651 ofs 0 array-ref caros 0.2 f* 652 freqs 0 vct-ref f+ 0.0 oscil amps 0 vct-ref f* 653 ofs 1 array-ref caros 0.2 f* 654 freqs 1 vct-ref f+ 0.0 oscil amps 1 vct-ref f* 655 f+ 0.80 f* 656 ofs 2 array-ref caros 0.5 f* 657 freqs 2 vct-ref f+ 0.0 oscil amps 2 vct-ref f* 658 ofs 3 array-ref caros 0.5 f* 659 freqs 3 vct-ref f+ 0.0 oscil amps 3 vct-ref f* 660 f+ 0.15 f* f+ 661 ofs 4 array-ref caros 662 freqs 4 vct-ref f+ 0.0 oscil amps 4 vct-ref f* 663 ofs 5 array-ref caros 664 freqs 5 vct-ref f+ 0.0 oscil amps 5 vct-ref f* 665 f+ 0.05 f* f+ 666 ampf env f* 667 end-run 668;instrument 669 670: vox-test <{ :optional start 0.0 dur 1.0 -- }> 671 start now! 672 #( 0 0 25 1 75 1 100 0 ) { amp-env } 673 #( 0 0 5 0.5 10 0 100 1 ) { frq-env } 674 #( 0 :E: 25 :AE: 35 :ER: 65 :ER: 75 :I: 100 :UH: ) { examp1 } 675 #( 0 :I: 5 :OW: 10 :I: 50 :AE: 100 :OO: ) { examp2 } 676 677 now@ dur 170 0.4 amp-env frq-env 0.1 examp1 0.05 0.1 vox 678 dur 0.2 f+ step 679 now@ dur 300 0.4 amp-env frq-env 0.1 examp2 0.02 0.1 vox 680 dur 0.2 f+ step 681 now@ 5.0 600 0.4 amp-env frq-env 0.1 examp2 0.01 0.1 vox 682 5.0 0.2 f+ step 683; 684 685\ FOF example 686\ 687\ snd/sndclm.html, section wave-train 688instrument: fofins <{ start dur freq amp vib f0 a0 f1 a1 f2 a2 :optional 689 ae #( 0 0 25 1 75 1 100 0 ) 690 ve #( 0 1 100 1 ) -- }> 691 doc" Produce FOF synthesis.\n\ 6920 1 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 <'> fofins with-sound." 693 :envelope ae :scaler amp :duration dur make-env { ampf } 694 :frequency 6.0 make-oscil { vibr } 695 :envelope ve :scaler vib :duration dur make-env { vibenv } 696 f0 hz->radians { frq0 } 697 f1 hz->radians { frq1 } 698 f2 hz->radians { frq2 } 699 mus-srate 22050.0 f= if 700 100 701 else 702 200 703 then { foflen } 704 two-pi foflen f/ { win-freq } 705 foflen 0.0 make-vct map 706 a0 i frq0 f* fsin f* 707 a1 i frq1 f* fsin f* f+ 708 a2 i frq2 f* fsin f* f+ f2/ 709 1.0 i win-freq f* fcos f- f* 710 end-map { foftab } 711 :frequency freq :wave foftab make-wave-train { wt0 } 712 start dur #{ :degree 90.0 random } run-instrument 713 ampf env wt0 vibenv env vibr 0.0 0.0 oscil f* wave-train f* 714 end-run 715;instrument 716 717: fofins-test <{ :optional start 0.0 dur 1.0 -- }> 718 start now! 719 now@ dur 270 0.2 0.001 730 0.6 1090 0.3 2440 0.1 fofins 720 dur 0.2 f+ step 721; 722 723\ FM TRUMPET 724\ 725\ Dexter Morrill's FM-trumpet: from CMJ feb 77 p51 726instrument: fm-trumpet <{ start dur :key 727 frq1 250 728 frq2 1500 729 amp1 0.5 730 amp2 0.1 731 ampatt1 0.03 732 ampdec1 0.35 733 ampatt2 0.03 734 ampdec2 0.3 735 modfrq1 250 736 modind11 0 737 modind12 2.66 738 modfrq2 250 739 modind21 0 740 modind22 1.8 741 rvibamp 0.007 742 rvibfrq 125 743 vibamp 0.007 744 vibfrq 7 745 vibatt 0.6 746 vibdec 0.2 747 frqskw 0.03 748 frqatt 0.06 749 ampenv1 #( 0 0 25 1 75 0.9 100 0 ) 750 ampenv2 #( 0 0 25 1 75 0.9 100 0 ) 751 indenv1 #( 0 0 25 1 75 0.9 100 0 ) 752 indenv2 #( 0 0 25 1 75 0.9 100 0 ) -- }> 753 doc" 0 2 <'> fm-trumpet with-sound." 754 :envelope #( 0 1 25 0.1 75 0 100 0 ) 755 25.0 756 vibatt dur f/ 100.0 f* 45.0 fmin 757 75.0 758 1.0 vibdec dur f/ f- 100.0 f* 55.0 fmax stretch-envelope 759 :scaler vibamp 760 :duration dur make-env { per-vib-f } 761 :frequency rvibfrq :amplitude rvibamp make-rand-interp { ran-vib } 762 :frequency vibfrq make-oscil { per-vib } 763 1.0 0.01 dur f/ f- 100.0 f* 75.0 fmax { dec-01 } 764 :envelope #( 0 0 25 1 75 1 100 0 ) 765 25.0 766 frqatt dur f/ 100.0 f* 25.0 fmin 767 75.0 768 dec-01 stretch-envelope 769 :scaler frqskw 770 :duration dur make-env { frq-f } 771 ampatt1 dur f/ 100.0 f* 25.0 fmin { ampattpt1 } 772 1.0 ampdec1 dur f/ f- 100.0 f* 75.0 fmax { ampdecpt1 } 773 ampatt2 dur f/ 100.0 f* 25.0 fmin { ampattpt2 } 774 1.0 ampdec2 dur f/ f- 100.0 f* 75.0 fmax { ampdecpt2 } 775 :envelope indenv1 25.0 ampattpt1 75.0 dec-01 stretch-envelope 776 :scaler modfrq1 modind12 modind11 f- f* 777 :duration dur make-env { mod1-f } 778 :frequency 0.0 make-oscil { mod1 } 779 :frequency 0.0 make-oscil { car1 } 780 :envelope ampenv1 25 ampattpt1 75 ampdecpt1 stretch-envelope 781 :scaler amp1 782 :duration dur make-env { car1-f } 783 :envelope indenv2 25 ampattpt2 75 dec-01 stretch-envelope 784 :scaler modfrq2 modind22 modind21 f- f* 785 :duration dur make-env { mod2-f } 786 :frequency 0.0 make-oscil { mod2 } 787 :frequency 0.0 make-oscil { car2 } 788 :envelope ampenv2 25.0 ampattpt2 75.0 ampdecpt2 stretch-envelope 789 :scaler amp2 790 :duration dur make-env { car2-f } 791 start dur #{ :degree 90.0 random } run-instrument 792 ran-vib 0.0 rand-interp 1.0 f+ 793 1.0 per-vib-f env per-vib 0.0 0.0 oscil f* f+ f* 794 1.0 frq-f env f+ f* hz->radians { frq-change } 795 car1 796 mod1 modfrq1 frq-change f* 0.0 oscil mod1-f env f* 797 frq1 f+ frq-change f* 0.0 oscil car1-f env f* 798 car2 799 mod2 modfrq2 frq-change f* 0.0 oscil mod2-f env f* 800 frq2 f+ frq-change f* 0.0 oscil car2-f env f* 801 f+ 802 end-run 803;instrument 804 805: fm-trumpet-test <{ :optional start 0.0 dur 1.0 -- }> 806 start now! 807 now@ dur fm-trumpet 808 dur 0.2 f+ step 809; 810 811#( "pqw-sin-evens" 812 "pqw-sin-odds" 813 "pqw-cos-evens" 814 "pqw-cos-odds" 815 "pqw-cos-coeffs" 816 "pqw-sin-coeffs" 817 "pqw-frmfs" 818 "pqw-amps" ) create-struct make-pqw-vox-struct 819 820\ PQWVOX 821\ 822\ translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's 823\ waveshaping voice instrument (using phase quadrature waveshaping)) 824instrument: pqw-vox <{ start dur 825 freq spacing-freq 826 amp ampfun 827 freqfun freqscl 828 phonemes 829 formant-amps formant-shapes -- }> 830 :frequency 0.0 make-oscil { car-sin } 831 :frequency 0.0 :initial-phase half-pi make-oscil { car-cos } 832 :envelope ampfun :scaler amp :duration dur make-env { ampf } 833 :envelope freqfun 834 :scaler freqscl freq f* 835 :duration dur :offset freq 836 make-env { freqf } 837 :frequency 6.0 :amplitude freq 0.1 f* make-triangle-wave { per-vib } 838 :frequency 20.0 :amplitude freq 0.05 f* make-rand-interp { ran-vib } 839 phonemes length { plen } 840 plen make-array { phone1 } 841 plen make-array { phone2 } 842 plen make-array { phone3 } 843 plen 1- 0 ?do 844 phonemes i object-ref { ph } 845 phone1 i ph array-set! 846 phone2 i ph array-set! 847 phone3 i ph array-set! 848 clm-ins-formants phonemes i 1+ object-ref hash-ref { ary } 849 phone1 i 1+ ary 0 object-ref array-set! 850 phone2 i 1+ ary 1 object-ref array-set! 851 phone3 i 1+ ary 2 object-ref array-set! 852 2 +loop 853 #( phone1 phone2 phone3 ) { phones } 854 nil 0 { pv shape } 855 formant-amps map 856 make-pqw-vox-struct to pv 857 pv :frequency 0.0 :initial-phase 0.0 make-oscil pqw-sin-evens! 858 pv :frequency 0.0 :initial-phase 0.0 make-oscil pqw-sin-odds! 859 pv 860 :frequency 0.0 :initial-phase half-pi make-oscil 861 pqw-cos-evens! 862 pv 863 :frequency 0.0 :initial-phase half-pi make-oscil 864 pqw-cos-odds! 865 formant-shapes i object-ref normalize-partials to shape 866 pv 867 shape mus-chebyshev-first-kind partials->polynomial 868 pqw-cos-coeffs! 869 pv 870 shape mus-chebyshev-second-kind partials->polynomial 871 pqw-sin-coeffs! 872 :envelope phones i array-ref :duration dur make-env 873 pv swap pqw-frmfs! 874 pv formant-amps i object-ref pqw-amps! 875 pv 876 end-map { values } 877 4 0.0 make-vct { vals } 878 spacing-freq freq f/ { frq-ratio } 879 start dur #{ :degree 90.0 random } run-instrument 880 freqf env per-vib 0.0 triangle-wave f+ 881 ran-vib 0.0 rand-interp f+ { frq } 882 frq frq-ratio f* hz->radians { frqscl } 883 car-sin frqscl 0.0 oscil { carsin } 884 car-cos frqscl 0.0 oscil { carcos } 885 0.0 ( sum ) 886 values each to pv 887 pv pqw-frmfs@ env frq f/ { frm0 } 888 frm0 floor { frm-fint } 889 frm-fint f>s 2 mod unless 890 vals 0 891 frm-fint frq f* hz->radians 892 vct-set! drop ( even-freq ) 893 vals 1 894 frm-fint 1.0 f+ frq f* hz->radians 895 vct-set! drop ( odd-freq ) 896 vals 3 897 frm0 frm-fint f- 898 vct-set! drop ( odd-amp ) 899 vals 2 900 1.0 vals 3 vct-ref f- 901 vct-set! drop ( even-amp ) 902 else 903 vals 1 904 frm-fint frq f* hz->radians 905 vct-set! drop ( odd-freq ) 906 vals 0 907 frm-fint 1.0 f+ frq f* hz->radians 908 vct-set! drop ( even-freq ) 909 vals 2 910 frm0 frm-fint f- 911 vct-set! drop ( even-amp ) 912 vals 3 913 1.0 vals 2 vct-ref f- 914 vct-set! drop ( odd-amp ) 915 then 916 pv pqw-cos-coeffs@ carcos polynomial { fax } 917 pv pqw-sin-coeffs@ carcos polynomial carsin f* { yfax } 918 pv pqw-sin-evens@ vals 0 vct-ref 0.0 oscil yfax f* 919 pv pqw-cos-evens@ 920 vals 0 vct-ref 0.0 oscil fax f* f- 921 vals 2 vct-ref f* 922 pv pqw-sin-odds@ vals 1 vct-ref 0.0 oscil yfax f* 923 pv pqw-cos-odds@ 924 vals 1 vct-ref 0.0 oscil fax f* f- 925 vals 3 vct-ref f* 926 f+ pv pqw-amps@ f* f+ 927 end-each ( sum ) 928 ampf env f* 929 end-run 930;instrument 931 932: pqw-vox-test <{ :optional start 0.0 dur 1.0 -- }> 933 start now! 934 #( 0 0 50 1 100 0 ) { ampfun } 935 #( 0 0 100 0 ) { freqfun } 936 #( 0 0 100 1 ) { freqramp } 937 #( #( 1 1 2 0.5 ) 938 #( 1 0.5 2 0.5 3 1 ) 939 #( 1 1 4 0.5 ) ) { sh1 } 940 #( #( 1 1 2 0.5 ) 941 #( 1 1 2 0.5 3 0.2 4 0.1 ) 942 #( 1 1 3 0.1 4 0.5 ) ) { sh2 } 943 #( #( 1 1 2 0.5 ) 944 #( 1 1 4 0.1 ) 945 #( 1 1 2 0.1 4 0.05 ) ) { sh3 } 946 #( #( 1 1 2 0.5 3 0.1 4 0.01 ) 947 #( 1 1 4 0.1 ) 948 #( 1 1 2 0.1 4 0.05 ) ) { sh4 } 949 #( 0.8 0.15 0.05 ) { amps } 950 951 now@ dur 300 300 0.5 ampfun freqfun 0.00 952 #( 0 :L: 100 :L: ) #( 0.33 0.33 0.33 ) sh1 pqw-vox 953 dur 0.2 f+ step 954 now@ dur 200 200 0.5 ampfun freqramp 0.10 955 #( 0 :UH: 100 :ER: ) amps sh2 pqw-vox 956 dur 0.2 f+ step 957 now@ dur 100 314 0.5 ampfun freqramp 0.10 958 #( 0 :UH: 100 :ER: ) amps sh2 pqw-vox 959 dur 0.2 f+ step 960 now@ dur 200 314 0.5 ampfun freqramp 0.01 961 #( 0 :UH: 100 :ER: ) amps sh3 pqw-vox 962 dur 0.2 f+ step 963 now@ dur 100 414 0.5 ampfun freqramp 0.01 964 #( 0 :OW: 50 :E: 100 :ER: ) amps sh4 pqw-vox 965 dur 0.2 f+ step 966; 967 968\ STEREO-FLUTE 969instrument: stereo-flute <{ start dur freq flow :key 970 flow-envelope #( 0 1 100 1 ) 971 decay 0.01 972 noise 0.0356 973 embouchure-size 0.5 974 fbk-scl1 0.5 975 fbk-scl2 0.55 976 out-scl 1.0 977 a0 0.7 978 b1 -0.3 979 vib-rate 5.0 980 vib-amount 0.03 981 ran-rate 5.0 982 ran-amount 0.03 -- }> 983 doc" A physical model of a flute.\n\ 9840 1 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) <'> stereo-flute with-sound." 985 :envelope flow-envelope 986 :scaler flow 987 :duration dur decay f- make-env { flowf } 988 :frequency vib-rate make-oscil { p-vib } 989 :frequency ran-rate make-rand-interp { ran-vib } 990 :frequency mus-srate f2/ :amplitude 1.0 make-rand { breath } 991 mus-srate freq f/ fround->s { periodic-samples } 992 embouchure-size periodic-samples f* fround->s make-delay { emb } 993 periodic-samples make-delay { bore } 994 a0 b1 make-one-pole { rlf } 995 0.0 0.0 0.0 0.0 { emb-sig delay-sig out-sig prev-out-sig } 996 0.0 0.0 0.0 { cur-exit cur-diff cur-flow } 997 0.0 0.0 { dc-blocked prev-dc-blocked } 998 start dur #{ :degree 90.0 random } run-instrument 999 bore out-sig 0.0 delay to delay-sig 1000 emb cur-diff 0.0 delay to emb-sig 1001 p-vib 0.0 0.0 oscil vib-amount f* ran-vib 0.0 rand-interp 1002 ran-amount f* f+ flowf env f+ to cur-flow 1003 breath 0.0 rand cur-flow f* noise f* 1004 cur-flow f+ fbk-scl1 delay-sig f* f+ to cur-diff 1005 emb-sig emb-sig emb-sig f* emb-sig f* f- to cur-exit 1006 rlf fbk-scl2 delay-sig f* cur-exit f+ one-pole to out-sig 1007 \ ;; NB the DC blocker is not in the cicuit. 1008 \ ;; It is applied to the out-sig but the result is 1009 \ ;; not fed back into the system. 1010 out-sig prev-out-sig f- 0.995 1011 prev-dc-blocked f* f+ to dc-blocked 1012 out-sig to prev-out-sig 1013 dc-blocked to prev-dc-blocked 1014 out-scl dc-blocked f* 1015 end-run 1016;instrument 1017 1018: flute-test <{ :optional start 0.0 dur 1.0 -- }> 1019 start now! 1020 now@ dur 440 0.55 :flow-envelope #( 0 0 1 1 2 1 3 0 ) stereo-flute 1021 dur 0.2 f+ step 1022; 1023 1024\ FM-BELL 1025instrument: fm-bell <{ start dur freq amp :optional 1026 amp-env #( 0 0 0.1 1 10 0.6 25 0.3 50 0.15 90 0.1 100 0 ) 1027 index-env #( 0 1 2 1.1 25 0.75 75 0.5 100 0.2 ) 1028 index 1.0 -- }> 1029 freq 32.0 f* hz->radians { fm-ind1 } 1030 8.0 freq 50.0 f/ f- 4.0 f* hz->radians { fm-ind2 } 1031 1.4 freq 250.0 f/ f- 0.705 f* fm-ind2 f* { fm-ind3 } 1032 20.0 freq 20.0 f/ f- 32.0 f* hz->radians { fm-ind4 } 1033 :frequency freq f2* make-oscil { mod1 } 1034 :frequency freq 1.41 f* make-oscil { mod2 } 1035 :frequency freq 2.82 f* make-oscil { mod3 } 1036 :frequency freq 2.4 f* make-oscil { mod4 } 1037 :frequency freq make-oscil { car1 } 1038 :frequency freq make-oscil { car2 } 1039 :frequency freq 2.4 f* make-oscil { car3 } 1040 :envelope amp-env :scaler amp :duration dur make-env { ampf } 1041 :envelope index-env :scaler index :duration dur make-env { indf } 1042 0.0 { fmenv } 1043 start dur #{ :degree 90.0 random } run-instrument 1044 indf env to fmenv 1045 car1 1046 fmenv fm-ind1 f* mod1 0.0 0.0 oscil f* ( fm ) 1047 0.0 ( pm ) oscil 1048 car2 1049 mod2 0.0 0.0 oscil fm-ind2 f* 1050 mod3 0.0 0.0 oscil fm-ind3 f* f+ 1051 fmenv f* ( fm ) 1052 0.0 ( pm ) oscil 0.15 f* f+ ( car1 + car2 ) 1053 car3 1054 mod4 0.0 0.0 oscil fmenv fm-ind4 f* f* ( fm ) 1055 0.0 ( pm ) oscil 0.15 f* f+ ( car12 + car3 ) 1056 ampf env f* ( car123 * ampf ) 1057 end-run 1058;instrument 1059 1060: fm-bell-test <{ :optional start 0.0 dur 1.0 -- }> 1061 start now! 1062 now@ dur 440.0 0.5 fm-bell 1063 dur 0.2 f+ step 1064; 1065 1066\ FM-INSECT 1067\ clm/insect.ins 1068instrument: fm-insect <{ start dur freq 1069 amp amp-env 1070 mod-freq mod-skew mod-freq-env 1071 mod-index mod-index-env 1072 fm-index fm-ratio -- }> 1073 :frequency freq make-oscil { carrier } 1074 :frequency mod-freq make-oscil { fm1-osc } 1075 :frequency fm-ratio freq f* make-oscil { fm2-osc } 1076 :envelope amp-env :scaler amp :duration dur make-env { ampf } 1077 :envelope mod-index-env 1078 :scaler mod-index hz->radians 1079 :duration dur make-env { indf } 1080 :envelope mod-freq-env 1081 :scaler mod-skew hz->radians 1082 :duration dur make-env { modfrqf } 1083 fm-index fm-ratio f* freq f* hz->radians { fm2-amp } 1084 0.0 0.0 { garble-in garble-out } 1085 start dur #{ :degree 90.0 random } run-instrument 1086 fm1-osc modfrqf env 0.0 oscil indf env f* to garble-in 1087 fm2-osc garble-in 0.0 oscil fm2-amp f* to garble-out 1088 carrier garble-out garble-in f+ 0.0 oscil ampf env f* 1089 end-run 1090;instrument 1091 1092: fm-insect-test <{ :optional start 0.0 dur 1.0 -- }> 1093 start now! 1094 #( 0 0 40 1 95 1 100 0.5 ) { locust } 1095 #( 0 1 25 0.7 75 0.78 100 1 ) { bug-hi } 1096 #( 0 0 25 1 75 0.7 100 0 ) { amp } 1097 1098 now@ 0.000 f+ 1.699 4142.627 0.015 amp 60 -16.707 1099 locust 500.866 bug-hi 0.346 0.5 fm-insect 1100 now@ 0.195 f+ 0.233 4126.284 0.030 amp 60 -12.142 1101 locust 649.490 bug-hi 0.407 0.5 fm-insect 1102 now@ 0.217 f+ 2.057 3930.258 0.045 amp 60 -3.011 1103 locust 562.087 bug-hi 0.591 0.5 fm-insect 1104 now@ 2.100 f+ 1.500 900.627 0.060 amp 40 -16.707 1105 locust 300.866 bug-hi 0.346 0.5 fm-insect 1106 now@ 3.000 f+ 1.500 900.627 0.060 amp 40 -16.707 1107 locust 300.866 bug-hi 0.046 0.5 fm-insect 1108 now@ 3.450 f+ 1.500 900.627 0.090 amp 40 -16.707 1109 locust 300.866 bug-hi 0.006 0.5 fm-insect 1110 now@ 3.950 f+ 1.500 900.627 0.120 amp 40 -10.707 1111 locust 300.866 bug-hi 0.346 0.5 fm-insect 1112 now@ 4.300 f+ 1.500 900.627 0.090 amp 40 -20.707 1113 locust 300.866 bug-hi 0.246 0.5 fm-insect 1114 6.0 step 1115; 1116 1117\ FM-DRUM 1118\ 1119\ Jan Mattox's fm drum: 1120instrument: fm-drum <{ start dur freq amp index :optional 1121 high #f 1122 degr 0.0 1123 dist 1.0 1124 rev-amt 0.01 -- }> 1125 high if 1126 3.414 8.525 1127 else 1128 1.414 3.515 1129 then { casrat fmrat } 1130 :envelope #( 0 0 25 0 75 1 100 1 ) 1131 :scaler high if 1132 66.0 hz->radians 1133 else 1134 0 1135 then 1136 :duration dur make-env { glsf } 1137 #( 0 0 3 0.05 5 0.2 7 0.8 8 0.95 1138 10 1.0 12 0.95 20 0.3 30 0.1 100 0 ) { ampfun } 1139 high if 1140 0.01 1141 else 1142 0.015 1143 then 100.0 f* dur f/ { atdrpt } 1144 :envelope ampfun 1145 10.0 1146 atdrpt 1147 15.0 1148 100.0 dur 0.2 f- dur f/ 100.0 f* f- 1149 atdrpt 1.0 f+ fmax stretch-envelope 1150 :scaler amp 1151 :duration dur make-env { ampf } 1152 #( 0 0 5 0.014 10 0.033 15 0.061 20 0.099 1153 25 0.153 30 0.228 35 0.332 40 0.477 45 0.681 1154 50 0.964 55 0.681 60 0.478 65 0.332 70 0.228 1155 75 0.153 80 0.099 85 0.061 90 0.033 95 0.0141 100 0 ) { indxfun } 1156 100.0 dur 0.1 f- dur f/ 100.0 f* f- { indxpt } 1157 indxfun 50.0 atdrpt 65.0 indxpt stretch-envelope { divindxf } 1158 :envelope divindxf 1159 :duration dur 1160 :scaler fmrat freq f* index f* hz->radians 1161 pi fmin make-env { indxf } 1162 :envelope divindxf 1163 :duration dur 1164 :scaler casrat freq f* index f* hz->radians 1165 pi fmin make-env { mindxf } 1166 :envelope ampfun 1167 10.0 1168 atdrpt 1169 90.0 1170 100.0 dur 0.05 f- dur f/ 100.0 f* f- 1171 atdrpt 1.0 f+ fmax stretch-envelope 1172 :duration dur 1173 :scaler 7000.0 hz->radians pi fmin make-env { devf } 1174 :frequency 7000.0 :amplitude 1 make-rand { rn } 1175 :frequency freq make-oscil { car } 1176 :frequency freq fmrat f* make-oscil { fmosc } 1177 :frequency freq casrat f* make-oscil { cc } 1178 0.0 { gls } 1179 start dur 1180 #{ :degree degr :distance dist :reverb rev-amt } run-instrument 1181 glsf env to gls 1182 cc ( gen ) 1183 devf env 1184 rn 0.0 rand f* 1185 gls casrat f* f+ ( fm ) 0.0 ( pm ) oscil 1186 mindxf env f* gls fmrat f* f+ ( fm ) 1187 fmosc ( gen ) swap 0.0 ( pm ) oscil 1188 indxf env f* gls f+ ( fm ) 1189 car ( gen ) swap 0.0 ( pm ) oscil 1190 ampf env f* 1191 end-run 1192;instrument 1193 1194: fm-drum-test <{ :optional start 0.0 dur 1.0 -- }> 1195 start now! 1196 now@ dur 55 0.3 5 fm-drum 1197 dur 0.2 f+ step 1198 now@ dur 66 0.3 4 #t fm-drum 1199 dur 0.2 f+ step 1200; 1201 1202\ FM-GONG 1203\ 1204\ Paul Weineke's gong. 1205instrument: gong <{ start dur freq amp :key 1206 degree 0.0 1207 distance 1.0 1208 reverb-amount 0.005 -- }> 1209 0.01 1.160 freq f* f* hz->radians { indx01 } 1210 0.30 1.160 freq f* f* hz->radians { indx11 } 1211 0.01 3.140 freq f* f* hz->radians { indx02 } 1212 0.38 3.140 freq f* f* hz->radians { indx12 } 1213 0.01 1.005 freq f* f* hz->radians { indx03 } 1214 0.50 1.005 freq f* f* hz->radians { indx13 } 1215 5 { atpt } 1216 100 0.002 dur f/ f* { atdur } 1217 #( 0 0 3 1 15 0.5 27 0.25 50 0.1 100 0 ) { expf } 1218 #( 0 0 15 0.3 30 1.0 75 0.5 100 0 ) { rise } 1219 #( 0 0 75 1.0 98 1.0 100 0 ) { fmup } 1220 #( 0 0 2 1.0 100 0 ) { fmdwn } 1221 :envelope expf atpt atdur 0 0 stretch-envelope 1222 :scaler amp 1223 :duration dur make-env { ampfun } 1224 :envelope fmup 1225 :scaler indx11 indx01 f- 1226 :duration dur :offset indx01 make-env { indxfun1 } 1227 :envelope fmdwn 1228 :scaler indx12 indx02 f- 1229 :duration dur 1230 :offset indx02 make-env { indxfun2 } 1231 :envelope rise 1232 :scaler indx13 indx03 f- 1233 :duration dur 1234 :offset indx03 make-env { indxfun3 } 1235 :frequency freq make-oscil { car } 1236 :frequency freq 1.160 f* make-oscil { mod1 } 1237 :frequency freq 3.140 f* make-oscil { mod2 } 1238 :frequency freq 1.005 f* make-oscil { mod3 } 1239 start dur 1240 #{ :degree degree :distance distance :reverb reverb-amount } 1241 run-instrument 1242 car 1243 mod3 0.0 0.0 oscil indxfun3 env f* 1244 mod2 0.0 0.0 oscil indxfun2 env f* f+ 1245 mod1 0.0 0.0 oscil indxfun1 env f* f+ 1246 0.0 oscil ampfun env f* 1247 end-run 1248;instrument 1249 1250: gong-test <{ :optional start 0.0 dur 1.0 -- }> 1251 start now! 1252 now@ dur 261.61 0.6 gong 1253 dur 0.2 f+ step 1254; 1255 1256\ ATTRACT 1257\ 1258\ by James McCartney, from CMJ vol 21 no 3 p 6 1259instrument: attract <{ start dur amp c -- }> 1260 0.2 0.2 { a b } 1261 0.04 { dt } 1262 amp f2/ c f/ { scale } 1263 -1.0 { x } 1264 0.0 0.0 0.0 { x1 y z } 1265 start dur #{ :degree 90.0 random } run-instrument 1266 x y z f+ dt f* f- to x1 1267 a y f* x f+ dt f* y f+ to y 1268 x z f* b f+ c z f* f- dt f* z f+ to z 1269 x1 to x 1270 scale x f* 1271 end-run 1272;instrument 1273 1274: attract-test <{ :optional start 0.0 dur 1.0 -- }> 1275 start now! 1276 now@ dur 0.5 2.0 attract 1277 dur 0.2 f+ step 1278; 1279 1280\ PQW 1281\ 1282\ phase-quadrature waveshaping used to create asymmetric (i.e. single 1283\ side-band) spectra. The basic idea here is a variant of sin x sin y 1284\ - cos x cos y = cos (x + y) 1285\ 1286\ clm/pqw.ins 1287instrument: pqw <{ start dur sfreq cfreq amp ampfun indexfun parts :key 1288 degree 0.0 1289 distance 1.0 1290 reverb-amount 0.005 -- }> 1291 parts normalize-partials { nparts } 1292 :frequency sfreq :initial-phase half-pi make-oscil { sp-cos } 1293 :frequency sfreq make-oscil { sp-sin } 1294 :frequency cfreq :initial-phase half-pi make-oscil { c-cos } 1295 :frequency cfreq make-oscil { c-sin } 1296 nparts mus-chebyshev-second-kind partials->polynomial { sin-coeffs } 1297 nparts mus-chebyshev-first-kind partials->polynomial { cos-coeffs } 1298 :envelope ampfun :scaler amp :duration dur make-env { amp-env } 1299 :envelope indexfun :duration dur make-env { ind-env } 1300 0.0 0.0 0.0 0.0 { vib ax fax yfax } 1301 cfreq sfreq f/ { r } 1302 :frequency 5.0 1303 :amplitude 0.005 sfreq f* hz->radians make-triangle-wave { tr } 1304 :frequency 12.0 1305 :amplitude 0.005 sfreq f* hz->radians make-rand-interp { rn } 1306 start dur 1307 #{ :degree degree :distance distance :reverb reverb-amount } 1308 run-instrument 1309 tr 0.0 triangle-wave rn 0.0 rand-interp f+ to vib 1310 1.0 ind-env env fmin sp-cos vib 0.0 oscil f* to ax 1311 cos-coeffs ax polynomial to fax 1312 sp-sin vib 0.0 oscil sin-coeffs ax polynomial f* to yfax 1313 c-sin vib r f* 0.0 oscil yfax f* 1314 c-cos vib r f* 0.0 oscil fax f* f- amp-env env f* 1315 end-run 1316;instrument 1317 1318: pqw-test <{ :optional start 0.0 dur 1.0 -- }> 1319 start now! 1320 now@ dur 200 1000 0.2 1321 #( 0 0 25 1 100 0 ) #( 0 1 100 0 ) #( 2 0.1 3 0.3 6 0.5 ) pqw 1322 dur 0.2 f+ step 1323; 1324 1325\ taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was 1326\ in a bit of a hurry and may not have made slavishly accurate 1327\ translations. Please let me (bil@ccrma.stanford.edu) know of any 1328\ serious (non-envelope) errors. 1329\ 1330\ from Perry Cook's TubeBell.cpp 1331instrument: tubebell <{ start dur freq amp :optional base 32.0 -- }> 1332 :frequency freq 0.995 f* make-oscil { osc0 } 1333 :frequency freq 0.995 1.414 f* f* make-oscil { osc1 } 1334 :frequency freq 1.005 f* make-oscil { osc2 } 1335 :frequency freq 1.414 f* make-oscil { osc3 } 1336 :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) 1337 :base base 1338 :duration dur make-env { ampenv1 } 1339 :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 ) 1340 :base base f2* 1341 :duration dur make-env { ampenv2 } 1342 :frequency 2.0 make-oscil { ampmod } 1343 amp f2/ { g0 } 1344 g0 0.707 f* { g1 } 1345 start dur #{ :degree 90.0 random } run-instrument 1346 ampmod 0.0 0.0 oscil 0.007 f* 0.993 f+ ( amp ) 1347 osc0 1348 osc1 0.0 0.0 oscil 0.203 f* 1349 0.0 oscil ampenv1 env f* g1 f* 1350 osc2 1351 osc3 0.0 0.0 oscil 0.144 f* 1352 0.0 oscil ampenv2 env f* g0 f* 1353 f+ ( osc0 + osc2 ) 1354 f* ( amp * osc0+2 ) 1355 end-run 1356;instrument 1357 1358: tubebell-test <{ :optional start 0.0 dur 1.0 -- }> 1359 start now! 1360 now@ dur 440 0.2 32 tubebell 1361 dur 0.2 f+ step 1362; 1363 1364\ from Perry Cook's Wurley.cpp 1365instrument: wurley <{ start dur freq amp -- }> 1366 :frequency freq make-oscil { osc0 } 1367 :frequency freq 4 f* make-oscil { osc1 } 1368 :frequency 510 make-oscil { osc2 } 1369 :frequency 510 make-oscil { osc3 } 1370 :frequency 8 make-oscil { ampmod } 1371 :envelope #( 0 0 1 1 9 1 10 0 ) :duration dur make-env { ampenv } 1372 :envelope #( 0 0 0.001 1 0.15 0 dur 0.16 fmax 0 ) 1373 :duration dur make-env { indenv } 1374 :envelope #( 0 0 0.001 1 0.25 0 dur 0.26 fmax 0 ) 1375 :duration dur make-env { resenv } 1376 amp f2/ { g0 } 1377 g0 0.307 f* { g1 } 1378 start dur #{ :degree 90.0 random } run-instrument 1379 ampenv env ( amp ) 1380 ampmod 0.0 0.0 oscil 0.007 f* 1.0 f+ f* ( ampmod * amp ) 1381 osc0 1382 osc1 0.0 0.0 oscil 0.307 f* 1383 0.0 oscil g0 f* 1384 osc2 1385 osc3 0.0 0.0 oscil indenv env f* 0.117 f* 1386 0.0 oscil g1 f* 1387 resenv env f* 1388 f+ ( osc0 + osc2 ) 1389 f* ( amp * osc0+2 ) 1390 end-run 1391;instrument 1392 1393: wurley-test <{ :optional start 0.0 dur 1.0 -- }> 1394 start now! 1395 now@ dur 440 0.2 wurley 1396 dur 0.2 f+ step 1397; 1398 1399\ from Perry Cook's Rhodey.cpp 1400instrument: rhodey <{ start dur freq amp :optional base 0.5 -- }> 1401 :frequency freq make-oscil { osc0 } 1402 :frequency freq make-oscil { osc1 } 1403 :frequency freq make-oscil { osc2 } 1404 :frequency freq make-oscil { osc3 } 1405 :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) 1406 :base base :duration dur make-env { ampenv1 } 1407 :envelope #( 0 0 0.001 1 dur 0.002 fmax 0 ) 1408 :base base 1.5 f* :duration dur make-env { ampenv2 } 1409 :envelope #( 0 0 0.001 1 0.25 0 ) 1410 :base base 4 f* 1411 :duration dur make-env { ampenv3 } 1412 amp f2/ { g0 } 1413 start dur #{ :degree 90.0 random } run-instrument 1414 osc0 1415 osc1 0.0 0.0 oscil 0.535 f* 1416 0.0 oscil ampenv1 env f* g0 f* 1417 osc2 1418 osc3 0.0 0.0 oscil 0.109 f* ampenv3 env f* 1419 0.0 oscil ampenv2 env f* g0 f* 1420 f+ ( osc0 + osc2 ) 1421 end-run 1422;instrument 1423 1424: rhodey-test <{ :optional start 0.0 dur 1.0 -- }> 1425 start now! 1426 now@ dur 440 0.2 0.5 rhodey 1427 dur 0.2 f+ step 1428; 1429 1430\ from Perry Cook's BeeThree.cpp 1431instrument: hammondoid <{ start dur freq amp -- }> 1432 :frequency freq 0.999 f* make-oscil { osc0 } 1433 :frequency freq 1.997 f* make-oscil { osc1 } 1434 :frequency freq 3.006 f* make-oscil { osc2 } 1435 :frequency freq 6.009 f* make-oscil { osc3 } 1436 :envelope #( 0 0 0.005 1 dur 0.006 fmax 0.008 f- 1 dur 0 ) 1437 :duration dur make-env { ampenv1 } 1438 :envelope #( 0 0 0.005 1 dur 0.006 fmax 0 ) 1439 :duration dur make-env { ampenv2 } 1440 amp f2/ { g0 } 1441 0.1875 amp f* { amp0.1875 } 1442 0.375 amp f* { amp0.375 } 1443 start dur #{ :degree 90.0 random } run-instrument 1444 osc0 0.0 0.0 oscil amp0.1875 f* 1445 osc1 0.0 0.0 oscil amp0.1875 f* 1446 f+ ( osc0 + osc1 ) 1447 osc2 0.0 0.0 oscil g0 f* 1448 f+ ( osc0+1 + osc2 ) 1449 ampenv1 env f* ( osc0+1+2 * amp1 ) 1450 osc3 0.0 0.0 oscil amp0.375 f* 1451 ampenv2 env f* ( osc3 * amp2 ) 1452 f+ ( osc0+1+2*amp1 + osc3*amp2 ) 1453 end-run 1454;instrument 1455 1456: hammondoid-test <{ :optional start 0.0 dur 1.0 -- }> 1457 start now! 1458 now@ dur 440 0.2 hammondoid 1459 dur 0.2 f+ step 1460; 1461 1462\ from Perry Cook's HeavyMtl.cpp 1463instrument: metal <{ start dur freq amp -- }> 1464 :frequency freq make-oscil { osc0 } 1465 :frequency freq 4 f* 0.999 f* make-oscil { osc1 } 1466 :frequency freq 3 f* 1.001 f* make-oscil { osc2 } 1467 :frequency freq 0.5 f* 1.002 f* make-oscil { osc3 } 1468 :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.002 f- 1 dur 0 ) 1469 :duration dur make-env { ampenv0 } 1470 :envelope #( 0 0 0.001 1 dur 0.002 fmax 0.011 f- 1 dur 0 ) 1471 :duration dur make-env { ampenv1 } 1472 :envelope #( 0 0 0.010 1 dur 0.020 fmax 0.015 f- 1 dur 0 ) 1473 :duration dur make-env { ampenv2 } 1474 :envelope #( 0 0 0.030 1 dur 0.040 fmax 0.040 f- 1 dur 0 ) 1475 :duration dur make-env { ampenv3 } 1476 0.615 amp f* { amp0.615 } 1477 start dur #{ :degree 90.0 random } run-instrument 1478 osc0 1479 osc1 1480 osc2 0.0 0.0 oscil ampenv2 env f* 0.574 f* ( fm1 ) 1481 0.0 ( pm1 ) oscil ampenv1 env f* 0.202 f* ( osc1 ) 1482 osc3 0.0 0.0 oscil ampenv3 env f* 0.116 f* ( osc3 ) 1483 f+ ( fm0 = osc1 + osc3 ) 1484 0.0 ( pm0 ) oscil ampenv0 env f* amp0.615 f* ( osc0 ) 1485 end-run 1486;instrument 1487 1488: metal-test <{ :optional start 0.0 dur 1.0 -- }> 1489 start now! 1490 now@ dur 440 0.2 metal 1491 dur 0.2 f+ step 1492; 1493 1494\ DRONE 1495instrument: drone 1496 <{ start dur freq amp ampfun synth ampat ampdc rvibamt rvibfreq -- }> 1497 :frequency freq :wave synth #f #f partials->wave make-table-lookup { s } 1498 :envelope ampfun 1499 25.0 1500 ampat dur f/ 100.0 f* 1501 75.0 1502 100.0 ampdc dur f/ 100.0 f* f- stretch-envelope 1503 :scaler amp 0.25 f* :duration dur make-env { ampenv } 1504 :frequency rvibfreq 1505 :amplitude rvibamt freq f* hz->radians make-rand { ranvib } 1506 start dur #{ :degree 90.0 random } run-instrument 1507 s ranvib 0.0 rand fabs table-lookup ampenv env f* 1508 end-run 1509;instrument 1510 1511\ CANTER 1512instrument: canter <{ start dur pitch amp 1513 ampfun ranfun skewfun skewpc ranpc ranfreq indexfun atdr dcdr 1514 ampfun1 indfun1 fmtfun1 1515 ampfun2 indfun2 fmtfun2 1516 ampfun3 indfun3 fmtfun3 1517 ampfun4 indfun4 fmtfun4 -- }> 1518 pitch 400.0 f/ flog 910.0 400.0 f/ flog f/ 100.0 f* floor { k } 1519 100.0 atdr dur f/ f* { atpt } 1520 100.0 100.0 dcdr dur f/ f* f- { dcpt } 1521 k fmtfun1 1.0 envelope-interp { lfmt1 } 1522 0.5 lfmt1 pitch f/ f+ floor { harm1 } 1523 k indfun1 1.0 envelope-interp pitch f* hz->radians { dev11 } 1524 dev11 f2/ { dev01 } 1525 k ampfun1 1.0 envelope-interp amp f* 1.0 harm1 lfmt1 1526 pitch f/ f- fabs f- f* { lamp1 } 1527 k fmtfun2 1.0 envelope-interp { lfmt2 } 1528 0.5 lfmt2 pitch f/ f+ floor { harm2 } 1529 k indfun2 1.0 envelope-interp pitch f* hz->radians { dev12 } 1530 dev12 f2/ { dev02 } 1531 k ampfun2 1.0 envelope-interp amp f* 1.0 harm2 lfmt2 1532 pitch f/ f- fabs f- f* { lamp2 } 1533 k fmtfun3 1.0 envelope-interp { lfmt3 } 1534 0.5 lfmt3 pitch f/ f+ floor { harm3 } 1535 k indfun3 1.0 envelope-interp pitch f* hz->radians { dev13 } 1536 dev13 f2/ { dev03 } 1537 k ampfun3 1.0 envelope-interp amp f* 1.0 harm3 lfmt3 1538 pitch f/ f- fabs f- f* { lamp3 } 1539 k fmtfun4 1.0 envelope-interp { lfmt4 } 1540 0.5 lfmt4 pitch f/ f+ floor { harm4 } 1541 k indfun4 1.0 envelope-interp pitch f* hz->radians { dev14 } 1542 dev14 f2/ { dev04 } 1543 k ampfun4 1.0 envelope-interp amp f* 1.0 harm4 lfmt4 1544 pitch f/ f- fabs f- f* { lamp4 } 1545 :envelope ampfun 25.0 atpt 75.0 dcpt stretch-envelope 1546 :duration dur make-env { tampfun } 1547 :envelope skewfun 25.0 atpt 75.0 dcpt stretch-envelope 1548 :duration dur 1549 :scaler pitch skewpc f* hz->radians make-env { tskwfun } 1550 :envelope ranfun 25.0 atpt 75.0 dcpt stretch-envelope 1551 :duration dur make-env { tranfun } 1552 :envelope indexfun 25.0 atpt 75.0 dcpt stretch-envelope 1553 :duration dur make-env { tidxfun } 1554 :frequency pitch make-oscil { modgen } 1555 :frequency pitch harm1 f* make-oscil { gen1 } 1556 :frequency pitch harm2 f* make-oscil { gen2 } 1557 :frequency pitch harm3 f* make-oscil { gen3 } 1558 :frequency pitch harm4 f* make-oscil { gen4 } 1559 :frequency ranfreq 1560 :amplitude ranpc pitch f* hz->radians make-rand { ranvib } 1561 0.0 0.0 0.0 0.0 { frqval modval ampval indval } 1562 start dur #{ :degree 90.0 random } run-instrument 1563 tskwfun env tranfun env ranvib 0.0 rand f* f+ to frqval 1564 modgen frqval 0.0 oscil to modval 1565 tampfun env to ampval 1566 tidxfun env to indval 1567 gen1 1568 indval dev11 f* dev01 f+ modval f* frqval f+ harm1 f* 1569 0.0 oscil lamp1 ampval f* f* 1570 gen2 1571 indval dev12 f* dev02 f+ modval f* frqval f+ harm2 f* 1572 0.0 oscil lamp2 ampval f* f* 1573 f+ ( gen1 + gen2 ) 1574 gen3 1575 indval dev13 f* dev03 f+ modval f* frqval f+ harm3 f* 1576 0.0 oscil lamp3 ampval f* f* 1577 f+ ( gen1+2 + gen3 ) 1578 gen4 1579 indval dev14 f* dev04 f+ modval f* frqval f+ harm4 f* 1580 0.0 oscil lamp4 ampval f* f* 1581 f+ ( gen1+2+3 + gen4 ) 1582 end-run 1583;instrument 1584 1585: drone/canter-test <{ :optional start 0.0 dur 1.0 -- }> 1586 start now! 1587 #( 0 1200 100 1000 ) { fmt1 } 1588 #( 0 2250 100 1800 ) { fmt2 } 1589 #( 0 4500 100 4500 ) { fmt3 } 1590 #( 0 6750 100 8100 ) { fmt4 } 1591 #( 0 0.67 100 0.70 ) { amp1 } 1592 #( 0 0.95 100 0.95 ) { amp2 } 1593 #( 0 0.28 100 0.33 ) { amp3 } 1594 #( 0 0.14 100 0.15 ) { amp4 } 1595 #( 0 0.75 100 0.65 ) { ind1 } 1596 #( 0 0.75 100 0.75 ) { ind2 } 1597 #( 0 1 100 1 ) { ind3 } 1598 #( 0 1 100 1 ) { ind4 } 1599 #( 0 0 100 0 ) { skwf } 1600 #( 0 0 25 1 75 1 100 0 ) { ampf } 1601 #( 0 0.5 100 0.5 ) { ranf } 1602 #( 0 1 100 1 ) { index } 1603 #( 0 0 5 1 95 1 100 0 ) { solid } 1604 #( 0.5 0.06 1 0.62 1.5 0.07 2 0.6 2.5 0.08 3 0.56 4 0.24 5 0.98 6 0.53 1605 7 0.16 8 0.33 9 0.62 10 0.12 12 1606 0.14 14 0.86 16 0.12 23 0.14 24 0.17 ) { bassdr2 } 1607 #( 0.3 0.04 1 0.81 2 0.27 3 0.2 4 0.21 5 0.18 6 0.35 7 0.03 1608 8 0.07 9 0.02 10 0.025 11 0.035 ) { tenordr } 1609 1610 now@ 4 115.0 0.125 solid bassdr2 0.1 0.5 0.01 10 drone 1611 now@ 4 229.0 0.125 solid tenordr 0.1 0.5 0.01 11 drone 1612 now@ 4 229.5 0.125 solid tenordr 0.1 0.5 0.01 09 drone 1613 now@ 2.100 918.000 0.175 ampf ranf skwf 0.050 1614 0.01 10 index 0.005 0.005 1615 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1616 now@ 2.100 f+ 0.300 688.500 0.175 ampf ranf skwf 0.050 1617 0.01 10 index 0.005 0.005 1618 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1619 now@ 2.400 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050 1620 0.01 10 index 0.005 0.005 1621 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1622 now@ 2.440 f+ 0.560 459.000 0.175 ampf ranf skwf 0.050 1623 0.01 10 index 0.005 0.005 1624 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1625 now@ 3.000 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050 1626 0.01 10 index 0.005 0.005 1627 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1628 now@ 3.040 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050 1629 0.01 10 index 0.005 0.005 1630 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1631 now@ 3.080 f+ 0.040 408.000 0.175 ampf ranf skwf 0.050 1632 0.01 10 index 0.005 0.005 1633 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1634 now@ 3.120 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050 1635 0.01 10 index 0.005 0.005 1636 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1637 now@ 3.160 f+ 0.290 459.000 0.175 ampf ranf skwf 0.050 1638 0.01 10 index 0.005 0.005 1639 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1640 now@ 3.450 f+ 0.150 516.375 0.175 ampf ranf skwf 0.050 1641 0.01 10 index 0.005 0.005 1642 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1643 now@ 3.600 f+ 0.040 826.200 0.175 ampf ranf skwf 0.050 1644 0.01 10 index 0.005 0.005 1645 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1646 now@ 3.640 f+ 0.040 573.750 0.175 ampf ranf skwf 0.050 1647 0.01 10 index 0.005 0.005 1648 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1649 now@ 3.680 f+ 0.040 619.650 0.175 ampf ranf skwf 0.050 1650 0.01 10 index 0.005 0.005 1651 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1652 now@ 3.720 f+ 0.180 573.750 0.175 ampf ranf skwf 0.050 1653 0.01 10 index 0.005 0.005 1654 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1655 now@ 3.900 f+ 0.040 688.500 0.175 ampf ranf skwf 0.050 1656 0.01 10 index 0.005 0.005 1657 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1658 now@ 3.940 f+ 0.260 459.000 0.175 ampf ranf skwf 0.050 1659 0.01 10 index 0.005 0.005 1660 amp1 ind1 fmt1 amp2 ind2 fmt2 amp3 ind3 fmt3 amp4 ind4 fmt4 canter 1661 4.4 step 1662; 1663 1664hide 1665: (nrev-one) { flts combs allpasses allpass4 low volume dur -- } 1666 flts 0 array-ref { gen } 1667 dur run-reverb ( in-val ) 1668 volume f* ( val ) 1669 combs swap comb-bank ( val ) 1670 allpasses swap all-pass-bank ( val ) 1671 low swap one-pole ( val ) 1672 allpass4 swap 0.0 all-pass ( val ) 1673 gen swap 0.0 all-pass ( samp ) 1674 end-run-reverb-out-1 1675; 1676 1677: (nrev-two) { flts combs allpasses allpass4 low volume dur -- } 1678 flts 0 array-ref { gen1 } 1679 flts 1 array-ref { gen2 } 1680 0.0 { val } 1681 dur run-reverb ( in-val ) 1682 volume f* ( val ) 1683 combs swap comb-bank ( val ) 1684 allpasses swap all-pass-bank ( val ) 1685 low swap one-pole ( val ) 1686 allpass4 swap 0.0 all-pass to val 1687 gen1 val 0.0 all-pass ( samp1 ) 1688 gen2 val 0.0 all-pass ( samp1 samp2 ) 1689 end-run-reverb-out-2 1690; 1691 1692: (nrev-quad) { flts combs allpasses allpass4 low volume dur -- } 1693 flts 0 array-ref { gen1 } 1694 flts 1 array-ref { gen2 } 1695 flts 2 array-ref { gen3 } 1696 flts 3 array-ref { gen4 } 1697 0.0 { val } 1698 dur run-reverb ( in-val ) 1699 volume f* ( val ) 1700 combs swap comb-bank ( val ) 1701 allpasses swap all-pass-bank ( val ) 1702 low swap one-pole ( val ) 1703 allpass4 swap 0.0 all-pass to val 1704 gen1 val 0.0 all-pass ( s1 ) 1705 gen2 val 0.0 all-pass ( s1 s2 ) 1706 gen3 val 0.0 all-pass ( s1 s2 s3 ) 1707 gen4 val 0.0 all-pass ( s1 s2 s3 s4 ) 1708 end-run-reverb-out-4 1709; 1710set-current 1711 1712\ NREV (the most popular Samson box reverb) 1713\ 1714\ REVERB-FACTOR controls the length of the decay -- it should not 1715\ exceed (/ 1.0 .823), LP-COEFF controls the strength of the low pass 1716\ filter inserted in the feedback loop, VOLUME can be used to boost the 1717\ reverb output. 1718\ 1719\ clm/nrev.ins and snd/nrev.scm 1720instrument: nrev <{ :key reverb-factor 1.09 lp-coeff 0.7 volume 1.0 -- }> 1721 doc" NREV (the most popular Samson box reverb).\n\ 1722REVERB-FACTOR controls the length of the decay -- it should not \ 1723exceed (/ 1.0 .823), LP-COEFF controls the strength of the low pass \ 1724filter inserted in the feedback loop, VOLUME can be used to boost the \ 1725reverb output.\n\ 1726<'> fm-violin-test :reverb <'> nrev with-sound." 1727 mus-srate 25641.0 f/ { sr } 1728 #( 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19 ) map 1729 sr *key* f* f>s dup 2 mod unless 1730 1+ 1731 then ( val ) 1732 begin 1733 ( val ) dup prime? false? 1734 while 1735 2 + 1736 repeat ( val ) 1737 end-map { dly-len } 1738 :scaler 0.822 reverb-factor f* 1739 :size dly-len 0 array-ref make-comb { comb1 } 1740 :scaler 0.802 reverb-factor f* 1741 :size dly-len 1 array-ref make-comb { comb2 } 1742 :scaler 0.773 reverb-factor f* 1743 :size dly-len 2 array-ref make-comb { comb3 } 1744 :scaler 0.753 reverb-factor f* 1745 :size dly-len 3 array-ref make-comb { comb4 } 1746 :scaler 0.753 reverb-factor f* 1747 :size dly-len 4 array-ref make-comb { comb5 } 1748 :scaler 0.733 reverb-factor f* 1749 :size dly-len 5 array-ref make-comb { comb6 } 1750 :feedback -0.7 :feedforward 0.7 1751 :size dly-len 6 array-ref make-all-pass { allpass1 } 1752 :feedback -0.7 :feedforward 0.7 1753 :size dly-len 7 array-ref make-all-pass { allpass2 } 1754 :feedback -0.7 :feedforward 0.7 1755 :size dly-len 8 array-ref make-all-pass { allpass3 } 1756 :feedback -0.7 :feedforward 0.7 1757 :size dly-len 9 array-ref make-all-pass { allpass4 } 1758 :feedback -0.7 :feedforward 0.7 1759 :size dly-len 11 array-ref make-all-pass { allpass5 } 1760 :feedback -0.7 :feedforward 0.7 1761 :size dly-len 12 array-ref make-all-pass { allpass6 } 1762 :feedback -0.7 :feedforward 0.7 1763 :size dly-len 13 array-ref make-all-pass { allpass7 } 1764 :feedback -0.7 :feedforward 0.7 1765 :size dly-len 14 array-ref make-all-pass { allpass8 } 1766 lp-coeff lp-coeff 1.0 f- make-one-pole { low } 1767 *output* channels { chans } 1768 *reverb* ws-framples samples->seconds *decay-time* f+ { dur } 1769 chans 1 = if 1770 #( allpass5 ) 1771 else 1772 chans 2 = if 1773 #( allpass5 allpass6 ) 1774 else 1775 #( allpass5 allpass6 allpass7 allpass8 ) 1776 then 1777 then { flts } 1778 #( comb1 comb2 comb3 comb4 comb5 comb6 ) make-comb-bank { combs } 1779 #( allpass1 allpass2 allpass3 ) make-all-pass-bank { allpasses } 1780 chans 1 = if 1781 flts combs allpasses allpass4 low volume dur (nrev-one) 1782 else 1783 chans 2 = if 1784 flts combs allpasses allpass4 low volume dur (nrev-two) 1785 else 1786 flts combs allpasses allpass4 low volume dur (nrev-quad) 1787 then 1788 then 1789;instrument 1790previous 1791 1792#( "reson-carriers" 1793 "reson-ampfs" 1794 "reson-indfs" 1795 "reson-c-rats" ) create-struct make-reson-struct 1796 1797\ RESON 1798instrument: reson <{ start dur pitch amp 1799 indxfun skewfun pcskew 1800 skewat skewdc 1801 vibfreq vibpc 1802 ranvibfreq ranvibpc data -- }> 1803 :frequency pitch make-oscil { mod } 1804 :envelope skewfun 1805 25.0 1806 skewat dur f/ 100.0 f* 1807 75.0 1808 100.0 skewdc dur f/ 100.0 f* f- stretch-envelope 1809 :scaler pcskew pitch f* hz->radians 1810 :duration dur make-env { frqf } 1811 :frequency vibfreq 1812 :amplitude vibpc pitch f* hz->radians make-triangle-wave { pervib } 1813 :frequency ranvibfreq 1814 :amplitude ranvibpc pitch f* hz->radians make-rand-interp { ranvib } 1815 0.0 ( sum ) 1816 data each ( lst-val ) 1817 2 object-ref f+ ( sum += ... ) 1818 end-each { totalamp } 1819 nil { rs } 1820 data object->array map! *key* { frmdat } 1821 frmdat 0 object-ref { ampf } 1822 frmdat 1 object-ref { freq } 1823 frmdat 2 object-ref { rfamp } 1824 frmdat 3 object-ref dur f/ 100.0 f* { ampat } 1825 100.0 frmdat 4 object-ref dur f/ 100.0 f* f- { ampdc } 1826 frmdat 5 object-ref freq f* hz->radians { dev0 } 1827 frmdat 6 object-ref freq f* hz->radians { dev1 } 1828 frmdat 7 object-ref dur f/ 100.0 f* { indxat } 1829 100.0 frmdat 8 object-ref dur f/ 100.0 f* f- { indxdc } 1830 freq pitch f/ fround->s { harm } 1831 1.0 harm freq pitch f/ f- fabs f- { rsamp } 1832 pitch harm f* { cfq } 1833 ampat f0= if 1834 25.0 to ampat 1835 then 1836 ampdc f0= if 1837 75.0 to ampdc 1838 then 1839 indxat f0= if 1840 25.0 to indxat 1841 then 1842 indxdc f0= if 1843 75.0 to indxdc 1844 then 1845 make-reson-struct to rs 1846 :envelope indxfun 25.0 indxat 75.0 indxdc stretch-envelope 1847 :scaler dev1 dev0 f- 1848 :offset dev0 1849 :duration dur make-env rs swap reson-indfs! 1850 :envelope ampf 25.0 ampat 75.0 ampdc stretch-envelope 1851 :scaler rsamp amp rfamp totalamp f/ f* f* 1852 :duration dur make-env rs swap reson-ampfs! 1853 rs harm reson-c-rats! 1854 rs :frequency cfq :initial-phase 0.0 make-oscil reson-carriers! 1855 rs 1856 end-map { values } 1857 start dur #{ :degree 90.0 random } run-instrument 1858 pervib 0.0 triangle-wave ranvib 1859 0.0 rand-interp f+ frqf env f+ { vib } 1860 mod vib 0.0 oscil { modsig } 1861 0.0 ( val ) 1862 values each { rs } 1863 rs reson-ampfs@ env ( amp ) 1864 rs reson-carriers@ ( car-os ) 1865 rs reson-c-rats@ vib f* 1866 rs reson-indfs@ env modsig f* f+ ( car-fm ) 1867 0.0 ( car-pm ) oscil 1868 f* ( car-os * amp ) 1869 f+ ( val += ... ) 1870 end-each ( val ) 1871 end-run 1872;instrument 1873 1874: reson-test <{ :optional start 0.0 dur 1.0 -- }> 1875 start now! 1876 #( #( #( 0 0 100 1 ) 1200 0.5 0.1 0.1 0 1.0 0.1 0.1 ) 1877 #( #( 0 1 100 0 ) 2400 0.5 0.1 0.1 0 1.0 0.1 0.1 ) ) { data } 1878 1879 now@ dur 440 0.5 #( 0 0 100 1 ) #( 0 0 100 1 ) 1880 0.1 0.1 0.1 5 0.01 5 0.01 data reson 1881 dur 0.2 f+ step 1882; 1883 1884\ STK's feedback-fm instrument named CelloN in Sambox-land 1885instrument: cellon <{ start dur pitch0 amp ampfun 1886 betafun beta0 beta1 betaat betadc ampat ampdc 1887 pitch1 glissfun glissat glissdc 1888 pvibfreq pvibpc pvibfun pvibat pvibdc 1889 rvibfreq rvibpc rvibfun -- }> 1890 pitch1 f0= if 1891 pitch0 1892 else 1893 pitch1 1894 then { pit1 } 1895 :frequency pitch0 make-oscil { carr } 1896 0.5 -0.5 make-one-zero { low } 1897 :frequency pitch0 make-oscil { fmosc } 1898 :frequency pvibfreq :amplitude 1.0 make-triangle-wave { pvib } 1899 :frequency rvibfreq :amplitude 1.0 make-rand-interp { rvib } 1900 ampat f0> if 1901 ampat dur f/ 100.0 f* 1902 else 1903 25.0 1904 then { ampap } 1905 ampdc f0> if 1906 1.0 ampdc dur f/ f- 100.0 f* 1907 else 1908 75.0 1909 then { ampdp } 1910 glissat f0> if 1911 glissat dur f/ 100.0 f* 1912 else 1913 25.0 1914 then { glsap } 1915 glissdc f0> if 1916 1.0 glissdc dur f/ f- 100.0 f* 1917 else 1918 75.0 1919 then { glsdp } 1920 betaat f0> if 1921 betaat dur f/ 100.0 f* 1922 else 1923 25.0 1924 then { betap } 1925 betadc f0> if 1926 1.0 betadc dur f/ f- 100.0 f* 1927 else 1928 75.0 1929 then { betdp } 1930 pvibat f0> if 1931 pvibat dur f/ 100.0 f* 1932 else 1933 25.0 1934 then { pvbap } 1935 pvibdc f0> if 1936 1.0 pvibdc dur f/ f- 100.0 f* 1937 else 1938 75.0 1939 then { pvbdp } 1940 :envelope pvibfun 25.0 pvbap 75.0 pvbdp stretch-envelope 1941 :scaler pvibpc pitch0 f* hz->radians 1942 :duration dur make-env { pvibenv } 1943 :envelope rvibfun 1944 :scaler rvibpc pitch0 f* hz->radians 1945 :duration dur make-env { rvibenv } 1946 :envelope glissfun 25.0 glsap 75.0 glsdp stretch-envelope 1947 :scaler pit1 pitch0 f- hz->radians 1948 :duration dur make-env { glisenv } 1949 :envelope ampfun 25.0 ampap 75.0 ampdp stretch-envelope 1950 :scaler amp 1951 :duration dur make-env { amplenv } 1952 :envelope betafun 25.0 betap 75.0 betdp stretch-envelope 1953 :scaler beta1 beta0 f- 1954 :offset beta0 1955 :duration dur make-env { betaenv } 1956 0.0 { fm } 1957 start dur #{ :degree 90.0 random } run-instrument 1958 pvibenv env pvib 0.0 triangle-wave f* 1959 rvibenv env rvib 0.0 rand-interp f* f+ 1960 glisenv env f+ { vib } 1961 low betaenv env fmosc vib fm f+ 0.0 oscil f* one-zero to fm 1962 amplenv env carr vib fm f+ 0.0 oscil f* 1963 end-run 1964;instrument 1965 1966: cellon-test <{ :optional start 0.0 dur 1.0 -- }> 1967 start now! 1968 1969 now@ dur 220 0.5 1970 #( 0 0 25 1 75 1 100 0 ) \ ampfun 1971 #( 0 0 25 1 75 1 100 0 ) \ betafun 1972 0.75 1 0 0 0 0 220 1973 #( 0 0 25 1 75 1 100 0 ) \ glissfun 1974 0 0 0 0 1975 #( 0 0 100 0 ) \ pvibfun 1976 0 0 0 0 1977 #( 0 0 100 0 ) \ rvibfun 1978 cellon 1979 dur 0.2 f+ step 1980; 1981 1982\ JL-REVERB 1983instrument: jl-reverb <{ :key decay 3.0 volume 1.0 -- }> 1984 :feedback -0.7 :feedforward 0.7 :size 2111 make-all-pass { allpass1 } 1985 :feedback -0.7 :feedforward 0.7 :size 673 make-all-pass { allpass2 } 1986 :feedback -0.7 :feedforward 0.7 :size 223 make-all-pass { allpass3 } 1987 :scaler 0.742 :size 9601 make-comb { comb1 } 1988 :scaler 0.733 :size 10007 make-comb { comb2 } 1989 :scaler 0.715 :size 10799 make-comb { comb3 } 1990 :scaler 0.697 :size 11597 make-comb { comb4 } 1991 :size 0.013 seconds->samples make-delay { outdel1 } 1992 :size 0.011 seconds->samples make-delay { outdel2 } 1993 #( comb1 comb2 comb3 comb4 ) make-comb-bank { combs } 1994 #( allpass1 allpass2 allpass3 ) make-all-pass-bank { allpasses } 1995 *reverb* ws-framples samples->seconds decay f+ { dur } 1996 *output* channels 1 = if 1997 dur run-reverb ( in-val ) 1998 allpasses swap all-pass-bank ( val ) 1999 combs swap comb-bank ( val ) 2000 volume f* ( val ) 2001 outdel1 swap 0.0 delay ( samp ) 2002 end-run-reverb-out-1 2003 else 2004 0.0 { val } 2005 dur run-reverb ( in-val ) 2006 allpasses swap all-pass-bank ( val ) 2007 combs swap comb-bank ( val ) 2008 volume f* to val 2009 outdel1 val 0.0 delay ( samp1 ) 2010 outdel2 val 0.0 delay ( samp1 samp2 ) 2011 end-run-reverb-out-2 2012 then 2013;instrument 2014 2015\ GRAN-SYNTH 2016instrument: gran-synth <{ start dur freq grain-dur interval amp -- }> 2017 :envelope #( 0 0 25 1 75 1 100 0 ) 2018 :duration grain-dur make-env { grain-env } 2019 :frequency freq make-oscil { carrier } 2020 grain-dur interval fmax mus-srate f* fceil f>s { grain-size } 2021 :frequency interval 1/f :size grain-size make-wave-train { grains } 2022 grains mus-data map! 2023 grain-env env carrier 0.0 0.0 oscil f* 2024 end-map drop 2025 start dur #{ :degree 90.0 random } run-instrument 2026 grains 0.0 wave-train amp f* 2027 end-run 2028;instrument 2029 2030: gran-synth-test <{ :optional start 0.0 dur 1.0 -- }> 2031 start now! 2032 now@ dur 100 0.0189 0.02 0.4 gran-synth 2033 dur 0.2 f+ step 2034; 2035 2036\ TOUCH-TONE 2037\ 2038\ clm/ugex.ins 2039instrument: touch-tone <{ numbers :key start 0.0 -- }> 2040 doc" (See clm/ugex.ins) NUMBERS is an array with phone numbers.\n\ 2041#( 4 8 3 4 6 2 1 ) <'> touch-tone with-sound." 2042 #( 0 697 697 697 770 770 770 2043 852 852 852 941 941 941 ) { tt1 } 2044 #( 0 1209 1336 1477 1209 1336 1477 2045 1209 1336 1477 1209 1336 1477 ) { tt2 } 2046 numbers each ( numb ) 2047 dup 0= if 2048 drop 2049 11 2050 then { idx } 2051 :frequency tt1 idx array-ref make-oscil { frq1 } 2052 :frequency tt2 idx array-ref make-oscil { frq2 } 2053 i 0.3 f* start f+ 0.2 #{ :degree 90.0 random } run-instrument 2054 frq1 0.0 0.0 oscil frq2 0.0 0.0 oscil f+ 0.25 f* 2055 end-run 2056 end-each 2057;instrument 2058 2059: touch-tone-test <{ :optional start 0.0 dur 1.0 -- }> 2060 start now! 2061 #( 4 8 3 4 6 2 1 ) :start now@ touch-tone 2062 dur 7 ( digits ) f* 0.2 f+ step 2063; 2064 2065\ SPECTRA 2066instrument: spectra <{ start dur freq amp :optional 2067 parts #( 1 1 2 0.5 ) 2068 ampenv #( 0 0 50 1 100 0 ) 2069 vibamp 0.005 2070 vibfrq 5.0 2071 degr 0.0 2072 dist 1.0 2073 rev-amt 0.005 -- }> 2074 :frequency freq :wave parts #f #f partials->wave make-table-lookup { s } 2075 :envelope ampenv :scaler amp :duration dur make-env { ampf } 2076 freq hz->radians vibamp f* { vamp } 2077 :frequency vibfrq :amplitude vamp make-triangle-wave { pervib } 2078 :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib } 2079 start dur 2080 #{ :degree degr :distance dist :reverb rev-amt } run-instrument 2081 s 2082 pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ 2083 table-lookup ampf env f* 2084 end-run 2085;instrument 2086 2087: spectra-test <{ :optional start 0.0 dur 1.0 -- }> 2088 start now! 2089 #( 1.00 0.1132 2.00 0.0252 3.00 0.0292 4.01 0.0136 5.03 0.0045 2090 6.06 0.0022 7.11 0.0101 8.17 0.0004 9.23 0.0010 10.33 0.0012 2091 11.44 0.0013 12.58 0.0011 13.75 0.0002 14.93 0.0005 2092 16.14 0.0002 ) { p-a4 } 2093 2094 now@ dur 440 2.0 p-a4 #( 0 0 1 1 5 0.9 12 0.5 25 0.25 100 0 ) spectra 2095 dur 0.2 f+ step 2096; 2097 2098\ TWO-TAB 2099\ 2100\ interpolate between two waveforms (this could be extended to 2101\ implement all the various wavetable-based synthesis techniques). 2102instrument: two-tab <{ start dur freq amp :optional 2103 part1 #( 1.0 1.0 2.0 0.5 ) 2104 part2 #( 1.0 0.0 3.0 1.0 ) 2105 ampenv #( 0 0 50 1 100 0 ) 2106 interpenv #( 0 1 100 0 ) 2107 vibamp 0.005 2108 vibfrq 5.0 2109 degr 0.0 2110 dist 1.0 2111 rev-amt 0.005 -- }> 2112 :frequency freq 2113 :wave part1 #f #f partials->wave make-table-lookup { s1 } 2114 :frequency freq 2115 :wave part2 #f #f partials->wave make-table-lookup { s2 } 2116 :envelope ampenv :scaler amp :duration dur make-env { ampf } 2117 :envelope interpenv :duration dur make-env { interpf } 2118 freq hz->radians vibamp f* { vamp } 2119 :frequency vibfrq :amplitude vamp make-triangle-wave { pervib } 2120 :frequency vibfrq 1.0 f+ :amplitude vamp make-rand-interp { ranvib } 2121 start dur 2122 #{ :degree degr :distance dist :reverb rev-amt } run-instrument 2123 pervib 0.0 triangle-wave ranvib 0.0 rand-interp f+ { vib } 2124 interpf env { intrp } 2125 s1 vib table-lookup intrp f* 2126 s2 vib table-lookup 1.0 intrp f- f* 2127 f+ ( s1 + s2 ) ampf env f* 2128 end-run 2129;instrument 2130 2131: two-tab-test <{ :optional start 0.0 dur 1.0 -- }> 2132 start now! 2133 now@ dur 440 0.5 two-tab 2134 dur 0.2 f+ step 2135; 2136 2137\ LBJ-PIANO 2138#( #( 1.97 0.0326 2.99 0.0086 3.95 0.0163 4.97 0.0178 5.98 0.0177 2139 6.95 0.0315 8.02 0.0001 8.94 0.0076 9.96 0.0134 10.99 0.0284 2140 11.98 0.0229 13.02 0.0229 13.89 0.0010 15.06 0.0090 16.00 0.0003 2141 17.08 0.0078 18.16 0.0064 19.18 0.0129 20.21 0.0085 21.27 0.0225 2142 22.32 0.0061 23.41 0.0102 24.48 0.0005 25.56 0.0016 26.64 0.0018 2143 27.70 0.0113 28.80 0.0111 29.91 0.0158 31.06 0.0093 32.17 0.0017 2144 33.32 0.0002 34.42 0.0018 35.59 0.0027 36.74 0.0055 37.90 0.0037 2145 39.06 0.0064 40.25 0.0033 41.47 0.0014 42.53 0.0004 43.89 0.0010 2146 45.12 0.0039 46.33 0.0039 47.64 0.0009 48.88 0.0016 50.13 0.0006 2147 51.37 0.0010 52.70 0.0002 54.00 0.0004 55.30 0.0008 56.60 0.0025 2148 57.96 0.0010 59.30 0.0012 60.67 0.0011 61.99 0.0003 62.86 0.0001 2149 64.36 0.0005 64.86 0.0001 66.26 0.0004 67.70 0.0006 68.94 0.0002 2150 70.10 0.0001 70.58 0.0002 72.01 0.0007 73.53 0.0006 75.00 0.0002 2151 77.03 0.0005 78.00 0.0002 79.57 0.0006 81.16 0.0005 82.70 0.0005 2152 84.22 0.0003 85.41 0.0002 87.46 0.0001 90.30 0.0001 94.02 0.0001 2153 95.26 0.0002 109.39 0.0003 ) 2154 #( 1.98 0.0194 2.99 0.0210 3.97 0.0276 4.96 0.0297 5.96 0.0158 2155 6.99 0.0207 8.01 0.0009 9.00 0.0101 10.00 0.0297 11.01 0.0289 2156 12.02 0.0211 13.04 0.0127 14.07 0.0061 15.08 0.0174 16.13 0.0009 2157 17.12 0.0093 18.16 0.0117 19.21 0.0122 20.29 0.0108 21.30 0.0077 2158 22.38 0.0132 23.46 0.0073 24.14 0.0002 25.58 0.0026 26.69 0.0035 2159 27.77 0.0053 28.88 0.0024 30.08 0.0027 31.13 0.0075 32.24 0.0027 2160 33.36 0.0004 34.42 0.0004 35.64 0.0019 36.78 0.0037 38.10 0.0009 2161 39.11 0.0027 40.32 0.0010 41.51 0.0013 42.66 0.0019 43.87 0.0007 2162 45.13 0.0017 46.35 0.0019 47.65 0.0021 48.89 0.0014 50.18 0.0023 2163 51.42 0.0015 52.73 0.0002 54.00 0.0005 55.34 0.0006 56.60 0.0010 2164 57.96 0.0016 58.86 0.0005 59.30 0.0004 60.75 0.0005 62.22 0.0003 2165 63.55 0.0005 64.82 0.0003 66.24 0.0003 67.63 0.0011 69.09 0.0007 2166 70.52 0.0004 72.00 0.0005 73.50 0.0008 74.95 0.0003 77.13 0.0013 2167 78.02 0.0002 79.48 0.0004 82.59 0.0004 84.10 0.0003 ) 2168 #( 2.00 0.0313 2.99 0.0109 4.00 0.0215 5.00 0.0242 5.98 0.0355 2169 7.01 0.0132 8.01 0.0009 9.01 0.0071 10.00 0.0258 11.03 0.0221 2170 12.02 0.0056 13.06 0.0196 14.05 0.0160 15.11 0.0107 16.11 0.0003 2171 17.14 0.0111 18.21 0.0085 19.23 0.0010 20.28 0.0048 21.31 0.0128 2172 22.36 0.0051 23.41 0.0041 24.05 0.0006 25.54 0.0019 26.62 0.0028 2173 27.72 0.0034 28.82 0.0062 29.89 0.0039 30.98 0.0058 32.08 0.0011 2174 33.21 0.0002 34.37 0.0008 35.46 0.0018 36.62 0.0036 37.77 0.0018 2175 38.92 0.0042 40.07 0.0037 41.23 0.0011 42.67 0.0003 43.65 0.0018 2176 44.68 0.0025 45.99 0.0044 47.21 0.0051 48.40 0.0044 49.67 0.0005 2177 50.88 0.0019 52.15 0.0003 53.42 0.0008 54.69 0.0010 55.98 0.0005 2178 57.26 0.0013 58.53 0.0027 59.83 0.0011 61.21 0.0027 62.54 0.0003 2179 63.78 0.0003 65.20 0.0001 66.60 0.0006 67.98 0.0008 69.37 0.0019 2180 70.73 0.0007 72.14 0.0004 73.62 0.0002 74.40 0.0003 76.52 0.0006 2181 77.97 0.0002 79.49 0.0004 80.77 0.0003 81.00 0.0001 82.47 0.0005 2182 83.97 0.0001 87.27 0.0002 ) 2183 #( 2.00 0.0257 2.99 0.0142 3.97 0.0202 4.95 0.0148 5.95 0.0420 2184 6.95 0.0037 7.94 0.0004 8.94 0.0172 9.95 0.0191 10.96 0.0115 2185 11.97 0.0059 12.98 0.0140 14.00 0.0178 15.03 0.0121 16.09 0.0002 2186 17.07 0.0066 18.08 0.0033 19.15 0.0022 20.18 0.0057 21.22 0.0077 2187 22.29 0.0037 23.33 0.0066 24.97 0.0002 25.49 0.0019 26.55 0.0042 2188 27.61 0.0043 28.73 0.0038 29.81 0.0084 30.91 0.0040 32.03 0.0025 2189 33.14 0.0005 34.26 0.0003 35.38 0.0019 36.56 0.0037 37.68 0.0049 2190 38.86 0.0036 40.11 0.0011 41.28 0.0008 42.50 0.0004 43.60 0.0002 2191 44.74 0.0022 45.99 0.0050 47.20 0.0009 48.40 0.0036 49.68 0.0004 2192 50.92 0.0009 52.17 0.0005 53.46 0.0007 54.76 0.0006 56.06 0.0005 2193 57.34 0.0011 58.67 0.0005 59.95 0.0015 61.37 0.0008 62.72 0.0004 2194 65.42 0.0009 66.96 0.0003 68.18 0.0003 69.78 0.0003 71.21 0.0004 2195 72.45 0.0002 74.22 0.0003 75.44 0.0001 76.53 0.0003 78.31 0.0004 2196 79.83 0.0003 80.16 0.0001 81.33 0.0003 82.44 0.0001 83.17 0.0002 2197 84.81 0.0003 85.97 0.0003 89.08 0.0001 90.70 0.0002 92.30 0.0002 2198 95.59 0.0002 97.22 0.0003 98.86 0.0001 108.37 0.0001 125.54 0.0001 ) 2199 #( 1.99 0.0650 3.03 0.0040 4.03 0.0059 5.02 0.0090 5.97 0.0227 2200 6.98 0.0050 8.04 0.0020 9.00 0.0082 9.96 0.0078 11.01 0.0056 2201 12.01 0.0095 13.02 0.0050 14.04 0.0093 15.08 0.0064 16.14 0.0017 2202 17.06 0.0020 18.10 0.0025 19.14 0.0023 20.18 0.0015 21.24 0.0032 2203 22.29 0.0029 23.32 0.0014 24.37 0.0005 25.43 0.0030 26.50 0.0022 2204 27.60 0.0027 28.64 0.0024 29.76 0.0035 30.81 0.0136 31.96 0.0025 2205 33.02 0.0003 34.13 0.0005 35.25 0.0007 36.40 0.0014 37.51 0.0020 2206 38.64 0.0012 39.80 0.0019 40.97 0.0004 42.09 0.0003 43.24 0.0003 2207 44.48 0.0002 45.65 0.0024 46.86 0.0005 48.07 0.0013 49.27 0.0008 2208 50.49 0.0006 52.95 0.0001 54.23 0.0005 55.45 0.0004 56.73 0.0001 2209 58.03 0.0003 59.29 0.0002 60.59 0.0003 62.04 0.0002 65.89 0.0002 2210 67.23 0.0002 68.61 0.0002 69.97 0.0004 71.36 0.0005 85.42 0.0001 ) 2211 #( 1.98 0.0256 2.96 0.0158 3.95 0.0310 4.94 0.0411 5.95 0.0238 2212 6.94 0.0152 7.93 0.0011 8.95 0.0185 9.92 0.0166 10.93 0.0306 2213 11.94 0.0258 12.96 0.0202 13.97 0.0403 14.95 0.0228 15.93 0.0005 2214 17.01 0.0072 18.02 0.0034 19.06 0.0028 20.08 0.0124 21.13 0.0137 2215 22.16 0.0102 23.19 0.0058 23.90 0.0013 25.30 0.0039 26.36 0.0039 2216 27.41 0.0025 28.47 0.0071 29.64 0.0031 30.60 0.0027 31.71 0.0021 2217 32.84 0.0003 33.82 0.0002 35.07 0.0019 36.09 0.0054 37.20 0.0038 2218 38.33 0.0024 39.47 0.0055 40.55 0.0016 41.77 0.0006 42.95 0.0002 2219 43.27 0.0018 44.03 0.0006 45.25 0.0019 46.36 0.0033 47.50 0.0024 2220 48.87 0.0012 50.03 0.0016 51.09 0.0004 53.52 0.0017 54.74 0.0012 2221 56.17 0.0003 57.40 0.0011 58.42 0.0020 59.70 0.0007 61.29 0.0008 2222 62.56 0.0003 63.48 0.0002 64.83 0.0002 66.12 0.0012 67.46 0.0017 2223 68.81 0.0003 69.13 0.0003 70.53 0.0002 71.84 0.0001 73.28 0.0002 2224 75.52 0.0010 76.96 0.0005 77.93 0.0003 78.32 0.0003 79.73 0.0003 2225 81.69 0.0002 82.52 0.0001 84.01 0.0001 84.61 0.0002 86.88 0.0001 2226 88.36 0.0002 89.85 0.0002 91.35 0.0003 92.86 0.0002 93.40 0.0001 2227 105.28 0.0002 106.22 0.0002 107.45 0.0001 108.70 0.0003 122.08 0.0002 ) 2228 #( 1.97 0.0264 2.97 0.0211 3.98 0.0234 4.98 0.0307 5.96 0.0085 2229 6.94 0.0140 7.93 0.0005 8.96 0.0112 9.96 0.0209 10.98 0.0194 2230 11.98 0.0154 12.99 0.0274 13.99 0.0127 15.01 0.0101 15.99 0.0002 2231 17.04 0.0011 18.08 0.0032 19.14 0.0028 20.12 0.0054 21.20 0.0053 2232 22.13 0.0028 23.22 0.0030 24.32 0.0006 25.24 0.0004 26.43 0.0028 2233 27.53 0.0048 28.52 0.0039 29.54 0.0047 30.73 0.0044 31.82 0.0007 2234 32.94 0.0008 34.04 0.0012 35.13 0.0018 36.29 0.0007 37.35 0.0075 2235 38.51 0.0045 39.66 0.0014 40.90 0.0004 41.90 0.0002 43.08 0.0002 2236 44.24 0.0017 45.36 0.0013 46.68 0.0020 47.79 0.0015 48.98 0.0010 2237 50.21 0.0012 51.34 0.0001 53.82 0.0003 55.09 0.0004 56.23 0.0005 2238 57.53 0.0004 58.79 0.0005 59.30 0.0002 60.03 0.0002 61.40 0.0003 2239 62.84 0.0001 66.64 0.0001 67.97 0.0001 69.33 0.0001 70.68 0.0001 2240 73.57 0.0002 75.76 0.0002 76.45 0.0001 79.27 0.0001 80.44 0.0002 2241 81.87 0.0002 ) 2242 #( 2.00 0.0311 2.99 0.0086 3.99 0.0266 4.97 0.0123 5.98 0.0235 2243 6.97 0.0161 7.97 0.0008 8.96 0.0088 9.96 0.0621 10.99 0.0080 2244 11.99 0.0034 12.99 0.0300 14.03 0.0228 15.04 0.0105 16.03 0.0004 2245 17.06 0.0036 18.09 0.0094 18.95 0.0009 20.17 0.0071 21.21 0.0161 2246 22.25 0.0106 23.28 0.0104 24.33 0.0008 25.38 0.0030 26.46 0.0035 2247 27.50 0.0026 28.59 0.0028 29.66 0.0128 30.75 0.0139 31.81 0.0038 2248 32.93 0.0006 34.04 0.0004 35.16 0.0005 36.25 0.0023 37.35 0.0012 2249 38.46 0.0021 39.59 0.0035 40.71 0.0006 41.86 0.0007 42.42 0.0001 2250 43.46 0.0003 44.17 0.0032 45.29 0.0013 46.57 0.0004 47.72 0.0011 2251 48.79 0.0005 50.11 0.0005 51.29 0.0003 52.47 0.0002 53.68 0.0004 2252 55.02 0.0005 56.18 0.0003 57.41 0.0003 58.75 0.0007 59.33 0.0009 2253 60.00 0.0004 61.34 0.0001 64.97 0.0003 65.20 0.0002 66.48 0.0002 2254 67.83 0.0002 68.90 0.0003 70.25 0.0003 71.59 0.0002 73.68 0.0001 2255 75.92 0.0001 77.08 0.0002 78.45 0.0002 81.56 0.0002 82.99 0.0001 2256 88.39 0.0001 ) 2257 #( 0.97 0.0059 1.98 0.0212 2.99 0.0153 3.99 0.0227 4.96 0.0215 2258 5.97 0.0153 6.98 0.0085 7.98 0.0007 8.97 0.0179 9.98 0.0512 2259 10.98 0.0322 12.00 0.0098 13.02 0.0186 14.00 0.0099 15.05 0.0109 2260 15.88 0.0011 17.07 0.0076 18.11 0.0071 19.12 0.0045 20.16 0.0038 2261 21.23 0.0213 22.27 0.0332 23.34 0.0082 24.34 0.0014 25.42 0.0024 2262 26.47 0.0012 27.54 0.0014 28.60 0.0024 29.72 0.0026 30.10 0.0008 2263 31.91 0.0021 32.13 0.0011 33.02 0.0007 34.09 0.0014 35.17 0.0007 2264 36.27 0.0024 37.39 0.0029 38.58 0.0014 39.65 0.0017 40.95 0.0012 2265 41.97 0.0004 42.43 0.0002 43.49 0.0001 44.31 0.0012 45.42 0.0031 2266 46.62 0.0017 47.82 0.0013 49.14 0.0013 50.18 0.0010 51.54 0.0003 2267 53.90 0.0006 55.06 0.0010 56.31 0.0003 57.63 0.0001 59.02 0.0003 2268 60.09 0.0004 60.35 0.0004 61.62 0.0009 63.97 0.0001 65.19 0.0001 2269 65.54 0.0002 66.92 0.0002 67.94 0.0002 69.17 0.0003 69.60 0.0004 2270 70.88 0.0002 72.24 0.0002 76.12 0.0001 78.94 0.0001 81.75 0.0001 2271 82.06 0.0001 83.53 0.0001 90.29 0.0002 91.75 0.0001 92.09 0.0002 2272 93.28 0.0001 97.07 0.0001 ) 2273 #( 1.98 0.0159 2.98 0.1008 3.98 0.0365 4.98 0.0133 5.97 0.0101 2274 6.97 0.0115 7.97 0.0007 8.99 0.0349 10.01 0.0342 11.01 0.0236 2275 12.00 0.0041 13.02 0.0114 14.05 0.0137 15.06 0.0100 16.05 0.0007 2276 17.04 0.0009 18.12 0.0077 19.15 0.0023 20.12 0.0017 21.24 0.0113 2277 22.26 0.0126 23.30 0.0093 24.36 0.0007 25.43 0.0007 26.47 0.0009 2278 27.55 0.0013 28.59 0.0025 29.61 0.0010 30.77 0.0021 31.86 0.0023 2279 32.96 0.0003 34.03 0.0007 35.06 0.0005 36.20 0.0006 37.34 0.0006 2280 38.36 0.0009 39.60 0.0016 40.69 0.0005 41.77 0.0002 42.92 0.0002 2281 44.02 0.0003 45.24 0.0006 46.33 0.0004 47.50 0.0007 48.71 0.0007 2282 49.87 0.0002 51.27 0.0002 53.42 0.0003 55.88 0.0003 57.10 0.0004 2283 58.34 0.0002 59.86 0.0003 61.13 0.0003 67.18 0.0001 68.50 0.0001 2284 71.17 0.0001 83.91 0.0001 90.55 0.0001 ) 2285 #( 0.98 0.0099 2.00 0.0181 2.99 0.0353 3.98 0.0285 4.97 0.0514 2286 5.96 0.0402 6.96 0.0015 7.98 0.0012 8.98 0.0175 9.98 0.0264 2287 10.98 0.0392 11.98 0.0236 13.00 0.0153 14.04 0.0049 15.00 0.0089 2288 16.01 0.0001 17.03 0.0106 18.03 0.0028 19.05 0.0024 20.08 0.0040 2289 21.11 0.0103 22.12 0.0104 23.20 0.0017 24.19 0.0008 25.20 0.0007 2290 26.24 0.0011 27.36 0.0009 27.97 0.0030 29.40 0.0044 30.37 0.0019 2291 31.59 0.0017 32.65 0.0008 33.59 0.0005 34.79 0.0009 35.75 0.0027 2292 36.88 0.0035 37.93 0.0039 39.00 0.0031 40.08 0.0025 41.16 0.0010 2293 43.25 0.0004 44.52 0.0012 45.62 0.0023 45.85 0.0012 47.00 0.0006 2294 47.87 0.0008 48.99 0.0003 50.48 0.0003 51.62 0.0001 52.43 0.0001 2295 53.56 0.0002 54.76 0.0002 56.04 0.0002 56.68 0.0006 57.10 0.0003 2296 58.28 0.0005 59.47 0.0003 59.96 0.0002 60.67 0.0001 63.08 0.0002 2297 64.29 0.0002 66.72 0.0001 67.97 0.0001 68.65 0.0001 70.43 0.0001 2298 79.38 0.0001 80.39 0.0001 82.39 0.0001 ) 2299 #( 1.00 0.0765 1.99 0.0151 2.99 0.0500 3.99 0.0197 5.00 0.0260 2300 6.00 0.0145 6.98 0.0128 7.97 0.0004 8.98 0.0158 9.99 0.0265 2301 11.02 0.0290 12.02 0.0053 13.03 0.0242 14.03 0.0103 15.06 0.0054 2302 16.04 0.0006 17.08 0.0008 18.10 0.0058 19.16 0.0011 20.16 0.0055 2303 21.18 0.0040 22.20 0.0019 23.22 0.0014 24.05 0.0005 25.31 0.0019 2304 26.38 0.0018 27.44 0.0022 28.45 0.0024 29.57 0.0073 30.58 0.0032 2305 31.66 0.0071 32.73 0.0015 33.85 0.0005 34.96 0.0003 36.00 0.0020 2306 37.11 0.0018 38.18 0.0055 39.23 0.0006 40.33 0.0004 41.52 0.0003 2307 43.41 0.0028 45.05 0.0003 45.99 0.0002 47.07 0.0003 48.52 0.0002 2308 49.48 0.0003 50.63 0.0003 51.81 0.0002 54.05 0.0002 55.24 0.0001 2309 56.62 0.0001 57.81 0.0004 59.16 0.0013 60.23 0.0003 66.44 0.0001 2310 68.99 0.0004 75.49 0.0001 87.56 0.0004 ) 2311 #( 0.98 0.0629 1.99 0.0232 2.98 0.0217 4.00 0.0396 4.98 0.0171 2312 5.97 0.0098 6.99 0.0167 7.99 0.0003 8.98 0.0192 9.98 0.0266 2313 10.99 0.0256 12.01 0.0061 13.02 0.0135 14.02 0.0062 15.05 0.0158 2314 16.06 0.0018 17.08 0.0101 18.09 0.0053 19.11 0.0074 20.13 0.0020 2315 21.17 0.0052 22.22 0.0077 23.24 0.0035 24.00 0.0009 25.32 0.0016 2316 26.40 0.0022 27.43 0.0005 28.55 0.0026 29.60 0.0026 30.65 0.0010 2317 31.67 0.0019 32.77 0.0008 33.81 0.0003 34.91 0.0003 36.01 0.0005 2318 37.11 0.0010 38.20 0.0014 39.29 0.0039 40.43 0.0012 41.50 0.0006 2319 43.38 0.0017 43.75 0.0002 44.94 0.0005 46.13 0.0002 47.11 0.0003 2320 48.28 0.0005 48.42 0.0005 49.44 0.0003 50.76 0.0004 51.93 0.0002 2321 54.15 0.0003 55.31 0.0005 55.50 0.0003 56.98 0.0003 57.90 0.0004 2322 60.33 0.0002 61.39 0.0001 61.59 0.0001 65.09 0.0002 66.34 0.0001 2323 68.85 0.0001 70.42 0.0002 71.72 0.0001 73.05 0.0003 79.65 0.0001 2324 85.28 0.0002 93.52 0.0001 ) 2325 #( 1.02 0.0185 1.99 0.0525 2.98 0.0613 3.99 0.0415 4.98 0.0109 2326 5.97 0.0248 6.99 0.0102 7.98 0.0005 8.98 0.0124 9.99 0.0103 2327 10.99 0.0124 12.00 0.0016 13.01 0.0029 14.03 0.0211 15.04 0.0128 2328 16.07 0.0021 17.09 0.0009 18.09 0.0043 19.14 0.0022 20.13 0.0016 2329 21.20 0.0045 22.21 0.0088 23.26 0.0046 24.29 0.0013 25.35 0.0009 2330 26.39 0.0028 27.49 0.0009 28.51 0.0006 29.58 0.0012 30.70 0.0010 2331 31.74 0.0019 32.75 0.0002 33.85 0.0001 34.95 0.0005 36.02 0.0003 2332 37.16 0.0009 38.25 0.0018 39.35 0.0008 40.54 0.0004 41.61 0.0002 2333 43.40 0.0004 43.74 0.0003 45.05 0.0001 46.11 0.0003 47.40 0.0002 2334 48.36 0.0004 49.55 0.0004 50.72 0.0002 52.00 0.0001 55.58 0.0002 2335 57.02 0.0001 57.98 0.0002 59.13 0.0003 61.56 0.0001 66.56 0.0001 2336 87.65 0.0002 ) 2337 #( 1.00 0.0473 1.99 0.0506 2.99 0.0982 3.99 0.0654 5.00 0.0196 2338 5.99 0.0094 6.99 0.0118 7.93 0.0001 8.99 0.0057 10.01 0.0285 2339 11.01 0.0142 12.03 0.0032 13.03 0.0056 14.06 0.0064 15.06 0.0059 2340 16.11 0.0005 17.09 0.0033 18.14 0.0027 19.15 0.0014 20.17 0.0010 2341 21.21 0.0059 22.26 0.0043 23.31 0.0031 24.31 0.0018 25.33 0.0009 2342 26.41 0.0005 27.47 0.0015 28.53 0.0015 29.58 0.0041 30.65 0.0025 2343 31.73 0.0011 32.83 0.0010 34.98 0.0003 36.07 0.0009 37.23 0.0001 2344 38.26 0.0020 39.41 0.0014 40.53 0.0005 41.40 0.0003 42.80 0.0002 2345 43.48 0.0028 43.93 0.0001 45.03 0.0003 46.18 0.0007 47.41 0.0001 2346 48.57 0.0002 49.67 0.0001 50.83 0.0002 54.39 0.0001 55.58 0.0002 2347 57.97 0.0005 58.11 0.0002 59.21 0.0001 60.42 0.0002 61.66 0.0001 ) 2348 #( 1.00 0.0503 2.00 0.0963 2.99 0.1304 3.99 0.0218 4.98 0.0041 2349 5.98 0.0292 6.98 0.0482 7.99 0.0005 8.99 0.0280 10.00 0.0237 2350 11.00 0.0152 12.02 0.0036 12.95 0.0022 14.06 0.0111 15.07 0.0196 2351 16.08 0.0016 17.11 0.0044 18.13 0.0073 19.17 0.0055 20.19 0.0028 2352 21.20 0.0012 22.27 0.0068 23.30 0.0036 24.35 0.0012 25.35 0.0002 2353 26.46 0.0005 27.47 0.0005 28.59 0.0009 29.65 0.0021 30.70 0.0020 2354 31.78 0.0012 32.89 0.0010 35.06 0.0005 36.16 0.0008 37.27 0.0010 2355 38.36 0.0010 39.47 0.0014 40.58 0.0004 41.43 0.0007 41.82 0.0003 2356 43.48 0.0008 44.53 0.0001 45.25 0.0003 46.43 0.0002 47.46 0.0002 2357 48.76 0.0005 49.95 0.0004 50.96 0.0002 51.12 0.0002 52.33 0.0001 2358 54.75 0.0001 55.75 0.0002 56.90 0.0002 58.17 0.0002 59.40 0.0004 2359 60.62 0.0002 65.65 0.0001 66.91 0.0002 69.91 0.0001 71.25 0.0002 ) 2360 #( 1.00 0.1243 1.98 0.1611 3.00 0.0698 3.98 0.0390 5.00 0.0138 2361 5.99 0.0154 7.01 0.0287 8.01 0.0014 9.01 0.0049 10.00 0.0144 2362 11.01 0.0055 12.05 0.0052 13.01 0.0011 14.05 0.0118 15.07 0.0154 2363 16.12 0.0028 17.14 0.0061 18.25 0.0007 19.22 0.0020 20.24 0.0011 2364 21.27 0.0029 22.30 0.0046 23.34 0.0049 24.35 0.0004 25.45 0.0003 2365 26.47 0.0007 27.59 0.0008 28.16 0.0009 29.12 0.0002 29.81 0.0006 2366 30.81 0.0009 31.95 0.0004 33.00 0.0011 34.12 0.0005 35.18 0.0003 2367 36.30 0.0008 37.38 0.0003 38.55 0.0003 39.64 0.0006 40.77 0.0007 2368 41.52 0.0006 41.89 0.0006 43.04 0.0011 43.60 0.0009 44.31 0.0002 2369 45.68 0.0002 46.56 0.0003 47.60 0.0001 48.83 0.0006 50.01 0.0003 2370 51.27 0.0003 56.04 0.0005 57.21 0.0003 58.56 0.0004 59.83 0.0003 2371 61.05 0.0001 62.20 0.0001 67.37 0.0002 76.53 0.0001 ) 2372 #( 0.99 0.0222 1.99 0.0678 2.99 0.0683 4.00 0.0191 5.00 0.0119 2373 6.01 0.0232 6.98 0.0336 7.99 0.0082 9.01 0.0201 10.01 0.0189 2374 11.01 0.0041 12.01 0.0053 13.05 0.0154 14.04 0.0159 15.06 0.0092 2375 16.11 0.0038 17.12 0.0014 18.15 0.0091 19.16 0.0006 20.30 0.0012 2376 21.25 0.0061 22.28 0.0099 23.34 0.0028 24.38 0.0012 25.43 0.0016 2377 26.49 0.0048 27.55 0.0025 28.62 0.0015 29.71 0.0032 30.78 0.0077 2378 31.88 0.0011 32.97 0.0007 34.08 0.0006 35.16 0.0008 36.28 0.0004 2379 37.41 0.0006 38.54 0.0005 39.62 0.0002 40.80 0.0003 41.93 0.0001 2380 43.06 0.0002 44.21 0.0003 45.38 0.0002 46.54 0.0007 47.78 0.0003 2381 48.95 0.0004 50.10 0.0003 51.37 0.0002 53.79 0.0003 56.20 0.0001 2382 58.71 0.0002 66.47 0.0003 ) 2383 #( 1.01 0.0241 1.99 0.1011 2.98 0.0938 3.98 0.0081 4.99 0.0062 2384 5.99 0.0291 6.99 0.0676 7.59 0.0004 8.98 0.0127 9.99 0.0112 2385 10.99 0.0142 12.00 0.0029 13.02 0.0071 14.02 0.0184 15.03 0.0064 2386 16.07 0.0010 17.09 0.0011 18.11 0.0010 19.15 0.0060 20.19 0.0019 2387 21.24 0.0025 22.29 0.0013 23.31 0.0050 25.41 0.0030 26.50 0.0018 2388 27.53 0.0006 28.63 0.0012 29.66 0.0013 30.77 0.0020 31.84 0.0006 2389 34.04 0.0001 35.14 0.0001 36.32 0.0004 37.41 0.0007 38.53 0.0007 2390 39.67 0.0009 40.85 0.0003 45.49 0.0002 46.65 0.0001 47.81 0.0004 2391 49.01 0.0002 53.91 0.0002 55.14 0.0002 57.69 0.0002 ) 2392 #( 1.00 0.0326 2.00 0.1066 2.99 0.1015 4.00 0.0210 4.97 0.0170 2393 5.99 0.0813 6.98 0.0820 7.96 0.0011 8.99 0.0248 10.03 0.0107 2394 11.01 0.0126 12.01 0.0027 13.01 0.0233 14.04 0.0151 15.05 0.0071 2395 16.04 0.0002 17.10 0.0061 18.12 0.0059 19.15 0.0087 20.23 0.0005 2396 21.25 0.0040 22.30 0.0032 23.35 0.0004 24.40 0.0001 25.45 0.0030 2397 26.54 0.0022 27.60 0.0003 28.70 0.0009 29.80 0.0029 30.85 0.0006 2398 31.97 0.0006 34.19 0.0004 35.30 0.0003 36.43 0.0007 37.56 0.0005 2399 38.68 0.0019 39.88 0.0013 41.00 0.0003 43.35 0.0003 44.51 0.0002 2400 45.68 0.0006 46.93 0.0010 48.11 0.0006 49.29 0.0003 55.58 0.0002 ) 2401 #( 0.98 0.0113 1.99 0.0967 3.00 0.0719 3.98 0.0345 4.98 0.0121 2402 6.00 0.0621 7.00 0.0137 7.98 0.0006 9.01 0.0314 10.01 0.0171 2403 11.02 0.0060 12.03 0.0024 13.05 0.0077 14.07 0.0040 15.12 0.0032 2404 16.13 0.0004 17.15 0.0011 18.20 0.0028 19.18 0.0003 20.26 0.0003 2405 21.31 0.0025 22.35 0.0021 23.39 0.0005 25.55 0.0002 26.62 0.0014 2406 27.70 0.0003 28.78 0.0005 29.90 0.0030 31.01 0.0011 32.12 0.0005 2407 34.31 0.0001 35.50 0.0002 36.62 0.0002 37.76 0.0005 38.85 0.0002 2408 40.09 0.0004 43.60 0.0001 44.73 0.0002 46.02 0.0002 47.25 0.0004 2409 48.44 0.0004 ) 2410 #( 0.99 0.0156 1.98 0.0846 2.98 0.0178 3.98 0.0367 4.98 0.0448 2411 5.98 0.0113 6.99 0.0189 8.00 0.0011 9.01 0.0247 10.02 0.0089 2412 11.01 0.0184 12.03 0.0105 13.00 0.0039 14.07 0.0116 15.09 0.0078 2413 16.13 0.0008 17.14 0.0064 18.19 0.0029 19.22 0.0028 20.25 0.0017 2414 21.32 0.0043 22.37 0.0055 23.42 0.0034 24.48 0.0004 25.54 0.0002 2415 26.61 0.0017 27.70 0.0011 28.80 0.0002 29.89 0.0019 30.97 0.0028 2416 32.09 0.0007 34.30 0.0002 35.44 0.0003 36.55 0.0001 37.69 0.0004 2417 38.93 0.0002 40.05 0.0005 41.20 0.0005 42.37 0.0002 43.54 0.0003 2418 44.73 0.0001 45.95 0.0002 47.16 0.0001 48.43 0.0005 49.65 0.0004 2419 55.90 0.0002 59.81 0.0004 ) 2420 #( 1.01 0.0280 2.00 0.0708 2.99 0.0182 3.99 0.0248 4.98 0.0245 2421 5.98 0.0279 6.98 0.0437 7.99 0.0065 8.99 0.0299 10.00 0.0073 2422 10.99 0.0011 12.03 0.0122 13.03 0.0028 14.08 0.0044 15.11 0.0097 2423 16.15 0.0010 17.17 0.0025 18.19 0.0017 19.24 0.0008 20.28 0.0040 2424 21.32 0.0024 22.38 0.0008 23.46 0.0032 24.52 0.0010 25.59 0.0008 2425 26.68 0.0009 27.76 0.0012 28.88 0.0003 29.95 0.0005 31.05 0.0017 2426 32.14 0.0002 33.29 0.0003 37.88 0.0002 39.03 0.0002 40.19 0.0004 2427 41.37 0.0003 43.74 0.0002 46.20 0.0001 48.68 0.0001 49.93 0.0001 2428 51.19 0.0002 ) 2429 #( 1.00 0.0225 1.99 0.0921 2.98 0.0933 3.99 0.0365 4.99 0.0100 2430 5.98 0.0213 6.98 0.0049 7.98 0.0041 8.98 0.0090 9.99 0.0068 2431 11.01 0.0040 12.03 0.0086 13.02 0.0015 14.04 0.0071 15.09 0.0082 2432 16.14 0.0011 17.15 0.0014 18.18 0.0010 19.26 0.0013 20.26 0.0005 2433 21.33 0.0006 22.36 0.0011 23.46 0.0016 24.52 0.0004 25.59 0.0002 2434 26.70 0.0006 27.78 0.0007 28.87 0.0002 30.03 0.0008 31.14 0.0010 2435 32.24 0.0006 33.37 0.0002 35.67 0.0003 37.99 0.0004 39.17 0.0004 2436 40.35 0.0005 41.53 0.0001 46.42 0.0001 ) 2437 #( 1.00 0.0465 1.99 0.0976 2.98 0.0678 4.00 0.0727 4.99 0.0305 2438 5.98 0.0210 6.98 0.0227 8.00 0.0085 9.01 0.0183 10.02 0.0258 2439 11.05 0.0003 12.06 0.0061 13.05 0.0021 14.10 0.0089 15.12 0.0077 2440 16.16 0.0016 17.21 0.0061 18.23 0.0011 19.29 0.0031 20.36 0.0031 2441 21.41 0.0007 22.48 0.0013 23.55 0.0020 24.64 0.0004 25.74 0.0005 2442 26.81 0.0006 27.95 0.0006 29.03 0.0001 30.22 0.0010 31.30 0.0004 2443 32.48 0.0001 33.60 0.0002 38.30 0.0003 ) 2444 #( 1.00 0.0674 1.99 0.0841 2.98 0.0920 3.99 0.0328 4.99 0.0368 2445 5.98 0.0206 6.99 0.0246 8.01 0.0048 9.01 0.0218 10.03 0.0155 2446 11.05 0.0048 12.06 0.0077 13.00 0.0020 14.10 0.0083 15.15 0.0084 2447 16.18 0.0015 17.22 0.0039 18.27 0.0032 19.34 0.0026 20.40 0.0012 2448 21.47 0.0009 22.54 0.0008 23.62 0.0016 24.71 0.0005 25.82 0.0004 2449 26.91 0.0002 28.03 0.0008 29.17 0.0002 30.32 0.0028 31.45 0.0004 2450 32.61 0.0005 33.77 0.0001 36.14 0.0003 37.32 0.0002 38.54 0.0005 2451 39.75 0.0002 42.23 0.0002 48.65 0.0001 ) 2452 #( 1.01 0.0423 1.99 0.0240 2.98 0.0517 4.00 0.0493 5.00 0.0324 2453 6.00 0.0094 6.99 0.0449 7.99 0.0050 9.00 0.0197 10.03 0.0132 2454 11.03 0.0009 12.07 0.0017 13.08 0.0023 14.12 0.0094 15.16 0.0071 2455 16.21 0.0020 17.25 0.0005 18.30 0.0027 19.04 0.0004 20.43 0.0022 2456 21.51 0.0002 22.59 0.0006 23.72 0.0018 24.80 0.0002 25.88 0.0002 2457 27.03 0.0002 28.09 0.0006 29.31 0.0002 30.46 0.0004 31.61 0.0007 2458 32.78 0.0005 33.95 0.0001 36.34 0.0002 37.56 0.0001 38.80 0.0001 2459 40.02 0.0001 44.14 0.0001 ) 2460 #( 1.00 0.0669 1.99 0.0909 2.99 0.0410 3.98 0.0292 4.98 0.0259 2461 5.98 0.0148 6.98 0.0319 7.99 0.0076 9.01 0.0056 10.02 0.0206 2462 11.04 0.0032 12.05 0.0085 13.08 0.0040 14.12 0.0037 15.16 0.0030 2463 16.20 0.0013 17.24 0.0021 18.30 0.0010 19.36 0.0015 20.44 0.0013 2464 21.50 0.0009 22.60 0.0015 23.69 0.0014 24.80 0.0006 25.87 0.0002 2465 27.02 0.0006 28.12 0.0002 29.28 0.0003 30.43 0.0002 31.59 0.0007 2466 32.79 0.0001 35.14 0.0001 37.57 0.0001 40.03 0.0002 41.28 0.0004 2467 44.10 0.0001 ) 2468 #( 0.99 0.0421 1.99 0.1541 2.98 0.0596 3.98 0.0309 4.98 0.0301 2469 5.99 0.0103 7.00 0.0240 8.01 0.0073 9.01 0.0222 10.04 0.0140 2470 11.05 0.0033 12.08 0.0045 13.13 0.0009 14.13 0.0015 15.21 0.0026 2471 16.24 0.0003 17.30 0.0004 18.35 0.0010 19.39 0.0003 20.50 0.0015 2472 21.57 0.0003 22.68 0.0011 23.80 0.0005 24.90 0.0008 26.02 0.0002 2473 27.16 0.0001 28.30 0.0006 29.48 0.0002 31.81 0.0005 33.00 0.0003 2474 34.21 0.0001 37.89 0.0001 ) 2475 #( 0.99 0.0389 2.00 0.2095 3.00 0.0835 3.99 0.0289 5.00 0.0578 2476 5.99 0.0363 7.01 0.0387 8.01 0.0056 9.04 0.0173 10.05 0.0175 2477 11.08 0.0053 12.10 0.0056 13.15 0.0064 14.19 0.0036 15.22 0.0019 2478 16.29 0.0010 17.36 0.0017 18.43 0.0018 19.51 0.0004 20.60 0.0011 2479 21.70 0.0003 22.82 0.0003 23.95 0.0001 25.05 0.0004 26.17 0.0001 2480 28.50 0.0003 29.68 0.0001 32.07 0.0003 33.28 0.0004 34.52 0.0001 ) 2481 #( 1.00 0.1238 1.99 0.2270 3.00 0.0102 3.99 0.0181 4.98 0.0415 2482 6.00 0.0165 7.01 0.0314 8.02 0.0148 9.04 0.0203 10.05 0.0088 2483 11.07 0.0062 12.11 0.0070 13.14 0.0054 14.19 0.0028 15.24 0.0044 2484 16.30 0.0029 17.38 0.0009 18.45 0.0026 19.56 0.0003 20.65 0.0025 2485 21.74 0.0014 22.87 0.0013 23.99 0.0007 25.15 0.0002 27.46 0.0004 2486 28.39 0.0006 28.65 0.0004 29.85 0.0001 31.05 0.0002 32.27 0.0003 2487 33.52 0.0002 34.76 0.0003 ) 2488 #( 1.00 0.1054 2.00 0.2598 2.99 0.0369 3.98 0.0523 4.99 0.0020 2489 5.99 0.0051 7.00 0.0268 8.01 0.0027 9.04 0.0029 10.05 0.0081 2490 11.08 0.0047 12.12 0.0051 13.16 0.0091 14.19 0.0015 15.27 0.0030 2491 16.34 0.0017 17.42 0.0006 18.51 0.0003 19.61 0.0007 20.72 0.0003 2492 21.84 0.0001 22.99 0.0010 24.13 0.0001 28.44 0.0001 30.09 0.0001 ) 2493 #( 0.99 0.0919 2.00 0.0418 2.99 0.0498 3.99 0.0135 4.99 0.0026 2494 6.00 0.0155 7.01 0.0340 8.02 0.0033 9.04 0.0218 10.08 0.0084 2495 11.11 0.0057 12.15 0.0051 13.21 0.0043 14.25 0.0015 15.31 0.0023 2496 16.40 0.0008 17.48 0.0004 18.59 0.0016 19.71 0.0010 20.84 0.0018 2497 21.98 0.0002 23.11 0.0013 24.26 0.0003 26.67 0.0002 29.12 0.0002 2498 30.37 0.0002 31.62 0.0003 32.92 0.0001 ) 2499 #( 0.99 0.1174 1.99 0.1126 2.99 0.0370 3.99 0.0159 5.01 0.0472 2500 6.01 0.0091 7.03 0.0211 8.05 0.0015 9.07 0.0098 10.11 0.0038 2501 11.15 0.0042 12.20 0.0018 13.24 0.0041 14.32 0.0033 15.41 0.0052 2502 16.49 0.0001 17.61 0.0004 18.71 0.0004 19.84 0.0004 20.99 0.0002 2503 22.14 0.0006 23.31 0.0006 24.50 0.0004 25.70 0.0002 28.09 0.0002 2504 28.66 0.0002 32.00 0.0001 ) 2505 #( 1.00 0.1085 2.00 0.1400 2.99 0.0173 3.99 0.0229 5.00 0.0272 2506 6.02 0.0077 7.03 0.0069 8.04 0.0017 9.08 0.0045 10.10 0.0030 2507 11.15 0.0040 12.20 0.0007 13.25 0.0019 14.32 0.0008 15.42 0.0024 2508 16.50 0.0002 17.59 0.0005 18.71 0.0003 19.83 0.0002 20.98 0.0005 2509 23.29 0.0008 ) 2510 #( 1.00 0.0985 2.00 0.1440 2.99 0.0364 3.99 0.0425 5.00 0.0190 2511 6.01 0.0089 7.03 0.0278 8.04 0.0006 9.07 0.0083 10.10 0.0021 2512 11.14 0.0050 12.18 0.0005 13.26 0.0036 14.33 0.0005 15.41 0.0026 2513 17.62 0.0004 18.75 0.0004 19.89 0.0003 21.04 0.0012 22.21 0.0002 2514 23.38 0.0004 27.04 0.0001 ) 2515 #( 0.99 0.1273 2.00 0.1311 2.99 0.0120 4.00 0.0099 5.00 0.0235 2516 6.02 0.0068 7.03 0.0162 8.06 0.0009 9.08 0.0083 10.12 0.0014 2517 11.17 0.0050 12.24 0.0010 13.29 0.0013 14.39 0.0022 15.48 0.0011 2518 16.59 0.0002 17.70 0.0003 18.84 0.0010 20.00 0.0003 21.17 0.0003 2519 23.56 0.0004 28.79 0.0003 ) 2520 #( 1.00 0.1018 2.00 0.1486 3.00 0.0165 4.00 0.0186 5.01 0.0194 2521 6.02 0.0045 7.04 0.0083 8.06 0.0012 9.10 0.0066 10.15 0.0009 2522 11.19 0.0008 12.26 0.0011 13.34 0.0028 14.45 0.0006 15.53 0.0009 2523 16.66 0.0002 17.79 0.0006 18.94 0.0005 20.11 0.0003 21.29 0.0005 2524 22.49 0.0003 23.73 0.0005 26.22 0.0001 27.52 0.0001 28.88 0.0002 ) 2525 #( 1.00 0.1889 1.99 0.1822 3.00 0.0363 4.00 0.0047 5.01 0.0202 2526 6.03 0.0053 7.05 0.0114 8.01 0.0002 9.13 0.0048 10.17 0.0010 2527 11.23 0.0033 12.30 0.0010 13.38 0.0006 14.50 0.0002 15.62 0.0010 2528 20.27 0.0001 21.47 0.0001 ) 2529 #( 1.00 0.0522 1.99 0.0763 2.99 0.0404 4.00 0.0139 5.01 0.0185 2530 6.01 0.0021 7.06 0.0045 8.09 0.0002 9.11 0.0003 10.17 0.0006 2531 11.25 0.0004 12.32 0.0005 13.40 0.0003 14.53 0.0003 15.65 0.0007 2532 16.80 0.0001 17.95 0.0002 19.14 0.0006 20.34 0.0002 21.56 0.0003 ) 2533 #( 0.99 0.1821 1.99 0.0773 3.00 0.0125 4.01 0.0065 5.01 0.0202 2534 6.03 0.0071 7.05 0.0090 8.08 0.0006 9.13 0.0008 10.18 0.0013 2535 11.25 0.0010 12.33 0.0012 13.42 0.0006 14.54 0.0005 15.65 0.0004 2536 17.97 0.0002 19.15 0.0001 ) 2537 #( 1.00 0.1868 2.00 0.0951 3.00 0.0147 4.01 0.0134 5.02 0.0184 2538 6.04 0.0132 7.06 0.0011 8.11 0.0008 9.15 0.0010 10.22 0.0012 2539 11.30 0.0011 12.40 0.0003 13.11 0.0004 13.49 0.0002 14.62 0.0003 2540 15.77 0.0001 ) 2541 #( 1.00 0.1933 2.00 0.0714 3.00 0.0373 4.00 0.0108 5.02 0.0094 2542 6.02 0.0010 7.07 0.0022 8.11 0.0002 9.16 0.0065 10.23 0.0015 2543 11.31 0.0023 12.40 0.0003 13.53 0.0014 14.66 0.0002 15.81 0.0011 2544 18.20 0.0002 19.41 0.0001 ) 2545 #( 0.99 0.2113 1.99 0.0877 3.00 0.0492 4.01 0.0094 5.02 0.0144 2546 6.04 0.0103 7.07 0.0117 8.12 0.0006 9.19 0.0019 10.25 0.0007 2547 11.35 0.0017 12.45 0.0010 13.58 0.0003 14.74 0.0003 15.91 0.0003 2548 19.57 0.0002 ) 2549 #( 0.99 0.2455 1.99 0.0161 3.00 0.0215 4.01 0.0036 5.03 0.0049 2550 6.04 0.0012 7.09 0.0036 8.14 0.0011 9.21 0.0009 10.30 0.0001 2551 11.40 0.0012 12.50 0.0001 13.66 0.0005 14.84 0.0001 ) 2552 #( 1.00 0.1132 2.00 0.0252 3.00 0.0292 4.01 0.0136 5.03 0.0045 2553 6.06 0.0022 7.11 0.0101 8.17 0.0004 9.23 0.0010 10.33 0.0012 2554 11.44 0.0013 12.58 0.0011 13.75 0.0002 14.93 0.0005 16.14 0.0002 ) 2555 #( 1.00 0.1655 2.00 0.0445 3.00 0.0120 4.00 0.0038 5.02 0.0015 2556 6.07 0.0038 7.11 0.0003 8.19 0.0002 9.25 0.0010 10.36 0.0011 2557 11.48 0.0005 12.63 0.0002 13.79 0.0003 16.24 0.0002 ) 2558 #( 0.99 0.3637 1.99 0.0259 3.01 0.0038 4.01 0.0057 5.03 0.0040 2559 6.07 0.0067 7.12 0.0014 8.19 0.0004 9.27 0.0003 10.38 0.0002 2560 12.67 0.0001 ) 2561 #( 1.00 0.1193 2.00 0.0230 3.00 0.0104 4.01 0.0084 5.04 0.0047 2562 6.08 0.0035 7.13 0.0041 8.20 0.0002 9.29 0.0005 10.40 0.0005 2563 11.53 0.0003 12.70 0.0002 13.91 0.0002 ) 2564 #( 1.00 0.0752 2.00 0.0497 3.00 0.0074 4.02 0.0076 5.05 0.0053 2565 6.09 0.0043 7.15 0.0024 8.22 0.0001 9.32 0.0006 10.45 0.0002 2566 11.58 0.0001 12.78 0.0001 15.22 0.0001 ) 2567 #( 1.00 0.2388 2.00 0.0629 3.01 0.0159 4.04 0.0063 5.07 0.0051 2568 6.12 0.0045 7.19 0.0026 8.29 0.0015 9.43 0.0001 11.75 0.0002 ) 2569 #( 1.00 0.1919 2.01 0.0116 3.01 0.0031 4.03 0.0090 5.07 0.0061 2570 6.13 0.0036 7.19 0.0013 8.30 0.0016 9.13 0.0001 10.59 0.0002 2571 11.78 0.0002 ) 2572 #( 1.00 0.1296 2.00 0.0135 3.01 0.0041 4.04 0.0045 5.09 0.0028 2573 6.14 0.0046 7.23 0.0007 8.32 0.0007 9.50 0.0001 ) 2574 #( 1.00 0.0692 2.00 0.0209 3.02 0.0025 4.05 0.0030 5.09 0.0047 2575 6.17 0.0022 7.25 0.0015 8.36 0.0015 9.53 0.0010 10.69 0.0001 2576 13.40 0.0001 ) 2577 #( 1.00 0.1715 2.00 0.0142 3.01 0.0024 4.03 0.0015 5.07 0.0017 2578 6.13 0.0018 7.22 0.0009 8.33 0.0014 9.51 0.0007 10.69 0.0002 ) 2579 #( 1.00 0.1555 2.01 0.0148 3.02 0.0007 4.06 0.0006 5.10 0.0005 2580 6.16 0.0008 7.26 0.0009 8.39 0.0008 9.58 0.0002 ) 2581 #( 1.00 0.1357 2.00 0.0116 3.02 0.0026 4.04 0.0009 5.09 0.0004 2582 6.17 0.0005 7.27 0.0002 8.40 0.0001 ) 2583 #( 1.00 0.2185 2.01 0.0087 3.03 0.0018 4.06 0.0025 5.11 0.0020 2584 6.20 0.0012 7.32 0.0005 8.46 0.0001 9.66 0.0003 ) 2585 #( 1.00 0.2735 2.00 0.0038 3.02 0.0008 4.06 0.0012 5.12 0.0008 2586 6.22 0.0011 7.35 0.0003 8.50 0.0002 ) 2587 #( 1.00 0.1441 1.99 0.0062 3.01 0.0023 4.05 0.0011 5.11 0.0012 2588 6.20 0.0003 7.33 0.0004 8.50 0.0001 ) 2589 #( 1.00 0.0726 2.01 0.0293 3.03 0.0022 5.14 0.0005 6.26 0.0011 2590 7.41 0.0002 8.63 0.0002 ) 2591 #( 1.00 0.0516 2.00 0.0104 3.02 0.0029 5.15 0.0002 6.27 0.0001 ) 2592 #( 1.00 0.0329 2.00 0.0033 3.03 0.0013 4.10 0.0005 5.19 0.0004 2593 6.32 0.0002 ) 2594 #( 1.00 0.0179 1.99 0.0012 3.04 0.0005 4.10 0.0017 5.20 0.0005 2595 6.35 0.0001 ) 2596 #( 1.00 0.0334 2.01 0.0033 3.04 0.0011 4.13 0.0003 5.22 0.0003 ) 2597 #( 0.99 0.0161 2.01 0.0100 3.04 0.0020 4.13 0.0003 ) 2598 #( 1.00 0.0475 1.99 0.0045 3.03 0.0035 4.12 0.0011 ) 2599 #( 1.00 0.0593 2.00 0.0014 4.17 0.0002 ) 2600 #( 1.00 0.0249 2.01 0.0016 ) 2601 #( 1.00 0.0242 2.00 0.0038 4.19 0.0002 ) 2602 #( 1.00 0.0170 2.02 0.0030 ) 2603 #( 1.00 0.0381 2.00 0.0017 3.09 0.0002 ) 2604 #( 1.00 0.0141 2.03 0.0005 3.11 0.0003 4.26 0.0001 ) 2605 #( 1.00 0.0122 2.03 0.0024 ) 2606 #( 1.00 0.0107 2.07 0.0007 3.12 0.0004 ) 2607 #( 1.00 0.0250 2.02 0.0026 3.15 0.0002 ) 2608 #( 1.01 0.0092 ) 2609 #( 1.01 0.0102 2.09 0.0005 ) 2610 #( 1.00 0.0080 2.00 0.0005 3.19 0.0001 ) 2611 #( 1.01 0.0298 2.01 0.0005 ) ) constant piano-spectra 2612 26130.04 value *clm-piano-attack-duration* 26140.2 value *clm-piano-realease-duration* 2615-10 value *clm-db-drop-per-second* 2616 2617\ This thing sounds pretty good down low, below middle c or so. 2618\ Unfortunately, there are some tens of partials down there and we're 2619\ using exponential envelopes. You're going to wait for a long long 2620\ time just to hear a single low note. The high notes sound pretty 2621\ rotten--they just don't sparkle; I have a feeling that this is due 2622\ to the low amplitude of the original data, and the lack of 2623\ mechanical noise. 2624\ 2625\ The only thing you can do to alter the sound of a piano note is to 2626\ set the pfreq parameter. Pfreq is used to look up the partials. By 2627\ default, it's set to the requested frequency. Setting it to a 2628\ neighboring freq is useful when you're repeating notes. Note that 2629\ there's no nyquist detection; a high freq with a low pfreq, will 2630\ give you fold over (hmmm...maybe I can get those high notes to 2631\ sparkle after all). 2632instrument: lbj-piano <{ start dur freq amp :key 2633 degree 45.0 2634 distance 1.0 2635 reverb-amount 0.0 -- }> 2636 12.0 freq 32.703 f/ flog 2.0 flog f/ f* f>s { idx } 2637 piano-spectra idx array-ref normalize-partials { parts } 2638 dur *clm-piano-attack-duration* *clm-piano-realease-duration* 2639 f+ f+ to dur 2640 dur *clm-piano-realease-duration* f- { env1dur } 2641 env1dur mus-srate f* fround->s { env1samples } 2642 #( 0.0 2643 0.0 2644 *clm-piano-attack-duration* 100.0 f* env1dur f/ 4.0 f/ 2645 1.0 2646 *clm-piano-attack-duration* 100.0 f* env1dur f/ 2647 1.0 2648 100.0 2649 *clm-db-drop-per-second* env1dur f* db->linear ) { ampfun1 } 2650 :envelope ampfun1 2651 :scaler amp 2652 :duration env1dur 2653 :base 10000.0 make-env { ampenv1 } 2654 :envelope #( 0 1 100 0 ) 2655 :scaler amp ampfun1 -1 array-ref f* 2656 :duration env1dur 2657 :base 1.0 make-env { ampenv2 } 2658 parts length 2/ 0.0 make-vct { alist } 2659 parts length 2/ make-array map! 2660 alist i parts i 2* 1+ vct-ref vct-set! drop 2661 :frequency parts i 2* vct-ref freq f* make-oscil 2662 end-map { oscils } 2663 start dur 2664 #{ :degree degree :distance distance :reverb reverb-amount } 2665 run-instrument 2666 0.0 ( sum ) 2667 oscils each ( os ) 2668 0.0 0.0 oscil alist i vct-ref f* f+ ( sum += ... ) 2669 end-each ( sum ) 2670 i env1samples > if 2671 ampenv2 2672 else 2673 ampenv1 2674 then env f* 2675 end-run 2676;instrument 2677 2678: lbj-piano-test <{ :optional start 0.0 dur 1.0 -- }> 2679 start now! 2680 now@ dur 440 0.5 lbj-piano 2681 dur 0.24 f+ 0.2 f+ step 2682; 2683 2684\ RESFLT 2685\ clm/resflt.ins 2686instrument: resflt <{ start dur driver 2687 ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum 2688 ampcosfun freqcosfun 2689 freq1 r1 g1 freq2 r2 g2 freq3 r3 g3 :key 2690 degree 0.0 2691 distance 1.0 2692 reverb-amount 0.005 -- }> 2693 doc" From clm/resflt.ins\n\ 26940 1 #f 0 0 #f 0.1 200 230 10 '( 0 0 50 1 100 0 ) '( 0 0 100 1 )\n\ 2695 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree\n\ 2696 90.0 random <'> resflt with-sound\n\ 26970 1 #t 10000 0.01 '( 0 0 50 1 100 0 ) 0 0 0 0 #f #f\n\ 2698 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 :degree\n\ 2699 90.0 random <'> resflt with-sound." 2700 :radius r1 :frequency freq1 make-two-pole { f1 } 2701 :radius r2 :frequency freq2 make-two-pole { f2 } 2702 :radius r3 :frequency freq3 make-two-pole { f3 } 2703 driver if 2704 :envelope noifun 2705 :scaler noiamp 2706 :duration dur make-env { ampf } 2707 :frequency ranfreq make-rand { gen } 2708 start dur 2709 #{ :degree degree :distance distance :reverb reverb-amount } 2710 run-instrument 2711 gen 0.0 rand ampf env f* { input } 2712 f1 input g1 f* two-pole 2713 f2 input g2 f* two-pole f+ 2714 f3 input g3 f* two-pole f+ 2715 end-run 2716 else 2717 :envelope freqcosfun 2718 :scaler cosfreq1 cosfreq0 f- hz->radians 2719 :duration dur make-env { frqf } 2720 :envelope ampcosfun 2721 :scaler cosamp 2722 :duration dur make-env { ampf } 2723 :frequency cosfreq0 :n cosnum make-ncos { gen } 2724 start dur 2725 #{ :degree degree :distance distance :reverb reverb-amount } 2726 run-instrument 2727 gen frqf env ncos ampf env f* { input } 2728 f1 input g1 f* two-pole 2729 f2 input g2 f* two-pole f+ 2730 f3 input g3 f* two-pole f+ 2731 end-run 2732 then 2733;instrument 2734 2735: resflt-test <{ :optional start 0.0 dur 1.0 -- }> 2736 start now! 2737 now@ dur #f \ start dur driver 2738 0 0 #f 0.1 \ ranfreq noiamp noifun cosamp 2739 200 230 10 \ cosfreq1 cosfreq0 cosnum 2740 '( 0 0 50 1 100 0 ) \ ampcosfun 2741 '( 0 0 100 1 ) \ freqcosfun 2742 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 2743 :degree 90.0 random resflt 2744 dur 0.2 f+ step 2745 now@ dur #t \ start dur driver 2746 10000 0.01 \ ranfreq noiamp 2747 '( 0 0 50 1 100 0 ) \ noifun 2748 0 0 0 0 \ cosamp cosfreq1 cosfreq0 cosnum 2749 #f #f \ ampcosfun freqcosfun 2750 500 0.995 0.1 1000 0.995 0.1 2000 0.995 0.1 2751 :degree 90.0 random resflt 2752 dur 0.2 f+ step 2753; 2754 2755hide 2756: scratch-input-cb { rd samp -- prc ; dir self -- r } 2757 1 proc-create ( prc ) 2758 samp , rd , 2759 does> { dir self -- r } 2760 self @ { samp } 2761 self cell+ @ { rd } 2762 rd samp 0 file->sample \ (file->sample rd samp 0) 2763 dir self +! \ samp += dir 2764; 2765set-current 2766 2767\ SCRATCH-INS 2768instrument: scratch-ins <{ start file src-ratio turntable -- }> 2769 file find-file to file 2770 file unless 2771 'file-not-found 2772 #( "%s: can't find %S" get-func-name file ) fth-throw 2773 then 2774 file mus-sound-duration { dur } 2775 file make-readin { f } 2776 turntable 0 object-ref seconds->samples { cur-samp } 2777 turntable 1 object-ref seconds->samples { turn-samp } 2778 :input f cur-samp scratch-input-cb :srate src-ratio make-src { rd } 2779 src-ratio f0> { forwards } 2780 forwards 2781 turn-samp cur-samp < && if 2782 rd src-ratio fnegate set-mus-increment drop 2783 then 2784 1 { turn-i } 2785 0 { turning } 2786 0.0 0.0 { last-val1 last-val2 } 2787 start dur #{ :degree 90.0 random } run-instrument 2788 turn-i turntable length >= ?leave 2789 rd 0.0 undef src { val } 2790 turning unless 2791 forwards 2792 cur-samp turn-samp >= && if 2793 1 2794 else 2795 forwards false? 2796 cur-samp turn-samp <= && if 2797 -1 2798 else 2799 turning 2800 then 2801 then to turning 2802 else 2803 last-val2 last-val1 f<= last-val1 val f>= && 2804 last-val2 last-val1 f>= last-val1 val f<= && || if 2805 turn-i 1+ to turn-i 2806 turn-i turntable length < if 2807 turntable turn-i object-ref 2808 seconds->samples to turn-samp 2809 forwards not to forwards 2810 rd rd mus-increment fnegate 2811 set-mus-increment drop 2812 then 2813 0 to turning 2814 then 2815 then 2816 last-val1 to last-val2 2817 val to last-val1 2818 val 2819 end-run 2820 f mus-close drop 2821;instrument 2822previous 2823 2824: scratch-test <{ :optional start 0.0 dur 1.0 -- }> 2825 start now! 2826 start "fyow.snd" dur 1.5 fmin #( 0 0.5 0.25 1 ) scratch-ins 2827 "fyow.snd" find-file mus-sound-duration 0.2 f+ step 2828; 2829 2830\ PINS 2831\ 2832\ spectral modeling (SMS) 2833instrument: pins <{ start dur file amp :key 2834 transposition 1.0 2835 time-scaler 1.0 2836 fftsize 256 2837 highest-bin 128 2838 max-peaks 16 2839 attack #f -- }> 2840 doc" start dur \"fyow.snd\" 1.0 :time-scaler 2.0 pins." 2841 file find-file to file 2842 file unless 2843 'file-not-found 2844 #( "%s: can't find %S" get-func-name file ) fth-throw 2845 then 2846 file mus-sound-duration { fdur } 2847 dur time-scaler f/ { sdur } 2848 sdur fdur f> if 2849 'forth-error 2850 #( "%s is %.3f secs long, \ 2851but we'll need %.3f secs of data for this note" file fdur sdur ) fth-throw 2852 then 2853 file make-readin { fil } 2854 fftsize make-vct { fdr } 2855 fftsize make-vct { fdi } 2856 blackman2-window fftsize 0.0 0.0 make-fft-window { win } 2857 fftsize make-vct { fftamps } 2858 max-peaks 2* { max-oscils } 2859 max-oscils make-vct { current-peak-freqs } 2860 max-oscils make-vct { last-peak-freqs } 2861 max-oscils make-vct { current-peak-amps } 2862 max-oscils make-vct { last-peak-amps } 2863 max-peaks make-vct { peak-amps } 2864 max-peaks make-vct { peak-freqs } 2865 max-oscils make-array map! 2866 :frequency 0.0 make-oscil 2867 end-map { resynth-oscils } 2868 max-oscils make-vct { ampls } 2869 max-oscils make-vct { rates } 2870 max-oscils make-vct { freqs } 2871 max-oscils make-vct { sweeps } 2872 fftsize 4.0 f/ fround->s { hop } 2873 time-scaler hop f* fround->s { outhop } 2874 outhop 1/f { ifreq } 2875 ifreq hz->radians { ihifreq } 2876 mus-srate fftsize f/ { fft-mag } 2877 max-oscils { cur-oscils } 2878 attack if 2879 attack 2880 else 2881 0 2882 then { ramped } 2883 attack { splice-attack } 2884 attack if 2885 attack 2886 else 2887 1 2888 then { attack-size } 2889 0.0 { ramp-ind } 2890 attack-size make-vct { ramped-attack } 2891 outhop { trigger } 2892 win fftsize 0.42323 f* 1/f vct-scale! drop 2893 0 { filptr } 2894 start dur #{ :degree 90.0 random } run-instrument 2895 splice-attack if 2896 attack-size 1/f { ramp } 2897 fil filptr 0 file->sample amp f* ( outval ) 2898 filptr 1+ to filptr 2899 filptr attack-size > if 2900 1 { mult } 2901 ramped-attack map! 2902 fil filptr i + 0 file->sample mult f* 2903 mult ramp f- to mult 2904 end-map drop 2905 #f to splice-attack 2906 then 2907 ( outval ) 2908 else 2909 trigger outhop >= if 2910 0 { peaks } 2911 0 to trigger 2912 fdr map! 2913 fil filptr i + 0 file->sample 2914 win i vct-ref f* 2915 end-map drop 2916 filptr fdr vct-length + to filptr 2917 fdi 0.0 vct-fill! drop 2918 filptr fftsize hop - - to filptr 2919 fdr fdi fftsize 1 mus-fft drop 2920 highest-bin 0 ?do 2921 fftamps i 2922 fdr i vct-ref dup f* 2923 fdi i vct-ref dup f* f+ 2924 fsqrt f2* 2925 vct-set! drop 2926 loop 2927 current-peak-freqs each { fv } 2928 current-peak-amps i vct-ref { av } 2929 last-peak-freqs i fv vct-set! drop 2930 last-peak-amps i av vct-set! drop 2931 current-peak-amps i 0.0 vct-set! drop 2932 end-each 2933 peak-amps 0.0 vct-fill! drop 2934 fftamps 0 vct-ref { ra } 2935 0.0 0.0 { la ca } 2936 highest-bin 0 ?do 2937 ca to la 2938 ra to ca 2939 fftamps i vct-ref to ra 2940 ca 0.001 f> 2941 ca ra f> && 2942 ca la f> && if 2943 la flog10 ra flog10 f- f2/ 2944 la flog10 -2.0 ca flog10 2945 f* f+ ra flog10 2946 f+ f/ { offset } 2947 10.0 ca flog10 2948 0.25 la flog10 2949 ra flog10 f- f* offset 2950 f* f- f** { amp-1 } 2951 fft-mag i offset -1.0 2952 f+ f+ f* { freq } 2953 peaks max-peaks = if 2954 0 { minp } 2955 peak-amps 0 2956 vct-ref { minpeak } 2957 max-peaks 1 ?do 2958 peak-amps i 2959 vct-ref 2960 minpeak f< if 2961 i to minp 2962 peak-amps i 2963 vct-ref to 2964 minpeak 2965 then 2966 loop 2967 amp-1 minpeak f> if 2968 peak-freqs minp 2969 freq 2970 vct-set! drop 2971 peak-amps minp 2972 amp-1 2973 vct-set! drop 2974 then 2975 else 2976 peak-freqs peaks 2977 freq vct-set! drop 2978 peak-amps peaks 2979 amp-1 vct-set! drop 2980 peaks 1+ to peaks 2981 then 2982 then 2983 loop 2984 peaks 0 ?do 2985 0 { maxp } 2986 peak-amps 0 vct-ref ( maxpk ) 2987 max-peaks 1 ?do 2988 peak-amps i vct-ref over f> if 2989 i to maxp 2990 drop ( maxpk ) 2991 peak-amps 2992 i vct-ref ( maxpk ) 2993 then 2994 loop 2995 ( maxpk ) f0> if 2996 -1 { closestp } 2997 10 { closestamp } 2998 peak-freqs maxp 2999 vct-ref { cur-freq } 3000 cur-freq 1/f { icf } 3001 max-peaks 0 ?do 3002 last-peak-amps 3003 i vct-ref f0> if 3004 icf 3005 last-peak-freqs 3006 i 3007 vct-ref 3008 cur-freq f- 3009 fabs f* 3010 { closeness } 3011 closeness 3012 closestamp f< if 3013 closeness to 3014 closestamp 3015 i to 3016 closestp 3017 then 3018 then 3019 loop 3020 closestamp 0.1 f< if 3021 current-peak-amps 3022 closestp 3023 peak-amps maxp vct-ref 3024 vct-set! drop 3025 peak-amps maxp 0.0 3026 vct-set! drop 3027 current-peak-freqs 3028 closestp cur-freq 3029 vct-set! drop 3030 then 3031 then 3032 loop 3033 max-peaks 0 ?do 3034 peak-amps i vct-ref f0> if 3035 -1 { new-place } 3036 max-oscils 0 ?do 3037 last-peak-amps 3038 i vct-ref f0= 3039 current-peak-amps 3040 i vct-ref f0= && if 3041 i to new-place 3042 leave 3043 then 3044 loop 3045 current-peak-amps new-place 3046 peak-amps i vct-ref 3047 vct-set! drop 3048 peak-amps i 0.0 vct-set! drop 3049 current-peak-freqs new-place 3050 peak-freqs i vct-ref 3051 vct-set! drop 3052 last-peak-freqs new-place 3053 peak-freqs i vct-ref 3054 vct-set! drop 3055 resynth-oscils new-place 3056 array-ref ( gen ) 3057 transposition peak-freqs 3058 i vct-ref f* ( val ) 3059 set-mus-frequency drop 3060 then 3061 loop 3062 0 to cur-oscils 3063 max-oscils 0 ?do 3064 rates i 3065 current-peak-amps i vct-ref 3066 last-peak-amps i vct-ref f- 3067 ifreq f* 3068 vct-set! drop 3069 current-peak-amps i vct-ref f0<> 3070 last-peak-amps i vct-ref f0<> || if 3071 i to cur-oscils 3072 then 3073 sweeps i 3074 current-peak-freqs i vct-ref 3075 last-peak-freqs i vct-ref f- 3076 transposition f* ihifreq f* 3077 vct-set! drop 3078 loop 3079 cur-oscils 1+ to cur-oscils 3080 then 3081 trigger 1+ to trigger 3082 ramped 0= if 3083 0.0 ( sum ) 3084 else 3085 ramped-attack ramp-ind vct-ref ( sum ) 3086 ramp-ind 1+ to ramp-ind 3087 ramp-ind ramped = if 3088 0 to ramp-ind 3089 then 3090 then ( sum ) 3091 cur-oscils 0 ?do 3092 ampls i vct-ref f0<> 3093 rates i vct-ref f0<> || if 3094 resynth-oscils i array-ref 3095 freqs i vct-ref 3096 0.0 oscil 3097 ampls i vct-ref f* f+ ( sum += ... ) 3098 ampls i rates i vct-ref object-set+! 3099 freqs i sweeps i vct-ref object-set+! 3100 then 3101 loop 3102 amp ( sum ) f* 3103 then 3104 end-run 3105;instrument 3106 3107: pins-test <{ :optional start 0.0 dur 1.0 -- }> 3108 start now! 3109 now@ dur "fyow.snd" 1.0 :time-scaler 2.0 pins 3110 dur 0.2 f+ step 3111; 3112 3113\ ZC 3114instrument: zc <{ start dur freq amp len1 len2 feedback -- }> 3115 :frequency freq make-pulse-train { s } 3116 :size len1 3117 :scaler feedback 3118 :max-size len1 len2 max 1+ make-comb { d0 } 3119 :envelope #( 0 0 1 1 ) 3120 :scaler len2 len1 f- 3121 :duration dur make-env { zenv } 3122 start dur #{ :degree 90.0 random } run-instrument 3123 d0 s 0.0 pulse-train amp f* zenv env comb 3124 end-run 3125;instrument 3126 3127: zc-test <{ :optional start 0.0 dur 1.0 -- }> 3128 start now! 3129 now@ dur 100 0.4 20 100 0.95 zc 3130 dur 0.2 f+ step 3131 now@ dur 100 0.4 100 20 0.95 zc 3132 dur 0.2 f+ step 3133; 3134 3135\ ZN 3136\ 3137\ notches are spaced at srate/len, feedforward sets depth thereof so 3138\ sweep of len from 20 to 100 sweeps the notches down from 1000 Hz to 3139\ ca 200 Hz so we hear our downward glissando beneath the pulses. 3140instrument: zn <{ start dur freq amp len1 len2 feedforward -- }> 3141 :frequency freq make-pulse-train { s } 3142 :size len1 3143 :scaler feedforward 3144 :max-size len1 len2 max 1+ make-notch { d0 } 3145 :envelope #( 0 0 1 1 ) 3146 :scaler len2 len1 f- 3147 :duration dur make-env { zenv } 3148 start dur #{ :degree 90.0 random } run-instrument 3149 d0 s 0.0 pulse-train amp f* zenv env notch 3150 end-run 3151;instrument 3152 3153: zn-test <{ :optional start 0.0 dur 1.0 -- }> 3154 start now! 3155 now@ dur 100 0.5 20 100 0.95 zn 3156 dur 0.2 f+ step 3157 now@ dur 100 0.5 100 20 0.95 zn 3158 dur 0.2 f+ step 3159; 3160 3161\ ZA 3162instrument: za <{ start dur freq amp len1 len2 fb ffw -- }> 3163 :frequency freq make-pulse-train { s } 3164 :size len1 3165 :feedback fb 3166 :feedforward ffw 3167 :max-size len1 len2 max 1+ make-all-pass { d0 } 3168 :envelope #( 0 0 1 1 ) 3169 :scaler len2 len1 f- 3170 :duration dur make-env { zenv } 3171 start dur #{ :degree 90.0 random } run-instrument 3172 d0 s 0.0 pulse-train amp f* zenv env all-pass 3173 end-run 3174;instrument 3175 3176: za-test <{ :optional start 0.0 dur 1.0 -- }> 3177 start now! 3178 now@ dur 100 0.3 20 100 0.95 0.95 za 3179 dur 0.2 f+ step 3180 now@ dur 100 0.3 100 20 0.95 0.95 za 3181 dur 0.2 f+ step 3182; 3183 3184hide 3185: clm-src-cb { gen -- prc; dir self -- r } 3186 1 proc-create ( prc ) 3187 gen , 3188 does> { dir self -- r } 3189 self @ ( gen ) #f #f granulate 3190; 3191set-current 3192 3193\ CLM-EXPSRC 3194instrument: clm-expsrc <{ start dur in-file exp-ratio src-ratio amp :optional 3195 rev #f 3196 start-in-file 0 -- }> 3197 in-file find-file to in-file 3198 in-file unless 3199 'file-not-found 3200 #( "%s: can't find %S" get-func-name in-file ) fth-throw 3201 then 3202 start-in-file in-file mus-sound-srate f* fround->s { stf } 3203 :file in-file :channel 0 :start stf make-readin { fdA } 3204 :input fdA readin-cb :expansion exp-ratio make-granulate { exA } 3205 :input exA clm-src-cb :srate src-ratio make-src { srcA } 3206 in-file channels 2 = *output* channels 2 = && { two-chans } 3207 *reverb* rev && { revit } 3208 two-chans if 3209 :file in-file :channel 1 :start stf make-readin { fdB } 3210 :input fdB readin-cb :expansion exp-ratio make-granulate { exB } 3211 :input exB clm-src-cb :srate src-ratio make-src { srcB } 3212 revit if 3213 rev f2/ to rev 3214 start dur run 3215 srcA 0.0 undef src amp f* { valA } 3216 srcB 0.0 undef src amp f* { valB } 3217 i valA *output* outa drop 3218 i valB *output* outb drop 3219 i valA valB f+ rev f* *reverb* outa drop 3220 loop 3221 else 3222 start dur run 3223 i srcA 0.0 undef src amp f* *output* outa drop 3224 i srcB 0.0 undef src amp f* *output* outb drop 3225 loop 3226 then 3227 else 3228 revit if 3229 start dur run 3230 srcA 0.0 undef src amp f* { valA } 3231 i valA *output* outa drop 3232 i valA rev f* *reverb* outa drop 3233 loop 3234 else 3235 start dur run 3236 i srcA 0.0 undef src amp f* *output* outa drop 3237 loop 3238 then 3239 then 3240;instrument 3241previous 3242 3243: clm-expsrc-test <{ :optional start 0.0 dur 1.0 -- }> 3244 start now! 3245 now@ dur "oboe.snd" 2.0 1.0 1.0 clm-expsrc 3246 dur 0.2 f+ step 3247; 3248 3249\ EXP-SND 3250instrument: exp-snd <{ file start dur amp :optional 3251 exp-amt 1.0 3252 ramp 0.4 3253 seglen 0.15 3254 sr 1.0 3255 hop 0.05 3256 ampenv #f -- }> 3257 doc" \n\ 3258\\ ;; granulate with envelopes on the expansion amount,\n\ 3259\\ ;; segment envelope shape, segment length, hop length,\n\ 3260\\ ;; and input file resampling rate\n\ 3261\"fyow.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15\n\ 3262 #( 0 2 1 0.5 ) 0.05 <'> exp-snd with-sound\n\ 3263\"oboe.snd\" 0 3 1 #( 0 1 1 3 ) 0.4 0.15\n\ 3264 #( 0 2 1 0.5 ) 0.2 <'> exp-snd with-sound." 3265 file find-file to file 3266 file unless 3267 'file-not-found 3268 #( "%s: can't find %S" get-func-name file ) fth-throw 3269 then 3270 file 0 make-readin { f0 } 3271 :envelope exp-amt array? if 3272 exp-amt 3273 else 3274 #( 0 exp-amt 1 exp-amt ) 3275 then :duration dur make-env { expenv } 3276 :envelope seglen array? if 3277 seglen 3278 else 3279 #( 0 seglen 1 seglen ) 3280 then :duration dur make-env { lenenv } 3281 seglen if 3282 seglen array? if 3283 seglen max-envelope 3284 else 3285 seglen 3286 then 3287 else 3288 0.15 3289 then { max-seg-len } 3290 seglen if 3291 seglen array? if 3292 seglen 1 array-ref 3293 else 3294 seglen 3295 then 3296 else 3297 0.15 3298 then { initial-seg-len } 3299 max-seg-len 0.15 f> if 3300 0.6 0.15 f* max-seg-len f/ 3301 else 3302 0.6 3303 then { scaler-amp } 3304 :envelope sr array? if 3305 sr 3306 else 3307 #( 0 sr 1 sr ) 3308 then :duration dur make-env { srenv } 3309 ramp array? if 3310 ramp 3311 else 3312 #( 0 ramp 1 ramp ) 3313 then { rampdata } 3314 :envelope rampdata :duration dur make-env { rampenv } 3315 ramp if 3316 ramp array? if 3317 ramp 1 array-ref 3318 else 3319 ramp 3320 then 3321 else 3322 0.4 3323 then { initial-ramp-time } 3324 :envelope hop array? if 3325 hop 3326 else 3327 #( 0 hop 1 hop ) 3328 then :duration dur make-env { hopenv } 3329 hop if 3330 hop array? if 3331 hop max-envelope 3332 else 3333 hop 3334 then 3335 else 3336 0.05 3337 then { max-out-hop } 3338 hop if 3339 hop array? if 3340 hop 1 array-ref 3341 else 3342 hop 3343 then 3344 else 3345 0.05 3346 then { initial-out-hop } 3347 exp-amt if 3348 exp-amt array? if 3349 exp-amt min-envelope 3350 else 3351 exp-amt 3352 then 3353 else 3354 1.0 3355 then { min-exp-amt } 3356 exp-amt if 3357 exp-amt array? if 3358 exp-amt 1 array-ref 3359 else 3360 exp-amt 3361 then 3362 else 3363 1.0 3364 then { initial-exp-amt } 3365 max-out-hop min-exp-amt f/ { max-in-hop } 3366 :envelope ampenv #( 0 0 0.5 1 1 0 ) || 3367 :scaler amp 3368 :duration dur make-env { ampe } 3369 :input f0 readin-cb 3370 :expansion initial-exp-amt 3371 :max-size max-out-hop max-in-hop fmax max-seg-len f+ 3372 mus-srate f* fceil f>s 3373 :ramp initial-ramp-time 3374 :hop initial-out-hop 3375 :length initial-seg-len 3376 :scaler scaler-amp make-granulate { ex-a } 3377 ampe env { vol } 3378 ex-a granulate vol f* { val-a0 } 3379 ex-a granulate vol f* { val-a1 } 3380 rampdata min-envelope f0<= 3381 rampdata max-envelope 0.5 f>= || if 3382 'forth-error 3383 #( "ramp arg to expand must always \ 3384be between 0.0 and 0.5, %.3f -- %.3f" 3385 rampdata min-envelope 3386 rampdata max-envelope ) fth-throw 3387 then 3388 0.0 0.0 { ex-samp next-samp } 3389 0.0 0.0 0.0 0.0 0.0 { expa segl resa rmpl hp } 3390 0 0 { sl rl } 3391 start dur #{ :degree 90.0 random } run-instrument 3392 expenv env to expa 3393 lenenv env to segl 3394 srenv env to resa 3395 rampenv env to rmpl 3396 hopenv env to hp 3397 segl mus-srate f* floor dup f>s to sl 3398 ( fsl ) rmpl f* floor f>s to rl 3399 ampe env to vol 3400 ex-a sl set-mus-length drop 3401 ex-a rl set-mus-ramp drop 3402 ex-a hp set-mus-frequency drop 3403 ex-a expa set-mus-increment drop 3404 resa next-samp f+ to next-samp 3405 next-samp ex-samp 1.0 f+ f> if 3406 next-samp ex-samp f- fround->s 0 ?do 3407 val-a1 to val-a0 3408 ex-a granulate vol f* to val-a1 3409 1.0 ex-samp f+ to ex-samp 3410 loop 3411 then 3412 next-samp ex-samp f= if 3413 val-a0 3414 else 3415 next-samp ex-samp f- val-a1 val-a0 f- f* val-a0 f+ 3416 then 3417 end-run 3418;instrument 3419 3420: exp-snd-test <{ :optional start 0.0 dur 1.0 -- }> 3421 start now! 3422 "fyow.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15 3423 #( 0 2 1 0.5 ) 0.05 exp-snd 3424 dur 0.2 f+ step 3425 "oboe.snd" now@ dur 1.0 #( 0 1 1 3 ) 0.4 0.15 3426 #( 0 2 1 0.5 ) 0.2 exp-snd 3427 dur 0.2 f+ step 3428; 3429 3430#( "exp-rampval" 3431 "exp-rampinc" 3432 "exp-loc" 3433 "exp-segctr" 3434 "exp-whichseg" 3435 "exp-ramplen" 3436 "exp-steadylen" 3437 "exp-trigger" ) create-struct make-expfil-struct 3438 3439\ EXPFIL 3440instrument: expfil <{ start dur hopsecs rampsecs steadysecs file1 file2 -- }> 3441 file1 find-file to file1 3442 file1 unless 3443 'file-not-found 3444 #( "%s: can't find %S" get-func-name file1 ) fth-throw 3445 then 3446 file2 find-file to file2 3447 file2 unless 3448 'file-not-found 3449 #( "%s: can't find %S" get-func-name file2 ) fth-throw 3450 then 3451 rampsecs seconds->samples { ramplen } 3452 make-expfil-struct { grn1 } 3453 make-expfil-struct { grn2 } 3454 grn1 0.0 exp-rampval! 3455 grn2 0.0 exp-rampval! 3456 grn1 ramplen 1/f exp-rampinc! 3457 grn2 ramplen 1/f exp-rampinc! 3458 grn1 0 exp-loc! 3459 grn2 0 exp-loc! 3460 grn1 0 exp-segctr! 3461 grn2 0 exp-segctr! 3462 grn1 0 exp-whichseg! 3463 grn2 0 exp-whichseg! 3464 grn1 ramplen exp-ramplen! 3465 grn2 ramplen exp-ramplen! 3466 grn1 steadysecs seconds->samples exp-steadylen! 3467 grn2 steadysecs seconds->samples exp-steadylen! 3468 grn1 0 exp-trigger! 3469 grn2 0 exp-trigger! 3470 hopsecs seconds->samples { hop } 3471 start seconds->samples { out1 } 3472 hop out1 + { out2 } 3473 file1 0 make-readin { fil1 } 3474 file2 0 make-readin { fil2 } 3475 0.0 { inval } 3476 start dur #{ :degree 90.0 random } run-instrument 3477 0.0 ( val ) 3478 i out1 = if 3479 fil1 grn1 exp-loc@ 0 file->sample to inval 3480 grn1 grn1 exp-loc@ 1+ exp-loc! 3481 grn1 exp-whichseg@ case 3482 0 of 3483 grn1 exp-rampval@ inval f* to inval 3484 grn1 grn1 exp-rampinc@ 3485 grn1 exp-rampval@ f+ exp-rampval! 3486 grn1 grn1 exp-segctr@ 1+ exp-segctr! 3487 grn1 exp-segctr@ grn1 exp-ramplen@ = if 3488 grn1 0 exp-segctr! 3489 grn1 grn1 exp-whichseg@ 1+ exp-whichseg! 3490 then 3491 endof 3492 1 of 3493 grn1 grn1 exp-segctr@ 1+ exp-segctr! 3494 grn1 exp-segctr@ grn1 exp-steadylen@ = if 3495 grn1 0 exp-segctr! 3496 grn1 grn1 exp-whichseg@ 1+ exp-whichseg! 3497 then 3498 endof 3499 \ default 3500 grn1 exp-rampval@ inval f* to inval 3501 grn1 grn1 exp-segctr@ 1+ exp-segctr! 3502 grn1 grn1 exp-rampinc@ fnegate 3503 grn1 exp-rampval@ f+ exp-rampval! 3504 grn1 exp-segctr@ grn1 exp-ramplen@ = if 3505 grn1 0 exp-segctr! 3506 grn1 1 exp-trigger! 3507 grn1 0 exp-whichseg! 3508 grn1 0.0 exp-rampval! 3509 then 3510 endcase 3511 inval f+ ( val ) 3512 out1 1+ to out1 3513 grn1 exp-trigger@ 1 = if 3514 grn1 0 exp-trigger! 3515 hop out1 + to out1 3516 then 3517 then 3518 i out2 = if 3519 fil2 grn2 exp-loc@ 0 file->sample { inval } 3520 grn2 grn2 exp-loc@ 1+ exp-loc! 3521 grn2 exp-whichseg@ case 3522 0 of 3523 grn2 exp-rampval@ inval f* to inval 3524 grn2 grn2 exp-rampinc@ 3525 grn1 exp-rampval@ f+ exp-rampval! 3526 grn2 grn2 exp-segctr@ 1+ exp-segctr! 3527 grn2 exp-segctr@ grn2 exp-ramplen@ = if 3528 grn2 0 exp-segctr! 3529 grn2 grn2 exp-whichseg@ 1+ exp-whichseg! 3530 then 3531 endof 3532 1 of 3533 grn2 grn2 exp-segctr@ 1+ exp-segctr! 3534 grn2 exp-segctr@ grn2 exp-steadylen@ = if 3535 grn2 0 exp-segctr! 3536 grn2 grn2 exp-whichseg@ 1+ exp-whichseg! 3537 then 3538 endof 3539 \ default 3540 grn2 exp-rampval@ inval f* to inval 3541 grn2 grn2 exp-segctr@ 1+ exp-segctr! 3542 grn2 grn2 exp-rampinc@ fnegate 3543 grn2 exp-rampval@ f+ exp-rampval! 3544 grn2 exp-segctr@ grn2 exp-ramplen@ = if 3545 grn2 0 exp-segctr! 3546 grn2 1 exp-trigger! 3547 grn2 0 exp-whichseg! 3548 grn2 0.0 exp-rampval! 3549 then 3550 endcase 3551 inval f+ ( val ) 3552 out2 1+ to out2 3553 grn2 exp-trigger@ 1 = if 3554 grn2 0 exp-trigger! 3555 hop out2 + to out2 3556 then 3557 then 3558 end-run 3559;instrument 3560 3561: expfil-test <{ :optional start 0.0 dur 1.0 -- }> 3562 start now! 3563 now@ dur 0.2 0.01 0.1 "oboe.snd" "fyow.snd" expfil 3564 dur 0.2 f+ step 3565; 3566 3567\ GRAPH-EQ 3568\ 3569\ From: Marco Trevisani <marco@ccrma.Stanford.EDU> 3570\ 3571\ This should work like a Graphic Equalizer.... 3572\ Very easy to use. Just some note: 3573\ 3574\ "amp" & "amp-env" apply an enveloppe to the final result of the 3575\ filtering. 3576\ 3577\ "dur" as ""standard"" in my instruments, when dur = 0 it will take the 3578\ length of the sndfile input, otherwise the duration in seconds. 3579\ 3580\ "gain-freq-list" is a list of gains and frequencies to 3581\ filter --in this order gain and frequencies--. There is no limit to 3582\ the size of the list. Gain can be a number or an 3583\ envelope. Unfortunatelly in this version they cant alternate, one 3584\ should chose, all envelopes or all numbers i.e.: 3585\ case 1 -> #( .1 440.0 .3 1500.0 .2 330.0 ...etc) or 3586\ case 2 -> #((0 .1 1 .5) 440.0 (0 1 1 .01) 1500 (0 .3 1 .5) 330.0 ...etc) 3587\ #( .1 440.0 (0 1 1 .01) 1500 ..etc) <<< again, this is not allowed .. 3588\ 3589\ "offset-gain" This apply to all the gains if case 1. It adds or 3590\ subtracts an offset to all the gains in the list. This number can be 3591\ positive or negative. In case the result is a negative number --let's 3592\ say offset = -.4 and, like in case 1, the first gain is .1, the result 3593\ would be -.3 -- the instrument will pass a gain equal to 0. 3594\ 3595\ "filt-gain-scale" & "filt-gain-base" will apply to the elements of the 3596\ envelopes if we are in case 2, gains are envelopes. 3597instrument: graph-eq <{ file start dur :key 3598 file-start 0.0 3599 amplitude 1.0 3600 amp-env #( 0 1 0.8 1 1 0 ) 3601 amp-base 1.0 3602 offset-gain 0.0 3603 gain-freq-list #( #( 0 1 1 0 ) 440 #( 0 0 1 1 ) 660 ) 3604 filt-gain-scale 1.0 3605 filt-gain-base 1.0 3606 a1 0.99 -- }> 3607 doc" \"oboe.snd\" 0 2 graph-eq." 3608 file find-file to file 3609 file unless 3610 'file-not-found 3611 #( "%s: can't find %S" get-func-name file ) fth-throw 3612 then 3613 :file file 3614 :start file mus-sound-srate file-start f* fround->s 3615 make-readin { rd } 3616 :envelope amp-env 3617 :scaler amplitude 3618 :duration dur 3619 :base amp-base make-env { ampf } 3620 gain-freq-list length 2/ { len } 3621 len make-array { gainl } 3622 len make-array { freql } 3623 0 { idx } 3624 gain-freq-list length 1- 0 ?do 3625 gainl idx gain-freq-list i array-ref array-set! 3626 freql idx gain-freq-list i 1+ array-ref array-set! 3627 idx 1+ to idx 3628 2 +loop 3629 gainl 0 array-ref array? dup { if-list-in-gain } if 3630 len make-array map! 3631 :envelope gainl i array-ref 3632 :scaler filt-gain-scale 3633 :duration dur 3634 :base filt-gain-base make-env 3635 end-map 3636 else 3637 #f 3638 then { env-size } 3639 freql map 3640 :frequency *key* :radius a1 make-formant 3641 end-map { frm-size } 3642 len 1.0 make-vct { gains } 3643 gainl each { gval } 3644 freql i array-ref { fval } 3645 if-list-in-gain if 3646 :envelope gval 3647 :scaler filt-gain-scale 3648 :duration dur 3649 :base filt-gain-base make-env 3650 env-size i rot ( en ) array-set! 3651 frm-size i :frequency fval 3652 :radius a1 make-formant array-set! 3653 else 3654 frm-size i :frequency fval 3655 :radius a1 make-formant array-set! 3656 gains i offset-gain gval f+ f0< if 3657 0.0 3658 else 3659 offset-gain gval f+ 3660 then vct-set! drop 3661 then 3662 end-each 3663 1.0 a1 f- { 1-a1 } 3664 start dur #{ :degree 90.0 random } run-instrument 3665 rd readin { inval } 3666 0.0 ( outval ) 3667 env-size each { en } 3668 if-list-in-gain if 3669 gains i en env 1-a1 f* vct-set! drop 3670 then 3671 frm-size i array-ref ( fmt ) inval undef formant 3672 gains i vct-ref f* ( fmt * gain ) 3673 f+ ( outval += ... ) 3674 end-each 3675 ampf env f* ( outval ) 3676 end-run 3677 rd mus-close drop 3678;instrument 3679 3680: graph-eq-test <{ :optional start 0.0 dur 1.0 -- }> 3681 start now! 3682 "oboe.snd" now@ dur :amplitude 50.0 graph-eq 3683 dur 0.2 f+ step 3684; 3685 3686\ ANOI 3687\ 3688\ a kind of noise reduction -- on-going average spectrum is squelched 3689\ to some extent obviously aimed at intermittent signal in background 3690\ noise 3691\ this is based on Perry Cook's Scrubber.m 3692\ 3693\ clm/anoi.ins 3694instrument: anoi <{ fname start dur :optional 3695 fftsize 128 3696 amp-scaler 1.0 3697 R two-pi -- }> 3698 fftsize 2/ { freq-inc } 3699 fftsize 0.0 make-vct { fdr } 3700 fftsize 0.0 make-vct { fdi } 3701 freq-inc 1.0 make-vct { spectr } 3702 freq-inc 1.0 make-vct { scales } 3703 freq-inc 0.0 make-vct { diffs } 3704 blackman2-window fftsize undef undef make-fft-window { win } 3705 amp-scaler 4.0 f* mus-srate f/ { incr } 3706 fname find-file to fname 3707 fname unless 3708 'file-not-found 3709 #( "%s: can't find %S" get-func-name fname ) fth-throw 3710 then 3711 fname make-file->sample { fil } 3712 fftsize s>f to fftsize 3713 fftsize fnegate { -fftsize } 3714 1.0 R fftsize f/ f- { radius } 3715 mus-srate fftsize f/ { bin } 3716 freq-inc make-array map! 3717 :frequency i bin f* :radius radius make-formant 3718 end-map { fs } 3719 0 { samp } 3720 0.0 { inval } 3721 nil { fmt } 3722 0.0 { curscl } 3723 0.0 { fd } 3724 0.0 { amp } 3725 start dur #{ :degree 90.0 random } run-instrument 3726 fil samp 0 file->sample to inval 3727 samp 1+ to samp 3728 fdr inval cycle-set! 3729 amp amp-scaler f< if 3730 incr amp f+ to amp 3731 then 3732 fdr cycle-start@ 0= if 3733 fdr fdi win 1 spectrum drop 3734 diffs map! 3735 fdr i vct-ref to fd 3736 spectr i 3737 spectr i vct-ref 0.9 f* fd 0.1 f* f+ 3738 vct-set! ( sp ) fd f>= if 3739 scales i vct-ref -fftsize f/ 3740 else 3741 fd spectr i vct-ref f- fd f/ 3742 scales i vct-ref f- fftsize f/ 3743 then ( diff ) 3744 end-map drop 3745 then 3746 0.0 ( outval ) 3747 fs each to fmt 3748 scales i vct-ref to curscl 3749 fmt inval undef formant curscl f* f+ ( outval += ... ) 3750 scales i diffs i vct-ref curscl f+ vct-set! drop 3751 end-each ( outval ) amp f* 3752 end-run 3753;instrument 3754 3755: anoi-test <{ :optional start 0.0 dur 1.0 -- }> 3756 start now! 3757 "fyow.snd" now@ dur 128 2.0 anoi 3758 dur 0.2 f+ step 3759; 3760 3761\ Date: Fri, 25 Sep 1998 09:56:41 +0300 3762\ From: Matti Koskinen <mjkoskin@sci.fi> 3763\ To: linux-audio-dev@ginette.musique.umontreal.ca 3764\ Subject: [linux-audio-dev] Announce: alpha version of denoising 3765\ [...] 3766\ I wrote a simple denoiser called anoi after it's parent 3767\ clm-instrument anoi.ins. 3768\ 3769\ anoi tries to remove white noise like tape hiss from wav- 3770\ files. Removing of noise succeeds ok, but depending of the 3771\ original sound, some distortion can be audible. 3772\ 3773\ If someone is interested, http://www.sci.fi/~mjkoskin 3774\ contains tarred and gzipped file. 3775\ 3776\ Now only monophonic wav-files can be denoised, but adding 3777\ others isn't too difficult. 3778\ 3779\ -matti 3780\ mjkoskin@sci.fi 3781 3782\ 3783\ FIXME fullmix 3784\ needs some more work 3785\ 3786instrument: fullmix <{ in-file :optional 3787 start 0.0 3788 dur #f 3789 inbeg 0.0 3790 matrix #f 3791 sr #f 3792 rev-amount #f -- }> 3793; 3794 3795: fullmix-test <{ :optional start 0.0 dur 1.0 -- }> 3796; 3797 37980 [if] 3799hide 3800: set-fullmix-matrix { outn mx inp outp in-chans out-chans dur -- envs } 3801 #f { envs } 3802 outn number? if 3803 mx inp outp outn mixer-set! drop 3804 else 3805 outn env? 3806 outn array? || if 3807 in-chans make-array map! 3808 out-chans make-array 3809 end-map to envs 3810 envs inp array-ref 3811 outp 3812 outn env? if 3813 outn 3814 else 3815 :envelope outn :duration dur make-env 3816 then array-set! 3817 else 3818 'forth-error 3819 #( "fullmix: unknown element in matrix: %S" 3820 outn ) fth-throw 3821 then 3822 then 3823 envs 3824; 3825set-current 3826 3827\ FULLMIX 3828instrument: fullmix <{ in-file :optional 3829 start 0.0 3830 dur #f 3831 inbeg 0.0 3832 matrix #f 3833 sr #f 3834 rev-amount #f -- }> 3835 doc" \"pistol.snd\" 0 1 fullmix\n\ 3836:envelope #( 0 0 1 1 ) :duration 2 :scaler 0.5 make-env value en 3837\"oboe.snd\" 0 2 0 #( #( 0.8 en ) ) 2.0 <'> fullmix with-sound." 3838 in-file find-file to in-file 3839 in-file unless 3840 'file-not-found 3841 #( "%s: can't find %S" get-func-name in-file ) fth-throw 3842 then 3843 dur number? unless 3844 in-file mus-sound-duration inbeg f- 3845 sr if 3846 sr fabs 3847 else 3848 1.0 3849 then f/ to dur 3850 then 3851 in-file channels { in-chans } 3852 *output* channels { out-chans } 3853 inbeg in-file mus-sound-srate f* fround->s { inloc } 3854 matrix if 3855 in-chans out-chans max make-mixer 3856 else 3857 in-chans out-chans max 1.0 make-scalar-mixer 3858 then { mx } 3859 #f { rev-mx } 3860 *reverb* 3861 rev-amount f0> && if 3862 in-chans make-mixer to rev-mx 3863 in-chans 0 ?do 3864 rev-mx i 0 rev-amount mixer-set! drop 3865 loop 3866 then 3867 #f { envs } 3868 #f { inlist } 3869 matrix if 3870 matrix object-length 0> if 3871 in-chans 0 ?do 3872 matrix i object-ref to inlist 3873 out-chans 0 ?do 3874 inlist i object-ref ( outn ) mx j i 3875 in-chans out-chans dur 3876 set-fullmix-matrix to envs 3877 loop 3878 loop 3879 else 3880 in-chans 0 ?do 3881 i out-chans < if 3882 mx i i matrix mixer-set! drop 3883 then 3884 loop 3885 then 3886 then 3887 sr unless 3888 \ ws-info ( start dur local-vars -- start dur ) 3889 \ 3890 \ This is normally done in RUN or RUN-INSTRUMENT, but here 3891 \ we haven't one of them. 3892 \ 3893 start dur local-variables ws-info ( start dur ) 3894 ( start ) seconds->samples { st } 3895 ( dur ) seconds->samples { samps } 3896 *output* in-file undef make-file->frame 3897 st samps inloc mx envs mus-file-mix drop 3898 rev-mx if 3899 *reverb* 1 make-frame 3900 st samps inloc rev-mx #f mus-file-mix drop 3901 then 3902 else 3903 in-chans make-frame { inframe } 3904 out-chans make-frame { outframe } 3905 in-chans make-array map! 3906 :file in-file :channel i :start inloc make-readin { rd } 3907 :input rd readin-cb :srate sr make-src 3908 end-map { srcs } 3909 envs if 3910 start dur run 3911 envs each ( mat ) 3912 each { en } 3913 env? if 3914 mx j ( inp ) 3915 i ( outp ) 3916 en env 3917 mixer-set! drop 3918 then 3919 end-each 3920 end-each 3921 in-chans 0 ?do 3922 inframe i 3923 srcs i array-ref 0.0 undef src 3924 frame-set! drop 3925 loop 3926 *output* i inframe mx outframe 3927 frame->frame frame->file drop 3928 rev-mx if 3929 *reverb* i inframe rev-mx outframe 3930 frame->frame frame->file drop 3931 then 3932 loop 3933 else 3934 start dur run 3935 in-chans 0 ?do 3936 inframe i 3937 srcs i array-ref 0.0 undef src 3938 frame-set! drop 3939 loop 3940 *output* i inframe mx outframe 3941 frame->frame frame->file drop 3942 rev-mx if 3943 *reverb* i inframe rev-mx outframe 3944 frame->frame frame->file drop 3945 then 3946 loop 3947 then 3948 then 3949;instrument 3950previous 3951 3952: fullmix-test <{ :optional start 0.0 dur 1.0 -- }> 3953 start now! 3954 :envelope #( 0 0 1 1 ) :duration dur :scaler 0.5 make-env { en } 3955 3956 "pistol.snd" now@ dur fullmix 3957 dur 0.2 f+ step 3958 "oboe.snd" now@ dur 0 #( #( 0.1 en ) ) fullmix 3959 dur 0.2 f+ step 3960; 3961[then] 3962 3963'snd provided? [if] 3964 \ ;;; bes-fm -- can also use bes-j0 here as in earlier versions 3965 instrument: bes-fm <{ start dur freq amp ratio index -- }> 3966 0.0 0.0 { car-ph mod-ph } 3967 freq hz->radians { car-incr } 3968 ratio car-incr f* { mod-incr } 3969 :envelope #( 0 0 25 1 75 1 100 0 ) 3970 :scaler amp 3971 :duration dur make-env { ampenv } 3972 start dur #{ :degree 90.0 random } run-instrument 3973 ampenv env car-ph bes-j1 f* ( result ) 3974 mod-ph bes-j1 index f* car-incr f+ car-ph f+ to car-ph 3975 mod-incr mod-ph f+ to mod-ph 3976 end-run 3977 ;instrument 3978 3979 : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }> 3980 start now! 3981 now@ dur 440.0 10.0 1.0 4.0 bes-fm 3982 dur 0.2 f+ step 3983 ; 3984 3985 include dsp 3986[else] 3987 : bes-fm-test <{ :optional start 0.0 dur 1.0 -- }> 3988 ; 3989 3990 \ --- Hilbert transform (from dsp.fs) 3991 3992 : make-hilbert-transform <{ :optional len 30 -- gen }> 3993 doc" Make Hilbert transform filter." 3994 len 2* 1+ { arrlen } 3995 arrlen 0.0 make-vct { arr } 3996 len even? if 3997 len 3998 else 3999 len 1+ 4000 then { lim } 4001 lim len negate ?do 4002 i len + { kk } 4003 i pi f* { denom } 4004 1.0 denom fcos f- { num } 4005 num f0<> 4006 i 0<> || if 4007 arr kk 4008 num denom f/ 4009 denom len f/ fcos 0.46 f* 0.54 f+ f* 4010 vct-set! drop 4011 then 4012 loop 4013 :order arrlen :xcoeffs arr make-fir-filter 4014 ; 4015 4016 <'> fir-filter alias hilbert-transform 4017 <'> fir-filter? alias hilbert-transform? 4018 <'> hilbert-transform <'> fir-filter help-ref help-set! 4019 <'> hilbert-transform? <'> fir-filter? help-ref help-set! 4020[then] 4021 4022\ SSB-FM 4023\ ;;; this might be better named "quasi-ssb-fm" -- cancellations are not 4024\ ;;; perfect 4025 4026#( "sbfm-am0" 4027 "sbfm-am1" 4028 "sbfm-car0" 4029 "sbfm-car1" 4030 "sbfm-mod0" 4031 "sbfm-mod1" ) create-struct make-ssb-fm-struct 4032 4033: make-ssb-fm ( freq -- sbfm ) 4034 { freq } 4035 make-ssb-fm-struct { sbfm } 4036 freq 0.0 make-oscil sbfm swap sbfm-am0! 4037 freq half-pi make-oscil sbfm swap sbfm-am1! 4038 0.0 0.0 make-oscil sbfm swap sbfm-car0! 4039 0.0 half-pi make-oscil sbfm swap sbfm-car1! 4040 40 make-hilbert-transform sbfm swap sbfm-mod0! 4041 40 make-delay sbfm swap sbfm-mod1! 4042 sbfm 4043; 4044 4045: ssb-fm ( gen modsig -- val ) 4046 { gen modsig } 4047 gen sbfm-am0@ 0.0 0.0 oscil 4048 gen sbfm-car0@ gen sbfm-mod0@ modsig hilbert-transform 0.0 oscil f* 4049 gen sbfm-am1@ 0.0 0.0 oscil 4050 gen sbfm-car1@ gen sbfm-mod1@ modsig 0.0 delay 0.0 oscil f* 4051 f+ 4052; 4053 4054\ ;;; if all we want are asymmetric fm-generated spectra, we can just 4055\ ;;; add 2 fm oscil pairs: 4056 4057#( "fm2-os1" 4058 "fm2-os2" 4059 "fm2-os3" 4060 "fm2-os4" ) create-struct make-fm2-struct 4061 4062: make-fm2 ( f1 f2 f3 f4 p1 p2 p3 p4 -- fm2 ) 4063 { f1 f2 f3 f4 p1 p2 p3 p4 } 4064 make-fm2-struct { fm2 } 4065 f1 p1 make-oscil fm2 swap fm2-os1! 4066 f2 p2 make-oscil fm2 swap fm2-os2! 4067 f3 p3 make-oscil fm2 swap fm2-os3! 4068 f4 p4 make-oscil fm2 swap fm2-os4! 4069 fm2 4070; 4071 4072: fm2 ( gen index -- val ) 4073 { gen index } 4074 gen fm2-os1@ gen fm2-os2@ 0.0 0.0 oscil index f* 0.0 oscil 4075 gen fm2-os3@ gen fm2-os4@ 0.0 0.0 oscil index f* 0.0 oscil f+ 0.25 f* 4076; 4077 4078\ ;;; rms gain balance 4079\ ;;; This is a translation of the rmsgain code provided by Fabio Furlanete. 4080 4081hide 4082#( "rmsg-c1" 4083 "rmsg-c2" 4084 "rmsg-q" 4085 "rmsg-r" 4086 "rmsg-avg" 4087 "rmsg-avgc" ) create-struct make-rmsgain-struct 4088set-current 4089 4090: make-rmsgain <{ :optional hp 10.0 -- gen }> 4091 doc" Make RMS gain generator." 4092 2.0 two-pi mus-srate f/ hp f* fcos f- { b } 4093 b b b f* 1.0 f- fsqrt f- { c2 } 4094 1.0 c2 f- { c1 } 4095 make-rmsgain-struct { rmsg } 4096 rmsg c1 rmsg-c1! 4097 rmsg c2 rmsg-c2! 4098 rmsg 0.0 rmsg-q! 4099 rmsg 0.0 rmsg-r! 4100 rmsg 0.0 rmsg-avg! 4101 rmsg 0 rmsg-avgc! 4102 rmsg 4103; 4104 4105: rmsgain-rms ( gen sig -- val ) 4106 doc" Run RMS gain generator." 4107 { gen sig } 4108 gen rmsg-c1@ sig f* sig f* 4109 gen rmsg-c2@ gen rmsg-q@ f* f+ 4110 gen over rmsg-q! 4111 ( val ) fsqrt 4112; 4113 4114: rmsgain-gain ( gen sig rmsval -- val ) 4115 doc" Return current RMS gain." 4116 { gen sig rmsval } 4117 gen rmsg-c1@ sig f* sig f* 4118 gen rmsg-c2@ gen rmsg-r@ f* f+ 4119 gen over rmsg-r! 4120 ( val ) f0= if 4121 rmsval 4122 else 4123 rmsval gen rmsg-r@ fsqrt f/ 4124 then { this-gain } 4125 gen gen rmsg-avg@ this-gain f+ rmsg-avg! 4126 gen gen rmsg-avgc@ 1+ rmsg-avgc! 4127 sig this-gain f* 4128; 4129 4130: rmsgain-balance ( gen sig comp -- val ) 4131 doc" Scale signal based on a RMS gain." 4132 { gen sig comp } 4133 gen sig 4134 gen comp rmsgain-rms 4135 rmsgain-gain 4136; 4137 4138: rmsgain-gain-avg ( gen -- val ) 4139 doc" Is part of the RMS gain stuff." 4140 { gen } 4141 gen rmsg-avg@ gen rmsg-avgc@ f/ 4142; 4143 4144<'> rmsg-avg@ alias rmsgain-avg ( gen -- val ) 4145<'> rmsg-avgc@ alias rmsgain-avgc ( gen -- val ) 4146previous 4147 4148: clm-ins-test <{ :optional start 0.0 dur 1.0 }> 4149 start now! 4150 now@ dur violin-test 4151 now@ dur fm-violin-test 4152 now@ dur pluck-test 4153 now@ dur vox-test 4154 now@ dur fofins-test 4155 now@ dur fm-trumpet-test 4156 now@ dur pqw-vox-test 4157 now@ dur flute-test 4158 now@ dur fm-bell-test 4159 now@ dur fm-insect-test 4160 now@ dur fm-drum-test 4161 now@ dur gong-test 4162 now@ dur attract-test 4163 now@ dur pqw-test 4164 now@ dur tubebell-test 4165 now@ dur wurley-test 4166 now@ dur rhodey-test 4167 now@ dur hammondoid-test 4168 now@ dur metal-test 4169 now@ dur drone/canter-test 4170 now@ dur reson-test 4171 now@ dur cellon-test 4172 now@ dur gran-synth-test 4173 now@ dur touch-tone-test 4174 now@ dur spectra-test 4175 now@ dur two-tab-test 4176 now@ dur lbj-piano-test 4177 now@ dur resflt-test 4178 now@ dur scratch-test 4179 now@ dur pins-test 4180 now@ dur zc-test 4181 now@ dur zn-test 4182 now@ dur za-test 4183 now@ dur clm-expsrc-test 4184 now@ dur exp-snd-test 4185 now@ dur expfil-test 4186 now@ dur graph-eq-test 4187 now@ dur anoi-test 4188 now@ dur fullmix-test 4189 now@ dur bes-fm-test 4190; 4191 4192\ clm-ins.fs ends here 4193