Browse Source

copy head of git.iem.at/dSP/tonalisa

master
Dom SP 2 years ago
commit
e37c040080
100 changed files with 248537 additions and 0 deletions
  1. +5
    -0
      .gitignore
  2. +675
    -0
      COPYING
  3. +33
    -0
      README
  4. +29
    -0
      lib/sndlib/COPYING
  5. +317
    -0
      lib/sndlib/HISTORY.sndlib
  6. +129
    -0
      lib/sndlib/README.sndlib
  7. +94
    -0
      lib/sndlib/_sndlib.h
  8. +528
    -0
      lib/sndlib/analog-filter.rb
  9. +490
    -0
      lib/sndlib/analog-filter.scm
  10. +10913
    -0
      lib/sndlib/animals.scm
  11. +5598
    -0
      lib/sndlib/audio.c
  12. +6416
    -0
      lib/sndlib/autom4te.cache/output.0
  13. +5651
    -0
      lib/sndlib/autom4te.cache/output.1
  14. +148
    -0
      lib/sndlib/autom4te.cache/requests
  15. +445
    -0
      lib/sndlib/autom4te.cache/traces.0
  16. +412
    -0
      lib/sndlib/autom4te.cache/traces.1
  17. +415
    -0
      lib/sndlib/bess.rb
  18. +249
    -0
      lib/sndlib/bess.scm
  19. +527
    -0
      lib/sndlib/bess1.rb
  20. +534
    -0
      lib/sndlib/bess1.scm
  21. +1119
    -0
      lib/sndlib/bird.fsm
  22. +1161
    -0
      lib/sndlib/bird.rb
  23. +1044
    -0
      lib/sndlib/bird.scm
  24. +3326
    -0
      lib/sndlib/clm-ins.fs
  25. +3783
    -0
      lib/sndlib/clm-ins.rb
  26. +2730
    -0
      lib/sndlib/clm-ins.scm
  27. +333
    -0
      lib/sndlib/clm-strings.h
  28. +16804
    -0
      lib/sndlib/clm.c
  29. +1223
    -0
      lib/sndlib/clm.fs
  30. +867
    -0
      lib/sndlib/clm.h
  31. +2847
    -0
      lib/sndlib/clm.rb
  32. +13286
    -0
      lib/sndlib/clm2xen.c
  33. +53
    -0
      lib/sndlib/clm2xen.h
  34. +653
    -0
      lib/sndlib/cload.scm
  35. +1497
    -0
      lib/sndlib/config.guess
  36. +1608
    -0
      lib/sndlib/config.sub
  37. +5651
    -0
      lib/sndlib/configure
  38. +395
    -0
      lib/sndlib/configure.ac
  39. +2938
    -0
      lib/sndlib/dlocsig.rb
  40. +3120
    -0
      lib/sndlib/dlocsig.scm
  41. +2798
    -0
      lib/sndlib/dsp.scm
  42. +562
    -0
      lib/sndlib/env.scm
  43. +345
    -0
      lib/sndlib/expandn.scm
  44. +281
    -0
      lib/sndlib/fade.scm
  45. +215
    -0
      lib/sndlib/freeverb.rb
  46. +208
    -0
      lib/sndlib/freeverb.scm
  47. +97
    -0
      lib/sndlib/fth.m4
  48. +165
    -0
      lib/sndlib/fullmix.scm
  49. +6824
    -0
      lib/sndlib/generators.scm
  50. +424
    -0
      lib/sndlib/grani.rb
  51. +643
    -0
      lib/sndlib/grani.scm
  52. +7085
    -0
      lib/sndlib/headers.c
  53. +250
    -0
      lib/sndlib/install-sh
  54. +3363
    -0
      lib/sndlib/io.c
  55. +45
    -0
      lib/sndlib/jcrev.scm
  56. +263
    -0
      lib/sndlib/jcvoi.scm
  57. +18971
    -0
      lib/sndlib/lint.scm
  58. +31
    -0
      lib/sndlib/make-config-pc.rb
  59. +100
    -0
      lib/sndlib/makefile.in
  60. +134
    -0
      lib/sndlib/maraca.rb
  61. +137
    -0
      lib/sndlib/maraca.scm
  62. +210
    -0
      lib/sndlib/maxf.rb
  63. +352
    -0
      lib/sndlib/maxf.scm
  64. +40
    -0
      lib/sndlib/mkinstalldirs
  65. +201
    -0
      lib/sndlib/moog.scm
  66. +47
    -0
      lib/sndlib/mus-config.h
  67. +117
    -0
      lib/sndlib/noise.rb
  68. +184
    -0
      lib/sndlib/noise.scm
  69. +74
    -0
      lib/sndlib/nrev.scm
  70. +4900
    -0
      lib/sndlib/peak-phases.scm
  71. +526
    -0
      lib/sndlib/piano.rb
  72. +514
    -0
      lib/sndlib/piano.scm
  73. +347
    -0
      lib/sndlib/prc95.rb
  74. +274
    -0
      lib/sndlib/prc95.scm
  75. +140
    -0
      lib/sndlib/premake4.lua
  76. +337
    -0
      lib/sndlib/pvoc.rb
  77. +75085
    -0
      lib/sndlib/s7.c
  78. +1013
    -0
      lib/sndlib/s7.h
  79. +9547
    -0
      lib/sndlib/s7.html
  80. +606
    -0
      lib/sndlib/singer.rb
  81. +565
    -0
      lib/sndlib/singer.scm
  82. +125
    -0
      lib/sndlib/sndinfo.c
  83. +57
    -0
      lib/sndlib/sndins/Makefile.in
  84. +403
    -0
      lib/sndlib/sndins/README
  85. +150
    -0
      lib/sndlib/sndins/samples/agn.fth
  86. +137
    -0
      lib/sndlib/sndins/samples/agn.rb
  87. +166
    -0
      lib/sndlib/sndins/samples/agn.scm
  88. +1788
    -0
      lib/sndlib/sndins/samples/fmviolin.fth
  89. +1753
    -0
      lib/sndlib/sndins/samples/fmviolin.rb
  90. +1978
    -0
      lib/sndlib/sndins/samples/fmviolin.scm
  91. +2371
    -0
      lib/sndlib/sndins/sndins.c
  92. +97
    -0
      lib/sndlib/sndins/sndins.h
  93. +84
    -0
      lib/sndlib/sndlib-config.in
  94. +87
    -0
      lib/sndlib/sndlib-strings.h
  95. +548
    -0
      lib/sndlib/sndlib-ws.scm
  96. +435
    -0
      lib/sndlib/sndlib.h
  97. +967
    -0
      lib/sndlib/sndlib.html
  98. +13
    -0
      lib/sndlib/sndlib.pc.in
  99. +1281
    -0
      lib/sndlib/sndlib2xen.c
  100. +31
    -0
      lib/sndlib/sndlib2xen.h

+ 5
- 0
.gitignore View File

@@ -0,0 +1,5 @@
*~
*.o
*.so
*.a
tonalisa

+ 675
- 0
COPYING View File

@@ -0,0 +1,675 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007

Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.

Preamble

The GNU General Public License is a free, copyleft license for
software and other kinds of works.

The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.

When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.

To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.

For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.

Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.

For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.

Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.

Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.

The precise terms and conditions for copying, distribution and
modification follow.

TERMS AND CONDITIONS

0. Definitions.

"This License" refers to version 3 of the GNU General Public License.

"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.

"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.

To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.

A "covered work" means either the unmodified Program or a work based
on the Program.

To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.

To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.

An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.

1. Source Code.

The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.

A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.

The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.

The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.

The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.

The Corresponding Source for a work in source code form is that
same work.

2. Basic Permissions.

All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.

You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.

Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.

3. Protecting Users' Legal Rights From Anti-Circumvention Law.

No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.

When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.

4. Conveying Verbatim Copies.

You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.

You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.

5. Conveying Modified Source Versions.

You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:

a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.

b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".

c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.

d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.

A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.

6. Conveying Non-Source Forms.

You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:

a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.

b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.

c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.

d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.

e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.

A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.

A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.

"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.

If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).

The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.

Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.

7. Additional Terms.

"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.

When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.

Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:

a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or

b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or

c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or

d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or

e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or

f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.

All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.

If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.

Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.

8. Termination.

You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).

However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.

Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.

Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.

9. Acceptance Not Required for Having Copies.

You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.

10. Automatic Licensing of Downstream Recipients.

Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.

An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.

You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.

11. Patents.

A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".

A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.

Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.

In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.

If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.

If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.

A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.

Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.

12. No Surrender of Others' Freedom.

If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.

13. Use with the GNU Affero General Public License.

Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.

14. Revised Versions of this License.

The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.

If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.

Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.

15. Disclaimer of Warranty.

THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

16. Limitation of Liability.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.

17. Interpretation of Sections 15 and 16.

If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.

END OF TERMS AND CONDITIONS

How to Apply These Terms to Your New Programs

If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.

To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.

<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.

Also add information on how to contact you by electronic and paper mail.

If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:

<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.

The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".

You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.

The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.


+ 33
- 0
README View File

@@ -0,0 +1,33 @@
Tonalisa
========

Tonalisa is a tool to look at overtone-structures.
(c) 2016 Dominik Schmidt-Philipp

DEPENDENCIES:
-------------

- Qt (tested with version 5.6)
- liblo
- sndlib (included)


INSTALL:
--------

tested on Linux (Debian 8)

install dependencies,
run the following commands in a terminal:

> qmake
> make

running qmake builds static and dynamic versions of sndlib required for building tonalisa.
it does not install sndlib to your system though. this can be done make by running "make install" in the sndlib directory

> cd lib/sndlib
> make install

if you need help email me:
dsp@tonmaschine.de

+ 29
- 0
lib/sndlib/COPYING View File

@@ -0,0 +1,29 @@
sndlib is a library written by Bill Schottstaedt (bil@ccrma.stanford.edu).

The authors hereby grant permission to use, copy, modify, distribute,
and license this software and its documentation for any purpose. No
written agreement, license, or royalty fee is required. Modifications
to this software may be copyrighted by their authors and need not
follow the licensing terms described here.

IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.









+ 317
- 0
lib/sndlib/HISTORY.sndlib View File

@@ -0,0 +1,317 @@
sndlib change log

20-Feb: removed mus_make_error and added several typedefs.

2015 ----------------------------------------------------------------

18-Jul: mus-sound-path.

2014 ----------------------------------------------------------------

2-Sep: vct struct is now local to vct.c (use the accessors mus_vct_length and mus_vct_data)
14-Jul: removed aclocal.m4, added sndlib.pc.
7-Jul: removed mus-config.h.in, sndlib.h.in, windows-*, added unix-config.h.in, mus-config.h.in.
5-Jul: added --with-audio to configure script.
27-Mar: removed mus-file-prescaler and mus-prescaler -- these no longer serve any purpose.

2013 ----------------------------------------------------------------

23-Nov: mus_sample_t is now mus_float_t.
22-Sep: cload.scm and lint.scm.
5-July: removed run.c, internal int mus_sample_t option.
1-May: removed mus-audio-describe, ESD audio support, audinfo,
mus_audio_read|write_buffers, mus_samples_peak.
30-Apr: removed mus_audio_systems.

2012 ----------------------------------------------------------------

20-Oct: --with-defaults is now built-in (i.e. mus_float_t is double).
14-Jul: removed thread stuff.

2011 ----------------------------------------------------------------

22-Sep: def-clm-struct is now just a synonym for defgenerator.
27-Feb: the run macro's argument no longer has to be a thunk.

2010 ----------------------------------------------------------------

11-Dec: removed midi.c, sndrecord.c, SGI support, and Alsa < 1.0 support.
7-Dec: removed mus-audio-report and changed mus-audio-describe to return the description as a string.
removed mus_audio_device_p, mus_audio_system_name, mus_audio_mixer_write.
27-Jul: Float changed to mus_float_t, off_t changed to mus_long_t.
14-Jul: Rick fixed the windows build process; added sndlib.sln.
13-Jul: frame, mixer, and sound-data are set-applicable.
frame and mixer are functions like vct: (frame .1 .2).
2-Jul: default audio in Linux is now ALSA.
17-Mar: Matlab-5 headers.
1-Jan: added MUS_EXPORT to headers.

2009 ----------------------------------------------------------------

5-Dec: mus-sox headers.
7-Nov: mus_header_type_to_string and mus_data_format_to_string are now const char*
so the string they return should not be freed
4-Nov: run.c (from snd-run.c), sndlib-ws.scm.
23-Oct: riff->rf64 autoconversion repaired.
16-Oct: removed Gauche support.
11-Sep: S7 support.
14-Jul: mus_samples_bounds.
12-Jul: mus_data_format_p and mus_header_type_p for C++'s benefit.
30-Jun: mus_max_malloc and mus_max_table_size.
27-Feb: removed mus_header_write_next_header (obsolete, deprecated since the days of Charlemagne)
23-Jan changes for OSS v4 thanks to Yair K.
new Jack environment variables thanks to Kjetil Matheussen.

2008 ----------------------------------------------------------------

25-Jun: RIFF bugfix and minGW configure info thanks to Steve Beet.
26-Mar: mus_samples_peak.
31-Jan: caff headers.

2007 ----------------------------------------------------------------

12-Dec: mus_clip_set_handler.
21-Nov: sound-data-scale! and sound-data-fill! with vct/sound-data with-sound output.
20-Nov: generic out-any, in-any, locsig.
13-Nov: RF64 headers.
11-Nov: MUS_BAD_SIZE and a warning for aifc/riff size > 2^31.
26-Sep: moved config.h to mus-config.h.
31-Apr: Gauche support.
28-Mar: version 20:
Forth support thanks to Mike Scholz.
17-Feb: prescaler and clipping defaults are now mus_[set_]prescaler and mus_[set_]clipping
(old names in mus_file_*_default are deprecated).
The file specific forms are mus_file_*, replacing data_clipped with clipping.
The prescaler type is now Float (not float).
2-Feb: mus_audio_sun_outputs -> mus_sun_set_outputs, added mus_netbsd_set_outputs.
mus_audio_set_oss_buffers -> mus_oss_set_buffers.
changed ALSA environment variable names to use MUS, not SNDLIB.
changed ALSA default device to "default" from "hw:0"
added mus_alsa_buffers|buffer_size|device|playback_device|capture_device|squelch_warning.

2006 ----------------------------------------------------------------

21-Nov: mus_sample_t is now double if use-float-samples and with-doubles.
2-Nov: -volume argument added to sndplay (Kjetil Matheussen).
1-Nov: mus-header-raw-defaults in sndlib2xen.
18-Aug: _sndlib.h and sndlib.h.in + configure.ac changes.
1-Jul: mus_data_format_short_name.
23-Jun: changed type of "cm" arg to mus_file_read_any and mus_file_read_chans.
These actually were mus_sample_t** all along, so I'm not sure why
they were declared mus_sample_t*.
27-Apr: vct* and vct+.

2005 ----------------------------------------------------------------

15-Nov: removed mus_audio_save|restore.
14-Jul: added defaults for data_clipped and prescaler choices.
30-Jun: removed obsolete mus_sound_maxamp (CLM no longer needs it)
9-Apr: added -start and -end (in seconds) args to sndplay.
29-Mar: version 19:
removed support for Digitracker SPL files (never have seen one).
removed mus_header_read_with_fd, mus_header_update_with_fd,
changed mus_header_change_samples to mus_header_change_data_size (in bytes).
added header-type args to other mus_header_change_* functions
15-Mar: exported optkey support stuff (sndlib2xen.h).
9-Mar: Jack input and other improvements thanks to Kjetil S. Matheussen.
26-Jan: OSX Midi bugfix thanks to Ian MacArthur.

2004 ----------------------------------------------------------------

22-Dec: sndplay jack support and other bugfixes thanks to Kjetil S. Matheussen.
19-Dec: changed mus-data-format-bytes-per-sample to mus-bytes-per-sample (also in C).
24-Nov: sndlib2xen mus-audio-open-* audio device check bugfix (thanks Michael Scholz).
5-Nov: Jack audio support thanks to Kjetil S. Matheussen.
10-Oct: libsndlib.a in Linux should be built with ld, not gcc -- thanks to Craig Sapp.
6-Oct: added sndins and gfm directories, both written by Michael Scholz.
11-Aug: int -> bool.
10-July: Sun audio support for Jurgen Keil's driver.
Removed mmreg.h dependency in windoze audio support.
6-June: CLM FFI name change: *_reset_c -> mus_*_reset_c (for consistency).
30-Apr: realloc support of Mac (old) OS thanks to Michael Klingbeil.
28-Apr: removed mus_sound_seek, mus_file_seek, mus_header_aiff_p, mus_sound_finalize,
mus_header_set_aiff_loop_info, and mus_sound_aiff_p.
for mus_header_aiff_p, just check the header type for MUS_AIFF (as opposed to MUS_AIFC)
for mus_header_set_aiff_loop_info use mus_header_set_full_aiff_loop_info
26-Apr: added 4 more header readers.
9-Apr: removed mus_header_update, mus_file_full_name -- use mus_expand_filename.
31-Mar: version 18.
fftw-3 support.
removed mus_audio_mixer_save and mus_audio_mixer_restore.
25-Mar: changed install process in makefile.in (thanks to Hugo Villeneuve)
17-Mar: mus_audio input for Mac OSX.
12-Mar: removed mus_audio_clear_soundcard_inputs.
11-Mar: --prefix bugfixes in configure.
4-Mar: removed mus_header_write_with_fd.

2003 ----------------------------------------------------------------

18-Dec: mus_audio_read|write_buffers.
11-Dec: sndlib-config, configure/make writes libsndlib.a|so
2-Dec: added mus_header_write hook.
18-Oct: xen-sndlib initialization now includes vct (thanks to Michael Scholz).
protect Ruby's kernel.rand as kernel_rand.
25-Sep: removed support for Tandy headers (I never have seen one).
24-Sep: removed obsolete mus_sound_set_maxamp.
13-Sep: removed obsolete mus_header_set_aifc.
10-Sep: removed NeXT (audio) support.
6-Sep: removed mus_header_distributed and mus_sound_distributed.
15-Jul: sndlib-config
20-May: moved LONG_INT_P stuff to cmus.h (it was CL/CLM-specific).
16-May: added mus_sound_maxamps and mus_sound_set_maxamps (for off_t times).
9-May: removed mus_sound_set_loop_info (deprecated long ago).
3-May: version 16.
many int->off_t changes for large files.
MUS_SAMPLE_TYPE -> mus_sample_t.
29-Apr: added optional initial-element to make_vct.
moved vct_do, vcts_do, vcts_map to snd5.scm.
23-Apr: added strdup for MPW.
18-Apr: tie run optimizer into vct-map!
29-Mar: mus_sound_srate|chans|data_location|data_format|header_type settable via Xen.
26-Mar: vct->vector.
24-Mar: removed ALSA 0.5 support.
11-Mar: version 15.
mus_header_change_chans|srate|type|format|location|comment|samples.
1-Feb: removed mus_header_update_comment.
24-Jan: removed "max_amp" functions -- use "maxamp".
23-Jan: ALSA improvements from Fernando.
removed old-sndlib2scm.scm, old-sndlib.h, sndlib.txt, transnd.cl, sndlib.i, snd-noguile.h

2002 ----------------------------------------------------------------

10-Dec: added midi.c
14-Nov: mus_audio_compatible_format.
12-Nov: Mac-OSX stuff.
29-Oct: soundforge 64-bit "riff" headers.
24-Sep: version 14.
mus_sound_max_amp -> mus_sound_maxamp (also the set form and exists)
the old names exist as macros for backwards compatibility
12-Sep: changed IRCAM "Vax" handling to match Csound/MixViews (unscaled lfloats)
29-Aug: added mus-audio-reinitialize.
10-Aug: added wrap_sound_data.
12-Jul: ALSA 0.9 support from Fernando.
6-Jul: version 13.
sg.h, sl.h, noguile.h, sr.h, sz.h -> xen.h.
clm2scm.[ch], sndlib2scm.[ch] -> xen for scm.
many internal name changes to change scm to xen.
mus_xen rather than mus_scm (clm2xen),
mus_xen_init for init_mus2scm_module,
mus_sndlib2xen_initialize for mus_sndlib2scm_initialize.
2-Jul: a couple soundfont header bugfixes.
21-Jun: Mac fixups.
4-June: configure.ac for autoconf 2.50.
22-May: in OSS, DSP_SETFRAGMENT ioctl now only called if set_oss_buffers has been called.
old default was (set-oss-buffers 4 12) but 2 12 is usable in most cases.
21-May: mus_header_raw_defaults (to read back current settings).
19-May: vct->sound-data now returns the sound-data object, not the vct.
28-Apr: mus_sound_report_cache.
17-Apr: remove broken, obsolete BeOS audio support.
4-Apr: mus_snprintf.
19-Mar: removed gdbm option.
12-Mar: sndinfo loop info report bugfix.
added mus_sound_set_max_amp, mus_sound_max_amp_exists.
bumped version to 12.
7-Mar: added mus-sound-write-date to sndlib2scm.
10-Feb: added sndlib2clm.lisp.
8-Feb: added clm2scm.h.
1-Feb: added vct-subseq.
31-Jan: changed mus-audio-read (sndlib2scm) to assume shorts, like mus-audio-write.
29-Jan: mus_sound_read can read trailing chunks, necessitating many fixups.
added mgetty's pvf header.
26-Jan: audio.c windows uninitialized variable bugfix (thanks to Paul A. Steckler).

2001 ----------------------------------------------------------------

28-Nov: BSD support thanks to Steven Schultz.
Dolph-Chebyshev window if HAVE_GSL.
24-Nov: split ALSA support out in sndplay.c (merging with Fernando's version).
17-Nov: esd support thanks to Nick Bailey.
6-Nov: char * -> const char * in various places for C++.
17-Oct: added optional offset arg to vct-add!.
28-Sep: removed mus_file_open_descriptors (was obsolete long ago -- use mus_file_set_descriptors).
19-Sep: version 11: changed error handling; in this version, any error is signalled
immediately by mus_error, then the error indication (-1 normally) is
returned. The caller needs to set mus_error_handler to specialize
this (its default is to fprintf(stderr,error-message)). mus_audio_error
has been folded into mus_error, so mus_audio_error_name etc have been
removed. mus_print added to replace the informational calls that used
mus_error and mus_audio_error (the latter should not be called anymore with
MUS_NO_ERROR!) -- MUS_AUDIO_NO_ERROR removed. added mus_error_to_string.
mus_error_make_tag -> mus_make_error with name as arg. removed mus_write.
18-Sep: changed mus_fwrite to mus_write, added mus_print.
22-Aug: sound_duration should return -1.0 if error, not 1.0 (thanks to Michael Edwards)
5-Aug: port to Mac OS-X (not audio yet).
17-July: added vct-move!
20-June: change to scm_make_smob_type rather than *_mfpe.
14-June: ALSA 0.60 updates thanks to Paul Barton-Davis.
8-June: Linux OSS/ALSA choice now made at run-time (thanks to Fernando!).
17-May: removed vax float support.
12-May: removed 'old' names -- use old-sndlib2scm.scm and old-sndlib.h
mus_prescaler overflow bugfix.
added sg.h
8-May: added "const" to various function arguments.
1-May: Sam 9407 (audio.c) improvements thanks to Gerd Rausch.
clm.c mus_make_frame|mixer va_arg -> float bugfix.
24-Apr: added CSL headers.
12-Apr: Fernando Lopez-Lezcano provided a new ALSA port!
changed clm2scm to use built-in keyword support (use (read-set! keywords 'prefix))
10-Apr: version 10: many name changes (this time for sure!) -- use transnd.cl to update.
Be audio support changed to reflect release 5.
Alsa also changed.
1-Mar: version 9.
added gdbm choice to sound.c, added sndlib2scm.h
changed to allow either floats or any-size "fraction" ints as internal data choice
removed mus_unshort_sound, added mus_write_to_buffer and mus_read_from_buffer
changed header macros to use SNDLIB_ -- old-sndlib.h has the old names
removed mus_float_sound (replaced by mus_read_from_buffer)
1-Jan-00: various changes to mus_outa etc.
changed (internal) mus_set_file_descriptor to include file name.
added buffer-full? and changed various macro names.
added mus_prescaler for problematic float files
brought headers.c loop support into sound.c, sndlib2scm, sndinfo.c.
added aiff loop info to write header via mus_set_aiff_loop_info

2000 ----------------------------------------------------------------

1-Dec: added several more configure switches, sound_print_cache.
sound_max_amp returned vals in wrong order.
several improvements to src, granulate, and convolve thanks to Marc Lehmann.
1-Nov: version 8.
decided to make a non-compatible change: AIFF_sound file is now AIFC_sound_file,
and old_style_AIFF_sound_file is now AIFF_sound_file.
12-Sep: version 7.
ALSA port thanks to Paul Barton-Davis
fixed 2 bugs related to Sonorus Studio support
several clm.c/clm2scm.c bugs and oversights repaired.
added list2vct, mus_file2array, mus_array2file, dsp_devices.
added configure files, README.sndlib, changed tar file to use sndlib directory
added -1 as error return from various functions (void->int change in io.c and headers.c)
added mus_header_writable, mus_header_aiff_p, sound_aiff_p
much more of sndlib tied into sndlib2scm
tried to get SGI new AL default devices to work right
USE_BYTESWAP in io.c (if you want to use the GLibC macros).
added forget_sound to remove entry from sound data base.
added more vct funcs, formant-bank, oscil-bank, etc.
1-Sep: added mus_set_raw_header_defaults, mus_probe_file
1-Aug: old-sndlib.h for backwards compatibility, added mus_fwrite
1-Jul: added sound_max_amp, mus_error
1-Jun: version 6.
moved clm-specific code out of sndlib files
changed many names to use "mus" prefix, or "SNDLIB" (and upper case)
added sound_frames
added clm.c, clm.h, vct.c, vct.h, clm2scm.c
added reopen_sound_output (arg order changed rev 6), mus_seek_frame, sound_seek_frame
1-Mar: version 5.
changed float_sound to omit the scaling by SNDLIB_SNDFLT
removed perror calls
added sndlib2scm.c, sndlib-strings.h
fixed windoze audio_output bug
fixed Mac p2cstr potential bug
1-Jan-99: version 4. Sun-related word-alignment changes, C++ fixups

1999 ----------------------------------------------------------------

1-Dec: version 3. removed output_scaler
12-Oct: version 2. removed header override functions
1-Oct-98 version 1.


+ 129
- 0
lib/sndlib/README.sndlib View File

@@ -0,0 +1,129 @@
S N D L I B

The sound library is a collection of sound file and audio hardware
handlers written in C, Forth, Scheme, Common Lisp, and Ruby, and
running currently on Linux, *BSD, Mac OSX, and Windows systems.
It provides relatively straightforward access to many sound file
headers and data types.

Documentation is in sndlib.html.

To build it

./configure
make
make install

The configure script takes several arguments:

--with-audio include audio (default=yes)
--with-alsa use ALSA if possible
--with-jack use Jack if possible
--with-s7 use s7 as the extension language (the default)
--with-forth use Forth as the extension language
--with-ruby use Ruby as the extension language
--with-gsl try to include GSL
--enable-shared include shared object version of sndlib (the default)

Many examples and more documentation can be found in the Snd
package (ccrma-ftp.stanford.edu:/pub/Lisp/snd-13.tar.gz), and
CLM (clm-4.tar.gz).


There are two packages included with sndlib, both written
by Michael Scholz: sndins (a faster Scheme/Ruby connection to
some instruments) and gfm (a Forth implementation of sndlib).


If your Ruby installation is missing its pkgconfig file (ruby.pc
or some such name), run the make-config-pc.rb script and move the
resultant file to some pkgconfig directory:

make-config-pc.rb > ruby.pc
mv ruby.pc /usr/local/lib/pkgconfig/ruby.pc


--------------------------------------------------------------------------------
from Rick Taube:

BUILDING SNDLIB AND CM FROM SOURCES ON WINDOWS

These instructions assume you already have Microsoft Visual Studio
Express C++ 2008 installed on your computer. Its easiest if you create
a common folder to hold the source trees for CM and SndLib. I created
a C:\Software directory to hold both systems on my machine:

C:\Software\sndlib
C:\Software\cm

BUILDING SNDLIB ON WINDOWS

1. Download and install the latest version of SndLib:

ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz

2. Double-click 'sndlib.sln' to open the project in Visual Studio
and choose 'Build Solution' from the Build menu (or press F7). This
should compile the release version of the sndlib library.

BUILDING CM ON WINDOWS

1. Download and install Premake 4.4, make sure that the executable is
on your PATH variable:

http://downloads.sourceforge.net/premake/premake-win32-4.4.zip

2. Open a CMD shell (terminal): Select Run... from the Start menu and
click OK.

3. In the terminal window, change directories to your CM directory and
use premake to create the Visual Studio project files:

cd \Software\cm
premake --target vs2008 --sndlib ../sndlib

4. Double click the file 'cm.sln' , select the Release configuration
in the pulldown menu and press F7.



BUILDING SNDLIB AND CM FROM SOURCES ON OSX AND LINUX

These instructions assume you already have all c++ developer tools,
libraries and headers installed on your machine. Its easiest if you
create a common folder to hold the source trees for CM and SndLib. I
created a ~/Software directory to hold both systems on my machine:

~/Software/sndlib
~/Software/cm

BUILDING SNDLIB ON OSX/LINUX

1. Download, install and make the latest version of SndLib:

$ cd ~/Software
$ wget ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz
$ tar -zxf sndlib.tar.gz
$ cd sndlib
$ ./configure CC=g++
$ make

BUILDING CM ON OS X/LINUX

1. Download and install Premake 4.4, make sure that the executable is
on your PATH variable:

os x: http://downloads.sourceforge.net/premake/premake-macosx-4.4.tar.gz
linux: http://downloads.sourceforge.net/premake/premake-linux-4.4.tar.gz

2. Download and build the latest CM3 sources from Sourceforge.

$ cd ~/Software
$ svn co http://commonmusic.svn.sourceforge.net/svnroot/commonmusic/trunk
cm
$ cd cm
$ premake --target gnu --sndlib ../sndlib
$ make

The applications will be saved in the bin/ subdirectory. Documentation
and examples are in cm/res/doc. See cm/readme.text for more information.

+ 94
- 0
lib/sndlib/_sndlib.h View File

@@ -0,0 +1,94 @@
#ifndef _SNDLIB_H
#define _SNDLIB_H

#include <mus-config.h>

#ifndef _MSC_VER
#include <unistd.h>
#endif

#include <sys/types.h>
#include <stdio.h>

#if ((!__NetBSD__) && ((_MSC_VER) || (!defined(__STC__)) || (defined(__STDC_VERSION__) && (__STDC_VERSION__ < 199901L))))
#define __func__ __FUNCTION__
#endif

#if (!defined(M_PI))
#define M_PI 3.14159265358979323846264338327
#define M_PI_2 (M_PI / 2.0)
#endif

#define is_power_of_2(x) ((((x) - 1) & (x)) == 0)

#define MUS_MAX_MALLOC_DEFAULT (1 << 26)
#define MUS_MAX_TABLE_SIZE_DEFAULT (1024 * 1024 * 20) /* delay line allocation etc */

#ifndef SEEK_SET
#define SEEK_SET 0
#define SEEK_END 2
#endif

#ifdef _MSC_VER
#ifdef FOPEN
#undef FOPEN
#endif
#if USE_SND
#define OPEN(File, Flags, Mode) snd_open((File), (Flags), 0)
#else
#define OPEN(File, Flags, Mode) open((File), (Flags))
#endif
#else
#if USE_SND
#define OPEN(File, Flags, Mode) snd_open((File), (Flags), (Mode))
#else
#define OPEN(File, Flags, Mode) open((File), (Flags), (Mode))
#endif
#endif

#if USE_SND
#define FOPEN(File, Flags) snd_fopen((File), (Flags))
#define CREAT(File, Flags) snd_creat((File), (Flags))
#define REMOVE(OldF) snd_remove(OldF, IGNORE_CACHE)
#define STRERROR(Err) snd_io_strerror()
#define CLOSE(Fd, Name) snd_close(Fd, Name)
#define FCLOSE(Fd, Name) snd_fclose(Fd, Name)
#else
#define FOPEN(File, Flags) fopen((File), (Flags))
#define CREAT(File, Flags) creat((File), (Flags))
#define REMOVE(OldF) remove(OldF)
#define STRERROR(Err) strerror(Err)
#define CLOSE(Fd, Name) close(Fd)
#define FCLOSE(Fd, Name) fclose(Fd)
#endif

#ifndef S_set
#if (!HAVE_EXTENSION_LANGUAGE)
#define S_set "set-"
#else
#if HAVE_RUBY
#define S_set "set_"
#else
#if HAVE_SCHEME
#define S_set "set! "
#else
#if HAVE_FORTH
#define S_set "set-"
#endif
#endif
#endif
#endif
#endif

#define MUS_LOOP_INFO_SIZE 8
#define MUS_ALSA_API 0
#define MUS_OSS_API 1
#define MUS_JACK_API 2

#define G7XX 0

#include "sndlib.h"
#include "xen.h"
#include "vct.h"

#endif

+ 528
- 0
lib/sndlib/analog-filter.rb View File

@@ -0,0 +1,528 @@
# analog-filter.rb -- analog-filter.scm --> analog-filter.rb -*- snd-ruby -*-

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Tue Aug 01 22:58:31 CEST 2006
# Changed: Wed Nov 17 22:07:58 CET 2010

# Commentary:
#
# ;;; various even order analog filters, based primarily on Anders Johansson's (GPL'd) code
#
# module Analog_filter
# make_butterworth_lowpass(n, fc)
# make_butterworth_highpass(n, fc)
# make_butterworth_bandpass(n, fl, fh)
# make_butterworth_bandstop(n, fl, fh)
#
# make_chebyshev_lowpass(n, fc, ripple = 1.0)
# make_chebyshev_highpass(n, fc, ripple = 1.0)
# make_chebyshev_bandpass(n, fl, fh, ripple = 1.0)
# make_chebyshev_bandstop(n, fl, fh, ripple = 1.0)
#
# make_inverse_chebyshev_lowpass(n, fc, loss_dB = 60.0)
# make_inverse_chebyshev_highpass(n, fc, loss_dB = 60.0)
# make_inverse_chebyshev_bandpass(n, fl, fh, loss_dB = 60.0)
# make_inverse_chebyshev_bandstop(n, fl, fh, loss_dB = 60.0)
#
# make_bessel_lowpass(n, fc)
# make_bessel_highpass(n, fc)
# make_bessel_bandpass(n, fl, fh)
# make_bessel_bandstop(n, fl, fh)
#
# make_elliptic_lowpass(n, fc, ripple = 1.0, loss_dB = 60.0)
# make_elliptic_highpass(n, fc, ripple = 1.0, loss_dB = 60.0)
# make_elliptic_bandpass(n, fl, fh, ripple = 1.0, loss_dB = 60.0)
# make_elliptic_bandstop(n, fl, fh, ripple = 1.0, loss_dB = 60.0)
#

# Code:

require "clm"
require "dsp"

module Analog_filter
def analog2digital(n, num, den, fz)
g = 1.0
wc = tan(PI * fz)
wcc = wc * wc
c = Vct.new(2 * n)
j = 0
k = 0
0.step(n - 1, 2) do |i|
nt0 = num[j + 0] / wcc
nt1 = num[j + 1] / wc
nt2 = num[j + 2]
dt0 = den[j + 0] / wcc
dt1 = den[j + 1] / wc
dt2 = den[j + 2]
kd = dt0 + dt1 + dt2
kn = nt0 + nt1 + nt2
c[k + 0] = (2.0 * dt2 - 2.0 * dt0) / kd
c[k + 1] = (dt0 + (-dt1) + dt2) / kd
c[k + 2] = (2.0 * nt2 - 2.0 * nt0) / kn
c[k + 3] = (nt0 + (-nt1) + nt2) / kn
g *= (kn / kd)
j += 3
k += 4
end
a = []
b = []
k = 0
0.step(n - 1, 2) do |i|
a.unshift(vct(c[k + 3], c[k + 2], c[k + 3]))
b.unshift(vct(1.0, c[k], c[k + 1]))
k += 4
end
[cascade2canonical(a).scale!(g), cascade2canonical(b)]
end

def prototype2highpass(n, num, den)
g = 1.0
numt = Vct.new(num.length)
dent = Vct.new(den.length)
i = 0
0.step(n - 1, 2) do |k|
g *= (num[i + 2] / den[i + 2])
numt[i + 0] = 1.0
numt[i + 1] = num[i + 1] / num[i + 2]
numt[i + 2] = num[i + 0] / num[i + 2]
dent[i + 0] = 1.0
dent[i + 1] = den[i + 1] / den[i + 2]
dent[i + 2] = den[i + 0] / den[i + 2]
i += 3
end
numt[0] = g
[numt, dent]
end

#
# === BUTTERWORTH ===
#
def butterworth_prototype(n)
len = (n * 3) / 2
num = Vct.new(len)
den = Vct.new(len)
n2 = 2.0 * n
j = 0
1.step(n - 1, 2) do |w|
num[j + 0] = 0.0
num[j + 1] = 0.0
num[j + 2] = 1.0
den[j + 0] = 1.0
den[j + 1] = 2.0 * cos((w * PI) / n2)
den[j + 2] = 1.0
j += 3
end
[num, den]
end

# n = order, fc = cutoff freq (srate = 1.0)
add_help(:make_butterworth_lowpass,
"make_butterworth_lowpass(n, fc): \
returns a lowpass Buttterworth filter; N = order, \
FC = cutoff freq (srate = 1.0): make_butterworth_lowpass(8, 0.1)")
def make_butterworth_lowpass(n, fc)
if n.odd? then n += 1 end
proto = butterworth_prototype(n)
coeffs = analog2digital(n, proto[0], proto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_butterworth_highpass,
"make_butterworth_highpass(n, fc): \
returns a highpass Buttterworth filter; N = order, \
FC = cutoff freq (srate = 1.0): make_butterworth_highpass(8, 0.1)")
def make_butterworth_highpass(n, fc)
if n.odd? then n += 1 end
proto = butterworth_prototype(n)
hproto = prototype2highpass(n, proto[0], proto[1])
coeffs = analog2digital(n, hproto[0], hproto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_butterworth_bandpass,
"make_butterworth_bandpass(n, fl, fh): \
returns a bandpass Buttterworth filter; N = order, \
FL and FH are (1.0-based) edge freqs: make_butterworth_bandpass(4, 0.1, 0.2)")
def make_butterworth_bandpass(n, fl, fh)
lp = make_butterworth_lowpass(n, fh)
hp = make_butterworth_highpass(n, fl)
lambda do |y| filter(lp, filter(hp, y)) end
end

add_help(:make_butterworth_bandstop,
"make_butterworth_bandstop(n, fl, fh): \
returns a bandstop Buttterworth filter; N = order, \
FL and FH are (1.0-based) edge freqs: make_butterworth_bandstop(4, 0.1, 0.2)")
def make_butterworth_bandstop(n, fl, fh)
lp = make_butterworth_lowpass(n, fl)
hp = make_butterworth_highpass(n, fh)
lambda do |y| filter(lp, y) + filter(hp, y) end
end

#
# === CHEBYSHEV ===
#

# ripple in dB (positive)
def chebyshev_prototype(n, ripple = 1.0)
e = sqrt((10.0 ** (0.1 * ripple)) - 1.0)
v0 = asinh(1.0 / e) / n.to_f
len = (n * 3) / 2
n2 = 2.0 * n
sinhv0 = sinh(v0)
coshv0 = cosh(v0)
num = Vct.new(len)
den = Vct.new(len)
j = 0
1.step(n - 1, 2) do |l|
lpi = l * PI
u = -(sinhv0 * sin(lpi / n2))
w = coshv0 * cos(lpi / n2)
num[j + 0] = 0.0
num[j + 1] = 0.0
num[j + 2] = 1.0
den[j + 0] = 1.0
den[j + 1] = -2.0 * u
den[j + 2] = u * u + w * w
j += 3
end
num[2] = (2.0 ** (2 - n)) / (3.2 ** (log(ripple) / log(10.0)))
[num, den]
end

# n = order, fc = cutoff freq (srate = 1.0)
add_help(:make_chebyshev_lowpass,
"make_chebyshev_lowpass(n, fc, ripple=1.0): \
returns a lowpass Chebyshev filter; N = order, \
FC = cutoff freq (srate = 1.0): make_chebyshev_lowpass(8, 0.1)")
def make_chebyshev_lowpass(n, fc, ripple = 1.0)
if n.odd? then n += 1 end
proto = chebyshev_prototype(n, ripple)
coeffs = analog2digital(n, proto[0], proto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_chebyshev_highpass,
"make_chebyshev_highpass(n, fc, ripple=1.0): \
returns a highpass Chebyshev filter; N = order, \
FC = cutoff freq (srate = 1.0): make_chebyshev_highpass(8, 0.1, 0.01)")
def make_chebyshev_highpass(n, fc, ripple = 1.0)
if n.odd? then n += 1 end
proto = chebyshev_prototype(n, ripple)
hproto = prototype2highpass(n, proto[0], proto[1])
coeffs = analog2digital(n, hproto[0], hproto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_chebyshev_bandpass,
"make_chebyshev_bandpass(n, fl, fh, ripple=1.0): \
returns a bandpass Chebyshev filter; N = order, \
FL and FH = edge freq (srate = 1.0): make_chebyshev_highpass(8, 0.1, 0.01)")
def make_chebyshev_bandpass(n, fl, fh, ripple = 1.0)
lp = make_chebyshev_lowpass(n, fh, ripple)
hp = make_chebyshev_highpass(n, fl, ripple)
lambda do |y| filter(lp, filter(hp, y)) end
end

add_help(:make_chebyshev_bandstop,
"make_chebyshev_bandstop(n, fl, fh, ripple=1.0): \
returns a bandstop Chebyshev filter; N = order, \
FL and FH = edge freqs (srate = 1.0): make_chebyshev_bandstop(8, 0.1, 0.4, 0.01)")
def make_chebyshev_bandstop(n, fl, fh, ripple = 1.0)
lp = make_chebyshev_lowpass(n, fl, ripple)
hp = make_chebyshev_highpass(n, fh, ripple)
lambda do |y| filter(lp, y) + filter(hp, y) end
end

#
# === INVERSE CHEBYSHEV ===
#

def inverse_chebyshev_prototype(n, loss_dB = 60.0)
e = sqrt(1.0 / (10.0 ** (0.1 * loss_dB) - 1.0))
v0 = asinh(1.0 / e) / n.to_f
len = (n * 3) / 2
n2 = 2.0 * n
num = Vct.new(len)
den = Vct.new(len)
pl = 0.0
j = 0
1.0.step(n - 1, 2.0) do |l|
lpi = l * PI
u = -(sinh(v0) * sin(lpi / n2))
w = cosh(v0) * cos(lpi / n2)
t = 1.0 / sin(((l + pl) * PI) / n2)
num[j + 0] = 1.0
num[j + 1] = 0.0
num[j + 2] = t * t
den[j + 0] = 1.0
den[j + 1] = (-2.0 * u) / (u * u + w * w)
den[j + 2] = 1.0 / (u * u + w * w)
j += 3
end
[num, den, 1.122 ** -loss_dB]
end

# n = order, fc = cutoff freq (srate = 1.0)
add_help(:make_inverse_chebyshev_lowpass,
"make_inverse_chebyshev_lowpass(n, fc, loss_dB=60.0): \
returns a lowpass inverse-Chebyshev filter; N = order, \
FC = cutoff freq (srate = 1.0): make_inverse_chebyshev_lowpass(10, 0.4, 120)")
def make_inverse_chebyshev_lowpass(n, fc, loss_dB = 60.0)
if n.odd? then n += 1 end
proto = inverse_chebyshev_prototype(n, loss_dB)
coeffs = analog2digital(n, proto[0], proto[1], fc)
make_filter(:xcoeffs, coeffs[0].scale!(proto[2]), :ycoeffs, coeffs[1])
end

add_help(:make_inverse_chebyshev_highpass,
"make_inverse_chebyshev_highpass(n, fc, loss_dB=60.0): \
returns a highpass inverse-Chebyshev filter; N = order, \
FC = cutoff freq (srate = 1.0): make_inverse_chebyshev_highpass(10, 0.1, 120)")
def make_inverse_chebyshev_highpass(n, fc, loss_dB = 60.0)
if n.odd? then n += 1 end
proto = inverse_chebyshev_prototype(n, loss_dB)
hproto = prototype2highpass(n, proto[0], proto[1])
coeffs = analog2digital(n, hproto[0], hproto[1], fc)
make_filter(:xcoeffs, coeffs[0].scale!(proto[2]), :ycoeffs, coeffs[1])
end

add_help(:make_inverse_chebyshev_bandpass,
"make_inverse_chebyshev_bandpass(n, fl, fh, loss_dB=60.0): \
returns a bandpass inverse-Chebyshev filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_inverse_chebyshev_bandpass(8, 0.1, 0.4)")
def make_inverse_chebyshev_bandpass(n, fl, fh, loss_dB = 60.0)
lp = make_inverse_chebyshev_lowpass(n, fh, loss_dB)
hp = make_inverse_chebyshev_highpass(n, fl, loss_dB)
lambda do |y| filter(lp, filter(hp, y)) end
end

add_help(:make_inverse_chebyshev_bandstop,
"make_inverse_chebyshev_bandstop(n, fl, fh, loss_dB=60.0): \
returns a bandstop inverse-Chebyshev filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_inverse_chebyshev_bandstop(8, 0.1, 0.4, 90)")
def make_inverse_chebyshev_bandstop(n, fl, fh, loss_dB = 60.0)
lp = make_inverse_chebyshev_lowpass(n, fl, loss_dB)
hp = make_inverse_chebyshev_highpass(n, fh, loss_dB)
lambda do |y| filter(lp, y) + filter(hp, y) end
end

if provided? :gsl
# requires with-gsl
if defined? gsl_roots
# gsl_roots isn't defined for ruby in snd-xen.c
#
# === BESSEL(-Thompson) ===
#
def fact(n)
x = 1
2.upto(n) do |i| x *= i end
x
end

def bessel_i(n)
Vct.new(n + 1) do |i| fact(2 * n - i) / ((2 ** (n - i)) * fact(i) * fact(n - i)) end
end
def bessel_prototype(n)
len = (n * 3) / 2
num = Vct.new(len)
den = Vct.new(len)
b2 = bessel_i(n)
p = gsl_roots(b2.to_a)
p.map! do |x| x / (b2[0] ** (1.0 / n)) end
j = 0
0.step(n - 1, 2) do |i|
num[j + 0] = 0.0
num[j + 0] = 0.0
num[j + 2] = 1.0
den[j + 0] = 1.0
den[j + 0] = -2.0 * p[i].real
den[j + 2] = (p[i] * p[i + 1]).real
j += 3
end
[num, den]
end
add_help(:make_bessel_lowpass,
"make_bessel_lowpass(n, fc): \
returns a lowpass Bessel filter; N = order, \
FC = cutoff freq (srate = 1.0): make_bessel_lowpass(4, 0.1)")
def make_bessel_lowpass(n, fc)
if n.odd? then n += 1 end
proto = bessel_prototype(n)
coeffs = analog2digital(n, proto[0], proto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_bessel_highpass,
"make_bessel_highpass(n, fc): \
returns a highpass Bessel filter; N = order, \
FC = cutoff freq (srate = 1.0): make_bessel_highpass(8, 0.1)")
def make_bessel_highpass(n, fc)
if n.odd? then n += 1 end
proto = bessel_prototype(n)
hproto = prototype2highpass(n, proto[0], proto[1])
coeffs = analog2digital(n, hproto[0], hproto[1], fc)
make_filter(:xcoeffs, coeffs[0], :ycoeffs, coeffs[1])
end

add_help(:make_bessel_bandpass,
"make_bessel_bandpass(n, fl, fh): \
returns a bandpass Bessel filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_bessel_bandpass(4, 0.1, 0.2)")
def make_bessel_bandpass(n, fl, fh)
lp = make_bessel_lowpass(n, fh)
hp = make_bessel_highpass(n, fl)
lambda do |y| filter(lp, filter(hp, y)) end
end

add_help(:make_bessel_bandstop,
"make_bessel_bandstop(n, fl, fh): \
returns a bandstop Bessel filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_bessel_bandstop(8, 0.1, 0.2)")
def make_bessel_bandstop(n, fl, fh, ripple = 1.0, loss_dB = 60.0)
lp = make_bessel_lowpass(n, fl)
hp = make_bessel_highpass(n, fh)
lambda do |y| filter(lp, y) + filter(hp, y) end
end
end
#
# === ELLIPTIC ===
#

def minimize_function(f, xmin, xmax, arg1 = nil, arg2 = nil)
fx = snd_func(f, xmin, arg1, arg2)
n = 20
x = Vct.new(n)
n.times do |i|
step = (xmax - xmin) / (n - 1.0)
s = xmin
(n - 1).times do |j|
x[j] = s
s += step
end
x[n - 1] = xmax
n.times do |j|
ft = snd_func(f, x[j], arg1, arg2)
if ft < fx
fx = ft
xmax = (j < (n - 1)) ? x[j + 1] : x[n - 1]
xmin = j > 0 ? x[j - 1] : x[0]
end
end
end
(xmax + xmin) / 2.0
end

def findm(m, arg1, arg2)
(gsl_ellipk(m) / gsl_ellipk(1.0 - m) - arg1).abs
end

def findv(u, arg1, arg2)
vals = gsl_ellipj(u, arg1)
(arg2 - vals[0] / vals[1]).abs
end
def elliptic_prototype(n, ripple = 1.0, loss_dB = 60.0)
e = sqrt((10.0 ** (0.1 * ripple)) - 1.0)
k1 = e / sqrt((10.0 ** (0.1 * loss_dB)) - 1.0)
k1p = sqrt(1.0 - k1 * k1)
kr = m = k = 0.0
len = (n * 3) / 2
num = Vct.new(len)
den = Vct.new(len)
g = 1.0
eps = 0.0000001
if (1.0 - k1p * k1p).abs > eps
kr = n.to_f * (gsl_ellipk(k1 * k1) / gsl_ellipk(k1p * k1p))
end
m = minimize_function(:findm, 0.001, 0.999, kr)
k = gsl_ellipk(m)
cv = Vct.new((0.5 * 3 * (n + 1)).floor)
j = 0
0.step(n - 1, 2) do |i|
vals = gsl_ellipj(((i + 1) * k) / n.to_f, m)
sn, cn, dn = vals[0..2]
cv[j + 0] = sn
cv[j + 1] = cn
cv[j + 2] = dn
z = Complex(0.0, -1.0) / (sqrt(m) * sn)
pz = (z * make_rectangular(z.real, -z.imag)).real
g /= pz
num[j + 0] = 1.0
num[j + 1] = -2.0 * z.real
num[j + 2] = pz
j += 3
end
optarg0 = k1p * k1p
optarg1 = 1.0 / e
minf = minimize_function(:findv, 0.0, 1.0 / e, optarg0, optarg1)
v0 = (k * minf) / (n.to_f * gsl_ellipk(k * k1))
vals = gsl_ellipj(v0, 1.0 - m)
sn, cn, dn = vals[0..2]
j = 0
0.step(n - 1, 2) do |i|
p = -(cv[j + 1] * cv[j + 2] * sn * cn + (Complex(0.0, 1.0) * cv[j + 0] * dn)) /
(1.0 - (cv[j + 2] * sn * cv[j + 2] * sn))
pp = (p * make_rectangular(p.real, -p.imag)).real
g *= pp
den[j + 0] = 1.0
den[j + 1] = -2.0 * p.real
den[j + 2] = pp
j += 3
end
g = (g / sqrt(1.0 + e * e)).abs
[num, den, g]
end
# n = order, fc = cutoff freq (srate = 1.0)
add_help(:make_elliptic_lowpass,
"make_elliptic_lowpass(n, fc, ripple=1.0, loss_dB=60.0): \
returns a lowpass elliptic filter; N = order, \
FC = cutoff freq (srate = 1.0): make_elliptic_lowpass(8, 0.25, 0.01, 90)")
def make_elliptic_lowpass(n, fc, ripple = 1.0, loss_dB = 60.0)
if n.odd? then n += 1 end
proto = elliptic_prototype(n, ripple, loss_dB)
coeffs = analog2digital(n, proto[0], proto[1], fc)
make_filter(:xcoeffs, coeffs[0].scale!(proto[2]), :ycoeffs, coeffs[1])
end

add_help(:make_elliptic_highpass,
"make_elliptic_highpass(n, fc, ripple=1.0, loss_dB=60.0): \
returns a highpass elliptic filter; N = order, \
FC = cutoff freq (srate = 1.0): make_elliptic_highpass(8, 0.25, 0.01, 90)")
def make_elliptic_highpass(n, fc, ripple = 1.0, loss_dB = 60.0)
if n.odd? then n += 1 end
proto = elliptic_prototype(n, ripple, loss_dB)
hproto = prototype2highpass(n, proto[0], proto[1])
coeffs = analog2digital(n, hproto[0], hproto[1], fc)
make_filter(:xcoeffs, coeffs[0].scale!(proto[2]), :ycoeffs, coeffs[1])
end

add_help(:make_elliptic_bandpass,
"make_elliptic_bandpass(n, fl, fh, ripple=1.0, loss_dB=60.0): \
returns a bandpass elliptic filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_elliptic_bandpass(6, 0.1, 0.2, 0.1, 90)")
def make_elliptic_bandpass(n, fl, fh, ripple = 1.0, loss_dB = 60.0)
lp = make_elliptic_lowpass(n, fh, ripple, loss_dB)
hp = make_elliptic_highpass(n, fl, ripple, loss_dB)
lambda do |y| filter(lp, filter(hp, y)) end
end

add_help(:make_elliptic_bandstop,
"make_elliptic_bandstop(n, fl, fh, ripple=1.0, loss_dB=60.0): \
returns a bandstop elliptic filter; N = order, \
FL and FH are edge freqs (srate = 1.0): make_elliptic_bandstop(6, 0.1, 0.2, 0.1, 90)")
def make_elliptic_bandstop(n, fl, fh, ripple = 1.0, loss_dB = 60.0)
lp = make_elliptic_lowpass(n, fl, ripple, loss_dB)
hp = make_elliptic_highpass(n, fh, ripple, loss_dB)
lambda do |y| filter(lp, y) + filter(hp, y) end
end
end
end

include Analog_filter

# analog-filter.rb ends here

+ 490
- 0
lib/sndlib/analog-filter.scm View File

@@ -0,0 +1,490 @@
;;; various even order analog filters, based primarily on Anders Johansson's (GPL'd) code
;;;
;;; butterworth-lowpass|highpass|bandstop|bandpass
;;; chebyshev-lowpass|highpass|bandstop|bandpass
;;; inverse-chebyshev-lowpass|highpass|bandstop|bandpass
;;;
;;; if GSL included in Snd:
;;; bessel-lowpass|highpass|bandstop|bandpass
;;; elliptic-lowpass|highpass|bandstop|bandpass
;;;
;;; build Snd with gsl for best results

(provide 'snd-analog-filter.scm)

(define* (analog->digital n num den fz)
(let ((g 1.0)
(Q 1.0)
(wc (tan (* pi fz)))
(c (make-float-vector (* 2 n))))
(define (cascade->canonical A)
;; (cascade->canonical A) converts cascade filter coeffs to canonical form
;; from Orfanidis "Introduction to Signal Processing"
(define (conv M h L x y)
;; x * h -> y
(do ((n 0 (+ n 1)))
((= n (+ L M)))
(let ((sum 0.0)
(start (max 0 (- n L 1)))
(end (min n M)))
(do ((m start (+ m 1)))
((> m end))
(set! sum (+ sum (* (h m) (x (- n m))))))
(set! (y n) sum))))
(let ((K (length A)))
(let ((d (make-float-vector (+ 1 (* 2 K))))
(a1 (make-float-vector (+ 1 (* 2 K)))))
(set! (a1 0) 1.0)
(do ((i 0 (+ i 1)))
((= i K))
(conv 2 (A i) (+ 1 (* 2 i)) a1 d)
(copy d a1 0 (+ 3 (* 2 i))))
a1)))
(do ((i 0 (+ i 2))
(j 0 (+ j 3))
(k 0 (+ k 4)))
((>= i n))
(let* ((nt0 (/ (num j) (* wc wc)))
(nt1 (/ (num (+ j 1)) wc))
(nt2 (num (+ j 2)))
(dt0 (/ (den j) (* wc wc)))
(dt1 (/ (den (+ j 1)) (* wc Q)))
(dt2 (den (+ j 2))))
(let ((kd (+ dt0 dt1 dt2))
(kn (+ nt0 nt1 nt2)))
(set! (c k ) (/ (- (* 2.0 dt2) (* 2.0 dt0)) kd))
(set! (c (+ k 1)) (/ (- (+ dt0 dt2) dt1) kd))
(set! (c (+ k 2)) (/ (- (* 2.0 nt2) (* 2.0 nt0)) kn))
(set! (c (+ k 3)) (/ (- (+ nt0 nt2) nt1) kn))
(set! g (* g (/ kn kd))))))
(do ((a ())
(b ())
(i 0 (+ i 2))
(k 0 (+ k 4))) ; c
((>= i n)
(list (float-vector-scale! (cascade->canonical a) g) ; scale entire numerator because this is the convolved form
(cascade->canonical b)))
(set! a (cons (float-vector (c (+ k 3)) (c (+ k 2)) (c (+ k 3))) a))
(set! b (cons (float-vector 1.0 (c k) (c (+ k 1))) b)))))

(define (prototype->highpass n proto)
(let ((num (car proto))
(den (cadr proto)))
(do ((g 1.0)
(numt (make-float-vector (length num)))
(dent (make-float-vector (length den)))
(k 0 (+ k 2))
(i 0 (+ i 3)))
((>= k n)
(set! (numt 0) g)
(list numt dent))
(set! g (* g (/ (num (+ i 2)) (den (+ i 2)))))
(set! (numt i ) 1.0)
(set! (numt (+ i 1)) (/ (num (+ i 1)) (num (+ i 2))))
(set! (numt (+ i 2)) (/ (num i) (num (+ i 2))))
(set! (dent i ) 1.0)
(set! (dent (+ i 1)) (/ (den (+ i 1)) (den (+ i 2))))
(set! (dent (+ i 2)) (/ (den i) (den (+ i 2)))))))


;;; ---------------- Butterworth ----------------

(define (butterworth-prototype n)
(let ((len (/ (* n 3) 2)))
(do ((num (make-float-vector len))
(den (make-float-vector len))
(w 1 (+ w 2))
(j 0 (+ j 3)))
((>= w n)
(list num den))
(set! (num j) 0.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) 1.0)
(set! (den j) 1.0)
(set! (den (+ j 1)) (* 2.0 (cos (/ (* w pi) (* 2.0 n)))))
(set! (den (+ j 2)) 1.0))))

(define make-butterworth-lowpass
(let ((documentation "(make-butterworth-lowpass n fc) returns a lowpass Buttterworth filter; n = order, fc = cutoff \
freq (srate = 1.0): (make-butterworth-lowpass 8 .1)"))
(lambda (n fc)
;; identical to make-butter-lp except for fc (freq->1.0) fixup
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((proto (butterworth-prototype n)))
(analog->digital n (car proto) (cadr proto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-butterworth-highpass
(let ((documentation "(make-butterworth-highpass n fc) returns a highpass Butterworth filter; n = order, fc = cutoff \
freq (srate = 1.0): (make-butterworth-highpass 8 .1)"))
(lambda (n fc)
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((hproto (prototype->highpass n (butterworth-prototype n))))
(analog->digital n (car hproto) (cadr hproto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-butterworth-bandpass
(let ((documentation "(make-butterworth-bandpass n fl fh) returns a bandpass Butterworth filter; n = order, fl and fh \
are (1.0-based) edge freqs: (make-butterworth-bandpass 4 .1 .2)"))
(lambda (n fl fh)
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-butterworth-lowpass n fh))
(hp (make-butterworth-highpass n fl)))
(lambda (y)
(filter lp (filter hp y)))))))

(define make-butterworth-bandstop
(let ((documentation "(make-butterworth-bandstop n fl fh) returns a bandstop Butterworth filter; n = order, fl and fh \
are (1.0-based) edge freqs: (make-butterworth-bandstop 4 .1 .2)"))
(lambda (n fl fh)
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-butterworth-lowpass n fl))
(hp (make-butterworth-highpass n fh)))
(lambda (y)
(+ (filter lp y) (filter hp y)))))))



;;; ---------------- Chebyshev ----------------

(define* (chebyshev-prototype n (ripple 1.0)) ; ripple in dB (positive)
(let ((len (/ (* n 3) 2)))
(do ((v0 (let ((e (sqrt (- (expt 10.0 (* 0.1 ripple)) 1.0))))
(/ (asinh (/ 1.0 e)) n)))
(num (make-float-vector len))
(den (make-float-vector len))
(k 1.0 (+ k 2.0))
(j 0 (+ j 3)))
((>= k n)
(set! (num 2) (/ (expt 2.0 (- 2 n))
(expt 3.2 (log ripple 10.0)))) ; whatever works...
(list num den))
(let ((u (- (* (sinh v0) (sin (/ (* k pi) (* 2.0 n))))))
(w (* (cosh v0) (cos (/ (* k pi) (* 2.0 n))))))
(set! (num j ) 0.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) 1.0)
(set! (den j ) 1.0)
(set! (den (+ j 1)) (* -2.0 u))
(set! (den (+ j 2)) (+ (* u u) (* w w)))))))

(define make-chebyshev-lowpass
(let ((documentation "(make-chebyshev-lowpass n fc (ripple 1.0)) returns a lowpass Chebyshev filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-chebyshev-lowpass 8 .1)"))
(lambda* (n fc (ripple 1.0))
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((proto (chebyshev-prototype n ripple)))
(analog->digital n (car proto) (cadr proto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-chebyshev-highpass
(let ((documentation "(make-chebyshev-highpass n fc (ripple 1.0)) returns a highpass Chebyshev filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-chebyshev-highpass 8 .1 .01)"))
(lambda* (n fc (ripple 1.0))
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((hproto (prototype->highpass n (chebyshev-prototype n ripple))))
(analog->digital n (car hproto) (cadr hproto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-chebyshev-bandpass
(let ((documentation "(make-chebyshev-bandpass n fl fh (ripple 1.0)) returns a bandpass Chebyshev filter; n = order, \
fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandpass 4 .1 .2)"))
(lambda* (n fl fh (ripple 1.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-chebyshev-lowpass n fh ripple))
(hp (make-chebyshev-highpass n fl ripple)))
(lambda (y)
(filter lp (filter hp y)))))))

(define make-chebyshev-bandstop
(let ((documentation "(make-chebyshev-bandstop n fl fh (ripple 1.0)) returns a bandstop Chebyshev filter; n = order, \
fl and fh = edge freqs (srate = 1.0): (make-chebyshev-bandstop 8 .1 .4 .01)"))
(lambda* (n fl fh (ripple 1.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-chebyshev-lowpass n fl ripple))
(hp (make-chebyshev-highpass n fh ripple)))
(lambda (y)
(+ (filter lp y) (filter hp y)))))))



;;; ---------------- inverse Chebyshev ----------------

(define* (inverse-chebyshev-prototype n (loss-dB 60.0)) ; stopband loss
(let ((len (/ (* n 3) 2)))
(do ((v0 (let ((e (sqrt (/ 1.0 (- (expt 10.0 (* 0.1 loss-dB)) 1.0)))))
(/ (asinh (/ 1.0 e)) n)))
(num (make-float-vector len))
(den (make-float-vector len))
(pl 0.0)
(L 1.0 (+ L 2.0))
(j 0 (+ j 3)))
((>= L n)
(list num den
(expt 1.122 (- loss-dB)))) ; argh
(let ((u (- (* (sinh v0) (sin (/ (* L pi) (* 2.0 n))))))
(w (* (cosh v0) (cos (/ (* L pi) (* 2.0 n)))))
(t (/ 1.0 (sin (/ (* (+ L pl) pi) (* 2.0 n))))))
(set! (num j ) 1.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) (* t t))
(set! (den j ) 1.0)
(set! (den (+ j 1)) (/ (* -2.0 u) (+ (* u u) (* w w))))
(set! (den (+ j 2)) (/ 1.0 (+ (* u u) (* w w))))))))

(define make-inverse-chebyshev-lowpass
(let ((documentation "(make-inverse-chebyshev-lowpass n fc (loss-dB 60.0)) returns a lowpass inverse-Chebyshev filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-lowpass 10 .4 120)"))
(lambda* (n fc (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let* ((proto (inverse-chebyshev-prototype n loss-dB))
(coeffs (analog->digital n (car proto) (cadr proto) fc)))
(make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))

(define make-inverse-chebyshev-highpass
(let ((documentation "(make-inverse-chebyshev-highpass n fc (loss-dB 60.0)) returns a highpass inverse-Chebyshev filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-inverse-chebyshev-highpass 10 .1 120)"))
(lambda* (n fc (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let* ((proto (inverse-chebyshev-prototype n loss-dB))
(coeffs (let ((hproto (prototype->highpass n proto)))
(analog->digital n (car hproto) (cadr hproto) fc))))
(make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))

(define make-inverse-chebyshev-bandpass
(let ((documentation "(make-inverse-chebyshev-bandpass n fl fh (loss-dB 60.0)) returns a bandpass inverse-Chebyshev filter; n = order, \
fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandpass 8 .1 .4)"))
(lambda* (n fl fh (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-inverse-chebyshev-lowpass n fh loss-dB))
(hp (make-inverse-chebyshev-highpass n fl loss-dB)))
(lambda (y) (filter lp (filter hp y)))))))

(define make-inverse-chebyshev-bandstop
(let ((documentation "(make-inverse-chebyshev-bandstop n fl fh (loss-dB 60.0)) returns a bandstop inverse-Chebyshev filter; n = order, \
fl and fh are edge freqs (srate=1.0): (make-inverse-chebyshev-bandstop 8 .1 .4 90)"))
(lambda* (n fl fh (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-inverse-chebyshev-lowpass n fl loss-dB))
(hp (make-inverse-chebyshev-highpass n fh loss-dB)))
(lambda (y) (+ (filter lp y) (filter hp y)))))))



;;; ---------------- Bessel (-Thompson) ----------------

(define (bessel-prototype n)
(define (bessel-i n)

(define (fact n)
(do ((x 1)
(i 2 (+ i 1)))
((> i n) x)
(set! x (* x i))))
;; this form overflows if we don't have bignums
;; (define (bessel-i n)
;; (let ((cs (make-float-vector (+ n 1))))
;; (do ((i 0 (+ i 1)))
;; ((> i n))
;; (set! (cs i) (/ (fact (- (* 2 n) i))
;; (* (expt 2 (- n i))
;; (fact i)
;; (fact (- n i))))))
;; cs))
(do ((cs (make-float-vector (+ n 1)))
(i 0 (+ i 1)))
((> i n) cs)
(do ((val (/ 1.0 (* (fact i) (expt 2 (- n i)))))
(k 1 (+ k 1))
(f (- n i -1) (+ f 1))) ; (f (+ 1 (- n i)) (+ 1 f))
((> k n)
(set! (cs i) val))
(set! val (* val f)))))
(let ((len (/ (* n 3) 2)))
(let ((num (make-float-vector len))
(den (make-float-vector len))
(b2 (bessel-i n)))
(let ((p (gsl-roots (copy b2 (make-vector (length b2))))))
(do ((i 0 (+ i 1)))
((= i n))
(set! (p i) (/ (p i) (expt (b2 0) (/ 1.0 n)))))
(do ((j 0 (+ j 3))
(i 0 (+ i 2)))
((>= i n))
(set! (num j ) 0.0)
(set! (num (+ j 1)) 0.0)
(set! (num (+ j 2)) 1.0)
(set! (den j ) 1.0)
(set! (den (+ j 1)) (* -2.0 (real-part (p i))))
(set! (den (+ j 2)) (real-part (* (p i) (p (+ i 1)))))))
(list num den))))

(define make-bessel-lowpass
(let ((documentation "(make-bessel-lowpass n fc) returns a lowpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-lowpass 4 .1)"))
(lambda (n fc)
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((proto (bessel-prototype n)))
(analog->digital n (car proto) (cadr proto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-bessel-highpass
(let ((documentation "(make-bessel-highpass n fc) returns a highpass Bessel filter; n = order, fc = cutoff freq (srate = 1.0): (make-bessel-highpass 8 .1)"))
(lambda* (n fc)
(if (odd? n) (set! n (+ n 1)))
(let ((coeffs (let ((hproto (prototype->highpass n (bessel-prototype n))))
(analog->digital n (car hproto) (cadr hproto) fc))))
(make-filter :xcoeffs (car coeffs) :ycoeffs (cadr coeffs))))))

(define make-bessel-bandpass
(let ((documentation "(make-bessel-bandpass n fl fh) returns a bandpass Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandpass 4 .1 .2)"))
(lambda* (n fl fh)
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-bessel-lowpass n fh))
(hp (make-bessel-highpass n fl)))
(lambda (y)
(filter lp (filter hp y)))))))

(define make-bessel-bandstop
(let ((documentation "(make-bessel-bandstop n fl fh) returns a bandstop Bessel filter; n = order, fl and fh are edge freqs (srate=1.0): (make-bessel-bandstop 8 .1 .2)"))
(lambda* (n fl fh)
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-bessel-lowpass n fl))
(hp (make-bessel-highpass n fh)))
(lambda (y)
(+ (filter lp y) (filter hp y)))))))



;;; ---------------- Elliptic ----------------

(define* (elliptic-prototype n (ripple 1.0) (loss-dB 60.0))
(define* (minimize-function f xmin xmax arg1 arg2)
(let* ((n 20)
(x (make-float-vector n))
(fx (f xmin arg1 arg2)))
(do ((i 0 (+ i 1)))
((= i n))
(do ((step (/ (- xmax xmin) (- n 1.0)))
(j 0 (+ j 1))
(s xmin (+ s step)))
((= j (- n 1)))
(float-vector-set! x j s))
(set! (x (- n 1)) xmax)
(do ((j 0 (+ j 1)))
((= j n))
(let ((ft (f (x j) arg1 arg2)))
(if (< ft fx)
(begin
(set! fx ft)
(set! xmax (x (if (< j (- n 1)) (+ j 1) (- n 1))))
(set! xmin (x (if (> j 0) (- j 1) 0))))))))
(/ (+ xmax xmin) 2.0)))
(define (findm m arg1 arg2)
(abs (- (/ (gsl-ellipk m) (gsl-ellipk (- 1.0 m))) arg1)))
(define (findv u arg1 arg2)
(let ((vals (gsl-ellipj u arg1)))
(abs (- arg2 (/ (car vals) (cadr vals))))))
(let ((e (sqrt (- (expt 10.0 (* 0.1 ripple)) 1.0))))
(let ((k1 (/ e (sqrt (- (expt 10.0 (* 0.1 loss-dB)) 1.0))))
(len (/ (* n 3) 2)))
(let ((k1p (sqrt (- 1.0 (* k1 k1))))
(m 0.0)
(num (make-float-vector len))
(den (make-float-vector len))
(g 1.0))
(let ((eps 0.0000001)
(kr 0.0))
(if (> (abs (- 1.0 (* k1p k1p))) eps)
(set! kr (* n (/ (gsl-ellipk (* k1 k1)) (gsl-ellipk (* k1p k1p))))))
(set! m (minimize-function findm 0.001 0.999 kr)))
(let ((k (gsl-ellipk m))
(cv (make-float-vector (floor (* 0.5 3 (+ n 1))))))
(do ((i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
(let ((vals (gsl-ellipj (/ (* (+ i 1) k) (* 1.0 n)) m)))
(let ((sn (car vals))
(cn (cadr vals))
(dn (caddr vals)))
(set! (cv j ) sn)
(set! (cv (+ j 1)) cn)
(set! (cv (+ j 2)) dn)
(let* ((z (/ 0.0-i (* (sqrt m) sn)))
(pz (real-part (* z (complex (real-part z) (- (imag-part z)))))))
(set! g (/ g pz))
(set! (num j ) 1.0)
(set! (num (+ j 1)) (* -2.0 (real-part z)))
(set! (num (+ j 2)) pz)))))
(let ((vals (let ((v0 (let ((minf (minimize-function findv 0.0 (/ 1.0 e) (* k1p k1p) (/ 1.0 e))))
(/ (* k minf)
(* n (gsl-ellipk (* k k1)))))))
(gsl-ellipj v0 (- 1.0 m)))))
(do ((sn (car vals))
(cn (cadr vals))
(dn (caddr vals))
(i 0 (+ i 2))
(j 0 (+ j 3)))
((>= i n))
(let* ((p (/ (- (+ (* (cv (+ j 1)) (cv (+ j 2)) sn cn)
(* 0.0+i (cv j) dn)))
(- 1.0 (* (cv (+ j 2)) sn
(cv (+ j 2)) sn))))
(pp (real-part (* p (complex (real-part p) (- (imag-part p)))))))
(set! g (* g pp))
(set! (den j ) 1.0)
(set! (den (+ j 1)) (* -2.0 (real-part p)))
(set! (den (+ j 2)) pp)))))
(list num den (abs (/ g (sqrt (+ 1.0 (* e e))))))))))

(define make-elliptic-lowpass
(let ((documentation "(make-elliptic-lowpass n fc (ripple 1.0) (loss-dB 60.0)) returns a lowpass elliptic filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-elliptic-lowpass 8 .25 .01 90)"))
(lambda* (n fc (ripple 1.0) (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let* ((proto (elliptic-prototype n ripple loss-dB))
(coeffs (analog->digital n (car proto) (cadr proto) fc)))
(make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))

(define make-elliptic-highpass
(let ((documentation "(make-elliptic-highpass n fc (ripple 1.0) (loss-dB 60.0)) returns a highpass elliptic filter; n = order, \
fc = cutoff freq (srate = 1.0): (make-elliptic-highpass 8 .25 .01 90)"))
(lambda* (n fc (ripple 1.0) (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let* ((proto (elliptic-prototype n ripple loss-dB))
(coeffs (let ((hproto (prototype->highpass n proto)))
(analog->digital n (car hproto) (cadr hproto) fc))))
(make-filter :xcoeffs (float-vector-scale! (car coeffs) (caddr proto)) :ycoeffs (cadr coeffs))))))

(define make-elliptic-bandpass
(let ((documentation "(make-elliptic-bandpass n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandpass elliptic filter; n = order, \
fl and fh are edge freqs (srate=1.0): (make-elliptic-bandpass 6 .1 .2 .1 90)"))
(lambda* (n fl fh (ripple 1.0) (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-elliptic-lowpass n fh ripple loss-dB))
(hp (make-elliptic-highpass n fl ripple loss-dB)))
(lambda (y)
(filter lp (filter hp y)))))))

(define make-elliptic-bandstop
(let ((documentation "(make-elliptic-bandstop n fl fh (ripple 1.0) (loss-dB 60.0)) returns a bandstop elliptic filter; n = order, \
fl and fh are edge freqs (srate=1.0): (make-elliptic-bandstop 6 .1 .2 .1 90)"))
(lambda* (n fl fh (ripple 1.0) (loss-dB 60.0))
(if (odd? n) (set! n (+ n 1)))
(let ((lp (make-elliptic-lowpass n fl ripple loss-dB))
(hp (make-elliptic-highpass n fh ripple loss-dB)))
(lambda (y)
(+ (filter lp y) (filter hp y)))))))


+ 10913
- 0
lib/sndlib/animals.scm
File diff suppressed because it is too large
View File


+ 5598
- 0
lib/sndlib/audio.c
File diff suppressed because it is too large
View File


+ 6416
- 0
lib/sndlib/autom4te.cache/output.0
File diff suppressed because it is too large
View File


+ 5651
- 0
lib/sndlib/autom4te.cache/output.1
File diff suppressed because it is too large
View File


+ 148
- 0
lib/sndlib/autom4te.cache/requests View File

@@ -0,0 +1,148 @@
# This file was generated.
# It contains the lists of macros which have been traced.
# It can be safely removed.

@request = (
bless( [
'0',
1,
[
'/usr/local/share/autoconf'
],
[
'/usr/local/share/autoconf/autoconf/autoconf.m4f',
'aclocal.m4',
'configure.ac'
],
{
'_LT_AC_TAGCONFIG' => 1,
'AM_PROG_F77_C_O' => 1,
'AC_INIT' => 1,
'm4_pattern_forbid' => 1,
'_AM_COND_IF' => 1,
'AC_CANONICAL_TARGET' => 1,
'AC_SUBST' => 1,
'AC_CONFIG_LIBOBJ_DIR' => 1,
'AC_FC_SRCEXT' => 1,
'AC_CANONICAL_HOST' => 1,
'AC_PROG_LIBTOOL' => 1,
'AM_INIT_AUTOMAKE' => 1,
'AM_PATH_GUILE' => 1,
'AC_CONFIG_SUBDIRS' => 1,
'AM_AUTOMAKE_VERSION' => 1,
'LT_CONFIG_LTDL_DIR' => 1,
'AC_REQUIRE_AUX_FILE' => 1,
'AC_CONFIG_LINKS' => 1,
'm4_sinclude' => 1,
'LT_SUPPORTED_TAG' => 1,
'AM_MAINTAINER_MODE' => 1,
'AM_NLS' => 1,
'AC_FC_PP_DEFINE' => 1,
'AM_GNU_GETTEXT_INTL_SUBDIR' => 1,
'AM_MAKEFILE_INCLUDE' => 1,
'_m4_warn' => 1,
'AM_PROG_CXX_C_O' => 1,
'_AM_COND_ENDIF' => 1,
'_AM_MAKEFILE_INCLUDE' => 1,
'AM_ENABLE_MULTILIB' => 1,
'AM_SILENT_RULES' => 1,
'AM_PROG_MOC' => 1,
'AC_CONFIG_FILES' => 1,
'include' => 1,
'LT_INIT' => 1,
'AM_PROG_AR' => 1,
'AM_GNU_GETTEXT' => 1,
'AC_LIBSOURCE' => 1,
'AM_PROG_FC_C_O' => 1,
'AC_CANONICAL_BUILD' => 1,
'AC_FC_FREEFORM' => 1,
'AH_OUTPUT' => 1,
'AC_FC_PP_SRCEXT' => 1,
'_AM_SUBST_NOTMAKE' => 1,
'AC_CONFIG_AUX_DIR' => 1,
'sinclude' => 1,
'AM_PROG_CC_C_O' => 1,
'm4_pattern_allow' => 1,
'AM_XGETTEXT_OPTION' => 1,
'AC_CANONICAL_SYSTEM' => 1,
'AM_CONDITIONAL' => 1,
'AC_CONFIG_HEADERS' => 1,
'AC_DEFINE_TRACE_LITERAL' => 1,
'AM_POT_TOOLS' => 1,
'm4_include' => 1,
'_AM_COND_ELSE' => 1,
'AC_SUBST_TRACE' => 1
}
], 'Autom4te::Request' ),
bless( [
'1',
1,
[
'/usr/local/share/autoconf'
],
[
'/usr/local/share/autoconf/autoconf/autoconf.m4f',
'configure.ac'
],
{
'AM_PROG_F77_C_O' => 1,
'_LT_AC_TAGCONFIG' => 1,
'm4_pattern_forbid' => 1,
'AC_INIT' => 1,
'AC_CANONICAL_TARGET' => 1,
'_AM_COND_IF' => 1,
'AC_CONFIG_LIBOBJ_DIR' => 1,
'AC_SUBST' => 1,
'AC_CANONICAL_HOST' => 1,
'AC_FC_SRCEXT' => 1,
'AC_PROG_LIBTOOL' => 1,
'AM_INIT_AUTOMAKE' => 1,
'AC_CONFIG_SUBDIRS' => 1,
'AM_PATH_GUILE' => 1,
'AM_AUTOMAKE_VERSION' => 1,
'LT_CONFIG_LTDL_DIR' => 1,
'AC_CONFIG_LINKS' => 1,
'AC_REQUIRE_AUX_FILE' => 1,
'LT_SUPPORTED_TAG' => 1,
'm4_sinclude' => 1,
'AM_MAINTAINER_MODE' => 1,
'AM_NLS' => 1,
'AC_FC_PP_DEFINE' => 1,
'AM_GNU_GETTEXT_INTL_SUBDIR' => 1,
'_m4_warn' => 1,
'AM_MAKEFILE_INCLUDE' => 1,
'AM_PROG_CXX_C_O' => 1,
'_AM_MAKEFILE_INCLUDE' => 1,
'_AM_COND_ENDIF' => 1,
'AM_ENABLE_MULTILIB' => 1,
'AM_SILENT_RULES' => 1,
'AM_PROG_MOC' => 1,
'AC_CONFIG_FILES' => 1,
'LT_INIT' => 1,
'include' => 1,
'AM_GNU_GETTEXT' => 1,
'AM_PROG_AR' => 1,
'AC_LIBSOURCE' => 1,
'AC_CANONICAL_BUILD' => 1,
'AM_PROG_FC_C_O' => 1,
'AC_FC_FREEFORM' => 1,
'AC_FC_PP_SRCEXT' => 1,
'AH_OUTPUT' => 1,
'AC_CONFIG_AUX_DIR' => 1,
'_AM_SUBST_NOTMAKE' => 1,
'm4_pattern_allow' => 1,
'AM_PROG_CC_C_O' => 1,
'sinclude' => 1,
'AM_CONDITIONAL' => 1,
'AC_CANONICAL_SYSTEM' => 1,
'AM_XGETTEXT_OPTION' => 1,
'AC_CONFIG_HEADERS' => 1,
'AC_DEFINE_TRACE_LITERAL' => 1,
'AM_POT_TOOLS' => 1,
'm4_include' => 1,
'_AM_COND_ELSE' => 1,
'AC_SUBST_TRACE' => 1
}
], 'Autom4te::Request' )
);


+ 445
- 0
lib/sndlib/autom4te.cache/traces.0 View File

@@ -0,0 +1,445 @@
m4trace:configure.ac:5: -1- AC_INIT([sndlib], [20], [bil@ccrma.stanford.edu], [ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz])
m4trace:configure.ac:5: -1- m4_pattern_forbid([^_?A[CHUM]_])
m4trace:configure.ac:5: -1- m4_pattern_forbid([_AC_])
m4trace:configure.ac:5: -1- m4_pattern_forbid([^LIBOBJS$], [do not use LIBOBJS directly, use AC_LIBOBJ (see section `AC_LIBOBJ vs LIBOBJS'])
m4trace:configure.ac:5: -1- m4_pattern_allow([^AS_FLAGS$])
m4trace:configure.ac:5: -1- m4_pattern_forbid([^_?m4_])
m4trace:configure.ac:5: -1- m4_pattern_forbid([^dnl$])
m4trace:configure.ac:5: -1- m4_pattern_forbid([^_?AS_])
m4trace:configure.ac:5: -1- AC_SUBST([SHELL])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([SHELL])
m4trace:configure.ac:5: -1- m4_pattern_allow([^SHELL$])
m4trace:configure.ac:5: -1- AC_SUBST([PATH_SEPARATOR])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PATH_SEPARATOR])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PATH_SEPARATOR$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_NAME], [m4_ifdef([AC_PACKAGE_NAME], ['AC_PACKAGE_NAME'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_NAME])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_NAME$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_TARNAME], [m4_ifdef([AC_PACKAGE_TARNAME], ['AC_PACKAGE_TARNAME'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_TARNAME])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_TARNAME$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_VERSION], [m4_ifdef([AC_PACKAGE_VERSION], ['AC_PACKAGE_VERSION'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_VERSION])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_VERSION$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_STRING], [m4_ifdef([AC_PACKAGE_STRING], ['AC_PACKAGE_STRING'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_STRING])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_STRING$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_BUGREPORT], [m4_ifdef([AC_PACKAGE_BUGREPORT], ['AC_PACKAGE_BUGREPORT'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_BUGREPORT])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_BUGREPORT$])
m4trace:configure.ac:5: -1- AC_SUBST([PACKAGE_URL], [m4_ifdef([AC_PACKAGE_URL], ['AC_PACKAGE_URL'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([PACKAGE_URL])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_URL$])
m4trace:configure.ac:5: -1- AC_SUBST([exec_prefix], [NONE])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([exec_prefix])
m4trace:configure.ac:5: -1- m4_pattern_allow([^exec_prefix$])
m4trace:configure.ac:5: -1- AC_SUBST([prefix], [NONE])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([prefix])
m4trace:configure.ac:5: -1- m4_pattern_allow([^prefix$])
m4trace:configure.ac:5: -1- AC_SUBST([program_transform_name], [s,x,x,])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([program_transform_name])
m4trace:configure.ac:5: -1- m4_pattern_allow([^program_transform_name$])
m4trace:configure.ac:5: -1- AC_SUBST([bindir], ['${exec_prefix}/bin'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([bindir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^bindir$])
m4trace:configure.ac:5: -1- AC_SUBST([sbindir], ['${exec_prefix}/sbin'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([sbindir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^sbindir$])
m4trace:configure.ac:5: -1- AC_SUBST([libexecdir], ['${exec_prefix}/libexec'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([libexecdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^libexecdir$])
m4trace:configure.ac:5: -1- AC_SUBST([datarootdir], ['${prefix}/share'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([datarootdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^datarootdir$])
m4trace:configure.ac:5: -1- AC_SUBST([datadir], ['${datarootdir}'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([datadir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^datadir$])
m4trace:configure.ac:5: -1- AC_SUBST([sysconfdir], ['${prefix}/etc'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([sysconfdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^sysconfdir$])
m4trace:configure.ac:5: -1- AC_SUBST([sharedstatedir], ['${prefix}/com'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([sharedstatedir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^sharedstatedir$])
m4trace:configure.ac:5: -1- AC_SUBST([localstatedir], ['${prefix}/var'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([localstatedir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^localstatedir$])
m4trace:configure.ac:5: -1- AC_SUBST([includedir], ['${prefix}/include'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([includedir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^includedir$])
m4trace:configure.ac:5: -1- AC_SUBST([oldincludedir], ['/usr/include'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([oldincludedir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^oldincludedir$])
m4trace:configure.ac:5: -1- AC_SUBST([docdir], [m4_ifset([AC_PACKAGE_TARNAME],
['${datarootdir}/doc/${PACKAGE_TARNAME}'],
['${datarootdir}/doc/${PACKAGE}'])])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([docdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^docdir$])
m4trace:configure.ac:5: -1- AC_SUBST([infodir], ['${datarootdir}/info'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([infodir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^infodir$])
m4trace:configure.ac:5: -1- AC_SUBST([htmldir], ['${docdir}'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([htmldir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^htmldir$])
m4trace:configure.ac:5: -1- AC_SUBST([dvidir], ['${docdir}'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([dvidir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^dvidir$])
m4trace:configure.ac:5: -1- AC_SUBST([pdfdir], ['${docdir}'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([pdfdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^pdfdir$])
m4trace:configure.ac:5: -1- AC_SUBST([psdir], ['${docdir}'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([psdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^psdir$])
m4trace:configure.ac:5: -1- AC_SUBST([libdir], ['${exec_prefix}/lib'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([libdir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^libdir$])
m4trace:configure.ac:5: -1- AC_SUBST([localedir], ['${datarootdir}/locale'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([localedir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^localedir$])
m4trace:configure.ac:5: -1- AC_SUBST([mandir], ['${datarootdir}/man'])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([mandir])
m4trace:configure.ac:5: -1- m4_pattern_allow([^mandir$])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_NAME])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_NAME$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_NAME], [/* Define to the full name of this package. */
@%:@undef PACKAGE_NAME])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_TARNAME])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_TARNAME$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_TARNAME], [/* Define to the one symbol short name of this package. */
@%:@undef PACKAGE_TARNAME])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_VERSION])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_VERSION$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_VERSION], [/* Define to the version of this package. */
@%:@undef PACKAGE_VERSION])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_STRING])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_STRING$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_STRING], [/* Define to the full name and version of this package. */
@%:@undef PACKAGE_STRING])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_BUGREPORT])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_BUGREPORT$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_BUGREPORT], [/* Define to the address where bug reports for this package should be sent. */
@%:@undef PACKAGE_BUGREPORT])
m4trace:configure.ac:5: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_URL])
m4trace:configure.ac:5: -1- m4_pattern_allow([^PACKAGE_URL$])
m4trace:configure.ac:5: -1- AH_OUTPUT([PACKAGE_URL], [/* Define to the home page for this package. */
@%:@undef PACKAGE_URL])
m4trace:configure.ac:5: -1- AC_SUBST([DEFS])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([DEFS])
m4trace:configure.ac:5: -1- m4_pattern_allow([^DEFS$])
m4trace:configure.ac:5: -1- AC_SUBST([ECHO_C])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([ECHO_C])
m4trace:configure.ac:5: -1- m4_pattern_allow([^ECHO_C$])
m4trace:configure.ac:5: -1- AC_SUBST([ECHO_N])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([ECHO_N])
m4trace:configure.ac:5: -1- m4_pattern_allow([^ECHO_N$])
m4trace:configure.ac:5: -1- AC_SUBST([ECHO_T])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([ECHO_T])
m4trace:configure.ac:5: -1- m4_pattern_allow([^ECHO_T$])
m4trace:configure.ac:5: -1- AC_SUBST([LIBS])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([LIBS])
m4trace:configure.ac:5: -1- m4_pattern_allow([^LIBS$])
m4trace:configure.ac:5: -1- AC_SUBST([build_alias])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([build_alias])
m4trace:configure.ac:5: -1- m4_pattern_allow([^build_alias$])
m4trace:configure.ac:5: -1- AC_SUBST([host_alias])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([host_alias])
m4trace:configure.ac:5: -1- m4_pattern_allow([^host_alias$])
m4trace:configure.ac:5: -1- AC_SUBST([target_alias])
m4trace:configure.ac:5: -1- AC_SUBST_TRACE([target_alias])
m4trace:configure.ac:5: -1- m4_pattern_allow([^target_alias$])
m4trace:configure.ac:8: -1- AC_CANONICAL_HOST
m4trace:configure.ac:8: -1- AC_CANONICAL_BUILD
m4trace:configure.ac:8: -1- AC_REQUIRE_AUX_FILE([config.sub])
m4trace:configure.ac:8: -1- AC_REQUIRE_AUX_FILE([config.guess])
m4trace:configure.ac:8: -1- AC_SUBST([build], [$ac_cv_build])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([build])
m4trace:configure.ac:8: -1- m4_pattern_allow([^build$])
m4trace:configure.ac:8: -1- AC_SUBST([build_cpu], [$[1]])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([build_cpu])
m4trace:configure.ac:8: -1- m4_pattern_allow([^build_cpu$])
m4trace:configure.ac:8: -1- AC_SUBST([build_vendor], [$[2]])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([build_vendor])
m4trace:configure.ac:8: -1- m4_pattern_allow([^build_vendor$])
m4trace:configure.ac:8: -1- AC_SUBST([build_os])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([build_os])
m4trace:configure.ac:8: -1- m4_pattern_allow([^build_os$])
m4trace:configure.ac:8: -1- AC_SUBST([host], [$ac_cv_host])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([host])
m4trace:configure.ac:8: -1- m4_pattern_allow([^host$])
m4trace:configure.ac:8: -1- AC_SUBST([host_cpu], [$[1]])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([host_cpu])
m4trace:configure.ac:8: -1- m4_pattern_allow([^host_cpu$])
m4trace:configure.ac:8: -1- AC_SUBST([host_vendor], [$[2]])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([host_vendor])
m4trace:configure.ac:8: -1- m4_pattern_allow([^host_vendor$])
m4trace:configure.ac:8: -1- AC_SUBST([host_os])
m4trace:configure.ac:8: -1- AC_SUBST_TRACE([host_os])
m4trace:configure.ac:8: -1- m4_pattern_allow([^host_os$])
m4trace:configure.ac:9: -1- AC_CONFIG_FILES([makefile])
m4trace:configure.ac:10: -1- AC_CONFIG_FILES([sndlib-config], [chmod +x sndlib-config])
m4trace:configure.ac:11: -1- AC_CONFIG_FILES([sndins/Makefile])
m4trace:configure.ac:12: -1- AC_CONFIG_HEADERS([unix-config.h])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([LDFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([LDFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^LDFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([LIBS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([LIBS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^LIBS$])
m4trace:configure.ac:13: -1- AC_SUBST([CPPFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CPPFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CPPFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([ac_ct_CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([ac_ct_CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^ac_ct_CC$])
m4trace:configure.ac:13: -1- AC_SUBST([EXEEXT], [$ac_cv_exeext])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([EXEEXT])
m4trace:configure.ac:13: -1- m4_pattern_allow([^EXEEXT$])
m4trace:configure.ac:13: -1- AC_SUBST([OBJEXT], [$ac_cv_objext])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([OBJEXT])
m4trace:configure.ac:13: -1- m4_pattern_allow([^OBJEXT$])
m4trace:configure.ac:14: -1- AC_SUBST([CPP])
m4trace:configure.ac:14: -1- AC_SUBST_TRACE([CPP])
m4trace:configure.ac:14: -1- m4_pattern_allow([^CPP$])
m4trace:configure.ac:14: -1- AC_SUBST([CPPFLAGS])
m4trace:configure.ac:14: -1- AC_SUBST_TRACE([CPPFLAGS])
m4trace:configure.ac:14: -1- m4_pattern_allow([^CPPFLAGS$])
m4trace:configure.ac:14: -1- AC_SUBST([CPP])
m4trace:configure.ac:14: -1- AC_SUBST_TRACE([CPP])
m4trace:configure.ac:14: -1- m4_pattern_allow([^CPP$])
m4trace:configure.ac:14: -1- AC_SUBST([GREP])
m4trace:configure.ac:14: -1- AC_SUBST_TRACE([GREP])
m4trace:configure.ac:14: -1- m4_pattern_allow([^GREP$])
m4trace:configure.ac:14: -1- AC_SUBST([EGREP])
m4trace:configure.ac:14: -1- AC_SUBST_TRACE([EGREP])
m4trace:configure.ac:14: -1- m4_pattern_allow([^EGREP$])
m4trace:configure.ac:14: -1- AC_DEFINE_TRACE_LITERAL([STDC_HEADERS])
m4trace:configure.ac:14: -1- m4_pattern_allow([^STDC_HEADERS$])
m4trace:configure.ac:14: -1- AH_OUTPUT([STDC_HEADERS], [/* Define to 1 if you have the ANSI C header files. */
@%:@undef STDC_HEADERS])
m4trace:configure.ac:40: -1- AC_SUBST([PKG_CONFIG])
m4trace:configure.ac:40: -1- AC_SUBST_TRACE([PKG_CONFIG])
m4trace:configure.ac:40: -1- m4_pattern_allow([^PKG_CONFIG$])
m4trace:configure.ac:50: -1- AC_REQUIRE_AUX_FILE([install-sh])
m4trace:configure.ac:50: -1- AC_SUBST([INSTALL_PROGRAM])
m4trace:configure.ac:50: -1- AC_SUBST_TRACE([INSTALL_PROGRAM])
m4trace:configure.ac:50: -1- m4_pattern_allow([^INSTALL_PROGRAM$])
m4trace:configure.ac:50: -1- AC_SUBST([INSTALL_SCRIPT])
m4trace:configure.ac:50: -1- AC_SUBST_TRACE([INSTALL_SCRIPT])
m4trace:configure.ac:50: -1- m4_pattern_allow([^INSTALL_SCRIPT$])
m4trace:configure.ac:50: -1- AC_SUBST([INSTALL_DATA])
m4trace:configure.ac:50: -1- AC_SUBST_TRACE([INSTALL_DATA])
m4trace:configure.ac:50: -1- m4_pattern_allow([^INSTALL_DATA$])
m4trace:configure.ac:53: -1- AH_OUTPUT([HAVE_LIBM], [/* Define to 1 if you have the `m\' library (-lm). */
@%:@undef HAVE_LIBM])
m4trace:configure.ac:53: -1- AC_DEFINE_TRACE_LITERAL([HAVE_LIBM])
m4trace:configure.ac:53: -1- m4_pattern_allow([^HAVE_LIBM$])
m4trace:configure.ac:54: -1- AH_OUTPUT([HAVE_LIBC], [/* Define to 1 if you have the `c\' library (-lc). */
@%:@undef HAVE_LIBC])
m4trace:configure.ac:54: -1- AC_DEFINE_TRACE_LITERAL([HAVE_LIBC])
m4trace:configure.ac:54: -1- m4_pattern_allow([^HAVE_LIBC$])
m4trace:configure.ac:56: -1- AH_OUTPUT([WORDS_BIGENDIAN], [/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
significant byte first (like Motorola and SPARC, unlike Intel). */
#if defined AC_APPLE_UNIVERSAL_BUILD
# if defined __BIG_ENDIAN__
# define WORDS_BIGENDIAN 1
# endif
#else
# ifndef WORDS_BIGENDIAN
# undef WORDS_BIGENDIAN
# endif
#endif])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_SYS_TYPES_H], [/* Define to 1 if you have the <sys/types.h> header file. */
@%:@undef HAVE_SYS_TYPES_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_SYS_STAT_H], [/* Define to 1 if you have the <sys/stat.h> header file. */
@%:@undef HAVE_SYS_STAT_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_STDLIB_H], [/* Define to 1 if you have the <stdlib.h> header file. */
@%:@undef HAVE_STDLIB_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_STRING_H], [/* Define to 1 if you have the <string.h> header file. */
@%:@undef HAVE_STRING_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_MEMORY_H], [/* Define to 1 if you have the <memory.h> header file. */
@%:@undef HAVE_MEMORY_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_STRINGS_H], [/* Define to 1 if you have the <strings.h> header file. */
@%:@undef HAVE_STRINGS_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_INTTYPES_H], [/* Define to 1 if you have the <inttypes.h> header file. */
@%:@undef HAVE_INTTYPES_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_STDINT_H], [/* Define to 1 if you have the <stdint.h> header file. */
@%:@undef HAVE_STDINT_H])
m4trace:configure.ac:56: -1- AH_OUTPUT([HAVE_UNISTD_H], [/* Define to 1 if you have the <unistd.h> header file. */
@%:@undef HAVE_UNISTD_H])
m4trace:configure.ac:56: -1- AC_DEFINE_TRACE_LITERAL([WORDS_BIGENDIAN])
m4trace:configure.ac:56: -1- m4_pattern_allow([^WORDS_BIGENDIAN$])
m4trace:configure.ac:56: -1- AC_DEFINE_TRACE_LITERAL([AC_APPLE_UNIVERSAL_BUILD])
m4trace:configure.ac:56: -1- m4_pattern_allow([^AC_APPLE_UNIVERSAL_BUILD$])
m4trace:configure.ac:56: -1- AH_OUTPUT([AC_APPLE_UNIVERSAL_BUILD], [/* Define if building universal (internal helper macro) */
@%:@undef AC_APPLE_UNIVERSAL_BUILD])
m4trace:configure.ac:57: -1- AC_DEFINE_TRACE_LITERAL([SIZEOF_VOID_P])
m4trace:configure.ac:57: -1- m4_pattern_allow([^SIZEOF_VOID_P$])
m4trace:configure.ac:57: -1- AH_OUTPUT([SIZEOF_VOID_P], [/* The size of `void *\', as computed by sizeof. */
@%:@undef SIZEOF_VOID_P])
m4trace:configure.ac:69: -1- AC_SUBST([GSL_CONFIG])
m4trace:configure.ac:69: -1- AC_SUBST_TRACE([GSL_CONFIG])
m4trace:configure.ac:69: -1- m4_pattern_allow([^GSL_CONFIG$])
m4trace:configure.ac:85: -1- AC_DEFINE_TRACE_LITERAL([HAVE_GSL])
m4trace:configure.ac:85: -1- m4_pattern_allow([^HAVE_GSL$])
m4trace:configure.ac:105: -1- AC_SUBST([GSL_LIBS])
m4trace:configure.ac:105: -1- AC_SUBST_TRACE([GSL_LIBS])
m4trace:configure.ac:105: -1- m4_pattern_allow([^GSL_LIBS$])
m4trace:configure.ac:106: -1- AC_SUBST([GSL_CFLAGS])
m4trace:configure.ac:106: -1- AC_SUBST_TRACE([GSL_CFLAGS])
m4trace:configure.ac:106: -1- m4_pattern_allow([^GSL_CFLAGS$])
m4trace:configure.ac:203: -2- AC_SUBST([RUBY_CFLAGS])
m4trace:configure.ac:203: -2- AC_SUBST_TRACE([RUBY_CFLAGS])
m4trace:configure.ac:203: -2- m4_pattern_allow([^RUBY_CFLAGS$])
m4trace:configure.ac:203: -2- AC_SUBST([RUBY_LIBS])
m4trace:configure.ac:203: -2- AC_SUBST_TRACE([RUBY_LIBS])
m4trace:configure.ac:203: -2- m4_pattern_allow([^RUBY_LIBS$])
m4trace:configure.ac:200: -1- AC_SUBST([RUBY])
m4trace:configure.ac:200: -1- AC_SUBST_TRACE([RUBY])
m4trace:configure.ac:200: -1- m4_pattern_allow([^RUBY$])
m4trace:configure.ac:200: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:200: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:200: -1- AC_DEFINE_TRACE_LITERAL([MUS_RUBY_VERSION])
m4trace:configure.ac:200: -1- m4_pattern_allow([^MUS_RUBY_VERSION$])
m4trace:configure.ac:200: -1- AC_DEFINE_TRACE_LITERAL([RUBY_RELEASE_DATE])
m4trace:configure.ac:200: -1- m4_pattern_allow([^RUBY_RELEASE_DATE$])
m4trace:configure.ac:200: -1- AC_DEFINE_TRACE_LITERAL([HAVE_READLINE])
m4trace:configure.ac:200: -1- m4_pattern_allow([^HAVE_READLINE$])
m4trace:configure.ac:200: -1- AC_SUBST([XEN_LIBS])
m4trace:configure.ac:200: -1- AC_SUBST_TRACE([XEN_LIBS])
m4trace:configure.ac:200: -1- m4_pattern_allow([^XEN_LIBS$])
m4trace:configure.ac:200: -1- AC_SUBST([XEN_CFLAGS])
m4trace:configure.ac:200: -1- AC_SUBST_TRACE([XEN_CFLAGS])
m4trace:configure.ac:200: -1- m4_pattern_allow([^XEN_CFLAGS$])
m4trace:configure.ac:234: -2- AC_SUBST([FTH_VERSION])
m4trace:configure.ac:234: -2- AC_SUBST_TRACE([FTH_VERSION])
m4trace:configure.ac:234: -2- m4_pattern_allow([^FTH_VERSION$])
m4trace:configure.ac:234: -2- AC_SUBST([FTH_CFLAGS])
m4trace:configure.ac:234: -2- AC_SUBST_TRACE([FTH_CFLAGS])
m4trace:configure.ac:234: -2- m4_pattern_allow([^FTH_CFLAGS$])
m4trace:configure.ac:234: -2- AC_SUBST([FTH_LIBS])
m4trace:configure.ac:234: -2- AC_SUBST_TRACE([FTH_LIBS])
m4trace:configure.ac:234: -2- m4_pattern_allow([^FTH_LIBS$])
m4trace:configure.ac:234: -2- AC_SUBST([FTH_HAVE_COMPLEX])
m4trace:configure.ac:234: -2- AC_SUBST_TRACE([FTH_HAVE_COMPLEX])
m4trace:configure.ac:234: -2- m4_pattern_allow([^FTH_HAVE_COMPLEX$])
m4trace:configure.ac:234: -2- AC_SUBST([FTH_HAVE_RATIO])
m4trace:configure.ac:234: -2- AC_SUBST_TRACE([FTH_HAVE_RATIO])
m4trace:configure.ac:234: -2- m4_pattern_allow([^FTH_HAVE_RATIO$])
m4trace:configure.ac:231: -1- AC_SUBST([FTH])
m4trace:configure.ac:231: -1- AC_SUBST_TRACE([FTH])
m4trace:configure.ac:231: -1- m4_pattern_allow([^FTH$])
m4trace:configure.ac:231: -1- AC_DEFINE_TRACE_LITERAL([HAVE_FORTH])
m4trace:configure.ac:231: -1- m4_pattern_allow([^HAVE_FORTH$])
m4trace:configure.ac:231: -1- AC_SUBST([XEN_CFLAGS], [$FTH_CFLAGS])
m4trace:configure.ac:231: -1- AC_SUBST_TRACE([XEN_CFLAGS])
m4trace:configure.ac:231: -1- m4_pattern_allow([^XEN_CFLAGS$])
m4trace:configure.ac:231: -1- AC_SUBST([XEN_LIBS], [$FTH_LIBS])
m4trace:configure.ac:231: -1- AC_SUBST_TRACE([XEN_LIBS])
m4trace:configure.ac:231: -1- m4_pattern_allow([^XEN_LIBS$])
m4trace:configure.ac:254: -1- AC_DEFINE_TRACE_LITERAL([HAVE_SCHEME])
m4trace:configure.ac:254: -1- m4_pattern_allow([^HAVE_SCHEME$])
m4trace:configure.ac:260: -1- AC_SUBST([S7_LIB])
m4trace:configure.ac:260: -1- AC_SUBST_TRACE([S7_LIB])
m4trace:configure.ac:260: -1- m4_pattern_allow([^S7_LIB$])
m4trace:configure.ac:293: -1- AC_DEFINE_TRACE_LITERAL([MUS_PORTAUDIO])
m4trace:configure.ac:293: -1- m4_pattern_allow([^MUS_PORTAUDIO$])
m4trace:configure.ac:332: -1- AC_DEFINE_TRACE_LITERAL([MUS_JACK])
m4trace:configure.ac:332: -1- m4_pattern_allow([^MUS_JACK$])
m4trace:configure.ac:392: -1- AC_DEFINE_TRACE_LITERAL([HAVE_ALSA])
m4trace:configure.ac:392: -1- m4_pattern_allow([^HAVE_ALSA$])
m4trace:configure.ac:394: -1- AC_SUBST([AUDIO_LIB])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([AUDIO_LIB])
m4trace:configure.ac:394: -1- m4_pattern_allow([^AUDIO_LIB$])
m4trace:configure.ac:402: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:402: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:406: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:406: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:412: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:412: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:440: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:440: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:450: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:450: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:511: -1- AC_SUBST([AUDIO_LIB])
m4trace:configure.ac:511: -1- AC_SUBST_TRACE([AUDIO_LIB])
m4trace:configure.ac:511: -1- m4_pattern_allow([^AUDIO_LIB$])
m4trace:configure.ac:525: -1- AC_DEFINE_TRACE_LITERAL([WITH_AUDIO])
m4trace:configure.ac:525: -1- m4_pattern_allow([^WITH_AUDIO$])
m4trace:configure.ac:539: -1- AC_SUBST([LDSO_FLAGS])
m4trace:configure.ac:539: -1- AC_SUBST_TRACE([LDSO_FLAGS])
m4trace:configure.ac:539: -1- m4_pattern_allow([^LDSO_FLAGS$])
m4trace:configure.ac:540: -1- AC_SUBST([SO_FLAGS])
m4trace:configure.ac:540: -1- AC_SUBST_TRACE([SO_FLAGS])
m4trace:configure.ac:540: -1- m4_pattern_allow([^SO_FLAGS$])
m4trace:configure.ac:541: -1- AC_SUBST([SO_INSTALL])
m4trace:configure.ac:541: -1- AC_SUBST_TRACE([SO_INSTALL])
m4trace:configure.ac:541: -1- m4_pattern_allow([^SO_INSTALL$])
m4trace:configure.ac:542: -1- AC_SUBST([A_INSTALL])
m4trace:configure.ac:542: -1- AC_SUBST_TRACE([A_INSTALL])
m4trace:configure.ac:542: -1- m4_pattern_allow([^A_INSTALL$])
m4trace:configure.ac:543: -1- AC_SUBST([SO_LD])
m4trace:configure.ac:543: -1- AC_SUBST_TRACE([SO_LD])
m4trace:configure.ac:543: -1- m4_pattern_allow([^SO_LD$])
m4trace:configure.ac:544: -1- AC_SUBST([A_LD])
m4trace:configure.ac:544: -1- AC_SUBST_TRACE([A_LD])
m4trace:configure.ac:544: -1- m4_pattern_allow([^A_LD$])
m4trace:configure.ac:545: -1- AC_SUBST([A_LD_FLAGS])
m4trace:configure.ac:545: -1- AC_SUBST_TRACE([A_LD_FLAGS])
m4trace:configure.ac:545: -1- m4_pattern_allow([^A_LD_FLAGS$])
m4trace:configure.ac:546: -1- AC_SUBST([LD_FLAGS])
m4trace:configure.ac:546: -1- AC_SUBST_TRACE([LD_FLAGS])
m4trace:configure.ac:546: -1- m4_pattern_allow([^LD_FLAGS$])
m4trace:configure.ac:547: -1- AC_SUBST([SNDLIB_VERSION])
m4trace:configure.ac:547: -1- AC_SUBST_TRACE([SNDLIB_VERSION])
m4trace:configure.ac:547: -1- m4_pattern_allow([^SNDLIB_VERSION$])
m4trace:configure.ac:548: -1- AC_SUBST([SNDLIB_LANGUAGE])
m4trace:configure.ac:548: -1- AC_SUBST_TRACE([SNDLIB_LANGUAGE])
m4trace:configure.ac:548: -1- m4_pattern_allow([^SNDLIB_LANGUAGE$])
m4trace:configure.ac:549: -1- AC_SUBST([AUDIO_CHOICE])
m4trace:configure.ac:549: -1- AC_SUBST_TRACE([AUDIO_CHOICE])
m4trace:configure.ac:549: -1- m4_pattern_allow([^AUDIO_CHOICE$])
m4trace:configure.ac:550: -1- AC_SUBST([SO_NAME])
m4trace:configure.ac:550: -1- AC_SUBST_TRACE([SO_NAME])
m4trace:configure.ac:550: -1- m4_pattern_allow([^SO_NAME$])
m4trace:configure.ac:551: -1- AC_SUBST([JACK_LIBS])
m4trace:configure.ac:551: -1- AC_SUBST_TRACE([JACK_LIBS])
m4trace:configure.ac:551: -1- m4_pattern_allow([^JACK_LIBS$])
m4trace:configure.ac:552: -1- AC_SUBST([JACK_FLAGS])
m4trace:configure.ac:552: -1- AC_SUBST_TRACE([JACK_FLAGS])
m4trace:configure.ac:552: -1- m4_pattern_allow([^JACK_FLAGS$])
m4trace:configure.ac:553: -1- AC_SUBST([RANLIB])
m4trace:configure.ac:553: -1- AC_SUBST_TRACE([RANLIB])
m4trace:configure.ac:553: -1- m4_pattern_allow([^RANLIB$])
m4trace:configure.ac:555: -1- AC_SUBST([LIB@&t@OBJS], [$ac_libobjs])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([LIB@&t@OBJS])
m4trace:configure.ac:555: -1- m4_pattern_allow([^LIB@&t@OBJS$])
m4trace:configure.ac:555: -1- AC_SUBST([LTLIBOBJS], [$ac_ltlibobjs])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([LTLIBOBJS])
m4trace:configure.ac:555: -1- m4_pattern_allow([^LTLIBOBJS$])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([top_builddir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([top_build_prefix])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([srcdir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([abs_srcdir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([top_srcdir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([abs_top_srcdir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([builddir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([abs_builddir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([abs_top_builddir])
m4trace:configure.ac:555: -1- AC_SUBST_TRACE([INSTALL])

+ 412
- 0
lib/sndlib/autom4te.cache/traces.1 View File

@@ -0,0 +1,412 @@
m4trace:configure.ac:3: -1- AC_INIT([sndlib], [22], [bil@ccrma.stanford.edu], [ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz])
m4trace:configure.ac:3: -1- m4_pattern_forbid([^_?A[CHUM]_])
m4trace:configure.ac:3: -1- m4_pattern_forbid([_AC_])
m4trace:configure.ac:3: -1- m4_pattern_forbid([^LIBOBJS$], [do not use LIBOBJS directly, use AC_LIBOBJ (see section `AC_LIBOBJ vs LIBOBJS'])
m4trace:configure.ac:3: -1- m4_pattern_allow([^AS_FLAGS$])
m4trace:configure.ac:3: -1- m4_pattern_forbid([^_?m4_])
m4trace:configure.ac:3: -1- m4_pattern_forbid([^dnl$])
m4trace:configure.ac:3: -1- m4_pattern_forbid([^_?AS_])
m4trace:configure.ac:3: -1- AC_SUBST([SHELL])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([SHELL])
m4trace:configure.ac:3: -1- m4_pattern_allow([^SHELL$])
m4trace:configure.ac:3: -1- AC_SUBST([PATH_SEPARATOR])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PATH_SEPARATOR])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PATH_SEPARATOR$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_NAME], [m4_ifdef([AC_PACKAGE_NAME], ['AC_PACKAGE_NAME'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_NAME])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_NAME$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_TARNAME], [m4_ifdef([AC_PACKAGE_TARNAME], ['AC_PACKAGE_TARNAME'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_TARNAME])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_TARNAME$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_VERSION], [m4_ifdef([AC_PACKAGE_VERSION], ['AC_PACKAGE_VERSION'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_VERSION])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_VERSION$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_STRING], [m4_ifdef([AC_PACKAGE_STRING], ['AC_PACKAGE_STRING'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_STRING])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_STRING$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_BUGREPORT], [m4_ifdef([AC_PACKAGE_BUGREPORT], ['AC_PACKAGE_BUGREPORT'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_BUGREPORT])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_BUGREPORT$])
m4trace:configure.ac:3: -1- AC_SUBST([PACKAGE_URL], [m4_ifdef([AC_PACKAGE_URL], ['AC_PACKAGE_URL'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([PACKAGE_URL])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_URL$])
m4trace:configure.ac:3: -1- AC_SUBST([exec_prefix], [NONE])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([exec_prefix])
m4trace:configure.ac:3: -1- m4_pattern_allow([^exec_prefix$])
m4trace:configure.ac:3: -1- AC_SUBST([prefix], [NONE])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([prefix])
m4trace:configure.ac:3: -1- m4_pattern_allow([^prefix$])
m4trace:configure.ac:3: -1- AC_SUBST([program_transform_name], [s,x,x,])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([program_transform_name])
m4trace:configure.ac:3: -1- m4_pattern_allow([^program_transform_name$])
m4trace:configure.ac:3: -1- AC_SUBST([bindir], ['${exec_prefix}/bin'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([bindir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^bindir$])
m4trace:configure.ac:3: -1- AC_SUBST([sbindir], ['${exec_prefix}/sbin'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([sbindir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^sbindir$])
m4trace:configure.ac:3: -1- AC_SUBST([libexecdir], ['${exec_prefix}/libexec'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([libexecdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^libexecdir$])
m4trace:configure.ac:3: -1- AC_SUBST([datarootdir], ['${prefix}/share'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([datarootdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^datarootdir$])
m4trace:configure.ac:3: -1- AC_SUBST([datadir], ['${datarootdir}'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([datadir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^datadir$])
m4trace:configure.ac:3: -1- AC_SUBST([sysconfdir], ['${prefix}/etc'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([sysconfdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^sysconfdir$])
m4trace:configure.ac:3: -1- AC_SUBST([sharedstatedir], ['${prefix}/com'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([sharedstatedir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^sharedstatedir$])
m4trace:configure.ac:3: -1- AC_SUBST([localstatedir], ['${prefix}/var'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([localstatedir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^localstatedir$])
m4trace:configure.ac:3: -1- AC_SUBST([includedir], ['${prefix}/include'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([includedir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^includedir$])
m4trace:configure.ac:3: -1- AC_SUBST([oldincludedir], ['/usr/include'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([oldincludedir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^oldincludedir$])
m4trace:configure.ac:3: -1- AC_SUBST([docdir], [m4_ifset([AC_PACKAGE_TARNAME],
['${datarootdir}/doc/${PACKAGE_TARNAME}'],
['${datarootdir}/doc/${PACKAGE}'])])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([docdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^docdir$])
m4trace:configure.ac:3: -1- AC_SUBST([infodir], ['${datarootdir}/info'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([infodir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^infodir$])
m4trace:configure.ac:3: -1- AC_SUBST([htmldir], ['${docdir}'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([htmldir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^htmldir$])
m4trace:configure.ac:3: -1- AC_SUBST([dvidir], ['${docdir}'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([dvidir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^dvidir$])
m4trace:configure.ac:3: -1- AC_SUBST([pdfdir], ['${docdir}'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([pdfdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^pdfdir$])
m4trace:configure.ac:3: -1- AC_SUBST([psdir], ['${docdir}'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([psdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^psdir$])
m4trace:configure.ac:3: -1- AC_SUBST([libdir], ['${exec_prefix}/lib'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([libdir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^libdir$])
m4trace:configure.ac:3: -1- AC_SUBST([localedir], ['${datarootdir}/locale'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([localedir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^localedir$])
m4trace:configure.ac:3: -1- AC_SUBST([mandir], ['${datarootdir}/man'])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([mandir])
m4trace:configure.ac:3: -1- m4_pattern_allow([^mandir$])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_NAME])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_NAME$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_NAME], [/* Define to the full name of this package. */
@%:@undef PACKAGE_NAME])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_TARNAME])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_TARNAME$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_TARNAME], [/* Define to the one symbol short name of this package. */
@%:@undef PACKAGE_TARNAME])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_VERSION])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_VERSION$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_VERSION], [/* Define to the version of this package. */
@%:@undef PACKAGE_VERSION])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_STRING])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_STRING$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_STRING], [/* Define to the full name and version of this package. */
@%:@undef PACKAGE_STRING])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_BUGREPORT])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_BUGREPORT$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_BUGREPORT], [/* Define to the address where bug reports for this package should be sent. */
@%:@undef PACKAGE_BUGREPORT])
m4trace:configure.ac:3: -1- AC_DEFINE_TRACE_LITERAL([PACKAGE_URL])
m4trace:configure.ac:3: -1- m4_pattern_allow([^PACKAGE_URL$])
m4trace:configure.ac:3: -1- AH_OUTPUT([PACKAGE_URL], [/* Define to the home page for this package. */
@%:@undef PACKAGE_URL])
m4trace:configure.ac:3: -1- AC_SUBST([DEFS])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([DEFS])
m4trace:configure.ac:3: -1- m4_pattern_allow([^DEFS$])
m4trace:configure.ac:3: -1- AC_SUBST([ECHO_C])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([ECHO_C])
m4trace:configure.ac:3: -1- m4_pattern_allow([^ECHO_C$])
m4trace:configure.ac:3: -1- AC_SUBST([ECHO_N])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([ECHO_N])
m4trace:configure.ac:3: -1- m4_pattern_allow([^ECHO_N$])
m4trace:configure.ac:3: -1- AC_SUBST([ECHO_T])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([ECHO_T])
m4trace:configure.ac:3: -1- m4_pattern_allow([^ECHO_T$])
m4trace:configure.ac:3: -1- AC_SUBST([LIBS])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([LIBS])
m4trace:configure.ac:3: -1- m4_pattern_allow([^LIBS$])
m4trace:configure.ac:3: -1- AC_SUBST([build_alias])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([build_alias])
m4trace:configure.ac:3: -1- m4_pattern_allow([^build_alias$])
m4trace:configure.ac:3: -1- AC_SUBST([host_alias])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([host_alias])
m4trace:configure.ac:3: -1- m4_pattern_allow([^host_alias$])
m4trace:configure.ac:3: -1- AC_SUBST([target_alias])
m4trace:configure.ac:3: -1- AC_SUBST_TRACE([target_alias])
m4trace:configure.ac:3: -1- m4_pattern_allow([^target_alias$])
m4trace:configure.ac:6: -1- AC_CANONICAL_HOST
m4trace:configure.ac:6: -1- AC_CANONICAL_BUILD
m4trace:configure.ac:6: -1- AC_REQUIRE_AUX_FILE([config.sub])
m4trace:configure.ac:6: -1- AC_REQUIRE_AUX_FILE([config.guess])
m4trace:configure.ac:6: -1- AC_SUBST([build], [$ac_cv_build])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([build])
m4trace:configure.ac:6: -1- m4_pattern_allow([^build$])
m4trace:configure.ac:6: -1- AC_SUBST([build_cpu], [$[1]])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([build_cpu])
m4trace:configure.ac:6: -1- m4_pattern_allow([^build_cpu$])
m4trace:configure.ac:6: -1- AC_SUBST([build_vendor], [$[2]])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([build_vendor])
m4trace:configure.ac:6: -1- m4_pattern_allow([^build_vendor$])
m4trace:configure.ac:6: -1- AC_SUBST([build_os])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([build_os])
m4trace:configure.ac:6: -1- m4_pattern_allow([^build_os$])
m4trace:configure.ac:6: -1- AC_SUBST([host], [$ac_cv_host])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([host])
m4trace:configure.ac:6: -1- m4_pattern_allow([^host$])
m4trace:configure.ac:6: -1- AC_SUBST([host_cpu], [$[1]])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([host_cpu])
m4trace:configure.ac:6: -1- m4_pattern_allow([^host_cpu$])
m4trace:configure.ac:6: -1- AC_SUBST([host_vendor], [$[2]])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([host_vendor])
m4trace:configure.ac:6: -1- m4_pattern_allow([^host_vendor$])
m4trace:configure.ac:6: -1- AC_SUBST([host_os])
m4trace:configure.ac:6: -1- AC_SUBST_TRACE([host_os])
m4trace:configure.ac:6: -1- m4_pattern_allow([^host_os$])
m4trace:configure.ac:7: -1- AC_CONFIG_FILES([makefile])
m4trace:configure.ac:8: -1- AC_CONFIG_FILES([sndlib.pc])
m4trace:configure.ac:9: -1- AC_CONFIG_FILES([sndins/Makefile])
m4trace:configure.ac:10: -1- AC_CONFIG_HEADERS([unix-config.h])
m4trace:configure.ac:11: -1- AC_CONFIG_FILES([sndlib-config], [chmod +x sndlib-config])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([LDFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([LDFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^LDFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([LIBS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([LIBS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^LIBS$])
m4trace:configure.ac:13: -1- AC_SUBST([CPPFLAGS])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CPPFLAGS])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CPPFLAGS$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^CC$])
m4trace:configure.ac:13: -1- AC_SUBST([ac_ct_CC])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([ac_ct_CC])
m4trace:configure.ac:13: -1- m4_pattern_allow([^ac_ct_CC$])
m4trace:configure.ac:13: -1- AC_SUBST([EXEEXT], [$ac_cv_exeext])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([EXEEXT])
m4trace:configure.ac:13: -1- m4_pattern_allow([^EXEEXT$])
m4trace:configure.ac:13: -1- AC_SUBST([OBJEXT], [$ac_cv_objext])
m4trace:configure.ac:13: -1- AC_SUBST_TRACE([OBJEXT])
m4trace:configure.ac:13: -1- m4_pattern_allow([^OBJEXT$])
m4trace:configure.ac:15: -1- AC_REQUIRE_AUX_FILE([install-sh])
m4trace:configure.ac:15: -1- AC_SUBST([INSTALL_PROGRAM])
m4trace:configure.ac:15: -1- AC_SUBST_TRACE([INSTALL_PROGRAM])
m4trace:configure.ac:15: -1- m4_pattern_allow([^INSTALL_PROGRAM$])
m4trace:configure.ac:15: -1- AC_SUBST([INSTALL_SCRIPT])
m4trace:configure.ac:15: -1- AC_SUBST_TRACE([INSTALL_SCRIPT])
m4trace:configure.ac:15: -1- m4_pattern_allow([^INSTALL_SCRIPT$])
m4trace:configure.ac:15: -1- AC_SUBST([INSTALL_DATA])
m4trace:configure.ac:15: -1- AC_SUBST_TRACE([INSTALL_DATA])
m4trace:configure.ac:15: -1- m4_pattern_allow([^INSTALL_DATA$])
m4trace:configure.ac:17: -1- AH_OUTPUT([WORDS_BIGENDIAN], [/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
significant byte first (like Motorola and SPARC, unlike Intel). */
#if defined AC_APPLE_UNIVERSAL_BUILD
# if defined __BIG_ENDIAN__
# define WORDS_BIGENDIAN 1
# endif
#else
# ifndef WORDS_BIGENDIAN
# undef WORDS_BIGENDIAN
# endif
#endif])
m4trace:configure.ac:17: -1- AC_SUBST([CPP])
m4trace:configure.ac:17: -1- AC_SUBST_TRACE([CPP])
m4trace:configure.ac:17: -1- m4_pattern_allow([^CPP$])
m4trace:configure.ac:17: -1- AC_SUBST([CPPFLAGS])
m4trace:configure.ac:17: -1- AC_SUBST_TRACE([CPPFLAGS])
m4trace:configure.ac:17: -1- m4_pattern_allow([^CPPFLAGS$])
m4trace:configure.ac:17: -1- AC_SUBST([CPP])
m4trace:configure.ac:17: -1- AC_SUBST_TRACE([CPP])
m4trace:configure.ac:17: -1- m4_pattern_allow([^CPP$])
m4trace:configure.ac:17: -1- AC_SUBST([GREP])
m4trace:configure.ac:17: -1- AC_SUBST_TRACE([GREP])
m4trace:configure.ac:17: -1- m4_pattern_allow([^GREP$])
m4trace:configure.ac:17: -1- AC_SUBST([EGREP])
m4trace:configure.ac:17: -1- AC_SUBST_TRACE([EGREP])
m4trace:configure.ac:17: -1- m4_pattern_allow([^EGREP$])
m4trace:configure.ac:17: -1- AC_DEFINE_TRACE_LITERAL([STDC_HEADERS])
m4trace:configure.ac:17: -1- m4_pattern_allow([^STDC_HEADERS$])
m4trace:configure.ac:17: -1- AH_OUTPUT([STDC_HEADERS], [/* Define to 1 if you have the ANSI C header files. */
@%:@undef STDC_HEADERS])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_SYS_TYPES_H], [/* Define to 1 if you have the <sys/types.h> header file. */
@%:@undef HAVE_SYS_TYPES_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_SYS_STAT_H], [/* Define to 1 if you have the <sys/stat.h> header file. */
@%:@undef HAVE_SYS_STAT_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_STDLIB_H], [/* Define to 1 if you have the <stdlib.h> header file. */
@%:@undef HAVE_STDLIB_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_STRING_H], [/* Define to 1 if you have the <string.h> header file. */
@%:@undef HAVE_STRING_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_MEMORY_H], [/* Define to 1 if you have the <memory.h> header file. */
@%:@undef HAVE_MEMORY_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_STRINGS_H], [/* Define to 1 if you have the <strings.h> header file. */
@%:@undef HAVE_STRINGS_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_INTTYPES_H], [/* Define to 1 if you have the <inttypes.h> header file. */
@%:@undef HAVE_INTTYPES_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_STDINT_H], [/* Define to 1 if you have the <stdint.h> header file. */
@%:@undef HAVE_STDINT_H])
m4trace:configure.ac:17: -1- AH_OUTPUT([HAVE_UNISTD_H], [/* Define to 1 if you have the <unistd.h> header file. */
@%:@undef HAVE_UNISTD_H])
m4trace:configure.ac:17: -1- AC_DEFINE_TRACE_LITERAL([WORDS_BIGENDIAN])
m4trace:configure.ac:17: -1- m4_pattern_allow([^WORDS_BIGENDIAN$])
m4trace:configure.ac:17: -1- AC_DEFINE_TRACE_LITERAL([AC_APPLE_UNIVERSAL_BUILD])
m4trace:configure.ac:17: -1- m4_pattern_allow([^AC_APPLE_UNIVERSAL_BUILD$])
m4trace:configure.ac:17: -1- AH_OUTPUT([AC_APPLE_UNIVERSAL_BUILD], [/* Define if building universal (internal helper macro) */
@%:@undef AC_APPLE_UNIVERSAL_BUILD])
m4trace:configure.ac:18: -1- AC_DEFINE_TRACE_LITERAL([SIZEOF_VOID_P])
m4trace:configure.ac:18: -1- m4_pattern_allow([^SIZEOF_VOID_P$])
m4trace:configure.ac:18: -1- AH_OUTPUT([SIZEOF_VOID_P], [/* The size of `void *\', as computed by sizeof. */
@%:@undef SIZEOF_VOID_P])
m4trace:configure.ac:19: -1- AC_SUBST([PKG_CONFIG])
m4trace:configure.ac:19: -1- AC_SUBST_TRACE([PKG_CONFIG])
m4trace:configure.ac:19: -1- m4_pattern_allow([^PKG_CONFIG$])
m4trace:configure.ac:64: -1- AC_DEFINE_TRACE_LITERAL([HAVE_GSL])
m4trace:configure.ac:64: -1- m4_pattern_allow([^HAVE_GSL$])
m4trace:configure.ac:72: -1- AC_SUBST([GSL_LIBS])
m4trace:configure.ac:72: -1- AC_SUBST_TRACE([GSL_LIBS])
m4trace:configure.ac:72: -1- m4_pattern_allow([^GSL_LIBS$])
m4trace:configure.ac:73: -1- AC_SUBST([GSL_CFLAGS])
m4trace:configure.ac:73: -1- AC_SUBST_TRACE([GSL_CFLAGS])
m4trace:configure.ac:73: -1- m4_pattern_allow([^GSL_CFLAGS$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:97: -1- AC_DEFINE_TRACE_LITERAL([HAVE_RUBY])
m4trace:configure.ac:97: -1- m4_pattern_allow([^HAVE_RUBY$])
m4trace:configure.ac:118: -1- AC_SUBST([FTH])
m4trace:configure.ac:118: -1- AC_SUBST_TRACE([FTH])
m4trace:configure.ac:118: -1- m4_pattern_allow([^FTH$])
m4trace:configure.ac:124: -1- AC_DEFINE_TRACE_LITERAL([HAVE_FORTH])
m4trace:configure.ac:124: -1- m4_pattern_allow([^HAVE_FORTH$])
m4trace:configure.ac:138: -1- AC_DEFINE_TRACE_LITERAL([HAVE_SCHEME])
m4trace:configure.ac:138: -1- m4_pattern_allow([^HAVE_SCHEME$])
m4trace:configure.ac:142: -1- AC_SUBST([S7_LIB])
m4trace:configure.ac:142: -1- AC_SUBST_TRACE([S7_LIB])
m4trace:configure.ac:142: -1- m4_pattern_allow([^S7_LIB$])
m4trace:configure.ac:145: -1- AC_SUBST([XEN_LIBS])
m4trace:configure.ac:145: -1- AC_SUBST_TRACE([XEN_LIBS])
m4trace:configure.ac:145: -1- m4_pattern_allow([^XEN_LIBS$])
m4trace:configure.ac:146: -1- AC_SUBST([XEN_CFLAGS])
m4trace:configure.ac:146: -1- AC_SUBST_TRACE([XEN_CFLAGS])
m4trace:configure.ac:146: -1- m4_pattern_allow([^XEN_CFLAGS$])
m4trace:configure.ac:161: -1- AC_DEFINE_TRACE_LITERAL([MUS_PULSEAUDIO])
m4trace:configure.ac:161: -1- m4_pattern_allow([^MUS_PULSEAUDIO$])
m4trace:configure.ac:167: -1- AC_DEFINE_TRACE_LITERAL([MUS_PORTAUDIO])
m4trace:configure.ac:167: -1- m4_pattern_allow([^MUS_PORTAUDIO$])
m4trace:configure.ac:174: -1- AC_DEFINE_TRACE_LITERAL([MUS_JACK])
m4trace:configure.ac:174: -1- m4_pattern_allow([^MUS_JACK$])
m4trace:configure.ac:194: -1- AC_DEFINE_TRACE_LITERAL([HAVE_ALSA])
m4trace:configure.ac:194: -1- m4_pattern_allow([^HAVE_ALSA$])
m4trace:configure.ac:200: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:200: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:208: -1- AC_DEFINE_TRACE_LITERAL([HAVE_ALSA])
m4trace:configure.ac:208: -1- m4_pattern_allow([^HAVE_ALSA$])
m4trace:configure.ac:221: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:221: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:225: -1- AC_DEFINE_TRACE_LITERAL([HAVE_OSS])
m4trace:configure.ac:225: -1- m4_pattern_allow([^HAVE_OSS$])
m4trace:configure.ac:260: -1- AC_DEFINE_TRACE_LITERAL([WITH_AUDIO])
m4trace:configure.ac:260: -1- m4_pattern_allow([^WITH_AUDIO$])
m4trace:configure.ac:264: -1- AC_SUBST([AUDIO_LIB])
m4trace:configure.ac:264: -1- AC_SUBST_TRACE([AUDIO_LIB])
m4trace:configure.ac:264: -1- m4_pattern_allow([^AUDIO_LIB$])
m4trace:configure.ac:265: -1- AC_SUBST([JACK_LIBS])
m4trace:configure.ac:265: -1- AC_SUBST_TRACE([JACK_LIBS])
m4trace:configure.ac:265: -1- m4_pattern_allow([^JACK_LIBS$])
m4trace:configure.ac:266: -1- AC_SUBST([JACK_FLAGS])
m4trace:configure.ac:266: -1- AC_SUBST_TRACE([JACK_FLAGS])
m4trace:configure.ac:266: -1- m4_pattern_allow([^JACK_FLAGS$])
m4trace:configure.ac:378: -1- AC_SUBST([LDSO_FLAGS])
m4trace:configure.ac:378: -1- AC_SUBST_TRACE([LDSO_FLAGS])
m4trace:configure.ac:378: -1- m4_pattern_allow([^LDSO_FLAGS$])
m4trace:configure.ac:379: -1- AC_SUBST([SO_FLAGS])
m4trace:configure.ac:379: -1- AC_SUBST_TRACE([SO_FLAGS])
m4trace:configure.ac:379: -1- m4_pattern_allow([^SO_FLAGS$])
m4trace:configure.ac:380: -1- AC_SUBST([SO_INSTALL])
m4trace:configure.ac:380: -1- AC_SUBST_TRACE([SO_INSTALL])
m4trace:configure.ac:380: -1- m4_pattern_allow([^SO_INSTALL$])
m4trace:configure.ac:381: -1- AC_SUBST([A_INSTALL])
m4trace:configure.ac:381: -1- AC_SUBST_TRACE([A_INSTALL])
m4trace:configure.ac:381: -1- m4_pattern_allow([^A_INSTALL$])
m4trace:configure.ac:382: -1- AC_SUBST([SO_LD])
m4trace:configure.ac:382: -1- AC_SUBST_TRACE([SO_LD])
m4trace:configure.ac:382: -1- m4_pattern_allow([^SO_LD$])
m4trace:configure.ac:383: -1- AC_SUBST([A_LD])
m4trace:configure.ac:383: -1- AC_SUBST_TRACE([A_LD])
m4trace:configure.ac:383: -1- m4_pattern_allow([^A_LD$])
m4trace:configure.ac:384: -1- AC_SUBST([A_LD_FLAGS])
m4trace:configure.ac:384: -1- AC_SUBST_TRACE([A_LD_FLAGS])
m4trace:configure.ac:384: -1- m4_pattern_allow([^A_LD_FLAGS$])
m4trace:configure.ac:385: -1- AC_SUBST([LD_FLAGS])
m4trace:configure.ac:385: -1- AC_SUBST_TRACE([LD_FLAGS])
m4trace:configure.ac:385: -1- m4_pattern_allow([^LD_FLAGS$])
m4trace:configure.ac:386: -1- AC_SUBST([SNDLIB_VERSION])
m4trace:configure.ac:386: -1- AC_SUBST_TRACE([SNDLIB_VERSION])
m4trace:configure.ac:386: -1- m4_pattern_allow([^SNDLIB_VERSION$])
m4trace:configure.ac:387: -1- AC_SUBST([SNDLIB_LANGUAGE])
m4trace:configure.ac:387: -1- AC_SUBST_TRACE([SNDLIB_LANGUAGE])
m4trace:configure.ac:387: -1- m4_pattern_allow([^SNDLIB_LANGUAGE$])
m4trace:configure.ac:388: -1- AC_SUBST([SO_NAME])
m4trace:configure.ac:388: -1- AC_SUBST_TRACE([SO_NAME])
m4trace:configure.ac:388: -1- m4_pattern_allow([^SO_NAME$])
m4trace:configure.ac:389: -1- AC_SUBST([JACK_LIBS])
m4trace:configure.ac:389: -1- AC_SUBST_TRACE([JACK_LIBS])
m4trace:configure.ac:389: -1- m4_pattern_allow([^JACK_LIBS$])
m4trace:configure.ac:390: -1- AC_SUBST([JACK_FLAGS])
m4trace:configure.ac:390: -1- AC_SUBST_TRACE([JACK_FLAGS])
m4trace:configure.ac:390: -1- m4_pattern_allow([^JACK_FLAGS$])
m4trace:configure.ac:391: -1- AC_SUBST([RANLIB])
m4trace:configure.ac:391: -1- AC_SUBST_TRACE([RANLIB])
m4trace:configure.ac:391: -1- m4_pattern_allow([^RANLIB$])
m4trace:configure.ac:392: -1- AC_SUBST([AUDIO_CHOICE])
m4trace:configure.ac:392: -1- AC_SUBST_TRACE([AUDIO_CHOICE])
m4trace:configure.ac:392: -1- m4_pattern_allow([^AUDIO_CHOICE$])
m4trace:configure.ac:394: -1- AC_SUBST([LIB@&t@OBJS], [$ac_libobjs])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([LIB@&t@OBJS])
m4trace:configure.ac:394: -1- m4_pattern_allow([^LIB@&t@OBJS$])
m4trace:configure.ac:394: -1- AC_SUBST([LTLIBOBJS], [$ac_ltlibobjs])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([LTLIBOBJS])
m4trace:configure.ac:394: -1- m4_pattern_allow([^LTLIBOBJS$])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([top_builddir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([top_build_prefix])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([srcdir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([abs_srcdir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([top_srcdir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([abs_top_srcdir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([builddir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([abs_builddir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([abs_top_builddir])
m4trace:configure.ac:394: -1- AC_SUBST_TRACE([INSTALL])

+ 415
- 0
lib/sndlib/bess.rb View File

@@ -0,0 +1,415 @@
#!/usr/local/bin/ruby -wd
# bess -- Translation of Bill Schottstaedt's bess.scm to Ruby.

# Copyright (c) 2002--2009 Michael Scholz <mi-scholz@users.sourceforge.net>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

begin require 'rubygems' rescue LoadError end

file = File.basename __FILE__
banner = "This is #{file.upcase} v1.9, (C) 2002--2009 Michael Scholz"

def warn(*args)
str = format(*args) << ($! ? ": #{$!}" : "") << "\n"
str << (($@ and $DEBUG) ? "\n[#{$@.join("\n")}]" : "")
$stdout.print str
$! = nil
end

def die(*args)
warn(*args)
exit 1
end

def rbm_require(lib)
require lib.to_s
rescue ScriptError
die "\aScriptError"
end

1.upto(15) do |i|
trap(i) do |sig| die("\nSignal #{sig} received. Process #{$$} canceled.") end
end

class Bess
def initialize(banner, file)
@bufsize = 256
@srate = 22050
@chans = 1
@play = 0.0
@freq = 220.0
@fm_index1 = 1.0
@fm_ratio1 = 1
@amp = 0.5
@sliderback = "lightsteelblue"
@background = "lightsteelblue1"
@low_freq = 40.0
@high_freq = 2000.0
@high_index1 = 3.0
@high_ratio = 10
get_options(banner, file)
rbm_require(:libxm)
rbm_require(:sndlib)
set_mus_srate(@srate)
end

def get_options(banner, file)
vers = false
help = false
vers_msg = "#{banner}
#{file.capitalize} comes with ABSOLUTELY NO WARRANTY.
You may redistribute copies of #{file.capitalize}
under the terms of the GNU General Public License.
For more information about these matters, see the file named COPYING."
help_msg = "#{banner}
#{file.capitalize} is a Ruby script working with sndlib.so and
libxm.so which must be in the Ruby library path, for example in
/usr/local/lib/ruby/site_ruby, or the environment variable $RUBYLIB
must be set correctly. It opens the DAC, creates some scale widgets,
and starts two CLM oscillators doing frequency modulation in
semi-real-time. This is a translation of bess.scm of Bill
Schottstaedt\'s Snd sound editor.

Default values shown in brackets.

Usage: #{file} [ options ] [ -- X options ]

-p, --play play immediately (#{@play.nonzero? ? "yes" : "no"})

-f, --frequency NUMBER frequency between #{@low_freq} and #{@high_freq} (#{@freq})
-i, --index1 NUMBER fm_index1 between 0 and #{@high_index1} (#{@fm_index1})
-r, --ratio NUMBER ratio between 0 and #{@high_ratio} (#{@fm_ratio1})
-a, --amplitude NUMBER amplitude between 0 and 1 (#{@amp})

-B, --bufsize NUMBER buffer size (#{@bufsize})
-S, --srate NUMBER sampling rate (#{@srate})
-C, --channels NUMBER number of channels (#{@chans})

-b --background COLOR background color (#{@background})
-s, --sliderback COLOR slider background color (#{@sliderback})

-V, --version display version information and exit
-h, --help display this help message and exit

Example: #{file} -pf1000 -r3 -b ivory1 -s ivory3"
rbm_require "getoptlong"
GetoptLong.new(["--play", "-p", GetoptLong::NO_ARGUMENT],
["--frequency", "-f", GetoptLong::REQUIRED_ARGUMENT],
["--index1", "-i", GetoptLong::REQUIRED_ARGUMENT],
["--ratio", "-r", GetoptLong::REQUIRED_ARGUMENT],
["--amplitude", "-a", GetoptLong::REQUIRED_ARGUMENT],
["--bufsize", "-B", GetoptLong::REQUIRED_ARGUMENT],
["--srate", "-S", GetoptLong::REQUIRED_ARGUMENT],
["--channels", "-C", GetoptLong::REQUIRED_ARGUMENT],
["--background", "-b", GetoptLong::REQUIRED_ARGUMENT],
["--sliderback", "-s", GetoptLong::REQUIRED_ARGUMENT],
["--version", "-V", GetoptLong::NO_ARGUMENT],
["--help", "-h", GetoptLong::NO_ARGUMENT]).each do |name, arg|

case name
when "--play"
@play = 1.0
when "--frequency"
@freq = arg.to_f.abs
@freq = @freq < @low_freq ? @low_freq : @freq > @high_freq ? @high_freq : @freq
when "--index1"
ind = arg.to_f.abs
@fm_index1 = ind > @high_index1 ? @high_index1 : ind
when "--ratio"
rat = arg.to_i.abs
@fm_ratio1 = rat > @high_ratio ? @high_ratio : rat
when "--amplitude"
amp = arg.to_f.abs
@amp = amp > 1 ? 1 : amp
when "--bufsize"
@bufsize = arg.to_i
when "--srate"
@srate = arg.to_i
when "--channels"
@chans = arg.to_i
when "--sliderback"
@sliderback = arg
when "--background"
@background = arg
when "--version"
vers = true
when "--help"
help = true
end
end
die help_msg if help
die vers_msg if vers
end
def get_color(color)
col = RXColor()
dpy = RXtDisplay(@shell_app[0])
cmap = RDefaultColormap(dpy, RDefaultScreen(dpy))
warn("Can't allocate #{color.inspect}!") if RXAllocNamedColor(dpy, cmap, color, col, col).zero?
Rpixel(col)
end

def set_label(wid, *args)
RXtVaSetValues(wid, [RXmNlabelString, RXmStringCreate(format(*args), RXmFONTLIST_DEFAULT_TAG)])
end

def make_label(wid, name)
RXtCreateManagedWidget(name, RxmLabelWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_FORM,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNalignment, RXmALIGNMENT_END,
RXmNwidth, 80, #114,
RXmNrecomputeSize, false,
RXmNbackground, get_color(@background)])
end
def make_scale_label(wid)
RXtCreateManagedWidget("label", RxmLabelWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, wid,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_OPPOSITE_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
end
def make_scale(wid)
RXtCreateManagedWidget("scale", RxmScaleWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, wid,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_OPPOSITE_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_FORM,
RXmNshowValue, false,
RXmNorientation, RXmHORIZONTAL,
RXmNbackground, get_color(@sliderback)])
end
def make_scales(wid, name, val, callback)
label = make_scale_label(make_label(wid, name))
scale = make_scale(label)
set_label(label, val.kind_of?(Integer) ? "%8d" : "%8.3f", val)
RXtAddCallback(scale, RXmNdragCallback, callback, label)
RXtAddCallback(scale, RXmNvalueChangedCallback, callback ,label)
scale
end
def start_dac(&body)
args = [$0] + $*
@shell_app = RXtVaOpenApplication("FM", args.length, args, RapplicationShellWidgetClass,
[RXmNallowShellResize, true, RXmNtitle, "FM forever!"])
RXtAddEventHandler(@shell_app[0], 0, true,
lambda do |w, c, i, f| R_XEditResCheckMessages(w, c, i, f) end)
@form = RXtCreateManagedWidget("form", RxmFormWidgetClass, @shell_app[0],
[RXmNresizePolicy, RXmRESIZE_GROW,
RXmNbackground, get_color(@background)])
play_button = RXtCreateManagedWidget("play", RxmToggleButtonWidgetClass, @form,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_FORM,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
RXmToggleButtonSetState(play_button, @play.nonzero? ? true : false, false)
RXtAddCallback(play_button, RXmNvalueChangedCallback,
lambda do |w, c, i| @play = Rset(i) ? 1.0 : 0.0 end)
quit_button = RXtCreateManagedWidget(" quit ", RxmPushButtonWidgetClass, @form,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_NONE,
RXmNrightAttachment, RXmATTACH_FORM,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
RXtAddCallback(quit_button, RXmNactivateCallback, lambda do |w, c, i| exit(0) end)
wid = make_scales(play_button, " carrier:", @freq,
lambda do |w, c, i|
@freq = @low_freq + Rvalue(i) * ((@high_freq - @low_freq) / 100.0)
set_label(c, "%8.3f", @freq)
end)
RXmScaleSetValue(wid, (100 * (@freq - @low_freq) / (@high_freq - @low_freq)).round)
wid = make_scales(wid, " amplitude:", @amp,
lambda do |w, c, i|
@amp = Rvalue(i) / 100.0
set_label(c, "%8.3f", @amp)
end)
RXmScaleSetValue(wid, (100 * @amp).round)
wid = make_scales(wid, "fm index 1:", @fm_index1,
lambda do |w, c, i|
@fm_index1 = Rvalue(i) * (@high_index1 / 100.0)
set_label(c, "%8.3f", @fm_index1)
end)
RXmScaleSetValue(wid, (100 * @fm_index1 / @high_index1).round)
wid = make_scales(wid, "c/m ratio 1:", @fm_ratio1,
lambda do |w, c, i|
@fm_ratio1 = (Rvalue(i) * (@high_ratio / 100.0)).round
set_label(c, "%8d", @fm_ratio1)
end)
RXmScaleSetValue(wid, (@fm_ratio1 * 100 / @high_ratio).round)
if defined? @fm_index2
wid = make_scales(wid, "fm index 2:", @fm_index2,
lambda do |w, c, i|
@fm_index2 = Rvalue(i) * (@high_index2 / 100.0)
set_label(c, "%8.3f", @fm_index2)
end)
RXmScaleSetValue(wid, (100 * @fm_index2 / @high_index2).round)
wid = make_scales(wid, "c/m ratio 2:", @fm_ratio2,
lambda do |w, c, i|
@fm_ratio2 = (Rvalue(i) * (@high_ratio / 100.0)).round
set_label(c, "%8d", @fm_ratio2)
end)
RXmScaleSetValue(wid, (@fm_ratio2 * 100 / @high_ratio).round)
end
if defined? @fm_index3
wid = make_scales(wid, "fm index 3:", @fm_index2,
lambda do |w, c, i|
@fm_index2 = Rvalue(i) * (@high_index3 / 100.0)
set_label(c, "%8.3f", @fm_index2)
end)
RXmScaleSetValue(wid, (100 * @fm_index3 / @high_index3).round)
wid = make_scales(wid, "c/m ratio 3:", @fm_ratio3,
lambda do |w, c, i|
@fm_ratio3 = (Rvalue(i) * (@high_ratio / 100.0)).round
set_label(c, "%8d", @fm_ratio3)
end)
RXmScaleSetValue(wid, (@fm_ratio3 * 100 / @high_ratio).round)
end
proc = nil
data = make_sound_data(@chans, @bufsize)
port = mus_audio_open_output(0, @srate, @chans, Mus_lshort, @bufsize * 2)
die("Can't open DAC!") if port < 0
RXmAddWMProtocolCallback(@shell_app[0],
RXmInternAtom(RXtDisplay(@shell_app[0]), "WM_DELETE_WINDOW", false),
lambda do |w, c, i|
RXtRemoveWorkProc(proc)
mus_audio_close(port)
end, false)
proc = RXtAppAddWorkProc(@shell_app[1], lambda do |dummy|
@bufsize.times do |i|
@chans.times do |c|
sound_data_set!(data, c, i, body.call)
end
end
mus_audio_write(port, data, @bufsize)
false
end)
RXtRealizeWidget(@shell_app[0])
RXtAppMainLoop(@shell_app[1])
rescue
die("start_dac() { ... }")
end
end

# test functions

def bess(banner, file, &body)
b = Bess.new(banner, file)
b.make_ffm()
b.start_dac() do b.instance_eval(&body) end
rescue
die("bess(banner, file, osf, mdf) { ... }")
end

class Bess
def make_fm
@osc = make_oscil(0.0)
@mod = make_oscil(0.0)
end
def fm
@amp * @play * oscil(@osc, in_hz(@freq) + @fm_index1 * oscil(@mod, in_hz(@fm_ratio1 * @freq)))
end

def make_ffm
@osc = make_oscil(0.0)
@md1 = make_oscil(0.0)
@md2 = make_oscil(0.0)
@md3 = make_oscil(0.0)
@fm_index1 = 1.0
@fm_index2 = 0.0
@fm_index3 = 0.0
@fm_ratio1 = 1
@fm_ratio2 = 1
@fm_ratio3 = 1
@high_index2 = 3.0
@high_index2 = 1.0
@high_index3 = 0.25
@amp = 0.5
end

def ffm_rb
@amp * @play * oscil(@osc, in_hz(@freq) + @fm_index1 * oscil(@md1, in_hz(@fm_ratio1 * @freq)) +
@fm_index2 * oscil(@md2, in_hz(@fm_ratio2 * @freq)) +
@fm_index3 * oscil(@md3, in_hz(@fm_ratio3 * @freq)))
end

def ffm
ffm_c(@amp, @play, @freq, @fm_index1, @fm_index2, @fm_index3,
@fm_ratio1, @fm_ratio2, @fm_ratio3, @osc, @md1, @md2, @md3)
end

rbm_require 'inline'
include Inline
inline do |ffm_c|
fft_c.c "
#include <sndlib.h>
#include <clm.h>
typedef struct {
mus_any *gen;
VALUE *vcts;
int nvcts;
void *input_ptree;
} mus_xen;
double
fft_c(double amp,
double play,
double freq,
double fm_index1,
double fm_index2,
double fm_index3,
double fm_ratio1,
double fm_ratio2,
double fm_ratio3,
mus_any *osc,
mus_any *md1,
mus_any *md2,
mus_any *md3)
{
return (amp * play * mus_oscil(osc, mus_hz2radians(freq) +
fm_index1 * mus_oscil(md1, mus_hz2radians(fm_ratio1 * freq), 0.0) +
fm_index2 * mus_oscil(md2, mus_hz2radians(fm_ratio2 * freq), 0.0) +
fm_index3 * mus_oscil(md3, mus_hz2radians(fm_ratio3 * freq), 0.0), 0.0));
}"
end
end

begin
bess(banner, file) do ffm_rb() end
end

# bess.rb ends here

+ 249
- 0
lib/sndlib/bess.scm View File

@@ -0,0 +1,249 @@
;;; this is obsolete -- it needs some replacement for the mus-audio* functions

(when (provided? 'snd-motif)
(with-let (sublet *motif*)
;; set up our user-interface
(let* ((app (car (main-widgets)))
(shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
(xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
(titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
(dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
(list XmNcancelLabelString xdismiss
XmNhelpLabelString xhelp
XmNautoUnmanage #f
XmNdialogTitle titlestr
XmNresizePolicy XmRESIZE_GROW
XmNnoResize #f
XmNtransient #f))))
(XtAddCallback dialog
XmNhelpCallback (lambda (w context info)
(snd-print "This dialog lets you experiment with simple FM")))
(XmStringFree xhelp)
(XmStringFree xdismiss)
(XmStringFree titlestr)
dialog))
(dpy (XtDisplay shell))
(screen (DefaultScreenOfDisplay dpy))
;; (cmap (DefaultColormap dpy (DefaultScreen dpy)))
(black (BlackPixelOfScreen screen))
(white (WhitePixelOfScreen screen)))
(define (set-flabel label value)
(let ((s1 (XmStringCreate (format #f "~,3F" value) XmFONTLIST_DEFAULT_TAG)))
(XtVaSetValues label (list XmNlabelString s1))
(XmStringFree s1)))
(define (set-ilabel label value)
(let ((s1 (XmStringCreate (format #f "~D" value) XmFONTLIST_DEFAULT_TAG)))
(XtVaSetValues label (list XmNlabelString s1))
(XmStringFree s1)))
(let* ((form (XtCreateManagedWidget "form" xmFormWidgetClass shell
(list XmNbackground white
XmNforeground black
XmNresizePolicy XmRESIZE_GROW)))
;; toggle named "play"
(play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNbackground white)))
;; carrier freq
(carrier (XtCreateManagedWidget "carrier freq:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget play-button
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground white)))
(freq-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget carrier
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget carrier
XmNrightAttachment XmATTACH_NONE
XmNbackground white)))
(freq-scale (XtCreateManagedWidget "carrier freq" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget freq-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget freq-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNbackground *position-color*)))
;; amp
(amp-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(let ((amp (XtCreateManagedWidget "amp:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget carrier
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground white))))
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget amp
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget amp
XmNrightAttachment XmATTACH_NONE
XmNbackground white))))
(amp-scale (XtCreateManagedWidget "amp" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget amp-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget amp-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNbackground *position-color*)))
;; fm index
(fm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(let ((fm-index (XtCreateManagedWidget "fm index:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget amp-scale
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground white))))
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget fm-index
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget fm-index
XmNrightAttachment XmATTACH_NONE
XmNbackground white))))
(fm-scale (XtCreateManagedWidget "fm index" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget fm-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget fm-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNbackground *position-color*)))
;; c/m ratio
(cm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(let ((cm-ratio (XtCreateManagedWidget "c/m ratio:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget fm-scale
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground white))))
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget cm-ratio
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget cm-ratio
XmNrightAttachment XmATTACH_NONE
XmNbackground white))))
(cm-scale (XtCreateManagedWidget "cm ratio" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget cm-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget cm-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNbackground *position-color*))))
(let ((frequency 220.0)
(low-frequency 40.0)
(high-frequency 2000.0)
(amplitude 0.5)
(index 1.0)
(high-index 3.0)
(ratio 1)
(high-ratio 10)
(playing 0.0)
(carosc (make-oscil 0.0))
(modosc (make-oscil 0.0)))
(define (freq-callback w c i)
(set! frequency (+ low-frequency (* (.value i) (/ (- high-frequency low-frequency) 100.0))))
(set-flabel freq-label frequency))
(define (amp-callback w c i)
(set! amplitude (/ (.value i) 100.0))
(set-flabel amp-label amplitude))
(define (fm-callback w c i)
(set! index (* (.value i) (/ high-index 100.0)))
(set-flabel fm-label index))
(define (ratio-callback w c i)
(set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
(set-ilabel cm-label ratio))
;; add scale-change (drag and value-changed) callbacks
(XtAddCallback freq-scale XmNdragCallback freq-callback)
(XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)
(XtAddCallback amp-scale XmNdragCallback amp-callback)
(XtAddCallback amp-scale XmNvalueChangedCallback amp-callback)
(XtAddCallback fm-scale XmNdragCallback fm-callback)
(XtAddCallback fm-scale XmNvalueChangedCallback fm-callback)
(XtAddCallback cm-scale XmNdragCallback ratio-callback)
(XtAddCallback cm-scale XmNvalueChangedCallback ratio-callback)
(XtAddCallback play-button XmNvalueChangedCallback (lambda (w c i) (set! playing (if (.set i) 1.0 0.0))))
;; set initial values
(set-flabel freq-label frequency)
(set-flabel amp-label amplitude)
(set-flabel fm-label index)
(set-ilabel cm-label ratio)
(XmScaleSetValue freq-scale (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency)))))
(XmScaleSetValue amp-scale (floor (* 100 amplitude)))
(XmScaleSetValue fm-scale (floor (* 100 (/ index high-index))))
(XmScaleSetValue cm-scale (floor (* ratio (/ 100 high-ratio))))
(XtManageChild shell)
(XtRealizeWidget shell)
;; send fm data to dac
(let* ((bufsize 256)
(work-proc #f)
(port (mus-audio-open-output mus-audio-default 22050 1 mus-lshort (* bufsize 2))))
(if (< port 0)
(format () "can't open DAC!"))
(XmAddWMProtocolCallback (cadr (main-widgets)) ; shell
(XmInternAtom dpy "WM_DELETE_WINDOW" #f)
(lambda (w c i)
(XtRemoveWorkProc work-proc) ; odd that there's no XtAppRemoveWorkProc
(mus-audio-close port))
#f)
(XtAddCallback shell
XmNcancelCallback (lambda (w context info)
(XtRemoveWorkProc work-proc)
(mus-audio-close port)
(XtUnmanageChild shell)))
(set! work-proc (XtAppAddWorkProc app
(lambda (ignored-arg)
(let ((data (make-float-vector bufsize)))
(do ((i 0 (+ 1 i)))
((= i bufsize))
(float-vector-set! data i (* amplitude playing
(oscil carosc
(+ (hz->radians frequency)
(* index
(oscil modosc
(hz->radians (* ratio frequency)))))))))
(mus-audio-write port data bufsize)
#f))))))))))

+ 527
- 0
lib/sndlib/bess1.rb View File

@@ -0,0 +1,527 @@
#!/usr/bin/env ruby
# bess1.rb -- some examples from clm/rt.lisp and clm/bess5.cl

# Copyright (C) 2002--2009 Michael Scholz

# Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Sun Sep 15 19:11:12 CEST 2002
# Changed: Tue Sep 29 02:05:49 CEST 2009

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

# Commentary:

# Requires sndlib.so and libxm.so!
#
# This file provides simple mono real time output to DAC. Tempo,
# frequency, amplitude, and FM index can be controlled via sliders.
# The music algorithms are taken from clm/rt.lisp and clm/bess5.cl.
#
# Bess.new.start -- starts a Motif widget with two DAC tests.
#
# Bess.new.start(:srate, $clm_srate # 22050
# :bufsize, $clm_rt_bufsize # 128
# :sample_type, $clm_sample_type # Mus_lshort
# :which, :agn # :agn or :vct_test
# :play, false)

# Code:

def warn(*args)
str = format(*args) << ($! ? ": #{$!}" : "") << "\n"
str << (($@ and $DEBUG) ? "\n[#{$@.join("\n")}]" : "")
$stdout.print str
$! = nil
end

def die(*args)
warn(*args)
exit 1
end

def rbm_require(lib)
puts "loading #{lib.inspect}" if $VERBOSE
require lib.to_s
rescue ScriptError
die "\aScriptError"
end

rbm_require "sndlib"
$output = nil # holds fd from mus_audio_open_output()
$clm_srate = 22050
$clm_sample_type = Mus_lshort
$clm_rt_bufsize = 128

module Bess_utils
def rbm_random(n)
mus_random(n).abs
end

def get_args(args, key, val)
if(key == :help and (args == key or args.member?(key) or args.assoc(key)))
val = true
elsif(args.member?(key))
x = args[args.index(key) + 1]
val = ((x == nil) ? val : x)
elsif(args.assoc(key))
val = (args.assoc(key)[1] rescue val)
end
val
end

def seconds2samples(sec)
sr = (mus_srate() rescue $clm_srate)
(sec * sr).round
end

def envelope_interp(*args)
x = args[0]
env = args[1]
base = args[2]
if (not env) or env.empty?
0.0
elsif x <= env[0] or env[2..-1].empty?
env[1]
elsif env[2] > x
if env[1] == env[3] or (base and base == 0.0)
env[1]
elsif (not base) or base == 1.0
env[1] + (x - env[0]) * ((env[3] - env[1]) / (env[2] - env[0]))
else
env[1] + ((env[3] - env[1]) / (base - 1.0)) *
((base ** ((x - env[0]) / (env[2] - env[0]))) - 1.0)
end
else
envelope_interp(x, env[2..-1])
end
end

include Math

# simple violin, see snd/fm.html
def make_rt_violin(dur = 1.0, freq = 440.0, amp = 0.3, *args)
fm_index = get_args(args, :fm_index, 1.0)
amp_env = get_args(args, :amp_env, [0, 0, 25, 1, 75, 1, 100, 0])
frq_scl = hz2radians(freq)
maxdev = frq_scl * fm_index
index1 = maxdev * (5.0 / log(freq))
index2 = maxdev * 3.0 * ((8.5 - log(freq)) / (3.0 + freq / 1000.0))
index3 = maxdev * (4.0 / sqrt(freq))
carrier = make_oscil(:frequency, freq)
fmosc1 = make_oscil(:frequency, freq)
fmosc2 = make_oscil(:frequency, freq * 3.0)
fmosc3 = make_oscil(:frequency, freq * 4.0)
ampf = make_env(:envelope, amp_env, :scaler, amp, :duration, dur)
indf1 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index1, :duration, dur)
indf2 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index2, :duration, dur)
indf3 = make_env(:envelope, [0, 1, 25, 0.4, 75, 0.6, 100, 0], :scaler, index3, :duration, dur)
pervib = make_triangle_wave(:frequency, 0.5, :amplitude, 0.0025 * frq_scl)
ranvib = make_rand_interp(:frequency, 16.0, :amplitude, 0.005 * frq_scl)
lambda do | |
vib = triangle_wave(pervib) + rand_interp(ranvib)
env(ampf) * oscil(carrier,
vib + env(indf1) * oscil(fmosc1, vib) +
env(indf2) * oscil(fmosc2, 3.0 * vib) +
env(indf3) * oscil(fmosc3, 4.0 * vib))
end
end
end

# class Agn is a simplified translation of clm/bess5.cl and
# clm/clm-example.lisp.
class Agn
include Bess_utils
def initialize
@tempo = 0.25
@amp = 1.0
@freq = 1.0
@index = 1.0
@play = false
@lim = 256
@time = 60
@octs = Array.new(@lim + 1) do |i| (4 + 2 * rbell(rbm_random(1.0))).floor end
@rhys = Array.new(@lim + 1) do |i| (4 + 6 * rbm_random(1.0)).floor end
@amps = Array.new(@lim + 1) do |i| (1 + 8 * rbell(rbm_random(1.0))).floor end
@pits = Array.new(@lim + 1) do |i|
[0, 0, 2, 4, 11, 11, 5, 6, 7, 9, 2, 0, 0].at((12 * rbm_random(1.0)).floor)
end
@begs = Array.new(@lim + 1) do |i|
if rbm_random(1.0) < 0.9
(4 + 2 * rbm_random(1.0)).floor
else
(6 * rbm_random(4.0)).floor
end
end
end

# called by XtAppAddWorkProc
def rt_send2dac(func)
if @play
mus_audio_write($output, vct2sound_data(vct_map!(make_vct($clm_rt_bufsize), func.call),
make_sound_data(1, $clm_rt_bufsize), 0),
$clm_rt_bufsize)
false
else
mus_audio_close($output)
$output = nil
true
end
end
# see clm/rt.lisp
def make_vct_test(*args)
srate = get_args(args, :srate, $clm_srate)
bufsize = get_args(args, :bufsize, $clm_rt_bufsize)
sample_type = get_args(args, :sample_type, $clm_sample_type)
$clm_srate = set_mus_srate(srate).to_i
$clm_rt_bufsize = bufsize
$output = mus_audio_open_output(Mus_audio_default, srate, 1, sample_type, bufsize * 2)
mode = [0, 12, 2, 4, 14, 4, 5, 5, 0, 7, 7, 11, 11]
pits = Array.new(@lim + 1) do rbm_random(12.0).floor end
begs = Array.new(@lim + 1) do 1 + rbm_random(3.0).floor end
cellbeg, cellsiz, cellctr = 0, 6, 0
func = nil
len = dur = 0
lambda do | |
if len > 1
len -= 1
else
dur = @tempo * begs[cellctr + 1]
cellctr += 1
if cellctr > (cellsiz + cellbeg)
cellbeg += 1 if rbm_random(1.0) > 0.5
cellsiz += 1 if rbm_random(1.0) > 0.5
cellctr = cellbeg
end
func = make_rt_violin(dur, @freq * 16.351 * 16 * 2 ** (mode[pits[cellctr]] / 12.0),
@amp * 0.3, :fm_index, @index)
len = (seconds2samples(dur) / bufsize).ceil
end
func
end
end
def tune(x)
[1.0, 256.0 / 243, 9.0 / 8, 32.0 / 27, 81.0 / 64,
4.0 / 3, 1024.0 / 729, 3.0 / 2, 128.0 / 81, 27.0 / 16,
16.0 / 9, 243.0 / 128, 2.0].at(x % 12) * 2 ** x.divmod(12).first
end

def rbell(x)
envelope_interp(x * 100, [0, 0, 10, 0.25, 90, 1.0, 100, 1.0])
end

# see clm/bess5.cl
def make_agn(*args)
srate = get_args(args, :srate, $clm_srate)
bufsize = get_args(args, :bufsize, $clm_rt_bufsize)
sample_type = get_args(args, :sample_type, $clm_sample_type)
$clm_srate = set_mus_srate(srate).to_i
$clm_rt_bufsize = bufsize
$output = mus_audio_open_output(Mus_audio_default, srate, 1, sample_type, bufsize * 2)
die("can't open DAC (%s)", $output.inspect) if $output < 0
wins = [[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 60, 0.1, 80, 0.2, 90, 0.4, 95, 1, 100, 0],
[0, 0, 10, 1, 16, 0, 32, 0.1, 50, 1, 56, 0, 60, 0, 90, 0.3, 100, 0],
[0, 0, 30, 1, 56, 0, 60, 0, 90, 0.3, 100, 0],
[0, 0, 50, 1, 80, 0.3, 100, 0],
[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 10, 1, 32, 0.1, 50, 1, 90, 0.3, 100, 0],
[0, 0, 60, 0.1, 80, 0.3, 95, 1, 100, 0],
[0, 0, 80, 0.1, 90, 1, 100, 0]]
cellbeg, cellsiz, cellctr, whichway = 0, 4, 0, 1
nextbeg = beg = 0.0
func = nil
len = dur = 0
lambda do | |
if len > 1
len -= 1
else
beg += nextbeg
nextbeg += [0.025, @tempo * (0.95 + rbm_random(0.1)) * @begs[cellctr]].max
dur = [0.025, @tempo * (0.85 + rbm_random(0.1)) * @rhys[cellctr]].max
freq = @freq * 16.351 * tune(@pits[cellctr]) * 2 ** @octs[cellctr]
dur += dur if freq < 100
ampl = @amp * 10 * [0.003, @amps[cellctr] * 0.01].max
ind = @index * rbm_random(1.0) * 3.0
cellctr += 1
if cellctr > (cellsiz + cellbeg)
cellbeg += 1
if rbm_random(1.0) > 0.5
cellsiz += whichway
end
if cellsiz > 10 and rbm_random(1.0) > 0.99
whichway = -2
if cellsiz > 6 and rbm_random(1.0) > 0.999
whichway = -1
if cellsiz < 4
whichway = 1
end
end
end
nextbeg += rbm_random(1.0)
cellctr = cellbeg
end
func = make_rt_violin(dur, freq, ampl, :fm_index, ind,
:amp_env, wins[(10 * (beg - beg.floor)).floor])
len = (seconds2samples(dur) / bufsize).ceil
end
func
end
end
end

class Bess < Agn
rbm_require "libxm"
def initialize
super
@sliderback = "lightsteelblue"
@background = "lightsteelblue1"
@which = @proc = nil
@shell_app = @form = nil
@tl = @ts = @fl = @fs = @al = @as = @il = @is = nil
1.upto(15) do |i|
trap(i) do |sig|
puts "\nSignal #{sig} received. Process #{$$} canceled."
RXtRemoveWorkProc(@proc) if @proc
exit 0
end
end
end
def get_color(color)
col = RXColor()
dpy = RXtDisplay(@shell_app[0])
cmap = RDefaultColormap(dpy, RDefaultScreen(dpy))
warn("Can't allocate #{color.inspect}!") if RXAllocNamedColor(dpy, cmap, color, col, col).zero?
Rpixel(col)
end

def set_label(wid, *args)
RXtVaSetValues(wid, [RXmNlabelString, RXmStringCreate(format(*args), RXmFONTLIST_DEFAULT_TAG)])
end

def make_label(wid, name)
RXtCreateManagedWidget(name, RxmLabelWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_FORM,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNalignment, RXmALIGNMENT_END,
RXmNrecomputeSize, false,
RXmNbackground, get_color(@background)])
end
def make_scale_label(wid)
RXtCreateManagedWidget("label", RxmLabelWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, wid,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_OPPOSITE_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
end
def make_scale(wid)
RXtCreateManagedWidget("scale", RxmScaleWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, wid,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_OPPOSITE_WIDGET,
RXmNtopWidget, wid,
RXmNrightAttachment, RXmATTACH_FORM,
RXmNshowValue, false,
RXmNorientation, RXmHORIZONTAL,
RXmNheight, 20,
RXmNbackground, get_color(@sliderback)])
end

# return label and scale widget
def make_scales(wid, name, val, callback)
label = make_scale_label(make_label(wid, name))
scale = make_scale(label)
set_label(label, val.kind_of?(Integer) ? "%4d" : "%4.3f", val)
RXtAddCallback(scale, RXmNdragCallback, callback, label)
RXtAddCallback(scale, RXmNvalueChangedCallback, callback ,label)
[label, scale]
end

def do_play(*args)
if @play
case @which
when :agn
func = make_agn(*args)
when :vct_test
func = make_vct_test(*args)
else
func = make_agn(*args)
end
@proc = RXtAppAddWorkProc(@shell_app[1], lambda do |c| rt_send2dac(func) end)
else
RXtRemoveWorkProc(@proc) if @proc
end
end

def set_defaults(parent)
@tempo = 0.25
@amp = 1.0
@freq = 1.0
@index = 1.0
low_tempo = 0.05
high_tempo = 0.5
low_freq = 0.1
high_freq = 4.0
high_index = 2.0
set_label(@tl, "%4.3f", @tempo)
RXmScaleSetValue(@ts, (100 * (@tempo - low_tempo) / (high_tempo - low_tempo)).round)
set_label(@fl, "%4.3f", @freq)
RXmScaleSetValue(@fs, (100 * (@freq - low_freq) / (high_freq - low_freq)).round)
set_label(@al, "%4.3f", @amp)
RXmScaleSetValue(@as, (100 * @amp).round)
set_label(@il, "%4.3f", @index)
RXmScaleSetValue(@is, (100 * (@index / high_index)).round)
end
def start(*args)
@play = get_args(args, :play, false)
@which = get_args(args, :which, :agn)
# rest args are going to make_vct_test() or make_agn()
cargs = [$0] + $*
@shell_app = RXtVaOpenApplication("FM", cargs.length, cargs, RapplicationShellWidgetClass,
[RXmNallowShellResize, true, RXmNtitle, "FM forever!"])
RXtAddEventHandler(@shell_app[0], 0, true,
lambda do |w, c, i, f| R_XEditResCheckMessages(w, c, i, f) end)
@form = RXtCreateManagedWidget("form", RxmFormWidgetClass, @shell_app[0],
[RXmNresizePolicy, RXmRESIZE_GROW,
RXmNbackground, get_color(@background)])
play = RXtCreateManagedWidget("play", RxmToggleButtonWidgetClass, @form,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_FORM,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
radio = RXmCreateRadioBox(@form, "radio",
[RXmNorientation, RXmHORIZONTAL,
RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, play,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
p_agn = RXtCreateManagedWidget("agn", RxmToggleButtonWidgetClass, radio,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_FORM,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
p_test = RXtCreateManagedWidget("test", RxmToggleButtonWidgetClass, radio,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, p_agn,
RXmNrightAttachment, RXmATTACH_NONE,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
quit = RXtCreateManagedWidget(" quit ", RxmPushButtonWidgetClass, @form,
[RXmNtopAttachment, RXmATTACH_FORM,
RXmNleftAttachment, RXmATTACH_WIDGET,
RXmNleftWidget, radio,
RXmNrightAttachment, RXmATTACH_FORM,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNbackground, get_color(@background)])
sep = RXtCreateManagedWidget("sep", RxmSeparatorWidgetClass, @form,
[RXmNleftAttachment, RXmATTACH_FORM,
RXmNbottomAttachment, RXmATTACH_NONE,
RXmNtopAttachment, RXmATTACH_WIDGET,
RXmNtopWidget, radio,
RXmNrightAttachment, RXmATTACH_FORM,
RXmNheight, 4,
RXmNorientation, RXmHORIZONTAL])
RXmToggleButtonSetState(play, @play, true)
RXtAddCallback(play, RXmNvalueChangedCallback,
lambda do |w, c, i|
@play = Rset(i)
set_defaults(sep) if @play
do_play(*args)
end)
RXmToggleButtonSetState(p_agn, @which == :agn, true)
RXtAddCallback(p_agn, RXmNvalueChangedCallback,
lambda do |w, c, i|
@which = c if Rset(i)
@play = false
RXmToggleButtonSetState(play, @play, true)
end, :agn)
RXmToggleButtonSetState(p_test, @which == :vct_test, true)
RXtAddCallback(p_test, RXmNvalueChangedCallback,
lambda do |w, c, i|
@which = c if Rset(i)
@play = false
RXmToggleButtonSetState(play, @play, true)
end, :vct_test)
RXtAddCallback(quit, RXmNactivateCallback,
lambda do |w, c, i|
RXtRemoveWorkProc(@proc) if @proc
exit 0
end)
low_tempo = 0.05
high_tempo = 0.5
low_freq = 0.1
high_freq = 4.0
high_index = 2.0
@tl, @ts = make_scales(sep, " tempo:", @tempo,
lambda do |w, c, i|
@tempo = low_tempo + Rvalue(i) * (high_tempo - low_tempo) * 0.01
set_label(c, "%4.3f", @tempo)
end)
RXmScaleSetValue(@ts, (100 * (@tempo - low_tempo) / (high_tempo - low_tempo)).round)
@fl, @fs = make_scales(@ts, " freq:", @freq,
lambda do |w, c, i|
@freq = low_freq + Rvalue(i) * ((high_freq - low_freq) * 0.01)
set_label(c, "%4.3f", @freq)
end)
RXmScaleSetValue(@fs, (100 * (@freq - low_freq) / (high_freq - low_freq)).round)
@al, @as = make_scales(@fs, " amp:", @amp,
lambda do |w, c, i|
@amp = Rvalue(i) * 0.01
set_label(c, "%4.3f", @amp)
end)
RXmScaleSetValue(@as, (100 * @amp).round)
@il, @is = make_scales(@as, " index:", @index,
lambda do |w, c, i|
@index = Rvalue(i) * high_index * 0.01
set_label(c, "%4.3f", @index)
end)
RXmScaleSetValue(@is, (100 * (@index / high_index)).round)
do_play(*args)
RXtManageChild(radio)
RXtRealizeWidget(@shell_app[0])
RXtAppMainLoop(@shell_app[1])
end
end

begin
# Bess.new.start(:srate, $clm_srate,
# :bufsize, $clm_rt_bufsize,
# :sample_type, $clm_sample_type,
# :which, :agn,
# :play, false)
Bess.new.start
end

# bess1.rb ends here

+ 534
- 0
lib/sndlib/bess1.scm View File

@@ -0,0 +1,534 @@
;;; bess1.scm -- some examples from clm-2/rt.lisp and clm-2/bess5.cl

;; Author: Michael Scholz <scholz-micha@gmx.de>
;; Created: Thu May 29 04:14:35 CEST 2003
;; Last: Sun Jun 15 03:50:21 CEST 2003
;; changed slightly 14-Jun-06 Bill to match bess.scm, fix pitch problem in make-oscil.
;; then again 18-Dec-09 to use s7 rather than Guile
;; changed float-vector-map! to use a loop instead (Bill 4-July-12)

(if (not (provided? 'snd-motif)) (error "bess1.scm needs motif"))

;;; Commentary:

;; This file provides simple mono real time output to DAC. Tempo,
;; frequency, amplitude, and FM index can be controlled via sliders.
;; The music algorithms are taken from clm-2/rt.lisp and
;; clm-2/bess5.cl.

;; (main) calls (rt-motif) which starts a Motif widget with two DAC
;; tests.
;;
;; (rt-motif :srate *clm-srate* ;; 22050
;; :bufsize *clm-rt-bufsize* ;; 128
;; :sample-type *clm-sample-type*) ;; mus-lshort

;;; Code:

(with-let *motif*

(set! *clm-srate* 22050)

(define *clm-sample-type* mus-lfloat)
(define *clm-rt-bufsize* 1024)
(define *output* #f) ;holds fd from (mus-audio-open-output)

(define ctempo 0.25)
(define camp 1.0)
(define cfreq 1.0)
(define cindex 1.0)
(define cplay #f)
(define sliderback "lightsteelblue")
(define background "lightsteelblue1")

;(define (seconds->samples secs) (round (* secs *clm-srate*)))

;; called by XtAppAddWorkProc
(define (rt-send->dac func)
(if cplay
(let ((data (make-float-vector *clm-rt-bufsize*)))
(do ((i 0 (+ i 1)))
((= i *clm-rt-bufsize*))
(set! (data i) (func)))
(mus-audio-write *output* (copy data (make-float-vector (list 1 *clm-rt-bufsize*))) *clm-rt-bufsize*)
#f)
(begin
(mus-audio-close *output*)
#t)))

(define make-rt-violin
(let ((documentation "(make-rt-violin dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0))) real time simple violin (see fm.html)"))
(lambda* (dur freq amp (fm-index 1.0) (amp-env '(0 0 25 1 75 1 100 0)))
(let* ((frq-scl (hz->radians freq))
(maxdev (* frq-scl fm-index)))
(let ((carrier (make-oscil :frequency freq))
(fmosc1 (make-oscil :frequency freq))
(fmosc2 (make-oscil :frequency (* 3 freq)))
(fmosc3 (make-oscil :frequency (* 4 freq)))
(ampf (make-env :envelope amp-env :scaler amp :duration dur))
(indf1 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
:scaler (* maxdev (/ 5.0 (log freq)))
:duration dur))
(indf2 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
:scaler (/ (* maxdev 3.0 (- 8.5 (log freq))) (+ 3.0 (/ freq 1000)))
:duration dur))
(indf3 (make-env :envelope '(0 1 25 0.4 75 0.6000000000000001 100 0)
:scaler (* maxdev (/ 4.0 (sqrt freq)))
:duration dur))
(pervib (make-triangle-wave :frequency 5 :amplitude (* 0.0025 frq-scl)))
(ranvib (make-rand-interp :frequency 16 :amplitude (* 0.005 frq-scl))))
(lambda ()
(let ((vib (+ (triangle-wave pervib) (rand-interp ranvib))))
(* (env ampf)
(oscil carrier
(+ vib
(* (env indf1) (oscil fmosc1 vib))
(* (env indf2) (oscil fmosc2 (* 3.0 vib)))
(* (env indf3) (oscil fmosc3 (* 4.0 vib)))))))))))))

(define lim 256)

;; from clm-2/rt.lisp
(define* (make-float-vector-test (srate *clm-srate*)
(bufsize *clm-rt-bufsize*)
(sample-type *clm-sample-type*))
(let ((vpits (make-vector (+ 1 lim) 0))
(vbegs (make-vector (+ 1 lim) 0)))
(do ((i 0 (+ 1 i)))
((= i lim))
(set! (vpits i) (random 12))
(set! (vbegs i) (+ 1 (random 3))))
(set! *clm-srate* srate)
(set! *clm-rt-bufsize* bufsize)
(set! *output* (mus-audio-open-output mus-audio-default srate 1 sample-type (* bufsize 2)))

(let ((cellbeg 0)
(cellsiz 6)
(cellctr 0)
(func #f)
(len 0)
(dur 0.0)
(vmode (vector 0 12 2 4 14 4 5 5 0 7 7 11 11)))
(lambda ()
(if (> len 1)
(set! len (- len 1))
(begin
(set! dur (* ctempo (vbegs (+ cellctr 1))))
(set! cellctr (+ cellctr 1))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(if (> (random 1.0) 0.5) (set! cellbeg (+ 1 cellbeg)))
(if (> (random 1.0) 0.5) (set! cellsiz (+ 1 cellsiz)))
(set! cellctr cellbeg)))
(let ((freq (* cfreq 16.351 16
(expt 2 (/ (vmode (vpits cellctr)) 12.0)))))
(format () "dur: ~A, freq: ~A, amp: ~A, index: ~A~%"
dur
(if (< (* 8 freq) *clm-srate*)
freq
(/ freq 4))
(* camp 0.3)
cindex)
(set! func (make-rt-violin dur
(if (< (* 8 freq) *clm-srate*)
freq
(/ freq 4))
(* camp 0.3) :fm-index cindex)))
(set! len (ceiling (/ (seconds->samples dur) bufsize)))))
func))))

;; from clm-2/bess5.cl and clm-2/clm-example.lisp
(define time 60)
(define mode (vector 0 0 2 4 11 11 5 6 7 9 2 0 0))
(define rats (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0))

(define bell '(0 0 10 0.25 90 1.0 100 1.0))

(define pits (make-vector (+ 1 lim) 0))
(define octs (make-vector (+ 1 lim) 0))
(define rhys (make-vector (+ 1 lim) 0))
(define begs (make-vector (+ 1 lim) 0))
(define amps (make-vector (+ 1 lim) 0))

(define (tune x)
(* (rats (modulo x 12))
(expt 2 (floor (/ x 12)))))

(define (rbell x)
(envelope-interp (* x 100) bell))

(define* (make-agn (srate *clm-srate*)
(bufsize *clm-rt-bufsize*)
(sample-type *clm-sample-type*))
(do ((i 0 (+ i 1)))
((= i lim))
(set! (octs i) (floor (+ 4 (* 2 (rbell (random 1.0))))))
(set! (pits i) (mode (random 12)))
(set! (rhys i) (+ 4 (random 6)))
(set! (begs i) (if (< (random 1.0) 0.9)
(+ 4 (random 2))
(random 24)))
(set! (amps i) (floor (+ 1 (* 8 (rbell (random 1.0)))))))
(set! *clm-srate* srate)
(set! *clm-rt-bufsize* bufsize)
(set! *output* (mus-audio-open-output mus-audio-default srate 1 sample-type (* bufsize 2)))
(let ((wins (vector '(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
'(0 0 60 0.1 80 0.2 90 0.4 95 1 100 0)
'(0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0)
'(0 0 30 1 56 0 60 0 90 0.3 100 0)
'(0 0 50 1 80 0.3 100 0)
'(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
'(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
'(0 0 10 1 32 0.1 50 1 90 0.3 100 0)
'(0 0 60 0.1 80 0.3 95 1 100 0)
'(0 0 80 0.1 90 1 100 0)))
(nextbeg 0.0)
(beg 0.0)
(dur 0.0)
(freq 0.0)
(ampl 0.0)
(ind 0.0)
(cellctr 0)
(cellsiz 4)
(cellbeg 0)
(whichway 1)
(func #f)
(len 0))
(lambda ()
(if (> len 1)
(set! len (- len 1))
(begin
(set! beg (+ beg nextbeg))
(set! nextbeg (+ nextbeg (max 0.025 (* ctempo (+ 0.95 (random 0.1)) (begs cellctr)))))
(set! dur (max 0.025 (* ctempo (+ 0.85 (random 0.1)) (rhys cellctr))))
(set! freq (* cfreq 16.351 (tune (pits cellctr)) (expt 2 (octs cellctr))))
(set! ampl (* camp 10 (max 0.003 (* (amps cellctr) 0.01))))
(set! ind (* cindex (random 3.0)))
(set! cellctr (+ cellctr 1))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(set! cellbeg (+ 1 cellbeg))
(if (> (random 1.0) 0.5) (set! cellsiz (+ cellsiz whichway)))
(cond ((and (> cellsiz 10)
(> (random 1.0) 0.99))
(set! whichway -2))
((and (> cellsiz 6)
(> (random 1.0) 0.999))
(set! whichway -1))
((< cellsiz 4)
(set! whichway 1)))
(set! nextbeg (+ nextbeg (random 1.0)))
(set! cellctr cellbeg)))
(set! func (make-rt-violin dur freq ampl
:fm-index ind
:amp-env (wins (floor (* 10 (- beg (floor beg)))))))
(set! len (ceiling (/ (seconds->samples dur) bufsize)))))
func)))

#|
;; from env.scm
(define* (envelope-interp :rest args)
(let ((x (car args))
(env (cadr args))
(base (if (null? (cddr args)) #f (caddr args))))
(cond ((null? env) 0.0)
((or (<= x (car env))
(null? (cddr env)))
(cadr env))
((> (caddr env) x)
(if (or (= (cadr env) (cadddr env))
(and base (= base 0.0)))
(cadr env)
(if (or (not base) (= base 1.0))
(+ (cadr env)
(* (- x (car env))
(/ (- (cadddr env) (cadr env))
(- (caddr env) (car env)))))
(+ (cadr env)
(* (/ (- (cadddr env) (cadr env))
(- base 1.0))
(- (expt base (/ (- x (car env))
(- (caddr env) (car env))))
1.0))))))
(else (envelope-interp x (cddr env))))))
|#

(define* (rt-motif :rest args)
(let* ((shell-app (XtVaOpenApplication
"FM" 0 () applicationShellWidgetClass
(list XmNallowShellResize #t)))
(app (cadr shell-app))
(shell (car shell-app))
(dpy (XtDisplay shell))
(black (BlackPixelOfScreen (DefaultScreenOfDisplay dpy))))

(define (get-color color)
(let ((col (XColor))
(cmap (DefaultColormap dpy (DefaultScreen dpy))))
(if (= (XAllocNamedColor dpy cmap color col col) 0)
(error (format #f "can't allocate ~A" color))
(.pixel col))))

(define (set-flabel label value)
(let ((s1 (XmStringCreate (format #f "~5,3F" value) XmFONTLIST_DEFAULT_TAG)))
(XtVaSetValues label (list XmNlabelString s1))
(XmStringFree s1)))

(XtSetValues shell (list XmNtitle "FM Forever!"))
(let* ((light-blue (get-color sliderback))
(form (XtCreateManagedWidget "form" xmFormWidgetClass shell
(list XmNbackground (get-color background)
XmNforeground black
XmNresizePolicy XmRESIZE_GROW)))
;; play
(play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
;; radio
(radio (XmCreateRadioBox form "radio"
(list XmNorientation XmHORIZONTAL
XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget play-button
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
;; play agn
(agn-button (XtCreateManagedWidget "agn" xmToggleButtonWidgetClass radio
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
;; play test
(test-button (XtCreateManagedWidget "test" xmToggleButtonWidgetClass radio
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget agn-button
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
;; quit
(quit-button (XtCreateManagedWidget " quit " xmPushButtonWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget radio
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_FORM
XmNrightAttachment XmATTACH_FORM
XmNbackground (get-color background))))
(tempo (let ((sep (XtCreateManagedWidget "sep" xmSeparatorWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget radio
XmNrightAttachment XmATTACH_FORM
XmNheight 4
XmNorientation XmHORIZONTAL))))
(XtCreateManagedWidget " tempo:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget sep
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground (get-color background)))))

(tempo-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget tempo
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget tempo
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
(tempo-scale (XtCreateManagedWidget "tempo" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget tempo-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget tempo-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNheight 20
XmNbackground light-blue)))
;; freq
(freq (XtCreateManagedWidget " freq:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget tempo
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground (get-color background))))
(freq-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget freq
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget freq
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
(freq-scale (XtCreateManagedWidget "freq" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget freq-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget freq-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNheight 20
XmNbackground light-blue)))
;; amp
(amp (XtCreateManagedWidget " amp:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget freq
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground (get-color background))))
(amp-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget amp
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget amp
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background))))
(amp-scale (XtCreateManagedWidget "amp" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget amp-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget amp-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNheight 20
XmNbackground light-blue)))
(index-label (let ((index (XtCreateManagedWidget " index:" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_FORM
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_WIDGET
XmNtopWidget amp
XmNrightAttachment XmATTACH_NONE
XmNrecomputeSize #f
XmNbackground (get-color background)))))
(XtCreateManagedWidget "label" xmLabelWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget index
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget index
XmNrightAttachment XmATTACH_NONE
XmNbackground (get-color background)))))
(index-scale (XtCreateManagedWidget "index" xmScaleWidgetClass form
(list XmNleftAttachment XmATTACH_WIDGET
XmNleftWidget index-label
XmNbottomAttachment XmATTACH_NONE
XmNtopAttachment XmATTACH_OPPOSITE_WIDGET
XmNtopWidget index-label
XmNrightAttachment XmATTACH_FORM
XmNshowValue #f
XmNorientation XmHORIZONTAL
XmNheight 20
XmNbackground light-blue))))
(let ((low-tempo 0.05)
(high-tempo 0.5)
(low-freq 0.1)
(high-freq 4.0)
(high-index 2.0)
(which-play 0)
(proc #f)
(func #f))
(define (tempo-callback w c i)
(set! ctempo (+ low-tempo (* (.value i) (/ (- high-tempo low-tempo) 100.0))))
(set-flabel tempo-label ctempo))
(define (amp-callback w c i)
(let ((high-amp 1.0))
(set! camp (* (.value i) (/ high-amp 100.0))))
(set-flabel amp-label camp))
(define (freq-callback w c i)
(set! cfreq (+ low-freq (* (.value i) (/ (- high-freq low-freq) 100.0))))
(set-flabel freq-label cfreq))
(define (index-callback w c i)
(set! cindex (* (.value i) (/ high-index 100.0)))
(set-flabel index-label cindex))
(define (set-defaults)
(set! ctempo 0.25)
(set! camp 1.0)
(set! cfreq 1.0)
(set! cindex 1.0)
(set-flabel tempo-label ctempo)
(set-flabel amp-label camp)
(set-flabel freq-label cfreq)
(set-flabel index-label cindex)
(XmScaleSetValue tempo-scale (floor (* 100 (/ (- ctempo low-tempo) (- high-tempo low-tempo)))))
(XmScaleSetValue freq-scale (floor (* 100 (/ (- cfreq low-freq) (- high-freq low-freq)))))
(XmScaleSetValue amp-scale (floor (* 100 camp)))
(XmScaleSetValue index-scale (floor (* 100 (/ cindex high-index)))))
(XtManageChild radio)
;; add scale-change (drag and value-changed) callbacks
(XtAddCallback tempo-scale XmNdragCallback tempo-callback)
(XtAddCallback tempo-scale XmNvalueChangedCallback tempo-callback)
(XtAddCallback amp-scale XmNdragCallback amp-callback)
(XtAddCallback amp-scale XmNvalueChangedCallback amp-callback)
(XtAddCallback freq-scale XmNdragCallback freq-callback)
(XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)
(XtAddCallback index-scale XmNdragCallback index-callback)
(XtAddCallback index-scale XmNvalueChangedCallback index-callback)
(XtAddCallback agn-button XmNvalueChangedCallback
(lambda (w c i)
(if (.set i)
(set! which-play 0))
(set! cplay #f)
(XmToggleButtonSetState play-button cplay #f)))
(XmToggleButtonSetState agn-button #t #f)
(XtAddCallback test-button XmNvalueChangedCallback
(lambda (w c i)
(if (.set i)
(set! which-play 1))
(set! cplay #f)
(XmToggleButtonSetState play-button cplay #f)))
(XtAddCallback quit-button XmNactivateCallback
(lambda (w c i)
(set! cplay #f)
(if proc (XtRemoveWorkProc proc))
(exit 0)))
(XtAddCallback play-button XmNvalueChangedCallback
(lambda (w c i)
(set! cplay (.set i))
(if cplay
(begin
(set-defaults)
(set! func (apply (if (= which-play 0) make-agn make-float-vector-test) (or args ())))
(set! proc (XtAppAddWorkProc app (lambda (c) (rt-send->dac func)))))
(if proc (XtRemoveWorkProc proc)))))
(XmToggleButtonSetState play-button cplay #f)
(set-defaults)
(XtRealizeWidget shell))
(XtAppMainLoop app))))

(rt-motif)
)
;; bess1.scm ends here

+ 1119
- 0
lib/sndlib/bird.fsm
File diff suppressed because it is too large
View File


+ 1161
- 0
lib/sndlib/bird.rb
File diff suppressed because it is too large
View File


+ 1044
- 0
lib/sndlib/bird.scm
File diff suppressed because it is too large
View File


+ 3326
- 0
lib/sndlib/clm-ins.fs
File diff suppressed because it is too large
View File


+ 3783
- 0
lib/sndlib/clm-ins.rb
File diff suppressed because it is too large
View File


+ 2730
- 0
lib/sndlib/clm-ins.scm
File diff suppressed because it is too large
View File


+ 333
- 0
lib/sndlib/clm-strings.h View File

@@ -0,0 +1,333 @@
#ifndef CLM_STRINGS_H
#define CLM_STRINGS_H

/* there's some inconsistency about the mus- prefix: mus-interp-* but *-window etc */

#define S_all_pass "all-pass"
#define S_is_all_pass "all-pass?"
#define S_all_pass_bank "all-pass-bank"
#define S_is_all_pass_bank "all-pass-bank?"
#define S_amplitude_modulate "amplitude-modulate"
#define S_array_interp "array-interp"
#define S_asymmetric_fm "asymmetric-fm"
#define S_is_asymmetric_fm "asymmetric-fm?"
#define S_autocorrelate "autocorrelate"
#define S_bartlett_window "bartlett-window"
#define S_bartlett_hann_window "bartlett-hann-window"
#define S_blackman2_window "blackman2-window"
#define S_blackman3_window "blackman3-window"
#define S_blackman4_window "blackman4-window"
#define S_blackman5_window "blackman5-window"
#define S_blackman6_window "blackman6-window"
#define S_blackman7_window "blackman7-window"
#define S_blackman8_window "blackman8-window"
#define S_blackman9_window "blackman9-window"
#define S_blackman10_window "blackman10-window"
#define S_bohman_window "bohman-window"
#define S_cauchy_window "cauchy-window"
#define S_clear_sincs "clear-sincs"
#define S_clm_default_frequency "clm-default-frequency"
#define S_clm_table_size "clm-table-size"
#define S_comb "comb"
#define S_is_comb "comb?"
#define S_comb_bank "comb-bank"
#define S_is_comb_bank "comb-bank?"
#define S_connes_window "connes-window"
#define S_continue_sample_to_file "continue-sample->file"
#define S_contrast_enhancement "contrast-enhancement"
#define S_convolution "convolution"
#define S_convolve "convolve"
#define S_convolve_files "convolve-files"
#define S_is_convolve "convolve?"
#define S_correlate "correlate"
#define S_db_to_linear "db->linear"
#define S_degrees_to_radians "degrees->radians"
#define S_delay "delay"
#define S_delay_tick "delay-tick"
#define S_is_delay "delay?"
#define S_dolph_chebyshev_window "dolph-chebyshev-window"
#define S_dot_product "dot-product"
#define S_dpss_window "dpss-window"
#define S_env "env"
#define S_env_any "env-any"
#define S_env_interp "env-interp"
#define S_is_env "env?"
#define S_even_multiple "even-multiple"
#define S_even_weight "even-weight"
#define S_exponential_window "exponential-window"
#define S_file_to_sample "file->sample"
#define S_is_file_to_sample "file->sample?"
#define S_filter "filter"
#define S_is_filter "filter?"
#define S_filtered_comb "filtered-comb"
#define S_is_filtered_comb "filtered-comb?"
#define S_filtered_comb_bank "filtered-comb-bank"
#define S_is_filtered_comb_bank "filtered-comb-bank?"
#define S_fir_filter "fir-filter"
#define S_is_fir_filter "fir-filter?"
#define S_flat_top_window "flat-top-window"
#define S_firmant "firmant"
#define S_is_firmant "firmant?"
#define S_formant "formant"
#define S_formant_bank "formant-bank"
#define S_is_formant_bank "formant-bank?"
#define S_is_formant "formant?"
#define S_gaussian_window "gaussian-window"
#define S_granulate "granulate"
#define S_is_granulate "granulate?"
#define S_hamming_window "hamming-window"
#define S_hann_window "hann-window"
#define S_hann_poisson_window "hann-poisson-window"
#define S_hz_to_radians "hz->radians"
#define S_iir_filter "iir-filter"
#define S_is_iir_filter "iir-filter?"
#define S_in_any "in-any"
#define S_ina "ina"
#define S_inb "inb"
#define S_kaiser_window "kaiser-window"
#define S_linear_to_db "linear->db"
#define S_locsig "locsig"
#define S_is_locsig "locsig?"
#define S_locsig_ref "locsig-ref"
#define S_locsig_reverb_ref "locsig-reverb-ref"
#define S_locsig_reverb_set "locsig-reverb-set!"
#define S_locsig_set "locsig-set!"
#define S_locsig_type "locsig-type"
#define S_make_all_pass "make-all-pass"
#define S_make_all_pass_bank "make-all-pass-bank"
#define S_make_asymmetric_fm "make-asymmetric-fm"
#define S_make_comb "make-comb"
#define S_make_comb_bank "make-comb-bank"
#define S_make_convolve "make-convolve"
#define S_make_delay "make-delay"
#define S_make_env "make-env"
#define S_make_fft_window "make-fft-window"
#define S_make_file_to_sample "make-file->sample"
#define S_make_filter "make-filter"
#define S_make_filtered_comb "make-filtered-comb"
#define S_make_filtered_comb_bank "make-filtered-comb-bank"
#define S_make_fir_coeffs "make-fir-coeffs"
#define S_make_fir_filter "make-fir-filter"
#define S_make_firmant "make-firmant"
#define S_make_formant "make-formant"
#define S_make_formant_bank "make-formant-bank"
#define S_make_granulate "make-granulate"
#define S_make_iir_filter "make-iir-filter"
#define S_make_locsig "make-locsig"
#define S_make_move_sound "make-move-sound"
#define S_make_moving_average "make-moving-average"
#define S_make_moving_max "make-moving-max"
#define S_make_moving_norm "make-moving-norm"
#define S_make_ncos "make-ncos"
#define S_make_notch "make-notch"
#define S_make_nrxycos "make-nrxycos"
#define S_make_nrxysin "make-nrxysin"
#define S_make_nsin "make-nsin"
#define S_make_one_pole "make-one-pole"
#define S_make_one_pole_all_pass "make-one-pole-all-pass"
#define S_make_one_zero "make-one-zero"
#define S_make_oscil "make-oscil"
#define S_make_oscil_bank "make-oscil-bank"
#define S_make_phase_vocoder "make-phase-vocoder"
#define S_make_polyshape "make-polyshape"
#define S_make_polywave "make-polywave"
#define S_make_pulse_train "make-pulse-train"
#define S_make_pulsed_env "make-pulsed-env"
#define S_make_rand "make-rand"
#define S_make_rand_interp "make-rand-interp"
#define S_make_readin "make-readin"
#define S_make_rxykcos "make-rxyk!cos"
#define S_make_rxyksin "make-rxyk!sin"
#define S_make_sample_to_file "make-sample->file"
#define S_make_sawtooth_wave "make-sawtooth-wave"
#define S_make_square_wave "make-square-wave"
#define S_make_src "make-src"
#define S_make_ssb_am "make-ssb-am"
#define S_make_table_lookup "make-table-lookup"
#define S_make_triangle_wave "make-triangle-wave"
#define S_make_two_pole "make-two-pole"
#define S_make_two_zero "make-two-zero"
#define S_make_wave_train "make-wave-train"
#define S_mlt_sine_window "mlt-sine-window"
#define S_move_locsig "move-locsig"
#define S_move_sound "move-sound"
#define S_is_move_sound "move-sound?"
#define S_moving_average "moving-average"
#define S_is_moving_average "moving-average?"
#define S_moving_max "moving-max"
#define S_is_moving_max "moving-max?"
#define S_moving_norm "moving-norm"
#define S_is_moving_norm "moving-norm?"
#define S_mus_apply "mus-apply"
#define S_mus_array_print_length "mus-array-print-length"
#define S_mus_channel "mus-channel"
#define S_mus_channels "mus-channels"
#define S_mus_chebyshev_first_kind "mus-chebyshev-first-kind"
#define S_mus_chebyshev_second_kind "mus-chebyshev-second-kind"
#define S_mus_chebyshev_both_kinds "mus-chebyshev-both-kinds"
#define S_mus_chebyshev_t_sum "mus-chebyshev-t-sum"
#define S_mus_chebyshev_tu_sum "mus-chebyshev-tu-sum"
#define S_mus_chebyshev_u_sum "mus-chebyshev-u-sum"
#define S_mus_close "mus-close"
#define S_mus_copy "mus-copy"
#define S_mus_data "mus-data"
#define S_mus_describe "mus-describe"
#define S_mus_feedback "mus-feedback"
#define S_mus_feedforward "mus-feedforward"
#define S_mus_fft "mus-fft"
#define S_mus_file_buffer_size "mus-file-buffer-size"
#define S_mus_file_name "mus-file-name"
#define S_mus_float_equal_fudge_factor "mus-float-equal-fudge-factor"
#define S_mus_frequency "mus-frequency"
#define S_is_mus_generator "mus-generator?"
#define S_mus_hop "mus-hop"
#define S_mus_increment "mus-increment"
#define S_is_mus_input "mus-input?"
#define S_mus_interpolate "mus-interpolate"
#define S_mus_interp_all_pass "mus-interp-all-pass"
#define S_mus_interp_bezier "mus-interp-bezier"
#define S_mus_interp_hermite "mus-interp-hermite"
#define S_mus_interp_lagrange "mus-interp-lagrange"
#define S_mus_interp_linear "mus-interp-linear"
#define S_mus_interp_none "mus-interp-none"
#define S_mus_interp_sinusoidal "mus-interp-sinusoidal"
#define S_mus_interp_type "mus-interp-type"
#define S_mus_length "mus-length"
#define S_mus_location "mus-location"
#define S_mus_name "mus-name"
#define S_mus_offset "mus-offset"
#define S_mus_order "mus-order"
#define S_is_mus_output "mus-output?"
#define S_mus_phase "mus-phase"
#define S_mus_ramp "mus-ramp"
#define S_mus_rand_seed "mus-rand-seed"
#define S_mus_random "mus-random"
#define S_mus_reset "mus-reset"
#define S_mus_run "mus-run"
#define S_mus_scaler "mus-scaler"
#define S_mus_set_formant_frequency "mus-set-formant-frequency"
#define S_mus_set_formant_radius_and_frequency "mus-set-formant-radius-and-frequency"
#define S_mus_srate "mus-srate"
#define S_mus_type "mus-type"
#define S_mus_width "mus-width"
#define S_mus_xcoeff "mus-xcoeff"
#define S_mus_xcoeffs "mus-xcoeffs"
#define S_mus_ycoeff "mus-ycoeff"
#define S_mus_ycoeffs "mus-ycoeffs"
#define S_ncos "ncos"
#define S_is_ncos "ncos?"
#define S_normalize_partials "normalize-partials"
#define S_notch "notch"
#define S_is_notch "notch?"
#define S_nrxycos "nrxycos"
#define S_is_nrxycos "nrxycos?"
#define S_nrxysin "nrxysin"
#define S_is_nrxysin "nrxysin?"
#define S_nsin "nsin"
#define S_is_nsin "nsin?"
#define S_odd_multiple "odd-multiple"
#define S_odd_weight "odd-weight"
#define S_one_pole "one-pole"
#define S_is_one_pole "one-pole?"
#define S_one_pole_all_pass "one-pole-all-pass"
#define S_is_one_pole_all_pass "one-pole-all-pass?"
#define S_one_zero "one-zero"
#define S_is_one_zero "one-zero?"
#define S_oscil "oscil"
#define S_is_oscil "oscil?"
#define S_oscil_bank "oscil-bank"
#define S_is_oscil_bank "oscil-bank?"
#define S_out_any "out-any"
#define S_outa "outa"
#define S_outb "outb"
#define S_outc "outc"
#define S_outd "outd"
#define S_papoulis_window "papoulis-window"
#define S_partials_to_polynomial "partials->polynomial"
#define S_partials_to_wave "partials->wave"
#define S_parzen_window "parzen-window"
#define S_phase_vocoder "phase-vocoder"
#define S_is_phase_vocoder "phase-vocoder?"
#define S_phase_partials_to_wave "phase-partials->wave"
#define S_poisson_window "poisson-window"
#define S_polar_to_rectangular "polar->rectangular"
#define S_polynomial "polynomial"
#define S_polyshape "polyshape"
#define S_is_polyshape "polyshape?"
#define S_polywave "polywave"
#define S_is_polywave "polywave?"
#define S_pulse_train "pulse-train"
#define S_is_pulse_train "pulse-train?"
#define S_phase_vocoder_amp_increments "phase-vocoder-amp-increments"
#define S_phase_vocoder_amps "phase-vocoder-amps"
#define S_phase_vocoder_freqs "phase-vocoder-freqs"
#define S_phase_vocoder_phase_increments "phase-vocoder-phase-increments"
#define S_phase_vocoder_phases "phase-vocoder-phases"
#define S_pulsed_env "pulsed-env"
#define S_is_pulsed_env "pulsed-env?"
#define S_radians_to_degrees "radians->degrees"
#define S_radians_to_hz "radians->hz"
#define S_rand "rand"
#define S_rand_interp "rand-interp"
#define S_is_rand_interp "rand-interp?"
#define S_is_rand "rand?"
#define S_readin "readin"
#define S_is_readin "readin?"
#define S_rectangular_to_magnitudes "rectangular->magnitudes"
#define S_rectangular_to_polar "rectangular->polar"
#define S_rectangular_window "rectangular-window"
#define S_riemann_window "riemann-window"
#define S_ring_modulate "ring-modulate"
#define S_rv2_window "rv2-window"
#define S_rv3_window "rv3-window"
#define S_rv4_window "rv4-window"
#define S_rxykcos "rxyk!cos"
#define S_is_rxykcos "rxyk!cos?"
#define S_rxyksin "rxyk!sin"
#define S_is_rxyksin "rxyk!sin?"
#define S_samaraki_window "samaraki-window"
#define S_sample_to_file "sample->file"
#define S_sample_to_file_add "sample->file+"
#define S_is_sample_to_file "sample->file?"
#define S_samples_to_seconds "samples->seconds"
#define S_sawtooth_wave "sawtooth-wave"
#define S_is_sawtooth_wave "sawtooth-wave?"
#define S_seconds_to_samples "seconds->samples"
#define S_sinc_window "sinc-window"
#define S_spectrum "spectrum"
#define S_square_wave "square-wave"
#define S_is_square_wave "square-wave?"
#define S_src "src"
#define S_is_src "src?"
#define S_ssb_am "ssb-am"
#define S_is_ssb_am "ssb-am?"
#define S_table_lookup "table-lookup"
#define S_is_table_lookup "table-lookup?"
#define S_tap "tap"
#define S_is_tap "tap?"
#define S_triangle_wave "triangle-wave"
#define S_is_triangle_wave "triangle-wave?"
#define S_tukey_window "tukey-window"
#define S_two_pole "two-pole"
#define S_is_two_pole "two-pole?"
#define S_two_zero "two-zero"
#define S_is_two_zero "two-zero?"
#define S_ultraspherical_window "ultraspherical-window"
#define S_wave_train "wave-train"
#define S_is_wave_train "wave-train?"
#define S_welch_window "welch-window"


#define S_continue_frample_to_file "continue-frample->file"
#define S_file_to_frample "file->frample"
#define S_is_file_to_frample "file->frample?"
#define S_frample_to_file "frample->file"
#define S_is_frample_to_file "frample->file?"
#define S_frample_to_frample "frample->frample"
#define S_make_file_to_frample "make-file->frample"
#define S_make_frample_to_file "make-frample->file"

#define S_mus_file_mix "mus-file-mix"
#define S_mus_file_mix_with_envs "mus-file-mix-with-envs"

#endif

+ 16804
- 0
lib/sndlib/clm.c
File diff suppressed because it is too large
View File


+ 1223
- 0
lib/sndlib/clm.fs
File diff suppressed because it is too large
View File


+ 867
- 0
lib/sndlib/clm.h View File

@@ -0,0 +1,867 @@
#ifndef CLM_H
#define CLM_H

#define MUS_VERSION 6
#define MUS_REVISION 13
#define MUS_DATE "5-Aug-15"

/* isn't mus_env_interp backwards? */

#include "sndlib.h"

#ifndef _MSC_VER
#include <sys/param.h>
#endif
#if HAVE_COMPLEX_TRIG
#include <complex.h>
#endif

#if(!defined(M_PI))
#define M_PI 3.14159265358979323846264338327
#define M_PI_2 (M_PI / 2.0)
#endif

#define MUS_DEFAULT_SAMPLING_RATE 44100.0
#define MUS_DEFAULT_FILE_BUFFER_SIZE 8192
#define MUS_DEFAULT_ARRAY_PRINT_LENGTH 8

typedef enum {MUS_NOT_SPECIAL, MUS_SIMPLE_FILTER, MUS_FULL_FILTER, MUS_OUTPUT, MUS_INPUT, MUS_DELAY_LINE} mus_clm_extended_t;

typedef struct mus_any_class mus_any_class;
typedef struct {
struct mus_any_class *core;
} mus_any;


typedef enum {MUS_INTERP_NONE, MUS_INTERP_LINEAR, MUS_INTERP_SINUSOIDAL, MUS_INTERP_ALL_PASS,
MUS_INTERP_LAGRANGE, MUS_INTERP_BEZIER, MUS_INTERP_HERMITE} mus_interp_t;

typedef enum {MUS_RECTANGULAR_WINDOW, MUS_HANN_WINDOW, MUS_WELCH_WINDOW, MUS_PARZEN_WINDOW, MUS_BARTLETT_WINDOW,
MUS_HAMMING_WINDOW, MUS_BLACKMAN2_WINDOW, MUS_BLACKMAN3_WINDOW, MUS_BLACKMAN4_WINDOW,
MUS_EXPONENTIAL_WINDOW, MUS_RIEMANN_WINDOW, MUS_KAISER_WINDOW, MUS_CAUCHY_WINDOW, MUS_POISSON_WINDOW,
MUS_GAUSSIAN_WINDOW, MUS_TUKEY_WINDOW, MUS_DOLPH_CHEBYSHEV_WINDOW, MUS_HANN_POISSON_WINDOW,
MUS_CONNES_WINDOW, MUS_SAMARAKI_WINDOW, MUS_ULTRASPHERICAL_WINDOW,
MUS_BARTLETT_HANN_WINDOW, MUS_BOHMAN_WINDOW, MUS_FLAT_TOP_WINDOW,
MUS_BLACKMAN5_WINDOW, MUS_BLACKMAN6_WINDOW, MUS_BLACKMAN7_WINDOW, MUS_BLACKMAN8_WINDOW, MUS_BLACKMAN9_WINDOW, MUS_BLACKMAN10_WINDOW,
MUS_RV2_WINDOW, MUS_RV3_WINDOW, MUS_RV4_WINDOW, MUS_MLT_SINE_WINDOW, MUS_PAPOULIS_WINDOW, MUS_DPSS_WINDOW, MUS_SINC_WINDOW,
MUS_NUM_FFT_WINDOWS} mus_fft_window_t;

typedef enum {MUS_SPECTRUM_IN_DB, MUS_SPECTRUM_NORMALIZED, MUS_SPECTRUM_RAW} mus_spectrum_t;
typedef enum {MUS_CHEBYSHEV_EITHER_KIND, MUS_CHEBYSHEV_FIRST_KIND, MUS_CHEBYSHEV_SECOND_KIND, MUS_CHEBYSHEV_BOTH_KINDS} mus_polynomial_t;

#define MUS_MAX_CLM_SINC_WIDTH 65536
#define MUS_MAX_CLM_SRC 65536.0


/* this is internal -- for clm->clm2xen */
typedef struct {
mus_any_class *core;
int chan;
mus_long_t loc;
char *file_name;
int chans;
mus_float_t **obufs;
mus_float_t *obuf0, *obuf1;
mus_long_t data_start, data_end;
mus_long_t out_end;
mus_sample_t output_sample_type;
mus_header_t output_header_type;
} rdout;
/* end internal stuff */


#ifdef __cplusplus
extern "C" {
#endif

MUS_EXPORT void mus_initialize(void);

MUS_EXPORT int mus_make_generator_type(void);

MUS_EXPORT mus_any_class *mus_generator_class(mus_any *ptr);
MUS_EXPORT mus_any_class *mus_make_generator(int type, char *name,
void (*release)(mus_any *ptr),
char *(*describe)(mus_any *ptr),
bool (*equalp)(mus_any *gen1, mus_any *gen2));

MUS_EXPORT void mus_generator_set_length(mus_any_class *p, mus_long_t (*length)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_scaler(mus_any_class *p, mus_float_t (*scaler)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_channels(mus_any_class *p, int (*channels)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_location(mus_any_class *p, mus_long_t (*location)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_set_location(mus_any_class *p, mus_long_t (*set_location)(mus_any *ptr, mus_long_t loc));
MUS_EXPORT void mus_generator_set_channel(mus_any_class *p, int (*channel)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_file_name(mus_any_class *p, char *(*file_name)(mus_any *ptr));
MUS_EXPORT void mus_generator_set_extended_type(mus_any_class *p, mus_clm_extended_t extended_type);
MUS_EXPORT void mus_generator_set_read_sample(mus_any_class *p, mus_float_t (*read_sample)(mus_any *ptr, mus_long_t samp, int chan));
MUS_EXPORT void mus_generator_set_feeders(mus_any *g,
mus_float_t (*feed)(void *arg, int direction),
mus_float_t (*block_feed)(void *arg, int direction, mus_float_t *block, mus_long_t start, mus_long_t end));
MUS_EXPORT void mus_generator_copy_feeders(mus_any *dest, mus_any *source);

MUS_EXPORT mus_float_t mus_radians_to_hz(mus_float_t radians);
MUS_EXPORT mus_float_t mus_hz_to_radians(mus_float_t hz);
MUS_EXPORT mus_float_t mus_degrees_to_radians(mus_float_t degrees);
MUS_EXPORT mus_float_t mus_radians_to_degrees(mus_float_t radians);
MUS_EXPORT mus_float_t mus_db_to_linear(mus_float_t x);
MUS_EXPORT mus_float_t mus_linear_to_db(mus_float_t x);
MUS_EXPORT mus_float_t mus_odd_multiple(mus_float_t x, mus_float_t y);
MUS_EXPORT mus_float_t mus_even_multiple(mus_float_t x, mus_float_t y);
MUS_EXPORT mus_float_t mus_odd_weight(mus_float_t x);
MUS_EXPORT mus_float_t mus_even_weight(mus_float_t x);

MUS_EXPORT mus_float_t mus_srate(void);
MUS_EXPORT mus_float_t mus_set_srate(mus_float_t val);
MUS_EXPORT mus_long_t mus_seconds_to_samples(mus_float_t secs);
MUS_EXPORT mus_float_t mus_samples_to_seconds(mus_long_t samps);
MUS_EXPORT int mus_array_print_length(void);
MUS_EXPORT int mus_set_array_print_length(int val);
MUS_EXPORT mus_float_t mus_float_equal_fudge_factor(void);
MUS_EXPORT mus_float_t mus_set_float_equal_fudge_factor(mus_float_t val);

MUS_EXPORT mus_float_t mus_ring_modulate(mus_float_t s1, mus_float_t s2);
MUS_EXPORT mus_float_t mus_amplitude_modulate(mus_float_t s1, mus_float_t s2, mus_float_t s3);
MUS_EXPORT mus_float_t mus_contrast_enhancement(mus_float_t sig, mus_float_t index);
MUS_EXPORT mus_float_t mus_dot_product(mus_float_t *data1, mus_float_t *data2, mus_long_t size);
#if HAVE_COMPLEX_TRIG
MUS_EXPORT complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size);
#endif

MUS_EXPORT bool mus_arrays_are_equal(mus_float_t *arr1, mus_float_t *arr2, mus_float_t fudge, mus_long_t len);
MUS_EXPORT mus_float_t mus_polynomial(mus_float_t *coeffs, mus_float_t x, int ncoeffs);
MUS_EXPORT void mus_rectangular_to_polar(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT void mus_rectangular_to_magnitudes(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT void mus_polar_to_rectangular(mus_float_t *rl, mus_float_t *im, mus_long_t size);
MUS_EXPORT mus_float_t mus_array_interp(mus_float_t *wave, mus_float_t phase, mus_long_t size);
MUS_EXPORT mus_float_t mus_bessi0(mus_float_t x);
MUS_EXPORT mus_float_t mus_interpolate(mus_interp_t type, mus_float_t x, mus_float_t *table, mus_long_t table_size, mus_float_t y);
MUS_EXPORT bool mus_is_interp_type(int val);
MUS_EXPORT bool mus_is_fft_window(int val);

MUS_EXPORT int mus_sample_type_zero(mus_sample_t samp_type);
MUS_EXPORT mus_float_t (*mus_run_function(mus_any *g))(mus_any *gen, mus_float_t arg1, mus_float_t arg2);


/* -------- generic functions -------- */

MUS_EXPORT int mus_type(mus_any *ptr);
MUS_EXPORT void mus_free(mus_any *ptr);
MUS_EXPORT char *mus_describe(mus_any *gen);
MUS_EXPORT bool mus_equalp(mus_any *g1, mus_any *g2);
MUS_EXPORT mus_float_t mus_phase(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_phase(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_set_frequency(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_frequency(mus_any *gen);
MUS_EXPORT mus_float_t mus_run(mus_any *gen, mus_float_t arg1, mus_float_t arg2);
MUS_EXPORT mus_long_t mus_length(mus_any *gen);
MUS_EXPORT mus_long_t mus_set_length(mus_any *gen, mus_long_t len);
MUS_EXPORT mus_long_t mus_order(mus_any *gen);
MUS_EXPORT mus_float_t *mus_data(mus_any *gen);
MUS_EXPORT mus_float_t *mus_set_data(mus_any *gen, mus_float_t *data);
MUS_EXPORT const char *mus_name(mus_any *ptr);
MUS_EXPORT mus_float_t mus_scaler(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_scaler(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_offset(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_offset(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_width(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_width(mus_any *gen, mus_float_t val);
MUS_EXPORT char *mus_file_name(mus_any *ptr);
MUS_EXPORT void mus_reset(mus_any *ptr);
MUS_EXPORT mus_any *mus_copy(mus_any *gen);
MUS_EXPORT mus_float_t *mus_xcoeffs(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_ycoeffs(mus_any *ptr);
MUS_EXPORT mus_float_t mus_xcoeff(mus_any *ptr, int index);
MUS_EXPORT mus_float_t mus_set_xcoeff(mus_any *ptr, int index, mus_float_t val);
MUS_EXPORT mus_float_t mus_ycoeff(mus_any *ptr, int index);
MUS_EXPORT mus_float_t mus_set_ycoeff(mus_any *ptr, int index, mus_float_t val);
MUS_EXPORT mus_float_t mus_increment(mus_any *rd);
MUS_EXPORT mus_float_t mus_set_increment(mus_any *rd, mus_float_t dir);
MUS_EXPORT mus_long_t mus_location(mus_any *rd);
MUS_EXPORT mus_long_t mus_set_location(mus_any *rd, mus_long_t loc);
MUS_EXPORT int mus_channel(mus_any *rd);
MUS_EXPORT int mus_channels(mus_any *ptr);
MUS_EXPORT int mus_position(mus_any *ptr); /* only C, envs (snd-env.c), shares slot with mus_channels */
MUS_EXPORT int mus_interp_type(mus_any *ptr);
MUS_EXPORT mus_long_t mus_ramp(mus_any *ptr);
MUS_EXPORT mus_long_t mus_set_ramp(mus_any *ptr, mus_long_t val);
MUS_EXPORT mus_long_t mus_hop(mus_any *ptr);
MUS_EXPORT mus_long_t mus_set_hop(mus_any *ptr, mus_long_t val);
MUS_EXPORT mus_float_t mus_feedforward(mus_any *gen);
MUS_EXPORT mus_float_t mus_set_feedforward(mus_any *gen, mus_float_t val);
MUS_EXPORT mus_float_t mus_feedback(mus_any *rd);
MUS_EXPORT mus_float_t mus_set_feedback(mus_any *rd, mus_float_t dir);


/* -------- generators -------- */

MUS_EXPORT mus_float_t mus_oscil(mus_any *o, mus_float_t fm, mus_float_t pm);
MUS_EXPORT mus_float_t mus_oscil_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_oscil_fm(mus_any *ptr, mus_float_t fm);
MUS_EXPORT mus_float_t mus_oscil_pm(mus_any *ptr, mus_float_t pm);
MUS_EXPORT bool mus_is_oscil(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_oscil(mus_float_t freq, mus_float_t phase);

MUS_EXPORT bool mus_is_oscil_bank(mus_any *ptr);
MUS_EXPORT mus_float_t mus_oscil_bank(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_oscil_bank(int size, mus_float_t *freqs, mus_float_t *phases, mus_float_t *amps, bool stable);

MUS_EXPORT mus_any *mus_make_ncos(mus_float_t freq, int n);
MUS_EXPORT mus_float_t mus_ncos(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_ncos(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_nsin(mus_float_t freq, int n);
MUS_EXPORT mus_float_t mus_nsin(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_nsin(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_nrxysin(mus_float_t frequency, mus_float_t y_over_x, int n, mus_float_t r);
MUS_EXPORT mus_float_t mus_nrxysin(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_nrxysin(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_nrxycos(mus_float_t frequency, mus_float_t y_over_x, int n, mus_float_t r);
MUS_EXPORT mus_float_t mus_nrxycos(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_nrxycos(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_rxykcos(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
MUS_EXPORT mus_float_t mus_rxykcos(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_rxykcos(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_rxyksin(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
MUS_EXPORT mus_float_t mus_rxyksin(mus_any *ptr, mus_float_t fm);
MUS_EXPORT bool mus_is_rxyksin(mus_any *ptr);

MUS_EXPORT mus_float_t mus_delay(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_delay_unmodulated(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_float_t mus_tap(mus_any *gen, mus_float_t loc);
MUS_EXPORT mus_float_t mus_tap_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_delay(int size, mus_float_t *line, int line_size, mus_interp_t type);
MUS_EXPORT bool mus_is_delay(mus_any *ptr);
MUS_EXPORT bool mus_is_tap(mus_any *ptr);
MUS_EXPORT mus_float_t mus_delay_tick(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_float_t mus_delay_unmodulated_noz(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_float_t mus_comb(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_comb_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_comb(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type);
MUS_EXPORT bool mus_is_comb(mus_any *ptr);
MUS_EXPORT mus_float_t mus_comb_unmodulated_noz(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_float_t mus_comb_bank(mus_any *bank, mus_float_t inval);
MUS_EXPORT mus_any *mus_make_comb_bank(int size, mus_any **combs);
MUS_EXPORT bool mus_is_comb_bank(mus_any *g);

MUS_EXPORT mus_float_t mus_notch(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_notch_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_notch(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type);
MUS_EXPORT bool mus_is_notch(mus_any *ptr);

MUS_EXPORT mus_float_t mus_all_pass(mus_any *gen, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_all_pass_unmodulated(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_all_pass(mus_float_t backward, mus_float_t forward, int size, mus_float_t *line, int line_size, mus_interp_t type);
MUS_EXPORT bool mus_is_all_pass(mus_any *ptr);
MUS_EXPORT mus_float_t mus_all_pass_unmodulated_noz(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_float_t mus_all_pass_bank(mus_any *bank, mus_float_t inval);
MUS_EXPORT mus_any *mus_make_all_pass_bank(int size, mus_any **combs);
MUS_EXPORT bool mus_is_all_pass_bank(mus_any *g);

MUS_EXPORT mus_any *mus_make_moving_average(int size, mus_float_t *line);
MUS_EXPORT mus_any *mus_make_moving_average_with_initial_sum(int size, mus_float_t *line, mus_float_t sum);
MUS_EXPORT bool mus_is_moving_average(mus_any *ptr);
MUS_EXPORT mus_float_t mus_moving_average(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_any *mus_make_moving_max(int size, mus_float_t *line);
MUS_EXPORT bool mus_is_moving_max(mus_any *ptr);
MUS_EXPORT mus_float_t mus_moving_max(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_any *mus_make_moving_norm(int size, mus_float_t *line, mus_float_t norm);
MUS_EXPORT bool mus_is_moving_norm(mus_any *ptr);
MUS_EXPORT mus_float_t mus_moving_norm(mus_any *ptr, mus_float_t input);

MUS_EXPORT mus_float_t mus_table_lookup(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_float_t mus_table_lookup_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_table_lookup(mus_float_t freq, mus_float_t phase, mus_float_t *wave, mus_long_t wave_size, mus_interp_t type);
MUS_EXPORT bool mus_is_table_lookup(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize);
MUS_EXPORT mus_float_t *mus_phase_partials_to_wave(mus_float_t *partial_data, int partials, mus_float_t *table, mus_long_t table_size, bool normalize);

MUS_EXPORT mus_float_t mus_sawtooth_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_sawtooth_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
MUS_EXPORT bool mus_is_sawtooth_wave(mus_any *gen);

MUS_EXPORT mus_float_t mus_square_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_square_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
MUS_EXPORT bool mus_is_square_wave(mus_any *gen);

MUS_EXPORT mus_float_t mus_triangle_wave(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_triangle_wave(mus_float_t freq, mus_float_t amp, mus_float_t phase);
MUS_EXPORT bool mus_is_triangle_wave(mus_any *gen);
MUS_EXPORT mus_float_t mus_triangle_wave_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_pulse_train(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_pulse_train(mus_float_t freq, mus_float_t amp, mus_float_t phase);
MUS_EXPORT bool mus_is_pulse_train(mus_any *gen);
MUS_EXPORT mus_float_t mus_pulse_train_unmodulated(mus_any *ptr);

MUS_EXPORT void mus_set_rand_seed(unsigned long seed);
MUS_EXPORT unsigned long mus_rand_seed(void);
MUS_EXPORT mus_float_t mus_random(mus_float_t amp);
MUS_EXPORT mus_float_t mus_frandom(mus_float_t amp);
MUS_EXPORT int mus_irandom(int amp);

MUS_EXPORT mus_float_t mus_rand(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_rand(mus_float_t freq, mus_float_t base);
MUS_EXPORT bool mus_is_rand(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_rand_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size);

MUS_EXPORT mus_float_t mus_rand_interp(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_any *mus_make_rand_interp(mus_float_t freq, mus_float_t base);
MUS_EXPORT bool mus_is_rand_interp(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_rand_interp_with_distribution(mus_float_t freq, mus_float_t base, mus_float_t *distribution, int distribution_size);
MUS_EXPORT mus_float_t mus_rand_interp_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_rand_unmodulated(mus_any *ptr);

MUS_EXPORT mus_float_t mus_asymmetric_fm(mus_any *gen, mus_float_t index, mus_float_t fm);
MUS_EXPORT mus_float_t mus_asymmetric_fm_unmodulated(mus_any *gen, mus_float_t index);
MUS_EXPORT mus_any *mus_make_asymmetric_fm(mus_float_t freq, mus_float_t phase, mus_float_t r, mus_float_t ratio);
MUS_EXPORT bool mus_is_asymmetric_fm(mus_any *ptr);

MUS_EXPORT mus_float_t mus_one_zero(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_one_zero(mus_float_t a0, mus_float_t a1);
MUS_EXPORT bool mus_is_one_zero(mus_any *gen);

MUS_EXPORT mus_float_t mus_one_pole(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_one_pole(mus_float_t a0, mus_float_t b1);
MUS_EXPORT bool mus_is_one_pole(mus_any *gen);

MUS_EXPORT mus_float_t mus_two_zero(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_two_zero(mus_float_t a0, mus_float_t a1, mus_float_t a2);
MUS_EXPORT bool mus_is_two_zero(mus_any *gen);
MUS_EXPORT mus_any *mus_make_two_zero_from_frequency_and_radius(mus_float_t frequency, mus_float_t radius);

MUS_EXPORT mus_float_t mus_two_pole(mus_any *gen, mus_float_t input);
MUS_EXPORT mus_any *mus_make_two_pole(mus_float_t a0, mus_float_t b1, mus_float_t b2);
MUS_EXPORT bool mus_is_two_pole(mus_any *gen);
MUS_EXPORT mus_any *mus_make_two_pole_from_frequency_and_radius(mus_float_t frequency, mus_float_t radius);

MUS_EXPORT mus_float_t mus_one_pole_all_pass(mus_any *f, mus_float_t input);
MUS_EXPORT mus_any *mus_make_one_pole_all_pass(int size, mus_float_t coeff);
MUS_EXPORT bool mus_is_one_pole_all_pass(mus_any *ptr);

MUS_EXPORT mus_float_t mus_formant(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_formant(mus_float_t frequency, mus_float_t radius);
MUS_EXPORT bool mus_is_formant(mus_any *ptr);
MUS_EXPORT mus_float_t mus_set_formant_frequency(mus_any *ptr, mus_float_t freq_in_hz);
MUS_EXPORT void mus_set_formant_radius_and_frequency(mus_any *ptr, mus_float_t radius, mus_float_t frequency);
MUS_EXPORT mus_float_t mus_formant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians);

MUS_EXPORT mus_float_t mus_formant_bank(mus_any *bank, mus_float_t inval);
MUS_EXPORT mus_float_t mus_formant_bank_with_inputs(mus_any *bank, mus_float_t *inval);
MUS_EXPORT mus_any *mus_make_formant_bank(int size, mus_any **formants, mus_float_t *amps);
MUS_EXPORT bool mus_is_formant_bank(mus_any *g);

MUS_EXPORT mus_float_t mus_firmant(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_firmant(mus_float_t frequency, mus_float_t radius);
MUS_EXPORT bool mus_is_firmant(mus_any *ptr);
MUS_EXPORT mus_float_t mus_firmant_with_frequency(mus_any *ptr, mus_float_t input, mus_float_t freq_in_radians);

MUS_EXPORT mus_float_t mus_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_filter(int order, mus_float_t *xcoeffs, mus_float_t *ycoeffs, mus_float_t *state);
MUS_EXPORT bool mus_is_filter(mus_any *ptr);

MUS_EXPORT mus_float_t mus_fir_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_fir_filter(int order, mus_float_t *xcoeffs, mus_float_t *state);
MUS_EXPORT bool mus_is_fir_filter(mus_any *ptr);

MUS_EXPORT mus_float_t mus_iir_filter(mus_any *ptr, mus_float_t input);
MUS_EXPORT mus_any *mus_make_iir_filter(int order, mus_float_t *ycoeffs, mus_float_t *state);
MUS_EXPORT bool mus_is_iir_filter(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_make_fir_coeffs(int order, mus_float_t *env, mus_float_t *aa);

MUS_EXPORT mus_float_t *mus_filter_set_xcoeffs(mus_any *ptr, mus_float_t *new_data);
MUS_EXPORT mus_float_t *mus_filter_set_ycoeffs(mus_any *ptr, mus_float_t *new_data);
MUS_EXPORT int mus_filter_set_order(mus_any *ptr, int order);

MUS_EXPORT mus_float_t mus_filtered_comb(mus_any *ptr, mus_float_t input, mus_float_t pm);
MUS_EXPORT mus_float_t mus_filtered_comb_unmodulated(mus_any *ptr, mus_float_t input);
MUS_EXPORT bool mus_is_filtered_comb(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_filtered_comb(mus_float_t scaler, int size, mus_float_t *line, int line_size, mus_interp_t type, mus_any *filt);

MUS_EXPORT mus_float_t mus_filtered_comb_bank(mus_any *bank, mus_float_t inval);
MUS_EXPORT mus_any *mus_make_filtered_comb_bank(int size, mus_any **combs);
MUS_EXPORT bool mus_is_filtered_comb_bank(mus_any *g);

MUS_EXPORT mus_float_t mus_wave_train(mus_any *gen, mus_float_t fm);
MUS_EXPORT mus_float_t mus_wave_train_unmodulated(mus_any *gen);
MUS_EXPORT mus_any *mus_make_wave_train(mus_float_t freq, mus_float_t phase, mus_float_t *wave, mus_long_t wsize, mus_interp_t type);
MUS_EXPORT bool mus_is_wave_train(mus_any *gen);

MUS_EXPORT mus_float_t *mus_partials_to_polynomial(int npartials, mus_float_t *partials, mus_polynomial_t kind);
MUS_EXPORT mus_float_t *mus_normalize_partials(int num_partials, mus_float_t *partials);

MUS_EXPORT mus_any *mus_make_polyshape(mus_float_t frequency, mus_float_t phase, mus_float_t *coeffs, int size, int cheby_choice);
MUS_EXPORT mus_float_t mus_polyshape(mus_any *ptr, mus_float_t index, mus_float_t fm);
MUS_EXPORT mus_float_t mus_polyshape_unmodulated(mus_any *ptr, mus_float_t index);
#define mus_polyshape_no_input(Obj) mus_polyshape(Obj, 1.0, 0.0)
MUS_EXPORT bool mus_is_polyshape(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_polywave(mus_float_t frequency, mus_float_t *coeffs, int n, int cheby_choice);
MUS_EXPORT mus_any *mus_make_polywave_tu(mus_float_t frequency, mus_float_t *tcoeffs, mus_float_t *ucoeffs, int n);
MUS_EXPORT bool mus_is_polywave(mus_any *ptr);
MUS_EXPORT mus_float_t mus_polywave_unmodulated(mus_any *ptr);
MUS_EXPORT mus_float_t mus_polywave(mus_any *ptr, mus_float_t fm);
MUS_EXPORT mus_float_t mus_chebyshev_t_sum(mus_float_t x, int n, mus_float_t *tn);
MUS_EXPORT mus_float_t mus_chebyshev_u_sum(mus_float_t x, int n, mus_float_t *un);
MUS_EXPORT mus_float_t mus_chebyshev_tu_sum(mus_float_t x, int n, mus_float_t *tn, mus_float_t *un);
MUS_EXPORT mus_float_t (*mus_polywave_function(mus_any *g))(mus_any *gen, mus_float_t fm);

MUS_EXPORT mus_float_t mus_env(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_env(mus_float_t *brkpts, int npts, mus_float_t scaler, mus_float_t offset, mus_float_t base,
mus_float_t duration, mus_long_t end, mus_float_t *odata);
MUS_EXPORT bool mus_is_env(mus_any *ptr);
MUS_EXPORT mus_float_t mus_env_interp(mus_float_t x, mus_any *env);
MUS_EXPORT mus_long_t *mus_env_passes(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t *mus_env_rates(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t mus_env_offset(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t mus_env_scaler(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t mus_env_initial_power(mus_any *gen); /* for Snd */
MUS_EXPORT int mus_env_breakpoints(mus_any *gen); /* for Snd */
MUS_EXPORT mus_float_t mus_env_any(mus_any *e, mus_float_t (*connect_points)(mus_float_t val));
MUS_EXPORT mus_float_t (*mus_env_function(mus_any *g))(mus_any *gen);

MUS_EXPORT mus_any *mus_make_pulsed_env(mus_any *e, mus_any *p);
MUS_EXPORT bool mus_is_pulsed_env(mus_any *ptr);
MUS_EXPORT mus_float_t mus_pulsed_env(mus_any *pl, mus_float_t inval);
MUS_EXPORT mus_float_t mus_pulsed_env_unmodulated(mus_any *pl);

MUS_EXPORT bool mus_is_file_to_sample(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_file_to_sample(const char *filename);
MUS_EXPORT mus_any *mus_make_file_to_sample_with_buffer_size(const char *filename, mus_long_t buffer_size);
MUS_EXPORT mus_float_t mus_file_to_sample(mus_any *ptr, mus_long_t samp, int chan);

MUS_EXPORT mus_float_t mus_readin(mus_any *rd);
MUS_EXPORT mus_any *mus_make_readin_with_buffer_size(const char *filename, int chan, mus_long_t start, int direction, mus_long_t buffer_size);
#define mus_make_readin(Filename, Chan, Start, Direction) mus_make_readin_with_buffer_size(Filename, Chan, Start, Direction, mus_file_buffer_size())
MUS_EXPORT bool mus_is_readin(mus_any *ptr);

MUS_EXPORT bool mus_is_output(mus_any *ptr);
MUS_EXPORT bool mus_is_input(mus_any *ptr);
MUS_EXPORT mus_float_t mus_in_any(mus_long_t frample, int chan, mus_any *IO);
MUS_EXPORT bool mus_in_any_is_safe(mus_any *IO);

/* new 6.0 */
MUS_EXPORT mus_float_t *mus_file_to_frample(mus_any *ptr, mus_long_t samp, mus_float_t *f);
MUS_EXPORT mus_any *mus_make_file_to_frample(const char *filename);
MUS_EXPORT bool mus_is_file_to_frample(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_file_to_frample_with_buffer_size(const char *filename, mus_long_t buffer_size);
MUS_EXPORT mus_float_t *mus_frample_to_frample(mus_float_t *matrix, int mx_chans, mus_float_t *in_samps, int in_chans, mus_float_t *out_samps, int out_chans);

MUS_EXPORT bool mus_is_frample_to_file(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_frample_to_file(mus_any *ptr, mus_long_t samp, mus_float_t *data);
MUS_EXPORT mus_any *mus_make_frample_to_file_with_comment(const char *filename, int chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment);
#define mus_make_frample_to_file(Filename, Chans, SampType, HeadType) mus_make_frample_to_file_with_comment(Filename, Chans, SampType, HeadType, NULL)
MUS_EXPORT mus_any *mus_continue_frample_to_file(const char *filename);

MUS_EXPORT void mus_file_mix_with_reader_and_writer(mus_any *outf, mus_any *inf,
mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
mus_float_t *mx, int mx_chans, mus_any ***envs);
MUS_EXPORT void mus_file_mix(const char *outfile, const char *infile,
mus_long_t out_start, mus_long_t out_framples, mus_long_t in_start,
mus_float_t *mx, int mx_chans, mus_any ***envs);

MUS_EXPORT bool mus_is_sample_to_file(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_sample_to_file_with_comment(const char *filename, int out_chans, mus_sample_t samp_type, mus_header_t head_type, const char *comment);
#define mus_make_sample_to_file(Filename, Chans, SampType, HeadType) mus_make_sample_to_file_with_comment(Filename, Chans, SampType, HeadType, NULL)
MUS_EXPORT mus_float_t mus_sample_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_float_t val);
MUS_EXPORT mus_any *mus_continue_sample_to_file(const char *filename);
MUS_EXPORT int mus_close_file(mus_any *ptr);
MUS_EXPORT mus_any *mus_sample_to_file_add(mus_any *out1, mus_any *out2);

MUS_EXPORT mus_float_t mus_out_any(mus_long_t frample, mus_float_t val, int chan, mus_any *IO);
MUS_EXPORT mus_float_t mus_safe_out_any_to_file(mus_long_t samp, mus_float_t val, int chan, mus_any *IO);
MUS_EXPORT bool mus_out_any_is_safe(mus_any *IO);
MUS_EXPORT mus_float_t mus_out_any_to_file(mus_any *ptr, mus_long_t samp, int chan, mus_float_t val);

MUS_EXPORT void mus_locsig(mus_any *ptr, mus_long_t loc, mus_float_t val);
MUS_EXPORT mus_any *mus_make_locsig(mus_float_t degree, mus_float_t distance, mus_float_t reverb, int chans,
mus_any *output, int rev_chans, mus_any *revput, mus_interp_t type);
MUS_EXPORT bool mus_is_locsig(mus_any *ptr);
MUS_EXPORT mus_float_t mus_locsig_ref(mus_any *ptr, int chan);
MUS_EXPORT mus_float_t mus_locsig_set(mus_any *ptr, int chan, mus_float_t val);
MUS_EXPORT mus_float_t mus_locsig_reverb_ref(mus_any *ptr, int chan);
MUS_EXPORT mus_float_t mus_locsig_reverb_set(mus_any *ptr, int chan, mus_float_t val);
MUS_EXPORT void mus_move_locsig(mus_any *ptr, mus_float_t degree, mus_float_t distance);
MUS_EXPORT mus_float_t *mus_locsig_outf(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_locsig_revf(mus_any *ptr);
MUS_EXPORT void *mus_locsig_closure(mus_any *ptr);
MUS_EXPORT void mus_locsig_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val));
MUS_EXPORT int mus_locsig_channels(mus_any *ptr);
MUS_EXPORT int mus_locsig_reverb_channels(mus_any *ptr);

MUS_EXPORT bool mus_is_move_sound(mus_any *ptr);
MUS_EXPORT mus_float_t mus_move_sound(mus_any *ptr, mus_long_t loc, mus_float_t val);
MUS_EXPORT mus_any *mus_make_move_sound(mus_long_t start, mus_long_t end, int out_channels, int rev_channels,
mus_any *doppler_delay, mus_any *doppler_env, mus_any *rev_env,
mus_any **out_delays, mus_any **out_envs, mus_any **rev_envs,
int *out_map, mus_any *output, mus_any *revput, bool free_arrays, bool free_gens);
MUS_EXPORT mus_float_t *mus_move_sound_outf(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_move_sound_revf(mus_any *ptr);
MUS_EXPORT void *mus_move_sound_closure(mus_any *ptr);
MUS_EXPORT void mus_move_sound_set_detour(mus_any *ptr, void (*detour)(mus_any *ptr, mus_long_t val));
MUS_EXPORT int mus_move_sound_channels(mus_any *ptr);
MUS_EXPORT int mus_move_sound_reverb_channels(mus_any *ptr);

MUS_EXPORT mus_any *mus_make_src(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure);
MUS_EXPORT mus_any *mus_make_src_with_init(mus_float_t (*input)(void *arg, int direction), mus_float_t srate, int width, void *closure, void (*init)(void *p, mus_any *g));
MUS_EXPORT mus_float_t mus_src(mus_any *srptr, mus_float_t sr_change, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT bool mus_is_src(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_src_20(mus_any *srptr, mus_float_t *in_data, mus_long_t dur);
MUS_EXPORT mus_float_t *mus_src_05(mus_any *srptr, mus_float_t *in_data, mus_long_t dur);
MUS_EXPORT void mus_src_to_buffer(mus_any *srptr, mus_float_t (*input)(void *arg, int direction), mus_float_t *out_data, mus_long_t dur);
MUS_EXPORT void mus_src_init(mus_any *ptr);

MUS_EXPORT bool mus_is_convolve(mus_any *ptr);
MUS_EXPORT mus_float_t mus_convolve(mus_any *ptr, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT mus_any *mus_make_convolve(mus_float_t (*input)(void *arg, int direction), mus_float_t *filter, mus_long_t fftsize, mus_long_t filtersize, void *closure);

MUS_EXPORT mus_float_t *mus_spectrum(mus_float_t *rdat, mus_float_t *idat, mus_float_t *window, mus_long_t n, mus_spectrum_t type);
MUS_EXPORT void mus_fft(mus_float_t *rl, mus_float_t *im, mus_long_t n, int is);
MUS_EXPORT mus_float_t *mus_make_fft_window(mus_fft_window_t type, mus_long_t size, mus_float_t beta);
MUS_EXPORT mus_float_t *mus_make_fft_window_with_window(mus_fft_window_t type, mus_long_t size, mus_float_t beta, mus_float_t mu, mus_float_t *window);
MUS_EXPORT const char *mus_fft_window_name(mus_fft_window_t win);
MUS_EXPORT const char **mus_fft_window_names(void);

MUS_EXPORT mus_float_t *mus_autocorrelate(mus_float_t *data, mus_long_t n);
MUS_EXPORT mus_float_t *mus_correlate(mus_float_t *data1, mus_float_t *data2, mus_long_t n);
MUS_EXPORT mus_float_t *mus_convolution(mus_float_t *rl1, mus_float_t *rl2, mus_long_t n);
MUS_EXPORT void mus_convolve_files(const char *file1, const char *file2, mus_float_t maxamp, const char *output_file);
MUS_EXPORT mus_float_t *mus_cepstrum(mus_float_t *data, mus_long_t n);

MUS_EXPORT bool mus_is_granulate(mus_any *ptr);
MUS_EXPORT mus_float_t mus_granulate(mus_any *ptr, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT mus_float_t mus_granulate_with_editor(mus_any *ptr, mus_float_t (*input)(void *arg, int direction), int (*edit)(void *closure));
MUS_EXPORT mus_any *mus_make_granulate(mus_float_t (*input)(void *arg, int direction),
mus_float_t expansion, mus_float_t length, mus_float_t scaler,
mus_float_t hop, mus_float_t ramp, mus_float_t jitter, int max_size,
int (*edit)(void *closure),
void *closure);
MUS_EXPORT int mus_granulate_grain_max_length(mus_any *ptr);
MUS_EXPORT void mus_granulate_set_edit_function(mus_any *ptr, int (*edit)(void *closure));

MUS_EXPORT mus_long_t mus_set_file_buffer_size(mus_long_t size);
MUS_EXPORT mus_long_t mus_file_buffer_size(void);

MUS_EXPORT mus_float_t mus_apply(mus_any *gen, mus_float_t f1, mus_float_t f2);

MUS_EXPORT bool mus_is_phase_vocoder(mus_any *ptr);
MUS_EXPORT mus_any *mus_make_phase_vocoder(mus_float_t (*input)(void *arg, int direction),
int fftsize, int overlap, int interp,
mus_float_t pitch,
bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)),
int (*edit)(void *arg), /* return value is ignored (int return type is intended to be consistent with granulate) */
mus_float_t (*synthesize)(void *arg),
void *closure);
MUS_EXPORT mus_float_t mus_phase_vocoder(mus_any *ptr, mus_float_t (*input)(void *arg, int direction));
MUS_EXPORT mus_float_t mus_phase_vocoder_with_editors(mus_any *ptr,
mus_float_t (*input)(void *arg, int direction),
bool (*analyze)(void *arg, mus_float_t (*input)(void *arg1, int direction)),
int (*edit)(void *arg),
mus_float_t (*synthesize)(void *arg));

MUS_EXPORT mus_float_t *mus_phase_vocoder_amp_increments(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_phase_vocoder_amps(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_phase_vocoder_freqs(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_phase_vocoder_phases(mus_any *ptr);
MUS_EXPORT mus_float_t *mus_phase_vocoder_phase_increments(mus_any *ptr);


MUS_EXPORT mus_any *mus_make_ssb_am(mus_float_t freq, int order);
MUS_EXPORT bool mus_is_ssb_am(mus_any *ptr);
MUS_EXPORT mus_float_t mus_ssb_am_unmodulated(mus_any *ptr, mus_float_t insig);
MUS_EXPORT mus_float_t mus_ssb_am(mus_any *ptr, mus_float_t insig, mus_float_t fm);

MUS_EXPORT void mus_clear_sinc_tables(void);
MUS_EXPORT void *mus_environ(mus_any *gen);
MUS_EXPORT void *mus_set_environ(mus_any *gen, void *e);
MUS_EXPORT mus_any *mus_bank_generator(mus_any *g, int i);
#ifdef __cplusplus
}
#endif

#endif


/* Change log.
*
* 5-Aug: removed some now-obsolete mus_locsig functions.
* 5-Jul: added stable arg to mus_make_oscil_bank.
* 15-Feb: removed mus_set_name, changed mus_free to void.
* 31-Jan-15: removed mus_multiply_arrays.
* --------
* 8-Nov: mus_copy, mus_bank_generator.
* 24-Oct: mus_generator_set_feeders.
* 10-Aug: data-format -> sample-type.
* 17-Apr: moving_norm generator.
* 14-Apr: mus_frame and mus_mixer removed, "frame" replaced by "frample" in IO functions.
* 11-Apr: mus_even|odd_weight|multiple.
* 9-Apr: deprecate mus_is_delay_line.
* 2-Apr: mus_make_moving_average_with_sum.
* 19-Mar: deprecate mus_make_env_with_length.
* 17-Feb-14: mus_*_p -> mus_is_*.
* --------
* 7-Dec: mus_set_formant_frequency, mus_src_20 and mus_src_05 changed. Removed mus_in_any_from_file.
* 29-Nov: mus_make_polywave_tu.
* 11-Oct: mus_vector_to_file, mus_vector_mix.
* 19-Apr: rxyk!cos and rxyk!sin from generators.scm.
* 11-Apr: mus_tap_p as a better name for mus_delay_line_p.
* 27-Mar: comb-bank, all-pass-bank, filtered-comb-bank, pulsed-env, oscil-bank.
* 21-Mar: one-pole-all-pass generator.
* 14-Mar: formant-bank generator.
* removed mus_delay_tick_noz.
* 4-Mar: moving_max generator.
* removed the unstable filter check in make_two_pole.
* 21-Jan-13: changed mus_formant_bank parameters.
* --------
* 22-Dec: removed all the safety settings.
* 15-Nov: removed mus_env_t, mus_env_type, and other recently deprecated stuff.
* 15-Jul: more changes for clm2xen.
* 4-July-12: moved various struct definitions to clm.c
* added accessors for mus_any_class etc.
* --------
* 1-Sep: mus_type.
* 20-Aug: changed type of mus_locsig to void, added mus_locsig_function_reset.
* removed function-as-output-location from locsig et al.
* 14-Jul-11: removed pthread stuff.
* --------
* 7-Mar-10: protect in-any and out-any from sample numbers less than 0.
* --------
* 14-Oct: sine-summation, sum-of-sines, sum-of-cosines removed.
* 28-Aug: changed some fft-related sizes from int to mus_long_t.
* 17-Aug: mus_frame|mixer_copy|fill.
* 27-Jul: mus_float_t for Float, and mus_long_t for off_t.
* 15-Jun: mus_rectangular_to_magnitudes (polar, but ignore phases).
* 11-Jun: mus_cepstrum.
* 11-May: MUS_ENV_LINEAR and friends, also mus_env_linear|exponential.
* mus_frame_to_frame_mono|stereo.
* 12-Mar: sinc, papoulis and dpss (slepian windows).
* 1-Jan-09: added MUS_EXPORT.
* --------
* 11-Dec: deprecated the sine-summation, sum-of-cosines, and sum-of-sines generators.
* 30-Oct: mus_sample_to_file_add.
* mus_describe once again allocates a fresh output string.
* finally removed sine-bank.
* 9-Oct: various thread-related internal changes.
* 14-Jul: mus_data_format_zero.
* 12-Jul: mus_interp_type_p and mus_fft_window_p for C++'s benefit.
* 1-July: mus-safety and various ints changed to mus_long_t.
* 20-Jun: support for pthreads.
* 16-Jun: changed init_mus_module to mus_initialize.
* 30-May: changed polyshape to use cos and added cheby_choice arg to mus_make_polyshape.
* 27-May: mus_waveshape retired -- generators.scm has a wrapper for it.
* clm_free, clm_realloc etc for rt work.
* mus_chebyshev_tu_sum.
* 25-May: mus_polywave algorithm changed.
* 17-May: mus_normalize_partials.
* 12-Apr: added choice arg to mus_make_polywave.
* 8-Apr: polywave uses sine-bank if highest harmonic out of Chebyshev range.
* 1-Mar: mus_set_name.
* 26-Feb: removed mus_cosines (use mus_length)
* 24-Feb: removed mus_make_env_with_start, added mus_make_env_with_length
* 20-Feb: clm 4:
* polywave for polyshape and waveshape.
* mus_formant_with_frequency.
* firmant generator.
* removed mus_formant_radius and mus_set_formant_radius.
* removed "gain" arg from mus_make_formant.
* reversed the order of the arguments to mus_make_formant.
* fixed long-standing bug in gain calculation in mus_formant.
* mus_env_any for arbitrary connecting functions.
* 15-Feb: nrxysin and nrxycos for sine-summation.
* 12-Feb: nsin for sum_of_sines, ncos for sum_of_cosines.
* 4-Feb: clm_default_frequency (clm2xen) and *clm-default-frequency* (ws.scm).
* 7-Jan-08: :dur replaced by :length in make-env.
* --------
* 19-Oct: all *_0 *_1 *_2 names now use _fm|_pm|_unmodulated|_no_input.
* 17-Oct: replace some method macros with functions (def-clm-struct local methods need true names).
* 15-Oct: mus_oscil_1 -> _fm, _2->_pm.
* mus_phase_vocoder_outctr accessors changed to use mus_location.
* 11-Oct: changed default srate to 44100.
* 5-Oct: mus_oscil_2.
* 6-Sep: changed asymmetric-fm to use cos(sin) and added amplitude normalization.
* 6-Aug: mus_autocorrelate, mus_correlate.
* 3-Aug: blackman5..10 and Rife-Vincent (RV2..4 fft), mlt-sine windows.
* 16-July: removed start arg from mus_make_env (see mus_make_env_with_start).
* 5-July: changed some mus_float_ts to doubles in env funcs.
* exp envs now use repeated multiplies rather than direct exp call.
* 19-June: mus-increment on gens with a notion of frequency (phase increment);
* to make room for this, asymmetric-fm ratio and sine-summation b moved to mus-offset.
* 22-Feb: mus_big_fft and mus_spectrum_t.
* 21-Feb: mus_fft_window_name.
* 14-Feb-07: three more fft window choices.
* --------
* 27-Nov: move-sound array access parallel to locsig.
* 22-Nov: had to add non-backwards-compatible reverb chans arg to mus_make_locsig.
* 21-Nov: mus_float_equal_fudge_factor, mus_arrays_are_equal.
* 30-July: renamed average to moving_average.
* 28-July: renamed make_ppolar and make_zpolar to make_two_pole|zero_from_radius_and_frequency.
* added mus_scaler and mus_frequency methods for two_pole and two_zero.
* 21-July: removed mus_wrapper field -- old way can't work since we need the original Xen object.
* 3-July: mus_move_sound (dlocsig) generator.
* changed return type of mus_locsig to float.
* 28-June: mus_filtered_comb generator.
* 8-May: mus_apply now takes 3 args: gen, two doubles (rather than bug-prone varargs).
* 1-Mar-06: granulate now has a local random number seed (settable via the mus-location method).
* --------
* 20-Dec: samaraki and ultraspherical windows.
* this required a non-backwards-compatible additional argument in mus_make_fft_window_with_window.
* 1-Nov: mus_filter_set_x|ycoeffs, mus_filter_set_order (needed by Snd).
* 1-May: mus-scaler|feedback ok with delay and average.
* 18-Apr: mus_set_environ.
* 11-Apr: mus_mixer|frame_offset, mus_frame_scale (for higher level generic functions).
* 23-Mar: frame_to_frame arg interpretation changed.
* 21-Mar: mus_make_readin|file_to_sample|file_to_frame_with_buffer_size.
* 16-Mar: polyshape generator (waveshaper as polynomial + oscil)
* mus_chebyshev_first|second_kind.
* mus_partials_to_waveshape no longer normalizes the partials.
* 18-Feb: mus_interpolate.
* 14-Feb: deprecated mus_restart_env and mus_clear_filter_state.
* 7-Feb-05: mus_reset method, replaces mus_restart_env and mus_clear_filter_state.
* --------
* 20-Dec: changed "jitter" handling if hop < .05 in granulate.
* 15-Dec: mus_generator? for type checks (clm2xen).
* 11-Sep: removed buffer generator.
* 6-Sep: removed mus_oscil_bank, mus_bank.
* 24-Aug: removed mus_inspect method -- overlaps mus_describe and is useless given gdb capabilities.
* 27-July: mus_granulate_with_editor and mus_phase_vocoder_with_editors.
* 21-July: edit-func as run-time arg to granulate (for CL/clm compatibility)
* 19-July: clm 3:
* deprecated mus_ina|b, mus-outa|b|c|d.
* mus_make_frame_to_file_with_comment, mus_mixer_scale, mus_make_frame|mixer_with_data.
* mus_make_scalar_mixer, mus_mixer_add, mus_continue_frame_to_file.
* changed pv_* to phase_vocoder_*
* 28-June: ssb_am + added fm arg (ssb_am_1 is the previous form).
* 21-June: wrapper method.
* 14-June: ssb_am generator.
* deprecated mus-a*|b*, replaced by mus-x|ycoeff.
* 9-June: mus_edot_product.
* 7-June: removed mus-x*|y* generic functions.
* 24-May: distribution arg to make-rand, make-rand-interp.
* 11-May: type arg to mus_make_table_lookup|wave_train, MUS_INTERP_NONE, MUS_INTERP_HERMITE.
* mus-interp-type.
* 10-May: changed MUS_LINEAR and MUS_SINUSOIDAL to MUS_INTERP_LINEAR and MUS_INTERP_SINUSOIDAL.
* mus-linear renamed mus-interp-linear, mus-sinusoidal renamed mus-interp-sinusoidal.
* added type arg to mus_make_delay|all_pass|comb|notch.
* added mus_delay_tick, all-pass delay line interpolation.
* 3-May: envelope arg to make-rand and make-rand-interp to give any arbitrary random number distribution.
* added mus_make_rand_with_distribution and mus_make_rand_interp_with_distribution.
* rand/rand-interp mus-data returns distribution (weight) function, mus-length its length.
* locsig mus-data returns output scalers, mus-xcoeffs returns reverb scalers
* 26-Apr: mus_sum_of_sines changed to mus_sine_bank.
* new mus_sum_of_sines parallels mus_sum_of_cosines.
* deprecated mus_sin.
* 14-Apr: changed "2" to "_to_" in several function names.
* 12-Apr: mus_average, mus_average_p, mus_make_average.
* 17-Mar: edit function added to mus_granulate.
* replaced MUS_DATA_POSITION with MUS_DATA_WRAPPER.
* 22-Jan: various "environ" variables renamed for Windows' benefit.
* 5-Jan-04: env_interp bugfix.
* --------
* 29-Sep: removed length arg from spectrum in clm2xen.
* 24-Aug: changed mus_length|ramp|hop type to mus_long_t.
* 21-Aug: export MUS_INPUT and friends (needed for specialized INA handlers).
* 11-Aug: int -> bool.
* 7-Aug: removed mus_type.
* 20-July: more run methods.
* 15-July: linear->dB check for 0.0 arg.
* 27-June: mus_samples_to_seconds and mus_seconds_to_samples.
* 9-June: mus_mix_with_reader_and_writer.
* 27-May: bugfix: interpolating all-pass ("zall-pass") had an extra delay.
* 25-Apr: mus_spectrum and mus_convolution now return mus_float_t*.
* 9-Apr: removed MUS_HANNING_WINDOW (use MUS_HANN_WINDOW).
* 3-Mar: mus_delay_line_p for tap error checking.
* 27-Feb: mus_length for env -> original duration in samples.
* 21-Feb: mus_set_cosines added, mus_cosines moved to hop slot.
* mus_[set_]x1/x2/y1/y2.
* 10-Feb: mus_file_name moved into the mus_input|output structs.
* folded mus_input|output into mus_any.
* moved mus_frame|mixer declarations into clm.c.
* all mus_input|output|frame|mixer pointers->mus_any.
* all method void pointers->mus_any.
* 7-Feb: split strings out of clm2xen.c into clm-strings.h.
* 3-Feb: mus_offset for envs, mus_width for square_wave et al.
* new core class fields(10) for various methods.
* 7-Jan-03: mus_src with very large sr_change segfault bugfix.
* --------
* 17-Dec: mus_env_offset|initial_power for Snd exp env optimizations.
* 13-Sep: mus_frandom and mus_irandom(for Snd optimizer).
* 19-Aug: changed internal phase-vocoder array accessor names
* 13-Aug: set!(*-ref) for frame, locsig, mixer, locsig-reverb.
* 29-Jul: various *_1 cases for the optimizer.
* 15-Jul: mus_continue_sample2file.
* 10-Jul: mus_file_name.
* 7-Jun: fftw support added.
* 31-May: changed mus_any_class.
* 3-May: many int->mus_long_t changes for large files.
* 8-Apr: off-by-1 env bug(Lisp/C are now identical), env_interp of exp env beyond end bugfix.
* 1-Apr: sine-summation n=0 bugfix.
* 27-Mar: negative degree locsig bugfix.
* 18-Mar: mus_move_locsig.
* 15-Mar: n-chan locsig(and reverb scalers), 'type' arg to mus_make_locsig.
* 6-Mar: mus_scaler in asymmetric-fm now refers to the "r" parameter, "a" in sine-summation.
* 5-Mar: dumb typo in asymmetric-fm generator fixed.
* 19-Feb: buffer reallocation redundant free bugfix.
* 25-Jan-02: mus_increment of env returns base.
* --------
* 10-Dec: add outctr calls, phase-vocoder bugfixes, thanks to Scott Wilson.
* 21-Oct: fill in some set-data methods.
* 1-Sep: mus_polar2rectangular.
* 6-July: scm -> xen.
* 26-May: mus_rand_seed.
* 22-May: locsig reverb distance calc was upside down.
* 18-May: mus_describe and mus_inspect returned string should not be freed any more.
* 7-May: filled in some leftover equal_p methods.
* 1-Apr: mus_make_file2sample_with_comment and mus_length for file->sample/sample->file.
* mus_file_buffer_size.
* 26-Mar: extended_type field added to mus_any_class for more robust type checking.
* 16-Mar: mus_phase of env -> current_value.
* 28-Feb: added mus_position(currently only for envs).
* 8-Feb: clm2scm.h.
* 24-Jan: mus-bank in clm2scm.
* 5-Jan: clm2scm gens are applicable.
* 4-Jan: mus_bank.
* 2-Jan-01: mus_run method.
* --------
* 28-Dec: mus_clear_filter_state and other minor tweaks for Snd.
* 28-Nov: Dolph-Chebyshev window(under HAVE_GSL flag -- needs complex trig support).
* 8-Nov: mus_clear_sinc_tables.
* 12-Oct: mus_formant_bank takes one input(can't remember why I had an array here)
* 27-Sep: mus_array_interp bugfix(imitates mus.lisp now).
* 18-Sep: clm now assumes it's used as a part of sndlib.
* 11-Sep: generalized set! to generic functions in clm2scm.c.
* 31-Aug: changed formant field setters(thanks to Anders Vinjar).
* 10-Aug: removed built-in setf support(clm2scm.c).
* 31-Jul: mus_granulate tries to protect against illegal length and ramp values.
* 24-Jul: mus_make_fir_coeffs.
* 20-Jul: sum_of_sines, atan2 to rectangular->polar, phase_vocoder gen.
* 22-June: made mus_bessi0 local again.
* 1-June: bugfixes for linuxppc 2000.
* 19-May: mus_apply.
* 8-May: added "const" and XEN_PROCEDURE_CAST(for c++), made mus_bessi0 global.
* 24-Apr: changed formant radius to match lisp version(it's now 1-old_radius)
* 20-Apr: mus_convolve_files
* 7-Apr: src width bug fixed
* 31-Mar: finally implemented set-location for envs.
* 14-Feb: buffer-full?.
* 1-Feb: removed mus_phasepartials2waveshape.
* 3-Jan-00: format and type args added to make_sample2file,
* mus_file_close.
* removed make_file_input and make_file_output.
* --------
* 29-Dec: various bugfixes especially in envelope handlers.
* 19-Nov: mus_oscil_bank and mus_formant_bank.
* 5-Nov: mus_sin exported.
* 4-Oct:(scm) make-env arg order changed to reflect mus.lisp.
* 29-Sep: implemented mus-increment and mus-frequency for granulate(as in mus.lisp).
* clm's fft renamed mus-fft to avoid collision with snd's version.
* added max_size arg to make_granulate(to reflect mus.lisp).
* 25-Sep-99: added width arg to make_src -- forgot this somehow in first pass.
* decided to make mus_inspect return char* like mus_describe.
*/

+ 2847
- 0
lib/sndlib/clm.rb
File diff suppressed because it is too large
View File


+ 13286
- 0
lib/sndlib/clm2xen.c
File diff suppressed because it is too large
View File


+ 53
- 0
lib/sndlib/clm2xen.h View File

@@ -0,0 +1,53 @@
#ifndef CLM2XEN_H
#define CLM2XEN_H

#include "vct.h"

typedef struct mus_xen mus_xen;

#define Xen_to_mus_xen(arg) ((mus_xen *)Xen_object_ref(arg))
#define Xen_to_mus_any(obj) mus_xen_gen(Xen_to_mus_xen(obj))
#define MUS_CLM_DEFAULT_TABLE_SIZE 512
#define MUS_CLM_DEFAULT_FREQUENCY 0.0

#ifdef __cplusplus
extern "C" {
#endif

MUS_EXPORT mus_long_t clm_default_table_size_c(void);
MUS_EXPORT mus_float_t clm_default_frequency_c(void);

MUS_EXPORT mus_any *mus_xen_gen(mus_xen *x);

MUS_EXPORT bool mus_is_xen(Xen obj);
MUS_EXPORT const char *mus_fft_window_xen_name(mus_fft_window_t i);
MUS_EXPORT Xen mus_xen_to_object(mus_xen *gn);
MUS_EXPORT Xen mus_xen_to_object_with_vct(mus_xen *gn, Xen v);
MUS_EXPORT mus_any *mus_optkey_to_mus_any(Xen key, const char *caller, int n, mus_any *def);
MUS_EXPORT int mus_optkey_unscramble(const char *caller, int nkeys, Xen *keys, Xen *args, int *orig);
MUS_EXPORT mus_float_t mus_optkey_to_float(Xen key, const char *caller, int n, mus_float_t def);
MUS_EXPORT int mus_optkey_to_int(Xen key, const char *caller, int n, int def);
MUS_EXPORT bool mus_optkey_to_bool(Xen key, const char *caller, int n, bool def);
MUS_EXPORT mus_long_t mus_optkey_to_mus_long_t(Xen key, const char *caller, int n, mus_long_t def);
MUS_EXPORT const char *mus_optkey_to_string(Xen key, const char *caller, int n, char *def);
MUS_EXPORT Xen mus_optkey_to_procedure(Xen key, const char *caller, int n, Xen def, int required_args, const char *err);

MUS_EXPORT mus_xen *mus_any_to_mus_xen(mus_any *ge);
MUS_EXPORT mus_xen *mus_any_to_mus_xen_with_vct(mus_any *ge, Xen v);
MUS_EXPORT mus_xen *mus_any_to_mus_xen_with_two_vcts(mus_any *ge, Xen v1, Xen v2);

MUS_EXPORT Xen g_mus_channels(Xen obj);
MUS_EXPORT Xen g_mus_length(Xen gen);
MUS_EXPORT Xen g_mus_file_name(Xen gen);
MUS_EXPORT Xen g_mus_data(Xen gen);

#if HAVE_SCHEME
MUS_EXPORT void s7_init_sndlib(s7_scheme *sc);
#endif

MUS_EXPORT void Init_sndlib(void);
#ifdef __cplusplus
}
#endif

#endif

+ 653
- 0
lib/sndlib/cload.scm View File

@@ -0,0 +1,653 @@
(provide 'cload.scm)

;;; --------------------------------------------------------------------------------
;;; automatically link a C function into s7 (there are a bunch of examples below)
;;; (c-define '(double j0 (double)) "m" "math.h")
;;; means link the name m:j0 to the math library function j0 passing a double arg and getting a double result (reals in s7)
;;;
;;; (c-define c-info prefix headers cflags ldflags)
;;; prefix is some arbitrary prefix (it can be "") that you want prepended to various names.
;;; headers is a list of headers (as strings) that the c-info relies on, (("math.h") for example).
;;; cflags are any special C compiler flags that are needed ("-I." in particular).
;;; ldflags is the similar case for the loader.
;;; c-info is a list that describes the C entities that you want to tie into s7.
;;; it can be either one list describing one entity, or a list of such lists.
;;; Each description has the form: (return-type entity-name-in-C (argument-type...))
;;; where each entry is a symbol, and C names are used throughout. So, in the j0
;;; example above, (double j0 (double)) says we want access to j0, it returns
;;; a C double, and takes one argument, also a C double. s7 tries to figure out
;;; what the corresponding s7 type is, but in tricky cases, you should tell it
;;; by replacing the bare type name with a list: (C-type underlying-C-type). For example,
;;; the Snd function set_graph_style takes an (enum) argument of type graph_style_t.
;;; This is actually an int, so we use (graph_style_t int) as the type:
;;; (void set_graph_style ((graph_style_t int)))
;;; If the C entity is a constant, then the descriptor list has just two entries,
;;; the C-type and the entity name: (int F_OK) for example. The entity name can also be a list
;;; (an enum listing for example).
;;; If the C type has a space ("struct tm*" for example), use (symbol "struct tm*")
;;; to construct the corresponding symbol.
;;; The entity is placed in the current s7 environment under the name (string-append prefix ":" name)
;;; where the ":" is omitted if the prefix is null. So in the j0 example, we get in s7 the function m:j0.
;;;
;;; some examples:
;;;
;;; (c-define '((double j0 (double))
;;; (double j1 (double))
;;; (double erf (double))
;;; (double erfc (double))
;;; (double lgamma (double)))
;;; "m" "math.h")
;;;
;;;
;;; (c-define '(char* getenv (char*)))
;;; (c-define '(int setenv (char* char* int)))
;;; (define get-environment-variable (let () (c-define '(char* getenv (char*))) getenv))
;;;
;;; (define file-exists? (let () (c-define '((int F_OK) (int access (char* int))) "" "unistd.h") (lambda (arg) (= (access arg F_OK) 0))))
;;; (define delete-file (let () (c-define '(int unlink (char*)) "" "unistd.h") (lambda (file) (= (unlink file) 0)))) ; 0=success, -1=failure
;;;
;;;
;;; these pick up Snd stuff:
;;; (c-define '(char* version_info ()) "" "snd.h" "-I.")
;;; (c-define '(mus_float_t mus_degrees_to_radians (mus_float_t)) "" "snd.h" "-I.")
;;;
;;; (c-define '(snd_info* any_selected_sound ()) "" "snd.h" "-I.")
;;; (c-define '(void select_channel (snd_info* int)) "" "snd.h" "-I.")
;;; (c-define '(((graph_style_t int) (GRAPH_LINES GRAPH_DOTS GRAPH_FILLED GRAPH_DOTS_AND_LINES GRAPH_LOLLIPOPS))
;;; (void set_graph_style ((graph_style_t int))))
;;; "" "snd.h" "-I.")
;;;
;;;
;;; (c-define '(char* getcwd (char* size_t)) "" "unistd.h")
;;; :(let ((str (make-string 32))) (getcwd str 32) str)
;;; "/home/bil/cl\x00 "
;;; so it works in a sense -- there is a memory leak here
;;;
;;;
;;; (c-define (list '(void* calloc (size_t size_t))
;;; '(void* malloc (size_t))
;;; '(void free (void*))
;;; '(void* realloc(void* size_t))
;;; '(void time (time_t*)) ; ignore returned value
;;; (list (symbol "struct tm*") 'localtime '(time_t*))
;;; (list 'size_t 'strftime (list 'char* 'size_t 'char* (symbol "struct tm*"))))
;;; "" "time.h")
;;; > (let ((p (calloc 1 8)) (str (make-string 32))) (time p) (strftime str 32 "%a %d-%b-%Y %H:%M %Z" (localtime p)) (free p) str)
;;; "Sat 11-Aug-2012 08:55 PDT\x00 "
;;;
;;;
;;; (c-define '((int closedir (DIR*))
;;; (DIR* opendir (char*))
;;; (in-C "static char *read_dir(DIR *p) \
;;; { \
;;; struct dirent *dirp; \
;;; dirp = readdir(p); \
;;; if (!dirp) return(NULL); \
;;; else return(dirp->d_name); \
;;; }")
;;; (char* read_dir (DIR*)))
;;; "" '("sys/types.h" "dirent.h"))
;;;
;;; (let ((dir (opendir "/home/bil/gtk-snd")))
;;; (do ((p (read_dir dir) (read_dir dir)))
;;; ((= (length p) 0))
;;; (format *stderr* "~A " p))
;;; (closedir dir))
;;;
;;; (define (memory-usage)
;;; (with-let *libc*
;;; (let ((v (rusage.make)))
;;; (getrusage RUSAGE_SELF v)
;;; (let ((mem (rusage.ru_maxrss v)))
;;; (free v)
;;; (* 1024 mem)))))
;;; --------------------------------------------------------------------------------

(define *cload-cflags* "")
(define *cload-ldflags* "")
(if (not (defined? '*cload-directory*))
(define *cload-directory* ""))


(define-macro (defvar name value)
`(if (not (defined? ',name))
(define ,name ,value)))

(defvar c-define-output-file-counter 0) ; ugly, but I can't find a way around this (dlopen/dlsym stupidity)


;;; to place the new function in the caller's current environment, we need to pass the environment in explicitly:
(define-macro (c-define . args)
`(c-define-1 (curlet) ,@args))


(define* (c-define-1 cur-env function-info (prefix "") (headers ()) (cflags "") (ldflags "") output-name)
;; write a C shared library module that links in the functions in function-info
;; function info is either a list: (return-type c-name arg-type) or a list thereof
;; the new functions are placed in cur-env

(define handlers (list '(integer s7_is_integer s7_integer s7_make_integer s7_int)
'(boolean s7_is_boolean s7_boolean s7_make_boolean bool)
'(real s7_is_real s7_number_to_real s7_make_real s7_double)

;; '(complex s7_is_complex #f s7_make_complex s7_Complex)
;; the typedef is around line 6116 in s7.c, but we also need s7_complex which requires the s7_Complex type
;; xen.h uses (s7_real_part(a) + s7_imag_part(a) * _Complex_I) instead since c++ won't let use define s7_Complex in s7.h

'(string s7_is_string s7_string s7_make_string char*)
(list 'character 's7_is_character 's7_character 's7_make_character (symbol "unsigned char"))
'(c_pointer s7_is_c_pointer s7_c_pointer s7_make_c_pointer void*)
'(s7_pointer #f #f #f s7_pointer)
))

(define (C-type->s7-type type)

(if (pair? type) ; in case the type name does not make its C type obvious: (graph_style_t int)
(C-type->s7-type (cadr type))
(let ((type-name (symbol->string type)))
(cond ((string-position "**" type-name) ; any complicated C pointer is uninterpreted
'c_pointer)

((string=? "s7_pointer" type-name)
's7_pointer)
((string-position "char*" type-name) ; but not char** (caught above)
'string)

((or (string-position "*" type-name) ; float* etc
(string-position "pointer" type-name))
'c_pointer)

((assoc type-name '(("char" . character)
("bool" . boolean)) string-position)
=> cdr)
;; ((string-position "complex" type-name)
;; 'complex) ; double complex or complex double (mus_edot_product in clm.c uses the latter)

((or (string-position "float" type-name)
(string-position "double" type-name))
'real)

((or (string-position "int" type-name)
(string-position "long" type-name) ; assuming not "long double" here so we need to look for it first (above)
(string-position "short" type-name)
(string-position "size" type-name)
(string-position "byte" type-name))
'integer)

(#t #t)))))

(define (find-handler type choice)
(cond ((assq (C-type->s7-type type) handlers) => choice) (else #t)))

(define (C->s7-cast type)
(find-handler type (lambda (p) (list-ref p 4))))
(define (C->s7 type)
(find-handler type cadddr))
(define (s7->C type)
(find-handler type caddr))

(define (checker type)
(find-handler type cadr))

(define* (cload->signature type rtn)
(case (C-type->s7-type type)
((real) (if rtn 'float? 'real?))
((integer) 'integer?)
((string) 'string?)
((boolean) 'boolean?)
((character) 'char?)
((c_pointer) 'c-pointer?)
(else #t)))

(define (signature->pl type)
(case type
((integer?) #\i)
((boolean?) #\b)
((real?) #\r)
((float?) #\d)
((char?) #\c)
((string?) #\s)
((c-pointer?) #\x)
(else #\t)))

(set! c-define-output-file-counter (+ c-define-output-file-counter 1))

(let ((file-name (string-append *cload-directory* (or output-name (format #f "temp-s7-output-~D" c-define-output-file-counter)))))
(let ((c-file-name (string-append file-name ".c"))
(o-file-name (string-append file-name ".o"))
(so-file-name (string-append file-name ".so"))
(init-name (if (string? output-name)
(string-append output-name "_init")
(string-append "init_" (number->string c-define-output-file-counter))))
(functions ())
(constants ())
(macros ()) ; these are protected by #ifdef ... #endif
(inits ()) ; C code (a string in s7) inserted in the library initialization function
(p #f)
(if-funcs ()) ; if-functions (guaranteed to return int, so we can optimize away make-integer etc)
(rf-funcs ()) ; rf-functions
(sig-symbols (list (cons 'integer? 0) (cons 'boolean? 0) (cons 'real? 0) (cons 'float? 0)
(cons 'char? 0) (cons 'string? 0) (cons 'c-pointer? 0) (cons 't 0)))
(signatures (make-hash-table)))
(define (make-signature rtn args)
(define (compress sig)
(if (and (pair? sig)
(pair? (cdr sig))
(eq? (car sig) (cadr sig)))
(compress (cdr sig))
sig))
(let ((sig (list (cload->signature rtn #t)))
(cyclic #f))
(for-each
(lambda (arg)
(set! sig (cons (cload->signature arg) sig)))
args)
(let ((len (length sig)))
(set! sig (compress sig))
(set! cyclic (not (= len (length sig)))))
(set! sig (reverse sig))
(unless (signatures sig) ; it's not in our collection yet
(let ((pl (make-string (+ (if cyclic 4 3) (length sig))))
(loc (if cyclic 4 3)))
(set! (pl 0) #\p)
(if cyclic
(begin (set! (pl 1) #\c) (set! (pl 2) #\l) (set! (pl 3) #\_))
(begin (set! (pl 1) #\l) (set! (pl 2) #\_)))
(for-each
(lambda (typer)
(set! (pl loc) (signature->pl typer))
(let ((count (or (assq typer sig-symbols)
(assq 't sig-symbols))))
(set-cdr! count (+ (cdr count) 1)))
(set! loc (+ loc 1)))
sig)
(set! (signatures sig) pl)))
sig))
(define (initialize-c-file)
;; C header stuff
(set! p (open-output-file c-file-name))
(format p "#include <stdlib.h>~%")
(format p "#include <stdio.h>~%")
(format p "#include <string.h>~%")
(if (string? headers)
(format p "#include <~A>~%" headers)
(for-each
(lambda (header)
(format p "#include <~A>~%" header))
headers))
(format p "#include \"s7.h\"~%~%"))
(define collides?
(let ((all-names ()))
(lambda (name)
(if (memq name all-names)
(format *stderr* "~A twice?~%" name)
(set! all-names (cons name all-names)))
name)))
(define* (add-one-function return-type name arg-types doc)
;; (format *stderr* "~A ~A ~A~%" return-type name arg-types): double j0 (double) for example
;; C function -> scheme
(let ((func-name (symbol->string (collides? name))))
(let ((num-args (length arg-types))
(base-name (string-append (if (> (length prefix) 0) prefix "s7_dl") "_" func-name)) ; not "g" -- collides with glib
(scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") func-name)))
(if (and (= num-args 1)
(eq? (car arg-types) 'void))
(set! num-args 0))
(format p "~%/* -------- ~A -------- */~%" func-name)
(format p "static s7_pointer ~A(s7_scheme *sc, s7_pointer args)~%" base-name)
(format p "{~%")
;; get the Scheme args, check their types, assign to local C variables
(when (positive? num-args)
(format p " s7_pointer arg;~%")
(do ((i 0 (+ i 1))
(type arg-types (cdr type)))
((= i num-args))
(format p " ~A ~A_~D;~%" ((if (pair? (car type)) caar car) type) base-name i))
(format p " arg = args;~%")
(do ((i 0 (+ i 1))
(type arg-types (cdr type)))
((= i num-args))
(let* ((nominal-type ((if (pair? (car type)) caar car) type)) ; double in the example
(true-type ((if (pair? (car type)) cadar car) type))
(s7-type (C-type->s7-type true-type))) ; real
(if (eq? true-type 's7_pointer)
(format p " ~A_~D = s7_car(arg);~%" base-name i)
(begin
(format p " if (~A(s7_car(arg)))~%" (checker true-type))
(format p " ~A_~D = (~A)~A(~As7_car(arg));~%"
base-name i
nominal-type
(s7->C true-type) ; s7_number_to_real which requires
(if (memq s7-type '(boolean real)) ; the extra sc arg
"sc, " ""))
(format p " else return(s7_wrong_type_arg_error(sc, ~S, ~D, s7_car(arg), ~S));~%"
func-name
(if (= num-args 1) 0 (+ i 1))
(if (symbol? s7-type)
(symbol->string s7-type)
(error 'bad-arg (format #f "in ~S, ~S is not a symbol~%" name s7-type))))))
(if (< i (- num-args 1))
(format p " arg = s7_cdr(arg);~%")))))
;; return C value to Scheme
(if (pair? return-type)
(set! return-type (cadr return-type)))
(let ((return-translator (C->s7 return-type)))
(format p " ")
(if (not (eq? return-translator #t))
(format p "return("))
(if (symbol? return-translator)
(format p "~A(sc, (~A)" return-translator (C->s7-cast return-type)))
(format p "~A(" func-name)
(do ((i 0 (+ i 1)))
((>= i (- num-args 1)))
(format p "~A_~D, " base-name i))
(if (positive? num-args)
(format p "~A_~D" base-name (- num-args 1)))
(format p ")")
(if (symbol? return-translator)
(format p ")"))
(format p (if (not (eq? return-translator #t))
");~%"
";~% return(s7_unspecified(sc));~%"))
(format p "}~%"))
;; add optimizer connection
(when (and (eq? return-type 'double) ; double (f double) -- s7_rf_t: double f(s7, s7_pointer **p)
(eq? (car arg-types) 'double)
(or (= num-args 1)
(and (= num-args 2) ; double (f double double)
(eq? (cadr arg-types) 'double))))
(set! rf-funcs (cons (cons func-name scheme-name) rf-funcs))
(format p (if (= num-args 1)
"static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~
{s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
"static s7_double ~A_rf_r(s7_scheme *sc, s7_pointer **p)~% ~
{s7_rf_t f; s7_double x, y; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); f = (s7_rf_t)(**p); (*p)++; y = f(sc, p); return(~A(x, y));}~%")
func-name func-name)
(format p "static s7_rf_t ~A_rf(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_rf(sc, s7_cadr(expr))) return(~A_rf_r); return(NULL);}~%"
func-name func-name))
(when (and (eq? return-type 'int) ; int (f int|double|void)
(memq (car arg-types) '(int double void))
(<= num-args 1))
(set! if-funcs (cons (cons func-name scheme-name) if-funcs))
(case (car arg-types)
((double)
(format p "static s7_int ~A_if_r(s7_scheme *sc, s7_pointer **p)~
{s7_rf_t f; s7_double x; f = (s7_rf_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
func-name func-name)
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_r); return(NULL);}~%"
func-name func-name))
((int)
(format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p)~
{s7_if_t f; s7_int x; f = (s7_if_t)(**p); (*p)++; x = f(sc, p); return(~A(x));}~%"
func-name (if (string=? func-name "abs") "llabs" func-name))
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) ~
{if (s7_arg_to_if(sc, s7_cadr(expr))) return(~A_if_i); return(NULL);}~%"
func-name func-name))
((void)
(format p "static s7_int ~A_if_i(s7_scheme *sc, s7_pointer **p) {return(~A());}~%" func-name func-name)
(format p "static s7_if_t ~A_if(s7_scheme *sc, s7_pointer expr) {return(~A_if_i);}~%" func-name func-name))))
(format p "~%")
(set! functions (cons (list scheme-name base-name
(if (and (string? doc)
(> (length doc) 0))
doc
(format #f "~A ~A~A" return-type func-name arg-types))
num-args 0
(make-signature return-type arg-types))
functions)))))
(define (end-c-file)
;; now the init function
;; the new scheme variables and functions are placed in the current environment
(format p "void ~A(s7_scheme *sc);~%" init-name)
(format p "void ~A(s7_scheme *sc)~%" init-name)
(format p "{~%")
(format p " s7_pointer cur_env;~%")
(format p " s7_pointer ")
(let ((pls (hash-table-entries signatures))
(loc 1))
(for-each
(lambda (s)
(format p "~A~A~A" (cdr s) (if (< loc pls) (values "," " ") (values ";" #\newline)))
(set! loc (+ loc 1)))
signatures))
(let ((syms ())
(names ()))
(for-each
(lambda (q)
(when (positive? (cdr q))
(set! syms (cons (car q) syms))
(set! names (cons (signature->pl (car q)) names))))
sig-symbols)
(when (pair? syms)
(format p " {~% s7_pointer ~{~C~^, ~};~%" names)
(for-each
(lambda (name sym)
(format p (if (eq? sym 't)
" t = s7_t(sc);~%"
(values " ~C = s7_make_symbol(sc, ~S);~%" name (symbol->string sym)))))
names syms)))
(format p "~%")
(for-each
(lambda (sig)
(let ((cyclic (char=? ((cdr sig) 1) #\c)))
(format p (if cyclic
(values " ~A = s7_make_circular_signature(sc, ~D, ~D" (cdr sig) (- (length (car sig)) 1) (length (car sig)))
(values " ~A = s7_make_signature(sc, ~D" (cdr sig) (length (car sig)))))
(format p "~{~^, ~C~}" (substring (cdr sig) (if cyclic 4 3)))
(format p ");~%")))
signatures)
(format p " }~%~%")
(format p " cur_env = s7_outlet(sc, s7_curlet(sc));~%") ; this must exist because we pass load the env ourselves
;; send out any special initialization code
(for-each
(lambda (init-str)
(format p " ~A~%" init-str))
(reverse inits))
;; "constants" -- actually variables in s7 because we want them to be local to the current environment
(if (pair? constants)
(begin
(format p "~%")
(for-each
(lambda (c)
(let* ((type (c 0))
(c-name (c 1))
(scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name)))
(format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%"
scheme-name
(C->s7 type)
(C->s7-cast type)
c-name)))
constants)))
;; C macros -- need #ifdef name #endif wrapper
(if (pair? macros)
(begin
(format p "~%")
(for-each
(lambda (c)
(let* ((type (c 0))
(c-name (c 1))
(scheme-name (string-append prefix (if (> (length prefix) 0) ":" "") c-name)))
(format p "#ifdef ~A~%" c-name)
(format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%"
scheme-name
(C->s7 type)
(C->s7-cast type)
c-name)
(format p "#endif~%")))
macros)))
;; functions
(for-each
(lambda (f)
(let ((scheme-name (f 0))
(base-name (f 1))
(help (f 2))
(num-args (f 3))
(opt-args (if (> (length f) 4) (f 4) 0))
(sig (and (> (length f) 5) (f 5))))
(format p "~% s7_define(sc, cur_env,~% s7_make_symbol(sc, ~S),~%" scheme-name)
(format p " s7_make_typed_function(sc, ~S, ~A, ~D, ~D, false, ~S, ~A));~%"
scheme-name
base-name
num-args
opt-args
help
(if (pair? sig) (signatures sig) 'NULL))))
functions)
;; optimizer connection
(when (pair? rf-funcs)
(format p "~% /* rf optimizer connections */~%")
(for-each
(lambda (f)
(format p " s7_rf_set_function(s7_name_to_value(sc, ~S), ~A_rf);~%" (cdr f) (car f)))
rf-funcs))
(when (pair? if-funcs)
(format p "~% /* if optimizer connections */~%")
(for-each
(lambda (f)
(format p " s7_if_set_function(s7_name_to_value(sc, ~S), ~A_if);~%" (cdr f) (car f)))
if-funcs))
(format p "}~%")
(close-output-port p)
;; now we have the module .c file -- make it into a shared object, load it, delete the temp files
(cond ((provided? 'osx)
;; I assume the caller is also compiled with these flags?
(system (format #f "gcc -c ~A -o ~A ~A ~A"
c-file-name o-file-name *cload-cflags* cflags))
(system (format #f "gcc ~A -o ~A -dynamic -bundle -undefined suppress -flat_namespace ~A ~A"
o-file-name so-file-name *cload-ldflags* ldflags)))
((provided? 'freebsd)
(system (format #f "cc -fPIC -c ~A -o ~A ~A ~A"
c-file-name o-file-name *cload-cflags* cflags))
(system (format #f "cc ~A -shared -o ~A ~A ~A"
o-file-name so-file-name *cload-ldflags* ldflags)))
((provided? 'openbsd)
(system (format #f "cc -fPIC -ftrampolines -c ~A -o ~A ~A ~A"
c-file-name o-file-name *cload-cflags* cflags))
(system (format #f "cc ~A -shared -o ~A ~A ~A"
o-file-name so-file-name *cload-ldflags* ldflags)))
((provided? 'sunpro_c) ; just guessing here...
(system (format #f "cc -c ~A -o ~A ~A ~A"
c-file-name o-file-name *cload-cflags* cflags))
(system (format #f "cc ~A -G -o ~A ~A ~A"
o-file-name so-file-name *cload-ldflags* ldflags)))
;; what about clang? Maybe use cc below, not gcc (and in osx case above)
(else
(system (format #f "gcc -fPIC -c ~A -o ~A ~A ~A"
c-file-name o-file-name *cload-cflags* cflags))
(system (format #f "gcc ~A -shared -o ~A ~A ~A"
o-file-name so-file-name *cload-ldflags* ldflags)))))
(define (handle-declaration func)
(define (add-one-constant type name)
;; C constant -> scheme
(let ((c-type (if (pair? type) (cadr type) type)))
(if (symbol? name)
(set! constants (cons (list c-type (symbol->string (collides? name))) constants))
(for-each
(lambda (c)
(set! constants (cons (list c-type (symbol->string (collides? c))) constants)))
name))))
(define (add-one-macro type name)
;; C macro (with definition check) -> scheme
(let ((c-type (if (pair? type) (cadr type) type)))
(if (symbol? name)
(set! macros (cons (list c-type (symbol->string (collides? name))) macros))
(for-each
(lambda (c)
(set! macros (cons (list c-type (symbol->string (collides? c))) macros)))
name))))
(define (check-doc func-data)
(let ((doc (caddr func-data)))
(if (and (string? doc)
(> (length doc) 0))
func-data
(append (list (car func-data) (cadr func-data) (car func-data)) (cdddr func-data)))))
;; functions
(if (>= (length func) 3)
(apply add-one-function func)
(case (car func)
((in-C) (format p "~A~%" (cadr func)))
((C-init) (set! inits (cons (cadr func) inits)))
((C-macro) (apply add-one-macro (cadr func)))
((C-function) (collides? (caadr func)) (set! functions (cons (check-doc (cadr func)) functions)))
(else (apply add-one-constant func)))))
;; this is the body of c-define
(unless (and output-name
(file-exists? c-file-name)
(file-exists? so-file-name)
(provided? 'system-extras)
(>= (file-mtime so-file-name) (file-mtime c-file-name))
(not (and (file-exists? (port-filename (current-input-port)))
(< (file-mtime so-file-name) (file-mtime (port-filename (current-input-port)))))))
(format *stderr* "writing ~A~%" c-file-name)
;; write a new C file and compile it
(initialize-c-file)
(if (and (pair? (cdr function-info))
(symbol? (cadr function-info)))
(handle-declaration function-info)
(for-each handle-declaration function-info))
(end-c-file)
(delete-file o-file-name))
;; load the object file, clean up
(let ((new-env (sublet cur-env 'init_func (string->symbol init-name))))
(format *stderr* "loading ~A~%" so-file-name)
(load so-file-name new-env)))))



;;; backwards compatibility
(define define-c-function c-define)


#|
(let ((cd (symbol "complex double"))
(cd* (symbol "complex double *")))
(c-define (list cd 'mus_edot_product (list cd cd* 'int))))

;complex double mus_edot_product(complex double freq, complex double *data, mus_long_t size)
|#

+ 1497
- 0
lib/sndlib/config.guess
File diff suppressed because it is too large
View File


+ 1608
- 0
lib/sndlib/config.sub
File diff suppressed because it is too large
View File


+ 5651
- 0
lib/sndlib/configure
File diff suppressed because it is too large
View File


+ 395
- 0
lib/sndlib/configure.ac View File

@@ -0,0 +1,395 @@
# Configuration script for sndlib (taken from Snd)

AC_INIT(sndlib, 22, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/sndlib.tar.gz)
SNDLIB_VERSION=22
AC_CONFIG_SRCDIR(io.c)
AC_CANONICAL_HOST
AC_CONFIG_FILES(makefile)
AC_CONFIG_FILES(sndlib.pc)
AC_CONFIG_FILES(sndins/Makefile)
AC_CONFIG_HEADERS(unix-config.h)
AC_CONFIG_FILES(sndlib-config, [chmod +x sndlib-config])

AC_PROG_CC
# AC_HEADER_STDC
AC_PROG_INSTALL

AC_C_BIGENDIAN
AC_CHECK_SIZEOF(void *)
AC_PATH_PROG(PKG_CONFIG, pkg-config, no)


#--------------------------------------------------------------------------------
# configuration options
# --disable-shared don't try to make a .so file
# --with-alsa use ALSA if possible
# --with-audio without-audio to stub out all audio
# --with-forth use Forth as extension language
# --with-gsl include GSL
# --with-jack use Jack
# --with-oss use OSS if possible
# --with-portaudio use portaudio
# --with-ruby use Ruby as the extension language
# --with-s7 use S7 as the extension language (default = yes)
#--------------------------------------------------------------------------------

AC_ARG_ENABLE(shared, [ --disable_shared don't build or install the shared library])
AC_ARG_WITH(alsa, [ --with-alsa use ALSA])
AC_ARG_WITH(audio, [ --without-audio don't include any audio functionality])
AC_ARG_WITH(forth, [ --with-forth use Forth as the extension language])
AC_ARG_WITH(gsl, [ --with-gsl use GSL, default=yes])
AC_ARG_WITH(jack, [ --with-jack use JACK])
AC_ARG_WITH(oss, [ --with-oss use OSS])
AC_ARG_WITH(portaudio, [ --with-portaudio use portaudio, default=no])
AC_ARG_WITH(ruby, [ --with-ruby use Ruby as the extension language])
AC_ARG_WITH(s7, [ --with-s7 use s7, default=yes])


AUDIO_SYSTEM="None"
LIBS=""


#--------------------------------------------------------------------------------
# GSL
#--------------------------------------------------------------------------------

GSL_LIBS=""
GSL_CFLAGS=""
if test "$with_gsl" != no; then
AC_MSG_CHECKING(for gsl)
if test x$PKG_CONFIG != xno ; then
if $PKG_CONFIG gsl --exists ; then
GSL_LIBS="`$PKG_CONFIG gsl --libs`"
GSL_CFLAGS="`$PKG_CONFIG gsl --cflags`"
AC_DEFINE(HAVE_GSL)
OPTIONAL_LIBRARIES="$OPTIONAL_LIBRARIES gsl"
AC_MSG_RESULT(yes)
else
AC_MSG_RESULT(no)
fi
fi
fi
AC_SUBST(GSL_LIBS)
AC_SUBST(GSL_CFLAGS)


#--------------------------------------------------------------------------------
# language
#--------------------------------------------------------------------------------

# language choice: ruby if --with-ruby and we can find one of ruby-2.0.pc, ruby-1.9.pc, or ruby-1.8.pc
# forth if --with-forth
# none if --without-extension-language
# s7 otherwise

XEN_LIBS=""
XEN_CFLAGS=""
ac_snd_extension_language=none
SNDLIB_LANGUAGE="None"


#--------------------------------------------------------------------------------
# Ruby
#--------------------------------------------------------------------------------

if test "$with_ruby" = yes ; then
if test x$PKG_CONFIG != xno ; then
m4_foreach([ruby_version], [[ruby-2.1], [ruby-2.0], [ruby], [ruby-1.9.3], [ruby-1.9], [ruby-1.8]],
[
if test "$ac_snd_extension_language" = none ; then
if $PKG_CONFIG ruby_version --exists ; then
AC_DEFINE(HAVE_RUBY)
XEN_CFLAGS="`$PKG_CONFIG ruby_version --cflags`"
XEN_LIBS="`$PKG_CONFIG ruby_version --libs`"
LOCAL_LANGUAGE="Ruby"
ac_snd_extension_language=Ruby
fi
fi
])
fi
fi


#--------------------------------------------------------------------------------
# Forth
#--------------------------------------------------------------------------------

if test "$with_forth" = yes ; then
AC_PATH_PROG([FTH], [fth], [no])
AC_MSG_CHECKING([for Forth])
if test "${FTH}" != no ; then
XEN_CFLAGS=`${FTH} --no-init-file --eval .cflags`
XEN_LIBS=`${FTH} --no-init-file --eval .libs`
AC_MSG_RESULT([yes])
AC_DEFINE(HAVE_FORTH)
ac_snd_extension_language=Forth
SNDLIB_LANGUAGE="Forth"
else
AC_MSG_RESULT([no])
fi
fi


#--------------------------------------------------------------------------------
# s7 (the default)
#--------------------------------------------------------------------------------

if test "$with_s7" != no && test "$ac_snd_extension_language" = none ; then
AC_DEFINE(HAVE_SCHEME)
ac_snd_extension_language=s7
SNDLIB_LANGUAGE="s7"
S7_LIB="s7.o"
AC_SUBST(S7_LIB)
fi

AC_SUBST(XEN_LIBS)
AC_SUBST(XEN_CFLAGS)



#--------------------------------------------------------------------------------
# Audio library
#--------------------------------------------------------------------------------

AUDIO_LIB=""
JACK_LIBS=""
JACK_FLAGS=""

if test "$with_audio" != no ; then

if test "$with_pulseaudio" = yes ; then
AC_DEFINE(MUS_PULSEAUDIO)
AUDIO_LIB="-lpulse-simple"
AUDIO_SYSTEM=pulseaudio
fi
if test "$with_portaudio" = yes ; then
AC_DEFINE(MUS_PORTAUDIO)
AUDIO_SYSTEM=portaudio
AUDIO_LIB="-lportaudio"
fi

if test "$with_jack" = yes ; then
AUDIO_SYSTEM=JACK
AC_DEFINE(MUS_JACK)
if test x$PKG_CONFIG != xno ; then
if $PKG_CONFIG jack --exists ; then
JACK_LIBS="`$PKG_CONFIG jack --libs`"
JACK_FLAGS="`$PKG_CONFIG jack --cflags`"
if $PKG_CONFIG samplerate --exists ; then
JACK_LIBS="$JACK_LIBS `$PKG_CONFIG samplerate --libs`"
JACK_FLAGS="$JACK_FLAGS `$PKG_CONFIG samplerate --cflags`"
else
JACK_LIBS="$JACK_LIBS -lsamplerate"
fi
else
JACK_LIBS="-ljack -lsamplerate"
fi
else
JACK_LIBS="-ljack -lsamplerate"
fi
fi

if test "$with_alsa" = yes ; then
AC_DEFINE(HAVE_ALSA)
AUDIO_LIB="-lasound"
AUDIO_SYSTEM=ALSA
fi

if test "$with_oss" = yes ; then
AC_DEFINE(HAVE_OSS)
AUDIO_SYSTEM=OSS
fi

if test "$AUDIO_SYSTEM" = None ; then
case "$host" in
*-*-linux*)
AUDIO_SYSTEM=ALSA
AC_DEFINE(HAVE_ALSA)
AUDIO_LIB="-lasound"
;;
*-*-sunos4*)
AUDIO_SYSTEM=Sun
;;
*-*-solaris*)
AUDIO_SYSTEM=Sun
;;
*-*-hpux*)
AUDIO_SYSTEM=Hpux
;;
*-*-bsdi*)
AC_DEFINE(HAVE_OSS)
AUDIO_SYSTEM=OSS
;;
*-*-freebsd*)
AC_DEFINE(HAVE_OSS)
AUDIO_SYSTEM=OSS
;;
*-*-openbsd*)
AUDIO_SYSTEM=OpenBSD
;;
*-*-netbsd*)
AUDIO_SYSTEM=NetBSD
;;
*-*-cygwin*)
if test "$with_jack" != yes ; then
AUDIO_SYSTEM=Windows
fi
;;
*-*-mingw*)
audio_system=Windows
;;
*-apple-*)
if test "$with_jack" != yes ; then
AUDIO_SYSTEM=MacOSX
AUDIO_LIB="-framework CoreAudio -framework CoreFoundation -framework CoreMIDI"
else
AUDIO_SYSTEM=JACK
JACK_LIBS="-framework CoreAudio -framework CoreServices -framework AudioUnit -L/usr/local/lib -ljack -lsamplerate"
JACK_FLAGS="-I/usr/local/include"
fi
;;
esac
fi
fi

AC_MSG_CHECKING([for audio system])
AC_MSG_RESULT($AUDIO_SYSTEM)

if test "$AUDIO_SYSTEM" != None ; then
AC_DEFINE(WITH_AUDIO)
fi


AC_SUBST(AUDIO_LIB)
AC_SUBST(JACK_LIBS)
AC_SUBST(JACK_FLAGS)


#--------------------------------------------------------------------------------
# compiler/loader flags
#--------------------------------------------------------------------------------

LDSO_FLAGS=""
SO_FLAGS=""
SO_LD="ld"
SO_INSTALL="install"
A_INSTALL="install"
# A_LD="ld"
# A_LD_FLAGS=""
A_LD="ar"
A_LD_FLAGS="-rc"
SO_NAME="libsndlib.so"
RANLIB=":"
LD_FLAGS="-r"

case "$host" in
*-*-linux*)
LDSO_FLAGS="-shared"
LIBS="$LIBS -lm -ldl"
if test "$GCC" = yes ; then
SO_FLAGS="-fPIC $SO_FLAGS"
SO_LD="$CC"
fi
if test "$with_jack" = yes ; then
A_INSTALL=":"
A_LD=":"
fi
;;

*-*-sunos4*)
LIBS="$LIBS -lm"
;;

*-*-solaris*)
LIBS="$LIBS -lm"
LDSO_FLAGS="-G"
;;

*-*-hpux*)
LDSO_FLAGS="+z -Ae +DA1.1"
if test "$GCC" = yes ; then
SO_FLAGS="-fPIC $SO_FLAGS"
fi
;;

*-*-bsdi*)
LIBS="$LIBS -lm"
if test "$GCC" = yes ; then
SO_FLAGS="-fPIC $SO_FLAGS"
fi
;;

*-*-freebsd*)
LIBS="$LIBS -lm"
if test "$GCC" = yes ; then
SO_LD="$CC"
SO_FLAGS="-fPIC $SO_FLAGS"
LDSO_FLAGS="-shared"
fi
;;

*-*-openbsd*)
LIBS="$LIBS -lm"
if test "$GCC" = yes ; then
SO_LD="$CC"
SO_FLAGS="-fPIC $SO_FLAGS"
CFLAGS="-ftrampolines $CFLAGS"
LDSO_FLAGS="-shared"
fi
;;

*-*-netbsd*)
LIBS="$LIBS -lm"
if test "$GCC" = yes ; then
SO_LD="$CC"
SO_FLAGS="-fPIC $SO_FLAGS"
LDSO_FLAGS="-shared"
fi
;;

*-*-cygwin*)
A_LD_FLAGS="-rc"
SO_INSTALL=":"
SO_LD=":"
;;

*-*-mingw*)
LIBS="$LIBS -lwinmm -lwsock32"
LDFLAGS="$LDFLAGS -mwindows"
SO_INSTALL=":"
SO_LD=":"
;;

*-apple-*)
SO_LD="$CC"
LDSO_FLAGS="-dynamic -bundle -undefined suppress -flat_namespace"
;;
esac

if test "$enable_shared" = no; then
SO_LD=":"
SO_INSTALL=":"
fi

AUDIO_CHOICE="$AUDIO_SYSTEM"
CFLAGS="-I. $CFLAGS"

AC_SUBST(LDSO_FLAGS)
AC_SUBST(SO_FLAGS)
AC_SUBST(SO_INSTALL)
AC_SUBST(A_INSTALL)
AC_SUBST(SO_LD)
AC_SUBST(A_LD)
AC_SUBST(A_LD_FLAGS)
AC_SUBST(LD_FLAGS)
AC_SUBST(SNDLIB_VERSION)
AC_SUBST(SNDLIB_LANGUAGE)
AC_SUBST(SO_NAME)
AC_SUBST(JACK_LIBS)
AC_SUBST(JACK_FLAGS)
AC_SUBST(RANLIB)
AC_SUBST(AUDIO_CHOICE)

AC_OUTPUT


+ 2938
- 0
lib/sndlib/dlocsig.rb
File diff suppressed because it is too large
View File


+ 3120
- 0
lib/sndlib/dlocsig.scm
File diff suppressed because it is too large
View File


+ 2798
- 0
lib/sndlib/dsp.scm
File diff suppressed because it is too large
View File


+ 562
- 0
lib/sndlib/env.scm View File

@@ -0,0 +1,562 @@
;;; various envelope functions
;;;
;;; window-envelope (beg end env) -> portion of env lying between x axis values beg and end
;;; map-envelopes (func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope
;;; multiply-envelopes (env1 env2) multiplies break-points of env1 and env2 returning a new envelope
;;; add-envelopes (env1 env2) adds break-points of env1 and env2 returning a new envelope
;;; max-envelope (env) -> max y value in env, min-envelope
;;; integrate-envelope (env) -> area under env
;;; envelope-last-x (env) -> max x axis break point position
;;; stretch-envelope env old-attack new-attack old-decay new-decay -> divseg-like envelope mangler
;;; scale-envelope (env scaler offset) scales y axis values by 'scaler' and optionally adds 'offset'
;;; reverse-envelope (env) reverses the breakpoints in 'env'
;;; concatenate-envelopes (:rest envs) concatenates its arguments into a new envelope
;;; repeat-envelope env repeats (reflected #f) (normalized #f) repeats an envelope
;;; power-env: generator for extended envelopes (each segment has its own base)
;;; envelope-exp: interpolate segments into envelope to give exponential curves
;;; rms-envelope
;;; normalize-envelope
;;; simplify-envelope

(provide 'snd-env.scm)


;;; -------- window-envelope (a kinda brute-force translation from the CL version in env.lisp)

(define window-envelope
(let ((documentation "(window-envelope beg end e) -> portion of e lying between x axis values beg and
end: (window-envelope 1.0 3.0 '(0.0 0.0 5.0 1.0)) -> '(1.0 0.2 3.0 0.6)"))
(lambda (beg end e)
(let ((nenv ())
(lasty (if (pair? e) (cadr e) 0.0))
(len (length e)))
(call-with-exit
(lambda (return-early)
(do ((i 0 (+ i 2)))
((>= i len))
(let ((x (e i))
(y (e (+ i 1))))
(set! lasty y)
(cond ((null? nenv)
(when (>= x beg)
(set! nenv (append nenv (list beg (envelope-interp beg e))))
(if (not (= x beg))
(if (>= x end)
(return-early (append nenv (list end (envelope-interp end e))))
(set! nenv (append nenv (list x y)))))))
((<= x end)
(set! nenv (append nenv (list x y)))
(if (= x end) (return-early nenv)))
((> x end)
(return-early
(append nenv (list end (envelope-interp end e))))))))
(append nenv (list end lasty))))))))


;;; -------- map-envelopes like map-across-envelopes in env.lisp

(define map-envelopes
(let ((documentation "(map-envelopes func env1 env2) maps func over the breakpoints in env1 and env2 returning a new envelope"))
(lambda (op e1 e2)
(let ((xs ()))
(let ((at0
(lambda (e)
(let* ((diff (car e))
(len (length e))
(lastx (e (- len 2)))
(newe (copy e)))
(do ((i 0 (+ i 2)))
((>= i len) newe)
(let ((x (/ (- (newe i) diff) lastx)))
(set! xs (cons x xs))
(set! (newe i) x))))))
(remove-duplicates
(lambda (lst)
(let rem-dup ((lst lst)
(nlst ()))
(cond ((null? lst) nlst)
((member (car lst) nlst) (rem-dup (cdr lst) nlst))
(else (rem-dup (cdr lst) (cons (car lst) nlst))))))))
(if (null? e1)
(at0 e2)
(if (null? e2)
(at0 e1)
(let ((ee1 (at0 e1))
(ee2 (at0 e2))
(newe ()))
(set! xs (sort! (remove-duplicates xs) <))
(do ((len (length xs))
(i 0 (+ i 1)))
((= i len) newe)
(let ((x (xs i)))
(set! newe (append newe (list x (op (envelope-interp x ee1) (envelope-interp x ee2)))))))))))))))


;;; -------- multiply-envelopes, add-envelopes

(define multiply-envelopes
(let ((documentation "(multiply-envelopes env1 env2) multiplies break-points of env1 and env2 returning a new
envelope: (multiply-envelopes '(0 0 2 .5) '(0 0 1 2 2 1)) -> '(0 0 0.5 0.5 1.0 0.5)"))
(lambda (e1 e2)
(map-envelopes * e1 e2))))

(define add-envelopes
(let ((documentation "(add-envelopes env1 env2) adds break-points of env1 and env2 returning a new envelope"))
(lambda (e1 e2)
(map-envelopes + e1 e2))))


;;; -------- max-envelope

(define max-envelope
(let ((documentation "(max-envelope env) -> max y value in env"))
(lambda (env1)
(let max-envelope-1 ((e (cddr env1))
(mx (cadr env1)))
(if (null? e)
mx
(max-envelope-1 (cddr e) (max mx (cadr e))))))))

;;; -------- min-envelope

(define min-envelope
(let ((documentation "(min-envelope env) -> min y value in env"))
(lambda (env1)
(let min-envelope-1 ((e (cddr env1))
(mx (cadr env1)))
(if (null? e)
mx
(min-envelope-1 (cddr e) (min mx (cadr e))))))))

;;; -------- integrate-envelope

(define integrate-envelope
(let ((documentation "(integrate-envelope env) -> area under env"))
(lambda (env1)
(let integrate-envelope-1 ((e env1)
(sum 0.0000))
(if (or (null? e) (null? (cddr e)))
sum
(integrate-envelope-1 (cddr e) (+ sum (* (+ (cadr e) (cadddr e)) 0.5 (- (caddr e) (car e))))))))))

;;; -------- envelope-last-x

(define envelope-last-x
(let ((documentation "(envelope-last-x env) -> max x axis break point position"))
(lambda (e)
(if (null? (cddr e))
(car e)
(envelope-last-x (cddr e))))))


;;; -------- stretch-envelope

(define stretch-envelope
(let ((documentation "(stretch-envelope env old-attack new-attack old-decay new-decay) takes 'env' and
returns a new envelope based on it but with the attack and optionally decay portions stretched
or squeezed; 'old-attack' is the original x axis attack end point, 'new-attack' is where that
section should end in the new envelope. Similarly for 'old-decay' and 'new-decay'. This mimics
divseg in early versions of CLM and its antecedents in Sambox and Mus10 (linen).
(stretch-envelope '(0 0 1 1) .1 .2) -> (0 0 0.2 0.1 1.0 1)
(stretch-envelope '(0 0 1 1 2 0) .1 .2 1.5 1.6) -> (0 0 0.2 0.1 1.1 1 1.6 0.5 2.0 0)"))
(lambda* (fn old-att new-att old-dec new-dec)
(cond ((not new-att)
(if old-att
(error 'wrong-number-of-args "stretch-envelope: ~A, old-attack but no new-attack?" old-att)
fn))
((and old-dec (not new-dec))
(error 'wrong-number-of-args "stretch-envelope:~A ~A ~A, old-decay but no new-decay?" old-att new-att old-dec))
(else
(let ((x0 (car fn))
(y0 (cadr fn)))
(let ((new-x x0)
(last-x (fn (- (length fn) 2)))
(new-fn (list y0 x0))
(scl (/ (- new-att x0) (max .0001 (- old-att x0)))))
(if (and (number? old-dec)
(= old-dec old-att))
(set! old-dec (* 1e-06 last-x)))
(reverse
(let stretch-envelope-1 ((new-fn new-fn)
(old-fn (cddr fn)))
(if (null? old-fn)
new-fn
(let ((x1 (car old-fn))
(y1 (cadr old-fn)))
(when (and (< x0 old-att) (>= x1 old-att))
(set! y0 (if (= x1 old-att)
y1
(+ y0 (* (- y1 y0) (/ (- old-att x0) (- x1 x0))))))
(set! x0 old-att)
(set! new-x new-att)
(set! new-fn (cons y0 (cons new-x new-fn)))
(set! scl (if old-dec
(/ (- new-dec new-att) (- old-dec old-att))
(/ (- last-x new-att) (- last-x old-att)))))
(when (and (real? old-dec)
(< x0 old-dec)
(>= x1 old-dec))
(set! y0 (if (= x1 old-dec)
y1
(+ y0 (* (- y1 y0) (/ (- old-dec x0) (- x1 x0))))))
(set! x0 old-dec)
(set! new-x new-dec)
(set! new-fn (cons y0 (cons new-x new-fn)))
(set! scl (/ (- last-x new-dec) (- last-x old-dec))))
(unless (= x0 x1)
(set! new-x (+ new-x (* scl (- x1 x0))))
(set! new-fn (cons y1 (cons new-x new-fn)))
(set! x0 x1)
(set! y0 y1))
(stretch-envelope-1 new-fn (cddr old-fn)))))))))))))

;;; -------- scale-envelope

(define scale-envelope
(let ((documentation "(scale-envelope env scaler (offset 0)) scales y axis values by 'scaler' and optionally adds 'offset'"))
(lambda* (e scl (offset 0))
(if (null? e)
()
(cons (car e) (cons (+ offset (* scl (cadr e))) (scale-envelope (cddr e) scl offset)))))))


;;; -------- reverse-envelope

(define reverse-envelope
(let ((documentation "(reverse-envelope env) reverses the breakpoints in 'env'"))
(lambda (e)
(define (reverse-env-1 e newe xd)
(if (null? e)
newe
(reverse-env-1 (cddr e)
(cons (- xd (car e))
(cons (cadr e)
newe))
xd)))
(let ((len (length e)))
(if (memv len '(0 2))
e
(reverse-env-1 e () (e (- len 2))))))))


;;; -------- concatenate-envelopes

(define concatenate-envelopes
(let ((documentation "(concatenate-envelopes :rest envs) concatenates its arguments into a new envelope"))
(lambda envs
(define (cat-1 e newe xoff x0)
(if (null? e)
newe
(cat-1 (cddr e)
(cons (cadr e)
(cons (- (+ (car e) xoff) x0)
newe))
xoff
x0)))
(let ((ne ())
(xoff 0.0))
(for-each
(lambda (e)
(if (and (pair? ne)
(= (car ne) (cadr e)))
(begin
(set! xoff (- xoff .01))
(set! ne (cat-1 (cddr e) ne xoff (car e))))
(set! ne (cat-1 e ne xoff (car e))))
(set! xoff (+ xoff .01 (cadr ne))))
envs)
(reverse ne)))))


(define repeat-envelope
(let ((documentation "(repeat-envelope env repeats (reflected #f) (normalized #f)) repeats 'env' 'repeats'
times. (repeat-envelope '(0 0 100 1) 2) -> (0 0 100 1 101 0 201 1).
If the final y value is different from the first y value, a quick ramp is
inserted between repeats. 'normalized' causes the new envelope's x axis
to have the same extent as the original's. 'reflected' causes every other
repetition to be in reverse."))
(lambda* (ur-env repeats reflected normalized)
(let ((e (if (not reflected)
ur-env
(let ((lastx (ur-env (- (length ur-env) 2)))
(rev-env (cddr (reverse ur-env)))
(new-env (reverse ur-env)))
(while (pair? rev-env)
(set! new-env (cons (- (+ lastx lastx) (cadr rev-env)) new-env))
(set! new-env (cons (car rev-env) new-env))
(set! rev-env (cddr rev-env)))
(reverse new-env)))))
(let ((first-y (cadr e))
(x (car e)))
(let ((x-max (e (- (length e) 2)))
(new-env (list first-y x)))
(let ((len (length e))
(times (if reflected (floor (/ repeats 2)) repeats))
(first-y-is-last-y (= first-y (e (- (length e) 1)))))
(do ((i 0 (+ i 1)))
((= i times))
(do ((j 2 (+ j 2)))
((>= j len))
(set! x (- (+ x (e j)) (e (- j 2))))
(set! new-env (cons (e (+ j 1)) (cons x new-env))))
(if (and (< i (- times 1)) (not first-y-is-last-y))
(begin
(set! x (+ x (/ x-max 100.0)))
(set! new-env (cons first-y (cons x new-env)))))))
(set! new-env (reverse new-env))
(if normalized
(do ((scl (/ x-max x))
(new-len (length new-env))
(i 0 (+ i 2)))
((>= i new-len))
(set! (new-env i) (* scl (new-env i)))))
new-env))))))


;;; -------- power-env
;;;
;;; (this could also be done using multi-expt-env (based on env-any) in generators.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

;;; (define pe (make-power-env '(0 0 1 1 2 0) :duration 1.0))
;;; :(power-env pe)
;;; 0.0
;;; :(power-env pe)
;;; 4.5352502324316e-05
;;; :(power-env pe)
;;; 9.0705004648631e-05
;;; :(power-env pe)
;;; 0.00013605750697295


(defgenerator penv (envs #f) (total-envs 0) (current-env 0) (current-pass 0))

(define (power-env pe)
(with-let pe
(let ((val (env (vector-ref envs current-env))))
(set! current-pass (- current-pass 1))
(when (and (= current-pass 0)
(< current-env (- total-envs 1)))
(set! current-env (+ current-env 1))
(set! current-pass (- (length (vector-ref envs current-env)) 1)))
val)))

(define* (make-power-env envelope (scaler 1.0) (offset 0.0) duration)
(let* ((len (- (floor (/ (length envelope) 3)) 1))
(pe (make-penv :envs (make-vector len)
:total-envs len
:current-env 0
:current-pass 0))
(xext (- (envelope (- (length envelope) 3)) (car envelope))))
(do ((i 0 (+ i 1))
(j 0 (+ j 3)))
((= i len))
(let ((x0 (envelope j))
(x1 (envelope (+ j 3)))
(y0 (envelope (+ j 1)))
(y1 (envelope (+ j 4)))
(base (envelope (+ j 2))))
(vector-set! (pe 'envs) i (make-env (list 0.0 y0 1.0 y1)
:base base :scaler scaler :offset offset
:duration (* duration (/ (- x1 x0) xext))))))
(set! (pe 'current-pass) (- (length (vector-ref (pe 'envs) 0)) 1))
pe))

(define* (power-env-channel pe (beg 0) snd chn edpos (edname "power-env-channel"))
;; split into successive calls on env-channel
(let ((curbeg beg)) ; sample number
(as-one-edit
(lambda ()
(do ((i 0 (+ i 1)))
((= i (pe 'total-envs)))
(let* ((e (vector-ref (pe 'envs) i))
(len (length e)))
(env-channel e curbeg len snd chn edpos)
(set! curbeg (+ curbeg len)))))
edname)))


;;; here's a simpler version that takes the breakpoint list, rather than the power-env structure:

(define powenv-channel
(let ((documentation "(powenv-channel envelope (beg 0) dur snd chn edpos) returns an envelope with a separate base for \
each segment: (powenv-channel '(0 0 .325 1 1 32.0 2 0 32.0))"))
(lambda* (envelope (beg 0) dur snd chn edpos)
(let ((len (length envelope))
(x1 (car envelope)))
(let ((curbeg beg)
(fulldur (or dur (framples snd chn edpos)))
(xrange (- (envelope (- len 3)) x1))
(y1 (cadr envelope))
(base (caddr envelope))
(x0 0.0)
(y0 0.0))
(if (= len 3)
(scale-channel y1 beg dur snd chn edpos)
(as-one-edit
(lambda ()
(do ((i 3 (+ i 3)))
((= i len))
(set! x0 x1)
(set! y0 y1)
(set! x1 (envelope i))
(set! y1 (envelope (+ i 1)))
(let ((curdur (round (* fulldur (/ (- x1 x0) xrange)))))
(xramp-channel y0 y1 base curbeg curdur snd chn edpos)
(set! curbeg (+ curbeg curdur)))
(set! base (envelope (+ i 2))))))))))))

;;; by Anders Vinjar:
;;;
;;; envelope-exp can be used to create exponential segments to include in
;;; envelopes. Given 2 or more breakpoints, it approximates the
;;; curve between them using 'xgrid linesegments and 'power as the
;;; exponent.
;;;
;;; env is a list of x-y-breakpoint-pairs,
;;; power applies to whole envelope,
;;; xgrid is how fine a solution to sample our new envelope with.

(define envelope-exp
(let ((documentation "(envelope-exp e (power 1.0) (xgrid 100)) approximates an exponential curve connecting the breakpoints"))
(lambda* (e (power 1.0) (xgrid 100))
(let ((mn (min-envelope e)))
(let ((largest-diff (* 1.0 (- (max-envelope e) mn)))
(x-min (car e))
(x-max (e (- (length e) 2))))
(do ((x-incr (* 1.0 (/ (- x-max x-min) xgrid)))
(new-e ())
(x x-min (+ x x-incr)))
((>= x x-max)
(reverse new-e))
(let ((y (envelope-interp x e)))
(set! new-e (cons (if (= largest-diff 0.0)
y
(+ mn
(* largest-diff
(expt (/ (- y mn) largest-diff) power))))
(cons x new-e))))))))))

;;; rms-envelope

(define rms-envelope
(let ((documentation "(rms-envelope file (beg 0.0) (dur #f) (rfreq 30.0) (db #f)) returns an envelope of RMS values in 'file'"))
(lambda* (file (beg 0.0) dur (rfreq 30.0) db)
;; based on rmsenv.ins by Bret Battey
(let* ((fsr (srate file))
(start (round (* beg fsr)))
(end (if dur (min (* 1.0 (+ start (round (* fsr dur))))
(mus-sound-framples file))
(mus-sound-framples file))))
(let ((incrsamps (round (/ fsr rfreq)))
(len (- (+ end 1) start)))
(let ((reader (make-sampler start file))
(rms (make-moving-average incrsamps)) ; this could use make-moving-rms from dsp.scm
(e ())
(rms-val 0.0)
(jend 0)
(data (make-float-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
(float-vector-set! data i (next-sample reader)))
(float-vector-multiply! data data)
(do ((i 0 (+ i incrsamps)))
((>= i end)
(reverse e))
(set! jend (min end (+ i incrsamps)))
(do ((j i (+ j 1)))
((= j jend))
(moving-average rms (float-vector-ref data j)))
(set! e (cons (* 1.0 (/ i fsr)) e))
(set! rms-val (sqrt (* (mus-scaler rms) (mus-increment rms))))
(set! e (cons (if db
(if (< rms-val 1e-05) -100.0 (* 20.0 (log rms-val 10.0)))
rms-val)
e)))))))))
(define* (normalize-envelope env1 (new-max 1.0))
(scale-envelope env1
(/ new-max
(let abs-max-envelope-1 ((e (cddr env1))
(mx (abs (cadr env1))))
(if (null? e)
mx
(abs-max-envelope-1 (cddr e) (max mx (abs (cadr e)))))))))


;;; simplify-envelope
;;;
;;; this is not very good...

(define* (simplify-envelope env1 (ygrid 10) (xgrid 100))
;; grid = how fine a fluctuation we will allow.
;; the smaller the grid, the less likely a given bump will get through
;; original x and y values are not changed, just sometimes omitted.
(define (point-on-line? px py qx qy tx ty)
;; is point tx ty on line defined by px py and qx qy --
;; #f if no, :before if on ray from p, :after if on ray from q, :within if between p and q
;; (these are looking at the "line" as a fat vector drawn on a grid)
;; taken from "Graphics Gems" by Glassner, code by A Paeth
(if (or (= py qy ty)
(= px qx tx))
:within
(and (< (abs (- (* (- qy py) (- tx px))
(* (- ty py) (- qx px))))
(max (abs (- qx px))
(abs (- qy py))))
(if (or (< qx px tx) (< qy py ty) (< tx px qx) (< ty py qy))
:before
(if (or (< px qx tx) (< py qy ty) (< tx qx px) (< ty qy py))
:after
:within)))))
(if (not (and env1
(> (length env1) 4)))
env1
(let ((new-env (list (cadr env1) (car env1)))
(ymax (max-envelope env1))
(ymin (min-envelope env1))
(xmax (env1 (- (length env1) 2)))
(xmin (car env1)))
(if (= ymin ymax)
(list xmin ymin xmax ymax)
(do ((y-scl (/ ygrid (- ymax ymin)))
(x-scl (/ (or xgrid ygrid) (- xmax xmin)))
(px #f) (py #f)
(qx #f) (qy #f)
(tx #f) (ty #f)
(qtx #f) (qty #f)
(i 0 (+ i 2)))
((>= i (length env1))
(set! new-env (cons qty (cons qtx new-env)))
(reverse new-env))
(let ((ttx (env1 i))
(tty (env1 (+ i 1))))
(set! tx (round (* ttx x-scl)))
(set! ty (round (* tty y-scl)))
(if px
(if (not (point-on-line? px py qx qy tx ty))
(begin
(set! new-env (cons qty (cons qtx new-env)))
(set! px qx)
(set! py qy)))
(begin
(set! px qx)
(set! py qy)))
(set! qx tx)
(set! qy ty)
(set! qtx ttx)
(set! qty tty)))))))

+ 345
- 0
lib/sndlib/expandn.scm View File

@@ -0,0 +1,345 @@
;;; multi-channel sound file expansion with srate and reverb.
;;; michael klingbeil (michael@klingbeil.com)
;;;
;;; $Name: $
;;; $Revision: 1.1 $
;;; $Date: 2005/10/16 22:15:44 $
;;;
;;; clm-4 and scheme May-08 bil
;;; split out cases to optimize May-09 bil

(provide 'snd-expandn.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))
(require snd-env.scm)


(definstrument (expandn time duration filename amplitude
(expand 1.0)
matrix
(ramp 0.4)
(seglen 0.15)
(srate 1.0)
(hop .05)
(amp-env '(0 0 50 1 100 0))
(input-start 0.0)
(grain-amp 0.8)
reverb)

(let ((fnam (file-name filename)))
(if (not (file-exists? fnam))
(error 'no-such-file (list 'expandn filename))

(let* ((beg (seconds->samples time))
(end (+ beg (seconds->samples duration)))
(min-exp-amt (if (pair? expand) (min-envelope expand) expand))
(max-out-hop (if (pair? hop) (max-envelope hop) hop)))
(let ((in-chans (channels fnam))
(out-chans (channels *output*))
(rev-chans (if *reverb* (channels *reverb*) 0)))
(let ((update-rate 100)
(ochans (max in-chans out-chans))
(max-seg-len (if (pair? seglen) (max-envelope seglen) seglen))
(rampdata (if (pair? ramp) ramp (list 0 ramp 1 ramp)))
(start (floor (* input-start (mus-sound-srate fnam))))
(max-in-hop (/ max-out-hop min-exp-amt))
(rev-mx (and *reverb* (real? reverb) (> reverb 0.0)
(let* ((rchans (max out-chans rev-chans))
(rmx (make-float-vector (list rchans rchans))))
(do ((i 0 (+ i 1)))
((= i rchans))
(set! (rmx i i) reverb))
rmx))))
(let ((mx (let ((v (make-float-vector (list ochans ochans))))
(if (pair? matrix)
(let ((mat-in (min ochans (length matrix)))
(mat-out (min ochans (length (car matrix)))))
(do ((inp 0 (+ inp 1)))
((= inp mat-in))
(do ((outp 0 (+ outp 1)))
((= outp mat-out))
(set! (v inp outp) (matrix inp outp)))))
(do ((i 0 (+ i 1)))
((= i ochans))
(set! (v i i) 1.0)))
v))
(revvals (and rev-mx (make-float-vector (max out-chans rev-chans))))
(update-envs (or (pair? expand)
(pair? seglen)
(pair? ramp)
(pair? hop)))
(update-ctr 0)
(expenv (make-env (if (pair? expand) expand (list 0 expand 1 expand))
:duration (/ duration update-rate)))
(lenenv (make-env (if (pair? seglen) seglen (list 0 seglen 1 seglen))
:duration (/ duration update-rate)))
(segment-scaler (if (> max-seg-len .15)
(/ (* grain-amp .15) max-seg-len)
grain-amp))
(srenv (make-env (if (pair? srate) srate (list 0 srate)) :duration duration))
(rampenv (make-env rampdata :duration (/ duration update-rate)))
(minramp-bug (<= (min-envelope rampdata) 0.0))
(maxramp-bug (>= (max-envelope rampdata) 0.5))
(hopenv (make-env (if (pair? hop) hop (list 0 hop 1 hop))
:duration (/ duration update-rate)))
(ampenv (make-env amp-env :duration duration :scaler amplitude))
(ex-array (make-vector in-chans #f))
(ex-samp -1.0)
(next-samp 0.0)
(max-len (ceiling (* *clm-srate*
(+ (max max-out-hop max-in-hop)
max-seg-len))))
(invals (make-float-vector ochans))
(outvals (make-float-vector ochans)))
(if (or minramp-bug maxramp-bug)
(error 'out-of-range (list expand
"ramp argument to expandn must always be "
(if (and minramp-bug maxramp-bug) "between 0.0 and 0.5"
(if minramp-bug "greater than 0.0"
"less than 0.5")))))
;; setup granulate generators
(do ((i 0 (+ i 1)))
((= i in-chans))
(vector-set! ex-array i (make-granulate :input (make-readin fnam :start start :channel i)
:expansion (if (pair? expand) (cadr expand) expand)
:max-size max-len
:ramp (if (pair? ramp) (cadr ramp) ramp)
:hop (if (pair? hop) (cadr hop) hop)
:length (if (pair? seglen) (cadr seglen) seglen)
:scaler segment-scaler)))
;; split out 1 and 2 chan input
(if (= in-chans 1)
(let ((ingen (vector-ref ex-array 0))
(sample-0 0.0)
(sample-1 0.0))
;; these vars used for resampling

(if (not (or (pair? srate)
update-envs
(not (= out-chans 1))
matrix
rev-mx))

(let ((file-end (+ beg (seconds->samples (+ (* 2 seglen)
(/ (* (mus-sound-duration fnam) (mus-sound-srate fnam) expand)
*clm-srate* srate))))))
(set! end (min end file-end))
(do ((i beg (+ i 1)))
((= i end))
(let ((vol (env ampenv)))
(if (negative? ex-samp)
(begin
(set! sample-0 (* vol (granulate ingen)))
(set! sample-1 (* vol (granulate ingen)))
(set! ex-samp (+ ex-samp 1))
(set! next-samp ex-samp)
(outa i sample-0))
(begin
(set! next-samp (+ next-samp srate))
(if (> next-samp (+ ex-samp 1))
(let ((samps (floor (- next-samp ex-samp))))
(if (= samps 2)
(begin
(set! sample-0 (* vol (granulate ingen)))
(set! sample-1 (* vol (granulate ingen))))
(do ((k 0 (+ k 1)))
((= k samps))
(set! sample-0 sample-1)
(set! sample-1 (* vol (granulate ingen)))))
(set! ex-samp (+ ex-samp samps))))
(if (= next-samp ex-samp)
(outa i (if (= next-samp ex-samp)
sample-0
(+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0)))))))))))
(do ((i beg (+ i 1)))
((= i end))
(let ((vol (env ampenv))
(resa (env srenv)))
(if update-envs
(begin
(set! update-ctr (+ update-ctr 1))
(if (>= update-ctr update-rate)
(let ((sl (floor (* (env lenenv) *clm-srate*))))
(set! update-ctr 0)
(set! (mus-length ingen) sl)
(set! (mus-ramp ingen) (floor (* sl (env rampenv))))
(set! (mus-frequency ingen) (env hopenv))
(set! (mus-increment ingen) (env expenv))))))
(if (negative? ex-samp)
(begin
(set! sample-0 (* vol (granulate ingen)))
(set! sample-1 (* vol (granulate ingen)))
(set! ex-samp (+ ex-samp 1))
(set! next-samp ex-samp))
(begin
(set! next-samp (+ next-samp resa))
(if (> next-samp (+ ex-samp 1))
(let ((samps (floor (- next-samp ex-samp))))
(if (= samps 2)
(begin
(set! sample-0 (* vol (granulate ingen)))
(set! sample-1 (* vol (granulate ingen))))
(do ((k 0 (+ k 1)))
((= k samps))
(set! sample-0 sample-1)
(set! sample-1 (* vol (granulate ingen)))))
(set! ex-samp (+ ex-samp samps)))))))
(set! (invals 0) (if (= next-samp ex-samp)
sample-0 ; output actual samples
(+ sample-0 (* (- next-samp ex-samp) (- sample-1 sample-0))))) ; output interpolated samples
;; output mixed result
(frample->file *output* i (frample->frample mx invals ochans outvals ochans))
;; if reverb is turned on, output to the reverb streams
(if rev-mx
(frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans))))))
(if (= in-chans 2)
(let ((sample-0-0 0.0)
(sample-1-0 0.0)
(sample-0-1 0.0)
(sample-1-1 0.0)
(ingen0 (vector-ref ex-array 0))
(ingen1 (vector-ref ex-array 1)))
(do ((i beg (+ i 1)))
((= i end))
(let ((vol (env ampenv))
(resa (env srenv)))
(if update-envs
(begin
(set! update-ctr (+ update-ctr 1))
(if (>= update-ctr update-rate)
(let ((expa (env expenv)) ;current expansion amount
(segl (env lenenv)) ;current segment length
(rmpl (env rampenv)) ;current ramp length (0 to .5)
(hp (env hopenv))) ;current hop size
(let* ((sl (floor (* segl *clm-srate*)))
(rl (floor (* rmpl sl))))
(set! update-ctr 0)
(set! (mus-length ingen0) sl)
(set! (mus-ramp ingen0) rl)
(set! (mus-frequency ingen0) hp)
(set! (mus-increment ingen0) expa)
(set! (mus-length ingen1) sl)
(set! (mus-ramp ingen1) rl)
(set! (mus-frequency ingen1) hp)
(set! (mus-increment ingen1) expa))))))
(if (negative? ex-samp)
(begin
(set! sample-0-0 (* vol (granulate ingen0)))
(set! sample-1-0 (* vol (granulate ingen0)))
(set! sample-0-1 (* vol (granulate ingen1)))
(set! sample-1-1 (* vol (granulate ingen1)))
(set! ex-samp (+ ex-samp 1))
(set! next-samp ex-samp))
(begin
(set! next-samp (+ next-samp resa))
(if (> next-samp (+ ex-samp 1))
(let ((samps (floor (- next-samp ex-samp))))
(do ((k 0 (+ k 1)))
((= k samps))
(set! sample-0-0 sample-1-0)
(set! sample-1-0 (* vol (granulate ingen0)))
(set! sample-0-1 sample-1-1)
(set! sample-1-1 (* vol (granulate ingen1))))
(set! ex-samp (+ ex-samp samps)))))))
(if (= next-samp ex-samp)
;; output actual samples
(begin
(set! (invals 0) sample-0-0)
(set! (invals 1) sample-0-1))
(begin
;; output interpolated samples
(set! (invals 0) (+ sample-0-0 (* (- next-samp ex-samp) (- sample-1-0 sample-0-0))))
(set! (invals 1) (+ sample-0-1 (* (- next-samp ex-samp) (- sample-1-1 sample-0-1))))))
;; output mixed result
(frample->file *output* i (frample->frample mx invals ochans outvals ochans))
;; if reverb is turned on, output to the reverb streams
(if rev-mx
(frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans)))))
(let ((samples-0 (make-float-vector in-chans))
(samples-1 (make-float-vector in-chans)))
;; more than 2 chans in input file
(do ((i beg (+ i 1)))
((= i end))
(let ((vol (env ampenv))
(resa (env srenv)))
(if update-envs
(begin
(set! update-ctr (+ update-ctr 1))
(if (>= update-ctr update-rate)
(let ((expa (env expenv)) ;current expansion amount
(segl (env lenenv)) ;current segment length
(rmpl (env rampenv)) ;current ramp length (0 to .5)
(hp (env hopenv))) ;current hop size
(let* ((sl (floor (* segl *clm-srate*)))
(rl (floor (* rmpl sl))))
(set! update-ctr 0)
(do ((ix 0 (+ ix 1)))
((= ix in-chans))
(let ((gen (vector-ref ex-array ix)))
(set! (mus-length gen) sl)
(set! (mus-ramp gen) rl)
(set! (mus-frequency gen) hp)
(set! (mus-increment gen) expa))))))))
(if (negative? ex-samp)
(begin
(do ((ix 0 (+ ix 1)))
((= ix in-chans))
(let ((gen (vector-ref ex-array ix)))
(float-vector-set! samples-0 ix (* vol (granulate gen)))
(float-vector-set! samples-1 ix (* vol (granulate gen)))))
(set! ex-samp (+ ex-samp 1))
(set! next-samp ex-samp))
(begin
(set! next-samp (+ next-samp resa))
(if (> next-samp (+ ex-samp 1))
(let ((samps (floor (- next-samp ex-samp))))
(do ((k 0 (+ k 1)))
((= k samps))
(do ((ix 0 (+ ix 1)))
((= ix in-chans))
(let ((gen (vector-ref ex-array ix)))
(float-vector-set! samples-0 ix (float-vector-ref samples-1 ix))
(float-vector-set! samples-1 ix (* vol (granulate gen))))))
(set! ex-samp (+ ex-samp samps)))))))
(if (= next-samp ex-samp)
;; output actual samples
(copy samples-0 invals 0 in-chans)
;; output interpolated samples
(do ((ix 0 (+ ix 1)))
((= ix in-chans))
(let ((v0 (float-vector-ref samples-0 ix))
(v1 (float-vector-ref samples-1 ix)))
(float-vector-set! invals ix (+ v0 (* (- next-samp ex-samp) (- v1 v0)))))))
;; output mixed result
(frample->file *output* i (frample->frample mx invals ochans outvals ochans))
;; if reverb is turned on, output to the reverb streams
(if rev-mx
(frample->file *reverb* i (frample->frample rev-mx outvals ochans revvals rev-chans))))))))))))))

;;; (with-sound () (expandn 0 1 "oboe.snd" 1 :expand 4))

+ 281
- 0
lib/sndlib/fade.scm View File

@@ -0,0 +1,281 @@
;;; cross fade instruments
;;;
;;; cross-fade sweeps up, down, or from mid-spectrum outwards,
;;; dissolve-fade chooses randomly -- like a graphical dissolve
;;; neither is exactly spectacular, but they work -- use similar sounds if possible (speech is problematic)
;;;
;;; translated from fade.ins

(provide 'snd-fade.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(definstrument (cross-fade beg dur amp file1 file2 ramp-beg ramp-dur ramp-type bank-dur fs fwidth)
;; ramp-type 0=sweep up, 1=sweep down, 2=split from middle

(if (> (+ (max bank-dur ramp-beg) ramp-dur bank-dur) dur)
(begin
(set! ramp-beg (* 0.25 dur))
(set! ramp-dur (* dur 0.49))
(set! bank-dur (* dur 0.24))))
(let ((fil1 (make-sampler 0 file1))
(fil2 (make-sampler 0 file2))
(start (seconds->samples beg))
(ramp-samps (seconds->samples ramp-dur))
(bank-samps (seconds->samples bank-dur))
(fs1 (make-vector fs)))

(let ((bin (/ *clm-srate* (* 2 fs)))
(radius (- 1.0 (/ fwidth (* 2 fs)))))
(do ((k 0 (+ k 1)))
((= k fs))
(set! (fs1 k) (make-formant (* k bin) radius))))
(set! fs1 (make-formant-bank fs1))
(let ((end (+ start (seconds->samples dur)))
(bank-incr (/ 1.0 bank-samps))
(ramp-incr (/ 1.0 ramp-samps))
(ramp-start (+ start (seconds->samples ramp-beg))))
(let ((bank1-start (- ramp-start bank-samps))
(ramp-end (+ ramp-start ramp-samps))
(bank2-start (+ ramp-start ramp-samps)))
(do ((i start (+ i 1)))
((= i bank1-start))
;; in first section -- just mix in file1
(outa i (* amp (read-sample fil1))))
(let ((bank2-end (+ bank2-start bank-samps))
(ramp 0.0)
(outval 0.0)
(inputs (make-float-vector fs))
(ifs (/ 1.0 fs))
(mid 0))
(do ((i bank1-start (+ i 1))
(bank1 0.0 (+ bank1 bank-incr)))
((= i ramp-start))
;; in bank1 section -- fire up the resonators
(let ((inval (read-sample fil1)))
(set! outval (formant-bank fs1 inval))
(outa i (* amp (+ (* bank1 outval) (* (- 1.0 bank1) inval))))))
;; in the ramp
(case ramp-type
((0)
(do ((i ramp-start (+ i 1)))
((= i ramp-end))
(let ((inval1 (read-sample fil1))
(inval2 (read-sample fil2)))
;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
(set! ramp (+ ramp ramp-incr))
;; low freqs go first
(if (>= ramp 0.5)
(begin
(set! mid (floor (* (- (* 2.0 ramp) 1.0) fs)))
(fill! inputs inval2 0 mid)
(float-vector-interpolate inputs mid fs 1.0 (- ifs) inval2 inval1)
;; (do ((k mid (+ k 1)) (ks 1.0 (- ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
)
(begin
(set! mid (min fs (floor (* 2.0 ramp fs))))
(fill! inputs inval1 mid)
(float-vector-interpolate inputs 0 mid (* 2.0 ramp) (- ifs) inval2 inval1)
;; (do ((k 0 (+ k 1)) (ks (* 2.0 ramp) (- ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
))
(outa i (* amp (formant-bank fs1 inputs))))))
((1)
(do ((i ramp-start (+ i 1)))
((= i ramp-end))
(let ((inval1 (read-sample fil1))
(inval2 (read-sample fil2)))
(set! ramp (+ ramp ramp-incr))
;; high freqs go first
(if (>= ramp 0.5)
(let ((r2 (- (* 2.0 ramp) 1.0)))
(set! mid (min fs (ceiling (* (- 1.0 r2) fs))))
(fill! inputs inval2 mid)
(float-vector-interpolate inputs 0 mid r2 ifs inval2 inval1)
;; (do ((k 0 (+ k 1)) (ks r2 (+ ks ifs))) ((= k mid)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
)
(begin
(set! mid (ceiling (* (- 1.0 (* 2.0 ramp)) fs)))
(fill! inputs inval1 0 mid)
(float-vector-interpolate inputs mid fs 0.0 ifs inval2 inval1)
;; (do ((k mid (+ k 1)) (ks 0.0 (+ ks ifs))) ((>= k fs)) (float-vector-set! inputs k (+ (* ks inval2) (* (- 1.0 ks) inval1))))
))
(outa i (* amp (formant-bank fs1 inputs))))))
(else
(let ((half-fs (/ fs 2)))
(do ((i ramp-start (+ i 1)))
((= i ramp-end))
(let ((inval1 (read-sample fil1))
(inval2 (read-sample fil2)))
;; now the choice of spectral fade -- we should end with all bank1 0.0 and all bank2 1.0
(set! ramp (+ ramp ramp-incr))
;; sweep from midpoint out
(fill! inputs inval1)
(set! mid (min half-fs (floor (* fs ramp))))
(do ((k (- half-fs mid) (+ k 1))
(hk (+ half-fs mid -1) (- hk 1))
(ks (max 0.0 (- (* 2.0 ramp) 1.0)) (+ ks ifs)))
((= k half-fs))
(let ((rfs (min 1.0 ks)))
(set! (inputs k) (+ (* rfs inval2) (* (- 1.0 rfs) inval1)))
(set! (inputs hk) (inputs k))))
(outa i (* amp (formant-bank fs1 inputs))))))))
(do ((i ramp-end (+ i 1))
(bank2 1.0 (- bank2 bank-incr)))
((= i bank2-end))
;; in bank2 section -- ramp out resonators
(let ((inval (read-sample fil2)))
(set! outval (formant-bank fs1 inval))
(outa i (* amp (+ (* bank2 outval) (* (- 1.0 bank2) inval))))))
(do ((i bank2-end (+ i 1)))
((= i end))
;; in last section -- just mix file2
(outa i (* amp (read-sample fil2))))
)))))



;;; (float-vector->channel (with-sound ((make-float-vector 22050)) (cross-fade 0 .1 1 0 1 .01 .01 0 .1 256 2)))
;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2)))
;;; (with-sound (:statistics #t) (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
;;; (with-sound () (cross-fade 0 2 1.0 "oboe.snd" "trumpet.snd" 0.5 1.0 0 .1 256 2))
;;; these fades seem more successful to me when done relatively quickly (the opposite of the dissolve below
;;; which is best if done as slowly as possible). I like the sweep up best -- a sort of "evaporation" effect.


(definstrument (dissolve-fade beg dur amp file1 file2 fsize r lo hi)
(let ((fil1 (make-sampler 0 file1))
(fil2 (make-sampler 0 file2))
(start (seconds->samples beg))
(freq-inc (floor (/ fsize 2)))
(ramp-inc (/ 1.0 1024.0)))
(let ((end (+ start (seconds->samples dur)))
(spectr (make-vector freq-inc #f))
(trigger (floor (/ (* dur *clm-srate*) freq-inc)))
(fs (make-vector freq-inc #f))
(amps (make-float-vector freq-inc amp))
(ctr 0)
(inputs (make-float-vector freq-inc))
(ramps (make-vector freq-inc -1))
(in2s (make-int-vector freq-inc))
(in2-ctr 0)
(ramp-ctr 0))
(if (not (number? hi)) (set! hi freq-inc))
(let ((bin (floor (/ *clm-srate* fsize)))
(radius (- 1.0 (/ r fsize))))
(do ((k lo (+ k 1)))
((= k hi))
(set! (fs k) (make-formant (* k bin) radius))))
(set! fs (make-formant-bank fs amps)) ; wrap it up...
(do ((i start (+ i 1)))
((= i end))

;; once a ramp is set in motion, it takes care of itself -- we need only choose which to trigger
(set! ctr (+ ctr 1))
(if (> ctr trigger)
(let ((next (floor (random freq-inc))))
;; find next randomly chosen resonator to flip
(if (not (spectr next))
(set! (spectr next) (- 1.0 ramp-inc))
(call-with-exit
(lambda (bbreak)
(do ((j next (+ j 1))
(k next (- k 1)))
()
(if (and (< j freq-inc)
(not (spectr j)))
(begin
(set! (spectr j) (- 1.0 ramp-inc))
(set! next j)
(bbreak)))
(if (and (>= k 0)
(not (spectr k)))
(begin
(set! (spectr k) (- 1.0 ramp-inc))
(set! next k)
(bbreak)))))))
(set! (ramps ramp-ctr) next)
(set! ramp-ctr (+ ramp-ctr 1))
(set! ctr 0)))
(let ((inval1 (read-sample fil1))
(inval2 (read-sample fil2)))
(fill! inputs inval1)
(float-vector-spatter inputs in2s in2-ctr inval2)
;; (do ((k 0 (+ k 1))) ((= k in2-ctr)) (float-vector-set! inputs (int-vector-ref in2s k) inval2))

(when (> ramp-ctr 0)
(let ((rk 0)
(sp 0.0)
(fixup-ramps #f))
(do ((k 0 (+ k 1)))
((= k ramp-ctr))
(set! rk (ramps k))
(set! sp (vector-ref spectr rk))
(float-vector-set! inputs k (+ (* sp inval1) (* (- 1.0 sp) inval2)))
(set! sp (- sp ramp-inc))
(if (> sp 0.0)
(vector-set! spectr rk sp)
(begin
(set! (in2s in2-ctr) rk)
(set! in2-ctr (+ in2-ctr 1))
(set! fixup-ramps #t)
(set! (ramps k) -1))))
(if fixup-ramps
(let ((j 0))
(do ((k 0 (+ k 1)))
((= k ramp-ctr))
(if (>= (ramps k) 0)
(begin
(set! (ramps j) (ramps k))
(set! j (+ j 1)))))
(set! ramp-ctr j)))))
(outa i (formant-bank fs inputs)))))))


;;; (with-sound (:statistics #t) (dissolve-fade 0 1 1.0 "oboe.snd" "trumpet.snd" 256 2 0 128))
;;; (float-vector->channel (with-sound ((make-float-vector 44100)) (dissolve-fade 0 2 1 0 1 4096 2 2 #f)))
;;;
;;; another neat effect here is to simply let the random changes float along with no
;;; direction -- if the hit is 1.0 send it toward 0.0 and vice versa -- strange
;;; pitches emerge from noises etc



#|
;;; make it easy to see and hear:

(with-sound ("p1.snd")
(let ((g (make-ncos 200 100)))
(do ((i 0 (+ i 1)))
((= i 100000))
(outa i (ncos g)))))

(with-sound ("p2.snd")
(let ((g (make-ncos 123 100)))
(do ((i 0 (+ i 1)))
((= i 100000))
(outa i (ncos g)))))

(with-sound (:statistics #t)
(cross-fade 0 2 1.0 "p1.snd" "p2.snd" 0.5 1.0 0 .1 256 2))

(with-sound (:statistics #t)
(dissolve-fade 0 2 1.0 "p1.snd" "p2.snd" 256 2 0 128))
|#

+ 215
- 0
lib/sndlib/freeverb.rb View File

@@ -0,0 +1,215 @@
# freeverb.rb -- CLM -> Snd/Ruby translation of freeverb.ins

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 03/04/08 03:53:20
# Changed: 14/11/13 15:47:00

# Original notes of Fernando Lopez-Lezcano

# ;; Freeverb - Free, studio-quality reverb SOURCE CODE in the public domain
# ;;
# ;; Written by Jezar at Dreampoint, June 2000
# ;; http://www.dreampoint.co.uk
# ;;
# ;; Translated into clm-2 by Fernando Lopez-Lezcano <nando@ccrma.stanford.edu>
# ;; Version 1.0 for clm-2 released in January 2001
# ;; http://ccrma.stanford.edu/~nando/clm/freeverb/
# ;;
# ;; Changes to the original code by Jezar (by Fernando Lopez-Lezcano):
# ;; - the clm version can now work with a mono input or an n-channel input
# ;; stream (in the latter case the number of channels of the input and output
# ;; streams must match.
# ;; - the "wet" parameter has been eliminated as it does not apply to the model
# ;; that clm uses to generate reverberation
# ;; - the "width" parameter name has been changed to :global. It now controls
# ;; the coefficients of an NxN matrix that specifies how the output of the
# ;; reverbs is mixed into the output stream.
# ;; - predelays for the input channels have been added.
# ;; - damping can be controlled individually for each channel.

# For more information see clm-x/freeverb.html.

require "ws"

# Snd-Ruby's freeverb and fcomb (see sndins.so for a faster one).

unless provided? :sndins
class Fcomb
def initialize(scaler, size, a0, a1)
@feedback = scaler.to_f
@delay = make_delay(size.to_i)
@filter = make_one_zero(a0, a1)
end
attr_accessor :feedback

def fcomb(input = 0.0)
delay(@delay, input + one_zero(@filter, tap(@delay)) * @feedback)
end

def inspect
format("#<%s: %p, %p, feedback: %0.3f>",
self.class, @delay, @filter, @feedback)
end
end
def make_fcomb(scaler = 0.0, size = 1, a0 = 0.0, a1 = 0.0)
Fcomb.new(scaler, size, a0, a1)
end

def fcomb(gen, input = 0.0)
gen.fcomb(input)
end

def fcomb?(obj)
obj.kind_of?(Fcomb)
end
end

add_help(:freeverb,
"freeverb(*args)
:room_decay, 0.5,
:damping, 0.5,
:global, 0.3,
:predelay, 0.03,
:output_gain, 1.0,
:output_mixer, nil,
:scale_room_decay, 0.28,
:offset_room_decay, 0.7,
:combtuning, [1116, 1188, 1277, 1356, 1422, 1491, 1557, 1617],
:allpasstuning, [556, 441, 341, 225],
:scale_damping, 0.4,
:stereo_spread, 23,
with_sound(:reverb, :freeverb) do fm_violin(0, 1, 440, 0.3) end
This is the Ruby version of freeverb. For a faster one see sndins.so.")
def freeverb(*args)
room_decay, damping, global, predelay, output_gain, output_mixer = nil
scale_room_decay, offset_room_decay, combtuning, allpasstuning = nil
scale_damping, stereo_spread = nil
optkey(args, binding,
[:room_decay, 0.5],
[:damping, 0.5],
[:global, 0.3],
[:predelay, 0.03],
[:output_gain, 1.0],
[:output_mixer, nil],
[:scale_room_decay, 0.28],
[:offset_room_decay, 0.7],
[:combtuning, [1116, 1188, 1277, 1356, 1422, 1491, 1557, 1617]],
[:allpasstuning, [556, 441, 341, 225]],
[:scale_damping, 0.4],
[:stereo_spread, 23])
if @reverb_channels > 1 and @reverb_channels != @channels
error("input must be mono or input channels must equal output channels")
end
out_gain = output_gain
local_gain = (1.0 - global) * (1.0 - 1.0 / @channels) + 1.0 / @channels
global_gain = (@channels - local_gain * @channels) /
[(@channels * @channels - @channels), 1].max
srate_scale = @srate / 44100.0
out_mix = output_mixer
unless vct?(output_mixer)
out_mix = Vct.new(@channels) do
(out_gain * global_gain) / @channels
end
end
predelays = make_array(@reverb_channels) do
make_delay(:size, (@srate * predelay).to_i)
end
room_decay_val = room_decay * scale_room_decay + offset_room_decay
combs = make_array(@channels) do |c|
combtuning.map do |tuning|
dmp = scale_damping * damping
sz = (srate_scale * tuning).to_i
if c.odd?
sz += (srate_scale * stereo_spread).to_i
end
make_fcomb(room_decay_val, sz, 1.0 - dmp, dmp)
end
end
allpasses = make_array(@channels) do |c|
allpasstuning.map do |tuning|
sz = (srate_scale * tuning).to_i
if c.odd?
sz += (srate_scale * stereo_spread).to_i
end
make_all_pass(:size, sz, :feedforward, -1.0, :feedback, 0.5)
end
end
len = @ws_reverb.length + seconds2samples(@decay_time)
name = get_func_name()
# to satisfy with_sound-option :info and :notehook
with_sound_info(name, 0, samples2seconds(len))
if @verbose
Snd.message("%s on %d in and %d out channels",
name, @reverb_channels, @channels)
end
f_in = Vct.new(@reverb_channels, 0.0)
f_out = Vct.new(@channels, 0.0)
out_buf = Vct.new(@channels, 0.0)
if @reverb_channels == 1
len.times do |i|
fin = delay(predelays[0], file2sample(@ws_reverb, i, 0))
combs.each_with_index do |fcbs, c|
f_out[c] = 0.0
fcbs.each do |fcb|
f_out[c] += fcomb(fcb, fin)
end
end
allpasses.each_with_index do |apss, c|
apss.each do |aps|
f_out[c] = all_pass(aps, f_out[c])
end
end
frample2file(@ws_output, i,
frample2frample(out_mix, f_out, @channels,
out_buf, @channels))
end
else
len.times do |i|
fin = file2frample(@ws_reverb, i, f_in).map_with_index do |f, c|
delay(predelays[c], f)
end
combs.each_with_index do |fcbs, c|
f_out[c] = 0.0
fcbs.each do |fcb|
f_out[c] += fcomb(fcb, fin[c])
end
end
allpasses.each_with_index do |apss, c|
apss.each do |aps|
f_out[c] = all_pass(aps, f_out[c])
end
end
frample2file(@ws_output, i,
frample2frample(out_mix, f_out, @channels,
out_buf, @channels))
end
end
end

=begin
with_sound(:reverb, :freeverb,
:reverb_data, [:room_decay, 0.9],
:channels, 2,
:reverb_channels, 1,
:output, "fvrb-test.snd",
:play, 1,
:statistics, true) do
fm_violin(0, 1, 440, 0.5)
end
with_sound(:statistics, true,
:reverb, :freeverb,
:reverb_data, [:output_gain, 3.0]) do
outa(0, 0.5, @ws_reverb)
end
with_sound(:channels, 2,
:reverb_channels, 2,
:statistics, true,
:reverb, :freeverb,
:reverb_data, [:output_gain, 3.0]) do
outa(0, 0.5, @ws_reverb)
outb(0, 0.1, @ws_reverb)
end
=end

# freeverb.rb ends here

+ 208
- 0
lib/sndlib/freeverb.scm View File

@@ -0,0 +1,208 @@
;;; freeverb.scm -- CLM -> Snd/Scheme translation of freeverb.ins

;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
;; Last: Thu Apr 24 01:32:15 CEST 2003
;; Version: $Revision: 1.2 $

;;; Original notes of Fernando Lopez-Lezcano

;; Freeverb - Free, studio-quality reverb SOURCE CODE in the public domain
;;
;; Written by Jezar at Dreampoint, June 2000
;; http://www.dreampoint.co.uk
;;
;; Translated into clm-2 by Fernando Lopez-Lezcano <nando@ccrma.stanford.edu>
;; Version 1.0 for clm-2 released in January 2001
;; http://ccrma.stanford.edu/~nando/clm/freeverb/
;;
;; Changes to the original code by Jezar (by Fernando Lopez-Lezcano):
;; - the clm version can now work with a mono input or an n-channel input
;; stream (in the latter case the number of channels of the input and output
;; streams must match.
;; - the "wet" parameter has been eliminated as it does not apply to the model
;; that clm uses to generate reverberation
;; - the "width" parameter name has been changed to :global. It now controls the
;; coefficients of an NxN matrix that specifies how the output of the reverbs
;; is mixed into the output stream.
;; - predelays for the input channels have been added.
;; - damping can be controlled individually for each channel.

;; For more information see clm-2/freeverb/index.html [MS]

;;; changed to accommodate run and mono output, bill 11-Jun-06
;;; use the filtered-comb gen, bill 29-Jun-06
;;; optimized slightly, bill 17-Sep-12
;;; changed to use float-vectors, not frames and mixers 11-Oct-13

;;; Code:

(provide 'snd-freeverb.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(definstrument (freeverb
(room-decay 0.5)
(damping 0.5)
(global 0.3)
(predelay 0.03)
(output-gain 1.0)
output-mixer
(scale-room-decay 0.28)
(offset-room-decay 0.7)
(combtuning '(1116 1188 1277 1356 1422 1491 1557 1617))
(allpasstuning '(556 441 341 225))
(scale-damping 0.4)
(stereo-spread 23)
(decay-time 1.0)
verbose)
(let ((startime 0.0)
(dur (+ decay-time (mus-sound-duration (mus-file-name *reverb*))))
(out-chans (channels *output*))
(in-chans (channels *reverb*))
(srate-scale (/ *clm-srate* 44100.0))
(room-decay-val (+ (* room-decay scale-room-decay) offset-room-decay))
(numcombs (length combtuning))
(numallpasses (length allpasstuning)))
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(out-buf (make-float-vector out-chans))
(f-out (make-float-vector out-chans))
(f-in (make-float-vector in-chans))
(predelays (make-vector in-chans))
(fcombs (make-vector (* out-chans numcombs)))
(allpasses (make-vector (* out-chans numallpasses)))
(local-gain (if (= out-chans 1)
global
(+ (/ (- 1.0 global) (- 1 (/ 1.0 out-chans)))
(/ 1.0 out-chans))))
(global-gain 0.0))

(set! global-gain (if (= out-chans 1)
local-gain
(/ (- out-chans (* local-gain out-chans))
(- (* out-chans out-chans) out-chans))))
(if verbose
(format () ";;; freeverb: ~d input channels, ~d output channels~%" in-chans out-chans))
(if (and (> in-chans 1)
(not (= in-chans out-chans)))
(error "input must be mono or input channels must equal output channels"))

(let ((out-mix (or output-mixer
(let ((v (make-float-vector (list out-chans out-chans))))
(do ((i 0 (+ i 1)))
((= i out-chans))
(do ((j 0 (+ j 1)))
((= j out-chans))
(set! (v i j) (/ (* output-gain (if (= i j) local-gain global-gain)) out-chans))))
v))))

(do ((c 0 (+ 1 c)))
((= c in-chans))
(set! (predelays c) (make-delay :size (round (* *clm-srate* (if (number? predelay) predelay (predelay c)))))))

(do ((c 0 (+ 1 c)))
((= c out-chans))
(do ((i 0 (+ i 1)))
((= i numcombs))
(let ((len (floor (* srate-scale (combtuning i))))
(dmp (* scale-damping (if (number? damping) damping (damping i)))))
(if (odd? c)
(set! len (+ len (floor (* srate-scale stereo-spread)))))
(set! (fcombs (+ (* c numcombs) i))
(make-filtered-comb :size len
:scaler room-decay-val
:filter (make-one-zero :a0 (- 1.0 dmp) :a1 dmp))))))
(do ((c 0 (+ 1 c)))
((= c out-chans))
(do ((i 0 (+ i 1)))
((= i numallpasses))
(let ((len (floor (* srate-scale (allpasstuning i)))))
(if (odd? c)
(set! len (+ len (floor (* srate-scale stereo-spread)))))
(set! (allpasses (+ (* c numallpasses) i))
(make-all-pass :size len :feedforward -1 :feedback 0.5)))))
(if (= out-chans in-chans 1)
(let ((amp (out-mix 0 0))
(pdelay (predelays 0)))
(set! allpasses (make-all-pass-bank allpasses))
(set! fcombs (make-filtered-comb-bank fcombs))
(do ((i beg (+ i 1)))
((= i end))
(outa i (* amp (all-pass-bank allpasses
(filtered-comb-bank fcombs
(delay pdelay (ina i *reverb*))))))))

(let ((allp-c (make-vector out-chans))
(fcmb-c (make-vector out-chans)))
(do ((c 0 (+ c 1)))
((= c out-chans))
(set! (allp-c c) (make-vector numallpasses))
(set! (fcmb-c c) (make-vector numcombs)))
(do ((c 0 (+ c 1)))
((= c out-chans))
(do ((j 0 (+ j 1)))
((= j numcombs))
(set! ((fcmb-c c) j) (fcombs (+ j (* c numcombs)))))
(do ((j 0 (+ j 1)))
((= j numallpasses))
(set! ((allp-c c) j) (allpasses (+ j (* c numallpasses)))))
(set! (allp-c c) (make-all-pass-bank (allp-c c)))
(set! (fcmb-c c) (make-filtered-comb-bank (fcmb-c c))))

(if (= in-chans out-chans 5)
(let ((allp0 (vector-ref allp-c 0))
(allp1 (vector-ref allp-c 1))
(allp2 (vector-ref allp-c 2))
(allp3 (vector-ref allp-c 3))
(allp4 (vector-ref allp-c 4))
(fcmb0 (vector-ref fcmb-c 0))
(fcmb1 (vector-ref fcmb-c 1))
(fcmb2 (vector-ref fcmb-c 2))
(fcmb3 (vector-ref fcmb-c 3))
(fcmb4 (vector-ref fcmb-c 4))
(dly0 (vector-ref predelays 0))
(dly1 (vector-ref predelays 1))
(dly2 (vector-ref predelays 2))
(dly3 (vector-ref predelays 3))
(dly4 (vector-ref predelays 4)))
(do ((i beg (+ i 1)))
((= i end))
(file->frample *reverb* i f-in)
(float-vector-set! f-out 0 (all-pass-bank allp0 (filtered-comb-bank fcmb0 (delay dly0 (float-vector-ref f-in 0)))))
(float-vector-set! f-out 1 (all-pass-bank allp1 (filtered-comb-bank fcmb1 (delay dly1 (float-vector-ref f-in 1)))))
(float-vector-set! f-out 2 (all-pass-bank allp2 (filtered-comb-bank fcmb2 (delay dly2 (float-vector-ref f-in 2)))))
(float-vector-set! f-out 3 (all-pass-bank allp3 (filtered-comb-bank fcmb3 (delay dly3 (float-vector-ref f-in 3)))))
(float-vector-set! f-out 4 (all-pass-bank allp4 (filtered-comb-bank fcmb4 (delay dly4 (float-vector-ref f-in 4)))))
(frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans))))
(if (> in-chans 1)
(do ((i beg (+ i 1)))
((= i end))
(file->frample *reverb* i f-in)
(do ((c 0 (+ c 1)))
((= c out-chans))
(float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
(filtered-comb-bank (vector-ref fcmb-c c)
(delay (vector-ref predelays c)
(float-vector-ref f-in c))))))
(frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))
(let ((pdelay (predelays 0)))
(do ((i beg (+ i 1)))
((= i end))
(let ((val (delay pdelay (ina i *reverb*))))
(do ((c 0 (+ c 1)))
((= c out-chans))
(float-vector-set! f-out c (all-pass-bank (vector-ref allp-c c)
(filtered-comb-bank (vector-ref fcmb-c c)
val))))
(frample->file *output* i (frample->frample out-mix f-out out-chans out-buf out-chans)))))))))))))
;;; (with-sound (:statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*))
;;; (with-sound (:channels 2 :reverb-channels 2 :statistics #t :reverb freeverb :reverb-data '(:output-gain 3.0)) (outa 0 .5 *reverb*) (outb 0 .1 *reverb*))


+ 97
- 0
lib/sndlib/fth.m4 View File

@@ -0,0 +1,97 @@
## fth.m4 -- Autoconf macros for configuring FTH -*- Autoconf -*-

## Copyright (C) 2006 Michael Scholz

## Author: Michael Scholz <scholz-micha@gmx.de>
## Created: Mon Mar 13 17:14:46 CET 2006
## Changed: Thu Mar 23 13:46:43 CET 2006
## Ident: $Id: fth.m4,v 1.1.1.1 2006/03/25 21:29:50 mi-scholz Exp $

## This file is part of FTH.

## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.

## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.

## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

## Commentary:

# FTH_CHECK_LIB(action-if-found, [action-if-not-found])
#
# Usage: FTH_CHECK_LIB([AC_DEFINE([HAVE_FORTH])])
#
# Don't quote this macro: [FTH_CHECK_LIB(...)] isn't correct.
# Instead call it FTH_CHECK_LIB(...).
#
# Six variables will be substituted:
#
# FTH fth program path or no
# FTH_VERSION version string or ""
# FTH_CFLAGS -I${prefix}/include/fth or ""
# FTH_LIBS -L${prefix}/lib -lfth or ""
# FTH_HAVE_COMPLEX yes or no
# FTH_HAVE_RATIO yes or no

## Code:

# AC_CHECK_LIB was written by David MacKenzie.
# This version is slightly changed to fit to FTH_CHECK_LIB.

AC_DEFUN([fth_AC_CHECK_LIB],
[
m4_ifval([$3], , [AH_CHECK_LIB([$1])])dnl
AS_LITERAL_IF([$1],
[AS_VAR_PUSHDEF([ac_Lib], [ac_cv_lib_$1_$2])],
[AS_VAR_PUSHDEF([ac_Lib], [ac_cv_lib_$1''_$2])])dnl
AC_CACHE_CHECK([m4_default([$4], [for $2 in -l$1])], ac_Lib,
[fth_check_lib_save_LIBS=$LIBS
LIBS="-l$1 $5 $LIBS"
AC_LINK_IFELSE([AC_LANG_CALL([], [$2])],
[AS_VAR_SET(ac_Lib, yes)],
[AS_VAR_SET(ac_Lib, no)])
LIBS=$fth_check_lib_save_LIBS])
AS_IF([test AS_VAR_GET(ac_Lib) = yes],
[m4_default([$3], [AC_DEFINE_UNQUOTED(AS_TR_CPP(HAVE_LIB$1)) LIBS="-l$1 $LIBS"])])dnl
AS_VAR_POPDEF([ac_Lib])dnl
])# fth_AC_CHECK_LIB

AC_DEFUN([FTH_CHECK_LIB],
[
[AC_PATH_PROG([FTH], [fth], [no])]
FTH_VERSION=""
FTH_CFLAGS=""
FTH_LIBS=""
FTH_HAVE_COMPLEX=no
FTH_HAVE_RATIO=no
AC_MSG_CHECKING([for Forth])
if test "${FTH}" != no ; then
FTH_VERSION=`${FTH} --no-init-file --eval .version`
FTH_CFLAGS=`${FTH} --no-init-file --eval .cflags`
FTH_LIBS=`${FTH} --no-init-file --eval .libs`
AC_MSG_RESULT([FTH version ${FTH_VERSION}])
fth_AC_CHECK_LIB([fth], [fth_make_complex], [FTH_HAVE_COMPLEX=yes],
[whether FTH supports complex numbers], [${FTH_LIBS}])
fth_AC_CHECK_LIB([fth], [fth_ratio_floor], [FTH_HAVE_RATIO=yes],
[whether FTH supports rational numbers], [${FTH_LIBS}])
[$1]
else
AC_MSG_RESULT([no])
[$2]
fi
AC_SUBST([FTH_VERSION])
AC_SUBST([FTH_CFLAGS])
AC_SUBST([FTH_LIBS])
AC_SUBST([FTH_HAVE_COMPLEX])
AC_SUBST([FTH_HAVE_RATIO])
])# FTH_CHECK_LIB
## fth.m4 ends here

+ 165
- 0
lib/sndlib/fullmix.scm View File

@@ -0,0 +1,165 @@
(provide 'snd-fullmix.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))


(definstrument (fullmix in-file beg outdur inbeg matrix srate reverb-amount)
;; "matrix" can be a simple amplitude or a list of lists
;; each inner list represents one input channel's amps into one output channel
;; each element of the list can be a number, a list (turned into an env) or an env
;;
;; "srate" can be a negative number (read in reverse), or an envelope.
(let ((st (seconds->samples (or beg 0.0)))
(dur (or outdur
(/ (- (mus-sound-duration in-file) (or inbeg 0.0))
(or (and (real? srate) (abs srate)) 1.0))))
(in-chans (channels in-file))
(out-chans (channels *output*))
(reversed (or (and (real? srate) (negative? srate))
(and (pair? srate) (pair? (cdr srate)) (negative? (cadr srate)))))
(inloc (floor (* (or inbeg 0.0) (mus-sound-srate in-file)))))
(let ((samps (seconds->samples dur))
(mx (let ((ochans (max in-chans out-chans)))
(if matrix
(make-float-vector (list ochans ochans))
(let ((v (make-float-vector (list ochans ochans))))
(do ((i 0 (+ i 1)))
((= i ochans))
(set! (v i i) 1.0))
v))))
(rev-mx (and *reverb* (real? reverb-amount) (> reverb-amount 0.0)
(let ((rmx (make-float-vector (list in-chans in-chans))))
(do ((i 0 (+ i 1)))
((= i in-chans))
(set! (rmx i 0) reverb-amount)) ; 0->assume 1 chan reverb stream, I think
rmx)))
(file (if (memv srate '(#f 1 1.0))
(make-file->frample in-file)
(let ((vect (make-vector in-chans #f)))
(do ((i 0 (+ i 1)))
((= i in-chans))
(vector-set! vect i (make-readin in-file i inloc :direction (if reversed -1 1))))
vect)))
(envs #f)
(srcenv (and (pair? srate)
(make-env srate :duration dur :scaler (if reversed -1.0 1.0)))))
(when matrix
(if (pair? matrix) ; matrix is list of scalers, envelopes (lists), or env gens
(do ((inp 0 (+ inp 1))
(off 0 (+ off out-chans)))
((= inp in-chans))
(let ((inlist (list-ref matrix inp)))
(do ((outp 0 (+ outp 1)))
((= outp out-chans))
(let ((outn (list-ref inlist outp)))
(if outn
(if (number? outn)
(set! (mx inp outp) outn)
(if (or (env? outn)
(pair? outn))
(begin
(if (not envs)
(set! envs (make-vector (* in-chans out-chans) #f)))
(vector-set! envs (+ off outp)
(if (env? outn)
outn
(make-env outn :duration dur))))
(format () "unknown element in matrix: ~A" outn))))))))
(do ((inp 0 (+ inp 1))) ; matrix is a number in this case (a global scaler)
((= inp in-chans))
(if (< inp out-chans)
(set! (mx inp inp) matrix)))))
(if (memv srate '(#f 1 1.0))
(let ((mxe (and envs
(do ((v (make-vector in-chans))
(i 0 (+ i 1))
(off 0 (+ off out-chans)))
((= i in-chans) v)
(let ((vo (make-vector out-chans #f)))
(vector-set! v i vo)
(do ((j 0 (+ j 1)))
((= j out-chans))
(vector-set! vo j (vector-ref envs (+ off j)))))))))
;; -------- no src
(mus-file-mix *output* file st samps inloc mx mxe)
(if rev-mx
(mus-file-mix *reverb* file st samps inloc rev-mx)))
(let ((srcs (make-vector in-chans #f)))
(do ((inp 0 (+ inp 1)))
((= inp in-chans))
(vector-set! srcs inp (make-src :input (vector-ref file inp) :srate (if (real? srate) (abs srate) 0.0))))
(mus-file-mix-with-envs file st samps mx rev-mx envs srcs srcenv *output* *reverb*)
)))))

#|
(with-sound (:channels 2 :statistics #t)
(fullmix "pistol.snd")
(fullmix "2.snd" .5 1)
(fullmix "2.snd" 1.5 1 0 #f 2.0)
(fullmix "oboe.snd" 1 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))))
(fullmix "pistol.snd" 2 1 0 #f .5)
(fullmix "2.snd" 0 2 0 (list (list .1 .2) (list .3 .4)) 2.0)
(fullmix "oboe.snd" 3 2 0 (list (list .1 (make-env '(0 0 1 1) :duration 2 :scaler .5))) .25)
(let ((e0->0 (make-env '(0 0 1 1) :duration 2))
(e0->1 (make-env '(0 1 1 0) :duration 2))
(e1->0 (make-env '(0 1 1 0) :duration 2))
(e1->1 (make-env '(0 0 1 1) :duration 2)))
(fullmix "2.snd" 4 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1))))
(let ((e0->0 (make-env '(0 0 1 1) :duration 2))
(e0->1 (make-env '(0 1 1 0) :duration 2))
(e1->0 (make-env '(0 1 1 0) :duration 2))
(e1->1 (make-env '(0 0 1 1) :duration 2)))
(fullmix "2.snd" 6 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)) 2.0)))

(with-sound (:channels 2 :statistics #t)
(fullmix "2.snd" 0 2 0 (list (list .1 .2) (list .3 .4)) 2.0))

(with-sound () (fullmix "pistol.snd" 0 2 2 #f -1.0))

(with-sound (:channels 2)
(let ((e0->0 (make-env '(0 0 1 1) :duration 2))
(e0->1 (make-env '(0 1 1 0) :duration 2))
(e1->0 (make-env '(0 1 1 0) :duration 2))
(e1->1 (make-env '(0 0 1 1) :duration 2)))
(fullmix "2.snd" 6 2 0 (list (list e0->0 e0->1) (list e1->0 e1->1))) 2.0))

(with-sound () (fullmix "pistol.snd"))
(with-sound () (fullmix "pistol.snd" 1))
(with-sound () (fullmix "pistol.snd" 1 1))
(with-sound () (fullmix "pistol.snd" 0 1 1))
(with-sound (:statistics #t) (fullmix "pistol.snd" 0 1 0 2.0))
(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 2.0))
(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 (list (list 0.1 0.7))))
(with-sound (:statistics #t :channels 2) (fullmix "pistol.snd" 0 1 0 (list (list 0.1 (list 0 0 1 1)))))

(with-sound (:channels 2 :output "one-2.snd") (do ((i 0 (+ i 1))) ((= i 10000)) (outa i 0.5) (outb i -0.5)))
(with-sound (:channels 4 :output "one-4.snd") (do ((i 0 (+ i 1))) ((= i 10000)) (outa i 0.5) (outb i -0.5) (outc i 0.1) (outd i -0.1)))

(with-sound (:statistics #t :channels 2) (fullmix "one-2.snd" 0 .2 0 '((1.0 0.5) (0.5 1.0))))
(with-sound (:statistics #t :channels 2) (fullmix "one-2.snd" 0 .2 0 (list (list 0.1 (list 0 0 1 1)) (list (list 0 1 1 0) .5))))
(with-sound (:statistics #t :channels 2)
(let ((e0->0 (make-env '(0 0 1 1) :end 10000))
(e0->1 (make-env '(0 1 1 0) :end 10000))
(e1->0 (make-env '(0 1 1 0) :end 10000))
(e1->1 (make-env '(0 0 1 1) :end 10000)))
(fullmix "one-2.snd" 0 .2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)))))


(with-sound (:statistics #t :channels 2 :reverb jc-reverb)
(let ((e0->0 (make-env '(0 0 1 1) :end 10000))
(e0->1 (make-env '(0 1 1 0) :end 10000))
(e1->0 (make-env '(0 1 1 0) :end 10000))
(e1->1 (make-env '(0 0 1 1) :end 10000)))
(fullmix "one-2.snd" 0 .2 0 (list (list e0->0 e0->1) (list e1->0 e1->1)) #f .1)))

(with-sound () (fullmix "oboe.snd" 0 2 0 #f '(0 0.5 1 1 2 .1)))
|#

+ 6824
- 0
lib/sndlib/generators.scm
File diff suppressed because it is too large
View File


+ 424
- 0
lib/sndlib/grani.rb View File

@@ -0,0 +1,424 @@
#!/usr/bin/env ruby -w
# grani.rb -- grani.ins CL --> Ruby

# Translator: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 05/02/01 00:47:00
# Changed: 14/11/13 05:03:02

# Original header:

# ;;; grani: a granular synthesis instrument
# ;;; by Fernando Lopez-Lezcano
# ;;; http://ccrma.stanford.edu/~nando/clm/grani/
# ;;;
# ;;; Original grani.ins instrument written for the 220a Course by
# ;;; Fernando Lopez-Lezcano & Juan Pampin, November 6 1996
# ;;;
# ;;; Mar 21 1997: working with hop and grain-dur envelopes
# ;;; Mar 22 1997: working with src envelope (grain wise) & src spread
# ;;; Jan 26 1998: started work on new version
# ;;; Nov 7 1998: input soundfile duration calculation wrong
# ;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing
# ;;; for this one)
# ;;; Dec 20 1998: added standard locsig code
# ;;; Feb 19 1999: added "nil" as default value of where to avoid warning
# ;;; (by bill)
# ;;; Jan 10 2000: added input-channel to select which channel of the input
# ;;; file to process.
# ;;; added grain-start-in-seconds to be able to specify input
# ;;; file locations in seconds for the grain-start envelope
# ;;; May 06 2002: fixed array passing of where-bins in clisp
# ;;; (reported by Charles Nichols and jennifer l doering)
# ;;; Mar 27 2003: added option for sending grains to all channels
# ;;; (requested by Oded Ben-Tal)

require "ws"
require "env"

# ;;; calculate a random spread around a center of 0
def random_spread(spread)
spread.nonzero? ? (random(spread) - spread / 2.0) : 0.0
end

# ;;; create a constant envelope if argument is a number
def envelope_or_number(val)
case val
when Numeric
[0, val, 1, val]
when Vct
vct2list(val)
when Array
val
else
error("%s: Number, Array, or Vct required", get_func_name())
end
end

# ;;; create a vct from an envelope
def make_gr_env(env, length = 512)
length_1 = (length - 1).to_f
make_vct!(length) do |i|
envelope_interp(i / length_1, env)
end
end

# ;;; Grain envelopes
def raised_cosine(*args)
duty_cycle = get_args(args, :duty_cycle, 100)
length = get_args(args, :length, 128)
active = length * duty_cycle.to_f * 0.01
incr = PI / (active - 1.0)
start = (length - active) / 2.0
fin = (length + active) / 2.0
s = -1
make_vct!(length) do |i|
sine = if i >= start and i < fin
s += 1
sin(s * incr)
else
0.0
end
sine * sine
end
end

# ;;;=========================================================================
# ;;; Granular synthesis instrument
# ;;;=========================================================================
#
# ;;; input-channel:
# ;;; from which channel in the input file are samples read
# ;;; amp-envelope:
# ;;; amplitude envelope for the note
# ;;; grain-envelope:
# ;;; grain-envelope-end:
# ;;; envelopes for each individual grain. The envelope applied in the result
# ;;; of interpolating both envelopes. The interpolation is controlled by
# ;;; grain-envelope-trasition. If "grain-envelope-end" is nil interpolation
# ;;; is turned off and only grain-envelope is applied to the grains.
# ;;; grain-envelope-trasition:
# ;;; an enveloper that controls the interpolation between the two
# ;;; grain envelopes
# ;;; 0 -> selects "grain-envelope"
# ;;; 1 -> selects "grain-envelope-end"
# ;;; grain-envelope-array-size
# ;;; size of the array passed to make-table-lookup
# ;;; grain-duration:
# ;;; envelope that controls grain duration in seconds
# ;;; srate-linear:
# ;;; t -> sample rate envelope is linear
# ;;; nil -> sample rate envelope is exponential
# ;;; srate:
# ;;; envelope that controls sample rate conversion. The envelope is an
# ;;; exponential envelope, the base and error bound of the conversion
# ;;; are controlled by "srate-base" and "srate-error".
# ;;; srate-spread:
# ;;; random spread of sample rate conversion around "srate"
# ;;; srate-base:
# ;;; base for the exponential conversion
# ;;; for example: base = (expt 2 (/ 12)) creates a semitone envelope
# ;;; srate-error:
# ;;; error bound for the exponential conversion.
# ;;; grain-start:
# ;;; envelope that determines the starting point of the current grain in
# ;;; the input file. "y"->0 starts the grain at the beginning of the input
# ;;; file. "y"->1 starts the grain at the end of the input file.
# ;;; grain-start-spread:
# ;;; random spread around the value of "grain-start"
# ;;; grain-start-in-seconds:
# ;;; nil -> grain-start y envelope expressed in percent of the duration
# ;;; of the input file
# ;;; t -> grain-start y envelope expressed in seconds
# ;;; grain-density:
# ;;; envelope that controls the number of grains per second generated
# ;;; in the output file

# ;;; grain-density-spread:

Grani_to_locsig = 0
Grani_to_grain_duration = 1
Grani_to_grain_start = 2
Grani_to_grain_sample_rate = 3
Grani_to_grain_random = 4
Grani_to_grain_allchans = 5

def grani(start, dur, amp, file, *args)
input_channel = get_args(args, :input_channel, 0)
grains = get_args(args, :grains, 0)
amp_envelope = get_args(args, :amp_envelope,
[0, 0, 0.3, 1, 0.7, 1, 1, 0])
grain_envelope = get_args(args, :grain_envelope,
[0, 0, 0.3, 1, 0.7, 1, 1, 0])
grain_envelope_end = get_args(args, :grain_envelope_end, false)
grain_envelope_transition = get_args(args, :grain_envelope_transition,
[0, 0, 1, 1])
grain_envelope_array_size = get_args(args, :grain_envelope_array_size, 512)
grain_duration = get_args(args, :grain_duration, 0.1)
grain_duration_spread = get_args(args, :grain_spread, 0.0)
grain_duration_limit = get_args(args, :grain_limit, 0.002)
srate = get_args(args, :srate, 0.0)
srate_spread = get_args(args, :srate_spread, 0.0)
srate_linear = get_args(args, :srate_linear, false)
srate_base = get_args(args, :srate_base, 2.0 ** (1.0 / 12))
srate_error = get_args(args, :srate_error, 0.01)
grain_start = get_args(args, :grain_start, [0, 0, 1, 1])
grain_start_spread = get_args(args, :grain_start_spread, 0.0)
grain_start_in_seconds = get_args(args, :grain_start_in_seconds, false)
grain_density = get_args(args, :grain_density, 10.0)
grain_density_spread = get_args(args, :grain_density_spread, 0.0)
reverb_amount = get_args(args, :reverb_amount, 0.01)
reverse = get_args(args, :reverse, false)
where_to = get_args(args, :where_to, 0)
where_bins = get_args(args, :where_bins, [])
grain_distance = get_args(args, :grain_distance, 1.0)
grain_distance_spread = get_args(args, :grain_distance_spread, 0.0)
grain_degree = get_args(args, :grain_degree, 45.0)
grain_degree_spread = get_args(args, :grain_degree_spread, 0.0)
beg, fin = times2samples(start, dur)
in_file_channels = mus_sound_chans(file)
in_file_sr = mus_sound_srate(file).to_f
in_file_dur = mus_sound_framples(file) / in_file_sr
in_file_reader = make_readin(:file, file,
:channel,
[input_channel, in_file_channels - 1].min)
last_in_sample = (in_file_dur * in_file_sr).round
srate_ratio = in_file_sr / mus_srate()
sr_env = make_env(:envelope,
if srate_linear
envelope_or_number(srate)
else
exp_envelope(envelope_or_number(srate),
:base, srate_base,
:error, srate_error)
end,
:scaler, srate_ratio, :duration, dur)
sr_spread_env = make_env(:envelope, envelope_or_number(srate_spread),
:duration, dur)
amp_env = make_env(:envelope, amp_envelope, :scaler, amp, :duration, dur)
gr_dur = make_env(:envelope, envelope_or_number(grain_duration),
:duration, dur)
gr_dur_spread = make_env(:envelope, envelope_or_number(grain_duration_spread),
:duration, dur)
gr_start_scaler = (grain_start_in_seconds ? 1.0 : in_file_dur)
gr_start = make_env(:envelope, envelope_or_number(grain_start),
:duration, dur)
gr_start_spread = make_env(:envelope, envelope_or_number(grain_start_spread),
:duration, dur)
gr_dens_env = make_env(:envelope, envelope_or_number(grain_density),
:duration, dur)
gr_dens_spread_env = make_env(:envelope,
envelope_or_number(grain_density_spread),
:duration, dur)
gr_env = make_table_lookup(:frequency, 1.0, "initial-phase".intern, 0.0,
:wave,
if vct?(grain_envelope)
grain_envelope
else
make_gr_env(grain_envelope,
grain_envelope_array_size)
end)
gr_env_end = make_table_lookup(:frequency, 1.0, "initial-phase".intern, 0.0,
:wave,
if grain_envelope_end
if vct?(grain_envelope_end)
grain_envelope_end
else
make_gr_env(grain_envelope_end,
grain_envelope_array_size)
end
else
make_vct(512)
end)
gr_int_env = make_env(:envelope,
envelope_or_number(grain_envelope_transition),
:duration, dur)
interp_gr_envs = grain_envelope_end
gr_dist = make_env(:envelope, envelope_or_number(grain_distance),
:duration, dur)
gr_dist_spread = make_env(:envelope,
envelope_or_number(grain_distance_spread),
:duration, dur)
gr_degree = make_env(:envelope, envelope_or_number(grain_degree),
:duration, dur)
gr_degree_spread = make_env(:envelope,
envelope_or_number(grain_degree_spread),
:duration, dur)
loc = make_locsig(:degree, 45.0,
:distance, 1.0,
:output, @ws_output,
:revout, @ws_reverb,
:channels, @channels)
gr_start_sample = beg
gr_samples = 0
gr_offset = 1
gr_dens = 0.0
gr_dens_spread = 0.0
grain_counter = 0
samples = 0
first_grain = true
set_mus_increment(in_file_reader, -1) if reverse
loop do
if gr_offset < gr_samples
gr_where = env(gr_int_env) if interp_gr_envs
val = if interp_gr_envs
(1 - gr_where) * table_lookup(gr_env) +
gr_where * table_lookup(gr_env_end)
else
table_lookup(gr_env)
end
locsig(loc,
gr_start_sample + gr_offset,
val * env(amp_env) * readin(in_file_reader))
gr_offset += 1
else
if first_grain
first_grain = false
gr_start_sample = beg
else
gr_start_sample += seconds2samples(1.0 / (gr_dens + gr_dens_spread))
if (gr_start_sample > fin) or
(grains.nonzero? and (grain_counter >= grains))
break
end
end
gr_offset = 0
gr_from_beg = gr_start_sample - beg
set_mus_location(amp_env, gr_from_beg)
set_mus_location(gr_dur, gr_from_beg)
set_mus_location(gr_dur_spread, gr_from_beg)
set_mus_location(sr_env, gr_from_beg)
set_mus_location(sr_spread_env, gr_from_beg)
set_mus_location(gr_start, gr_from_beg)
set_mus_location(gr_start_spread, gr_from_beg)
set_mus_location(gr_dens_env, gr_from_beg)
set_mus_location(gr_dens_spread_env, gr_from_beg)
in_start_value = env(gr_start) * gr_start_scaler +
random_spread(env(gr_start_spread) * gr_start_scaler)
in_start = (in_start_value * in_file_sr).round
gr_duration = [grain_duration_limit,
env(gr_dur) + random_spread(env(gr_dur_spread))].max
gr_samples = seconds2samples(gr_duration)
gr_srate = if srate_linear
env(sr_env) + random_spread(env(sr_spread_env))
else
env(sr_env) * srate_base ** random_spread(env(sr_spread_env))
end
set_mus_increment(in_file_reader, gr_srate)
in_samples = gr_samples / (1.0 / srate_ratio)
set_mus_phase(gr_env, 0.0)
set_mus_phase(gr_env_end, 0.0)
set_mus_frequency(gr_env, 1.0 / gr_duration)
set_mus_frequency(gr_env_end, 1.0 / gr_duration)
gr_dens = env(gr_dens_env)
gr_dens_spread = random_spread(env(gr_dens_spread_env))
samples += gr_samples
grain_counter += 1
where = case where_to
when Grani_to_grain_duration
gr_duration
when Grani_to_grain_start
in_start_value
when Grani_to_grain_sample_rate
gr_srate
when Grani_to_grain_random
random(1.0)
else
Grani_to_locsig
end
if where.nonzero? and where_bins.length > 1
(where_bins.length - 1).times do |chn|
locsig_set!(loc, chn,
((where_bins[chn] < where and
where < where_bins[chn + 1]) ? 1.0 : 0.0))
end
else
if where_to == Grani_to_grain_allchans
@channels.times do |chn|
locsig_set!(loc, chn, 1.0)
end
else
set_mus_location(gr_dist, gr_from_beg)
set_mus_location(gr_dist_spread, gr_from_beg)
set_mus_location(gr_degree, gr_from_beg)
set_mus_location(gr_degree_spread, gr_from_beg)
deg = env(gr_degree) + random_spread(env(gr_degree_spread))
dist = env(gr_dist) + random_spread(env(gr_dist_spread))
dist_scl = 1.0 / [dist, 1.0].max
if @ws_reverb
locsig_reverb_set!(loc, 0,
reverb_amount * (1.0 / sqrt([dist, 1.0].max)))
end
if @channels == 1
locsig_set!(loc, 0, dist_scl)
else
if @channels == 2
frac = [90.0, [0.0, deg].max].min / 90.0
locsig_set!(loc, 0, dist_scl * (1.0 - frac))
locsig_set!(loc, 1, dist_scl * frac)
else
if @channels > 2
locsig_set!(loc, 0,
if 0 <= deg and deg <= 90
dist_scl * ((90.0 - deg) / 90.0)
else
if 270 <= deg and deg <= 360
dist_scl * ((deg - 270.0) / 90.0)
else
0.0
end
end)
locsig_set!(loc, 1,
if 90 <= deg and deg <= 180
dist_scl * (180.0 - deg) / 90.0
else
if 0 <= deg and deg <= 90
dist_scl * (deg / 90.0)
else
0.0
end
end)
locsig_set!(loc, 2,
if 180 <= deg and deg <= 270
dist_scl * (270.0 - deg) / 90.0
else
if 90 <= deg and deg <= 180
dist_scl * (deg - 90.0) / 90.0
else
0.0
end
end)
if @channels > 3
locsig_set!(loc, 3,
if 270 <= deg and deg <= 360
dist_scl * (360.0 - deg) / 90.0
else
if 180 <= deg and deg <= 270
dist_scl * (deg - 180.0) / 90.0
else
0.0
end
end)
end
end
end
end
end
end
in_start = if (in_start + in_samples) > last_in_sample
last_in_sample - in_samples
else
[in_start, 0].max
end
set_mus_location(in_file_reader, in_start)
end
end
mus_close(in_file_reader)
end

=begin
with_sound(:play, 1, :statistics, true, :channels, 1, :reverb, nil) do
grani(0.0, 2.0, 5.0, "oboe.snd", :grain_envelope, raised_cosine())
end
=end

# grani.rb ends here

+ 643
- 0
lib/sndlib/grani.scm View File

@@ -0,0 +1,643 @@
;;; *************************
;;; ENVELOPES (env.scm)
;;; *************************


;;;=============================================================================
;;; Exponential envelopes
;;;=============================================================================

;;; Approximate an exponential envelope with a given base and error bound
;;; by Fernando Lopez-Lezcano (nando@ccrma.stanford.edu)
;;;
;;; base:
;;; step size of the exponential envelope
;;; error:
;;; error band of the approximation
;;; scaler:
;;; scaling factor for the y coordinates
;;; offset:
;;; offset for the y coordinates
;;; cutoff:
;;; lowest value of the exponentially rendered envelope, values lower than
;;; this cutoff value will be approximated as cero.
;;; out-scaler
;;; scaler for the converted values

(provide 'snd-grani.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))
(require snd-env.scm)

(define grani-default-base (expt 2 1/12))

(define* (exp-envelope env1
(base grani-default-base)
(error 0.01)
(scaler 1)
(offset 0)
cutoff
(out-scaler 1))
(let ((base (* 1.0 base))
(error (* 1.0 error))
(scaler (* 1.0 scaler))
(offset (* 1.0 offset))
(out-scaler (* 1.0 out-scaler)))
(let ((ycutoff (and cutoff (expt base (+ offset (* cutoff scaler)))))
(result ()))
;; recursively render one segment
;; xl,xh = x coordinates of segment ends
;; yl,yh = y coordinates of segment ends
;; yle,yhe = exponential values of y coords of segment ends
;; error = linear domain error bound for rendering
(define (exp-seg xl yle xh yhe yl yh error)
;; linear interpolation
(define (interpolate xl yl xh yh xi)
(+ yl (* (- xi xl) (/ (- yh yl) (- xh xl)))))
(let* ((xint (/ (+ xl xh) 2.0))
(yint (interpolate xl yl xh yh xint))
(yexp (expt base yint)))
(let ((yinte (interpolate xl yle xh yhe xint))
(yerr (- (expt base (+ yint error)) yexp)))
;; is the linear approximation accurate enough?
;; are we still over the cutoff limit?
(if (not (and (> (abs (- yexp yinte)) yerr)
(or (not (real? ycutoff))
(> yinte ycutoff))))
;; yes --> don't need to add nu'ting to the envelope
(values () ())
;; no --> add a breakpoint and recurse right and left
((lambda (xi yi xj yj)
(values (append xi (cons xint xj))
(append yi (cons yexp yj))))
(exp-seg xl yle xint yexp yl yint error)
(exp-seg xint yexp xh yhe yint yh error))))))
;; loop for each segment in the envelope
(let segs ((en env1))
(let ((x (car en))
(yscl (+ offset (* (cadr en) scaler))))
(let ((nx (caddr en))
(nyscl (+ offset (* (cadddr en) scaler)))
(xy (list x (if (or (not (real? ycutoff))
(>= (expt base yscl) ycutoff))
(* out-scaler (expt base yscl))
0.0))))
(set! result (append result xy))
((lambda (xs ys)
(if (pair? ys)
(let vals ((xx xs)
(yy (map (lambda (y) (* y out-scaler)) ys)))
(let ((x (car xx))
(y (car yy)))
(set! result (append result (list x y)))
(if (pair? (cdr xx))
(vals (cdr xx) (cdr yy)))))))
(exp-seg x (expt base yscl) nx (expt base nyscl) yscl nyscl error))
(if (<= (length en) 4)
(append result (list nx (if (or (not (real? ycutoff))
(>= (expt base nyscl) ycutoff))
(* out-scaler (expt base nyscl))
0.0)))
(segs (cddr en)))))))))
;;; Amplitude envelope in dBs
;;;
;;; The db scale is defined as:
;;; value(db)=(* 20 (log10 (/ vin vref)))
;;; where:
;;; vref=1.0 reference value = digital clipping

(define* (db-envelope envelope (cutoff -70) (error 0.01))
(exp-envelope envelope
:base 10
:scaler 1/20
:offset 0
:cutoff cutoff
:error error))

(define* (make-db-env envelope
(scaler 1)
(offset 0)
(base 1)
(duration 0)
(end 0)
(cutoff -70)
(error 0.01))
(make-env (db-envelope envelope cutoff error)
:scaler scaler :offset offset
:base base :duration duration :length (+ 1 end)))

;;; Pitch envelopes (y units are semitone and octave intervals)

(define* (semitones-envelope envelope (around 1.0) (error 0.01))
(exp-envelope envelope
:error error
:base (expt 2 1/12)
:cutoff #f
:scaler 1
:offset 0
:out-scaler around))

(define* (make-semitones-env envelope
(around 1.0)
(scaler 1.0)
(offset 0.0)
(base 1)
(duration 0)
(end 0)
(error 0.01))
(make-env (semitones-envelope envelope around error)
:scaler scaler :offset offset
:base base :duration duration :length (+ 1 end)))

(define* (octaves-envelope envelope (around 1.0) (error 0.01))
(exp-envelope envelope
:error error
:base 2
:cutoff #f
:scaler 1
:offset 0
:out-scaler around))

(define* (make-octaves-env envelope
(around 1.0)
(scaler 1.0)
(offset 0.0)
(base 1)
(duration 0)
(end 0)
(error 0.01))
(make-env (octaves-envelope envelope around error)
:scaler scaler :offset offset
:base base :duration duration :length (+ 1 end)))


;;; *************************
;;; GRANI (clm-ins.scm)
;;; *************************

;;; grani: a granular synthesis instrument
;;; by Fernando Lopez-Lezcano
;;; http://ccrma.stanford.edu/~nando/clm/grani/
;;;
;;; Original grani.ins instrument written for the 220a Course by
;;; Fernando Lopez-Lezcano & Juan Pampin, November 6 1996
;;;
;;; Mar 21 1997: working with hop and grain-dur envelopes
;;; Mar 22 1997: working with src envelope (grain wise) & src spread
;;; Jan 26 1998: started work on new version
;;; Nov 7 1998: input soundfile duration calculation wrong
;;; Nov 10 1998: bug in in-samples (thanks to Kristopher D. Giesing for this one)
;;; Dec 20 1998: added standard locsig code
;;; Feb 19 1999: added "nil" as default value of where to avoid warning (by bill)
;;; Jan 10 2000: added input-channel to select which channel of the input file
;;; to process.
;;; added grain-start-in-seconds to be able to specify input file
;;; locations in seconds for the grain-start envelope
;;; May 06 2002: fixed array passing of where-bins in clisp (reported by Charles
;;; Nichols and jennifer l doering
;;; Mar 27 2003: added option for sending grains to all channels (requested by
;;; Oded Ben-Tal)
;;; Jun 17 2006: made some changes for the run macro (Bill)
;;; Jul 14 2007: removed :start args (Bill)
;;;-----------------------------------------------------------------------------
;;; Auxiliary functions

;;; calculate a random spread around a center of 0

(define-macro (random-spread spread)
`(if (not (zero? ,spread))
(- (random ,spread)
(/ ,spread 2.0))
0.0))

;;; convert a time in seconds to a number of samples

(define-macro (to-samples time srate)
`(floor (* ,time ,srate)))

;;; create a constant envelope if argument is a number

(define (envelope-or-number in)
(if (number? in)
(list 0 in 1 in)
in))

;;; create a float-vector from an envelope

(define* (make-gr-env env1 (len 512))
(let ((env-float-vector (make-float-vector len))
(length-1 (* 1.0 (- len 1))))
(do ((i 0 (+ 1 i)))
((= i len) env-float-vector)
(set! (env-float-vector i) (envelope-interp (/ i length-1) env1)))))

;;;-----------------------------------------------------------------------------
;;; Grain envelopes

(define* (raised-cosine (duty-cycle 100)
(len 128))
(let ((active (* len duty-cycle 0.01)))
(let ((v (make-float-vector len))
(incr (/ pi (- active 1)))
(start (max 0 (/ (- len active) 2)))
(end (min len (/ (+ len active) 2))))
(do ((i start (+ i 1))
(s 0.0 (+ s incr)))
((= i end) v)
(let ((sine (sin s)))
(set! (v i) (* sine sine)))))))

;;;=============================================================================
;;; Granular synthesis instrument
;;;=============================================================================

;;; input-channel:
;;; from which channel in the input file are samples read
;;; amp-envelope:
;;; amplitude envelope for the note
;;; grain-envelope:
;;; grain-envelope-end:
;;; envelopes for each individual grain. The envelope applied in the result
;;; of interpolating both envelopes. The interpolation is controlled by
;;; grain-envelope-trasition. If "grain-envelope-end" is nil interpolation
;;; is turned off and only grain-envelope is applied to the grains.
;;; grain-envelope-trasition:
;;; an enveloper that controls the interpolation between the two grain envelopes
;;; 0 -> selects "grain-envelope"
;;; 1 -> selects "grain-envelope-end"
;;; grain-envelope-array-size
;;; size of the array passed to make-table-lookup
;;; grain-duration:
;;; envelope that controls grain duration in seconds
;;; srate-linear:
;;; #t -> sample rate envelope is linear
;;; #f -> sample rate envelope is exponential
;;; srate:
;;; envelope that controls sample rate conversion. The envelope is an
;;; exponential envelope, the base and error bound of the conversion
;;; are controlled by "srate-base" and "srate-error".
;;; srate-spread:
;;; random spread of sample rate conversion around "srate"
;;; srate-base:
;;; base for the exponential conversion
;;; for example: base = (expt 2 (/ 12)) creates a semitone envelope
;;; srate-error:
;;; error bound for the exponential conversion.
;;; grain-start:
;;; envelope that determines the starting point of the current grain in
;;; the input file. "y"->0 starts the grain at the beginning of the input
;;; file. "y"->1 starts the grain at the end of the input file.
;;; grain-start-spread:
;;; random spread around the value of "grain-start"
;;; grain-start-in-seconds:
;;; #f -> grain-start y envelope expressed in percent of the duration of the input file
;;; #t -> grain-start y envelope expressed in seconds
;;; grain-density:
;;; envelope that controls the number of grains per second generated in the output file
;;; grain-density-spread:
;;; envelope that controls a random variation of density

(define grani-to-locsig 0.0)
(define grani-to-grain-duration 1)
(define grani-to-grain-start 2)
(define grani-to-grain-sample-rate 3)
(define grani-to-grain-random 4)
(define grani-to-grain-allchans 5)

(definstrument (grani start-time duration amplitude file
(input-channel 0)
(grains 0)
(amp-envelope '(0 0 0.3 1 0.7 1 1 0))
(grain-envelope '(0 0 0.3 1 0.7 1 1 0))
grain-envelope-end
(grain-envelope-transition '(0 0 1 1))
(grain-envelope-array-size 512)
(grain-duration 0.1)
(grain-duration-spread 0.0)
(grain-duration-limit 0.002)
(srate 0.0)
(srate-spread 0.0)
srate-linear
(srate-base grani-default-base)
(srate-error 0.01)
(grain-start '(0 0 1 1))
(grain-start-spread 0.0)
grain-start-in-seconds
(grain-density 10.0)
(grain-density-spread 0.0)
(reverb-amount 0.01)
reversed ; change this from "reverse" 18-Nov-13
(where-to 0)
where-bins ; a float-vector, not a list
(grain-distance 1.0)
(grain-distance-spread 0.0)
(grain-degree 45.0)
(grain-degree-spread 0.0)
(verbose #t))
(let ((ts (times->samples start-time duration))
(in-file-channels (channels file))
(in-file-sr (* 1.0 (mus-sound-srate file))))

(let ((beg (car ts))
(end (cadr ts))
(in-file-dur (/ (framples file) in-file-sr))
(out-chans (channels *output*))
(gr-samples 0)
;; ratio between input and output sampling rates
(srate-ratio (/ in-file-sr *clm-srate*))
;; sample rate converter for input samples
(rd (make-readin :file file :channel (min input-channel (- in-file-channels 1)))))
(let ((last-in-sample (floor (* in-file-dur in-file-sr)))
(in-file-reader (make-src :input rd :srate 1.0))
;; sample rate conversion envelope
(sr-env (make-env (if srate-linear
(envelope-or-number srate)
(exp-envelope (envelope-or-number srate)
:base srate-base
:error srate-error))
:scaler srate-ratio
:duration duration))
;; sample rate conversion random spread
(sr-spread-env (make-env (envelope-or-number srate-spread)
:duration duration))
;; amplitude envelope for the note
(amp-env (make-env amp-envelope
:scaler amplitude
:duration duration))
;; grain duration envelope
(gr-dur (make-env (envelope-or-number grain-duration)
:duration duration))
(gr-dur-spread (make-env (envelope-or-number grain-duration-spread)
:duration duration))
;; position in the input file where the grain starts
(gr-start-scaler (if (not grain-start-in-seconds) in-file-dur 1.0))
(gr-start (make-env (envelope-or-number grain-start)
:duration duration))
;; random variation in the position in the input file
(gr-start-spread (make-env (envelope-or-number grain-start-spread)
:duration duration))
;; density envelope in grains per second
(gr-dens-env (make-env (envelope-or-number grain-density)
:duration duration))
;; density spread envelope in grains per second
(gr-dens-spread-env (make-env (envelope-or-number grain-density-spread)
:duration duration))
;; grain envelope
(gr-env (make-table-lookup :frequency 1.0
:initial-phase 0.0
:wave (if (float-vector? grain-envelope)
grain-envelope
(make-gr-env grain-envelope
grain-envelope-array-size))))
;; grain envelope
(gr-env-end (make-table-lookup :frequency 1.0
:initial-phase 0.0
:wave (if grain-envelope-end
(if (float-vector? grain-envelope-end)
grain-envelope-end
(make-gr-env grain-envelope-end
grain-envelope-array-size))
(make-float-vector 512))))
;; envelope for transition between grain envelopes
(gr-int-env (make-env (envelope-or-number grain-envelope-transition) :duration duration))
(gr-int-env-1 (make-env (envelope-or-number grain-envelope-transition) :duration duration :offset 1.0 :scaler -1.0))
(interp-gr-envs grain-envelope-end)
;; envelope for distance of grains (for using in locsig)
(gr-dist (make-env (envelope-or-number grain-distance)
:duration duration))
(gr-dist-spread (make-env (envelope-or-number grain-distance-spread)
:duration duration))
;; envelopes for angular location and spread of grain in the stereo field
(gr-degree (make-env (envelope-or-number grain-degree)
:duration duration))
(gr-degree-spread (make-env (envelope-or-number grain-degree-spread)
:duration duration))
;; signal locator in the stereo image
(loc (make-locsig :degree 45.0
:distance 1.0
:channels out-chans))
(in-samples 0)
(gr-start-sample beg)
(gr-from-beg 0)
(in-start 0)
(in-start-value 0.0)
(gr-duration 0.0)
(gr-dens 0.0)
(gr-dens-spread 0.0)
(gr-srate 0.0)
(grain-counter 0)
(first-grain #t)
(where 0.0)
(happy #t)
(where-bins-len (if (float-vector? where-bins) (length where-bins) 0)))
(if (<= where-bins-len 1)
(set! where-bins #f))

(if reversed (set! (mus-increment in-file-reader) -1.0))
(do ()
((not happy))
;;
;; start of a new grain
;;
(if first-grain
;; first grain always starts at 0
(begin
(set! first-grain #f)
(set! gr-start-sample beg))
(begin
;; start grain in output file using
;; increments from previous grain
(set! gr-start-sample (+ gr-start-sample
(floor
(* (/ (+ gr-dens gr-dens-spread)) *clm-srate*))))
;; finish if start of grain falls outside of note
;; bounds or number of grains exceeded
(if (or (> gr-start-sample end)
(and (not (zero? grains))
(>= grain-counter grains)))
(set! happy #f))))
(when happy
;; back to the beginning of the grain
;(set! gr-offset 0)
;; start of grain in samples from beginning of note
(set! gr-from-beg (floor (- gr-start-sample beg)))
;; reset out-time dependent envelopes to current time
(set! (mus-location amp-env) gr-from-beg)
(set! (mus-location gr-dur) gr-from-beg)
(set! (mus-location gr-dur-spread) gr-from-beg)
(set! (mus-location sr-env) gr-from-beg)
(set! (mus-location sr-spread-env) gr-from-beg)
(set! (mus-location gr-start) gr-from-beg)
(set! (mus-location gr-start-spread) gr-from-beg)
(set! (mus-location gr-dens-env) gr-from-beg)
(set! (mus-location gr-dens-spread-env) gr-from-beg)
;; start of grain in input file
(set! in-start-value (+ (* (env gr-start) gr-start-scaler)
(mus-random (* 0.5 (env gr-start-spread)
gr-start-scaler))))
(set! in-start (floor (* in-start-value in-file-sr)))
;; duration in seconds of the grain
(set! gr-duration (max grain-duration-limit
(+ (env gr-dur)
(mus-random (* 0.5 (env gr-dur-spread))))))
;; number of samples in the grain
(set! gr-samples (floor (* gr-duration *clm-srate*)))
;; new sample rate for grain
(set! gr-srate (if srate-linear
(+ (env sr-env)
(mus-random (* 0.5 (env sr-spread-env))))
(* (env sr-env)
(expt srate-base
(mus-random (* 0.5 (env sr-spread-env)))))))
;; set new sampling rate conversion factor
(set! (mus-increment in-file-reader) gr-srate)
;; number of samples in input
(set! in-samples (floor (* gr-samples srate-ratio)))
;; check for out of bounds condition in in-file pointers
(set! in-start (if (> (+ in-start in-samples) last-in-sample)
(- last-in-sample in-samples)
(max in-start 0)))
;; reset position of input file reader
(set! (mus-location rd) in-start)
;; restart grain envelopes
(set! (mus-phase gr-env) 0.0)
(set! (mus-phase gr-env-end) 0.0)
;; reset grain envelope durations
(set! (mus-frequency gr-env) (/ gr-duration))
(set! (mus-frequency gr-env-end) (/ gr-duration))
;;
;; move position in output file for next grain
;;
(set! gr-dens (env gr-dens-env))
;; increment spread in output file for next grain
(set! gr-dens-spread (mus-random (* 0.5 (env gr-dens-spread-env))))
(set! grain-counter (+ grain-counter 1))
(set! where (cond (;; use duration of grains as delimiter
(= where-to grani-to-grain-duration)
gr-duration)
(;; use start in input file as delimiter
(= where-to grani-to-grain-start)
in-start-value)
(;; use sampling rate as delimiter
(= where-to grani-to-grain-sample-rate)
gr-srate)
(;; use a random number as delimiter
(= where-to grani-to-grain-random)
(random 1.0))
(else grani-to-locsig)))
(if (and where-bins
(not (zero? where)))
;; set output scalers according to criteria
(do ((chn 0 (+ chn 1)))
((or (= chn out-chans)
(= chn where-bins-len)))
(locsig-set! loc chn (if (< (where-bins chn)
where
(where-bins (+ chn 1)))
1.0
0.0)))
;; if not "where" see if the user wants to send to all channels
(if (= where-to grani-to-grain-allchans)
;; send the grain to all channels
(do ((chn 0 (+ chn 1)))
((= chn out-chans))
(locsig-set! loc chn 1.0))
;; "where" is zero or unknown: use normal n-channel locsig,
;; only understands mono reverb and 1, 2 or 4 channel output
(begin
(set! (mus-location gr-dist) gr-from-beg)
(set! (mus-location gr-dist-spread) gr-from-beg)
(set! (mus-location gr-degree) gr-from-beg)
(set! (mus-location gr-degree-spread) gr-from-beg)
;; set locsig parameters, for now only understands stereo
(move-locsig loc
(+ (env gr-degree)
(mus-random (* 0.5 (env gr-degree-spread))))
(+ (env gr-dist)
(mus-random (* 0.5 (env gr-dist-spread))))))))
(let ((grend (+ gr-start-sample gr-samples)))
(if interp-gr-envs
(do ((gr-offset gr-start-sample (+ gr-offset 1)))
((= gr-offset grend))
(locsig loc gr-offset (* (env amp-env)
(src in-file-reader)
(+ (* (env gr-int-env) (table-lookup gr-env-end))
(* (env gr-int-env-1) (table-lookup gr-env))))))
(do ((gr-offset gr-start-sample (+ gr-offset 1)))
((= gr-offset grend))
(locsig loc gr-offset (* (env amp-env)
(table-lookup gr-env)
(src in-file-reader))))))))))))


;; (with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))
;; (with-sound (:channels 2) (let ((file "oboe.snd")) (grani 0 2 5 file :grain-envelope (raised-cosine))))

(define (test-grani)
(with-sound (:channels 2 :reverb jc-reverb :reverb-channels 1 :statistics #t)
(grani 0 1 .5 "oboe.snd" :grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0))
(grani 0 4 1 "oboe.snd")
(grani 0 4 1 "oboe.snd" :grains 10)
(grani 0 4 1 "oboe.snd"
:grain-start 0.11
:amp-envelope '(0 1 1 1) :grain-density 8
:grain-envelope '(0 0 0.2 0.2 0.5 1 0.8 0.2 1 0)
:grain-envelope-end '(0 0 0.01 1 0.99 1 1 0)
:grain-envelope-transition '(0 0 0.4 1 0.8 0 1 0))
(grani 0 3 1 "oboe.snd"
:grain-start 0.1
:amp-envelope '(0 1 1 1) :grain-density 20
:grain-duration '(0 0.003 0.2 0.01 1 0.3))
(grani 0 3 1 "oboe.snd"
:grain-start 0.1
:amp-envelope '(0 1 1 1) :grain-density 20
:grain-duration '(0 0.003 0.2 0.01 1 0.3)
:grain-duration-limit 0.02)
(grani 0 2 1 "oboe.snd"
:amp-envelope '(0 1 1 1) :grain-density 40
:grain-start '(0 0.1 0.3 0.1 1 0.6))
(grani 0 2 1 "oboe.snd"
:amp-envelope '(0 1 1 1) :grain-density 40
:grain-start '(0 0.1 0.3 0.1 1 0.6)
:grain-start-spread 0.01)
(grani 0 2.6 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
:srate '(0 0 0.2 0 0.6 5 1 5))
(grani 0 2.6 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
:srate-base 2
:srate '(0 0 0.2 0 0.6 -1 1 -1))
(grani 0 2.6 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
:srate-linear #t
:srate (list 0 1 0.2 1 0.6 (expt 2 5/12) 1 (expt 2 5/12)))
(grani 0 2 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
:grain-duration '(0 0.02 1 0.1)
:grain-duration-spread '(0 0 0.5 0.1 1 0)
:where-to grani-to-grain-duration ; from grani.scm
:where-bins (float-vector 0 0.05 1))
(grani 0 2 1 "oboe.snd"
:grain-start 0.1 :grain-start-spread 0.01
:amp-envelope '(0 1 1 1) :grain-density 40
:grain-degree '(0 0 1 90)
:grain-degree-spread 10)))

+ 7085
- 0
lib/sndlib/headers.c
File diff suppressed because it is too large
View File


+ 250
- 0
lib/sndlib/install-sh View File

@@ -0,0 +1,250 @@
#! /bin/sh
#
# install - install a program, script, or datafile
# This comes from X11R5 (mit/util/scripts/install.sh).
#
# Copyright 1991 by the Massachusetts Institute of Technology
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of M.I.T. not be used in advertising or
# publicity pertaining to distribution of the software without specific,
# written prior permission. M.I.T. makes no representations about the
# suitability of this software for any purpose. It is provided "as is"
# without express or implied warranty.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# `make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch. It can only install one file at a time, a restriction
# shared with many OS's install programs.


# set DOITPROG to echo to test this script

# Don't use :- since 4.3BSD and earlier shells don't like it.
doit="${DOITPROG-}"


# put in absolute paths if you don't have them in your path; or use env. vars.

mvprog="${MVPROG-mv}"
cpprog="${CPPROG-cp}"
chmodprog="${CHMODPROG-chmod}"
chownprog="${CHOWNPROG-chown}"
chgrpprog="${CHGRPPROG-chgrp}"
stripprog="${STRIPPROG-strip}"
rmprog="${RMPROG-rm}"
mkdirprog="${MKDIRPROG-mkdir}"

transformbasename=""
transform_arg=""
instcmd="$mvprog"
chmodcmd="$chmodprog 0755"
chowncmd=""
chgrpcmd=""
stripcmd=""
rmcmd="$rmprog -f"
mvcmd="$mvprog"
src=""
dst=""
dir_arg=""

while [ x"$1" != x ]; do
case $1 in
-c) instcmd="$cpprog"
shift
continue;;

-d) dir_arg=true
shift
continue;;

-m) chmodcmd="$chmodprog $2"
shift
shift
continue;;

-o) chowncmd="$chownprog $2"
shift
shift
continue;;

-g) chgrpcmd="$chgrpprog $2"
shift
shift
continue;;

-s) stripcmd="$stripprog"
shift
continue;;

-t=*) transformarg=`echo $1 | sed 's/-t=//'`
shift
continue;;

-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
shift
continue;;

*) if [ x"$src" = x ]
then
src=$1
else
# this colon is to work around a 386BSD /bin/sh bug
:
dst=$1
fi
shift
continue;;
esac
done

if [ x"$src" = x ]
then
echo "install: no input file specified"
exit 1
else
true
fi

if [ x"$dir_arg" != x ]; then
dst=$src
src=""
if [ -d $dst ]; then
instcmd=:
else
instcmd=mkdir
fi
else

# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
# might cause directories to be created, which would be especially bad
# if $src (and thus $dsttmp) contains '*'.

if [ -f $src -o -d $src ]
then
true
else
echo "install: $src does not exist"
exit 1
fi
if [ x"$dst" = x ]
then
echo "install: no destination specified"
exit 1
else
true
fi

# If destination is a directory, append the input filename; if your system
# does not like double slashes in filenames, you may need to add some logic

if [ -d $dst ]
then
dst="$dst"/`basename $src`
else
true
fi
fi

## this sed command emulates the dirname command
dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`

# Make sure that the destination directory exists.
# this part is taken from Noah Friedman's mkinstalldirs script

# Skip lots of stat calls in the usual case.
if [ ! -d "$dstdir" ]; then
defaultIFS='
'
IFS="${IFS-${defaultIFS}}"

oIFS="${IFS}"
# Some sh's can't handle IFS=/ for some reason.
IFS='%'
set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
IFS="${oIFS}"

pathcomp=''

while [ $# -ne 0 ] ; do
pathcomp="${pathcomp}${1}"
shift

if [ ! -d "${pathcomp}" ] ;
then
$mkdirprog "${pathcomp}"
else
true
fi

pathcomp="${pathcomp}/"
done
fi

if [ x"$dir_arg" != x ]
then
$doit $instcmd $dst &&

if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
else

# If we're going to rename the final executable, determine the name now.

if [ x"$transformarg" = x ]
then
dstfile=`basename $dst`
else
dstfile=`basename $dst $transformbasename |
sed $transformarg`$transformbasename
fi

# don't allow the sed command to completely eliminate the filename

if [ x"$dstfile" = x ]
then
dstfile=`basename $dst`
else
true
fi

# Make a temp file name in the proper directory.

dsttmp=$dstdir/#inst.$$#

# Move or copy the file name to the temp name

$doit $instcmd $src $dsttmp &&

trap "rm -f ${dsttmp}" 0 &&

# and set any options; do chmod last to preserve setuid bits

# If any of these fail, we abort the whole thing. If we want to
# ignore errors from any of these, just make sure not to ignore
# errors from the above "$doit $instcmd $src $dsttmp" command.

if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&

# Now rename the file to the real destination.

$doit $rmcmd -f $dstdir/$dstfile &&
$doit $mvcmd $dsttmp $dstdir/$dstfile

fi &&


exit 0

+ 3363
- 0
lib/sndlib/io.c
File diff suppressed because it is too large
View File


+ 45
- 0
lib/sndlib/jcrev.scm View File

@@ -0,0 +1,45 @@
(provide 'snd-jcrev.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))


(definstrument (jc-reverb low-pass (volume 1.0) amp-env)
"(jc-reverb (low-pass #f) (volume 1.0) (amp-env #f)) -- Chowning reverb"
(let ((allpass1 (make-all-pass -0.700 0.700 1051))
(allpass2 (make-all-pass -0.700 0.700 337))
(allpass3 (make-all-pass -0.700 0.700 113))
(comb1 (make-comb 0.742 4799))
(comb2 (make-comb 0.733 4999))
(comb3 (make-comb 0.715 5399))
(comb4 (make-comb 0.697 5801))
(chns (channels *output*))
(file-dur (framples *reverb*)))

(let ((len (floor (+ *clm-srate* file-dur)))
(filts (if (= chns 1)
(vector (make-delay (seconds->samples .013)))
(vector (make-delay (seconds->samples .013))
(make-delay (seconds->samples .011)))))
(combs (make-comb-bank (vector comb1 comb2 comb3 comb4)))
(allpasses (make-all-pass-bank (vector allpass1 allpass2 allpass3))))

(if (or amp-env low-pass)
(let ((flt (and low-pass (make-fir-filter 3 (float-vector 0.25 0.5 0.25))))
(envA (make-env :envelope (or amp-env '(0 1 1 1)) :scaler volume :duration (/ len *clm-srate*))))
(if low-pass
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i (* (env envA) (fir-filter flt (comb-bank combs (all-pass-bank allpasses (ina i *reverb*)))))))
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i (* (env envA) (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))
(do ((i 0 (+ i 1)))
((= i len))
(out-bank filts i (* volume (comb-bank combs (all-pass-bank allpasses (ina i *reverb*))))))))))
;;; (with-sound (:reverb jc-reverb) (fm-violin 0 .1 440 .1 :reverb-amount .3))
;;; (with-sound (:reverb jc-reverb) (outa 0 .1) (outa 0 .5 *reverb*))
;;; (with-sound (:reverb jc-reverb :reverb-data '((:low-pass #t))) (outa 0 .1) (outa 0 .5 *reverb*))
;;; (with-sound (:statistics #t :reverb jc-reverb :reverb-data '((:low-pass #t))) (outa 0 .1) (outa 100000 .1) (outa 0 .5 *reverb*) (outa 100000 .5 *reverb*))

+ 263
- 0
lib/sndlib/jcvoi.scm View File

@@ -0,0 +1,263 @@
;;; from VOIDAT.SAI[220,JDC] and GLSVOI.SAI[220,JDC], then (30 years later) jcvoi.ins

(provide 'snd-jcvoi.scm)
(require snd-env.scm)

(define fnc #f) ;; fnc[sex,vowel,formant number,formant freq,amp or fm index]
(define vibfreqfun #f)
(define i3fun1 #f)
(define i3fun2 #f)

(define (flipxy data) ; SEG functions expected data in (y x) pairs.
(let ((unseg ())
(len (length data)))
(do ((i 0 (+ i 2)))
((>= i len)
(reverse unseg))
(let ((x (data (+ 1 i)))
(y (data i)))
(set! unseg (cons y (cons x unseg)))))))

(define (addenv env1 sc1 off1 env2 sc2 off2)
(add-envelopes (scale-envelope env1 sc1 off1)
(scale-envelope env2 sc2 off2)))

(define (checkpt att dur)
(if (not (positive? att))
(* 100 (/ .01 dur))
(if (< att dur)
(* 100 (/ att dur))
100)))

(define (setf-aref vect a b c d val)
(set! (vect (+ a (* 3 b) (* 18 c) (* 72 d))) val))
(define (aref vect a b c d)
(vect (+ a (* 3 b) (* 18 c) (* 72 d))))
(define (fillfnc)
(unless fnc
(set! fnc (make-vector 288 ())) ; 288 = (* 3 6 4 4)
(set! vibfreqfun (make-vector 3 ()))
(set! i3fun1 (make-vector 3 ()))
(set! i3fun2 (make-vector 3 ()))
(setf-aref fnc 1 1 1 1 (flipxy '(350 130.8 524 261.6 392 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 1 1 2 (flipxy '(.3 130.8 .8 261.6 .9 392 .9 523.2 .7 784 .86 1064 .86 1568)))
(setf-aref fnc 1 1 1 3 (flipxy '(1.4 130.8 1.4 261.6 1.0 392 .8 523.2 .5 784 .3 1064 .2 1568)))
(setf-aref fnc 1 1 2 1 (flipxy '(1100 130.8 1100 261.6 1100 392 1200 523.2 1500 784 1800 1064 2200 1568)))
(setf-aref fnc 1 1 2 2 (flipxy '(.1 130.8 .2 261.6 .3 392 .3 523.2 .1 784 .05 1064 .05 1568)))
(setf-aref fnc 1 1 2 3 (flipxy '(1.0 130.8 1.0 261.6 .4 392 .4 523.2 .2 784 .2 1064 .1 1568)))
(setf-aref fnc 1 1 3 1 (flipxy '(3450 130.8 3400 261.6 3400 392 3600 523.2 4500 784 5000 1064 5800 1568)))
(setf-aref fnc 1 1 3 2 (flipxy '(.04 130.8 .04 261.6 .04 392 .045 523.2 .03 784 .02 1064 .02 1568)))
(setf-aref fnc 1 1 3 3 (flipxy '(3.5 130.8 2.0 261.6 1.5 392 1.2 523.2 .8 784 .8 1064 1.0 1568)))
(setf-aref fnc 1 2 1 1 (flipxy '(175 130.8 262 261.6 392 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 2 1 2 (flipxy '(.25 130.8 .6 261.6 .6 392 .6 523.2 .7 784 .86 1064 .86 1568)))
(setf-aref fnc 1 2 1 3 (flipxy '(0.5 130.8 0.3 261.6 0.1 392 .05 523.2 .04 784 .03 1064 .02 1568)))
(setf-aref fnc 1 2 2 1 (flipxy '(2900 130.8 2700 261.6 2600 392 2400 523.2 2300 784 2200 1064 2100 1568)))
(setf-aref fnc 1 2 2 2 (flipxy '(.01 130.8 .05 261.6 .08 392 .1 523.2 .1 784 .1 1064 .05 1568)))
(setf-aref fnc 1 2 2 3 (flipxy '(1.5 130.8 1.0 261.6 1.0 392 1.0 523.2 1.0 784 1.0 1064 .5 1568)))
(setf-aref fnc 1 2 3 1 (flipxy '(4200 130.8 3900 261.6 3900 392 3900 523.2 3800 784 3700 1064 3600 1568)))
(setf-aref fnc 1 2 3 2 (flipxy '(.01 130.8 .04 261.6 .03 392 .03 523.2 .03 784 .03 1064 .02 1568)))
(setf-aref fnc 1 2 3 3 (flipxy '(1.2 130.8 .8 261.6 .8 392 .8 523.2 .8 784 .8 1064 .5 1568)))
(setf-aref fnc 1 3 1 1 (flipxy '(175 130.8 262 261.6 392 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 3 1 2 (flipxy '(.3 130.8 .7 261.6 .8 392 .6 523.2 .7 784 .86 1064 .86 1568)))
(setf-aref fnc 1 3 1 3 (flipxy '(0.4 130.8 0.2 261.6 0.4 392 .4 523.2 .7 784 .5 1064 .2 1568)))
(setf-aref fnc 1 3 2 1 (flipxy '(1000 130.8 1000 261.6 1100 392 1200 523.2 1400 784 1800 1064 2200 1568)))
(setf-aref fnc 1 3 2 2 (flipxy '(.055 130.8 .1 261.6 .15 392 .13 523.2 .1 784 .1 1064 .05 1568)))
(setf-aref fnc 1 3 2 3 (flipxy '(0.3 130.8 0.4 261.6 0.4 392 0.4 523.2 0.3 784 0.2 1064 0.1 1568)))
(setf-aref fnc 1 3 3 1 (flipxy '(2600 130.8 2600 261.6 3000 392 3400 523.2 4500 784 5000 1064 5800 1568)))
(setf-aref fnc 1 3 3 2 (flipxy '(.005 130.8 .03 261.6 .04 392 .04 523.2 .02 784 .02 1064 .02 1568)))
(setf-aref fnc 1 3 3 3 (flipxy '(1.1 130.8 1.0 261.6 1.2 392 1.2 523.2 0.8 784 0.8 1064 1.0 1568)))
(setf-aref fnc 1 4 1 1 (flipxy '(353 130.8 530 261.6 530 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 4 1 2 (flipxy '(.5 130.8 .8 261.6 .8 392 .6 523.2 .7 784 .86 1064 .86 1568)))
(setf-aref fnc 1 4 1 3 (flipxy '(0.6 130.8 0.7 261.6 1.0 392 0.8 523.2 .7 784 .5 1064 .2 1568)))
(setf-aref fnc 1 4 2 1 (flipxy '(1040 130.8 1040 261.6 1040 392 1200 523.2 1400 784 1800 1064 2200 1568)))
(setf-aref fnc 1 4 2 2 (flipxy '(.050 130.8 .05 261.6 .1 392 .2 523.2 .1 784 .1 1064 .05 1568)))
(setf-aref fnc 1 4 2 3 (flipxy '(0.1 130.8 0.1 261.6 0.1 392 0.4 523.2 0.3 784 0.2 1064 0.1 1568)))
(setf-aref fnc 1 4 3 1 (flipxy '(2695 130.8 2695 261.6 2695 392 3400 523.2 4500 784 5000 1064 5800 1568)))
(setf-aref fnc 1 4 3 2 (flipxy '( .05 130.8 .05 261.6 .04 392 .04 523.2 .02 784 .02 1064 .02 1568)))
(setf-aref fnc 1 4 3 3 (flipxy '(1.2 130.8 1.2 261.6 1.2 392 1.2 523.2 0.8 784 0.8 1064 1.0 1568)))
(setf-aref fnc 1 5 1 1 (flipxy '(175 130.8 262 261.6 392 392 523 523.2 784 784 1046 1064 1568 1568)))
(setf-aref fnc 1 5 1 2 (flipxy '(.4 130.8 .4 261.6 .8 392 .8 523.2 .8 784 .8 1064 .8 1568)))
(setf-aref fnc 1 5 1 3 (flipxy '(0.1 130.8 0.1 261.6 0.1 392 0.1 523.2 .0 784 .0 1064 .0 1568)))
(setf-aref fnc 1 5 2 1 (flipxy '( 350 130.8 524 261.6 784 392 950 523.2 1568 784 2092 1064 3136 1568)))
(setf-aref fnc 1 5 2 2 (flipxy '(.8 130.8 .8 261.6 .4 392 .2 523.2 .1 784 .1 1064 .0 1568)))
(setf-aref fnc 1 5 2 3 (flipxy '(0.5 130.8 0.1 261.6 0.1 392 0.1 523.2 0.0 784 0.0 1064 0.0 1568)))
(setf-aref fnc 1 5 3 1 (flipxy '(2700 130.8 2700 261.6 2500 392 2450 523.2 2400 784 2350 1064 4500 1568)))
(setf-aref fnc 1 5 3 2 (flipxy '( .1 130.8 .15 261.6 .15 392 .15 523.2 .15 784 .1 1064 .1 1568)))
(setf-aref fnc 1 5 3 3 (flipxy '(2.0 130.8 1.6 261.6 1.6 392 1.6 523.2 1.6 784 1.6 1064 1.0 1568)))
(setf-aref fnc 2 1 1 1 (flipxy '( 33 16.5 33 24.5 33 32.7 49 49.0 65 65.41 98 98 131 130.8)))
(setf-aref fnc 2 1 1 2 (flipxy '( .3 16.5 .5 24.5 .6 32.7 .5 49.0 .47 65.41 .135 98 .2 130.8)))
(setf-aref fnc 2 1 1 3 (flipxy '(2.4 16.5 2.0 24.5 1.8 32.7 1.6 49.0 1.5 65.41 1.2 98 .8 130.8)))
(setf-aref fnc 2 1 2 1 (flipxy '(400 16.5 400 24.5 400 32.7 400 49.0 400 65.41 400 98 400 130.8)))
(setf-aref fnc 2 1 2 2 (flipxy '( .2 16.5 .2 24.5 .35 32.7 .37 49.0 .4 65.41 .6 98 .8 130.8)))
(setf-aref fnc 2 1 2 3 (flipxy '(6.0 16.5 5.0 24.5 4.0 32.7 3.0 49.0 2.7 65.41 2.2 98 1.8 130.8)))
(setf-aref fnc 2 1 3 1 (flipxy '(2142 16.5 2142 24.5 2142 32.7 2142 49.0 2142 65.41 2142 98 2142 130.8)))
(setf-aref fnc 2 1 3 2 (flipxy '(.02 16.5 .025 24.5 .05 32.7 .09 49.0 .13 65.41 .29 98 .4 130.8)))
(setf-aref fnc 2 1 3 3 (flipxy '(9.0 16.5 8.0 24.5 7.2 32.7 5.5 49.0 3.9 65.41 3.0 98 1.8 130.8)))
(setf-aref fnc 2 2 1 1 (flipxy '( 33 16.5 33 24.5 33 32.7 49 49.0 65 65.41 98 98 131 130.8)))
(setf-aref fnc 2 2 1 2 (flipxy '( .75 16.5 .83 24.5 .91 32.7 .91 49.0 .91 65.41 .79 98 .67 130.8)))
(setf-aref fnc 2 2 1 3 (flipxy '(2.5 16.5 2.5 24.5 2.5 32.7 2.1 49.0 1.8 65.41 1.4 98 1.0 130.8)))
(setf-aref fnc 2 2 2 1 (flipxy '(1500 16.5 1500 24.5 1500 32.7 1500 49.0 1500 65.41 1500 98 1500 130.8)))
(setf-aref fnc 2 2 2 2 (flipxy '( .01 16.5 .02 24.5 .02 32.7 .02 49.0 .02 65.41 .08 98 .08 130.8)))
(setf-aref fnc 2 2 2 3 (flipxy '(1.5 16.5 1.37 24.5 1.25 32.7 1.07 49.0 0.9 65.41 0.7 98 0.5 130.8)))
(setf-aref fnc 2 2 3 1 (flipxy '(2300 16.5 2300 24.5 2300 32.7 2325 49.0 2350 65.41 2375 98 2400 130.8)))
(setf-aref fnc 2 2 3 2 (flipxy '(.05 16.5 .065 24.5 .70 32.7 .07 49.0 .07 65.41 .16 98 .2 130.8)))
(setf-aref fnc 2 2 3 3 (flipxy '(11.0 16.5 10.0 24.5 10.0 32.7 7.7 49.0 5.4 65.41 3.7 98 2.0 130.8)))
(setf-aref fnc 2 3 1 1 (flipxy '( 33 16.5 33 24.5 33 32.7 49 49.0 65 65.41 98 98 131 130.8)))
(setf-aref fnc 2 3 1 2 (flipxy '( .75 16.5 .83 24.5 .87 32.7 .88 49.0 .90 65.41 .87 98 .85 130.8)))
(setf-aref fnc 2 3 1 3 (flipxy '(1.4 16.5 1.4 24.5 1.4 32.7 1.4 49.0 1.4 65.41 1.4 98 1.4 130.8)))
(setf-aref fnc 2 3 2 1 (flipxy '( 450 16.5 450 24.5 450 32.7 450 49.0 450 65.41 450 98 450 130.8)))
(setf-aref fnc 2 3 2 2 (flipxy '( .01 16.5 .02 24.5 .08 32.7 .065 49.0 .05 65.41 .05 98 .05 130.8)))
(setf-aref fnc 2 3 2 3 (flipxy '(3.0 16.5 2.6 24.5 2.1 32.7 1.75 49.0 1.4 65.41 1.05 98 0.7 130.8)))
(setf-aref fnc 2 3 3 1 (flipxy '(2100 16.5 2100 24.5 2100 32.7 2125 49.0 2150 65.41 2175 98 2100 130.8)))
(setf-aref fnc 2 3 3 2 (flipxy '(.05 16.5 .05 24.5 .05 32.7 .05 49.0 .05 65.41 .075 98 .1 130.8)))
(setf-aref fnc 2 3 3 3 (flipxy '( 9.0 16.5 8.0 24.5 7.0 32.7 4.5 49.0 2.1 65.41 1.75 98 1.4 130.8)))
(setf-aref fnc 2 4 1 1 (flipxy '( 33 16.5 33 24.5 33 32.7 49 49.0 65 65.41 98 98 131 130.8)))
(setf-aref fnc 2 4 1 2 (flipxy '( .35 16.5 .40 24.5 .43 32.7 .47 49.0 .50 65.41 .57 98 .45 130.8)))
(setf-aref fnc 2 4 1 3 (flipxy '(1.4 16.5 1.4 24.5 1.0 32.7 1.0 49.0 1.0 65.41 1.1 98 1.0 130.8)))
(setf-aref fnc 2 4 2 1 (flipxy '( 300 16.5 300 24.5 300 32.7 300 49.0 300 65.41 300 98 300 130.8)))
(setf-aref fnc 2 4 2 2 (flipxy '( .75 16.5 .80 24.5 .85 32.7 .90 49.0 .95 65.41 .99 98 .99 130.8)))
(setf-aref fnc 2 4 2 3 (flipxy '(3.0 16.5 2.5 24.5 2.0 32.7 1.9 49.0 1.8 65.41 1.65 98 0.25 130.8)))
(setf-aref fnc 2 4 3 1 (flipxy '(2200 16.5 2200 24.5 2200 32.7 2225 49.0 2250 65.41 2275 98 2300 130.8)))
(setf-aref fnc 2 4 3 2 (flipxy '(.02 16.5 .02 24.5 .02 32.7 .035 49.0 .05 65.41 .07 98 .05 130.8)))
(setf-aref fnc 2 4 3 3 (flipxy '( 5.0 16.5 4.0 24.5 3.0 32.7 2.8 49.0 2.6 65.41 1.9 98 1.2 130.8)))
;; (sef-(aref fnc 2 5 1 1 (flipxy '(175 16.5 262 24.5 392 32.7 523 49.0 784 65.41 1046 98 1568 130.8)))
(setf-aref fnc 2 5 1 1 (flipxy '( 33 16.5 33 24.5 33 32.7 49 49.0 65 65.41 98 98 131 130.8)))
(setf-aref fnc 2 5 1 2 (flipxy '( .40 16.5 .40 24.5 .80 32.7 .80 49.0 .80 65.41 .80 98 .80 130.8)))
(setf-aref fnc 2 5 1 3 (flipxy '(0.1 16.5 0.1 24.5 0.1 32.7 0.1 49.0 0.0 65.41 0.0 98 0.0 130.8)))
(setf-aref fnc 2 5 2 1 (flipxy '( 350 16.5 524 24.5 784 32.7 950 49.0 1568 65.41 2092 98 3136 130.8)))
(setf-aref fnc 2 5 2 2 (flipxy '( .80 16.5 .80 24.5 .40 32.7 .20 49.0 .10 65.41 .10 98 .00 130.8)))
(setf-aref fnc 2 5 2 3 (flipxy '(0.5 16.5 0.1 24.5 0.1 32.7 0.1 49.0 0.0 65.41 0.0 98 0.0 130.8)))
(setf-aref fnc 2 5 3 1 (flipxy '(2700 16.5 2700 24.5 2500 32.7 2450 49.0 2400 65.41 2350 98 4500 130.8)))
(setf-aref fnc 2 5 3 2 (flipxy '(.10 16.5 .15 24.5 .15 32.7 .15 49.0 .15 65.41 .10 98 .10 130.8)))
(setf-aref fnc 2 5 3 3 (flipxy '( 2.0 16.5 1.6 24.5 1.6 32.7 1.6 49.0 1.6 65.41 1.5 98 1.0 130.8)))
;; these are vibrato frequencies functions (pitch dependent);
(set! (vibfreqfun 1) (flipxy '(4.5 138.8 5 1568)))
(set! (vibfreqfun 2) (flipxy '(4.5 16.5 5 130.8)))
;; these are index functions for cascade modulater (pitch dependent);
(set! (i3fun1 1) (flipxy '(4 138.8 4 784 1 1568)))
(set! (i3fun1 2) (flipxy '(4 16.5 4 65.41 1 130.8)))
(set! (i3fun2 1) (flipxy '(.4 138.8 .1 1568)))
(set! (i3fun2 2) (flipxy '(.4 16.5 .1 130.8)))))

(define (fncval ptr pitch)
(envelope-interp pitch ptr))

(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
dis pcrev deg vibscl pcran skewscl glissfun glissamt)
(fillfnc)
(let ((c 261.62)
(vowel (floor vowel-1))
(sex (floor sex-1))
(ampref (expt amp .8))
(deg (- deg 45))
(ranfreq 20)
(fm2 3)
(mscale 1)
(mconst 0)
(indx1 1))
(let ((vibfreq (fncval (vibfreqfun sex) pitch))
(vibpc (* .01 (log pitch 2) (+ .15 (sqrt amp)) vibscl))
(ranpc (* .002 (log pitch 2) (- 2 (expt amp .25)) pcran))
(skewpc (* skewscl (sqrt (+ .1 (* .05 ampref (if (= sex 1) (- 1568 130.8) (- 130.8 16.5)))))))
(form1 (/ (fncval (aref fnc sex vowel 1 1) pitch) pitch))
(form2 (/ (fncval (aref fnc sex vowel 2 1) pitch) pitch))
(form3 (/ (fncval (aref fnc sex vowel 3 1) pitch) pitch)))
(let ((fmntfreq1 (round form1))
(fmntfreq2 (round form2))
(fmntfreq3 (round form3))
(mfq (+ (* pitch mscale) mconst)))
(let ((amp1 (sqrt amp))
(amp2 (expt amp 1.5))
(amp3 (* amp amp))
(formscl1 (abs (- form1 fmntfreq1)))
(formscl2 (abs (- form2 fmntfreq2)))
(formscl3 (abs (- form3 fmntfreq3)))
(i3 (fncval ((if (< pitch (/ c 2)) i3fun1 i3fun2) sex) pitch))
(indx0 (if (memv vowel '(3 4)) 0 1.5)))
(let ((caramp1sc (* (fncval (aref fnc sex vowel 1 2) pitch) (- 1 formscl1) amp1))
(caramp2sc (* (fncval (aref fnc sex vowel 2 2) pitch) (- 1 formscl2) amp2))
(caramp3sc (* (fncval (aref fnc sex vowel 3 2) pitch) (- 1 formscl3) amp3))
(scdev1 (fncval (aref fnc sex vowel 1 3) pitch))
(scdev2 (fncval (aref fnc sex vowel 2 3) pitch))
(scdev3 (fncval (aref fnc sex vowel 3 3) pitch))
(dev (hz->radians (* i3 mfq)))
(dev0 (hz->radians (* indx0 mfq)))
(dev1 (hz->radians (* (- indx1 indx0) mfq))))
(let ((gens1 (make-oscil 0))
(gens2 (make-oscil 0 (/ pi 2.0)))
(gens2ampenv (make-env indxfun :duration dur
:scaler (* scdev1 dev1)
:offset (* scdev1 dev0)))
(gens3 (make-oscil 0 (/ pi 2.0)))
(gens3ampenv (make-env indxfun :duration dur
:scaler (* scdev2 dev1)
:offset (* scdev2 dev0)))
(gens4 (make-oscil 0 (/ pi 2.0)))
(gens4ampenv (make-env indxfun :duration dur
:scaler (* scdev3 dev1)
:offset (* scdev3 dev0)))
(gens5 (make-oscil 0))
(gens5ampenv (make-env ampfun1 :duration dur
:scaler (* amp caramp1sc .75)))
(gens6 (make-oscil 0))
(gens6ampenv (make-env ampfun2 :duration dur
:scaler (* amp caramp2sc .75)))
(gens7 (make-oscil 0))
(gens7ampenv (make-env ampfun3 :duration dur
:scaler (* amp caramp3sc .75)))
(freqenv (make-env (addenv glissfun (* glissamt pitch) 0 skewfun (* skewpc pitch) pitch) :duration dur
:scaler (hz->radians 1.0)))
(pervenv (make-env vibfun :duration dur
:scaler vibpc))
(ranvenv (make-env :envelope ranfun :duration dur
:scaler ranpc))
(per-vib (make-triangle-wave :frequency vibfreq
:amplitude (hz->radians pitch)))
(ran-vib (make-rand-interp :frequency ranfreq
:amplitude (hz->radians pitch)))
(loc (make-locsig :degree deg :distance dis :reverb pcrev))
(start (floor (* *clm-srate* beg)))
(end (floor (* *clm-srate* (+ beg dur)))))
(do ((i start (+ i 1)))
((= i end))
(let* ((vib (+ (env freqenv)
(* (env pervenv)
(triangle-wave per-vib))
(* (env ranvenv)
(rand-interp ran-vib))))
(cascadeout (* dev (oscil gens1 (* vib fm2)))))
(locsig loc i (+ (* (env gens5ampenv)
(oscil gens5 (+ (* vib fmntfreq1)
(* (env gens2ampenv)
(oscil gens2 (+ cascadeout (* vib mscale)))))))
(* (env gens6ampenv)
(oscil gens6 (+ (* vib fmntfreq2)
(* (env gens3ampenv)
(oscil gens3 (+ cascadeout (* vib mscale)))))))
(* (env gens7ampenv)
(oscil gens7 (+ (* vib fmntfreq3)
(* (env gens4ampenv)
(oscil gens4 (+ cascadeout (* vib mscale))))))))))))))))))

#|
(let ((ampf '(0 0 1 1 2 1 3 0)))
(with-sound (:play #t) (fm-voice 0 1 300 .8 3 1 ampf ampf ampf ampf ampf ampf ampf 1 0 0 .25 .01 0 ampf .01)))

(definstrument (fm-voice beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
dis pcrev deg vibscl pcran skewscl glissfun glissamt)

(define-macro (voi beg dur pitch amp vowel-1 sex-1 ampfun1 ampfun2 ampfun3 indxfun skewfun vibfun ranfun
dis pcrev deg vibscl skewscl)
`(fm-voice ,beg ,dur ,pitch ,amp ,vowel-1 ,sex-1 ,ampfun1 ,ampfun2 ,ampfun3 ,indxfun ,skewfun ,vibfun ,ranfun
,dis ,pcrev ,deg ,vibscl 0 ,skewscl '(0 0 100 0)))
|#

+ 18971
- 0
lib/sndlib/lint.scm
File diff suppressed because it is too large
View File


+ 31
- 0
lib/sndlib/make-config-pc.rb View File

@@ -0,0 +1,31 @@
#! /usr/bin/env ruby

# ruby make-config-pc.rb > ruby.pc

require "rbconfig"
if RUBY_VERSION < "1.9"
include Config
else
include RbConfig
end
version = CONFIG["ruby_version"]
arch = CONFIG["arch"]
rubyhdrdir = CONFIG["rubyhdrdir"]
if rubyhdrdir.nil?
rubyhdrdir = CONFIG["rubylibdir"]
else
rubyhdrdir.chomp("/")
end
dldflags = CONFIG["DLDFLAGS"]
librubyarg = CONFIG["LIBRUBYARG"]
libs = CONFIG["LIBS"]

print <<OUT
Name: Ruby
Description: Object Oriented Script Language
Version: #{version}
URL: http://www.ruby-lang.org
Cflags: -I#{rubyhdrdir}/#{arch} -I#{rubyhdrdir}
Libs: #{dldflags} #{librubyarg} #{libs}
Requires:
OUT

+ 100
- 0
lib/sndlib/makefile.in View File

@@ -0,0 +1,100 @@
SHELL = /bin/sh
top_srcdir = .

INSTALL = @INSTALL@
prefix = @prefix@
exec_prefix = @exec_prefix@
datarootdir = @datarootdir@
bindir = @bindir@
srcdir = @srcdir@
mandir = @mandir@
libdir = @libdir@
includedir = @includedir@
pkgconfigdir = $(libdir)/pkgconfig
VPATH = @srcdir@
mkinstalldirs = $(SHELL) $(srcdir)/mkinstalldirs

CC = @CC@
DEFS = @DEFS@
CFLAGS = @CFLAGS@
LDFLAGS = @LDFLAGS@
LIBS = @LIBS@
JACK_LIBS = @JACK_LIBS@

S7_HEADERS = s7.h
S7_FILES = s7.c
S7_O_FILES = @S7_LIB@

XEN_LIBS = @XEN_LIBS@
XEN_CFLAGS = @XEN_CFLAGS@
AUDIO_LIB = @AUDIO_LIB@
GSL_LIBS = @GSL_LIBS@
GSL_FLAGS = @GSL_CFLAGS@
JACK_FLAGS = @JACK_FLAGS@

LDSO_FLAGS = @LDSO_FLAGS@
SO_FLAGS = @SO_FLAGS@
SO_INSTALL = @SO_INSTALL@
A_INSTALL = @A_INSTALL@
SO_LD = @SO_LD@
A_LD = @A_LD@
A_LD_FLAGS = @A_LD_FLAGS@
LD_FLAGS = @LD_FLAGS@
SO_NAME = @SO_NAME@
RANLIB = @RANLIB@

main_target: sndlib

.c.o:
$(CC) -c $(DEFS) $(CFLAGS) $(SO_FLAGS) $(XEN_CFLAGS) $(GSL_FLAGS) $(JACK_FLAGS) $<

SNDLIB_HEADERS = sndlib.h sndlib-strings.h vct.h clm.h xen.h sndlib2xen.h clm2xen.h s7.h
SNDLIB_O_FILES = headers.o audio.o io.o sound.o xen.o vct.o clm.o sndlib2xen.o clm2xen.o
SNDLIB_SIMPLE_O_FILES = headers.o audio.o io.o sound.o


sndlib: $(SNDLIB_HEADERS) $(SNDLIB_O_FILES) $(S7_O_FILES)
$(SO_LD) $(LDFLAGS) $(SNDLIB_O_FILES) $(S7_O_FILES) -o $(SO_NAME) $(LDSO_FLAGS) $(XEN_LIBS) $(AUDIO_LIB) $(GSL_LIBS) $(JACK_FLAGS) $(JACK_LIBS) $(LIBS)
$(A_LD) $(A_LD_FLAGS) libsndlib.a $(SNDLIB_O_FILES) $(S7_O_FILES)
$(RANLIB) libsndlib.a

$(SNDLIB_O_FILES): $(SNDLIB_HEADERS)
$(S7_O_FILES): $(S7_HEADERS) $(S7_FILES)


clean:
rm -f $(SNDLIB_O_FILES)
rm -f $(S7_O_FILES)

sndplay: $(SNDLIB_HEADERS) $(SNDLIB_O_FILES) sndplay.o
$(CC) sndplay.c -o sndplay libsndlib.a $(AUDIO_LIB) $(DEFS) $(CFLAGS) $(SO_FLAGS) $(XEN_CFLAGS) $(JACK_FLAGS) $(JACK_LIBS) $(LIBS)

sndinfo: $(SNDLIB_HEADERS) $(SNDLIB_O_FILES) sndinfo.o
$(CC) sndinfo.c -o sndinfo libsndlib.a $(AUDIO_LIB) $(DEFS) $(CFLAGS) $(SO_FLAGS) $(XEN_CFLAGS) $(JACK_FLAGS) $(JACK_LIBS) $(LIBS)

audinfo: $(SNDLIB_HEADERS) $(SNDLIB_O_FILES) audinfo.o
$(CC) audinfo.c -o audinfo libsndlib.a $(AUDIO_LIB) $(DEFS) $(CFLAGS) $(SO_FLAGS) $(XEN_CFLAGS) $(JACK_FLAGS) $(JACK_LIBS) $(LIBS)

install: sndlib
$(mkinstalldirs) $(bindir)
$(mkinstalldirs) $(libdir)
$(mkinstalldirs) $(includedir)
$(SO_INSTALL) libsndlib.so $(libdir)/libsndlib.so
$(A_INSTALL) libsndlib.a $(libdir)/libsndlib.a
$(INSTALL) sndlib.h $(includedir)/sndlib.h
$(INSTALL) sndlib-config $(bindir)/sndlib-config
$(INSTALL) sndlib.pc $(pkgconfigdir)/sndlib.pc

uninstall:
rm -f $(libdir)/libsndlib.so
rm -f $(libdir)/libsndlib.a

Makefile: Makefile.in config.status
./config.status

config.status: configure
./config.status --recheck

configure: configure.in
cd $(srcdir); autoconf


+ 134
- 0
lib/sndlib/maraca.rb View File

@@ -0,0 +1,134 @@
# maraca.rb -- maraca.ins -> maraca.scm -> maraca.rb

# Translator: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Fri Apr 22 23:29:22 CEST 2005
# Changed: Sat Feb 19 18:27:34 CET 2011

# Commentary:
#
# Perry Cook's maraca from CMJ vol 21 no 3 (Fall 97) p 44 translated
# from CLM's maraca.ins
#
# Code:

def maraca(start, dur,
amp = 0.1,
sound_decay = 0.95,
system_decay = 0.999,
probability = 0.0625,
shell_freq = 3200.0,
shell_reso = 0.96)
temp = 0.0
shake_energy = 0.0
snd_level = 0.0
input = 0.0
output = Vct.new(2)
coeffs = Vct.new(2)
num_beans = 64
j = 0
sndamp = amp / 16384.0
srate4 = (mus_srate / 4.0).floor
gain = ((log(num_beans) / log(4)) * 40.0) / num_beans
coeffs[0] = -2.0 * shell_reso * cos(hz2radians(shell_freq))
coeffs[1] = shell_reso * shell_reso
run_instrument(start, dur) do
if temp < TWO_PI
temp += hz2radians(20)
shake_energy += 1.0 - cos(temp)
end
if j == srate4
temp = 0.0
j = 0
end
j += 1
shake_energy *= system_decay
if random(1.0) < probability
snd_level = snd_level + gain * shake_energy
end
input = snd_level * (random(2.0) - 1.0)
snd_level *= sound_decay
input = input - output[0] * coeffs[0] - output[1] * coeffs[1]
output[1], output[0] = output[0], input
sndamp * (output[0] - output[1])
end
end
# maraca: vct2channel(maraca(0, 5, 0.5))
# cabasa: vct2channel(maraca(0, 5, 0.5, 0.95, 0.997, 0.5, 3000.0, 0.7))

def big_maraca(start, dur,
amp = 0.1,
sound_decay = 0.95,
system_decay = 0.999,
probability = 0.0625,
shell_freqs = [3200.0],
shell_resos = [0.96],
randiff = 0.01,
with_filters = true)
temp = 0.0
temp1 = 0.0
resn = shell_freqs.length
shake_energy = 0.0
snd_level = 0.0
input = 0.0
sum = 0.0
last_sum = 0.0
last_diff = 0.0
diff = 0.0
output = Vct.new(resn * 2)
coeffs = Vct.new(resn * 2)
basesf = Vct.new(resn)
num_beans = 64
j = 0
sndamp = amp / 16384.0
srate4 = (mus_srate / 4.0).floor
gain = ((log(num_beans) / log(4)) * 40.0) / num_beans
resn.times do |i|
basesf[i] = coeffs[i * 2] = -2.0 * shell_resos[i] * cos(hz2radians(shell_freqs[i]))
coeffs[1 + i * 2] = shell_resos[i] * shell_resos[i]
end
run_instrument(start, dur) do
if temp < TWO_PI
temp += hz2radians(20)
shake_energy += 1.0 - cos(temp)
end
if j == srate4
temp = 0.0
j = 0
end
j += 1
shake_energy *= system_decay
if random(1.0) < probability
snd_level = snd_level + gain * shake_energy
basesf.each_with_index do |val, i|
coeffs[i * 2] = val + (random(2.0 * randiff) - randiff)
end
end
input = snd_level * (random(2.0) - 1.0)
snd_level *= sound_decay
temp1 = input
last_sum = sum
sum = 0.0
resn.times do |i|
input = temp1
input = input - output[i * 2] * coeffs[i * 2] - output[i * 2 + 1] * coeffs[i * 2 + 1]
output[i * 2 + 1], output[i * 2] = output[i * 2], input
sum += input
end
if with_filters
last_diff, diff = diff, sum - last_sum
temp1 = last_diff + diff
else
temp1 = sum
end
sndamp * temp1
end
end
# tambourine: big_maraca(0, 1, 0.25, 0.95, 0.9985, 0.03125,
# [2300, 5600, 8100], [0.96, 0.995, 0.995], 0.01)
# sleighbells: big_maraca(0, 2, 0.5, 0.97, 0.9994, 0.03125,
# [2500, 5300, 6500, 8300, 9800], [0.999, 0.999, 0.999, 0.999, 0.999])
# sekere: big_maraca(0, 2, 0.5, 0.96, 0.999, .0625, [5500], [0.6])
# windchimes: big_maraca(0, 2, 0.5, 0.99995, 0.95, 0.001,
# [2200, 2800, 3400], [0.995, 0.995, 0.995], 0.01, false)

# maraca.rb ends here

+ 137
- 0
lib/sndlib/maraca.scm View File

@@ -0,0 +1,137 @@
;;; Perry Cook's maraca from CMJ vol 21 no 3 (Fall 97) p 44
;;; translated from CLM's maraca.ins

(provide 'snd-maraca.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(define two-pi (* 2 pi))

(definstrument (maraca beg dur (amp .1)
(sound-decay 0.95)
(system-decay 0.999)
(probability .0625)
(shell-freq 3200.0)
(shell-reso 0.96))
(let ((num-beans 64))
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(temp 0.0)
(shake-energy 0.0)
(snd-level 0.0)
(input 0.0)
(stop 0)
(h20 (hz->radians 20.0))
(sndamp (/ amp 16384.0))
(srate4 (floor (/ *clm-srate* 4)))
(gain (/ (* (log num-beans 4.0) 40) num-beans))
(tz (make-two-pole 1.0 (* -2.0 shell-reso (cos (hz->radians shell-freq))) (* shell-reso shell-reso)))
(oz (make-one-zero 1.0 -1.0))
;; gourd resonance filter
)
(do ((i st (+ i srate4)))
((>= i nd))
(set! temp 0.0)
(set! stop (min nd (+ i srate4)))
(do ((k i (+ k 1)))
((= k stop))
(if (< temp two-pi)
(begin
;; shake over 50msec and add shake energy
(set! temp (+ temp h20))
(set! shake-energy (- (+ shake-energy 1.0) (cos temp)))))
(set! shake-energy (* shake-energy system-decay))
;; if collision, add energy
(if (< (random 1.0) probability)
(set! snd-level (+ snd-level (* gain shake-energy))))
;; actual sound is random
(set! input (mus-random snd-level))
;; compute exponential sound decay
(set! snd-level (* snd-level sound-decay))
;; gourd resonance filter calc
(outa k (* sndamp (one-zero oz (two-pole tz input)))))))))

;;; maraca: (with-sound (:statistics #t :play #t) (maraca 0 5 .5))
;;; cabasa: (with-sound (:statistics #t :play #t) (maraca 0 5 .5 0.95 0.997 0.5 3000.0 0.7))

(definstrument (big-maraca beg dur (amp .1)
(sound-decay 0.95)
(system-decay 0.999)
(probability .0625)
(shell-freqs '(3200.0))
(shell-resos '(0.96))
(randiff .01)
(with-filters #t))
;; like maraca, but takes a list of resonances and includes low-pass filter (or no filter)
(let ((num-beans 64)
(resn (length shell-freqs)))
(let ((st (seconds->samples beg))
(nd (seconds->samples (+ beg dur)))
(temp 0.0)
(shake-energy 0.0)
(snd-level 0.0)
(input 0.0)
(sum 0.0)
(last-sum 0.0)
(tzs (make-vector resn))
(h20 (hz->radians 20.0))
(stop 0)
(sndamp (/ amp (* 16384.0 resn)))
(srate4 (floor (/ *clm-srate* 4)))
(gain (/ (* (log num-beans 4) 40) num-beans))
(oz (make-one-zero (/ amp (* resn 16384.0)) (/ amp (* resn 16384.0)))))

;; we need to fixup Perry's frequency dithering amount since we're going through our mus-frequency method
(set! randiff (radians->hz randiff))

;; gourd resonance filters
(do ((i 0 (+ i 1)))
((= i resn))
(vector-set! tzs i (make-two-pole 1.0
(* -2.0 (shell-resos i) (cos (hz->radians (shell-freqs i))))
(* (shell-resos i) (shell-resos i)))))
(do ((i st (+ i srate4)))
((>= i nd))
(set! temp 0.0)
(set! stop (min nd (+ i srate4)))
(do ((k i (+ k 1)))
((= k stop))

(if (< temp two-pi)
(begin
;; shake over 50msec and add shake energy
(set! temp (+ temp h20))
(set! shake-energy (- (+ shake-energy 1.0) (cos temp)))))

(set! shake-energy (* shake-energy system-decay))
;; if collision, add energy
(if (< (random 1.0) probability)
(begin
(set! snd-level (+ snd-level (* gain shake-energy)))
;; randomize res freqs a bit
(do ((j 0 (+ j 1)))
((= j resn))
(set! (mus-frequency (vector-ref tzs j)) (+ (shell-freqs j) (mus-random randiff))))))

;; actual sound is random
(set! input (mus-random snd-level))
;; compute exponential sound decay
(set! snd-level (* snd-level sound-decay))

;; gourd resonance filter calcs
(set! last-sum sum)
(set! sum 0.0)
(do ((j 0 (+ j 1)))
((= j resn))
(set! sum (+ sum (two-pole (vector-ref tzs j) input))))
(outa k (if with-filters
(one-zero oz (- sum last-sum))
(* sndamp sum))))))))
;;; tambourine: (with-sound (:play #t :statistics #t) (big-maraca 0 1 .25 0.95 0.9985 .03125 '(2300 5600 8100) '(0.96 0.995 0.995) .01))
;;; sleighbells: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .15 0.97 0.9994 0.03125 '(2500 5300 6500 8300 9800) '(0.999 0.999 0.999 0.999 0.999)))
;;; sekere: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.96 0.999 .0625 '(5500) '(0.6)))
;;; windchimes: (with-sound (:play #t :statistics #t) (big-maraca 0 2 .5 0.99995 0.95 .001 '(2200 2800 3400) '(0.995 0.995 0.995) .01 #f))


+ 210
- 0
lib/sndlib/maxf.rb View File

@@ -0,0 +1,210 @@
# maxf.rb -- CLM -> Snd/Ruby translation of maxf.ins

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Mon Mar 24 11:24:23 CET 2003
# Changed: Thu Oct 15 00:16:58 CEST 2009

# It follows the original header of Juan Reyes.

# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# ;;
# ;; maxf.ins
# ;; This is Max Mathews (mvm) new filter (2002)
# ;; High-Q, 2-Integrator, filter with
# ;; Two Poles, and one Zero at the Origin
# ;;
# ;; It synthesizes equal-tempered frequencies
# ;; integer & just scales out of a wide-band input
# ;; signal.
# ;; Based on Max's code (filter.cpp)
# ;;
# ;; This heuristic might be called Modal Synthesis.
# ;; But as well it can also be additive synthesis in
# ;; which a resonator is initialized to generate the
# ;; exponentially decaying sinusoids at the desired
# ;; phase.
# ;;
# ;; This implementation written by Juan Reyes with dsp
# ;; assistance from JOS.
# ;; This version Oct-30, 2002
# ;;
# ;; Change gain(att) of input file if clipping
# ;;
# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

require "ws"

CLM = Struct.new("CLM", :yy1, :yy2, :zz1, :zz2, :pp1, :pp2, :pp3, :out)

add_help(:maxfilter, "maxfilter(file, start, *args)
:att = 1.0
:numf = 1
:freqfactor = 1.0
:amplitude = 1.0
:amp-env = [0, 1, 100, 1]
:degree = kernel_rand(90.0)
:distance = 1.0
:reverb_amount = 0.2

This is Max Mathews (mvm) new filter (2002) High-Q, 2-Integrator,
filter with Two Poles, and one Zero at the Origin

It synthesizes equal-tempered frequencies integer & just scales
out of a wide-band input signal.
Based on Max's code (filter.cpp)

This heuristic might be called Modal Synthesis. But as well it
can also be additive synthesis in which a resonator is
initialized to generate the exponentially decaying sinusoids at
the desired phase.

:att = 1 in-file attenuation
:numf = 1 1 filter
:numf = 4 4 filters
:numf = 9 9 filters
:numf = 12 12 filters
:numf = 13 13 filters")
def maxfilter(file, start = 0, *args)
att, numf, freqfactor, amplitude, amp_env, degree, distance, reverb_amount = nil
optkey(args, binding,
[:att, 1.0],
[:numf, 1],
[:freqfactor, 1.0],
[:amplitude, 1.0],
[:amp_env, [0, 1, 100, 1]],
[:degree, kernel_rand(90.0)],
[:distance, 1.0],
[:reverb_amount, 0.2])
rda, snd = make_general_reader(file, :channel, 0)
formfil = CLM.new(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
dur = duration(file)
ampf = make_env(:envelope, amp_env, :scaler, amplitude, :duration, dur)
state_0 = make_array( 1) do make_array(3, 0.0) end
state_1 = make_array(12) do make_array(3, 0.0) end
state_2 = make_array( 9) do make_array(3, 0.0) end
state_3 = make_array(13) do make_array(3, 0.0) end
state_4 = make_array( 4) do make_array(3, 0.0) end
state_5 = make_array( 2) do make_array(3, 0.0) end
case numf
when 1
Snd.display "State 0 (default): One filter"
state_0[0] = 7.54e-002, 2000.0 * freqfactor, 2.0
when 2
Snd.display "State 5: Two filters"
state_5[0] = 7.54e-003, 200.0 * freqfactor, 4.0
state_5[1] = 7.54e-004, 800.0 * freqfactor, 1.0
when 4
Snd.display "State 4: Four filters"
state_4[0] = 7.54e-002, 1000.0 * freqfactor, 0.5
state_4[1] = 3.225e-002, 400.0 * freqfactor, 3.0
state_4[2] = 1.14e-002, 800.0 * freqfactor, 2.8
state_4[3] = 7.54e-002, 1600.0 * freqfactor, 1.0
when 9
Snd.display "State 2: Streached overtone string 9 filters"
state_2[0] = 1.07e-002, 100.0, 2.5
state_2[1] = 1.07e-002, 202.0, 0.75
state_2[2] = 1.07e-002, 305.0, 0.5
state_2[3] = 7.077e-003, 408.0, 0.4
state_2[4] = 1.07e-002, 501.0, 0.3
state_2[5] = 1.07e-002, 612.0, 0.25
state_2[6] = 1.07e-003, 715.0, 0.25
state_2[7] = 1.07e-002, 817.0, 0.2
state_2[8] = 1.07e-002, 920.0, 0.18
when 12
Snd.display "State 1: Risset bell long 12 filters"
state_1[0] = 5.025e-002, 224.0, 3.7
state_1[1] = 5.025e-002, 225.0, 3.3
state_1[2] = 5.025e-002, 368.0, 2.8
state_1[3] = 5.025e-002, 369.0, 2.4
state_1[4] = 1.047e-002, 476.0, 1.9
state_1[5] = 5.025e-002, 680.0, 1.7
state_1[6] = 5.025e-002, 800.0, 1.5
state_1[7] = 4.05e-002, 1096.0, 1.1
state_1[8] = 4.05e-002, 1099.0, 0.9
state_1[9] = 4.05e-002, 1200.0, 0.6
state_1[10] = 3.78e-002, 1504.0, 0.4
state_1[11] = 4.05e-002, 1628.0, 0.3
when 13
Snd.display "State 3: Open major chord with repeated octave 12 filters"
state_3[0] = 5.025e-002, 100.0, 2.0
state_3[1] = 5.025e-002, 251.0, 2.0
state_3[2] = 5.025e-002, 299.0, 2.0
state_3[3] = 5.025e-002, 401.0, 2.0
state_3[4] = 5.025e-002, 199.0, 2.0
state_3[5] = 5.025e-002, 501.0, 2.0
state_3[6] = 5.025e-002, 599.0, 2.0
state_3[7] = 5.025e-002, 801.0, 2.0
state_3[8] = 5.025e-002, 201.0, 2.0
state_3[9] = 5.025e-002, 749.0, 2.0
state_3[10] = 5.025e-002, 900.0, 2.0
state_3[11] = 5.025e-004, 1205.0, 2.0
state_3[12] = 5.025e-004, 1205.0, 2.0
else
Snd.display "Please leave default or enter [1] [2] [4] [9] [12] [13]"
numf = 1
end
mvmfilt = lambda do |b, sample|
b[:yy2] = (b[:pp1] * b[:yy1] + b[:pp2] * b[:zz1]) - b[:pp3] * sample
b[:zz2] = b[:zz1] - b[:pp2] * b[:yy2]
b[:zz1] = b[:zz2]
b[:yy1] = b[:yy2]
b[:out] = b[:yy1]
end
set_coeffs = lambda do |b, ary|
famp, ffreq, fdecay = ary
tper = 1.0 / @srate
centerfreq = (2.0 * PI * ffreq) / @srate
maxdecay = (2.0 * tper) / (centerfreq * centerfreq)
mindecay = tper / centerfreq
fdecay = if fdecay >= maxdecay
maxdecay
else
fdecay.to_f
end
fdecay = mindecay if fdecay <= mindecay
b[:pp1] = 1.0 - 2.0 / (fdecay * @srate)
b[:pp2] = (2.0 * PI * ffreq) / @srate
b[:pp3] = b[:pp2] * famp
end
run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb_amount) do
outval_a = att * general_readin(rda)
add_fl = 0.0
numf.times do |j|
case numf
when 1
set_coeffs.call(formfil, state_0[j])
when 2
set_coeffs.call(formfil, state_5[j])
when 4
set_coeffs.call(formfil, state_4[j])
when 9
set_coeffs.call(formfil, state_2[j])
when 12
set_coeffs.call(formfil, state_1[j])
when 13
set_coeffs.call(formfil, state_3[j])
end
filsig = mvmfilt.call(formfil, outval_a)
add_fl += filsig
end
env(ampf) * add_fl
end
close_general_reader(snd, rda)
end

=begin
ifile = "dog.snd"
ofile = "rmax_dog.snd"
stats = [1, 2, 4, 9, 12, 13]
with_sound(:play, 1, :statistics, true, :channels, 4, :output, ofile, :reverb, :jc_reverb,
:comment, format("maxfilter test, filters %s, source %s", stats.inspect, ifile)) do
stats.each_with_index do |val, i| maxfilter(ifile, i, :numf, val) end
end

with_sound(:srate, 22050) do maxfilter("dog.snd", 0) end
with_sound(:srate, 44100) do maxfilter("dog.snd", 0, :numf, 12) end
with_sound(:srate, 44100) do maxfilter("dog.snd", 0, :numf, 13, :att, 0.75) end
with_sound(:srate, 44100) do maxfilter("dog.snd", 0, :numf, 2, :att, 0.25, :freqfactor, 0.5) end
=end

# maxf.rb ends here

+ 352
- 0
lib/sndlib/maxf.scm View File

@@ -0,0 +1,352 @@
;;; maxf.scm -- CLM -> Snd/Scheme translation of maxf.ins

;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
;; Last: Tue Mar 25 04:32:23 CET 2003
;; Version: $Revision: 1.2 $

;; array -> vector functions added by Bill S, 18-Apr-11
;; defgenerator changes (Bill 25-Jul-12)

;; It follows the original header by Juan Reyes.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; maxf.ins
;; This is Max Mathews (mvm) new filter (2002)
;; High-Q, 2-Integrator, filter with
;; Two Poles, and one Zero at the Origin
;;
;; It synthesizes equal-tempered frequencies
;; integer & just scales out of a wide-band input
;; signal.
;; Based on Max's code (filter.cpp)
;;
;; This heuristic might be called Modal Synthesis.
;; But as well it can also be additive synthesis in
;; which a resonator is initialized to generate the
;; exponentially decaying sinusoids at the desired
;; phase.
;;
;; This implementation written by Juan Reyes with dsp
;; assistance from JOS.
;; This version Oct-30, 2002
;;
;; Change gain(att) of input file if clipping
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'snd-maxf.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(define *locsig-type* mus-interp-sinusoidal)

(define (snd-msg frm . args)
((if (not (string=? "" (getenv "EMACS"))) display snd-print)
(apply format #f frm args)))

(defgenerator mvm sample pp1 pp2 pp3 yy1 yy2 zz1 zz2 out)

(define (mvmfilt b sample0)
(let-set! b 'sample sample0)
(with-let b
(set! yy2 (- (+ (* pp1 yy1)
(* pp2 zz1))
(* pp3 sample)))
(set! zz2 (- zz1 (* pp2 yy2)))
(set! zz1 zz2)
(set! yy1 yy2)
(set! out yy1)))

(define pi2s (/ (* 2.0 pi) *clm-srate*))
(define i2s (/ 2.0 *clm-srate*))
(define tper (/ 1.0 *clm-srate*))

(define (set-coeffs b famp ffreq fdecay)
(let ((centerfreq (* ffreq pi2s)))
(let ((maxdecay (/ (* 2.0 tper) (* centerfreq centerfreq)))
(mindecay (/ tper centerfreq)))
;; Conditions for JOS constraints
;; maxdecay: Filter may be unstable
;; mindecay: Filter may not oscillate
(set! fdecay (max mindecay (min fdecay maxdecay))))
(set! (b 'pp1) (- 1.0 (/ i2s fdecay)))
(set! (b 'pp2) centerfreq)
(set! (b 'pp3) (* (b 'pp2) famp))))

(define (make-array dim1) ; I'm guessing ...
(make-vector (list dim1 3) 0.0))

(define (array-set! arr val i1 i2)
(set! (arr i1 i2) val))

(define array-ref vector-ref)

(define maxfilter

(let ((documentation "(maxfilter file beg (att 1.0) (numf 1) (freqfactor 1.0)
(amplitude 1.0) (amp-env '(0 1 100 1))
(degree (random 90.0)) (distance 1.0) (reverb-amount 0.2))

This is Max Mathews (mvm) new filter (2002) High-Q, 2-Integrator,
filter with Two Poles, and one Zero at the Origin

It synthesizes equal-tempered frequencies integer & just scales
out of a wide-band input signal.
Based on Max's code (filter.cpp)

This heuristic might be called Modal Synthesis. But as well it
can also be additive synthesis in which a resonator is
initialized to generate the exponentially decaying sinusoids at
the desired phase.

(att 1) in-file attenuation
(numf 1) 1 filter
(numf 4) 4 filters
(numf 9) 9 filters
(numf 12) 12 filters
(numf 13) 13 filters"))

(lambda* (file beg
(att 1.0)
(numf 1)
(freqfactor 1.0)
(amplitude 1.0)
(amp-env '(0 1 100 1))
(degree (random 90.0))
(distance 1.0)
(reverb-amount 0.2))
(let ((beg (floor (* beg *clm-srate*)))
(dur (mus-sound-framples file)))
(let ((formfil (make-mvm))
(end (+ beg dur))
(rdA (make-readin :file file :channel 0))
(ampf (make-env :envelope amp-env :scaler amplitude :length dur))
(state-0 (make-array 1))
(state-1 (make-array 12))
(state-2 (make-array 9))
(state-3 (make-array 13))
(state-4 (make-array 4))
(state-5 (make-array 2))
(loc (make-locsig :degree degree
:distance distance
:reverb reverb-amount
:type *locsig-type*)))
(case numf
((1)
(snd-msg ";;;; State 0 (default): One filter~%")
(array-set! state-0 7.54e-002 0 0)
(array-set! state-0 (* 2000 freqfactor) 0 1)
(array-set! state-0 2.0 0 2))
;;
((2)
(snd-msg ";;;; State 5: Two filters~%")
(array-set! state-5 7.54e-003 0 0)
(array-set! state-5 (* 200.0 freqfactor) 0 1)
(array-set! state-5 4.0 0 2)
;;
(array-set! state-5 7.54e-004 1 0)
(array-set! state-5 (* 800.0 freqfactor) 1 1)
(array-set! state-5 1.0 1 2))
;;
((4)
(snd-msg ";;;; State 4: Four filters~%")
(array-set! state-4 7.54e-002 0 0)
(array-set! state-4 (* 1000.0 freqfactor) 0 1)
(array-set! state-4 0.5 0 2)
;;
(array-set! state-4 3.225e-002 1 0)
(array-set! state-4 (* 400.0 freqfactor) 1 1)
(array-set! state-4 3.0 1 2)
;;
(array-set! state-4 1.14e-002 2 0)
(array-set! state-4 (* 800.0 freqfactor) 2 1)
(array-set! state-4 2.8 2 2)
;;
(array-set! state-4 7.54e-002 3 0)
(array-set! state-4 (* 1600.0 freqfactor) 3 1)
(array-set! state-4 1.0 3 2))
;;
((9)
(snd-msg ";;;; State 2: Streached overtone string 9 filters~%")
(array-set! state-2 1.07e-002 0 0)
(array-set! state-2 100.0 0 1)
(array-set! state-2 2.5 0 2)
;;
(array-set! state-2 1.07e-002 1 0)
(array-set! state-2 202.0 1 1)
(array-set! state-2 0.75 1 2)
;;
(array-set! state-2 1.07e-002 2 0)
(array-set! state-2 305.0 2 1)
(array-set! state-2 0.5 2 2)
;;
(array-set! state-2 7.077e-003 3 0)
(array-set! state-2 408.0 3 1)
(array-set! state-2 0.4 3 2)
;;
(array-set! state-2 1.07e-002 4 0)
(array-set! state-2 501.0 4 1)
(array-set! state-2 0.3 4 2)
;;
(array-set! state-2 1.07e-002 5 0)
(array-set! state-2 612.0 5 1)
(array-set! state-2 0.25 5 2)
;;
(array-set! state-2 1.07e-003 6 0)
(array-set! state-2 715.0 6 1)
(array-set! state-2 0.25 6 2)
;;
(array-set! state-2 1.07e-002 7 0)
(array-set! state-2 817.0 7 1)
(array-set! state-2 0.2 7 2)
;;
(array-set! state-2 1.07e-002 8 0)
(array-set! state-2 920.0 8 1)
(array-set! state-2 0.18 8 2))
;;
((12)
(snd-msg ";;;; State 1: Risset bell long 12 filters~%")
(array-set! state-1 5.025e-002 0 0)
(array-set! state-1 224.0 0 1)
(array-set! state-1 3.7 0 2)
;;
(array-set! state-1 5.025e-002 1 0)
(array-set! state-1 225.0 1 1)
(array-set! state-1 3.3 1 2)
;;
(array-set! state-1 5.025e-002 2 0)
(array-set! state-1 368.0 2 1)
(array-set! state-1 2.8 2 2)
;;
(array-set! state-1 5.025e-002 3 0)
(array-set! state-1 369.0 3 1)
(array-set! state-1 2.4 3 2)
;;
(array-set! state-1 1.047e-002 4 0)
(array-set! state-1 476.0 4 1)
(array-set! state-1 1.9 4 2)
;;
(array-set! state-1 5.025e-002 5 0)
(array-set! state-1 680.0 5 1)
(array-set! state-1 1.7 5 2)
;;
(array-set! state-1 5.025e-002 6 0)
(array-set! state-1 800.0 6 1)
(array-set! state-1 1.5 6 2)
;;
(array-set! state-1 4.05e-002 7 0)
(array-set! state-1 1096.0 7 1)
(array-set! state-1 1.1 7 2)
;;
(array-set! state-1 4.05e-002 8 0)
(array-set! state-1 1099.0 8 1)
(array-set! state-1 0.9 8 2)
;;
(array-set! state-1 4.05e-002 9 0)
(array-set! state-1 1200.0 9 1)
(array-set! state-1 0.6 9 2)
;;
(array-set! state-1 3.78e-002 10 0)
(array-set! state-1 1504.0 10 1)
(array-set! state-1 0.4 10 2)
;;
(array-set! state-1 4.05e-002 11 0)
(array-set! state-1 1628.0 11 1)
(array-set! state-1 0.3 11 2))
;;
((13)
(snd-msg ";;;; State 3: Open major chord with repeated octave 12 filters~%")
(array-set! state-3 5.025e-002 0 0)
(array-set! state-3 100.0 0 1)
(array-set! state-3 2.0 0 2)
;;
(array-set! state-3 5.025e-002 1 0)
(array-set! state-3 251.0 1 1)
(array-set! state-3 2.0 1 2)
;;
(array-set! state-3 5.025e-002 2 0)
(array-set! state-3 299.0 2 1)
(array-set! state-3 2.0 2 2)
;;
(array-set! state-3 5.025e-002 3 0)
(array-set! state-3 401.0 3 1)
(array-set! state-3 2.0 3 2)
;;
(array-set! state-3 5.025e-002 4 0)
(array-set! state-3 199.0 4 1)
(array-set! state-3 2.0 4 2)
;;
(array-set! state-3 5.025e-002 5 0)
(array-set! state-3 501.0 5 1)
(array-set! state-3 2.0 5 2)
;;
(array-set! state-3 5.025e-002 6 0)
(array-set! state-3 599.0 6 1)
(array-set! state-3 2.0 6 2)
;;
(array-set! state-3 5.025e-002 7 0)
(array-set! state-3 801.0 7 1)
(array-set! state-3 2.0 7 2)
;;
(array-set! state-3 5.025e-002 8 0)
(array-set! state-3 201.0 8 1)
(array-set! state-3 2.0 8 2)
;;
(array-set! state-3 5.025e-002 9 0)
(array-set! state-3 749.0 9 1)
(array-set! state-3 2.0 9 2)
;;
(array-set! state-3 5.025e-002 10 0)
(array-set! state-3 900.0 10 1)
(array-set! state-3 2.0 10 2)
;;
(array-set! state-3 5.025e-004 11 0)
(array-set! state-3 1205.0 11 1)
(array-set! state-3 2.0 11 2)
;;
(array-set! state-3 5.025e-004 12 0)
(array-set! state-3 1205.0 12 1)
(array-set! state-3 2.0 12 2))
(else
(snd-msg "Please leave default or enter [1] [2] [4] [9] [12] [13]~%")
(set! numf 1)))
(do ((run-state (case numf
((1) state-0)
((2) state-5)
((4) state-4)
((9) state-2)
((12) state-1)
((13) state-3)))
(i beg (+ 1 i)))
((= i end))
(let ((outvalA (* att (readin rdA)))
(add-fl 0.0))
(do ((j 0 (+ 1 j)))
((= j numf))
(set-coeffs formfil (array-ref run-state j 0) (array-ref run-state j 1) (array-ref run-state j 2))
(set! add-fl (+ add-fl (mvmfilt formfil outvalA))))
(locsig loc i (* (env ampf) add-fl)))))))))
;; (let* ((ifile "dog.snd")
;; (ofile "gmax_dog.snd")
;; (snd (find-sound ofile))
;; (number-ary '(1 2 4 9 12 13)))
;; (if snd
;; (close-sound snd))
;; (with-sound (:play 1 :statistics #t :channels 4 :output ofile :reverb jc-reverb
;; :comment
;; (format #f "maxfilter test, filters ~S, source ~A" number-ary ifile))
;; (do ((i 0 (+ 1 i))
;; (nary number-ary (cdr nary)))
;; ((null? nary))
;; (maxfilter ifile i :numf (car nary) :degree (random 3454)))))

;; (with-sound () (maxfilter "dog.snd" 0))
;; (with-sound (:srate 44100) (maxfilter "dog.snd" 0 :numf 12))
;; (with-sound (:srate 44100) (maxfilter "dog.snd" 0 :numf 13 :att 0.75))
;; (with-sound (:srate 44100) (maxfilter "dog.snd" 0 :numf 2 :att 0.25 :freqfactor 0.5))

;; maxf.scm ends here

+ 40
- 0
lib/sndlib/mkinstalldirs View File

@@ -0,0 +1,40 @@
#! /bin/sh
# mkinstalldirs --- make directory hierarchy
# Author: Noah Friedman <friedman@prep.ai.mit.edu>
# Created: 1993-05-16
# Public domain

# $Id: mkinstalldirs,v 1.13 1999/01/05 03:18:55 bje Exp $

errstatus=0

for file
do
set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
shift

pathcomp=
for d
do
pathcomp="$pathcomp$d"
case "$pathcomp" in
-* ) pathcomp=./$pathcomp ;;
esac

if test ! -d "$pathcomp"; then
echo "mkdir $pathcomp"

mkdir "$pathcomp" || lasterr=$?

if test ! -d "$pathcomp"; then
errstatus=$lasterr
fi
fi

pathcomp="$pathcomp/"
done
done

exit $errstatus

# mkinstalldirs ends here

+ 201
- 0
lib/sndlib/moog.scm View File

@@ -0,0 +1,201 @@
;;; Moog style four pole lowpass filter clm unit generator
;;; low pass, 24db/Oct, variable resonance, warm, analog sound ;-)
;;; [all this digital wizardry and we're back where we started!]
;;;
;;; original C instrument by Tim Stilson
;;; translation into clm and tuning by
;;; Fernando Lopez-Lezcano, nando@ccrma.stanford.edu
;;; http://ccrma.stanford.edu/~nando/clm/moog
;;;
;;; translated to Snd scheme function by Bill,
;;; changed 21-Sep-10 to use defgenerator

(provide 'snd-moog.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(define moog-gaintable (float-vector 0.999969 0.990082 0.980347 0.970764 0.961304 0.951996 0.94281 0.933777 0.924866 0.916077
0.90741 0.898865 0.890442 0.882141 0.873962 0.865906 0.857941 0.850067 0.842346 0.834686
0.827148 0.819733 0.812378 0.805145 0.798004 0.790955 0.783997 0.77713 0.770355 0.763672
0.75708 0.75058 0.744141 0.737793 0.731537 0.725342 0.719238 0.713196 0.707245 0.701355
0.695557 0.689819 0.684174 0.678558 0.673035 0.667572 0.66217 0.65686 0.651581 0.646393
0.641235 0.636169 0.631134 0.62619 0.621277 0.616425 0.611633 0.606903 0.602234 0.597626
0.593048 0.588531 0.584045 0.579651 0.575287 0.570953 0.566681 0.562469 0.558289 0.554169
0.550079 0.546051 0.542053 0.538116 0.53421 0.530334 0.52652 0.522736 0.518982 0.515289
0.511627 0.507996 0.504425 0.500885 0.497375 0.493896 0.490448 0.487061 0.483704 0.480377
0.477081 0.473816 0.470581 0.467377 0.464203 0.46109 0.457977 0.454926 0.451874 0.448883
0.445892 0.442932 0.440033 0.437134 0.434265 0.431427 0.428619 0.425842 0.423096 0.42038
0.417664 0.415009 0.412354 0.409729 0.407135 0.404572 0.402008 0.399506 0.397003 0.394501
0.392059 0.389618 0.387207 0.384827 0.382477 0.380127 0.377808 0.375488 0.37323 0.370972
0.368713 0.366516 0.364319 0.362122 0.359985 0.357849 0.355713 0.353607 0.351532 0.349457
0.347412 0.345398 0.343384 0.34137 0.339417 0.337463 0.33551 0.333588 0.331665 0.329773
0.327911 0.32605 0.324188 0.322357 0.320557 0.318756 0.316986 0.315216 0.313446 0.311707
0.309998 0.308289 0.30658 0.304901 0.303223 0.301575 0.299927 0.298309 0.296692 0.295074
0.293488 0.291931 0.290375 0.288818 0.287262 0.285736 0.284241 0.282715 0.28125 0.279755
0.27829 0.276825 0.275391 0.273956 0.272552 0.271118 0.269745 0.268341 0.266968 0.265594
0.264252 0.262909 0.261566 0.260223 0.258911 0.257599 0.256317 0.255035 0.25375))

(define moog-freqtable
'(0 -1
0.03311111 -0.9
0.06457143 -0.8
0.0960272 -0.7
0.127483 -0.6
0.1605941 -0.5
0.1920544 -0.4
0.22682086 -0.3
0.2615873 -0.2
0.29801363 -0.1
0.33278003 -0.0
0.37086168 0.1
0.40893877 0.2
0.4536417 0.3
0.5 0.4
0.5463583 0.5
0.5943719 0.6
0.6556281 0.7
0.72185487 0.8
0.8096009 0.9
0.87913835 0.95
0.9933787 1
1 1))

;;; moog struct is a list (freq res arr a)
;;; freq: cutoff frequency in Hertz
;;; Q: resonance, 0->no resonance, 1->oscilates at freq
;;;
;;; Note: the relation between freq and the actual cutoff is not exactly linear but
;;; I prefered to translate Hz into the internal parameter rather than controlling
;;; the cutoff frequency in terms of a number that goes between -1 and 1.

#|
(defgenerator moog freq Q s y fc gain sig)

(define make-moog-filter
(let ((documentation "(make-moog-filter frequency Q) makes a new moog-filter generator. 'frequency' is the cutoff in Hz,
'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'"))
(lambda (frequency Q)
(let ((frq (envelope-interp (/ frequency (* *clm-srate* 0.5)) moog-freqtable)))
(make-moog :freq frequency
:Q Q
:s (make-float-vector 4)
:y 0.0
:fc frq
:gain (* Q (array-interp moog-gaintable (+ 99.0 (* frq 99.0)))))))))

(define moog-frequency
(dilambda
(let ((documentation "(moog-frequency gen) accesses the cutoff frequency of the Moog filter 'gen'"))
(lambda (gen)
(gen 'freq)))
(lambda (gen frq)
(let ((fr (envelope-interp (/ frq (* *clm-srate* 0.5)) moog-freqtable)))
(set! (gen 'freq) frq)
(set! (gen 'fc) fr)
(set! (gen 'gain) (* (gen 'Q) (array-interp moog-gaintable (+ 99.0 (* fr 99.0)))))))))


(define moog-filter
(let ((documentation "(moog-filter m sig) is the generator associated with make-moog-filter"))
(lambda (m sig)
(let-set! m 'sig sig)
(with-let m
(let ((A (* 0.25 (- sig y)))
(st 0.0))
(do ((cell 0 (+ 1 cell)))
((= cell 4))
(set! st (float-vector-ref s cell))
(set! A (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
(float-vector-set! s cell A)
(set! A (min 0.95 (max -0.95 (+ A st)))))
(set! y (* A gain))
A)))))
;;; (let ((gen (make-moog-filter 500.0 .1))) (map-channel (lambda (y) (moog-filter gen y))))

|#

;;; faster version?

(defgenerator moog freq Q s0 s1 s2 s3 y fc gain sig)

(define make-moog-filter
(let ((documentation "(make-moog-filter frequency Q) makes a new moog-filter generator. 'frequency' is the cutoff in Hz,
'Q' sets the resonance: 0 = no resonance, 1: oscillates at 'frequency'"))
(lambda (frequency Q)
(let ((frq (envelope-interp (/ frequency (* *clm-srate* 0.5)) moog-freqtable)))
(make-moog :freq frequency
:Q Q
:y 0.0 :s0 0.0 :s1 0.0 :s2 0.0 :s3 0.0
:fc frq
:gain (* Q (array-interp moog-gaintable (+ 99.0 (* frq 99.0)))))))))

(define moog-frequency
(dilambda
(let ((documentation "(moog-frequency gen) accesses the cutoff frequency of the Moog filter 'gen'"))
(lambda (gen)
(gen 'freq)))
(lambda (gen frq)
(let ((fr (envelope-interp (/ frq (* *clm-srate* 0.5)) moog-freqtable)))
(set! (gen 'freq) frq)
(set! (gen 'fc) fr)
(set! (gen 'gain) (* (gen 'Q) (array-interp moog-gaintable (+ 99.0 (* fr 99.0)))))))))


(define moog-filter
(let ((documentation "(moog-filter m sig) is the generator associated with make-moog-filter"))
(lambda (m sig)
; see below for the "saturate" option
(let-set! m 'sig sig)
(with-let m
(let ((A (* 0.25 (- sig y)))
(st s0))
(set! s0 (+ A (* fc (- A st))))
(set! A (+ s0 st))
(set! st s1)
(set! s1 (+ A (* fc (- A st))))
(set! A (+ s1 st))
(set! st s2)
(set! s2 (+ A (* fc (- A st))))
(set! A (+ s2 st))
(set! st s3)
(set! s3 (+ A (* fc (- A st))))
(set! A (+ s3 st))
(set! y (* A gain))
A)))))

(define moog-filter-saturated
(let ((documentation "(moog-filter-saturated m sig) is the generator associated with make-moog-filter with internal saturation"))
(lambda (m sig)
(let-set! m 'sig sig)
(with-let m
(let ((A (* 0.25 (- sig y)))
(st s0))
(set! s0 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
(set! A (min 0.95 (max -0.95 (+ s0 st))))
(set! st s1)
(set! s1 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
(set! A (min 0.95 (max -0.95 (+ s1 st))))
(set! st s2)
(set! s2 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
(set! A (min 0.95 (max -0.95 (+ s2 st))))
(set! st s3)
(set! s3 (min 0.95 (max -0.95 (+ A (* fc (- A st))))))
(set! A (min 0.95 (max -0.95 (+ s3 st))))
(set! y (* A gain))
A)))))


+ 47
- 0
lib/sndlib/mus-config.h View File

@@ -0,0 +1,47 @@
#ifndef MUS_CONFIG_H
#define MUS_CONFIG_H

#define USE_SND 0

#ifdef _MSC_VER

#ifndef SIZEOF_VOID_P
#define SIZEOF_VOID_P 8
#endif
#ifndef HAVE_SCHEME
#define HAVE_SCHEME 1
#endif

typedef long off_t;
#define ssize_t int
#define snprintf _snprintf
#define strtoll strtol

#if _MSC_VER > 1200
#ifndef _CRT_DEFINED
#define _CRT_DEFINED
#define _CRT_SECURE_NO_DEPRECATE 1
#define _CRT_NONSTDC_NO_DEPRECATE 1
#define _CRT_SECURE_CPP_OVERLOAD_STANDARD_NAMES 1
#endif
#endif
#else

#if (!HAVE_PREMAKE)
/* if premake4, all settings are passed in the command line
* otherwise the configure script writes unix-config.h
*/
#include "unix-config.h"
#endif

#endif

/* ---------------------------------------- */

#define HAVE_EXTENSION_LANGUAGE (HAVE_SCHEME || HAVE_RUBY || HAVE_FORTH)

#define HAVE_COMPLEX_NUMBERS ((!_MSC_VER) && ((!HAVE_FORTH) || HAVE_COMPLEX))
#define HAVE_COMPLEX_TRIG ((!_MSC_VER) && (!__cplusplus) && (!__FreeBSD__))
#define HAVE_MAKE_RATIO ((HAVE_SCHEME) || (HAVE_FORTH))

#endif

+ 117
- 0
lib/sndlib/noise.rb View File

@@ -0,0 +1,117 @@
# noise.rb -- CLM -> Snd/Ruby translation of noise.ins

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Wed Mar 19 05:16:56 CET 2003
# Changed: Thu Oct 15 00:17:48 CEST 2009

# Comments beginning with ;; are taken from noise.ins!

# attack_point(dur, attack, decay, total_x = 100.0)
# fm_noise(...)

# ;;; The "noise" instrument (useful for Oceanic Music):

require "ws"
require "env"
include Env

def attack_point(dur, attack, decay, total_x = 100.0)
x = if 0.0 == attack
if 0.0 == decay
dur / 4.0
else
(dur - decay) / 4.0
end
else
attack.to_f
end
total_x * (x / dur)
end

def fm_noise(start, dur, freq0,
amp, ampfun, ampat, ampdc,
freq1, glissfun, freqat, freqdc,
rfreq0, rfreq1, rfreqfun, rfreqat, rfreqdc,
dev0, dev1, devfun, devat, devdc,
*args)
degree, distance, reverb = nil
optkey(args, binding,
[:degree, kernel_rand(90.0)],
[:distance, 1.0],
[:reverb, 0.005])

# ;; ampat = amp envelope attack time, and so on -- this instrument
# ;; assumes your envelopes go from 0 to 100 on the x-axis, and that
# ;; the "attack" portion ends at 25, the "decay" portion starts at
# ;; 75. "rfreq" is the frequency of the random number generator --
# ;; if below about 25 hz you get automatic composition, above that
# ;; you start to get noise. well, you get a different kind of
# ;; noise. "dev" is the bandwidth of the noise -- very narrow
# ;; gives a whistle, very broad more of a whoosh. this is
# ;; basically "simple fm", but the modulating signal is white
# ;; noise.
car = make_oscil(:frequency, freq0)
mod = make_rand(:frequency, rfreq0, :amplitude, 1.0)
dev_0 = hz2radians(dev0)
# ;; next fix-up troubles in attack and decay times (there are lots
# ;; of ways to handle this -- the basic problem is that these
# ;; durned instruments end up having way too many parameters. rick
# ;; taube's common music replacement for pla should help, but just
# ;; for old time's sake, we'll do it the way the ancients did it.
# ;; (we could also package up this stuff in our own function,
# ;; somewhat like the allvln function in vln.clm, leaving the
# ;; instrument code to apply envelopes and other data to some
# ;; patch).
amp_attack = attack_point(dur, ampat, ampdc)
amp_decay = 100.0 - attack_point(dur, ampdc, ampat)
freq_attack = attack_point(dur, freqat, freqdc)
freq_decay = 100.0 - attack_point(dur, freqdc, freqat)
dev_attack = attack_point(dur, devat, devdc)
dev_decay = 100.0 - attack_point(dur, devdc, devat)
rfreq_attack = attack_point(dur, rfreqat, rfreqdc)
rfreq_decay = 100.0 - attack_point(dur, rfreqdc, rfreqat)
# ;; now make the actual envelopes -- these all assume we are
# ;; thinking in terms of the "value when the envelope is 1"
# ;; (i.e. dev1 and friends), and the "value when the envelope is 0"
# ;; (i.e. dev0 and friends) -- over the years this seemed to make
# ;; beginners happier than various other ways of describing the
# ;; y-axis behaviour of the envelope. all this boiler-plate for
# ;; envelopes might seem overly elaborate when our basic instrument
# ;; is really simple, but in most cases, and this one in
# ;; particular, nearly all the musical interest comes from the
# ;; envelopes, not the somewhat dull spectrum generated by the
# ;; basic patch.
dev_f = make_env(stretch_envelope(devfun, 25, dev_attack, 75, dev_decay),
hz2radians(dev1 - dev0), dur)
amp_f = make_env(stretch_envelope(ampfun, 25, amp_attack, 75, amp_decay), amp, dur)
freq_f = make_env(stretch_envelope(glissfun, 25, freq_attack, 75, freq_decay),
hz2radians(freq1 - freq0), dur)
rfreq_f = make_env(stretch_envelope(rfreqfun, 25, rfreq_attack, 75, rfreq_decay),
hz2radians(rfreq1 - rfreq0), dur)

run_instrument(start, dur, :degree, degree, :distance, distance, :reverb_amount, reverb) do
env(amp_f) * oscil(car, env(freq_f) + (dev_0 + env(dev_f)) * rand(mod, env(rfreq_f)))
end
end

=begin
with_sound(:statistics, true, :play, 1) do
fm_noise(0, 1.8, 500,
0.25, [0, 0, 25, 1, 75, 1, 100, 0], 0.1, 0.1,
1000, [0, 0, 100, 1], 0.1, 0.1,
10, 1000, [0, 0, 100, 1], 0, 0,
100, 500, [0, 0, 100, 1], 0, 0)
fm_noise(2, 1.8, 200,
0.25, [0, 0, 25, 1, 75, 1, 100, 0], 0.1, 0.1,
1000, [0, 0, 100, 1], 0.1, 0.1,
10, 1000, [0, 0, 100, 1], 0, 0,
100, 500, [0, 0, 100, 1], 0, 0)
end
=end

# noise.rb ends here

+ 184
- 0
lib/sndlib/noise.scm View File

@@ -0,0 +1,184 @@
;;; noise.scm -- CLM -> Snd/Scheme translation of noise.ins

;; Translator/Author: Michael Scholz <scholz-micha@gmx.de>
;; Last: Wed Apr 02 02:47:21 CEST 2003
;; Version: $Revision: 1.9 $

;;; Comments not otherwise noted are taken from noise.ins!

;; Included functions:
;; (attack-point duration attack decay (total-x 100.0))
;; (fm-noise ...)
;; (make-fm-noise len freq ...)

;;; The "noise" instrument (useful for Oceanic Music):

(provide 'snd-noise.scm)
(require snd-ws.scm snd-env.scm)

(define *locsig-type* mus-interp-sinusoidal)

(define* (attack-point duration attack decay (total-x 100.0))
(* total-x (/ (if (= 0.0 attack)
(/ (if (= 0.0 decay) duration (- duration decay)) 4)
attack)
duration)))

(definstrument (fm-noise startime dur freq0 amp ampfun ampat ampdc
freq1 glissfun freqat freqdc rfreq0 rfreq1 rfreqfun rfreqat rfreqdc
dev0 dev1 devfun devat devdc
(degree 0.0)
(distance 1.0)
(reverb-amount 0.005))
;; ampat = amp envelope attack time, and so on -- this instrument
;; assumes your envelopes go from 0 to 100 on the x-axis, and that
;; the "attack" portion ends at 25, the "decay" portion starts at
;; 75. "rfreq" is the frequency of the random number generator --
;; if below about 25 hz you get automatic composition, above that
;; you start to get noise. well, you get a different kind of noise.
;; "dev" is the bandwidth of the noise -- very narrow gives a
;; whistle, very broad more of a whoosh. this is basically "simple
;; fm", but the modulating signal is white noise.
(let ((beg (seconds->samples startime))
(end (seconds->samples (+ startime dur)))
(carrier (make-oscil freq0))
(modulator (make-rand :frequency rfreq0 :amplitude 1.0))
(loc (make-locsig :degree degree
:distance distance
:reverb reverb-amount
:type *locsig-type*))
;; now make the actual envelopes -- these all assume we are
;; thinking in terms of the "value when the envelope is 1"
;; (i.e. dev1 and friends), and the "value when the envelope
;; is 0" (i.e. dev0 and friends) -- over the years this
;; seemed to make beginners happier than various other ways
;; of describing the y-axis behaviour of the envelope. all
;; this boiler-plate for envelopes might seem overly
;; elaborate when our basic instrument is really simple, but
;; in most cases, and this one in particular, nearly all the
;; musical interest comes from the envelopes, not the
;; somewhat dull spectrum generated by the basic patch.
(dev-f (let ((dev-attack (attack-point dur devat devdc))
(dev-decay (- 100.0 (attack-point dur devdc devat))))
(make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
:duration dur
:offset (hz->radians dev0)
:scaler (hz->radians (- dev1 dev0)))))
(amp-f (let ((amp-attack (attack-point dur ampat ampdc))
(amp-decay (- 100.0 (attack-point dur ampdc ampat))))
(make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
:duration dur :scaler amp)))
(freq-f (let ((freq-attack (attack-point dur freqat freqdc))
(freq-decay (- 100.0 (attack-point dur freqdc freqat))))
(make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
:duration dur :scaler (hz->radians (- freq1 freq0)))))
(rfreq-f (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
(rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
(make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
:duration dur :scaler (hz->radians (- rfreq1 rfreq0))))))
(do ((i beg (+ i 1)))
((= i end))
(locsig loc i (* (env amp-f)
(oscil carrier (+ (env freq-f)
(* (env dev-f) (rand modulator (env rfreq-f))))))))))

;;; (with-sound () (fm-noise 0 0.5 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1 1000 '(0 0 100 1) 0.1 0.1 10 1000 '(0 0 100 1) 0 0 100 500 '(0 0 100 1) 0 0))


;; (let* ((ofile "test.snd")
;; (snd (find-sound ofile)))
;; (if snd
;; (close-sound snd))
;; (with-sound (:output ofile :play 1 :statistics #t)
;; (fm-noise 0 2.0 500 0.25 '(0 0 25 1 75 1 100 0) 0.1 0.1
;; 1000 '(0 0 100 1) 0.1 0.1
;; 10 1000 '(0 0 100 1) 0 0
;; 100 500 '(0 0 100 1) 0 0)))

;;; And here is a generator-like instrument, see make-fm-violin in
;;; fmv.scm. [MS]

(define* (make-fm-noise len freq
(amp 0.25)
(ampfun '(0 0 25 1 75 1 100 0))
(ampat 0.1)
(ampdc 0.1)
(freq1 1000)
(glissfun '(0 0 100 1))
(freqat 0.1)
(freqdc 0.1)
(rfreq0 10)
(rfreq1 1000)
(rfreqfun '(0 0 100 1))
(rfreqat 0)
(rfreqdc 0)
(dev0 100)
(dev1 500)
(devfun '(0 0 100 1))
(devat 0)
(devdc 0)
; (degree (random 90.0))
; (distance 1.0)
; (reverb-amount 0.005)
)
(let ((dur (/ len (floor (srate)))))
(let ((dev-ff (let ((dev-attack (attack-point dur devat devdc))
(dev-decay (- 100.0 (attack-point dur devdc devat))))
(make-env (stretch-envelope devfun 25 dev-attack 75 dev-decay)
:duration dur :scaler (hz->radians (- dev1 dev0)))))
(amp-ff (let ((amp-attack (attack-point dur ampat ampdc))
(amp-decay (- 100.0 (attack-point dur ampdc ampat))))
(make-env (stretch-envelope ampfun 25 amp-attack 75 amp-decay)
:duration dur :scaler amp)))
(freq-ff (let ((freq-attack (attack-point dur freqat freqdc))
(freq-decay (- 100.0 (attack-point dur freqdc freqat))))
(make-env (stretch-envelope glissfun 25 freq-attack 75 freq-decay)
:duration dur :scaler (hz->radians (- freq1 freq)))))
(rfreq-ff (let ((rfreq-attack (attack-point dur rfreqat rfreqdc))
(rfreq-decay (- 100.0 (attack-point dur rfreqdc rfreqat))))
(make-env (stretch-envelope rfreqfun 25 rfreq-attack 75 rfreq-decay)
:duration dur :scaler (hz->radians (- rfreq1 rfreq0)))))
(carrier (make-oscil freq))
(modulator (make-rand :frequency rfreq0 :amplitude 1.0))
(dev-0 (hz->radians dev0)))
(let ((dev-f (lambda () (env dev-ff)))
(amp-f (lambda () (env amp-ff)))
(freq-f (lambda () (env freq-ff)))
(rfreq-f (lambda () (env rfreq-ff))))
(lambda ()
(* (amp-f) (oscil carrier (+ (freq-f) (* (+ dev-0 (dev-f)) (rand modulator (rfreq-f)))))))))))

;; (let* ((beg 0)
;; (dur 9.8)
;; (len (+ beg (floor (* dur (srate)))))
;; (chns 4)
;; (outfile "test.snd")
;; (snd (find-sound outfile))
;; (loc (make-locsig :degree (random 3535.0) :channels chns))
;; (data (make-float-vector len)))
;; (do ((i 0 (+ i 1)))
;; ((= i len))
;; (set! (data i) (make-fm-noise len 500)))
;; (if snd
;; (close-sound snd))
;; (set! snd (new-sound outfile chns *clm-srate* mus-bshort mus-next))
;; (do ((i 0 (+ i 1)))
;; ((= i chns))
;; (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;; (let* ((beg (floor (* 10 (srate))))
;; (len (+ beg (floor (* dur (srate)))))
;; (loc (make-locsig :degree (random 3535.0) :channels chns))
;; (data (make-float-vector len)))
;; (do ((i 0 (+ i 1)))
;; ((= i len))
;; (set! (data i) (make-fm-noise len 200)))
;; (do ((i 0 (+ i 1)))
;; ((= i chns))
;; (mix-float-vector (float-vector-scale! (copy data) (locsig-ref loc i)) beg snd i #f))
;; (play snd 0)))

;; noise.scm ends here

+ 74
- 0
lib/sndlib/nrev.scm View File

@@ -0,0 +1,74 @@
;;; NREV (the most popular Samson box reverb)

(provide 'snd-nrev.scm)

(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))


(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

(let ((dly-len (if (= (floor *clm-srate*) 44100)
#(2467 2753 3217 3533 3877 4127 599 197 67 101 97 73 67 53 37)
(and (= (floor *clm-srate*) 22050)
#(1237 1381 1607 1777 1949 2063 307 97 31 53 47 37 31 29 17))))
(chan2 (> (channels *output*) 1))
(chan4 (= (channels *output*) 4)))
(if (not dly-len)
(let ((srscale (/ *clm-srate* 25641)))

(define (next-prime val)
(if (or (= val 2)
(and (odd? val)
(do ((i 3 (+ i 2))
(lim (sqrt val)))
((or (= 0 (modulo val i)) (> i lim)) (> i lim)))))
val
(next-prime (+ val 2))))

(set! dly-len #(1433 1601 1867 2053 2251 2399 347 113 37 59 53 43 37 29 19))
(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*))))))))))))

;;; (with-sound (:reverb nrev) (outa 0 .1) (outa 0 .5 *reverb*))

+ 4900
- 0
lib/sndlib/peak-phases.scm
File diff suppressed because it is too large
View File


+ 526
- 0
lib/sndlib/piano.rb View File

@@ -0,0 +1,526 @@
# piano.rb -- translation of piano.scm -*- snd-ruby -*-
# ;;; CLM piano.ins (Scott Van Duyne) translated to Snd/Scheme

# Ruby Translator: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Thu Mar 06 03:58:02 CET 2003
# Changed: Mon Nov 22 13:25:33 CET 2010

module Piano
require "ws"
require "env"
include Math

Number_of_stiffness_allpasses = 8
Longitudinal_mode_cutoff_keynum = 29
Longitudinal_mode_stiffness_coefficient = -0.5
Golden_mean = 0.618
Loop_gain_env_t60 = 0.05
Loop_gain_default = 0.9999
Nstrings = 3

# ;;keyNum indexed parameter tables
# ;;these should all be &key variable defaults for p instrument
Default_loudPole_table = [36, 0.8, 60, 0.85, 84, 0.7, 96, 0.6, 108, 0.5]
Default_softPole_table = [36, 0.93, 60, 0.9, 84, 0.9, 96, 0.8, 108, 0.8]
Default_loudGain_table = [21.0, 0.7, 36.0, 0.7, 48.0, 0.7, 60.0, 0.65, 72.0, 0.65, 84.0,
0.65, 87.006, 0.681, 88.07, 0.444, 90.653, 0.606, 95.515, 0.731,
99.77, 0.775, 101.897, 0.794, 104.024, 0.8, 105.695, 0.806]
Default_softGain_table = [21, 0.25, 108, 0.25]
Default_strikePosition_table = [21.0, 0.14, 23.884, 0.139, 36.0, 0.128, 56.756, 0.129,
57.765, 0.13, 59.0, 0.13, 60.0, 0.128, 61.0, 0.128, 62.0,
0.129, 66.128, 0.129, 69.0, 0.128, 72.0, 0.128, 73.0,
0.128, 79.0, 0.128, 80.0, 0.128, 96.0, 0.128, 99.0, 0.128]
Default_detuning2_table = [22.017, -0.09, 23.744, -0.09, 36.0, -0.08, 48.055, -0.113,
60.0, -0.135, 67.264, -0.16, 72.0, -0.2, 84.054, -0.301,
96.148, -0.383, 108, -0.383]
Default_detuning3_table = [21.435, 0.027, 23.317, 0.043, 36.0, 0.03, 48.0, 0.03, 60.0,
0.03, 72.0, 0.02, 83.984, 0.034, 96.0, 0.034, 99.766, 0.034]
Default_stiffnessCoefficient_table = [21.0, -0.92, 24.0, -0.9, 36.0, -0.7, 48.0, -0.25,
60.0, -0.1, 75.179, -0.04, 82.986, -0.04, 92.24,
-0.04, 96.0, -0.04, 99.0, 0.2, 108.0, 0.5]
Default_singleStringDecayRate_table = [21.678, -2.895, 24.0, -3.0, 36.0, -4.641, 41.953, -5.867,
48.173, -7.113, 53.818, -8.016, 59.693, -8.875, 66.605,
-9.434, 73.056, -10.035, 78.931, -10.293, 84.0, -12.185]
Default_singleStringZero_table = [21.0, -0.3, 24.466, -0.117, 28.763, -0.047, 36.0, -0.03, 48.0,
-0.02, 60.0, -0.01, 72.0, -0.01, 84.0, -0.01, 96.0, -0.01]
Default_singleStringPole_table = [21.0, 0.0, 24.466, 0.0, 28.763, 0.0, 36.0, 0.0, 108, 0.0]
Default_releaseLoopGain_table = [21.643, 0.739, 24.0, 0.8, 36.0, 0.88, 48.0, 0.91, 60.0, 0.94,
72.0, 0.965, 84.0, 0.987, 88.99, 0.987, 89.0, 1.0, 108.0, 1.0]
Default_dryTapFiltCoeft60_table = [36, 0.35, 60, 0.25, 108, 0.15]
Default_dryTapFiltCoefTarget_table = [36, -0.8, 60, -0.5, 84, -0.4, 108, -0.1]
Default_dryTapFiltCoefCurrent_table = [0, 0, 200, 0]
Default_dryTapAmpt60_table = [36, 0.55, 60, 0.5, 108, 0.45]
Default_sustainPedalLevel_table = [21.0, 0.25, 24.0, 0.25, 36.0, 0.2, 48.0, 0.125, 60.0,
0.075, 72.0, 0.05, 84.0, 0.03, 96.0, 0.01, 99.0, 0.01]
Default_pedalResonancePole_table = [20.841, 0.534, 21.794, 0.518, 33.222, 0.386, 45.127,
0.148, 55.445, -0.065, 69.255, -0.409, 82.905, -0.729,
95.763, -0.869, 106.398, -0.861]
Default_pedalEnvelopet60_table = [21.0, 7.5, 108.0, 7.5]
Default_soundboardCutofft60_table = [21.0, 0.25, 108.0, 0.25]
Default_dryPedalResonanceFactor_table = [21.0, 0.5, 108.0, 0.5]
Default_unaCordaGain_table = [21, 1.0, 24, 0.4, 29, 0.1, 29.1, 0.95, 108, 0.95]

def p(start, *args)
duration = get_args(args, :duration, 1.0)
keyNum = get_args(args, :keyNum, 60.0)
strike_velocity = get_args(args, :strike_velocity, 0.5)
pedal_down = get_args(args, :pedal_down, false)
release_time_margin = get_args(args, :release_time_margin, 0.75)
amp = get_args(args, :amp, 0.5)
detuningFactor = get_args(args, :detuningFactor, 1.0)
detuningFactor_table = get_args(args, :detuningFactor_table, [])
stiffnessFactor = get_args(args, :stiffnessFactor, 1.0)
stiffnessFactor_table = get_args(args, :stiffnessFactor_table, [])
pedalPresenceFactor = get_args(args, :pedalPresenceFactor, 0.3)
longitudinalMode = get_args(args, :longitudinalMode, 10.5)
strikePositionInvFac = get_args(args, :strikePositionInvFac, -0.9)
singleStringDecayRateFactor = get_args(args, :singleStringDecayRateFactor, 1.0)
loudPole = get_args(args, :loudPole, nil)
loudPole_table = get_args(args, :loudPole_table, Default_loudPole_table)
softPole = get_args(args, :softPole, nil)
softPole_table = get_args(args, :softPole_table, Default_softPole_table)
loudGain = get_args(args, :loudGain, nil)
loudGain_table = get_args(args, :loudGain_table, Default_loudGain_table)
softGain = get_args(args, :softGain, nil)
softGain_table = get_args(args, :softGain_table, Default_softGain_table)
strikePosition = get_args(args, :strikePosition, nil)
strikePosition_table = get_args(args, :strikePosition_table, Default_strikePosition_table)
detuning2 = get_args(args, :detuning2, nil)
detuning2_table = get_args(args, :detuning2_table, Default_detuning2_table)
detuning3 = get_args(args, :detuning3, nil)
detuning3_table = get_args(args, :detuning3_table, Default_detuning3_table)
stiffnessCoefficient = get_args(args, :stiffnessCoefficient, nil)
stiffnessCoefficient_table = get_args(args, :stiffnessCoefficient_table,
Default_stiffnessCoefficient_table)
singleStringDecayRate = get_args(args, :singleStringDecayRate, nil)
singleStringDecayRate_table = get_args(args, :singleStringDecayRate_table,
Default_singleStringDecayRate_table)
singleStringZero = get_args(args, :singleStringZero, nil)
singleStringZero_table = get_args(args, :singleStringZero_table,
Default_singleStringZero_table)
singleStringPole = get_args(args, :singleStringPole, nil)
singleStringPole_table = get_args(args, :singleStringPole_table,
Default_singleStringPole_table)
releaseLoopGain = get_args(args, :releaseLoopGain, nil)
releaseLoopGain_table = get_args(args, :releaseLoopGain_table, Default_releaseLoopGain_table)
dryTapFiltCoeft60 = get_args(args, :dryTapFiltCoeft60, nil)
dryTapFiltCoeft60_table = get_args(args, :dryTapFiltCoeft60_table,
Default_dryTapFiltCoeft60_table)
dryTapFiltCoefTarget = get_args(args, :dryTapFiltCoefTarget, nil)
dryTapFiltCoefTarget_table = get_args(args, :dryTapFiltCoefTarget_table,
Default_dryTapFiltCoefTarget_table)
dryTapFiltCoefCurrent = get_args(args, :dryTapFiltCoefCurrent, nil)
dryTapFiltCoefCurrent_table = get_args(args, :dryTapFiltCoefCurrent_table,
Default_dryTapFiltCoefCurrent_table)
dryTapAmpt60 = get_args(args, :dryTapAmpt60, nil)
dryTapAmpt60_table = get_args(args, :dryTapAmpt60_table, Default_dryTapAmpt60_table)
sustainPedalLevel = get_args(args, :sustainPedalLevel, nil)
sustainPedalLevel_table = get_args(args, :sustainPedalLevel_table,
Default_sustainPedalLevel_table)
pedalResonancePole = get_args(args, :pedalResonancePole, nil)
pedalResonancePole_table = get_args(args, :pedalResonancePole_table,
Default_pedalResonancePole_table)
pedalEnvelopet60 = get_args(args, :pedalEnvelopet60, nil)
pedalEnvelopet60_table = get_args(args, :pedalEnvelopet60_table,
Default_pedalEnvelopet60_table)
soundboardCutofft60 = get_args(args, :soundboardCutofft60, nil)
soundboardCutofft60_table = get_args(args, :soundboardCutofft60_table,
Default_soundboardCutofft60_table)
dryPedalResonanceFactor = get_args(args, :dryPedalResonanceFactor, nil)
dryPedalResonanceFactor_table = get_args(args, :dryPedalResonanceFactor_table,
Default_dryPedalResonanceFactor_table)
unaCordaGain = get_args(args, :unaCordaGain, nil)
unaCordaGain_table = get_args(args, :unaCordaGain_table, Default_unaCordaGain_table)
dur = seconds2samples(duration)
freq = 440.0 * (2.0 ** ((keyNum - 69.0) / 12.0))
wT = (TWO_PI * freq) / mus_srate
# ;;look_up parameters in tables (or else use the override value)
loudPole = (loudPole or envelope_interp(keyNum, loudPole_table))
softPole = (softPole or envelope_interp(keyNum, softPole_table))
loudGain = (loudGain or envelope_interp(keyNum, loudGain_table))
softGain = (softGain or envelope_interp(keyNum, softGain_table))
strikePosition = (strikePosition or envelope_interp(keyNum, strikePosition_table))
detuning2 = (detuning2 or envelope_interp(keyNum, detuning2_table))
detuning3 = (detuning3 or envelope_interp(keyNum, detuning3_table))
stiffnessCoefficient = (stiffnessCoefficient or
envelope_interp(keyNum, stiffnessCoefficient_table))
singleStringDecayRate = (singleStringDecayRate or
envelope_interp(keyNum, singleStringDecayRate_table))
singleStringDecayRate = singleStringDecayRateFactor * singleStringDecayRate
singleStringZero = (singleStringZero or envelope_interp(keyNum, singleStringZero_table))
singleStringPole = (singleStringPole or envelope_interp(keyNum, singleStringPole_table))
releaseLoopGain = (releaseLoopGain or envelope_interp(keyNum, releaseLoopGain_table))
dryTapFiltCoeft60 = (dryTapFiltCoeft60 or
envelope_interp(keyNum, dryTapFiltCoeft60_table))
dryTapFiltCoefTarget = (dryTapFiltCoefTarget or
envelope_interp(keyNum, dryTapFiltCoefTarget_table))
dryTapFiltCoefCurrent = (dryTapFiltCoefCurrent or
envelope_interp(keyNum, dryTapFiltCoefCurrent_table))
dryTapAmpt60 = (dryTapAmpt60 or envelope_interp(keyNum, dryTapAmpt60_table))
sustainPedalLevel = (sustainPedalLevel or envelope_interp(keyNum, sustainPedalLevel_table))
pedalResonancePole = (pedalResonancePole or envelope_interp(keyNum, pedalResonancePole_table))
pedalEnvelopet60 = (pedalEnvelopet60 or envelope_interp(keyNum, pedalEnvelopet60_table))
soundboardCutofft60 = (soundboardCutofft60 or
envelope_interp(keyNum, soundboardCutofft60_table))
dryPedalResonanceFactor = (dryPedalResonanceFactor or
envelope_interp(keyNum, dryPedalResonanceFactor_table))
unaCordaGain = (unaCordaGain or envelope_interp(keyNum, unaCordaGain_table))
detuningFactor = if detuningFactor_table.empty?
envelope_interp(keyNum, detuningFactor_table)
else
detuningFactor
end
stiffnessFactor = if stiffnessFactor_table.empty?
envelope_interp(keyNum, stiffnessFactor_table)
else
stiffnessFactor
end

# ;;initialize soundboard impulse response elements
dryTap_one_pole_one_zero_pair = make_one_pole_one_zero(1.0, 0.0, 0.0)
dryTap0 = dryTap_one_pole_one_zero_pair[0]
dryTap1 = dryTap_one_pole_one_zero_pair[1]
dryTap_coef_expseg = make_expseg(dryTapFiltCoefCurrent, dryTapFiltCoefTarget)
drycoefrate = in_t60(dryTapFiltCoeft60)
dryTap_one_pole_swept = make_one_pole_swept()
dryTap_amp_expseg = make_expseg(1.0, 0.0)
dryamprate = in_t60(dryTapAmpt60)
# ;;initialize open_string resonance elements
wetTap_one_pole_one_zero_pair =
make_one_pole_one_zero(1.0 - signum(pedalResonancePole) * pedalResonancePole,
0.0, -pedalResonancePole)
wetTap0 = wetTap_one_pole_one_zero_pair[0]
wetTap1 = wetTap_one_pole_one_zero_pair[1]
wetTap_coef_expseg = make_expseg(0.0, -0.5)
wetcoefrate = in_t60(pedalEnvelopet60)
wetTap_one_pole_swept = make_one_pole_swept()
wetTap_amp_expseg = make_expseg(sustainPedalLevel * pedalPresenceFactor *
(pedal_down ? 1.0 : dryPedalResonanceFactor),
0.0)
wetamprate = in_t60(pedalEnvelopet60)
sb_cutoff_rate = in_t60(soundboardCutofft60)
# ;;initialize velocity_dependent piano hammer filter elements
hammerPole = softPole + (loudPole - softPole) * strike_velocity
hammerGain = softGain + (loudGain - softGain) * strike_velocity
hammer_one_pole = Array.new(4)
# ;;strike position comb filter delay length
agraffe_len = (mus_srate * strikePosition) / freq

0.upto(3) do |i|
hammer_one_pole[i] = make_one_pole(1.0 * (1.0 - hammerPole), -hammerPole)
end

vals = apfloor(agraffe_len, wT)
dlen1 = vals[0]
apcoef1 = vals[1]
agraffe_delay1 = make_delay0(dlen1)
agraffe_tuning_ap1 = make_one_pole_allpass(apcoef1)
# ;;compute coefficients for and initialize the coupling filter
# ;;taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
attenuationPerPeriod = 10.0 ** (singleStringDecayRate / freq / 20.0)
g = attenuationPerPeriod # ;;DC gain
b = singleStringZero
a = singleStringPole
ctemp = 1 + -b + g + -(a * g) + Nstrings * (1 + -b + -g + a * g)

cfb0 = (2 * (-1 + b + g + -(a * g))) / ctemp
cfb1 = (2 * (a + -(a * b) + -(b * g) + a * b * g)) / ctemp
cfa1 = (-a + a * b + -(b * g) + a * b * g + Nstrings * (-a + a * b + b * g + -(a * b * g))) /
ctemp
couplingFilter_pair = make_one_pole_one_zero(cfb0, cfb1, cfa1)
cou0 = couplingFilter_pair[0]
cou1 = couplingFilter_pair[1]
# ;;determine string tunings (and longitudinal modes, if present)
freq1 = if keyNum <= Longitudinal_mode_cutoff_keynum
freq * longitudinalMode
else
freq
end
freq2 = freq + detuning2 * detuningFactor
freq3 = freq + detuning3 * detuningFactor

# ;;scale stiffness coefficients, if desired
stiffnessCoefficient = if stiffnessFactor > 1.0
stiffnessCoefficient - ((stiffnessCoefficient + 1) *
(stiffnessFactor - 1))
else
stiffnessCoefficient * stiffnessFactor
end
stiffnessCoefficientL = if keyNum <= Longitudinal_mode_cutoff_keynum
Longitudinal_mode_stiffness_coefficient
else
stiffnessCoefficient
end
# ;;initialize the coupled_string elements
vals1 = tune_piano(freq1, stiffnessCoefficientL, Number_of_stiffness_allpasses,
cfb0, cfb1, cfa1)
delayLength1 = vals1[0]
tuningCoefficient1 = vals1[1]
vals2 = tune_piano(freq2, stiffnessCoefficient, Number_of_stiffness_allpasses,
cfb0, cfb1, cfa1)
delayLength2 = vals2[0]
tuningCoefficient2 = vals2[1]
vals3 = tune_piano(freq3, stiffnessCoefficient, Number_of_stiffness_allpasses,
cfb0, cfb1, cfa1)
delayLength3 = vals3[0]
tuningCoefficient3 = vals3[1]
string1_delay = make_delay0(delayLength1 - 1)
string1_tuning_ap = make_one_pole_allpass(tuningCoefficient1)
string1_stiffness_ap = Array.new(8)
string2_delay = make_delay0(delayLength2 - 1)
string2_tuning_ap = make_one_pole_allpass(tuningCoefficient2)
string2_stiffness_ap = Array.new(8)
string3_delay = make_delay0(delayLength3 - 1)
string3_tuning_ap = make_one_pole_allpass(tuningCoefficient3)
string3_stiffness_ap = Array.new(8)
# ;;initialize loop_gain envelope
loop_gain_expseg = make_expseg(Loop_gain_default, releaseLoopGain)
looprate = in_t60(Loop_gain_env_t60)
adelOut = 0.0
loop_gain = Loop_gain_default
is_release_time = false
string1_junction_input = 0.0
string2_junction_input = 0.0
string3_junction_input = 0.0
couplingFilter_output = 0.0
sampCount = 0
noi = make_noise()

0.upto(7) do |i|
string1_stiffness_ap[i] = make_one_pole_allpass(stiffnessCoefficientL)
end
0.upto(7) do |i|
string2_stiffness_ap[i] = make_one_pole_allpass(stiffnessCoefficient)
end
0.upto(7) do |i|
string3_stiffness_ap[i] = make_one_pole_allpass(stiffnessCoefficient)
end

run_instrument(start, duration + release_time_margin) do
if is_release_time
loop_gain = loop_gain_expseg.call(looprate)
elsif sampCount == dur
is_release_time = true
dryamprate = sb_cutoff_rate
wetamprate = sb_cutoff_rate
end
dryTap = (dryTap_amp_expseg.call(dryamprate) * \
dryTap_one_pole_swept.call(one_pole_one_zero(dryTap0, dryTap1, noi.call(amp)),
dryTap_coef_expseg.call(drycoefrate)))
openStrings = (wetTap_amp_expseg.call(wetamprate) * \
wetTap_one_pole_swept.call(one_pole_one_zero(wetTap0, wetTap1, noi.call(amp)),
wetTap_coef_expseg.call(wetcoefrate)))
adelIn = dryTap + openStrings
0.upto(3) do |i| adelIn = one_pole(hammer_one_pole[i], adelIn) end
combedExcitationSignal = hammerGain * (adelOut + adelIn * strikePositionInvFac)
adelOut = agraffe_tuning_ap1.call(delay0(agraffe_delay1, adelIn))
string1_junction_input += couplingFilter_output
0.upto(7) do |i|
string1_junction_input = string1_stiffness_ap[i].call(string1_junction_input)
end
string1_junction_input = (unaCordaGain * combedExcitationSignal + \
loop_gain * delay0(string1_delay,
string1_tuning_ap.call(string1_junction_input)))
string2_junction_input += couplingFilter_output
0.upto(7) do |i|
string2_junction_input = string2_stiffness_ap[i].call(string2_junction_input)
end
string2_junction_input = (combedExcitationSignal + \
loop_gain * delay0(string2_delay,
string2_tuning_ap.call(string2_junction_input)))
string3_junction_input += couplingFilter_output
0.upto(7) do |i|
string3_junction_input = string3_stiffness_ap[i].call(string3_junction_input)
end
string3_junction_input = (combedExcitationSignal + \
loop_gain * delay0(string3_delay,
string3_tuning_ap.call(string3_junction_input)))
couplingFilter_input = string1_junction_input + string2_junction_input +
string3_junction_input
couplingFilter_output = one_pole_one_zero(cou0, cou1, couplingFilter_input)
sampCount += 1
couplingFilter_input
end
end

# ;;; converts t60 values to suitable :rate values for expseg
def in_t60(t60)
1.0 - (0.001 ** (1.0 / t60 / mus_srate))
end

# ;;; expseg (like musickit asymp)
def make_expseg(cv = 0.0, tv = 0.0)
lambda do |r|
old_cv = cv
cv = cv + (tv - cv) * r
old_cv # ; (bil) this is slightly different (getting clicks)
end
end

# ;;; signal controlled one-pole lowpass filter
def make_one_pole_swept
y1 = 0.0
lambda do |input, coef|
y1 = (coef + 1) * input - coef * y1
end
end

# ;;; one-pole allpass filter
def make_one_pole_allpass(coeff)
coef = coeff
x1 = 0.0
y1 = 0.0
lambda do |input|
y1 = (coef * (input - y1)) + x1
x1 = input
y1
end
end

def one_pole_one_zero(f0, f1, input)
one_zero(f0, one_pole(f1, input))
end

def make_one_pole_one_zero(a0, a1, b1)
[make_one_zero(a0, a1), make_one_pole(1.0, b1)]
end

# ;;; very special noise generator
def make_noise
noise_seed = 16383
lambda do |amp|
noise_seed = (noise_seed * 1103515245 + 12345) & 0xffffffff
# ;; (bil) added the logand -- otherwise we get an overflow somewhere
amp * (((noise_seed / 65536).round % 65536) * 0.0000305185 - 1.0)
end
end

# ;;; delay line unit generator with length 0 capabilities...
def make_delay0(len)
len > 0 ? make_delay(len) : false
end

def delay0(f, input)
f ? delay(f, input) : input
end

def ap_phase(a1, wT)
atan2((a1 * a1 - 1.0) * sin(wT), 2.0 * a1 + (a1 * a1 + 1.0) * cos(wT))
end

def opoz_phase(b0, b1, a1, wT)
s = sin(wT)
c = cos(wT)
atan2(a1 * s * (b0 + b1 * c) - b1 * s * (1 + a1 * c),
(b0 + b1 * c) * (1 + a1 * c) + b1 * s * a1 * s)
end

def get_allpass_coef(samp_frac, wT)
ta = tan(-(samp_frac * wT))
c = cos(wT)
s = sin(wT)
(-ta + signum(ta) * sqrt((ta * ta + 1) * s * s)) / (c * ta - s)
end

def signum(x)
if x == 0.0
0
elsif x < 0.0
-1
else
1
end
end

def apfloor(len, wT)
len_int = len.floor.round
len_frac = len - len_int
if len_frac < Golden_mean
len_int -= 1
len_frac += 1.0
end
if len_frac < Golden_mean and len_int > 0
len_int -= 1
len_frac += 1.0
end
[len_int, get_allpass_coef(len_frac, wT)]
end

def tune_piano(frequency, stiffnessCoefficient, numAllpasses, b0, b1, a1)
wT = (frequency * TWO_PI) / mus_srate
len = (TWO_PI + (numAllpasses * ap_phase(stiffnessCoefficient, wT)) +
opoz_phase(1 + 3 * b0, a1 + 3 * b1, a1, wT)) / wT
apfloor(len, wT)
end
end

include Piano

=begin
with_sound(:clm, false, :channels, 1) do
7.times do |i|
p(i * 0.5,
:duration, 0.5,
:keyNum, 24 + 12.0 * i,
:strike_velocity, 0.5,
:amp, 0.4,
:dryPedalResonanceFactor, 0.25)
end
end

with_sound(:clm, false, :channels, 1) do
7.times do |i|
p(i * 0.5,
:duration, 0.5,
:keyNum, 24 + 12.0 * i,
:strike_velocity, 0.5,
:amp, 0.4,
:dryPedalResonanceFactor, 0.25,
:detuningFactor_table, [24, 5, 36, 7.0, 48, 7.5, 60, 12.0, 72, 20,
84, 30, 96, 100, 108, 300],
:stiffnessFactor_table, [21, 1.5, 24, 1.5, 36, 1.5, 48, 1.5, 60, 1.4,
72, 1.3, 84, 1.2, 96, 1.0, 108, 1.0])
end
end

with_sound(:clm, false, :channels, 1) do
7.times do |i|
p(i * 0.5,
:duration, 0.5,
:keyNum, 24 + 12.0 * i,
:strike_velocity, 0.5,
:amp, 0.4,
:dryPedalResonanceFactor, 0.25,
:singleStringDecayRate_table, [21, -5, 24.0, -5.0, 36.0, -5.4, 41.953, -5.867, 48.173,
-7.113, 53.818, -8.016, 59.693, -8.875, 66.605, -9.434,
73.056, -10.035, 78.931, -10.293, 84.000, -12.185],
:singleStringPole_table, [21, 0.8, 24, 0.7, 36.0, 0.6, 48, 0.5, 60,
0.3, 84, 0.1, 96, 0.03, 108, 0.03],
:stiffnessCoefficient_table, [21.0, -0.92, 24.0, -0.9, 36.0, -0.7, 48.0, -0.250, 60.0,
-0.1, 75.179, -0.040, 82.986, -0.040, 92.240, 0.3, 96.0,
0.5, 99.0, 0.7, 108.0, 0.7])
end
end

with_sound(:clm, false, :channels, 1) do
p(0,
:duration, 5,
:keyNum, 24 + 12.0 * 5,
:strike_velocity, 0.5,
:amp, 0.4,
:dryPedalResonanceFactor, 0.25,
:singleStringDecayRateFactor, 1 / 10.0)
end
=end

# piano.rb ends here

+ 514
- 0
lib/sndlib/piano.scm View File

@@ -0,0 +1,514 @@
;;; CLM piano.ins (Scott Van Duyne) translated to Snd/Scheme

(provide 'snd-piano.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))
(require snd-env.scm)

;;; see generators.scm for the old scheme versions of one-pole-all-pass, pnoise, one-pole-swept, and expseg

;; converts t60 values to suitable :rate values for expseg
(define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 *clm-srate*))))
(define number-of-stiffness-allpasses 8)
(define longitudinal-mode-cutoff-keynum 29)
(define longitudinal-mode-stiffness-coefficient -.5)
(define loop-gain-env-t60 (In-t60 .05))
(define loop-gain-default .9999)
(define nstrings 3)
(define two-pi (* 2 pi))

;;keyNum indexed parameter tables
;;these should all be &key variable defaults for p instrument
(define default-loudPole-table '(36 .8 60 .85 84 .7 96 .6 108 .5))
(define default-softPole-table '(36 .93 60 .9 84 .9 96 .8 108 .8))
(define default-loudGain-table '(21.000 0.700 36.000 0.700 48.000 0.700 60.000 0.650 72.000 0.650
84.000 0.650 87.006 0.681 88.070 0.444 90.653 0.606 95.515 0.731
99.770 0.775 101.897 0.794 104.024 0.800 105.695 0.806))
(define default-softGain-table '(21 .25 108 .25))
(define default-strikePosition-table '(21.000 0.140 23.884 0.139 36.000 0.128 56.756 0.129 57.765 0.130
59.000 0.130 60.000 0.128 61.000 0.128 62.000 0.129 66.128 0.129
69.000 0.128 72.000 0.128 73.000 0.128 79.000 0.128 80.000 0.128
96.000 0.128 99.000 0.128))

(define default-detuning2-table '(22.017 -0.090 23.744 -0.090 36.000 -0.080 48.055 -0.113 60.000 -0.135
67.264 -0.160 72.000 -0.200 84.054 -0.301 96.148 -0.383 108 -0.383))
(define default-detuning3-table '(21.435 0.027 23.317 0.043 36.000 0.030 48.000 0.030 60.000 0.030 72.000
0.020 83.984 0.034 96.000 0.034 99.766 0.034))
(define default-stiffnessCoefficient-table '(21.000 -0.920 24.000 -0.900 36.000 -0.700 48.000 -0.250 60.000
-0.100 75.179 -0.040 82.986 -0.040 92.240 -0.040 96.000 -0.040
99.000 .2 108.000 .5))

(define default-singleStringDecayRate-table '(21.678 -2.895 24.000 -3.000 36.000 -4.641 41.953 -5.867 48.173
-7.113 53.818 -8.016 59.693 -8.875 66.605 -9.434 73.056 -10.035
78.931 -10.293 84.000 -12.185))
(define default-singleStringZero-table '(21.000 -0.300 24.466 -0.117 28.763 -0.047 36.000 -0.030 48.000 -0.020
60.000 -0.010 72.000 -0.010 84.000 -0.010 96.000 -0.010))
(define default-singleStringPole-table '(21.000 0 24.466 0 28.763 0 36.000 0 108 0))
(define default-releaseLoopGain-table '(21.643 0.739 24.000 0.800 36.000 0.880 48.000 0.910 60.000 0.940
72.000 0.965 84.000 0.987 88.99 .987 89.0 1.0 108 1.0))

(define default-DryTapFiltCoeft60-table '(36 .35 60 .25 108 .15))
(define default-DryTapFiltCoefTarget-table '(36 -.8 60 -.5 84 -.4 108 -.1))
(define default-DryTapFiltCoefCurrent-table '(0 0 200 0))
(define default-DryTapAmpt60-table '(36 .55 60 .5 108 .45))
(define default-sustainPedalLevel-table '(21.000 0.250 24.000 0.250 36.000 0.200 48.000 0.125 60.000 0.075
72.000 0.050 84.000 0.030 96.000 0.010 99.000 0.010))
(define default-pedalResonancePole-table '(20.841 0.534 21.794 0.518 33.222 0.386 45.127 0.148 55.445 -0.065
69.255 -0.409 82.905 -0.729 95.763 -0.869 106.398 -0.861))
(define default-pedalEnvelopet60-table '(21.0 7.5 108.0 7.5))
(define default-soundboardCutofft60-table '(21.0 .25 108.0 .25))
(define default-DryPedalResonanceFactor-table '(21.0 .5 108.0 .5))
(define default-unaCordaGain-table '(21 1.0 24 .4 29 .1 29.1 .95 108 .95))


(definstrument (p start (duration 1.0)
(keyNum 60.0) ; middleC=60: can use fractional part to detune
(strike-velocity 0.5) ; corresponding normalized velocities (range: 0.0--1.0)
pedal-down ; set to #t for sustain pedal down...pedal-down-times not yet implemented
(release-time-margin 0.75) ; extra compute time allowed beyond duration
(amp .5) ; amp scale of noise inputs...
;;slider controls
(detuningFactor 1.0)
(detuningFactor-table ())
(stiffnessFactor 1.0)
(stiffnessFactor-table ())
(pedalPresenceFactor .3)
(longitudinalMode 10.5)
(StrikePositionInvFac -0.9)
(singleStringDecayRateFactor 1.0)
;; parameter tables indexed by keyNum
;; you can override the loudPole-table by directly setting :loudPole to a value
loudPole
(loudPole-table default-loudPole-table)
softPole
(softPole-table default-softPole-table)
loudGain
(loudGain-table default-loudGain-table)
softGain
(softGain-table default-softGain-table)
strikePosition (strikePosition-table default-strikePosition-table)
detuning2
(detuning2-table default-detuning2-table)
detuning3
(detuning3-table default-detuning3-table)
stiffnessCoefficient
(stiffnessCoefficient-table default-stiffnessCoefficient-table)
singleStringDecayRate
(singleStringDecayRate-table default-singleStringDecayRate-table)
singleStringZero
(singleStringZero-table default-singleStringZero-table)
singleStringPole
(singleStringPole-table default-singleStringPole-table)
releaseLoopGain
(releaseLoopGain-table default-releaseLoopGain-table)
DryTapFiltCoeft60
(DryTapFiltCoeft60-table default-DryTapFiltCoeft60-table)
DryTapFiltCoefTarget
(DryTapFiltCoefTarget-table default-DryTapFiltCoefTarget-table)
DryTapFiltCoefCurrent
(DryTapFiltCoefCurrent-table default-DryTapFiltCoefCurrent-table)
DryTapAmpt60
(DryTapAmpt60-table default-DryTapAmpt60-table)
sustainPedalLevel
(sustainPedalLevel-table default-sustainPedalLevel-table)
pedalResonancePole
(pedalResonancePole-table default-pedalResonancePole-table)
pedalEnvelopet60
(pedalEnvelopet60-table default-pedalEnvelopet60-table)
soundboardCutofft60
(soundboardCutofft60-table default-soundboardCutofft60-table)
DryPedalResonanceFactor
(DryPedalResonanceFactor-table default-DryPedalResonanceFactor-table)
unaCordaGain
(unaCordaGain-table default-unaCordaGain-table))
(define (make-one-pole-one-zero a0 a1 b1)
(list (make-one-zero a0 a1)
(make-one-pole 1.0 b1)))
(define (signum n)
;; in CL this returns 1.0 if n is float
(if (positive? n) 1
(if (zero? n) 0
-1)))

(define apfloor
(let ((golden-mean .618))
(define (get-allpass-coef samp-frac wT)
(let ((ta (tan (- (* samp-frac wT))))
(c (cos wT))
(s (sin wT)))
(/ (- (* (signum ta)
(sqrt (* (+ 1 (* ta ta)) s s))) ta) ; is the (* s s) correct? it's in the original
(- (* c ta) s))))
(lambda (len wT)
(let* ((len-int (floor len))
(len-frac (- len len-int)))
(if (< len-frac golden-mean)
(begin
(set! len-int (- len-int 1))
(set! len-frac (+ len-frac 1.0))))
(if (and (< len-frac golden-mean)
(> len-int 0))
(begin
(set! len-int (- len-int 1))
(set! len-frac (+ len-frac 1.0))))
(list len-int (get-allpass-coef len-frac wT))))))
(define (tune-piano frequency stiffnessCoefficient numAllpasses b0 b1 a1)
(define (apPhase a1 wT)
(atan (* (- (* a1 a1) 1.0)
(sin wT))
(+ (* 2.0 a1)
(* (+ (* a1 a1) 1.0)
(cos wT)))))
(define (opozPhase b0 b1 a1 wT)
(let ((s (sin wT))
(c (cos wT)))
(atan (- (* a1 s (+ b0 (* b1 c)))
(* b1 s (+ 1 (* a1 c))))
(+ (* (+ b0 (* b1 c))
(+ 1 (* a1 c)))
(* b1 s a1 s)))))
(let* ((wT (/ (* frequency two-pi) *clm-srate*))
(len (/ (+ two-pi
(* numAllpasses
(apPhase stiffnessCoefficient wT))
(opozPhase (+ 1 (* 3 b0)) (+ a1 (* 3 b1)) a1 wT))
wT)))
(apfloor len wT)))
(let (;;look-up parameters in tables (or else use the override value)
(loudPole (or loudPole (envelope-interp keyNum loudPole-table)))
(softPole (or softPole (envelope-interp keyNum softPole-table)))
(loudGain (or loudGain (envelope-interp keyNum loudGain-table)))
(softGain (or softGain (envelope-interp keyNum softGain-table)))
(strikePosition (or strikePosition (envelope-interp keyNum strikePosition-table)))
(detuning2 (or detuning2 (envelope-interp keyNum detuning2-table)))
(detuning3 (or detuning3 (envelope-interp keyNum detuning3-table)))
(stiffnessCoefficient (or stiffnessCoefficient (envelope-interp keyNum stiffnessCoefficient-table)))
(singleStringDecayRate-1 (or singleStringDecayRate (envelope-interp keyNum singleStringDecayRate-table)))
(singleStringZero (or singleStringZero (envelope-interp keyNum singleStringZero-table)))
(singleStringPole (or singleStringPole (envelope-interp keyNum singleStringPole-table)))
(releaseLoopGain (or releaseLoopGain (envelope-interp keyNum releaseLoopGain-table)))
(DryTapFiltCoeft60 (In-t60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table))))
(DryTapFiltCoefTarget (or DryTapFiltCoefTarget (envelope-interp keyNum DryTapFiltCoefTarget-table)))
(DryTapFiltCoefCurrent (or DryTapFiltCoefCurrent (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
(DryTapAmpt60 (In-t60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table))))
(sustainPedalLevel (or sustainPedalLevel (envelope-interp keyNum sustainPedalLevel-table)))
(pedalResonancePole (or pedalResonancePole (envelope-interp keyNum pedalResonancePole-table)))
(pedalEnvelopet60 (In-t60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table))))
(soundboardCutofft60 (or soundboardCutofft60 (envelope-interp keyNum soundboardCutofft60-table)))
(DryPedalResonanceFactor (or DryPedalResonanceFactor (envelope-interp keyNum DryPedalResonanceFactor-table)))
(unaCordaGain (or unaCordaGain (envelope-interp keyNum unaCordaGain-table)))
(detuningFactor (if (null? detuningFactor-table) (envelope-interp keyNum detuningFactor-table) detuningFactor))
(stiffnessFactor (if (null? stiffnessFactor-table) (envelope-interp keyNum stiffnessFactor-table) stiffnessFactor))
(dryTap-one-pole-one-zero-pair (make-one-pole-one-zero 1.0 0.0 0.0))
(dryTap-one-pole-swept 0.0)
(wetTap-one-pole-swept 0.0)
(beg (seconds->samples start))
(dur (seconds->samples duration))
(freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0)))))
(let((end (+ beg dur (seconds->samples release-time-margin)))
(release-time (+ beg dur))
(wT (/ (* two-pi freq) *clm-srate*))
;;strike position comb filter delay length
(agraffe-len (/ (* *clm-srate* strikePosition) freq))
(singleStringDecayRate (* singleStringDecayRateFactor singleStringDecayRate-1)))
(let (;;initialize soundboard impulse response elements
;;initialize open-string resonance elements
(wetTap-one-pole-one-zero-pair (make-one-pole-one-zero (- 1.0 (* (signum pedalResonancePole) pedalResonancePole)) 0.0 (- pedalResonancePole)))

(sb-cutoff-rate (In-t60 soundboardCutofft60))
;;initialize velocity-dependent piano hammer filter elements
(hammerPole (+ softPole (* (- loudPole softPole) strike-velocity)))
(hammerGain (+ softGain (* (- loudGain softGain) strike-velocity)))
(vals (apfloor agraffe-len wT))
(attenuationPerPeriod (expt 10.0 (/ singleStringDecayRate freq 20.0))))

(let ((dlen1 (car vals))
(apcoef1 (cadr vals))
;;compute coefficients for and initialize the coupling filter
;; taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
(g attenuationPerPeriod) ;;DC gain
(b singleStringZero)
(a singleStringPole)
;;determine string tunings (and longitudinal modes, if present)
(freq1 (if (<= keyNum longitudinal-mode-cutoff-keynum) (* freq longitudinalMode) freq))
(freq2 (+ freq (* detuning2 detuningFactor)))
(freq3 (+ freq (* detuning3 detuningFactor)))
;;scale stiffness coefficients, if desired
(stiffnessCoefficient (if (> stiffnessFactor 1.0)
(- stiffnessCoefficient
(* (+ 1 stiffnessCoefficient)
(- stiffnessFactor 1)))
(* stiffnessCoefficient stiffnessFactor))))
(let ((ctemp (- (+ 1 g (* nstrings (- (+ 1 (* a g)) b g))) b (* a g)))
(stiffnessCoefficientL (if (<= keyNum longitudinal-mode-cutoff-keynum)
longitudinal-mode-stiffness-coefficient
stiffnessCoefficient)))
(let ((cfb0 (/ (* 2 (- (+ -1 b g) (* a g))) ctemp))
(cfb1 (/ (* 2 (- (+ a (* a b g)) (* a b) (* b g))) ctemp))
(cfa1 (/ (- (+ (* a b) (* a b g) (* nstrings (- (* b (+ a g)) a (* a b g)))) a (* b g)) ctemp))
(agraffe-delay1 (make-delay dlen1))
(agraffe-tuning-ap1 (make-one-pole-all-pass 1 apcoef1)))
(let ((couplingFilter-pair (make-one-pole-one-zero cfb0 cfb1 cfa1))
;;initialize the coupled-string elements
(vals1 (tune-piano freq1 stiffnessCoefficientL number-of-stiffness-allpasses cfb0 cfb1 cfa1))
(vals2 (tune-piano freq2 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1))
(vals3 (tune-piano freq3 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1)))
(let ((delayLength1 (car vals1))
(tuningCoefficient1 (cadr vals1))
(delayLength2 (car vals2))
(tuningCoefficient2 (cadr vals2))
(delayLength3 (car vals3))
(tuningCoefficient3 (cadr vals3))
(interp 0.0)
(dryTap-rx 0.0)
(wetTap-rx 0.0))
(define piano-loop
(let ((dryTap0 (car dryTap-one-pole-one-zero-pair))
(dryTap1 (cadr dryTap-one-pole-one-zero-pair))
(wetTap0 (car wetTap-one-pole-one-zero-pair))
(wetTap1 (cadr wetTap-one-pole-one-zero-pair))
(op1 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
(op2 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
(op3 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
(op4 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
(cou0 (car couplingFilter-pair))
(cou1 (cadr couplingFilter-pair))
(string1-delay (make-delay (- delayLength1 1)))
(string1-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient1))
(string1-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficientL))
(string2-delay (make-delay (- delayLength2 1)))
(string2-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient2))
(string2-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
(string3-delay (make-delay (- delayLength3 1)))
(string3-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient3))
(string3-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
;;initialize loop-gain envelope
(loop-gain loop-gain-default)
(loop-gain-ry (* releaseLoopGain loop-gain-env-t60))
(loop-gain-rx (- 1.0 loop-gain-env-t60))
(dry-coef (* 1.0 DryTapFiltCoefCurrent))
(dry-coef-ry (* DryTapFiltCoefTarget DryTapFiltCoeft60))
(dry-coef-rx (- 1.0 DryTapFiltCoeft60))
(wet-coef 0.0)
(wet-coef-ry (* -0.5 pedalEnvelopet60))
(wet-coef-rx (- 1.0 pedalEnvelopet60))
(dryTap 0.0)
(dryTap-x 1.0)
(openStrings 0.0)
(wetTap-x (* sustainPedalLevel pedalPresenceFactor (if pedal-down 1.0 DryPedalResonanceFactor)))
(combedExcitationSignal 0.0)
(adelOut 0.0)
(adelIn 0.0)
(totalTap 0.0)
(string1-junction-input 0.0)
(string2-junction-input 0.0)
(string3-junction-input 0.0)
(couplingFilter-input 0.0)
(couplingFilter-output 0.0)
(temp1 0.0)
;; (pn-gen 16383)
(pnoise (int-vector 16383)))
(lambda (beg end)
(do ((i beg (+ i 1)))
((= i end))
(set! loop-gain (+ (* interp (+ loop-gain-ry (* loop-gain-rx loop-gain)))
(* (- 1.0 interp) loop-gain-default)))
(set! temp1 (one-zero dryTap0 (one-pole dryTap1 (piano-noise pnoise amp))))
(set! dry-coef (+ dry-coef-ry (* dry-coef-rx dry-coef)))
(set! dryTap-one-pole-swept (- (* (+ 1.0 dry-coef) temp1) (* dry-coef dryTap-one-pole-swept)))
(set! dryTap-x (* dryTap-x dryTap-rx))
(set! dryTap (* dryTap-x dryTap-one-pole-swept))
(set! temp1 (one-zero wetTap0 (one-pole wetTap1 (piano-noise pnoise amp))))
(set! wet-coef (+ wet-coef-ry (* wet-coef-rx wet-coef)))
(set! wetTap-one-pole-swept (- (* (+ 1.0 wet-coef) temp1) (* wet-coef wetTap-one-pole-swept)))
(set! wetTap-x (* wetTap-x wetTap-rx))
(set! openStrings (* wetTap-x wetTap-one-pole-swept))
(set! totalTap (+ dryTap openStrings))
(set! adelIn (one-pole op1 (one-pole op2 (one-pole op3 (one-pole op4 totalTap)))))
(set! combedExcitationSignal (* hammerGain (+ adelOut (* adelIn StrikePositionInvFac))))
(set! adelOut (one-pole-all-pass agraffe-tuning-ap1 (delay agraffe-delay1 adelIn)))
(set! string1-junction-input
(+ (* unaCordaGain combedExcitationSignal)
(* loop-gain
(delay string1-delay
(one-pole-all-pass string1-tuning-ap
(one-pole-all-pass string1-stiffness-ap
(+ string1-junction-input couplingFilter-output)))))))
(set! string2-junction-input
(+ combedExcitationSignal
(* loop-gain
(delay string2-delay
(one-pole-all-pass string2-tuning-ap
(one-pole-all-pass string2-stiffness-ap
(+ string2-junction-input couplingFilter-output)))))))
(set! string3-junction-input
(+ combedExcitationSignal
(* loop-gain
(delay string3-delay
(one-pole-all-pass string3-tuning-ap
(one-pole-all-pass string3-stiffness-ap
(+ string3-junction-input couplingFilter-output)))))))
(set! couplingFilter-input (+ string1-junction-input string2-junction-input string3-junction-input))
(set! couplingFilter-output (one-zero cou0 (one-pole cou1 couplingFilter-input)))
(outa i couplingFilter-input)))))
(set! dryTap-rx (- 1.0 DryTapAmpt60))
(set! wetTap-rx (- 1.0 pedalEnvelopet60))
(piano-loop beg release-time)
(set! dryTap-rx (- 1.0 sb-cutoff-rate))
(set! wetTap-rx dryTap-rx)
(set! interp 1.0)
(piano-loop release-time end))))))))))

#|
(with-sound ()
(do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
:keyNum (+ 24 (* 12 i))
:strike-velocity .5
;0 to 1, 0 is softest played note, 1 is loud note
:amp .4
;overall volume level
:DryPedalResonanceFactor .25
;0 no open string resonance
;1.0 is about full resonance of dampers raised
;can be greater than 1.0
)))


(with-sound ()
(do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
:keyNum (+ 24 (* 12 i))
:strike-velocity .5
;0 to 1, 0 is softest played note, 1 is loud note
:amp .4
;overall volume level
:DryPedalResonanceFactor .25
;0 no open string resonance
;1.0 is about full resonance of dampers raised
;can be greater than 1.0
;;modification to do detunedness
:detuningFactor-table '(24 5 36 7.0 48 7.5 60 12.0 72 20
84 30 96 100 108 300)
;scales the above detuning values
; so 1.0 is nominal detuning
; 0.0 is exactly in tune (no two stage decay...)
; > 1.0 is out of tune...
;;modification to do stiffness
:stiffnessFactor-table '(21 1.5 24 1.5 36 1.5 48 1.5 60 1.4
72 1.3 84 1.2 96 1.0 108 1.0)
;0.0 to 1.0 is less stiff, 1.0 to 2.0 is more stiff...
)))


(with-sound ()
(do ((i 0 (+ i 1))) ((= i 8))
(p
(* i .5)
:duration .5
:keyNum (+ 24 (* 12 i))
:strike-velocity .5
;0 to 1, 0 is softest played note, 1 is loud note
:amp .4
;overall volume level
:DryPedalResonanceFactor .25
;0 no open string resonance
;1.0 is about full resonance of dampers raised
;can be greater than 1.0
;;modifications to do damped sounds
:singleStringDecayRate-table '(21 -5 24.000 -5.000 36.000 -5.4
41.953 -5.867 48.173 -7.113 53.818 -8.016
59.693 -8.875 66.605 -9.434 73.056 -10.035
78.931 -10.293 84.000 -12.185)
:singleStringPole-table '(21 .8 24 0.7 36.000 .6 48 .5 60 .3
84 .1 96 .03 108 .03)
:stiffnessCoefficient-table '(21.000 -0.920 24.000 -0.900 36.000 -0.700
48.000 -0.250 60.000 -0.100 75.179 -0.040
82.986 -0.040 92.240 .3 96.000 .5
99.000 .7 108.000 .7)
;these are the actual allpass coefficients modified here
;to allow dampedness at high freqs
)))

(let ((i 5))
(with-sound ()
(p
0
:duration 5
:keyNum (+ 24 (* 12 i))
:strike-velocity .5
;0 to 1, 0 is softest played note, 1 is loud note
:amp .4
;overall volume level
:DryPedalResonanceFactor .25
;0 no open string resonance
;1.0 is about full resonance of dampers raised
;can be greater than 1.0
;;modification for long duration notes
:singleStringDecayRateFactor 1/10
;scales attenuation rate (1/2 means twice as long duration)
)))
|#


+ 347
- 0
lib/sndlib/prc95.rb View File

@@ -0,0 +1,347 @@
# prc95.rb -- Translation of prc95.scm/prc-toolkit95.lisp to Snd/Ruby
# Perry Cook's Physical Modelling Toolkit

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Changed: Mon Nov 22 13:28:27 CET 2010

require "ws"

module PRC
def play_all(dur = 1)
with_sound(:clm, false, :play, 1, :statistics, true, :output, "cook.snd") do
beg = 0
plucky(beg, dur, 440, 0.2, 1.0)
beg += dur + 0.2
bow(beg, dur, 440, 0.2, 1.0)
beg += dur + 0.2
brass(beg, dur, 440, 0.2, 1.0)
beg += dur + 0.2
clarinet(beg, dur, 440, 0.2, 1.0)
beg += dur + 0.2
flute(beg, dur, 440, 0.2, 1.0)
end
end
def make_reed(*args)
offset, slope = nil
optkey(args, binding,
[:offset, 0.6],
[:slope, -0.8])
lambda do |samp| [1.0, offset + slope * samp].min end
end
def reedtable(r, sample)
r.call(sample)
end

def make_bowtable(*args)
offset, slope = nil
optkey(args, binding,
[:offset, 0.0],
[:slope, 1.0])
lambda do |samp| [0.0, 1.0 - (slope * (samp + offset)).abs].max end
end

def bowtable(b, sample)
b.call(sample)
end

def jettable(sample)
[-1.0, [1.0, sample * (sample * sample - 1.0)].min].max
end

def make_onezero(*args)
gain, zerocoeff = nil
optkey(args, binding,
[:gain, 0.5],
[:zerocoeff, 1.0])
make_one_zero(gain, gain * zerocoeff)
end

def make_onep(*args)
polecoeff = optkey(args, [:polecoeff, 0.9])
make_one_pole(1.0 - polecoeff, -polecoeff)
end

def set_pole(p, val)
set_mus_b1(p, -val)
set_mus_a0(p, 1.0 - val)
end

def set_gain(p, val)
set_mus_a0(p, mus_a0(p) * val)
end

def lip_set_freq(b, freq)
set_mus_frequency(b, freq)
end

def lip(b, mouthsample, boresample)
temp = formant(b, mouthsample - boresample)
temp = [1.0, temp * temp].min
temp * mouthsample + ((1.0 - temp) * boresample)
end

def make_dc_block
input = output = 0.0
lambda do |samp|
output = samp + (0.99 * output - input)
input = samp
output
end
end

def dc_block(b, sample)
b.call(sample)
end

def make_delaya(len, lag)
lastin = output = 0.0
input = make_delay(len)
outpointer = 2.0 - lag
outpointer += len while outpointer <= 0.0
outpoint = outpointer.floor
alpha = outpointer - outpoint
coeff = (1.0 - alpha) / (1.0 + alpha)
outpoint = -outpoint
lambda do |samp|
delay(input, samp)
temp = tap(input, outpoint)
output = -coeff * output + lastin + temp * coeff
lastin = temp
output
end
end

def delaya(d, sample)
d.call(sample)
end

def make_delayl(len, lag)
input = make_delay(len)
outpointer = 1 - lag
outpointer += len while outpointer <= 0.0
outpoint = outpointer.floor
alpha = outpointer - outpoint
omalpha = 1.0 - alpha
outpoint = -outpoint
lambda do |samp|
delay(input, samp)
tap(input, outpoint - 1) * omalpha + tap(input, outpoint) * alpha
end
end

def delayl(d, sample)
d.call(sample)
end

# sample instruments

def plucky(start, dur, freq, amp, maxa)
len = (mus_srate / 100.0).floor + 1
delayline = make_delaya(len, mus_srate / freq.to_f - 0.5)
filter = make_onezero()
dout = 0.0
len.times do |i| dout = delaya(delayline, 0.99 * dout + maxa * (1.0 - random(2.0))) end
run_instrument(start, dur) do
dout = delaya(delayline, one_zero(filter, dout))
amp * dout
end
end

def bowstr(start, dur, freq, amp, maxa)
len = (mus_srate / 100.0).floor + 1
ratio = 0.8317
temp = mus_srate / freq.to_f - 4.0
neckdelay = make_delayl(len, temp * ratio)
bridgedelay = make_delayl((len / 2.0).floor, temp * (1.0 - ratio))
bowtab = make_bowtable(:slope, 3.0)
filt = make_onep()
rate = 0.001
bowing = true
bowvelocity = rate
maxvelocity = maxa
attackrate = rate
durlen = seconds2samples(dur)
ctr = 0
release = (0.8 * durlen).floor
bridgeout = 0.0
neckout = 0.0
set_pole(filt, 0.6)
set_gain(filt, 0.3)
run_instrument(start, dur) do
bridgerefl = nutrefl = veldiff = stringvel = bowtemp = 0.0
if bowing
unless maxvelocity == bowvelocity
if bowvelocity < maxvelocity
bowvelocity += attackrate
else
bowvelocity -= attackrate
end
end
else
if bowvelocity > 0.0
bowvelocity -= attackrate
end
end
bowtemp = 0.3 * bowvelocity
filt_output = one_pole(filt, bridgeout)
bridgerefl = -filt_output
nutrefl = -neckout
stringvel = bridgerefl + nutrefl
veldiff = bowtemp - stringvel
veldiff = veldiff * bowtable(bowtab, veldiff)
neckout = delayl(neckdelay, bridgerefl + veldiff)
bridgeout = delayl(bridgedelay, nutrefl + veldiff)
result = amp * 10.0 * filt_output
if ctr == release
bowing = false
attackrate = 0.0005
end
ctr += 1
result
end
end

def brass(start, dur, freq, amp, maxa)
len = (mus_srate / 100.0).floor + 1
delayline = make_delaya(len, 1.0 + mus_srate / freq.to_f)
lipfilter = make_formant()
dcblocker = make_dc_block()
blowing = true
rate = 0.001
breathpressure = 0.0
maxpressure = maxa
attackrate = rate
durlen = seconds2samples(dur)
release = (0.8 * durlen).floor
ctr = 0
dout = 0.0
lip_set_freq(lipfilter, freq)
run_instrument(start, dur) do
if blowing
unless maxpressure == breathpressure
if breathpressure < maxpressure
breathpressure += attackrate
else
breathpressure -= attackrate
end
end
else
if breathpressure > 0.0
breathpressure -= attackrate
end
end
dout = delaya(delayline,
dc_block(dcblocker, lip(lipfilter, 0.3 * breathpressure, 0.9 * dout)))
result = amp * dout
if ctr == release
blowing = false
attackrate = 0.0005
end
ctr += 1
result
end
end

def clarinet(start, dur, freq, amp, maxa)
len = (mus_srate / 100.0).floor + 1
delayline = make_delayl(len, 0.5 * (mus_srate / freq.to_f) - 1.0)
rtable = make_reed(:offset, 0.7, :slope, -0.3)
filter = make_onezero()
blowing = true
breathpressure = 0.0
rate = 0.001
maxpressure = maxa
attackrate = rate
durlen = seconds2samples(dur)
release = (0.8 * durlen).floor
ctr = 0
dout = 0.0
run_instrument(start, dur) do
pressurediff = 0.0
if blowing
unless maxpressure == breathpressure
if breathpressure < maxpressure
breathpressure += attackrate
else
breathpressure -= attackrate
end
end
else
if breathpressure > 0.0
breathpressure -= attackrate
end
end
pressurediff = one_zero(filter, -0.95 * dout) - breathpressure
dout = delayl(delayline,
breathpressure + pressurediff * reedtable(rtable, pressurediff))
result = amp * dout
if ctr == release
blowing = false
attackrate = 0.0005
end
ctr += 1
result
end
end

def flute(start, dur, freq, amp, maxa)
len = (mus_srate / 100.0).floor + 1
ratio = 0.8
temp = mus_srate / freq.to_f - 0.5
jetdelay = make_delayl((len / 2.0).floor, temp * (1.0 - ratio))
boredelay = make_delayl(len, ratio * temp)
filter = make_onep()
dcblocker = make_dc_block()
jetrefl = 0.6
sinphase = 0.0
blowing = true
breathpressure = 0.0
rate = 0.0005
maxpressure = maxa
attackrate = rate
durlen = seconds2samples(dur)
release = (0.8 * durlen).floor
ctr = 0
dout = 0.0
set_pole(filter, 0.8)
set_gain(filter, -1.0)
run_instrument(start, dur) do
randpressure = 0.1 * breathpressure * random(1.0)
temp = 0.0
pressurediff = 0.0
sinphase += 0.0007
sinphase -= 6.28 if sinphase > 6.28
randpressure = randpressure + 0.05 * breathpressure * sin(sinphase)
if blowing
unless maxpressure == breathpressure
if breathpressure < maxpressure
breathpressure += attackrate
else
breathpressure -= attackrate
end
end
else
if breathpressure > 0.0
breathpressure -= attackrate
end
end
temp = dc_block(dcblocker, one_pole(filter, dout))
pressurediff = jettable(delayl(jetdelay,
breathpressure + (randpressure - jetrefl * temp)))
dout = delayl(boredelay, pressurediff)
result = 0.3 * amp * dout
if ctr == release
blowing = false
attackrate = 0.0005
end
ctr += 1
result
end
end
end

include PRC

# prc95.rb ends here

+ 274
- 0
lib/sndlib/prc95.scm View File

@@ -0,0 +1,274 @@
;;; this is a translation to Snd (from CLM's prc-toolkit95.lisp)
;;; of Perry Cook's Physical Modelling Toolkit.

(provide 'snd-prc95.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))


(define* (make-reed (offset 0.6) (slope -0.8))
(float-vector offset slope))

(define (reedtable r samp)
(min 1.0 (+ (r 0) (* (r 1) samp))))

(define* (make-bowtable (offset 0.0) (slope 1.0))
(float-vector offset slope))

(define (bowtable b samp)
(max 0.0 (- 1.0 (abs (* (b 1) (+ samp (b 0)))))))

(define (jettable samp)
(max -1.0 (min 1.0 (* samp (- (* samp samp) 1.0)))))

(define* (make-onezero (gain 0.5) (zerocoeff 1.0))
(make-one-zero gain (* gain zerocoeff)))

(define* (make-onep (polecoeff 0.9))
(make-one-pole (- 1.0 polecoeff) (- polecoeff)))

(define (set-pole p val)
(set! (mus-ycoeff p 1) (- val))
(set! (mus-xcoeff p 0) (- 1.0 val)))

(define (set-gain p val)
(set! (mus-xcoeff p 0) (* (mus-xcoeff p 0) val)))


(define (lip-set-freq b freq)
(set! (mus-frequency b) freq))

(define (lip b mouthsample boresample)
(let ((temp (formant b (- mouthsample boresample))))
(set! temp (min 1.0 (* temp temp)))
(+ (* temp mouthsample) (* (- 1.0 temp) boresample))))


(define (make-dc-block)
(float-vector 0.0 0.0))

(define (dc-block b samp)
(set! (b 1) (- (+ samp (* 0.99 (b 1))) (b 0)))
(set! (b 0) samp)
(b 1))
;; we could also use a filter generator here: (make-filter 2 (float-vector 1 -1) (float-vector 0 -0.99))


;;; this ia a 0-based versions of the clm delays
(defgenerator dlya (outp 0) (input #f))

(define (make-delayl len lag)
;; Perry's original had linear interp bug, I think -- this form is more in tune
(make-dlya :input (make-delay len :max-size (ceiling (+ len lag 1)))
:outp (- lag len)))

(define (delayl d samp)
(delay-tick (d 'input) samp)
(tap (d 'input) (d 'outp)))



;;; now some example instruments

(definstrument (plucky beg dur freq amplitude maxa)
;; (with-sound () (plucky 0 .3 440 .2 1.0))

(let ((len (+ 1 (floor (/ *clm-srate* 100.0))))) ; 100 = lowest freq
(let ((delayline (make-delayl len (- (/ *clm-srate* freq) 0.5)))
(filt (make-onezero))
(start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(dout 0.0))
(do ((i 0 (+ i 1)))
((= i len))
(set! dout (delayl delayline (+ (* 0.99 dout) (mus-random maxa)))))
(do ((i start (+ i 1)))
((= i end))
(set! dout (delayl delayline (one-zero filt dout)))
(outa i (* amplitude dout))))))


;;; freq is off in this one (in prc's original also)
(definstrument (bowstr beg dur frq amplitude maxa)
;; (with-sound () (bowstr 0 .3 220 .2 1.0))

(let ((len (+ 1 (floor (/ *clm-srate* 100.0))))) ; 100 = lowest freq
(let ((ratio 0.8317)
(rate .001)
(bowing #t)
(temp (- (/ *clm-srate* frq) 4.0)))
(let ((neckdelay (make-delayl len (* temp ratio)))
(bridgedelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
(bowtab (make-bowtable :slope 3.0))
(filt (make-onep))
(bowvelocity rate)
(maxvelocity maxa)
(attackrate rate)
(st (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(release (seconds->samples (* .8 dur)))
(ctr 0)
(bridgeout 0.0)
(neckout 0.0))
(set-pole filt 0.6)
(set-gain filt 0.3)
(do ((i st (+ i 1))
(bridgerefl 0.0 0.0)
(nutrefl 0.0 0.0)
(veldiff 0.0 0.0)
(stringvel 0.0 0.0)
(bowtemp 0.0 0.0))
((= i end))
(if bowing
(if (not (= maxvelocity bowvelocity))
(set! bowvelocity ((if (< bowvelocity maxvelocity) + -) bowvelocity attackrate)))
(if (> bowvelocity 0.0)
(set! bowvelocity (- bowvelocity attackrate))))
(set! bowtemp (* 0.3 bowvelocity))
(let ((filt-output (one-pole filt bridgeout)))
(set! bridgerefl (- filt-output))
(set! nutrefl (- neckout))
(set! stringvel (+ bridgerefl nutrefl))
(set! veldiff (- bowtemp stringvel))
(set! veldiff (* veldiff (bowtable bowtab veldiff)))
(set! neckout (delayl neckdelay (+ bridgerefl veldiff)))
(set! bridgeout (delayl bridgedelay (+ nutrefl veldiff)))
(outa i (* amplitude 10.0 filt-output))
(if (= ctr release)
(begin
(set! bowing #f)
(set! attackrate .0005)))
(set! ctr (+ ctr 1))))))))


(definstrument (brass beg dur freq amplitude maxa)
;; does this work at all?
(let ((len (+ 1 (floor (/ *clm-srate* 100.0)))))
(let ((blowing #t)
(rate .001)
(breathpressure 0.0)) ; 0.1 ?
(let ((delayline (make-delayl len (+ 1.0 (/ *clm-srate* freq))))
(lipfilter (make-formant freq))
(dcblocker (make-dc-block))
(maxpressure maxa)
(attackrate rate)
(st (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(release (seconds->samples (* .8 dur)))
(ctr 0)
(dout 0.0))
(do ((i st (+ i 1)))
((= i end))
(if blowing
(if (not (= maxpressure breathpressure))
(set! breathpressure ((if (< breathpressure maxpressure) + -) breathpressure attackrate)))
(if (> breathpressure 0.0)
(set! breathpressure (- breathpressure attackrate))))
(set! dout (delayl delayline (dc-block dcblocker
(lip lipfilter
(* 0.3 breathpressure)
(* 0.9 dout)))))
(outa i (* amplitude dout))
(if (= ctr release)
(begin
(set! blowing #f)
(set! attackrate .0005)))
(set! ctr (+ ctr 1)))))))


(definstrument (clarinet beg dur freq amplitude maxa)
;; (with-sound () (clarinet 0 .3 440 .2 1.0))

(let ((len (+ 1 (floor (/ *clm-srate* 100.0)))))
(let ((blowing #t)
(breathpressure 0.0) ; 0.1 ?
(rate .001))
(let ((delayline (make-delayl len (- (* 0.5 (/ *clm-srate* freq)) 1.0)))
(rtable (make-reed :offset 0.7 :slope -0.3))
(filt (make-onezero))
(maxpressure maxa)
(attackrate rate)
(st (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(ctr 0)
(release (seconds->samples (* .8 dur)))
(dlyout 0.0))
(do ((i st (+ i 1)))
((= i end))
(if blowing
(if (not (= maxpressure breathpressure))
(set! breathpressure ((if (< breathpressure maxpressure) + -) breathpressure attackrate)))
(if (> breathpressure 0.0)
(set! breathpressure (- breathpressure attackrate))))
(let ((pressurediff (- (one-zero filt (* -0.95 dlyout)) breathpressure)))
(set! dlyout (delayl delayline
(+ breathpressure
(* pressurediff
(reedtable rtable pressurediff))))))
(outa i (* amplitude dlyout))
(if (= ctr release)
(begin
(set! blowing #f)
(set! attackrate .0005)))
(set! ctr (+ ctr 1)))))))


(definstrument (flute beg dur freq amplitude maxa)
;; (with-sound () (flute 0 .3 440 .2 1.0))
(let ((len (+ 1 (floor (/ *clm-srate* 100.0)))))
(let ((jetrefl 0.6)
(endrefl 0.6)
(sinphase 0.0)
(blowing #t)
(rate .0005)
(breathpressure 0.0) ; 0.1 ?
(ratio 0.8)
(temp (- (/ *clm-srate* freq) 5.0)))
(let ((jetdelay (make-delayl (floor (/ len 2)) (* temp (- 1.0 ratio))))
(boredelay (make-delayl len (* ratio temp)))
(filt (make-onep))
(dcblocker (make-dc-block))
(maxpressure maxa)
(attackrate rate)
(st (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(ctr 0)
(release (seconds->samples (* .8 dur)))
(boreout 0.0))
(set-pole filt 0.8)
(set-gain filt -1.0)
(do ((i st (+ i 1)))
((= i end))
(let ((randpressure (random (* 0.1 breathpressure))))
(set! sinphase (+ sinphase 0.0007)) ;5 hz vibrato?
(if (> sinphase 6.28) (set! sinphase (- sinphase 6.28)))
(set! randpressure (+ randpressure (* 0.05 breathpressure (sin sinphase))))
(if blowing
(if (not (= maxpressure breathpressure))
(set! breathpressure ((if (< breathpressure maxpressure) + -) breathpressure attackrate)))
(if (> breathpressure 0.0)
(set! breathpressure (- breathpressure attackrate))))
(let ((pressurediff (let ((temp (dc-block dcblocker (one-pole filt boreout))))
(+ (jettable (delayl jetdelay (- (+ breathpressure randpressure) (* jetrefl temp))))
(* endrefl temp)))))
(set! boreout (delayl boredelay pressurediff)))
(outa i (* 0.3 amplitude boreout))
(if (= ctr release)
(begin
(set! blowing #f)
(set! attackrate .0005)))
(set! ctr (+ ctr 1))))))))

#|
(with-sound ()
(plucky 0 .3 440 .2 1.0)
(bowstr .5 .3 220 .2 1.0)
(brass 1 .3 440 .2 1.0)
(clarinet 1.5 .3 440 .2 1.0)
(flute 2 .3 440 .2 1.0))
|#


+ 140
- 0
lib/sndlib/premake4.lua View File

@@ -0,0 +1,140 @@
-- sndlib premake4
-- requires premake-4.4 (for os.is64bit)
-- currently assumes you want s7 (scheme) as the extension language


--------------------------------------------------------------------------------
-- Command Line
--------------------------------------------------------------------------------

newoption({trigger = "with-g++", description = "Optionally use g++ compiler."})

if (not _ACTION) then
if (os.is("windows")) then
_ACTION = "vs2010"
else
_ACTION = "gmake"
end
end


--------------------------------------------------------------------------------
-- Global Config
--------------------------------------------------------------------------------

--General
DebugFlags = {"Symbols", "NoPCH", "NoManifest"}
ReleaseFlags = {"NoPCH", "NoManifest"}
SpeedFlags = {"OptimizeSpeed", "NoPCH", "NoManifest"}

--Warnings
StandardGCCWarnings = {"-Wall"}

--Mac
MacFrameworks = {"-framework CoreAudio", "-framework CoreFoundation", "-framework CoreMidi"}
MacTarget = "-mmacosx-version-min=10.6"

--------------------------------------------------------------------------------
-- Paths
--------------------------------------------------------------------------------

PathToRoot = ""
PathToSrc = "./"
PathToLib = "lib/" -- folder to save libs in
PathToBin = "bin/" -- folder to save apps in
PathToObj = "obj/" -- intermediate dir for object files

--------------------------------------------------------------------------------
--
--------------------------------------------------------------------------------

solution("sndlib")
--Create a release, debug, and speed configuration for each project.
configurations({"Release", "Debug", "Speed"})

--------------------------------------------------------------------------------
-- project sndlib: create static libsndlib
--------------------------------------------------------------------------------

project("sndlib")

-- optionally use g++ compiler for .c files
if (_OPTIONS["with-g++"]) then
language("C++")
-- buildoptions( {"-x c++"})
-- for clang on osx?
else
language("C")
end

if (_OPTIONS["with-gsl"]) then
defines("HAVE_GSL")
links({"gsl", "gslcblas"})
end

defines("WITH_AUDIO")
defines("HAVE_SCHEME")
defines("HAVE_PREMAKE")

if (os.get() == "macosx") then
-- links({"dl"})
linkoptions(MacFrameworks)
else
if (os.get() == "windows") then
links("winmm")
else
if (os.get() == "linux") then
defines("HAVE_ALSA")
else
-- I tried FreeBSD (had to remove -ldl from LIBS in gmake.unix), but
-- premake died with some lua error.
end
end
end

if (os.is64bit()) then
defines("SIZEOF_VOID_P=8")
else
defines("SIZEOF_VOID_P=4")
end


-- TODO: WORDS_BIGENDIAN:
-- I got this from some Lua mailing list -- I have no idea what it does!
-- apparently it returns true if little-endian
--
-- function endian()
-- return string.byte(string.dump(function() end),7)
-- end
--
-- if (!endian()) then
-- defines("WORDS_BIGENDIAN")
-- end
-- until I have a test case, I think I'll leave it little-endian by default
-- it's not clear that Lua works in big-endian machines


kind("StaticLib")
flags({"StaticRuntime"})
includedirs({PathToSrc})
objdir(PathToObj)
targetdir(PathToLib)
files({"headers.*", "audio.*", "io.*", "sound.*", "xen.*", "vct.*", "clm.*", "sndlib2xen.*", "clm2xen.*", "s7.*"})
defines({"HAVE_CONFIG_H=1"})

-- ADD WHATEVER OTHER PROJECTS YOU WANT, EG:
-- project("s7")
-- kind("ConsoleApp")
-- ...

configuration "Debug" flags(DebugFlags) defines("DEBUG")
configuration "Release" flags(ReleaseFlags) defines({"NDEBUG", "_NDEBUG"})
configuration "Speed" flags(SpeedFlags) defines({"NDEBUG", "_NDEBUG"})


-- to find a library os.findlib("X11"), nil if not found
-- os.execute to run external prog
-- os.isfile("path") true if file exists, else false
-- os.outputof("command")



+ 337
- 0
lib/sndlib/pvoc.rb View File

@@ -0,0 +1,337 @@
# pvoc.rb -- pvoc.scm -> pvoc.rb

# Translator: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 04/03/27 00:19:51
# Changed: 14/11/14 08:58:16

# versions of the Moore-Klingbeil-Trevisani-Edwards phase-vocoder
#
# class Pvocoder
# initialize(fftsize, overlap, interp, analyze, edit, synthesize)
# inspect
# pvocoder(input)
#
# make_pvocoder(fftsize, overlap, interp, analyze, edit, synthesize)
# pvocoder(pv, input)
#
# test_pv_1
# test_pv_2(freq)
# test_pv_3(time)
# test_pv_4(gate)
#
# pvoc(*rest)

require "ws"

class Pvocoder
def initialize(fftsize, overlap, interp, analyze, edit, synthesize)
@output = interp
@interp = interp
@hop = overlap
@filptr = 0
@N = fftsize
@window = make_fft_window(Hamming_window, fftsize)
@window.scale!(2.0 / (0.54 * fftsize))
@D = fftsize / overlap
@in_data = nil
@ampinc = make_vct(fftsize)
@freqs = make_vct(fftsize)
@amps = make_vct(fftsize / 2)
@phaseinc = make_vct(fftsize / 2)
@phases = make_vct(fftsize / 2)
@lastphase = make_vct(fftsize / 2)
@analyze = analyze
@edit = edit
@synthesize = synthesize
end

def inspect
format("#<%s outctr: %d, interp: %d, \
filptr: %d, N: %d, D: %d, in_data: %p>",
self.class, @output, @interp, @filptr, @N, @D, @in_data)
end
def pvocoder(input)
if @output >= @interp
if @analyze
@analyze.call(self, input)
else
vct_fill!(@freqs, 0.0)
@output = 0
if (not vct?(@in_data))
@in_data = make_vct!(@N) do
input.call
end
else
vct_move!(@in_data, 0, @D)
((@N - @D)...@N).each do |i|
@in_data[i] = input.call
end
end
buf = @filptr % @N
if buf.zero?
vct_fill!(@ampinc, 0.0)
vct_add!(@ampinc, @in_data)
vct_multiply!(@ampinc, @window)
else
@N.times do |k|
@ampinc[buf] = @window[k] * @in_data[k]
buf += 1
if buf >= @N
buf = 0
end
end
end
@filptr += @D
mus_fft(@ampinc, @freqs, @N, 1)
rectangular2polar(@ampinc, @freqs)
end
if @edit
@edit.call(self)
else
pscl = 1.0 / @D
kscl = TWO_PI / @N
(@N / 2).times do |k|
phasediff = @freqs[k] - @lastphase[k]
@lastphase[k] = @freqs[k]
while phasediff > PI
phasediff -= TWO_PI
end
while phasediff < -TWO_PI
phasediff += TWO_PI
end
@freqs[k] = pscl * phasediff + k * kscl
end
end
scl = 1.0 / @interp
vct_subtract!(@ampinc, @amps)
vct_subtract!(@freqs, @phaseinc)
vct_scale!(@ampinc, scl)
vct_scale!(@freqs, scl)
end
@output += 1
if @synthesize
@synthesize.call
else
vct_add!(@amps, @ampinc)
vct_add!(@phaseinc, @freqs)
vct_add!(@phases, @phaseinc)
sine_bank(@amps, @phases)
end
end
end

add_help(:make_pvocoder,
"make_pvocoder(fftsize, overlap, interp, analyze=false, \
edit=false, synthesize=false) \
Makes a new (Ruby-based, not CLM) phase-vocoder generator.")
def make_pvocoder(fftsize = 512,
overlap = 4,
interp = 128,
analyze = false,
edit = false,
synthesize = false)
Pvocoder.new(fftsize, overlap, interp, analyze, edit, synthesize)
end

add_help(:pvocoder,
"pvocoder(pv, input) \
Is the phase-vocoder generator associated with make_pvocoder.")
def pvocoder(pv, input)
pv.pvocoder(input)
end

=begin
let(open_sound("oboe.snd"),
make_pvocoder(256, 4, 64),
make_sampler(0)) do |ind, pv, rd|
map_channel(lambda do |y| pvocoder(pv, rd) end)
play(ind, :wait, true)
save_sound_as("pvoc.snd", ind)
revert_sound(ind)
close_sound(ind)
open_sound("pvoc.snd")
end
=end

def test_pv_1
pv = make_phase_vocoder(false, 512, 4, 128, 1.0, false, false, false)
rd = make_sampler(0)
map_channel(lambda do |y|
phase_vocoder(pv,
lambda do |dir|
next_sample(rd)
end)
end)
free_sampler(rd)
end

def test_pv_2(freq)
pv = make_phase_vocoder(false, 512, 4, 128, freq, false, false, false)
rd = make_sampler(0)
map_channel(lambda do |y|
phase_vocoder(pv,
lambda do |dir|
next_sample(rd)
end)
end)
free_sampler(rd)
end

def test_pv_3(time)
pv = make_phase_vocoder(false, 512, 4, (time * 128.0).floor,
1.0, false, false, false)
rd = make_sampler(0)
len = (time * framples()).floor
data = make_vct!(len) do
phase_vocoder(pv,
lambda do |dir|
next_sample(rd)
end)
end
free_sampler(rd)
vct2channel(data, 0, len)
end

def test_pv_4(gate)
pv = make_phase_vocoder(false,
512, 4, 128, 1.0,
false,
lambda do |v|
phase_vocoder_amp_increments(v).map! do |val|
if val < gate
0.0
else
val
end
true
end
end, false)
rd = make_sampler(0)
map_channel(lambda do |y|
phase_vocoder(pv,
lambda do |dir|
next_sample(rd)
end)
end)
free_sampler(rd)
end

# another version of the phase vocoder

add_help(:pvoc,
"pvoc(*rest)
:fftsize = 512
:overlap = 4
:time = 1.0
:pitch = 1.0
:gate = 0.0
:hoffset = 0.0
:snd = false
:chn = false
Applies the phase vocoder algorithm to the current sound (i.e. fft analysis, \
oscil bank resynthesis). \
TIME specifies the time dilation ratio, \
PITCH specifies the pitch transposition ratio, \
GATE specifies a resynthesis gate in dB (partials with \
amplitudes lower than the gate value will not be synthesized), \
HOFFSET is a pitch offset in Hz.")
def pvoc(*rest)
fftsize, overlap, time, pitch, gate, hoffset, snd, chn = nil
optkey(rest, binding,
[:fftsize, 512],
[:overlap, 4],
[:time, 1.0],
[:pitch, 1.0],
[:gate, 0.0],
[:hoffset, 0.0],
[:snd, false],
[:chn, false])
len = framples(snd, chn)
filptr = 0
sr = srate(snd)
fftsize2 = (fftsize / 2.0).floor
d = fftsize / overlap
interp = d * time
syngate = gate.zero? ? 0.0 : (10 ** (-gate.abs / 20.0))
poffset = hz2radians(hoffset)
window = make_fft_window(Hamming_window, fftsize)
fdr = make_vct(fftsize)
fdi = make_vct(fftsize)
lastphase = make_vct(fftsize2)
lastamp = make_vct(fftsize2)
lastfreq = make_vct(fftsize2)
ampinc = make_vct(fftsize2)
freqinc = make_vct(fftsize2)
fundamental = TWO_PI / fftsize
output = interp
# resynth_oscils = make_array(fftsize2) do
# make_oscil(:frequency, 0)
# end
outlen = (time * len).floor
in_data = channel2vct(0, fftsize * 2, snd, chn)
in_data_beg = 0
vct_scale!(window, 2.0 / (0.54 * fftsize))
obank = make_oscil_bank(lastfreq, make_vct(fftsize2, 0.0), lastamp)
out_data = make_vct([len, outlen].max)
out_data.length.times do |i|
if output >= interp
output = 0
buffix = filptr % fftsize
vct_fill!(lastamp, 0.0)
vct_fill!(lastfreq, 0.0)
vct_add!(lastamp, fdr)
vct_add!(lastfreq, fdi)
fftsize.times do |k|
fdr[buffix] = window[k] * in_data[filptr - in_data_beg]
filptr += 1
buffix += 1
if buffix >= fftsize
buffix = 0
end
end
filptr -= fftsize - d
if filptr > in_data_beg + fftsize
in_data_beg = filptr
in_data = channel2vct(in_data_beg, fftsize * 2, snd, chn)
end
vct_fill!(fdi, 0.0)
mus_fft(fdr, fdi, fftsize, 1)
fftsize2.times do |k|
a = fdr[k]
b = fdi[k]
mag = sqrt(a * a + b * b)
phase = 0
phasediff = 0
fdr[k] = mag
if mag > 0
phase = -atan2(b, a)
phasediff = phase - lastphase[k]
lastphase[k] = phase
while phasediff > PI
phasediff -= TWO_PI
end
while phasediff < -PI
phasediff += TWO_PI
end
end
fdi[k] = pitch *
((phasediff * sr) / (d * sr) + k * fundamental + poffset)
if fdr[k] < syngate
fdr[k] = 0.0
end
ampinc[k] = (fdr[k] - lastamp[k]) / interp
freqinc[k] = (fdi[k] - lastfreq[k]) / interp
end
end
output += 1
vct_add!(lastamp, ampinc)
vct_add!(lastfreq, freqinc)
# old_oscil_bank from extensions.rb
# out_data[i] = old_oscil_bank(lastamp, resynth_oscils, lastfreq)
out_data[i] = oscil_bank(obank)
end
vct2channel(out_data, 0, out_data.length)
end

# pvoc.rb ends here

+ 75085
- 0
lib/sndlib/s7.c
File diff suppressed because it is too large
View File


+ 1013
- 0
lib/sndlib/s7.h
File diff suppressed because it is too large
View File


+ 9547
- 0
lib/sndlib/s7.html
File diff suppressed because it is too large
View File


+ 606
- 0
lib/sndlib/singer.rb View File

@@ -0,0 +1,606 @@
# singer.rb -- singer.ins -> singer.scm -> singer.rb -*- snd-ruby -*-

# Translator: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Sat Apr 23 13:07:53 CEST 2005
# Changed: Mon Nov 22 13:36:42 CET 2010

# Commentary:
#
# Perry Cook's physical model of the vocal tract as described in:
#
# Cook, Perry R. "Synthesis of the Singing Voice Using a Physically
# Parameterized Model of the Human Vocal Tract"
# Published in the Proceedings of the International Computer Music Conference, Ohio 1989
# and as Stanford University Department of Music Technical Report Stan-M-57, August 1989.
#
# -- "Identification of Control Parameters in an Articulatory Vocal
# Tract Model, with Applications to the Synthesis of Singing,"
# Ph.D. Thesis, Stanford University Department of Music Technical
# Report
#
# -- "SPASM, a Real-time Vocal Tract Physical Model Controller; and
# Singer, the Companion Software Synthesis System", Computer Music
# Journal, vol 17 no 1 Spring 1993.
#
# This code is a translation of Perry Cook's singer implementation originally in C.
# Apparently all Perry's data is aimed at srate=22050.
#
# Code:

def singer(start, amp, data)
# data is a list of lists very similar to the sequence of synthesize
# calls in Perry's original implementation.
# Each imbedded list has the form: dur shape glot pitch glotamp
# noiseamps vibramt.
# See below for examples.
setup = data.first
durs = data.map do |val| val[0] end
dur = 0.0
durs.each do |val| dur += val end
dur -= samples2seconds(1)
beg = start
begs = [start] + durs.map do |val| beg += val end
beg_samps = begs.map do |val| seconds2samples(val) end
change_times = (beg_samps + [beg_samps.last]).to_vct
shps = data.map do |val| val[1] end
glts = data.map do |val| val[2] end
pfun = [0.0, 0.8 * setup[3]]
data.zip(begs[1..-1]) do |dat, b| pfun.push(b - start, Float(dat[3])) end
gfun = [0.0, 0.0]
data.zip(begs[1..-1]) do |dat, b| gfun.push(b - start, Float(dat[4])) end
nfun = [0.0, Float(setup[5])]
data.zip(begs[1..-1]) do |dat, b| nfun.push(b - start, Float(dat[5])) end
vfun = [0.0, Float(setup[6])]
data.zip(begs[1..-1]) do |dat, b| vfun.push(b - start, Float(dat[6])) end
noiseamps = Vct.new(data.length) do |i| Float(data[i][5]) end
frq_env = make_env(:envelope, pfun, :duration, dur)
vib_env = make_env(:envelope, vfun, :duration, dur)
vib_osc = make_oscil(:frequency, 6.0)
glot_env = make_env(:envelope, gfun, :duration, dur)
noise_env = make_env(:envelope, nfun, :duration, dur)
ran_vib = make_rand_interp(:frequency, 10, :amplitude, 0.02)
#
tractlength = 9 # length of vocal tract
shape_data = Vct.new(shps.length * (tractlength + 8))
glot_datai = Vct.new(2 * glts.length)
glot_datar = Vct.new(2 * glts.length)
shps.each_with_index do |shp, i|
shp[1..-1].each_with_index do |val, j| shape_data[j + i] = val end
end
ii = 0
glts.each do |glt|
glot_datai[ii] = 0.0
glot_datai[ii + 1] = glt[0]
glot_datar[ii] = glt[1]
glot_datar[ii + 1] = glt[2]
ii += 2
end
table_size = 1000 # size of glottis wave-table
noseposition = 3
noselength = 6
nose_ring_time = 1000 # naso pharynx response decay time
one_over_two_pi = 1.0 / TWO_PI
two_pi_over_table_size = TWO_PI / table_size
table_size_over_sampling_rate = table_size / mus_srate
dpole = 0.998
dgain = 1.0 - dpole
tong_hump_pole = 0.998
tong_hump_gain = 1.0 - tong_hump_pole
tong_tip_pole = 0.998
tong_tip_gain = 1.0 - tong_tip_pole
glot_table = Vct.new(table_size + 1)
glot_table2 = Vct.new(table_size + 1)
gn_table = Vct.new(table_size + 1)
gn_gain = 0.0
gn_out = 0.0
gn_del = Vct.new(4)
gn_coeffs = Vct.new(4)
sines = Vct.new(200)
cosines = Vct.new(200)
table_increment = 0.0
table_location = 0.0
glot_refl_gain = 0.7
pitch = 400.0
vibr_amt = 0.0
last_lip_in = 0.0 # for lip reflection/transmission filter
last_lip_out = 0.0
last_lip_refl = 0.0
lip_refl_gain = -0.45
noise_gain = 0.0 # for vocal tract noise generator
noise_input = 0.0
noise_output = 0.0
noise_c = Vct.new(4) # net coefficients on delayed outputs
noise_pos = 0
fnoiseamp = 0.0
inz1 = 0.0
inz2 = 0.0
outz = Vct.new(4) # delayed versions of input and output
# nasal tract acoustic tube structure
nose_coeffs = vct(0.0, -0.29, -0.22, 0.0, 0.24, 0.3571)
nose1 = Vct.new(noselength)
nose2 = Vct.new(noselength)
velum_pos = 0.0
alpha = Vct.new(4)
nose_last_minus_refl = 0.0
nose_last_plus_refl = 0.0
nose_last_output = 0.0
nose_filt = 0.0
nose_filt1 = 0.0
time_nose_closed = 1000 # this is a hack used to determine if we
# need to calculate the nasal acoustics
# vocal tract acoustic tube structure
radii = Vct.new(tractlength + 8)
# the radii array contains the vocal tract section radii
# (tractlength-1 of them), then glottal reflection gain then lip
# reflection gain, then noise position, then noise gain, then noise
# pole angle, then noise pole radius, then noise pole angle2, then
# noise pole radius2, then velum opening radius
8.times do |i| radii[i] = 1.0 end
radii[8] = 0.7
radii[9] = -0.5
coeffs = Vct.new(tractlength)
dline1 = Vct.new(tractlength)
dline2 = Vct.new(tractlength)
# throat radiation low-pass filter
lt = Vct.new(2)
ltcoeff = 0.9995
ltgain = 0.05 # a low order iir filter
lip_radius = 0.0
s_glot = 0.0
s_glot_mix = 0.0
s_noise = 0.0
last_tract_plus = 0.0
initial_noise_position = 0.0
formant_shift = 1.0
target_radii = Vct.new(tractlength + 8)
8.times do |i| target_radii[i] = 1.0 end
target_radii[8] = 0.7
target_radii[9] = -0.5
radii_poles = Vct.new(tractlength + 8, dpole)
radii_poles[2] = tong_hump_pole
radii_poles[3] = tong_hump_pole
radii_poles[4] = tong_hump_pole
radii_poles[5] = tong_tip_pole
radii_pole_gains = Vct.new(tractlength + 8, dgain)
radii_pole_gains[2] = tong_hump_gain
radii_pole_gains[3] = tong_hump_gain
radii_pole_gains[4] = tong_hump_gain
radii_pole_gains[5] = tong_tip_gain
change_radii = 0
glotsamp = 0.0
delta = 0.0
temp_arr = Vct.new(tractlength + 1)
new_glot = 1
first_glot = 1
new_tract = 1
first_tract = 1
offset = -1
next_offset = seconds2samples(start)
last_sfd = -1
last_gfd = -1
run_instrument(start, dur) do |i|
if i == next_offset
# time to check for new tract shapes, glottal pulse shapes etc.
offset += 1
fnoiseamp = noiseamps[offset]
if last_sfd == -1
last_sfd = 0
else
new_sfd = last_sfd + tractlength + 8
kk = new_sfd
last_sfd.upto(new_sfd - 1) do |j|
if (shape_data[j] - shape_data[kk]).abs > 0.001 then new_tract = 1 end
kk += 1
end
last_sfd = new_sfd
end
if last_gfd == -1
last_gfd = 0
else
last_gfd += 2
end
next_offset = change_times[offset + 1].to_i
end
if new_tract.nonzero?
jj = last_sfd - 1
target_radii.map! do |val| shape_data[jj += 1] end
if first_tract == 1
radii.map_with_index! do |val, j| target_radii[j] end
end
change_radii = 0
initial_noise_position = radii[tractlength + 1]
target_radii.zip(radii) do |t, r|
if (t - r).abs > 0.001 then change_radii = 1 end
end
end
if first_tract == 1 or change_radii.nonzero?
if new_tract.zero?
radii.map_with_index! do |val, j|
val * radii_poles[j] + target_radii[j] * radii_pole_gains[j]
end
end
# set tract shape
temp_arr[0] = 1.0
1.upto(temp_arr.length - 1) do |j|
temp_arr[j] = radii[j - 1] * radii[j - 1]
if temp_arr[j].zero? then temp_arr[j] = 1e-10 end
end
1.upto(tractlength - 1) do |j|
coeffs[j] = (temp_arr[j - 1] - temp_arr[j]) / (temp_arr[j - 1] + temp_arr[j])
end
glot_refl_gain = radii[tractlength - 1]
lip_refl_gain = radii[tractlength]
noise_pos = radii[tractlength + 1].to_i
noise_gain = radii[tractlength + 2]
# fricative noise generator (set noise angle and radius)
noise_angle = hz2radians(radii[tractlength + 3])
noise_radius = radii[tractlength + 4]
noise_a = -2.0 * cos(noise_angle / formant_shift) * noise_radius
noise_b = noise_radius * noise_radius
noise_angle2 = hz2radians(radii[tractlength + 5])
noise_radius2 = radii[tractlength + 6]
noise_a2 = -2.0 * cos(noise_angle2 / formant_shift) * noise_radius2
noise_b2 = noise_radius2 * noise_radius2
noise_c[0] = noise_a + noise_a2
noise_c[1] = noise_b + noise_b2 + noise_a * noise_a2
noise_c[2] = noise_a2 * noise_b + noise_b2 * noise_a
noise_c[3] = noise_b2 * noise_b
lip_radius = radii[tractlength - 2]
velum_pos = radii[tractlength + 7]
leftradius = radii[noseposition - 2]
velumradius = velum_pos
rightradius = radii[noseposition - 1]
# nasal tract (set nasal shape)
temp = [rightradius - velumradius, 0.0].max
alpha[1] = leftradius * leftradius
alpha[2] = temp * temp
alpha[3] = velumradius * velumradius
temp1 = 2.0 / (alpha[1] + alpha[2] + alpha[3])
alpha[1] *= temp1
alpha[2] *= temp1
alpha[3] *= temp1
end
if new_tract.nonzero?
new_tract = 0
first_tract = 0
if s_noise < 1.0 or fnoiseamp < 0.0001
target_radii[tractlength + 1] = initial_noise_position
end
end
if new_glot.nonzero?
if first_glot.zero?
glot_table2.map_with_index! do |val, j| glot_table[j] end
end
harms = glot_datai[last_gfd + 1].to_i
a = glot_datar[last_gfd]
b = glot_datar[last_gfd + 1]
a2 = TWO_PI * a
b2 = TWO_PI * b
sines.fill(0.0)
cosines.fill(0.0)
if a != b
temp = one_over_two_pi / (b - a)
temp1 = 1.0 - cos(a2)
sines[1] = (cos(a2) + (sin(a2) - sin(b2)) * temp) * temp1 * one_over_two_pi
cosines[1] = (-sin(a2) + (cos(a2) - cos(b2)) * temp) * temp1 * one_over_two_pi
end
sines[1] = sines[1] + (0.75 + -cos(a2) + cos(2.0 * a2) * 0.25) * one_over_two_pi
cosines[1] = cosines[1] + (sin(a2) - sin(2.0 * a2) * 0.25) * one_over_two_pi - a * 0.5
ka1 = a2
ka2 = 2 * a2
ka3 = 3 * a2
2.upto(harms) do |k|
if b != a
temp = one_over_two_pi / ((b - a) * k)
sines[k] = (cos(ka2) + (sin(ka2) - sin(k * b2)) * temp) * (temp1 / k)
cosines[k] = (-sin(ka2) + (cos(ka2) - cos(k * b2)) * temp) * (temp1 / k)
end
sines[k] = sines[k] + ((1.0 - cos(ka2)) / k) + \
((cos(ka1) - 1.0) * 0.5) / (k - 1) + \
((cos(ka3) - 1.0) * 0.5) / (k + 1)
sines[k] *= one_over_two_pi
cosines[k] = cosines[k] + sin(ka2) / k - (sin(ka1) * 0.5) / (k - 1) - (sin(ka3) * 0.5) / (k + 1)
cosines[k] *= one_over_two_pi
ka1 += a2
ka2 += a2
ka3 += a2
end
glot_table.fill(0.0)
x = 0.0
glot_table.length.times do |j|
1.upto(harms) do |k|
glot_table[j] = glot_table[j] + cosines[k] * cos(k * x) + sines[k] * sin(k * x)
end
x += two_pi_over_table_size
end
s_glot_mix = 1.0
delta = 1.0 / (next_offset - i)
if first_glot.nonzero?
glot_table2.map_with_index! do |val, j| glot_table[j] end
first_glot = 0
end
new_glot = 0
end
s_glot_mix -= delta
s_glot = env(glot_env)
s_noise = env(noise_env)
pitch = env(frq_env)
vibr_amt = env(vib_env)
table_increment = pitch *
(1.0 + vibr_amt * oscil(vib_osc) + rand_interp(ran_vib)) *
table_size_over_sampling_rate
last_lip_out = last_lip_in + last_tract_plus
last_lip_refl = (last_lip_in + last_tract_plus) * lip_refl_gain
last_lip_in = last_tract_plus
# next glot tick
glotsamp = dline2[1] * glot_refl_gain
if table_increment.nonzero?
table_location += table_increment
if table_location >= table_size then table_location -= table_size end
int_loc = table_location.floor
table1 = glot_table[int_loc]
table2 = glot_table2[int_loc]
glotsamp = glotsamp + s_glot * (table1 + s_glot_mix * (table2 - table1))
# glot noise tick
if gn_table[int_loc].nonzero? and gn_gain.nonzero?
gn_out = gn_gain * s_glot * (1.0 - random(2.0)) -
gn_coeffs[3] * gn_del[3] -
gn_coeffs[2] * gn_del[2] -
gn_coeffs[1] * gn_del[1] -
gn_coeffs[0] * gn_del[0]
3.downto(1) do |j| gn_del[j] = gn_del[j - 1] end
gn_del[0] = gn_out
end
glotsamp = glotsamp + gn_out * gn_table[int_loc]
end
# next tract tick
lt[0] = dline1[2] + dline2[2]
dline2[1] = dline2[2] + coeffs[1] * (glotsamp - dline2[2])
temp = glotsamp + (dline2[1] - dline2[2])
2.upto(noseposition - 1) do |j|
dline2[j] = dline2[j + 1] + coeffs[j] * (dline1[j - 1] - dline2[j + 1])
dline1[j - 1], temp = temp, dline1[j - 1] + (dline2[j] - dline2[j + 1])
end
jj = noseposition
# next nasal tick
plussamp = dline1[jj - 1]
minussamp = dline2[jj + 1]
nose_reftemp = 0.0
if velum_pos.zero? and time_nose_closed >= nose_ring_time
# nasal tick
nose_reftemp = alpha[1] * plussamp + alpha[2] * minussamp + alpha[3] * nose2[1]
nose_last_minus_refl = nose_reftemp - plussamp
nose_last_plus_refl = nose_reftemp - minussamp
else
if velum_pos.nonzero?
time_nose_closed = 0
else
time_nose_closed += 1
end
nose_reftemp = alpha[1] * plussamp + alpha[2] * minussamp + alpha[3] * nose2[1]
plus_in = velum_pos * (nose_reftemp - nose2[1])
nose_last_minus_refl = nose_reftemp - plussamp
nose_last_plus_refl = nose_reftemp - minussamp
nose_reftemp = nose_coeffs[1] * (plus_in - nose2[2])
nose2[1] = nose2[2] + nose_reftemp
nose_temp = plus_in + nose_reftemp
2.upto(noselength - 2) do |j|
nose_reftemp = nose_coeffs[j] * (nose1[j - 1] - nose2[j + 1])
nose2[j] = nose2[j + 1] + nose_reftemp
nose1[j - 1], nose_temp = nose_temp, nose1[j - 1] + nose_reftemp
end
nose_reftemp = nose_coeffs[noselength - 1] * (nose1[noselength - 2] - nose_last_output * 0.25)
nose2[noselength - 1] = nose_last_output * 0.25 + nose_reftemp
nose1[noselength - 1] = nose1[noselength - 2] + nose_reftemp
nose1[noselength - 2] = nose_temp
nose_filt1, nose_filt = nose_filt, nose1[noselength - 1]
nose_last_output = (nose_filt + nose_filt1) * 0.5
end
dline2[jj] = nose_last_minus_refl
dline1[jj - 1], temp = temp, nose_last_plus_refl
(noseposition + 1).upto(tractlength - 2) do |j|
dline2[j] = dline2[j + 1] + coeffs[j] * (dline1[j - 1] - dline2[j + 1])
dline1[j - 1], temp = temp, dline1[j - 1] + (dline2[j] - dline2[j + 1])
end
dline2[tractlength - 1] = last_lip_refl +
coeffs[tractlength - 1] * (dline1[tractlength - 2] - last_lip_refl)
dline1[tractlength - 1] = dline1[tractlength - 2] + (dline2[tractlength - 1] - last_lip_refl)
dline1[tractlength - 2] = temp
if noise_gain.nonzero?
noise_input = 1.0 - random(2.0) # a guess
3.downto(1) do |j|
outz[j] = outz[j - 1]
end
outz[0] = noise_output
noise_output = noise_input - inz2
4.times do |j|
noise_output = noise_output - noise_c[j] * outz[j]
end
inz2, inz1 = inz1, noise_input
dline1[noise_pos] = dline1[noise_pos] + noise_output * noise_gain * s_noise
end
last_tract_plus = dline1[tractlength - 1] * lip_radius
lt[1] = ltgain * (lt[0] + ltcoeff * lt[1])
amp * (last_lip_out + nose_last_output + lt[1])
end
end

Test_glt = [10, 0.65, 0.65]
Loud_glt = [13, 0.6, 0.6]
Soft_glt = [13, 0.65, 0.73]
Wide4_glt = [18, 0.534, 0.56]
Wide5_glt = [10, 0.65, 0.65]
Greekdefault_glt = [20, 0.65, 0.672472]
Lowbass_glt = [99, 0.5, 0.17737593]

Aa_shp = [8, 0.63110816, 0.94615144, 1.0756062, 0.9254686, 0.9928594, 0.98307705,
1.4507878, 0.95167005, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Hh2_shp = [8, 0.928177, 0.61326, 0.39779, 0.530387, 0.679558, 0.961326, 1.44199,
1.09392, 0.7, -0.203125, 1.0, 0.0, 554.1667, 0.8, 2000.0, 0.772222, 0.0]
Dhh_shp = [8, 0.828729, 1.45856, 0.9882353, 0.662983, 0.9352941, 1.2529411, 0.40588236,
1.1740758, 0.7, -0.140625, 7.0, 0.023333002, 3039.613, 0.691692, 1264.1677, 0.404788, 0.0]
Aah_shp = [8, 0.8214024, 0.7839217, 1.0981537, 0.9937591, 0.817757, 1.1907763, 1.3149668,
1.0705689, 0.7, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Hhh_shp = [8, 0.928177, 0.61326, 0.39779, 0.530387, 0.679558, 0.961326, 1.44199, 1.09392,
0.7, -0.203125, 1.0, 0.046296295, 554.1667, 0.8, 2000.0, 0.7722222, 0.0]
Ohh_shp = [8, 1.02762, 0.696133, 0.39779, 0.513812, 0.6371682, 1.4070797, 1.80663, 0.5044248,
0.7, -0.2, 1.0, 0.0, 1000.0, 0.0, 0.0, 0.0, 0.0]
Ah_shp = [8, 0.7162393, 0.6389201, 0.8881412, 0.6060006, 1.293248, 1.4140776, 1.8503952,
0.8622935, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Oo_shp = [8, 0.46043858, 1.0865723, 0.33916336, 0.88724023, 0.9989101, 1.224445, 0.39867023,
0.506609, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ahh_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 1.65746, 1.62431, 0.944751,
0.7, -0.45, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Eem_shp = [8, 0.928177, 1.37569, 1.37569, 0.679558, 0.629834, 0.24817872, 0.56896555, 0.662983,
0.7, -0.403125, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.09677419]
Hoo_shp = [8, 1.32597, 1.29282, 0.39779, 0.530387, 1.32597, 1.34254, 1.78182, 0.46408796,
0.7, -0.4, 1.0, 0.031045755, 2215.7856, 0.82698005, 1026.6984, 0.96960765, 0.0]
Ooo_shp = [8, 1.32597, 1.29282, 0.39779, 0.530387, 1.32597, 1.34254, 1.78182, 0.464088,
0.7, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ee_shp = [8, 1.02, 1.637, 1.67, 1.558, 0.952, 0.501, 0.681, 0.675, 0.9, -0.4, 1.0,
0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ih_shp = [8, 0.72092783, 1.2719809, 1.3881364, 0.6532612, 0.7501422, 0.65654784, 0.8194081,
0.6556785, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ee2_shp = [8, 0.9180887, 1.3481673, 1.3433423, 0.74573994, 0.593326, 0.5647744, 0.6692766,
0.7419633, 0.7, -0.405254, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ihh_shp = [8, 0.7906788, 1.272475, 1.4089537, 0.68072784, 0.62673146, 0.7479623, 0.7506758,
0.7054355, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Open_shp = [8, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 0.7, -0.45,
1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0]
Thh_shp = [8, 0.828729, 1.45856, 0.9882353, 0.662983, 0.9352941, 1.2529411, 0.40588236,
1.1740758, 0.7, -0.140625, 7.0, 0.101764, 3039.613, 0.691692, 1264.1677, 0.404788, 0.0]
Aw_shp = [8, 1.0525645, 0.643587, 0.935229, 0.4901642, 1.0743295, 1.1822895, 1.4161918,
0.82537806, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Eee_shp = [8, 0.928177, 1.37569, 1.37569, 0.679558, 0.629834, 0.646409, 0.56896555, 0.662983,
0.7, -0.403125, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Ttp_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.18584079, 1.62431, 0.944751,
0.7, -0.45, 6.0, 0.388889, 10514.583, 0.854335, 1315.2043, 0.280428, 0.0]
Aww_shp = [8, 1.02762, 0.696133, 0.563536, 0.513812, 0.977901, 1.37569, 1.80663, 0.712707,
0.7, -0.2, 1.0, 0.0, 1000.0, 0.0, 0.0, 0.0, 0.0]
Eee2_shp = [8, 0.928177, 1.37569, 1.37569, 0.679558, 0.629834, 0.646409, 0.5117647, 0.662983,
0.7, -0.203125, 7.3688526, 0.0, 5214.53, 0.975806, 0.0, 0.0, 0.0]
Jjj_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.1592921, 1.1464338, 0.944751,
0.7, -0.45, 6.0, 0.098039, 2315.7278, 0.7089554, 3066.7, 0.7983351, 0.0]
Ttt_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.0, 1.62431, 0.944751,
0.7, -0.45, 6.0, 0.388889, 10514.583, 0.854335, 1315.2043, 0.280428, 0.0]
Bb2_shp = [8, 1.0, 1.0, 0.46902645, 0.5486725, 0.65486723, 1.079646, 1.3982301, 0.0,
0.7, -0.2, 8.0, 0.03, 500.0, 0.98, 0.0, 0.0, 0.0]
Eh_shp = [8, 0.7866194, 1.1630946, 1.2335452, 0.93186677, 0.94121367, 0.7586716, 1.3509308,
0.8279036, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Kkp_shp = [8, 0.8214024, 0.7839217, 1.0981537, 0.1592921, 1.061947, 1.1907763, 1.3149668,
1.0705689, 0.7, -0.4, 4.0, 0.4, 2000.0, 0.93, 0.0, 0.0, 0.0]
Pipe1_shp = [8, 1.0, 1.0, 1.0, 0.7, 0.7, 0.7, 0.7, 0.7, 0.0, 0.0, 1.0, 0.0, 100.0,
0.0, 0.0, 0.0, 0.0]
Tzz_shp = [8, 0.828729, 1.45856, 0.9882353, 0.662983, 0.9352941, 1.2529411, 0.40588236,
1.1740758, 0.7, -0.140625, 7.0, 0.101764, 3039.613, 0.691692, 1264.1677, 0.404788, 0.0]
Bbb_shp = [8, 1.0, 1.0, 0.46902645, 0.5486725, 0.65486723, 1.079646, 1.3982301, 0.0,
0.7, -0.2, 8.0, 0.03, 500.0, 0.98, 0.0, 0.0, 0.0]
Ehh_shp = [8, 0.682, 1.554, 1.581, 1.367, 1.315, 1.579, 0.843, 1.476, 0.7, -0.24507,
1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Kk2_shp = [8, 0.82140243, 0.7839217, 1.0981537, 0.0, 1.061947, 1.1907763, 1.3149668,
1.0705689, 0.7, -0.4, 5.0, 0.01, 2000.0, 0.93, 0.0, 0.0, 0.0]
PpP_shp = [8, 1.0, 1.0, 0.3362832, 0.49557513, 0.7079646, 1.2389379, 1.1327434, 0.29203534,
0.7, -0.2, 8.0, 0.040740736, 0.0, 0.89649165, 2082.2144, 0.8713607, 0.0]
Uhh_shp = [8, 0.928177, 0.61326, 0.39779, 0.530387, 0.679558, 0.961326, 1.44199, 1.09392,
0.7, -0.203125, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Big_shp = [8, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0]
Euu_shp = [8, 0.9285748, 1.3756071, 1.3747121, 0.6794088, 0.60398144, 0.43471563,
0.8356653, 0.7158814, 0.7, -0.403122, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Kkk_shp = [8, 0.8214024, 0.7839217, 1.0981537, 0.0, 1.061947, 1.1907763, 1.3149668, 1.0705689,
0.7, -0.4, 4.0, 0.09444445, 2000.0, 0.93, 0.0, 0.0, 0.0]
Ppp_shp = [8, 1.0, 1.0, 0.3362832, 0.49557513, 0.7079646, 1.2389379, 1.1327434, 0.0,
0.7, -0.2, 8.0, 0.05, 500.0, 0.98, 0.0, 0.0, 0.0]
Uu_shp = [8, 0.45291674, 1.0539645, 0.39576897, 0.8116293, 1.0510263, 1.1789232, 0.47529656,
0.62563825, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Fff_shp = [8, 0.93787295, 0.70496833, 0.8969878, 0.60815966, 0.9375178, 0.7412625, 1.1285298,
0.2665695, 0.7, -0.202603, 8.0, 0.10341219, 8236.909, 0.945306, 79.28094, 0.498648, 0.0]
Ll2_shp = [8, 0.928177, 0.779006, 0.71772796, 0.807417, 1.02762, 1.65746, 0.36206907,
0.86510503, 0.7, -0.258055, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.20806663]
Uuu_shp = [8, 0.55, 0.943094, 1.035, 0.434071, 1.14681, 1.487, 0.555, 0.656, 0.9, -0.4,
1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Lll_shp = [8, 0.928177, 0.779006, 0.7330638, 0.8156748, 1.02762, 1.65746, 0.3620689, 0.944751,
0.7, -0.103125, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.21774194]
Rolledr_shp = [8, 0.3365169, 0.9244819, 1.0542682, 0.4485168, 1.0597233, 0.054845095,
0.66896766, 0.8336522, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Vvv_shp = [8, 0.9400966, 0.6775904, 0.88759726, 0.59890866, 0.9485658, 0.737778, 1.1542239,
0.23893797, 0.7, -0.2, 8.0, 0.5, 8500.0, 0.95, 0.0, 0.5, 0.0]
Rolledrc_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.0, 1.62431, 0.944751,
0.7, -0.45, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Mmm_shp = [8, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, 0.7, -0.2,
1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.503268]
Rolledro_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.42477876, 1.62431,
0.944751, 0.7, -0.45, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Breath_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 1.65746, 1.62431, 0.944751,
0.7, -0.45, 1.0, 0.018518519, 2588.6013, 0.90612125, 812.6343, 0.9814815, 0.0]
Moo_shp = [8, 1.32597, 1.29282, 0.39779, 0.530387, 1.32597, 1.34254, 1.78182, 0.0,
0.7, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.30645162]
Rr2_shp = [8, 0.3365169, 0.9244819, 1.0542682, 0.4485168, 1.0597233, 0.71856207,
0.66896766, 0.7274576, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 32.000004, 0.0]
Chh_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.1592921, 1.1464338,
0.944751, 0.7, -0.45, 6.0, 0.098039, 2315.7278, 0.7089554, 3066.7, 0.7983351, 0.0]
Gg2_shp = [8, 0.8214024, 0.4122405, 0.40788835, 0.0, 0.8495575, 0.7129002, 0.7308959,
0.7785335, 0.7, -0.4, 4.0, 0.05, 2000.0, 0.9, 0.0, 0.0, 0.0]
Nng_shp = [8, 1.0, 1.0, 1.0333333, 0.0, 1.0, 0.99999994, 0.9568965, 1.3189656,
0.7, -0.2, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0]
Rrr_shp = [8, 0.3365169, 0.9244819, 1.0542682, 0.4485168, 1.0597233, 0.71856207,
0.66896766, 0.7274576, 0.9, -0.4, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Wsp_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 1.65746, 1.62431,
0.944751, 0.7, -0.45, 1.0, 0.018518519, 0.0, 0.97, 0.0, 0.0, 0.0]
Ggg_shp = [8, 0.8214024, 0.7839217, 1.0981537, 0.0, 0.8495575, 0.7129002, 0.7308959,
0.7785335, 0.7, -0.4, 4.0, 0.05, 2000.0, 0.9, 0.0, 0.0, 0.0]
Nnn_shp = [8, 1.0, 1.0, 1.0, 1.4579439, 1.0, 0.0, 0.9568965, 1.3189656,
0.7, -0.2, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.503268]
Sh2_shp = [8, 0.828729, 1.45856, 0.9882353, 0.662983, 0.9352941, 1.2529411, 0.40588236,
0.9882353, 0.7, -0.140625, 7.0, 0.0, 2451.5984, 0.928097, 2957.0518, 0.883636, 0.0]
Xx2_shp = [8, 0.928177, 1.37569, 1.37569, 0.8495575, 0.3451327, 0.646409, 0.56896555, 0.662983,
0.7, -0.403125, 5.0, 0.022222, 2102.0833, 0.805556, 1735.4166, 0.759259, 0.0]
Dd2_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.0, 0.72165513, 0.5996184,
0.7, -0.45, 6.0, 0.02, 4851.6665, 0.953704, 2500.0, 0.966296, 0.0]
Ggg1_shp = [8, 0.8214024, 0.7839217, 1.0981537, 0.18584079, 1.061947, 1.1907763,
1.3149668, 1.0705689, 0.7, -0.4, 4.0, 0.4, 2000.0, 0.9, 0.0, 0.0, 0.0]
Noisahh_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 1.65746, 1.62431, 0.944751,
0.7, -0.45, 1.0, 0.005, 0.0, 0.787037, 3777.0835, 0.759259, 0.0]
Shh_shp = [8, 0.828729, 1.45856, 0.9882353, 0.662983, 0.9352941, 1.2529411, 0.40588236,
0.9882353, 0.7, -0.140625, 7.0, 0.023333, 2451.5984, 0.9280972, 2957.0518, 0.88363576, 0.0]
Xxx_shp = [8, 0.928177, 1.37569, 1.37569, 0.3451327, 0.6371682, 0.646409, 0.56896555, 0.662983,
0.7, -0.403125, 4.0, 0.022222219, 2102.0833, 0.8055556, 612.5, 0.7592593, 0.0]
Ddd_shp = [8, 0.928177, 0.779006, 0.629834, 0.629834, 1.02762, 0.0, 0.72165513, 0.5996184,
0.7, -0.45, 6.0, 0.02, 4851.6665, 0.953704, 2500.0, 0.966296, 0.0]
Gxx_shp = [8, 0.928177, 1.37569, 1.37569, 0.3451327, 0.6371682, 0.646409, 0.56896555, 0.662983,
0.7, -0.403125, 4.0, 0.022222, 2102.0833, 0.805556, 612.5, 0.759259, 0.0]
None_shp = [8, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0]
Sss_shp = [8, 0.928177, 1.3588235, 1.3588235, 0.679558, 0.61764705, 0.63529414, 0.31764707,
0.65294117, 0.7, -0.103125, 7.0, 0.105292, 1500.0, 0.916452, 4943.75, 0.97222227, 0.0]
Zzz_shp = [8, 0.928177, 1.3588235, 1.3588235, 0.679558, 0.61764705, 0.63529414, 0.31764707,
0.65294117, 0.7, -0.103125, 7.0, 0.016, 1500.0, 0.9257112, 4943.75, 0.925926, 0.0]

=begin
with_sound do
singer(0, 0.1, [
[0.4, Ehh_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.6, Oo_shp, Test_glt, 523.0, 0.7, 0.1, 0.01]])
end
=end

=begin
with_sound do
singer(0.2, 0.1,[
[0.05, Ehh_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.15, Ehh_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.05, Kkk_shp, Test_glt, 523.0, 0.0, 0.0, 0.01],
[0.05, Kkk_shp, Test_glt, 523.0, 0.0, 0.0, 0.01],
[0.02, Kkp_shp, Test_glt, 523.0, 0.0, 1.0, 0.01],
[0.08, Kkp_shp, Test_glt, 523.0, 0.0, 0.2, 0.01],
[0.05, Ooo_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.15, Ooo_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.05, Eee_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.15, Eee_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.05, Ehh_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.15, Ehh_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.05, Mmm_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.15, Mmm_shp, Test_glt, 523.0, 0.8, 0.0, 0.01],
[0.10, Mmm_shp, Test_glt, 523.0, 0.0, 0.0, 0.01]])
end
=end

# singer.rb ends here

+ 565
- 0
lib/sndlib/singer.scm View File

@@ -0,0 +1,565 @@
;;; Perry Cook's physical model of the vocal tract as described in:
;;;
;;; Cook, Perry R. "Synthesis of the Singing Voice Using a Physically Parameterized Model of the Human Vocal Tract"
;;; Published in the Proceedings of the International Computer Music Conference, Ohio 1989
;;; and as Stanford University Department of Music Technical Report Stan-M-57, August 1989.
;;;
;;; ---- "Identification of Control Parameters in an Articulatory Vocal Tract Model, with Applications
;;; to the Synthesis of Singing," Ph.D. Thesis, Stanford University Department of Music Technical Report
;;; Stan-M-68, December 1990.
;;;
;;; ---- "SPASM, a Real-time Vocal Tract Physical Model Controller; and Singer, the Companion Software
;;; Synthesis System", Computer Music Journal, vol 17 no 1 Spring 1993.
;;;
;;; This code is a translation of Perry Cook's singer implementation originally in C.
;;; Apparently all Perry's data is aimed at srate=22050.
;;;
;;; translated from CLM singer.ins

(provide 'snd-singer.scm)
(if (provided? 'snd)
(require snd-ws.scm)
(require sndlib-ws.scm))

(define two-pi (* 2 pi))

(definstrument (singer beg amp data)
;; data is a list of lists very similar to the sequence of synthesize calls in Perry's original implementation.
;; Each imbedded list has the form: dur shape glot pitch glotamp noiseamps vibramt.
;; See below for examples.

(let* ((durs (map car data))
(dur (apply + durs))
(begs (let ((bg beg))
(cons beg
(map (lambda (x)
(set! bg (+ bg x)))
durs)))))
(let ((setup (car data))
(beg-samps (map seconds->samples begs)))
(let ((change-times (apply vector (append beg-samps (list (beg-samps (- (length beg-samps) 1))))))
(shps (map cadr data))
(glts (map caddr data))
(pfun (let ((init (list 0.0 (* .8 (setup 3)))))
(for-each (lambda (b dat)
(set! init (append init (list (- b beg) (* 1.0 (dat 3))))))
(cdr begs)
data)
init))
(gfun (let ((init (list 0.0 0.0)))
(for-each (lambda (b dat)
(set! init (append init (list (- b beg) (* 1.0 (dat 4))))))
(cdr begs)
data)
init))
(nfun (let ((init (list 0.0 (* 1.0 (setup 5)))))
(for-each (lambda (b dat)
(set! init (append init (list (- b beg) (* 1.0 (dat 5))))))
(cdr begs)
data)
init))
(vfun (let ((init (list 0.0 (* 1.0 (setup 6)))))
(for-each (lambda (b dat)
(set! init (append init (list (- b beg) (* 1.0 (dat 6))))))
(cdr begs)
data)
init))
(noiseamps (let* ((len (length data))
(v (make-float-vector len)))
(do ((i 0 (+ i 1)))
((= i len))
(set! (v i) (* 1.0 ((data i) 5))))
v))
(tractlength 9)) ;length of vocal tract
(let ((frq-env (make-env pfun :duration dur))
(vib-env (make-env vfun :duration dur))
(vib-osc (make-oscil 6.0))
(glot-env (make-env gfun :duration dur))
(noise-env (make-env nfun :duration dur))
(ran-vib (make-rand-interp :frequency 10 :amplitude .02))
(glot-datai (make-float-vector (* 2 (length glts))))
(glot-datar (make-float-vector (* 2 (length glts))))
(tractlength+8 (+ tractlength 8))
(tractlength+1 (+ tractlength 1))
(tractlength-1 (- tractlength 1))
(tractlength-2 (- tractlength 2))
(noselength 6)
(table-size 1000) ; size of glottis wave-table
(dpole 0.998)
(bg (seconds->samples beg))
(tong-hump-pole 0.998)
(tong-tip-pole 0.998))
(let ((shape-data (make-float-vector (* (length shps) tractlength+8)))
(noselength-1 (- noselength 1))
(noselength-2 (- noselength 2))
(nose-ring-time 1000) ; naso pharynx response decay time
(table-size-over-sampling-rate (/ table-size *clm-srate*))
(dgain (- 1.0 dpole))
(tong-hump-gain (- 1.0 tong-hump-pole))
(tong-tip-gain (- 1.0 tong-tip-pole))
(last-sfd -1)
(last-gfd -1)
(glot-table (make-float-vector (+ 1 table-size)))
(glot-table2 (make-float-vector (+ 1 table-size)))
;; (gn-table (make-float-vector (+ 1 table-size))) ;(gn-gain 0.0) ;(gn-out 0.0) ;(gn-del (make-float-vector 4))
;; (gn-coeffs (make-float-vector 4)) ; in Perry's C code, these were set in setGlotNoiseFilter but it was never called!
(table-increment 0.0)
(glot-refl-gain 0.7)
(pitch 400.0)
(last-lip-in 0.0) ;for lip reflection/transmission filter
(last-lip-out 0.0)
(last-lip-refl 0.0)
(lip-refl-gain -0.45)
(noise-gain 0.0) ;for vocal tract noise generator
(noise-input 0.0)
(noise-output 0.0)
(noisef (make-fir-filter 4 :xcoeffs (make-float-vector 4)))
(noisev #f)
(noise-pos 0)
(fnoiseamp 0.0)
(inz1 0.0)
(inz2 0.0)
;; nasal tract acoustic tube structure
(nose-coeffs (make-float-vector noselength))
(nose1 (make-float-vector noselength))
(nose2 (make-float-vector noselength))
(velum-pos 0.0)
(nose-last-minus-refl 0.0)
(nose-last-plus-refl 0.0)
(nose-last-output 0.0)
(nose-filt 0.0)
(nose-filt1 0.0)
(time-nose-closed 1000) ; this is a hack used to determine if we need to calculate the nasal acoustics
;; vocal tract acoustic tube structure
;; throat radiation low-pass filter
(lt1 0.0)
(lp (make-one-pole 0.05 (* -0.05 .9995)))
(lip-radius 0.0)
(s-glot-mix 1.0)
(s-noise 0.0)
(initial-noise-position 0.0)
(formant-shift 1.0)
(change-radii #f)
(delta 0.0)
(new-tract #t)
(first-tract #t)
(offset -1)
(nd (floor (change-times (- (length change-times) 1))))
(next-offset bg)
(table-location 0.0)
(glotsamp 0.0)
(last-tract-plus 0.0)
(alpha1 0.0)
(alpha2 0.0)
(alpha3 0.0)
(noseposition 3)
(target-radii (make-float-vector tractlength+8))
(target-temp (make-float-vector tractlength+8))
(radii-poles (make-float-vector tractlength+8))
(radii-pole-gains (make-float-vector tractlength+8))
(radii (make-float-vector tractlength+8))
; the radii array contains the vocal tract section radii
; (tractlength-1 of them), then glottal reflection gain
; then lip reflection gain, then noise position, then noise gain,
; then noise pole angle, then noise pole radius,
; then noise pole angle2, then noise pole radius2, then velum opening radius
(coeffs (make-float-vector tractlength))
(dline1 (make-float-vector tractlength))
(dline2 (make-float-vector tractlength)))
(set! noisev (mus-xcoeffs noisef))
(do ((k 0 (+ k 1))
(i 0 (+ i tractlength+8)))
((= k (length shps)))
(let ((shp (cdr (shps k))))
(do ((j i (+ j 1))
(m 0 (+ 1 m)))
((= m (length shp)))
(float-vector-set! shape-data j (shp m)))))
(do ((k 0 (+ k 1))
(i 0 (+ i 2)))
((= k (length glts)))
(let ((glt (glts k)))
(set! (glot-datai i) 0.0)
(set! (glot-datai (+ i 1)) (car glt))
(set! (glot-datar i) (cadr glt))
(set! (glot-datar (+ i 1)) (caddr glt))))
(set! (nose-coeffs 0) 0.0)
(set! (nose-coeffs 1) -0.29)
(set! (nose-coeffs 2) -0.22)
(set! (nose-coeffs 3) 0.0)
(set! (nose-coeffs 4) 0.24)
(set! (nose-coeffs 5) 0.3571)
(fill! radii 1.0) ;(do ((i 0 (+ i 1))) ((= i 8)) (set! (radii i) 1.0))
(set! (radii 8) 0.7)
(set! (radii 9) -0.5)
(fill! target-radii 1.0) ;(do ((i 0 (+ i 1))) ((= i 8)) (set! (target-radii i) 1.0))
(set! (target-radii 8) 0.7)
(set! (target-radii 9) -0.5)
(fill! radii-poles dpole) ;(do ((i 0 (+ i 1))) ((= i tractlength+8)) (set! (radii-poles i) dpole))
(set! (radii-poles 2) tong-hump-pole)
(set! (radii-poles 3) tong-hump-pole)
(set! (radii-poles 4) tong-hump-pole)
(set! (radii-poles 5) tong-tip-pole)
(fill! radii-pole-gains dgain) ;(do ((i 0 (+ i 1))) ((= i tractlength+8)) (set! (radii-pole-gains i) dgain))
(set! (radii-pole-gains 2) tong-hump-gain)
(set! (radii-pole-gains 3) tong-hump-gain)
(set! (radii-pole-gains 4) tong-hump-gain)
(set! (radii-pole-gains 5) tong-tip-gain)
;; ---------------- make glot ----------------
(let ((harms (floor (glot-datai 1)))
(temp1 0.0)
(temp 0.0)
(sines (make-float-vector 200))
(cosines (make-float-vector 200))
(one-over-two-pi 0.159154943)
(two-pi-over-table-size (/ two-pi table-size))
(a (glot-datar 0))
(b (glot-datar 1)))
(let ((a2 (* two-pi a))
(b2 (* two-pi b))
(b-a (- b a)))
(let ((sa2 (sin a2))
(ca2 (cos a2)))
(fill! sines 0.0)
(fill! cosines 0.0)
(if (not (= b a))
(begin
(set! temp (/ one-over-two-pi b-a))
(set! temp1 (- 1.0 ca2))
(set! (sines 1) (* (+ ca2 (* (- sa2 (sin b2)) temp)) temp1 one-over-two-pi))
(set! (cosines 1) (* (- (* (- ca2 (cos b2)) temp) sa2) temp1 one-over-two-pi))))
(set! (sines 1) (+ (sines 1) (* (- (+ 0.75 (* (cos (* 2 a2)) 0.25)) ca2) one-over-two-pi)))
(set! (cosines 1) (- (+ (cosines 1) (* (- sa2 (* (sin (* 2 a2)) 0.25)) one-over-two-pi)) (* a 0.5)))
(do ((k 2 (+ k 1))
(ka2 (* 2 a2) (+ ka2 a2))
(ka1 a2 (+ ka1 a2))
(ka3 (* 3 a2) (+ ka3 a2)))
((> k harms))
(if (not (= b a))
(begin
(set! temp (/ one-over-two-pi (* b-a k)))
(set! (sines k) (* (+ (cos ka2) (* (- (sin ka2) (sin (* k b2))) temp)) (/ temp1 k)))
(set! (cosines k) (* (- (* (- (cos ka2) (cos (* k b2))) temp) (sin ka2)) (/ temp1 k)))))
(set! (sines k) (+ (sines k)
(/ (- 1.0 (cos ka2)) k)
(/ (* (- (cos ka1) 1.0) 0.5) (- k 1))
(/ (* (- (cos ka3) 1.0) 0.5) (+ k 1))))
(set! (sines k) (* (sines k) one-over-two-pi))
(set! (cosines k) (- (+ (cosines k) (/ (sin ka2) k)) (/ (* (sin ka1) 0.5) (- k 1)) (/ (* (sin ka3) 0.5) (+ k 1))))
(set! (cosines k) (* (cosines k) one-over-two-pi)))
(fill! glot-table 0.0)
(do ((j 0 (+ j 1))
(x 0.0 (+ x two-pi-over-table-size)))
((> j table-size))
(do ((k 1 (+ k 1))
(kx x (+ kx x)))
((> k harms))
(float-vector-set! glot-table j (+ (float-vector-ref glot-table j)
(* (float-vector-ref cosines k) (cos kx))
(* (float-vector-ref sines k) (sin kx)))))))))
(copy glot-table glot-table2)
;; ---------------- end make glot ----------------
(do ((i bg (+ i 1)))
((= i nd))
(if (= i next-offset)
(begin
;; time to check for new tract shapes, glottal pulse shapes etc.
(set! offset (+ offset 1))
(set! fnoiseamp (noiseamps offset))
(if (= last-sfd -1)
(set! last-sfd 0)
(let ((new-sfd (+ last-sfd 8 tractlength)))
(do ((j last-sfd (+ j 1))
(k new-sfd (+ k 1)))
((= j new-sfd))
(if (> (abs (- (shape-data j) (shape-data k))) .001)
(set! new-tract #t)))
(set! last-sfd new-sfd)))
(set! last-gfd (if (= last-gfd -1) 0 (+ last-gfd 2)))
(set! next-offset (floor (change-times (+ offset 1))))
(set! delta (/ 1.0 (- next-offset i)))))
(if new-tract
(begin
(copy shape-data target-radii last-sfd)
(if first-tract
(copy target-radii radii))
(set! change-radii #f)
(set! initial-noise-position (radii tractlength+1))
(do ((j 0 (+ j 1)))
((or (= j tractlength+8)
change-radii))
(if (> (abs (- (target-radii j) (radii j))) 0.001)
(set! change-radii #t)))))
(when (or first-tract change-radii)
(if (not new-tract)
(begin
(float-vector-multiply! radii radii-poles)
(copy target-radii target-temp)
(float-vector-multiply! target-temp radii-pole-gains)
(float-vector-add! radii target-temp)
;; (do ((j 0 (+ j 1))) ((= j tractlength+8))
;; (float-vector-set! radii j (+ (* (float-vector-ref radii j) (float-vector-ref radii-poles j))
;; (* (float-vector-ref target-radii j) (float-vector-ref radii-pole-gains j)))))
))
;; set tract shape
(do ((tj 1.0)
(tk 0.0)
(k 0 (+ k 1))
(j 1 (+ j 1)))
((= j tractlength))
(set! tk tj)
(set! tj (if (zero? (float-vector-ref radii j))
1e-10
(* (float-vector-ref radii k) (float-vector-ref radii k))))
(float-vector-set! coeffs j (/ (- tk tj) (+ tk tj))))
(set! glot-refl-gain (radii tractlength-1))
(set! lip-refl-gain (radii tractlength))
(set! noise-pos (floor (radii tractlength+1)))
(set! noise-gain (radii (+ tractlength 2)))
(let ((temp1 (radii (+ tractlength 3)))
(r (radii (+ tractlength 4)))
(t2 (radii (+ tractlength 5)))
(r2 (radii (+ tractlength 6))))
(let ((noise-angle (hz->radians temp1)) ; fricative noise generator (set noise angle and radius)
(noise-angle2 (hz->radians t2)))
(let ((noise-a (* -2.0 (cos (/ noise-angle formant-shift)) r))
(noise-b (* r r))
(noise-a2 (* -2.0 (cos (/ noise-angle2 formant-shift)) r2))
(noise-b2 (* r2 r2)))
(set! (noisev 0) (+ noise-a noise-a2))
(set! (noisev 1) (+ noise-b noise-b2 (* noise-a noise-a2)))
(set! (noisev 2) (+ (* noise-a2 noise-b) (* noise-b2 noise-a)))
(set! (noisev 3) (* noise-b2 noise-b)))))
(set! lip-radius (radii tractlength-2))
(set! velum-pos (radii (+ tractlength 7)))
(let ((leftradius (radii (- noseposition 2)))
(rightradius (radii (- noseposition 1))))
(let ((temp (max (- rightradius velum-pos) 0.0)))
;; nasal tract (set nasal shape)
(set! alpha1 (* leftradius leftradius))
(set! alpha2 (* temp temp)))
(set! alpha3 (* velum-pos velum-pos)))
(let ((temp1 (/ 2.0 (+ alpha1 alpha2 alpha3))))
(set! alpha1 (* alpha1 temp1))
(set! alpha2 (* alpha2 temp1))
(set! alpha3 (* alpha3 temp1))))
(if new-tract
(begin
(set! new-tract #f)
(set! first-tract #f)
(if (or (< s-noise 1.0) (< fnoiseamp 0.0001))
(set! (target-radii tractlength+1) initial-noise-position))))
(set! s-glot-mix (- s-glot-mix delta))
(set! s-noise (env noise-env))
(set! pitch (env frq-env))
(set! table-increment (* pitch (+ 1.0 (* (env vib-env) (oscil vib-osc)) (rand-interp ran-vib)) table-size-over-sampling-rate))
(set! last-lip-out (+ last-lip-in last-tract-plus))
(set! last-lip-refl (* (+ last-lip-in last-tract-plus) lip-refl-gain))
(set! last-lip-in last-tract-plus)
;; next glot tick
(set! glotsamp (* (dline2 1) glot-refl-gain))
(if (not (= table-increment 0.0))
(begin
(set! table-location (+ table-location table-increment))
(if (>= table-location table-size)
(set! table-location (- table-location table-size)))
(let* ((int-loc (floor table-location))
(table1 (glot-table int-loc)))
(set! glotsamp (+ glotsamp (* (env glot-env) (+ table1 (* s-glot-mix (- (glot-table2 int-loc) table1)))))))))
;; next tract tick
(let ((j 0)
;(temp1 0.0)
(temp (dline2 2)))
(set! lt1 (one-pole lp (+ (dline1 2) temp)))
(set! (dline2 1) (+ temp (* (coeffs 1) (- glotsamp temp))))
(set! temp (- (+ glotsamp (dline2 1)) temp))
(set! temp (singer-filter 1 noseposition temp dline1 dline2 coeffs))
(set! j noseposition) ;added
;;next nasal tick
(let ((plussamp (dline1 (- j 1)))
(minussamp (dline2 (+ j 1)))
(nose-reftemp 0.0))
(if (and (= velum-pos 0.0)
(>= time-nose-closed nose-ring-time))
(let ((nose2-1 (float-vector-ref nose2 1)))
(set! nose-reftemp (+ (* alpha1 plussamp) (* alpha2 minussamp) (* alpha3 nose2-1)))
(set! nose-last-minus-refl (- nose-reftemp plussamp))
(set! nose-last-plus-refl (- nose-reftemp minussamp)))
(begin
(set! time-nose-closed
(if (= velum-pos 0.0)
(+ time-nose-closed 1) ; added 1 bil 17-Apr-11 but didn't test it
0))
;; nasal tick
(let ((nose-reftemp (+ (* alpha1 plussamp) (* alpha2 minussamp) (* alpha3 (nose2 1)))))
(let (;(nose-t1 0.0)
(nose-temp 0.0)
(plus-in (* velum-pos (- nose-reftemp (nose2 1)))))
(set! nose-last-minus-refl (- nose-reftemp plussamp))
(set! nose-last-plus-refl (- nose-reftemp minussamp))
(set! nose-reftemp (* (nose-coeffs 1) (- plus-in (nose2 2))))
(set! (nose2 1) (+ (nose2 2) nose-reftemp))
(set! nose-temp (singer-nose-filter noselength-1 (+ plus-in nose-reftemp) nose1 nose2 nose-coeffs))
(set! nose-reftemp (* (nose-coeffs noselength-1) (- (nose1 noselength-2) (* nose-last-output 0.25))))
(set! (nose2 noselength-1) (+ (* nose-last-output 0.25) nose-reftemp))
(set! (nose1 noselength-1) (+ (nose1 noselength-2) nose-reftemp))
(set! (nose1 noselength-2) nose-temp)
(set! nose-filt1 nose-filt)
(set! nose-filt (nose1 noselength-1))
(set! nose-last-output (* (+ nose-filt nose-filt1) 0.5))))))
(set! (dline2 j) nose-last-minus-refl))
(set! (dline1 (- j 1)) temp)
;; j always starts at 4, goes to 8 so this loop can be unrolled, but doing so doesn't make a big difference
(set! temp (singer-filter noseposition tractlength-1 nose-last-plus-refl dline1 dline2 coeffs))
(set! (dline2 tractlength-1) (+ last-lip-refl (* (coeffs tractlength-1) (- (dline1 tractlength-2) last-lip-refl))))
(set! (dline1 tractlength-1) (- (+ (dline1 tractlength-2) (dline2 tractlength-1)) last-lip-refl))
(set! (dline1 tractlength-2) temp)
(if (not (= noise-gain 0.0))
(begin
(set! noise-input (mus-random 1.0)) ;a guess
(set! noise-output (- noise-input inz2 (fir-filter noisef noise-output)))
(set! inz2 inz1)
(set! inz1 noise-input)
(set! (dline1 noise-pos) (+ (dline1 noise-pos) (* noise-output noise-gain s-noise)))))
(set! last-tract-plus (* (dline1 tractlength-1) lip-radius)))
(outa i (* amp (+ last-lip-out nose-last-output lt1))))))))))

#|
(with-sound (:statistics #t)
(singer 0 .1 (list (list .4 ehh.shp test.glt 523.0 .8 0.0 .01) (list .6 oo.shp test.glt 523.0 .7 .1 .01))))

(with-sound (:statistics #t)
(singer 0 .1 (list (list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
(list .05 kkk.shp test.glt 523.0 0.0 0.0 .01)
(list .02 kk+.shp test.glt 523.0 0.0 1.0 .01)
(list .08 kk+.shp test.glt 523.0 0.0 0.2 .01)
(list .05 ooo.shp test.glt 523.0 0.8 0.0 .01)
(list .15 ooo.shp test.glt 523.0 0.8 0.0 .01)
(list .05 eee.shp test.glt 523.0 0.8 0.0 .01)
(list .15 eee.shp test.glt 523.0 0.8 0.0 .01)
(list .05 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .15 ehh.shp test.glt 523.0 0.8 0.0 .01)
(list .05 mmm.shp test.glt 523.0 0.8 0.0 .01)
(list .15 mmm.shp test.glt 523.0 0.8 0.0 .01)
(list .10 mmm.shp test.glt 523.0 0.0 0.0 .01) )))
|#

(define test.glt (list 10 .65 .65))
(define loud.glt (list 13 .6 .6))
(define soft.glt (list 13 0.65 0.73))
(define wide4.glt (list 18 0.534 0.56))
(define wide5.glt (list 10 0.65 0.65))
(define greekdefault.glt (list 20 0.65 0.672472))
(define lowbass.glt (list 99 0.5 0.17737593))


(define aa.shp (list 8 0.63110816 0.94615144 1.0756062 0.9254686 0.9928594 0.98307705 1.4507878 0.95167005 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define hh2.shp (list 8 0.928177 0.61326 0.39779 0.530387 0.679558 0.961326 1.44199 1.09392 0.7 -0.203125 1.0 0.0 554.1667 0.8 2000.0 0.772222 0.0))
(define dhh.shp (list 8 0.828729 1.45856 0.9882353 0.662983 0.9352941 1.2529411 0.40588236 1.1740758 0.7 -0.140625 7.0 0.023333002 3039.613 0.691692 1264.1677 0.404788 0.0))
(define aah.shp (list 8 0.8214024 0.7839217 1.0981537 0.9937591 0.817757 1.1907763 1.3149668 1.0705689 0.7 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define hhh.shp (list 8 0.928177 0.61326 0.39779 0.530387 0.679558 0.961326 1.44199 1.09392 0.7 -0.203125 1.0 0.046296295 554.1667 0.8 2000.0 0.7722222 0.0))
(define ohh.shp (list 8 1.02762 0.696133 0.39779 0.513812 0.6371682 1.4070797 1.80663 0.5044248 0.7 -0.2 1.0 0.0 1000.0 0.0 0.0 0.0 0.0))
(define ah.shp (list 8 0.7162393 0.6389201 0.8881412 0.6060006 1.293248 1.4140776 1.8503952 0.8622935 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define oo.shp (list 8 0.46043858 1.0865723 0.33916336 0.88724023 0.9989101 1.224445 0.39867023 0.506609 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ahh.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 1.65746 1.62431 0.944751 0.7 -0.45 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ee-.shp (list 8 0.928177 1.37569 1.37569 0.679558 0.629834 0.24817872 0.56896555 0.662983 0.7 -0.403125 1.0 0.0 0.0 0.0 0.0 0.0 0.09677419))
(define hoo.shp (list 8 1.32597 1.29282 0.39779 0.530387 1.32597 1.34254 1.78182 0.46408796 0.7 -0.4 1.0 0.031045755 2215.7856 0.82698005 1026.6984 0.96960765 0.0))
(define ooo.shp (list 8 1.32597 1.29282 0.39779 0.530387 1.32597 1.34254 1.78182 0.464088 0.7 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ee.shp (list 8 1.02 1.637 1.67 1.558 0.952 0.501 0.681 0.675 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ih.shp (list 8 0.72092783 1.2719809 1.3881364 0.6532612 0.7501422 0.65654784 0.8194081 0.6556785 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ee2.shp (list 8 0.9180887 1.3481673 1.3433423 0.74573994 0.593326 0.5647744 0.6692766 0.7419633 0.7 -0.405254 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define ihh.shp (list 8 0.7906788 1.272475 1.4089537 0.68072784 0.62673146 0.7479623 0.7506758 0.7054355 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define open.shp (list 8 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 0.7 -0.45 1.0 0.0 0.0 0.0 1.0 0.0 0.0))
(define thh.shp (list 8 0.828729 1.45856 0.9882353 0.662983 0.9352941 1.2529411 0.40588236 1.1740758 0.7 -0.140625 7.0 0.101764 3039.613 0.691692 1264.1677 0.404788 0.0))
(define aw.shp (list 8 1.0525645 0.643587 0.935229 0.4901642 1.0743295 1.1822895 1.4161918 0.82537806 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define eee.shp (list 8 0.928177 1.37569 1.37569 0.679558 0.629834 0.646409 0.56896555 0.662983 0.7 -0.403125 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define tt+.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.18584079 1.62431 0.944751 0.7 -0.45 6.0 0.388889 10514.583 0.854335 1315.2043 0.280428 0.0))
(define aww.shp (list 8 1.02762 0.696133 0.563536 0.513812 0.977901 1.37569 1.80663 0.712707 0.7 -0.2 1.0 0.0 1000.0 0.0 0.0 0.0 0.0))
(define eee2.shp (list 8 0.928177 1.37569 1.37569 0.679558 0.629834 0.646409 0.5117647 0.662983 0.7 -0.203125 7.3688526 0.0 5214.53 0.975806 0.0 0.0 0.0))
(define jjj.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.1592921 1.1464338 0.944751 0.7 -0.45 6.0 0.098039 2315.7278 0.7089554 3066.7 0.7983351 0.0))
(define ttt.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.0 1.62431 0.944751 0.7 -0.45 6.0 0.388889 10514.583 0.854335 1315.2043 0.280428 0.0))
(define bb2.shp (list 8 1.0 1.0 0.46902645 0.5486725 0.65486723 1.079646 1.3982301 0.0 0.7 -0.2 8.0 0.03 500.0 0.98 0.0 0.0 0.0))
(define eh.shp (list 8 0.7866194 1.1630946 1.2335452 0.93186677 0.94121367 0.7586716 1.3509308 0.8279036 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define kk+.shp (list 8 0.8214024 0.7839217 1.0981537 0.1592921 1.061947 1.1907763 1.3149668 1.0705689 0.7 -0.4 4.0 0.4 2000.0 0.93 0.0 0.0 0.0))
(define pipe1.shp (list 8 1.0 1.0 1.0 0.7 0.7 0.7 0.7 0.7 0.0 0.0 1.0 0.0 100.0 0.0 0.0 0.0 0.0))
(define tzz.shp (list 8 0.828729 1.45856 0.9882353 0.662983 0.9352941 1.2529411 0.40588236 1.1740758 0.7 -0.140625 7.0 0.101764 3039.613 0.691692 1264.1677 0.404788 0.0))
(define bbb.shp (list 8 1.0 1.0 0.46902645 0.5486725 0.65486723 1.079646 1.3982301 0.0 0.7 -0.2 8.0 0.03 500.0 0.98 0.0 0.0 0.0))
(define ehh.shp (list 8 0.682 1.554 1.581 1.367 1.315 1.579 0.843 1.476 0.7 -0.24507 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define kk2.shp (list 8 0.82140243 0.7839217 1.0981537 0.0 1.061947 1.1907763 1.3149668 1.0705689 0.7 -0.4 5.0 0.01 2000.0 0.93 0.0 0.0 0.0))
(define pp+.shp (list 8 1.0 1.0 0.3362832 0.49557513 0.7079646 1.2389379 1.1327434 0.29203534 0.7 -0.2 8.0 0.040740736 0.0 0.89649165 2082.2144 0.8713607 0.0))
(define uhh.shp (list 8 0.928177 0.61326 0.39779 0.530387 0.679558 0.961326 1.44199 1.09392 0.7 -0.203125 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define big.shp (list 8 3.0 3.0 3.0 3.0 3.0 3.0 3.0 3.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0 0.0 0.0))
(define euu.shp (list 8 0.9285748 1.3756071 1.3747121 0.6794088 0.60398144 0.43471563 0.8356653 0.7158814 0.7 -0.403122 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define kkk.shp (list 8 0.8214024 0.7839217 1.0981537 0.0 1.061947 1.1907763 1.3149668 1.0705689 0.7 -0.4 4.0 0.09444445 2000.0 0.93 0.0 0.0 0.0))
(define ppp.shp (list 8 1.0 1.0 0.3362832 0.49557513 0.7079646 1.2389379 1.1327434 0.0 0.7 -0.2 8.0 0.05 500.0 0.98 0.0 0.0 0.0))
(define uu.shp (list 8 0.45291674 1.0539645 0.39576897 0.8116293 1.0510263 1.1789232 0.47529656 0.62563825 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define fff.shp (list 8 0.93787295 0.70496833 0.8969878 0.60815966 0.9375178 0.7412625 1.1285298 0.2665695 0.7 -0.202603 8.0 0.10341219 8236.909 0.945306 79.28094 0.498648 0.0))
(define ll2.shp (list 8 0.928177 0.779006 0.71772796 0.807417 1.02762 1.65746 0.36206907 0.86510503 0.7 -0.258055 1.0 0.0 0.0 0.0 0.0 0.0 0.20806663))
(define uuu.shp (list 8 0.55 0.943094 1.035 0.434071 1.14681 1.487 0.555 0.656 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define lll.shp (list 8 0.928177 0.779006 0.7330638 0.8156748 1.02762 1.65746 0.3620689 0.944751 0.7 -0.103125 1.0 0.0 0.0 0.0 0.0 0.0 0.21774194))
(define rolledr.shp (list 8 0.3365169 0.9244819 1.0542682 0.4485168 1.0597233 0.054845095 0.66896766 0.8336522 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define vvv.shp (list 8 0.9400966 0.6775904 0.88759726 0.59890866 0.9485658 0.737778 1.1542239 0.23893797 0.7 -0.2 8.0 0.5 8500.0 0.95 0.0 0.5 0.0))
(define rolledrc.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.0 1.62431 0.944751 0.7 -0.45 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define mmm.shp (list 8 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.7 -0.2 1.0 0.0 0.0 0.0 0.0 0.0 0.503268))
(define rolledro.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.42477876 1.62431 0.944751 0.7 -0.45 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define breath.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 1.65746 1.62431 0.944751 0.7 -0.45 1.0 0.018518519 2588.6013 0.90612125 812.6343 0.9814815 0.0))
(define moo.shp (list 8 1.32597 1.29282 0.39779 0.530387 1.32597 1.34254 1.78182 0.0 0.7 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.30645162))
(define rr2.shp (list 8 0.3365169 0.9244819 1.0542682 0.4485168 1.0597233 0.71856207 0.66896766 0.7274576 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 32.000004 0.0))
(define chh.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.1592921 1.1464338 0.944751 0.7 -0.45 6.0 0.098039 2315.7278 0.7089554 3066.7 0.7983351 0.0))
(define gg2.shp (list 8 0.8214024 0.4122405 0.40788835 0.0 0.8495575 0.7129002 0.7308959 0.7785335 0.7 -0.4 4.0 0.05 2000.0 0.9 0.0 0.0 0.0))
(define nng.shp (list 8 1.0 1.0 1.0333333 0.0 1.0 0.99999994 0.9568965 1.3189656 0.7 -0.2 1.0 0.0 0.0 0.0 0.0 0.0 1.0))
(define rrr.shp (list 8 0.3365169 0.9244819 1.0542682 0.4485168 1.0597233 0.71856207 0.66896766 0.7274576 0.9 -0.4 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define wsp.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 1.65746 1.62431 0.944751 0.7 -0.45 1.0 0.018518519 0.0 0.97 0.0 0.0 0.0))
(define ggg.shp (list 8 0.8214024 0.7839217 1.0981537 0.0 0.8495575 0.7129002 0.7308959 0.7785335 0.7 -0.4 4.0 0.05 2000.0 0.9 0.0 0.0 0.0))
(define nnn.shp (list 8 1.0 1.0 1.0 1.4579439 1.0 0.0 0.9568965 1.3189656 0.7 -0.2 1.0 0.0 0.0 0.0 0.0 0.0 0.503268))
(define sh2.shp (list 8 0.828729 1.45856 0.9882353 0.662983 0.9352941 1.2529411 0.40588236 0.9882353 0.7 -0.140625 7.0 0.0 2451.5984 0.928097 2957.0518 0.883636 0.0))
(define xx2.shp (list 8 0.928177 1.37569 1.37569 0.8495575 0.3451327 0.646409 0.56896555 0.662983 0.7 -0.403125 5.0 0.022222 2102.0833 0.805556 1735.4166 0.759259 0.0))
(define dd2.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.0 0.72165513 0.5996184 0.7 -0.45 6.0 0.02 4851.6665 0.953704 2500.0 0.966296 0.0))
(define ggg1.shp (list 8 0.8214024 0.7839217 1.0981537 0.18584079 1.061947 1.1907763 1.3149668 1.0705689 0.7 -0.4 4.0 0.4 2000.0 0.9 0.0 0.0 0.0))
(define noisahh.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 1.65746 1.62431 0.944751 0.7 -0.45 1.0 0.005 0.0 0.787037 3777.0835 0.759259 0.0))
(define shh.shp (list 8 0.828729 1.45856 0.9882353 0.662983 0.9352941 1.2529411 0.40588236 0.9882353 0.7 -0.140625 7.0 0.023333 2451.5984 0.9280972 2957.0518 0.88363576 0.0))
(define xxx.shp (list 8 0.928177 1.37569 1.37569 0.3451327 0.6371682 0.646409 0.56896555 0.662983 0.7 -0.403125 4.0 0.022222219 2102.0833 0.8055556 612.5 0.7592593 0.0))
(define ddd.shp (list 8 0.928177 0.779006 0.629834 0.629834 1.02762 0.0 0.72165513 0.5996184 0.7 -0.45 6.0 0.02 4851.6665 0.953704 2500.0 0.966296 0.0))
(define gxx.shp (list 8 0.928177 1.37569 1.37569 0.3451327 0.6371682 0.646409 0.56896555 0.662983 0.7 -0.403125 4.0 0.022222 2102.0833 0.805556 612.5 0.759259 0.0))
(define none.shp (list 8 1.0 1.0 1.0 1.0 1.0 1.0 1.0 1.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0))
(define sss.shp (list 8 0.928177 1.3588235 1.3588235 0.679558 0.61764705 0.63529414 0.31764707 0.65294117 0.7 -0.103125 7.0 0.105292 1500.0 0.916452 4943.75 0.97222227 0.0))
(define zzz.shp (list 8 0.928177 1.3588235 1.3588235 0.679558 0.61764705 0.63529414 0.31764707 0.65294117 0.7 -0.103125 7.0 0.016 1500.0 0.9257112 4943.75 0.925926 0.0))

+ 125
- 0
lib/sndlib/sndinfo.c View File

@@ -0,0 +1,125 @@
/* sndinfo describes sounds */

#include "mus-config.h"

#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#ifndef _MSC_VER
#include <unistd.h>
#endif
#include <string.h>
#include <errno.h>
#include <time.h>

#include "sndlib.h"

static char *display_maxamps(const char *filename, int chans)
{
char *ampstr;
char fstr[16];
int i, len;
mus_float_t *vals;
mus_long_t *times;

len = chans * 32;
ampstr = (char *)calloc(len, sizeof(char));
vals = (mus_float_t *)calloc(chans, sizeof(mus_float_t));
times = (mus_long_t *)calloc(chans, sizeof(mus_long_t));

snprintf(ampstr, len, "\n max amp%s: ", (chans > 1) ? "s" : "");
mus_sound_maxamps(filename, chans, vals, times);
for (i = 0; i < chans; i++)
{
snprintf(fstr, 16, "%.3f ", vals[i]);
strcat(ampstr, fstr);
}
free(vals);
free(times);
return(ampstr);
}

int main(int argc, char *argv[])
{
int chans, srate, ctr;
mus_sample_t samp_type;
mus_header_t type;
mus_long_t samples;
float length = 0.0;
time_t date;
int *loops = NULL;
char *comment, *header_name;
char *samp_type_info = NULL, *samp_type_name, *ampstr = NULL;
char timestr[64];
if (argc == 1) {printf("usage: sndinfo file\n"); exit(0);}
mus_sound_initialize();
for (ctr = 1; ctr < argc; ctr++)
{
if (mus_file_probe(argv[ctr])) /* see if it exists */
{
date = mus_sound_write_date(argv[ctr]);
srate = mus_sound_srate(argv[ctr]);
if (srate == MUS_ERROR)
{
fprintf(stdout, "%s: not a sound file?\n", argv[ctr]);
continue;
}
chans = mus_sound_chans(argv[ctr]);
samples = mus_sound_samples(argv[ctr]);
comment = mus_sound_comment(argv[ctr]);
if ((chans > 0) && (srate > 0))
length = (float)((double)samples / (double)(chans * srate));
loops = mus_sound_loop_info(argv[ctr]);
type = mus_sound_header_type(argv[ctr]);
header_name = (char *)mus_header_type_name(type);
samp_type = mus_sound_sample_type(argv[ctr]);
if (samp_type != MUS_UNKNOWN_SAMPLE)
samp_type_info = (char *)mus_sample_type_name(samp_type);
else
{
int orig_type;
if (samp_type_info == NULL) samp_type_info = (char *)calloc(64, sizeof(char));
orig_type = mus_sound_original_sample_type(argv[ctr]);
samp_type_name = (char *)mus_header_original_sample_type_name(orig_type, type);
if (samp_type_name)
snprintf(samp_type_info, 64, "%d (%s)", orig_type, samp_type_name);
else snprintf(samp_type_info, 64, "%d", orig_type);
}
fprintf(stdout, "%s:\n srate: %d\n chans: %d\n length: %f",
argv[ctr], srate, chans, length);
if (length < 10.0)
{
int samps;
samps = mus_sound_framples(argv[ctr]);
fprintf(stdout, " (%d sample%s)", samps, (samps != 1) ? "s" : "");
}
fprintf(stdout, "\n");
fprintf(stdout, " header type: %s\n sample type: %s\n ",
header_name,
samp_type_info);

strftime(timestr, 64, "%a %d-%b-%Y %H:%M %Z", localtime(&date));
fprintf(stdout, "written: %s", timestr);

if ((chans > 0) && (mus_sound_maxamp_exists(argv[ctr])))
{
ampstr = display_maxamps(argv[ctr], chans);
if (ampstr) fprintf(stdout, "%s", ampstr);
}
fprintf(stdout, "\n");
if (comment) fprintf(stdout, " comment: %s\n", comment);
if (loops)
{
fprintf(stdout, " loop: %d to %d\n", loops[0], loops[1]);
if (loops[2] != 0)
fprintf(stdout, " loop: %d to %d\n", loops[2], loops[3]);
if (loops[0] != 0)
fprintf(stdout, " base: %d, detune: %d\n", loops[4], loops[5]);
}
}
else
fprintf(stderr, "%s: %s\n", argv[ctr], strerror(errno));
if (ctr < argc - 1) fprintf(stdout, "\n");
}
return(0);
}

+ 57
- 0
lib/sndlib/sndins/Makefile.in View File

@@ -0,0 +1,57 @@
# Makefile for libsndins.so

prefix = @prefix@
srcdir = @srcdir@
libdir = $(prefix)/lib
top_builddir = ..
top_srcdir = @top_srcdir@
VPATH = @srcdir@
includedir = @includedir@
SHELL = @SHELL@
mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs

CC = @CC@
DEFS = -DUSE_SND=0 @DEFS@
LDFLAGS = @LDFLAGS@
CFLAGS = @CFLAGS@ -fPIC @XEN_CFLAGS@ @GSL_CFLAGS@
LIBS = @LIBS@ @XEN_LIBS@ @GSL_LIBS@

INSTALL = @INSTALL@
SO_INSTALL = @SO_INSTALL@
SO_LD = @SO_LD@
A_LD = ar
A_LD_FLAGS = cr
LD_FLAGS = @LD_FLAGS@
LDSO_FLAGS = @LDSO_FLAGS@

OBJS = sndins.o $(top_builddir)/sndlib.a
SO_TARGET = libsndins.so
A_TARGET = libsndins.a
LIB_TARGET = sndins.so

.c.o:
$(CC) -c $(DEFS) $(CFLAGS) -I$(top_builddir) -I$(top_srcdir) $<

sndins: $(OBJS)
$(SO_LD) $(LDSO_FLAGS) $(LDFLAGS) -o $(SO_TARGET) $(OBJS) $(LIBS)
$(A_LD) $(A_LD_FLAGS) $(A_TARGET) $(OBJS)
ranlib $(A_TARGET)
cp $(SO_TARGET) $(LIB_TARGET)

install: sndins
$(mkinstalldirs) $(libdir)
$(mkinstalldirs) $(includedir)
$(INSTALL) $(A_TARGET) $(libdir)/$(A_TARGET)
$(SO_INSTALL) $(SO_TARGET) $(libdir)/$(SO_TARGET)

uninstall:
rm -f $(libdir)/$(A_TARGET)
rm -f $(libdir)/$(SO_TARGET)

clean:
rm -f *.so *.a *.o *.core core

distclean: clean
rm -f Makefile *~

# Makefile ends here

+ 403
- 0
lib/sndlib/sndins/README View File

@@ -0,0 +1,403 @@
-*- outline -*-

* Introduction

The C/XEN library `libsndins.so' provides the instrument FM-VIOLIN and
the reverberators JC-REVERB, NREV, and FREEVERB to use them in longer
notelists in Snd/Scheme, Snd/Ruby, or Snd/Forth. They are not so fast
as Lisp's FFI versions, at least not on my machine, but they run much
faster than the Scheme, Ruby, or Forth variants. In addition I have
added the FCOMB example from sndscm.html which is used in freeverb.

The library is based on Bill Schottstaedt's `xen' and `sndlib'
libraries and the Snd editor itself. Thank you for these great music
programs and libraries!

* XEN-Instruments

The following generator and instruments are accessible from Scheme,
Ruby and Forth.

** make-fcomb, fcomb?, and fcomb

These are the examples from sndscm.html.

*** (make-fcomb (:scaler 1.0) (:size 1) (:a0 0.0) (:a1 0.0))
*** make_fcomb(:scaler, 1.0, :size, 1, :a0, 0.0, :a1, 0.0)
*** make-fcomb ( :scaler 1.0 :size 1 :a0 0.0 :a1 0.0 -- gen )

Return a new fcomb generator.

*** (fcomb? gen)
*** fcomb?(gen)
*** fcomb? ( gen -- f )

Test if GEN is an fcomb generator.

*** (fcomb gen (input 0.0))
*** fcomb(gen[, input=0.0])
*** fcomb ( gen input=0.0 -- result )

Return the next value of the fcomb generator GEN.

*** (mus-describe gen)
*** gen.to_s
*** object->string ( gen -- str )

Show the inspect string of the fcomb GEN.

*** (mus-length gen)
*** gen.length
*** mus-length ( gen -- len )

Show length of delay line.

*** (mus-scaler gen) (set! (mus-scaler gen) scl)
*** gen.scaler gen.scaler = scl
*** mus-scaler ( gen -- scl ) set-mus-scaler ( gen scl -- scl )

Show the scaler value, settable.

*** (mus-xcoeff gen index) (set! (mus-xcoeff gen index) val)
*** gen.xcoeff(index) gen.xcoeff = [index, val]
*** mus-xcoeff ( gen index -- val ) set-mus-xcoeff ( gen index val -- val )

Show the a0/a1 values, settable (index == 0: a0, index == 1: a1)

** fm-violin

Keyword options for fm-violin (v.ins, v.scm, examp.rb, clm-ins.fs).

*** :startime 0.0
*** :duration 1.0
*** :frequency 440.0
*** :amplitude 0.5
*** :fm-index 1.0
*** :amp-env '( 0 0 25 1 75 1 100 0 )
*** :periodic-vibrato-rate 5.0
*** :periodic-vibrato-amplitude 0.0025
*** :random-vibrato-rate 16.0
*** :random-vibrato-amplitude 0.005
*** :noise-freq 1000.0
*** :noise-amount 0.0
*** :ind-noise-freq 10.0
*** :ind-noise-amount 0.0
*** :amp-noise-freq 20.0
*** :amp-noise-amount 0.0
*** :gliss-env '( 0 0 100 0 )
*** :glissando-amount 0.0
*** :fm1-env '( 0 1 25 0.4 75 0.6 100 0 )
*** :fm2-env '( 0 1 25 0.4 75 0.6 100 0 )
*** :fm3-env '( 0 1 25 0.4 75 0.6 100 0 )
*** :fm1-rat 1.0
*** :fm2-rat 3.0
*** :fm3-rat 4.0
*** :fm1-index #f
*** :fm2-index #f
*** :fm3-index #f
*** :base 1.0
*** :degree 0.0
*** :distance 1.0
*** :reverb-amount 0.01
*** :index-type 'violin ('cello or 'violin)
*** :no-waveshaping #f

** jc-reverb

Keyword options for jc-reverb (jcrev.ins, jcrev.scm, examp.rb,
clm-ins.fs).

*** :volume 1.0
*** :delay1 0.013
*** :delay2 0.011
*** :delay3 0.015
*** :delay4 0.017
*** :low-pass #f
*** :doubled #f
*** :amp-env #f

If more than one reverb channel exists, the values from them are
collected together before computing the result.

** nrev

Keyword options for nrev (nrev.ins, clm-ins.scm, clm-ins.rb).

*** :reverb-factor 1.09
*** :lp-coeff 0.7
*** :lp-out-coeff 0.85
*** :output-scale 1.0
*** :amp-env '( 0 1 1 1 )
*** :volume 1.0

If more than one reverb channel exists, the values from them are
collected together before computing the result.

** freeverb

Keyword options for freeverb (freeverb.ins, freeverb.scm, freeverb.rb).

*** :room-decay 0.5
*** :damping 0.5
*** :global 0.3
*** :predelay 0.03
*** :output-gain 1.0
*** :output-mixer #f
*** :scale-room-decay 0.28
*** :offset-room-decay 0.7
*** :combtuning '( 1116 1188 1277 1356 1422 1491 1557 1617 )
*** :allpasstuning '( 556 441 341 225 )
*** :scale-damping 0.4
*** :stereo-spread 23.0

Works with one reverb channel or the same number of reverb channels
like output channels.

* C-Instruments

The following functions are accessible from C.

** mus_any *mus_make_fcomb(Float scaler, int size, Float a0, Float a1);
** int mus_fcomb_p(mus_any *ptr);
** Float mus_fcomb(mus_any *ptr, Float input, Float ignored);

** off_t ins_fm_violin(Float start,
Float dur,
Float freq,
Float amp,
Float fm_index,
Float *amp_env,
int amp_len,
Float periodic_vibrato_rate,
Float periodic_vibrato_amp,
Float random_vibrato_rate,
Float random_vibrato_amp,
Float noise_freq,
Float noise_amount,
Float ind_noise_freq,
Float ind_noise_amount,
Float amp_noise_freq,
Float amp_noise_amount,
Float *gliss_env,
int gliss_len,
Float gliss_amount,
Float *fm1_env,
int fm1_len,
Float *fm2_env,
int fm2_len,
Float *fm3_env,
int fm3_len,
Float fm1_rat,
Float fm2_rat,
Float fm3_rat,
Float fm1_index,
Float fm2_index,
Float fm3_index,
Float base,
Float degree,
Float distance,
Float reverb_amount,
bool index_type,
bool no_waveshaping,
mus_any *out,
mus_any *rev,
mus_interp_t mode);

** off_t ins_jc_reverb(Float start,
Float dur,
Float volume,
bool low_pass,
bool doubled,
Float delay1,
Float delay2,
Float delay3,
Float delay4,
Float *amp_env,
int amp_len,
mus_any *out,
mus_any *rev);

** off_t ins_nrev(Float start,
Float dur,
Float reverb_factor,
Float lp_coeff,
Float lp_out_coeff,
Float output_scale,
Float volume,
Float *amp_env,
int amp_len,
mus_any *out,
mus_any *rev);

** off_t ins_freeverb(Float start,
Float dur,
Float room_decay,
Float damping,
Float global,
Float predelay,
Float output_gain,
Float scale_room_decay,
Float offset_room_decay,
Float scale_damping,
Float stereo_spread,
int *combtuning,
int comb_len,
int *allpasstuning,
int all_len,
mus_any *output_mixer,
mus_any *out,
mus_any *rev);

* Prerequisite

Sndins depends on a configured and compiled, but not necessary
installed, libsndlib.a one directory in the hierarchy above sndins.
Configuring sndlib from sndlib.tar.gz creates a Makefile in
sndlib/sndins, sndlib's mus-config.h is needed as well and the
compiled sndlib/libsndlib.a will be linked in
sndlib/sndins/libsndins.*

* Compilation

Running Sndlib's configure script in sndlib path creates
sndins/Makefile from sndins/Makefile.in so we can use the configured
variables from Sndlib. Then one can cd to sndins and run make.
Again: Sndlib must be configured before!

cd sndins
make

* Installation

** Scheme

You can install libsndlib.so and libsndins.so to ${prefix}/lib with
the usual `make install' command. Again: Sndlib must be configured
before!

cd ${compile_sndlib_dir}
make
make install
cd sndins
make
make install

The library path should be in your LD_LIBRARY_PATH, e.g. if you have
installed the library in the unusual path /usr/gnu/lib., you can add
it by:

(csh) setenv LD_LIBRARY_PATH /usr/gnu/lib:${LD_LIBRARY_PATH}

(sh) LD_LIBRARY_PATH=/usr/gnu/lib:${LD_LIBRARY_PATH}; export LD_LIBRARY_PATH

In Snd/Scheme one can add to the ~/.snd init file:

(if (provided? 'snd)
(begin
(if (not (provided? 'sndlib))
(let ((hsndlib (dlopen "sndlib.so")))
(if (string? hsndlib)
(snd-error (format #f "script needs the sndlib module: ~A" hsndlib))
(dlinit hsndlib "Init_sndlib"))))
(if (not (provided? 'sndins))
(let ((hsndins (dlopen "sndins.so")))
(if (string? hsndins)
(snd-error (format #f "script needs the sndins module: ~A" hsndins))
(dlinit hsndins "Init_sndins")))))
(begin
(if (not (provided? 'sndlib)) (load-extension "libsndlib" "Init_sndlib"))
(if (not (provided? 'sndins)) (load-extension "libsndins" "Init_sndins"))))

** Ruby

You can install sndlib.so and sndins.so in the ruby library path, e.g.

(csh) setenv RUBYLIB ${HOME}/share/ruby/site-ruby:${HOME}/share/snd:${HOME}/lib/ruby/site-ruby
(sh) RUBYLIB=${HOME}/share/ruby/site-ruby:${HOME}/share/snd:${HOME}/lib/ruby/site-ruby
(sh) export RUBYLIB
cd ${compile_sndlib_dir}
make
install -c sndlib.so ~/lib/ruby/site-ruby/
cd sndins
make
install -c sndins.so ~/lib/ruby/site-ruby/

So in Snd/Ruby one can add to the ~/.snd(_ruby) init file:

require "sndlib"
require "sndins"

** Forth

Installing so-libs in Forth is possible with these command lines:

(csh) setenv FTH_FTHPATH ${HOME}/share/fth/site-fth
(csh) setenv FTH_LIBPATH ${HOME}/lib/fth
(sh) FTH_FTHPATH=${HOME}/share/fth/site-fth; export FTH_FTHPATH
(sh) FTH_LIBPATH=${HOME}/lib/fth; export FTH_LIBPATH

cd ${compile_sndlib_dir}
make
fth -Qve "install sndlib.so"
cd sndins
make
fth -Qve "install sndins.so"

These lines install the libraries in ~/lib/fth, the first user
writeable path.

Then in Snd/Forth one can add to the ~/.snd(_forth) init file:

dl-load sndlib Init_sndlib
dl-load sndins Init_sndins

* Samples

You can load the sample files into Snd, with Ruby and Forth you can
test them in a shell too. One may set with-sound variables in agn.*
and fmviolin.* files.

The agn.* files are translations of clm/clm-example.clm into Scheme,
Ruby, and Forth as a test case.

The fmviolin.* files are translations of clm/fmviolin.clm into Scheme,
Ruby, and Forth as a test case.

** Scheme

You can load the *.scm scripts into Snd. If you have compiled and
installed the Scheme sndlib and sndins libraries, you can type

(do-agn) ;; agn.scm
(short-example) ;; fmviolin.scm
(long-example) ;; fmviolin.scm

** Ruby

If you have compiled and installed the Ruby sndlib and sndins
libraries, you can type in a shell

./agn.rb [ outfile.rbm ]
./fmviolin.rb [ -s ]

The default outfile is agn.rbm. A different outfile name may end
in *.rbm. The option -s can be everything, its only meaning is to
choose the short_example, without an option long_example is chosen.

You can load these scripts into Snd too.

** Forth

If you have compiled and installed the Forth sndlib and sndins
libraries, you can type

./agn.fth [ outfile.fsm ]
./fmviolin.fth [ -s ]

The default outfile is agn.fsm. A different outfile name should end
in *.fsm. The option -s can be everything, its only meaning is to
choose the short-example, without an option long-example is chosen.

You can load these scripts into Snd too.

* README ends here

+ 150
- 0
lib/sndlib/sndins/samples/agn.fth View File

@@ -0,0 +1,150 @@
#! /usr/bin/env fth
\ agn.fth -- Bill Schottstaedt's agn.cl
\ (see clm-2/clm-example.clm and clm-2/bess5.cl)

\ Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
\ Created: Wed Dec 15 23:30:43 CET 2004
\ Changed: Sat Jul 28 00:00:24 CEST 2012

\ Type do-agn
\ or start the script in a shell.

#t value *clm-c-version*

dl-load sndlib Init_sndlib
*clm-c-version* [if]
dl-load sndins Init_sndins
[else]
require clm-ins
[then]
require clm
require env

*argc* 2 > [if]
*argv* 2 array-ref
[else]
"agn.fsm"
[then] value agn-test-file
60.0 value agn-time

#t to *clm-play*
#t to *clm-statistics*
#t to *clm-verbose*
44100 to *clm-srate*
2 to *clm-channels*
<'> jc-reverb to *clm-reverb*
'( :volume 0.8 ) to *clm-reverb-data*
2 to *clm-reverb-channels*
#t to *clm-delete-reverb*

: rbell ( x -- r ) 100 f* '( 0 0 10 0.25 90 1 100 1 ) 1.0 envelope-interp ;
: tune ( x -- r )
{ x }
#( 1 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2 )
x 12.0 fmod f>s array-ref
2.0 x 12.0 f/ floor f**
f*
;

#( 0 0 2 4 11 11 5 6 7 9 2 0 0 ) constant agn-mode
256 constant agn-lim

#f value agn-octs
#f value agn-pits
#f value agn-rhys
#f value agn-amps
#f value agn-begs

: agn-init ( -- )
agn-lim make-array map!
1.0 random rbell f2* 4.0 f+ floor
end-map to agn-octs
agn-lim make-array map!
agn-mode 1.0 random 12.0 f* floor f>s array-ref
end-map to agn-pits
agn-lim make-array map!
1.0 random 6.0 f* 4.0 f+
end-map to agn-rhys
agn-lim make-array map!
1.0 random rbell 8.0 f* 1.0 f+
end-map to agn-amps
agn-lim make-array map!
1.0 random 0.9 f< if 1.0 random f2* 4.0 f+ else 4.0 random 6.0 f* then
end-map to agn-begs
;

: agn ( fname -- )
( fname ) io-open-write { io }
io "\\ from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)\n" io-write
io "\\\n" io-write
io "%s\n" '( make-default-comment ) io-write-format
#( '( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
'( 0 0 60 0.1 80 0.2 90 0.4 95 1 100 0 )
'( 0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0 )
'( 0 0 30 1 56 0 60 0 90 0.3 100 0 )
'( 0 0 50 1 80 0.3 100 0 )
'( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
'( 0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0 )
'( 0 0 10 1 32 0.1 50 1 90 0.3 100 0 )
'( 0 0 60 0.1 80 0.3 95 1 100 0 )
'( 0 0 80 0.1 90 1 100 0 ) ) { wins }
agn-init
4 1 do
0 4 0 { cellbeg cellsiz cellctr }
1 i s>f i 1- s>f 0.2 { whichway base mi mytempo }
0.0 0.0 { nextbeg beg }
begin
beg agn-time f< cellctr agn-lim < and
while
beg nextbeg f+ to beg
0.25 mytempo 1.0 random 0.2 f* 0.9 f+ f* agn-rhys
cellctr array-ref f* fmax to nextbeg
16.352 2.0 mi f** f/ agn-pits cellctr array-ref tune f*
2.0 agn-octs cellctr array-ref f** f* { freq }
freq 100.0 f< if nextbeg f2* else nextbeg then { dur }
0.003 agn-amps cellctr array-ref 60.0 base f* 1/f f* fmax { amp }
1.0 random 2.0 f* base f* { ind }
base 0.1 f* { revamt }
10.0 beg beg floor f- f* floor f>s { winnum }
0.00001 freq 2.0 flogn 4.0 f- 4.0 f** f* { ranamt }
io
"
%f %f %f %f :fm-index %f
:amp-env %S
:reverb-amount %f :noise-amount %f fm-violin"
'( beg dur freq amp ind wins winnum array-ref revamt ranamt )
io-write-format
cellctr 1+ to cellctr
cellctr cellsiz cellbeg + > if
cellbeg 1+ to cellbeg
1.0 random 0.5 f> if cellsiz whichway + to cellsiz then
cellsiz 16 > 1.0 random 0.99 f> and if
-2 to whichway
else
cellsiz 12 > 1.0 random 0.999 f> and if
-1 to whichway
else
cellsiz 4 < if
1 to whichway
then
then
then
cellbeg 3 + to cellbeg
cellbeg to cellctr
then
repeat
loop
io "\n\n\\ %s ends here\n" '( agn-test-file ) io-write-format
io io-close
;

: do-agn ( -- )
agn-test-file undef file-basename ".snd" $+ { sndfile }
"\\ writing \"%s\"\n" '( agn-test-file ) fth-print
agn-test-file agn
:output sndfile agn-test-file clm-load
;

'snd provided? [unless] do-agn [then]

\ agn.fth ends here

+ 137
- 0
lib/sndlib/sndins/samples/agn.rb View File

@@ -0,0 +1,137 @@
#!/usr/bin/env ruby
# agn.rb -- Bill Schottstaedt's agn.cl
# (see clm-2/clm-example.clm and clm-2/bess5.cl)

# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: Sat May 24 20:35:03 CEST 2003
# Changed: Sat Jul 28 00:37:44 CEST 2012

# Type do_agn
# or start the script in a shell.

$clm_c_version = true

require "sndlib"
if $clm_c_version
require "sndins"
else
require "v" # fm_violin_rb, jc_reverb_rb
require "clm-ins" # nrev_rb
class Instrument
alias fm_violin fm_violin_rb
alias jc_reverb jc_reverb_rb
alias nrev nrev_rb
end
end
require "clm"
require "ws"
require "env"

$clm_play = true
$clm_statistics = true
$clm_verbose = true
$clm_srate = 44100
$clm_channels = 2
$clm_reverb = :jc_reverb
$clm_reverb_data = [:volume, 0.8]
$clm_reverb_channels = 2
$clm_delete_reverb = true

class Agn
include Math
include Env
Limit = 256
Time = 60
def initialize
mode = [0, 0, 2, 4, 11, 11, 5, 6, 7, 0, 0, 0, 0]
@octs = make_array(Limit) do |i| (4 + 2 * rbell(random(1.0))).floor end
@pits = make_array(Limit) do |i| mode[(12 * random(1.0)).floor] end
@rhys = make_array(Limit) do |i| (4 + 6 * random(1.0)).floor end
@amps = make_array(Limit) do |i| (1 + 8 * rbell(random(1.0))).floor end
end
def tune(x)
[1.0, 256.0 / 243, 9.0 / 8, 32.0 / 27, 81.0 / 64,
4.0 / 3, 1024.0 / 729, 3.0 / 2, 128.0 / 81, 27.0 / 16,
16.0 / 9, 243.0 / 128, 2.0].at(x % 12) * 2 ** x.divmod(12).first
end

def rbell(x)
envelope_interp(x * 100, [0, 0, 10, 0.25, 90, 1.0, 100, 1.0])
end

def agn(file)
File.open(file, "w") do |f|
f << "# from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)\n"
f << "#\n"
f << make_default_comment() << "\n\n"
wins = [[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 60, 0.1, 80, 0.2, 90, 0.4, 95, 1, 100, 0],
[0, 0, 10, 1, 16, 0, 32, 0.1, 50, 1, 56, 0, 60, 0, 90, 0.3,100,0],
[0, 0, 30, 1, 56, 0, 60, 0, 90, 0.3, 100, 0],
[0, 0, 50, 1, 80, 0.3, 100, 0],
[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 40, 0.1, 60, 0.2, 75, 0.4, 82, 1, 90, 1, 100, 0],
[0, 0, 10, 1, 32, 0.1, 50, 1, 90, 0.3, 100, 0],
[0, 0, 60, 0.1, 80, 0.3, 95, 1, 100, 0],
[0, 0, 80, 0.1, 90, 1, 100, 0]]
(1..3).each do |i|
cellbeg, cellsiz, cellctr = 0, 4, 0
whichway, base, mi, winnum, mytempo = 1, i, i - 1, 0, 0.2
nextbeg = revamt = ranamt = beg = dur = freq = ampl = ind = 0.0
while beg < Time and cellctr < Limit
beg += nextbeg
nextbeg = dur = [0.25,
mytempo * (0.9 + 0.2 * random(1.0)) * @rhys[cellctr]].max
freq = (16.352 / 2 ** mi) * tune(@pits[cellctr]) * 2 ** @octs[cellctr]
dur += dur if freq < 100
ampl = [0.003, @amps[cellctr] * (1.0 / (60 * base))].max
ind = random(1.0) * 2 * base
revamt = base * 0.1
winnum = (10 * (beg - beg.floor)).floor
ranamt = 0.00001 * (logn(freq, 2.0) - 4) ** 4
f << format("\
fm_violin(%f, %f, %f, %f, :fm_index, %f,
:amp_env, %s,
:reverb_amount, %f, :noise_amount, %f)\n",
beg, dur, freq, ampl, ind,
wins[winnum].inspect, revamt, ranamt)
cellctr += 1
if cellctr > (cellsiz + cellbeg)
cellbeg += 1
if random(1.0) > 0.5
cellsiz += whichway
end
if cellsiz > 16 and random(1.0) > 0.99
whichway = -2
if cellsiz > 12 and random(1.0) > 0.999
whichway = -1
if cellsiz < 4
whichway = 1
end
end
end
cellbeg += 3
cellctr = cellbeg
end
end
end
f << "\n# " + file + " ends here\n"
end
file
end
end

def do_agn(file = "agn.rbm")
sndfile = File.basename(file, ".*") + ".snd"
message("Writing %s", file.inspect)
Agn.new.agn(file)
clm_load(file, :clm, true, :output, sndfile)
end

unless provided?(:snd)
do_agn((ARGV[0] or "agn.rbm"))
end

# agn.rb ends here

+ 166
- 0
lib/sndlib/sndins/samples/agn.scm View File

@@ -0,0 +1,166 @@
;;; agn.scm -- Bill Schottstaedt's agn.cl
;;; (see clm-2/clm-example.clm and clm-2/bess5.cl)

;; Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
;; Created: Tue Jun 24 19:05:06 CEST 2003
;; Changed: Sat Jul 28 00:33:36 CEST 2012

;; Try (do-agn)

(define *clm-c-version* #t)

(if (not (provided? 'sndlib))
(let ((hsndlib (dlopen "libsndlib.so")))
(if (string? hsndlib)
(snd-error (format #f "script needs the sndlib module: ~A" hsndlib))
(dlinit hsndlib "Init_sndlib"))))
(if *clm-c-version*
(if (not (provided? 'sndins))
(let ((hsndins (dlopen "libsndins.so")))
(if (string? hsndins)
(snd-error (format #f "script needs the sndins module: ~A" hsndins))
(dlinit hsndins "Init_sndins"))))
(load "v.scm"))

(if (not (provided? 'snd-ws.scm)) (load "ws.scm"))
(if (not (provided? 'snd-env.scm)) (load "env.scm"))

(define *clm-play* #t)
(define *clm-statistics* #t)
(define *clm-verbose* #t)
(define *clm-srate* 44100)
(define *clm-channels* 2)
(define *clm-reverb* jc-reverb)
(define *clm-reverb-data* '(:volume 0.8))
(define *clm-reverb-channels* 2)
(define *clm-delete-reverb* #t)

(define (snd-msg frm . args)
(snd-print (apply format (append (list #f frm) args))))

(define (main args)
(do-agn (if (= 2 (length args)) (cadr args) "agn.clm")))

(define* (do-agn (file "agn.clm"))
(let ((sndfile (format #f "~A.snd" "agn")))
(snd-msg ";; Writing ~S~%" file)
(agn file)
(with-sound (:output sndfile)
(snd-msg ";; Loading ~S~%" file)
(load file))))

(define lim 256)
(define time 60)
(define mode (list->vector '(0 0 2 4 11 11 5 6 7 0 0 0 0)))
(define rats (list->vector '(1.0 256/243 9/8 32/27 81/64 4/3 1024/729
3/2 128/81 27/16 16/9 243/128 2.0)))

(define bell '(0 0 10 0.25 90 1.0 100 1.0))

(define octs (make-vector (1+ lim)))
(define pits (make-vector (1+ lim)))
(define rhys (make-vector (1+ lim)))
(define amps (make-vector (1+ lim)))

(define (tune x)
(let* ((pit (modulo x 12))
(oct (inexact->exact (floor (/ x 12))))
(base (vector-ref rats pit)))
(* base (expt 2 oct))))

(define (rbell x)
(envelope-interp (* x 100) bell))

(define* (glog r b)
(if (<= r 0) (error "r must be > 0"))
(if (and b (<= b 0)) (error "b must be > 0"))
(if b (/ (log r) (log b)) (log r)))

(define (agn file)
(let ((wins (list->vector '((0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
(0 0 60 0.1 80 0.2 90 0.4 95 1 100 0)
(0 0 10 1 16 0 32 0.1 50 1 56 0 60 0 90 0.3 100 0)
(0 0 30 1 56 0 60 0 90 0.3 100 0)
(0 0 50 1 80 0.3 100 0)
(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
(0 0 40 0.1 60 0.2 75 0.4 82 1 90 1 100 0)
(0 0 10 1 32 0.1 50 1 90 0.3 100 0)
(0 0 60 0.1 80 0.3 95 1 100 0)
(0 0 80 0.1 90 1 100 0)))))
(do ((i 0 (1+ i)))
((= i (+ lim 1)))
(vector-set! octs i
(inexact->exact (floor (+ 4 (* 2 (rbell (random 1.0)))))))
(vector-set! pits i
(vector-ref mode (inexact->exact (floor (* 12 (random 1.0))))))
(vector-set! rhys i
(inexact->exact (floor (+ 4 (* 6 (random 1.0))))))
(vector-set! amps i
(inexact->exact (floor (+ 1 (* 8 (rbell (random 1.0))))))))
(call-with-output-file file
(lambda (out-port)
(format out-port
";; from agn.cl (see clm-2/clm-example.clm and clm-2/bess5.cl)~%")
(do ((i 1 (1+ i)))
((> i 3))
(let ((cellbeg 0)
(cellsiz 4)
(cellctr 0)
(whichway 1)
(base i)
(mi (- i 1))
(winnum 0)
(mytempo 0.2)
(nextbeg 0.0)
(revamt 0.0)
(ranamt 0.0)
(beg 0.0)
(dur 0.0)
(freq 0.0)
(ampl 0.0)
(ind 0.0))
(while (and (< beg time) (< cellctr lim))
(set! beg (+ beg nextbeg))
(set! nextbeg (max 0.25
(* mytempo (+ 0.9 (* 0.2 (random 0.1)))
(vector-ref rhys cellctr))))
(set! freq (* (/ 16.352 (expt 2 mi))
(tune (vector-ref pits cellctr))
(expt 2 (vector-ref octs cellctr))))
(set! dur nextbeg)
(if (< freq 100) (set! dur (+ dur dur)))
(set! ampl (max 0.003
(* (vector-ref amps cellctr) (/ (* 60 base)))))
(set! ind (* (random 1.0) 2 base))
(set! cellctr (1+ cellctr))
(set! revamt (* base 0.1))
(set! winnum (inexact->exact
(floor (* 10 (- beg (floor beg))))))
(set! ranamt (* 0.00001 (expt (- (glog freq 2.0) 4) 4)))
(format out-port
"
(fm-violin ~F ~F ~F ~F :fm-index ~F
:amp-env '~S
:reverb-amount ~F :noise-amount ~F)"
beg dur freq ampl ind
(vector-ref wins winnum) revamt ranamt)
(set! cellctr (1+ cellctr))
(if (> cellctr (+ cellsiz cellbeg))
(begin
(set! cellbeg (1+ cellbeg))
(if (> (random 1.0) 0.5)
(set! cellsiz (+ cellsiz whichway)))
(if (and (> cellsiz 16) (> (random 1.0) 0.99))
(begin
(set! whichway -2)
(if (and (> cellsiz 12) (> (random 1.0) 0.999))
(begin
(set! whichway -1)
(if (< cellsiz 4)
(set! whichway 1))))))
(set! cellbeg (+ cellbeg 3))
(set! cellctr cellbeg))))))
(format out-port "~%~%;; ~A ends here~%" file))))
file)

;; agn.scm ends here

+ 1788
- 0
lib/sndlib/sndins/samples/fmviolin.fth
File diff suppressed because it is too large
View File


+ 1753
- 0
lib/sndlib/sndins/samples/fmviolin.rb
File diff suppressed because it is too large
View File


+ 1978
- 0
lib/sndlib/sndins/samples/fmviolin.scm
File diff suppressed because it is too large
View File


+ 2371
- 0
lib/sndlib/sndins/sndins.c
File diff suppressed because it is too large
View File


+ 97
- 0
lib/sndlib/sndins/sndins.h View File

@@ -0,0 +1,97 @@
/* sndins.h -- Sndins for Snd/CLM
*
* Copyright (c) 2003-2012 Michael Scholz <mi-scholz@users.sourceforge.net>
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/

#ifndef _SNDINS_H_
#define _SNDINS_H_

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
#define __BEGIN_DECLS extern "C" {
#define __END_DECLS }
#else
#define __BEGIN_DECLS
#define __END_DECLS
#endif

__BEGIN_DECLS

mus_any *mus_make_fcomb(mus_float_t scaler, int size,
mus_float_t a0, mus_float_t a1);
int mus_fcomb_p(mus_any *ptr);
mus_float_t mus_fcomb(mus_any *ptr, mus_float_t input, mus_float_t ignored);

mus_long_t ins_fm_violin(mus_float_t start, mus_float_t dur,
mus_float_t freq, mus_float_t amp, mus_float_t fm_index,
mus_float_t *amp_env, int amp_len,
mus_float_t periodic_vibrato_rate,
mus_float_t periodic_vibrato_amp,
mus_float_t random_vibrato_rate,
mus_float_t random_vibrato_amp, mus_float_t noise_freq,
mus_float_t noise_amount, mus_float_t ind_noise_freq,
mus_float_t ind_noise_amount, mus_float_t amp_noise_freq,
mus_float_t amp_noise_amount, mus_float_t *gliss_env,
int gliss_len, mus_float_t gliss_amount,
mus_float_t *fm1_env, int fm1_len,
mus_float_t *fm2_env, int fm2_len,
mus_float_t *fm3_env, int fm3_len,
mus_float_t fm1_rat, mus_float_t fm2_rat,
mus_float_t fm3_rat, mus_float_t fm1_index,
mus_float_t fm2_index, mus_float_t fm3_index,
mus_float_t base, mus_float_t degree,
mus_float_t distance, mus_float_t reverb_amount,
bool index_type, bool no_waveshaping, mus_any *out,
mus_any *rev, mus_interp_t mode);
mus_long_t ins_jc_reverb(mus_float_t start, mus_float_t dur,
mus_float_t volume, bool low_pass, bool doubled,
mus_float_t delay1, mus_float_t delay2,
mus_float_t delay3, mus_float_t delay4,
mus_float_t *amp_env, int amp_len,
mus_any *out, mus_any *rev);
mus_long_t ins_nrev(mus_float_t start, mus_float_t dur,
mus_float_t reverb_factor, mus_float_t lp_coeff,
mus_float_t lp_out_coeff, mus_float_t output_scale,
mus_float_t volume, mus_float_t *amp_env, int amp_len,
mus_any *out, mus_any *rev);
mus_long_t ins_freeverb(mus_float_t start, mus_float_t dur,
mus_float_t room_decay, mus_float_t damping,
mus_float_t global, mus_float_t predelay,
mus_float_t output_gain, mus_float_t scale_room_decay,
mus_float_t offset_room_decay, mus_float_t scale_damping,
mus_float_t stereo_spread, int *combtuning, int comb_len,
int *allpasstuning, int all_len, mus_any *output_mixer,
mus_any *out, mus_any *rev);

void Init_sndins(void);

__END_DECLS

#endif /* _SNDINS_H_ */

/*
* sndins.h ends here
*/

+ 84
- 0
lib/sndlib/sndlib-config.in View File

@@ -0,0 +1,84 @@
#! /bin/sh

# borrowed from gsl-config.in

prefix=@prefix@
exec_prefix=@exec_prefix@
includedir=@includedir@

usage()
{
cat <<EOF
Usage: sndlib-config [OPTION]

Known values for OPTION are:

--prefix show Sndlib installation prefix
--libs print library linking information
--cflags print pre-processor and compiler flags
--help display this help and exit
--version output version information
--language extension language info
--audio audio library choice

EOF

exit $1
}

if test $# -eq 0; then
usage 1
fi

cflags=false
libs=false

while test $# -gt 0; do
case "$1" in
-*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
*) optarg= ;;
esac

case "$1" in
--prefix=*)
prefix=$optarg
;;

--prefix)
echo $prefix
;;

--version)
echo @SNDLIB_VERSION@
exit 0
;;

--help)
usage 0
;;

--cflags)
echo @CFLAGS@ @GSL_CFLAGS@ @XEN_CFLAGS@ @JACK_FLAGS@
;;

--libs)
echo @LIBS@ @GSL_LIBS@ @AUDIO_LIB@ @XEN_LIBS@ @JACK_LIBS@ -lm
;;

--language)
echo @SNDLIB_LANGUAGE@
;;

--audio)
echo @AUDIO_CHOICE@
;;

*)
usage
exit 1
;;
esac
shift
done

exit 0

+ 87
- 0
lib/sndlib/sndlib-strings.h View File

@@ -0,0 +1,87 @@
#ifndef SNDLIB_STRINGS_H
#define SNDLIB_STRINGS_H

#define S_array_to_file "array->file"
#define S_file_to_array "file->array"
#define S_mus_aifc "mus-aifc"
#define S_mus_aiff "mus-aiff"
#define S_mus_alaw "mus-alaw"
#define S_mus_alsa_buffer_size "mus-alsa-buffer-size"
#define S_mus_alsa_buffers "mus-alsa-buffers"
#define S_mus_alsa_capture_device "mus-alsa-capture-device"
#define S_mus_alsa_device "mus-alsa-device"
#define S_mus_alsa_playback_device "mus-alsa-playback-device"
#define S_mus_alsa_squelch_warning "mus-alsa-squelch-warning"
#define S_mus_b24int "mus-b24int"
#define S_mus_bdouble "mus-bdouble"
#define S_mus_bdouble_unscaled "mus-bdouble-unscaled"
#define S_mus_bfloat "mus-bfloat"
#define S_mus_bfloat_unscaled "mus-bfloat-unscaled"
#define S_mus_bicsf "mus-bicsf"
#define S_mus_bint "mus-bint"
#define S_mus_bintn "mus-bintn"
#define S_mus_bshort "mus-bshort"
#define S_mus_byte "mus-byte"
#define S_mus_bytes_per_sample "mus-bytes-per-sample"
#define S_mus_caff "mus-caff"
#define S_mus_clipping "mus-clipping"
#define S_mus_sample_type_name "mus-sample-type-name"
#define S_mus_sample_type_to_string "mus-sample-type->string"
#define S_mus_error_type_to_string "mus-error-type->string"
#define S_mus_expand_filename "mus-expand-filename"
#define S_mus_file_clipping "mus-file-clipping"
#define S_mus_header_raw_defaults "mus-header-raw-defaults"
#define S_mus_header_type_name "mus-header-type-name"
#define S_mus_header_type_to_string "mus-header-type->string"
#define S_mus_header_writable "mus-header-writable"
#define S_mus_ircam "mus-ircam"
#define S_mus_l24int "mus-l24int"
#define S_mus_ldouble "mus-ldouble"
#define S_mus_ldouble_unscaled "mus-ldouble-unscaled"
#define S_mus_lfloat "mus-lfloat"
#define S_mus_lfloat_unscaled "mus-lfloat-unscaled"
#define S_mus_lint "mus-lint"
#define S_mus_lintn "mus-lintn"
#define S_mus_lshort "mus-lshort"
#define S_mus_max_malloc "mus-max-malloc"
#define S_mus_max_table_size "mus-max-table-size"
#define S_mus_mulaw "mus-mulaw"
#define S_mus_next "mus-next"
#define S_mus_nist "mus-nist"
#define S_mus_oss_set_buffers "mus-oss-set-buffers"
#define S_mus_out_format "mus-out-format"
#define S_mus_raw "mus-raw"
#define S_mus_rf64 "mus-rf64"
#define S_mus_riff "mus-riff"
#define S_mus_sound_chans "mus-sound-chans"
#define S_mus_sound_comment "mus-sound-comment"
#define S_mus_sound_sample_type "mus-sound-sample-type"
#define S_mus_sound_data_location "mus-sound-data-location"
#define S_mus_sound_datum_size "mus-sound-datum-size"
#define S_mus_sound_duration "mus-sound-duration"
#define S_mus_sound_forget "mus-sound-forget"
#define S_mus_sound_framples "mus-sound-framples"
#define S_mus_sound_header_type "mus-sound-header-type"
#define S_mus_sound_length "mus-sound-length"
#define S_mus_sound_loop_info "mus-sound-loop-info"
#define S_mus_sound_mark_info "mus-sound-mark-info"
#define S_mus_sound_maxamp "mus-sound-maxamp"
#define S_mus_sound_maxamp_exists "mus-sound-maxamp-exists?"
#define S_mus_sound_path "mus-sound-path"
#define S_mus_sound_prune "mus-sound-prune"
#define S_mus_sound_report_cache "mus-sound-report-cache"
#define S_mus_sound_samples "mus-sound-samples"
#define S_mus_sound_srate "mus-sound-srate"
#define S_mus_sound_type_specifier "mus-sound-type-specifier"
#define S_mus_sound_write_date "mus-sound-write-date"
#define S_mus_soundfont "mus-soundfont"
#define S_mus_svx "mus-svx"
#define S_mus_ubshort "mus-ubshort"
#define S_mus_ubyte "mus-ubyte"
#define S_mus_ulshort "mus-ulshort"
#define S_mus_unknown_header "mus-unknown-header"
#define S_mus_unknown_sample "mus-unknown-sample"
#define S_mus_voc "mus-voc"
#define S_new_sound_hook "new-sound-hook"

#endif

+ 548
- 0
lib/sndlib/sndlib-ws.scm View File

@@ -0,0 +1,548 @@
;;; with-sound for a sndlib-only context (no Snd editor)

(provide 'sndlib-ws.scm)

(set! *clm-srate* 44100)

(define *clm-file-name* "test.snd")
(define *clm-channels* 1)
(define *clm-sample-type* mus-lfloat)
(define *clm-header-type* mus-next)
(define *clm-verbose* #f)
(define *clm-play* #f)
(define *clm-statistics* #f)
(define *clm-reverb* #f)
(define *clm-reverb-channels* 1)
(define *clm-reverb-data* ())
(define *clm-locsig-type* mus-interp-linear)
(define *clm-clipped* #t)
(define *clm-array-print-length* 12)
(define *clm-player* #f)
(define *clm-notehook* #f)
(define *clm-with-sound-depth* 0) ; for CM, not otherwise used
(define *clm-delete-reverb* #f) ; should with-sound clean up reverb stream

(set! *clm-file-buffer-size* 65536)

(define (times->samples beg dur)
"(times->samples beg dur) converts beg and (+ beg dur) to samples, returning both in a list"
(list (seconds->samples beg) (seconds->samples (+ beg dur))))


;;; -------- definstrument --------

;(define definstrument define*) -- old form 2-Nov-05

(define *definstrument-hook* #f) ; for CM

(define-macro (definstrument args . body)
(let* ((name (car args))
(targs (cdr args))
(utargs (let ((arg-names ()))
(for-each
(lambda (a)
(if (not (keyword? a))
(if (symbol? a)
(set! arg-names (cons a arg-names))
(set! arg-names (cons (car a) arg-names)))))
targs)
(reverse arg-names))))
`(begin
(define* (,name ,@targs)
(if *clm-notehook*
(*clm-notehook* (symbol->string ',name) ,@utargs))
,@body)
,@(if *definstrument-hook*
(list (*definstrument-hook* name targs))
(list)))))



;;; -------- with-sound --------

(define* (with-sound-helper thunk
(output *clm-file-name*)
(channels *clm-channels*)
(srate *clm-srate*)
(sample-type *clm-sample-type*)
(header-type *clm-header-type*)
(comment #f)
(verbose *clm-verbose*)
(reverb *clm-reverb*)
(revfile "test.rev")
(reverb-data *clm-reverb-data*)
(reverb-channels *clm-reverb-channels*)
(continue-old-file #f)
(statistics *clm-statistics*)
(scaled-to #f)
(scaled-by #f)
(play *clm-play*)
(clipped 'unset)
(notehook *clm-notehook*) ; (with-sound (:notehook (lambda args (display args))) (fm-violin 0 1 440 .1))
(ignore-output #f))
"with-sound-helper is the business portion of the with-sound macro"
(let* ((old-srate *clm-srate*)
(old-*output* *output*)
(old-*reverb* *reverb*)
(old-notehook *clm-notehook*)
(old-verbose *clm-verbose*)
(output-to-file (string? output))
(output-1 (if (and output-to-file
(or scaled-to scaled-by))
(string-append output ".temp")
output)) ; protect during nesting
(reverb-1 revfile)
(reverb-to-file (and reverb (string? revfile))))

(if ignore-output
(begin
(set! output-1 *clm-file-name*)
(set! output-to-file (string? output-1))))

(dynamic-wind

(lambda ()
(set! *clm-verbose* verbose)
(set! *clm-notehook* notehook)
(set! (locsig-type) *clm-locsig-type*)
(set! (mus-array-print-length) *clm-array-print-length*)
(if (equal? clipped 'unset)
(if (and (or scaled-by scaled-to)
(member sample-type (list mus-bfloat mus-lfloat mus-bdouble mus-ldouble)))
(set! (mus-clipping) #f)
(set! (mus-clipping) *clm-clipped*))
(set! (mus-clipping) clipped))
(set! *clm-srate* srate))

(lambda ()
(if output-to-file
(begin
(if continue-old-file
(begin
(set! *output* (continue-sample->file output-1))
(set! *clm-srate* (mus-sound-srate output-1)))
(begin
(if (file-exists? output-1)
(delete-file output-1))
(set! *output* (make-sample->file output-1 channels sample-type header-type comment)))))
(begin
(if (and (not continue-old-file)
(vector? output-1))
(fill! output-1 0.0))
(set! *output* output-1)))
(if reverb
(if reverb-to-file
(begin
(if continue-old-file
(set! *reverb* (continue-sample->file reverb-1))
(begin
(if (file-exists? reverb-1)
(delete-file reverb-1))
(set! *reverb* (make-sample->file reverb-1 reverb-channels sample-type header-type)))))
(begin
(if (and (not continue-old-file)
(vector? reverb-1))
(fill! reverb-1 0.0))
(set! *reverb* reverb-1))))

(let ((start (if statistics (get-internal-real-time)))
(flush-reverb #f)
(cycles 0)
(revmax #f))

(catch 'mus-error
thunk
(lambda args
(format () ";~%with-sound mus-error: ~{~A~^ ~}~%" (cdr args))
(set! flush-reverb #t)))
(if (and reverb
(not flush-reverb)) ; i.e. not interrupted by error and trying to jump out
(begin
(if reverb-to-file
(mus-close *reverb*))
(if statistics
(if reverb-to-file
(set! revmax (cadr (mus-sound-maxamp reverb-1)))
(if (float-vector? reverb-1)
(set! revmax (float-vector-peak reverb-1)))))
(if reverb-to-file
(set! *reverb* (make-file->sample reverb-1)))
(apply reverb reverb-data) ; here is the reverb call(!)
(if reverb-to-file
(mus-close *reverb*))
))

(if output-to-file
(mus-close *output*))

(if statistics
(begin
(set! cycles (- (get-internal-real-time) start))
(format () "~%;~A:~% maxamp~A:~{ ~,4F~}~%~A compute time: ~,3F~%"
(if output-to-file
(if (or scaled-to scaled-by)
(substring output-1 0 (- (length output-1) 5))
output-1)
(if (vector? output-1) "vector" "flush"))
(if (or scaled-to scaled-by)
" (before scaling)"
"")
(if output-to-file
(let ((lst (mus-sound-maxamp output-1)))
(do ((i 0 (+ i 2)))
((>= i (length lst)))
(list-set! lst i (/ (list-ref lst i) *clm-srate*)))
lst)
(if (float-vector? output-1)
(list (float-vector-peak output-1))
'(0.0)))
(if revmax (format #f " rev max: ~,4F~%" revmax) "")
cycles)))

(if (or scaled-to scaled-by)
(if output-to-file
(let ((scaling
(or scaled-by
(let* ((mx-lst (mus-sound-maxamp output-1))
(mx (if (not (null? mx-lst)) (cadr mx-lst) 1.0)))
(do ((i 1 (+ i 2)))
((>= i (length mx-lst)) (/ scaled-to mx))
(set! mx (max mx (list-ref mx-lst i)))))))
(out-file (substring output-1 0 (- (length output-1) 5))))
(let ((g (make-sample->file out-file channels sample-type header-type #f)))
(mus-close g))
(mus-file-mix out-file output-1 0 (mus-sound-framples output-1) 0
(let ((mx (make-float-vector (list channels channels) 0.0)))
(do ((i 0 (+ i 1)))
((= i channels) mx)
(set! (mx i i) scaling))))
(delete-file output-1)
(set! output-1 (substring output-1 0 (- (length output-1) 5))))

(if (float-vector? output-1)
(if scaled-to
(let ((pk (float-vector-peak output-1)))
(if (> pk 0.0)
(float-vector-scale! output-1 (/ scaled-to pk))))
(float-vector-scale! output-1 scaled-by)))))

(if (and *clm-player* play output-to-file)
(*clm-player* output-1)))

output-1)

(lambda ()
(set! *clm-verbose* old-verbose)
(set! *clm-notehook* old-notehook)
(if *reverb*
(begin
(mus-close *reverb*)
(set! *reverb* old-*reverb*)))
(if *output*
(begin
(if (mus-output? *output*)
(mus-close *output*))
(set! *output* old-*output*)))
(set! *clm-srate* old-srate)))))


(define-macro (with-sound args . body)
`(with-sound-helper (lambda () ,@body) ,@args))



;;; -------- with-temp-sound --------

(define-macro (with-temp-sound args . body)
`(let ((old-file-name *clm-file-name*))
;; with-sound but using tempnam for output (can be over-ridden by explicit :output)
(dynamic-wind
(lambda ()
(set! *clm-file-name* (tmpnam)))
(lambda ()
(with-sound-helper (lambda () ,@body) ,@args)) ; dynamic-wind returns this as its result
(lambda ()
(set! *clm-file-name* old-file-name)))))


;;; -------- clm-load --------

(define (clm-load file . args)
"(clm-load file . args) loads 'file' in the context of with-sound"
(apply with-sound-helper (lambda () (load file)) args))



;;; -------- sound-let --------
;;;
;;; (with-sound () (sound-let ((a () (fm-violin 0 .1 440 .1))) (mus-file-mix "test.snd" a)))

(define-macro (sound-let snds . body)
`(let ((temp-files ()))
(begin
(let ((val (let ,(map (lambda (arg)
(if (> (length arg) 2)
`(,(car arg) (with-temp-sound ,(cadr arg) ,@(cddr arg)))
arg))
snds)
,@body))) ; sound-let body
(for-each (lambda (file) ; clean up all local temps
(if (and (string? file) ; is it a file?
(file-exists? file))
(delete-file file)))
temp-files)
val)))) ; return body result



;;; -------- Common Music --------

(define* (init-with-sound
(srate *clm-srate*)
(output *clm-file-name*)
(channels *clm-channels*)
(header-type *clm-header-type*)
data-format
(sample-type *clm-sample-type*)
(comment #f)
;(verbose *clm-verbose*) ; why is this commented out?
(reverb *clm-reverb*)
(revfile "test.rev")
(reverb-data *clm-reverb-data*)
(reverb-channels *clm-reverb-channels*)
(continue-old-file #f)
(statistics *clm-statistics*)
(scaled-to #f)
(play *clm-play*)
(scaled-by #f))
"(init-with-sound . args) is the first half of with-sound; it sets up the CLM output choices, reverb, etc. Use \
finish-with-sound to complete the process."
(let ((old-srate *clm-srate*)
(start (if statistics (get-internal-real-time)))
(output-to-file (string? output))
(reverb-to-file (and reverb (string? revfile))))
(set! *clm-srate* srate)
(if output-to-file
(if continue-old-file
(begin
(set! *output* (continue-sample->file output))
(set! *clm-srate* (mus-sound-srate output)))
(begin
(if (file-exists? output)
(delete-file output))
(set! *output* (make-sample->file output channels (or data-format sample-type) header-type comment))))
(begin
(if (and (not continue-old-file)
(vector output))
(fill! output 0.0))
(set! *output* output)))

(if reverb
(if reverb-to-file
(if continue-old-file
(set! *reverb* (continue-sample->file revfile))
(begin
(if (file-exists? revfile)
(delete-file revfile))
(set! *reverb* (make-sample->file revfile reverb-channels (or data-format sample-type) header-type))))
(begin
(if (and (not continue-old-file)
(vector? revfile))
(fill! revfile 0.0))
(set! *reverb* revfile))))

(list 'with-sound-data
output
reverb
revfile
old-srate
statistics
#f ;to-snd
scaled-to
scaled-by
play
reverb-data
start)))

(define (finish-with-sound wsd)
"(finish-with-sound wsd) closes the notelist process started by init-with-sound"
(if (eq? (car wsd) 'with-sound-data)
(let ((output (list-ref wsd 1))
(reverb (list-ref wsd 2))
(revfile (list-ref wsd 3))
(old-srate (list-ref wsd 4))
;(statistics (list-ref wsd 5))
;(to-snd (list-ref wsd 6))
;(scaled-to (list-ref wsd 7))
;(scaled-by (list-ref wsd 8))
;(play (list-ref wsd 9))
(reverb-data (list-ref wsd 10))
;(start (list-ref wsd 11))
)

(if reverb
(begin
(mus-close *reverb*)
(if (string? revfile)
(set! *reverb* (make-file->sample revfile))
(set! *reverb* revfile))
(apply reverb reverb-data)
(mus-close *reverb*)))
(if (mus-output? *output*)
(mus-close *output*))

(set! *clm-srate* old-srate)
output)
(throw 'wrong-type-arg
(list "finish-with-sound" wsd))))


(define wsdat-play ; for cm
(dilambda
(lambda (w)
"accessor for play field of init-with-sound struct"
(list-ref w 9))
(lambda (w val)
(list-set! w 9 val))))


(define ->frequency
(let ((main-pitch (/ 440.0 (expt 2.0 (/ 57 12)))) ; a4 = 440Hz is pitch 57 in our numbering
(last-octave 0) ; octave number can be omitted
(ratios (vector 1.0 256/243 9/8 32/27 81/64 4/3 1024/729 3/2 128/81 27/16 16/9 243/128 2.0)))

(lambda* (pitch pythagorean) ; pitch can be pitch name or actual frequency
"(->frequency pitch pythagorean) returns the frequency (Hz) of the 'pitch', a CLM/CM style note name as a \
symbol: 'e4 for example. If 'pythagorean', the frequency calculation uses small-integer ratios, rather than equal-tempered tuning."
(if (symbol? pitch)
(let* ((name (string-downcase (symbol->string pitch)))
(base-char (name 0))
(sign-char (and (> (length name) 1)
(not (char-numeric? (name 1)))
(not (char=? (name 1) #\n))
(name 1)))
(octave-char (if (and (> (length name) 1)
(char-numeric? (name 1)))
(name 1)
(if (and (> (length name) 2)
(char-numeric? (name 2)))
(name 2)
#f)))
(base (modulo (+ 5 (- (char->integer base-char) (char->integer #\a))) 7)) ; c-based (diatonic) octaves
(sign (if (not sign-char) 0 (if (char=? sign-char #\f) -1 1)))
(octave (if octave-char (- (char->integer octave-char) (char->integer #\0)) last-octave))
(base-pitch (+ sign (case base ((0) 0) ((1) 2) ((2) 4) ((3) 5) ((4) 7) ((5) 9) ((6) 11))))
(et-pitch (+ base-pitch (* 12 octave))))
(set! last-octave octave)
(if pythagorean
(* main-pitch (expt 2 octave) (ratios base-pitch))
(* main-pitch (expt 2.0 (/ et-pitch 12)))))
pitch))))


(define (->sample beg)
"(->sample time-in-seconds) -> time-in-samples"
(round (* (if (not (null? (sounds))) (srate) *clm-srate*) beg)))


;;; -------- defgenerator --------

;;; (defgenerator osc a b)
;;; (defgenerator (osc :methods (list (cons 'mus-frequency (lambda (obj) 100.0)))) a b)

(define-macro (defgenerator struct-name . fields)

(define (list->bindings lst)
(let ((len (length lst)))
(let ((nlst (make-list (* len 2))))
(do ((old lst (cdr old))
(nsym nlst (cddr nsym)))
((null? old) nlst)
(if (pair? (car old))
(begin
(set-car! (cdr nsym) (caar old))
(set-car! nsym (list 'quote (caar old))))
(begin
(set-car! (cdr nsym) (car old))
(set-car! nsym (list 'quote (car old)))))))))

(let* ((name (if (pair? struct-name)
(car struct-name)
struct-name))
(sname (if (string? name)
name
(symbol->string name)))
(wrapper (or (and (pair? struct-name)
(or (and (> (length struct-name) 2)
(equal? (struct-name 1) :make-wrapper)
(struct-name 2))
(and (= (length struct-name) 5)
(equal? (struct-name 3) :make-wrapper)
(struct-name 4))))
(lambda (gen) gen)))
(methods (and (pair? struct-name)
(or (and (> (length struct-name) 2)
(equal? (struct-name 1) :methods)
(struct-name 2))
(and (= (length struct-name) 5)
(equal? (struct-name 3) :methods)
(struct-name 4))))))
`(begin
(define ,(string->symbol (string-append sname "?")) #f)
(define ,(string->symbol (string-append "make-" sname)) #f)

(let ((gen-type ',(string->symbol (string-append "+" sname "+")))
(gen-methods (and ,methods (apply inlet ,methods))))
(set! ,(string->symbol (string-append sname "?"))
(lambda (obj)
(and (let? obj)
(eq? (obj 'mus-generator-type) gen-type))))

(set! ,(string->symbol (string-append "make-" sname))
(lambda* ,(map (lambda (n)
(if (pair? n) n (list n 0.0)))
fields)
(,wrapper
(openlet
,(if methods
`(sublet gen-methods
,@(list->bindings (reverse fields)) 'mus-generator-type gen-type)
`(inlet 'mus-generator-type gen-type ,@(list->bindings fields)))))))))))


;;; --------------------------------------------------------------------------------
;;;
;;; functions from Snd that are used in some instruments
;;; these replacements assume that the Snd functions are not present

(define* (file-name name)
(if (string? name)
(mus-expand-filename name)
(mus-file-name name)))

(define srate mus-sound-srate)

(define (channels . args)
(let ((obj (car args)))
(if (string? obj)
(mus-sound-chans obj)
(mus-channels obj))))

;;; I think length is handled by s7 for all types

(define (framples . args)
(let ((obj (car args)))
(if (string? obj)
(mus-sound-framples obj)
(length obj))))


(define snd-print display)
(define snd-warning display)
(define snd-display (lambda args (apply format (append (list #t) (cdr args)))))
(define (snd-error str) (error 'mus-error str))
(define snd-tempnam tmpnam)


+ 435
- 0
lib/sndlib/sndlib.h View File

@@ -0,0 +1,435 @@
#ifndef SNDLIB_H
#define SNDLIB_H

#define SNDLIB_VERSION 24
#define SNDLIB_REVISION 4
#define SNDLIB_DATE "1-Sep-15"

#include <stdio.h>
#include <time.h>
#include <sys/types.h>

/* not sure how to handle this one cleanly: */
#ifndef __cplusplus
#ifndef _MSC_VER
#include <stdbool.h>
#else
#ifndef true
#define bool unsigned char
#define true 1
#define false 0
#endif
#endif
#endif

typedef double mus_float_t;
typedef long long int mus_long_t;

#if defined(__sun) && defined(__SVR4)
#define HAVE_SUN 1
#endif

#ifdef _MSC_VER
/* I got these from gmp.h */
#if defined (__GNUC__)
#define MUS_EXPORT __declspec(__dllexport__)
#else
#define MUS_EXPORT __declspec(dllexport)
#endif
#else
#define MUS_EXPORT
#endif


#ifndef MUS_LITTLE_ENDIAN
#if WORDS_BIGENDIAN
#define MUS_LITTLE_ENDIAN 0
#else
#define MUS_LITTLE_ENDIAN 1
#endif
#endif

typedef enum {MUS_UNKNOWN_HEADER, MUS_NEXT, MUS_AIFC, MUS_RIFF, MUS_RF64, MUS_BICSF, MUS_NIST, MUS_INRS, MUS_ESPS, MUS_SVX, MUS_VOC,
MUS_SNDT, MUS_RAW, MUS_SMP, MUS_AVR, MUS_IRCAM, MUS_SD1, MUS_SPPACK, MUS_MUS10, MUS_HCOM, MUS_PSION, MUS_MAUD,
MUS_IEEE, MUS_MATLAB, MUS_ADC, MUS_MIDI, MUS_SOUNDFONT, MUS_GRAVIS, MUS_COMDISCO, MUS_GOLDWAVE, MUS_SRFS,
MUS_MIDI_SAMPLE_DUMP, MUS_DIAMONDWARE, MUS_ADF, MUS_SBSTUDIOII, MUS_DELUSION,
MUS_FARANDOLE, MUS_SAMPLE_DUMP, MUS_ULTRATRACKER, MUS_YAMAHA_SY85, MUS_YAMAHA_TX16W, MUS_DIGIPLAYER,
MUS_COVOX, MUS_AVI, MUS_OMF, MUS_QUICKTIME, MUS_ASF, MUS_YAMAHA_SY99, MUS_KURZWEIL_2000,
MUS_AIFF, MUS_PAF, MUS_CSL, MUS_FILE_SAMP, MUS_PVF, MUS_SOUNDFORGE, MUS_TWINVQ, MUS_AKAI4,
MUS_IMPULSETRACKER, MUS_KORG, MUS_NVF, MUS_CAFF, MUS_MAUI, MUS_SDIF, MUS_OGG, MUS_FLAC, MUS_SPEEX, MUS_MPEG,
MUS_SHORTEN, MUS_TTA, MUS_WAVPACK, MUS_SOX,
MUS_NUM_HEADERS} mus_header_t;


typedef enum {MUS_UNKNOWN_SAMPLE, MUS_BSHORT, MUS_MULAW, MUS_BYTE, MUS_BFLOAT, MUS_BINT, MUS_ALAW, MUS_UBYTE, MUS_B24INT,
MUS_BDOUBLE, MUS_LSHORT, MUS_LINT, MUS_LFLOAT, MUS_LDOUBLE, MUS_UBSHORT, MUS_ULSHORT, MUS_L24INT,
MUS_BINTN, MUS_LINTN, MUS_BFLOAT_UNSCALED, MUS_LFLOAT_UNSCALED, MUS_BDOUBLE_UNSCALED, MUS_LDOUBLE_UNSCALED,
MUS_NUM_SAMPLES} mus_sample_t;

#ifndef MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE
#if WORDS_BIGENDIAN
#if __APPLE__
#define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_BFLOAT
#else
#define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_BSHORT
#endif
#else
#if __APPLE__
#define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_LFLOAT
#else
#define MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE MUS_LSHORT
#endif
#endif
#endif

#ifndef MUS_OUT_SAMPLE_TYPE
#if WORDS_BIGENDIAN
#define MUS_OUT_SAMPLE_TYPE MUS_BDOUBLE
#else
#define MUS_OUT_SAMPLE_TYPE MUS_LDOUBLE
#endif
#endif

#define MUS_IGNORE_SAMPLE MUS_NUM_SAMPLES
/* MUS_LINTN and MUS_BINTN refer to 32 bit ints with 31 bits of fraction -- the data is left justified */
/* "unscaled" means the float value is used directly (i.e. not as -1.0 to 1.0, but (probably) -32768.0 to 32768.0) */


#define MUS_NIST_SHORTPACK 2
#define MUS_AIFF_IMA_ADPCM 99

#define MUS_AUDIO_PACK_SYSTEM(n) ((n) << 16)
#define MUS_AUDIO_SYSTEM(n) (((n) >> 16) & 0xffff)
#define MUS_AUDIO_DEVICE(n) ((n) & 0xffff)


#define MUS_AUDIO_DEFAULT 0
#define MUS_ERROR -1

enum {MUS_NO_ERROR, MUS_NO_FREQUENCY, MUS_NO_PHASE, MUS_NO_GEN, MUS_NO_LENGTH,
MUS_NO_DESCRIBE, MUS_NO_DATA, MUS_NO_SCALER,
MUS_MEMORY_ALLOCATION_FAILED,
MUS_CANT_OPEN_FILE, MUS_NO_SAMPLE_INPUT, MUS_NO_SAMPLE_OUTPUT,
MUS_NO_SUCH_CHANNEL, MUS_NO_FILE_NAME_PROVIDED, MUS_NO_LOCATION, MUS_NO_CHANNEL,
MUS_NO_SUCH_FFT_WINDOW, MUS_UNSUPPORTED_SAMPLE_TYPE, MUS_HEADER_READ_FAILED,
MUS_UNSUPPORTED_HEADER_TYPE,
MUS_FILE_DESCRIPTORS_NOT_INITIALIZED, MUS_NOT_A_SOUND_FILE, MUS_FILE_CLOSED, MUS_WRITE_ERROR,
MUS_HEADER_WRITE_FAILED, MUS_CANT_OPEN_TEMP_FILE, MUS_INTERRUPTED, MUS_BAD_ENVELOPE,

MUS_AUDIO_CHANNELS_NOT_AVAILABLE, MUS_AUDIO_SRATE_NOT_AVAILABLE, MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE,
MUS_AUDIO_NO_INPUT_AVAILABLE, MUS_AUDIO_CONFIGURATION_NOT_AVAILABLE,
MUS_AUDIO_WRITE_ERROR, MUS_AUDIO_SIZE_NOT_AVAILABLE, MUS_AUDIO_DEVICE_NOT_AVAILABLE,
MUS_AUDIO_CANT_CLOSE, MUS_AUDIO_CANT_OPEN, MUS_AUDIO_READ_ERROR,
MUS_AUDIO_CANT_WRITE, MUS_AUDIO_CANT_READ, MUS_AUDIO_NO_READ_PERMISSION,

MUS_CANT_CLOSE_FILE, MUS_ARG_OUT_OF_RANGE,
MUS_NO_CHANNELS, MUS_NO_HOP, MUS_NO_WIDTH, MUS_NO_FILE_NAME, MUS_NO_RAMP, MUS_NO_RUN,
MUS_NO_INCREMENT, MUS_NO_OFFSET,
MUS_NO_XCOEFF, MUS_NO_YCOEFF, MUS_NO_XCOEFFS, MUS_NO_YCOEFFS, MUS_NO_RESET, MUS_BAD_SIZE, MUS_CANT_CONVERT,
MUS_READ_ERROR,
MUS_NO_FEEDFORWARD, MUS_NO_FEEDBACK, MUS_NO_INTERP_TYPE, MUS_NO_POSITION, MUS_NO_ORDER, MUS_NO_COPY,
MUS_CANT_TRANSLATE,
MUS_NUM_ERRORS};

/* keep this list in sync with mus_error_names in sound.c and snd-test.scm|rb */

#define MUS_LOOP_INFO_SIZE 8

#ifdef __cplusplus
extern "C" {
#endif

/* -------- sound.c -------- */

#ifdef __GNUC__
MUS_EXPORT int mus_error(int error, const char *format, ...) __attribute__ ((format (printf, 2, 3)));
MUS_EXPORT void mus_print(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
MUS_EXPORT char *mus_format(const char *format, ...) __attribute__ ((format (printf, 1, 2)));
#else
MUS_EXPORT int mus_error(int error, const char *format, ...);
MUS_EXPORT void mus_print(const char *format, ...);
MUS_EXPORT char *mus_format(const char *format, ...);
#endif

typedef void mus_error_handler_t(int type, char *msg);
MUS_EXPORT mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler);
MUS_EXPORT const char *mus_error_type_to_string(int err);

typedef void mus_print_handler_t(char *msg);
MUS_EXPORT mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handler);

typedef mus_float_t mus_clip_handler_t(mus_float_t val);
MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler(mus_clip_handler_t *new_clip_handler);
MUS_EXPORT mus_clip_handler_t *mus_clip_set_handler_and_checker(mus_clip_handler_t *new_clip_handler, bool (*checker)(void));

MUS_EXPORT mus_long_t mus_sound_samples(const char *arg);
MUS_EXPORT mus_long_t mus_sound_framples(const char *arg);
MUS_EXPORT int mus_sound_datum_size(const char *arg);
MUS_EXPORT mus_long_t mus_sound_data_location(const char *arg);
MUS_EXPORT int mus_sound_chans(const char *arg);
MUS_EXPORT int mus_sound_srate(const char *arg);
MUS_EXPORT mus_header_t mus_sound_header_type(const char *arg);
MUS_EXPORT mus_sample_t mus_sound_sample_type(const char *arg);
MUS_EXPORT int mus_sound_original_sample_type(const char *arg);
MUS_EXPORT mus_long_t mus_sound_comment_start(const char *arg);
MUS_EXPORT mus_long_t mus_sound_comment_end(const char *arg);
MUS_EXPORT mus_long_t mus_sound_length(const char *arg);
MUS_EXPORT int mus_sound_fact_samples(const char *arg);
MUS_EXPORT time_t mus_sound_write_date(const char *arg);
MUS_EXPORT int mus_sound_type_specifier(const char *arg);
MUS_EXPORT int mus_sound_block_align(const char *arg);
MUS_EXPORT int mus_sound_bits_per_sample(const char *arg);

MUS_EXPORT int mus_sound_set_chans(const char *arg, int val);
MUS_EXPORT int mus_sound_set_srate(const char *arg, int val);
MUS_EXPORT mus_header_t mus_sound_set_header_type(const char *arg, mus_header_t val);
MUS_EXPORT mus_sample_t mus_sound_set_sample_type(const char *arg, mus_sample_t val);
MUS_EXPORT int mus_sound_set_data_location(const char *arg, mus_long_t val);
MUS_EXPORT int mus_sound_set_samples(const char *arg, mus_long_t val);

MUS_EXPORT const char *mus_header_type_name(mus_header_t type);
MUS_EXPORT const char *mus_header_type_to_string(mus_header_t type);
MUS_EXPORT const char *mus_sample_type_name(mus_sample_t samp_type);
MUS_EXPORT const char *mus_sample_type_to_string(mus_sample_t samp_type);
MUS_EXPORT const char *mus_sample_type_short_name(mus_sample_t samp_type);

MUS_EXPORT char *mus_sound_comment(const char *name);
MUS_EXPORT int mus_bytes_per_sample(mus_sample_t samp_type);
MUS_EXPORT float mus_sound_duration(const char *arg);
MUS_EXPORT int mus_sound_initialize(void);
MUS_EXPORT int mus_sound_override_header(const char *arg, int srate, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t location, mus_long_t size);
MUS_EXPORT int mus_sound_forget(const char *name);
MUS_EXPORT int mus_sound_prune(void);
MUS_EXPORT void mus_sound_report_cache(FILE *fp);
MUS_EXPORT int *mus_sound_loop_info(const char *arg);
MUS_EXPORT void mus_sound_set_loop_info(const char *arg, int *loop);
MUS_EXPORT int mus_sound_mark_info(const char *arg, int **mark_ids, int **mark_positions);

MUS_EXPORT int mus_sound_open_input(const char *arg);
MUS_EXPORT int mus_sound_open_output(const char *arg, int srate, int chans, mus_sample_t sample_type, mus_header_t header_type, const char *comment);
MUS_EXPORT int mus_sound_reopen_output(const char *arg, int chans, mus_sample_t samp_type, mus_header_t type, mus_long_t data_loc);
MUS_EXPORT int mus_sound_close_input(int fd);
MUS_EXPORT int mus_sound_close_output(int fd, mus_long_t bytes_of_data);
#define mus_sound_read(Fd, Beg, End, Chans, Bufs) mus_file_read(Fd, Beg, End, Chans, Bufs)
#define mus_sound_write(Fd, Beg, End, Chans, Bufs) mus_file_write(Fd, Beg, End, Chans, Bufs)

MUS_EXPORT mus_long_t mus_sound_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times);
MUS_EXPORT int mus_sound_set_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_long_t *times);
MUS_EXPORT bool mus_sound_maxamp_exists(const char *ifile);
MUS_EXPORT bool mus_sound_channel_maxamp_exists(const char *file, int chan);
MUS_EXPORT mus_float_t mus_sound_channel_maxamp(const char *file, int chan, mus_long_t *pos);
MUS_EXPORT void mus_sound_channel_set_maxamp(const char *file, int chan, mus_float_t mx, mus_long_t pos);
MUS_EXPORT mus_long_t mus_file_to_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
MUS_EXPORT int mus_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
MUS_EXPORT const char *mus_array_to_file_with_error(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);
MUS_EXPORT mus_long_t mus_file_to_float_array(const char *filename, int chan, mus_long_t start, mus_long_t samples, mus_float_t *array);
MUS_EXPORT int mus_float_array_to_file(const char *filename, mus_float_t *ddata, mus_long_t len, int srate, int channels);

MUS_EXPORT mus_float_t **mus_sound_saved_data(const char *arg);
MUS_EXPORT void mus_sound_set_saved_data(const char *arg, mus_float_t **data);
MUS_EXPORT void mus_file_save_data(int tfd, mus_long_t framples, mus_float_t **data);



/* -------- audio.c -------- */

MUS_EXPORT int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t samp_type, int size);
MUS_EXPORT int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t samp_type, int size);
MUS_EXPORT int mus_audio_write(int line, char *buf, int bytes);
MUS_EXPORT int mus_audio_close(int line);
MUS_EXPORT int mus_audio_read(int line, char *buf, int bytes);

MUS_EXPORT int mus_audio_initialize(void);
MUS_EXPORT char *mus_audio_moniker(void);
MUS_EXPORT int mus_audio_api(void);
MUS_EXPORT mus_sample_t mus_audio_compatible_sample_type(int dev);

#if HAVE_OSS || HAVE_ALSA
MUS_EXPORT void mus_oss_set_buffers(int num, int size);
MUS_EXPORT char *mus_alsa_playback_device(void);
MUS_EXPORT char *mus_alsa_set_playback_device(const char *name);
MUS_EXPORT char *mus_alsa_capture_device(void);
MUS_EXPORT char *mus_alsa_set_capture_device(const char *name);
MUS_EXPORT char *mus_alsa_device(void);
MUS_EXPORT char *mus_alsa_set_device(const char *name);
MUS_EXPORT int mus_alsa_buffer_size(void);
MUS_EXPORT int mus_alsa_set_buffer_size(int size);
MUS_EXPORT int mus_alsa_buffers(void);
MUS_EXPORT int mus_alsa_set_buffers(int num);
MUS_EXPORT bool mus_alsa_squelch_warning(void);
MUS_EXPORT bool mus_alsa_set_squelch_warning(bool val);
#endif

#if __APPLE__
MUS_EXPORT bool mus_audio_output_properties_mutable(bool mut);
#endif

MUS_EXPORT int mus_audio_device_channels(int dev);
MUS_EXPORT mus_sample_t mus_audio_device_sample_type(int dev);



/* -------- io.c -------- */

MUS_EXPORT int mus_file_open_descriptors(int tfd, const char *arg, mus_sample_t df, int ds, mus_long_t dl, int dc, mus_header_t dt);
MUS_EXPORT int mus_file_open_read(const char *arg);
MUS_EXPORT bool mus_file_probe(const char *arg);
MUS_EXPORT int mus_file_open_write(const char *arg);
MUS_EXPORT int mus_file_create(const char *arg);
MUS_EXPORT int mus_file_reopen_write(const char *arg);
MUS_EXPORT int mus_file_close(int fd);
MUS_EXPORT mus_long_t mus_file_seek_frample(int tfd, mus_long_t frample);
MUS_EXPORT mus_long_t mus_file_read(int fd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
MUS_EXPORT mus_long_t mus_file_read_chans(int fd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, mus_float_t **cm);
MUS_EXPORT int mus_file_write(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
MUS_EXPORT mus_long_t mus_file_read_any(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, mus_float_t **cm);
MUS_EXPORT mus_long_t mus_file_read_file(int tfd, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs);
MUS_EXPORT mus_long_t mus_file_read_buffer(int charbuf_sample_type, mus_long_t beg, int chans, mus_long_t nints, mus_float_t **bufs, char *charbuf);
MUS_EXPORT int mus_file_write_file(int tfd, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs);
MUS_EXPORT int mus_file_write_buffer(int charbuf_sample_type, mus_long_t beg, mus_long_t end, int chans, mus_float_t **bufs, char *charbuf, bool clipped);
MUS_EXPORT char *mus_expand_filename(const char *name);
MUS_EXPORT char *mus_getcwd(void);

MUS_EXPORT bool mus_clipping(void);
MUS_EXPORT bool mus_set_clipping(bool new_value);
MUS_EXPORT bool mus_file_clipping(int tfd);
MUS_EXPORT int mus_file_set_clipping(int tfd, bool clipped);

MUS_EXPORT int mus_file_set_header_type(int tfd, mus_header_t type);
MUS_EXPORT mus_header_t mus_file_header_type(int tfd);
MUS_EXPORT char *mus_file_fd_name(int tfd);
MUS_EXPORT int mus_file_set_chans(int tfd, int chans);

MUS_EXPORT int mus_iclamp(int lo, int val, int hi);
MUS_EXPORT mus_long_t mus_oclamp(mus_long_t lo, mus_long_t val, mus_long_t hi);
MUS_EXPORT mus_float_t mus_fclamp(mus_float_t lo, mus_float_t val, mus_float_t hi);

/* for CLM */
/* these are needed to clear a saved lisp image to the just-initialized state */
MUS_EXPORT void mus_reset_io_c(void);
MUS_EXPORT void mus_reset_headers_c(void);
MUS_EXPORT void mus_reset_audio_c(void);

MUS_EXPORT int mus_samples_bounds(unsigned char *data, int bytes, int chan, int chans, mus_sample_t samp_type, mus_float_t *min_samp, mus_float_t *max_samp);

MUS_EXPORT mus_long_t mus_max_malloc(void);
MUS_EXPORT mus_long_t mus_set_max_malloc(mus_long_t new_max);
MUS_EXPORT mus_long_t mus_max_table_size(void);
MUS_EXPORT mus_long_t mus_set_max_table_size(mus_long_t new_max);

MUS_EXPORT char *mus_strdup(const char *str);
MUS_EXPORT int mus_strlen(const char *str);
MUS_EXPORT bool mus_strcmp(const char *str1, const char *str2);
MUS_EXPORT char *mus_strcat(char *errmsg, const char *str, int *err_size);



/* -------- headers.c -------- */

MUS_EXPORT bool mus_is_sample_type(int n);
MUS_EXPORT bool mus_is_header_type(int n);

MUS_EXPORT mus_long_t mus_header_samples(void);
MUS_EXPORT mus_long_t mus_header_data_location(void);
MUS_EXPORT int mus_header_chans(void);
MUS_EXPORT int mus_header_srate(void);
MUS_EXPORT mus_header_t mus_header_type(void);
MUS_EXPORT mus_sample_t mus_header_sample_type(void);
MUS_EXPORT mus_long_t mus_header_comment_start(void);
MUS_EXPORT mus_long_t mus_header_comment_end(void);
MUS_EXPORT int mus_header_type_specifier(void);
MUS_EXPORT int mus_header_bits_per_sample(void);
MUS_EXPORT int mus_header_fact_samples(void);
MUS_EXPORT int mus_header_block_align(void);
MUS_EXPORT int mus_header_loop_mode(int which);
MUS_EXPORT int mus_header_loop_start(int which);
MUS_EXPORT int mus_header_loop_end(int which);
MUS_EXPORT int mus_header_mark_position(int id);
MUS_EXPORT int mus_header_mark_info(int **marker_ids, int **marker_positions);
MUS_EXPORT int mus_header_base_note(void);
MUS_EXPORT int mus_header_base_detune(void);
MUS_EXPORT void mus_header_set_raw_defaults(int sr, int chn, mus_sample_t frm);
MUS_EXPORT void mus_header_raw_defaults(int *sr, int *chn, mus_sample_t *frm);
MUS_EXPORT mus_long_t mus_header_true_length(void);
MUS_EXPORT int mus_header_original_sample_type(void);
MUS_EXPORT mus_long_t mus_samples_to_bytes(mus_sample_t samp_type, mus_long_t size);
MUS_EXPORT mus_long_t mus_bytes_to_samples(mus_sample_t samp_type, mus_long_t size);
MUS_EXPORT int mus_header_read(const char *name);
MUS_EXPORT int mus_header_write(const char *name, mus_header_t type, int srate, int chans, mus_long_t loc, mus_long_t size_in_samples,
mus_sample_t samp_type, const char *comment, int len);
MUS_EXPORT int mus_write_header(const char *name, mus_header_t type, int in_srate, int in_chans, mus_long_t size_in_samples,
mus_sample_t samp_type, const char *comment);
MUS_EXPORT mus_long_t mus_header_aux_comment_start(int n);
MUS_EXPORT mus_long_t mus_header_aux_comment_end(int n);
MUS_EXPORT int mus_header_initialize(void);
MUS_EXPORT bool mus_header_writable(mus_header_t type, mus_sample_t samp_type);
MUS_EXPORT void mus_header_set_aiff_loop_info(int *data);
MUS_EXPORT int mus_header_sf2_entries(void);
MUS_EXPORT char *mus_header_sf2_name(int n);
MUS_EXPORT int mus_header_sf2_start(int n);
MUS_EXPORT int mus_header_sf2_end(int n);
MUS_EXPORT int mus_header_sf2_loop_start(int n);
MUS_EXPORT int mus_header_sf2_loop_end(int n);
MUS_EXPORT const char *mus_header_original_sample_type_name(int samp_type, mus_header_t type);
MUS_EXPORT bool mus_header_no_header(const char *name);

MUS_EXPORT char *mus_header_riff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);
MUS_EXPORT char *mus_header_aiff_aux_comment(const char *name, mus_long_t *starts, mus_long_t *ends);

MUS_EXPORT int mus_header_change_chans(const char *filename, mus_header_t type, int new_chans);
MUS_EXPORT int mus_header_change_srate(const char *filename, mus_header_t type, int new_srate);
MUS_EXPORT int mus_header_change_type(const char *filename, mus_header_t new_type, mus_sample_t new_sample_type);
MUS_EXPORT int mus_header_change_sample_type(const char *filename, mus_header_t type, mus_sample_t new_sample_type);
MUS_EXPORT int mus_header_change_location(const char *filename, mus_header_t type, mus_long_t new_location);
MUS_EXPORT int mus_header_change_comment(const char *filename, mus_header_t type, const char *new_comment);
MUS_EXPORT int mus_header_change_data_size(const char *filename, mus_header_t type, mus_long_t bytes);

typedef void mus_header_write_hook_t(const char *filename);
MUS_EXPORT mus_header_write_hook_t *mus_header_write_set_hook(mus_header_write_hook_t *new_hook);


/* these are internal to sndlib */
void mus_bint_to_char(unsigned char *j, int x);
void mus_lint_to_char(unsigned char *j, int x);
void mus_bfloat_to_char(unsigned char *j, float x);
void mus_lfloat_to_char(unsigned char *j, float x);
void mus_bshort_to_char(unsigned char *j, short x);
void mus_lshort_to_char(unsigned char *j, short x);
void mus_bdouble_to_char(unsigned char *j, double x);
void mus_blong_to_char(unsigned char *j, mus_long_t x);
void mus_llong_to_char(unsigned char *j, mus_long_t x);
int mus_char_to_bint(const unsigned char *inp);
int mus_char_to_lint(const unsigned char *inp);
mus_long_t mus_char_to_llong(const unsigned char *inp);
mus_long_t mus_char_to_blong(const unsigned char *inp);
int mus_char_to_uninterpreted_int(const unsigned char *inp);
float mus_char_to_bfloat(const unsigned char *inp);
float mus_char_to_lfloat(const unsigned char *inp);
short mus_char_to_bshort(const unsigned char *inp);
short mus_char_to_lshort(const unsigned char *inp);
unsigned short mus_char_to_ubshort(const unsigned char *inp);
unsigned short mus_char_to_ulshort(const unsigned char *inp);
double mus_char_to_ldouble(const unsigned char *inp);
double mus_char_to_bdouble(const unsigned char *inp);
unsigned int mus_char_to_ubint(const unsigned char *inp);
unsigned int mus_char_to_ulint(const unsigned char *inp);


#ifdef __cplusplus
}
#endif

#if (!DISABLE_DEPRECATED)
#define mus_header_format mus_header_sample_type
#define mus_header_original_format mus_header_original_sample_type
#define mus_header_original_format_name mus_header_original_sample_type_name
#define mus_header_change_format mus_header_change_sample_type
#define mus_sound_original_format mus_sound_original_sample_type
#define MUS_AUDIO_COMPATIBLE_FORMAT MUS_AUDIO_COMPATIBLE_SAMPLE_TYPE
#define MUS_OUT_FORMAT MUS_OUT_SAMPLE_TYPE
#define MUS_AUDIO_FORMAT_NOT_AVAILABLE MUS_AUDIO_SAMPLE_TYPE_NOT_AVAILABLE
#define mus_audio_compatible_format mus_audio_compatible_sample_type
#define mus_audio_device_format mus_audio_device_sample_type
#endif

#endif

+ 967
- 0
lib/sndlib/sndlib.html View File

@@ -0,0 +1,967 @@
<!DOCTYPE html>

<html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8" >
<title>The Sound Library</title>
<style type="text/css">
EM.red {color:red; font-style:normal}
EM.def {font-style:italic; font-weight: bold}
H1 {text-align: center}
UL {list-style-type: none}
DIV.center {text-align: center}

A {text-decoration:none}
A:hover {text-decoration:underline}
A.quiet {color:black; text-decoration:none}
A.quiet:hover {text-decoration:underline}
A.def {font-weight: bold; font-style: normal; text-decoration:none; text-color:black}

DIV.topheader {margin-top: 10px;
margin-bottom: 40px;
border: 4px solid #00ff00; /* green */
background-color: #f5f5dc; /* beige */
font-family: 'Helvetica';
font-size: 30px;
text-align: center;
padding-top: 10px;
padding-bottom: 10px;
}
DIV.innerheader {margin-top: 60px;
margin-bottom: 30px;
border: 4px solid #00ff00; /* green */
background-color: #eefdee; /* lightgreen */
padding-left: 30px;
width: 50%;
padding-top: 20px;
padding-bottom: 20px;
}
DIV.header {margin-top: 50px;
margin-bottom: 10px;
font-size: 20px;
font-weight: bold;
border: 4px solid #00ff00; /* green */
background-color: #f5f5dc; /* beige */
text-align: center;
padding-top: 20px;
padding-bottom: 20px;
}
DIV.related {text-align:center;
border: 1px solid lightgray;
margin-bottom: 1.0cm;
margin-top: 1.0cm;
padding-top: 10px;
padding-bottom: 10px;
background-color: #f0f0f0;
}
TD.green {background-color: lightgreen;
padding-left: 1.0cm;}
TD.beige {background-color: beige}
BODY.body {background-color: #ffffff; /* white */
margin-left: 0.5cm;
}

</style>
</head>
<body class="body">

<div class="topheader">SndLib</div>
<div class="center">Bill Schottstaedt (bil@ccrma.stanford.edu)</div>


<div class="related">
related documentation: &nbsp;
<a href="snd.html">snd.html &nbsp;</a>
<a href="grfsnd.html">grfsnd.html &nbsp;</a>
<a href="extsnd.html">extsnd.html &nbsp;</a>
<a href="sndscm.html">sndscm.html &nbsp;</a>
<a href="sndclm.html">sndclm.html &nbsp;</a>
<a href="s7.html">s7.html &nbsp;</a>
<a href="index.html">index.html</a>
</div>

<div class="header">Contents</div>

<ul>
<li><a href="#introduction">Introduction</a>
<li><a href="#headers">Headers</a>
<li><a href="#data">Data</a>
<li><a href="#hardware">Hardware</a>
<li><a href="#music5">Music V</a>
<li><a href="#examples">Examples</a>
<ul>
<li><a href="#sndinfo">SndInfo</a>
<li><a href="#sndplay">SndPlay</a>
<li><a href="#sndsine">SndSine</a>
<li><a href="#clmosc">clmosc</a>
<li><a href="#otherexamples">Other Examples</a>
</ul>
<li><a href="#sndlibxen">Extension Languages</a>
</ul>



<div class="header" id="introduction">Introduction</div>

<p>sndlib is a collection of sound file and sound synthesis
function written in C and running currently in various Unices
via OSS or ALSA, Mac OSX, and on old Windows systems.
To build sndlib (sndlib.so if possible, and sndlib.a):
</p>
<pre>
./configure
make
</pre>
<p>To install it, 'make install' &mdash; I've tested this process in Linux.
</p>

<p>The following files make up sndlib:</p>
<ul>
<li>io.c (read and write sound file data)
<li>headers.c (read and write sound file headers)
<li>audio.c (read and write sound hardware ports)
<li>sound.c (provide slightly higher level access to the preceding files)
<li>sndlib.h (header for the preceding files)
<li>sndlib2xen.c and sndlib-strings.h (tie preceding into s7, Ruby, or Forth)
<li>clm.c and clm.h (Music V implementation)
<li>clm2xen.c, vct.c and vct.h (tie clm.c into s7, Ruby, or Forth)
<li>xen.h, xen.c (the embedded language support)
</ul>

<p>
The naming scheme is more as less as follows:
the sndlib prefix is "mus" so
function names start with "mus_" and constants start with "MUS_".
Functions involving sound files referenced through the file name
start with "mus_sound_", functions involving files at a lower level
with "mus_file_", functions involving header access with "mus_header_",
functions involving audio hardware access with "mus_audio_",
and various
others just with "mus_" (number translations, etc). Conversions use
the word "to" as in "mus_samples_to_bytes".
</p>



<div class="header" id="headers">Headers</div>

<p>Sound files have built-in descriptors known as headers.
The following functions return the information in the header.
In each case the argument to the function is the full file
name of the sound file.
</p>
<pre>
mus_long_t mus_sound_samples (const char *arg) /* samples of sound according to header */
mus_long_t mus_sound_framples (const char *arg) /* samples per channel */
float mus_sound_duration (const char *arg) /* sound duration in seconds */
mus_long_t mus_sound_length (const char *arg) /* true file length in bytes */

int mus_sound_datum_size (const char *arg) /* bytes per sample */
mus_long_t mus_sound_data_location (const char *arg) /* location of first sample (bytes) */
int mus_sound_bits_per_sample(const char *arg) /* bits per sample */
int mus_bytes_per_sample(int format) /* bytes per sample */

int mus_sound_chans (const char *arg) /* number of channels (samples are interleaved) */
int mus_sound_srate (const char *arg) /* sampling rate */

mus_header_t mus_sound_header_type (const char *arg) /* header type (aiff etc) */
mus_sample_t mus_sound_sample_type (const char *arg) /* sample type (alaw etc) */
int mus_sound_original_format (const char *arg) /* unmodified sample type specifier */
int mus_sound_type_specifier (const char *arg) /* original header type identifier */

char *mus_sound_comment (const char *arg) /* comment if any */
mus_long_t mus_sound_comment_start (const char *arg) /* comment start (bytes) if any */
mus_long_t mus_sound_comment_end (const char *arg) /* comment end (bytes) */
int *mus_sound_loop_info(const char *arg) /* 8 loop vals (mode,start,end) then base-detune and base-note (empty list if no loop info found) */

int mus_sound_write_date (const char *arg) /* bare (uninterpreted) file write date */
int mus_sound_initialize(void) /* initialize everything */
</pre>

<p>The following can be used to provide user-understandable descriptions
of the header type and the sample type:</p>
<pre>
char *mus_header_type_name(mus_header_t type) /* "AIFF" etc */
char *mus_sample_type_name(mus_sample_t samp_type) /* "16-bit big endian linear" etc */
char *mus_header_type_to_string(mus_header_t type)
char *mus_sample_type_to_string(mus_sample_t samp_type)
const char *mus_sample_type_short_name(mus_sample_t samp_type)
</pre>

<p>In all cases if an error occurs, -1 (MUS_ERROR) is returned, and some sort of error message
is printed; to customize error handling, use mus_set_error_handler and mus_set_print_handler.
</p>
<pre>
mus_error_handler_t *mus_error_set_handler(mus_error_handler_t *new_error_handler);
mus_print_handler_t *mus_print_set_handler(mus_print_handler_t *new_print_handler);
</pre>
<p>To decode the error indication, use:</p>
<pre>
char *mus_error_to_string(int err);
</pre>

<p>Header data is cached internally, so the actual header is read
only if it hasn't already been read, or the write date has changed.
Loop points are also available, if there's interest. To go below the
"sound" level, see headers.c &mdash; once a header has been read, all the
components that have been found can be read via functions such as
<b>mus_header_srate</b>.
</p>



<div class="header" id="data">Data</div>

<p>The following functions provide access to
sound file data:</p>
<pre>
int mus_sound_open_input (const char *arg)
int mus_sound_open_output (const char *arg, int srate, int chans, mus_sample_t sample_type, mus_header_t header_type, const char *comment)
int mus_sound_reopen_output (const char *arg, mus_header_t type, mus_sample_t format, mus_long_t data_loc)
int mus_sound_close_input (int fd)
int mus_sound_close_output (int fd, mus_long_t bytes_of_data)
int mus_sound_read (int fd, int beg, int end, int chans, mus_float_t **bufs)
int mus_sound_write (int fd, int beg, int end, int chans, mus_float_t **bufs)
mus_long_t mus_sound_seek_frample (int fd, mus_long_t frample)
</pre>
<p>mus_float_t defaults to double. It is set when
sndlib is built, and refers to Sndlib's internal representation of sample values.
</p>

<p>mus_sound_open_input opens arg for reading. Most standard
uncompressed formats are readable. This function returns the associated
file number, or -1 upon failure. </p>

<p>mus_sound_close_input closes an open sound file. Its argument is
the integer returned by mus_sound_open_input.</p>

<p>mus_sound_open_output opens (creates) the file arg, setting its sampling rate
to be srate, number of channels to chans, sample type
to sample_type (see sndlib.h for these types: MUS_BSHORT,
means 16-bit 2's complement big endian fractions),
header type to header_type (AIFF for example; the available
writable header types are MUS_AIFC (or AIFF), MUS_RIFF ('wave'), MUS_RF64,
MUS_NEXT, MUS_NIST, MUS_CAFF, and MUS_IRCAM), and comment (if any) to
comment. The header is not considered complete without
an indication of the data size, but since this is rarely known
in advance, it is supplied when the sound file is closed. mus_sound_open_output
function returns the associated file number.</p>

<p>mus_sound_close_output first updates the file's header to
reflect the final data size bytes_of_data, then closes
the file. The argument fd is the integer returned by
mus_sound_open_output.</p>

<p>mus_sound_read reads data from the file indicated by fd,
placing data in the array obufs as mus_float_t values (floats normally).
chans determines how many arrays of
samples are in obufs, which is filled by mus_sound_read from its
index beg to end with zero padding if necessary.
</p>

<p>mus_sound_write writes samples to the file indicated by fd,
starting for each of chans channels in obufs at
beg and ending at end.</p>

<p>mus_sound_seek_frample moves the read or write position for the
file indicated by fd to the desired frample.
</p>


<div class="header" id="hardware">Hardware</div>

<p>The following functions provide access to audio harware. If an
error occurs, they return -1 (MUS_ERROR). </p>
<pre>
int mus_audio_initialize(void)
int mus_audio_open_output(int dev, int srate, int chans, mus_sample_t format, int size)
int mus_audio_open_input(int dev, int srate, int chans, mus_sample_t format, int size)
int mus_audio_write(int line, char *buf, int bytes)
int mus_audio_close(int line)
int mus_audio_read(int line, char *buf, int bytes)
</pre>

<p>mus_audio_initialize takes care of any necessary initialization.</p>

<p>mus_audio_open_input opens an audio port to read sound data (i.e. a microphone, line in, etc).
The input device is dev (see sndlib.h for details; when in doubt, use MUS_AUDIO_DEFAULT).
The input sampling rate is srate or as close as we
can get to it. The number of input channels (if available) is chans.
The input sample type is format (when in doubt, use the macro MUS_AUDIO_COMPATIBLE_FORMAT).
And the input buffer size (if settable at all) is size (bytes). This
function returns an integer to distinguish its port from others that might be
in use.
</p>

<p>mus_audio_open_output opens an audio port to write data (i.e. speakers, line out, etc).
The output device is dev (see sndlib.h). Its sampling rate is srate, number
of channels chans, sample type format, and buffer size size. This
function returns the associated line number of the output port.</p>

<p>mus_audio_close closes the port (input or output) associated with line.</p>

<p>mus_audio_read reads sound data from line. The incoming 'bytes' bytes of data are placed
in buf. If no error was returned from mus_audio_open_input, the data is in the format requested
by that function with channels interleaved.</p>

<p>mus_audio_write writes 'bytes' bytes of data in buf to the output
port associated with line. This data is assumed to be in the format
requested by mus_audio_open_output with channels interleaved.</p>



<div class="header" id="music5">Music V</div>

<p>clm.c and friends implement all the generators found in CLM, a
music V implementation, and clm2xen.c ties these into the languages supported by the
xen package (currently s7, Ruby, and Forth). The
primary clm documentation (which describes both the Scheme and Common Lisp implementations)
is clm.html found in clm-5.tar.gz or sndclm.html in snd-16.tar.gz alongside sndlib at ccrma-ftp.
The simplest way to try these out is to load them into Snd; see extsnd.html,
<a href="sndscm.html#exampdoc">examp.scm</a>, and <a href="sndscm.html#sndtestdoc">snd-test.scm</a> in snd-16.tar.gz for more details.
The following briefly describes the C calls (see clm.h).
</p>

<p>clm.c implements a bunch of generators and sound IO handlers. Each generator
has three associated functions, make-gen, gen, and gen_p; the first
creates the generator (if needed), the second gets the next sample from
the generator, and the last examines some pointer to determine if it is
that kind of generator. In addition, there are a variety of generic
functions that generators respond to: mus_free, for example, frees a
generator, and mus_frequency returns its current frequency, if relevant.
All generators are pointers to mus_any structs.
</p>

<ul>
<li>oscil &mdash; generate a sine wave.
<ul>
<li>mus_any *mus_make_oscil (float freq, float phase)
<li>float mus_oscil (mus_any *o, float fm, float pm)
<li>int mus_oscil_p (mus_any *ptr)
</ul>
<pre>
mus_any *osc;
osc = mus_make_oscil(440.0, 0.0);
if (mus_oscil_p(osc))
fprintf(stderr, "%.3f, %.3f ", .1 * mus_oscil(osc, 0.0, 0.0), mus_frequency(osc));
mus_free(osc);
</pre>
</ul>
<p>The other generators are:</p>
<ul>
<li>sum_of_cosines: generate a pulse train made up of cosines
<li>sum_of_sines: generate a sum of sines
<li>delay: a delay line with optional interpolation
<li>tap: read delay line
<li>comb: comb filter
<li>notch: notch filter
<li>all_pass: all pass filter
<li>table_lookup: interpolating table lookup
<li>sawtooth_wave, triangle_wave, pulse_train, square_wave
<li>rand: white noise (a step function)
<li>rand-interp: interpolating noise
<li>asymmetric_fm: a variety of FM
<li>one_zero, two_zero, one_pole, two_pole: basic filters
<li>formant: create a formant region (two poles, two zeros)
<li>sine_summation: another way to create sine waves
<li>filter, fir_filter, iir_filter: direct form filters of any order
<li>wave_train: sequence of possibly overlapping waves
<li>env: envelopes
<li>polyshape, polywave: waveshaping
<li>readin, file_to_sample, file_to_frample, in_any: file sample input
<li>locsig, sample_to_file, frample_to_file, out_any: file sample output
<li>src: sampling rate conversion
<li>granulate: granular synthesis
<li>convolve: convolution
<li>phase-vocoder: phase vocoder
<li>moving-average: moving window average
<li>ssb-am: single side-bank amplitude modulation
</ul>

<p>Some useful functions provided by clm.c are: </p>
<ul>
<li>float mus_radians_to_hz(float rads): convert radians/sample to cycles/sec.
<li>float mus_hz_to_radians(float hz): and the reverse.
<li>float mus_degrees_to_radians(float deg): convert degrees to radians.
<li>float mus_radians_to_degrees(float rads): and the reverse.
<li>float mus_srate(void): current sampling rate
<li>float mus_set_srate(float rate): set current sampling rate
<li>float mus_ring_modulate(float sig1, float sig2): multiply sig1 by sig2
<li>float mus_amplitude_modulate(float s1, float s2, float s3): AM
<li>float mus_contrast_enhancement(float sig, float index)
<li>float mus_dot_product(float *data1, float *data2, int size)
<li>void mus_clear_array(float *arr, int size)
<li>float mus_array_interp(float *wave, float phase, int size)
<li>float mus_polynomial(float *coeffs, float x, int ncoeffs);
<li>void mus_multiply_arrays(float *data, float *window, int len);
<li>void mus_rectangular_to_polar(float *rl, float *im, int size);
<li>void mus_spectrum(float *rdat, float *idat, float *window, int n, int type)
<li>void mus_fft(float *rl, float *im, int n, int isign)
<li>float *mus_make_fft_window(int size, int type, float beta)
<li>void mus_convolution(float* rl1, float* rl2, int n, int ipow)
<li>float *mus_partials_to_wave(float *partial_data, int partials, float *table, int table_size, int normalize)
<li>float *mus_phase_partials_to_wave(float *partial_data, int partials, float *table, int table_size, int normalize)
<li>float mus_samples_to_seconds(mus_long_t samps)
<li>mus_long_t mus_seconds_to_samples(float secs)
</ul>
<p>and various others: see clm.h.</p>

<p>The more useful generic functions are:</p>
<ul>
<li>int mus_free(mus_any *ptr)
<li>char *mus_describe(mus_any *gen)
<li>float mus_phase(mus_any *gen)
<li>float mus_set_phase(mus_any *gen, float val)
<li>float mus_set_frequency(mus_any *gen, float val)
<li>float mus_frequency(mus_any *gen)
<li>float mus_run(mus_any *gen, float arg1, float arg2)
<li>int mus_length(mus_any *gen)
<li>int mus_set_length(mus_any *gen, int len)
<li>float *mus_data(mus_any *gen)
<li>float *mus_set_data(mus_any *gen, float *data)
<li>char *mus_name(mus_any *ptr)
<li>float mus_scaler(mus_any *gen)
<li>float mus_set_scaler(mus_any *gen, float val)
<li>float mus_apply(mus_any *gen, ...)
</ul>

<p>Errors are reported
through mus_error which can be redirected or muffled. See clm2xen.c for an example.
</p>



<div class="header" id="examples">Examples</div>

<div class="innerheader" id="sndinfo">sndinfo</div>


<p>This program prints out a description of a sound file (sndinfo.c).</p>
<pre>
int main(int argc, char *argv[])
{
int fd, chans, srate;
mus_long_t samples;
float length;
time_t date;
char *comment;
char timestr[64];
mus_sound_initialize(); /* initialize sndlib */
fd = mus_file_open_read(argv[1]); /* see if it exists */
if (fd != -1)
{
close(fd);
date = mus_sound_write_date(argv[1]);
srate = mus_sound_srate(argv[1]);
chans = mus_sound_chans(argv[1]);
samples = mus_sound_samples(argv[1]);
comment = mus_sound_comment(argv[1]);
length = (double)samples / (float)(chans * srate);
strftime(timestr, 64, "%a %d-%b-%y %H:%M %Z", localtime(&amp;date));
fprintf(stdout, "%s:\n srate: %d\n chans: %d\n length: %f\n",
argv[1], srate, chans, length);
fprintf(stdout, " header: %s\n sample type: %s\n written: %s\n comment: %s\n",
mus_header_type_name(mus_sound_header_type(argv[1])),
mus_sample_type_name(mus_sound_sample_type(argv[1])),
timestr, comment);
}
else
fprintf(stderr, "%s: %s\n", argv[1], strerror(errno));
return(0);
}
</pre>


<div class="innerheader" id="sndplay">sndplay</div>

<p>This code plays a sound file (sndplay.c):</p>

<pre>

int main(int argc, char *argv[])
{
int fd, afd, i, j, n, k, chans, srate, outbytes;
mus_long_t framples;
mus_float_t **bufs;
short *obuf;
mus_sound_initialize();
fd = mus_sound_open_input(argv[1]);
if (fd != -1)
{
chans = mus_sound_chans(argv[1]);
srate = mus_sound_srate(argv[1]);
framples = mus_sound_framples(argv[1]);
outbytes = BUFFER_SIZE * chans * 2;
bufs = (mus_float_t **)calloc(chans, sizeof(mus_float_t *));
for (i=0;i&lt;chans;i++)
bufs[i] = (mus_float_t *)calloc(BUFFER_SIZE, sizeof(mus_float_t));
obuf = (short *)calloc(BUFFER_SIZE * chans, sizeof(short));
afd = mus_audio_open_output(MUS_AUDIO_DEFAULT, srate, chans, MUS_AUDIO_COMPATIBLE_FORMAT, outbytes);
if (afd != -1)
{
for (i = 0; i &lt; framples; i += BUFFER_SIZE)
{
mus_sound_read(fd, 0, BUFFER_SIZE - 1, chans, bufs);
for (k = 0, j = 0; k &lt; BUFFER_SIZE; k++, j += chans)
for (n = 0; n &lt; chans; n++)
obuf[j + n] = MUS_SAMPLE_TO_SHORT(bufs[n][k]);
mus_audio_write(afd, (char *)obuf, outbytes);
}
mus_audio_close(afd);
}
mus_sound_close_input(fd);
for (i = 0; i &lt; chans; i++) free(bufs[i]);
free(bufs);
free(obuf);
}
return(0);
}

</pre>



<div class="innerheader" id="sndsine">sndsine</div>

<p>This program writes a one channel NeXT/Sun sound file
containing a sine wave at 440 Hz.</p>

<pre>
int main(int argc, char *argv[])
{
int fd, i, k, framples;
float phase, incr;
mus_float_t *obuf[1];
mus_sound_initialize();
fd = mus_sound_open_output(argv[1], 22050, 1, MUS_BSHORT, MUS_NEXT, "created by sndsine");
if (fd != -1)
{
framples = 22050;
phase = 0.0;
incr = 2 * M_PI * 440.0 / 22050.0;
obuf[0] = (mus_float_t *)calloc(BUFFER_SIZE, sizeof(mus_float_t));
k = 0;
for (i = 0; i &lt; framples; i++)
{
obuf[0][k] = MUS_FLOAT_TO_SAMPLE(0.1 * sin(phase)); /* amp = .1 */
phase += incr;
k++;
if (k == BUFFER_SIZE)
{
mus_sound_write(fd, 0, BUFFER_SIZE-1, 1, obuf);
k=0;
}
}
if (k &gt; 0) mus_sound_write(fd, 0, k - 1, 1, obuf);
mus_sound_close_output(fd, 22050 * mus_bytes_per_sample(MUS_BSHORT));
free(obuf[0]);
}
return(0);
}
</pre>



<div class="innerheader" id="clmosc">clmosc</div>

<p>This is program uses the clm.c oscillator and output functions to write the same sine wave
as we wrote in SndSine.</p>
<pre>
int main(int argc, char *argv[])
{
int i;
mus_any *osc, *op;
mus_sound_initialize();
osc = mus_make_oscil(440.0, 0.0);
op = mus_make_sample_to_file("test.snd", 1, MUS_BSHORT, MUS_NEXT);
if (op)
for (i = 0; i &lt; 22050; i++)
mus_sample_to_file(op, i, 0, .1 * mus_oscil(osc, 0.0, 0.0));
mus_free(osc);
if (op) mus_free(op);
return(0);
}
</pre>
<p>Here is the fm-violin and a sample with-sound call:</p>
<pre>
static int feq(float x, int i) {return(fabs(x-i)&lt;.00001);}

void fm_violin(float start, float dur, float frequency, float amplitude, float fm_index, mus_any *op)
{
float pervibfrq = 5.0,
ranvibfrq = 16.0,
pervibamp = .0025,
ranvibamp = .005,
noise_amount = 0.0,
noise_frq = 1000.0,
gliss_amp = 0.0,
fm1_rat = 1.0,
fm2_rat = 3.0,
fm3_rat = 4.0,
reverb_amount = 0.0,
degree = 0.0,
distance = 1.0;
float fm_env[] = {0.0, 1.0, 25.0, 0.4, 75.0, 0.6, 100.0, 0.0};
float amp_env[] = {0.0, 0.0, 25.0, 1.0, 75.0, 1.0, 100.0, 0.0};
float frq_env[] = {0.0, -1.0, 15.0, 1.0, 25.0, 0.0, 100.0, 0.0};
int beg = 0, end, easy_case = 0, npartials, i;
float *coeffs, *partials;
float frq_scl, maxdev, logfrq, sqrtfrq, index1, index2, index3, norm;
float vib = 0.0, modulation = 0.0, fuzz = 0.0, indfuzz = 1.0;
mus_any *carrier, *fmosc1, *fmosc2, *fmosc3, *ampf;
mus_any *indf1, *indf2, *indf3, *fmnoi = NULL, *pervib, *ranvib, *frqf = NULL, *loc;
beg = start * mus_srate();
end = beg + dur * mus_srate();
frq_scl = mus_hz_to_radians(frequency);
maxdev = frq_scl * fm_index;
if ((noise_amount == 0.0) &amp;&amp;
(feq(fm1_rat, floor(fm1_rat))) &amp;&amp;
(feq(fm2_rat, floor(fm2_rat))) &amp;&amp;
(feq(fm3_rat, floor(fm3_rat))))
easy_case = 1;
logfrq = log(frequency);
sqrtfrq = sqrt(frequency);
index1 = maxdev * 5.0 / logfrq;
if (index1 &gt; M_PI) index1 = M_PI;
index2 = maxdev * 3.0 * (8.5 - logfrq) / (3.0 + frequency * .001);
if (index2 &gt; M_PI) index2 = M_PI;
index3 = maxdev * 4.0 / sqrtfrq;
if (index3 &gt; M_PI) index3 = M_PI;
if (easy_case)
{
npartials = floor(fm1_rat);
if ((floor(fm2_rat)) &gt; npartials) npartials = floor(fm2_rat);
if ((floor(fm3_rat)) &gt; npartials) npartials = floor(fm3_rat);
npartials++;
partials = (float *)calloc(npartials, sizeof(float));
partials[(int)(fm1_rat)] = index1;
partials[(int)(fm2_rat)] = index2;
partials[(int)(fm3_rat)] = index3;
coeffs = mus_partials_to_polynomial(npartials, partials, 1);
norm = 1.0;
}
else norm = index1;
carrier = mus_make_oscil(frequency, 0.0);
if (easy_case == 0)
{
fmosc1 = mus_make_oscil(frequency * fm1_rat, 0.0);
fmosc2 = mus_make_oscil(frequency * fm2_rat, 0.0);
fmosc3 = mus_make_oscil(frequency * fm3_rat, 0.0);
}
else fmosc1 = mus_make_oscil(frequency, 0.0);
ampf = mus_make_env(amp_env, 4, amplitude, 0.0, 1.0, dur, 0, NULL);
indf1 = mus_make_env(fm_env, 4, norm, 0.0, 1.0, dur, 0, NULL);
if (gliss_amp != 0.0)
frqf = mus_make_env(frq_env, 4, gliss_amp * frq_scl, 0.0, 1.0, dur, 0, NULL);
if (easy_case == 0)
{
indf2 = mus_make_env(fm_env, 4, index2, 0.0, 1.0, dur, 0, NULL);
indf3 = mus_make_env(fm_env, 4, index3, 0.0, 1.0, dur, 0, NULL);
}
pervib = mus_make_triangle_wave(pervibfrq, frq_scl * pervibamp, 0.0);
ranvib = mus_make_rand_interp(ranvibfrq, frq_scl * ranvibamp);
if (noise_amount != 0.0) fmnoi = mus_make_rand(noise_frq, noise_amount * M_PI);
loc = mus_make_locsig(degree, distance, reverb_amount, 1, (mus_any *)op, 0, NULL, MUS_INTERP_LINEAR);
for (i = beg; i &lt; end; i++)
{
if (noise_amount != 0.0) fuzz = mus_rand(fmnoi, 0.0);
if (frqf) vib = mus_env(frqf); else vib = 0.0;
vib += mus_triangle_wave(pervib, 0.0) + mus_rand_interp(ranvib, 0.0);
if (easy_case)
modulation = mus_env(indf1) *
mus_polynomial(coeffs, mus_oscil(fmosc1, vib, 0.0), npartials);
else
modulation = mus_env(indf1) * mus_oscil(fmosc1, (fuzz + fm1_rat * vib), 0.0) +
mus_env(indf2) * mus_oscil(fmosc2, (fuzz + fm2_rat * vib), 0.0) +
mus_env(indf3) * mus_oscil(fmosc3, (fuzz + fm3_rat * vib), 0.0);
mus_locsig(loc, i, mus_env(ampf) * mus_oscil(carrier, vib + indfuzz * modulation, 0.0));
}
mus_free(pervib);
mus_free(ranvib);
mus_free(carrier);
mus_free(fmosc1);
mus_free(ampf);
mus_free(indf1);
if (fmnoi) mus_free(fmnoi);
if (frqf) mus_free(frqf);
if (!(easy_case))
{
mus_free(indf2);
mus_free(indf3);
mus_free(fmosc2);
mus_free(fmosc3);
}
else
free(partials);
mus_free(loc);
}

int main(int argc, char *argv[])
{
mus_any *op = NULL;
mus_sound_initialize();
op = mus_make_sample_to_file("test.snd", 1, MUS_BSHORT, MUS_NEXT);
if (op)
{
fm_violin(0.0, 20.0, 440.0, .3, 1.0, op);
mus_free(op);
}
return(0);
}
</pre>
<p>The CLM version is v.ins, the Scheme version can be found in <a href="sndscm.html#vdoc">v.scm</a>,
and the Ruby version is in v.rb.
This code can be run:</p>
<pre>
cc v.c -o vc -O3 -lm io.o headers.o audio.o sound.o clm.o -DLINUX
</pre>

<p>For generators such as src that take a function for "as-needed" input,
you can use something like:</p>
<pre>
static mus_float_t input_as_needed(void *arg, int dir) {/* get input here &mdash; arg is "sf" passed below */}

static SCM call_phase-vocoder(void)
{
mus_any *pv;
int sf; /* file channel or whatever */
pv = mus_make_phase_vocoder(NULL, 512, 4, 128, 0.5, NULL, NULL, NULL, (void *)sf);
mus_phase_vocoder(pv, &amp;input_as_needed);
/* etc */
}
</pre>

<!--
void src_file(const char *file, double ratio)
{
mus_any **rds, **srcs;
char *temp_out;
const char *comment;
int k, chan, chans, width = 32, out_fd, sample_type, header_type, buffer_size;
mus_long_t samp, old_samps, new_samps;
mus_float_t old_srate, new_srate;
mus_float_t **obufs;

old_srate = mus_srate();
new_srate = mus_sound_srate(file); /* need have no connection with previous CLM srate setting */
mus_set_srate(new_srate);

chans = mus_sound_chans(file);
sample_type = mus_sound_sample_type(file);
header_type = mus_sound_header_type(file);
comment = mus_sound_comment(file);
buffer_size = mus_file_buffer_size();
old_samps = mus_sound_framples(file);
new_samps = old_samps / ratio; /* old-srate/new-srate in-coming */

temp_out = snd_tempnam();
out_fd = mus_sound_open_output(temp_out, new_srate, chans, sample_type, header_type, comment);

srcs = (mus_any **)malloc(chans * sizeof(mus_any *));
rds = (mus_any **)malloc(chans * sizeof(mus_any *));
obufs = (mus_float_t **)malloc(chans * sizeof(mus_float_t));

for (chan = 0; chan < chans; chan++)
{
rds[chan] = mus_make_readin(file, chan, 0, 1);
srcs[chan] = mus_make_src(NULL, ratio, width, (void *)rds[chan]);
obufs[chan] = (mus_float_t *)malloc(buffer_size * sizeof(mus_float_t));
}

for (k = 0, samp = 0; samp < new_samps; samp++)
{
for (chan = 0; chan < chans; chan++)
obufs[chan][k] = MUS_FLOAT_TO_SAMPLE(mus_src(srcs[chan], 0.0, &input_as_needed));
k++;
if (k == buffer_size)
{
mus_sound_write(out_fd, 0, buffer_size - 1, chans, obufs);
k = 0;
}
}
if (k > 0)
mus_sound_write(out_fd, 0, k - 1, chans, obufs);

mus_sound_close_output(out_fd, new_samps * chans * mus_bytes_per_sample(sample_type));
mus_sound_forget(file);

for (chan = 0; chan < chans; chan++)
{
free(obufs[chan]);
mus_free(srcs[chan]);
mus_free(rds[chan]);
}
free(obufs);
free(srcs);
free(rds);

move_file(temp_out, file);
free(temp_out);
mus_set_srate(old_srate);
}
-->

<p>
Michael Scholz
has written a package using these functions, and several CLM instruments:
see the sndins directory, and in particular the README file, for details.
</p>




<div class="innerheader" id="otherexamples">Other examples</div>

<p>The primary impetus for the sound library was the development
of Snd and CLM, both of which are freely available.
</p>



<div class="header" id="sndlibxen">Extension Languages</div>

<p>Much of sndlib is accessible at run time in any program that has one of
the languages supported by the xen package (s7, Ruby, Forth);
the modules sndlib2xen and clm2xen tie most of the library into that language
making it possible to call the library functions from its interpreter. The documentation
is scattered around, unfortunately: the clm side is in sndclm.html and extsnd.html with many
examples in Snd's <a href="sndscm.html#exampdoc">examp.scm</a>. Most of these are obvious translations of the
constants and functions described above into Scheme. To initialize sndlib, call Init_sndlib,
or, at run time, use s7's loader and s7_init_sndlib:
</p>

<pre>
(let ((sndlib (load "libsndlib.so"
(inlet (curlet)
(cons 'init_func 's7_init_sndlib)))))
....)
</pre>

<p>Init_sndlib ties most of the functions mentioned above into the extension language (s7, Forth, or Ruby).
</p>

<pre>
mus-next mus-aifc mus-rf64 mus-riff mus-nist mus-raw mus-ircam mus-aiff mus-bicsf mus-soundfont mus-voc mus-svx mus-caff

mus-bshort mus-lshort mus-mulaw mus-alaw mus-byte mus-ubyte mus-bfloat
mus-lfloat mus-bint mus-lint mus-b24int mus-l24int mus-bdouble mus-ldouble
mus-ubshort mus-ulshort

mus-sound-samples (filename) samples of sound according to header (can be incorrect)
mus-sound-framples (filename) framples of sound according to header (can be incorrect)
mus-sound-duration (filename) duration of sound in seconds
mus-sound-datum-size (filename) bytes per sample
mus-sound-data-location (filename) location of first sample (bytes)
mus-sound-chans (filename) number of channels (samples are interleaved)
mus-sound-srate (filename) sampling rate
mus-sound-header-type (filename) header type (e.g. mus-aiff)
mus-sound-sample-type (filename) sample type (e.g. mus-bshort)
mus-sound-length (filename) true file length (bytes)
mus-sound-type-specifier (filename) original header type identifier
mus-sound-maxamp(filename) returns a list of max amps and locations thereof
mus-sound-loop-info(filename) returns list of 4 loop values (the actual mark positions here, not
the so-called id's), then base-note and base-detune
mus-header-type-name (type) e.g. "AIFF"
mus-sample-type-name (format) e.g. "16-bit big endian linear"
mus-sound-comment (filename) header comment, if any
mus-sound-write-date (filename) sound write date
sample-type-bytes-per-sample (format) bytes per sample

mus-sound-open-input (filename) open filename (a sound file) returning an integer ("fd" below)
mus-sound-open-output (filename srate chans sample-type header-type comment)
create a new sound file with the indicated attributes, return "fd"
mus-sound-reopen-output (filename chans sample-type header-type data-location)
reopen (without disturbing) filename, ready to be written
mus-sound-close-input (fd) close sound file
mus-sound-close-output (fd bytes) close sound file and update its length indication, if any
mus-sound-read (fd beg end chans sdata) read data from sound file fd loading the data array from beg to end
sdata is a float-vector that should be able to accommodate the read
mus-sound-write (fd beg end chans sdata) write data to sound file fd
mus-sound-seek-frample (fd frample) move to frample in sound file fd
mus-file-clipping (fd) whether output is clipped in file 'fd'
mus-clipping () global clipping choice

mus-oss-set-buffers (num size) in Linux (OSS) sets the number and size of the OSS "fragments"

;;; this function prints header information
(define info
(lambda (file)
(string-append
file
": chans: " (number-&gt;string (mus-sound-chans file))
", srate: " (number-&gt;string (mus-sound-srate file))
", " (mus-header-type-name (mus-sound-header-type file))
", " (mus-sample-type-name (mus-sound-sample-type file))
", len: " (number-&gt;string
(/ (mus-sound-samples file)
(* (mus-sound-chans file) (mus-sound-srate file)))))))
</pre>


<div class="innerheader">s7 repl and sndlib</div>

<pre>
#include &lt;stdlib.h&gt;
#include &lt;stdio.h&gt;
#include &lt;string.h&gt;
#include &lt;unistd.h&gt;

#include "mus-config.h"
#include "s7.h"
#include "xen.h"
#include "clm.h"
#include "clm2xen.h"

static void mus_error_to_s7(int type, char *msg)
{
s7_error(s7, /* s7 is declared in xen.h, defined in xen.c */
s7_make_symbol(s7, "mus-error"),
s7_cons(s7, s7_make_string(s7, msg), s7_nil(s7)));
}

int main(int argc, char **argv)
{
s7 = s7_init();

s7_xen_initialize(s7);
Init_sndlib();
mus_error_set_handler(mus_error_to_s7); /* catch low-level errors and pass them to s7-error */

if (argc == 2)
{
fprintf(stderr, "load %s\n", argv[1]);
s7_load(s7, argv[1]);
}
else
{
s7_load(s7, "repl.scm");
s7_eval_c_string(s7, "((*repl* 'run))");
}

return(0);
}

/* gcc -o sl sl.c /home/bil/test/sndlib/libsndlib.a -Wl,-export-dynamic -lasound -lm -I. -ldl -lgsl -lgslcblas -lfftw3
*
* (load "sndlib-ws.scm")
* (load "v.scm")
* (set! *clm-player* (lambda (file) (system (format #f "sndplay ~A" file))))
* (with-sound (:play #t) (fm-violin 0 1 330 .1))
*/
</pre>


<div class="related">
related documentation: &nbsp;
<a href="snd.html">snd.html &nbsp;</a>
<a href="grfsnd.html">grfsnd.html &nbsp;</a>
<a href="extsnd.html">extsnd.html &nbsp;</a>
<a href="sndscm.html">sndscm.html &nbsp;</a>
<a href="sndclm.html">sndclm.html &nbsp;</a>
<a href="s7.html">s7.html &nbsp;</a>
<a href="index.html">index.html</a>
</div>

</body>
</html>

+ 13
- 0
lib/sndlib/sndlib.pc.in View File

@@ -0,0 +1,13 @@
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@

SNDLIB_LANGUAGE=@SNDLIB_LANGUAGE@
SNDLIB_AUDIO=@AUDIO_CHOICE@

Name: sndlib
Description: audio library
Version: @SNDLIB_VERSION@
Libs: @LIBS@ @GSL_LIBS@ @AUDIO_LIB@ @XEN_LIBS@ @JACK_LIBS@ -lm
Cflags:

+ 1281
- 0
lib/sndlib/sndlib2xen.c
File diff suppressed because it is too large
View File


+ 31
- 0
lib/sndlib/sndlib2xen.h View File

@@ -0,0 +1,31 @@
#ifndef SNDLIB2XEN_H
#define SNDLIB2XEN_H

#include "xen.h"

/* error indications */

#define NO_SUCH_CHANNEL Xen_make_error_type("no-such-channel")
#define NO_SUCH_FILE Xen_make_error_type("no-such-file")
#define BAD_TYPE Xen_make_error_type("bad-type")
#define NO_DATA Xen_make_error_type("no-data")
#define BAD_HEADER Xen_make_error_type("bad-header")

#ifdef __cplusplus
extern "C" {
#endif

MUS_EXPORT void mus_sndlib_xen_initialize (void);
MUS_EXPORT Xen g_mus_sound_srate(Xen filename); /* snd-snd.c */
MUS_EXPORT Xen g_mus_sound_chans(Xen filename); /* snd-snd.c */
MUS_EXPORT Xen g_mus_sound_framples(Xen filename); /* snd-chn.c */
MUS_EXPORT Xen g_mus_expand_filename(Xen file); /* snd-snd.c */
MUS_EXPORT Xen g_mus_sound_maxamp(Xen file); /* snd-chn.c */

MUS_EXPORT Xen g_mus_sound_path(void);

#ifdef __cplusplus
}
#endif

#endif

Some files were not shown because too many files changed in this diff

Loading…
Cancel
Save