/usr/share/snd/clm-ins.scm is in snd 17.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 | ;;; CLM instruments translated to Snd/Scheme
(provide 'snd-clm-ins.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))
(require snd-env.scm snd-dsp.scm snd-fullmix.scm snd-expandn.scm)
;;; -------- pluck
;;;
;;; The Karplus-Strong algorithm as extended by David Jaffe and Julius Smith -- see
;;; Jaffe and Smith, "Extensions of the Karplus-Strong Plucked-String Algorithm"
;;; CMJ vol 7 no 2 Summer 1983, reprinted in "The Music Machine".
;;; translated from CLM's pluck.ins
(definstrument (pluck start dur freq amp (weighting .5) (lossfact .9))
"(pluck start dur freq amp weighting lossfact) implements the Jaffe-Smith plucked string physical model.
'weighting' is the ratio of the once-delayed to the twice-delayed samples. It defaults to .5=shortest decay.
Anything other than .5 = longer decay. Must be between 0 and less than 1.0.
'lossfact' can be used to shorten decays. Most useful values are between .8 and 1.0. (with-sound () (pluck 0 1 330 .3 .7 .995))"
(define tuneIt
(let ((getOptimumC (lambda (S o p)
(let* ((pa (* (/ 1.0 o)
(atan (* S (sin o))
(- (+ 1.0 (* S (cos o))) S))))
(tmpInt (floor (- p pa)))
(pc (- p pa tmpInt)))
(if (< pc .1)
(do ()
((>= pc .1))
(set! tmpInt (- tmpInt 1))
(set! pc (+ pc 1.0))))
(list tmpInt (/ (- (sin o) (sin (* o pc)))
(sin (+ o (* o pc)))))))))
(lambda (f s1)
(let ((p (/ *clm-srate* f)) ;period as float
(s (if (= s1 0.0) 0.5 s1))
(o (hz->radians f)))
(let ((vals (getOptimumC s o p))
(vals1 (getOptimumC (- 1.0 s) o p)))
(if (and (not (= s 1/2))
(< (abs (cadr vals)) (abs (cadr vals1))))
(list (- 1.0 s) (cadr vals) (car vals))
(list s (cadr vals1) (car vals1))))))))
(let ((vals (tuneIt freq weighting)))
(let ((wt0 (car vals))
(c (cadr vals))
(dlen (caddr vals))
(beg (seconds->samples start))
(end (seconds->samples (+ start dur)))
(lf (if (= lossfact 0.0) 1.0 (min 1.0 lossfact))))
(let ((wt (if (= wt0 0.0) 0.5 (min 1.0 wt0)))
(tab (make-float-vector dlen)))
;; get initial waveform in "tab" -- here we can introduce 0's to simulate different pick
;; positions, and so on -- see the CMJ article for numerous extensions. The normal case
;; is to load it with white noise (between -1 and 1).
(let ((allp (make-one-zero (* lf (- 1.0 wt)) (* lf wt)))
(feedb (make-one-zero c 1.0)) ;or (feedb (make-one-zero 1.0 c))
(c1 (- 1.0 c)))
(do ((i 0 (+ i 1)))
((= i dlen))
(float-vector-set! tab i (mus-random 1.0)))
(do ((i beg (+ i 1))
(ctr 0 (modulo (+ ctr 1) dlen)))
((= i end))
(outa i (* amp (float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp (float-vector-ref tab ctr)))))))))))))
#|
(let ((val (float-vector-ref tab ctr))) ;current output value
(float-vector-set! tab ctr (* c1 (one-zero feedb (one-zero allp val))))
(outa i (* amp val)))))))))
|#
;;; -------- mlbvoi
;;;
;;; translation from MUS10 of Marc LeBrun's waveshaping voice instrument (using FM here)
;;; this version translated (and simplified slightly) from CLM's mlbvoi.ins
(definstrument (vox beg dur freq amp ampfun freqfun freqscl phonemes formant-amps formant-indices (vibscl .1) (deg 0) (pcrev 0))
(define vox-fun
(let ((formants ; formant center frequencies for a male speaker
'((I 390 1990 2550) (E 530 1840 2480) (AE 660 1720 2410)
(UH 520 1190 2390) (A 730 1090 2440) (OW 570 840 2410)
(U 440 1020 2240) (OO 300 870 2240) (ER 490 1350 1690)
(W 300 610 2200) (LL 380 880 2575) (R 420 1300 1600)
(Y 300 2200 3065) (EE 260 3500 3800) (LH 280 1450 1600)
(L 300 1300 3000) (I2 350 2300 3340) (B 200 800 1750)
(D 300 1700 2600) (G 250 1350 2000) (M 280 900 2200)
(N 280 1700 2600) (NG 280 2300 2750) (P 300 800 1750)
(T 200 1700 2600) (K 350 1350 2000) (F 175 900 4400)
(TH 200 1400 2200) (S 200 1300 2500) (SH 200 1800 2000)
(V 175 1100 2400) (THE 200 1600 2200)(Z 200 1300 2500)
(ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400)))
(find-phoneme (lambda (phoneme forms)
(do ((forms forms (cdr forms)))
((eq? phoneme (caar forms))
(cdar forms))))))
(lambda (phons which)
(let ((f1 ())
(len (length phons)))
(do ((i 0 (+ i 2)))
((>= i len))
(set! f1 (cons ((find-phoneme (phons (+ i 1)) formants) which) (cons (phons i) f1))))
(reverse f1)))))
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(car-os (make-oscil 0))
(fs (length formant-amps))
(per-vib (make-triangle-wave :frequency 6 :amplitude (hz->radians (* freq vibscl))))
(ran-vib (make-rand-interp :frequency 20 :amplitude (hz->radians (* freq .5 vibscl))))
(freqf (make-env freqfun :duration dur :scaler (hz->radians (* freqscl freq)) :offset (hz->radians freq))))
(if (and (= fs 3)
(= (channels *output*) 1))
;; optimize the common case
(let ((a0 (make-env ampfun :scaler (* amp (formant-amps 0)) :duration dur))
(a1 (make-env ampfun :scaler (* amp (formant-amps 1)) :duration dur))
(a2 (make-env ampfun :scaler (* amp (formant-amps 2)) :duration dur))
(o0 (make-oscil 0.0))
(o1 (make-oscil 0.0))
(o2 (make-oscil 0.0))
(e0 (make-oscil 0.0))
(e1 (make-oscil 0.0))
(e2 (make-oscil 0.0))
(ind0 (formant-indices 0))
(ind1 (formant-indices 1))
(ind2 (formant-indices 2))
(f0 (make-env (vox-fun phonemes 0) :scaler (hz->radians 1.0) :duration dur))
(f1 (make-env (vox-fun phonemes 1) :scaler (hz->radians 1.0) :duration dur))
(f2 (make-env (vox-fun phonemes 2) :scaler (hz->radians 1.0) :duration dur)))
(do ((i start (+ i 1)))
((= i end))
(let* ((frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(carg (oscil car-os frq))
(frm0 (/ (env f0) frq))
(frm1 (/ (env f1) frq))
(frm2 (/ (env f2) frq)))
(outa i (+
(* (env a0)
(+ (* (even-weight frm0) (oscil e0 (+ (* ind0 carg) (even-multiple frm0 frq))))
(* (odd-weight frm0) (oscil o0 (+ (* ind0 carg) (odd-multiple frm0 frq))))))
(* (env a1)
(+ (* (even-weight frm1) (oscil e1 (+ (* ind1 carg) (even-multiple frm1 frq))))
(* (odd-weight frm1) (oscil o1 (+ (* ind1 carg) (odd-multiple frm1 frq))))))
(* (env a2)
(+ (* (even-weight frm2) (oscil e2 (+ (* ind2 carg) (even-multiple frm2 frq))))
(* (odd-weight frm2) (oscil o2 (+ (* ind2 carg) (odd-multiple frm2 frq)))))))))))
(let ((evens (make-vector fs))
(odds (make-vector fs))
(ampfs (make-vector fs))
(indices (make-float-vector fs))
(frmfs (make-vector fs))
(carrier 0.0)
(frm-int 0)
(rfrq 0.0)
(frm0 0.0)
(frac 0.0)
(fracf 0.0)
(loc (make-locsig deg 1.0 pcrev)))
(do ((i 0 (+ i 1)))
((= i fs))
(set! (evens i) (make-oscil 0))
(set! (odds i) (make-oscil 0))
(set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
(set! (indices i) (formant-indices i))
(set! (frmfs i) (make-env (vox-fun phonemes i) :scaler (hz->radians 1.0) :duration dur)))
(if (= fs 3)
(let ((frmfs0 (frmfs 0)) (frmfs1 (frmfs 1)) (frmfs2 (frmfs 2))
(index0 (indices 0)) (index1 (indices 1)) (index2 (indices 2))
(ampfs0 (ampfs 0)) (ampfs1 (ampfs 1)) (ampfs2 (ampfs 2))
(evens0 (evens 0)) (evens1 (evens 1)) (evens2 (evens 2))
(odds0 (odds 0)) (odds1 (odds 1)) (odds2 (odds 2)))
(do ((i start (+ i 1)))
((= i end))
(set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(set! carrier (oscil car-os rfrq))
(set! frm0 (/ (env frmfs0) rfrq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (+ (* index0 carrier) (* frm-int rfrq)))
(locsig loc i
(* (env ampfs0)
(if (even? frm-int)
(+ (* (- 1.0 frac) (oscil evens0 fracf)) (* frac (oscil odds0 (+ fracf rfrq))))
(+ (* frac (oscil evens0 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds0 fracf))))))
(set! frm0 (/ (env frmfs1) rfrq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (+ (* index1 carrier) (* frm-int rfrq)))
(locsig loc i
(* (env ampfs1)
(if (even? frm-int)
(+ (* (- 1.0 frac) (oscil evens1 fracf)) (* frac (oscil odds1 (+ fracf rfrq))))
(+ (* frac (oscil evens1 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds1 fracf))))))
(set! frm0 (/ (env frmfs2) rfrq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (+ (* index2 carrier) (* frm-int rfrq)))
(locsig loc i
(* (env ampfs2)
(if (even? frm-int)
(+ (* (- 1.0 frac) (oscil evens2 fracf)) (* frac (oscil odds2 (+ fracf rfrq))))
(+ (* frac (oscil evens2 (+ fracf rfrq))) (* (- 1.0 frac) (oscil odds2 fracf))))))))
(do ((i start (+ i 1)))
((= i end))
(set! rfrq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(set! carrier (oscil car-os rfrq)) ; better name: modulator or perhaps perceived-carrier?
(do ((k 0 (+ k 1)))
((= k fs))
(set! frm0 (/ (env (vector-ref frmfs k)) rfrq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (+ (* (float-vector-ref indices k) carrier) (* frm-int rfrq)))
(locsig loc i
(* (env (vector-ref ampfs k))
(if (even? frm-int)
(+ (* (- 1.0 frac) (oscil (vector-ref evens k) fracf))
(* frac (oscil (vector-ref odds k) (+ fracf rfrq))))
(+ (* frac (oscil (vector-ref evens k) (+ fracf rfrq)))
(* (- 1.0 frac) (oscil (vector-ref odds k) fracf)))))))))))))
;;; (with-sound (:statistics #t) (vox 0 2 170 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 E 25 AE 35 ER 65 ER 75 I 100 UH) '(.8 .15 .05) '(.005 .0125 .025) .05 .1))
;;; (with-sound () (vox 0 2 300 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .15 .05) '(.05 .0125 .025) .02 .1))
;;; (with-sound () (vox 0 5 600 .4 '(0 0 25 1 75 1 100 0) '(0 0 5 .5 10 0 100 1) .1 '(0 I 5 OW 10 I 50 AE 100 OO) '(.8 .16 .04) '(.01 .01 .1) .01 .1))
;;; -------- PQWVOX
;;; translation of CLM pqwvox.ins (itself translated from MUS10 of MLB's waveshaping voice instrument (using phase quadrature waveshaping))
(definstrument (pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes)
"(pqw-vox beg dur freq spacing-freq amp ampfun freqfun freqscl phonemes formant-amps formant-shapes) produces
vocal sounds using phase quadrature waveshaping"
(letrec ((vox-fun
(let ((formants '((I 390 1990 2550) (E 530 1840 2480) (AE 660 1720 2410)
(UH 520 1190 2390) (A 730 1090 2440) (OW 570 840 2410)
(U 440 1020 2240) (OO 300 870 2240) (ER 490 1350 1690)
(W 300 610 2200) (LL 380 880 2575) (R 420 1300 1600)
(Y 300 2200 3065) (EE 260 3500 3800) (LH 280 1450 1600)
(L 300 1300 3000) (I2 350 2300 3340) (B 200 800 1750)
(D 300 1700 2600) (G 250 1350 2000) (M 280 900 2200)
(N 280 1700 2600) (NG 280 2300 2750) (P 300 800 1750)
(T 200 1700 2600) (K 350 1350 2000) (F 175 900 4400)
(TH 200 1400 2200) (S 200 1300 2500) (SH 200 1800 2000)
(V 175 1100 2400) (THE 200 1600 2200)(Z 200 1300 2500)
(ZH 175 1800 2000) (ZZ 900 2400 3800) (VV 565 1045 2400))))
;; formant center frequencies for a male speaker
(lambda (phons which newenv)
;; make an envelope from which-th entry of phoneme data referred to by phons
(if (null? phons)
newenv
(vox-fun (cddr phons) which
(append newenv
(list (car phons)
((do ((phoneme (cadr phons))
(form formants (cdr form)))
((eq? (caar form) phoneme)
(cdar form)))
which)))))))))
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(car-sin (make-oscil 0))
(car-cos (make-oscil 0 :initial-phase (/ pi 2.0)))
(frq-ratio (/ spacing-freq freq))
(fs (length formant-amps))
(freqf (make-env freqfun :duration dur :scaler (* freqscl freq) :offset freq))
(per-vib (make-triangle-wave :frequency 6.0 :amplitude (* freq .1)))
(ran-vib (make-rand-interp :frequency 20.0 :amplitude (* freq .05))))
(let ((sin-evens (make-vector fs))
(cos-evens (make-vector fs))
(sin-odds (make-vector fs))
(cos-odds (make-vector fs))
(ampfs (make-vector fs))
(frmfs (make-vector fs))
(sin-coeffs (make-vector fs))
(cos-coeffs (make-vector fs))
(frq 0.0) (rfrq 0.0) (carcos 0.0) (carsin 0.0)
(frac 0.0) (fracf 0.0) (frm0 0.0) (frm-int 0) (fax 0.0) (yfax 0.0))
(do ((i 0 (+ i 1)))
((= i fs))
(let ((shape (normalize-partials (formant-shapes i))))
(set! (sin-evens i) (make-oscil 0))
(set! (sin-odds i) (make-oscil 0))
(set! (cos-evens i) (make-oscil 0 :initial-phase (/ pi 2.0)))
(set! (cos-odds i) (make-oscil 0 :initial-phase (/ pi 2.0)))
(set! (ampfs i) (make-env ampfun :scaler (* amp (formant-amps i)) :duration dur))
(set! (cos-coeffs i) (partials->polynomial shape mus-chebyshev-first-kind))
(set! (sin-coeffs i) (partials->polynomial shape mus-chebyshev-second-kind))
(set! (frmfs i) (make-env (vox-fun phonemes i ()) :duration dur))))
(if (= fs 3) ; unroll the inner loop in the most common case
(let ((frmfs0 (frmfs 0)) (frmfs1 (frmfs 1)) (frmfs2 (frmfs 2))
(ampfs0 (ampfs 0)) (ampfs1 (ampfs 1)) (ampfs2 (ampfs 2))
(sin-evens0 (sin-evens 0)) (sin-evens1 (sin-evens 1)) (sin-evens2 (sin-evens 2))
(sin-odds0 (sin-odds 0)) (sin-odds1 (sin-odds 1)) (sin-odds2 (sin-odds 2))
(cos-evens0 (cos-evens 0)) (cos-evens1 (cos-evens 1)) (cos-evens2 (cos-evens 2))
(cos-odds0 (cos-odds 0)) (cos-odds1 (cos-odds 1)) (cos-odds2 (cos-odds 2))
(cos-coeffs0 (cos-coeffs 0)) (cos-coeffs1 (cos-coeffs 1)) (cos-coeffs2 (cos-coeffs 2))
(sin-coeffs0 (sin-coeffs 0)) (sin-coeffs1 (sin-coeffs 1)) (sin-coeffs2 (sin-coeffs 2)))
(do ((i start (+ i 1)))
((= i end))
(set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(set! rfrq (hz->radians frq))
(set! carsin (oscil car-sin (* rfrq frq-ratio)))
(set! carcos (oscil car-cos (* rfrq frq-ratio)))
(set! frm0 (/ (env frmfs0) frq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (* frm-int rfrq))
(set! fax (polynomial cos-coeffs0 carcos))
(set! yfax (* carsin (polynomial sin-coeffs0 carcos)))
(outa i
(* (env ampfs0)
(if (even? frm-int)
(+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens0 fracf)) (* fax (oscil cos-evens0 fracf))))
(* frac (- (* yfax (oscil sin-odds0 (+ fracf rfrq))) (* fax (oscil cos-odds0 (+ fracf rfrq))))))
(+ (* frac (- (* yfax (oscil sin-evens0 (+ fracf rfrq))) (* fax (oscil cos-evens0 (+ fracf rfrq)))))
(* (- 1.0 frac) (- (* yfax (oscil sin-odds0 fracf)) (* fax (oscil cos-odds0 fracf))))))))
(set! frm0 (/ (env frmfs1) frq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (* frm-int rfrq))
(set! fax (polynomial cos-coeffs1 carcos))
(set! yfax (* carsin (polynomial sin-coeffs1 carcos)))
(outa i
(* (env ampfs1)
(if (even? frm-int)
(+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens1 fracf)) (* fax (oscil cos-evens1 fracf))))
(* frac (- (* yfax (oscil sin-odds1 (+ fracf rfrq))) (* fax (oscil cos-odds1 (+ fracf rfrq))))))
(+ (* frac (- (* yfax (oscil sin-evens1 (+ fracf rfrq))) (* fax (oscil cos-evens1 (+ fracf rfrq)))))
(* (- 1.0 frac) (- (* yfax (oscil sin-odds1 fracf)) (* fax (oscil cos-odds1 fracf))))))))
(set! frm0 (/ (env frmfs2) frq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (* frm-int rfrq))
(set! fax (polynomial cos-coeffs2 carcos))
(set! yfax (* carsin (polynomial sin-coeffs2 carcos)))
(outa i
(* (env ampfs2)
(if (even? frm-int)
(+ (* (- 1.0 frac) (- (* yfax (oscil sin-evens2 fracf)) (* fax (oscil cos-evens2 fracf))))
(* frac (- (* yfax (oscil sin-odds2 (+ fracf rfrq))) (* fax (oscil cos-odds2 (+ fracf rfrq))))))
(+ (* frac (- (* yfax (oscil sin-evens2 (+ fracf rfrq))) (* fax (oscil cos-evens2 (+ fracf rfrq)))))
(* (- 1.0 frac) (- (* yfax (oscil sin-odds2 fracf)) (* fax (oscil cos-odds2 fracf))))))))))
(do ((i start (+ i 1)))
((= i end))
(set! frq (+ (env freqf) (triangle-wave per-vib) (rand-interp ran-vib)))
(set! rfrq (hz->radians frq))
(set! carsin (oscil car-sin (* rfrq frq-ratio)))
(set! carcos (oscil car-cos (* rfrq frq-ratio)))
(do ((k 0 (+ k 1)))
((= k fs))
(set! frm0 (/ (env (vector-ref frmfs k)) frq))
(set! frm-int (floor frm0))
(set! frac (- frm0 frm-int))
(set! fracf (* frm-int rfrq))
(set! fax (polynomial (vector-ref cos-coeffs k) carcos))
(set! yfax (* carsin (polynomial (vector-ref sin-coeffs k) carcos)))
(outa i (* (env (vector-ref ampfs k))
(if (even? frm-int)
(+ (* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-evens k) fracf))
(* fax (oscil (vector-ref cos-evens k) fracf))))
(* frac (- (* yfax (oscil (vector-ref sin-odds k) (+ fracf rfrq)))
(* fax (oscil (vector-ref cos-odds k) (+ fracf rfrq))))))
(+ (* frac (- (* yfax (oscil (vector-ref sin-evens k) (+ fracf rfrq)))
(* fax (oscil (vector-ref cos-evens k) (+ fracf rfrq)))))
(* (- 1.0 frac) (- (* yfax (oscil (vector-ref sin-odds k) fracf))
(* fax (oscil (vector-ref cos-odds k) fracf)))))))))))))))
;;; (with-sound (:statistics #t) (pqw-vox 0 1 300 300 .1 '(0 0 50 1 100 0) '(0 0 100 0) 0 '(0 L 100 L) '(.33 .33 .33) '((1 1 2 .5) (1 .5 2 .5 3 1) (1 1 4 .5))))
;;; (a test to see if the cancellation is working -- sounds like a mosquito)
;;; (with-sound () (pqw-vox 0 2 200 200 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
;;; (with-sound () (pqw-vox 0 2 100 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .1 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 2 .5 3 .2 4 .1) (1 1 3 .1 4 .5))))
;;; (with-sound () (pqw-vox 0 2 200 314 .1 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 UH 100 ER) '(.8 .15 .05) '((1 1 2 .5) (1 1 4 .1) (1 1 2 .1 4 .05))))
;;; (with-sound () (pqw-vox 0 2 100 414 .2 '(0 0 50 1 100 0) '(0 0 100 1) .01 '(0 OW 50 E 100 ER) '(.8 .15 .05) '((1 1 2 .5 3 .1 4 .01) (1 1 4 .1) (1 1 2 .1 4 .05))))
;;; -------- FOF
(definstrument (fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ae '(0 0 25 1 75 1 100 0)) ve)
"(fofins beg dur frq amp vib f0 a0 f1 a1 f2 a2 (ampenv '(0 0 25 1 75 1 100 0)) vibenv) produces FOF
synthesis: (fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)"
(let ((foflen (if (= *clm-srate* 22050) 100 200)))
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(ampf (make-env ae :scaler amp :duration dur))
(vibf (make-env (or ve '(0 1 100 1)) :scaler vib :duration dur))
(frq0 (hz->radians f0))
(frq1 (hz->radians f1))
(frq2 (hz->radians f2))
(vibr (make-oscil 6))
(win-freq (/ (* 2.0 pi) foflen))
(wt0 (make-wave-train :size foflen :frequency frq)))
(let ((foftab (mus-data wt0)))
(do ((i 0 (+ i 1)))
((= i foflen))
(float-vector-set! foftab i (* (+ (* a0 (sin (* i frq0)))
(* a1 (sin (* i frq1)))
(* a2 (sin (* i frq2))))
.5 (- 1.0 (cos (* i win-freq)))))))
(do ((i start (+ i 1)))
((= i end))
(outa i (* (env ampf)
(wave-train wt0 (* (env vibf)
(oscil vibr)))))))))
;;; FM TRUMPET ---------------------------------------------------
;;; Dexter Morrill's FM-trumpet:
;;; from CMJ feb 77 p51
(definstrument (fm-trumpet startime dur
(frq1 250.0)
(frq2 1500.0)
(amp1 0.5)
(amp2 0.1)
(ampatt1 0.03)
(ampdec1 0.35)
(ampatt2 0.03)
(ampdec2 0.3)
(modfrq1 250.0)
(modind11 0.0)
(modind12 2.66)
(modfrq2 250.0)
(modind21 0.0)
(modind22 1.8)
(rvibamp 0.007)
(rvibfrq 125.0)
(vibamp 0.007)
(vibfrq 7.0)
(vibatt 0.6)
(vibdec 0.2)
(frqskw 0.03)
(frqatt 0.06)
(ampenv1 '(0 0 25 1 75 .9 100 0))
(ampenv2 '(0 0 25 1 75 .9 100 0))
(indenv1 '(0 0 25 1 75 .9 100 0))
(indenv2 '(0 0 25 1 75 .9 100 0))
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
(let ((dec-01 (max 75 (* 100 (- 1.0 (/ .01 dur))))))
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(loc (make-locsig degree distance reverb-amount))
(per-vib-f (let ((vibe (stretch-envelope '(0 1 25 .1 75 0 100 0)
25 (min (* 100 (/ vibatt dur)) 45)
75 (max (* 100 (- 1.0 (/ vibdec dur))) 55))))
(make-env vibe :scaler vibamp :duration dur)))
(ran-vib (make-rand-interp :frequency rvibfrq :amplitude rvibamp))
(per-vib (make-oscil vibfrq))
(frq-f (let ((frqe (stretch-envelope '(0 0 25 1 75 1 100 0)
25 (min 25 (* 100 (/ frqatt dur)))
75 dec-01)))
(make-env frqe :scaler frqskw :offset 1.0 :duration dur)))
(ampattpt1 (min 25 (* 100 (/ ampatt1 dur))))
(ampdecpt1 (max 75 (* 100 (- 1.0 (/ ampdec1 dur)))))
(ampattpt2 (min 25 (* 100 (/ ampatt2 dur))))
(ampdecpt2 (max 75 (* 100 (- 1.0 (/ ampdec2 dur))))))
(let ((mod1-f (make-env (stretch-envelope indenv1 25 ampattpt1 75 dec-01)
:scaler (* modfrq1 (- modind12 modind11)) :duration dur))
(mod1 (make-oscil 0.0))
(car1 (make-oscil 0.0))
;; set frequency to zero here because it is handled multiplicatively below
(car1-f (make-env (stretch-envelope ampenv1 25 ampattpt1 75 ampdecpt1)
:scaler amp1 :duration dur))
(mod2-f (make-env (stretch-envelope indenv2 25 ampattpt2 75 dec-01)
:scaler (* modfrq2 (- modind22 modind21)) :duration dur))
(mod2 (make-oscil 0.0))
(car2 (make-oscil 0.0))
(car2-f (make-env (stretch-envelope ampenv2 25 ampattpt2 75 ampdecpt2)
:scaler amp2 :duration dur)))
(do ((i beg (+ i 1)))
((= i end))
(let ((frq-change (hz->radians (* (+ 1.0 (rand-interp ran-vib))
(+ 1.0 (* (env per-vib-f) (oscil per-vib)))
(env frq-f)))))
(locsig loc i (+ (* (env car1-f)
(oscil car1 (* frq-change
(+ frq1 (* (env mod1-f)
(oscil mod1 (* modfrq1 frq-change)))))))
(* (env car2-f)
(oscil car2 (* frq-change
(+ frq2 (* (env mod2-f)
(oscil mod2 (* modfrq2 frq-change)))))))))))))))
;;; -------- STEREO-FLUTE
(definstrument (stereo-flute start dur freq flow
(flow-envelope '(0 1 100 1))
(decay 0.01) ; additional time for instrument to decay
(noise 0.0356)
(embouchure-size 0.5)
(fbk-scl1 0.5) ; these two are crucial for good results
(fbk-scl2 0.55)
(offset-pos 0.764264) ; from 0.0 to 1.0 along the bore
(out-scl 1.0)
(a0 0.7) (b1 -0.3) ; filter coefficients
(vib-rate 5) (vib-amount 0.03)
(ran-rate 5) (ran-amount 0.03))
"(stereo-flute dur freq flow
(flow-envelope '(0 1 100 1)) (decay 0.01)
(noise 0.0356) (embouchure-size 0.5) (fbk-scl1 0.5)
(fbk-scl2 0.55) (offset-pos 0.764264) (out-scl 1.0)
(a0 0.7) (b1 -0.3) (vib-rate 5) (vib-amount 0.03)
(ran-rate 5) (ran-amount 0.03))
is a physical model of a flute:
(stereo-flute 0 1 440 .55 :flow-envelope '(0 0 1 1 2 1 3 0))"
(let ((period-samples (floor (/ *clm-srate* freq))))
(let ((embouchure-samples (floor (* embouchure-size period-samples))))
(let ((current-excitation 0.0)
(current-difference 0.0)
(current-flow 0.0)
(out-sig 0.0)
(tap-sig 0.0)
(previous-out-sig 0.0)
(previous-tap-sig 0.0)
(dc-blocked-a 0.0)
(dc-blocked-b 0.0)
(previous-dc-blocked-a 0.0)
(previous-dc-blocked-b 0.0)
(delay-sig 0.0)
(emb-sig 0.0)
(beg (seconds->samples start))
(end (seconds->samples (+ start dur)))
(flowf (make-env flow-envelope
:scaler flow
:duration (- dur decay)))
(periodic-vibrato (make-oscil vib-rate))
(random-vibrato (make-rand-interp :frequency ran-rate :amplitude ran-amount))
(breath (make-rand :frequency (/ *clm-srate* 2) :amplitude noise))
(embouchure (make-delay embouchure-samples :initial-element 0.0))
(bore (make-delay period-samples))
(offset (floor (* period-samples offset-pos)))
(reflection-lowpass-filter (make-one-pole a0 b1)))
(do ((i beg (+ i 1)))
((= i end))
(set! delay-sig (delay bore out-sig))
(set! emb-sig (delay embouchure current-difference))
(set! current-flow (+ (* vib-amount (oscil periodic-vibrato))
(rand-interp random-vibrato)
(env flowf)))
(set! current-difference
(+ current-flow
(* current-flow (rand breath))
(* fbk-scl1 delay-sig)))
(set! current-excitation (- emb-sig (* emb-sig emb-sig emb-sig)))
(set! out-sig (one-pole reflection-lowpass-filter
(+ current-excitation (* fbk-scl2 delay-sig))))
(set! tap-sig (tap bore offset))
;; NB the DC blocker is not in the cicuit. It is applied to the out-sig
;; but the result is not fed back into the system.
(set! dc-blocked-a (- (+ out-sig (* 0.995 previous-dc-blocked-a)) previous-out-sig))
(set! dc-blocked-b (- (+ tap-sig (* 0.995 previous-dc-blocked-b)) previous-tap-sig))
(outa i (* out-scl dc-blocked-a))
(outb i (* out-scl dc-blocked-b))
(set! previous-out-sig out-sig)
(set! previous-dc-blocked-a dc-blocked-a)
(set! previous-tap-sig tap-sig)
(set! previous-dc-blocked-b dc-blocked-b))))))
;;; -------- FM-BELL
(definstrument (fm-bell startime dur frequency amplitude amp-env index-env index)
"(fm-bell startime dur frequency amplitude amp-env index-env index) mixes in one fm bell note"
(let ((fmInd2 (hz->radians (* 4.0 (- 8.0 (/ frequency 50.0))))))
(let ((beg (seconds->samples startime))
;(len (seconds->samples dur))
(end (seconds->samples (+ startime dur)))
(fmInd1 (hz->radians (* 32.0 frequency)))
(fmInd3 (* fmInd2 0.705 (- 1.4 (/ frequency 250.0))))
(fmInd4 (hz->radians (* 32.0 (- 20 (/ frequency 20)))))
(mod1 (make-oscil (* frequency 2)))
(mod2 (make-oscil (* frequency 1.41)))
(mod3 (make-oscil (* frequency 2.82)))
(mod4 (make-oscil (* frequency 2.4)))
(car1 (make-oscil frequency))
(car2 (make-oscil frequency))
(car3 (make-oscil (* frequency 2.4)))
(indf (make-env (or index-env
'(0 1 2 1.1 25 .75 75 .5 100 .2))
(or index 1.0) dur))
(ampf (make-env (or amp-env
'(0 0 .1 1 10 .6 25 .3 50 .15 90 .1 100 0))
amplitude dur)))
(do ((i beg (+ i 1)))
((= i end))
(let ((fmenv (env indf)))
(outa i (* (env ampf)
(+ (oscil car1 (* fmenv fmInd1 (oscil mod1)))
(* .15 (oscil car2 (* fmenv
(+ (* fmInd2 (oscil mod2))
(* fmInd3
(oscil mod3))))))
(* .15 (oscil car3 (* fmenv
fmInd4
(oscil mod4))))))))))))
;(define fbell '(0 1 2 1.1000 25 .7500 75 .5000 100 .2000 ))
;(define abell '(0 0 .1000 1 10 .6000 25 .3000 50 .1500 90 .1000 100 0 ))
;(fm-bell 0.0 1.0 220.0 .5 abell fbell 1.0)
;;; -------- FM_INSECT
(definstrument (fm-insect startime dur frequency amplitude amp-env
mod-freq mod-skew mod-freq-env mod-index mod-index-env
fm-index fm-ratio
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(loc (make-locsig degree distance reverb-amount))
(carrier (make-oscil frequency))
(fm1-osc (make-oscil mod-freq))
(fm2-osc (make-oscil (* fm-ratio frequency)))
(ampf (make-env amp-env :scaler amplitude :duration dur))
(indf (make-env mod-index-env :scaler (hz->radians mod-index) :duration dur))
(modfrqf (make-env mod-freq-env :scaler (hz->radians mod-skew) :duration dur))
(fm2-amp (hz->radians (* fm-index fm-ratio frequency))))
(do ((i beg (+ i 1)))
((= i end))
(let ((garble-in (* (env indf)
(oscil fm1-osc (env modfrqf)))))
(locsig loc i (* (env ampf)
(oscil carrier (+ (* fm2-amp (oscil fm2-osc garble-in))
garble-in))))))))
#|
(with-sound (:srate 22050)
(let ((locust '(0 0 40 1 95 1 100 .5))
(bug_hi '(0 1 25 .7 75 .78 100 1))
(amp '(0 0 25 1 75 .7 100 0)))
(fm-insect 0 1.699 4142.627 .015 amp 60 -16.707 locust 500.866 bug_hi .346 .500)
(fm-insect 0.195 .233 4126.284 .030 amp 60 -12.142 locust 649.490 bug_hi .407 .500)
(fm-insect 0.217 2.057 3930.258 .045 amp 60 -3.011 locust 562.087 bug_hi .591 .500)
(fm-insect 2.100 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .346 .500)
(fm-insect 3.000 1.500 900.627 .06 amp 40 -16.707 locust 300.866 bug_hi .046 .500)
(fm-insect 3.450 1.500 900.627 .09 amp 40 -16.707 locust 300.866 bug_hi .006 .500)
(fm-insect 3.950 1.500 900.627 .12 amp 40 -10.707 locust 300.866 bug_hi .346 .500)
(fm-insect 4.300 1.500 900.627 .09 amp 40 -20.707 locust 300.866 bug_hi .246 .500)))
|#
;;; -------- FM-DRUM
;;; Jan Mattox's fm drum:
(definstrument (fm-drum start-time duration frequency amplitude index
high (degree 0.0) (distance 1.0) (reverb-amount 0.01))
(let (;; many of the following variables were originally passed as arguments
(casrat (if high 8.525 3.515))
(fmrat (if high 3.414 1.414))
(glsfun '(0 0 25 0 75 1 100 1))
(indxfun '(0 0 5 .014 10 .033 15 .061 20 .099
25 .153 30 .228 35 .332 40 .477
45 .681 50 .964 55 .681 60 .478 65 .332
70 .228 75 .153 80 .099 85 .061
90 .033 95 .0141 100 0))
(indxpt (- 100 (* 100 (/ (- duration .1) duration))))
(ampfun '(0 0 3 .05 5 .2 7 .8 8 .95 10 1.0 12 .95 20 .3 30 .1 100 0))
(atdrpt (* 100 (/ (if high .01 .015) duration))))
(let ((divindxf (stretch-envelope indxfun 50 atdrpt 65 indxpt)))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(glsf (make-env glsfun :scaler (if high (hz->radians 66) 0.0) :duration duration))
(ampf (let ((ampe (stretch-envelope ampfun
10 atdrpt
15 (max (+ atdrpt 1)
(- 100 (* 100 (/ (- duration .2) duration)))))))
(make-env ampe :scaler amplitude :duration duration)))
(indxf (make-env divindxf :scaler (min (hz->radians (* index fmrat frequency)) pi) :duration duration))
(mindxf (make-env divindxf :scaler (min (hz->radians (* index casrat frequency)) pi) :duration duration))
(devf (let ((deve (stretch-envelope ampfun
10 atdrpt
90 (max (+ atdrpt 1)
(- 100 (* 100 (/ (- duration .05) duration)))))))
(make-env deve :scaler (min pi (hz->radians 7000)) :duration duration)))
(loc (make-locsig degree distance reverb-amount))
(rn (make-rand :frequency 7000 :amplitude 1.0))
(carrier (make-oscil frequency))
(fmosc (make-oscil (* frequency fmrat)))
(cascade (make-oscil (* frequency casrat))))
(do ((i beg (+ i 1)))
((= i end))
(let ((gls (env glsf)))
(locsig loc i (* (env ampf)
(oscil carrier
(+ gls
(* (env indxf)
(oscil fmosc
(+ (* gls fmrat)
(* (env mindxf)
(oscil cascade
(+ (* gls casrat)
(* (env devf) (rand rn))))))))))))))))))
#|
(with-sound ()
(fm-drum 0 1.5 55 .3 5 #f)
(fm-drum 2 1.5 66 .3 4 #t))
|#
;;; -------- FM-GONG
;;; Paul Weineke's gong.
(definstrument (gong start-time duration frequency amplitude
(degree 0.0) (distance 1.0) (reverb-amount 0.005))
(let ((mfq1 (* frequency 1.16))
(mfq2 (* frequency 3.14))
(mfq3 (* frequency 1.005)))
(let ((indx01 (hz->radians (* .01 mfq1)))
(indx11 (hz->radians (* .30 mfq1)))
(indx02 (hz->radians (* .01 mfq2)))
(indx12 (hz->radians (* .38 mfq2)))
(indx03 (hz->radians (* .01 mfq3)))
(indx13 (hz->radians (* .50 mfq3)))
(atpt 5)
(atdur (* 100 (/ .002 duration)))
(expf '(0 0 3 1 15 .5 27 .25 50 .1 100 0))
(rise '(0 0 15 .3 30 1.0 75 .5 100 0))
(fmup '(0 0 75 1.0 98 1.0 100 0))
(fmdwn '(0 0 2 1.0 100 0)))
(let ((ampfun (make-env (stretch-envelope expf atpt atdur)
:scaler amplitude :duration duration))
(indxfun1 (make-env fmup :duration duration
:scaler (- indx11 indx01) :offset indx01))
(indxfun2 (make-env fmdwn :duration duration
:scaler (- indx12 indx02) :offset indx02))
(indxfun3 (make-env rise :duration duration
:scaler (- indx13 indx03) :offset indx03))
(loc (make-locsig degree distance reverb-amount))
(carrier (make-oscil frequency))
(mod1 (make-oscil mfq1))
(mod2 (make-oscil mfq2))
(mod3 (make-oscil mfq3))
(beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration))))
(do ((i beg (+ i 1)))
((= i end))
(locsig loc i (* (env ampfun)
(oscil carrier (+ (* (env indxfun1) (oscil mod1))
(* (env indxfun2) (oscil mod2))
(* (env indxfun3) (oscil mod3)))))))))))
;;; (with-sound () (gong 0 3 261.61 .6))
(definstrument (attract beg dur amp c-1) ;c from 1 to 10 or so
;; by James McCartney, from CMJ vol 21 no 3 p 6
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(c c-1) (a .2) (b .2) (dt .04)
(scale (/ (* .5 amp) c-1))
(x -1.0) (y 0.0) (z 0.0))
(do ((i st (+ i 1)))
((= i nd))
(let ((x1 (- x (* dt (+ y z)))))
(set! y (+ y (* dt (+ x (* a y)))))
(set! z (+ z (* dt (- (+ b (* x z)) (* c z)))))
(set! x x1)
(outa i (* scale x))))))
;;; -------- PQW
(definstrument (pqw start dur spacing-freq carrier-freq amplitude ampfun indexfun partials
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
;; phase-quadrature waveshaping used to create asymmetric (i.e. single side-band) spectra.
;; The basic idea here is a variant of sin x sin y - cos x cos y = cos (x + y)
(define (clip-env e)
(do ((x e (cddr x)))
((null? x) e)
(if (> (cadr x) 1.0)
(list-set! x 1 1.0))))
(let ((normalized-partials (normalize-partials partials))
(spacing-cos (make-oscil spacing-freq :initial-phase (/ pi 2.0)))
(spacing-sin (make-oscil spacing-freq))
(carrier-cos (make-oscil carrier-freq :initial-phase (/ pi 2.0)))
(carrier-sin (make-oscil carrier-freq)))
(let ((sin-coeffs (partials->polynomial normalized-partials mus-chebyshev-second-kind))
(cos-coeffs (partials->polynomial normalized-partials mus-chebyshev-first-kind))
(amp-env (make-env ampfun :scaler amplitude :duration dur))
(ind-env (make-env (clip-env indexfun) :duration dur))
(loc (make-locsig degree distance reverb-amount))
(r (/ carrier-freq spacing-freq))
(tr (make-triangle-wave :frequency 5 :amplitude (hz->radians (* .005 spacing-freq))))
(rn (make-rand-interp :frequency 12 :amplitude (hz->radians (* .005 spacing-freq))))
(beg (seconds->samples start))
(end (seconds->samples (+ start dur))))
(do ((i beg (+ i 1)))
((= i end))
(let* ((vib (+ (triangle-wave tr) (rand-interp rn)))
(ax (* (env ind-env) (oscil spacing-cos vib))))
(locsig loc i (* (env amp-env)
(- (* (oscil carrier-sin (* vib r))
(oscil spacing-sin vib)
(polynomial sin-coeffs ax))
(* (oscil carrier-cos (* vib r))
(polynomial cos-coeffs ax))))))))))
;; (with-sound () (pqw 0 .5 200 1000 .2 '(0 0 25 1 100 0) '(0 1 100 0) '(2 .1 3 .3 6 .5)))
;; to see the asymmetric spectrum most clearly, set the index function above to '(0 1 100 1)
;;; taken from Perry Cook's stkv1.tar.Z (Synthesis Toolkit), but I was
;;; in a bit of a hurry and may not have made slavishly accurate translations.
;;; Please let me know of any errors.
(definstrument (tubebell beg dur freq amp (base 32.0))
;; from Perry Cook's TubeBell.cpp
(let ((osc0 (make-oscil (* freq 0.995)))
(osc1 (make-oscil (* freq 1.414 0.995)))
(osc2 (make-oscil (* freq 1.005)))
(osc3 (make-oscil (* freq 1.414)))
(ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5 .707)))
(ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* 2 base) :duration dur :scaler (* .5 amp)))
(ampmod (make-oscil 2.0))
(st (seconds->samples beg))
(nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (+ (* .007 (oscil ampmod)) .993)
(+ (* (env ampenv1) (oscil osc0 (* .203 (oscil osc1))))
(* (env ampenv2) (oscil osc2 (* .144 (oscil osc3))))))))))
(definstrument (wurley beg dur freq amp)
;; from Perry Cook's Wurley.cpp
(let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 4.0)))
(osc2 (make-oscil 510.0))
(osc3 (make-oscil 510.0))
(ampmod (make-oscil 8.0))
(g0 (* .5 amp))
(ampenv (make-env '(0 0 1 1 9 1 10 0) :duration dur))
(indenv (make-env (list 0 0 .001 1 .15 0 (max dur .16) 0) :duration dur :scaler .117))
(resenv (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :duration dur :scaler (* .5 .307 amp)))
(st (seconds->samples beg))
(nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (env ampenv)
(+ 1.0 (* .007 (oscil ampmod)))
(+ (* g0 (oscil osc0 (* .307 (oscil osc1))))
(* (env resenv) (oscil osc2 (* (env indenv) (oscil osc3))))))))))
(definstrument (rhodey beg dur freq amp (base .5))
;; from Perry Cook's Rhodey.cpp
(let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 0.5)))
(osc2 (make-oscil freq))
(osc3 (make-oscil (* freq 15.0)))
(ampenv1 (make-env (list 0 0 .005 1 dur 0) :base base :duration dur :scaler (* amp .5)))
(ampenv2 (make-env (list 0 0 .001 1 dur 0) :base (* base 1.5) :duration dur :scaler (* amp .5)))
(ampenv3 (make-env (list 0 0 .001 1 .25 0 (max dur .26) 0) :base (* base 4) :duration dur :scaler .109))
(st (seconds->samples beg))
(nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (+ (* (env ampenv1) (oscil osc0 (* .535 (oscil osc1))))
(* (env ampenv2) (oscil osc2 (* (env ampenv3) (oscil osc3)))))))))
(definstrument (hammondoid beg dur freq amp)
;; from Perry Cook's BeeThree.cpp
(let ((osc0 (make-oscil (* freq 0.999)))
(osc1 (make-oscil (* freq 1.997)))
(osc2 (make-oscil (* freq 3.006)))
(osc3 (make-oscil (* freq 6.009)))
(ampenv1 (make-env (list 0 0 .005 1 (- dur .008) 1 dur 0) :duration dur))
(ampenv2 (make-env (list 0 0 .005 1 dur 0) :duration dur :scaler (* .5 .75 amp)))
(g0 (* .25 .75 amp))
(g1 (* .25 .75 amp))
(g2 (* .5 amp))
(st (seconds->samples beg))
(nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (+ (* (env ampenv1)
(+ (* g0 (oscil osc0))
(* g1 (oscil osc1))
(* g2 (oscil osc2))))
(* (env ampenv2) (oscil osc3)))))))
(definstrument (metal beg dur freq amp)
;; from Perry Cook's HeavyMtl.cpp
(let ((osc0 (make-oscil freq))
(osc1 (make-oscil (* freq 4.0 0.999)))
(osc2 (make-oscil (* freq 3.0 1.001)))
(osc3 (make-oscil (* freq 0.50 1.002)))
(ampenv0 (make-env (list 0 0 .001 1 (- dur .002) 1 dur 0) :duration dur :scaler (* amp .615)))
(ampenv1 (make-env (list 0 0 .001 1 (- dur .011) 1 dur 0) :duration dur :scaler .202))
(ampenv2 (make-env (list 0 0 .01 1 (- dur .015) 1 dur 0) :duration dur :scaler .574))
(ampenv3 (make-env (list 0 0 .03 1 (- dur .040) 1 dur 0) :duration dur :scaler .116))
(st (seconds->samples beg))
(nd (seconds->samples (+ beg dur))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (env ampenv0)
(oscil osc0
(+ (* (env ampenv1) (oscil osc1 (* (env ampenv2) (oscil osc2))))
(* (env ampenv3) (oscil osc3)))))))))
(definstrument (drone startime dur frequency amp ampfun synth ampat ampdc amtrev deg dis rvibamt rvibfreq)
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(waveform (partials->wave synth))
(amplitude (* amp .25))
(freq (hz->radians frequency)))
(let ((s (make-table-lookup :frequency frequency :wave waveform))
(amp-env (let ((ampe (stretch-envelope ampfun 25 (* 100 (/ ampat dur)) 75 (- 100 (* 100 (/ ampdc dur))))))
(make-env ampe :scaler amplitude :duration dur)))
(ran-vib (make-rand :frequency rvibfreq :amplitude (* rvibamt freq)))
(loc (make-locsig deg dis amtrev)))
(do ((i beg (+ i 1)))
((= i end))
(locsig loc i (* (env amp-env) (table-lookup s (rand ran-vib))))))))
(definstrument (canter beg dur pitch amp-1 deg dis pcrev ampfun ranfun skewfun
skewpc ranpc ranfreq indexfun atdr dcdr
ampfun1 indfun1 fmtfun1
ampfun2 indfun2 fmtfun2
ampfun3 indfun3 fmtfun3
ampfun4 indfun4 fmtfun4)
(let ((amp (* amp-1 .25)) ;pvc's amplitudes in bag.clm are very high (overflows)
(rangetop 910.0)
(rangebot 400.0))
(let ((k (floor (* 100 (log (/ pitch rangebot) (/ rangetop rangebot)))))
(atpt (* 100 (/ atdr dur)))
(dcpt (- 100 (* 100 (/ dcdr dur)))))
(let ((lfmt1 (envelope-interp k fmtfun1))
(lfmt2 (envelope-interp k fmtfun2))
(lfmt3 (envelope-interp k fmtfun3))
(lfmt4 (envelope-interp k fmtfun4))
(dev11 (hz->radians (* (envelope-interp k indfun1) pitch)))
(dev12 (hz->radians (* (envelope-interp k indfun2) pitch)))
(dev13 (hz->radians (* (envelope-interp k indfun3) pitch)))
(dev14 (hz->radians (* (envelope-interp k indfun4) pitch))))
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(dev01 (* dev11 .5))
(dev02 (* dev12 .5))
(dev03 (* dev13 .5))
(dev04 (* dev14 .5))
(harm1 (floor (+ .5 (/ lfmt1 pitch))))
(harm2 (floor (+ .5 (/ lfmt2 pitch))))
(harm3 (floor (+ .5 (/ lfmt3 pitch))))
(harm4 (floor (+ .5 (/ lfmt4 pitch)))))
(let ((lamp1 (* (envelope-interp k ampfun1) amp (- 1 (abs (- harm1 (/ lfmt1 pitch))))))
(lamp2 (* (envelope-interp k ampfun2) amp (- 1 (abs (- harm2 (/ lfmt2 pitch))))))
(lamp3 (* (envelope-interp k ampfun3) amp (- 1 (abs (- harm3 (/ lfmt3 pitch))))))
(lamp4 (* (envelope-interp k ampfun4) amp (- 1 (abs (- harm4 (/ lfmt4 pitch))))))
(tidx-stretched (stretch-envelope indexfun 25 atpt 75 dcpt)))
(let ((tampfun (make-env (stretch-envelope ampfun 25 atpt 75 dcpt) :duration dur))
(tskwfun (make-env (stretch-envelope skewfun 25 atpt 75 dcpt) :scaler (hz->radians (* pitch skewpc)) :duration dur))
(tranfun (make-env (stretch-envelope ranfun 25 atpt 75 dcpt) :duration dur))
(d1env (make-env tidx-stretched :offset dev01 :scaler dev11 :duration dur))
(d2env (make-env tidx-stretched :offset dev02 :scaler dev12 :duration dur))
(d3env (make-env tidx-stretched :offset dev03 :scaler dev13 :duration dur))
(d4env (make-env tidx-stretched :offset dev04 :scaler dev14 :duration dur))
(modgen (make-oscil pitch))
(ranvib (make-rand :frequency ranfreq :amplitude (hz->radians (* ranpc pitch))))
(loc (make-locsig deg dis pcrev))
(gen1 (make-oscil (* pitch harm1)))
(gen2 (make-oscil (* pitch harm2)))
(gen3 (make-oscil (* pitch harm3)))
(gen4 (make-oscil (* pitch harm4))))
(do ((i start (+ i 1)))
((= i end))
(let* ((frqval (+ (env tskwfun) (* (env tranfun) (rand ranvib))))
(modval (oscil modgen frqval)))
(locsig loc i (* (env tampfun)
(+ (* lamp1 (oscil gen1 (* (+ (* (env d1env) modval) frqval) harm1)))
(* lamp2 (oscil gen2 (* (+ (* (env d2env) modval) frqval) harm2)))
(* lamp3 (oscil gen3 (* (+ (* (env d3env) modval) frqval) harm3)))
(* lamp4 (oscil gen4 (* (+ (* (env d4env) modval) frqval) harm4)))))))))))))))
;;; NREV (the most popular Samson box reverb)
(definstrument (nrev (reverb-factor 1.09) (lp-coeff 0.7) (volume 1.0))
;; reverb-factor controls the length of the decay -- it should not exceed (/ 1.0 .823)
;; lp-coeff controls the strength of the low pass filter inserted in the feedback loop
;; output-scale can be used to boost the reverb output
(define (next-prime val)
(do ((val val (+ val 2)))
((or (= val 2)
(and (odd? val)
(do ((i 3 (+ i 2))
(lim (sqrt val)))
((or (= 0 (modulo val i))
(> i lim))
(> i lim)))))
val)))
(let ((srscale (/ *clm-srate* 25641))
(dly-len (list 1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
(chan2 (> (channels *output*) 1))
(chan4 (= (channels *output*) 4)))
(do ((i 0 (+ i 1)))
((= i 15))
(let ((val (floor (* srscale (dly-len i)))))
(if (even? val) (set! val (+ val 1)))
(set! (dly-len i) (next-prime val))))
(let ((len (+ (floor *clm-srate*) (framples *reverb*)))
(comb1 (make-comb (* .822 reverb-factor) (dly-len 0)))
(comb2 (make-comb (* .802 reverb-factor) (dly-len 1)))
(comb3 (make-comb (* .773 reverb-factor) (dly-len 2)))
(comb4 (make-comb (* .753 reverb-factor) (dly-len 3)))
(comb5 (make-comb (* .753 reverb-factor) (dly-len 4)))
(comb6 (make-comb (* .733 reverb-factor) (dly-len 5)))
(low (make-one-pole lp-coeff (- lp-coeff 1.0)))
(allpass1 (make-all-pass -0.700 0.700 (dly-len 6)))
(allpass2 (make-all-pass -0.700 0.700 (dly-len 7)))
(allpass3 (make-all-pass -0.700 0.700 (dly-len 8)))
(allpass4 (make-all-pass -0.700 0.700 (dly-len 9))) ; 10 for quad
(allpass5 (make-all-pass -0.700 0.700 (dly-len 11)))
(allpass6 (and chan2 (make-all-pass -0.700 0.700 (dly-len 12))))
(allpass7 (and chan4 (make-all-pass -0.700 0.700 (dly-len 13))))
(allpass8 (and chan4 (make-all-pass -0.700 0.700 (dly-len 14)))))
(let ((filts (if (not chan2)
(vector allpass5)
(if (not chan4)
(vector allpass5 allpass6)
(vector allpass5 allpass6 allpass7 allpass8))))
(combs (make-comb-bank (vector comb1 comb2 comb3 comb4 comb5 comb6)))
(allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i
(all-pass allpass4
(one-pole low
(all-pass-bank allpasses
(comb-bank combs (* volume (ina i *reverb*))))))))))))
(definstrument (reson startime dur pitch amp numformants indxfun skewfun pcskew skewat skewdc
vibfreq vibpc ranvibfreq ranvibpc degree distance reverb-amount data)
;; data is a list of lists of form '(ampf resonfrq resonamp ampat ampdc dev0 dev1 indxat indxdc)
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(carriers (make-vector numformants))
(modulator (make-oscil pitch))
(ampfs (make-vector numformants))
(indfs (make-vector numformants))
(c-rats (make-vector numformants))
(totalamp 0.0)
(loc (make-locsig degree distance reverb-amount))
(pervib (make-triangle-wave :frequency vibfreq
:amplitude (hz->radians (* vibpc pitch))))
(ranvib (make-rand-interp :frequency ranvibfreq
:amplitude (hz->radians (* ranvibpc pitch))))
(frqf (let ((frqe (stretch-envelope skewfun
25 (* 100 (/ skewat dur))
75 (- 100 (* 100 (/ skewdc dur))))))
(make-env frqe :scaler (hz->radians (* pcskew pitch)) :duration dur))))
;; initialize the "formant" generators
(do ((i 0 (+ i 1)))
((= i numformants))
(set! totalamp (+ totalamp ((data i) 2))))
(do ((i 0 (+ i 1)))
((= i numformants))
(let* ((frmdat (data i))
(freq (cadr frmdat))
(harm (round (/ freq pitch))))
(let ((rfamp (frmdat 2))
(ampat (* 100 (/ (frmdat 3) dur)))
(ampdc (- 100 (* 100 (/ (frmdat 4) dur))))
(dev0 (hz->radians (* (frmdat 5) freq)))
(dev1 (hz->radians (* (frmdat 6) freq)))
(indxat (* 100 (/ (frmdat 7) dur)))
(indxdc (- 100 (* 100 (/ (frmdat 8) dur))))
(ampf (car frmdat))
(rsamp (- 1.0 (abs (- harm (/ freq pitch)))))
(cfq (* pitch harm)))
(if (zero? ampat) (set! ampat 25))
(if (zero? ampdc) (set! ampdc 75))
(if (zero? indxat) (set! indxat 25))
(if (zero? indxdc) (set! indxdc 75))
(set! (indfs i) (make-env (stretch-envelope indxfun 25 indxat 75 indxdc) :duration dur
:scaler (- dev1 dev0) :offset dev0))
(set! (ampfs i) (make-env (stretch-envelope ampf 25 ampat 75 ampdc) :duration dur
:scaler (/ (* rsamp amp rfamp) totalamp)))
(set! (c-rats i) harm)
(set! (carriers i) (make-oscil cfq)))))
(if (= numformants 2)
(let ((e1 (ampfs 0))
(e2 (ampfs 1))
(c1 (carriers 0))
(c2 (carriers 1))
(i1 (indfs 0))
(i2 (indfs 1))
(r1 (c-rats 0))
(r2 (c-rats 1)))
(do ((i beg (+ i 1)))
((= i end))
(let* ((vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
(modsig (oscil modulator vib)))
(locsig loc i (+ (* (env e1)
(oscil c1 (+ (* vib r1)
(* (env i1) modsig))))
(* (env e2)
(oscil c2 (+ (* vib r2)
(* (env i2) modsig)))))))))
(do ((i beg (+ i 1)))
((= i end))
(let* ((outsum 0.0)
(vib (+ (env frqf) (triangle-wave pervib) (rand-interp ranvib)))
(modsig (oscil modulator vib)))
(do ((k 0 (+ k 1)))
((= k numformants))
(set! outsum (+ outsum
(* (env (ampfs k))
(oscil (carriers k)
(+ (* vib (c-rats k))
(* (env (indfs k)) modsig)))))))
(locsig loc i outsum))))))
;; (with-sound (:statistics #t) (reson 0 1.0 440 .1 2 '(0 0 100 1) '(0 0 100 1) .1 .1 .1 5 .01 5 .01 0 1.0 0.01 '(((0 0 100 1) 1200 .5 .1 .1 0 1.0 .1 .1) ((0 1 100 0) 2400 .5 .1 .1 0 1.0 .1 .1))))
;;; STK's feedback-fm instrument named CelloN in Sambox-land
(definstrument (cellon beg dur pitch0 amp ampfun betafun
beta0 beta1 betaat betadc ampat ampdc dis pcrev deg
pitch1 glissfun glissat glissdc
pvibfreq pvibpc pvibfun pvibat pvibdc
rvibfreq rvibpc rvibfun)
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(pit1 (if (zero? pitch1) pitch0 pitch1))
(loc (make-locsig deg dis pcrev))
(carrier (make-oscil pitch0))
(low (make-one-zero .5 -.5))
(fm 0.0)
(fmosc (make-oscil pitch0))
(pvib (make-triangle-wave :frequency pvibfreq :amplitude 1.0))
(rvib (make-rand-interp :frequency rvibfreq :amplitude 1.0))
(ampap (if (> ampat 0.0) (* 100 (/ ampat dur)) 25))
(ampdp (if (> ampdc 0.0) (* 100 (- 1.0 (/ ampdc dur))) 75))
(glsap (if (> glissat 0.0) (* 100 (/ glissat dur)) 25))
(glsdp (if (> glissdc 0.0) (* 100 (- 1.0 (/ glissdc dur))) 75))
(betap (if (> betaat 0.0) (* 100 (/ betaat dur)) 25))
(betdp (if (> betadc 0.0) (* 100 (- 1.0 (/ betadc dur))) 75))
(pvbap (if (> pvibat 0.0) (* 100 (/ pvibat dur)) 25))
(pvbdp (if (> pvibdc 0.0) (* 100 (- 1.0 (/ pvibdc dur))) 75)))
(let ((pvibenv (make-env (stretch-envelope (or pvibfun '(0 1 100 1)) 25 pvbap 75 pvbdp) :duration dur
:scaler (hz->radians (* pvibpc pitch0))))
(rvibenv (make-env (or rvibfun '(0 1 100 1)) :duration dur
:scaler (hz->radians (* rvibpc pitch0))))
(glisenv (make-env (stretch-envelope (or glissfun '(0 0 100 0)) 25 glsap 75 glsdp) :duration dur
:scaler (hz->radians (- pit1 pitch0))))
(amplenv (make-env (stretch-envelope ampfun 25 ampap 75 ampdp) :scaler amp :duration dur))
(betaenv (make-env (stretch-envelope betafun 25 betap 75 betdp) :duration dur
:scaler (- beta1 beta0) :offset beta0)))
(if (and (= pitch0 pitch1)
(or (zero? pvibfreq)
(zero? pvibpc))
(or (zero? rvibfreq)
(zero? rvibpc)))
(do ((i st (+ i 1)))
((= i nd))
(set! fm (one-zero low (* (env betaenv) (oscil fmosc fm))))
(locsig loc i (* (env amplenv) (oscil carrier fm))))
(do ((i st (+ i 1)))
((= i nd))
(let ((vib (+ (* (env pvibenv) (triangle-wave pvib))
(* (env rvibenv) (rand-interp rvib))
(env glisenv))))
(set! fm (one-zero low (* (env betaenv) (oscil fmosc (+ fm vib)))))
(locsig loc i (* (env amplenv)
(oscil carrier (+ fm vib))))))))))
(definstrument (jl-reverb (decay 3.0) (volume 1.0))
(let ((allpass1 (make-all-pass -0.700 0.700 2111))
(allpass2 (make-all-pass -0.700 0.700 673))
(allpass3 (make-all-pass -0.700 0.700 223))
(comb1 (make-comb 0.742 9601))
(comb2 (make-comb 0.733 10007))
(comb3 (make-comb 0.715 10799))
(comb4 (make-comb 0.697 11597))
(outdel1 (make-delay (seconds->samples .013)))
(outdel2 (make-delay (seconds->samples .011)))
(len (floor (+ (* decay *clm-srate*) (length *reverb*)))))
(let ((filts (vector outdel1 outdel2))
(combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
(allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*)))))))))
(definstrument (gran-synth start-time duration audio-freq grain-dur grain-interval amp)
(let ((grain-size (ceiling (* (max grain-dur grain-interval) *clm-srate*))))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(grain-env (make-env '(0 0 25 1 75 1 100 0) :duration grain-dur))
(carrier (make-oscil audio-freq))
(grains (make-wave-train :size grain-size :frequency (/ 1.0 grain-interval))))
(let ((grain (mus-data grains)))
(do ((i 0 (+ i 1)))
((= i grain-size))
(set! (grain i) (* (env grain-env) (oscil carrier)))))
(do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (wave-train grains)))))))
;;; (with-sound () (gran-synth 0 2 100 .0189 .02 .4))
(definstrument (touch-tone start telephone-number)
(let ((touch-tab-1 '(0 697 697 697 770 770 770 852 852 852 941 941 941))
(touch-tab-2 '(0 1209 1336 1477 1209 1336 1477 1209 1336 1477 1209 1336 1477)))
(do ((i 0 (+ i 1)))
((= i (length telephone-number)))
(let ((k (telephone-number i))
(beg (seconds->samples (+ start (* i .4)))))
(let ((end (+ beg (seconds->samples .3)))
(i (if (number? k)
(if (not (= 0 k)) k 11)
(if (eq? k '*) 10 12))))
(let ((frq1 (make-oscil (touch-tab-1 i)))
(frq2 (make-oscil (touch-tab-2 i))))
(do ((j beg (+ j 1)))
((= j end))
(outa j (* 0.1 (+ (oscil frq1)
(oscil frq2)))))))))))
;;; (with-sound () (touch-tone 0.0 '(7 2 3 4 9 7 1)))
;;; I think the dial tone is 350 + 440
;;; http://www.hackfaq.org/telephony/telephone-tone-frequencies.shtml
(definstrument (spectra start-time duration frequency amplitude
(partials '(1 1 2 0.5))
(amp-envelope '(0 0 50 1 100 0))
(vibrato-amplitude 0.005)
(vibrato-speed 5.0)
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(waveform (partials->wave partials))
(freq (hz->radians frequency)))
(let ((s (make-table-lookup :frequency frequency :wave waveform))
(amp-env (make-env amp-envelope :scaler amplitude :duration duration))
(per-vib (make-triangle-wave :frequency vibrato-speed
:amplitude (* vibrato-amplitude freq)))
(loc (make-locsig degree distance reverb-amount))
(ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
:amplitude (* vibrato-amplitude freq))))
(do ((i beg (+ i 1)))
((= i end))
(locsig loc i (* (env amp-env)
(table-lookup s (+ (triangle-wave per-vib)
(rand-interp ran-vib)))))))))
#|
(with-sound (:play #t)
(spectra 0 1 440.0 .1 '(1.0 .4 2.0 .2 3.0 .2 4.0 .1 6.0 .1)
'(0.0 0.0 1.0 1.0 5.0 0.9 12.0 0.5 25.0 0.25 100.0 0.0)))
|#
;;; interpolate between two waveforms (this could be extended to implement all the various
;;; wavetable-based synthesis techniques).
(definstrument (two-tab start-time duration frequency amplitude
(partial-1 '(1.0 1.0 2.0 0.5))
(partial-2 '(1.0 0.0 3.0 1.0))
(amp-envelope '(0 0 50 1 100 0))
(interp-func '(0 1 100 0))
(vibrato-amplitude 0.005)
(vibrato-speed 5.0)
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
(let ((beg (seconds->samples start-time))
(end (seconds->samples (+ start-time duration)))
(waveform-1 (partials->wave partial-1))
(waveform-2 (partials->wave partial-2))
(freq (hz->radians frequency)))
(let ((s-1 (make-table-lookup :frequency frequency :wave waveform-1))
(s-2 (make-table-lookup :frequency frequency :wave waveform-2))
(amp-env (make-env amp-envelope :scaler amplitude :duration duration))
(interp-env (make-env interp-func :duration duration))
(interp-env-1 (make-env interp-func :duration duration :offset 1.0 :scaler -1.0))
(loc (make-locsig degree distance reverb-amount))
(per-vib (make-triangle-wave :frequency vibrato-speed
:amplitude (* vibrato-amplitude freq)))
(ran-vib (make-rand-interp :frequency (+ vibrato-speed 1.0)
:amplitude (* vibrato-amplitude freq))))
(do ((i beg (+ i 1)))
((= i end))
(let ((vib (+ (triangle-wave per-vib) (rand-interp ran-vib))))
(locsig loc i (* (env amp-env)
(+ (* (env interp-env) (table-lookup s-1 vib))
(* (env interp-env-1) (table-lookup s-2 vib))))))))))
(definstrument (lbj-piano begin-time duration frequency amplitude pfreq
(degree 45) (reverb-amount 0) (distance 1))
(define (get-piano-partials freq)
(let ((piano-spectra #((1.97 .0326 2.99 .0086 3.95 .0163 4.97 .0178 5.98 .0177 6.95 .0315 8.02 .0001
8.94 .0076 9.96 .0134 10.99 .0284 11.98 .0229 13.02 .0229 13.89 .0010 15.06 .0090 16.00 .0003
17.08 .0078 18.16 .0064 19.18 .0129 20.21 .0085 21.27 .0225 22.32 .0061 23.41 .0102 24.48 .0005
25.56 .0016 26.64 .0018 27.70 .0113 28.80 .0111 29.91 .0158 31.06 .0093 32.17 .0017 33.32 .0002
34.42 .0018 35.59 .0027 36.74 .0055 37.90 .0037 39.06 .0064 40.25 .0033 41.47 .0014 42.53 .0004
43.89 .0010 45.12 .0039 46.33 .0039 47.64 .0009 48.88 .0016 50.13 .0006 51.37 .0010 52.70 .0002
54.00 .0004 55.30 .0008 56.60 .0025 57.96 .0010 59.30 .0012 60.67 .0011 61.99 .0003 62.86 .0001
64.36 .0005 64.86 .0001 66.26 .0004 67.70 .0006 68.94 .0002 70.10 .0001 70.58 .0002 72.01 .0007
73.53 .0006 75.00 .0002 77.03 .0005 78.00 .0002 79.57 .0006 81.16 .0005 82.70 .0005 84.22 .0003
85.41 .0002 87.46 .0001 90.30 .0001 94.02 .0001 95.26 .0002 109.39 .0003)
(1.98 .0194 2.99 .0210 3.97 .0276 4.96 .0297 5.96 .0158 6.99 .0207 8.01 .0009
9.00 .0101 10.00 .0297 11.01 .0289 12.02 .0211 13.04 .0127 14.07 .0061 15.08 .0174 16.13 .0009
17.12 .0093 18.16 .0117 19.21 .0122 20.29 .0108 21.30 .0077 22.38 .0132 23.46 .0073 24.14 .0002
25.58 .0026 26.69 .0035 27.77 .0053 28.88 .0024 30.08 .0027 31.13 .0075 32.24 .0027 33.36 .0004
34.42 .0004 35.64 .0019 36.78 .0037 38.10 .0009 39.11 .0027 40.32 .0010 41.51 .0013 42.66 .0019
43.87 .0007 45.13 .0017 46.35 .0019 47.65 .0021 48.89 .0014 50.18 .0023 51.42 .0015 52.73 .0002
54.00 .0005 55.34 .0006 56.60 .0010 57.96 .0016 58.86 .0005 59.30 .0004 60.75 .0005 62.22 .0003
63.55 .0005 64.82 .0003 66.24 .0003 67.63 .0011 69.09 .0007 70.52 .0004 72.00 .0005 73.50 .0008
74.95 .0003 77.13 .0013 78.02 .0002 79.48 .0004 82.59 .0004 84.10 .0003)
(2.00 .0313 2.99 .0109 4.00 .0215 5.00 .0242 5.98 .0355 7.01 .0132 8.01 .0009
9.01 .0071 10.00 .0258 11.03 .0221 12.02 .0056 13.06 .0196 14.05 .0160 15.11 .0107 16.11 .0003
17.14 .0111 18.21 .0085 19.23 .0010 20.28 .0048 21.31 .0128 22.36 .0051 23.41 .0041 24.05 .0006
25.54 .0019 26.62 .0028 27.72 .0034 28.82 .0062 29.89 .0039 30.98 .0058 32.08 .0011 33.21 .0002
34.37 .0008 35.46 .0018 36.62 .0036 37.77 .0018 38.92 .0042 40.07 .0037 41.23 .0011 42.67 .0003
43.65 .0018 44.68 .0025 45.99 .0044 47.21 .0051 48.40 .0044 49.67 .0005 50.88 .0019 52.15 .0003
53.42 .0008 54.69 .0010 55.98 .0005 57.26 .0013 58.53 .0027 59.83 .0011 61.21 .0027 62.54 .0003
63.78 .0003 65.20 .0001 66.60 .0006 67.98 .0008 69.37 .0019 70.73 .0007 72.14 .0004 73.62 .0002
74.40 .0003 76.52 .0006 77.97 .0002 79.49 .0004 80.77 .0003 81.00 .0001 82.47 .0005 83.97 .0001
87.27 .0002)
(2.00 .0257 2.99 .0142 3.97 .0202 4.95 .0148 5.95 .0420 6.95 .0037 7.94 .0004
8.94 .0172 9.95 .0191 10.96 .0115 11.97 .0059 12.98 .0140 14.00 .0178 15.03 .0121 16.09 .0002
17.07 .0066 18.08 .0033 19.15 .0022 20.18 .0057 21.22 .0077 22.29 .0037 23.33 .0066 24.97 .0002
25.49 .0019 26.55 .0042 27.61 .0043 28.73 .0038 29.81 .0084 30.91 .0040 32.03 .0025 33.14 .0005
34.26 .0003 35.38 .0019 36.56 .0037 37.68 .0049 38.86 .0036 40.11 .0011 41.28 .0008 42.50 .0004
43.60 .0002 44.74 .0022 45.99 .0050 47.20 .0009 48.40 .0036 49.68 .0004 50.92 .0009 52.17 .0005
53.46 .0007 54.76 .0006 56.06 .0005 57.34 .0011 58.67 .0005 59.95 .0015 61.37 .0008 62.72 .0004
65.42 .0009 66.96 .0003 68.18 .0003 69.78 .0003 71.21 .0004 72.45 .0002 74.22 .0003 75.44 .0001
76.53 .0003 78.31 .0004 79.83 .0003 80.16 .0001 81.33 .0003 82.44 .0001 83.17 .0002 84.81 .0003
85.97 .0003 89.08 .0001 90.70 .0002 92.30 .0002 95.59 .0002 97.22 .0003 98.86 .0001 108.37 .0001
125.54 .0001)
(1.99 .0650 3.03 .0040 4.03 .0059 5.02 .0090 5.97 .0227 6.98 .0050 8.04 .0020
9.00 .0082 9.96 .0078 11.01 .0056 12.01 .0095 13.02 .0050 14.04 .0093 15.08 .0064 16.14 .0017
17.06 .0020 18.10 .0025 19.14 .0023 20.18 .0015 21.24 .0032 22.29 .0029 23.32 .0014 24.37 .0005
25.43 .0030 26.50 .0022 27.60 .0027 28.64 .0024 29.76 .0035 30.81 .0136 31.96 .0025 33.02 .0003
34.13 .0005 35.25 .0007 36.40 .0014 37.51 .0020 38.64 .0012 39.80 .0019 40.97 .0004 42.09 .0003
43.24 .0003 44.48 .0002 45.65 .0024 46.86 .0005 48.07 .0013 49.27 .0008 50.49 .0006 52.95 .0001
54.23 .0005 55.45 .0004 56.73 .0001 58.03 .0003 59.29 .0002 60.59 .0003 62.04 .0002 65.89 .0002
67.23 .0002 68.61 .0002 69.97 .0004 71.36 .0005 85.42 .0001)
(1.98 .0256 2.96 .0158 3.95 .0310 4.94 .0411 5.95 .0238 6.94 .0152 7.93 .0011
8.95 .0185 9.92 .0166 10.93 .0306 11.94 .0258 12.96 .0202 13.97 .0403 14.95 .0228 15.93 .0005
17.01 .0072 18.02 .0034 19.06 .0028 20.08 .0124 21.13 .0137 22.16 .0102 23.19 .0058 23.90 .0013
25.30 .0039 26.36 .0039 27.41 .0025 28.47 .0071 29.64 .0031 30.60 .0027 31.71 .0021 32.84 .0003
33.82 .0002 35.07 .0019 36.09 .0054 37.20 .0038 38.33 .0024 39.47 .0055 40.55 .0016 41.77 .0006
42.95 .0002 43.27 .0018 44.03 .0006 45.25 .0019 46.36 .0033 47.50 .0024 48.87 .0012 50.03 .0016
51.09 .0004 53.52 .0017 54.74 .0012 56.17 .0003 57.40 .0011 58.42 .0020 59.70 .0007 61.29 .0008
62.56 .0003 63.48 .0002 64.83 .0002 66.12 .0012 67.46 .0017 68.81 .0003 69.13 .0003 70.53 .0002
71.84 .0001 73.28 .0002 75.52 .0010 76.96 .0005 77.93 .0003 78.32 .0003 79.73 .0003 81.69 .0002
82.52 .0001 84.01 .0001 84.61 .0002 86.88 .0001 88.36 .0002 89.85 .0002 91.35 .0003 92.86 .0002
93.40 .0001 105.28 .0002 106.22 .0002 107.45 .0001 108.70 .0003 122.08 .0002)
(1.97 .0264 2.97 .0211 3.98 .0234 4.98 .0307 5.96 .0085 6.94 .0140 7.93 .0005
8.96 .0112 9.96 .0209 10.98 .0194 11.98 .0154 12.99 .0274 13.99 .0127 15.01 .0101 15.99 .0002
17.04 .0011 18.08 .0032 19.14 .0028 20.12 .0054 21.20 .0053 22.13 .0028 23.22 .0030 24.32 .0006
25.24 .0004 26.43 .0028 27.53 .0048 28.52 .0039 29.54 .0047 30.73 .0044 31.82 .0007 32.94 .0008
34.04 .0012 35.13 .0018 36.29 .0007 37.35 .0075 38.51 .0045 39.66 .0014 40.90 .0004 41.90 .0002
43.08 .0002 44.24 .0017 45.36 .0013 46.68 .0020 47.79 .0015 48.98 .0010 50.21 .0012 51.34 .0001
53.82 .0003 55.09 .0004 56.23 .0005 57.53 .0004 58.79 .0005 59.30 .0002 60.03 .0002 61.40 .0003
62.84 .0001 66.64 .0001 67.97 .0001 69.33 .0001 70.68 .0001 73.57 .0002 75.76 .0002 76.45 .0001
79.27 .0001 80.44 .0002 81.87 .0002)
(2.00 .0311 2.99 .0086 3.99 .0266 4.97 .0123 5.98 .0235 6.97 .0161 7.97 .0008
8.96 .0088 9.96 .0621 10.99 .0080 11.99 .0034 12.99 .0300 14.03 .0228 15.04 .0105 16.03 .0004
17.06 .0036 18.09 .0094 18.95 .0009 20.17 .0071 21.21 .0161 22.25 .0106 23.28 .0104 24.33 .0008
25.38 .0030 26.46 .0035 27.50 .0026 28.59 .0028 29.66 .0128 30.75 .0139 31.81 .0038 32.93 .0006
34.04 .0004 35.16 .0005 36.25 .0023 37.35 .0012 38.46 .0021 39.59 .0035 40.71 .0006 41.86 .0007
42.42 .0001 43.46 .0003 44.17 .0032 45.29 .0013 46.57 .0004 47.72 .0011 48.79 .0005 50.11 .0005
51.29 .0003 52.47 .0002 53.68 .0004 55.02 .0005 56.18 .0003 57.41 .0003 58.75 .0007 59.33 .0009
60.00 .0004 61.34 .0001 64.97 .0003 65.20 .0002 66.48 .0002 67.83 .0002 68.90 .0003 70.25 .0003
71.59 .0002 73.68 .0001 75.92 .0001 77.08 .0002 78.45 .0002 81.56 .0002 82.99 .0001 88.39 .0001)
( .97 .0059 1.98 .0212 2.99 .0153 3.99 .0227 4.96 .0215 5.97 .0153 6.98 .0085
7.98 .0007 8.97 .0179 9.98 .0512 10.98 .0322 12.00 .0098 13.02 .0186 14.00 .0099 15.05 .0109
15.88 .0011 17.07 .0076 18.11 .0071 19.12 .0045 20.16 .0038 21.23 .0213 22.27 .0332 23.34 .0082
24.34 .0014 25.42 .0024 26.47 .0012 27.54 .0014 28.60 .0024 29.72 .0026 30.10 .0008 31.91 .0021
32.13 .0011 33.02 .0007 34.09 .0014 35.17 .0007 36.27 .0024 37.39 .0029 38.58 .0014 39.65 .0017
40.95 .0012 41.97 .0004 42.43 .0002 43.49 .0001 44.31 .0012 45.42 .0031 46.62 .0017 47.82 .0013
49.14 .0013 50.18 .0010 51.54 .0003 53.90 .0006 55.06 .0010 56.31 .0003 57.63 .0001 59.02 .0003
60.09 .0004 60.35 .0004 61.62 .0009 63.97 .0001 65.19 .0001 65.54 .0002 66.92 .0002 67.94 .0002
69.17 .0003 69.60 .0004 70.88 .0002 72.24 .0002 76.12 .0001 78.94 .0001 81.75 .0001 82.06 .0001
83.53 .0001 90.29 .0002 91.75 .0001 92.09 .0002 93.28 .0001 97.07 .0001)
(1.98 .0159 2.98 .1008 3.98 .0365 4.98 .0133 5.97 .0101 6.97 .0115 7.97 .0007
8.99 .0349 10.01 .0342 11.01 .0236 12.00 .0041 13.02 .0114 14.05 .0137 15.06 .0100 16.05 .0007
17.04 .0009 18.12 .0077 19.15 .0023 20.12 .0017 21.24 .0113 22.26 .0126 23.30 .0093 24.36 .0007
25.43 .0007 26.47 .0009 27.55 .0013 28.59 .0025 29.61 .0010 30.77 .0021 31.86 .0023 32.96 .0003
34.03 .0007 35.06 .0005 36.20 .0006 37.34 .0006 38.36 .0009 39.60 .0016 40.69 .0005 41.77 .0002
42.92 .0002 44.02 .0003 45.24 .0006 46.33 .0004 47.50 .0007 48.71 .0007 49.87 .0002 51.27 .0002
53.42 .0003 55.88 .0003 57.10 .0004 58.34 .0002 59.86 .0003 61.13 .0003 67.18 .0001 68.50 .0001
71.17 .0001 83.91 .0001 90.55 .0001)
( .98 .0099 2.00 .0181 2.99 .0353 3.98 .0285 4.97 .0514 5.96 .0402 6.96 .0015
7.98 .0012 8.98 .0175 9.98 .0264 10.98 .0392 11.98 .0236 13.00 .0153 14.04 .0049 15.00 .0089
16.01 .0001 17.03 .0106 18.03 .0028 19.05 .0024 20.08 .0040 21.11 .0103 22.12 .0104 23.20 .0017
24.19 .0008 25.20 .0007 26.24 .0011 27.36 .0009 27.97 .0030 29.40 .0044 30.37 .0019 31.59 .0017
32.65 .0008 33.59 .0005 34.79 .0009 35.75 .0027 36.88 .0035 37.93 .0039 39.00 .0031 40.08 .0025
41.16 .0010 43.25 .0004 44.52 .0012 45.62 .0023 45.85 .0012 47.00 .0006 47.87 .0008 48.99 .0003
50.48 .0003 51.62 .0001 52.43 .0001 53.56 .0002 54.76 .0002 56.04 .0002 56.68 .0006 57.10 .0003
58.28 .0005 59.47 .0003 59.96 .0002 60.67 .0001 63.08 .0002 64.29 .0002 66.72 .0001 67.97 .0001
68.65 .0001 70.43 .0001 79.38 .0001 80.39 .0001 82.39 .0001)
(1.00 .0765 1.99 .0151 2.99 .0500 3.99 .0197 5.00 .0260 6.00 .0145 6.98 .0128
7.97 .0004 8.98 .0158 9.99 .0265 11.02 .0290 12.02 .0053 13.03 .0242 14.03 .0103 15.06 .0054
16.04 .0006 17.08 .0008 18.10 .0058 19.16 .0011 20.16 .0055 21.18 .0040 22.20 .0019 23.22 .0014
24.05 .0005 25.31 .0019 26.38 .0018 27.44 .0022 28.45 .0024 29.57 .0073 30.58 .0032 31.66 .0071
32.73 .0015 33.85 .0005 34.96 .0003 36.00 .0020 37.11 .0018 38.18 .0055 39.23 .0006 40.33 .0004
41.52 .0003 43.41 .0028 45.05 .0003 45.99 .0002 47.07 .0003 48.52 .0002 49.48 .0003 50.63 .0003
51.81 .0002 54.05 .0002 55.24 .0001 56.62 .0001 57.81 .0004 59.16 .0013 60.23 .0003 66.44 .0001
68.99 .0004 75.49 .0001 87.56 .0004)
( .98 .0629 1.99 .0232 2.98 .0217 4.00 .0396 4.98 .0171 5.97 .0098 6.99 .0167
7.99 .0003 8.98 .0192 9.98 .0266 10.99 .0256 12.01 .0061 13.02 .0135 14.02 .0062 15.05 .0158
16.06 .0018 17.08 .0101 18.09 .0053 19.11 .0074 20.13 .0020 21.17 .0052 22.22 .0077 23.24 .0035
24.00 .0009 25.32 .0016 26.40 .0022 27.43 .0005 28.55 .0026 29.60 .0026 30.65 .0010 31.67 .0019
32.77 .0008 33.81 .0003 34.91 .0003 36.01 .0005 37.11 .0010 38.20 .0014 39.29 .0039 40.43 .0012
41.50 .0006 43.38 .0017 43.75 .0002 44.94 .0005 46.13 .0002 47.11 .0003 48.28 .0005 48.42 .0005
49.44 .0003 50.76 .0004 51.93 .0002 54.15 .0003 55.31 .0005 55.50 .0003 56.98 .0003 57.90 .0004
60.33 .0002 61.39 .0001 61.59 .0001 65.09 .0002 66.34 .0001 68.85 .0001 70.42 .0002 71.72 .0001
73.05 .0003 79.65 .0001 85.28 .0002 93.52 .0001)
(1.02 .0185 1.99 .0525 2.98 .0613 3.99 .0415 4.98 .0109 5.97 .0248 6.99 .0102
7.98 .0005 8.98 .0124 9.99 .0103 10.99 .0124 12.00 .0016 13.01 .0029 14.03 .0211 15.04 .0128
16.07 .0021 17.09 .0009 18.09 .0043 19.14 .0022 20.13 .0016 21.20 .0045 22.21 .0088 23.26 .0046
24.29 .0013 25.35 .0009 26.39 .0028 27.49 .0009 28.51 .0006 29.58 .0012 30.70 .0010 31.74 .0019
32.75 .0002 33.85 .0001 34.95 .0005 36.02 .0003 37.16 .0009 38.25 .0018 39.35 .0008 40.54 .0004
41.61 .0002 43.40 .0004 43.74 .0003 45.05 .0001 46.11 .0003 47.40 .0002 48.36 .0004 49.55 .0004
50.72 .0002 52.00 .0001 55.58 .0002 57.02 .0001 57.98 .0002 59.13 .0003 61.56 .0001 66.56 .0001
87.65 .0002)
(1.00 .0473 1.99 .0506 2.99 .0982 3.99 .0654 5.00 .0196 5.99 .0094 6.99 .0118
7.93 .0001 8.99 .0057 10.01 .0285 11.01 .0142 12.03 .0032 13.03 .0056 14.06 .0064 15.06 .0059
16.11 .0005 17.09 .0033 18.14 .0027 19.15 .0014 20.17 .0010 21.21 .0059 22.26 .0043 23.31 .0031
24.31 .0018 25.33 .0009 26.41 .0005 27.47 .0015 28.53 .0015 29.58 .0041 30.65 .0025 31.73 .0011
32.83 .0010 34.98 .0003 36.07 .0009 37.23 .0001 38.26 .0020 39.41 .0014 40.53 .0005 41.40 .0003
42.80 .0002 43.48 .0028 43.93 .0001 45.03 .0003 46.18 .0007 47.41 .0001 48.57 .0002 49.67 .0001
50.83 .0002 54.39 .0001 55.58 .0002 57.97 .0005 58.11 .0002 59.21 .0001 60.42 .0002 61.66 .0001)
(1.00 .0503 2.00 .0963 2.99 .1304 3.99 .0218 4.98 .0041 5.98 .0292 6.98 .0482
7.99 .0005 8.99 .0280 10.00 .0237 11.00 .0152 12.02 .0036 12.95 .0022 14.06 .0111 15.07 .0196
16.08 .0016 17.11 .0044 18.13 .0073 19.17 .0055 20.19 .0028 21.20 .0012 22.27 .0068 23.30 .0036
24.35 .0012 25.35 .0002 26.46 .0005 27.47 .0005 28.59 .0009 29.65 .0021 30.70 .0020 31.78 .0012
32.89 .0010 35.06 .0005 36.16 .0008 37.27 .0010 38.36 .0010 39.47 .0014 40.58 .0004 41.43 .0007
41.82 .0003 43.48 .0008 44.53 .0001 45.25 .0003 46.43 .0002 47.46 .0002 48.76 .0005 49.95 .0004
50.96 .0002 51.12 .0002 52.33 .0001 54.75 .0001 55.75 .0002 56.90 .0002 58.17 .0002 59.40 .0004
60.62 .0002 65.65 .0001 66.91 .0002 69.91 .0001 71.25 .0002)
(1.00 .1243 1.98 .1611 3.00 .0698 3.98 .0390 5.00 .0138 5.99 .0154 7.01 .0287
8.01 .0014 9.01 .0049 10.00 .0144 11.01 .0055 12.05 .0052 13.01 .0011 14.05 .0118 15.07 .0154
16.12 .0028 17.14 .0061 18.25 .0007 19.22 .0020 20.24 .0011 21.27 .0029 22.30 .0046 23.34 .0049
24.35 .0004 25.45 .0003 26.47 .0007 27.59 .0008 28.16 .0009 29.12 .0002 29.81 .0006 30.81 .0009
31.95 .0004 33.00 .0011 34.12 .0005 35.18 .0003 36.30 .0008 37.38 .0003 38.55 .0003 39.64 .0006
40.77 .0007 41.52 .0006 41.89 .0006 43.04 .0011 43.60 .0009 44.31 .0002 45.68 .0002 46.56 .0003
47.60 .0001 48.83 .0006 50.01 .0003 51.27 .0003 56.04 .0005 57.21 .0003 58.56 .0004 59.83 .0003
61.05 .0001 62.20 .0001 67.37 .0002 76.53 .0001)
( .99 .0222 1.99 .0678 2.99 .0683 4.00 .0191 5.00 .0119 6.01 .0232 6.98 .0336
7.99 .0082 9.01 .0201 10.01 .0189 11.01 .0041 12.01 .0053 13.05 .0154 14.04 .0159 15.06 .0092
16.11 .0038 17.12 .0014 18.15 .0091 19.16 .0006 20.30 .0012 21.25 .0061 22.28 .0099 23.34 .0028
24.38 .0012 25.43 .0016 26.49 .0048 27.55 .0025 28.62 .0015 29.71 .0032 30.78 .0077 31.88 .0011
32.97 .0007 34.08 .0006 35.16 .0008 36.28 .0004 37.41 .0006 38.54 .0005 39.62 .0002 40.80 .0003
41.93 .0001 43.06 .0002 44.21 .0003 45.38 .0002 46.54 .0007 47.78 .0003 48.95 .0004 50.10 .0003
51.37 .0002 53.79 .0003 56.20 .0001 58.71 .0002 66.47 .0003)
(1.01 .0241 1.99 .1011 2.98 .0938 3.98 .0081 4.99 .0062 5.99 .0291 6.99 .0676
7.59 .0004 8.98 .0127 9.99 .0112 10.99 .0142 12.00 .0029 13.02 .0071 14.02 .0184 15.03 .0064
16.07 .0010 17.09 .0011 18.11 .0010 19.15 .0060 20.19 .0019 21.24 .0025 22.29 .0013 23.31 .0050
25.41 .0030 26.50 .0018 27.53 .0006 28.63 .0012 29.66 .0013 30.77 .0020 31.84 .0006 34.04 .0001
35.14 .0001 36.32 .0004 37.41 .0007 38.53 .0007 39.67 .0009 40.85 .0003 45.49 .0002 46.65 .0001
47.81 .0004 49.01 .0002 53.91 .0002 55.14 .0002 57.69 .0002)
(1.00 .0326 2.00 .1066 2.99 .1015 4.00 .0210 4.97 .0170 5.99 .0813 6.98 .0820
7.96 .0011 8.99 .0248 10.03 .0107 11.01 .0126 12.01 .0027 13.01 .0233 14.04 .0151 15.05 .0071
16.04 .0002 17.10 .0061 18.12 .0059 19.15 .0087 20.23 .0005 21.25 .0040 22.30 .0032 23.35 .0004
24.40 .0001 25.45 .0030 26.54 .0022 27.60 .0003 28.70 .0009 29.80 .0029 30.85 .0006 31.97 .0006
34.19 .0004 35.30 .0003 36.43 .0007 37.56 .0005 38.68 .0019 39.88 .0013 41.00 .0003 43.35 .0003
44.51 .0002 45.68 .0006 46.93 .0010 48.11 .0006 49.29 .0003 55.58 .0002)
( .98 .0113 1.99 .0967 3.00 .0719 3.98 .0345 4.98 .0121 6.00 .0621 7.00 .0137
7.98 .0006 9.01 .0314 10.01 .0171 11.02 .0060 12.03 .0024 13.05 .0077 14.07 .0040 15.12 .0032
16.13 .0004 17.15 .0011 18.20 .0028 19.18 .0003 20.26 .0003 21.31 .0025 22.35 .0021 23.39 .0005
25.55 .0002 26.62 .0014 27.70 .0003 28.78 .0005 29.90 .0030 31.01 .0011 32.12 .0005 34.31 .0001
35.50 .0002 36.62 .0002 37.76 .0005 38.85 .0002 40.09 .0004 43.60 .0001 44.73 .0002 46.02 .0002
47.25 .0004 48.44 .0004)
( .99 .0156 1.98 .0846 2.98 .0178 3.98 .0367 4.98 .0448 5.98 .0113 6.99 .0189
8.00 .0011 9.01 .0247 10.02 .0089 11.01 .0184 12.03 .0105 13.00 .0039 14.07 .0116 15.09 .0078
16.13 .0008 17.14 .0064 18.19 .0029 19.22 .0028 20.25 .0017 21.32 .0043 22.37 .0055 23.42 .0034
24.48 .0004 25.54 .0002 26.61 .0017 27.70 .0011 28.80 .0002 29.89 .0019 30.97 .0028 32.09 .0007
34.30 .0002 35.44 .0003 36.55 .0001 37.69 .0004 38.93 .0002 40.05 .0005 41.20 .0005 42.37 .0002
43.54 .0003 44.73 .0001 45.95 .0002 47.16 .0001 48.43 .0005 49.65 .0004 55.90 .0002 59.81 .0004)
(1.01 .0280 2.00 .0708 2.99 .0182 3.99 .0248 4.98 .0245 5.98 .0279 6.98 .0437
7.99 .0065 8.99 .0299 10.00 .0073 10.99 .0011 12.03 .0122 13.03 .0028 14.08 .0044 15.11 .0097
16.15 .0010 17.17 .0025 18.19 .0017 19.24 .0008 20.28 .0040 21.32 .0024 22.38 .0008 23.46 .0032
24.52 .0010 25.59 .0008 26.68 .0009 27.76 .0012 28.88 .0003 29.95 .0005 31.05 .0017 32.14 .0002
33.29 .0003 37.88 .0002 39.03 .0002 40.19 .0004 41.37 .0003 43.74 .0002 46.20 .0001 48.68 .0001
49.93 .0001 51.19 .0002)
(1.00 .0225 1.99 .0921 2.98 .0933 3.99 .0365 4.99 .0100 5.98 .0213 6.98 .0049
7.98 .0041 8.98 .0090 9.99 .0068 11.01 .0040 12.03 .0086 13.02 .0015 14.04 .0071 15.09 .0082
16.14 .0011 17.15 .0014 18.18 .0010 19.26 .0013 20.26 .0005 21.33 .0006 22.36 .0011 23.46 .0016
24.52 .0004 25.59 .0002 26.70 .0006 27.78 .0007 28.87 .0002 30.03 .0008 31.14 .0010 32.24 .0006
33.37 .0002 35.67 .0003 37.99 .0004 39.17 .0004 40.35 .0005 41.53 .0001 46.42 .0001)
(1.00 .0465 1.99 .0976 2.98 .0678 4.00 .0727 4.99 .0305 5.98 .0210 6.98 .0227
8.00 .0085 9.01 .0183 10.02 .0258 11.05 .0003 12.06 .0061 13.05 .0021 14.10 .0089 15.12 .0077
16.16 .0016 17.21 .0061 18.23 .0011 19.29 .0031 20.36 .0031 21.41 .0007 22.48 .0013 23.55 .0020
24.64 .0004 25.74 .0005 26.81 .0006 27.95 .0006 29.03 .0001 30.22 .0010 31.30 .0004 32.48 .0001
33.60 .0002 38.30 .0003)
(1.00 .0674 1.99 .0841 2.98 .0920 3.99 .0328 4.99 .0368 5.98 .0206 6.99 .0246
8.01 .0048 9.01 .0218 10.03 .0155 11.05 .0048 12.06 .0077 13.00 .0020 14.10 .0083 15.15 .0084
16.18 .0015 17.22 .0039 18.27 .0032 19.34 .0026 20.40 .0012 21.47 .0009 22.54 .0008 23.62 .0016
24.71 .0005 25.82 .0004 26.91 .0002 28.03 .0008 29.17 .0002 30.32 .0028 31.45 .0004 32.61 .0005
33.77 .0001 36.14 .0003 37.32 .0002 38.54 .0005 39.75 .0002 42.23 .0002 48.65 .0001)
(1.01 .0423 1.99 .0240 2.98 .0517 4.00 .0493 5.00 .0324 6.00 .0094 6.99 .0449
7.99 .0050 9.00 .0197 10.03 .0132 11.03 .0009 12.07 .0017 13.08 .0023 14.12 .0094 15.16 .0071
16.21 .0020 17.25 .0005 18.30 .0027 19.04 .0004 20.43 .0022 21.51 .0002 22.59 .0006 23.72 .0018
24.80 .0002 25.88 .0002 27.03 .0002 28.09 .0006 29.31 .0002 30.46 .0004 31.61 .0007 32.78 .0005
33.95 .0001 36.34 .0002 37.56 .0001 38.80 .0001 40.02 .0001 44.14 .0001)
(1.00 .0669 1.99 .0909 2.99 .0410 3.98 .0292 4.98 .0259 5.98 .0148 6.98 .0319
7.99 .0076 9.01 .0056 10.02 .0206 11.04 .0032 12.05 .0085 13.08 .0040 14.12 .0037 15.16 .0030
16.20 .0013 17.24 .0021 18.30 .0010 19.36 .0015 20.44 .0013 21.50 .0009 22.60 .0015 23.69 .0014
24.80 .0006 25.87 .0002 27.02 .0006 28.12 .0002 29.28 .0003 30.43 .0002 31.59 .0007 32.79 .0001
35.14 .0001 37.57 .0001 40.03 .0002 41.28 .0004 44.10 .0001)
( .99 .0421 1.99 .1541 2.98 .0596 3.98 .0309 4.98 .0301 5.99 .0103 7.00 .0240
8.01 .0073 9.01 .0222 10.04 .0140 11.05 .0033 12.08 .0045 13.13 .0009 14.13 .0015 15.21 .0026
16.24 .0003 17.30 .0004 18.35 .0010 19.39 .0003 20.50 .0015 21.57 .0003 22.68 .0011 23.80 .0005
24.90 .0008 26.02 .0002 27.16 .0001 28.30 .0006 29.48 .0002 31.81 .0005 33.00 .0003 34.21 .0001
37.89 .0001)
( .99 .0389 2.00 .2095 3.00 .0835 3.99 .0289 5.00 .0578 5.99 .0363 7.01 .0387
8.01 .0056 9.04 .0173 10.05 .0175 11.08 .0053 12.10 .0056 13.15 .0064 14.19 .0036 15.22 .0019
16.29 .0010 17.36 .0017 18.43 .0018 19.51 .0004 20.60 .0011 21.70 .0003 22.82 .0003 23.95 .0001
25.05 .0004 26.17 .0001 28.50 .0003 29.68 .0001 32.07 .0003 33.28 .0004 34.52 .0001)
(1.00 .1238 1.99 .2270 3.00 .0102 3.99 .0181 4.98 .0415 6.00 .0165 7.01 .0314
8.02 .0148 9.04 .0203 10.05 .0088 11.07 .0062 12.11 .0070 13.14 .0054 14.19 .0028 15.24 .0044
16.30 .0029 17.38 .0009 18.45 .0026 19.56 .0003 20.65 .0025 21.74 .0014 22.87 .0013 23.99 .0007
25.15 .0002 27.46 .0004 28.39 .0006 28.65 .0004 29.85 .0001 31.05 .0002 32.27 .0003 33.52 .0002
34.76 .0003)
(1.00 .1054 2.00 .2598 2.99 .0369 3.98 .0523 4.99 .0020 5.99 .0051 7.00 .0268
8.01 .0027 9.04 .0029 10.05 .0081 11.08 .0047 12.12 .0051 13.16 .0091 14.19 .0015 15.27 .0030
16.34 .0017 17.42 .0006 18.51 .0003 19.61 .0007 20.72 .0003 21.84 .0001 22.99 .0010 24.13 .0001
28.44 .0001 30.09 .0001)
( .99 .0919 2.00 .0418 2.99 .0498 3.99 .0135 4.99 .0026 6.00 .0155 7.01 .0340
8.02 .0033 9.04 .0218 10.08 .0084 11.11 .0057 12.15 .0051 13.21 .0043 14.25 .0015 15.31 .0023
16.40 .0008 17.48 .0004 18.59 .0016 19.71 .0010 20.84 .0018 21.98 .0002 23.11 .0013 24.26 .0003
26.67 .0002 29.12 .0002 30.37 .0002 31.62 .0003 32.92 .0001)
( .99 .1174 1.99 .1126 2.99 .0370 3.99 .0159 5.01 .0472 6.01 .0091 7.03 .0211
8.05 .0015 9.07 .0098 10.11 .0038 11.15 .0042 12.20 .0018 13.24 .0041 14.32 .0033 15.41 .0052
16.49 .0001 17.61 .0004 18.71 .0004 19.84 .0004 20.99 .0002 22.14 .0006 23.31 .0006 24.50 .0004
25.70 .0002 28.09 .0002 28.66 .0002 32.00 .0001)
(1.00 .1085 2.00 .1400 2.99 .0173 3.99 .0229 5.00 .0272 6.02 .0077 7.03 .0069
8.04 .0017 9.08 .0045 10.10 .0030 11.15 .0040 12.20 .0007 13.25 .0019 14.32 .0008 15.42 .0024
16.50 .0002 17.59 .0005 18.71 .0003 19.83 .0002 20.98 .0005 23.29 .0008)
(1.00 .0985 2.00 .1440 2.99 .0364 3.99 .0425 5.00 .0190 6.01 .0089 7.03 .0278
8.04 .0006 9.07 .0083 10.10 .0021 11.14 .0050 12.18 .0005 13.26 .0036 14.33 .0005 15.41 .0026
17.62 .0004 18.75 .0004 19.89 .0003 21.04 .0012 22.21 .0002 23.38 .0004 27.04 .0001)
( .99 .1273 2.00 .1311 2.99 .0120 4.00 .0099 5.00 .0235 6.02 .0068 7.03 .0162
8.06 .0009 9.08 .0083 10.12 .0014 11.17 .0050 12.24 .0010 13.29 .0013 14.39 .0022 15.48 .0011
16.59 .0002 17.70 .0003 18.84 .0010 20.00 .0003 21.17 .0003 23.56 .0004 28.79 .0003)
(1.00 .1018 2.00 .1486 3.00 .0165 4.00 .0186 5.01 .0194 6.02 .0045 7.04 .0083
8.06 .0012 9.10 .0066 10.15 .0009 11.19 .0008 12.26 .0011 13.34 .0028 14.45 .0006 15.53 .0009
16.66 .0002 17.79 .0006 18.94 .0005 20.11 .0003 21.29 .0005 22.49 .0003 23.73 .0005 26.22 .0001
27.52 .0001 28.88 .0002)
(1.00 .1889 1.99 .1822 3.00 .0363 4.00 .0047 5.01 .0202 6.03 .0053 7.05 .0114
8.01 .0002 9.13 .0048 10.17 .0010 11.23 .0033 12.30 .0010 13.38 .0006 14.50 .0002 15.62 .0010
20.27 .0001 21.47 .0001)
(1.00 .0522 1.99 .0763 2.99 .0404 4.00 .0139 5.01 .0185 6.01 .0021 7.06 .0045
8.09 .0002 9.11 .0003 10.17 .0006 11.25 .0004 12.32 .0005 13.40 .0003 14.53 .0003 15.65 .0007
16.80 .0001 17.95 .0002 19.14 .0006 20.34 .0002 21.56 .0003)
( .99 .1821 1.99 .0773 3.00 .0125 4.01 .0065 5.01 .0202 6.03 .0071 7.05 .0090
8.08 .0006 9.13 .0008 10.18 .0013 11.25 .0010 12.33 .0012 13.42 .0006 14.54 .0005 15.65 .0004
17.97 .0002 19.15 .0001)
(1.00 .1868 2.00 .0951 3.00 .0147 4.01 .0134 5.02 .0184 6.04 .0132 7.06 .0011
8.11 .0008 9.15 .0010 10.22 .0012 11.30 .0011 12.40 .0003 13.11 .0004 13.49 .0002 14.62 .0003
15.77 .0001)
(1.00 .1933 2.00 .0714 3.00 .0373 4.00 .0108 5.02 .0094 6.02 .0010 7.07 .0022
8.11 .0002 9.16 .0065 10.23 .0015 11.31 .0023 12.40 .0003 13.53 .0014 14.66 .0002 15.81 .0011
18.20 .0002 19.41 .0001)
( .99 .2113 1.99 .0877 3.00 .0492 4.01 .0094 5.02 .0144 6.04 .0103 7.07 .0117
8.12 .0006 9.19 .0019 10.25 .0007 11.35 .0017 12.45 .0010 13.58 .0003 14.74 .0003 15.91 .0003
19.57 .0002)
( .99 .2455 1.99 .0161 3.00 .0215 4.01 .0036 5.03 .0049 6.04 .0012 7.09 .0036
8.14 .0011 9.21 .0009 10.30 .0001 11.40 .0012 12.50 .0001 13.66 .0005 14.84 .0001)
(1.00 .1132 2.00 .0252 3.00 .0292 4.01 .0136 5.03 .0045 6.06 .0022 7.11 .0101
8.17 .0004 9.23 .0010 10.33 .0012 11.44 .0013 12.58 .0011 13.75 .0002 14.93 .0005 16.14 .0002)
(1.00 .1655 2.00 .0445 3.00 .0120 4.00 .0038 5.02 .0015 6.07 .0038 7.11 .0003
8.19 .0002 9.25 .0010 10.36 .0011 11.48 .0005 12.63 .0002 13.79 .0003 16.24 .0002)
( .99 .3637 1.99 .0259 3.01 .0038 4.01 .0057 5.03 .0040 6.07 .0067 7.12 .0014
8.19 .0004 9.27 .0003 10.38 .0002 12.67 .0001)
(1.00 .1193 2.00 .0230 3.00 .0104 4.01 .0084 5.04 .0047 6.08 .0035 7.13 .0041
8.20 .0002 9.29 .0005 10.40 .0005 11.53 .0003 12.70 .0002 13.91 .0002)
(1.00 .0752 2.00 .0497 3.00 .0074 4.02 .0076 5.05 .0053 6.09 .0043 7.15 .0024
8.22 .0001 9.32 .0006 10.45 .0002 11.58 .0001 12.78 .0001 15.22 .0001)
(1.00 .2388 2.00 .0629 3.01 .0159 4.04 .0063 5.07 .0051 6.12 .0045 7.19 .0026
8.29 .0015 9.43 .0001 11.75 .0002)
(1.00 .1919 2.01 .0116 3.01 .0031 4.03 .0090 5.07 .0061 6.13 .0036 7.19 .0013
8.30 .0016 9.13 .0001 10.59 .0002 11.78 .0002)
(1.00 .1296 2.00 .0135 3.01 .0041 4.04 .0045 5.09 .0028 6.14 .0046 7.23 .0007
8.32 .0007 9.50 .0001)
(1.00 .0692 2.00 .0209 3.02 .0025 4.05 .0030 5.09 .0047 6.17 .0022 7.25 .0015
8.36 .0015 9.53 .0010 10.69 .0001 13.40 .0001)
(1.00 .1715 2.00 .0142 3.01 .0024 4.03 .0015 5.07 .0017 6.13 .0018 7.22 .0009
8.33 .0014 9.51 .0007 10.69 .0002)
(1.00 .1555 2.01 .0148 3.02 .0007 4.06 .0006 5.10 .0005 6.16 .0008 7.26 .0009
8.39 .0008 9.58 .0002)
(1.00 .1357 2.00 .0116 3.02 .0026 4.04 .0009 5.09 .0004 6.17 .0005 7.27 .0002
8.40 .0001)
(1.00 .2185 2.01 .0087 3.03 .0018 4.06 .0025 5.11 .0020 6.20 .0012 7.32 .0005
8.46 .0001 9.66 .0003)
(1.00 .2735 2.00 .0038 3.02 .0008 4.06 .0012 5.12 .0008 6.22 .0011 7.35 .0003
8.50 .0002)
(1.00 .1441 1.99 .0062 3.01 .0023 4.05 .0011 5.11 .0012 6.20 .0003 7.33 .0004
8.50 .0001)
(1.00 .0726 2.01 .0293 3.03 .0022 5.14 .0005 6.26 .0011 7.41 .0002 8.63 .0002)
(1.00 .0516 2.00 .0104 3.02 .0029 5.15 .0002 6.27 .0001)
(1.00 .0329 2.00 .0033 3.03 .0013 4.10 .0005 5.19 .0004 6.32 .0002)
(1.00 .0179 1.99 .0012 3.04 .0005 4.10 .0017 5.20 .0005 6.35 .0001)
(1.00 .0334 2.01 .0033 3.04 .0011 4.13 .0003 5.22 .0003)
( .99 .0161 2.01 .0100 3.04 .0020 4.13 .0003)
(1.00 .0475 1.99 .0045 3.03 .0035 4.12 .0011)
(1.00 .0593 2.00 .0014 4.17 .0002)
(1.00 .0249 2.01 .0016)
(1.00 .0242 2.00 .0038 4.19 .0002)
(1.00 .0170 2.02 .0030)
(1.00 .0381 2.00 .0017 3.09 .0002)
(1.00 .0141 2.03 .0005 3.11 .0003 4.26 .0001)
(1.00 .0122 2.03 .0024)
(1.00 .0107 2.07 .0007 3.12 .0004)
(1.00 .0250 2.02 .0026 3.15 .0002)
(1.01 .0092)
(1.01 .0102 2.09 .0005)
(1.00 .0080 2.00 .0005 3.19 .0001)
(1.01 .0298 2.01 .0005)))
(pitch (round (* 12 (log (/ freq 32.703) 2)))))
(piano-spectra pitch)))
(let ((*piano-attack-duration* .04)
(*piano-release-duration* .2))
(define (make-piano-ampfun dur)
(let ((*db-drop-per-second* -10.0))
(let ((releaseAmp (db->linear (* *db-drop-per-second* dur)))
(attackTime (/ (* *piano-attack-duration* 100) dur)))
(list 0 0 (/ attackTime 4) 1.0 attackTime 1.0 100 releaseAmp))))
;; This thing sounds pretty good down low, below middle c or so.
;; The high notes sound pretty rotten--they just don't
;; sparkle; I have a feeling that this is due to the low amplitude of the
;; original data, and the lack of mechanical noise.
;;
;; The only thing you can do to alter the sound of a piano note is to set the
;; pfreq parameter. Pfreq is used to look up the partials. By default, it's
;; set to the requested frequency. Setting it to a neighboring freq is useful
;; when you're repeating notes. Note that there's no nyquist detection;
;; a high freq with a low pfreq, will give you fold over (hmmm...maybe
;; I can get those high notes to sparkle after all).
(if (not (number? pfreq))
(set! pfreq frequency))
(let ((partials (normalize-partials (get-piano-partials pfreq)))
(beg (seconds->samples begin-time))
(newdur (+ duration *piano-attack-duration* *piano-release-duration*)))
(let ((end (+ beg (seconds->samples newdur)))
(env1dur (- newdur *piano-release-duration*))
(siz (floor (/ (length partials) 2))))
(let ((env1samples (+ beg (seconds->samples env1dur)))
(freqs (make-float-vector siz))
(phases (make-float-vector siz))
(alist (make-float-vector siz))
(locs (make-locsig degree distance reverb-amount))
(ampfun1 (make-piano-ampfun env1dur)))
(let ((ampenv1 (make-env ampfun1
:scaler amplitude
:duration env1dur
:base 10000.0))
(ampenv2 (make-env '(0 1 100 0)
:scaler (* amplitude (ampfun1 (- (length ampfun1) 1)))
:duration env1dur
:base 1.0)))
(do ((i 0 (+ i 2))
(j 0 (+ j 1)))
((= i (length partials)))
(set! (alist j) (partials (+ i 1)))
(set! (freqs j) (hz->radians (* (partials i) frequency))))
(let ((obank (make-oscil-bank freqs phases alist #t)))
(do ((i beg (+ i 1)))
((= i env1samples))
(locsig locs i (* (env ampenv1) (oscil-bank obank))))
(do ((i env1samples (+ i 1)))
((= i end))
(locsig locs i (* (env ampenv2) (oscil-bank obank)))))))))))
;;; (with-sound () (lbj-piano 0 3 440.0 .2))
(definstrument (resflt start dur driver
ranfreq noiamp noifun cosamp cosfreq1 cosfreq0 cosnum
ampcosfun freqcosfun
frq1 r1 g1 frq2 r2 g2 frq3 r3 g3
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
;; driver=0 -- use sum of cosines to drive the filter,
;; driver=1 -- use white noise
;; if noise used, ranfreq=frequency of random number generator,
;; noiamp=amplitude thereof,
;; noifun=amplitude envelope on white noise
;; if ncos (i.e. a band-limited pulse train),
;; cosamp=amplitude of pulse train,
;; cosfreq1=top frequency (given freqcosfun) (i.e. pulse frequency)
;; cosfreq0=bottom frequency,
;; cosnum=number of cosines in the pulse,
;; ampcosfun=amplitude envelope on pulse train
;; freqcosfun=frequency envelope on pulse train
;; There are then 3 resonators, centered at frq1, frq2, frq3,
;; with pole-radius r1, r2, and r3 respectively, and
;; with gains of g1, g2, and g3.
(let ((with-noise (= driver 1)))
(let ((beg (seconds->samples start))
(end (seconds->samples (+ start dur)))
(f1 (make-two-pole :radius r1 :frequency frq1))
(f2 (make-two-pole :radius r2 :frequency frq2))
(f3 (make-two-pole :radius r3 :frequency frq3))
(loc (make-locsig degree distance reverb-amount))
(frqf (and (not with-noise)
(make-env freqcosfun :duration dur
:scaler (hz->radians (- cosfreq1 cosfreq0)))))
(ampf (make-env (if with-noise
(values noifun :scaler noiamp)
(values ampcosfun :scaler cosamp))
:duration dur))
(rn (and with-noise
(make-rand :frequency ranfreq)))
(cn (and (not with-noise)
(make-ncos cosfreq0 cosnum))))
(set! (mus-xcoeff f1 0) g1)
(set! (mus-xcoeff f2 0) g2)
(set! (mus-xcoeff f3 0) g3)
(if with-noise
(do ((i beg (+ i 1)))
((= i end))
(let ((input1 (* (env ampf) (rand rn))))
(locsig loc i (+ (two-pole f1 input1)
(two-pole f2 input1)
(two-pole f3 input1)))))
(do ((i beg (+ i 1)))
((= i end))
(let ((input1 (* (env ampf) (ncos cn (env frqf)))))
(locsig loc i (+ (two-pole f1 input1)
(two-pole f2 input1)
(two-pole f3 input1)))))))))
; (with-sound () (resflt 0 1.0 0 0 0 #f .1 200 230 10 '(0 0 50 1 100 0) '(0 0 100 1) 500 .995 .1 1000 .995 .1 2000 .995 .1))
; (with-sound () (resflt 0 1.0 1 10000 .01 '(0 0 50 1 100 0) 0 0 0 0 #f #f 500 .995 .1 1000 .995 .1 2000 .995 .1))
(definstrument (scratch start file src-ratio turnaroundlist)
(let ((f (make-file->sample file))
(beg (seconds->samples start))
(turntable (apply vector turnaroundlist))
(turn-i 1)
(turns (length turnaroundlist)))
(let ((cur-sample (seconds->samples (turntable 0)))
(turn-sample (seconds->samples (turntable 1))))
(let ((func (lambda (dir)
(let ((inval (file->sample f cur-sample)))
(set! cur-sample (+ cur-sample dir))
inval)))
(turning 0)
(last-val 0.0)
(last-val2 0.0)
(rd (make-src :srate src-ratio))
(forwards (> src-ratio 0.0)))
(if (and forwards (< turn-sample cur-sample))
(set! (mus-increment rd) (- src-ratio)))
(do ((i beg (+ i 1)))
((>= turn-i turns))
(let ((val (src rd 0.0 func)))
(if (= turning 0)
(if (and forwards (>= cur-sample turn-sample)) ;; we passed turn point going forwards
(set! turning 1)
(if (and (not forwards) (<= cur-sample turn-sample)) ;; we passed turn point going backwards
(set! turning -1)))
;; wait for an inflection...
(if (or (and (<= last-val2 last-val) (>= last-val val))
(and (>= last-val2 last-val) (<= last-val val)))
(begin
(set! turn-i (+ turn-i 1))
(if (< turn-i turns)
(begin
(set! turn-sample (seconds->samples (turntable turn-i)))
(set! forwards (not forwards))
(set! (mus-increment rd) (- (mus-increment rd)))))
(set! turning 0))))
(set! last-val2 last-val)
(set! last-val val)
(outa i val)))))))
;;; (with-sound () (scratch 0.0 "now.snd" 1.5 '(0.0 .5 .25 1.0)))
;;; spectral modeling (SMS)
(definstrument (pins beg dur file amp
(transposition 1.0) ; this can be used to transpose the sound
(time-scaler 1.0) ; this can make things happen faster (< 1.0)/slower (> 1.0) in the output
(fftsize 256) ; should be a power of 2
;; at 22050 srate, this is ok for sounds above 300Hz or so, below that you need 512 or 1024,
;; at 44100, probably best to double these sizes -- it takes some searching sometimes.
(highest-bin 128) ; how high in fft data should we search for peaks
(max-peaks 16) ; how many spectral peaks to track at the maximum
attack) ; whether to use original attack via time domain splice
;; do the sliding fft shuffle, translate to polar coordinates, find spectral peaks,
;; match with current, do some interesting transformation, resynthesize using oscils
;; All the envelopes are created on the fly. max-peaks is how many of these peaks
;; we are willing to track at any given time.
(let ((max-peaks-1 max-peaks)
(fftsize-1 fftsize)
(highest-bin-1 highest-bin)
(start (seconds->samples beg))
(attack-size (or attack 1)))
(let* ((hop (floor (/ fftsize-1 4)))
(outhop (floor (* time-scaler hop))))
(let ((ifreq (/ 1.0 outhop))
(max-oscils (* 2 max-peaks-1)))
(let ((end (+ start (seconds->samples dur)))
(fil (make-readin file))
(fdr (make-float-vector fftsize-1))
(fdi (make-float-vector fftsize-1))
(window (make-fft-window blackman2-window fftsize-1))
(current-peak-freqs (make-float-vector max-oscils))
(last-peak-freqs (make-float-vector max-oscils))
(current-peak-amps (make-float-vector max-oscils))
(last-peak-amps (make-float-vector max-oscils))
(peak-amps (make-float-vector max-peaks-1))
(peak-freqs (make-float-vector max-peaks-1))
(amps (make-float-vector max-oscils)) ;run-time generated amplitude and frequency envelopes
(rates (make-float-vector max-oscils))
(freqs (make-float-vector max-oscils))
(sweeps (make-float-vector max-oscils))
;; (lowest-magnitude .001)
(ihifreq (hz->radians ifreq))
(fftscale (/ 1.0 fftsize-1 .42323)) ;integrate Blackman-Harris window = .42323*window width and shift by fftsize-1
(fft-mag (/ *clm-srate* fftsize-1))
(furthest-away-accepted .1)
(filptr 0)
(filend 0)
(cur-oscils max-oscils)
(splice-attack (number? attack))
(ramped-attack (make-float-vector attack-size)))
(let ((obank (make-oscil-bank freqs (make-float-vector max-oscils) amps)))
(set! filend (mus-length fil))
(float-vector-scale! window fftscale)
(when splice-attack
(let ((cur-end (+ start attack-size)))
;; my experience in translating SMS, and rumor via Greg Sandell leads me to believe that
;; there is in fact no way to model some attacks successfully in this manner, so this block
;; simply splices the original attack on to the rest of the note. "attack" is the number
;; of samples to include bodily.
(do ((i start (+ i 1)))
((= i cur-end))
(outa i (* amp (readin fil))))
(set! filptr attack_size)
(let ((mult (make-env '(0 1.0 1.0 0.0) :length attack-size)))
(do ((k 0 (+ k 1)))
((= k attack-size))
(float-vector-set! ramped-attack k (* (env mult) (readin fil)))))
(set! start cur-end)))
(when (< start end)
(do ((i start (+ i outhop)))
((>= i end))
(when (<= filptr filend)
;; get next block of data and apply window to it
(set! (mus-location fil) filptr)
(do ((k 0 (+ k 1)))
((= k fftsize-1))
(float-vector-set! fdr k (readin fil)))
(float-vector-multiply! fdr window)
(set! filptr (+ filptr hop))
(fill! fdi 0.0)
;; get the fft
(mus-fft fdr fdi fftsize-1 1)
;; change to polar coordinates (ignoring phases)
(rectangular->magnitudes fdr fdi)
(float-vector-scale! fdr 2.0)
(float-vector-subseq current-peak-freqs 0 max-oscils last-peak-freqs)
(float-vector-subseq current-peak-amps 0 max-oscils last-peak-amps)
(fill! current-peak-amps 0.0)
(fill! peak-amps 0.0)
(let ((peaks 0))
(let ((ra (fdr 0))
(la 0.0)
(ca 0.0))
;; search for current peaks following Xavier Serra's recommendations in
;; "A System for Sound Analysis/Transformation/Synthesis
;; Based on a Deterministic Plus Stochastic Decomposition"
(do ((k 0 (+ k 1)))
((= k highest-bin-1))
(set! la ca)
(set! ca ra)
(set! ra (fdr k))
(unless (or (<= ca 0.001) ; lowest-magnitude
(<= ca ra)
(<= ca la)
(zero? ra)
(zero? la))
;; found a local maximum above the current threshold (its bin number is k-1)
(let ((logla (log la 10.0))
(logca (log ca 10.0))
(logra (log ra 10.0)))
(let ((offset (/ (* .5 (- logla logra)) (+ logla (* -2 logca) logra)))) ; isn't logca always 0?
(let ((amp (expt 10.0 (- logca (* .25 (- logla logra) offset))))
(freq (* fft-mag (+ k offset -1))))
;; (if (not (real? amp)) (format *stderr* "~A ~A ~A -> ~A ~A~%" la ca ra offset amp))
(if (= peaks max-peaks-1)
;; gotta either flush this peak, or find current lowest and flush him
(let ((minp 0)
(minpeak (peak-amps 0)))
(do ((j 1 (+ j 1)))
((= j max-peaks-1))
(if (< (peak-amps j) minpeak)
(begin
(set! minp j)
(set! minpeak (peak-amps j)))))
(if (> amp minpeak)
(begin
(set! (peak-freqs minp) freq)
(set! (peak-amps minp) amp))))
(begin
(set! (peak-freqs peaks) freq)
(set! (peak-amps peaks) amp)
(set! peaks (+ peaks 1))))))))))
;; now we have the current peaks -- match them to the previous set and do something interesting with the result
;; the end results are reflected in the updated values in the rates and sweeps arrays.
;; search for fits between last and current, set rates/sweeps for those found
;; try to go by largest amp first
(do ((k 0 (+ k 1)))
((= k peaks))
(let ((pl (float-vector-peak-and-location peak-amps)))
(let ((maxpk (car pl))
(maxp (cadr pl)))
;; now maxp points to next largest unmatched peak
(if (> maxpk 0.0)
(let ((closestp -1)
(closestamp 10.0)
(current-freq (peak-freqs maxp)))
(let ((icf (/ 1.0 current-freq)))
(do ((j 0 (+ j 1)))
((= j max-peaks-1))
(if (> (last-peak-amps j) 0.0)
(let ((closeness (* icf (abs (- (last-peak-freqs j) current-freq)))))
(if (< closeness closestamp)
(begin
(set! closestamp closeness)
(set! closestp j))))))
(if (< closestamp furthest-away-accepted)
(begin
;; peak-amp is transferred to appropriate current-amp and zeroed,
(set! (current-peak-amps closestp) (peak-amps maxp))
(set! (peak-amps maxp) 0.0)
(set! (current-peak-freqs closestp) current-freq))))))))))
(do ((k 0 (+ k 1)))
((= k max-peaks-1))
(if (> (peak-amps k) 0.0)
;; find a place for a new oscil and start it up
(let ((new-place -1))
(do ((j 0 (+ j 1)))
((or (not (= new-place -1))
(= j max-oscils)))
(if (= (last-peak-amps j) 0.0 (current-peak-amps j))
(set! new-place j)))
(set! (current-peak-amps new-place) (peak-amps k))
(set! (peak-amps k) 0.0)
(set! (current-peak-freqs new-place) (peak-freqs k))
(set! (last-peak-freqs new-place) (peak-freqs k))
(set! (freqs new-place) (hz->radians (* transposition (peak-freqs k)))))))
(set! cur-oscils 0)
(do ((k 0 (+ k 1)))
((= k max-oscils))
(set! (rates k) (* amp ifreq (- (current-peak-amps k) (last-peak-amps k))))
(if (not (and (= (current-peak-amps k) 0.0)
(= (last-peak-amps k) 0.0)))
(set! cur-oscils k))
(set! (sweeps k) (* ihifreq transposition (- (current-peak-freqs k) (last-peak-freqs k)))))
(set! cur-oscils (+ cur-oscils 1))
(set! (mus-length obank) cur-oscils)
(let ((stop (min end (+ i outhop))))
(do ((k i (+ k 1)))
((= k stop))
;; run oscils, update envelopes
(outa k (oscil-bank obank))
(float-vector-add! amps rates)
(float-vector-add! freqs sweeps))))))))))))
;; (with-sound (:statistics #t) (pins 0 2 "oboe.snd" 1.0 :max-peaks 8))
(definstrument (zc time dur freq amp length1 length2 feedback)
(let ((beg (seconds->samples time))
(end (seconds->samples (+ time dur)))
(s (make-pulse-train freq amp))
(d0 (make-comb :size length1 :max-size (+ 1 (max length1 length2)) :scaler feedback))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
(do ((i beg (+ i 1)))
((= i end))
(outa i (comb d0 (pulse-train s) (env zenv))))))
;; (with-sound () (zc 0 3 100 .1 20 100 .95) (zc 3.5 3 100 .1 100 20 .95))
(definstrument (zn time dur freq amp length1 length2 feedforward)
;; notches are spaced at srate/len, feedforward sets depth thereof
;; so sweep of len from 20 to 100 sweeps the notches down from 1000 Hz to ca 200 Hz
;; so we hear our downward glissando beneath the pulses.
(let ((beg (seconds->samples time))
(end (seconds->samples (+ time dur)))
(s (make-pulse-train freq amp))
(d0 (make-notch :size length1 :max-size (+ 1 (max length1 length2)) :scaler feedforward))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
(do ((i beg (+ i 1)))
((= i end))
(outa i (notch d0 (pulse-train s) (env zenv))))))
;;(with-sound () (zn 0 1 100 .1 20 100 .995) (zn 1.5 1 100 .1 100 20 .995))
(definstrument (za time dur freq amp length1 length2 feedback feedforward)
(let ((beg (seconds->samples time))
(end (seconds->samples (+ time dur)))
(s (make-pulse-train freq amp))
(d0 (make-all-pass feedback feedforward :size length1 :max-size (+ 1 (max length1 length2))))
(zenv (make-env '(0 0 1 1) :scaler (- length2 length1) :duration dur)))
(do ((i beg (+ i 1)))
((= i end))
(outa i (all-pass d0 (pulse-train s) (env zenv))))))
;;(with-sound () (za 0 1 100 .1 20 100 .95 .95) (za 1.5 1 100 .1 100 20 .95 .95))
(define* (clm-expsrc beg dur input-file exp-ratio src-ratio amp rev start-in-file)
(let ((stf (floor (* (or start-in-file 0) (srate input-file))))
(two-chans (= (channels input-file) 2 (channels *output*)))
(revit (and *reverb* rev)))
(let ((st (seconds->samples beg))
(exA (make-granulate (make-readin input-file :channel 0 :start stf) :expansion exp-ratio))
(exB (and two-chans (make-granulate (make-readin input-file :channel 1 :start stf) :expansion exp-ratio))))
(let ((srcA (make-src :srate src-ratio
:input (lambda (dir) (granulate exA))))
(srcB (and two-chans (make-src :srate src-ratio
:input (lambda (dir) (granulate exB)))))
(rev-amp (if revit (if two-chans (* rev .5) rev) 0.0))
(nd (seconds->samples (+ beg dur))))
(if revit
(let ((valA 0.0)
(valB 0.0))
(if two-chans
(do ((i st (+ i 1)))
((= i nd))
(set! valA (* amp (src srcA)))
(set! valB (* amp (src srcB)))
(outa i valA)
(outb i valB)
(outa i (* rev-amp (+ valA valB)) *reverb*))
(do ((i st (+ i 1)))
((= i nd))
(set! valA (* amp (src srcA)))
(outa i valA)
(outa i (* rev-amp valA) *reverb*))))
(if two-chans
(do ((i st (+ i 1)))
((= i nd))
(outa i (* amp (src srcA)))
(outb i (* amp (src srcB))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* amp (src srcA))))))))))
;;; (with-sound () (clm-expsrc 0 2.5 "oboe.snd" 2.0 1.0 1.0))
(definstrument (exp-snd file beg dur amp (exp-amt 1.0) (ramp .4) (seglen .15) (sr 1.0) (hop .05) ampenv)
;; granulate with envelopes on the expansion amount, segment envelope shape,
;; segment length, hop length, and input file resampling rate
(let ((max-seg-len (if seglen (if (pair? seglen) (max-envelope seglen) seglen) .15))
(initial-seg-len (if seglen (if (pair? seglen) (cadr seglen) seglen) .15))
(rampdata (if (pair? ramp) ramp (list 0 ramp 1 ramp)))
(max-out-hop (if hop (if (pair? hop) (max-envelope hop) hop) .05))
(initial-out-hop (if hop (if (pair? hop) (cadr hop) hop) .05))
(min-exp-amt (if exp-amt (if (pair? exp-amt) (min-envelope exp-amt) exp-amt) 1.0))
(initial-exp-amt (if exp-amt (if (pair? exp-amt) (cadr exp-amt) exp-amt) 1.0)))
(if (or (<= (min-envelope rampdata) 0.0)
(>= (max-envelope rampdata) 0.5))
(format #t "ramp argument to exp-snd must always be between 0.0 and 0.5: ~A" ramp)
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(f0 (make-readin file 0))
(expenv (make-env (if (pair? exp-amt)
exp-amt
(list 0 exp-amt 1 exp-amt))
:duration dur))
(lenenv (make-env (if (pair? seglen)
seglen
(list 0 seglen 1 seglen))
:scaler *clm-srate* :duration dur))
(scaler-amp (if (> max-seg-len .15) (/ (* 0.6 .15) max-seg-len) 0.6))
(srenv (make-env (if (pair? sr)
sr
(list 0 sr 1 sr))
:duration dur))
(rampenv (make-env rampdata :duration dur))
(initial-ramp-time (if ramp (if (pair? ramp) (cadr ramp) ramp) .4))
(max-in-hop (/ max-out-hop min-exp-amt)))
(let ((max-len (seconds->samples (+ (max max-out-hop max-in-hop) max-seg-len)))
(hopenv (make-env (if (pair? hop)
hop
(list 0 hop 1 hop))
:duration dur))
(ampe (make-env (or ampenv '(0 0 .5 1 1 0)) :scaler amp :duration dur)))
(let ((exA (make-granulate :expansion initial-exp-amt
:input f0
:max-size max-len
:ramp initial-ramp-time
:hop initial-out-hop
:length initial-seg-len
:scaler scaler-amp))
(vol (env ampe)))
(do ((valA0 (* vol (granulate exA)))
(valA1 (* vol (granulate exA)))
(ex-samp 0.0)
(next-samp 0.0)
(i st (+ i 1)))
((= i nd))
(let ((sl (env lenenv))) ;current segment length
;; now we set the granulate generator internal state to reflect all these envelopes
(set! vol (env ampe))
(set! (mus-length exA) (round sl))
(set! (mus-ramp exA) (floor (* sl (env rampenv))))) ;current ramp length (0 to .5)
(set! (mus-frequency exA) (env hopenv)) ;current hop size
(set! (mus-increment exA) (env expenv)) ;current expansion amount
(set! next-samp (+ next-samp (env srenv))) ;current resampling increment
(if (> next-samp (+ 1 ex-samp))
(let ((samps (floor (- next-samp ex-samp))))
(if (> samps 2)
(do ((k 0 (+ k 1)))
((= k (- samps 2)))
(granulate exA)))
(set! valA0 (if (>= samps 2)
(* vol (granulate exA))
(set! valA0 valA1)))
(set! valA1 (* vol (granulate exA)))
(set! ex-samp (+ ex-samp samps))))
(outa i (if (= next-samp ex-samp)
valA0
(+ valA0 (* (- next-samp ex-samp) (- valA1 valA0))))))))))))
;;; (with-sound (:statistics #t) (exp-snd "fyow.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.05))
;;; (with-sound () (exp-snd "oboe.snd" 0 3 1 '(0 1 1 3) 0.4 .15 '(0 2 1 .5) 0.2))
(defgenerator grn
(rampval 0.0)
(rampinc 0.0)
(loc 0)
(segctr 0)
(whichseg 0)
(ramplen 0)
(steadylen 0)
(trigger 0)
file)
(definstrument (expfil start duration hopsecs rampsecs steadysecs file1 file2)
(let ((fil1 (make-file->sample file1))
(fil2 (make-file->sample file2))
(hop (seconds->samples hopsecs))
(rampdur (seconds->samples rampsecs))
(steadydur (seconds->samples steadysecs))
(beg (seconds->samples start))
(end (seconds->samples (+ start duration))))
(let ((grn1 (make-grn :rampval 0.0 :rampinc (/ 1.0 rampdur) :loc 0 :segctr 0 :whichseg 0 :ramplen rampdur :steadylen steadydur :trigger 0 :file fil1))
(grn2 (make-grn :rampval 0.0 :rampinc (/ 1.0 rampdur) :loc 0 :segctr 0 :whichseg 0 :ramplen rampdur :steadylen steadydur :trigger 0 :file fil2))
(out1 beg)
(out2 (+ hop beg)))
(do ((i beg (+ i 1))
(val 0.0 0.0))
((= i end))
(when (= i out1)
(set! val (with-let grn1
(let ((inval (ina loc file)))
(set! loc (+ loc 1))
(case whichseg
((0) ;ramp-up
(set! inval (* inval rampval))
(set! rampval (+ rampval rampinc))
(set! segctr (+ segctr 1))
(if (= segctr ramplen)
(begin
(set! segctr 0)
(set! whichseg (+ whichseg 1)))))
((1) ;steady-state
(set! segctr (+ segctr 1))
(if (= segctr steadylen)
(begin
(set! segctr 0)
(set! whichseg (+ whichseg 1)))))
(else ;ramp-down
(set! inval (* inval rampval))
(set! segctr (+ segctr 1))
(set! rampval (- rampval rampinc))
(if (= segctr ramplen)
(begin
(set! segctr 0)
(set! trigger 1)
(set! whichseg 0)
(set! rampval 0.0)))))
inval)))
(set! out1 (+ out1 1))
(if (= (grn1 'trigger) 1)
(begin
(set! (grn1 'trigger) 0)
(set! out1 (+ out1 hop)))))
(when (= i out2)
(set! val (+ val (with-let grn2
(let ((inval (ina loc file)))
(set! loc (+ loc 1))
(case whichseg
((0) ;ramp-up
(set! inval (* inval rampval))
(set! rampval (+ rampval rampinc))
(set! segctr (+ segctr 1))
(if (= segctr ramplen)
(begin
(set! segctr 0)
(set! whichseg (+ whichseg 1)))))
((1) ;steady-state
(set! segctr (+ segctr 1))
(if (= segctr steadylen)
(begin
(set! segctr 0)
(set! whichseg (+ whichseg 1)))))
(else ;ramp-down
(set! inval (* inval rampval))
(set! segctr (+ segctr 1))
(set! rampval (- rampval rampinc))
(if (= segctr ramplen)
(begin
(set! segctr 0)
(set! trigger 1)
(set! whichseg 0)
(set! rampval 0.0)))))
inval))))
(set! out2 (+ out2 1))
(if (= (grn2 'trigger) 1)
(begin
(set! (grn2 'trigger) 0)
(set! out2 (+ out2 hop)))))
(outa i val)))))
;;; (with-sound () (expfil 0 2 .2 .01 .1 "oboe.snd" "fyow.snd"))
#|
From: Marco Trevisani <marco@ccrma.Stanford.EDU>
This should work like a Graphic Equalizer....
Very easy to use. Just some note:
"amp" & "amp-env" apply an enveloppe to the final result of the
filtering.
"dur" as ""standard"" in my instruments, when dur = 0 it will take the length of the
sndfile input, otherwise the duration in seconds.
"gain-freq-list" is a list of gains and frequencies to
filter --in this order gain and frequencies--. There is no limit to
the size of the list. Gain can be a number or an
envelope. Unfortunatelly in this version they can't alternate, one
should chose, all envelopes or all numbers i.e.:
case 1 -> '( .1 440.0 .3 1500.0 .2 330.0 ...etc) or
case 2 -> '((0 .1 1 .5) 440.0 (0 1 1 .01) 1500 (0 .3 1 .5) 330.0 ...etc)
'( .1 440.0 (0 1 1 .01) 1500 ..etc) <<< again, this is not allowed ..
"offset-gain" This apply to all the gains if case 1. It adds or
subtracts an offset to all the gains in the list. This number can be positive or
negative. In case the result is a negative number --let's say offset =
-.4 and, like in case 1, the first gain is .1, the result would be
-.3 -- the instrument will pass a gain equal to 0.
"filt-gain-scale" & "filt-gain-base" will apply to the elements of the
envelopes if we are in case 2, gains are envelopes.
"stats" if #t --default-- prints the number of seconds processed, if
nil doesnt print anything, which will speed up a bit the process.
|#
(definstrument (graphEq file (beg 0) (dur 0) (or-beg 0) (amp 1) (amp-env '(0 1 .8 1 1 0)) (amp-base 1)
(offset-gain 0)
(gain-freq-list '(.8 440 .2 660))
(filt-gain-scale 1)
(filt-gain-base 1)
(a1 .99))
(let ((st (seconds->samples beg))
(durata (if (= 0 dur) (mus-sound-duration file) dur))
(or-start (round (* or-beg (srate file))))
(gain-list (let ((lst ())
(len (length gain-freq-list)))
(do ((i (- len 2) (- i 2)))
((< i 0))
(set! lst (cons (gain-freq-list i) lst)))
lst))
(freq-list (let ((lst ())
(len (length gain-freq-list)))
(do ((i (- len 1) (- i 2)))
((<= i 0))
(set! lst (cons (gain-freq-list i) lst)))
lst)))
(let ((nd (+ st (seconds->samples durata)))
(RdA (make-readin :file file :start or-start))
(half-list (/ (length gain-freq-list) 2))
(ampenv (make-env amp-env :scaler amp :duration durata :base amp-base))
(env-size (and (pair? (car gain-list))
(make-vector (length freq-list))))
(if-list-in-gain (pair? (car gain-list)))
(frm-size (make-vector (length freq-list)))
(gains (make-float-vector (length freq-list) 1.0))
(filt-scl (* filt-gain-scale (- 1.0 a1))))
(do ((k 0 (+ k 1)))
((= k half-list))
(let ((gval (gain-list k))
(fval (freq-list k)))
(if (pair? gval)
(begin
(set! (env-size k) (make-env gval
:scaler filt-scl
:duration durata :base filt-gain-base))
(set! (frm-size k) (make-formant fval a1)))
(begin
(set! (frm-size k) (make-formant fval a1))
(set! (gains k) (max 0 (+ offset-gain gval)))))))
(set! frm-size (make-formant-bank frm-size gains))
(if if-list-in-gain
(do ((i st (+ i 1)))
((= i nd))
(do ((k 0 (+ k 1)))
((= k half-list))
(float-vector-set! gains k (env (vector-ref env-size k))))
(outa i (* (env ampenv) (formant-bank frm-size (readin RdA)))))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (env ampenv) (formant-bank frm-size (readin RdA)))))))))
(definstrument (anoi infile start dur (fftsize 128) (amp-scaler 1.0) rr)
;; a kind of noise reduction -- on-going average spectrum is squelched to some extent
;; obviously aimed at intermittent signal in background noise
;; this is based on Perry Cook's Scrubber.m
(let ((r (or rr (* 2.0 pi)))
(freq-inc (floor (/ fftsize 2)))
(fdi (make-float-vector fftsize))
(fdr (make-float-vector fftsize)))
(let ((spectr (make-vector freq-inc 1.0))
(scales (make-float-vector freq-inc 1.0))
(diffs (make-float-vector freq-inc))
(win (make-fft-window blackman2-window fftsize))
(incr (/ (* amp-scaler 4) *clm-srate*))
(beg (seconds->samples start))
(end (seconds->samples (+ start dur)))
(file (make-file->sample infile))
(fs (make-vector freq-inc)))
(let ((bin (/ *clm-srate* fftsize))
(radius (- 1.0 (/ r fftsize))))
(do ((ctr 0 (+ ctr 1)))
((= ctr freq-inc))
(set! (fs ctr) (make-formant (* ctr bin) radius))))
(set! fs (make-formant-bank fs scales))
(set! (scales 0) 0.0)
(do ((k 0)
(amp 0.0)
(samp 0)
(fdrc 0.0)
(i beg (+ i 1)))
((= i end))
(let ((inval (file->sample file samp)))
(set! samp (+ samp 1))
(set! (fdr k) inval)
(set! k (+ k 1))
(if (< amp amp-scaler) (set! amp (+ amp incr)))
(if (>= k fftsize)
(begin
(set! k 0)
(spectrum fdr fdi win 1)
(do ((ctr 0 (+ ctr 1)))
((= ctr freq-inc))
(set! fdrc (fdr ctr))
(set! (spectr ctr) (+ (* .9 (spectr ctr)) (* .1 fdrc)))
(set! (diffs ctr) (if (>= (spectr ctr) fdrc)
(/ (scales ctr) (- fftsize))
(/ (- (/ (- fdrc (spectr ctr)) fdrc)
(scales ctr))
fftsize))))))
(outa i (* amp (formant-bank fs inval)))
(float-vector-add! scales diffs))))))
#|
Date: Fri, 25 Sep 1998 09:56:41 +0300
From: Matti Koskinen <mjkoskin@sci.fi>
To: linux-audio-dev@ginette.musique.umontreal.ca
Subject: [linux-audio-dev] Announce: alpha version of denoising
[...]
I wrote a simple denoiser called anoi after it's parent
clm-instrument anoi.ins.
anoi tries to remove white noise like tape hiss from wav-
files. Removing of noise succeeds ok, but depending of the
original sound, some distortion can be audible.
If someone is interested, http://www.sci.fi/~mjkoskin
contains tarred and gzipped file.
Now only monophonic wav-files can be denoised, but adding
others isn't too difficult.
-matti
mjkoskin@sci.fi
|#
;;; bes-fm -- can also use bes-j0 here as in earlier versions
(define bes-fm
(let ((documentation "(bes-fm beg dur freq amp ratio index) produces J1(J1) imitating FM"))
(lambda (beg dur freq amp ratio index)
(let ((car-incr (hz->radians freq)))
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(car-ph 0.0)
(mod-ph 0.0)
(mod-incr (* ratio car-incr))
(ampenv (make-env '(0 0 25 1 75 1 100 0) :scaler amp :duration dur)))
(do ((i st (+ i 1)))
((= i nd))
(outa i (* (env ampenv) (bes-j1 car-ph)))
(set! car-ph (+ car-ph car-incr (* index (bes-j1 mod-ph))))
(set! mod-ph (+ mod-ph mod-incr))))))))
;;; (with-sound (:statistics #t) (bes-fm 0 1 440 10.0 1.0 4.0))
;;; ssb-fm
;;; this might be better named "quasi-ssb-fm" -- cancellations are not perfect
(defgenerator sbfm
(am0 #f) (am1 #f)
(car0 #f) (car1 #f)
(mod0 #f) (mod1 #f)
modsig)
(define make-ssb-fm
(let ((documentation "(make-ssb-fm freq) makes an ssb-fm generator"))
(lambda (freq)
(make-sbfm :am0 (make-oscil freq 0)
:am1 (make-oscil freq (* 0.5 pi))
:car0 (make-oscil 0 0)
:car1 (make-oscil 0 (* 0.5 pi))
:mod0 (make-hilbert-transform 40)
:mod1 (make-delay 40)))))
(define ssb-fm
(let ((documentation "(ssb-fm gen modsig) runs an ssb-fm generator"))
(lambda (gen modsig)
(let-set! gen 'modsig modsig)
(with-let gen
(+ (* (oscil am0)
(oscil car0 (hilbert-transform mod0 modsig)))
(* (oscil am1)
(oscil car1 (delay mod1 modsig))))))))
;;; if all we want are asymmetric fm-generated spectra, we can just add 2 fm oscil pairs:
(define make-fm2
(let ((documentation "(make-fm2 f1 f2 f3 f4 p1 p2 p3 p4) makes two FM paired oscils"))
(lambda (f1 f2 f3 f4 p1 p2 p3 p4)
;; (make-fm2 1000 100 1000 100 0 0 (* 0.5 pi) (* 0.5 pi))
;; (make-fm2 1000 100 1000 100 0 0 0 (* 0.5 pi))
(list (make-oscil f1 p1)
(make-oscil f2 p2)
(make-oscil f3 p3)
(make-oscil f4 p4)))))
(define fm2
(let ((documentation "(fm2 gen index) runs an fm2 generator"))
(lambda (gen index)
(* .25 (+ (oscil (gen 0) (* index (oscil (gen 1))))
(oscil (gen 2) (* index (oscil (gen 3)))))))))
;;; rms gain balance
;;; This is a translation of the rmsgain code provided by Fabio Furlanete.
(defgenerator rmsg
(c1 0.0)
(c2 0.0)
(q 0.0)
(r 0.0)
(avg 0.0)
(avgc 0)
sig rmsval)
(define make-rmsgain
(let ((documentation "(make-rmsgain (hp 10.0)) makes an RMS gain generator"))
(lambda* ((hp 10.0))
(let ((c2 (let ((b (- 2.0 (cos (* hp (/ (* 2.0 pi) *clm-srate*))))))
(- b (sqrt (- (* b b) 1.0))))))
(make-rmsg :c1 (- 1.0 c2) :c2 c2)))))
(define rms
(let ((documentation "(rms gen sig) runs an RMS gain generator"))
(lambda (gen sig)
(let-set! gen 'sig sig)
(with-let gen
(set! q (+ (* c1 sig sig) (* c2 q)))
(sqrt q)))))
(define gain
(let ((documentation "(gain gen sig rmsval) returns the current RMS gain"))
(lambda (gen sig rmsval)
(let-set! gen 'sig sig)
(let-set! gen 'rmsval rmsval)
(with-let gen
(set! r (+ (* c1 sig sig) (* c2 r)))
(let ((this-gain (if (zero? r)
rmsval
(/ rmsval (sqrt r)))))
(set! avg (+ avg this-gain))
(set! avgc (+ avgc 1))
(* sig this-gain))))))
(define balance
(let ((documentation "(balance gen signal compare) scales a signal based on a RMS gain"))
(lambda (gen signal compare)
(gain gen signal (rms gen compare)))))
(define gain-avg
(let ((documentation "(gain-avg gen) is part of the RMS gain stuff"))
(lambda (gen)
(/ (gen 'avg) (gen 'avgc)))))
(define balance-avg
(let ((documentation "(balance-avg gen) is part of the RM gain stuff"))
(lambda (gen)
(gen 'avg))))
(definstrument (cnvrev file impulse (rev-amt .1))
(let ((filter-len (mus-sound-framples impulse)))
(let ((file-len (mus-sound-framples file))
(filter-chan0 (make-float-vector filter-len))
(filter-chan1 (and (= (mus-channels *output*) 2)
(> (mus-sound-chans impulse) 1)
(make-float-vector filter-len))))
(file->array impulse 0 0 filter-len filter-chan0)
(if (float-vector? filter-chan1)
(file->array impulse 1 0 filter-len filter-chan1)
(set! filter-chan1 filter-chan0))
(let ((fd (make-readin file))
(fd1 (and (= (mus-channels *output*) 2)
(> (mus-sound-chans file) 1)
(make-readin file :channel 1))))
(let ((ff0 (make-convolve :input fd :filter filter-chan0))
(ff1 (and (= (mus-channels *output*) 2)
(> (mus-sound-chans file) 1)
(make-convolve :input fd1 :filter filter-chan1)))
(end (+ file-len filter-len)))
(if ff1
(do ((i 0 (+ i 1)))
((= i end))
(outa i (* rev-amt (convolve ff0)))
(outb i (* rev-amt (convolve ff1))))
(do ((i 0 (+ i 1)))
((= i end))
(outa i (* rev-amt (convolve ff0))))))))))
#|
(with-sound (:statistics #t :scaled-to .5 :srate 44100 :channels 1)
(cnvrev "oboe.snd" "fyow.snd"))
|#
|