diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ 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.
+
+
+ Copyright (C)
+
+ 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 .
+
+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:
+
+ Copyright (C)
+ 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
+.
+
+ 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
+.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,44 @@
+.PHONY: ghci jack jack-rt supercollider supercollider-rt scj
+
+ghci:
+ ghci -i:src
+
+jack:
+# -n 2 is default, larger values are not supported
+ jackd -d alsa -r 44100 -n 3 -d hw:0 &
+# jackd -d alsa -r 44100 -d hw:0 &
+
+jack-stop:
+ kill `pgrep jackd`
+
+supercollider:
+ (export SC_JACK_DEFAULT_OUTPUTS=alsa_pcm:playback_1,alsa_pcm:playback_2; \
+ scsynth -u 57110 -D 0)
+
+supercollider-stop:
+ kill `pgrep scsynth`
+
+scj: jack supercollider
+
+
+jack-rt:
+# block size 4096 freezes the machine
+# more than two buffer blocks (-n 2) are not supported
+# jackd --realtime -d alsa -r 44100 -p 4096 -d hw:0 &
+ jackd --realtime -d alsa -r 44100 -d hw:0 &
+
+scj-rt: jack-rt supercollider
+ echo "start with 'sudo make scj-rt'"
+
+
+jack-sudo:
+# causes repeated message "delay of 68264.000 usecs exceeds estimated spare time of 23188.000; restart ..."
+# sudo jackd -R -d alsa -r 44100 -n 2 -d hw:0 &
+# sudo jackd -P 15 -d alsa -r 44100 -n 2 -d hw:0 &
+ sudo jackd --realtime -d alsa -r 44100 -n 2 -d hw:0 &
+
+supercollider-sudo:
+ echo 'export SC_JACK_DEFAULT_OUTPUTS=alsa_pcm:playback_1,alsa_pcm:playback_2; scsynth -u 57110 -D 0' | sudo bash
+
+scj-sudo: jack-sudo supercollider-sudo
+
diff --git a/Readme b/Readme
new file mode 100644
--- /dev/null
+++ b/Readme
@@ -0,0 +1,40 @@
+We assume that we have successfully installed haskore-supercollider
+and all of its dependencies.
+Now, how do we get something to hear?
+
+When SuperCollider and JACK are available, but not currently running,
+start 'jack' with
+
+$ make jack
+
+and SuperCollider (scsynth) with
+
+$ make supercollider
+
+or both together
+
+$ make scj
+
+
+If SuperCollider server is running,
+then start Haskore (make ghci) in a new terminal:
+
+*Main> :load Haskore.Interface.SuperCollider.Example
+...
+*Haskore.Interface.SuperCollider.Example> play glissando
+...
+*Haskore.Interface.SuperCollider.Example> play chillOut
+...
+
+*Main> :load Haskore.Interface.SuperCollider.Play.Life
+...
+*Haskore.Interface.SuperCollider.Play.Life> sawPerc <- installInstr0 "saw percussion" Example.sawPercUGen
+*Haskore.Interface.SuperCollider.Play.Life> playKeyboard sawPerc
+
+Then hit some keys, terminate with CTRL-D.
+However, playing will only work as expected on a German keyboard.
+Create a string like germanKeyboard for your needs and use this instead.
+
+If you installed the package with Cabal
+a program 'song-air' is compiled which plays a nice demo song
+using Haskore and SuperCollider (scsynth must be running).
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/haskore-supercollider.cabal b/haskore-supercollider.cabal
new file mode 100644
--- /dev/null
+++ b/haskore-supercollider.cabal
@@ -0,0 +1,91 @@
+Name: haskore-supercollider
+Version: 0.0.2
+License: GPL
+License-File: LICENSE
+Author: Henning Thielemann
+Homepage: http://www.haskell.org/haskellwiki/SuperCollider
+Package-URL: http://darcs.haskell.org/haskore-supercollider/
+Category: Sound
+Synopsis: Haskore back-end for SuperCollider
+Description:
+ This package lets you play Haskore music via Supercollider
+ using the packages @hosc@ and @hsc3@.
+ The functions manage NodeIds and SuperCollider buffers for you.
+ We support realtime replay and rendering to disk.
+Stability: Experimental
+Tested-With: GHC==6.4.1, GHC==6.8.2
+Cabal-Version: >=1.2
+Build-Type: Simple
+
+Extra-Source-Files:
+ Makefile
+ Readme
+
+Flag splitBase
+ description: Choose the new smaller, split-up base package.
+
+Flag buildTests
+ description: Build test executables
+ default: False
+
+Library
+ Build-Depends:
+ haskore-realtime >= 0.0.2 && < 0.1,
+ haskore >=0.0.5 && <0.1,
+ -- for SuperCollider support
+ hosc >=0.1 && <0.2, hsc3 >=0.1 && <0.2, supercollider-ht >=0.0 && <0.1,
+ bytestring >=0.9 && <1.0,
+ -- dependency on non-negative for Haddock
+ non-negative >=0.0.1 && <0.1,
+ event-list >=0.0.6 && <0.1,
+ data-accessor >=0.1 && <0.2,
+ unix >= 2.0 && <3,
+ mtl >=1.0 && <2
+
+ If flag(splitBase)
+ Build-Depends:
+ base >= 3, random >= 1.0 && < 1.1, array >= 0.1 && < 1, process >= 1.0 && < 1.1
+ Else
+ Build-Depends:
+ base >= 1.0 && < 2
+
+ GHC-Options: -Wall
+ Hs-source-dirs: src
+ Exposed-modules:
+ Haskore.Interface.SuperCollider.Channel,
+ Haskore.Interface.SuperCollider.Channel.State,
+ Haskore.Interface.SuperCollider.Channel.File,
+ -- needs 'unix' package
+ Haskore.Interface.SuperCollider.Channel.Env,
+ Haskore.Interface.SuperCollider.Example,
+ Haskore.Interface.SuperCollider.SoundMap,
+ -- needs Haskore.Interface.SuperCollider.Channel.Env and thus 'unix' package
+ Haskore.Interface.SuperCollider.Note,
+ Haskore.Interface.SuperCollider.Performance,
+ Haskore.Interface.SuperCollider.Play,
+ Haskore.Interface.SuperCollider.Play.Install,
+ Haskore.Interface.SuperCollider.Play.Channel,
+ Haskore.Interface.SuperCollider.Play.Life,
+ Haskore.Interface.SuperCollider.Render,
+ Haskore.Interface.SuperCollider.Schedule,
+ Haskore.Interface.SuperCollider.Schedule.Install,
+ Haskore.Interface.SuperCollider.Schedule.Channel
+ Other-modules:
+ Haskore.Interface.SuperCollider.Example.Air,
+ Haskore.Interface.SuperCollider.Example.Morph
+
+Executable song-air
+ Hs-source-dirs: src
+ GHC-Options: -Wall
+ Main-Is: Haskore/Interface/SuperCollider/Example/AirMain.hs
+
+Executable test
+ If !flag(buildTests)
+ Buildable: False
+
+ Build-Depends:
+ QuickCheck >=1 && <2, HUnit >=1.2 && <1.3
+ Hs-source-dirs: src
+ GHC-Options: -Wall
+ Main-Is: Test/Main.hs
+ Buildable: False
diff --git a/src/Haskore/Interface/SuperCollider/Channel.hs b/src/Haskore/Interface/SuperCollider/Channel.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Channel.hs
@@ -0,0 +1,43 @@
+{- |
+Bookkeeping of SuperCollider channels
+-}
+module Haskore.Interface.SuperCollider.Channel where
+
+-- import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.IO as SCIO
+import qualified Sound.SC3.UGen.Rate as SCRate
+import Sound.SC3.UGen.UGen (UGen)
+
+
+type Channel = Int
+type NumberChannels = Int
+
+
+{- |
+We reserve the first two channels for the stereo output.
+We must not use them for instruments.
+This is too unflexible and will certainly change in the future.
+-}
+least :: Channel
+least = 2
+
+
+data T m =
+ Cons {
+ next :: NumberChannels -> m Channel,
+ reset :: m ()
+-- liftTransport :: Trans.IO t a -> m a
+ }
+
+
+
+
+readUGen :: NumberChannels -> Channel -> UGen
+readUGen numChan chan =
+ SCIO.in' numChan SCRate.AR (SCUGen.Constant (fromIntegral chan))
+
+writeUGen :: Channel -> UGen -> UGen
+writeUGen chan =
+ SCIO.out (SCUGen.Constant (fromIntegral chan))
diff --git a/src/Haskore/Interface/SuperCollider/Channel/Env.hs b/src/Haskore/Interface/SuperCollider/Channel/Env.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Channel/Env.hs
@@ -0,0 +1,39 @@
+{- |
+An instance of 'Haskore.Interface.SuperCollider.Channel.T'
+using environment variables.
+Since we need writing of variables,
+we need "System.Posix.Env" module
+rather than the generic "System.Environment".
+-}
+module Haskore.Interface.SuperCollider.Channel.Env where
+
+import qualified Haskore.Interface.SuperCollider.Channel as ChannelMng
+import Haskore.Interface.SuperCollider.Channel
+ (Channel, NumberChannels)
+
+import System.Posix.Env (setEnv, getEnv)
+import Data.Char (isDigit)
+
+
+manager :: ChannelMng.T IO
+manager = ChannelMng.Cons next reset
+
+
+next :: NumberChannels -> IO Channel
+next inc =
+ do maybeNumStr <- getEnv envName
+ let num =
+ maybe ChannelMng.least
+ (\numStr ->
+ if all isDigit numStr
+ then read numStr
+ else ChannelMng.least)
+ maybeNumStr
+ setEnv envName (show (inc+num)) True
+ return num
+
+reset :: IO ()
+reset = setEnv envName (show ChannelMng.least) True
+
+envName :: String
+envName = "HaskoreSC3Channel"
diff --git a/src/Haskore/Interface/SuperCollider/Channel/File.hs b/src/Haskore/Interface/SuperCollider/Channel/File.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Channel/File.hs
@@ -0,0 +1,35 @@
+{- |
+An instance of 'Haskore.Interface.SuperCollider.Channel.T'
+using a temporary file.
+-}
+module Haskore.Interface.SuperCollider.Channel.File where
+
+import qualified Haskore.Interface.SuperCollider.Channel as ChannelMng
+import Haskore.Interface.SuperCollider.Channel
+ (Channel, NumberChannels)
+
+-- import System.Directory (removeFile)
+import Data.Char (isDigit)
+
+
+manager :: ChannelMng.T IO
+manager = ChannelMng.Cons next reset
+
+
+next :: NumberChannels -> IO Channel
+next inc =
+ do num <- catch
+ (do numStr <- readFile fileName
+ if all isDigit numStr
+ then return (read numStr)
+ else ioError (userError "not a number in channel file"))
+ (const $ return ChannelMng.least)
+ -- removeFile fileName
+ writeFile fileName (show (inc+num))
+ return num
+
+reset :: IO ()
+reset = writeFile fileName (show ChannelMng.least)
+
+fileName :: FilePath
+fileName = "sc3-channel"
diff --git a/src/Haskore/Interface/SuperCollider/Channel/State.hs b/src/Haskore/Interface/SuperCollider/Channel/State.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Channel/State.hs
@@ -0,0 +1,29 @@
+{- |
+An instance of 'Haskore.Interface.SuperCollider.Channel.T'
+using a 'StateT' monad transformer.
+-}
+module Haskore.Interface.SuperCollider.Channel.State where
+
+import qualified Control.Monad.State as State
+import Control.Monad.State (StateT)
+
+import qualified Haskore.Interface.SuperCollider.Channel as ChannelMng
+import Haskore.Interface.SuperCollider.Channel
+ (Channel, NumberChannels)
+
+
+manager :: Monad m => ChannelMng.T (StateT Channel m)
+manager = ChannelMng.Cons next reset
+
+
+next :: Monad m =>
+ NumberChannels -> StateT Channel m Channel
+next inc =
+ do num <- State.get
+ State.modify (inc+)
+ return num
+
+reset :: Monad m =>
+ StateT Channel m ()
+reset =
+ State.put ChannelMng.least
diff --git a/src/Haskore/Interface/SuperCollider/Example.hs b/src/Haskore/Interface/SuperCollider/Example.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Example.hs
@@ -0,0 +1,536 @@
+module Haskore.Interface.SuperCollider.Example where
+
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Render as Render
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Math as SCMath
+import qualified Sound.SC3.UGen.Rate as SCRate
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilter
+import qualified Sound.SC3.UGen.Noise.Base as SCNoise
+import qualified Sound.SC3.UGen.Envelope as SCEnv
+import qualified Sound.SC3.UGen.Envelope.Construct as SCEnvCons
+import Sound.SC3.UGen.Enum
+ (DoneAction(DoNothing, PauseSynth),
+ EnvCurve(EnvLin, EnvSin))
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Haskore.Melody.Standard as StdMelody
+import qualified Haskore.Melody as Melody
+import Haskore.Music.Rhythmic as RhyMusic
+import qualified Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music as Music
+
+import qualified Haskore.Example.ChildSong6 as ChildSong6
+import qualified Haskore.Example.Kantate147 as Kantate147
+
+import qualified Haskore.Composition.Drum as Drum
+import qualified Haskore.Composition.Chord as Chord
+import qualified Haskore.Composition.Rhythm as Rhythm
+
+import qualified Haskore.Basic.Duration as Dur
+
+import qualified Data.ByteString.Lazy as B
+
+import qualified Data.Accessor.Basic as Accessor
+
+
+import Data.List (genericLength)
+import Data.Ratio(Rational,(%))
+import System.Random (randomRs, mkStdGen)
+
+
+latency :: Schedule.Time
+latency = 0.1
+
+type Song = (String, Schedule.T)
+
+play :: Song -> IO ()
+play =
+ Play.schedule latency . snd
+
+render :: Song -> IO ()
+render (fileName, schedule) =
+ do B.writeFile (fileName++".osc") (Render.byteStringFromSchedule schedule)
+ Render.runSCSynth [] 2 Render.AIFF Render.Int16 44100 fileName
+ return ()
+
+
+
+glissandoStringsUGen :: UGen -> UGen -> UGen
+glissandoStringsUGen vel freq =
+ let -- control = 2*freq - SCFilter.lag freq 0.2
+ control = SCFilter.lag freq 0.2
+ volume = vel * 0.3
+ tone0 = SCOsci.saw SCRate.AR (control * SCUGen.MCE [0.998, 1.005])
+ tone1 = SCOsci.saw SCRate.AR (control * SCUGen.MCE [0.995, 1.002])
+ in (tone0 + tone1) * volume
+
+reverb :: UGen -> UGen -> UGen
+reverb dec x =
+ 0.7*x + 0.03 *
+ sum (map
+ (\delfl -> let del = SCUGen.Constant delfl
+ in SCFilter.combN x del del dec)
+ (take 8 (randomRs (0.01,0.03) (mkStdGen 2347))))
+
+filterStrings :: SoundMap.Instrument
+filterStrings =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let lfo = SCOsci.sinOsc SCRate.KR 0.1 0 * 1500 + 2000
+ sweep = SCFilter.rlpf (glissandoStringsUGen vel freq) lfo 0.1
+ in reverb 3 sweep
+
+
+glissando :: Song
+glissando =
+ ("Glissando",
+ Schedule.fromMelody filterStrings $
+ changeTempo 3 $ transpose (-48) $
+ Melody.toMelodyNullAttr $ ChildSong6.mainVoice)
+
+
+-- | normalize a list of numbers, such that they have a specific average
+normalizeLevel :: Fractional a => a -> [a] -> [a]
+normalizeLevel newAvrg xs =
+ let avrg = sum xs / genericLength xs
+ in map ((newAvrg-avrg)+) xs
+
+strings :: SoundMap.Instrument
+strings =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let n = 5
+ volume = vel * 0.5 / sqrt (fromIntegral n)
+ detunes =
+ normalizeLevel 1 $ take (2*n) $
+ randomRs (0,0.03) $ mkStdGen 912
+ phases =
+ randomRs (0,2) $ mkStdGen 54
+ tones =
+ zipWith
+ (\detune phase -> SCOsci.lfSaw SCRate.AR (freq*detune) phase)
+ detunes phases
+ (tonesLeft,tonesRight) = splitAt n tones
+ in volume * SCUGen.MCE [sum tonesLeft, sum tonesRight]
+
+modulatedStrings :: SoundMap.Instrument
+modulatedStrings =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let n = 3
+ volume = vel * 0.3 / sqrt (fromIntegral n)
+ tones =
+ zipWith3
+ (\depth rate phase ->
+ SCOsci.saw SCRate.AR
+ (freq * (1 + depth * SCOsci.sinOsc SCRate.KR rate phase)))
+ (randomRs (0,0.015) (mkStdGen 912))
+ (randomRs (2,5) (mkStdGen 105))
+ (randomRs (0,2*pi) (mkStdGen 234))
+ (tonesLeft,tonesRight) = splitAt n $ take (2*n) tones
+ in volume * SCUGen.MCE [sum tonesLeft, sum tonesRight]
+
+brass :: SoundMap.Instrument
+brass =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let volume = vel * 0.3
+ detune = SCEnv.xLine SCRate.KR 10 0.00001 2 PauseSynth
+ tone0 = SCOsci.saw SCRate.AR (freq*(1-0.004*detune)) * volume
+ tone1 = SCOsci.saw SCRate.AR (freq*(1-0.001*detune)) * volume
+ tone2 = SCOsci.saw SCRate.AR (freq*(1+0.005*detune)) * volume
+ in tone0 + tone1 + tone2
+
+sawPerc :: SoundMap.Instrument
+sawPerc = SoundMap.instrumentFromUGen sawPercUGen
+
+-- for demonstration in Play.Life
+sawPercUGen :: UGen -> UGen -> UGen
+sawPercUGen vel freq =
+ let -- env = SCEnv.envGen SCRate.KR 1 2 0 1 PauseSynth SCEnv.envperc'
+ env = SCEnv.xLine SCRate.KR 1.5 0.1 1 PauseSynth
+ saw = vel * SCEnv.xLine SCRate.KR 1 0.05 5 DoNothing
+ * SCOsci.saw SCRate.AR freq
+ prc = SCFilter.rlpf saw (exp env * freq * 1.2) 0.05
+ in prc * 0.3
+
+dynPerc :: UGen -> SoundMap.Instrument
+dynPerc detune = SoundMap.instrumentFromUGen (dynPercUGen detune)
+
+-- for demonstration in Play.Life
+dynPercUGen :: UGen -> UGen -> UGen -> UGen
+dynPercUGen detune vel freq =
+ let env = SCEnv.xLine SCRate.KR 1.5 0.1 1 DoNothing
+ saw = SCEnv.xLine SCRate.KR 1 0.05 5 DoNothing
+ * SCOsci.saw SCRate.AR
+ (SCUGen.MCE [freq*(1-detune), freq*(1+detune)])
+ prc = SCFilter.rlpf saw (exp (2*vel*env) * freq * 1.2) 0.05
+ in prc * 0.1
+
+fmBass :: UGen -> SoundMap.Instrument
+fmBass ratio =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let env = SCEnv.xLine SCRate.KR 1 0.01 1 DoNothing
+ modOsci = SCOsci.sinOsc SCRate.AR (ratio*freq) 0 * env * vel * 10
+ osci = SCOsci.sinOsc SCRate.AR freq modOsci *env
+ in osci * 1
+
+fmGuitar :: UGen -> SoundMap.Instrument
+fmGuitar ratio =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let modEnv = SCEnv.xLine SCRate.KR 0.5 2 5 DoNothing
+ modOsci = SCOsci.sinOsc SCRate.AR (ratio*freq) 0 * modEnv * vel * 10
+ env = SCEnv.xLine SCRate.KR 1 0.01 5 DoNothing
+ lfo = SCOsci.sinOsc SCRate.KR 3 0 * 10
+ osci = SCOsci.sinOsc SCRate.AR (freq+lfo) modOsci * env
+ in osci
+
+
+xylophone :: SoundMap.Instrument
+xylophone =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let env1 = SCEnv.xLine SCRate.KR 1.5 0.03 0.2 PauseSynth
+ sine1 = SCOsci.sinOsc SCRate.AR freq 0 * env1
+ env2 = SCEnv.xLine SCRate.KR 1.5 0.01 0.2 PauseSynth
+ sine2 = SCOsci.sinOsc SCRate.AR (3*freq) 0 * env2 * vel
+ in sine1 + sine2
+
+
+harpsichord :: SoundMap.Instrument
+harpsichord =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let env = SCEnv.xLine SCRate.KR 1.5 0.03 1 PauseSynth
+ saw = SCOsci.saw SCRate.AR (SCUGen.MCE [freq*0.995, freq*1.005]) * env * vel
+ in saw
+
+
+{- |
+The 'dust' UGen as provided by SuperCollider has a problem:
+The higher the sample rate, the more narrow are the impulses,
+the less volume you obtain.
+We work-around this by choosing a larger impulse.
+(We could also use a fixed width for the impulses.)
+-}
+colorDust :: Double -> SoundMap.Instrument
+colorDust sampleRate =
+ SoundMap.instrumentFromUGen $ \ _vel freq ->
+ 0.0005 * SCFilter.rlpf
+ (SCUGen.Constant sampleRate * SCNoise.dust zeroUId SCRate.AR 10)
+ freq 0.01
+
+
+flangerSquare :: UGen -> UGen
+flangerSquare freq =
+ SCOsci.pulse SCRate.AR freq (0.5 + 0.3 * SCOsci.sinOsc SCRate.KR 0.5 0)
+
+cubicSine :: UGen -> UGen
+cubicSine freq =
+ let osci = SCOsci.sinOsc SCRate.AR (SCUGen.MCE [freq*1.003, freq*0.997]) 0
+ in osci*osci*osci
+
+cubicPhaserSaw :: UGen -> UGen
+cubicPhaserSaw freq =
+ let osci dfreq = sum $ map (SCOsci.saw SCRate.AR) [dfreq*1.003, dfreq*0.997]
+ osciCubic dfreq = osci dfreq * osci dfreq * osci dfreq
+ in SCUGen.MCE [osciCubic (freq*1.002), osciCubic (freq*0.998)]
+
+
+
+
+
+midiInstrMap :: SoundMap.InstrumentTable MidiMusic.Instr
+midiInstrMap =
+ [(MidiMusic.AcousticGrandPiano, sawPerc),
+ (MidiMusic.SynthBass1, dynPerc (SCUGen.Constant 0.003)),
+ (MidiMusic.SynthBrass1, brass),
+ (MidiMusic.StringEnsemble1, strings)]
+
+
+childSong :: Song
+childSong =
+ ("ChildSong",
+ Schedule.fromMusic
+ (Schedule.rhythmicMusic [] midiInstrMap)
+ -- (changeTempo 3 (transpose (-48) (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano ChildSong6.mainVoice)))
+ (loudness1 0.5 $ changeTempo 1 $ transpose 0 ChildSong6.song))
+
+bassMusic :: MidiMusic.T
+bassMusic =
+ MidiMusic.fromStdMelody MidiMusic.SynthBass1
+ (Music.line
+ (zipWith
+ (\n v -> n tn (Accessor.set velocity1 (v%1000) na))
+ (cycle [c 0, d 0, g 0, d 0])
+ (randomRs (0,1000) (mkStdGen 142))))
+
+bass :: Song
+bass =
+ ("BassPercs",
+ Schedule.fromMusic
+ (Schedule.rhythmicMusic [] midiInstrMap)
+ bassMusic)
+
+bassFinite :: Song
+bassFinite =
+ ("BassPercs",
+ Schedule.fromMusic (Schedule.rhythmicMusic [] midiInstrMap) $
+ Music.take 4 bassMusic)
+
+
+{- |
+Oscillator with the waveform of a parabola.
+
+The parabola is created by moving a saw up or down, and squaring it.
+That is we repeat the function @\x -> (x+s)^2@.
+
+The crux is the subsequent normalization to zero DC offset.
+This boils down to a parabola plus a saw.
+-}
+parabolaOsci ::
+ UGen {- ^ Zero means a perfect parabola.
+ The higher the absolute value, the closer is the waveform to a saw. -}
+ -> UGen {- ^ frequency -}
+ -> UGen
+parabolaOsci straight freq =
+ let x = SCOsci.saw SCRate.AR freq
+ {-
+ integrate parabola, average and subtract offset
+ (1+s)^3-(-1+s)^3)/3 = (3*s^2+1)*2/3
+
+ (x+s)^2 - (3*s^2+1)*2/(3*2)
+ = (x+s)^2 - (3*s^2+1)/3
+ = x^2 + 2*s*x - 1/3
+ -}
+ in (x+2*straight) * x - 1/3
+
+
+
+kantate147 :: Song
+kantate147 =
+ ("Kantate147",
+ Schedule.fromMusicGlobalEffect
+ (Schedule.rhythmicMusic [] midiInstrMap)
+ (\sig ->
+ flip SCMath.clip2 1 $
+ 0.5*sig + 0.2*SCFilter.combN sig 0.2 0.2 5, 2) $
+ MidiMusic.fromMelodyNullAttr MidiMusic.StringEnsemble1 $
+ loudness1 0.5 $ transpose (-12) $
+ changeTempo 2 Kantate147.song)
+
+
+-------------------------------------------------------------------
+
+
+
+pad :: UGen -> SoundMap.Instrument
+pad dur =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let filtered = SCFilter.bpf mix filterFreq 0.3
+ filterFreq = SCEnv.xLine SCRate.KR 100 4000 totalDur DoNothing
+ totalDur = 3 + dur
+ mix = (tone0 + tone1) * env * vel * 0.2
+ env = SCEnv.envGen SCRate.KR 1 2 0 1 PauseSynth
+ (SCEnvCons.envSine totalDur 1)
+ -- (bridge 1 dur 1)
+ tone0 = SCOsci.saw SCRate.AR (freq * SCUGen.MCE [0.998, 1.005])
+ tone1 = SCOsci.saw SCRate.AR (freq * SCUGen.MCE [0.995, 1.002])
+ in filtered
+
+bridge :: UGen -> UGen -> UGen -> [UGen]
+bridge fadeDur sustainDur lvl =
+ let segTypes = [EnvSin, EnvLin, EnvSin]
+ clippedFadeDur = min fadeDur sustainDur
+ in SCEnvCons.env
+ [0, lvl, lvl, 0]
+ [clippedFadeDur, max 0 (sustainDur-fadeDur), clippedFadeDur]
+ segTypes (-1) (-1)
+
+zeroUId :: SCUGen.UGenId
+zeroUId = SCUGen.UGenId 0
+
+hihat :: SoundMap.Drum
+hihat =
+ SoundMap.drumFromUGen $ \ vel ->
+ let noise = SCNoise.whiteNoise zeroUId SCRate.AR
+ in SCFilter.hpf noise (SCUGen.MCE [4000, 4001]) *
+ SCEnv.xLine SCRate.KR 1 0.01 0.2 DoNothing * vel * 0.25
+
+bassdrum :: SoundMap.Drum
+bassdrum =
+ SoundMap.drumFromUGen $ \ vel ->
+ let freq = SCEnv.xLine SCRate.KR 100 10 0.5 DoNothing
+ env = SCEnv.xLine SCRate.KR 1 0.1 0.5 DoNothing * vel * 0.8
+ osci = SCOsci.sinOsc SCRate.AR freq 0 * SCUGen.MCE [env,env]
+ in SCMath.clip2 0.5 osci
+-- in 0.7 * tanh osci
+
+
+bassdrumOnk :: SoundMap.Drum
+bassdrumOnk =
+ SoundMap.drumFromUGen $ \ vel ->
+ let freq = SCEnv.xLine SCRate.KR 100 10 0.5 DoNothing
+ env = SCEnv.xLine SCRate.KR 1.5 0.1 0.5 DoNothing * vel * 0.8
+ osci = SCOsci.sinOsc SCRate.AR freq 0 * SCUGen.MCE [env,env]
+ distorted = sin (osci^(3::Int))
+ in distorted
+
+
+bassdrumPM :: SoundMap.Drum
+bassdrumPM =
+ SoundMap.drumFromUGen $ \ vel ->
+ let freq = SCEnv.xLine SCRate.KR 100 10 0.5 DoNothing
+ env = SCEnv.xLine SCRate.KR 1 0.1 0.5 DoNothing * vel * 0.8
+ modu = SCOsci.sinOsc SCRate.AR (2.17*freq) 0 * (2*env)
+ osci = SCOsci.sinOsc SCRate.AR freq modu
+ in osci * SCUGen.MCE [env,env]
+
+
+bassdrumNoisy :: SoundMap.Drum
+bassdrumNoisy =
+ SoundMap.drumFromUGen $ \ vel ->
+ let freq = SCEnv.xLine SCRate.KR 100 50 0.15 DoNothing
+ env = SCEnv.xLine SCRate.KR 1 0.1 0.15 DoNothing
+ osci = SCOsci.sinOsc SCRate.AR freq 0 * env
+
+-- nsenv = 0.02 + SCEnv.xLine SCRate.KR 2 0.00001 0.15 DoNothing
+ nsenv = SCEnv.line SCRate.KR 0.02 0.02 0.15 PauseSynth +
+ SCEnv.xLine SCRate.KR 2 0.00001 0.15 PauseSynth
+ noise = SCFilter.lpf (SCNoise.whiteNoise zeroUId SCRate.AR) 5000 * nsenv
+ drm = SCMath.clip2 0.5 (osci + noise) * vel * 0.8
+ in SCUGen.MCE [drm,drm]
+
+
+
+
+data Instrument =
+ SynthBass Double
+ | Pad Double
+ deriving (Eq, Ord)
+
+data Drum =
+ Hihat
+ | BassDrum
+ deriving (Show, Eq, Ord)
+
+
+instrMap :: SoundMap.InstrumentTableWithAttributes Instrument
+instrMap =
+ SoundMap.assign1 "synthbass"
+ (\x -> do SynthBass detune <- Just x; Just detune)
+-- (\x -> case x of SynthBass detune -> Just detune; _ -> Nothing)
+ dynPerc :
+ SoundMap.assign1 "pad"
+ (\x -> do Pad dur <- Just x; Just dur)
+ pad :
+ []
+
+drumMap :: SoundMap.DrumTableWithAttributes Drum
+drumMap =
+ SoundMap.assignEq "hihat" Hihat hihat :
+ SoundMap.assignEq "bassdrum" BassDrum bassdrumNoisy :
+ []
+
+
+synthBassAttrsToInstr :: (Rational,Double) -> (Rational, Instrument)
+synthBassAttrsToInstr (vel,detune) = (vel, SynthBass detune)
+
+synthBassMelody :: Melody.T (Rational,Double)
+synthBassMelody =
+ Music.line (zipWith (\n (vel,detune) -> n tn (vel%1000,detune))
+ (cycle [c 0, d 0, g 0, d 0])
+ (zip (randomRs (0,1000) (mkStdGen 142))
+ (randomRs (-0.02,0.02) (mkStdGen 857))))
+
+padAttrsToInstr :: Double -> (Rational, Instrument)
+padAttrsToInstr dur = (1, Pad dur)
+
+padMelody :: Melody.T Double
+padMelody =
+ Music.legato wn $ Music.line $ cycle $
+ map (\(dur, chd) -> Chord.harmonicGen (4 * Dur.toNumber dur) dur chd)
+ [(hn, [c 1, e 1, a 1]),
+ (hn, [b 0, e 1, g 1]),
+ (hn, [a 0, d 1, f 1]),
+ (hn, [b 0, d 1, g 1])]
+
+rhythm :: RhyMusic.T Drum Instrument
+rhythm =
+ Music.repeat (Drum.toMusic Hihat tn na) =:=
+ Music.repeat (Rhythm.toMusicWithDrumUnit tn BassDrum
+ (Rhythm.fromString "x..x..x..x..x..."))
+
+
+chillOutMusic :: RhyMusic.T Drum Instrument
+chillOutMusic =
+ RhyMusic.fromMelody synthBassAttrsToInstr synthBassMelody =:=
+ RhyMusic.fromMelody padAttrsToInstr padMelody =:=
+ rhythm
+
+
+chillOut :: Song
+chillOut =
+ ("ChillOut",
+ Schedule.fromMusic
+ (Schedule.rhythmicMusicWithAttributes drumMap instrMap)
+ chillOutMusic)
+
+chillOutFinite :: Song
+chillOutFinite =
+ ("ChillOut",
+ Schedule.fromMusicGlobalEffect
+ (Schedule.rhythmicMusicWithAttributes drumMap instrMap)
+ (flip SCMath.clip2 1, 2) $
+ Music.take 4 chillOutMusic)
+
+
+
+
+data InstrumentTriplet =
+ SawPerc
+ | DynPerc Double
+ deriving (Eq, Ord)
+
+
+sawPercAssign :: SoundMap.InstrumentAssign InstrumentTriplet
+sawPercAssign =
+ SoundMap.assign "sawPerc"
+ (\x -> do SawPerc <- Just x; Just ())
+ sawPerc
+
+dynPercAssign :: SoundMap.InstrumentAssign InstrumentTriplet
+dynPercAssign =
+ SoundMap.assign1 "dynPerc"
+ (\x -> do DynPerc detune <- Just x; Just detune)
+ dynPerc
+
+
+
+tripletsMusic :: RhyMusic.T Drum InstrumentTriplet
+tripletsMusic =
+ let mainMel =
+ RhyMusic.fromMelody (\() -> (1, SawPerc)) $
+ Music.transpose 12 $ Music.line $
+ cycle [c 0 qn (), b 0 qn (), c 1 qn ()]
+ bassMel =
+ RhyMusic.fromMelody (\detune -> (1, DynPerc detune)) $
+ Music.line $
+ cycle [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ in Music.changeTempo 2 $
+ Music.chord [Music.changeTempo 3 mainMel, bassMel]
+
+
+triplets :: Song
+triplets =
+ ("Triplets",
+ Schedule.fromRhythmicMusicSoundEffects
+ (SoundMap.registerInstrument dynPercAssign $ \dynPercUG ->
+ SoundMap.registerInstrument sawPercAssign $ \sawPercUG ->
+ let lfoSine = exp (SCOsci.sinOsc SCRate.KR 0.2 (-pi/2) * 0.5) * 1000
+ lfoSquare = exp (SCOsci.pulse SCRate.KR 5.1 0.5 * 1) * 1000
+ mix =
+ SCFilter.rlpf (0.5 * sawPercUG) lfoSine 0.1 +
+ SCFilter.rlpf (0.5 * dynPercUG) lfoSquare 0.1
+ in SoundMap.soundEffect mix)
+ 2 tripletsMusic)
diff --git a/src/Haskore/Interface/SuperCollider/Example/Air.hs b/src/Haskore/Interface/SuperCollider/Example/Air.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Example/Air.hs
@@ -0,0 +1,356 @@
+{- |
+Demonstration song using with SuperCollider and global effects.
+This was arranged for the HAL2 meeting in July 2007, Leipzig.
+-}
+module Haskore.Interface.SuperCollider.Example.Air where
+
+-- import qualified Sound.SC3 as SC
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilt
+import qualified Sound.SC3.UGen.Envelope as SCUGEnv
+import qualified Sound.SC3.UGen.Math as SCMath
+
+import Sound.SC3.UGen.Enum (DoneAction(PauseSynth))
+import Sound.SC3.UGen.Rate (Rate(KR))
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import qualified Haskore.Interface.SuperCollider.Schedule.Channel as CSchedule
+
+import Haskore.Interface.SuperCollider.Schedule.Channel
+ (rhythmicMusicFromRhythm, rhythmicMusicFromDrum,
+ rhythmicMusicFromMelody,
+ ugenFromSound, installSound)
+
+import Haskore.Composition.Chord as Chord
+
+import Haskore.Melody as Melody
+import qualified Haskore.Music as Music
+import Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Basic.Duration((%+))
+
+import qualified Haskore.Basic.Duration as Dur
+
+import System.Random (randomRs, mkStdGen)
+
+import Data.List (genericLength)
+
+
+
+transposition :: Int
+transposition = 2
+
+{-
+bassMelody :: Melody.T (Rational, ())
+bassMelody =
+ Music.line $
+ zipWith
+ (\vel n -> n (vel%1000, ()))
+ (randomRs (0,1000) (mkStdGen 914)) $
+-}
+bassMelodyA0 :: [() -> Melody.T ()]
+bassMelodyA0 =
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : d 2 sn : e 2 den :
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : a 1 sn : g 1 den :
+ []
+
+bassMelodyA1 :: [() -> Melody.T ()]
+bassMelodyA1 =
+ a 1 den : d 2 en : a 1 sn : e 2 en : fs 2 sn : a 2 en :
+ a 1 den : a 1 sn : d 2 en : a 1 sn : d 2 en : e 2 sn : a 2 den :
+ a 1 den : d 2 en : a 1 sn : e 2 en : fs 2 sn : a 2 en :
+ a 1 den : a 1 sn : c 2 en : d 2 sn : e 2 en : d 2 sn : a 1 den :
+ []
+
+bassMelodyA :: [() -> Melody.T ()]
+bassMelodyA = bassMelodyA0 ++ bassMelodyA1
+
+-- B == A
+
+bassMelodyC :: [() -> Melody.T ()]
+bassMelodyC =
+ a 1 den : d 2 en : a 1 sn : e 2 en : f 2 sn : a 2 en :
+ a 1 den : a 1 sn : d 2 en : a 1 sn : d 2 en : f 2 sn : a 2 den :
+ a 1 den : d 2 en : a 1 sn : e 2 en : f 2 sn : a 2 en :
+ a 1 den : a 1 sn : c 2 en : d 2 sn : e 2 en : d 2 sn : a 1 den :
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : d 2 sn : e 2 den :
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : a 1 sn : g 1 den :
+ []
+
+-- D == A
+
+bassMelodyE :: [() -> Melody.T ()]
+bassMelodyE =
+ a 1 den : d 2 en : a 1 sn : e 2 en : f 2 sn : a 2 en :
+ a 1 den : a 1 sn : d 2 en : a 1 sn : d 2 en : f 2 sn : a 2 den :
+ a 1 den : d 2 en : a 1 sn : e 2 en : f 2 sn : a 2 en :
+ a 1 den : a 1 sn : c 2 en : d 2 sn : e 2 en : d 2 sn : a 1 den :
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : d 2 sn : e 2 den :
+ a 1 den : c 2 en : a 1 sn : d 2 en : e 2 sn : g 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : a 1 sn : g 1 den :
+ []
+
+bassMelodyF :: [() -> Melody.T ()]
+bassMelodyF =
+ a 1 den : c 2 en : a 1 sn : c 2 en : e 2 sn : f 2 en :
+ a 1 den : a 1 sn : c 2 en : a 1 sn : c 2 en : e 2 sn : f 2 den :
+ a 1 den : d 2 en : a 1 sn : d 2 en : f 2 sn : a 2 en :
+ a 1 den : a 1 sn : d 2 en : e 2 sn : f 2 en : e 2 sn : a 1 den :
+ b 1 den : e 2 en : b 1 sn : e 2 en : a 2 sn : b 2 en :
+ b 1 den : b 1 sn : e 2 en : b 1 sn : e 2 en : a 2 sn : b 2 den :
+ b 1 den : e 2 en : b 1 sn : e 2 en : gs 2 sn : b 2 en :
+ b 1 den : b 1 sn : e 2 en : b 1 sn : gs 2 en : e 2 sn : b 1 den :
+ []
+
+
+
+bassMelody :: Melody.T ()
+bassMelody =
+ let trans = map (Music.transpose transposition .)
+ in Music.line $
+ map
+ (Music.crescendo 0.8 . Music.loudness1 0.2 .
+ Music.line . map ($())) $
+ bassMelodyA : bassMelodyA :
+ bassMelodyA : bassMelodyC :
+ bassMelodyA : bassMelodyE :
+ bassMelodyA : bassMelodyC :
+ trans bassMelodyA :
+ trans bassMelodyF :
+ trans bassMelodyA :
+ trans bassMelodyF :
+ trans bassMelodyA :
+ trans (bassMelodyA0 ++ bassMelodyA0) :
+ []
+
+-- cf. Example.Morph
+sliceVertInf :: Int -> [a] -> [[a]]
+sliceVertInf n =
+ map (take n) . iterate (drop n)
+
+harpScale :: Melody.T ()
+harpScale =
+ -- could use sliceVert or sliceHoriz
+ let binomDists = map sum $ sliceVertInf 3 $
+ randomRs (-1,1::Double) (mkStdGen 102)
+ tones = [d,e,a,b]
+ -- properFraction is useless for negative numbers
+ splitFraction x =
+ let n = floor x
+ in (n, x - fromIntegral n)
+ makeNote x =
+ let (oct,p) = splitFraction x
+ in (tones!!floor(p*genericLength tones)) oct sn ()
+ in Music.legato qn $ Music.line $ take (round(6*4*dhn/sn)) $
+ map makeNote $ zipWith (+) binomDists $
+ iterate (0.02+) (-2)
+
+
+-- envelopedStrings :: Music.Dur -> InstrumentUGen
+envelopedStrings :: UGen -> SoundMap.Instrument
+envelopedStrings dur params =
+ let env = SCUGEnv.envGen KR 1 2 0 1 PauseSynth
+ (Example.bridge 3 dur 0.5)
+ in env * Example.strings params
+
+
+chordConfuse :: Melody.T ()
+chordConfuse =
+ Chord.harmonicGen () (2*4*dhn) [a 1, b 1, d 2, e 2, g 2]
+
+
+chordsA :: Melody.T ()
+chordsA =
+ Chord.harmonicGen () (4*dhn) [a 1, c 2, e 2] +:+
+ Chord.harmonicGen () (4*dhn) [a 1, d 2, fs 2] +:+
+ Chord.harmonicGen () (4*dhn) [a 2, c 2, e 2] +:+
+ (Chord.harmonicGen () (4*dhn) [a 2, d 2] =:=
+ (fs 2 (3*dhn) () +:+ g 2 dhn ()))
+
+chordsB :: Melody.T ()
+chordsB =
+ let ce = Chord.harmonicGen () (4*dhn) [c 2, e 2]
+ in ce +:+
+ (d 2 (2*4*dhn) () =:=
+ fs 2 (4*dhn) () +:+
+ f 2 (4*dhn) ()) +:+
+ ce
+
+chordsBlow :: Melody.T ()
+chordsBlow =
+ a 1 (4*4*dhn) () =:= chordsB
+
+chordsBhigh :: Melody.T ()
+chordsBhigh =
+ a 2 (4*4*dhn) () =:= chordsB
+
+chordsC :: Melody.T ()
+chordsC =
+ (a 1 (2*dhn) () +:+ a 2 (2*dhn) ()
+ =:= c 2 (4*dhn) () =:= e 2 (4*dhn) ()) +:+
+ (d 2 (2*4*dhn) () =:=
+ fs 2 (2*dhn) () +:+ g 2 (dhn) () +:+ fs 2 (dhn) () +:+
+ f 2 (2*dhn) () +:+ g 2 (dhn) () +:+ f 2 (dhn) () =:=
+ a 2 (2*4*dhn) ()) +:+
+ (a 2 (4*dhn) () =:= c 2 (4*dhn) () =:= e 2 (4*dhn) ())
+
+chordsD :: Melody.T ()
+chordsD =
+ (a 1 (2*dhn) () +:+ a 2 (2*dhn) ()
+ =:= c 2 (4*dhn) () =:= e 2 (4*dhn) ()) +:+
+ (d 2 (4*dhn) () =:=
+ fs 2 (2*dhn) () +:+ g 2 (dhn) () +:+ fs 2 (dhn) () =:=
+ a 2 (4*dhn) ()) +:+
+ (c 2 (2*dhn) () +:+ d 2 (2*dhn) () =:= f 2 (4*dhn) () =:= a 2 (4*dhn) ())
+
+chordsD0 :: Melody.T ()
+chordsD0 = chordsD +:+
+ (b 1 (4*dhn) () =:=
+ e 2 (4*dhn) () =:=
+ gs 2 (2*dhn) () +:+ a 2 (dhn) () +:+ b 2 (dhn) ())
+
+chordsD1 :: Melody.T ()
+chordsD1 = chordsD +:+
+ (b 1 (4*dhn) () =:=
+ e 2 (4*dhn) () =:=
+ a 2 (2*dhn) () +:+ gs 2 (2*dhn) ())
+
+chordsE :: Melody.T ()
+chordsE =
+ Chord.harmonicGen () (4*dhn) [a 1, c 2, e 2] +:+
+ Chord.harmonicGen () (4*dhn) [a 1, d 2, fs 2] +:+
+ Chord.harmonicGen () (8*dhn) [a 1, c 2, e 2]
+
+chords :: Melody.T Double
+chords =
+ Music.legato wn $ Music.mapDurNote
+ (\dur (Melody.Note () p) ->
+ Melody.Note (2 * Dur.toNumber dur) p) $
+ chordConfuse +:+
+ chordsA +:+
+ chordsBlow +:+ chordsBhigh +:+
+ chordsC +:+
+ Music.transpose transposition (chordsD0 +:+ chordsD1 +:+ chordsE)
+
+
+xylophoneSolo :: Melody.T ()
+xylophoneSolo =
+ let build n0 notes =
+ Music.line $
+ map (\n -> n sn () +:+ n0 sn () +:+ n0 sn ()) notes
+ in build (a 1)
+ [e 2, d 2, e 2, d 2, e 2, d 2, e 2, d 2,
+ e 2, d 2, e 2, g 2, a 2, g 2, e 2, d 2,
+ e 2, d 2, e 2, d 2, e 2, d 2, e 2, d 2,
+ g 2, a 2, c 3, a 2, d 3, c 3, a 2, g 2,
+ f 2, d 2, f 2, d 2, f 2, d 2, f 2, d 2,
+ f 2, d 2, f 2, d 2, g 2, d 2, f 2, d 2,
+ e 2, d 2, e 2, d 2, e 2, d 2, e 2, d 2,
+ a 2, gs 2, g 2, fs 2, f 2, e 2, ds 2, d 2]
+
+
+bassStringMelody :: Melody.T ()
+bassStringMelody =
+ Music.transpose transposition $
+ Music.line $ map (\n -> n dhn ()) $
+ a 1 : b 1 : c 2 : e 2 : fs 2 : g 2 : a 2 : b 2 :
+ d 2 : e 2 : f 2 : a 2 : gs 2 : a 2 : b 2 : c 3 :
+ []
+
+
+melodyA :: Melody.T ()
+melodyA =
+ Music.line $
+ e 2 (9%+8) () : d 2 den () : c 2 den () : a 2 dqn () :
+ e 2 dqn () : d 2 (5%+16) () : c 2 qn () : d 2 (21%+16) () :
+ e 2 den () : a 1 (15%+16) () :
+ a 1 (5%+16) () : b 1 qn () : c 2 (wn + 5%+16) () :
+ b 1 den () : a 1 den () : d 2 dqn () : e 2 dqn () :
+ c 2 dqn () : d 2 den () : a 1 (15%+8 + 21%+16) () :
+ []
+
+melodyB :: Melody.T ()
+melodyB =
+ Music.take (10 + 11%+16) melodyA +:+
+ (Music.line $
+ g 2 (5%+16) () : fs 2 qn () : f 2 (5%+16) () : e 2 ddqn () :
+ [])
+
+melody :: Melody.T ()
+melody =
+ Music.rest (4*4*dhn)
+ +:+ melodyB
+ +:+ melodyB
+ +:+ Music.rest (4*4*dhn)
+ +:+ Music.transpose transposition (melodyA +:+ melodyA)
+
+
+{-
+scsynth -N air.osc _ air.aiff 44100 AIFF int16
+-}
+
+schedule :: Schedule.T
+schedule =
+ CSchedule.fromRhythmicMusic $
+ do bass <- installSound SoundMap.with0Attributes "bass"
+ (Example.fmBass (SCUGen.MCE [0.99,1.01]))
+ guitar <- installSound SoundMap.with0Attributes "guitar"
+ (Example.fmGuitar (SCUGen.MCE [2.99,3.01]))
+ strings <- installSound SoundMap.with1Attribute "strings"
+ envelopedStrings
+ harpsichord <- installSound SoundMap.with0Attributes "harpsichord"
+ Example.harpsichord
+ bassStrings <- installSound SoundMap.with0Attributes "bassstrings"
+ Example.modulatedStrings
+ xylophone <- installSound SoundMap.with0Attributes "xylophone"
+ Example.xylophone
+ hihat <- installSound SoundMap.with0Attributes "hihat"
+ Example.hihat
+ bassdrum <- installSound SoundMap.with0Attributes "bassdrum"
+ Example.bassdrum
+ let lfoSine = 1000 * exp
+ (0.3 * SCOsci.sinOsc KR 0.1 (SCUGen.MCE [-pi/2, 0]) +
+ 0.3 * SCOsci.sinOsc KR (sqrt 0.03) 0)
+ mix = flip SCMath.clip2 1 $ 0.2 * (
+ ugenFromSound bass +
+ 0.3 * ugenFromSound xylophone +
+ 0.5 * ugenFromSound harpsichord +
+ 3 * SCFilt.lpf (ugenFromSound bassStrings) 1000 +
+ SCFilt.rlpf (0.5 * ugenFromSound strings) lfoSine 0.1 +
+ (let guit = 0.6 * ugenFromSound guitar
+ in guit + SCFilt.combN (SCFilt.lpf guit 500) 0.2 0.2 5) +
+ ugenFromSound hihat +
+ 2*ugenFromSound bassdrum)
+ return (mix,
+ Music.changeTempo 2 $
+-- Music.take 10 $
+-- Music.drop (4*4*4*dhn) $
+ (rhythmicMusicFromMelody strings $ Music.transpose (-12) chords) =:=
+ hnr +:+
+ (rhythmicMusicFromMelody harpsichord harpScale =:=
+ Music.rest (2*4*dhn) +:+ (Music.chord $
+ (rhythmicMusicFromMelody bass $ Music.transpose (-36) bassMelody) :
+ (rhythmicMusicFromMelody guitar $ Music.transpose (-12) melody) :
+ (Music.rest (3*4*4*dhn) +:+
+ (rhythmicMusicFromMelody xylophone $ Music.transpose (0) xylophoneSolo)) :
+ (Music.rest (5*4*4*dhn) +:+
+ (rhythmicMusicFromMelody bassStrings $ Music.transpose (-36) bassStringMelody)) :
+ (Music.replicate (7*4*8 + 2) $
+ rhythmicMusicFromRhythm bassdrum sn "x.x..x" =:=
+ (Music.replicate 6 $ rhythmicMusicFromDrum hihat sn)) :
+ [])))
+
+
+main :: IO ()
+main = Play.schedule Play.defaultLatency schedule
diff --git a/src/Haskore/Interface/SuperCollider/Example/AirMain.hs b/src/Haskore/Interface/SuperCollider/Example/AirMain.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Example/AirMain.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import qualified Haskore.Interface.SuperCollider.Example.Air as Air
+
+main :: IO ()
+main = Air.main
diff --git a/src/Haskore/Interface/SuperCollider/Example/Morph.hs b/src/Haskore/Interface/SuperCollider/Example/Morph.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Example/Morph.hs
@@ -0,0 +1,177 @@
+{- |
+This was composed for the Teachers '95 morph
+of the Georg Cantor school in Halle
+in occasion of the 20th birthday in 2008.
+-}
+module Haskore.Interface.SuperCollider.Example.Morph where
+
+-- import qualified Sound.SC3 as SC
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilt
+-- import qualified Sound.SC3.UGen.Math as SCMath
+import qualified Sound.SC3.UGen.Envelope as SCEnv
+import qualified Sound.SC3.UGen.Envelope.Construct as SCEnvCons
+
+import Sound.SC3.UGen.Enum (DoneAction(PauseSynth), {- EnvCurve(EnvSin,EnvExp) -} )
+import Sound.SC3.UGen.Rate (Rate(KR,AR))
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import qualified Haskore.Interface.SuperCollider.Schedule.Channel as CSchedule
+
+import Haskore.Interface.SuperCollider.Schedule.Channel
+ ({- rhythmicMusicFromDrum, -} rhythmicMusicFromMelody,
+ ugenFromSound, installSound)
+
+import Haskore.Melody as Melody
+import qualified Haskore.Music as Music
+import Haskore.Music.Rhythmic as RhyMusic
+
+-- import qualified Haskore.Composition.Drum as Drum
+-- import Haskore.Composition.Chord as Chord
+import Haskore.Basic.Pitch as Pitch
+import qualified Haskore.Basic.Duration as Dur
+
+import System.Random (randomRs, mkStdGen)
+
+import Data.List (genericLength)
+
+
+
+{-
+blub :: UGen -> SoundMap.Instrument
+blub pan =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let dur = 0.3
+ env = SCEnv.envGen KR 1 1 0 1 PauseSynth
+ (SCEnvCons.envSine dur 1)
+ in 0.2 * env * SCUGen.MCE [1+pan,1-pan] *
+ SCFilt.hpf
+ (SCOsci.pulse AR (SCUGen.MCE [freq*0.995, freq*1.005]) 0.5)
+ (4000 * 0.5**env)
+-}
+
+
+zirp :: UGen -> SoundMap.Instrument
+zirp pan =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ let env = SCEnv.envGen KR 1 1 0 1 PauseSynth $
+ (SCEnvCons.envSine 0.2 1)
+{-
+ SCEnvCons.env
+ [0, 1, 0.1]
+ [0.1, 0.5]
+ [EnvSin, EnvExp]
+ (-1) (-1)
+-}
+ in vel * env * SCUGen.MCE [1+pan,1-pan] *
+ SCFilt.hpf
+ (SCOsci.saw AR (SCUGen.MCE [freq*0.995, freq*1.005]))
+ (2000 * 0.5**env)
+
+
+-- cf. Example.Air
+sliceVertInf :: Int -> [a] -> [[a]]
+sliceVertInf n =
+ map (take n) . iterate (drop n)
+
+-- properFraction is useless for negative numbers
+splitFraction :: (RealFrac a) => a -> (Int, a)
+splitFraction x =
+ let n = floor x
+ in (n, x - fromIntegral n)
+
+makeChord ::
+ [Pitch.Octave -> Music.Dur -> attr -> Music.T note]
+ -> attr -> Double -> Music.T note
+makeChord ns pan x =
+ let (oct,p) = splitFraction x
+ (high,low) = splitAt (floor (p*genericLength ns)) ns
+ in chord $ map (\n -> n sn pan) $
+ map ($ oct) low ++ map ($ (oct+1)) high
+
+zirpScale :: Melody.T Double
+zirpScale =
+ let binomDists = map sum $ sliceVertInf 3 $
+ randomRs (-1,1::Double) (mkStdGen 102)
+ panoramas = randomRs (-0.5,0.5) (mkStdGen 95)
+ in Music.legato hn $ Music.line $
+ zipWith3 makeChord
+ (concat $ map (replicate 16)
+ [[c, e, a], [c, e, g], [d, fs, a], [c, e, a]])
+ panoramas $
+ zipWith (+) binomDists $
+ iterate (0.02+) 0.2
+
+
+
+bassSquare :: SoundMap.Instrument
+bassSquare =
+ SoundMap.instrumentFromUGen $ \ vel freq ->
+ vel * SCOsci.pulse AR (SCUGen.MCE [freq*0.999, freq*1.001])
+ (0.5 + 0.3 * SCOsci.sinOsc KR 0.3 0)
+
+infix 7 +:
+
+(+:) :: Music.T note -> Music.T note -> Music.T note
+m0 +: m1 =
+ Music.take (Music.dur m0 - Music.dur m1) m0 +:+ m1
+
+bassMelody :: Melody.T ()
+bassMelody =
+ Music.transpose (-24) $
+ Music.line $
+-- a 0 wn () : c 1 wn () : d 1 wn () : a 1 wn () : []
+ a 0 wn () +: (g 0 sn () +:+ a 0 en ()) :
+ c 1 wn () +: (a 0 sn () +:+ c 1 en ()) :
+ d 1 wn () +: (c 1 sn () +:+ d 1 en () +:+ c 1 en ()) :
+ a 1 wn () : []
+
+
+tempo :: Dur.Ratio
+tempo = 2
+
+
+schedule :: Schedule.T
+schedule =
+ CSchedule.fromRhythmicMusic $
+ do zirpInstr <- installSound SoundMap.with1Attribute "zirp" zirp
+ bassInstr <- installSound SoundMap.with0Attributes "bass" bassSquare
+ hihatDrum <- installSound SoundMap.with0Attributes "hihat" Example.hihat
+ let mix = -- flip SCMath.clip2 1 $
+ 0.2 * (
+-- ugenFromSound zirpInstr +
+-- (let z = ugenFromSound zirpInstr
+-- in z + SCFilt.combN z 0.11 0.11 2) +
+ (Example.reverb 4 (ugenFromSound zirpInstr)) +
+ 0.4*(flip (SCFilt.rlpf (ugenFromSound bassInstr)) 0.1 $
+ flip SCFilt.lag 1 $
+ 400 * 8 ** SCOsci.lfSaw KR (Dur.toNumber tempo / 4) 1) +
+ 5 * ugenFromSound hihatDrum)
+ return (mix,
+ Music.changeTempo tempo $
+-- Music.take 10 $
+-- Music.drop (4*4*4*dhn) $
+ (rhythmicMusicFromMelody zirpInstr zirpScale =:=
+ Music.rest (sn/2) +:+
+ (-- Music.replicate (4*4) (rhythmicMusicFromDrum hihatDrum qn) =:=
+ rhythmicMusicFromMelody bassInstr bassMelody)) +:+
+ Music.rest wn
+{-
+ Music.transpose (12) (
+ Chord.harmonicGen () (qn) [e 0, a 0, c 1] +:+
+ Chord.harmonicGen () (qn) [g 0, c 1, e 1] +:+
+ Chord.harmonicGen () (qn) [a 0, d 1, fs 1] +:+
+ Chord.harmonicGen () (qn) [c 1, e 1, a 1])
+-}
+ )
+
+
+main :: IO ()
+main = Play.schedule Play.defaultLatency schedule
diff --git a/src/Haskore/Interface/SuperCollider/Note.hs b/src/Haskore/Interface/SuperCollider/Note.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Note.hs
@@ -0,0 +1,93 @@
+
+module Haskore.Interface.SuperCollider.Note where
+
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap (Attribute)
+
+import qualified Haskore.Music.Standard as StdMusic
+import qualified Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import qualified Haskore.Basic.Pitch as Pitch
+
+import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+import Haskore.General.Utility
+ (compareRecord, compareField, equalRecord, equalField)
+
+data T =
+ Cons {
+ parameters :: [Attribute],
+ velocity :: NonNeg.Double,
+ instrument :: String,
+ pitch :: Maybe NonNeg.Double
+ }
+ deriving Show
+
+{-
+If the parameters would be pairs of parameter name and parameter value
+then we could make use of the default values.
+But is this worth the trouble?
+-}
+
+instance Eq T where
+ (==) =
+ equalRecord
+ [equalField pitch,
+ equalField velocity]
+
+instance Ord T where
+ compare =
+ compareRecord
+ [compareField pitch,
+ compareField velocity]
+
+type FromNote dyn note =
+ dyn -> Pitch.Relative -> note -> T
+
+
+fromRhythmicNoteWithAttributes :: (Real dyn) =>
+ SoundMap.ToSound drum ->
+ SoundMap.ToSound instr ->
+ FromNote dyn (RhyMusic.Note drum instr)
+fromRhythmicNoteWithAttributes dMap iMap dyn trans (RhyMusic.Note vel body) =
+ let velSC = velocityFromStd dyn vel
+ in case body of
+ RhyMusic.Tone instr p ->
+ uncurry (flip Cons velSC) (iMap instr)
+ (Just (pitchFromStd trans p))
+ RhyMusic.Drum drum ->
+ uncurry (flip Cons velSC) (dMap drum) Nothing
+
+fromRhythmicNote :: (Real dyn) =>
+ (drum -> String) ->
+ (instr -> String) ->
+ FromNote dyn (RhyMusic.Note drum instr)
+fromRhythmicNote dMap iMap =
+ fromRhythmicNoteWithAttributes
+ (\drum -> ([], dMap drum))
+ (\instr -> ([], iMap instr))
+
+fromGMNote :: (Real dyn) =>
+ FromNote dyn MidiMusic.Note
+fromGMNote = fromRhythmicNote show show
+
+fromStdNote :: (Real dyn) =>
+ FromNote dyn StdMusic.Note
+fromStdNote = fromRhythmicNote id id
+
+velocityFromStd :: Real dyn =>
+ dyn -> Rational -> NonNeg.Double
+velocityFromStd dyn vel = realToFrac dyn * fromRational vel
+
+{-
+The resulting frequency is always positive,
+but we must explicitly convert to NonNeg.T
+because we cannot perform the whole computation in NonNeg.Double
+because the pitch can be negative.
+-}
+pitchFromStd ::
+ Pitch.Relative -> Pitch.T -> NonNeg.Double
+pitchFromStd trans p =
+ NonNeg.fromNumberMsg "SuperCollider.Note.pitchFromStd" $
+ Pitch.intToFreq (trans + Pitch.toInt p)
diff --git a/src/Haskore/Interface/SuperCollider/Performance.hs b/src/Haskore/Interface/SuperCollider/Performance.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Performance.hs
@@ -0,0 +1,186 @@
+module Haskore.Interface.SuperCollider.Performance where
+
+import qualified Haskore.Interface.SuperCollider.Note as Note
+import qualified Haskore.Interface.SuperCollider.SoundMap as InstrMap
+
+import qualified Haskore.Music.Standard as StdMusic
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import qualified Haskore.Music as Music
+import qualified Haskore.Melody as Melody
+
+import qualified Haskore.Performance as Pf
+import qualified Haskore.Performance.BackEnd as PfBE
+import qualified Haskore.Performance.Fancy as FancyPf
+
+import qualified Haskore.RealTime.EventList.TimeBody as TimeList
+import qualified Haskore.RealTime.EventList.TimeTime as TimeListPad
+import qualified Haskore.General.IdGenerator as IdGen
+
+import qualified Numeric.NonNegative.Class as NonNeg
+
+
+
+fromMelody :: (NonNeg.C time, Floating time, RealFrac time) =>
+ Melody.T () -> PfBE.Padded time Note.T
+fromMelody =
+{-
+ PfBE.fromPaddedPerformance
+ (Note.fromRhythmicNote
+ (const "no drum")
+ (const "no instrument")) .
+-}
+ PfBE.fromPaddedPerformance
+ (Note.fromRhythmicNote
+ (error "no drum defined")
+ (error "no instrument defined")) .
+ fancyPaddedPerformanceFromMusic .
+ StdMusic.fromMelodyNullAttr undefined
+
+
+fancyPaddedPerformanceFromMusic ::
+ (Ord note, NonNeg.C time, RealFrac time) =>
+ Music.T note -> Pf.Padded time Double note
+fancyPaddedPerformanceFromMusic =
+ FancyPf.paddedFromMusic
+
+
+
+type NodeId = Int -- cf. PlayEasy
+type NodeIdGen a = IdGen.T NodeId a
+type T time = TimeListPad.T time (NodeId, Maybe (time, Note.T))
+
+
+eventsFromNotes, eventsFromNotesQueue, eventsFromNotesEither ::
+ (NonNeg.C time)
+ => PfBE.Padded time Note.T
+ -> NodeIdGen (T time)
+eventsFromNotes = eventsFromNotesEither
+
+
+
+eventsFromNotesQueue =
+ eventsFromNotesQueueAux TimeList.empty
+
+{- |
+This variant does not need a list of 'Either's,
+instead it uses two separate lists for start and stop events.
+We would like to use a standard datatype for priority queues,
+however it must be efficient to remove the first element
+which means that the time stamp of all following elements must be decreased.
+Since we have no such data structure, we simply use a TimeList.
+But then again, without the 'Either' list,
+we have to merge the queue of stop events and the list of start events manually.
+This makes the implementation less beautiful.
+-}
+eventsFromNotesQueueAux :: (NonNeg.C time)
+ => TimeList.T time NodeId
+ -> PfBE.Padded time Note.T
+ -> NodeIdGen (T time)
+eventsFromNotesQueueAux queue xtt =
+ let (qExists, (~(qTime,oldSId), qs)) =
+ maybe
+ (False, (error "no q", error "no qs"))
+ (\q' -> (True, q'))
+ (TimeList.viewL queue)
+ (xTime,xs0) = TimeListPad.viewTimeL xtt
+ (xExists, (note, xs)) =
+ maybe
+ (False, (error "no x", error "no xs"))
+ (\x' -> (True, x'))
+ (TimeListPad.viewBodyL xs0)
+ qFirst =
+ do IdGen.free oldSId
+ fmap
+ (TimeListPad.cons qTime (oldSId, Nothing))
+ (eventsFromNotesQueueAux qs
+ (TimeListPad.decreaseStart qTime xtt))
+ xFirst =
+ do newSId <- IdGen.alloc
+ let noteDur = PfBE.eventDur note
+ fmap
+ (TimeListPad.cons xTime
+ (newSId, Just (noteDur, PfBE.eventNote note)))
+ (eventsFromNotesQueueAux
+ (TimeList.insert noteDur newSId
+ (TimeList.decreaseStart xTime queue))
+ xs)
+ in if qExists && (not xExists || qTime <= xTime)
+ then qFirst
+ else
+ if xExists
+ then xFirst
+ else return (TimeListPad.pause xTime)
+
+
+eventsFromNotesEither =
+ eventsFromNotesEitherAux . TimeListPad.mapBody Right
+
+{-
+It seems not to be possible to implement that with foldM,
+because one recursive call to eventsFromNotes
+requires modifying the events list.
+-}
+eventsFromNotesEitherAux :: (NonNeg.C time)
+ => TimeListPad.T time (Either NodeId (PfBE.Event time Note.T))
+ -> NodeIdGen (T time)
+eventsFromNotesEitherAux =
+ (\ (dur, xss) ->
+ fmap (TimeListPad.consTime dur) $
+ maybe
+ (return TimeListPad.empty)
+ (\(x,xs) ->
+ let doRest ev restAct =
+ fmap (TimeListPad.consBody ev) restAct
+ in either
+ (\sid ->
+ do IdGen.free sid
+ doRest
+ (sid, Nothing)
+ (eventsFromNotesEitherAux xs))
+ (\note ->
+ do sid <- IdGen.alloc
+ let noteDur = PfBE.eventDur note
+ doRest
+ (sid, Just (noteDur, PfBE.eventNote note))
+ (eventsFromNotesEitherAux
+ (TimeListPad.insert noteDur (Left sid) xs)))
+ x) $
+ TimeListPad.viewBodyL xss)
+ . TimeListPad.viewTimeL
+
+
+instrStartNodeId :: NodeId
+instrStartNodeId = 2 -- succ Sound.SC3.Server.Play.homeId
+
+fixNodeIds :: NodeIdGen a -> a
+fixNodeIds = IdGen.run instrStartNodeId
+
+fromMusic :: (Ord note, NonNeg.C time, RealFrac time) =>
+ Note.FromNote time note ->
+ Music.T note ->
+ NodeIdGen (T time)
+fromMusic makeNote =
+ eventsFromNotes .
+ PfBE.fromPaddedPerformance makeNote .
+ FancyPf.paddedFromMusic
+
+{- needed for Play.Install, Play.Channel, Life -}
+{-
+fromRhythmicMusic ::
+ (Show drum, Show instr, Ord drum, Ord instr,
+ Floating time, RealFrac time) =>
+ RhyMusic.T drum instr ->
+ NodeIdGen (T time)
+fromRhythmicMusic =
+ fromMusic (Note.fromRhythmicNote show show)
+-}
+
+fromRhythmicMusicWithAttributes ::
+ (Ord drum, Ord instr,
+ NonNeg.C time, Floating time, RealFrac time) =>
+ InstrMap.ToSound drum ->
+ InstrMap.ToSound instr ->
+ RhyMusic.T drum instr ->
+ NodeIdGen (T time)
+fromRhythmicMusicWithAttributes dMap iMap =
+ fromMusic (Note.fromRhythmicNoteWithAttributes dMap iMap)
diff --git a/src/Haskore/Interface/SuperCollider/Play.hs b/src/Haskore/Interface/SuperCollider/Play.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Play.hs
@@ -0,0 +1,279 @@
+module Haskore.Interface.SuperCollider.Play (
+ music, melody, performance,
+ schedule, scheduleWithPlayer, shutUp,
+ defaultLatency, timeStamp,
+
+ -- for Life module
+ installSound, playAtom,
+ performanceTrans, messagesGrouped,
+
+ -- for suppression of "unused" warnings :-)
+ messagesGroupedManual, messagesSingly, messagesSimple,
+ ) where
+
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import Haskore.Interface.SuperCollider.Schedule (Time)
+
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap (Instrument, Sound)
+
+-- import qualified Sound.SC3.UGen.UGen as SCUGen
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+
+-- import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.Transport (Transport)
+import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+-- import qualified Sound.OpenSoundControl.Transport.UDP as UDP
+-- import qualified Sound.OpenSoundControl.UDPMonad as UDP
+import Sound.OpenSoundControl.OSC (OSC)
+
+import qualified Haskore.Melody as Melody
+-- import qualified Haskore.Music.Rhythmic as RhyMusic
+import qualified Haskore.Music as Music
+
+import qualified Haskore.RealTime.EventList.TimeBody as TimeList
+
+import qualified Haskore.RealTime.Timer as Timer
+import qualified Haskore.RealTime.Timer.Thread as TimerThread
+
+-- import Control.Monad.Trans (liftIO)
+-- import Control.Monad (when)
+
+
+
+{- * Play several representations of music -}
+
+music :: Ord note =>
+ Time ->
+ Schedule.SoundHandler note ->
+ Music.T note ->
+ IO ()
+music latency soundHandler =
+ schedule latency .
+ Schedule.fromMusic soundHandler
+
+{-
+-- slightly inconsistent naming with respect to Music.fromMelodyNullAttr
+rhythmicMusic :: (Show instr, Show drum, Ord instr, Ord drum) =>
+ Double ->
+ SoundMap.DrumTable drum ->
+ SoundMap.InstrumentTable instr ->
+ RhyMusic.T drum instr -> IO ()
+rhythmicMusic latency drumMap instrMap =
+ schedule latency .
+ Schedule.fromRhythmicMusic drumMap instrMap
+
+rhythmicMusicWithAttributes :: (Ord instr, Ord drum) =>
+ Double ->
+ SoundMap.DrumTableWithAttributes drum ->
+ SoundMap.InstrumentTableWithAttributes instr ->
+ RhyMusic.T drum instr -> IO ()
+rhythmicMusicWithAttributes latency drumMap instrMap =
+ schedule latency .
+ Schedule.fromRhythmicMusicWithAttributes drumMap instrMap
+-}
+
+melody :: Time -> Instrument -> Melody.T () -> IO ()
+melody latency sound =
+ schedule latency .
+ Schedule.fromMelody sound
+
+
+performanceTrans :: Transport t =>
+ Time ->
+ [OSC] ->
+ SCPf.T Time ->
+ Trans.IO t ()
+performanceTrans latency installMsgs =
+ scheduleWithPlayer
+ (messagesGrouped TimerThread.timer latency) .
+ Schedule.fromPerformance installMsgs []
+
+performance ::
+ Time ->
+ [OSC] ->
+ SCPf.T Time ->
+ IO ()
+performance latency installMsgs =
+ schedule latency .
+ Schedule.fromPerformance installMsgs []
+
+
+schedule ::
+ Time ->
+ Schedule.T ->
+ IO ()
+schedule latency =
+ SCPlay.withSC3 .
+ scheduleWithPlayer
+ (messagesGrouped TimerThread.timer latency)
+
+
+shutUp :: IO ()
+shutUp =
+ do SCPlay.withSC3 SCPlay.stop
+ return ()
+
+
+{- * Initialization of replay -}
+
+{- |
+Default value for latency used in "Haskore.Interface.SuperCollider.Play.Life"
+and connected modules.
+-}
+defaultLatency :: Time
+defaultLatency = 0.1
+
+
+-- should be moved to Hsc or supercollider-ht
+timeStamp :: Time -> Time -> [OSC] -> OSC
+timeStamp start t = Schedule.timeStamp (start+t)
+
+
+installSound ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ String ->
+ Sound params ->
+ Trans.IO t ()
+installSound name instr =
+ SCPlay.simpleSync $ Schedule.installSoundMsg name Schedule.defaultChannel instr
+
+
+playAtom :: Transport t =>
+ SCPlay.NodeId
+ -> String
+ -> [(String,Double)]
+ -> Trans.IO t ()
+playAtom sid name params =
+ Trans.send (Schedule.atomPlayMsg sid name params)
+
+
+
+{- * Different approaches to timing -}
+
+
+{-
+How to synchronize to different messages simultaneously?
+
+this behavior is application specific. SuperCollider sends '/done'
+replies for each command tagged 'asynchronous', i.e. messages that
+are deferred to the non-realtime-thread. so yes, if you want to make
+sure each command completes before sending the next one, you need one
+wait per asynchronous command.
+
+the '/sync' message is also very useful in asynchronous
+communication: it implements a barrier identified by an integer id,
+so you can chunk asynchronous commands that don't have a mutual
+dependency. the sf site seems to be down, here's the excerpt from
+Server-Command-Reference.html:
+
+"/sync notify when async commands have completed.
+ int - a unique number identifying this command.
+
+Replies with a /synced message when all asynchronous commands
+received before this one have completed. The reply will contain the
+sent unique ID.
+Asynchronous. Replies to sender with /synced, ID when complete."
+
+to avoid a race, i think you need to send all the commands and /sync
+in the same bundle, or else /sync might arrive before the last
+command and consequently you might get /synced too early. that's not
+a problem with TCP, of course.
+
+-}
+
+scheduleWithPlayer :: Transport t =>
+ (TimeList.T Time OSC -> Trans.IO t ()) ->
+ Schedule.T ->
+ Trans.IO t ()
+scheduleWithPlayer player sc =
+ do {- both variants do only work,
+ if only synchronous commands are contained -}
+ {-
+ mapM_
+ Trans.simpleSync
+ (Schedule.initial sc)
+ -}
+ {-
+ Synchronization of messages:
+ http://lists.lurk.org/pipermail/haskell-art/2008-February/000102.html
+ -}
+ let isc = Schedule.initial sc
+ mapM_ Trans.send isc
+ mapM_ (const (Trans.wait "/done" >> return ())) isc
+
+ player (Schedule.body sc)
+ return ()
+
+{- |
+Uses @threadDelay@ and @getClockTime@ for a long-time stable,
+but not very accurate timing.
+Use time stamped messages for SuperCollider in order
+to achieve exact scheduling.
+You have to specify the latency,
+that is, the maximal expected delay of creating and sending messages
+to the SuperCollider server.
+-}
+messagesGrouped :: Transport t =>
+ Timer.T ->
+ Time ->
+ TimeList.T Time OSC -> Trans.IO t ()
+messagesGrouped timer latency =
+ fmap (const ()) .
+ TimeList.runTimeStampGrouped timer
+ (\time -> Trans.send . timeStamp latency time)
+{-
+ (\time msgs ->
+ liftIO (print time) >>
+ Trans.send (timeStamp latency time msgs))
+-}
+
+{-
+Group events before quantization.
+This results in splitted events which actually should occur at the same time.
+This makes SuperCollider switching the order messages in certain occasions.
+-}
+messagesGroupedManual :: Transport t =>
+ Timer.T ->
+ Time ->
+ TimeList.T Time OSC -> Trans.IO t ()
+messagesGroupedManual timer latency =
+ fmap (const ()) .
+ -- (\ pf -> liftIO Timer.getTimeSeconds >>= \startTime ->
+ TimeList.runTimeStamp timer
+ (\time ->
+ {-
+ putStr "current time: " >>
+ Timer.getTimeSeconds >>= print >>
+ putStrLn ("schedule time: " ++ show(time+latency)) >>
+ -}
+ {-
+ (liftIO $ putStr (show (time-startTime) ++ ": ") >>
+ (print $ map eventToMark es)) >>
+ -}
+ (Trans.send . timeStamp latency time)) -- pf)
+ . TimeList.collectCoincident
+
+messagesSingly :: Transport t =>
+ Timer.T ->
+ Time ->
+ TimeList.T Time OSC -> Trans.IO t ()
+messagesSingly timer latency =
+ fmap (const ()) .
+ TimeList.runTimeStamp timer
+ (\time ->
+ -- (liftIO $ print $ eventToMark e) >>
+ (Trans.send . timeStamp latency time . (:[])))
+
+
+messagesSimple :: Transport t =>
+ Timer.T ->
+ TimeList.T Time OSC ->
+ Trans.IO t ()
+messagesSimple timer =
+ fmap (const ()) .
+ TimeList.run timer Trans.send
diff --git a/src/Haskore/Interface/SuperCollider/Play/Channel.hs b/src/Haskore/Interface/SuperCollider/Play/Channel.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Play/Channel.hs
@@ -0,0 +1,164 @@
+{- |
+This is a variant of the "Haskore.Interface.SuperCollider.Play.Install" module.
+It assigns output channels to instruments
+such that instrument specific global effects can be applied to them.
+-}
+module Haskore.Interface.SuperCollider.Play.Channel
+ {-# DEPRECATED "use Haskore.Interface.SuperCollider.Schedule.Channel instead" #-}
+ where
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilt
+
+import Sound.SC3.UGen.Rate (Rate(KR))
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+import qualified Sound.SC3.Server.Command as SCCmd
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.Transport (Transport)
+import Sound.OpenSoundControl.Transport.UDP (UDP)
+import Sound.OpenSoundControl.Transport.File (File)
+import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+
+import qualified Haskore.Interface.SuperCollider.Channel.State as ChannelState
+import qualified Haskore.Interface.SuperCollider.Channel as Channel
+import Haskore.Interface.SuperCollider.Channel (Channel, NumberChannels)
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.Schedule.Channel
+ (Sound(..), SoundAttributes(..), ugenFromSound,
+ DrumAttributes, InstrumentAttributes,
+ {- rhythmicMusicFromDynamicMelody, -} rhythmicMusicFromMelody,
+ {- rhythmicMusicFromRhythm, rhythmicMusicFromDrum, -} )
+import Haskore.Interface.SuperCollider.SoundMap (AttributeList)
+
+import qualified Haskore.Music as Music
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Music.Rhythmic (qn)
+import Haskore.Melody as Melody
+
+import qualified Haskore.RealTime.Timer.Thread as TimerThread
+-- import qualified Haskore.RealTime.Timer.Immediate as TimerImmediate
+
+import qualified Haskore.General.IdGenerator as IdGen
+
+import qualified Control.Monad.State as State
+import Control.Monad.State (StateT, evalStateT, lift, liftM2)
+import Control.Monad.Reader (ReaderT)
+
+
+
+{- * Install instruments -}
+
+
+{-
+The @[OSC]@ state is used for messages for installing the instruments.
+We cannot use a Writer monad for this purpose
+because we have to read the generated messages for 'playMusic'.
+-}
+
+
+type Environment t a = StateT Channel (ReaderT t IO) a
+-- type Environment t a = StateT Channel (Trans.IO t) a
+
+
+installUGen :: Transport t =>
+ String ->
+ UGen ->
+ Environment t (Channel, NumberChannels)
+installUGen name sound =
+ do let numChan = SCPlay.mceDegree sound
+ chan <- Channel.next ChannelState.manager numChan
+ lift $ SCPlay.simpleSync $
+ Schedule.installUGenMsg name chan sound
+ return (chan, numChan)
+
+installSound ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ (parameterTuple -> AttributeList, graph -> SoundMap.Sound params) ->
+ String ->
+ graph ->
+ Environment t (Sound params parameterTuple)
+installSound (makeAttributeList, makeSoundUGen) name instr =
+ do chanChunk <-
+ installUGen name $ SoundMap.ugenFromSound $ makeSoundUGen instr
+ return (Sound name chanChunk makeAttributeList)
+
+
+
+
+{- * Play music -}
+
+reset :: Transport t => Environment t ()
+reset =
+ do Channel.reset ChannelState.manager
+ lift SCPlay.reset
+
+
+playMusic :: Transport t =>
+ UGen ->
+ RhyMusic.T DrumAttributes InstrumentAttributes ->
+ Environment t ()
+playMusic effect song =
+ let (sid,pf) =
+ SCPf.fixNodeIds $
+ liftM2 (,)
+ IdGen.alloc
+ (SCPf.fromRhythmicMusicWithAttributes
+ (\(SoundAttributes attrs name) -> (attrs,name))
+ (\(SoundAttributes attrs name) -> (attrs,name))
+ song)
+ effectsName = "global effects"
+ in lift $
+ {- We rely on the fact, that the performance player
+ always adds new nodes to the head.
+ This way, the effect is run after the instrument nodes. -}
+ Play.scheduleWithPlayer
+ (Play.messagesGrouped TimerThread.timer Play.defaultLatency)
+ (Schedule.fromPerformance
+ [Schedule.installUGenMsg effectsName
+ Schedule.defaultChannel effect]
+ [SCCmd.s_new effectsName sid SCCmd.AddToTail SCPlay.homeId []]
+ pf) >>
+ return ()
+
+
+run :: Environment UDP a -> IO a
+run act =
+ SCPlay.withSC3 (evalStateT act Channel.least)
+
+writeScript :: FilePath -> Environment File a -> IO a
+writeScript fn act =
+ SCPlay.withSC3File fn (evalStateT act Channel.least)
+
+
+
+{- * Example music -}
+
+example :: IO ()
+example =
+ run $
+ do sawPerc <- installSound SoundMap.with0Attributes "saw percussion" Example.sawPerc
+ dynPerc <- installSound SoundMap.with1Attribute "detuned bass" Example.dynPerc
+ let lfoSine = exp (SCOsci.sinOsc KR 0.2 (-pi/2) * 0.5) * 1000
+ lfoSquare = exp (SCOsci.pulse KR 5.1 0.5 * 1) * 1000
+ mix =
+ SCFilt.rlpf (0.5 * ugenFromSound sawPerc) lfoSine 0.1 +
+ SCFilt.rlpf (0.5 * ugenFromSound dynPerc) lfoSquare 0.1
+ -- SCUGen.Constant 0
+ let mel = rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line $
+ cycle [c 0 qn (), b 0 qn (), c 1 qn ()]
+ bass = rhythmicMusicFromMelody dynPerc $ Music.line $
+ cycle [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ playMusic mix $
+ -- (0.3 * SCOsci.sinOsc AR 880 0) $
+ Music.changeTempo 2 $
+ Music.chord [Music.changeTempo 3 mel, bass]
diff --git a/src/Haskore/Interface/SuperCollider/Play/Install.hs b/src/Haskore/Interface/SuperCollider/Play/Install.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Play/Install.hs
@@ -0,0 +1,105 @@
+{- |
+This is a variant of the "Haskore.Interface.SuperCollider.Play" module.
+Instead of an abstract @Instrument@ type
+and a "Haskore.Interface.SuperCollider.SoundMap",
+we attach SuperCollider instrument information to each note.
+
+This module can be used as basis for life performances.
+-}
+module Haskore.Interface.SuperCollider.Play.Install
+ {-# DEPRECATED "use Haskore.Interface.SuperCollider.Schedule.Install instead" #-}
+ where
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.Transport (Transport)
+import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+
+import Haskore.Interface.SuperCollider.Schedule.Install
+ (Sound(..),
+ SoundAttributes(..), InstrumentAttributes, DrumAttributes,
+ {- rhythmicMusicFromDynamicMelody, -} rhythmicMusicFromMelody,
+ {- rhythmicMusicFromRhythm, rhythmicMusicFromDrum, -} )
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap (AttributeList)
+
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Music.Rhythmic (qn)
+import qualified Haskore.Music as Music
+import Haskore.Melody as Melody
+
+
+
+installSound ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ (parameterTuple -> AttributeList, graph -> SoundMap.Sound params) ->
+ String ->
+ graph ->
+ Trans.IO t (Sound params parameterTuple)
+installSound (makeAttributeList, makeSoundUGen) name instr =
+ Play.installSound name (makeSoundUGen instr) >>
+ return (Sound name makeAttributeList)
+
+
+installSound0 ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ String ->
+ SoundMap.Sound params ->
+ Trans.IO t (Sound params ())
+installSound0 =
+ installSound SoundMap.with0Attributes
+
+installSound1 ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ String ->
+ (UGen -> SoundMap.Sound params) ->
+ Trans.IO t (Sound params Double)
+installSound1 =
+ installSound SoundMap.with1Attribute
+
+installSound2 ::
+ (Transport t, SoundMap.SoundParameters params) =>
+ String ->
+ (UGen -> UGen -> SoundMap.Sound params) ->
+ Trans.IO t (Sound params (Double,Double))
+installSound2 =
+ installSound SoundMap.with2Attributes
+
+
+
+
+playMusic :: Transport t =>
+ RhyMusic.T DrumAttributes InstrumentAttributes -> Trans.IO t ()
+playMusic =
+ Play.performanceTrans Play.defaultLatency [] .
+ SCPf.fixNodeIds .
+ SCPf.fromRhythmicMusicWithAttributes
+ (\(SoundAttributes attrs name) -> (attrs,name))
+ (\(SoundAttributes attrs name) -> (attrs,name))
+
+
+
+example :: IO ()
+example =
+ SCPlay.withSC3 $
+ do SCPlay.reset
+ sawPerc <- installSound0 "saw percussion" Example.sawPerc
+ dynPerc <- installSound1 "detuned bass" Example.dynPerc
+ let mel = rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line
+ [c 0 qn (), e 0 qn (),
+ Music.chord [c 0 qn (), e 0 qn (), g 0 qn ()]]
+ bass = rhythmicMusicFromMelody dynPerc $ Music.line
+ [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ playMusic $
+ Music.changeTempo 2 $
+ Music.chord [mel,bass]
+
diff --git a/src/Haskore/Interface/SuperCollider/Play/Life.hs b/src/Haskore/Interface/SuperCollider/Play/Life.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Play/Life.hs
@@ -0,0 +1,319 @@
+{- |
+This is a module specialised to life performances.
+
+You can create and install instruments in SuperCollider,
+obtain a handle and use that in your song.
+
+The alternative way would be to upload an instrument
+whenever one tone shall be played.
+This is less efficient but simpler and certainly more flexbile.
+-}
+module Haskore.Interface.SuperCollider.Play.Life where
+
+import qualified Sound.SC3 as SC
+import qualified Sound.SC3.UGen.IO as SCIO
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilt
+import qualified Sound.SC3.UGen.Envelope as SCUGEnv
+import qualified Sound.SC3.UGen.Noise.Base as SCNoise
+import qualified Sound.SC3.UGen.UId as SCUId
+
+import Sound.SC3.UGen.Enum (DoneAction(DoNothing, PauseSynth))
+import Sound.SC3.UGen.Rate (Rate(AR,KR))
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+import qualified Sound.SC3.Server.Command as SCCmd
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.Transport (Transport)
+import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play.Install as IPlay
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.Schedule.Channel as CSched
+import qualified Haskore.Interface.SuperCollider.Schedule.Install as ISched
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap
+ (InstrumentParameters, DrumParameters, AttributeList)
+
+import qualified Haskore.Interface.SuperCollider.Channel.Env as ChannelEnv
+import qualified Haskore.Interface.SuperCollider.Channel as Channel
+import Haskore.Interface.SuperCollider.Channel (Channel, NumberChannels)
+
+import Haskore.Interface.SuperCollider.Schedule.Channel
+ (Sound(..), ugenFromSound,
+ Instrument, -- InstrumentAttributes,
+ Drum, -- DrumAttributes,
+ rhythmicMusicFromDynamicMelody, rhythmicMusicFromMelody,
+ rhythmicMusicFromRhythm, rhythmicMusicFromDrum)
+import Haskore.Interface.SuperCollider.Schedule.Install
+ (InstrumentAttributes(..), DrumAttributes(..))
+
+import qualified Haskore.Basic.Pitch as Pitch
+import qualified Haskore.Basic.Duration as Dur
+import Haskore.Basic.Duration ((%+))
+
+import qualified Haskore.RealTime.Timer.Thread as TimerThread
+
+import qualified Haskore.General.IdGenerator as IdGen
+
+import qualified Haskore.Composition.Drum as Drum
+import Haskore.Composition.Chord as Chord
+
+import Haskore.Melody as Melody
+import qualified Haskore.Music as Music
+import Haskore.Music (mapNote)
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Music.Rhythmic (
+ (+:+), (=:=),
+ wn, hn, qn, en, sn, tn, sfn,
+ dwn, dhn, dqn, den, dsn, dtn,
+ wnr, hnr, qnr, enr, snr, tnr, sfnr,
+ dwnr, dhnr, dqnr, denr, dsnr, dtnr,)
+
+-- import System.Random (randomRs, mkStdGen)
+
+import System.Posix.Process (forkProcess)
+-- import Control.Concurrent (forkIO)
+import Control.Monad (liftM2)
+
+import Data.List (elemIndex)
+
+
+
+{- * Install instruments -}
+
+type InstrumentUGen = UGen -> UGen -> UGen
+
+installInstr ::
+ (parameterTuple -> AttributeList, graph -> InstrumentUGen) ->
+ String ->
+ graph ->
+ IO (ISched.Instrument parameterTuple)
+installInstr (makeAttributeList, makeSoundUGen) name sound =
+ SCPlay.withSC3 $
+ IPlay.installSound
+ (makeAttributeList, SoundMap.instrumentFromUGen . makeSoundUGen) name sound
+
+
+installInstr0 ::
+ String ->
+ InstrumentUGen ->
+ IO (ISched.Instrument ())
+installInstr0 =
+ installInstr SoundMap.with0Attributes
+
+installInstr1 ::
+ String ->
+ (UGen -> InstrumentUGen) ->
+ IO (ISched.Instrument Double)
+installInstr1 =
+ installInstr SoundMap.with1Attribute
+
+installInstr2 ::
+ String ->
+ (UGen -> UGen -> InstrumentUGen) ->
+ IO (ISched.Instrument (Double,Double))
+installInstr2 =
+ installInstr SoundMap.with2Attributes
+
+
+type DrumUGen = UGen -> UGen
+
+installDrum ::
+ (parameterTuple -> AttributeList, graph -> DrumUGen) ->
+ String ->
+ graph ->
+ IO (ISched.Drum parameterTuple)
+installDrum (makeAttributeList, makeSoundUGen) name sound =
+ SCPlay.withSC3 $
+ IPlay.installSound
+ (makeAttributeList, SoundMap.drumFromUGen . makeSoundUGen) name sound
+
+
+
+
+{- * Install instruments on specific channels -}
+
+
+installSoundChan ::
+ SoundMap.SoundParameters params =>
+ String ->
+ SoundMap.Sound params ->
+ IO (Channel, NumberChannels)
+installSoundChan name sound =
+ do let ugen = SoundMap.ugenFromSound sound
+ let numChan = SCPlay.mceDegree ugen
+ chan <- Channel.next ChannelEnv.manager numChan
+ SCPlay.withSC3 $
+ SCPlay.simpleSync $ SCPlay.d_recv' name $
+ SCIO.out (SCUGen.Constant (fromIntegral chan)) ugen
+ return (chan, numChan)
+
+
+installInstrChan ::
+ (parameterTuple -> AttributeList, graph -> InstrumentUGen) ->
+ String ->
+ graph ->
+ IO (Instrument parameterTuple)
+installInstrChan (makeAttributeList, makeInstrumentUGen) name sound =
+ do chanChunk <-
+ installSoundChan name $
+ SoundMap.instrumentFromUGen $
+ makeInstrumentUGen sound
+ return (Sound name chanChunk makeAttributeList)
+
+installDrumChan ::
+ (parameterTuple -> AttributeList, graph -> DrumUGen) ->
+ String ->
+ graph ->
+ IO (Drum parameterTuple)
+installDrumChan (makeAttributeList, makeDrumUGen) name sound =
+ do chanChunk <-
+ installSoundChan name $
+ SoundMap.drumFromUGen $
+ makeDrumUGen sound
+ return (Sound name chanChunk makeAttributeList)
+
+
+
+{- |
+This one is more portable but less elegant.
+-}
+
+
+{- * Play music -}
+
+reset :: IO ()
+reset =
+ do Channel.reset ChannelEnv.manager
+ SCPlay.withSC3 $ SCPlay.reset
+
+playSound :: UGen -> IO ()
+playSound = fmap (const ()) . SCPlay.withSC3 . SCPlay.play
+
+playMusic ::
+ RhyMusic.T DrumAttributes InstrumentAttributes -> IO ()
+playMusic =
+ Play.performance Play.defaultLatency [] .
+ SCPf.fixNodeIds .
+ SCPf.fromRhythmicMusicWithAttributes
+ (\(ISched.SoundAttributes params name) -> (params,name))
+ (\(ISched.SoundAttributes params name) -> (params,name))
+
+playMusicEffect ::
+ UGen ->
+ RhyMusic.T CSched.DrumAttributes CSched.InstrumentAttributes ->
+ IO ()
+playMusicEffect effect song =
+ let (sid,pf) =
+ SCPf.fixNodeIds $
+ liftM2 (,)
+ IdGen.alloc
+ (SCPf.fromRhythmicMusicWithAttributes
+ (\(CSched.SoundAttributes params name) -> (params,name))
+ (\(CSched.SoundAttributes params name) -> (params,name))
+ song)
+ effectsName = "global effects"
+ in SCPlay.withSC3 $
+ {- We rely on the fact, that the performance player
+ always adds new nodes to the head.
+ This way, the effect is run after the instrument nodes. -}
+ Play.scheduleWithPlayer
+ (Play.messagesGrouped TimerThread.timer Play.defaultLatency)
+ (Schedule.fromPerformance
+ [Schedule.installUGenMsg effectsName
+ Schedule.defaultChannel effect]
+ [SCCmd.s_new effectsName sid SCCmd.AddToTail SCPlay.homeId []]
+ pf) >>
+ return ()
+
+
+{- * Interactively play music on keyboard -}
+
+germanLatin1Keyboard :: [Char]
+germanLatin1Keyboard =
+ let oUmlaut = '\246'
+ uUmlaut = '\252'
+ szLig = '\223'
+ in "ysxdcvgbhnjm,l."++oUmlaut:"-q2w3e4rt6z7ui9o0p"++szLig:uUmlaut:"+"
+
+playKey :: ISched.Instrument () -> Char -> IO ()
+playKey (ISched.Sound name _) key =
+ maybe
+ (return ())
+ (\pitch ->
+ do SCPlay.withSC3 $
+ Play.playAtom SCPlay.noId name $
+ ("pitch", Pitch.intToFreq pitch) :
+ ("velocity", 1) : []
+ print (Pitch.fromInt pitch))
+ (elemIndex key germanLatin1Keyboard)
+
+{- |
+Interprets the keyboard as piano and play according tones,
+when keys are hit.
+
+Is it more convenient to have a UGen parameter and install the instrument automatically?
+-}
+{-
+Try suppressing output on keys by
+System.IO.hSetEcho System.IO.stdin False
+-}
+playKeyboard :: ISched.Instrument () -> IO ()
+playKeyboard instr =
+ let recurse =
+ do char <- getChar
+ if char == '\004'
+ then putStrLn ""
+ else do putChar '\008'
+ playKey instr char
+ recurse
+ in recurse
+
+
+
+{- * Example music -}
+
+
+example :: IO ()
+example =
+ do reset
+ sawPerc <- installInstr0 "saw percussion" Example.sawPercUGen
+ dynPerc <- installInstr1 "detuned bass" Example.dynPercUGen
+ let mel = ISched.rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line
+ [c 0 qn (), e 0 qn (),
+ Music.chord [c 0 qn (), e 0 qn (), g 0 qn ()]]
+ bass = ISched.rhythmicMusicFromMelody dynPerc $ Music.line
+ [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ playMusic $
+ Music.changeTempo 2 $
+ Music.chord [mel,bass]
+
+
+exampleEffect :: IO ()
+exampleEffect =
+ do reset
+ sawPerc <- installInstrChan SoundMap.with0Attributes "saw percussion" Example.sawPercUGen
+ dynPerc <- installInstrChan SoundMap.with1Attribute "detuned bass" Example.dynPercUGen
+ let lfoSine = exp (SCOsci.sinOsc KR 0.2 (-pi/2) * 0.5) * 1000
+ lfoSquare = exp (SCOsci.pulse KR 5.1 0.5 * 1) * 1000
+ mix =
+ SCFilt.rlpf (0.5 * ugenFromSound sawPerc) lfoSine 0.1 +
+ SCFilt.rlpf (0.5 * ugenFromSound dynPerc) lfoSquare 0.1
+ -- SCUGen.Constant 0
+ let mel = CSched.rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line $
+ cycle [c 0 qn (), b 0 qn (), c 1 qn ()]
+ bass = CSched.rhythmicMusicFromMelody dynPerc $ Music.line $
+ cycle [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ playMusicEffect mix $
+ -- (0.3 * SCOsci.sinOsc AR 880 0) $
+ Music.changeTempo 2 $
+ Music.chord [Music.changeTempo 3 mel, bass]
+
diff --git a/src/Haskore/Interface/SuperCollider/Render.hs b/src/Haskore/Interface/SuperCollider/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Render.hs
@@ -0,0 +1,97 @@
+module Haskore.Interface.SuperCollider.Render (
+ fileFromMelody, fileFromMelodyMonad,
+
+ byteStringFromSchedule, runSCSynth,
+ HeaderFormat(..), SampleFormat(..),
+ ) where
+
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.Play as Play
+
+import Haskore.Interface.SuperCollider.SoundMap (Instrument)
+
+import qualified Sound.SC3.Server.NRT as SCNRT
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+
+-- import Sound.OpenSoundControl.Transport (Transport)
+-- import qualified Sound.OpenSoundControl.Transport.Monad as Trans
+
+import qualified Data.ByteString.Lazy as B
+
+import qualified Haskore.Melody as Melody
+
+import qualified Haskore.RealTime.Timer.Immediate as TimerImmediate
+
+import System.Cmd (rawSystem)
+import System.Exit (ExitCode)
+
+import Data.Array(Array, Ix, (!), listArray)
+
+
+
+{- * Generate audio files for various representations of music. -}
+
+fileFromMelody :: FilePath -> Instrument -> Melody.T () -> IO ()
+fileFromMelody fileName sound =
+ B.writeFile fileName .
+ byteStringFromSchedule .
+ Schedule.fromMelody sound
+
+fileFromMelodyMonad :: FilePath -> Instrument -> Melody.T () -> IO ()
+fileFromMelodyMonad fileName sound =
+ SCPlay.withSC3File fileName .
+ Play.scheduleWithPlayer
+ (Play.messagesGrouped TimerImmediate.timer 0) .
+ Schedule.fromMelody sound
+
+
+{- * invocation of SuperCollider program -}
+
+data HeaderFormat = AIFF | Wave | NeXT
+ deriving (Read, Show, Eq, Ord, Ix, Bounded)
+
+headerExtension :: Array HeaderFormat String
+headerExtension =
+ listArray (minBound,maxBound) ["aiff", "wav", "au"]
+
+headerName :: Array HeaderFormat String
+headerName =
+ listArray (minBound,maxBound) ["AIFF", "WAVE", "NeXT"]
+
+
+data SampleFormat = Int16 | Int24 | Int32 | Float | Double
+ deriving (Read, Show, Eq, Ord, Ix, Bounded)
+
+sampleName :: Array SampleFormat String
+sampleName =
+ listArray (minBound,maxBound)
+ ["int16", "int24", "int32", "float", "double"]
+
+{-
+because there are so much parameters,
+an option list would be the better choice
+-}
+runSCSynth ::
+ [String] ->
+ Int {- ^ number of (stereo) channels -} ->
+ HeaderFormat ->
+ SampleFormat ->
+ Int {- ^ sample rate -} ->
+ FilePath ->
+ IO ExitCode
+runSCSynth
+ options numChannels headerFormat sampleFormat sampleRate fileName =
+ rawSystem "scsynth"
+ (options ++
+ ["-D", "0", "-o", show numChannels, "-N",
+ fileName++".osc", "_", fileName ++ '.' : headerExtension ! headerFormat,
+ show sampleRate, headerName ! headerFormat, sampleName ! sampleFormat])
+
+
+{- * helper functions -}
+
+byteStringFromSchedule :: Schedule.T -> B.ByteString
+byteStringFromSchedule =
+ SCNRT.encodeNRT .
+ Schedule.toStream
+
diff --git a/src/Haskore/Interface/SuperCollider/Schedule.hs b/src/Haskore/Interface/SuperCollider/Schedule.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Schedule.hs
@@ -0,0 +1,356 @@
+module Haskore.Interface.SuperCollider.Schedule (
+ T(..), SoundHandler, Time,
+
+ fromMelody, fromMusic, fromMusicGlobalEffect,
+ fromRhythmicMusicSoundEffects,
+ fromPerformance,
+ rhythmicMusic, rhythmicMusicWithAttributes,
+
+ -- for Play module
+ installUGenMsg, installSoundMsg,
+ defaultChannel, atomPlayMsg,
+ timeStamp,
+
+ -- for Render module
+ toStream,
+
+ -- for suppression of "unused" warnings :-)
+ fromMusicMsgs, messagesToStream, eventToMark,
+
+ -- testing
+ -- fromMelodyPerformance,
+ ) where
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+
+import qualified Sound.SC3.Server.Command as SCCmd
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+
+import Sound.SC3.UGen.UGen (UGen)
+
+-- import qualified Sound.OpenSoundControl.Transport.UDP as UDP
+-- import qualified Sound.OpenSoundControl.UDPMonad as UDP
+import Sound.OpenSoundControl.OSC (OSC(Bundle))
+
+import qualified Haskore.Interface.SuperCollider.Note as Note
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap (Instrument, Sound)
+
+import Haskore.Interface.SuperCollider.Channel (Channel, NumberChannels)
+import qualified Haskore.Interface.SuperCollider.Channel as Channel
+
+import qualified Haskore.Melody as Melody
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import qualified Haskore.Music as Music
+
+import qualified Haskore.Performance.BackEnd as PfBE
+import qualified Haskore.RealTime.EventList.TimeBody as TimeList
+import qualified Haskore.RealTime.EventList.TimeTime as TimeListPad
+import qualified Data.EventList.Absolute.TimeBody as AbsoluteEventList
+
+import qualified Haskore.General.IdGenerator as IdGen
+
+import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+import Control.Monad (liftM2)
+
+import Data.Maybe(fromMaybe,maybeToList)
+
+
+{- * Schedule data structure -}
+
+
+data T =
+ Cons {
+ initial :: [OSC]
+ {- ^ All of these messages must be synchronous!
+ Otherwise the player might wait forever. -},
+ body :: TimeList.T Time OSC
+ }
+ deriving Show
+
+type SoundAssign = (SoundMap.Name, UGen)
+
+type SoundHandler note =
+ (Note.FromNote NonNeg.Double note, [SoundAssign])
+
+type Time = NonNeg.Double
+
+
+fromMusic :: Ord note =>
+ SoundHandler note ->
+ Music.T note ->
+ T
+fromMusic (makeNote, soundAssigns) =
+ fromPerformance (installSoundsMsg defaultChannel soundAssigns) [] .
+ SCPf.fixNodeIds .
+ SCPf.fromMusic makeNote
+
+fromMusicMsgs :: Ord note =>
+ (Note.FromNote NonNeg.Double note, [OSC]) ->
+ Music.T note ->
+ T
+fromMusicMsgs (makeNote, installSounds) =
+ fromPerformance installSounds [] .
+ SCPf.fixNodeIds .
+ SCPf.fromMusic makeNote
+
+fromMusicGlobalEffect :: Ord note =>
+ SoundHandler note ->
+ (UGen -> UGen, NumberChannels) ->
+ Music.T note ->
+ T
+fromMusicGlobalEffect
+ (makeNote, soundAssigns) (globalEffect, numChan) music =
+ let effectsName = "global effects"
+ instrumentChannel = defaultChannel+numChan
+ effectChannel = defaultChannel
+ (sid,pf) =
+ SCPf.fixNodeIds $
+ liftM2 (,)
+ IdGen.alloc
+ (SCPf.fromMusic makeNote music)
+ in fromPerformance
+ (installUGenMsg effectsName effectChannel
+ (globalEffect (Channel.readUGen numChan instrumentChannel)) :
+ installSoundsMsg instrumentChannel soundAssigns)
+ [SCCmd.s_new effectsName sid SCCmd.AddToTail SCPlay.homeId []]
+ pf
+
+fromRhythmicMusicSoundEffects ::
+ (Ord drum, Ord instr) =>
+ SoundMap.ChannelMap instr drum ->
+ NumberChannels ->
+ RhyMusic.T instr drum ->
+ T
+fromRhythmicMusicSoundEffects cMap numChan music =
+ let effectsName = "global effects"
+ instrumentChannel = defaultChannel+numChan
+ effectChannel = defaultChannel
+ (globalEffect, (drumCMap, instrCMap)) =
+ SoundMap.runChannelMap cMap instrumentChannel
+ (drumChannels, drumMap) = unzip drumCMap
+ (instrChannels,instrMap) = unzip instrCMap
+ (makeNote, soundAssigns) =
+ rhythmicMusicWithAttributes drumMap instrMap
+ soundChannelAssigns =
+ zipWith
+ (\chan (name,ugen) -> (name,chan,ugen))
+ (drumChannels++instrChannels) soundAssigns
+ (sid,pf) =
+ SCPf.fixNodeIds $
+ liftM2 (,)
+ IdGen.alloc
+ (SCPf.fromMusic makeNote music)
+ in fromPerformance
+ (installUGenMsg effectsName effectChannel globalEffect :
+ installChannelSoundsMsg soundChannelAssigns)
+ [SCCmd.s_new effectsName sid SCCmd.AddToTail SCPlay.homeId []]
+ pf
+
+-- slightly inconsistent naming with respect to Music.fromMelodyNullAttr
+rhythmicMusic :: (Show instr, Show drum, Ord instr, Ord drum) =>
+ SoundMap.DrumTable drum ->
+ SoundMap.InstrumentTable instr ->
+ SoundHandler (RhyMusic.Note drum instr)
+rhythmicMusic drumMap instrMap =
+ (Note.fromRhythmicNote show show,
+ map extractSoundAssign drumMap ++
+ map extractSoundAssign instrMap)
+
+rhythmicMusicWithAttributes :: (Ord instr, Ord drum) =>
+ SoundMap.DrumTableWithAttributes drum ->
+ SoundMap.InstrumentTableWithAttributes instr ->
+ SoundHandler (RhyMusic.Note drum instr)
+rhythmicMusicWithAttributes drumMap instrMap =
+ (Note.fromRhythmicNoteWithAttributes
+ (SoundMap.lookup drumMap)
+ (SoundMap.lookup instrMap),
+ -- fromRhythmicMusicSoundEffects relies on that order
+ map extractSoundWithAttributesAssign drumMap ++
+ map extractSoundWithAttributesAssign instrMap)
+
+
+
+fromMelody ::
+ Instrument ->
+ Melody.T () ->
+ T
+fromMelody sound =
+ fromMelodyPerformance sound .
+ SCPf.fromMelody
+
+
+melodyRestError :: a
+melodyRestError =
+ error "SuperCollider.Play: Music from Melody contains a rest."
+
+
+fromMelodyPerformance ::
+ Instrument ->
+ PfBE.Padded Time Note.T ->
+ T
+fromMelodyPerformance sound =
+ let name = "mono instrument"
+
+ sid = SCPf.instrStartNodeId
+ installSoundEvent =
+ installSoundMsg name defaultChannel sound
+ playSoundEvent =
+ atomPlayMsg sid name []
+
+ events =
+ flip TimeListPad.snocBody stopMsg .
+ TimeListPad.mapBody
+ (\note ->
+ SCCmd.n_set sid
+ [(SoundMap.pitchName, NonNeg.toNumber $ fromMaybe melodyRestError $ Note.pitch note),
+ (SoundMap.velocityName, NonNeg.toNumber (Note.velocity note))]) .
+ TimeListPad.mapBody PfBE.eventNote
+
+ in Cons (installSoundEvent : []) .
+ prependInitialMsgs (resetMsgs ++ playSoundEvent : []) . events
+
+
+fromPerformance ::
+ [OSC] ->
+ [OSC] ->
+ SCPf.T Time ->
+ T
+fromPerformance installInstruments globalEffects pf =
+ Cons
+ installInstruments
+ (prependInitialMsgs
+ (resetMsgs ++ globalEffects) (messagesFromPerformance pf))
+
+
+prependInitialMsgs :: [OSC] -> TimeList.T Time OSC -> TimeList.T Time OSC
+prependInitialMsgs = flip (foldr (TimeList.cons 0))
+
+messagesFromPerformance :: SCPf.T Time -> TimeList.T Time OSC
+messagesFromPerformance =
+ flip TimeListPad.snocBody stopMsg .
+ TimeListPad.mapBody (uncurry eventToMsg)
+
+
+toStream ::
+ T ->
+ [OSC]
+toStream sc =
+ timeStamp 0 (initial sc) :
+ messagesToStream (body sc)
+
+messagesToStream ::
+ TimeList.T Time OSC ->
+ [OSC]
+messagesToStream =
+ map (uncurry timeStamp) .
+ AbsoluteEventList.toPairList .
+ {- first absolutize, then collectCoincident in order to catch
+ coincidences caused by rounding -}
+ AbsoluteEventList.collectCoincident .
+ TimeList.toAbsoluteEventList 0
+
+timeStamp :: Time -> [OSC] -> OSC
+timeStamp = Bundle . NonNeg.toNumber
+
+
+
+
+
+
+{- * Construction of OpenSoundControl messages -}
+
+stopMsg :: OSC
+stopMsg = SCCmd.g_freeAll [SCPlay.homeId]
+
+
+resetMsgs :: [OSC]
+resetMsgs =
+ [SCCmd.g_freeAll [SCPlay.rootId],
+ SCCmd.g_new [(SCPlay.homeId, SCCmd.AddToTail, SCPlay.rootId)]]
+
+
+atomPlayMsg ::
+ SCPlay.NodeId ->
+ String ->
+ [(String, Double)] ->
+ OSC
+atomPlayMsg sid name =
+ SCCmd.s_new name sid SCCmd.AddToHead SCPlay.homeId
+ -- adding to head is necessary for allowing global effects like in the Life module
+
+
+installUGenMsg ::
+ String ->
+ Channel ->
+ UGen ->
+ OSC
+installUGenMsg name chan =
+ SCPlay.d_recv' name .
+ Channel.writeUGen chan
+
+installSoundMsg ::
+ SoundMap.SoundParameters params =>
+ String ->
+ Channel ->
+ Sound params ->
+ OSC
+installSoundMsg name chan =
+ installUGenMsg name chan . SoundMap.ugenFromSound
+
+
+defaultChannel :: Channel
+defaultChannel = 0
+
+
+installSoundsMsg ::
+ Channel ->
+ [SoundAssign] ->
+ [OSC]
+installSoundsMsg channel =
+ map (\(name,sound) ->
+ installUGenMsg name channel sound)
+
+installChannelSoundsMsg ::
+ [(SoundMap.Name, Channel, UGen)] ->
+ [OSC]
+installChannelSoundsMsg =
+ map (\(name, channel, ugen) ->
+ installUGenMsg name channel ugen)
+
+extractSoundAssign ::
+ (Show instr, SoundMap.SoundParameters params) =>
+ (instr, Sound params) -> SoundAssign
+extractSoundAssign =
+ \(instr, sound) ->
+ (show instr, SoundMap.ugenFromSound sound)
+
+extractSoundWithAttributesAssign ::
+ SoundMap.SoundParameters params =>
+ SoundMap.Assign params instr -> SoundAssign
+extractSoundWithAttributesAssign =
+ \(SoundMap.Assign name _ sound) -> (name, SoundMap.ugenFromSound sound)
+
+
+eventToMark ::
+ (SCPlay.NodeId, Maybe Note.T) ->
+ (SCPlay.NodeId, Bool)
+eventToMark (sid, note) =
+ (sid, maybe False (const True) note)
+
+eventToMsg :: SCPlay.NodeId -> Maybe (Time, Note.T) -> OSC
+eventToMsg sid =
+ maybe
+ (SCCmd.n_free [sid])
+ (\(dur,note) ->
+ atomPlayMsg sid
+ (Note.instrument note)
+ (map ((,) SoundMap.pitchName . NonNeg.toNumber)
+ (maybeToList (Note.pitch note)) ++
+ (SoundMap.velocityName, NonNeg.toNumber (Note.velocity note)) :
+ (SoundMap.durationName, NonNeg.toNumber dur) :
+ zip SoundMap.attributeNames (Note.parameters note)))
+
diff --git a/src/Haskore/Interface/SuperCollider/Schedule/Channel.hs b/src/Haskore/Interface/SuperCollider/Schedule/Channel.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Schedule/Channel.hs
@@ -0,0 +1,228 @@
+{- |
+This is a variant of the "Haskore.Interface.SuperCollider.Schedule.Install" module.
+It assigns output channels to instruments
+such that instrument specific global effects can be applied to them.
+-}
+module Haskore.Interface.SuperCollider.Schedule.Channel where
+
+import qualified Sound.SC3.UGen.UGen as SCUGen
+import qualified Sound.SC3.UGen.Oscillator as SCOsci
+import qualified Sound.SC3.UGen.Filter as SCFilt
+
+import Sound.SC3.UGen.Rate (Rate(KR))
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+import qualified Sound.SC3.Server.Command as SCCmd
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.OSC (OSC)
+
+import qualified Haskore.Interface.SuperCollider.Channel as Channel
+import Haskore.Interface.SuperCollider.Channel (Channel, NumberChannels)
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.Note as Note
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap
+ (InstrumentParameters, DrumParameters, AttributeList)
+
+import qualified Haskore.Composition.Drum as Drum
+import qualified Haskore.Composition.Rhythm as Rhythm
+
+import qualified Haskore.Music as Music
+import Haskore.Music (mapNote)
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Music.Rhythmic (qn)
+import Haskore.Melody as Melody
+
+import qualified Haskore.General.IdGenerator as IdGen
+
+import qualified Control.Monad.State as State
+import Control.Monad.State (StateT, runStateT, lift, liftM2, get, put)
+import Control.Monad.Writer (Writer, tell, runWriter)
+
+
+
+{- * Install instruments -}
+
+
+newtype Environment a =
+ Environment {unwrapEnvironment ::
+ StateT (Channel, NumberChannels) (Writer [OSC]) a}
+
+instance Monad Environment where
+ x >>= y = Environment $ unwrapEnvironment . y =<< unwrapEnvironment x
+ return = Environment . return
+
+writeOSC :: [OSC] -> Environment ()
+writeOSC = Environment . lift . tell
+
+nextChannel :: NumberChannels -> Environment Channel
+nextChannel numChan =
+ Environment $
+ do (chan, maxNumChan) <- get
+ put (chan+numChan, max numChan maxNumChan)
+ return chan
+
+
+data Sound params attr =
+ Sound String (Channel, NumberChannels) (attr -> AttributeList)
+
+type Instrument attr = Sound InstrumentParameters attr
+type Drum attr = Sound DrumParameters attr
+
+
+installUGen ::
+ String ->
+ UGen ->
+ Environment (Channel, NumberChannels)
+installUGen name sound =
+ do let numChan = SCPlay.mceDegree sound
+ chan <- nextChannel numChan
+ writeOSC [Schedule.installUGenMsg name chan sound]
+ return (chan, numChan)
+
+installSound ::
+ SoundMap.SoundParameters params =>
+ (parameterTuple -> AttributeList, graph -> SoundMap.Sound params) ->
+ String ->
+ graph ->
+ Environment (Sound params parameterTuple)
+installSound (makeAttributeList, makeSoundUGen) name instr =
+ do chanChunk <-
+ installUGen name $ SoundMap.ugenFromSound $ makeSoundUGen instr
+ return (Sound name chanChunk makeAttributeList)
+
+ugenFromSound :: Sound params attr -> UGen
+ugenFromSound (Sound _ (chan, numChan) _) =
+ Channel.readUGen numChan chan
+
+
+
+
+
+{- * Play music -}
+
+{- |
+These types are identically defined to those from
+"Haskore.Interface.SuperCollider.Schedule.Install"
+but they shall be distinct.
+Instruments that are installed for use of global effects
+cannot be used with the simple 'playMusic' routine.
+-}
+data SoundAttributes params = SoundAttributes AttributeList String
+ deriving (Eq, Ord)
+
+type DrumAttributes = SoundAttributes DrumParameters
+type InstrumentAttributes = SoundAttributes InstrumentParameters
+
+
+rhythmicMusicFromDynamicMelody ::
+ Instrument attr ->
+ Melody.T (Rational, attr) ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromDynamicMelody (Sound name _ flattenAttr) =
+ RhyMusic.fromMelody
+ (\(vel,attr) -> (vel, SoundAttributes (flattenAttr attr) name))
+
+rhythmicMusicFromMelody ::
+ Instrument attr ->
+ Melody.T attr ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromMelody instr =
+ rhythmicMusicFromDynamicMelody instr .
+ mapNote (\(Melody.Note attr p) -> Melody.Note (1,attr) p)
+
+
+rhythmicMusicFromRhythm ::
+ Drum () ->
+ Music.Dur ->
+ String ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromRhythm (Sound name _ _) dur =
+ Rhythm.toMusicWithDrumUnit dur (SoundAttributes [] name) .
+ Rhythm.fromString
+
+rhythmicMusicFromDrum ::
+ Drum () ->
+ Music.Dur ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromDrum (Sound name _ _) dur =
+ Drum.toMusicDefaultAttr (SoundAttributes [] name) dur
+
+
+{-
+reset :: Environment ()
+reset =
+ do Channel.reset ChannelState.manager
+ lift SCPlay.reset
+-}
+
+fromRhythmicMusic ::
+ Environment
+ (UGen,
+ RhyMusic.T DrumAttributes InstrumentAttributes) ->
+ Schedule.T
+fromRhythmicMusic genMusic =
+ let {- a nice loop in order to determine the maximum number of channels needed
+ and reserving an according number of channels beginning at zero -}
+ (((effect,song), (_,maxNumChan)), installSounds) =
+ runWriter $
+ runStateT (unwrapEnvironment genMusic) (maxNumChan,0)
+ (sid,pf) =
+ SCPf.fixNodeIds $
+ liftM2 (,)
+ IdGen.alloc
+ (SCPf.fromMusic
+ (Note.fromRhythmicNoteWithAttributes
+ (\(SoundAttributes params name) -> (params,name))
+ (\(SoundAttributes params name) -> (params,name)))
+ song)
+ effectsName = "global effects"
+ in {- We rely on the fact, that the performance player
+ always adds new nodes to the head.
+ This way, the effect is run after the instrument nodes. -}
+ Schedule.fromPerformance
+ (Schedule.installUGenMsg effectsName Schedule.defaultChannel effect :
+ installSounds)
+ [SCCmd.s_new effectsName sid SCCmd.AddToTail SCPlay.homeId []]
+ pf
+
+
+{-
+run :: Environment UDP a -> IO a
+run act =
+ SCPlay.withSC3 (evalStateT act Channel.least)
+
+writeScript :: FilePath -> Environment File a -> IO a
+writeScript fn act =
+ SCPlay.withSC3File fn (evalStateT act Channel.least)
+-}
+
+
+{- * Example music -}
+
+example :: IO ()
+example =
+ Play.schedule Play.defaultLatency $ fromRhythmicMusic $
+ do sawPerc <- installSound SoundMap.with0Attributes "saw percussion" Example.sawPerc
+ dynPerc <- installSound SoundMap.with1Attribute "detuned bass" Example.dynPerc
+ let lfoSine = exp (SCOsci.sinOsc KR 0.2 (-pi/2) * 0.5) * 1000
+ lfoSquare = exp (SCOsci.pulse KR 5.1 0.5 * 1) * 1000
+ mix =
+ SCFilt.rlpf (0.5 * ugenFromSound sawPerc) lfoSine 0.1 +
+ SCFilt.rlpf (0.5 * ugenFromSound dynPerc) lfoSquare 0.1
+ -- SCUGen.Constant 0
+ let mel = rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line $
+ cycle [c 0 qn (), b 0 qn (), c 1 qn ()]
+ bass = rhythmicMusicFromMelody dynPerc $ Music.line $
+ cycle [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ return (mix,
+ -- (0.3 * SCOsci.sinOsc AR 880 0) $
+ Music.changeTempo 2 $
+ Music.chord [Music.changeTempo 3 mel, bass])
diff --git a/src/Haskore/Interface/SuperCollider/Schedule/Install.hs b/src/Haskore/Interface/SuperCollider/Schedule/Install.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/Schedule/Install.hs
@@ -0,0 +1,167 @@
+{- |
+This is a variant of the "Haskore.Interface.SuperCollider.Schedule" module.
+Instead of an abstract @Instrument@ type
+and a "Haskore.Interface.SuperCollider.SoundMap",
+we attach SuperCollider instrument information to each note.
+-}
+module Haskore.Interface.SuperCollider.Schedule.Install where
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Sound.OpenSoundControl.OSC (OSC)
+
+import qualified Haskore.Interface.SuperCollider.Example as Example
+import qualified Haskore.Interface.SuperCollider.Play as Play
+import qualified Haskore.Interface.SuperCollider.Schedule as Schedule
+import qualified Haskore.Interface.SuperCollider.Note as Note
+import qualified Haskore.Interface.SuperCollider.SoundMap as SoundMap
+
+import Haskore.Interface.SuperCollider.SoundMap
+ (DrumParameters, InstrumentParameters, AttributeList)
+
+import qualified Haskore.Composition.Drum as Drum
+import qualified Haskore.Composition.Rhythm as Rhythm
+
+import qualified Haskore.Music.Rhythmic as RhyMusic
+import Haskore.Music.Rhythmic (qn)
+import qualified Haskore.Music as Music
+import Haskore.Melody as Melody
+
+
+import Control.Monad.Writer (MonadWriter, Writer, tell, runWriter)
+
+
+
+{- |
+The @[OSC]@ state is used for messages for installing the instruments.
+We cannot use a Writer monad for this purpose
+because we have to read the generated messages for 'playMusic'.
+-}
+newtype Environment a =
+ Environment {unwrapEnvironment :: Writer [OSC] a}
+
+instance Monad Environment where
+ x >>= y = Environment $ unwrapEnvironment . y =<< unwrapEnvironment x
+ return = Environment . return
+
+writeOSC :: [OSC] -> Environment ()
+writeOSC = Environment . tell
+
+
+data Sound params attr =
+ Sound
+ {nameFromSound :: String,
+ flattenAttrFromSound :: (attr -> AttributeList)}
+
+type Instrument attr = Sound InstrumentParameters attr
+type Drum attr = Sound DrumParameters attr
+
+
+
+installSound ::
+ SoundMap.SoundParameters params =>
+ (parameterTuple -> AttributeList, graph -> SoundMap.Sound params) ->
+ String ->
+ graph ->
+ Environment (Sound params parameterTuple)
+installSound (makeAttributeList, makeSoundUGen) name instr =
+ writeOSC [Schedule.installSoundMsg name
+ Schedule.defaultChannel (makeSoundUGen instr)] >>
+ return (Sound name makeAttributeList)
+
+
+installSound0 ::
+ SoundMap.SoundParameters params =>
+ String ->
+ SoundMap.Sound params ->
+ Environment (Sound params ())
+installSound0 =
+ installSound SoundMap.with0Attributes
+
+installSound1 ::
+ SoundMap.SoundParameters params =>
+ String ->
+ (UGen -> SoundMap.Sound params) ->
+ Environment (Sound params Double)
+installSound1 =
+ installSound SoundMap.with1Attribute
+
+installSound2 ::
+ SoundMap.SoundParameters params =>
+ String ->
+ (UGen -> UGen -> SoundMap.Sound params) ->
+ Environment (Sound params (Double,Double))
+installSound2 =
+ installSound SoundMap.with2Attributes
+
+
+
+-- cf. SoundMap.ToSound
+data SoundAttributes params = SoundAttributes AttributeList String
+ deriving (Eq, Ord)
+
+type DrumAttributes = SoundAttributes DrumParameters
+type InstrumentAttributes = SoundAttributes InstrumentParameters
+
+
+rhythmicMusicFromDynamicMelody ::
+ Instrument attr ->
+ Melody.T (Rational, attr) ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromDynamicMelody (Sound name flattenAttr) =
+ RhyMusic.fromMelody
+ (\(vel,attr) -> (vel, SoundAttributes (flattenAttr attr) name))
+
+rhythmicMusicFromMelody ::
+ Instrument attr ->
+ Melody.T attr ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromMelody instr =
+ rhythmicMusicFromDynamicMelody instr .
+ Music.mapNote (\(Melody.Note attr p) -> Melody.Note (1,attr) p)
+
+
+
+rhythmicMusicFromRhythm ::
+ Drum () ->
+ Music.Dur ->
+ String ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromRhythm sound dur =
+ Rhythm.toMusicWithDrumUnit dur (SoundAttributes [] (nameFromSound sound)) .
+ Rhythm.fromString
+
+rhythmicMusicFromDrum ::
+ Drum () ->
+ Music.Dur ->
+ RhyMusic.T DrumAttributes InstrumentAttributes
+rhythmicMusicFromDrum sound dur =
+ Drum.toMusicDefaultAttr (SoundAttributes [] (nameFromSound sound)) dur
+
+
+fromRhythmicMusic ::
+ Environment (RhyMusic.T DrumAttributes InstrumentAttributes) ->
+ Schedule.T
+fromRhythmicMusic genMusic =
+ let (music, installInstruments) = runWriter $ unwrapEnvironment genMusic
+ in Schedule.fromMusicMsgs
+ (Note.fromRhythmicNoteWithAttributes
+ (\(SoundAttributes params name) -> (params,name))
+ (\(SoundAttributes params name) -> (params,name)),
+ installInstruments) $
+ music
+
+
+example :: IO ()
+example =
+ Play.schedule Play.defaultLatency $ fromRhythmicMusic $
+ do sawPerc <- installSound0 "saw percussion" Example.sawPerc
+ dynPerc <- installSound1 "detuned bass" Example.dynPerc
+ let mel = rhythmicMusicFromMelody sawPerc $ Music.transpose 12 $ Music.line
+ [c 0 qn (), e 0 qn (),
+ Music.chord [c 0 qn (), e 0 qn (), g 0 qn ()]]
+ bass = rhythmicMusicFromMelody dynPerc $ Music.line
+ [c 0 qn 0.001, c 0 qn 0.003, c 0 qn 0.01]
+ return $
+ Music.changeTempo 2 $
+ Music.chord [mel,bass]
diff --git a/src/Haskore/Interface/SuperCollider/SoundMap.hs b/src/Haskore/Interface/SuperCollider/SoundMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/SuperCollider/SoundMap.hs
@@ -0,0 +1,317 @@
+{- |
+This module is quite specific to "Haskore.Music.Rhythmic".
+Maybe the module name should reflect this?
+-}
+module Haskore.Interface.SuperCollider.SoundMap where
+
+import Haskore.Interface.SuperCollider.Channel (Channel)
+import qualified Haskore.Interface.SuperCollider.Channel as Channel
+
+import qualified Sound.SC3.Server.PlayEasy as SCPlay
+import qualified Sound.SC3.UGen.Rate as SCRate
+import qualified Sound.SC3.UGen.UGen as SCUGen
+
+import Sound.SC3.UGen.UGen (UGen)
+
+import Haskore.General.Utility (toMaybe)
+import Data.Maybe (mapMaybe)
+
+
+{- * Generic definitions -}
+
+type Name = String
+
+{- |
+'Attribute' means an optional information for a note.
+Compare with 'InstrumentParameters'.
+-}
+type Attribute = Double
+type AttributeList = [Attribute]
+type ToSound instr = instr -> (AttributeList, Name)
+
+
+attributeControl :: Int -> UGen
+attributeControl n =
+ SCUGen.Control SCRate.KR (attributeName n) 0
+
+attributeName :: Int -> String
+attributeName n = "attribute" ++ show n
+
+attributeNames :: [String]
+attributeNames = map attributeName [0..]
+
+control :: String -> UGen
+control name = SCUGen.Control SCRate.KR name 0
+
+pitchName :: String
+pitchName = "pitch"
+
+velocityName :: String
+velocityName = "velocity"
+
+durationName :: String
+durationName = "duration"
+
+
+
+
+
+{- * Generic sound maps -}
+
+with0Attributes ::
+ (() -> AttributeList,
+ (sound) -> sound)
+with0Attributes =
+ (\() -> [],
+ \sound -> sound)
+
+with1Attribute ::
+ ((Attribute) -> AttributeList,
+ (UGen -> sound) -> sound)
+with1Attribute =
+ (\(p0) -> [p0],
+ \sound -> sound
+ (attributeControl 0))
+
+with2Attributes ::
+ ((Attribute, Attribute) -> AttributeList,
+ (UGen -> UGen -> sound) -> sound)
+with2Attributes =
+ (\(p0,p1) -> [p0,p1],
+ \sound -> sound
+ (attributeControl 0)
+ (attributeControl 1))
+
+with3Attributes ::
+ ((Attribute, Attribute, Attribute) -> AttributeList,
+ (UGen -> UGen -> UGen -> sound) -> sound)
+with3Attributes =
+ (\(p0,p1,p2) -> [p0,p1,p2],
+ \sound -> sound
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2))
+
+with4Attributes ::
+ ((Attribute, Attribute, Attribute, Attribute) -> AttributeList,
+ (UGen -> UGen -> UGen -> UGen -> sound) -> sound)
+with4Attributes =
+ (\(p0,p1,p2,p3) -> [p0,p1,p2,p3],
+ \sound -> sound
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2)
+ (attributeControl 3))
+
+
+
+
+type Table params sound = [(sound, Sound params)]
+
+type TableWithAttributes params sound = [Assign params sound]
+
+type TableWithChannels params sound = [(Channel, Assign params sound)]
+
+type Sound params = params -> UGen
+
+class SoundParameters params where
+ soundParameters :: params
+
+ugenFromSound :: SoundParameters params => Sound params -> UGen
+ugenFromSound sound = sound soundParameters
+
+data Assign params sound =
+ Assign Name (sound -> Maybe AttributeList) (Sound params)
+
+lookup :: TableWithAttributes params sound -> ToSound sound
+lookup table sound =
+ case mapMaybe (\(Assign name toAttributes _) ->
+ fmap (\ps -> (ps,name)) (toAttributes sound)) table of
+ [x] -> x
+ [] -> error "SuperCollider.SoundMap.lookup: sound not found"
+ _ -> error "SuperCollider.SoundMap.lookup: multiple sounds found"
+
+
+assignGeneric ::
+ (attributeTuple -> AttributeList, soundGen -> Sound params) ->
+ Name ->
+ (sound -> Maybe attributeTuple) ->
+ soundGen ->
+ Assign params sound
+assignGeneric (makeAttributeList, makeSound) name select soundGen =
+ Assign
+ name
+ (fmap makeAttributeList . select)
+ (makeSound soundGen)
+
+
+assign ::
+ Name -> (sound -> Maybe ()) -> Sound params ->
+ Assign params sound
+assign = assignGeneric with0Attributes
+
+-- simplified variant of 'assign' for comparable @sound@ types
+assignEq :: Eq sound =>
+ Name -> sound -> Sound params ->
+ Assign params sound
+assignEq name soundId =
+ assign name (\x -> toMaybe (soundId==x) ())
+
+assign1 ::
+ Name -> (sound -> Maybe Attribute) ->
+ (UGen -> Sound params) ->
+ Assign params sound
+assign1 = assignGeneric with1Attribute
+
+assign2 ::
+ Name -> (sound -> Maybe (Attribute, Attribute)) ->
+ (UGen -> UGen -> Sound params) ->
+ Assign params sound
+assign2 = assignGeneric with2Attributes
+
+assign3 ::
+ Name -> (sound -> Maybe (Attribute, Attribute, Attribute)) ->
+ (UGen -> UGen -> UGen -> Sound params) ->
+ Assign params sound
+assign3 = assignGeneric with3Attributes
+
+assign4 ::
+ Name -> (sound -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
+ (UGen -> UGen -> UGen -> UGen -> Sound params) ->
+ Assign params sound
+assign4 = assignGeneric with4Attributes
+
+
+withDuration :: (UGen -> Sound params) -> Sound params
+withDuration ugen =
+ ugen (control durationName)
+
+
+
+
+
+{- * Instrument maps -}
+
+{- |
+@Parameter@ means an obligatory information for a note,
+like @frequency@, @velocity@, @duration@.
+Compare with 'Attribute'.
+-}
+data InstrumentParameters = InstrumentParameters {
+ instrumentDuration :: UGen,
+ instrumentVelocity :: UGen,
+ instrumentFrequency :: UGen
+ }
+
+instrumentParameters :: InstrumentParameters
+instrumentParameters =
+ InstrumentParameters (control durationName) (control velocityName) (control pitchName)
+
+instance SoundParameters InstrumentParameters where
+ soundParameters = instrumentParameters
+
+
+type InstrumentTable instr = Table InstrumentParameters instr
+
+type InstrumentTableWithAttributes instr =
+ TableWithAttributes InstrumentParameters instr
+
+type InstrumentTableWithChannels instr =
+ TableWithChannels InstrumentParameters instr
+
+type Instrument = Sound InstrumentParameters
+
+type InstrumentAssign instr =
+ Assign InstrumentParameters instr
+
+instrumentFromUGen :: (UGen -> UGen -> UGen) -> Instrument
+instrumentFromUGen ugen params =
+ ugen (instrumentVelocity params) (instrumentFrequency params)
+
+
+
+{- * Drum maps -}
+
+data DrumParameters = DrumParameters {
+ drumDuration :: UGen,
+ drumVelocity :: UGen
+ }
+
+drumParameters :: DrumParameters
+drumParameters =
+ DrumParameters (control durationName) (control velocityName)
+
+instance SoundParameters DrumParameters where
+ soundParameters = drumParameters
+
+
+type DrumTable instr = Table DrumParameters instr
+
+type DrumTableWithAttributes instr =
+ TableWithAttributes DrumParameters instr
+
+type DrumTableWithChannels instr =
+ TableWithChannels DrumParameters instr
+
+type Drum = Sound DrumParameters
+
+type DrumAssign instr =
+ Assign DrumParameters instr
+
+drumFromUGen :: (UGen -> UGen) -> Drum
+drumFromUGen ugen params =
+ ugen (drumVelocity params)
+
+
+
+
+{- * Sound Maps with Channel management -}
+
+{- |
+Like a State+Writer monad with the binding operation
+baked into 'registerInstrument'.
+This way we can suppress ignoring of results of 'registerInstrument',
+which is easily possible with 'do' notation.
+-}
+newtype ChannelMap drum instr =
+ ChannelMap {runChannelMap :: Channel ->
+ (UGen, (DrumTableWithChannels drum, InstrumentTableWithChannels instr))}
+
+registerSound ::
+ params ->
+ ((Channel, Assign params sound) ->
+ (DrumTableWithChannels drum, InstrumentTableWithChannels instr) ->
+ (DrumTableWithChannels drum, InstrumentTableWithChannels instr)) ->
+ Assign params sound ->
+ (UGen -> ChannelMap drum instr) ->
+ ChannelMap drum instr
+registerSound params insert ass@(Assign _ _ sound) nextCM =
+ ChannelMap $ \chan ->
+ let numChan = SCPlay.mceDegree (sound params)
+ ChannelMap f = nextCM (Channel.readUGen numChan chan)
+ (globalUGen, tables) = f (chan + numChan)
+ in (globalUGen, insert (chan,ass) tables)
+
+registerInstrument ::
+ InstrumentAssign instr ->
+ (UGen -> ChannelMap drum instr) ->
+ ChannelMap drum instr
+registerInstrument =
+ registerSound instrumentParameters $
+ \ (chan,ass) (drumTable, instrTable) ->
+ (drumTable, (chan,ass) : instrTable)
+
+registerDrum ::
+ DrumAssign drum ->
+ (UGen -> ChannelMap drum instr) ->
+ ChannelMap drum instr
+registerDrum =
+ registerSound drumParameters $
+ \ (chan,ass) (drumTable, instrTable) ->
+ ((chan,ass) : drumTable, instrTable)
+
+soundEffect ::
+ UGen ->
+ ChannelMap drum instr
+soundEffect globalUGen =
+ ChannelMap $ const (globalUGen, ([], []))
diff --git a/src/Test/Main.hs b/src/Test/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Main.hs
@@ -0,0 +1,43 @@
+module Main where
+
+import qualified Haskore.Interface.SuperCollider.Performance as SCPf
+import qualified Haskore.Interface.SuperCollider.Note as SCNote
+
+import Haskore.Music hiding (repeat, reverse)
+import Haskore.Melody as Melody
+import Haskore.Basic.Duration (wn, qn, en, (%+), )
+
+import qualified Test.HUnit as HUnit
+
+
+propSuperColliderEventsFromNotes :: MidiMusic.T -> Bool
+propSuperColliderEventsFromNotes music =
+ let notes =
+ PfBE.fromPaddedPerformance SCNote.fromGMNote $
+ (FancyPerformance.paddedFromMusic music ::
+ Performance.Padded NonNegW.Rational Rational MidiMusic.Note)
+ in SCPf.fixNodeIds (SCPf.eventsFromNotesQueue notes) ==
+ (SCPf.fixNodeIds (SCPf.eventsFromNotesEither notes)
+ :: SCPf.T NonNegW.Rational)
+
+testSuperColliderInfinitePerformance :: HUnit.Test
+testSuperColliderInfinitePerformance =
+ let -- mel = Music.repeat (a 0 wn () +:+ b 0 wn ())
+ mel = a 0 wn () +:+ b 1 wn () =:= rest qn +:+ mel
+ pf = SCPf.fixNodeIds (SCPf.fromMusic SCNote.fromGMNote (withPiano mel))
+ :: SCPf.T NonNegW.Double
+ in HUnit.TestCase
+ (HUnit.assertBool "infinite performance"
+ (testShowInf 200 pf))
+
+testSuperCollider :: HUnit.Test
+testSuperCollider =
+ HUnit.TestLabel "supercollider" $ HUnit.TestList $
+ -- fails for time of type Double probably because of rounding errors
+ testUnit "eventsFromNotes" propSuperColliderEventsFromNotes :
+ testSuperColliderInfinitePerformance :
+ []
+
+
+main :: IO ()
+main = return ()