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,241 @@
+
+# BasicWriteMidi.lhs, BasicMidiFile.lhs are stripped versions of
+# WriteMidi.lhs, MidiFile.lhs
+# ../ghc_add/IOExtensions.hs needs non-existing IOExts
+
+OBJECT_DIR := build/$(shell uname -s)-$(shell uname -m)
+INTERFACE_DIR := build/Interface
+#BUILD_DIR = `uname -s`-`uname -m`
+
+
+BASICS = Basic/Pitch.lhs Basic/Duration.lhs Basic/Tempo.lhs Basic/Interval.lhs Basic/Scale.lhs \
+ Composition/Trill.lhs Composition/Chord.lhs Composition/ChordType.lhs \
+ Composition/Drum.lhs Composition/Rhythm.lhs \
+ Melody.lhs Melody/Standard.lhs \
+ Music.lhs Music/Standard.lhs Music/Rhythmic.lhs Music/GeneralMIDI.lhs \
+ Performance/Player.lhs Performance/BackEnd.lhs \
+ Performance/Default.lhs Performance/Fancy.lhs \
+ Performance.lhs Performance/Context.hs \
+ General/Utility.lhs General/IO.hs \
+ General/Monad.lhs General/Map.hs \
+ General/IdGenerator.lhs \
+ General/LoopTreeTagged.lhs General/LoopTreeRecursive.lhs \
+ General/LoopTreeTaggedGen.lhs General/LoopTreeRecursiveGen.lhs \
+ Process/Optimization.lhs Process/Format.lhs \
+ Interface/MML.lhs Interface/MED/Text.hs
+
+MEDIA = Medium.hs Medium/Temporal.hs \
+ Medium/Plain/List.hs Medium/Plain/Binary.hs Medium/Plain/ContextFreeGrammar.lhs \
+ Medium/Controlled/List.hs Medium/LabeledControlled/List.hs Medium/Controlled.hs \
+ Medium/Controlled/ContextFreeGrammar.lhs
+
+
+MIDI = Interface/MIDI.lhs \
+ $(patsubst %, Interface/MIDI/%, \
+ InstrumentMap.lhs Note.lhs \
+ Read.lhs Write.lhs Render.lhs )
+
+CSOUND = Interface/CSound.lhs \
+ $(patsubst %, Interface/CSound/%, \
+ Score.lhs InstrumentMap.lhs SoundMap.hs Note.lhs \
+ Generator.lhs Orchestra.lhs OrchestraFunction.lhs Tutorial.lhs)
+
+AUTOTRACK = $(patsubst %, Interface/AutoTrack/%.lhs, \
+ ChartBar ChordChart ChordSymbol EventChart \
+ Instrument ScaleChart Style Transposeable)
+
+AUTOTRACK_PROG = $(patsubst %, src/Haskore/Interface/AutoTrack/%.lhs, \
+ Main Option)
+
+
+EXAMPLES = $(patsubst %, Example/%, \
+ Miscellaneous.lhs \
+ Ssf.lhs NewResolutions.lhs \
+ ChildSong6.lhs Kantate147.hs WhiteChristmas.hs \
+ SelfSim.lhs Fractal.hs Flip.hs Guitar.lhs)
+
+MODULES = $(BASICS) $(EXAMPLES) $(MIDI) $(CSOUND) $(AUTOTRACK)
+
+MODULEPATH = src
+
+# http://www.gnu.org/software/automake/manual/make/Syntax-of-Functions.html#Syntax-of-Functions
+colon:= :
+empty:=
+space:= $(empty) $(empty)
+
+# exclude installed versions of Haskore, because we want to use the local one
+HUGS_PACKAGE_PATH = \
+ {Hugs}/libraries:{Hugs}/libraries:{Hugs}/packages/*:$(subst $(space),$(colon),$(patsubst %,/usr/local/lib/hugs/packages/%,event-list midi markov-chain non-negative special-functors data-accessor))
+# $(subst $(space),$(colon),$(patsubst %,{Hugs}/packages/%,event-list midi markov-chain non-negative record-access))
+
+
+GHC_MODULES = $(patsubst %, src/%, $(MEDIA) \
+ Test/Equivalence.lhs Test/Suite.lhs) \
+ $(patsubst %, src/Haskore/%, \
+ $(MODULES) )
+
+GHC_DEPENDS = $(GHC_MODULES)
+
+# names of literate modules after removing literary information
+UNLIT_MODULES = $(patsubst %.lhs, %.hs, $(patsubst %.hs, , $(GHC_MODULES)))
+
+# names of all modules without literary information
+HS_MODULES = $(patsubst %.lhs, %.hs, $(GHC_MODULES))
+
+
+STDINTERFACES = base/base haskell-src/haskell-src QuickCheck/QuickCheck
+
+STDPACKAGES = base mtl haskell-src network hosc hsc3 QuickCheck HUnit
+
+GHC_OPTIONS = -Wall -odir$(OBJECT_DIR) -hidir$(INTERFACE_DIR) \
+ -i:$(MODULEPATH):src/Test
+ # -threaded
+ # -hide-package Haskore # ignore modules compiled and registered by Cabal
+
+
+HUGS_MODULES = $(patsubst %, src/%, $(MEDIA)) \
+ $(patsubst %, src/Haskore/%, $(MODULES))
+
+
+TEX_FILES = $(patsubst %, src/Doc/%, \
+ Tutorial.tex Discussion.tex Introduction.tex Macros.tex Related.tex)
+
+PICS = equiv haskore midi poly
+
+PDF_PICS = $(patsubst %, src/Doc/Pics/%.pdf, $(PICS))
+
+
+
+.INTERMEDIATE: $(UNLIT_MODULES) PlayTmp.hs
+
+.PHONY: all clean cabal-configure cabal-build compile ghc-all ghci hugs playmidi \
+ pdf autotrack-ps doc \
+ test test-compile test-hugs testcases debug \
+ fluid
+
+all: compile
+
+clean:
+ -(cd build && rm `find . -name "*.hi"` `find . -name "*.o"`)
+ -rm $(UNLIT_MODULES)
+
+test: test-compile testcases pdf autotrack-ps cabal-haddock
+
+compile: hugs ghc-all autotrack
+
+test-compile: test-hugs ghc-all autotrack
+
+# disable optimization for GHC-6.4 and NewResolutions
+cabal-configure:
+ runhaskell Setup.lhs configure --user --disable-optimization
+
+cabal-build: cabal-configure
+ runhaskell Setup.lhs build
+
+cabal-haddock: cabal-configure
+ runhaskell Setup.lhs haddock
+
+ghc-all: $(GHC_DEPENDS)
+ -mkdir $(OBJECT_DIR)
+ ghc --make $(GHC_OPTIONS) $(GHC_DEPENDS)
+
+# start ghci using compiled objects from Cabal's 'dist/build' directory
+ghci: cabal-build
+ ghci +RTS -M256m -c30 -RTS -Wall \
+ -odirdist/build -hidirdist/build -i:$(MODULEPATH):src/Test
+
+# start ghci using compiled objects from 'build' directory
+ghci-custom: cabal-configure $(GHC_DEPENDS) ghci-quick
+
+ghci-quick:
+ ghci +RTS -M256m -c30 -RTS $(GHC_OPTIONS) $(GHC_DEPENDS)
+
+hugs: $(HUGS_MODULES)
+# this version wouldn't stop on a failure :-(
+# echo ":quit" | hugs $(HUGS_MODULES)
+# this worked as long as most of the modules were Haskell 98 compliant
+# hugs -P:$(MODULEPATH) $(HUGS_MODULES)
+
+# for hugs version 2002-11
+# hugs +N -98 -h1000000 -P:$(MODULEPATH) $(HUGS_MODULES)
+
+# for hugs version 2005-03
+ hugs -98 -h1000000 -P$(MODULEPATH):$(HUGS_PACKAGE_PATH) $(HUGS_MODULES)
+
+test-hugs: $(HUGS_MODULES) # hugs
+ @echo "***** If in test mode, enter :q in order to continue. *****"
+ hugs -98 -h1000000 -P$(MODULEPATH):$(HUGS_PACKAGE_PATH) $(HUGS_MODULES)
+
+doc: $(HS_MODULES)
+ haddock -B /usr/lib/ghc -o docs/html --dump-interface=docs/haskore.haddock -h \
+ $(HS_MODULES)
+# $(patsubst %, --use-package=%, $(STDPACKAGES)) \
+
+olddoc: $(HS_MODULES)
+ haddock -o docs/html --dump-interface=docs/haskore.haddock -h \
+ $(patsubst %, -i /usr/local/share/ghc-6.2/html/libraries/%.haddock, $(STDINTERFACES)) \
+ $(HS_MODULES)
+
+
+%.hs: %.lhs
+ unlit $< $@
+
+
+pdf: $(TEX_FILES) $(PDF_PICS) $(GHC_MODULES)
+# src/Doc needed for Tutorial.bbl
+ TEXINPUTS=src:src/Doc:$(TEXINPUTS) pdflatex $<
+ mkindex Tutorial
+ thumbpdf Tutorial
+ -ln -s ../Tutorial.pdf docs/Tutorial.pdf
+
+%.pdf: %.eps
+ epstopdf $<
+
+testcases: src/Test/Suite.lhs src/Test/Equivalence.lhs
+ -rm $(OBJECT_DIR)/Main.o
+ ghc --make $(GHC_OPTIONS) -o $(OBJECT_DIR)/test $<
+ $(OBJECT_DIR)/test +RTS -M32m -c30 -RTS
+# runhugs +N -98 -h2000000 -P:$(MODULEPATH) Test/Suite.lhs
+
+flip: src/Haskore/Example/FlipTest.hs
+ ghc $(GHC_OPTIONS) -O --make -o $@ $<
+# $@ | timidity -B8,9 -
+
+autotrack: $(AUTOTRACK_PROG) $(GHC_DEPENDS)
+ -rm $(OBJECT_DIR)/Main.o
+ ghc $(GHC_OPTIONS) -i:src/Haskore/Interface/AutoTrack/ -O --make -o $@ $<
+
+autotrack-ps:
+ cd src/Haskore/Interface/AutoTrack/ && make doc
+
+
+playmidi:
+# install in NEdit menu:
+# cd haskore_dir/src/ ; make playmidi MODULE=%
+
+# doesn't work, because Hugs supports only one visible module at the prompt
+# echo TestMidi.testTimidity `xargs echo` | hugs +N -98 -h1000000 -P:$(MODULEPATH) Interface/MIDI/TestMidi.lhs $(MODULE)
+
+ echo module Main where > PlayTmp.hs
+ echo import TestMidi >> PlayTmp.hs
+ MODULE_LHS=`basename $(MODULE) .lhs` && echo import `basename $$MODULE_LHS .hs` >> PlayTmp.hs
+ echo main = TestMidi.testTimidity '('`xargs echo`')' >> PlayTmp.hs
+ runhugs +N -98 -h1000000 -P:$(MODULEPATH) PlayTmp.hs
+
+# start fluidsynth as server
+# search fluidsynth port with pmidi -l
+# play MIDI files using pmidi -p 128:0 src/Test/MIDI/ChildSong6.mid
+fluid:
+ fluidsynth --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2
+
+# better start jack separately and then run 'make fluidjack'
+# because otherwise fluidsynth starts jack itself but with inappropriate settings
+fluidjack:
+ fluidsynth -a jack --verbose /usr/share/sounds/sf2/Vintage_Dreams_Waves_v2.sf2
+
+timidity:
+ timidity -iA -B1,8
+
+
+debug:
+ echo $(GHC_DEPENDS)
diff --git a/Readme b/Readme
new file mode 100644
--- /dev/null
+++ b/Readme
@@ -0,0 +1,78 @@
+
+ Haskore Music System
+ --------------------
+
+This is a revised and extended version of Haskore from
+
+ http://darcs.haskell.org/haskore/
+
+which evolved from the February 2000 release, available from:
+
+ http://haskell.org/haskore/
+
+The features are:
+ - music can be composed by programming Haskell
+ - the music is output into MIDI files, CSound, or SuperCollider,
+ or even rendered to an audio stream with http://darcs.haskell.org/synthesizer/
+ - CSound instruments can generated by programming Haskell, as well
+
+ - all modules can be used with GHC,
+ and many of them with Hugs
+
+For more details, refer to the Tutorial.
+
+
+For installation we recommend Cabal.
+
+$ ./Setup.lhs configure --user
+$ ./Setup.lhs build
+$ ./Setup.lhs haddock
+$ ./Setup.lhs install
+
+This way you have a usable Haskore installation.
+
+However most modules are written in literate style with LaTeX markup.
+There are no Haddock comments.
+You can build a PDF file which introduces you to the internals of Haskore.
+However it got a bit out of sync over the time,
+many parts are now extracted into separate packages.
+You can build the documentation using
+
+$ make pdf
+
+.
+
+Certainly you will want to try some examples.
+To this end you must have installed CSound or a MIDI player, respectively.
+
+$ make ghci # interactive session in GHC
+or
+$ make hugs # interactive session in Hugs
+...
+*Main> :load Haskore.Interface.CSound.Tutorial
+...
+*Haskore.Interface.CSound.Tutorial> test tut13
+...
+*Main> :load Haskore.Interface.MIDI.Render Haskore.Example.ChildSong6
+...
+*Haskore.Interface.MIDI.Render> playTimidity Haskore.Example.ChildSong6.song
+...
+
+You can choose other MIDI players. Type
+
+*Haskore.Interface.MIDI.Render> :browse Haskore.Interface.MIDI.Render
+
+to see the alternatives.
+
+If you like to play via SuperCollider,
+install the haskore-supercollider package
+from http://darcs.haskell.org/haskore-supercollider
+and continue with its Readme file.
+
+
+
+
+Send requests, questions and comments to
+ the original author of Haskore: Paul Hudak
+ and the reviser: Henning Thielemann
+ and for more discussion: http://lists.lurk.org/mailman/listinfo/haskell-art
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.cabal b/haskore.cabal
new file mode 100644
--- /dev/null
+++ b/haskore.cabal
@@ -0,0 +1,162 @@
+-- We are going to split this package into smaller ones, which are easier to install.
+-- Eventually we will also overhaul the package.
+Name: haskore
+Version: 0.0.5
+License: GPL
+License-File: LICENSE
+Author: Paul Hudak , Henning Thielemann
+Maintainer: Henning Thielemann
+Homepage: http://www.haskell.org/haskellwiki/Haskore
+Package-URL: http://darcs.haskell.org/haskore/
+Category: Sound, Music
+Synopsis: The Haskore Computer Music System
+Stability: Experimental
+Description:
+ Compose music using programming features.
+ Output in MIDI, CSound, SuperCollider or as a audio signal.
+Tested-With: GHC==6.4.1, GHC==6.8.2, Hugs==2005.3.8
+Cabal-Version: >=1.2
+Build-Type: Simple
+
+Extra-Source-Files:
+ Makefile
+ Readme
+ src/Doc/Macros.tex
+ src/Doc/Related.tex
+ src/Doc/Discussion.tex
+ src/Doc/Introduction.tex
+ src/Doc/Tutorial.tex
+
+Flag splitBase
+ description: Choose the new smaller, split-up base package.
+
+Library
+ Build-Depends:
+ event-list >=0.0.5 && <0.1,
+ midi >=0.1.1 && <0.2,
+ markov-chain >=0.0.1 && <0.1,
+ non-negative >=0.0.1 && <0.1,
+ data-accessor >=0.1 && <0.2,
+ mtl >=1.1 && <1.2,
+ haskell-src >=1.0 && <1.1,
+ parsec >=2.1 && <2.2,
+ -- for testing
+ QuickCheck >=1 && <2,
+ HUnit >=1.2 && <1.3
+
+ If flag(splitBase)
+ Build-Depends:
+ base >=3,
+ array >=0.1 && <0.2,
+ random >=1.0 && <1.1,
+ process >=1.0 && <1.1,
+ containers >=0.1 && <0.2
+ Else
+ Build-Depends:
+ base >= 1.0 && < 2,
+ special-functors >=1.0 && <1.1
+
+ GHC-Options: -Wall
+ -- with GHC-6.4.1 and option -O2 the compilation of NewResolution needs too much heap, thus swapping
+
+ Hs-source-dirs: src
+ Exposed-modules:
+ Haskore,
+ Haskore.Basic.Duration,
+ Haskore.Basic.Dynamics,
+ Haskore.Basic.Interval,
+ Haskore.Basic.Pitch,
+ Haskore.Basic.Scale,
+ Haskore.Basic.Tempo,
+ Haskore.Composition.Chord,
+ Haskore.Composition.ChordType,
+ Haskore.Composition.Drum,
+ Haskore.Composition.Rhythm,
+ Haskore.Composition.Trill,
+ Haskore.Example.BesondrerTag,
+ Haskore.Example.ChildSong6,
+ Haskore.Example.Detail,
+ Haskore.Example.Flip,
+ Haskore.Example.Fractal,
+ Haskore.Example.Guitar,
+ Haskore.Example.Kantate147,
+ Haskore.Example.Miscellaneous,
+ Haskore.Example.NewResolutions,
+ Haskore.Example.Raenzlein,
+ Haskore.Example.SelfSim,
+ Haskore.Example.Ssf,
+ Haskore.Example.WhiteChristmas,
+ Haskore.General.IO,
+ Haskore.General.IdGenerator,
+ Haskore.General.LoopTreeRecursive,
+ Haskore.General.LoopTreeRecursiveGen,
+ Haskore.General.LoopTreeTagged,
+ Haskore.General.LoopTreeTaggedGen,
+ Haskore.General.GraphRecursiveGen,
+ Haskore.General.GraphTaggedGen,
+ Haskore.General.Map,
+ Haskore.General.Monad,
+ Haskore.General.TagDictionary,
+ Haskore.General.Utility,
+ Haskore.Interface.AutoTrack.ChartBar,
+ Haskore.Interface.AutoTrack.ChordChart,
+ Haskore.Interface.AutoTrack.ChordSymbol,
+ Haskore.Interface.AutoTrack.EventChart,
+ Haskore.Interface.AutoTrack.Instrument,
+ Haskore.Interface.AutoTrack.ScaleChart,
+ Haskore.Interface.AutoTrack.Style,
+ Haskore.Interface.AutoTrack.Transposeable,
+ Haskore.Interface.CSound,
+ Haskore.Interface.CSound.Generator,
+ Haskore.Interface.CSound.InstrumentMap,
+ Haskore.Interface.CSound.Note,
+ Haskore.Interface.CSound.Orchestra,
+ Haskore.Interface.CSound.OrchestraFunction,
+ Haskore.Interface.CSound.Score,
+ Haskore.Interface.CSound.SoundMap,
+ Haskore.Interface.CSound.Tutorial,
+ Haskore.Interface.CSound.TutorialCustom,
+ -- needs 'parsec' package
+ Haskore.Interface.MED.Text,
+ Haskore.Interface.MIDI,
+ Haskore.Interface.MIDI.InstrumentMap,
+ Haskore.Interface.MIDI.Note,
+ Haskore.Interface.MIDI.Read,
+ Haskore.Interface.MIDI.Render,
+ Haskore.Interface.MIDI.Write,
+ Haskore.Interface.MML,
+ Haskore.Melody,
+ Haskore.Melody.Standard,
+ Haskore.Music,
+ Haskore.Music.GeneralMIDI,
+ Haskore.Music.Rhythmic,
+ Haskore.Music.Standard,
+ Haskore.Performance,
+ Haskore.Performance.BackEnd,
+ Haskore.Performance.Context,
+ Haskore.Performance.Player,
+ Haskore.Performance.Default,
+ Haskore.Performance.Fancy,
+ Haskore.Process.Format,
+ Haskore.Process.Optimization,
+ Medium,
+ Medium.Temporal,
+ Medium.Plain.Binary,
+ Medium.Plain.List,
+ Medium.Plain.ContextFreeGrammar,
+ Medium.Controlled,
+ Medium.Controlled.List,
+ Medium.Controlled.ContextFreeGrammar,
+ Medium.LabeledControlled.List
+
+Executable test
+ Hs-Source-Dirs: src, src/Test
+ Main-Is: Suite.lhs
+ Other-Modules:
+ Equivalence
+
+Executable autotrack
+ Hs-Source-Dirs: src, src/Haskore/Interface/AutoTrack
+ Main-Is: Haskore/Interface/AutoTrack/Main.lhs
+ Other-Modules:
+ Haskore.Interface.AutoTrack.Option
diff --git a/src/Doc/Discussion.tex b/src/Doc/Discussion.tex
new file mode 100644
--- /dev/null
+++ b/src/Doc/Discussion.tex
@@ -0,0 +1,301 @@
+\section{Design discussion}
+
+This section presents the advantages and disadvantages
+of several design decisions that has been made.
+
+\paragraph*{Principal type \code{T}}
+
+Analogously to Modula-3 we use the following naming scheme:
+A module has the name of the principal type
+and the type itself has the name \code{T}.
+If there is only one constructor for that type its name is \code{Cons}.
+If the main object of a module is a type class, its name is \code{C}.
+A function in a module don't need a prefix related to the principal type.
+Many functions can be considered as conversion functions.
+They should be named \code{TargetType.fromSourceType}
+or \code{SourceType.toTargetType}.
+If there is a choice, the first form is prefered.
+This does better fit to the order of functions and their arguments.
+Compare \code{a = A.fromB b} and \code{a = B.toA b}.
+
+A programmer using such a module is encouraged
+to import it with qualified identifiers.
+This way the programmer may abbreviate the module name to its convenience.
+
+\paragraph*{\code{Music.T}}
+
+The data structure should be hidden.
+The user should use \code{changeTempo} and similar functions
+instead of the constructors \code{Tempo} etc.
+This way the definition of a \code{Music.T}
+stays independent from the actual data structure \code{Music.T}.
+Then \code{changeTempo} can be implemented silently
+using a constructor or using a mapping function.
+
+\paragraph*{\code{Medium.T}}
+
+\seclabel{discussion:media}
+
+The idea of extracting the structure of animation movies and music
+into an abstract data structure is taken from Paul Hudak's paper
+``An Algebraic Theory of Polymorphic Temporal Media''.
+
+The temporial media data structure \code{Medium.T}
+is used here as the basis type for Haskore's Music.
+
+\subparagraph*{Binary composition vs. List composition}
+
+There are two natural representations for temporal media.
+We have implemented both of them:
+\begin{enumerate}
+\item \code{Medium.Plain.Binary} uses binary constructors \code{:+:}, \code{:=:}
+\item \code{Medium.Plain.List} uses List constructors \code{Serial}, \code{Parallel}
+\end{enumerate}
+
+Both of these modules provide
+the functions \code{foldBinFlat} and \code{foldListFlat}
+which apply binary functions or list functions, respectively, to \code{Medium.T}.
+Import your prefered module to \code{Medium}.
+
+Each of these data structures has its advantages:
+
+\code{Medium.Binary.T}
+\begin{itemize}
+\item There is only one way to represent a zero object,
+which must be a single media primitive (\code{Prim}).
+\item You need only a few constructors for
+serial and parallel compositions.
+\end{itemize}
+
+\code{Medium.List.T}
+\begin{itemize}
+\item
+Zero objects can be represented without a particalur zero primitives.
+\item
+You can represent two different zero objects,
+an empty parallelism and an empty serialism.
+Both can be interpreted as limits of
+compositions of decreasing size.
+\item
+You can store music with an internal structure
+which is lost in a performance.
+E.g. a serial composition of serial compositions
+will sound identical to a flattened serial composition,
+but the separation might contain additional information.
+\end{itemize}
+
+In my (Henning's) opinion
+\code{Music.T} is for representing musical ideas
+and \code{Performance.T} is for representing the sound of a song.
+Thus it is ok and even useful if there are several ways
+to represent the same sound impression (\code{Performance.T})
+in different ways (\code{Music.T}),
+just like it is possible to write very different \LaTeX{} code
+which results in the same page graphics.
+The same style of text may have different meanings
+which can be seen only in the \LaTeX{} source code.
+Analogously music can be structured more detailed than one can hear.
+
+\subparagraph*{Algebraic structure}
+
+The type \code{Medium.T} almost forms an algebraic ring
+where \code{=:=} is like a sum (commutative) and
+\code{+:+} is like a product (non-commutative).
+Unfortunately \code{Medium.T} is not really a ring:
+There are no inverse elements with respect to addition (\code{=:=}).
+Further \code{=:=} is not distributive with respect to \code{+:+}
+because \code{x} is different from \code{x =:= x}.
+There is also a problem if the durations
+of the parallel music objects differ.
+I.e. if \code{dur y /= dur z}
+then \code{x +:+ (y =:= z)} is different from
+\code{(x +:+ y) =:= (x +:+ z)}
+even if \code{x == x =:= x} holds.
+So it is probably better not to make \code{Medium.T}
+an instance of a \code{Ring} type class.
+(In Prelude 98 the class \code{Num} is quite a \code{Ring} type class.)
+
+\paragraph*{Relative times in \code{Performance.T}}
+
+\seclabel{discussion:performance-reltime}
+
+Absolute times for events disallow infinite streams of music.
+The time information becomes more and more inaccurate
+and finally there is an overflow or no change in time.
+Relative times make synchronization difficult,
+especially many small time differences are critical.
+But since the \code{Music.T} is inherently based on time differences
+one cannot get rid of sum rounding errors.
+The problem can only be weakened by more precise floating point formats.
+
+
+\paragraph*{Type variable for time and dynamics in \code{Performance.T}}
+
+In the original design of Haskore
+\type{Float} was the only fractional type
+used for time and volume measures in \type{Performance.T}.
+This is good with respect to efficiency.
+But rounding errors make it almost impossible
+to test literal equivalence (\secref{equivalence})
+between different music expressions.
+In order to match both applications
+I introduced type variables \type{time} and \type{dyn}
+which is now floating all around.
+It also needs some explicit type hints in some cases
+where the performance is only an interim step.
+In future \type{Music.T} itself might get a \type{time} type parameter.
+We should certainly declare types for every-day use
+such as \type{CommonMusic.T} which instantiates \type{Music.T}
+with \type{Double} or so.
+
+
+\paragraph*{Unification of Rests and Notes}
+
+Since rests and notes share the property of the duration,
+the constructor \code{Music.Atom} is used
+which handles the duration and the particalur music primitive,
+namely Rest and Note.
+All functions concerning duration (\code{dur}, \code{cut})
+don't need to interpret the musical primitive.
+
+\paragraph*{Pitch}
+
+\seclabel{discussion:pitch}
+
+With the definition \code{Pitch = (Octave, PitchClass)}
+(swapped order with respect to original Haskore)
+the order on \code{Pitch} equals the order on pitches.
+Functions like \code{o0}, \code{o1}, \code{o2} etc. may support this order
+for short style functional note definitions.
+It should be e.g. \code{o0 g == g 0}.
+Alternatively one can put this into a duration function
+like \code{qn'}, \code{en'}, etc.
+Then it must hold e.g. \code{qn' 0 g == g 0 qn}
+
+The problem is that the range of notes
+of the enumeration \code{PitchClass} overlaps
+with notes from neighbouring octaves.
+Overlapping \code{PitchClass}es,
+ e.g. \code{(0,Bs) < (1,Cf)} although \code{absPitch (0,Bs) > absPitch (1,Cf)}
+
+The musical naming of notes is a bit unlogical.
+The range is not from A to G but from C to B.
+Further on there are two octaves with note names without indices
+(e.g. $A$ and $a$).
+Both octaves are candidates for a ``zero'' octave.
+We define that octave $0$ is the one which contains $a$.
+
+
+\paragraph*{Absolute pitch}
+
+Find a definition for the absolute pitch
+that will be commonly used for MIDI, CSound, and Signal output.
+
+Yamaha-SY35 manual says:
+\begin{itemize}
+\item Note \$00 - (-2,C)
+\item Note \$7F - ( 8,G)
+\end{itemize}
+But which A is 440 Hz?
+
+By playing around with the Multi key range
+I found out that the keyboard ranges from (1,C) to (6,C) (in MIDI terms).
+The frequencies of the instruments played at the same note are not equal. :-(
+Many of them have (3,A) (MIDI) = 440 Hz,
+but some are an octave below, some are an octave above.
+In CSound it was (8,A) = 440 Hz in original Haskore.
+Very confusing.
+
+
+\paragraph*{Volume vs. Velocity}
+
+MIDI distinguishes Volume and Velocity.
+Volume is related to the physical amplitude,
+i.e. if we want to change the Volume of a sound
+we simply amplify the sound by a constant factor.
+In contrast to that Velocity means the speed
+with which a key is pressed or released.
+This is most oftenly interpreted as the force
+with which an instrument is played.
+This distinction is very sensible
+and is reflected in \code{Music.T}.
+Velocity is inherently related
+to the beginning and the end of a note,
+whereas the Volume can be changed everywhere.
+All phrases related to dynamics are mapped
+to velocities and not to volumes,
+since one cannot change the volume of natural instruments
+without changing the force to play them
+(and thus changing their timbre).
+The control of Volume is to be added later,
+together with controllers like pitch bender, frequency modulation and so on.
+
+
+\paragraph*{Global instrument setting vs. note attribute}
+
+In the original version of Haskore,
+there was an \code{Instr} constructor
+that set the instrument used in the enclosed piece of music.
+I found that changing an instrument by surrounding a piece of music
+with a special constructor is not very natural.
+On which parts of the piece it has an effect
+or if it has an effect at all
+depends on \code{Instr} statements within the piece of music.
+To assert that instruments are set once and only once
+and that setting an instrument has an effect,
+we distinguish between (instrument-less) melodies
+and music (with instrument information) now.
+In a melody we store only notes and rests,
+in a music we store an instrument for any note.
+Even more since the instrument is stored for each note
+this can be interpreted as an instrument event,
+where some instruments support note pitches
+and others not (sound effects)
+or other attributes (velocity).
+
+\paragraph*{PhraseFun}
+
+The original Haskore version used \code{PhraseFun}s
+of the type \code{Music.T -> (Performance.T, Dur)}.
+This way it was a bit cumbersome to combine different phrases.
+In principle all \code{PhraseFun}s could be of type
+ \code{(Performance.T, Dur) -> (Performance.T, Dur)}
+This would be a more clean design but lacks some efficiency
+because e.g. the Loudness can be controlled
+by changing the default velocity of the performance context.
+This is much more efficient (even more if Loudness phrases are cascaded)
+than modifying a performance afterwards.
+Now the performance is no longer generated as-is,
+but it is enclosed in a state monad,
+that manages the \type{Performance.Context}.
+The \code{PhraseFun}s are now of type
+ \code{Performance.PState -> Performance.PState}
+which is both clean and efficient.
+
+
+\paragraph*{Phrase}
+
+\seclabel{discussion:phrase}
+
+The original version of Haskore used a list of \code{PhraseAttribute}s
+for the \code{Phrase} constructor.
+Now it allows only one attribute
+in order to make the order of application transparent to the user.
+
+%\paragraph*{InstrumentMap}
+
+%\seclabel{discussion:user-patch-map}
+
+%The current implementation of \code{InstrumentMap.T}
+
+
+
+\paragraph*{Type of \code{Music.Dur}}
+
+\seclabel{discussion:dur}
+
+Durations are represented as rational numbers;
+specifically, as ratios of two Haskell \code{Integer} values.
+Previous versions of Haskore used floating-point numbers,
+but rational numbers are more precise
+and allow quick-checking of music composition properties.
diff --git a/src/Doc/Introduction.tex b/src/Doc/Introduction.tex
new file mode 100644
--- /dev/null
+++ b/src/Doc/Introduction.tex
@@ -0,0 +1,63 @@
+\section{Introduction}
+\seclabel{intro}
+
+{\em Haskore} is a collection of Haskell modules designed for
+expressing musical structures in the high-level, declarative style of
+ \keyword{functional programming}. In Haskore, musical objects consist of
+primitive notions such as notes and rests, operations to transform
+musical objects such as transpose and tempo-scaling, and operations to
+combine musical objects to form more complex ones, such as concurrent
+and sequential composition. From these simple roots, much richer
+musical ideas can easily be developed.
+
+Haskore is a means for describing {\em music}---in particular Western
+Music---rather than {\em sound}. It is not a vehicle for synthesizing
+sound produced by musical instruments, for example, although it does
+capture the way certain (real or imagined) instruments permit control
+of dynamics and articulation.
+
+Haskore also defines a notion of \keyword{literal performance} through
+which \keyword{observationally equivalent} musical objects can be
+determined. From this basis many useful properties can be proved,
+such as commutative, associative, and distributive properties of
+various operators. An \keyword{algebra of music} thus surfaces.
+
+In fact a key aspect of Haskore is that objects represent both
+\keyword{abstract musical ideas} and their \keyword{concrete implementations}.
+This means that when we prove some property about an object, that
+property is true about the music in the abstract {\em and} about its
+implementation. Similarly, transformations that preserve musical
+meaning also preserve the behavior of their implementations. For this
+reason Haskell is often called an \keyword{executable specification
+language}; i.e.~programs serve the role of mathematical specifications
+that are directly executable.
+
+Building on the results of the functional programming community's
+Haskell effort has several important advantages: First, and most
+obvious, we can avoid the difficulties involved in new programming
+language design, and at the same time take advantage of the many years
+of effort that went into the design of Haskell. Second, the resulting
+system is both \keyword{extensible} (the user is free to add new features
+in substantive, creative ways) and \keyword{modifiable} (if the user
+doesn't like our approach to a particular musical idea, she is free to
+change it).
+
+In the remainder of this paper I assume that the reader is familar
+with the basics of functional programming and Haskell in particular.
+If not, I encourage reading at least {\em A Gentle Introduction to
+Haskell} \cite{haskell-tutorial} before proceeding. I also assume
+some familiarity with \keyword{equational reasoning}; an excellent
+introductory text on this is \cite{birdwadler88}.
+
+
+\subsection{Acknowledgements}
+
+Many students have contributed to Haskore over the years, doing for
+credit what I didn't have the spare time to do! I am indebted to them
+all: Amar Chaudhary, Syam Gadde, Bo Whong, and John Garvin, in
+particular. Thanks also to Alastair Reid for implementing the first
+Midi-file writer, to Stefan Ratschan for porting Haskore to GHC, and
+to Matt Zamec for help with the Csound compatibility module. I would
+also like to express sincere thanks to my friend and talented New
+Haven composer, Tom Makucevich, for being Haskore's most faithful
+user.
diff --git a/src/Doc/Macros.tex b/src/Doc/Macros.tex
new file mode 100644
--- /dev/null
+++ b/src/Doc/Macros.tex
@@ -0,0 +1,43 @@
+
+\usepackage{amsthm}
+
+\swapnumbers
+%\numberwithin{definition}{section}
+\newtheorem{prop}{Proposition}
+\newtheorem{axiom}[prop]{Axiom}
+\newtheorem{theorem}[prop]{Theorem}
+\newtheorem{exercise}[prop]{Exercise}
+\theoremstyle{definition}
+\newtheorem{definition}[prop]{Definition}
+
+\newcommand{\ignore}[1]{}
+\newcommand{\out}[1]{}
+%\newcommand{\code}[1]{\texttt{#1}}
+\newcommand{\code}[1]{{\tt #1}} % overrides italics
+\newcommand{\type}[1]{\code{#1}}
+\newcommand{\constructor}[1]{\code{#1}}
+\newcommand{\function}[1]{\code{#1}}
+\newcommand{\expression}[1]{\code{#1}}
+\newcommand{\module}[1]{module \texttt{#1}}
+
+\newcommand \keyword[1]{\emph{#1}\index{#1}}
+\newcommand \keywordref[2]{#2\index{#2} (\dfnref{#1})}
+
+\newcommand \eqnlabel[1]{\yesnumber\label{eqn:#1}} % set tag and declare label
+\newcommand \dfnlabel[1]{\label{dfn:#1}}
+\newcommand \thmlabel[1]{\label{thm:#1}}
+\newcommand \lemlabel[1]{\label{lem:#1}}
+\newcommand \rmklabel[1]{\label{rmk:#1}}
+\newcommand \seclabel[1]{\label{sec:#1}}
+\newcommand \tablabel[1]{\label{tab:#1}}
+\newcommand \figlabel[1]{\label{fig:#1}}
+
+\newcommand \eqnref[1]{(\ref{eqn:#1})} % reference to an equation (number surrounded by parentheses)
+\newcommand \meqnref[1]{\text{(\ref{eqn:#1})}} % reference to an equation for use in math mode, only necessary for pdflatex
+\newcommand \dfnref[1]{Definition~\ref{dfn:#1}}
+\newcommand \thmref[1]{Theorem~\ref{thm:#1}} % reference to a theorem
+\newcommand \lemref[1]{Lemma~\ref{lem:#1}}
+\newcommand \rmkref[1]{Remark~\ref{rmk:#1}}
+\newcommand \secref[1]{Section~\ref{sec:#1}} % reference to a section
+\newcommand \tabref[1]{Table~\ref{tab:#1}} % reference to a table
+\newcommand \figref[1]{Figure~\ref{fig:#1}} % reference to a figure
diff --git a/src/Doc/Related.tex b/src/Doc/Related.tex
new file mode 100644
--- /dev/null
+++ b/src/Doc/Related.tex
@@ -0,0 +1,59 @@
+\section{Related and Future Research}
+\seclabel{related}
+
+Many proposals have been put forth for programming languages targeted
+for computer music composition
+\cite{canon,pla,moxie,formula,fugue,scoresynth,formes,grame94},
+% common-music
+so many in fact that it would be difficult to describe them all here.
+None of them (perhaps surprisingly) are based on a {\em pure}
+functional language, with one exception: the recent work done by
+Orlarey et al.\ at GRAME \cite{grame94}, which uses a pure lambda
+calculus approach to music description, and bears some resemblance to
+our effort. There are some other related approaches based on variants
+of Lisp, most notably Dannenberg's \keyword{Fugue} language \cite{fugue},
+in which operators similar to ours can be found but where the emphasis
+is more on instrument synthesis rather than note-oriented composition.
+Fugue also highlights the utility of lazy evaluation in certain
+contexts, but extra effort is needed to make this work in Lisp,
+whereas in a non-strict language such as Haskell it essentially comes
+``for free''. Other efforts based on Lisp utilize Lisp primarily as a
+convenient vehicle for ``embedded language design,'' and the
+applicative nature of Lisp is not exploited well (for example, in
+Common Music the user will find a large number of macros which are
+difficult if not impossible to use in a functional style).
+
+We are not aware of any computer music language that has been shown to
+exhibit the kinds of algebraic properties that we have demonstrated
+for Haskore. Indeed, none of the languages that we have investigated
+make a useful distinction between music and performance, a property
+that we find especially attractive about the Haskore design. On the
+other hand, Balaban describes an abstract notion (apparently not yet a
+programming language) of ``music structure,'' and provides various
+operators that look similar to ours \cite{balaban92}. In addition,
+she describes an operation called {\em flatten} that resembles our
+literal interpretation {\tt perform}. It would be interesting to
+translate her ideas into Haskell; the match would likely be good.
+
+Perhaps surprisingly, the work that we find most closely related to
+ours is not about music at all: it is Henderson's \keyword{functional
+geometry}, a functional language approach to generating computer
+graphics \cite{henderson82}. There we find a structure that is in
+spirit very similar to ours: most importantly, a clear distinction
+between object \keyword{description} and \keyword{interpretation} (which in
+this paper we have been calling musical objects and their
+performance). A similar structure can be found in Arya's
+\keyword{functional animation} work \cite{arya94}.
+
+There are many interesting avenues to pursue with this research. On
+the theoretical side, we need a deeper investigation of the algebraic
+structure of music, and would like to express certain modern theories
+of music in Haskore. The possibility of expressing other scale types
+instead of the thus far unstated assumption of standard equal
+temperament scales is another area of investigation. On the practical
+side, the potential of a graphical interface to Haskore is appealing.
+We are also interested in extending the methodology to sound
+synthesis. Our primary goal currently, however, is to continue using
+Haskore as a vehicle for interesting algorithmic composition (for
+example, see \cite{hudakberger95}).
+
diff --git a/src/Doc/Tutorial.tex b/src/Doc/Tutorial.tex
new file mode 100644
--- /dev/null
+++ b/src/Doc/Tutorial.tex
@@ -0,0 +1,238 @@
+% For DVIWindo:
+\documentclass[11pt,fleqn]{article}
+
+\usepackage{comment}
+\usepackage{doc} % .ind (index) files use macros like \pfill, \scan@allowedfalse
+\usepackage{makeidx}
+\makeindex
+
+\usepackage{color}
+\usepackage{graphicx}
+\graphicspath{{.}{Pics/}}
+
+\newif\ifpdf
+\ifx\pdfoutput\undefined
+ \pdffalse
+\else
+ \pdfoutput=1
+ \pdftrue
+\fi
+
+\definecolor{brown}{rgb}{0.7,0.2,0}
+\definecolor{darkgreen}{rgb}{0,0.6,0.1}
+\definecolor{darkgrey}{rgb}{0.4,0.4,0.4}
+\definecolor{lightgrey}{rgb}{0.95,0.95,0.95}
+
+
+\usepackage{times}
+\usepackage{listings}
+\usepackage{amsbsy} % \poor man's bold \pmb
+
+% keywordstyle=\pmb,
+% keywordstyle=\color{brown},
+
+\lstset{%
+ language=Haskell,
+ showstringspaces=false,
+ basicstyle=\ttfamily,
+ keywordstyle=\textbf,
+ commentstyle=\highlightcomment,
+ backgroundcolor=\color{lightgrey}}
+
+\newcommand\highlightcomment[1]{\textsl{\color{darkgrey}#1}}
+\lstnewenvironment{haskelllisting}
+ {\lstset{language=Haskell,gobble=2,firstline=2}}{}
+\lstnewenvironment{haskellblock}
+ {\mbox{}\\\lstset{language=Haskell}}{}
+
+
+\ifpdf
+%% pdflatex: *.tex -> *.pdf
+ \usepackage[pdftex,
+ colorlinks=true,
+ urlcolor=blue,
+ linkcolor=brown,
+ citecolor=darkgreen,
+ pdfstartview=FitH,
+ bookmarks,
+ pdftitle={Haskore tutorial},
+ pdfsubject={},
+ pdfkeywords={},
+ pdfauthor={Paul Hudak}
+ ]{hyperref}
+ \pdfimageresolution=288
+ \pdfcompresslevel=9
+ \usepackage{thumbpdf}
+\else
+ \usepackage[
+ colorlinks=true,
+ urlcolor=blue,
+ linkcolor=brown
+ ]{hyperref}
+\fi
+
+
+
+% Old Latex:
+% \documentstyle[epsf,11pt]{article}
+%
+%\input texnansi
+%\input lcdlatex.tex
+%\input epsfsafe.tex
+
+\textheight=8.5in
+\textwidth=6.5in
+\topmargin=-.3in
+\oddsidemargin=0in
+\evensidemargin=0in
+\parskip=6pt plus2pt minus2pt
+
+% Use these for extended mode:
+\newcommand{\extended}[1]{#1}
+\newcommand{\basic}[1]{}
+
+% Use these for basic mode:
+% \newcommand{\extended}[1]{}
+% \newcommand{\basic}[1]{#1}
+
+\input{Doc/Macros}
+
+\sloppy % prevent keywords from stitching out off the text block
+
+\begin{document}
+
+\title{Haskore Music Tutorial}
+
+\author{Paul Hudak\\
+Yale University\\
+Department of Computer Science\\
+New Haven, CT 06520\\
+\href{mailto:paul.hudak@yale.edu}{paul.hudak@yale.edu}}
+
+\date{February 14, 1997\\
+(Revised November 1998)\\
+(Revised February 2000)\\
+(Constantly mixed up in 2004 - 2007 by
+\href{mailto:haskore@henning-thielemann.de}{Henning Thielemann} :-)}
+
+\maketitle
+
+\tableofcontents
+
+% the introduction
+\input{Doc/Introduction.tex}
+
+% the structure of Haskore
+\input{Haskore.lhs}
+
+\section{Creation of Music}
+
+\subsection{Composing Music}
+
+% pitch definitions and conversions
+\input{Haskore/Basic/Pitch.lhs}
+
+% the basics
+\input{Haskore/Music.lhs}
+
+% some common interval names
+\input{Haskore/Basic/Interval.lhs}
+
+% a brief treatise on chords
+\input{Haskore/Composition/Chord.lhs}
+
+% some common scales
+\input{Haskore/Basic/Scale.lhs}
+
+% tempo handling
+\input{Haskore/Basic/Tempo.lhs}
+
+% all about performance and players
+\input{Haskore/Performance.lhs}
+
+% moved to Performance.lhs
+%\input{Equivalence.tex}
+\input{Haskore/Performance/Player.lhs}
+
+\input{Haskore/Performance/Default.lhs}
+
+\input{Haskore/Performance/Fancy.lhs}
+
+\section{Interfaces to other musical software}
+
+% all about performance and players
+\input{Haskore/Performance/BackEnd.lhs}
+
+% translating a performance into Midi
+\basic{\input{Haskore/Interface/BasicMIDI/Write.lhs}}
+\extended{\input{Haskore/Interface/MIDI/Write.lhs}}
+\input{Haskore/Interface/MIDI/InstrumentMap.lhs}
+
+% the MidiFile datatype
+\basic{\input{Haskore/Interface/BasicMIDI/File.lhs}}
+% \extended{\input{Haskore/Interface/MIDI/File.lhs}}
+
+For a description of the MIDI file type
+and its loading and saving to disk, see the \texttt{midi} package.
+
+% storing Midi in files
+% \input{Haskore/Interface/MIDI/Save.lhs}
+
+% loading Midi files
+% \input{Haskore/Interface/MIDI/Load.lhs}
+
+% translating Midi to Haskore
+\input{Haskore/Interface/MIDI/Read.lhs}
+
+% table of General Midi assignments
+% \input{Haskore/Interface/MIDI/General.lhs}
+
+% CSound
+\input{Haskore/Interface/CSound.lhs}
+\input{Haskore/Interface/CSound/Tutorial.lhs}
+
+% MML
+\input{Haskore/Interface/MML.lhs}
+
+\section{Processing and Analysis}
+\input{Haskore/Process/Optimization.lhs}
+\input{Medium/Controlled/ContextFreeGrammar.lhs}
+\subsection{Markov Chains}
+Markov chains are now available in a package called \texttt{markov-chain}.
+\input{Haskore/Process/Format.lhs}
+
+% related work
+\input{Doc/Related.tex}
+
+\appendix
+
+\section{Helper modules}
+
+% random test routines
+\input{Haskore/Interface/MIDI/Render.lhs}
+
+% utility functions
+\input{Haskore/General/Utility.lhs}
+
+\section{Examples}
+% random examples
+\input{Haskore/Example/Miscellaneous.lhs}
+
+% Chick Corea's Child Song 6
+\input{Haskore/Example/ChildSong6.lhs}
+
+% some self-similar (fractal) music
+\input{Haskore/Example/SelfSim.lhs}
+
+% simulating a guitar
+\input{Haskore/Example/Guitar.lhs}
+
+% discussion about design decisions
+\input{Doc/Discussion}
+
+\bibliographystyle{alpha}
+\bibliography{/homes/systems/hudak/Bib/old}
+
+\printindex
+
+\end{document}
diff --git a/src/Haskore.lhs b/src/Haskore.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore.lhs
@@ -0,0 +1,94 @@
+\section{The Architecture of Haskore}
+
+\figref{haskore} shows the overall structure of Haskore. Note the
+independence of high level structures from the ``music platform'' on
+which Haskore runs. Originally, the goal was for Haskore compositions
+to run equally well as conventional midi-files \cite{midi},
+NeXT MusicKit score files \cite{musickit}
+\footnote{The NeXT music platform is obsolete.},
+and CSound score files \cite{csound}
+\footnote{There also exists a translation to CSound for an earlier version of Haskore.},
+and for Haskore compositions to be displayed and
+printed in traditional notation using the CMN (Common Music Notation) subsystem.
+\footnote{We have abandoned CMN entirely,
+as there are now better candidates for notation packages
+into which Haskore could be mapped.}
+In reality, three platforms are currently supported:
+MIDI, CSound, and some signal processing routines written in Haskell.
+For musical notation an interface to Lilypond is currently in progress.
+
+
+\begin{figure*}
+\centerline{
+\includegraphics[height=4.0in]{Doc/Pics/haskore}
+}
+\caption{Overall System Diagram}
+\figlabel{haskore}
+\end{figure*}
+
+In any case, the independence of abstract musical ideas from the
+concrete rendering platform is accomplished by having abstract notions
+of \keyword{musical object}, \keyword{player}, \keyword{instrument}, and
+\keyword{performance}. All of this resides in the box labeled ``Haskore'' in
+the diagram above.
+
+At the module level, Haskore is organized as follows:
+\begin{haskelllisting}
+
+> module Haskore (module Haskore,
+> module Haskore.Music,
+> module Haskore.Performance,
+> module Haskore.Performance.Player,
+> module Haskore.Interface.MIDI.Write,
+> module Haskore.Interface.MIDI.Read,
+> module Sound.MIDI.File.Save,
+> module Sound.MIDI.File.Load,
+> module Haskore.Interface.MIDI.Render)
+> where
+>
+> import qualified Haskore.Music
+> import qualified Haskore.Performance
+> import qualified Haskore.Performance.Player
+> import qualified Haskore.Interface.MIDI.Write
+> import qualified Haskore.Interface.MIDI.Read
+> import qualified Sound.MIDI.File.Save
+> import qualified Sound.MIDI.File.Load
+> import qualified Haskore.Interface.MIDI.Render
+
+\end{haskelllisting}
+
+\begin{comment}
+
+> import Prelude hiding (repeat, reverse)
+
+\end{comment}
+
+This document was written in the \keyword{literate programming style}, and
+thus the \LaTeX\ manuscript file from which it was generated is an
+\keyword{executable Haskell program}. It can be compiled under \LaTeX\ in
+two ways: a basic mode provides all of the functionality that most
+users will need, and an extended mode in which various pieces of
+lower-level code are provided and documented as well (see file header
+for details). This version was compiled in
+\basic{basic}\extended{extended} mode. The document can be retrieved
+via WWW from: \url{http://haskell.org/haskore/} (consult the README
+file for details). It is also delivered with the standard joint
+Nottingham/Yale Hugs release.
+
+The Haskore code conforms to Haskell 1.4, and has been tested under
+the June, 1998 release of Hugs 1.4. Unfortunately Hugs does not yet
+support mutually recursive modules, so all references to the
+\module{Player} in this document are commented out, which in effect
+makes it part of \module{Performance} (with which it is mutually
+recursive).
+
+A final word before beginning: As various musical ideas are presented
+in this Haskore tutorial, I urge the reader to question the design
+decisions that are made. There is no supreme theory of music that
+dictates my decisions, and what I present is actually one of several
+versions that I have developed over the years (this version is much
+richer than the one described in \cite{haskore}; it is the ``Haskore
+in practice'' version alluded to in \secref{midi} of that paper). I
+believe that this version is suitable for many practical purposes, but
+the reader may wish to modify it to better satisfy her intuitions
+and/or application.
diff --git a/src/Haskore/Basic/Duration.lhs b/src/Haskore/Basic/Duration.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Duration.lhs
@@ -0,0 +1,133 @@
+\subsubsection{Duration}
+\seclabel{duration}
+
+\begin{haskelllisting}
+
+> module Haskore.Basic.Duration where
+
+> import qualified Medium.Temporal as TemporalMedium
+> import Data.Ratio((%))
+
+> import qualified Haskore.General.Utility as Utility
+> import Haskore.General.Map (Map)
+> import qualified Haskore.General.Map as Map
+
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> type T = TemporalMedium.Dur
+> type Ratio = T
+> type Offset = Rational
+
+> infixl 7 %+
+> (%+) :: Integer -> Integer -> T
+> (%+) x y = fromRatio (x%y)
+
+> fromRatio :: Rational -> T
+> fromRatio = NonNeg.fromNumberMsg "Duration.fromRatio"
+
+> toRatio :: T -> Rational
+> toRatio = NonNeg.toNumber
+
+> toNumber :: Fractional a => T -> a
+> toNumber = fromRational . NonNeg.toNumber
+
+> scale :: Ratio -> T -> T
+> scale = (*)
+
+> add :: Offset -> T -> T
+> add d = NonNeg.fromNumberMsg "Duration.add" . (d+) . toRatio
+
+\end{haskelllisting}
+
+\function{add} may have undefined result.
+
+\begin{haskelllisting}
+
+> divide :: T -> T -> Integer
+> divide r1 r2 = Utility.divide (toRatio r1) (toRatio r2)
+
+> divisible :: T -> T -> Bool
+> divisible r1 r2 = Utility.divisible (toRatio r1) (toRatio r2)
+
+> gcd :: T -> T -> T
+> gcd r1 r2 = fromRatio (Utility.gcdDur (toRatio r1) (toRatio r2))
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> dotted, doubleDotted :: T -> T
+> dotted = ((3%+2) *)
+> doubleDotted = ((7%+4) *)
+>
+> bn, wn, hn, qn, en, sn, tn, sfn :: T
+> dwn, dhn, dqn, den, dsn, dtn :: T
+> ddhn, ddqn, dden :: T
+>
+> bn = 2 -- brevis
+> wn = 1 -- whole note
+> hn = 1%+ 2 -- half note
+> qn = 1%+ 4 -- quarter note
+> en = 1%+ 8 -- eight note
+> sn = 1%+16 -- sixteenth note
+> tn = 1%+32 -- thirty-second note
+> sfn = 1%+64 -- sixty-fourth note
+>
+> dwn = dotted wn -- dotted whole note
+> dhn = dotted hn -- dotted half note
+> dqn = dotted qn -- dotted quarter note
+> den = dotted en -- dotted eighth note
+> dsn = dotted sn -- dotted sixteenth note
+> dtn = dotted tn -- dotted thirty-second note
+>
+> ddhn = doubleDotted hn -- double-dotted half note
+> ddqn = doubleDotted qn -- double-dotted quarter note
+> dden = doubleDotted en -- double-dotted eighth note
+
+\end{haskelllisting}
+
+
+\begin{haskelllisting}
+
+> nameDictionary :: Map T String
+> nameDictionary =
+> let names = "b" : "w" : "h" : "q" : "e" : "s" : "t" : "sf" : []
+> durs = zip (iterate (/2) 2) names
+> ddurs = map (\(d,s) -> (dotted d, "d" ++s)) durs
+> dddurs = map (\(d,s) -> (doubleDotted d, "dd"++s)) durs
+> in Map.fromList $
+> durs ++
+> take 6 (drop 1 ddurs) ++
+> take 3 (drop 2 dddurs)
+
+> {- |
+> Converts @1%4@ to @\"qn\"@ and so on.
+> -}
+> toString :: T -> String
+> toString dur =
+> maybe
+> ("(" ++ show dur ++ ")")
+> (++"n")
+> (Map.lookup nameDictionary dur)
+
+\end{haskelllisting}
+
+
+Check proper formatting.
+
+\begin{haskelllisting}
+
+> propToString :: Bool
+> propToString =
+> all (\(dur,name) -> toString dur == name) $
+> (bn, "bn") : (wn, "wn") : (hn, "hn") : (qn, "qn") :
+> (en, "en") : (sn, "sn") : (tn, "tn") : (sfn, "sfn") :
+> (dwn, "dwn") : (dhn, "dhn") : (dqn, "dqn") :
+> (den, "den") : (dsn, "dsn") : (dtn, "dtn") :
+> (ddhn, "ddhn") : (ddqn, "ddqn") : (dden, "dden") : []
+
+\end{haskelllisting}
diff --git a/src/Haskore/Basic/Dynamics.lhs b/src/Haskore/Basic/Dynamics.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Dynamics.lhs
@@ -0,0 +1,53 @@
+\subsubsection{Dynamics}
+\seclabel{dynamics}
+
+\begin{haskelllisting}
+
+> module Haskore.Basic.Dynamics where
+
+\end{haskelllisting}
+
+These definitions contradict to the rest of Haskore
+where the normal Velocity is 1
+and the default player makes crescendo relative to the starting velocity.
+According the MIDI specification the velocity shall be a logarithmic scale,
+thus it should be additive,
+thus the normal velocity is 0.
+
+\begin{haskelllisting}
+
+> type Velocity = Rational
+> type T = Rational
+
+> normal, mp, p, pp, ppp, mf, f, ff, fff,
+> -- levels of softness
+> mezzoPiano, piano, pianissimo, pianoPianissimo,
+> -- levels of loudness
+> mezzoForte, forte, fortissimo, forteFortissimo :: Velocity
+
+> normal = 0
+
+> mezzoPiano = -1
+> piano = -3
+> pianissimo = -5
+> pianoPianissimo = -7
+
+> mezzoForte = 1
+> forte = 3
+> fortissimo = 5
+> forteFortissimo = 7
+
+> mp = mezzoPiano
+> p = piano
+> pp = pianissimo
+> ppp = pianoPianissimo
+
+> mf = mezzoForte
+> f = forte
+> ff = fortissimo
+> fff = forteFortissimo
+
+\end{haskelllisting}
+
+Cf. MIDI 1.0 Detailed Specification, Document Version 4.2, February 1996,
+page 10
diff --git a/src/Haskore/Basic/Interval.lhs b/src/Haskore/Basic/Interval.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Interval.lhs
@@ -0,0 +1,44 @@
+\subsubsection{Intervals}
+\seclabel{intervals}
+
+% \url{http://en.wikipedia.org/wiki/Interval_(music)}
+
+In music theory, an interval is the difference
+(a ratio or logarithmic measure) in pitch between two notes
+and often refers to those two notes themselves (otherwise known as a dyad).
+
+Here we list some common names for some possible intervals.
+
+\begin{haskelllisting}
+
+> module Haskore.Basic.Interval where
+
+> unison, minorSecond, majorSecond, minorThird, majorThird,
+> fourth, fifth, minorSixth, majorSixth, minorSeventh, majorSeventh,
+> octave, octaveMinorSecond, octaveMajorSecond, octaveMinorThird,
+> octaveMajorThird, octaveFourth, octaveFifth, octaveMinorSixth,
+> octaveMajorSixth, octaveMinorSeventh, octaveMajorSeventh :: Integral a => a
+> unison = 0
+> minorSecond = 1
+> majorSecond = 2
+> minorThird = 3
+> majorThird = 4
+> fourth = 5
+> fifth = 7
+> minorSixth = 8
+> majorSixth = 9
+> minorSeventh = 10
+> majorSeventh = 11
+> octave = 12
+> octaveMinorSecond = octave + minorSecond
+> octaveMajorSecond = octave + majorSecond
+> octaveMinorThird = octave + minorThird
+> octaveMajorThird = octave + majorThird
+> octaveFourth = octave + fourth
+> octaveFifth = octave + fifth
+> octaveMinorSixth = octave + minorSixth
+> octaveMajorSixth = octave + majorSixth
+> octaveMinorSeventh = octave + minorSeventh
+> octaveMajorSeventh = octave + majorSeventh
+
+\end{haskelllisting}
diff --git a/src/Haskore/Basic/Pitch.lhs b/src/Haskore/Basic/Pitch.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Pitch.lhs
@@ -0,0 +1,122 @@
+\subsubsection{Pitch}
+\seclabel{pitch}
+
+Perhaps the most basic musical idea is that of a \keyword{pitch},
+which consists of an \keyword{octave} and a \keyword{pitch class}
+(i.e. one of 12 semi-tones, cf. \secref{discussion:pitch}):
+\begin{haskelllisting}
+
+> module Haskore.Basic.Pitch where
+
+> import Data.Ix(Ix)
+
+> type T = (Octave, Class)
+> data Class = Cf | C | Cs | Df | D | Ds | Ef | E | Es | Ff | F | Fs
+> | Gf | G | Gs | Af | A | As | Bf | B | Bs
+> deriving (Eq,Ord,Ix,Enum,Show,Read)
+> type Octave = Int
+
+\end{haskelllisting}
+So a \type{Pitch.T} is a pair consisting of a pitch class and an octave.
+Octaves are just integers, but we define a datatype for pitch classes,
+since distinguishing enharmonics (such as $G^\#$ and $A^b$) may be important
+(especially for notation).
+\figref{note-freqs} shows the meaning of the some \type{Pitch.T} values.
+
+\begin{figure}
+\begin{center}
+\begin{tabular}{llr}
+$A_2$ & \code{(-3,A)} & 27.5 Hz \\
+$A_1$ & \code{(-2,A)} & 55.0 Hz \\
+$A $ & \code{(-1,A)} & 110.0 Hz \\
+$a $ & \code{( 0,A)} & 220.0 Hz \\
+$a^1$ & \code{( 1,A)} & 440.0 Hz \\
+$a^2$ & \code{( 2,A)} & 880.0 Hz
+\end{tabular}
+\end{center}
+\caption{Note names, Haskore representations and frequencies.}
+\figlabel{note-freqs}
+\end{figure}
+
+Treating pitches simply as integers is useful in many settings,
+so let's also define some functions for converting between \type{Pitch.T}
+values and \type{Pitch.Absolute} values (integers):
+\begin{haskelllisting}
+
+> type Absolute = Int
+> type Relative = Int
+>
+> toInt :: T -> Absolute
+> toInt (oct,pc) = 12*oct + classToInt pc
+>
+> fromInt :: Absolute -> T
+> fromInt ap =
+> let (oct, n) = divMod ap 12
+> in (oct, [C,Cs,D,Ds,E,F,Fs,G,Gs,A,As,B] !! n)
+>
+> classToInt :: Class -> Relative
+> classToInt pc = case pc of
+> Cf -> -1; C -> 0; Cs -> 1 -- or should Cf be 11?
+> Df -> 1; D -> 2; Ds -> 3
+> Ef -> 3; E -> 4; Es -> 5
+> Ff -> 4; F -> 5; Fs -> 6
+> Gf -> 6; G -> 7; Gs -> 8
+> Af -> 8; A -> 9; As -> 10
+> Bf -> 10; B -> 11; Bs -> 12 -- or should Bs be 0?
+
+\end{haskelllisting}
+
+Now two functions for parsing and formatting pitch classes
+in a more human way, that is using '\#' and 'b' suffixes
+instead of 's' and 'f'.
+We do not simply use
+
+\begin{haskelllisting}
+
+> classParse :: ReadS Class
+> classParse (p:'#':r) = reads (p:'s':r)
+> classParse (p:'b':r) = reads (p:'f':r)
+> classParse r = reads r
+
+> classFormat :: Class -> ShowS
+> classFormat pc =
+> let (p:r) = show pc
+> in (p:) .
+> case r of
+> [] -> id
+> 's':[] -> ('#':)
+> 'f':[] -> ('b':)
+> _ -> error ("classFormat: Pitch.Class.show must not return suffixes" ++
+> " other than 's' and 'f'")
+
+\end{haskelllisting}
+
+Using \type{Pitch.Absolute} we can compute the frequency associated
+with a pitch:
+
+\begin{haskelllisting}
+
+> intToFreq :: Floating a => Absolute -> a
+> intToFreq ap = 440 * 2 ** (fromIntegral (ap - toInt (1,A)) / 12)
+
+\end{haskelllisting}
+
+We can also define a function \function{Pitch.transpose},
+which transposes pitches
+(analogous to \function{Music.transpose},
+which transposes values of type \type{Music.T}):
+\begin{haskelllisting}
+
+> transpose :: Relative -> T -> T
+> transpose i p = fromInt (toInt p + i)
+
+\end{haskelllisting}
+
+\begin{exercise}
+Show that\ \ \code{toInt\ .\ fromInt = id}, and,
+up to enharmonic equivalences,\newline \code{fromInt\ .\ toInt = id}.
+\end{exercise}
+
+\begin{exercise}
+Show that\ \ \code{transpose i (transpose j p) = transpose (i+j) p}.
+\end{exercise}
diff --git a/src/Haskore/Basic/Scale.lhs b/src/Haskore/Basic/Scale.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Scale.lhs
@@ -0,0 +1,99 @@
+% from AutoTrack by Stefan Ratschan
+
+\subsubsection{Scales}
+
+\begin{haskelllisting}
+
+> module Haskore.Basic.Scale
+> (T, ionian, dorian, phrygian, lydian, mixolydian,
+> aeolian, lokrian, altered, htwt, wtht,
+> ionianRel, dorianRel, phrygianRel, lydianRel, mixolydianRel,
+> aeolianRel, lokrianRel, alteredRel, htwtRel, wthtRel,
+>
+> fromOffsets, fromIntervals, continue) where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import Control.Monad(liftM2)
+
+\end{haskelllisting}
+
+Some of the following code is taken
+from the EasyScale implementation of Martin Schwenke.
+
+\begin{haskelllisting}
+
+> type T = [Pitch.Absolute]
+> type Intervals = [Pitch.Relative]
+
+\end{haskelllisting}
+
+Make a scale given a list of absolute pitches, usually starting at 0,
+and a \type{Pitch.Class} representing the root note of the scale.
+
+\begin{haskelllisting}
+
+> fromOffsets :: [Pitch.Absolute] -> Pitch.Class -> T
+> fromOffsets ns pc
+> = map (+ Pitch.classToInt pc) ns
+
+\end{haskelllisting}
+
+Create a scale from a list of intervals between successive notes.
+
+\begin{haskelllisting}
+
+> fromIntervals :: Intervals -> Pitch.Class -> T
+> fromIntervals = fromOffsets . scanl (+) 0
+
+\end{haskelllisting}
+
+Continue a scale to all octaves.
+
+\begin{haskelllisting}
+
+> continue :: T -> T
+> continue = liftM2 (+) (iterate (12+) 0)
+
+\end{haskelllisting}
+
+Now some general useful scales from music theory.
+
+\begin{haskelllisting}
+
+> ionianRel, dorianRel, phrygianRel, lydianRel, mixolydianRel,
+> aeolianRel, lokrianRel, alteredRel, htwtRel,
+> wthtRel :: Intervals
+
+> ionianRel = [ 2, 2, 1, 2, 2, 2, 1 ]
+> dorianRel = [ 2, 1, 2, 2, 2, 1, 2 ]
+> phrygianRel = [ 1, 2, 2, 2, 1, 2, 2 ]
+> lydianRel = [ 2, 2, 2, 1, 2, 2, 1 ]
+> mixolydianRel = [ 2, 2, 1, 2, 2, 1, 2 ]
+> aeolianRel = [ 2, 1, 2, 2, 1, 2, 2 ]
+> lokrianRel = [ 1, 2, 2, 1, 2, 2, 2 ]
+> alteredRel = [ 1, 2, 1, 2, 2, 2, 2 ]
+> htwtRel = [ 1, 2, 1, 2, 1, 2, 1, 2 ]
+> wthtRel = [ 2, 1, 2, 1, 2, 1, 2, 1 ]
+
+> ionian, dorian, phrygian, lydian, mixolydian,
+> aeolian, lokrian, altered, htwt,
+> wtht :: Pitch.Class -> T
+
+> ionian = fromIntervals ionianRel
+> dorian = fromIntervals dorianRel
+> phrygian = fromIntervals phrygianRel
+> lydian = fromIntervals lydianRel
+> mixolydian = fromIntervals mixolydianRel
+> aeolian = fromIntervals aeolianRel
+> lokrian = fromIntervals lokrianRel
+> altered = fromIntervals alteredRel
+> htwt = fromIntervals htwtRel
+> wtht = fromIntervals wthtRel
+
+\end{haskelllisting}
+
+Example:
+Alternatively to applying \function{continue} to a scale
+you can create an infinitely increasing scale
+using the definition by intervals,
+e.g. \code{fromIntervals (cycle ionianRel) Pitch.C}.
diff --git a/src/Haskore/Basic/Tempo.lhs b/src/Haskore/Basic/Tempo.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Basic/Tempo.lhs
@@ -0,0 +1,155 @@
+\subsubsection{Tempo}
+\seclabel{tempo}
+
+\begin{haskelllisting}
+
+> module Haskore.Basic.Tempo where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import Haskore.Basic.Duration (qn, en, sn, (%+), )
+> import qualified Haskore.Music as Music
+> import Haskore.Music(changeTempo, line, (+:+), (=:=), )
+> import qualified Haskore.Melody as Melody
+
+> import qualified Haskore.Basic.Duration as Dur
+
+> import qualified Data.List as List
+
+\end{haskelllisting}
+
+\paragraph*{Set tempo.}
+
+To make it easier to initialize the duration element
+of a \code{PerformanceContext.T} (see \secref{performance}),
+we can define a ``metronome'' function that,
+given a standard metronome marking (in beats per minute)
+and the note type associated with one beat (quarter note, eighth note, etc.)
+generates the duration of one whole note:
+\begin{haskelllisting}
+
+> metro :: Fractional a => a -> Music.Dur -> a
+> metro setting dur = 60 / (setting * Dur.toNumber dur)
+
+\end{haskelllisting}
+
+Additionally we define some common tempos and
+some range of interpretation as in \figref{tempos}.
+This means, the tempo Andante may vary between
+\code{fst andanteRange} and \code{snd andanteRange}
+beats per minute.
+For example, \code{metro andante qn} creates a tempo of 92 quarter
+notes per minute.
+
+\begin{figure}
+%larghissimoRange = ( 30, 40) -- as slow as reasonably possible
+%adagiettoRange = ( 70, 80) -- slightly faster than adagio
+%allegrettoRange = (110,150) -- not quite allegro
+\begin{haskelllisting}
+
+> largoRange, larghettoRange, adagioRange, andanteRange,
+> moderatoRange, allegroRange, prestoRange, prestissimoRange
+> :: Fractional a => (a,a)
+>
+> largoRange = ( 40, 60) -- slowly and broadly
+> larghettoRange = ( 60, 68) -- a little less slow than largo
+> adagioRange = ( 66, 76) -- slowly
+> andanteRange = ( 76,108) -- at a walking pace
+> moderatoRange = (108,120) -- at a moderate tempo
+> allegroRange = (120,168) -- quickly
+> prestoRange = (168,200) -- fast
+> prestissimoRange = (200,208) -- very fast
+>
+>
+> largo, larghetto, adagio, andante, moderato, allegro,
+> presto, prestissimo :: Fractional a => a
+>
+> average :: Fractional a => a -> a -> a
+> average x y = (x+y)/2
+>
+> largo = uncurry average largoRange
+> larghetto = uncurry average larghettoRange
+> adagio = uncurry average adagioRange
+> andante = uncurry average andanteRange
+> moderato = uncurry average moderatoRange
+> allegro = uncurry average allegroRange
+> presto = uncurry average prestoRange
+> prestissimo = uncurry average prestissimoRange
+
+\end{haskelllisting}
+\caption{Common names for tempo.}
+\figlabel{tempos}
+\end{figure}
+
+% http://en.wikipedia.org/wiki/Tempo
+% http://groups.google.de/groups?q=adagio+andante+allegro+bpm&hl=de&lr=&ie=UTF-8&selm=25919-385E77EA-28%40storefull-615.iap.bryant.webtv.net&rnum=5
+
+
+\begin{figure*}
+\centerline{
+\includegraphics[height=2.0in]{Doc/Pics/poly}
+}
+\caption{Nested Polyrhythms}
+\figlabel{polyrhythms}
+\end{figure*}
+
+\paragraph*{Polyrhythms.}
+
+For some rhythmical ideas, consider first a simple \keyword{triplet} of
+eighth notes; it can be expressed as ``\code{Tempo (3\%2) m}'', where
+\code{m} is a line of three eighth notes. In fact \code{Tempo} can be
+used to create quite complex rhythmical patterns. For example,
+consider the ``nested polyrhythms'' shown in \figref{polyrhythms}.
+They can be expressed quite naturally in Haskore as follows (note the
+use of the \code{where} clause in \code{pr2} to capture recurring
+phrases):
+\begin{haskelllisting}
+
+> pr1, pr2 :: Pitch.T -> Melody.T ()
+> pr1 p =
+> changeTempo (5%+6)
+> (changeTempo (4%+3)
+> (line [mkLn 1 p qn,
+> changeTempo (3%+2)
+> (line [mkLn 3 p en,
+> mkLn 2 p sn,
+> mkLn 1 p qn] ),
+> mkLn 1 p qn]) +:+
+> changeTempo (3%+2) (mkLn 6 p en))
+>
+> pr2 p =
+> changeTempo (7%+6)
+> (line [m1,
+> changeTempo (5%+4) (mkLn 5 p en),
+> m1,
+> mkLn 2 p en])
+> where m1 = changeTempo (5%+4) (changeTempo (3%+2) m2 +:+ m2)
+> m2 = mkLn 3 p en
+>
+> mkLn :: Int -> Pitch.T -> Music.Dur -> Melody.T ()
+> mkLn n p d = line (take n (List.repeat (Melody.note p d ())))
+
+\end{haskelllisting}
+To play polyrhythms \code{pr1} and \code{pr2} in parallel using middle C
+and middle G, respectively, we would do the following (middle C is in
+the 5th octave):
+\begin{haskelllisting}
+
+> pr12 :: Melody.T ()
+> pr12 = pr1 (5, Pitch.C) =:= pr2 (5, Pitch.G)
+
+\end{haskelllisting}
+
+\paragraph*{Symbolic Meter Changes}
+
+We can implement a notion of ``symbolic meter changes'' of the form
+``oldnote = newnote'' (quarter note = dotted eighth, for example) by
+defining a function:
+\begin{haskelllisting}
+
+> (=/=) :: Music.Dur -> Music.Dur -> Music.T note -> Music.T note
+> old =/= new = changeTempo (new/old)
+
+\end{haskelllisting}
+Of course, using the new function is not much longer than using
+\code{changeTempo} directly, but it may have nemonic value.
+
diff --git a/src/Haskore/Composition/Chord.lhs b/src/Haskore/Composition/Chord.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Composition/Chord.lhs
@@ -0,0 +1,373 @@
+\subsubsection{Chords}
+\seclabel{chords}
+
+Earlier I described how to represent chords as values of type \code{Music.T}.
+However, sometimes it is convenient to treat chords more abstractly.
+Rather than think of a chord in terms of its actual notes,
+it is useful to think of it in terms of its chord ``quality'',
+coupled with the key it is played in and the particular voicing used.
+For example, we can describe a chord as being a ``major triad in root
+position, with root middle C''. Several approaches have been put
+forth for representing this information, and we cannot cover all of
+them here. Rather, I will describe two basic representations, leaving
+other alternatives to the skill and imagination of the
+reader.\footnote{For example, Forte prescribes normal forms for chords
+in an atonal setting \cite{forte}.}
+
+First, one could use a \keyword{pitch} representation, where each note is
+represented as its distance from some fixed pitch. \code{0} is the
+obvious fixed pitch to use, and thus, for example, \code{[0,4,7]}
+represents a major triad in root position. The first zero is in some
+sense redundant, of course, but it serves to remind us that the chord
+is in ``normal form''. For example, when forming and transforming
+chords, we may end up with a representation such as \code{[2,6,9]},
+which is not normalized; its normal form is in fact \code{[0,4,7]}.
+Thus we define:
+\begin{quote}
+A chord is in \keyword{pitch normal form} if the first pitch is zero,
+and the subsequent pitches are monotonically increasing.
+\end{quote}
+
+One could also represent a chord \keyword{intervalically}; i.e.~as a
+sequence of intervals. A major triad in root position, for example,
+would be represented as \code{[4,3,-7]}, where the last interval
+``returns'' us to the ``origin''. Like the \code{0} in the pitch
+representation, the last interval is redundant, but allows us to
+define another sense of normal form:
+\begin{quote}
+A chord is in \keyword{interval normal form} if the intervals are all
+greater than zero, except for the last which must be equal to the
+negation of the sum of the others.
+\end{quote}
+In either case, we can define a chord type as:
+\begin{haskelllisting}
+
+> module Haskore.Composition.Chord where
+>
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Basic.Interval as I
+> import Haskore.General.Utility (minimumKey, foldrf, splitInit)
+> import Data.List(genericLength)
+>
+> type T = [Pitch.Relative]
+
+\end{haskelllisting}
+
+
+We might ask whether there is some advantage, computationally, of
+using one of these representations over the other. However, there is
+an invertible linear transformation between them, as defined by the
+following functions, and thus there is in fact little advantage of one
+over the other:
+\begin{haskelllisting}
+
+> pitchToInterval :: T -> T
+> pitchToInterval [] = error "pitchToInterval: Chord must be non-empty."
+> pitchToInterval ch@(p:ps) =
+> zipWith (-) (ps++[p]) ch
+>
+> intervalToPitch :: T -> T
+> intervalToPitch [] = error "intervalToPitch: Chord must be non-empty."
+> intervalToPitch ch =
+> let (chInit, chLast) = splitInit (scanl (+) 0 ch)
+> in if chLast==0
+> then chInit
+> else error "intervalToPitch: intervals do not sum-up to zero."
+
+\end{haskelllisting}
+
+\begin{exercise}
+Show that \code{pitchToInterval} and \code{intervalToPitch}
+are \keyword{inverses} in the following sense:
+for any chord \code{ch1} in pitch normal form, and
+\code{ch2} in interval normal form, each of length at least two:
+\begin{center}
+\code{intervalToPitch (pitchToInterval ch1) = ch1}\\
+\code{pitchToInterval (intervalToPitch ch2) = ch2}
+\end{center}
+\end{exercise}
+
+Another operation we may wish to perform is a test for \keyword{equality}
+on chords, which can be done at many levels: based only on chord
+quality, taking inversion into account, absolute equality, etc. Since
+the above normal forms guarantee a unique representation, equality of
+chords with respect to chord quality and inversion is simple: it is
+just the standard (overloaded) equality operator on lists. On the
+other hand, to measure equality based on chord quality alone, we need
+to account for the notion of an \keyword{inversion}.
+
+Using the pitch representation, the inversion of a chord can be
+defined as follows:
+\begin{haskelllisting}
+
+> pitchInvert, intervalInvert :: T -> T
+> pitchInvert (0:p2:ps) = 0 : map (subtract p2) ps ++ [12-p2]
+> pitchInvert _ =
+> error "pitchInvert: Pitch chord representation must start with a zero."
+
+\end{haskelllisting}
+Although we could also directly define a function to invert
+a chord given in interval representation, we will simply
+define it in terms of functions already defined:
+\begin{haskelllisting}
+
+> intervalInvert = pitchToInterval . pitchInvert . intervalToPitch
+
+\end{haskelllisting}
+% pitchInvert [0,4,7] => [4,7,0] => [0,3,-4] => [0,3,8]
+% intervalInvert [4,3,-7] => [3,-7,4] => [3,5,4] => [3,5,-8]
+
+We can now determine whether a chord in normal form has the same
+quality (but possibly different inversion) as another chord in normal
+form, as follows: simply test whether one chord is equal either to the
+other chord or to one of its inversions. Since there is only a finite
+number of inversions, this is well defined. In Haskell:
+\begin{haskelllisting}
+
+> samePitch, sameInterval :: T -> T -> Bool
+> samePitch ch1 ch2 =
+> let invs = take (length ch1) (iterate pitchInvert ch1)
+> in ch2 `elem` invs
+>
+> sameInterval ch1 ch2 =
+> let invs = take (length ch1) (iterate intervalInvert ch1)
+> in ch2 `elem` invs
+
+\end{haskelllisting}
+For example, \code{samePitch [0,4,7] [0,5,9]} returns \code{True}
+(since \code{[0,5,9]} is the pitch normal form for the second inversion
+of \code{[0,4,7]}).
+
+
+Here we provide a list of some common types of chords.
+
+%\begin{figure}
+\begin{haskelllisting}
+
+> majorInt, minorInt, majorSeventhInt, minorSeventhInt,
+> dominantSeventhInt, minorMajorSeventhInt,
+> sustainedFourthInt :: [Pitch.Relative]
+
+> majorInt = [I.unison, I.majorThird, I.fifth]
+> minorInt = [I.unison, I.minorThird, I.fifth]
+
+> majorSeventhInt = [I.unison, I.majorThird, I.fifth, I.majorSeventh]
+> minorSeventhInt = [I.unison, I.minorThird, I.fifth, I.minorSeventh]
+> dominantSeventhInt = [I.unison, I.majorThird, I.fifth, I.minorSeventh]
+> minorMajorSeventhInt = [I.unison, I.minorThird, I.fifth, I.majorSeventh]
+
+> sustainedFourthInt = [I.unison, I.fourth, I.fifth]
+
+> type Inversion = Int
+
+> fromIntervals ::
+> [Pitch.Relative] -> Inversion -> Music.T note -> [Music.T note]
+> fromIntervals int inv m =
+> let err = error ("Chord.fromInterval: inversion number "
+> ++ show inv ++ " too large")
+> in map (flip Music.transpose m) (zipWith const
+> (drop inv (init (int ++ map (12+) int) ++ repeat err)) int)
+
+> major, minor, majorSeventh, minorSeventh, dominantSeventh,
+> minorMajorSeventh, sustainedFourth ::
+> Inversion -> Music.T note -> [Music.T note]
+
+> major = fromIntervals majorInt
+> minor = fromIntervals minorInt
+
+> majorSeventh = fromIntervals majorSeventhInt
+> minorSeventh = fromIntervals minorSeventhInt
+> dominantSeventh = fromIntervals dominantSeventhInt
+> minorMajorSeventh = fromIntervals minorMajorSeventhInt
+
+> sustainedFourth = fromIntervals sustainedFourthInt
+
+\end{haskelllisting}
+%\caption{Common chords.}
+%\figlabel{chords}
+%\end{figure}
+
+We want to offer a special service:
+The computer shall find out inversions for chords in a sequence
+such that the overall pitch does not vary so much.
+
+A very simple approach is to compute the ``center'' of a chord,
+that is the average of all pitches.
+We do now try to keep the center as close as possible to an overall trend.
+This is especially easy because for a chord of $n$ notes
+the change to the next inversion
+moves the center of the chord by $\frac{12}{n}$ tones.
+
+The function gets the inversion of the first and the last chord and
+the list of chords represented by the base note and
+the intervals of all notes of the chord.
+\begin{haskelllisting}
+
+> data Generic attr = Generic {
+> genericPitchClass :: Pitch.Class,
+> genericIntervals :: T,
+> genericDur :: Music.Dur,
+> genericAttr :: attr}
+>
+> type Boundary = (Pitch.T, Pitch.T)
+>
+> generic :: Pitch.Class -> T -> Music.Dur -> attr -> Generic attr
+> generic = Generic
+>
+> leastVaryingInversions ::
+> Boundary -> [Generic attr] -> [[Melody.T attr]]
+> leastVaryingInversions (begin,end) gs =
+> let beginCenter = fromIntegral (Pitch.toInt begin)
+> endCenter = fromIntegral (Pitch.toInt end)
+> steep = (endCenter - beginCenter) / (genericLength gs - 1)
+> trend = map (\k -> beginCenter + steep * fromIntegral k)
+> [0 .. (length gs - 1)]
+> invs = zipWith
+> (\g t -> round (matchingInversion g t))
+> gs trend
+> in zipWith genericToNotes invs gs
+>
+> inversionIncrement :: T -> Double
+> inversionIncrement ps = 12 / genericLength ps
+>
+> matchingInversion :: Generic attr -> Double -> Double
+> matchingInversion g dst =
+> let c = chordCenter g
+> inc = inversionIncrement (genericIntervals g)
+> in (dst-c)/inc
+>
+> mean :: [Pitch.Relative] -> Double
+> mean ps = sum (map fromIntegral ps) / genericLength ps
+>
+> chordCenter :: Generic attr -> Double
+> chordCenter (Generic pc ps _ _) =
+> fromIntegral (Pitch.classToInt pc) + mean ps
+>
+> boundaryCenter :: (Pitch.Octave,Inversion) -> Generic attr -> Double
+> boundaryCenter (oct,inv) g =
+> 12 * fromIntegral oct + chordCenter g +
+> fromIntegral inv * inversionIncrement (genericIntervals g)
+>
+> invert :: Inversion -> T -> T
+> invert inv ps =
+> let (q,r) = divMod inv (length ps)
+> in zipWith (+) ps
+> (replicate r (12*(q+1)) ++ repeat (12*q))
+>
+> genericToNotes :: Inversion -> Generic attr -> [Melody.T attr]
+> genericToNotes inv (Generic pc ps dur attr) =
+> map (\t -> Melody.note (Pitch.transpose t (0,pc)) dur attr)
+> (invert inv ps)
+
+\end{haskelllisting}
+
+A more complicated algorithm will also work for other definitions of variation.
+We compute the mean pitch for every chord
+and minimize the variation of the pitch.
+The variation is defined here
+as the sum of the squared differences of successive chords.
+
+This leads to a shortest ways search in a graph
+where each inversion of a chord is a node
+and each possible neighbourhood of inversions is an edge.
+The nodes for the inversions of a chord
+and the nodes for the inversions of the succeeding chord
+build a complete bi-partite graph.
+
+First we write a shortest ways search algorithm
+that is specialised to our problem.
+In each step we process one chord.
+We construct a list of inversions,
+where each inversion is associated
+with the optimal way from the beginning chord to this inversion
+and its variation.
+This list passed to the processing of the next chord.
+For reasons of simplicity we process the list backwards.
+
+The inputs of the algorithm are a distance function
+and the list of concurrent inversions for each chord.
+The first element of the list contains all starting inversions,
+the last element contains all ending inversions.
+If you want a definitive start and end inversion,
+use one-element lists.
+The output is the list of the optimal inversion for each chord.
+More precisely it is a list of all optimal ways,
+where for each starting inversion there is one optimal way
+to the closest ending inversion.
+\begin{haskelllisting}
+
+> shortestWays :: (Num b, Ord b) =>
+> (a -> a -> b) -> [[a]] -> [(b,[a])]
+> shortestWays dist =
+> foldrf (processZone dist) (map (\x->(0,[x])))
+
+> processZone :: (Num b, Ord b) =>
+> (a -> a -> b) -> [a] -> [(b,[a])] -> [(b,[a])]
+> processZone dist srcs ways =
+> let distToWay src (d,dst:_) = d + dist src dst
+> distToWay _ (_,[]) =
+> error "processZone: list is never empty if called from shortestWays"
+> in map (\src -> minimumKey fst
+> (map (\way -> (distToWay src way, src : snd way)) ways)) srcs
+
+> propShortestWays :: Int -> Int -> Bool
+> propShortestWays n k =
+> let sws = shortestWays (\x y -> (x-y)^(2::Int))
+> (replicate n [0..(n*k)] ++ [[0]])
+> in head sws == (0, replicate (n+1) 0) &&
+> last sws == (n*k^(2::Int), reverse [0,k..n*k])
+
+\end{haskelllisting}
+
+This routine could be made more efficient
+because the centers of the chords with different inversions are equidistant.
+
+\begin{haskelllisting}
+
+> leastVaryingInversionsSW ::
+> Boundary -> [Generic attr] -> [[Melody.T attr]]
+> leastVaryingInversionsSW bnd gs =
+> let dist (_,c0) (_,c1) = (c0-c1)^(2::Int)
+> [(_,invs)] =
+> shortestWays dist
+> (inversionCenters bnd gs)
+> in zipWith (\(inv,_) -> genericToNotes inv) invs gs
+>
+> inversionCenters :: Boundary -> [Generic attr] -> [[(Inversion,Double)]]
+> inversionCenters (begin,end) gs =
+> let margin = 7
+> beginCenter = fromIntegral (Pitch.toInt begin)
+> endCenter = fromIntegral (Pitch.toInt end)
+> lower = min beginCenter endCenter - margin
+> upper = max beginCenter endCenter + margin
+> inversions g =
+> let c = chordCenter g
+> inc = inversionIncrement (genericIntervals g)
+> invs :: [Inversion]
+> invs = [floor ((lower-c)/inc) ..
+> ceiling ((upper-c)/inc)]
+> in map (\inv -> (inv, c + inc * fromIntegral inv)) invs
+> boundInv g center =
+> (round (matchingInversion g center), center)
+> in [[boundInv (head gs) beginCenter]] ++
+> map inversions (tail (init gs)) ++
+> [[boundInv (last gs) endCenter]]
+
+\end{haskelllisting}
+
+
+
+Now two helper functions for creating a harmonic and a melodic chord,
+that is chords of notes of the same length
+in sequentially or simultaneously.
+
+\begin{haskelllisting}
+
+> melodicGen, harmonicGen :: attr -> Music.Dur ->
+> [Music.Dur -> attr -> Melody.T attr] -> Melody.T attr
+> melodicGen attr d = Music.line . map (\n -> n d attr)
+> harmonicGen attr d = Music.chord . map (\n -> n d attr)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Composition/ChordType.lhs b/src/Haskore/Composition/ChordType.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Composition/ChordType.lhs
@@ -0,0 +1,217 @@
+
+\begin{haskelllisting}
+
+> module Haskore.Composition.ChordType
+> (T, toChord, parse, fromString, toString) where
+>
+> import qualified Haskore.Composition.Chord as Chord
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Text.ParserCombinators.ReadP as ReadP
+> import Text.ParserCombinators.ReadP (ReadP)
+> import qualified Data.Array as Array
+> import Data.Array(Array,Ix,(!))
+> import Haskore.General.Utility(mapSnd)
+> import Control.Monad(liftM2,liftM3)
+
+\end{haskelllisting}
+
+% http://www.geocities.com/melatefet/chordsr.htm
+
+\begin{haskelllisting}
+
+> data T = Cons Third Fourth [Fifth]
+> deriving (Show, Eq)
+>
+> toChord :: T -> Chord.T
+> toChord (Cons third fourth fifth) =
+> scanl (\p (rel,rp) -> if rel then p+rp else rp) 0
+> (foldl (flip fifthToSteps)
+> (fourthToSteps third fourth
+> (thirdToSteps third)) fifth)
+
+> thirdToSteps :: Third -> [Pitch.Relative]
+> thirdToSteps third =
+> case third of
+> ThirdMajor -> [4,3]
+> ThirdAugmentedFifth -> [4,4]
+> ThirdDiminishedFifth -> [4,2]
+> ThirdMinor -> [3,4]
+> ThirdMinorAugmentedFifth -> [3,5]
+> ThirdMinorDiminishedFifth -> [3,3]
+> ThirdDiminished -> [3,3]
+> ThirdSustained2 -> [2,5]
+> ThirdSustained4 -> [5,2]
+> ThirdDiminishedAugmented -> [3,3,3]
+
+> absP, relP :: Pitch.Relative -> (Bool,Pitch.Relative)
+> absP = (,) False
+> relP = (,) True
+
+> fourthToSteps ::
+> Third -> Fourth -> [Pitch.Relative] -> [(Bool,Pitch.Relative)]
+> -- (True,p) - p relative pitch to the previous note in the chord
+> -- (False,p) - p absolute pitch
+> fourthToSteps third fourth ps =
+> let bps = map relP ps
+> in case fourth of
+> FourthNone -> bps
+> FourthSecond -> bps++[absP 2]
+> FourthSixth -> bps++[absP 9]
+> FourthSixthNineth -> bps++[absP 9, relP 5]
+> FourthSeventh ->
+> if third==ThirdDiminished
+> then bps++[relP 3]
+> else bps++[absP 10]
+> FourthMajorSeventh -> bps++[absP 11]
+> FourthNineth -> bps++[relP 10, absP 2]
+> FourthMajorNineth -> bps++[absP 11, relP 3]
+> FourthEleventh -> [absP 7, relP 3, relP 4, absP 5]
+> FourthThirteenth -> [absP (head ps), relP 5, absP 2, absP 10]
+
+> updateNode :: Int -> a -> (a -> a) -> [a] -> [a]
+> updateNode n deflt f xs =
+> let (x0,x1) = splitAt n xs
+> in x0 ++ case x1 of
+> [] -> [f deflt]
+> (y:ys) -> f y : ys
+
+> incPitch :: Int -> Pitch.Relative -> Pitch.Relative ->
+> [(Bool,Pitch.Relative)] -> [(Bool,Pitch.Relative)]
+> incPitch n deflt inc =
+> updateNode n (False,deflt) (mapSnd (inc+))
+
+> fifthToSteps :: Fifth -> [(Bool,Pitch.Relative)] -> [(Bool,Pitch.Relative)]
+> fifthToSteps fifth =
+> case fifth of
+> FifthAugmentedThird -> incPitch 0 undefined 1 .
+> incPitch 1 undefined (-1)
+> FifthDiminishedFifth -> incPitch 1 undefined (-1)
+> FifthAugmentedFifth -> incPitch 1 undefined 1
+> FifthMajorSeventh -> incPitch 2 10 1
+> FifthMinorNineth -> incPitch 3 14 (-1)
+> FifthMajorNineth -> incPitch 3 14 1
+> FifthAugmentedEleventh -> incPitch 3 17 1
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> data Third =
+> ThirdMajor
+> | ThirdAugmentedFifth
+> | ThirdDiminishedFifth
+> | ThirdMinor
+> | ThirdMinorAugmentedFifth
+> | ThirdMinorDiminishedFifth
+> | ThirdDiminished
+> | ThirdSustained2
+> | ThirdSustained4
+> | ThirdDiminishedAugmented
+> deriving (Show, Eq, Ord, Ix)
+>
+> data Fourth =
+> FourthNone
+> | FourthSecond
+> | FourthSixth
+> | FourthSixthNineth
+> | FourthSeventh
+> | FourthMajorSeventh
+> | FourthNineth
+> | FourthMajorNineth
+> | FourthEleventh
+> | FourthThirteenth
+> deriving (Show, Eq, Ord, Ix)
+>
+> data Fifth =
+> FifthAugmentedThird
+> | FifthDiminishedFifth
+> | FifthAugmentedFifth
+> | FifthMajorSeventh
+> | FifthMinorNineth
+> | FifthMajorNineth
+> | FifthAugmentedEleventh
+> deriving (Show, Eq, Ord, Ix)
+>
+> toString :: T -> String
+> toString (Cons third fourth fifthList) =
+> thirdsArray!third ++
+> fourthsArray!fourth ++
+> concatMap (fifthsArray!) fifthList
+>
+> intervalToArray :: (Ix a) => [(a,[String])] -> Array a String
+> intervalToArray xs =
+> Array.array (fst (head xs), fst (last xs))
+> (map (mapSnd head) xs)
+>
+> thirdsArray :: Array Third String
+> thirdsArray = intervalToArray thirds
+>
+> fourthsArray :: Array Fourth String
+> fourthsArray = intervalToArray fourths
+>
+> fifthsArray :: Array Fifth String
+> fifthsArray = intervalToArray fifths
+>
+> fromString :: String -> T
+> fromString =
+> fst . head . filter (null . snd) . ReadP.readP_to_S parse
+>
+> -- copy of GHC-6.4's ReadP.many function
+> readPmany :: ReadP a -> ReadP [a]
+> readPmany p = return [] ReadP.+++ liftM2 (:) p (readPmany p)
+>
+> parse :: ReadP T
+> parse =
+> liftM3 Cons
+> (parseInterval thirds)
+> (parseInterval fourths)
+> (readPmany (parseInterval fifths))
+>
+> parseInterval :: [(a,[String])] -> ReadP a
+> parseInterval =
+> ReadP.choice . map (uncurry parseIntervalAlternatives)
+>
+> parseIntervalAlternatives :: a -> [String] -> ReadP a
+> parseIntervalAlternatives x sym =
+> ReadP.choice (map ReadP.string sym) >> return x
+>
+> thirds :: [(Third,[String])]
+> thirds = [
+> (ThirdMajor, ["", "maj"]),
+> (ThirdAugmentedFifth, ["+", "aug"]),
+> (ThirdDiminishedFifth, ["-"]),
+> (ThirdMinor, ["m"]),
+> (ThirdMinorAugmentedFifth, ["m+"]),
+> (ThirdMinorDiminishedFifth, ["m-"]),
+> (ThirdDiminished, ["0", "dim"]),
+> (ThirdSustained2, ["sus2"]),
+> (ThirdSustained4, ["sus4", "4"]),
+> (ThirdDiminishedAugmented, ["0+"])
+> ]
+
+> fourths :: [(Fourth,[String])]
+> fourths = [
+> (FourthNone, [""]),
+> (FourthSecond, ["2"]),
+> (FourthSixth, ["6"]),
+> (FourthSixthNineth, ["6/9"]),
+> (FourthSeventh, ["7"]),
+> (FourthMajorSeventh, ["M7", "Ma7"]), -- "maj7" collides with "maj"++"7"
+> (FourthNineth, ["9"]),
+> (FourthMajorNineth, ["M9"]),
+> (FourthEleventh, ["11"]),
+> (FourthThirteenth, ["13"])
+> ]
+
+> fifths :: [(Fifth,[String])]
+> fifths = [
+> (FifthAugmentedThird, ["3+"]),
+> (FifthDiminishedFifth, ["-5", "5-"]),
+> (FifthAugmentedFifth, ["+5", "5+", "-6", "6-"]),
+> (FifthMajorSeventh, ["7+"]),
+> (FifthMinorNineth, ["-9"]),
+> (FifthMajorNineth, ["+9"]),
+> (FifthAugmentedEleventh, ["+11"])
+> ]
+
+\end{haskelllisting}
diff --git a/src/Haskore/Composition/Drum.lhs b/src/Haskore/Composition/Drum.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Composition/Drum.lhs
@@ -0,0 +1,101 @@
+\subsubsection{Percussion}
+
+Percussion is a difficult notion to represent in the abstract, since
+in a way, a percussion instrument is just another instrument, so why
+should it be treated differently? On the other hand, even common
+practice notation treats it specially, even though it has much in
+common with non-percussive notation. The midi standard is equally
+ambiguous about the treatment of percussion: on one hand, percussion
+sounds are chosen by specifying an octave and pitch, just like any
+other instrument, on the other hand these notes have no tonal meaning
+whatsoever: they are just a convenient way to select from a large
+number of percussion sounds. Indeed, part of the General Midi
+Standard is a set of names for commonly used percussion sounds.
+
+\begin{haskelllisting}
+
+> module Haskore.Composition.Drum
+> (T, GM.Drum(..), Element(..), na,
+> toMusic, toMusicDefaultAttr,
+> lineToMusic, elementToMusic, funkGroove) where
+
+> import Haskore.Composition.Trill
+> import qualified Haskore.Basic.Duration as Duration
+> import Haskore.Basic.Duration (qn, en, )
+> import Haskore.Music (qnr, enr, (=:=), changeTempo, rest, line)
+> import Haskore.Melody.Standard (NoteAttributes, na, )
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Sound.MIDI.General as GM
+
+> type T = GM.Drum
+
+\end{haskelllisting}
+
+Since Midi is such a popular platform, we can at least define some
+handy functions for using the General Midi Standard. We start by
+defining the datatype shown in \figref{percussion}, which
+borrows its constructor names from the General Midi standard. The
+comments reflecting the ``Midi Key'' numbers will be explained later,
+but basically a Midi Key is the equivalent of an absolute pitch in
+Haskore terminology.
+We will not adapt the MIDI treatment of drums in Haskore
+since it makes no sense,
+e.g. to transpose drums by increasing the key number.
+Thus we defined a special constructor for drums in \type{RhyMusic.T}.
+We will now give a function which constructs a \type{RhyMusic.T}
+for a given value specifying a drum:
+\begin{haskelllisting}
+
+> toMusic :: drum -> Duration.T -> NoteAttributes -> RhyMusic.T drum instr
+> toMusic drm dr nas =
+> Music.atom dr (Just (RhyMusic.noteFromAttrs nas (RhyMusic.Drum drm)))
+
+> toMusicDefaultAttr ::
+> drum -> Duration.T -> RhyMusic.T drum instr
+> toMusicDefaultAttr drm dr = toMusic drm dr na
+
+\end{haskelllisting}
+
+For example, here are eight bars of a simple rock or ``funk groove''
+that uses \function{Drum.toMusic} and \function{Drum.roll}:
+\begin{haskelllisting}
+
+> funkGroove :: MidiMusic.T
+> funkGroove =
+> let p1 = toMusic GM.LowTom qn na
+> p2 = toMusic GM.AcousticSnare en na
+> in changeTempo 3 (Music.take 8 (Music.repeat
+> ( (Music.line [p1, qnr, p2, qnr, p2,
+> p1, p1, qnr, p2, enr])
+> =:= roll en (toMusic GM.ClosedHiHat 2 na) )
+> ))
+
+\end{haskelllisting}
+
+We can go one step further by defining
+our own little ``percussion datatype'':
+\begin{haskelllisting}
+
+> data Element =
+> R Duration.T -- rest
+> | N Duration.T NoteAttributes -- note
+> | Roll Duration.T Duration.T NoteAttributes -- roll w/duration
+> | Rolln Integer Duration.T NoteAttributes -- roll w/number of strokes
+>
+> lineToMusic :: T -> [Element] -> MidiMusic.T
+> lineToMusic dsnd =
+> Music.line . map (elementToMusic dsnd)
+
+> elementToMusic :: T -> Element -> MidiMusic.T
+> elementToMusic dsnd el =
+> let drum = toMusic dsnd
+> in case el of
+> R dur -> rest dur
+> N dur nas -> drum dur nas
+> Roll sDur dur nas -> roll sDur (drum dur nas)
+> Rolln nTimes dur nas -> rollN nTimes (drum dur nas)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Composition/Rhythm.lhs b/src/Haskore/Composition/Rhythm.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Composition/Rhythm.lhs
@@ -0,0 +1,216 @@
+% from AutoTrack by Stefan Ratschan
+
+\section{Rhythm}
+
+\begin{haskelllisting}
+
+> module Haskore.Composition.Rhythm where
+>
+> import qualified Haskore.Composition.Drum as Drum
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import Haskore.Basic.Duration (qn, en, sn, (%+), )
+> import Haskore.General.Utility(zapWith, select)
+> import Data.Char(isSpace)
+
+\end{haskelllisting}
+
+There are many different possibilities for dealing with the notion of rhythm.
+Some of them are:
+
+\begin{itemize}
+\item Modeling it as a succession of notes and rests of equal length
+\item Allowing notes and rests to be of different (integer or rational) lengths
+\item Dealing with rhythm on the level of the \texttt{RhyMusic.T} data type, without any
+ special data type for modeling rhythm
+\end{itemize}
+
+We will use the first possibility here. The third possibility has been used in
+Martin Schwenke's \texttt{DrumMachine} module.
+
+As explained above we think of rhythm as a succession of notes and rests of
+equal length. For this we use lists of booleans, where \texttt{True} means that
+a note is played, and \texttt{False} means that no note is played (i.e. a
+rest).
+
+\begin{haskelllisting}
+
+> type T = [ Bool ]
+
+\end{haskelllisting}
+
+By default the basic rhythmical unit is one sixteenth note. The \texttt{Rhythm.T}
+data-type does not depend on this, it only comes into the game when we convert
+rhythms to music.
+
+\begin{haskelllisting}
+
+> unit :: Music.Dur
+> unit = sn
+
+\end{haskelllisting}
+
+We provide two ways of creating rhythms:
+
+\begin{itemize}
+\item From strings, where an 'x' means that some note is played at this place, and any
+ other character means that no note is played, while white spaces are ignored.
+\item From ordered lists of integers, where every integer means that at the place with
+ this number we have a note (the first place is zero). On all the other places we have
+ rests.
+\end{itemize}
+
+\begin{haskelllisting}
+
+> fromString :: String -> T
+> fromString = map ('x'==) . filter (not . isSpace)
+
+> fromPositions :: [ Int ] -> T
+> fromPositions l =
+> let hitAfter x = replicate (x-1) False ++ [ True ]
+> checkPos d =
+> if d>0
+> then d
+> else error ("fromPositions: list of time events must increase strictly monotonously")
+> in concatMap hitAfter (zapWith ((checkPos .) . subtract) ((-1):l))
+
+\end{haskelllisting}
+
+Now we want to convert rhythms to music.
+We do this using two data types,
+which one can immediately convert to music via function application.
+
+\begin{haskelllisting}
+
+> type ToMusicWithMusic drum instr = RhyMusic.T drum instr -> T -> RhyMusic.T drum instr
+> type ToMusicWithDrum drum instr = drum -> T -> RhyMusic.T drum instr
+
+> toMusicWithMusic :: ToMusicWithMusic drum instr
+> toMusicWithMusic m r =
+> let play b = if b then m else Music.rest (Music.dur m)
+> in Music.line (map play r)
+
+> toMusicWithDrum :: ToMusicWithDrum drum instr
+> toMusicWithDrum = toMusicWithDrumUnit unit
+
+\end{haskelllisting}
+
+Sometimes we also want to specify a basic rhythmical unit which is different from the
+default one.
+
+\begin{haskelllisting}
+
+> toMusicWithDrumUnit :: Music.Dur -> ToMusicWithDrum drum instr
+> toMusicWithDrumUnit d p = toMusicWithMusic (Drum.toMusic p d Drum.na)
+
+\end{haskelllisting}
+
+Finally one can also create shuffled music from rhythms.
+
+\begin{haskelllisting}
+
+> toShuffledMusicWithDrum :: ToMusicWithDrum drum instr
+> toShuffledMusicWithDrum = toShuffledMusicWithDrumUnit unit
+
+> toShuffledMusicWithDrumUnit :: Music.Dur -> ToMusicWithDrum drum instr
+> toShuffledMusicWithDrumUnit d p r =
+> let stretch = 1%+3
+> dstr = Dur.scale (1+stretch) d
+> dcompr = Dur.scale (1-stretch) d
+> play b =
+> if b
+> then flip (Drum.toMusic p) Drum.na
+> else Music.rest
+> in Music.line (zipWith play r (cycle [dstr, dcompr]))
+
+\end{haskelllisting}
+
+Some basic rhythms:
+
+\begin{haskelllisting}
+
+> tickR, downBeatR, backBeatR, claveR, claveRumbaR,
+> claveBossaR, clave5, clave7, jazzRideR,
+> jazzWaltzRideR, jazzWaltzHiHatR :: T
+
+> tickR = fromString "x"
+
+> downBeatR = fromString "x."
+> backBeatR = fromString ".x"
+
+> claveR = fromString "x..x..x. ..x.x..."
+
+> claveRumbaR = fromString "x..x...x ..x.x..."
+
+> claveBossaR = fromString "x..x..x. ..x..x.."
+
+> clave5 = fromString "..x.x"
+
+> clave7 = fromString ".x.x..x"
+
+> jazzRideR = fromString "x.xx"
+
+> jazzWaltzRideR = fromString "x.xxx."
+> jazzWaltzHiHatR = fromString "..x"
+
+> countInR :: Music.Dur -> T
+> countInR d =
+> select (error "countIn not defined for this measure")
+> [(d == 4%+4, fromString "x.x.xxxx"),
+> (d == 5%+4, fromString "x..x.xxxxx"),
+> (Dur.divisible d qn,
+> let b = fromInteger (Dur.divide d qn)
+> in True : replicate (b-1) False ++ replicate b True)]
+
+\end{haskelllisting}
+
+In one more step in the conversion to music we fix the basic rhythmical unit and shuffle/straight.
+
+\begin{haskelllisting}
+
+> tickP, claveP, claveRumbaP, claveBossaP, jazzRideP,
+> jazzWaltzRideP, jazzWaltzHiHatP, downBeatP,
+> backBeatP :: drum -> RhyMusic.T drum instr
+
+> tickP = flip (toMusicWithDrumUnit en) tickR
+> claveP = flip (toMusicWithDrumUnit en) claveR
+> claveRumbaP = flip (toMusicWithDrumUnit en) claveRumbaR
+> claveBossaP = flip (toMusicWithDrumUnit en) claveBossaR
+
+> jazzRideP = flip (toShuffledMusicWithDrumUnit en) jazzRideR
+
+> jazzWaltzRideP = flip (toShuffledMusicWithDrumUnit en) jazzWaltzRideR
+> jazzWaltzHiHatP = flip (toMusicWithDrumUnit qn) jazzWaltzHiHatR
+
+> downBeatP = flip (toMusicWithDrumUnit qn) downBeatR
+> backBeatP = flip (toMusicWithDrumUnit qn) backBeatR
+
+\end{haskelllisting}
+
+And now we assign these rhythms to instruments.
+
+\begin{haskelllisting}
+
+> click, clave, claveRumba, claveBossa, metro5, metro7,
+> basicBassDrum, basicSnare, basicHiHat, ride :: MidiMusic.T
+
+> click = Music.repeat (tickP Drum.Claves)
+
+> clave = claveP Drum.Claves
+> claveRumba = claveRumbaP Drum.Claves
+> claveBossa = claveBossaP Drum.Claves
+
+> metro5 = toMusicWithDrumUnit qn Drum.Claves (cycle clave5)
+> metro7 = toMusicWithDrumUnit qn Drum.Claves (cycle clave7)
+
+> basicBassDrum = downBeatP Drum.AcousticBassDrum
+> basicSnare = backBeatP Drum.AcousticSnare
+> basicHiHat = tickP Drum.ClosedHiHat
+> ride = tickP Drum.RideCymbal2
+
+> countIn :: Music.Dur -> MidiMusic.T
+> countIn m = toMusicWithDrumUnit qn Drum.Claves (countInR m)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Composition/Trill.lhs b/src/Haskore/Composition/Trill.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Composition/Trill.lhs
@@ -0,0 +1,83 @@
+\subsubsection{Trills}
+
+\begin{haskelllisting}
+
+> module Haskore.Composition.Trill where
+>
+> import qualified Haskore.Music as Music
+
+\end{haskelllisting}
+
+A \keyword{trill} is an ornament that alternates rapidly between two (usually
+adjacent) pitches. Let's implement a trill as a function that take a note as
+an argument and returns a series of notes whose durations add up to the same
+duration as as the given note.
+
+A trill alternates between the given note and another note, usually the note
+above it in the scale. Therefore, it must know what other note to use. So
+that the structure of \function{trill} remains parallel across different keys, we'll
+implement the other note in terms of its interval from the given note in half
+steps. Usually, the note is either a half-step above (interval = 1) or a
+whole-step above (interval = 2). Using negative numbers, a trill that goes to
+lower notes can even be implemented.
+
+Also, the trill needs to know how fast to alternate between the two notes.
+One way is simply to specify the type of smaller note to use.
+(Another implementation will be discussed later.)
+So, our \function{trill} has the following type:
+\begin{haskelllisting}
+
+> trill :: Int -> Music.Dur -> Music.T note -> Music.T note
+
+\end{haskelllisting}
+Its implementation:
+\begin{haskelllisting}
+
+> trill i d m =
+> let atom = Music.take d m
+> in Music.line (Music.takeLine (Music.dur m)
+> (cycle [atom, Music.transpose i atom]))
+
+\end{haskelllisting}
+Since the function uses \function{Music.tranpose}
+one can even trill more complex objects like chords.
+
+The next version of \function{trill} starts on the second note,
+rather than the given note.
+It is simple to define a function that starts on the other note:
+\begin{haskelllisting}
+
+> trill' :: Int -> Music.Dur -> Music.T note -> Music.T note
+> trill' i sDur m =
+> trill (negate i) sDur (Music.transpose i m)
+
+\end{haskelllisting}
+Another way to define a trill is in terms of the number of subdivided notes
+to be included in the trill.
+\begin{haskelllisting}
+
+> trillN :: Int -> Integer -> Music.T note -> Music.T note
+> trillN i nTimes m =
+> trill i (Music.dur m / fromIntegral nTimes) m
+
+\end{haskelllisting}
+This, too, can be made to start on the other note.
+\begin{haskelllisting}
+
+> trillN' :: Int -> Integer -> Music.T note -> Music.T note
+> trillN' i nTimes m =
+> trillN (negate i) nTimes (Music.transpose i m)
+
+\end{haskelllisting}
+
+Finally, a \function{roll} can be implemented as a trill whose interval is
+zero. This feature is particularly useful for percussion.
+\begin{haskelllisting}
+
+> roll :: Music.Dur -> Music.T note -> Music.T note
+> rollN :: Integer -> Music.T note -> Music.T note
+>
+> roll d = trill 0 d
+> rollN nTimes = trillN 0 nTimes
+
+\end{haskelllisting}
diff --git a/src/Haskore/Example/BesondrerTag.hs b/src/Haskore/Example/BesondrerTag.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/BesondrerTag.hs
@@ -0,0 +1,39 @@
+module Haskore.Example.BesondrerTag where
+
+import Haskore.Melody.Standard as Melody
+import Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music as Music
+
+
+noAttr :: [Melody.NoteAttributes -> Melody.T] -> Melody.T
+noAttr = line . map ($ na)
+
+bar0, bar1, bass0, bass1 :: Melody.T
+bar0 = noAttr $
+ [b 0 qn, g 0 qn, a 0 qn, d 1 en, c 1 en, b 0 qn, a 0 en, g 0 en, a 0 hn,
+ g 0 dqn, fs 0 en, e 0 en, fs 0 en, g 0 qn, a 0 qn, b 0 qn, a 0 hn, g 0 hn]
+
+bass0 = noAttr $
+ [g 1 hn, d 1 hn, e 1 hn, d 1 hn, e 1 hn, c 1 hn, d 1 hn, d 1 hn, g 1 hn,
+ g 1 hn, fs 1 hn, e 1 hn, d 1 hn, b 0 hn, c 1 hn, cs 1 hn, d 1 hn, g 1 hn]
+
+bar1 = noAttr $
+ [d 0 dqn, d 0 en, e 0 qn, fs 0 qn, g 0 qn, a 0 en, g 0 en, fs 0 qn, d 0 qn,
+ g 0 dqn, g 0 en, a 0 qn, b 0 qn, c 1 qn, b 0 qn, a 0 hn, g 0 hn]
+
+bass1 = noAttr $
+ [d 1 hn, c 1 qn, a 0 qn, e 1 qn, cs 1 qn, d 1 qn, c 1 qn,
+ b 0 hn, c 1 qn, cs 1 qn, d 1 hn, d 1 hn, g 1 hn]
+
+
+melody :: Melody.T
+melody = Music.replicate 2 bar0 +:+ bar1
+
+bass :: Melody.T
+bass = bass0 +:+ bass1
+
+song :: MidiMusic.T
+song =
+ changeTempo 2
+ (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano (transpose ( 24) melody) =:=
+ MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose (-12) bass))
diff --git a/src/Haskore/Example/ChildSong6.lhs b/src/Haskore/Example/ChildSong6.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/ChildSong6.lhs
@@ -0,0 +1,90 @@
+\subsection{Children's Song No. 6}
+\seclabel{chick}
+
+This is a partial encoding of Chick Corea's ``Children's Song No. 6''.
+
+\begin{haskelllisting}
+
+> module Haskore.Example.ChildSong6 where
+
+> import Haskore.Melody.Standard as Melody
+> import Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music as Music
+
+\end{haskelllisting}
+
+note updaters for mappings
+
+\begin{haskelllisting}
+
+> fd :: t -> (t -> NoteAttributes -> m) -> m
+> fd dur n = n dur v
+>
+> vel :: (NoteAttributes -> m) -> m
+> vel n = n v
+>
+> v :: NoteAttributes
+> v = Melody.na
+>
+> lmap :: (a -> Melody.T) -> [a] -> Melody.T
+> lmap func l = line (map func l)
+>
+>
+> bassLine, mainVoice :: Melody.T
+> song :: MidiMusic.T
+
+\end{haskelllisting}
+
+Baseline:
+
+\begin{haskelllisting}
+
+> b1, b2, b3 :: Melody.T
+> b1 = lmap (fd dqn) [b 3, fs 4, g 4, fs 4]
+> b2 = lmap (fd dqn) [b 3, es 4, fs 4, es 4]
+> b3 = lmap (fd dqn) [as 3, fs 4, g 4, fs 4]
+>
+> bassLine =
+> Music.loudness1 (10/13)
+> (line [Music.replicate 3 b1, Music.replicate 2 b2,
+> Music.replicate 4 b3, Music.replicate 5 b1])
+
+\end{haskelllisting}
+
+Main Voice:
+
+\begin{haskelllisting}
+
+> v1, v1a, v1b :: Melody.T
+> v1 = v1a +:+ v1b
+> v1a = lmap (fd en) [a 5, e 5, d 5, fs 5, cs 5, b 4, e 5, b 4]
+> v1b = lmap vel [cs 5 tn, d 5 (qn-tn), cs 5 en, b 4 en]
+>
+> v2, v2a, v2b, v2c, v2d, v2e, v2f :: Melody.T
+> v2 = line [v2a, v2b, v2c, v2d, v2e, v2f]
+> v2a = lmap vel [cs 5 (dhn+dhn), d 5 dhn,
+> f 5 hn, gs 5 qn, fs 5 (hn+en), g 5 en]
+> v2b = lmap (fd en) [fs 5, e 5, cs 5, as 4] +:+ a 4 dqn v +:+
+> lmap (fd en) [as 4, cs 5, fs 5, e 5, fs 5, g 5, as 5]
+> v2c = lmap vel [cs 6 (hn+en), d 6 en, cs 6 en, e 5 en] +:+ enr +:+
+> lmap vel [as 5 en, a 5 en, g 5 en, d 5 qn, c 5 en, cs 5 en]
+> v2d = lmap (fd en) [fs 5, cs 5, e 5, cs 5, a 4, as 4, d 5, e 5, fs 5] +:+
+> lmap vel [fs 5 tn, e 5 (qn-tn), d 5 en, e 5 tn, d 5 (qn-tn),
+> cs 5 en, d 5 tn, cs 5 (qn-tn), b 4 (en+hn)]
+> v2e = lmap vel [cs 5 en, b 4 en, fs 5 en, a 5 en, b 5 (hn+qn), a 5 en,
+> fs 5 en, e 5 qn, d 5 en, fs 5 en, e 5 hn, d 5 hn, fs 5 qn]
+> v2f = changeTempo (3/2) (lmap vel [cs 5 en, d 5 en, cs 5 en]) +:+ b 4 (3*dhn+hn) v
+>
+> mainVoice = Music.replicate 3 v1 +:+ v2
+
+\end{haskelllisting}
+
+Putting it all together:
+
+\begin{haskelllisting}
+
+> song = MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano
+> (transpose (-48) (changeTempo 3
+> (bassLine =:= mainVoice)))
+
+\end{haskelllisting}
diff --git a/src/Haskore/Example/Detail.hs b/src/Haskore/Example/Detail.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Detail.hs
@@ -0,0 +1,93 @@
+{- |
+Create chord patterns with controlable level of details.
+-}
+module Haskore.Example.Detail where
+
+import qualified Haskore.Basic.Pitch as Pitch
+import Haskore.Basic.Pitch (Class(..))
+import qualified Haskore.Melody as Melody
+import qualified Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music as Music
+
+import qualified System.Random as Random
+
+import System.Random (RandomGen, randomR, mkStdGen, )
+import Control.Monad.State (State(State), evalState, )
+
+import Haskore.General.Utility (toMaybe, )
+import qualified Data.List as List
+
+
+
+levels :: [[Pitch.T]]
+levels =
+ ((0,C) : []) :
+ ((0,C) : (1,C) : []) :
+ ((0,C) : (1,C) : (0,G) : []) :
+ ((0,C) : (1,C) : (0,G) : (0,E) : []) :
+ ((0,C) : (1,C) : (0,G) : (0,E) : (0,D) : (0,F) : []) :
+ []
+
+
+{-
+candidate for Utility
+
+cf. Data.MarkovChain.randomItem
+-}
+randomItem :: (RandomGen g) => [a] -> State g a
+randomItem x = fmap (x!!) (randomRState (0, length x - 1))
+
+{- |
+'System.Random.randomR' wrapped in a State monad.
+-}
+randomRState :: (RandomGen g) => (Int,Int) -> State g Int
+randomRState bnds = State (randomR bnds)
+
+
+merge :: [a] -> [a] -> [a]
+merge xs ys =
+ concat (zipWith (\x y -> [x,y]) xs ys)
+
+
+
+dyadicPattern :: [Pitch.T]
+dyadicPattern =
+ foldl1 merge $
+ zipWith
+ (\g level -> flip evalState g (sequence (repeat (randomItem level))))
+ (List.unfoldr (Just . Random.split) (mkStdGen 925)) $
+ levels
+
+
+simpleSong :: MidiMusic.T
+simpleSong =
+ Music.changeTempo 2 $
+ Music.take 10 $
+ MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
+ MidiMusic.line $
+ List.map (\p -> Melody.note p MidiMusic.sn ()) dyadicPattern
+
+
+
+dyadicLevelPattern :: [(Int, Pitch.T)]
+dyadicLevelPattern =
+ foldl1 merge $
+ zipWith3
+ (\g i level -> map ((,) i) $
+ flip evalState g (sequence (repeat (randomItem level))))
+ (List.unfoldr (Just . Random.split) (mkStdGen 925))
+ [0..] $
+ levels
+
+
+song :: MidiMusic.T
+song =
+ Music.changeTempo 2 $
+ MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
+ MidiMusic.line $
+ List.map (maybe MidiMusic.snr (\p -> Melody.note p MidiMusic.sn ())) $
+ List.zipWith
+ (\li (l,p) -> toMaybe (l<=li) p)
+ (concatMap (replicate (2 * 2 ^ length levels)) [0 .. length levels]) $
+ dyadicLevelPattern
+
diff --git a/src/Haskore/Example/Flip.hs b/src/Haskore/Example/Flip.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Flip.hs
@@ -0,0 +1,79 @@
+module Haskore.Example.Flip where
+
+import Haskore.Melody as Melody
+import Haskore.Music.GeneralMIDI as MidiMusic
+
+import Data.Array (Array, (!), listArray)
+import qualified Data.List as List
+
+{-
+ flipSeq 2 !! n = parity of number of 1's in binary representation of n.
+ http://www.research.att.com/cgi-bin/access.cgi/as/njas/sequences/eisA.cgi?Anum=A010060
+-}
+
+flipSeq :: Int -> [Int]
+flipSeq n =
+ let incList m = map (\x -> mod (x+m) n)
+ recurse y = let z = concatMap (flip incList y) [1..(n-1)]
+ in z ++ recurse (y++z)
+ in [0] ++ recurse [0]
+
+{- based on Helmut Podhaisky's implementation
+ it must be flipSeq2 == flipSeq 2 -}
+flipSeq2 :: [Int]
+flipSeq2 =
+ let recurse y = let z = map (1-) y
+ in z ++ recurse (y++z)
+ in [0] ++ recurse [0]
+
+
+noteArray :: [() -> Melody.T ()] -> Array Int (Melody.T ())
+noteArray ns = listArray (0, length ns - 1) (map (\n -> n ()) ns)
+
+makeSong :: [() -> Melody.T ()] -> Melody.T ()
+makeSong ms = line (map (noteArray ms ! )
+ (flipSeq (length ms)))
+
+song, song1, core, core1 :: Melody.T ()
+
+song = changeTempo 8 core
+core = makeSong [e 1 qn, g 1 qn, c 2 qn, e 2 qn]
+
+song1 = changeTempo 8 core1
+core1 =
+ let rep = 16
+ in line $ zipWith (!) (cycle
+ (List.replicate rep (noteArray [e 1 qn, a 1 qn, c 2 qn, e 2 qn]) ++
+ List.replicate rep (noteArray [g 1 qn, c 2 qn, e 2 qn, g 2 qn]) ++
+ List.replicate rep (noteArray [a 1 qn, d 2 qn, f 2 qn, a 2 qn]) ++
+ List.replicate rep (noteArray [a 1 qn, c 2 qn, f 2 qn, a 2 qn]) ++
+ List.replicate rep (noteArray [a 1 qn, c 2 qn, e 2 qn, a 2 qn])))
+ (flipSeq 4)
+
+{-
+ If you divide the stream into blocks of size n
+ each block will contain each of the indices of {0,..,n-1} exactly once.
+ Thus you can also choose musical atoms of different length
+ for generating rythms.
+-}
+song2, core2 :: MidiMusic.T
+song2 = changeTempo 4 core2
+core2 =
+ let rep = 16
+ flipper = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano $
+ line $ zipWith (!) (cycle
+ (List.replicate rep (noteArray [e 1 dqn, a 1 en, c 2 qn, e 2 qn]) ++
+ List.replicate rep (noteArray [g 1 dqn, c 2 en, e 2 qn, g 2 qn]) ++
+ List.replicate rep (noteArray [a 1 dqn, d 2 en, f 2 qn, a 2 qn]) ++
+ List.replicate rep (noteArray [a 1 dqn, c 2 en, f 2 qn, a 2 qn]) ++
+ List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn]) ++
+ List.replicate rep (noteArray [a 1 dqn, c 2 en, e 2 qn, a 2 qn])))
+ (flipSeq 4)
+ bassLine =
+ MidiMusic.fromMelodyNullAttr MidiMusic.Viola $
+ transpose (-12) $ line $ cycle $
+ concatMap (List.replicate 8) $
+ List.map ($ ())
+ [a 0 hn, c 1 hn, d 1 hn,
+ f 1 hn, a 1 hn, a 0 hn]
+ in flipper =:= bassLine
diff --git a/src/Haskore/Example/Fractal.hs b/src/Haskore/Example/Fractal.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Fractal.hs
@@ -0,0 +1,87 @@
+module Haskore.Example.Fractal where
+
+import Prelude hiding (init)
+import System.Random (randomRs, mkStdGen)
+import Data.Array (Array, (!), listArray, bounds)
+
+import qualified Haskore.Basic.Pitch as Pitch
+import qualified Haskore.Music as Music
+import qualified Haskore.Melody as Melody
+import Haskore.Music((+:+))
+
+import qualified Haskore.Basic.Duration as Dur
+
+type Vector a = [a]
+type Matrix a = [Vector a]
+type AT a = Vector a -> Vector a
+type IFS a = Array Int (AT a)
+
+-- First define some general matrix operations.
+-- These will facilitate moving to higher dimensions later.
+
+vadd :: Num a => Vector a -> Vector a -> Vector a
+vadd = zipWith (+)
+
+vvmult :: Num a => Vector a -> Vector a -> a
+vvmult v1 v2 = sum (zipWith (*) v1 v2)
+
+mvmult :: Num a => Matrix a -> Vector a -> Vector a
+mvmult m v = map (vvmult v) m
+
+cvmult :: Num a => a -> Vector a -> Vector a
+cvmult z = map (z*)
+
+---------------------------------------------------------------------
+
+{- The following simulates the Iterated Function System for the
+ Sierpinski Triangle as described in Barnsley's "Desktop Fractal
+ Design Handbook". -}
+
+-- First the affine transformations:
+
+w0, w1, w2 :: Fractional a => AT a
+w0 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
+ `vadd` [8,8,8]
+w1 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
+ `vadd` [30,16,2]
+w2 v = (cvmult 0.01 ([[50,0],[0,50],[50,0]] `mvmult` v))
+ `vadd` [20,40,30]
+
+init0 :: Num a => Vector a
+init0 = [0,0,0]
+
+-- Now we have an Iterated Function System:
+
+ws :: Fractional a => IFS a
+ws = let wl = [w0,w1,w2]
+ in listArray (0, length wl - 1) wl
+
+-- And here is the result:
+
+result :: [Vector Rational]
+result =
+ let ws' = ws -- make it monomorph
+ f init r = (ws'!r) init
+ in scanl f init0 (randomRs (bounds ws') (mkStdGen 215))
+ -- (read "42" :: StdGen)
+
+
+-- where "randomRs" computes a list of random indices in the range 0-2,
+-- which simulates flipping the coin in Barnsley.
+
+--------
+
+mkNote :: [Rational] -> Melody.T ()
+mkNote [a,b,c] =
+ Music.rest (Dur.fromRatio (b/20)) +:+
+ Melody.note (Pitch.fromInt (round a)) (Dur.fromRatio (c/20)) ()
+mkNote _ = error "mkNote: Need three components."
+
+{- Of course, a triple would be the better type
+ but that would complicate the vector computation. -}
+
+sourceToMusic :: [[Rational]] -> Melody.T ()
+sourceToMusic s = Music.chord (map mkNote s)
+
+song :: Melody.T ()
+song = Music.transpose (-12) (sourceToMusic (take 128 result))
diff --git a/src/Haskore/Example/Guitar.lhs b/src/Haskore/Example/Guitar.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Guitar.lhs
@@ -0,0 +1,230 @@
+\subsection{Guitar}
+\seclabel{guitar}
+
+In this section we want to develop a simulation of a guitar.
+This clearly demonstrates the power of our music-by-programming approach.
+After writing some routines for doing the mechanical stuff
+we can describe the music concisely as a sequence of chords.
+
+\begin{haskelllisting}
+
+> module Haskore.Example.Guitar where
+>
+> import qualified Haskore.Basic.Pitch as Pitch
+> import Haskore.Basic.Pitch (Class(..))
+> import qualified Haskore.Basic.Duration as Dur
+> -- import Haskore.Melody.Standard as StdMelody
+> import Haskore.Music.GeneralMIDI as MidiMusic
+> import Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Music as Music
+>
+> import qualified Data.List as List
+
+\end{haskelllisting}
+
+% import qualified Haskore.Performance.Fancy as FancyPerformance
+
+
+On a guitar a chord is not played
+as an immediate sequence of the constituting notes,
+but the order and the number of occurences of each tone
+is adapted to the guitar and the possibilities of the player.
+We want to automatically design a sequence of tones
+that represents a given chord.
+Our approach is simple:
+For every string we choose the lowest possible note
+which occurs in the chord.
+This way we may miss notes of the chord,
+but we have a good approximation.
+If a chord consists of more than six notes,
+we have to ignore some notes definitely.
+
+For given pitches of all guitar strings
+and the pitch classes of a chord,
+\function{mapChordToString}
+compute the tones that are played on each string of the guitar.
+
+\begin{haskelllisting}
+
+> mapChordToString :: [Pitch.T] -> [Pitch.Class] -> [Pitch.T]
+> mapChordToString strs chrd =
+> map (choosePitchForString chrd) strs
+>
+> choosePitchForString :: [Pitch.Class] -> Pitch.T -> Pitch.T
+> choosePitchForString chrd str@(_,pc) =
+> let diff x = mod (Pitch.classToInt x - Pitch.classToInt pc) 12
+> smallestDiff = minimum (map diff chrd)
+> in Pitch.transpose smallestDiff str
+>
+> stringPitches :: [Pitch.T]
+> stringPitches =
+> reverse [(-2,E), (-2,A), (-1,D), (-1,G), (-1,B), (0,E)]
+
+\end{haskelllisting}
+
+Once we obtain the tones that are played on a guitar
+we want to arrange them into a guitar like melody.
+We distinguish between up strokes and down strokes,
+which are often played alternatingly.
+According to the stroke direction,
+the low notes are played slightly before the high ones
+and vice versa.
+We define the respective delays for each string.
+Since both direction are perceived differently,
+we have to prefetch the down strokes a bit.
+
+\begin{haskelllisting}
+
+> data Direction =
+> Up
+> | Down
+>
+> delayTime :: Dur
+> delayTime = en/15
+>
+> dirDelays :: Direction -> [Dur.Offset]
+> dirDelays dir =
+> map (Dur.toRatio delayTime *)
+> (case dir of
+> Up -> [0..5]
+> Down -> [2,1..(-3)])
+
+\end{haskelllisting}
+
+Here is the only creative part:
+The essential description of the guitar music.
+
+\begin{haskelllisting}
+
+> type UpDownPattern = [(Dur, Direction)]
+>
+> udp, udpInter, udpLast :: UpDownPattern
+> udp = [(qn,Up), (en,Down), (qn,Up), (en,Down), (qn, Up)]
+> udpInter = [(qn,Up), (en,Down), (qn,Up), (en,Down), (en,Up), (en,Down)]
+> udpLast = [(qn,Up), (en,Down), (qn,Up), (en,Down), (qn+wn,Up)]
+>
+> chords :: [([Pitch.Class], UpDownPattern)]
+> chords =
+> [([C,E,G], udp),
+> ([C,E,G,Bf], udp),
+> ([F,A,C], udp),
+> ([F,Af,C], udpInter),
+> ([C,E,G], udp),
+> ([G,B,D], udp),
+> ([C,F,G], udp),
+> ([C,E,G], udpLast)]
+
+\end{haskelllisting}
+
+The next step is to arrange the notes corresponding to the chords.
+
+\begin{haskelllisting}
+
+> type DelayedNote = (Dur.Offset, (Dur, Maybe Pitch.T))
+>
+> chordToPattern :: [Pitch.Class] -> UpDownPattern -> [[DelayedNote]]
+> chordToPattern chrd =
+> map (\(dur,ord) ->
+> zipWith
+> (\delay p -> (delay, (dur, Just p)))
+> (dirDelays ord)
+> (mapChordToString stringPitches chrd))
+>
+> guitarEvents :: [[DelayedNote]]
+> guitarEvents =
+> concatMap (uncurry chordToPattern) chords
+
+\end{haskelllisting}
+
+We want to simulate the guitar by a parallel composition of six strings.
+The sound of each string finishes when the next sound on the string is played.
+Thus we have to compute the time each string oscillates.
+Finally we want to obtain this pattern of events:
+
+\begin{verbatim}
+
+ o o o
+ o o o
+ o o o
+ o o o
+ o o o
+ o o o
+
+\end{verbatim}
+
+\begin{haskelllisting}
+
+> delayNotes :: [DelayedNote] -> [Melody.T ()]
+> delayNotes m =
+> let zero = (0, (0, Nothing))
+> in zipWith
+> (\(d0, (dur, at)) (d1, _) ->
+> Music.atom (Dur.add (d1-d0) dur)
+> (fmap (Melody.Note ()) at))
+> (zero : m) (m ++ [zero])
+>
+> stringMelodies :: [Melody.T ()]
+> stringMelodies =
+> map (line . delayNotes) (List.transpose guitarEvents)
+>
+> parallelSong :: [instr] -> RhyMusic.T drum instr
+> parallelSong instrs =
+> changeTempo 2 (chord (zipWith RhyMusic.fromMelodyNullAttr
+> instrs stringMelodies))
+>
+> parallelSongMIDI :: MidiMusic.T
+> parallelSongMIDI =
+> transpose 12 (parallelSong (repeat MidiMusic.ElectricGuitarClean))
+
+\end{haskelllisting}
+
+Unfortunately the Guitar music appears to be slightly longer
+than it is on the note sheet.
+To workaround that we use notes of very short duration but very long legato.
+For simplicity this simulation is not as precise as the one above.
+We don't prefetch the down strokes and
+we do not exactly care for the correct length of the string sounds.
+The resulting MIDI files does still not sound satisfyingly
+because notes of equal pitch overlap, which is not properly supported by MIDI.
+
+\begin{verbatim}
+<----------------->
+ <-------------->
+\end{verbatim}
+
+The end of the first note terminates the second one, which is not intended.
+Of course, you can play the MidiMusic using other back ends.
+
+\begin{haskelllisting}
+
+> chordWithLegatoPattern ::
+> [RhyMusic.T drum instr] -> UpDownPattern -> RhyMusic.T drum instr
+> chordWithLegatoPattern tones pattern =
+> let beat (dur, dir) =
+> legato dur
+> (line (case dir of {Up -> tones; Down -> reverse tones}) +:+
+> Music.rest (dur - delayTime * List.genericLength tones))
+> in line (map beat pattern)
+>
+>
+>
+> legatoSong :: [instr] -> RhyMusic.T drum instr
+> legatoSong instrs =
+> changeTempo 2 (line (map
+> (uncurry
+> (chordWithLegatoPattern .
+> zipWith RhyMusic.fromMelodyNullAttr instrs .
+> map (Music.atom delayTime . Just . Melody.Note ()) .
+> mapChordToString stringPitches))
+> chords))
+>
+> legatoSongMIDI :: MidiMusic.T
+> legatoSongMIDI =
+> transpose 12 (legatoSong (repeat MidiMusic.ElectricGuitarClean))
+
+\end{haskelllisting}
+
+% let strings = map (RhyMusic.fromStdMelody MidiMusic.ElectricGuitarClean) [a 0 delayTime [], b 0 delayTime [], c 0 delayTime []]
+% chordWithLegatoPattern strings udp
+% FancyPerformance.floatFromMusic (chordWithLegatoPattern strings udp)
diff --git a/src/Haskore/Example/Kantate147.hs b/src/Haskore/Example/Kantate147.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Kantate147.hs
@@ -0,0 +1,173 @@
+module Haskore.Example.Kantate147 where
+
+{- Kantate 147 by Johann Sebastian Bach -}
+
+import qualified Haskore.Basic.Pitch as Pitch
+import qualified Haskore.Basic.Tempo as Tempo
+import qualified Haskore.Music as Music
+import Haskore.Music (line, chord, (=:=))
+import qualified Haskore.Melody as Melody
+import qualified Haskore.Music.GeneralMIDI as MidiMusic
+import Haskore.Basic.Duration (qn, (%+), )
+
+import qualified Haskore.Performance.Context as Context
+import qualified Haskore.Performance.Default as DefltPf
+
+import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+import qualified Haskore.Interface.MML as MML
+-- import qualified Medium.Controlled.List as CtrlMedium
+import qualified Medium.Controlled.ContextFreeGrammar as Grammar
+import qualified Data.MarkovChain as MarkovChain
+
+import qualified Sound.MIDI.File as MidiFile
+import qualified Haskore.Interface.MIDI.InstrumentMap as InstrumentMap
+import qualified Haskore.Interface.MIDI.Write as WriteMidi
+import qualified Sound.MIDI.File.Save as SaveMidi
+import qualified Sound.MIDI.General as GeneralMidi
+
+import qualified Data.List as List
+
+import Control.Monad.State
+import System.Random (mkStdGen, split)
+
+
+initOctaves :: [Pitch.Octave]
+initOctaves = [1, 0, 2, 2]
+
+songMML :: [(String, String, String, String)]
+songMML = [
+ ("l2g>ge", "l2p2de", "l2p2l6g3f#g3a", "l6p6gab>dcced"),
+ ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"),
+ ("ed", "geced", "a3f#g3ec", "e>dcg6d3gb3>dg3d", "gb>dgdd"),
+ ("g>f#e", "dc"),
+ ("f#ed", "agf#", "a1b", "d1d"),
+ ("ef#g", "gag", "bag", "c1d3d6", "al6d3ef#3g", "l6adef#aga>cp3d6d3d6", "f#3a6f#3d6d6", "a3>cccdcced"),
+ ("be", "gdcdcdcge", "b>de", "dg3f#g3a", "gbab>dcced"),
+ ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>f#a3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"),
+ ("ed", "geced", "a3f#g3ec", "e>dcf#e", "dc", "l2g1g"),
+ ("f#ed", "agf#", "d1d", "a1b"),
+ ("ef#g", "gag", "c1d3d", "al6d3ef#3g", "l6ddef#aga>cd6d3d6", "f#3af#3dd", "a3>cccc", "bgab>dcced"),
+ ("be", "gdcdcc8dcge", "l2b>de", "l6g3dg3f#g3a", "gbab>dcced"),
+ ("ec", "a>dc", "e3f#g3de3cdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"),
+ ("ed", "geced", "a3f#g3ec", "e>dcg6f#3e6", "dp3g6d3e6", "gb3>dg3dgdc#"),
+ ("dca4g4f4e4", "ea", ">c1c", "a>cce", "aag#", "c8d8dcdfd", "ef#", "al6a3g#a3b", "a>cceddfe"),
+ ("cfe", "afc", ">c3c3c"),
+ ("dd#e", "df#e", "a3g#a3f#d", "fedcab", "cl2c1d", "a>ceap3l2d"),
+ (">ccag", "e1e", "l6ecdegfgb-a"),
+ ("fdg", "df#g", "dd4e8f8d", "a>ccc3d", "a>ccd6", "gp3d6d3d6", "c3c3d3ge", "dde", "l2b1>c", "bgab>dcced"),
+ ("ec", "a>dc", "ccdedcd3d", "l6a3c#d3ef#3g", "f#def#aga>cd6d3d6", "f#3af#3dd", "a3>cccc", "bgab>dcced"),
+ ("be", "gdcdcc8dcg6d3g6", "gl6dg3d", "gb>dgda"),
+ ("g1g2", "dp3g6e3c6", "d3b>c2", "fddedd6e6", "c3cda6f#3d6", "a2a3f#d3f#", ">ccge", "dde", "g3dg3f#g3a", "bgab>dcced"),
+ ("ec", "a>dcdedcf#", "a3>da3ga3f#", "f#gadf#a>ce", "d3f#g3f#g3a", "bgab>dcced"),
+ ("ed", "gec", "e>dc Music.Atom (dr * (3%+4)) at) songTrackwise
+ in Grammar.fromMedium (map (("part"++) . show) [(0 :: Int) ..]) 4
+ songConvDurs
+
+
+{- Try to create new music by reordering the notes using Markov chains. -}
+
+markovChain :: Melody.T ()
+markovChain =
+ let tracks = map concat musicTracks
+ gs = evalState (sequence (repeat (State split))) (mkStdGen 147)
+ chains = zipWith (\track g -> line (MarkovChain.run 3 track 0 g)) tracks gs
+ in chains !! 2 =:= chains !! 3
+
+
+markovChainMidi :: MidiFile.T
+markovChainMidi = toMidi (Music.take 100 markovChain)
+
+
+
+----- Player details
+
+cm :: InstrumentMap.ChannelTable MidiMusic.Instrument
+cm = [(MidiMusic.ChurchOrgan, MidiMusic.toChannel 1),
+ (MidiMusic.Viola, MidiMusic.toChannel 2)]
+
+context :: Context.T NonNeg.Float Float MidiMusic.Note
+context =
+ Context.setDur (Tempo.metro 105 qn) $
+ DefltPf.context
+
+toMidi :: Melody.T () -> MidiFile.T
+toMidi m =
+ WriteMidi.fromGMMusic (cm, context,
+ MidiMusic.fromMelodyNullAttr MidiMusic.ChurchOrgan m)
+
+
+midi :: MidiFile.T
+midi = toMidi song
+
+main :: IO ()
+main = SaveMidi.toFile "test.mid" midi
diff --git a/src/Haskore/Example/Miscellaneous.lhs b/src/Haskore/Example/Miscellaneous.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Miscellaneous.lhs
@@ -0,0 +1,348 @@
+\subsection{Haskore in Action}
+\seclabel{examples}
+
+\begin{haskelllisting}
+
+> module Haskore.Example.Miscellaneous where
+>
+> import Haskore.Composition.Trill as Trill
+> import Haskore.Composition.Drum as Drum
+>
+> import qualified Haskore.Music as Music
+> import Haskore.Music (rest, delay, (/=:))
+> import Haskore.Music.GeneralMIDI as MidiMusic
+> import Haskore.Music.Standard as StdMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Melody as Melody
+> import Haskore.Melody.Standard as StdMelody
+> import qualified Haskore.Performance.Context as Context
+
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import qualified Haskore.Interface.MIDI.Write as WriteMidi
+> import qualified Haskore.Interface.MIDI.Read as ReadMidi
+> import qualified Haskore.Interface.MIDI.Render as Render
+
+> import qualified Sound.MIDI.File.Save as SaveMidi
+> import qualified Sound.MIDI.File.Load as LoadMidi
+> import qualified Sound.MIDI.File as MidiFile
+> import qualified Sound.MIDI.General as GeneralMidi
+
+> import qualified Haskore.Example.SelfSim as SelfSim
+> import qualified Haskore.Example.ChildSong6 as ChildSong6
+> import qualified Haskore.Example.Ssf as Ssf
+
+> import Haskore.Basic.Duration ((%+))
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+> import System.IO(IO)
+> import Haskore.General.Utility (fst3, snd3, thd3)
+
+
+> t0, t1, t2, t3, t4, t5,
+> t10s, t12, t12a, t13, t13a, t13b, t13c, t13d, t13e,
+> t14, t14b, t14c, t14d, cs6, ssf0 :: MidiFile.T
+
+> piano, vibes, flute :: GeneralMidi.Instrument
+> piano = GeneralMidi.AcousticGrandPiano
+> vibes = GeneralMidi.Vibraphone
+> flute = GeneralMidi.Flute
+
+\end{haskelllisting}
+
+Simple examples of Haskore in action. Note that this module also
+imports modules ChildSong6, SelfSim, and Ssf.
+
+\vspace{2ex}
+\hrule{\hfill}
+
+From the tutorial, try things such as pr12, cMajArp, cMajChd, etc. and
+try applying inversions, retrogrades, etc. on the same examples. Also
+try \code{ChildSong.song}. For example:
+
+\begin{haskelllisting}
+
+> t0 = Render.generalMidiDeflt ChildSong6.song
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+C Major scale for use in examples below:
+
+\begin{haskelllisting}
+
+> cms', cms :: Melody.T ()
+> cms' = line (map (\n -> n en ())
+> [c 0, d 0, e 0, f 0, g 0, a 0, b 0, c 1])
+> cms = changeTempo 2 cms'
+
+> drumScale :: MidiMusic.T
+> drumScale =
+> line (map (\n -> Drum.toMusicDefaultAttr (toEnum (n+13)) sn)
+> [0,2,4,5,7,9,11,12])
+
+\end{haskelllisting}
+
+Test of various articulations and dynamics:
+
+\begin{haskelllisting}
+
+> t1 = Render.generalMidi
+> (staccato (sn/10) drumScale +:+
+> drumScale +:+
+> legato (sn/10) drumScale )
+>
+> temp, mu2 :: MidiMusic.T
+> temp = MidiMusic.fromMelodyNullAttr piano (crescendo 4.0 (c 0 en ()))
+>
+> mu2 = MidiMusic.fromMelodyNullAttr vibes
+> (diminuendo 0.75 cms +:+
+> crescendo 0.75 (loudness1 0.25 cms))
+> t2 = Render.generalMidiDeflt mu2
+>
+> t3 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr flute
+> (accelerando 0.3 cms +:+
+> ritardando 0.6 cms ))
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+A function to recursively apply transformations
+\code{f'} (to elements in a sequence) and
+\code{g'} (to accumulated phrases):
+
+\begin{haskelllisting}
+
+> rep :: (Music.T note -> Music.T note)
+> -> (Music.T note -> Music.T note)
+> -> Int -> Music.T note -> Music.T note
+> rep _ _ 0 _ = rest 0
+> rep f' g' n m = m =:= g' (rep f' g' (n-1) (f' m))
+
+\end{haskelllisting}
+
+An example using "rep" three times, recursively, to create a "cascade"
+of sounds.
+
+\begin{haskelllisting}
+
+> run, cascade, cascades :: Melody.T ()
+> run = rep (transpose 5) (delay tn) 8 (c 0 tn ())
+> cascade = rep (transpose 4) (delay en) 8 run
+> cascades = rep id (delay sn) 2 cascade
+>
+> t4' :: Melody.T () -> MidiFile.T
+> t4' x = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano x)
+> t4 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano
+> (cascades +:+ Music.reverse cascades))
+
+\end{haskelllisting}
+
+What happens if we simply reverse the \code{f} and \code{g} arguments?
+
+\begin{haskelllisting}
+
+> run', cascade', cascades' :: Melody.T ()
+> run' = rep (delay tn) (transpose 5) 4 (c 0 tn ())
+> cascade' = rep (delay en) (transpose 4) 6 run'
+> cascades' = rep (delay sn) id 2 cascade'
+> t5 = Render.generalMidiDeflt (MidiMusic.fromMelodyNullAttr piano cascades')
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Example from the SelfSim module.
+
+\begin{haskelllisting}
+
+> t10s = Render.generalMidiDeflt (rep (delay SelfSim.durss) (transpose 4) 2 SelfSim.ss)
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Example from the ChildSong6 module.
+
+\begin{haskelllisting}
+
+> cs6 = Render.generalMidiDeflt ChildSong6.song
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Example from the Ssf (Stars and Stripes Forever) module.
+
+\begin{haskelllisting}
+
+> ssf0 = Render.generalMidiDeflt Ssf.song
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Midi percussion test. Plays all "notes" in a range. (Requires adding
+an instrument for percussion to the \code{InstrMap}.)
+
+\begin{haskelllisting}
+
+> drums :: GeneralMidi.Drum -> GeneralMidi.Drum -> MidiMusic.T
+> drums dr0 dr1 =
+> line (map (\drm -> Drum.toMusicDefaultAttr drm sn) [dr0..dr1])
+>
+> t11 :: GeneralMidi.Drum -> GeneralMidi.Drum -> MidiFile.T
+> t11 dr0 dr1 = Render.generalMidiDeflt (drums dr0 dr1)
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Test of \function{Music.take} and shorten.
+
+\begin{haskelllisting}
+
+> t12 = Render.generalMidiDeflt (Music.take 4 ChildSong6.song)
+> t12a =
+> Render.generalMidiDeflt
+> (MidiMusic.fromMelodyNullAttr piano cms /=: ChildSong6.song)
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Tests of the trill functions.
+
+\begin{haskelllisting}
+
+> t13note :: MidiMusic.T
+> t13note = MidiMusic.fromMelodyNullAttr piano (c 1 qn ())
+> t13 = Render.generalMidiDeflt (trill 1 sn t13note)
+> t13a = Render.generalMidiDeflt (trill' 2 dqn t13note)
+> t13b = Render.generalMidiDeflt (trillN 1 5 t13note)
+> t13c = Render.generalMidiDeflt (trillN' 3 7 t13note)
+> t13d = Render.generalMidiDeflt (roll tn t13note)
+> t13e = Render.generalMidiDeflt (changeTempo (2/3) (transpose 2 (trillN' 2 7 t13note)))
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+Tests of drum.
+
+\begin{haskelllisting}
+
+> t14 = Render.generalMidiDeflt (Drum.toMusicDefaultAttr AcousticSnare qn)
+
+\end{haskelllisting}
+
+A "funk groove"
+
+\begin{haskelllisting}
+
+> t14b = let p1 = Drum.toMusicDefaultAttr LowTom qn
+> p2 = Drum.toMusicDefaultAttr AcousticSnare en
+> in Render.generalMidiDeflt (changeTempo 3 (Music.replicate 4
+> (line [p1, qnr, p2, qnr, p2,
+> p1, p1, qnr, p2, enr]
+> =:= roll en (Drum.toMusicDefaultAttr ClosedHiHat 2))))
+
+\end{haskelllisting}
+
+A "jazz groove"
+
+\begin{haskelllisting}
+
+> t14c = let p1 = Drum.toMusicDefaultAttr CrashCymbal2 qn
+> p2 = Drum.toMusicDefaultAttr AcousticSnare en
+> p3 = Drum.toMusicDefaultAttr LowTom qn
+> in Render.generalMidiDeflt (changeTempo 3 (Music.replicate 8
+> ((p1 +:+ changeTempo (3%+2) (p2 +:+ enr +:+ p2))
+> =:= (p3 +:+ qnr)) ))
+
+> t14d = let p1 = Drum.toMusicDefaultAttr LowTom en
+> p2 = Drum.toMusicDefaultAttr AcousticSnare hn
+> in Render.generalMidiDeflt(line [roll tn p1,
+> p1,
+> p1,
+> rest en,
+> roll tn p1,
+> p1,
+> p1,
+> rest qn,
+> roll tn p2,
+> p1,
+> p1] )
+
+\end{haskelllisting}
+
+\hrule{\hfill}
+
+\paragraph{Tests of the MIDI interface.}
+
+\code{MidiMusic.T} into a MIDI file.
+
+\begin{haskelllisting}
+
+> tab :: MidiMusic.T -> IO ()
+> tab m = SaveMidi.toFile "test.mid" (Render.generalMidiDeflt m)
+
+\end{haskelllisting}
+
+\code{MidiMusic.T} to a MidiFile datatype and back to Music.
+
+\begin{haskelllisting}
+
+> type StdContext =
+> Context.T NonNeg.Float Float (RhyMusic.Note MidiMusic.Drum MidiMusic.Instr)
+> -- type StdContext = Pf.Context NonNeg.Float Float MidiMusic.Note -- rejected by Hugs
+
+> type MidiArrange =
+> (InstrMap.ChannelTable MidiMusic.Instr, StdContext, MidiMusic.T)
+
+> tad :: MidiMusic.T -> MidiArrange
+> tad = ReadMidi.toGMMusic . Render.generalMidiDeflt
+
+\end{haskelllisting}
+
+A MIDI file to a MidiFile datatype and back to a MIDI file.
+
+\begin{haskelllisting}
+
+> tcb, tc, tcd, tcdab :: FilePath -> IO ()
+> tcb file = LoadMidi.fromFile file >>= SaveMidi.toFile "test.mid"
+
+\end{haskelllisting}
+
+MIDI file to MidiFile datatype.
+
+\begin{haskelllisting}
+
+> tc file = LoadMidi.fromFile file >>= print
+
+\end{haskelllisting}
+
+MIDI file to \code{MidiMusic.T}, a \code{InstrMap}, and a \code{Context}.
+
+\begin{haskelllisting}
+
+> tcd file = do
+> x <- fmap ReadMidi.toGMMusic
+> (LoadMidi.fromFile file)
+> print $ fst3 (x::MidiArrange)
+> print $ snd3 x
+> print $ thd3 x
+
+\end{haskelllisting}
+
+A MIDI file to \code{MidiMusic.T} and back to a MIDI file.
+
+\begin{haskelllisting}
+
+> tcdab file =
+> LoadMidi.fromFile file >>=
+> (SaveMidi.toFile "test.mid" . WriteMidi.fromGMMusic .
+> (id::MidiArrange -> MidiArrange) . ReadMidi.toGMMusic)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Example/NewResolutions.lhs b/src/Haskore/Example/NewResolutions.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/NewResolutions.lhs
@@ -0,0 +1,268 @@
+GHC-6.4.1 runs out of memory with optimization.
+Unfortunately we cannot override Cabal's option here,
+so you have to configure with --disable-optimization
+
+> {-# OPTIONS_GHC -Onot #-}
+
+New Resolutions by Jean-Luc Ponty, Scott O'Neil, and John Garvin
+
+> module Haskore.Example.NewResolutions where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Basic.Tempo as Tempo
+> import qualified Haskore.Interface.MIDI.Write as WriteMidi
+> import qualified Sound.MIDI.File.Save as SaveMidi
+> import qualified Sound.MIDI.File as MidiFile
+
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Fancy as FancyPf
+
+> import Haskore.Basic.Duration((%+))
+> import Haskore.Basic.Pitch
+> import Haskore.Basic.Interval as Interval
+> import qualified Haskore.Music as Music
+> import Haskore.Melody as Melody
+> import Haskore.Melody.Standard as StdMelody
+> import Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+
+> import qualified Data.List as List
+
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+> import qualified Data.Accessor.Basic as Accessor
+
+
+> piano, marimba, xylo, vib, glock :: MidiMusic.Instr
+> piano = MidiMusic.AcousticGrandPiano
+> marimba = MidiMusic.Marimba
+> xylo = MidiMusic.Xylophone
+> vib = MidiMusic.Vibraphone
+> glock = MidiMusic.Glockenspiel
+
+> pattern, melPattern,
+> melody1, bellPart, vibesLine, vibesPart,
+> melody2, vibeLine3, vibePart3,
+> melody3, endRun :: StdMelody.T
+> part1, part2, part3, bridge, ending, harmony3 :: MidiMusic.T
+
+> comp2 :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
+> comp2 func = ((func .) .)
+
+% comp2 func1 func0 = curry (func1 . uncurry func0)
+
+> arpeggio :: [Int] -> Pitch.T -> Dur -> StdMelody.T
+> arpeggio trs p d' = line (map (\tr -> note (Pitch.transpose tr p) d' na) trs)
+
+> minArpegUp, minArpegDown, majArpegDown, six3ArpegDown
+> :: Pitch.T -> Dur -> StdMelody.T
+> minArpegUp = arpeggio [unison, minorThird, fifth, octave]
+> minArpegDown = arpeggio [octave, fifth, minorThird, unison]
+> majArpegDown = arpeggio [octave, fifth, majorThird, unison]
+> six3ArpegDown = arpeggio [octave, majorSixth, majorThird, unison]
+
+> pattern = minArpegUp (5,D) sn
+> +:+ minArpegDown (5,C) sn
+> +:+ minArpegUp (4,A) sn
+> +:+ minArpegDown (4,G) sn
+> +:+ minArpegUp (4,F) sn
+> +:+ d 5 sn na +:+ a 4 sn na +:+ f 4 sn na +:+ a 4 sn na
+
+> melPattern = d 6 en na +:+ c 6 en na +:+ d 6 en na
+> +:+ snr
+> +:+ a 5 en na +:+ g 5 en na +:+ a 5 en na
+
+> melody1 = melPattern +:+ enr +:+ d 5 sn na
+> +:+ f 5 sn na +:+ g 5 en na +:+ f 5 sn na +:+ d 5 en na +:+ c 5 en na
+> +:+ d 5 en na +:+ melPattern +:+ d 5 sn na
+> +:+ f 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na
+> +:+ d 5 sn na +:+ c 5 en na +:+ d 5 den na
+> +:+ melPattern +:+ d 5 sn na
+> +:+ f 5 sn na +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 en na
+> +:+ c 5 sn na +:+ d 5 en na
+> +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na +:+ c 6 en na
+> +:+ a 5 en na +:+ c 6 en na +:+ a 5 sn na +:+ g 5 en na
+> +:+ f 5 en na +:+ af 5 en na
+> +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na
+> -- last note removed to make fit with pattern
+
+> bellPart = d 7 en na +:+ f 7 en na +:+ c 7 en na +:+ d 7 en na
+> +:+ a 6 en na +:+ c 7 en na +:+ g 6 en na +:+ a 6 en na
+> +:+ f 6 en na +:+ g 6 en na
+> +:+ d 6 sn na +:+ f 6 sn na +:+ a 6 sn na +:+ c 7 sn na
+
+> vibesLine = d 5 qn na +:+ c 5 qn na +:+ a 4 qn na
+> +:+ g 4 qn na +:+ f 4 qn na +:+ d 4 qn na
+> vibesPart = vibesLine =:= Music.transpose 12 vibesLine
+
+> cMajorScale, gMajorScale, dPentMinScale :: [Pitch.T]
+> cMajorScale = [(0,C), (0,D), (0,E), (0,F), (0,G), (0,A), (0,B)]
+> gMajorScale = [(0,G), (0,A), (0,B), (1,C), (1,D), (1,E), (1,Fs)]
+> dPentMinScale = [(0,D), (0,F), (0,G), (0,A), (1,C)]
+
+> prevNote, nextNote :: [Pitch.T] -> Pitch.T -> Pitch.T
+> prevNote [] _ = error ("Scale empty")
+> prevNote [_] _ = error ("Note not found in scale")
+> prevNote ((n,y):ys) (oct,p) | y == p = let (m,x) = last ys
+> in (oct + m - n - 1, x)
+> prevNote ((m,x):(n,y):xys) (oct,p) | y == p = (oct + m - n, x)
+> | otherwise = prevNote ((n,y):xys) (oct,p)
+
+> nextNote scale n = nextNote' (head scale) scale n
+> nextNote' :: Pitch.T -> [Pitch.T] -> Pitch.T -> Pitch.T
+> nextNote' _ [] _ = error ("Scale empty")
+> nextNote' (fstO,fstP) [(m,x)] (oct,p)
+> | x == p = (oct - m + fstO + 1, fstP)
+> | otherwise = error ("Note not found in scale")
+> nextNote' fst' ((m,x):(n,y):xys) (oct,p)
+> | x == p = (oct - m + n, y)
+> | otherwise = nextNote' fst' ((n,y):xys) (oct,p)
+
+> back2Note :: [Pitch.T] -> Pitch.T -> Pitch.T
+> back2Note s = prevNote s . prevNote s
+
+> nextNR, prevNR, back2NR :: Pitch.T -> Pitch.T
+> nextNR = nextNote dPentMinScale
+> prevNR = prevNote dPentMinScale
+> back2NR = back2Note dPentMinScale
+
+> makeSN, diddle :: Pitch.T -> StdMelody.T
+> makeSN p = note p sn na
+> diddle p = line $ snr : map makeSN [p, prevNR p, p]
+
+> melody2 = d 6 sn na +:+ d 6 en na +:+ c 6 en na +:+ d 6 sn na +:+ c 6 en na
+> +:+ a 5 en na +:+ g 5 sn na +:+ f 5 sn na
+> +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ f 5 sn na
+> +:+ diddle (5,D) +:+ diddle (5,C)
+> +:+ diddle (6,D) +:+ diddle (6,C) +:+ diddle (5,A)
+> +:+ diddle (5,G) +:+ diddle (5,F) +:+ diddle (5,D)
+> +:+ snr +:+ d 6 en na +:+ c 6 en na +:+ d 6 den na
+> +:+ c 6 en na +:+ a 5 en na +:+ g 5 den na
+> +:+ f 5 en na +:+ g 5 en na +:+ f 5 sn na
+> +:+ g 5 sn na +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na
+> +:+ d 5 den na +:+ d 6 en na +:+ c 6 den na +:+ a 5 en na +:+ g 5 den na
+> +:+ f 5 en na +:+ d 5 den na +:+ c 5 en na +:+ d 5 qn na
+
+> part1 = MidiMusic.fromStdMelody marimba (loudness1 0.7 pattern)
+> +:+
+> MidiMusic.fromStdMelody xylo (loudness1 1.2 melody1)
+> =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 4 pattern))
+> bridge = MidiMusic.fromStdMelody xylo (d 5 hn (Accessor.set velocity1 1.2 na))
+> =:= (Music.replicate 2 $
+> MidiMusic.fromStdMelody marimba (loudness1 0.6 (Music.transpose (-12) bellPart))
+> =:= MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart)
+> =:= MidiMusic.fromStdMelody glock (loudness1 0.8 bellPart))
+> part2 = MidiMusic.fromStdMelody xylo (loudness1 1.2 melody2)
+> =:= MidiMusic.fromStdMelody marimba (loudness1 0.7 (Music.replicate 3 pattern
+> +:+ minArpegUp (5,D) sn
+> +:+ minArpegDown (5,C) sn
+> +:+ minArpegUp (4,A) sn
+> +:+ minArpegDown (4,G) sn
+> +:+ minArpegUp (4,F) sn
+> +:+ d 5 sn na))
+> =:= Music.replicate 4 (MidiMusic.fromStdMelody vib (loudness1 0.4 vibesPart))
+
+> run1, run2, run3 :: Pitch.T -> Dur -> StdMelody.T
+> run1 = arpeggio [unison, minorThird, fifth,
+> minorSeventh, octave, octaveMinorThird,
+> octaveFifth, octaveMinorThird, octave,
+> minorSeventh, fifth, minorThird]
+
+> part3Pattern :: (Num t) =>
+> ((t, Pitch.Class) -> Dur -> StdMelody.T) -> MidiMusic.T
+> part3Pattern el = MidiMusic.fromStdMelody piano $
+> el (4,D) sn +:+ el (4,C) sn +:+ el (4,D) sn +:+ el (4,F) sn
+
+> run2 = Music.replicate 2 `comp2`
+> arpeggio [fifth, minorSeventh, octave,
+> octaveMinorThird, octave, minorSeventh]
+
+> run3 = Music.replicate 3 `comp2`
+> arpeggio [octaveMinorThird, octave, minorSeventh, fifth]
+
+> vibeLine3 = let el p = arpeggio [octave, fifth, minorSeventh, octave] p den
+> in el (4,D) +:+ el (4,C) +:+ el (4,D)
+> +:+ f 5 den na +:+ c 5 den na
+> +:+ ef 5 en na +:+ f 5 en na +:+ af 5 en na
+> vibePart3 = vibeLine3 =:= Music.transpose 12 vibeLine3
+
+> melody3 = a 5 (11%+16) na +:+ f 6 sn na
+> +:+ ef 6 en na +:+ d 6 en na +:+ c 6 en na +:+ g 5 dqn na
+> +:+ Music.replicate 3 (a 5 sn na +:+ f 6 en na) +:+ a 5 en na
+> +:+ f 6 en na +:+ af 5 en na +:+ f 6 en na +:+ af 5 en na
+> +:+ minArpegDown (5,F) sn +:+ snr
+> +:+ majArpegDown (5,F) sn +:+ snr
+> +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na
+> +:+ ef 6 sn na +:+ d 6 sn na +:+ c 6 sn na +:+ g 5 sn na +:+ snr
+> +:+ majArpegDown (5,Ef) sn +:+ snr +:+ ef 6 sn na +:+ c 6 sn na
+> +:+ majArpegDown (5,F) sn +:+ snr
+> +:+ six3ArpegDown (5,F) sn +:+ snr +:+ f 6 sn na +:+ d 6 sn na
+> +:+ minArpegDown (5,F) sn +:+ snr
+> +:+ minArpegDown (5,F) sn +:+ af 5 sn na +:+ c 6 sn na +:+ f 6 sn na
+> +:+ line (map (Music.replicate 2) [f 6 sn na, d 6 sn na, c 6 sn na,
+> a 5 sn na, g 5 sn na, f 5 sn na])
+> +:+ ef 5 sn na +:+ f 5 sn na +:+ g 5 sn na +:+ bf 5 sn na
+> +:+ c 6 sn na +:+ d 6 sn na +:+ ef 6 sn na +:+ d 6 sn na
+> +:+ c 6 sn na +:+ bf 5 sn na +:+ a 5 sn na +:+ g 5 sn na
+> +:+ Music.replicate 4 (a 5 sn na +:+ a 5 sn na +:+ g 5 sn na)
+> +:+ Music.replicate 2 (af 5 sn na +:+ af 5 sn na +:+ g 5 sn na)
+> +:+ Music.replicate 2 (af 5 sn na +:+ g 5 sn na +:+ f 5 sn na)
+> +:+ a 5 dqn na
+> +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na
+> +:+ a 5 sn na +:+ g 5 sn na +:+ f 5 sn na
+> +:+ g 5 sn na +:+ bf 5 sn na +:+ ef 6 dqn na
+> +:+ bf 6 den na +:+ bf 6 sn na
+> +:+ a 6 en na +:+ a 6 sn na +:+ g 6 en na +:+ g 6 sn na
+> +:+ f 6 den na +:+ a 5 sn na +:+ c 6 sn na +:+ d 6 sn na
+> +:+ f 6 den na +:+ f 6 sn na +:+ d 6 sn na +:+ c 6 sn na
+> +:+ af 5 sn na +:+ af 5 sn na +:+ g 5 sn na
+> +:+ f 5 sn na +:+ d 5 sn na +:+ c 5 sn na
+
+> harmony3 = loudness1 0.6 (part3Pattern run1
+> =:= part3Pattern run2
+> =:= Music.transpose 12 (part3Pattern run3))
+> =:= loudness1 0.5 (MidiMusic.fromStdMelody vib vibePart3)
+
+> part3 = loudness1 0.6 (part3Pattern run1)
+> +:+ (loudness1 0.6 (part3Pattern run1)
+> =:= loudness1 0.9 (part3Pattern run2))
+> +:+ (loudness1 0.6 ((part3Pattern run1)
+> =:= (part3Pattern run2))
+> =:= loudness1 1.0 (Music.transpose 12 (part3Pattern run3)))
+> +:+ loudness1 0.6 (part3Pattern run1
+> =:= part3Pattern run2
+> =:= Music.transpose 12 (part3Pattern run3))
+> =:= loudness1 0.7 (MidiMusic.fromStdMelody vib vibePart3)
+> +:+ (Music.replicate 4 harmony3 =:=
+> loudness1 1.0 (MidiMusic.fromStdMelody xylo melody3 =:=
+> MidiMusic.fromStdMelody marimba melody3))
+
+> all3Insts :: StdMelody.T -> MidiMusic.T
+> all3Insts m = chord [MidiMusic.fromStdMelody marimba m,
+> MidiMusic.fromStdMelody xylo m,
+> MidiMusic.fromStdMelody vib m]
+
+> endEl :: Pitch.T -> StdMelody.T
+> endEl p = line $ map makeSN [p, back2NR p, prevNR p, p]
+
+> endRun = line $ map endEl $ List.take 10 $ iterate nextNR (5,D)
+
+> ending = all3Insts $
+> d 5 qn na
+> +:+ loudness1 1.2 (endRun +:+ d 7 sn na)
+
+
+
+> song :: MidiMusic.T
+> song = Music.transpose (-48) $ line [part1, bridge, part2, part3, ending]
+>
+> -- context :: Context.T NonNeg.Float Float MidiMusic.Note -- rejected by Hugs
+> context :: Context.T NonNeg.Float Float (RhyMusic.Note MidiMusic.Drum MidiMusic.Instr)
+> context =
+> Context.setDur (Tempo.metro 120 qn) $
+> FancyPf.context
+>
+> midi :: MidiFile.T
+> midi = WriteMidi.fromGMMusicAuto (context, song)
+>
+> main :: IO ()
+> main = SaveMidi.toFile "newresolutions.mid" midi
diff --git a/src/Haskore/Example/Raenzlein.hs b/src/Haskore/Example/Raenzlein.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Raenzlein.hs
@@ -0,0 +1,98 @@
+module Haskore.Example.Raenzlein where
+
+{- Heute wollen wir das Ränzlein schnüren -}
+
+import Haskore.Melody.Standard as Melody
+import Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music as Music
+import qualified Haskore.Composition.Chord as Chord
+import Haskore.Basic.Pitch (Class(..))
+
+import qualified Data.Accessor.Basic as Accessor
+
+
+vline :: [NoteAttributes -> Melody.T] -> Melody.T
+vline = line . map ($ Melody.na)
+
+mel0 :: Melody.T
+mel0 = vline
+ [bf 0 en, d 1 en,
+ f 1 dqn, f 1 en, f 1 en, f 1 en, g 1 en, a 1 en]
+
+verse, refrain, strings :: Melody.T
+verse =
+ mel0 +:+
+ vline
+ [bf 1 hn, f 1 qn, g 1 en, f 1 en,
+ f 1 dqn, ef 1 en, ef 1 en, g 1 en, f 1 en, ef 1 en,
+ d 1 hn] +:+
+ qnr +:+
+ mel0 +:+
+ vline
+ [bf 1 qn, d 2 qn, d 2 qn, bf 1 en, d 2 en,
+ c 2 dqn, a 1 en, c 2 en, bf 1 en, a 1 en, g 1 en,
+ f 1 hn] +:+
+ qnr
+
+refrain =
+ vline
+ [f 1 den, g 1 sn, f 1 hn, ef 1 qn,
+ g 1 den, a 1 sn, g 1 hn, f 1 qn,
+ f 1 en, f 1 en, g 1 qn, f 1 qn, ef 1 qn, d 1 qn, c 1 hn] +:+
+ qnr +:+
+ Music.replicate 2 (vline
+ [bf 0 en, d 1 en, f 1 dqn, g 1 en, f 1 qn,
+ bf 1 en, a 1 en, g 1 dqn, a 1 en, g 1 qn,
+ ef 2 en, ef 2 en, d 2 dqn, bf 1 en,
+ c 2 den, c 2 sn, c 2 en, a 1 en, bf 1 hn]
+ +:+ qnr)
+
+melody :: Melody.T
+melody = verse +:+ refrain
+
+
+
+v :: NoteAttributes
+v = Accessor.set Melody.velocity1 0.4 Melody.na
+
+
+s1, s2 :: [Chord.Generic NoteAttributes]
+s1 =
+ Chord.generic Bf Chord.majorInt hn v :
+ Chord.generic F Chord.majorInt hn v :
+ Chord.generic Bf Chord.majorInt wn v :
+ Chord.generic F Chord.dominantSeventhInt wn v :
+ Chord.generic Bf Chord.majorInt dwn v :
+ Chord.generic F Chord.majorInt hn v :
+ Chord.generic Bf Chord.majorInt wn v :
+ Chord.generic F Chord.majorInt hn v :
+ Chord.generic C Chord.dominantSeventhInt hn v :
+ Chord.generic F Chord.majorInt wn v :
+ Chord.generic F Chord.dominantSeventhInt wn v :
+ Chord.generic Bf Chord.majorInt wn v :
+ Chord.generic Ef Chord.majorInt qn v :
+ Chord.generic Bf Chord.majorInt qn v :
+ Chord.generic F Chord.dominantSeventhInt qn v :
+ Chord.generic Bf Chord.majorInt qn v :
+ Chord.generic F Chord.majorInt wn v :
+ []
+s2 =
+ Chord.generic Bf Chord.majorInt wn v :
+ Chord.generic Ef Chord.majorInt wn v :
+ Chord.generic Bf Chord.majorInt hn v :
+ Chord.generic F Chord.dominantSeventhInt hn v :
+ Chord.generic Bf Chord.majorInt wn v :
+ []
+
+strings = qnr +:+
+ line (map chord
+ (Chord.leastVaryingInversions
+ ((1,C),(1,C))
+ (s1 ++ s2 ++ s2)))
+
+
+song :: MidiMusic.T
+song =
+ changeTempo (2)
+ (MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano (transpose 24 melody) =:=
+ MidiMusic.fromStdMelody MidiMusic.StringEnsemble1 (transpose 12 strings))
diff --git a/src/Haskore/Example/SelfSim.lhs b/src/Haskore/Example/SelfSim.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/SelfSim.lhs
@@ -0,0 +1,94 @@
+\subsection{Self-Similar (Fractal) Music.T}
+\seclabel{self-similar}
+
+\begin{haskelllisting}
+
+> module Haskore.Example.SelfSim where
+>
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Music as Music
+> import Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Interface.MIDI.Render as Render
+> import qualified Sound.MIDI.File as MidiFile
+
+\end{haskelllisting}
+
+An example of self-similar, or fractal, music.
+
+\begin{haskelllisting}
+
+> data Cluster = Cl SNote [Cluster] -- this is called a Rose tree
+> type Pat = [SNote]
+> type SNote = [(Pitch.Absolute,Dur)] -- i.e. a chord
+>
+> sim :: Pat -> [Cluster]
+> sim pat = map mkCluster pat
+> where mkCluster notes = Cl notes (map (mkCluster . addmult notes) pat)
+>
+>
+> addmult :: (Num a, Num b) => [(a, b)] -> [(a, b)] -> [(a, b)]
+> addmult pds iss = zipWith addmult' pds iss
+> where addmult' (p,d) (i,s) = (p+i,d*s)
+>
+> simFringe :: (Num a) => a -> Pat -> [SNote]
+> simFringe n pat = fringe n (Cl [(0,0)] (sim pat))
+>
+> fringe :: (Num a) => a -> Cluster -> [SNote]
+> fringe 0 (Cl n _) = [n]
+> fringe m (Cl _ cls) = concatMap (fringe (m-1)) cls
+>
+> -- this just converts the result to Haskore:
+> simToHask :: [[(Pitch.Absolute, Music.Dur)]] -> Melody.T ()
+> simToHask s = let mkNote (p,d) = Melody.note (Pitch.fromInt p) d ()
+> in line (map (chord . map mkNote) s)
+>
+> -- and here are some examples of it being applied:
+>
+> sim4 :: Int -> Melody.T ()
+> sim1, sim2, sim12, sim3, sim4s :: Int -> MidiMusic.T
+> t6, t7, t8, t9, t10 :: MidiFile.T
+>
+> sim1 n = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass
+> (transpose (-12)
+> (changeTempo 4 (simToHask (simFringe n pat1))))
+> t6 = Render.generalMidiDeflt (sim1 4)
+>
+> sim2 n = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano
+> (transpose 5
+> (changeTempo 4 (simToHask (simFringe n pat2))))
+> t7 = Render.generalMidiDeflt (sim2 4)
+>
+> sim12 n = sim1 n =:= sim2 n
+> t8 = Render.generalMidiDeflt (sim12 4)
+>
+> sim3 n = MidiMusic.fromMelodyNullAttr MidiMusic.Vibraphone
+> (transpose 0
+> (changeTempo 4 (simToHask (simFringe n pat3))))
+> t9 = Render.generalMidiDeflt (sim3 3)
+>
+> sim4 n = (transpose 12
+> (changeTempo 2 (simToHask (simFringe n pat4'))))
+>
+> sim4s n = let s = sim4 n
+> l1 = MidiMusic.fromMelodyNullAttr MidiMusic.Flute s
+> l2 = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass
+> (transpose (-36) (Music.reverse s))
+> in l1 =:= l2
+>
+> ss :: MidiMusic.T
+> ss = sim4s 3
+> durss :: Music.Dur
+> durss = Music.dur ss
+>
+> t10 = Render.generalMidiDeflt ss
+>
+> pat1, pat2, pat3, pat4, pat4' :: [SNote]
+> pat1 = [[(0,1.0)],[(4,0.5)],[(7,1.0)],[(5,0.5)]]
+> pat2 = [[(0,0.5)],[(4,1.0)],[(7,0.5)],[(5,1.0)]]
+> pat3 = [[(2,0.6)],[(5,1.3)],[(0,1.0)],[(7,0.9)]]
+> pat4' = [[(3,0.5)],[(4,0.25)],[(0,0.25)],[(6,1.0)]]
+> pat4 = [[(3,0.5),(8,0.5),(22,0.5)],[(4,0.25),(7,0.25),(21,0.25)],
+> [(0,0.25),(5,0.25),(15,0.25)],[(6,1.0),(9,1.0),(19,1.0)]]
+
+\end{haskelllisting}
diff --git a/src/Haskore/Example/Ssf.lhs b/src/Haskore/Example/Ssf.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/Ssf.lhs
@@ -0,0 +1,40 @@
+The first phrase of the flute part of "Stars and Stripes Forever."
+
+\begin{haskelllisting}
+
+> module Haskore.Example.Ssf where
+> import Haskore.Composition.Trill as Trill
+> import Haskore.Melody as Melody
+> import Haskore.Music.GeneralMIDI as MidiMusic
+>
+> shortLegato :: Melody.T () -> Melody.T ()
+> shortLegato = legato (sn/10)
+>
+> m1, m2, m3, m4 :: [Melody.T ()]
+> m1 = [ trillN 2 5 (bf 2 en ()),
+> defltStaccato (line [ef 3 en (),
+> ef 2 en (),
+> ef 3 en ()])]
+>
+> m2 = [shortLegato (line [bf 2 sn (),
+> c 3 sn (),
+> bf 2 sn (),
+> g 2 sn ()]),
+> defltStaccato (line [ef 2 en (),
+> bf 1 en ()])]
+>
+> m3 = [shortLegato (line [ef 2 sn (),
+> f 2 sn (),
+> g 2 sn (),
+> af 2 sn ()]),
+> defltStaccato (line [bf 2 en (),
+> ef 3 en ()])]
+>
+> m4 = [ trill 2 tn (bf 2 qn ()),
+> bf 2 sn (),
+> denr]
+>
+> melody :: Melody.T ()
+> melody = line (m1 ++ m2 ++ m3 ++ m4)
+> song :: MidiMusic.T
+> song = MidiMusic.fromMelodyNullAttr MidiMusic.Flute (changeTempo 2 melody)
diff --git a/src/Haskore/Example/WhiteChristmas.hs b/src/Haskore/Example/WhiteChristmas.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Example/WhiteChristmas.hs
@@ -0,0 +1,101 @@
+
+{- Demonstrate handling of chords and drums -}
+
+module Haskore.Example.WhiteChristmas where
+
+import qualified Haskore.Composition.Drum as Drum
+import qualified Haskore.Composition.Chord as Chord
+import Haskore.Basic.Dynamics (Velocity)
+import Haskore.Melody.Standard as Melody
+import Haskore.Music.GeneralMIDI as MidiMusic
+import qualified Haskore.Music as Music
+import Haskore.Basic.Pitch (Class(..))
+
+import qualified Data.Accessor.Basic as Accessor
+
+
+vline :: [NoteAttributes -> Melody.T] -> Melody.T
+vline l = line (map ($ Melody.na) l)
+
+melody, strings :: Melody.T
+melody = line [m1, m2, m3a, m4a, m1, m2, m3b, m4b]
+strings = line (map chord
+ (Chord.leastVaryingInversions
+ ((1,C),(1,C))
+ (s1 ++ s2 ++ s3 ++ s4a ++ s1 ++ s2 ++ s3 ++ s4b)))
+
+m1, m2, m3a, m4a, m3b, m4b :: Melody.T
+m1 = vline [e 1 hn, f 1 en, e 1 en, ds 1 en, e 1 en,
+ f 1 hn, fs 1 en, g 1 dqn]
+m2 = enr +:+
+ vline [a 1 en, b 1 en, c 2 en,
+ d 2 en, c 2 en, b 1 en, a 1 en,
+ g 1 hn]
+m3a = qnr +:+ vline [c 1 en, d 1 en, e 1 qn, e 1 qn,
+ e 1 en, a 1 qn, g 1 en, c 1 qn, c 1 qn,
+ c 1 en, g 1 qn]
+m4a = vline [f 1 en, e 1 hn, f 1 en, e 1 en,
+ d 1 en, c 1 en, d 1 hn, g 0 hn]
+m3b = qnr +:+ vline [c 1 en, d 1 en, e 1 qn, e 1 qn,
+ e 1 en, a 1 qn, g 1 en, c 2 dhn]
+m4b = vline [c 1 en, d 1 en, e 1 qn, e 1 qn, a 1 en,
+ g 1 en, a 0 en, b 0 en, c 1 hn]
+
+v :: NoteAttributes
+v = vel 0.25
+
+vel :: Velocity -> NoteAttributes
+vel vl = Accessor.set Melody.velocity1 vl Melody.na
+
+s1, s2, s3, s4a, s4b :: [Chord.Generic NoteAttributes]
+s1 = [
+ Chord.generic C Chord.majorInt wn v,
+ Chord.generic D Chord.minorInt hn v,
+ Chord.generic G Chord.majorInt hn v
+ ]
+s2 = [
+ Chord.generic F Chord.majorInt wn v,
+ Chord.generic C Chord.majorInt hn v,
+ Chord.generic G Chord.sustainedFourthInt qn v,
+ Chord.generic G Chord.majorInt qn v
+ ]
+s3 = [
+ Chord.generic C Chord.majorInt qn v,
+ Chord.generic E Chord.minorInt qn v,
+ Chord.generic C Chord.dominantSeventhInt hn v,
+ Chord.generic F Chord.majorInt hn v,
+ Chord.generic F Chord.minorInt hn v
+ ]
+s4a =[
+ Chord.generic C Chord.majorInt hn v,
+ Chord.generic D Chord.minorInt qn v,
+ Chord.generic D Chord.majorInt qn v,
+ Chord.generic G Chord.sustainedFourthInt hn v,
+ Chord.generic G Chord.majorInt hn v
+ ]
+s4b =[
+ Chord.generic C Chord.majorInt hn v,
+ Chord.generic G Chord.majorInt hn v,
+ Chord.generic C Chord.majorInt hn v
+ ]
+
+
+bassdrum, snare, hihat :: Dur -> MidiMusic.T
+bassdrum durat = Drum.toMusic MidiMusic.AcousticBassDrum durat (vel 2)
+snare durat = Drum.toMusic MidiMusic.AcousticSnare durat (vel 1)
+hihat durat = Drum.toMusic MidiMusic.OpenHiHat durat (vel 1.5)
+
+rhythm :: MidiMusic.T
+rhythm =
+ line [bassdrum en, hihat sn, hihat sn,
+ snare en, hihat sn, hihat sn,
+ bassdrum en, hihat sn, hihat sn,
+ snare sn, hihat sn, hihat sn, hihat sn]
+
+song :: MidiMusic.T
+song = MidiMusic.changeTempo 1.2 $
+ MidiMusic.fromStdMelody MidiMusic.StringEnsemble1
+ (transpose 12 strings) =:=
+ MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano
+ (transpose 12 melody) =:=
+ Music.line (replicate 16 rhythm)
diff --git a/src/Haskore/General/GraphRecursiveGen.lhs b/src/Haskore/General/GraphRecursiveGen.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/GraphRecursiveGen.lhs
@@ -0,0 +1,103 @@
+> module Haskore.General.GraphRecursiveGen where
+
+> import qualified Haskore.General.GraphTaggedGen as GTG
+> import qualified Haskore.General.TagDictionary as Dict
+> import Data.Traversable(Traversable)
+> import qualified Data.Traversable as Traversable
+
+> import Control.Monad.RWS (RWS, evalRWS, liftM, put, get, tell)
+
+This is a generalization of \module{Haskore.General.LoopTreeTaggedGen}.
+It adds a constructor for sharing interim results.
+
+> data T coll =
+> Branch (coll (T coll))
+> | Recurse (Fix (T coll)) -- function with a fix-point
+> | Share (T coll) (T coll -> T coll)
+> -- share a sub-expression among deeper sub-expressions
+> | Reference Tag -- tag needed for resolving Recurse and Share by 'unwind'
+>
+> type Fix a = a -> a
+> type Tag = Int
+
+> recurse :: Fix (T coll) -> T coll
+> recurse = Recurse
+
+> share :: (T coll) -> (T coll -> T coll) -> T coll
+> share = Share
+
+Implement this one
+
+ let x = f y
+ y = g x
+ in h x y
+
+with recursion, but without sharing:
+
+ h (recurse (f . g)) (recurse (g . f))
+
+with recursion of tuples:
+
+ uncurry h $ recurse (\(x,y) -> (f y, g x))
+
+with recursion and sharing:
+
+ share (f y) (\x -> share (g x) (\y -> h x y)) -- wrong!
+
+
+> toTaggedUnique :: (Traversable coll) => Tag -> T coll -> GTG.T Tag coll
+> toTaggedUnique n branch = snd $ evalRWS (toTaggedState branch) () n
+
+> toTaggedState :: (Traversable coll) =>
+> T coll -> RWS () (GTG.T Tag coll) Tag (GTG.Tree Tag coll)
+> toTaggedState branch =
+> case branch of
+> Branch x -> liftM GTG.Branch (Traversable.mapM toTaggedState x)
+> Recurse fe -> do t <- get
+> put (succ t)
+> tree <- toTaggedState (fe (Reference t))
+> tell (Dict.singleton t tree)
+> return tree
+> Share x fe -> do t <- get
+> put (succ t)
+> sharedTree <- toTaggedState x
+> tell (Dict.singleton t sharedTree)
+> toTaggedState (fe (Reference t))
+> Reference t -> return (GTG.Reference t)
+
+> {-
+> fromTagged :: (Eq tag, Functor coll) => GTG.T tag coll -> [T coll]
+> fromTagged =
+> let aux branch =
+> case branch of
+> Branch x -> Branch (fmap aux x)
+> Reference tag -> fromMaybe
+> (error ("unknown reference tag"))
+> (lookup tag newDict)
+> newDict = map (\(tag, tree) -> (tag, aux tree)) dict
+> in newDict
+
+> let conv tags branch =
+> case branch of
+> GTG.Branch x -> Branch (fmap (conv tags) x)
+> GTG.Tag tag x -> Recurse (\y -> conv
+> (LTT.addUnique (tag,y) tags) x)
+> GTG.Loop tag -> fromMaybe (error ("unknown loop tag"))
+> (lookup tag tags)
+> in conv []
+> -}
+
+> instance (Traversable coll, GTG.CollEq coll) => Eq (T coll) where
+> x == y = toTaggedUnique 0 x == toTaggedUnique 0 y
+>
+> instance (Traversable coll, GTG.CollShow coll) => Show (T coll) where
+> showsPrec p x = showString "fromTagged " .
+> showParen (p>10) (showsPrec 11 (toTaggedUnique 0 x))
+
+Unwinding, i.e. computing fixpoints:
+
+> unwind :: (Functor coll) => T coll -> T coll
+> unwind (Branch x) = Branch (fmap unwind x)
+> unwind (Recurse fe) = x where x = unwind (fe x)
+> unwind (Reference _) = error "unwind: no loop allowed in a tree"
+> unwind (Share x fe) = fe (unwind x)
diff --git a/src/Haskore/General/GraphTaggedGen.lhs b/src/Haskore/General/GraphTaggedGen.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/GraphTaggedGen.lhs
@@ -0,0 +1,48 @@
+> module Haskore.General.GraphTaggedGen where
+
+> import qualified Haskore.General.TagDictionary as Dict
+
+This is a generalization from \module{Haskore.General.LoopTreeTaggedGen}
+to general graphs.
+The addition to that module is ``sharing''.
+It doesn't seem to be worthwile to put everything into a tree based structure.
+Instead we maintain a dictionary of sharing branches,
+where we split the signal either for feedback or for forward sharing.
+
+The dictionary structure should be shared
+with \module{Haskore.General.LoopTreeTagged}.
+
+> type T tag coll = Dict.T tag (Tree tag coll)
+> data Tree tag coll =
+> Branch (coll (Tree tag coll))
+> | Reference tag {- continue at one root of the dictionary,
+> this can mean feedback or sharing -}
+> -- deriving (Eq, Show)
+
+Cf. \module{Haskore.General.LoopTreeTaggedGen}.
+
+> class CollEq coll where
+> collEqual :: Eq tag => coll (Tree tag coll) -> coll (Tree tag coll) -> Bool
+
+> class CollShow coll where
+> collShowsPrec :: Show tag => Int -> coll (Tree tag coll) -> ShowS
+
+> instance (Eq tag, CollEq coll) => Eq (Tree tag coll) where
+> Branch x0 == Branch x1 = collEqual x0 x1
+> Reference i0 == Reference i1 = i0 == i1
+> _ == _ = False
+
+> instance (Show tag, CollShow coll) => Show (Tree tag coll) where
+> showsPrec p branch = showParen (p>10)
+> (case branch of
+> Branch x -> showString "Branch " . collShowsPrec 11 x
+> Reference i -> showString "Reference " . showsPrec 11 i)
+
+> unwind :: (Ord tag, Functor coll) => T tag coll -> T tag coll
+> unwind dict =
+> let aux branch =
+> case branch of
+> Branch x -> Branch (fmap aux x)
+> Reference tag -> Dict.lookup newDict tag
+> newDict = fmap aux dict
+> in newDict
diff --git a/src/Haskore/General/IO.hs b/src/Haskore/General/IO.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/IO.hs
@@ -0,0 +1,42 @@
+-----------------------------------------------------------------------------
+-- Implements only the functions necessary for Haskore!
+--
+-- Suitable for use with Hugs 98
+-----------------------------------------------------------------------------
+
+module Haskore.General.IO
+ (openBinaryFile, readBinaryFile, writeBinaryFile,
+ ByteString, stringCharFromByte, stringByteFromChar, )
+ where
+
+import System.IO
+ (IOMode(ReadMode, WriteMode),
+ openBinaryFile, hClose, hGetContents, hPutStr, )
+import Control.Exception(bracket)
+import Control.Monad(liftM)
+import Data.Char (ord, chr)
+import Data.Word (Word8)
+
+type ByteString = [Word8]
+
+{- |
+Hugs makes trouble here because it performs UTF-8 conversions.
+E.g. @[255]@ is output as @[195,191]@
+It would be easy to replace these routines by FastPackedString(fps).ByteString.Lazy,
+however this introduces a new package dependency.
+-}
+writeBinaryFile :: FilePath -> ByteString -> IO ()
+writeBinaryFile path str =
+ bracket (openBinaryFile path WriteMode) hClose
+ (flip hPutStr (stringCharFromByte str))
+
+stringCharFromByte :: ByteString -> String
+stringCharFromByte = map (chr . fromIntegral)
+
+readBinaryFile :: FilePath -> IO ByteString
+readBinaryFile path =
+ liftM stringByteFromChar .
+ hGetContents =<< openBinaryFile path ReadMode
+
+stringByteFromChar :: String -> ByteString
+stringByteFromChar = map (fromIntegral . ord)
diff --git a/src/Haskore/General/IdGenerator.lhs b/src/Haskore/General/IdGenerator.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/IdGenerator.lhs
@@ -0,0 +1,87 @@
+
+\subsection{Identifier generator}
+
+Generates unique elements but elements can be declared as unused, again.
+
+\begin{haskelllisting}
+
+> module Haskore.General.IdGenerator where
+
+> import Data.Set (Set)
+> import qualified Data.Set as Set
+> import Control.Monad.State(State(State),evalState,modify,get,when)
+> import Haskore.General.Utility(mapFst)
+
+\end{haskelllisting}
+
+The generator is a state monad
+where the state consists of the set of the explicitly unused elements
+and a lower bound for another set of ids that are still unused.
+Essentially, the Set stores all recycled ids,
+and the lower bound stores the ids not used so far.
+All elements in the explicit set must be below the bound.
+
+\begin{haskelllisting}
+
+> type T i a = State (St i) a
+
+> type St i = (Set i, i)
+
+> run :: i -> T i a -> a
+> run start gen = evalState gen (Set.empty, start)
+
+\end{haskelllisting}
+
+Reserve a new id.
+
+\begin{haskelllisting}
+
+> alloc :: (Ord i, Enum i) => T i i
+> alloc =
+> State $ \(set, next) ->
+> if Set.null set
+> then (next, (set, succ next))
+> else let (newId, newSet) = Set.deleteFindMin set
+> in (newId, (newSet, next))
+
+\end{haskelllisting}
+
+Return an id.
+
+We call reduce in order to prevent the set from growing too much.
+We call it only once in order to prevent a heavy CPU lead
+when the last id of a sequence is returned.
+So the reduction is spread over several calls to 'free'.
+
+\begin{haskelllisting}
+
+> free :: (Ord i, Enum i) => i -> T i ()
+> free oldId =
+> do s <- get
+> when (isFree s oldId)
+> (error "IdGenerator.free: id freed twice")
+> modify (mapFst (Set.insert oldId))
+> modify reduce
+
+\end{haskelllisting}
+
+If the largest free id and the lower bound of free ids are successive elements
+then we can decrease the lower bound.
+This procedure can be iterated.
+This way we can save storage in the set.
+
+\begin{haskelllisting}
+
+> reduce :: (Ord i, Enum i) => St i -> St i
+> reduce (set, next) =
+> if not (Set.null set) && Set.findMax set == pred next
+> then (Set.deleteMax set, pred next)
+> else (set, next)
+
+> isFree :: (Ord i) => St i -> i -> Bool
+> isFree (set,next) i = Set.member i set || i >= next
+
+> isValid :: (Ord i) => St i -> Bool
+> isValid (set,next) = Set.findMax set < next
+
+\end{haskelllisting}
diff --git a/src/Haskore/General/LoopTreeRecursive.lhs b/src/Haskore/General/LoopTreeRecursive.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/LoopTreeRecursive.lhs
@@ -0,0 +1,115 @@
+> module Haskore.General.LoopTreeRecursive where
+
+> import qualified Haskore.General.LoopTreeTagged as LTT
+> import qualified Haskore.General.TagDictionary as Dict
+
+> import Control.Monad.State(MonadState, evalState, mapM, liftM, put, get)
+
+Loop now needs an ID because there may be more than one of them.
+
+> data T a =
+> Branch a [T a]
+> | Recurse (Fix (T a)) -- function with a fix-point
+> | Loop Tag -- tag needed for resolving Recurse by 'unwind'
+>
+> type Fix a = a -> a
+> type Tag = Int
+
+> example0 :: T Char
+> example0 = Recurse (\x -> Branch 'a' [Recurse (\y -> Branch 'b' [y]), x])
+
+> example1 :: T Char
+> example1 =
+> Branch 'a'
+> [Recurse (\x -> Branch 'b' [x]),
+> Recurse (\y -> Branch 'c' [y])]
+
+Implement two interleaved recursions.
+
+ let x = f y
+ y = g x z
+ z = h y
+ in z
+
+> exampleLeapFrog :: T Char
+> exampleLeapFrog =
+> Recurse (\z -> Branch 'h' [
+> Recurse (\y -> Branch 'g' [
+> Branch 'f' [y],z])])
+
+This data structure is very safe to use,
+that is, it is not possible to loop to undefined tags
+as in \code{LoopTreeTagged}.
+But some operations are easier to perform on the tagged variant.
+Especially we can not inspect the structure
+of the \code{Recurse} function immediately.
+Instead we have to place a \code{Loop} marker
+inside the tree produced by the \code{Recurse} function.
+In order to turn such a marked tree back into a \code{Recurse} function
+we have to maintain a dictionary.
+This is obviously not very efficient.
+Intensive operations should be applied to the tagged tree.
+We provide the conversions now.
+
+The function \function{toTagged} uses duplicate tags in different branches.
+They do not cause confusion but reduce data dependencies.
+
+> toTagged :: Tag -> T a -> LTT.T Tag a
+> toTagged n branch =
+> case branch of
+> Branch x s -> LTT.Branch x (map (toTagged n) s)
+> Recurse fe -> LTT.Tag n (toTagged (succ n) (fe (Loop n)))
+> Loop m -> LTT.Loop m
+
+The function \function{toTaggedUnique}
+employs a State in order to assign tags
+that are unique overall the whole tree.
+
+> toTaggedUnique :: Tag -> T a -> LTT.T Tag a
+> toTaggedUnique n branch = evalState (toTaggedState branch) n
+
+> toTaggedState :: (Enum tag, MonadState tag m) => T a -> m (LTT.T tag a)
+> toTaggedState branch =
+> case branch of
+> Branch x s -> liftM (LTT.Branch x) (mapM toTaggedState s)
+> Recurse fe -> do n <- get
+> put (succ n)
+> liftM (LTT.Tag n)
+> (toTaggedState (fe (Loop (fromEnum n))))
+> Loop m -> return (LTT.Loop (toEnum m))
+
+> fromTagged :: (Ord tag) => LTT.T tag a -> T a
+> fromTagged =
+> let conv tags branch =
+> case branch of
+> LTT.Branch x s -> Branch x (map (conv tags) s)
+> LTT.Tag tag x -> Recurse (\y -> conv
+> (Dict.insert tag y tags) x)
+> LTT.Loop tag -> Dict.lookup tags tag
+> in conv Dict.empty
+
+To check equality of and show Trees,
+we need to supply unique Tags to each recursive loop,
+which we do via a simple counter.
+
+> instance Eq a => Eq (T a) where
+> x == y = toTagged 0 x == toTagged 0 y
+>
+> instance Show a => Show (T a) where
+> show = show . toTaggedUnique 0
+>
+> instance Functor T where
+> fmap f = fromTagged . fmap f . toTagged 0
+
+Unwinding (i.e. computing fixpoints):
+
+> unwind :: T a -> T a
+> unwind (Branch x s) = Branch x (map unwind s)
+> unwind (Recurse fe) = x where x = unwind (fe x)
+> unwind (Loop _) = error "unwind: no loop allowed in a tree"
+
+The 2nd equation above is analogous to:
+fix f = x where x = f x
+And these two equations could also be written as:
+fix f = f (fix f)
+unwind (Rec fe) = unwind (fe (Rec fe))
diff --git a/src/Haskore/General/LoopTreeRecursiveGen.lhs b/src/Haskore/General/LoopTreeRecursiveGen.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/LoopTreeRecursiveGen.lhs
@@ -0,0 +1,74 @@
+> module Haskore.General.LoopTreeRecursiveGen where
+
+> import qualified Haskore.General.LoopTreeTaggedGen as LTTG
+> import qualified Haskore.General.TagDictionary as Dict
+
+> import Data.Traversable(Traversable)
+> import qualified Data.Traversable as Traversable
+
+> import Control.Monad.State(MonadState, evalState, liftM, put, get)
+
+The Loop constructor should not be used by users.
+It is only necessary for interim results of 'toTagged'.
+With the type \code{data ListTree a b = ListTree a [b]},
+a \type{LoopTreeRecursiveGen.T (ListTree a)}
+is isomoprhic to \type{LoopTreeRecursive.T a}.
+'Tag' is a fixed type instead of a type variable
+since it is only needed for internal issues.
+
+> data T coll =
+> Branch (coll (T coll))
+> | Recurse (Fix (T coll)) -- function with a fix-point
+> | Loop Tag -- tag needed for resolving Recurse by 'unwind'
+>
+> type Fix a = a -> a
+> type Tag = Int
+
+> recurse :: Fix (T coll) -> T coll
+> recurse = Recurse
+
+> toTagged :: (Functor coll) => Tag -> T coll -> LTTG.T Tag coll
+> toTagged n branch =
+> case branch of
+> Branch x -> LTTG.Branch (fmap (toTagged n) x)
+> Recurse fe -> LTTG.Tag n (toTagged (succ n) (fe (Loop n)))
+> Loop m -> LTTG.Loop m
+
+> toTaggedUnique :: (Traversable coll) => Tag -> T coll -> LTTG.T Tag coll
+> toTaggedUnique n branch = evalState (toTaggedState branch) n
+
+> toTaggedState :: (Traversable coll, Enum tag, MonadState tag m) =>
+> T coll -> m (LTTG.T tag coll)
+> toTaggedState branch =
+> case branch of
+> Branch x -> liftM LTTG.Branch (Traversable.mapM toTaggedState x)
+> Recurse fe -> do n <- get
+> put (succ n)
+> liftM (LTTG.Tag n)
+> (toTaggedState (fe (Loop $ fromEnum n)))
+> Loop m -> return (LTTG.Loop $ toEnum m)
+
+> fromTagged :: (Functor coll) => LTTG.T Tag coll -> T coll
+> fromTagged =
+> let conv tags branch =
+> case branch of
+> LTTG.Branch x -> Branch (fmap (conv tags) x)
+> LTTG.Tag tag x -> Recurse (\y -> conv
+> (Dict.insert tag y tags) x)
+> LTTG.Loop tag -> Dict.lookup tags tag
+> in conv Dict.empty
+
+
+> instance (Functor coll, LTTG.CollEq coll) => Eq (T coll) where
+> x == y = toTagged 0 x == toTagged 0 y
+>
+> instance (Functor coll, LTTG.CollShow coll) => Show (T coll) where
+> showsPrec p x = showString "fromTagged " .
+> showParen (p>10) (showsPrec 11 (toTagged 0 x))
+
+Unwinding, i.e. computing fixpoints:
+
+> unwind :: (Functor coll) => T coll -> T coll
+> unwind (Branch x) = Branch (fmap unwind x)
+> unwind (Recurse fe) = x where x = unwind (fe x)
+> unwind (Loop _) = error "unwind: no loop allowed in a tree"
diff --git a/src/Haskore/General/LoopTreeTagged.lhs b/src/Haskore/General/LoopTreeTagged.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/LoopTreeTagged.lhs
@@ -0,0 +1,62 @@
+> module Haskore.General.LoopTreeTagged where
+
+> import qualified Haskore.General.TagDictionary as Dict
+
+> data T tag a =
+> Branch a [T tag a]
+> | Tag tag (T tag a) -- mark a point where we want return to later
+> | Loop tag -- return to a marked point
+> deriving (Eq, Show)
+
+The tag for \code{Tag} must be unique,
+but multiple use in \code{Loop} is allowed.
+Vice versa tags for \code{Loop} must be defined by a \code{Tag} constructor.
+
+> example0 :: T Int Char
+> example0 = Tag 0 (Branch 'a' [Tag 1 (Branch 'b' [Loop 1]), Loop 0])
+
+\begin{comment}
+
+Eq and Show
+
+instance (Eq tag, Eq a) => Eq (T tag a) where
+ Branch x xSub == Branch y ySub = x == y && xSub == ySub
+ Tag xTag xSub == Tag yTag ySub = xTag == yTag && xSub == ySub
+ Loop xTag == Loop yTag = xTag == yTag
+ _ == _ = False
+
+instance (Show tag, Show a) => Show (T tag a) where
+ show (Const x) = "(Const " ++ show x ++ ")"
+ show (Add e1 e2) = "(Add " ++ show e1 ++ " " ++ show e2 ++ ")"
+ show (Tag i e) = "(Tag " ++ show i ++ " " ++ show e ++ ")"
+ show (Loop i) = "(Loop " ++ show i ++ ")"
+
+\end{comment}
+
+MapE:
+
+> mapE :: (a -> b) -> T tag a -> T tag b
+> mapE f =
+> let aux branch =
+> case branch of
+> Branch x sub -> Branch (f x) (map aux sub)
+> Tag tag sub -> Tag tag (aux sub)
+> Loop tag -> Loop tag
+> in aux
+
+> instance Functor (T tag) where
+> fmap = mapE
+
+Replace all loops by the corresponding super-trees.
+Internally the compiler should translate this into loops, again,
+but this cannot be observed by the Haskell code anymore.
+
+> unwind :: (Ord tag) => T tag a -> T tag a
+> unwind =
+> let aux tags branch =
+> case branch of
+> Branch x sub -> Branch x (map (aux tags) sub)
+> Tag tag sub -> let e' = aux (Dict.insert tag e' tags) sub
+> in e'
+> Loop tag -> Dict.lookup tags tag
+> in aux Dict.empty
diff --git a/src/Haskore/General/LoopTreeTaggedGen.lhs b/src/Haskore/General/LoopTreeTaggedGen.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/LoopTreeTaggedGen.lhs
@@ -0,0 +1,57 @@
+> module Haskore.General.LoopTreeTaggedGen where
+
+> import qualified Haskore.General.TagDictionary as Dict
+
+
+Similar to \module{Haskore.General.LoopTreeTagged},
+but here the sub-trees are organized in general collection types \type{coll}.
+Actually we do not want to use generic collections, like Set or so,
+but we want to store custom data plus sub-trees in \type{coll} type objects.
+
+> data T tag coll =
+> Branch (coll (T tag coll))
+> | Tag tag (T tag coll) -- mark a point where we want return to later
+> | Loop tag -- return to a marked point
+> -- deriving (Eq, Show)
+
+In order to avoid non-standard instance class contexts,
+undecidable instances and other mess,
+we define the classes CollEq and CollShow,
+which allow implementation of Eq and Show instances
+for collections without making assumptions about the collection members.
+Coding CollEq and CollShow instances for collections is quite boring
+because this is mainly replication of code
+that would be otherwise generated automatically due to a 'deriving' clause.
+
+(Proposed by Roberto Zunino
+2006-03-11 in haskell-cafe@haskell.org)
+
+> class CollEq coll where
+> collEqual :: Eq tag => coll (T tag coll) -> coll (T tag coll) -> Bool
+
+> class CollShow coll where
+> collShowsPrec :: Show tag => Int -> coll (T tag coll) -> ShowS
+
+> instance (Eq tag, CollEq coll) => Eq (T tag coll) where
+> Branch x0 == Branch x1 = collEqual x0 x1
+> Tag tag0 x0 == Tag tag1 x1 = tag0 == tag1 && x0 == x1
+> Loop i0 == Loop i1 = i0 == i1
+> _ == _ = False
+
+> instance (Show tag, CollShow coll) => Show (T tag coll) where
+> showsPrec p branch = showParen (p>10)
+> (case branch of
+> Branch x -> showString "Branch " . collShowsPrec 11 x
+> Tag i e -> showString "Tag " . showsPrec 11 i
+> . showString " " . showsPrec 11 e
+> Loop i -> showString "Loop " . showsPrec 11 i)
+
+> unwind :: (Ord tag, Functor coll) => T tag coll -> T tag coll
+> unwind =
+> let aux tags branch =
+> case branch of
+> Branch x -> Branch (fmap (aux tags) x)
+> Tag tag sub -> let e' = aux (Dict.insert tag e' tags) sub
+> in e'
+> Loop tag -> Dict.lookup tags tag
+> in aux Dict.empty
diff --git a/src/Haskore/General/Map.hs b/src/Haskore/General/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/Map.hs
@@ -0,0 +1,65 @@
+module Haskore.General.Map
+ (Map, (!), (\\), null, size, member, lookup, findWithDefault,
+ empty, singleton,
+ insert, insertWith, insertWithKey, insertLookupWithKey,
+ delete, adjust, adjustWithKey,
+ update, updateWithKey, updateLookupWithKey,
+ union, unionWith, unionWithKey, unions, unionsWith,
+ difference, differenceWith, differenceWithKey,
+ intersection, intersectionWith, intersectionWithKey,
+ map, mapWithKey, mapAccum, mapAccumWithKey,
+ mapKeys, mapKeysWith, mapKeysMonotonic,
+ fold, foldWithKey, elems, keys, keysSet,
+ assocs, toList, fromList, fromListWith, fromListWithKey,
+ toAscList, fromAscList, fromAscListWith, fromAscListWithKey,
+ fromDistinctAscList, filter, filterWithKey,
+ partition, partitionWithKey, split, splitLookup,
+ isSubmapOf, isSubmapOfBy, isProperSubmapOf, isProperSubmapOfBy,
+ lookupIndex, findIndex, elemAt, updateAt, deleteAt,
+ findMin, findMax, deleteMin, deleteMax, deleteFindMin, deleteFindMax,
+ updateMin, updateMax, updateMinWithKey, updateMaxWithKey,
+ showTree, showTreeWith, valid)
+ where
+
+import qualified Data.Map as Map
+import Data.Map
+ (Map, (!), (\\), null, size, member, empty, singleton,
+ insert, insertWith, insertWithKey, insertLookupWithKey,
+ delete, adjust, adjustWithKey,
+ update, updateWithKey, updateLookupWithKey,
+ union, unionWith, unionWithKey, unions, unionsWith,
+ difference, differenceWith, differenceWithKey,
+ intersection, intersectionWith, intersectionWithKey,
+ map, mapWithKey, mapAccum, mapAccumWithKey,
+ mapKeys, mapKeysWith, mapKeysMonotonic,
+ fold, foldWithKey, elems, keys, keysSet,
+ assocs, toList, fromList, fromListWith, fromListWithKey,
+ toAscList, fromAscList, fromAscListWith, fromAscListWithKey,
+ fromDistinctAscList, filter, filterWithKey,
+ partition, partitionWithKey, split, splitLookup,
+ isSubmapOf, isSubmapOfBy, isProperSubmapOf, isProperSubmapOfBy,
+ elemAt, updateAt, deleteAt,
+ findMin, findMax, deleteMin, deleteMax, deleteFindMin, deleteFindMax,
+ updateMin, updateMax, updateMinWithKey, updateMaxWithKey,
+ showTree, showTreeWith, valid)
+
+import Prelude hiding (lookup, map, filter, null)
+
+{-
+ The signatures of the lookup functions in Data.Map
+ are very unfortunate.
+ We replace them by more usable ones here.
+-}
+
+lookup :: (Monad m, Ord k) => Map k a -> k -> m a
+lookup = flip Map.lookup
+
+findWithDefault :: Ord k => Map k a -> a -> k -> a
+findWithDefault dict deflt key =
+ Map.findWithDefault deflt key dict
+
+lookupIndex :: (Monad m, Ord k) => Map k a -> k -> m Int
+lookupIndex = flip Map.lookupIndex
+
+findIndex :: Ord k => Map k a -> k -> Int
+findIndex = flip Map.findIndex
diff --git a/src/Haskore/General/Monad.lhs b/src/Haskore/General/Monad.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/Monad.lhs
@@ -0,0 +1,105 @@
+
+These functions were formerly located in a module called "HugsUtils" --
+but it was too messy to make it a "standard Hugs library"
+so we moved it over here.
+
+> module Haskore.General.Monad where
+
+> import Control.Monad (MonadPlus, mplus, liftM2)
+
+ToDo: decide on appropriate fixities for these functions
+
+\begin{haskelllisting}
+
+> infixr 2 `andOnError`, `butOnError`
+>
+> assert :: Bool -> String -> IO ()
+> assert True _ = return ()
+> assert False msg = ioError (userError msg)
+
+\end{haskelllisting}
+
+Resource (de)allocation can interact badly with error handling code.
+For example, even if the programmer has taken care that every
+resource allocation is paired with an appropriate deallocation,
+they might forget to release resources when an exception is
+invoked. For example, this program would fail to close
+\code{outFile} if an error occured while operating on one of the \code{inFile}s.
+
+\begin{haskelllisting}
+
+ cat :: String -> [String] -> IO ()
+ cat outfile files = do
+ outFile <- open outfile WriteMode
+ mapM_ (\file -> do
+ inFile <- open file ReadMode
+ copy inFile outFile
+ close inFile
+ )
+ files
+ close outFile
+
+\end{haskelllisting}
+
+The following functions provide ways of ensuring that a piece of
+"cleanup code" is executed even if an exception is raised.
+
+\begin{itemize}
+\item
+ \lstinline!m `andOnError` k! is like \lstinline!m >> k! except that \code{k} gets executed
+ even if an exception is raised in \code{m}.
+\item
+ \lstinline!m `butOnError` k! is like \code{m} except that \code{k} gets executed if
+ an exception is raised in \code{m}.
+\end{itemize}
+
+For example, the following version of \code{cat} guarantees to close all
+files even if an error occurs.
+
+\begin{haskelllisting}
+
+ cleancat :: String -> [String] -> IO ()
+ cleancat outfile files = do
+ outFile <- open outfile WriteMode
+ mapM_ (\file -> do
+ open file ReadMode >>= \ inFile ->
+ copy inFile outFile `andOnError`
+ close inFile
+ )
+ files
+ `andOnError`
+ close outFile
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> andOnError :: IO a -> IO b -> IO b
+> m `andOnError` k = (m `catch` \e -> k >> ioError e) >> k
+
+\end{haskelllisting}
+
+Use this to add some cleanup code k that only gets executed
+if an error occurs during execution of m.
+
+\begin{haskelllisting}
+
+> butOnError :: IO a -> IO () -> IO a
+> m `butOnError` k = (m `catch` \e -> k >> ioError e)
+
+> zeroOrMore, oneOrMore :: MonadPlus m => m a -> m [a]
+> zeroOrMore m = return [] `mplus` oneOrMore m
+> oneOrMore m = liftM2 (:) m (zeroOrMore m)
+
+\end{haskelllisting}
+
+Repeat the action \code{m} until the result fulfills \code{p}.
+
+\begin{haskelllisting}
+
+> untilM :: Monad m => (a -> Bool) -> m a -> m a
+> untilM p m =
+> do x <- m
+> if p x then return x else untilM p m
+
+\end{haskelllisting}
diff --git a/src/Haskore/General/TagDictionary.hs b/src/Haskore/General/TagDictionary.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/TagDictionary.hs
@@ -0,0 +1,21 @@
+{- |
+For use in Tree and Graph modules.
+-}
+module Haskore.General.TagDictionary (T, empty, insert, lookup, singleton) where
+
+import Haskore.General.Map (Map, empty, singleton)
+import qualified Haskore.General.Map as Map
+
+import Prelude hiding (lookup)
+
+
+type T tag tree = Map tag tree
+
+insert :: Ord tag => tag -> tree -> Map tag tree -> Map tag tree
+insert =
+ Map.insertWith
+ (error "TagDictionary.insert: multiple definition of tag")
+
+lookup :: (Ord tag) => Map tag tree -> tag -> tree
+lookup dict =
+ Map.findWithDefault dict (error "unknown loop tag")
diff --git a/src/Haskore/General/Utility.lhs b/src/Haskore/General/Utility.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/General/Utility.lhs
@@ -0,0 +1,504 @@
+\subsection{Utility functions}
+
+\begin{haskelllisting}
+
+> module Haskore.General.Utility(
+> fst3, snd3, thd3, mapPair, mapFst, mapSnd, flipPair,
+> flattenTuples2, flattenTuples3, flattenTuples4,
+> mergeBy, partition, splitBy, segmentBefore,
+> shuffle, removeDups, foldrf,
+> roundDiff, roundDiff',
+> mapInit, splitInit, headWithDefault,
+> zapWith, zipWithMatch, zipWithMatch3,
+> maximum0, maximumKey, minimumKey,
+> limit, translate, randList, select,
+> equalField, equalRecord,
+> compareField, compareRecord, composeDouble,
+> divisible, divide, modulus, divideModulus, gcdDur,
+> toMaybe, partitionMaybe
+> ) where
+>
+> import Control.Monad.State (State(State), runState)
+> import System.Random(RandomGen, randomR, randomRs, mkStdGen)
+> import Data.List (group, find, foldl', maximumBy, minimumBy)
+> import Data.Ratio((%), denominator, numerator, Ratio)
+> import Data.Maybe (fromMaybe, listToMaybe)
+> import qualified Haskore.General.Map as Map
+
+
+\end{haskelllisting}
+
+Support for triples.
+
+\begin{haskelllisting}
+
+> fst3 :: (a,b,c) -> a
+> fst3 (x,_,_) = x
+
+> snd3 :: (a,b,c) -> b
+> snd3 (_,x,_) = x
+
+> thd3 :: (a,b,c) -> c
+> thd3 (_,_,x) = x
+
+\end{haskelllisting}
+
+Given two lists that are ordered
+(i.e. \lstinline!p x y! holds for subsequent \code{x} and \code{y})
+mergeBy them into a list that is ordered, again.
+
+This could be used for parallel compositions of \code{Performance.T}
+if the events had absolute times.
+
+\begin{haskelllisting}
+
+> mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+> mergeBy p =
+> let recurse xl@(x:xs) yl@(y:ys) =
+> if p x y then x : recurse xs yl
+> else y : recurse xl ys
+> recurse [] yl = yl
+> recurse xl [] = xl
+> in recurse
+
+\end{haskelllisting}
+
+\code{List.partition} of GHC 6.2.1 fails on infinite lists.
+But this one does not.
+The strict evaluation of the argument \code{(y,z)} is necessary
+since otherwise it fails on infinite lists.
+
+\begin{haskelllisting}
+
+> partition :: (a -> Bool) -> [a] -> ([a], [a])
+> partition p =
+> foldr (\x ~(y,z) -> if p x then (x : y, z)
+> else (y, x : z)) ([],[])
+
+\end{haskelllisting}
+
+\function{splitBy} takes a boolean test and a list;
+it divides up the list and turns it into a {\em list of sub-lists};
+each sub-list consists of
+\begin{enumerate}
+\item
+one element for which the test is true (or the first element in the list), and
+\item
+all elements after that element for which the test is false.
+\end{enumerate}
+For example, \code{splitBy (>10) [27, 0, 2, 1, 15, 3, 42, 4]}
+yields \code{[ [27,0,2,1], [15,3], [42,4] ]}.
+\begin{haskelllisting}
+
+> splitBy :: (a -> Bool) -> [a] -> [[a]]
+> splitBy p = dropWhile null . segmentBefore p
+
+> segmentBefore :: (a -> Bool) -> [a] -> [[a]]
+> segmentBefore p =
+> foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]
+
+\end{haskelllisting}
+
+\function{segmentBefore} will have at most one empty list at the beginning,
+which is dropped by \function{dropWhile}.
+
+It should have signature
+ segmentBefore :: (a -> Bool) -> [a] -> ([a], [(a, [a])])
+or even better
+ segmentBefore :: (a -> Bool) -> [a] -> AlternatingListUniform.T a [a]
+and could be implemented using Uniform.fromEitherList
+
+A variant of \function{foldr} and \function{foldr1}
+which works only for non-empty lists
+and initializes the accumulator depending on the last element of the list.
+
+\begin{haskelllisting}
+
+> foldrf :: (a -> b -> b) -> (a -> b) -> [a] -> b
+> foldrf f g =
+> let aux [] = error "foldrf: list must be non-empty"
+> aux (x:[]) = g x
+> aux (x:xs) = f x (aux xs)
+> in aux
+
+\end{haskelllisting}
+
+
+
+Randomly permutate a list.
+For this purpose we generate a random \type{Bool} value
+for each item of the list
+which specifies in what sun-list it is inserted.
+Both sublists are then concatenated hereafter.
+By repeating this procedure several times
+the list should be somehow randomly ordered.
+
+Some notes about perfect shuffling from Oleg:
+\url{http://okmij.org/ftp/Haskell/misc.html#perfect-shuffle}
+
+\begin{haskelllisting}
+
+> shuffle :: RandomGen g => [a] -> g -> ([a],g)
+> shuffle x g0 =
+> let (choices,g1) = runState (mapM (const (State (randomR (False,True)))) x) g0
+> xc = zip x choices
+> in (map fst (uncurry (++) (partition snd xc)), g1)
+
+\end{haskelllisting}
+
+Remove consecutive duplicates from a list.
+The implementation could avoid \function{head},
+if the \function{group} would indicate by its return type,
+that all sub-lists are non-empty.
+\begin{haskelllisting}
+
+> removeDups :: Eq a => [a] -> [a]
+> removeDups = map head . group
+
+\end{haskelllisting}
+
+
+Given the time fraction that remains from the preceding event
+and the current time difference,
+evaluate an integer time difference and
+the remaining fractional part.
+If we would simply map Time to integer values
+with respect to the sampling rate,
+then rounding errors would accumulate.
+\begin{haskelllisting}
+
+> roundDiff' :: (RealFrac t, Integral i) => t -> t -> (i, t)
+> roundDiff' time frac =
+> let x = time+frac
+> n = round x
+> in (n, x - fromIntegral n)
+
+> roundDiff :: (RealFrac t, Integral i) => t -> State t i
+> roundDiff = State . roundDiff'
+
+\end{haskelllisting}
+
+Apply two functions on corresponding values.
+
+Instead of pattern matching with say \code{(x,y)}
+we use \function{fst} and \function{snd}.
+Pattern matching with \code{(x,y)} is too lazy (or too strict?)
+so it can be that the pair parameter is the result
+of an infinite recursion.
+It can not be matched until the recursion is finished,
+because the program don't know whether it is bottom.
+The functions \function{fst} and \function{snd}
+seems to work-around this problem.
+
+\begin{haskelllisting}
+
+> -- Control.Arrow.***
+> mapPair :: (a -> c, b -> d) -> (a,b) -> (c,d)
+> mapPair ~(f,g) ~(x,y) = (f x, g y)
+> -- mapPair f x = (fst f (fst x), snd f (snd x))
+
+> -- Control.Arrow.first
+> mapFst :: (a -> c) -> (a,b) -> (c,b)
+> mapFst f ~(x,y) = (f x, y)
+
+> -- Control.Arrow.second
+> mapSnd :: (b -> d) -> (a,b) -> (a,d)
+> mapSnd g ~(x,y) = (x, g y)
+
+> flipPair :: (a,b) -> (b,a)
+> flipPair (x,y) = (y,x)
+
+\end{haskelllisting}
+
+\function{flattenTuples2} flattens a list of pairs into a list.
+Similarly, \function{flattenTuples3} flattens a list of 3-tuples into a list,
+and so on.
+\begin{haskelllisting}
+
+> flattenTuples2 :: [(a,a)] -> [a]
+> flattenTuples3 :: [(a,a,a)] -> [a]
+> flattenTuples4 :: [(a,a,a,a)] -> [a]
+>
+> flattenTuples2 = concatMap (\(x,y) -> [x,y])
+> flattenTuples3 = concatMap (\(x,y,z) -> [x,y,z])
+> flattenTuples4 = concatMap (\(x,y,z,w) -> [x,y,z,w])
+
+\end{haskelllisting}
+
+
+
+Map all elements by f except the last one, which is kept unchanged.
+
+\begin{haskelllisting}
+
+> mapInit :: (a -> a) -> [a] -> [a]
+> mapInit f =
+> foldr (\x ys -> (if null ys then x else f x) : ys) []
+
+ mapInit' :: (a -> a) -> [a] -> [a]
+ mapInit' f xs =
+ let repf = map (const f) xs -- replicate f lazily to (length xs)
+ in zipWith ($) (tail (repf ++ [id])) xs
+
+ quickCheck
+ (\x -> mapInit succ x == mapInit' succ (x::[Integer]))
+
+
+ mapInit'' :: (a -> a) -> [a] -> [a]
+ mapInit'' f = foldrf (\x ys -> f x : ys) (:[])
+
+ quickCheck
+ (\x -> not (null (x::[Integer])) ==>
+ mapInit succ x == mapInit' succ x)
+
+\end{haskelllisting}
+
+This is a combination of \function{init} and \function{last}
+which avoids memoizing the list
+if the last element is accessed after the initial ones.
+
+\begin{haskelllisting}
+
+> splitInit :: [a] -> ([a], a)
+> splitInit [] = error "splitInit: empty list"
+> splitInit [x] = ([], x)
+> splitInit (x:xs) =
+> mapPair ((x:),id) (splitInit xs)
+
+ propSplitInit :: Eq a => [a] -> Bool
+ propSplitInit xs =
+ splitInit xs == (init xs, last xs)
+
+\end{haskelllisting}
+
+Choose the first element from a list,
+and return the default value, if the list is empty.
+\begin{haskelllisting}
+
+> headWithDefault :: a -> [a] -> a
+> headWithDefault deflt = fromMaybe deflt . listToMaybe
+
+\end{haskelllisting}
+
+Implementation with the partial function \function{head},
+which is a bad thing.
+
+\begin{haskelllisting}
+
+ headWithDefault deflt xs = head (xs ++ [deflt])
+
+\end{haskelllisting}
+
+
+
+Compare
+\begin{haskelllisting}
+
+ let (x,y) = splitInit [0..] in (last x, y)
+
+\end{haskelllisting}
+and
+\begin{haskelllisting}
+
+ let as = [0..]; (x,y) = (init as, last as) in (last x, y)
+
+\end{haskelllisting}
+
+
+This function combines every pair of neighbour elements
+in a list with a certain function.
+
+\begin{haskelllisting}
+
+> zapWith :: (a -> a -> b) -> [a] -> [b]
+> zapWith f x = zipWith f x (tail x)
+
+\end{haskelllisting}
+
+Variants of \function{zip} and \function{zip3}
+which check that all argument lists have the same length.
+
+\begin{haskelllisting}
+
+> zipWithMatch :: (a -> b -> c) -> [a] -> [b] -> [c]
+> zipWithMatch f (x:xs) (y:ys) = f x y : zipWithMatch f xs ys
+> zipWithMatch _ [] [] = []
+> zipWithMatch _ _ _ = error "zipWithMatch: lengths of lists differ"
+
+> zipWithMatch3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
+> zipWithMatch3 f (x:xs) (y:ys) (z:zs) = f x y z : zipWithMatch3 f xs ys zs
+> zipWithMatch3 _ [] [] [] = []
+> zipWithMatch3 _ _ _ _ = error "zipWithMatch3: lengths of lists differ"
+
+\end{haskelllisting}
+
+This is a variant of \function{maximum}
+which returns at least zero, i.e. always a non-negative number.
+This is necessary for determining the length of a parallel music composition
+where the empty list has zero duration.
+
+\begin{haskelllisting}
+
+> maximum0 :: (Ord a, Num a) => [a] -> a
+> maximum0 = foldl' max 0
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> maximumKey, minimumKey :: (Ord b) => (a -> b) -> [a] -> a
+> maximumKey f = maximumBy (compareField f)
+> minimumKey f = minimumBy (compareField f)
+
+\end{haskelllisting}
+
+A combination of \function{min} and \function{max}
+for clipping a value to a certain range.
+
+\begin{haskelllisting}
+
+> limit :: (Ord a) => (a,a) -> a -> a
+> limit (l,u) = max l . min u
+
+\end{haskelllisting}
+
+From a list of expressions choose the one,
+whose condition is true.
+
+\begin{haskelllisting}
+
+> select :: a -> [(Bool, a)] -> a
+> select def = maybe def snd . find fst
+
+\end{haskelllisting}
+
+
+Compare the same field of two records.
+
+\begin{haskelllisting}
+
+> composeDouble :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
+> composeDouble g f x y = g (f x) (f y)
+
+> compareField :: Ord b => (a -> b) -> a -> a -> Ordering
+> compareField = composeDouble compare
+
+\end{haskelllisting}
+
+Lexicographically compare a list of attributes of two records.
+
+\begin{haskelllisting}
+
+> compareRecord :: [a -> a -> Ordering] -> a -> a -> Ordering
+> compareRecord cs x y =
+> head (dropWhile (EQ==) (map (\c -> c x y) cs) ++ [EQ])
+
+\end{haskelllisting}
+
+
+\begin{haskelllisting}
+
+> equalField :: Eq b => (a -> b) -> a -> a -> Bool
+> equalField = composeDouble (==)
+
+> equalRecord :: [a -> a -> Bool] -> a -> a -> Bool
+> equalRecord cs x y = all (\c -> c x y) cs
+
+\end{haskelllisting}
+
+
+Convert a mapping (i.e. list of pairs) to a function, and use this for a
+translation function, which translates every character in a by replacing it by
+looking it up in l2 and replacing it with the according character in l2.
+
+\begin{haskelllisting}
+
+> translate :: (Ord a) => [ a ] -> [ a ] -> [ a ] -> [ a ]
+> translate l1 l2 a =
+> if length l1 == length l2
+> then let table = Map.fromList (zip l1 l2)
+> in map (\x -> Map.findWithDefault table x x) a
+> else error "translate: lists must have equal lengths"
+
+\end{haskelllisting}
+
+A random list of integers between 0 and n.
+
+\begin{haskelllisting}
+
+> randList :: Int -> [ Int ]
+> randList n = randomRs (0, n) (mkStdGen 0)
+
+\end{haskelllisting}
+
+Is one rational divisible by another one (i.e., is it a integer multiple of it)?
+
+\begin{haskelllisting}
+
+> divisible :: Integral a => Ratio a -> Ratio a -> Bool
+> divisible r1 r2 =
+> 0 == mod (numerator r1 * denominator r2)
+> (numerator r2 * denominator r1)
+
+\end{haskelllisting}
+
+Do the division.
+
+\begin{haskelllisting}
+
+> divide :: Integral a => Ratio a -> Ratio a -> a
+> divide r1 r2 =
+> let (q, r) = divideModulus r1 r2
+> in if r == 0
+> then q
+> else error "Utility.divide: rationals are indivisible"
+
+> modulus :: Integral a => Ratio a -> Ratio a -> Ratio a
+> modulus r1 r2 = snd (divideModulus r1 r2)
+
+> divideModulus :: Integral a => Ratio a -> Ratio a -> (a, Ratio a)
+> divideModulus r1 r2 =
+> let (q, r) = divMod (numerator r1 * denominator r2)
+> (numerator r2 * denominator r1)
+> in (q, r % (denominator r1 * denominator r2))
+
+\end{haskelllisting}
+
+Also the GCD can be generalized to ratios:
+
+\begin{haskelllisting}
+
+> gcdDur :: Integral a => Ratio a -> Ratio a -> Ratio a
+> gcdDur x1 x2 =
+> let a = numerator x1
+> b = denominator x1
+> c = numerator x2
+> d = denominator x2
+> in gcd a c % lcm b d
+
+\end{haskelllisting}
+
+Returns 'Just' if the precondition is fulfilled.
+
+\begin{haskelllisting}
+
+> toMaybe :: Bool -> a -> Maybe a
+> toMaybe False _ = Nothing
+> toMaybe True x = Just x
+
+\end{haskelllisting}
+
+Every element which evaluates to Just is put into the first list.
+The second list contains the remaining elements.
+It holds \expression{mapMaybe f == fst . partitionMaybe f}
+and \expression{partition p == partitionMaybe (\ x -> toMaybe (p x) x)}.
+
+\begin{haskelllisting}
+
+> partitionMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
+> partitionMaybe f =
+> foldr (\x ~(y,z) -> case f x of
+> Just x' -> (x' : y, z)
+> Nothing -> (y, x : z)) ([],[])
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/ChartBar.lhs b/src/Haskore/Interface/AutoTrack/ChartBar.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/ChartBar.lhs
@@ -0,0 +1,81 @@
+% from AutoTrack by Stefan Ratschan
+
+\section{Chord-Symbol-, Scale- and other Charts}
+\label{sec:charts}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.ChartBar
+> (T(Cons), dur, chords, readChordSymbol,
+> length) where
+
+> import qualified Haskore.Music as Music
+> import qualified Data.List as List
+> import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol
+> import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable
+> import Data.Char(isSpace, isAlpha)
+
+> import Haskore.Basic.Duration(wn, (%+), )
+> import qualified Haskore.Basic.Duration as Dur
+
+> import Prelude hiding (length)
+
+\end{haskelllisting}
+
+A bar consists of a time signature and a list of chord symbols. Bars have the following
+input syntax:
+
+\begin{verbatim}
+ bar = { chord | timeSig | '%' | '_' }
+ timeSig = '(' int '/' int ')'
+\end{verbatim}
+
+If no time signature is provided then a default is used (within chord chart the time
+signature of the bar before, and 4/4 for the first bar). The character '\%' is a short-cut
+for the chords just before. The character '\_' denotes a break.
+
+\begin{haskelllisting}
+
+> data T = Cons {
+> dur :: Music.Dur,
+> chords :: [ Maybe ChordSymbol.T ]
+> } deriving Show
+>
+> length :: Integral a => T -> a
+> length = fromIntegral . List.length . chords
+
+> instance Read T where
+> readsPrec _ = readChordSymbol wn Nothing
+
+> readChordSymbol :: Music.Dur -> Maybe ChordSymbol.T -> ReadS T
+> readChordSymbol oldSig oldChord (c:s) | isSpace c = readChordSymbol oldSig oldChord s
+> readChordSymbol _ oldChord s@('(':_) =
+> [ (Cons r b, r2) | (r, r1) <- readSig s,
+> (Cons _ b, r2) <- readChordSymbol r oldChord r1 ]
+> readChordSymbol oldSig (Just chord) ('%':r) =
+> [ (Cons oldSig (Just chord:b), r1) | (Cons _ b, r1) <- readChordSymbol oldSig (Just chord) r ]
+> readChordSymbol oldSig (Just _) ('_':r) =
+> [ (Cons oldSig (Nothing:b), r1) | (Cons _ b, r1) <- readChordSymbol oldSig Nothing r ]
+> readChordSymbol oldSig _ s@(d:_) | isAlpha d =
+> [ (Cons oldSig (Just c:b), r2) | (c, r1) <- reads s,
+> (Cons _ b, r2) <- readChordSymbol oldSig (Just c) r1 ]
+> readChordSymbol oldSig _ s = [ (Cons oldSig [], s) ]
+>
+> readSig :: ReadS Music.Dur
+> readSig s@('(':_) =
+> let readRatio s' =
+> [ (p%+q, r1) |
+> (p,'/':r) <- reads s', (q, r1) <- reads r ]
+> in readParen True readRatio s
+> readSig _ = []
+
+\end{haskelllisting}
+
+Bars can be transposed.
+
+\begin{haskelllisting}
+
+> instance Transposeable.C T where
+> transpose i (Cons d l) = Cons d (fmap (fmap (Transposeable.transpose i)) l)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/ChordChart.lhs b/src/Haskore/Interface/AutoTrack/ChordChart.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/ChordChart.lhs
@@ -0,0 +1,106 @@
+% from AutoTrack by Stefan Ratschan
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.ChordChart
+> (T(Cons), bars, hasChord,
+> length, concat) where
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar
+> import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable
+> import qualified Haskore.Basic.Duration as Dur
+> import Haskore.Basic.Duration (wn, (%+), )
+> import Data.Char(isSpace)
+> import qualified Data.List as List
+
+> import Prelude hiding (length, concat)
+
+\end{haskelllisting}
+
+
+Chord charts are lists of bars. They have the following input syntax:
+
+\begin{verbatim}
+ chart = { (bar | '%') '|' }
+\end{verbatim}
+
+The character '\%' is a shortcut for the same bar as before.
+Comments can occur everywhere in the text.
+They start with "--" and continue till the end of the current line.
+
+\begin{haskelllisting}
+
+> data T = Cons {bars :: [ ChartBar.T ] } deriving Show
+
+> length :: Integral a => T -> a
+> length = fromIntegral . List.length . bars
+
+> instance Read T where
+> readsPrec _ = Haskore.Interface.AutoTrack.ChordChart.read
+
+> concat :: T -> T -> T
+> concat (Cons x) (Cons y) = Cons (x++y)
+
+> read :: ReadS T
+> read s = read1 (ChartBar.Cons wn []) (filterComment s)
+
+> filterComment :: String -> String
+> filterComment ('-':'-':r) = filterComment (tail (snd (break (=='\n') r)))
+> filterComment (c:r) = (c:filterComment r)
+> filterComment "" = ""
+
+> read1 :: ChartBar.T -> ReadS T
+> read1 lb (c:r) | isSpace c =
+> read1 lb (dropWhile isSpace r)
+> read1 lb ('%':r) =
+> [ (Cons (lb:br), r2) |
+> ('|':r1) <- [ dropWhile isSpace r ],
+> (Cons br, r2) <- read1 lb r1 ]
+> read1 (ChartBar.Cons sig _) s@(_:_) =
+> [ (Cons (b:br), r1) |
+> (b, ('|':r)) <- ChartBar.readChordSymbol sig Nothing s,
+> (Cons br, r1) <- read1 b r ]
+> read1 _ s = [ (Cons [], s) ]
+
+\end{haskelllisting}
+
+Chord charts can be transposed.
+
+\begin{haskelllisting}
+
+> instance Transposeable.C T where
+> transpose i (Cons c) = Cons (fmap (Transposeable.transpose i) c)
+
+\end{haskelllisting}
+
+We can extract a Boolean list from a chord chart that tells whether there is a chord at a certain position
+(hc[i] is true iff d*i has a chord).
+
+\begin{haskelllisting}
+
+> hasChord :: T -> (Music.Dur, [ Bool ] )
+> hasChord c =
+> let g = barGCD c
+> in (g, hasChord1 g c)
+
+> hasChord1 :: Music.Dur -> T -> [ Bool ]
+> hasChord1 bDur (Cons c) = List.concat (map (hasChordBar bDur) c)
+
+> barUnit :: ChartBar.T -> Music.Dur -> Dur.Ratio
+> barUnit bar d = d * (1 %+ ChartBar.length bar)
+
+> hasChordBar :: Music.Dur -> ChartBar.T -> [ Bool ]
+> hasChordBar bDur bar@(ChartBar.Cons d chords) =
+> let times =
+> fromInteger
+> (Dur.divide (barUnit bar d) bDur)
+> createList = replicate times . maybe False (const True)
+> in concatMap createList chords
+
+> barGCD :: T -> Music.Dur
+> barGCD (Cons c) =
+> let chordDur bar = barUnit bar (ChartBar.dur bar)
+> in foldr1 Dur.gcd (map chordDur c)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/ChordSymbol.lhs b/src/Haskore/Interface/AutoTrack/ChordSymbol.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/ChordSymbol.lhs
@@ -0,0 +1,110 @@
+% from AutoTrack by Stefan Ratschan
+
+\section{Chord Symbols}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.ChordSymbol
+> (T(Cons, root, chordType),
+> toChord,
+> toString, parse) where
+> import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable
+> import qualified Haskore.Basic.Pitch as Pitch
+> -- import qualified Haskore.Basic.Scale as Scale
+> import qualified Haskore.Composition.ChordType as ChordType
+> import qualified Text.ParserCombinators.ReadP as ReadP
+> import Text.ParserCombinators.ReadP (ReadP)
+> import Haskore.General.Utility(mapSnd)
+
+\end{haskelllisting}
+
+A chord symbol consists of its root, its bass note, and the description of the type of
+chord. The chord type description is currently in free (string) form and only used by some
+very experimental code.
+
+\begin{haskelllisting}
+
+> data T = Cons { root :: Pitch.Class,
+> bassnote :: Pitch.Class,
+> chordType :: ChordType.T } deriving Eq
+
+\end{haskelllisting}
+
+Now we define input and output of chord symbols. Note that we denote sharp and
+flat root notes by '\#' and 'b' respectively, instead of 's' and 'f' as in
+Haskore.
+
+\begin{haskelllisting}
+
+> instance Show T where
+> showsPrec _ ch =
+> ("(ChordSymbol "++) .
+> shows (root ch) . (" "++) .
+> shows (bassnote ch) . (" "++) .
+> shows (chordType ch) . (")"++)
+
+> instance Read T where
+> readsPrec _ = ReadP.readP_to_S parse
+
+> parse :: ReadP T
+> parse =
+> do r <- parsePitch
+> t <- ChordType.parse
+> b <- return r ReadP.+++
+> (ReadP.char '/' >> parsePitch)
+> return (Cons r b t)
+
+> parsePitch :: ReadP Pitch.Class
+> parsePitch = ReadP.readS_to_P readSPitch
+
+> readSPitch :: ReadS Pitch.Class
+> readSPitch (p:'#':r) = continueReadS r (p:"s")
+> readSPitch (p:'b':r) = continueReadS r (p:"f")
+> readSPitch (p:r) = continueReadS r [p]
+> readSPitch "" = [] -- error "readSPitch: empty string"
+
+> continueReadS :: (Read a) => String -> ReadS a
+> continueReadS r p = map (mapSnd (++r)) (reads p)
+
+\end{haskelllisting}
+
+We also can transpose chord symbols.
+
+\begin{haskelllisting}
+
+> instance Transposeable.C T where
+> transpose i c = Cons (Transposeable.transpose i (root c))
+> (Transposeable.transpose i (bassnote c))
+> (chordType c)
+
+\end{haskelllisting}
+
+Now we are going to determine the according scale for various chords. Not that such
+``default scales'' exist only for some few chords. We plan to implement a
+detailed scale analyzer for chord charts (see section~\ref{sec:charts}) in the
+future.
+
+\begin{haskelllisting}
+
+> {-
+> toScale :: T -> Scale.T
+> toScale (Cons {root=r, chordType=ct}) =
+> (case ct of
+> Type ThirdMajor FourthNone [] -> Scale.ionian
+> Type ThirdMinor FourthNone [] -> Scale.dorian
+> _ -> error ("ChordSymbol.toScale: unknown chord type " ++ show ct)) r
+> -}
+>
+> toChord :: T -> [Pitch.T]
+> toChord (Cons {root=r, chordType=ct}) =
+> map (flip Pitch.transpose (0,r)) (ChordType.toChord ct)
+>
+> toString :: T -> String
+> toString chord =
+> let rp = root chord
+> bp = bassnote chord
+> in Pitch.classFormat rp
+> (ChordType.toString (chordType chord))
+> ++ if rp == bp then "" else "/"++Pitch.classFormat bp ""
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/EventChart.lhs b/src/Haskore/Interface/AutoTrack/EventChart.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/EventChart.lhs
@@ -0,0 +1,53 @@
+% from AutoTrack by Stefan Ratschan
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.EventChart
+> (T(Cons), events, fromChordChart, fromChartBar) where
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar
+> import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart
+> import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol
+> import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Data.List as List
+> import Data.Maybe(fromJust)
+
+\end{haskelllisting}
+
+Event charts are currently not used. An event chart represents a list of objects of a
+certain type and duration (the ``events'').
+
+\begin{haskelllisting}
+
+> data T e = Cons {events :: [ (Music.Dur, e) ] } deriving Show
+
+> fromChordChart :: ChordChart.T -> T ChordSymbol.T
+> fromChordChart (ChordChart.Cons c) =
+> Cons (concatMap (events . fromChartBar) c)
+
+> fromChartBar :: ChartBar.T -> T ChordSymbol.T
+> fromChartBar (ChartBar.Cons d l) =
+> let f c = (d / Dur.fromRatio (List.genericLength l), fromJust c)
+> in Cons (map f l)
+
+\end{haskelllisting}
+
+Transpose an event chart by a certain number of semitones
+
+\begin{haskelllisting}
+
+> instance (Transposeable.C a) => Transposeable.C (T a) where
+> transpose i = fmap (Transposeable.transpose i)
+
+\end{haskelllisting}
+
+Event charts can also act as functors:
+
+\begin{haskelllisting}
+
+> instance Functor T where
+> fmap f (Cons v) = Cons (map ( \(d, c) -> (d, f c) ) v)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/Instrument.lhs b/src/Haskore/Interface/AutoTrack/Instrument.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/Instrument.lhs
@@ -0,0 +1,44 @@
+% from AutoTrack by Stefan Ratschan
+
+\section{Instruments}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.Instrument
+> (T, bass, bottomRange, topRange) where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+
+\end{haskelllisting}
+
+Here we store various information about instruments. Currently the only information is the
+range of an instrument (its highest possible and lowest possible note).
+
+\begin{haskelllisting}
+
+> data T = Cons { lowest, highest :: Pitch.T }
+
+> bass :: T
+> bass = Cons { lowest=(2, Pitch.E), highest=(7, Pitch.G) } -- ???
+
+\end{haskelllisting}
+
+Create the deepest/highest note of a certain pitchclass, that an instrument can create.
+
+\begin{haskelllisting}
+
+> bottomRange :: T -> Pitch.Class -> Pitch.T
+> bottomRange instr cl =
+> let (boct, bcl) = lowest instr
+> in if cl > bcl
+> then (boct, cl)
+> else (boct+1, cl)
+
+> topRange :: T -> Pitch.Class -> Pitch.T
+> topRange instr cl =
+> let (boct, bcl) = highest instr
+> in if cl < bcl
+> then (boct, cl)
+> else (boct-1, cl)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/Main.lhs b/src/Haskore/Interface/AutoTrack/Main.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/Main.lhs
@@ -0,0 +1,162 @@
+% from AutoTrack by Stefan Ratschan
+
+\documentclass[10pt]{article}
+
+\usepackage[a4paper, margin=3cm]{geometry}
+\usepackage{url}
+
+\usepackage{color}
+\definecolor{darkgrey}{rgb}{0.4,0.4,0.4}
+\definecolor{lightgrey}{rgb}{0.95,0.95,0.95}
+
+
+\usepackage{listings}
+
+\lstset{%
+ language=Haskell,
+ showstringspaces=false,
+ basicstyle=\ttfamily,
+ keywordstyle=\textbf,
+ commentstyle=\highlightcomment,
+ backgroundcolor=\color{lightgrey}}
+
+\newcommand\highlightcomment[1]{\textsl{\color{darkgrey}#1}}
+\lstnewenvironment{haskelllisting}
+ {\lstset{language=Haskell,gobble=2,firstline=2}}{}
+\lstnewenvironment{haskellblock}
+ {\mbox{}\\\lstset{language=Haskell}}{}
+
+
+\newcommand{\STitle}{\texttt{AutoTrack}}
+
+\title{\STitle}
+\author{Stefan Ratschan}
+
+\begin{document}
+
+\maketitle
+
+\section{Introduction}
+
+This software has a short term and a long term goal. The short term goal is a tool for
+creating practicing tracks for musicians. For this it is already usable: You feed it with
+some chord chart, tell it the style of music, and it outputs some MIDI file with a simple
+drum and bass track over these chords. The long term goal is a sophisticated high-level
+composing environment, especially useful for creating demos for bands. You should be able to
+make instructions like: Give me four bars of mainstream jazz over these chords, then
+switch to heavy-metal, using this melody and these chords, afterwards a short drum break,
+and so on.
+
+Under Microsoft Windows there are a lot of different programs for music production systems
+(Cubase, Band-In-A-Box, Finale). Instead of such WYSIWYG systems, the UNIX world has
+traditionally used language-based approaches in various application areas (e.g. \LaTeX for
+typesetting). The advantage of the first approach is that it is easier to learn, the
+advantage of the second approach is that it is more flexible (and one can always add
+a WYSIWYG interface afterwards). For this software we follow the second approach.
+
+In the area of music various languages for representing and creating music have been
+developed, see \cite{dannenberg:89}, \cite{collinge:84}, \cite{anderson:91} and
+\cite{cointe:84} for just a few examples. Most of the existing systems provide very
+general languages with an emphasis on gaining theorical insight, while the system, that is
+presented here, should be \emph{practical} and \emph{useful}.
+
+For writing the software, the library \texttt{Haskore} \cite{haskore} programmed in the
+functional programming language \texttt{Haskell} (see \cite{haskell, hudak:96} for further
+references) proved to be the perfect basis for such a system. Another author, Martin
+Schwenke \cite{schwenke}, is working on a similar system, aimed at a slightly different
+application area.
+
+This program is free software; you can redistribute it and/or modify it under the terms of
+the GNU General Public License as published by the Free Software Foundation; either
+version 2 of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
+without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+See the GNU General Public License for more details.
+
+This document consists of a (short) user-manual, and the literate source code.
+
+
+
+\section{User Manual}
+
+The program acts as a filter, which takes some chord chart from standard input, and writes
+the corresponding MIDI file to standard output. This output can be directly piped into
+some MIDI player. Information about run-time options can be obtained by calling the
+program with the \texttt{-h} option.
+
+The syntax of input files is as follows:
+
+\begin{haskelllisting}
+ chart = { (bar | '%') '|' }
+
+ bar = { chord | timeSig | '%' }
+
+ timeSig = '(' int '/' int ')'
+
+\end{haskelllisting}
+
+Chords follow the usual syntax (e.g., like in the Real Book). The character \texttt{\%}
+acts as a short-cut for repeating the last bar or chord, respectively. Examples of chord
+charts come with the program distribution.
+
+\section{Main Program}
+
+We just extract the options from the command-line, and construct a string-to-string filter
+from the chord-chart and options.
+
+\begin{haskelllisting}
+
+> module Main where
+> import qualified Option
+> import qualified Haskore.Interface.AutoTrack.Style as Style
+> import Haskore.General.IO (stringCharFromByte)
+
+> main :: IO ()
+> main = do (t, s, r, c) <- Option.getAll
+> interact (fmap stringCharFromByte $
+> Style.playToStream r s t c . read)
+
+\end{haskelllisting}
+
+\input{ChartBar.lhs}
+\input{ChordChart.lhs}
+\input{EventChart.lhs}
+\input{ScaleChart.lhs}
+
+\input{Style.lhs}
+
+\input{ChordSymbol.lhs}
+
+\input{Instrument.lhs}
+
+%\input{Scales.lhs}
+
+%\input{Rhythm.lhs}
+
+\input{Transposeable.lhs}
+
+\input{Option.lhs}
+
+\section{Todo}
+
+\begin{itemize}
+\item rock style: electric bass
+\item humanize drums (tempo, single notes)
+\item modularize styles, make style creation simpler
+\item walking bass
+\item recording music / reading in MIDI files
+\item intros, codas, turnarounds etc.
+\item breaks (e.g. night in tunesia), rhythmic accents
+\item different styles within one theme (e.g., on green dolphin street)
+\item error messages on wrong chord charts (for example takeFive not in 5/4 measure) (prelude function "error") via Monads!!!
+\item more structured approach to parsing chord charts (either parsing tool/library, or
+ via ReadS, or: treat EBNF rules as function definitions, EBNF operators as combinators);
+ Even better: Try to get rid of a custom file format and to replace it by descriptions in pure Haskell code.
+\item various degrees of shuffle
+\end{itemize}
+
+\bibliographystyle{abbrv}
+\bibliography{composer}
+
+\end{document}
diff --git a/src/Haskore/Interface/AutoTrack/Option.lhs b/src/Haskore/Interface/AutoTrack/Option.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/Option.lhs
@@ -0,0 +1,131 @@
+% from AutoTrack by Stefan Ratschan
+
+For extracting the options from the command line
+we use the \texttt{GetOpt} package proviced by \texttt{ghc}.
+This is currently a little bit of a mess.
+It should be reimplemented using the technique described at
+\url{http://www.haskell.org/haskellwiki/GetOpt}.
+
+\begin{haskelllisting}
+
+> module Option(T, getAll) where
+
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Interface.AutoTrack.Style as Style
+> import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart
+
+> import System.Console.GetOpt (getOpt, usageInfo,
+> ArgDescr(NoArg, ReqArg), OptDescr(Option), ArgOrder(Permute))
+> import System.Environment (getArgs)
+> import System.Exit (exitWith, ExitCode(ExitSuccess, ExitFailure))
+
+> import Haskore.General.Utility (headWithDefault)
+> import Data.Maybe (listToMaybe, mapMaybe)
+> import Data.List (intersperse)
+
+> {-
+> Should be a record with one constructor and multiple fields, i.e.
+> data T = Cons {optError :: String, optTempo :: Integer, ...}
+> This should replace Tuple.
+> -}
+
+> data T = Error String
+> | Tempo Integer
+> | Style Style.T
+> | Transpose Int
+> | Choruses Int
+> | Help
+
+> isHelp :: T -> Bool
+> isHelp Help = True
+> isHelp _ = False
+
+> errorToMaybe :: T -> Maybe String
+> errorToMaybe (Option.Error m) = Just m
+> errorToMaybe _ = Nothing
+
+> -- should be [ OptDescr (T -> T) ]
+> options :: [ OptDescr T ]
+> options = [ Option [ 't' ] [ "tempo" ] (ReqArg tempoOption "TEMPO") "TEMPO of track",
+> Option [ 'r' ] [ "transpose" ] (ReqArg transposeOption "TRANSPOSE") "TRANSPOSE track",
+> Option [ 's' ] [ "style" ] (ReqArg styleOption "STYLE") "music STYLE",
+> Option [ 'c' ] [ "choruses" ] (ReqArg chorusesOption "CHORUSES") "number of CHORUSES",
+> Option [ 'h' ] [ "help" ] (NoArg Option.Help) "display usage" ]
+
+> tempoOption, transposeOption, styleOption,
+> chorusesOption :: String -> T
+
+> tempoOption = Option.Tempo . read
+> transposeOption = Option.Transpose . read
+
+> styles :: [(String, ChordChart.T -> MidiMusic.T)]
+> styles = [("jazz", Style.jazz),
+> ("bossa", Style.bossa),
+> ("takeFive", Style.takeFive),
+> ("rock", Style.rock),
+> ("harmonic", Style.harmonic)]
+
+> styleOption s =
+> maybe (Option.Error ("Unknown style '"++s++"'\n"))
+> Option.Style (lookup s styles)
+
+> chorusesOption = Choruses . read
+
+> usage :: String
+> usage = usageInfo "\nUsage: track [OPTION...] outfile\n" options ++
+> "\nAvailable styles: " ++ concat (intersperse ", " (map fst styles)) ++ "\n\n" ++
+> "This program is free software; you can redistribute it and/or\n" ++
+> "modify it under the terms of the GNU General Public License\n" ++
+> "as published by the Free Software Foundation; either version 2\n" ++
+> "of the License, or (at your option) any later version.\n\n" ++
+> "This program is distributed in the hope that it will be useful,\n" ++
+> "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" ++
+> "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" ++
+> "GNU General Public License for more details.\n"
+
+> processAll :: [String] -> IO [T]
+> processAll argv =
+> case (getOpt Permute options argv) of
+> (o,_,[] ) -> return o
+> (_,_,errs) -> fail (concat errs ++ usage)
+
+> getDefault :: (a -> Maybe b) -> [ a ] -> b -> b
+> getDefault b t def = headWithDefault def (mapMaybe b t)
+
+> getTempo :: T -> Maybe Integer
+> getTempo (Option.Tempo t) = Just t
+> getTempo _ = Nothing
+
+> getTrans, getChoruses :: T -> Maybe Int
+> getTrans (Option.Transpose t) = Just t
+> getTrans _ = Nothing
+
+> getChoruses (Option.Choruses c) = Just c
+> getChoruses _ = Nothing
+
+> getStyle :: T -> Maybe (ChordChart.T -> MidiMusic.T)
+> getStyle (Option.Style s) = Just s
+> getStyle _ = Nothing
+
+> type Tuple = (Integer, Style.T, Int, Int)
+
+> toTuple :: [ T ] -> Tuple
+> toTuple l = (getDefault getTempo l 120,
+> getDefault getStyle l Style.jazz,
+> getDefault getTrans l 0,
+> getDefault getChoruses l 5)
+
+> exit :: Bool -> String -> IO a
+> exit c m = do putStr (m ++ usage)
+> if c then exitWith ExitSuccess else exitWith (ExitFailure 1)
+
+> getError :: [ T ] -> Maybe String
+> getError = listToMaybe . mapMaybe errorToMaybe
+
+> getAll :: IO Tuple
+> getAll = do opts <- (getArgs >>= processAll)
+> if any isHelp opts
+> then exit True ""
+> else maybe (return (toTuple opts)) (exit False) (getError opts)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/ScaleChart.lhs b/src/Haskore/Interface/AutoTrack/ScaleChart.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/ScaleChart.lhs
@@ -0,0 +1,30 @@
+% from AutoTrack by Stefan Ratschan
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.ScaleChart(T(Cons)) where
+
+> import qualified Haskore.Basic.Scale as Scale
+
+\end{haskelllisting}
+
+
+A certain type of event chart is a scale chart.
+
+\begin{haskelllisting}
+
+> newtype T = Cons Scale.T
+
+\end{haskelllisting}
+
+Conversion from chord chart to ScaleChart. This needs to be improved into a
+sophisticated scale analyzer.
+
+\begin{haskelllisting}
+
+ fromChord :: (EventChart.T ChordSym) -> T
+ fromChord (EventChart.C c) =
+ let f d ch = (d, chordToScale ch)
+ in Cons (map f c)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/Style.lhs b/src/Haskore/Interface/AutoTrack/Style.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/Style.lhs
@@ -0,0 +1,366 @@
+% from AutoTrack by Stefan Ratschan
+
+\section{Styles}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.Style
+> (T, playToStream, jazz, bossa, takeFive, rock,
+> thomasCarib, harmonic) where
+
+> import Haskore.General.Utility (select, splitInit)
+> import Haskore.General.IO (ByteString)
+> import Haskore.Basic.Duration (en, qn, (%+), )
+> import Haskore.Music ((+:+), (=:=), )
+
+> import qualified Haskore.Composition.Rhythm as Rhythm
+> import qualified Haskore.Composition.Drum as Drum
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Interface.MIDI.Render as MidiRender
+> import qualified Sound.MIDI.File.Save as MidiSave
+
+> import qualified Haskore.Interface.AutoTrack.Transposeable as Transposeable
+> import qualified Haskore.Interface.AutoTrack.ChordSymbol as ChordSymbol
+> import qualified Haskore.Interface.AutoTrack.ChartBar as ChartBar
+> import qualified Haskore.Interface.AutoTrack.ChordChart as ChordChart
+> import qualified Haskore.Interface.AutoTrack.EventChart as EventChart
+> import qualified Haskore.Interface.AutoTrack.Instrument as Instrument
+
+\end{haskelllisting}
+
+A style takes a chord chart and creates some music out of it.
+
+\begin{haskelllisting}
+
+> type T = ChordChart.T -> MidiMusic.T
+> type TMelody = ChordChart.T -> Melody.T ()
+
+\end{haskelllisting}
+
+
+\subsection{Filtering music}
+
+Filtering certain parts from music,
+in order to introduce rests \emph{after} the creation of some music.
+The needed information can be encoded in several ways:
+
+\begin{enumerate}
+\item [ (Music.Dur, Music.Dur) ]: Place of rest, length of rest, sorted
+\item [ Music.Dur ]: Place to switch from rest to music, or other way round
+\item Music.Dur [ Bool ]: Some basic duration and then True implies music, False implies Rest
+\end{enumerate}
+
+We use the third possibility here, but use a helper function with a more general
+interface, which additionally specifies the length of the first list member
+(different from the basic duration).
+
+\begin{haskelllisting}
+
+> filterMusic :: Music.Dur -> [ Bool ] -> Music.T note -> Music.T note
+> filterMusic = fm 0
+
+> fm :: Music.Dur -> Music.Dur -> [ Bool ] -> Music.T note -> Music.T note
+> fm fDur bDur plc =
+> Music.switchBinary
+> (\dur at -> case at of
+> (Just _) -> Music.atom (min dur (musicDur fDur bDur plc)) at
+> (Nothing) -> Music.rest dur)
+> (\ctrl m -> case ctrl of
+> (Music.Tempo t) -> Music.changeTempo t (fm (fDur*t) (bDur*t) plc m)
+> _ -> Music.control ctrl m)
+> (\m0 m1 -> let m0' = fm fDur bDur plc m0
+> (rFDur, rPlc) = remLen bDur plc (Music.dur m0 - fDur)
+> m1' = fm rFDur bDur rPlc m1
+> in m0' +:+ m1')
+> (\m0 m1 -> fm fDur bDur plc m0 =:= fm fDur bDur plc m1)
+> (Music.rest 0)
+
+> remLen :: Music.Dur -> [ Bool ] -> Music.Dur -> (Music.Dur, [ Bool ])
+> remLen bDur plc len =
+> if bDur>len
+> then (bDur-len, plc)
+> else (len-bDur, tail plc)
+
+> musicDur :: (Num a) => a -> a -> [Bool] -> a
+> musicDur fDur bDir plc =
+> sum (zipWith const (fDur : repeat bDir) (takeWhile id plc))
+> -- sum (map fst (takeWhile snd (zip (fDur : repeat bDir) plc)))
+
+\end{haskelllisting}
+
+
+\subsection{Playing Styles}
+
+Playing a chord chart and style into a stream of binary MIDI data.
+We abuse a String to store it.
+
+\begin{haskelllisting}
+
+> playToStream :: Int -> T -> Integer -> Int -> ChordChart.T -> ByteString
+> playToStream trans style tempo chornum chart =
+> let countin = Rhythm.countIn (ChartBar.dur (head (ChordChart.bars chart)))
+> choruses = Music.replicate chornum (style (Transposeable.transpose trans chart))
+> music = Music.changeTempo (tempo%+60) (countin +:+ choruses)
+> in MidiSave.toByteList (MidiRender.generalMidiDeflt music)
+
+\end{haskelllisting}
+
+\subsection{Drum Fill}
+
+\begin{haskelllisting}
+
+> jazzFill :: Music.Dur -> MidiMusic.T
+> jazzFill d =
+> if d >= 2%+4
+> then
+> let shuffle dr =
+> Rhythm.toShuffledMusicWithDrumUnit en dr . Rhythm.fromString
+> in Music.rest (d-2%+4) +:+
+> (shuffle Drum.SplashCymbal "...x" =:=
+> shuffle Drum.AcousticBassDrum "...x" =:=
+> shuffle Drum.AcousticSnare ".xx.")
+> else error "jazzFill: d must be at least 2%+4"
+
+> endFill :: [ ChartBar.T ] -> MidiMusic.T
+> endFill l = let (initLd,lastLd) = splitInit $ map ChartBar.dur l
+> in Music.line (map Music.rest initLd) +:+
+> jazzFill lastLd
+
+\end{haskelllisting}
+
+\subsection{Bass Lines}
+
+First some auxiliary function to play the bass note of a chord.
+
+\begin{haskelllisting}
+
+> bassFromMelody :: Melody.T () -> MidiMusic.T
+> bassFromMelody =
+> MidiMusic.fromMelodyNullAttr MidiMusic.AcousticBass
+
+> bassChoose :: (Music.Dur, ChordSymbol.T) -> Melody.T ()
+> bassChoose (l, (ChordSymbol.Cons _ b _)) = bassNote l b
+
+> bassNote :: Music.Dur -> Pitch.Class -> Melody.T ()
+> bassNote l b =
+> Melody.note (Instrument.bottomRange Instrument.bass b) l ()
+
+\end{haskelllisting}
+
+\subsubsection{Chart Bass}
+
+This bass line style plays the root of a chord on every chord of a chord chart.
+
+\begin{haskelllisting}
+
+> evFromCC :: ChordChart.T -> [(Music.Dur, ChordSymbol.T)]
+> evFromCC = EventChart.events . EventChart.fromChordChart
+
+> chartBass :: TMelody
+> chartBass =
+> Music.line . map bassChoose . evFromCC
+
+\end{haskelllisting}
+
+\subsubsection{Quarter Bass}
+
+This bass line style plays the root of the current chord on every quarter note.
+It first creates chords on every beat, then maps bassChoose to it.
+Problem: Right now only works if all chords are on quarter notes!
+
+\begin{haskelllisting}
+
+> splitToDur :: Music.Dur -> [ ( Music.Dur, e ) ] -> [ ( Music.Dur, e ) ]
+> splitToDur sd =
+> concatMap (\(d,e) -> replicate (fromInteger (Dur.divide d sd)) (sd, e))
+
+> quarterBass :: TMelody
+> quarterBass =
+> Music.line . map bassChoose . splitToDur (1%+4) . evFromCC
+
+> eighthBass :: TMelody
+> eighthBass =
+> Music.line . map bassChoose . splitToDur (1%+8) . evFromCC
+
+\end{haskelllisting}
+
+\subsubsection{Bossa Bass}
+
+A simple bass for Bossas using the bass note and its fifth.
+
+\begin{haskelllisting}
+
+> bossaBass :: TMelody
+> bossaBass = Music.line . map bossaBassC . evFromCC
+
+> bossaBassC :: (Music.Dur, ChordSymbol.T) -> Melody.T ()
+> bossaBassC (l, ch@(ChordSymbol.Cons r _ _)) =
+> let r7 = Transposeable.transpose 7 r
+> bossa' = bassNote (3%+8) r +:+ bassNote (1%+8) r7 +:+
+> bassNote (1%+2) r7 +:+
+> bossaBassC (l - 1%+1, ch)
+> in select (bassChoose (l, ch))
+> [(l >= 1%+1, bossa'),
+> (l >= 1%+2, bassNote (3%+8) r +:+ bassNote (1%+8) r)]
+
+\end{haskelllisting}
+
+\subsubsection{Walking Bass Line}
+
+Creating a good walking bass is a science in itself. There are numerous books which give
+various rules for creating good bass lines. The following code is still VERY experimental
+and just follows these basic rules:
+
+\begin{itemize}
+\item Create the root on the first quarter note of a chord, and
+\item create random quarter notes of the appropriate scale for the rest.
+\end{itemize}
+
+We do this by creating a walking bass line for every chord of a chart separately
+and then concatenating the created bass lines.
+
+\begin{haskelllisting}
+
+walking :: T
+walking = Music.line . map walkChord . evFromCC c
+
+\end{haskelllisting}
+
+Walking bass line for a single chord of a certain length. Take the root for the
+first note and random notes for the rest.
+
+\begin{haskelllisting}
+
+walkChord :: (Music.Dur, ChordSymbol.T) -> Melody.T ()
+walkChord (d, ch) | (divisible d (1%+4)) =
+ bassChoose ((1%+4), ch) +:+ walkRandom ((divide d (1%+4))-1) ch
+
+\end{haskelllisting}
+
+Create a random walking bass line of n quarter notes using chord ch.
+
+\begin{haskelllisting}
+
+walkRandom :: Int -> ChordSymbol.T -> Melody.T ()
+walkRandom n ch = let scale = (chordToScale ch)
+ choice = \n -> bassChooseR n (1%+4, scale)
+ in line (map choice (take n (randList (length scale))))
+
+bassChooseR :: Int -> (Music.Dur, Scale) -> Melody.T ()
+bassChooseR n (d, s) = Melody.note d (pitch (s!!n)) ()
+
+\end{haskelllisting}
+
+\subsection{Full Styles}
+
+The jazz style works for 3/4 and 4/4 measure. It currently does not yet use walking bass,
+but uses the quarter bass style above.
+
+\begin{haskelllisting}
+
+> jazzDrum :: Music.Dur -> MidiMusic.T
+> jazzDrum d =
+> select (error "jazzDrum supports only 3%+4 and 4%+4")
+> [(d==3%+4, Rhythm.jazzWaltzRideP Drum.RideCymbal2 =:=
+> Rhythm.jazzWaltzHiHatP Drum.PedalHiHat),
+> (d==4%+4, Music.replicate 2
+> (Rhythm.jazzRideP Drum.RideCymbal2 =:=
+> Rhythm.backBeatP Drum.PedalHiHat))]
+
+> jazz :: T
+> jazz s = let drums = Music.line (map (jazzDrum . ChartBar.dur) (ChordChart.bars s)) =:=
+> endFill (ChordChart.bars s)
+> (bd, hc) = ChordChart.hasChord s
+> in filterMusic bd hc drums =:=
+> bassFromMelody (quarterBass s)
+>
+
+\end{haskelllisting}
+
+The bossa style just plays the usual bossa clave with the hi-hat on the backbeat and some
+simple bass.
+
+\begin{haskelllisting}
+
+> bossa :: T
+> bossa c = let drums = Music.repeat Rhythm.claveBossa =:=
+> Music.repeat Rhythm.ride =:=
+> Music.repeat (Rhythm.backBeatP Drum.PedalHiHat)
+> bass = bassFromMelody (bossaBass c)
+> in Music.take ((4 * ChordChart.length c) %+ 4) drums =:= bass
+
+\end{haskelllisting}
+
+The Take-Five style works for charts with 5/4 measures only.
+
+\begin{haskelllisting}
+
+> takeFiveBass :: ChartBar.T -> Melody.T ()
+> takeFiveBass b =
+> if ChartBar.dur b == 5%+4 && length (ChartBar.chords b) <= 2
+> then
+> let c=ChartBar.chords b
+> bass d Nothing = Music.rest d
+> bass d (Just x) = bassChoose (d, x)
+> in if length c == 2
+> then bass (3%+4) (c!!0) +:+ bass (2%+4) (c!!1)
+> else bass (3%+4) (c!!0) +:+ bass (2%+4) (c!!0)
+> else error "takeFiveBass: only allowed for 5%+4 and maximally 2 chords per bar"
+
+> takeFive :: T
+> takeFive (ChordChart.Cons l) =
+> let rep pat = concat (replicate (length l) (Rhythm.fromString pat))
+> hiHatR = rep "..x .x"
+> cymbalR = rep "x. xx x. x. xx"
+> in Rhythm.toMusicWithDrumUnit qn Drum.PedalHiHat hiHatR =:=
+> Rhythm.toShuffledMusicWithDrumUnit en Drum.RideCymbal2 cymbalR =:=
+> endFill l =:=
+> bassFromMelody (Music.line (map takeFiveBass l))
+
+\end{haskelllisting}
+
+The rock style just plays the usual hi-hat eights, bass drum on downbeat, snare on backbeat.
+
+\begin{haskelllisting}
+
+> rock :: T
+> rock c = let drums = Music.repeat Rhythm.basicBassDrum =:=
+> Music.repeat Rhythm.basicSnare =:=
+> Music.repeat Rhythm.basicHiHat
+> bass = bassFromMelody (eighthBass c)
+> in Music.take ((4 * ChordChart.length c) %+ 4) drums =:= bass
+
+\end{haskelllisting}
+
+This style is not yet finished.
+
+\begin{haskelllisting}
+
+> thomasCarib :: T
+> thomasCarib c =
+> Rhythm.backBeatP Drum.PedalHiHat =:=
+> Rhythm.basicBassDrum =:=
+> Rhythm.toShuffledMusicWithDrumUnit en Drum.Claves
+> (Rhythm.fromString ".. .x .x x.") =:=
+> bassFromMelody (chartBass c)
+
+\end{haskelllisting}
+
+This is a rather simple style
+where the tones of a chord a played simultaneously.
+
+\begin{haskelllisting}
+
+> harmonic :: T
+> harmonic =
+> let chordSymbolToMusic (dur, cs) = Music.chord $
+> map (\p -> Melody.note p dur ()) $
+> ChordSymbol.toChord cs
+> in bassFromMelody . Music.line .
+> map chordSymbolToMusic . evFromCC
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/AutoTrack/Transposeable.lhs b/src/Haskore/Interface/AutoTrack/Transposeable.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/AutoTrack/Transposeable.lhs
@@ -0,0 +1,26 @@
+% from AutoTrack by Stefan Ratschan
+
+\subsection{Class of transposeable objects}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.AutoTrack.Transposeable(C, transpose) where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+
+\end{haskelllisting}
+
+\subsection{Haskore Additions}
+
+Here we turn to some stuff that really belongs into the Haskore core. First
+transposition of pitch classes:
+
+\begin{haskelllisting}
+
+> class C a where
+> transpose :: Int -> a -> a
+
+> instance C Pitch.Class where
+> transpose i pc = snd (Pitch.fromInt (Pitch.classToInt pc + i))
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound.lhs b/src/Haskore/Interface/CSound.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound.lhs
@@ -0,0 +1,85 @@
+\subsection{CSound}
+\seclabel{csound}
+
+\newcommand\genparagraph[1]{
+\hypertarget{csound-gen{#1}}{\subparagraph*{GEN{#1}.}}
+}
+\newcommand\refgen[1]{\hyperlink{csound-gen{#1}}{GEN{#1}}}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound where
+
+\end{haskelllisting}
+
+[Note: if this module is loaded into Hugs98, the following error
+message may result:
+\begin{haskelllisting}
+ Reading file "CSound.lhs":
+ ERROR "CSound.lhs" (line 707):
+ *** Cannot derive Eq OrcExp after 40 iterations.
+ *** This may indicate that the problem is undecidable. However,
+ *** you may still try to increase the cutoff limit using the -c
+ *** option and then try again. (The current setting is -c40)
+\end{haskelllisting}
+This is apparently due to the size of the {\tt OrcExp} data type. For
+correct operation, start Hugs with a larger cutoff limit, such as {\tt
+-c1000}.]
+
+CSound is a software synthesizer that allows its user to create a
+virtually unlimited number of sounds and instruments. It is extremely
+portable because it is written entirely in C. Its strength lies
+mainly in the fact that all computations are performed in software, so
+it is not reliant on sophisticated musical hardware. The output of a
+CSound computation is a file representing the signal which can be
+played by an independent application, so there is no hard upper limit
+on computation time. This is important because many sophisticated
+signals take much longer to compute than to play. The purpose of this
+module is to create an interface between Haskore and CSound in order
+to give the Haskore user access to all the powerful features of a
+software sound synthesizer.
+
+CSound takes as input two plain text files: a \keyword{score} (.sco) file
+and an \keyword{orchestra} (.orc) file. The score file is similar to a
+Midi file, and the orchestra file defines one or more
+\keyword{instrument}s that are referenced from the score file (the orchestra
+file can thus be thought of as the software equivalent of Midi
+hardware). The CSound program takes these two files as input, and
+produces a \keyword{sound file} as output, usually in {\tt .wav} format.
+Sound files are generally much larger than Midi files, since they
+describe the actual sound to be generated, represented as a sequence
+of values (typically 44,100 of them for each second of music), which
+are converted directly into voltages that drive the audio speakers.
+Sound files can be played by any standard media player found on
+conventional PC's.
+
+Each of these files is described in detail in the following sections.
+
+Here are some common definitions:
+\begin{haskelllisting}
+
+> newtype Instrument = Instrument Int
+> deriving (Show, Eq)
+
+> instrument :: Int -> Instrument
+> instrument = Instrument
+
+> instruments :: [Instrument]
+> instruments = map instrument [1..]
+
+> instrumentToNumber :: Instrument -> Int
+> instrumentToNumber (Instrument n) = n
+
+> showInstrumentNumber :: Instrument -> String
+> showInstrumentNumber = show . instrumentToNumber
+
+> type Name = String
+
+> type Velocity = Float
+> type PField = Float
+> type Time = Float
+
+\end{haskelllisting}
+
+\input{Haskore/Interface/CSound/Score.lhs}
+\input{Haskore/Interface/CSound/Orchestra.lhs}
diff --git a/src/Haskore/Interface/CSound/Generator.lhs b/src/Haskore/Interface/CSound/Generator.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/Generator.lhs
@@ -0,0 +1,280 @@
+\paragraph{Function Tables}
+\seclabel{function-table}
+
+Each function table must have a unique integer ID (\type{Table}),
+creation time (usually 0), size (which must be a power of 2), and a
+{\tt Normalize} flag. Most tables in CSound are normalized, i.e.\
+rescaled to a maximum absolute value of 1. The normalization process
+can be skipped by setting the {\tt Normalize} flag to {\tt False}.
+Such a table may be desirable to generate a control or modifying
+signal, but is not very useful for audio signal generation.
+
+Tables are simply arrays of floating point values. The values stored
+in the table are calculated by one of CSound's predefined \keyword{generating
+routines}, represented by the type {\tt Generator.T}:
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.Generator where
+>
+> import Haskore.Interface.CSound (Time)
+> import Haskore.General.Utility
+> (flattenTuples2, flattenTuples3, flattenTuples4)
+>
+> data T = Routine Number [Parameter]
+> | SoundFile SFName SkipTime ChanNum
+> deriving Show
+>
+> type SFName = String
+> type SkipTime = Time
+> type ChanNum = Float
+> type Number = Int
+> type Parameter = Float
+
+\end{haskelllisting}
+{\tt Routine n args} refers to CSound's generating routine $n$ (an
+integer), called with floating point arguments {\tt args}. There is
+only one generating routine (called \refgen{01}) in CSound that takes an
+argument type other than floating point, and thus we represent this
+using the special constructor {\tt SoundFile}, whose functionality
+will be described shortly.
+
+Knowing which of CSound's generating routines to use and with what
+arguments can be a daunting task. The newest version of CSound
+(version 4.01) provides 23 different generating routines, and each one
+of them assigns special meanings to its arguments. To avoid having to
+reference routines using integer ids, the following functions are
+defined for the most often-used generating routines. A brief
+discussion of each routine is also included. For a full description
+of these and other routines, refer to the CSound manual or consult the
+following webpage:
+\url{http://www.leeds.ac.uk/music/Man/Csound/Function/GENS.html}.
+The user
+familiar with CSound is free to write helper functions like the ones
+below to capture other generating routines.
+
+\genparagraph{01} Transfers data from a soundfile into a function
+table. Recall that the size of the function table in CSound must be a
+power of two. If the soundfile is larger than the table size, reading
+stops when the table is full; if it is smaller, then the table is
+padded with zeros. One exception is allowed: if the file is of type
+AIFF and the table size is set to zero, the size of the function table
+is allocated dynamically as the number of points in the soundfile.
+The table is then unusable by normal oscillators, but can be used by a
+special {\tt SampOsc} constructor (discussed in \secref{orchestra-file}). The first argument passed to the \refgen{01}
+subroutine is a string containing the name of the source file. The
+second argument is skip time, which is the number of seconds into the
+file that the reading begins. Finally there is an argument for the
+channel number, with 0 meaning read all channels. \refgen{01} is
+represented in Haskore as {\tt SoundFile SFName SkipTime ChanNum}, as
+discussed earlier. To make the use of {\tt SoundFile} consistent with
+the use of other functions to be described shortly, we define a simple
+equivalent:
+\begin{haskelllisting}
+
+> soundFile :: SFName -> SkipTime -> ChanNum -> T
+> soundFile = SoundFile
+
+\end{haskelllisting}
+
+\genparagraph{02} Transfers data from its argument fields directly
+into the function table. We represent its functionality as follows:
+\begin{haskelllisting}
+
+> tableValues :: [Parameter] -> T
+> tableValues gas = Routine 2 gas
+
+\end{haskelllisting}
+
+\genparagraph{03} Fills the table by evaluating a polynomial over a
+specified interval and with given coefficients. For example, calling
+\refgen{03} with an interval of $(-1,1)$ and coefficients 5, 4, 3, 2, 0, 1
+will generate values of the function $5+4x+3x^2+2x^3+x^5$ over the
+interval $-1$ to $1$. The number of values generated is equal to the
+size of the table. Let's express this by the following function:
+\begin{haskelllisting}
+
+> polynomial :: Interval -> Coefficients -> T
+> polynomial (x1,x2) cfs = Routine 3 (x1:x2:cfs)
+>
+> type Interval = (Float, Float)
+> type Coefficients = [Float]
+
+\end{haskelllisting}
+
+\genparagraph{05} Constructs a table from segments of exponential
+curves. The first argument is the starting point. The meaning of the
+subsequent arguments alternates between the length of a segment in
+samples, and the endpoint of the segment. The endpoint of one segment
+is the starting point of the next. The sum of all the segment lengths
+normally equals the size of the table: if it is less the table is
+padded with zeros, if it is more, only the first \type{TableSize}
+locations will be stored in the table.
+
+\begin{haskelllisting}
+
+> exponential1 :: StartPt -> [(SegLength, EndPt)] -> T
+> exponential1 sp xs = Routine 5 (sp : flattenTuples2 xs)
+>
+> type StartPt = Float
+> type SegLength = Float
+> type EndPt = Float
+
+\end{haskelllisting}
+
+\genparagraph{25} Similar to \refgen{05} in that it produces segments of
+exponential curves, but instead of representing the lengths of
+segments and their endpoints, its arguments represent $(x,y)$
+coordinates in the table, and the subroutine produces curves between
+successive locations. The $x$-coordinates must be in increasing
+order.
+
+\begin{haskelllisting}
+
+> exponential2 :: [Point] -> T
+> exponential2 pts = Routine 25 (flattenTuples2 pts)
+>
+> type Point = (Float,Float)
+
+\end{haskelllisting}
+
+\genparagraph{06} Generates a table from segments of cubic
+polynomial functions, spanning three points at a time. We define a
+function {\tt cubic} with two arguments: a starting position and a
+list of segment length (in number of samples) and segment endpoint
+pairs. The endpoint of one segment is the starting point of the next.
+The meaning of the segment endpoint alternates between a local
+minimum/maximum and point of inflexion. Whether a point is a maximum
+or a minimum is determined by its relation to the next point of
+inflexion. Also note that for two successive minima or maxima, the
+inflexion points will be jagged, whereas for alternating maxima and
+minima, they will be smooth. The slope of the two segments is
+independent at the point of inflection and will likely vary. The
+starting point is a local minimum or maximum (if the following point
+is greater than the starting point, then the starting point is a
+minimum, otherwise it is a maximum). The first pair of numbers will
+in essence indicate the position of the first inflexion point in
+$(x,y)$ coordinates. The folowing pair will determine the next local
+minimum/maximum, followed by the second point of inflexion, etc.
+\begin{haskelllisting}
+
+> cubic :: StartPt -> [(SegLength, EndPt)] -> T
+> cubic sp pts = Routine 6 (sp : flattenTuples2 pts)
+
+\end{haskelllisting}
+
+\genparagraph{07} Similar to \refgen{05}, except that it generates
+straight lines instead of exponential curve segments. All other
+issues discussed about \refgen{05} also apply to \refgen{07}. We represent it as:
+\begin{haskelllisting}
+
+> lineSeg1 :: StartPt -> [(SegLength, EndPt)] -> T
+> lineSeg1 sp pts = Routine 7 (sp : flattenTuples2 pts)
+
+\end{haskelllisting}
+
+\genparagraph{27} As with \refgen{05} and \refgen{25}, produces straight line
+segments between points whose locations are given as $(x,y)$
+coordinates, rather than a list of segment length, endpoint pairs.
+\begin{haskelllisting}
+
+> lineSeg2 :: [Point] -> T
+> lineSeg2 pts = Routine 27 (flattenTuples2 pts)
+
+\end{haskelllisting}
+
+\genparagraph{08} Produces a smooth piecewise cubic spline curve
+through the specified points. Neighboring segments have the same
+slope at the common points, and it is that of a parabola through that
+point and its two neighbors. The slope is zero at the ends.
+\begin{haskelllisting}
+
+> cubicSpline :: StartPt -> [(SegLength, EndPt)] -> T
+> cubicSpline sp pts = Routine 8 (sp : flattenTuples2 pts)
+
+\end{haskelllisting}
+
+\genparagraph{10} Produces a composite sinusoid. It takes a list of
+relative strengths of harmonic partials 1, 2, 3, etc. Partials not
+required should be given strength of zero.
+\begin{haskelllisting}
+
+> compSine1 :: [PStrength] -> T
+> compSine1 pss = Routine 10 pss
+>
+> type PStrength = Float
+
+\end{haskelllisting}
+
+\genparagraph{09} Also produces a composite sinusoid, but requires
+three arguments to specify each contributing partial. The arguments
+specify the partial number, which doesn't have to be an integer (i.e.\
+inharmonic partials are allowed), the relative partial strength, and
+the initial phase offset of each partial, expressed in degrees.
+\begin{haskelllisting}
+
+> compSine2 :: [(PNum, PStrength, PhaseOffset)] -> T
+> compSine2 args = Routine 9 (flattenTuples3 args)
+>
+> type PNum = Float
+> type PhaseOffset = Float
+
+\end{haskelllisting}
+
+\genparagraph{19} Provides all of the functionality of \refgen{09}, but in
+addition a DC offset must be specified for each partial. The DC
+offset is a vertical displacement, so that a value of 2 will lift a
+2-strength partial from range $[-2,2]$ to range $[0,4]$ before further
+scaling.
+\begin{haskelllisting}
+
+> compSine3 :: [(PNum, PStrength, PhaseOffset, DCOffset)] -> T
+> compSine3 args = Routine 19 (flattenTuples4 args)
+>
+> type DCOffset = Float
+
+\end{haskelllisting}
+
+\genparagraph{11} Produces an additive set of harmonic cosine
+partials, similar to \refgen{10}. We will represent it by a function that
+takes three arguments: the number of harmonics present, the lowest
+harmonic present, and a multiplier in an exponential series of
+harmonics amplitudes (if the $x$'th harmonic has strength coefficient
+of $A$, then the $(x+n)$'th harmonic will have a strength of
+$A*(r^n)$, where $r$ is the multiplier).
+\begin{haskelllisting}
+
+> cosineHarms :: NHarms -> LowestHarm -> Mult -> T
+> cosineHarms n l m = Routine 11 [fromIntegral n, fromIntegral l, m]
+>
+> type NHarms = Int
+> type LowestHarm = Int
+> type Mult = Float
+
+\end{haskelllisting}
+
+\genparagraph{21} Produces tables having selected random distributions.
+\begin{haskelllisting}
+
+> randomTable :: RandDist -> T
+> randomTable rd = Routine 21 [fromIntegral (fromEnum rd + 1)]
+>
+> data RandDist =
+> Uniform
+> | Linear
+> | Triangular
+> | Expon
+> | BiExpon
+> | Gaussian
+> | Cauchy
+> | PosCauchy
+> deriving (Eq, Ord, Enum, Show)
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> toStatementWords :: T -> [String]
+> toStatementWords (Routine gn gas) = show gn : map show gas
+> toStatementWords (SoundFile nm st cn) = ["1", nm, show st, "0", show cn]
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound/InstrumentMap.lhs b/src/Haskore/Interface/CSound/InstrumentMap.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/InstrumentMap.lhs
@@ -0,0 +1,54 @@
+\paragraph{Naming Instruments and Tables}
+
+In CSound, each table and instrument has a unique identifying integer
+associated with it. Haskore, on the other hand, uses strings to name
+instruments. What we need is a way to convert Haskore instrument
+names to identifier integers that CSound can use. Similar to
+Haskore's player maps, we define a notion of a \keyword{CSound name map}
+for this purpose.
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.InstrumentMap where
+>
+> import Haskore.Interface.CSound (PField, Instrument, instruments)
+>
+> import qualified Data.List as List
+
+> type SoundTable instr = [(instr, Instrument)]
+
+\end{haskelllisting}
+A name map can be provided directly in the form
+\code{[("name1", int1), ("name2", int2), ...]}, or the programmer can
+define auxiliary functions to make map construction easier.
+For example:
+\begin{haskelllisting}
+
+> tableFromInstruments :: [instr] -> SoundTable instr
+> tableFromInstruments nms = zip nms $ instruments
+
+\end{haskelllisting}
+The following function will add a name to an existing name map.
+If the name is already in the map, an error results.
+\begin{haskelllisting}
+
+> addToTable :: (Eq instr) =>
+> instr -> Instrument -> SoundTable instr -> SoundTable instr
+> addToTable nm i instrMap =
+> if elem nm (map fst instrMap)
+> then ((nm,i) : instrMap)
+> else (error ("CSound.addToTable: instrument already in the map"))
+
+\end{haskelllisting}
+
+Note the use of the function \function{lookup} imported from \module{List}.
+\begin{haskelllisting}
+
+> type ToSound instr = instr -> ([PField], Instrument)
+
+> lookup :: (Eq instr) => SoundTable instr -> ToSound instr
+> lookup table instr =
+> maybe (error "CSound.InstrMap.lookup: instrument not found")
+> ((,) [])
+> (List.lookup instr table)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound/Note.lhs b/src/Haskore/Interface/CSound/Note.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/Note.lhs
@@ -0,0 +1,72 @@
+\subsubsection{The Score File}
+\seclabel{score-file}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.Note where
+>
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+
+> import qualified Haskore.Interface.CSound.InstrumentMap as InstrMap
+
+> import Haskore.Interface.CSound (Instrument, Velocity, PField)
+
+\end{haskelllisting}
+
+
+\begin{haskelllisting}
+
+> data T =
+> Cons {
+> parameters :: [PField],
+> velocity :: Velocity,
+> instrument :: Instrument,
+> pitch :: Maybe Pitch.Absolute
+> }
+
+> fromRhyNote :: RealFrac dyn =>
+> InstrMap.ToSound drum ->
+> InstrMap.ToSound instr ->
+> dyn -> Pitch.Relative -> RhyMusic.Note drum instr -> T
+> fromRhyNote dMap iMap dyn trans (RhyMusic.Note vel body) =
+> let velCS = velocityFromStd dyn vel
+> in case body of
+> RhyMusic.Tone instr p ->
+> uncurry (flip Cons velCS) (iMap instr)
+> (Just (pitchFromStd trans p))
+> RhyMusic.Drum drum ->
+> uncurry (flip Cons velCS) (dMap drum) Nothing
+
+> velocityFromStd :: RealFrac dyn =>
+> dyn -> Rational -> Velocity
+> velocityFromStd dyn vel =
+> velocityToDb (fromRational (toRational dyn * vel))
+> -- velocityToDb (realToFrac dyn * vel)
+
+> pitchFromStd :: Pitch.Relative -> Pitch.T -> Pitch.Absolute
+> pitchFromStd trans p =
+> let csoundP = Pitch.toInt p + zeroKey + trans
+> in if csoundP<0
+> then error ("CSound.Note: pitch " ++ show csoundP ++
+> " must not be negative")
+> else csoundP
+
+\end{haskelllisting}
+
+
+\begin{haskelllisting}
+
+> velocityToDb :: Float -> Float
+> velocityToDb = (50*)
+>
+> -- still unused, but it should be implemented this way
+> amplitudeToDb :: Float -> Float
+> amplitudeToDb v = 20 * logBase 10 v
+
+> {- Offset to map from Haskore's pitch 0
+> to the corresponding pitch of CSound -}
+> zeroKey :: Int
+> zeroKey = 84
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound/Orchestra.lhs b/src/Haskore/Interface/CSound/Orchestra.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/Orchestra.lhs
@@ -0,0 +1,1738 @@
+\subsubsection{The Orchestra File}
+\seclabel{orchestra-file}
+
+\newcommand\csoundfunc[1]{\textit{\texttt{#1}}}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.Orchestra (
+> T(Cons), InstrBlock(..), Header, AudRate, CtrlRate,
+> -- SigTerm(ConstFloat, ConstInt, TableNumber, PField, Str,
+> -- Read, Tap, Result, Conditional,
+> -- Infix, Prefix, SigGen),
+> SigExp, DelayLine, Boolean,
+> -- DelayLine(DelayLine), Boolean(Operator, Comparison),
+> GlobalSig(Global), Output(..), Mono(Mono), Stereo(Stereo), Quad(Quad),
+> EvalRate(NR, CR, AR), Instrument, Name,
+> sigGen, tableNumber, readGlobal, rec,
+>
+> -- assorted functions
+> toString, saveIA, save,
+> channelCount, getMultipleOutputs,
+>
+> -- variables dealing with PFields
+> noteDur, notePit, noteVel, p1, p2, p3, p4, p5, p6, p7, p8, p9, pField,
+>
+> -- functions for dealing with Booleans and Conditional SigExps
+> (<*), (<=*), (>*), (>=*), (==*), (/=*), (&&*), (||*), ifthen,
+> constInt, constFloat, constEnum,
+>
+> -- functions for creating signal expressions
+> pchToHz, dbToAmp, line, expon, lineSeg, exponSeg, env, phasor,
+> IndexMode(..), tblLookup, tblLookupI, osc, oscI,
+> fmOsc, fmOscI, sampOsc, random, randomH, randomI, genBuzz, buzz,
+> pluck, PluckDecayMethod(..), delay, vdelay, comb, alpass, reverb,
+> delTap, delTapI,
+>
+> -- monad-related functions
+> Orc, mkSignal, addInstr, mkOrc,
+>
+> -- assorted examples
+> orc1, test, test1) where
+>
+> import Haskore.Interface.CSound
+> (Name, Instrument, instrument, instruments, showInstrumentNumber)
+> import Haskore.Interface.CSound.OrchestraFunction
+>
+> import qualified Haskore.General.LoopTreeRecursiveGen as TreeRec
+> import qualified Haskore.General.LoopTreeTaggedGen as TreeTag
+>
+> import Haskore.General.Utility (flattenTuples2, partition, mapSnd, toMaybe)
+
+> import Control.Monad.State (State(..), modify, execState, )
+> import Control.Applicative (liftA, liftA2, liftA3, pure)
+> import Data.Foldable (Foldable(foldMap))
+> import Data.Traversable (Traversable(sequenceA))
+> import qualified Data.Traversable as Traversable
+
+> import System.IO
+> import Data.Maybe (mapMaybe)
+> import Data.List (nub, intersperse, (\\))
+
+\end{haskelllisting}
+
+The orchestra file consists of two parts: a \keyword{header}, and one or
+more \keyword{instrument blocks}. The header sets global parameters
+controlling sampling rate and control rate. The instrument blocks define
+instruments, each identified by a unique integer ID, and containing
+statements modifying or generating various audio signals. Each note statement
+in a score file passes all its arguments---including the p-fields---to its
+corresponding instrument in the orchestra file. While some properties
+vary from note to note, and should therefore be designed as p-fields,
+many can be defined within the instrument; the choice is up to the
+user.
+
+The orchestra file is represented as:
+\begin{haskelllisting}
+
+> data Output out =>
+> T out = Cons Header [InstrBlock out] deriving (Show, Eq)
+
+\end{haskelllisting}
+The orchestra header sets the audio rate, control rate, and number of
+output channels:
+\begin{haskelllisting}
+
+> type Header = (AudRate, CtrlRate)
+>
+> type AudRate = Int -- samples per second
+> type CtrlRate = Int -- samples per second
+
+\end{haskelllisting}
+Digital computers represent continuous analog audio waveforms as a
+sequence of discrete samples. The audio rate (\type{AudRate}) is the
+number of these samples calculated each second. Theoretically, the
+maximum frequency that can be represented is equal to one-half the
+audio rate. Audio CDs contain 44,100 samples per second of music,
+giving them a maximum sound frequency of 22,050 Hz, which is as high
+as most human ears are able to hear.
+
+Computing 44,100 values each second can be a demanding task for a CPU,
+even by today's standards. However, some signals used as inputs to
+other signal generating routines don't require such a high resolution,
+and can thus be generated at a lower rate. A good example of this is
+an amplitude envelope, which changes relatively slowly, and thus can
+be generated at a rate much lower than the audio rate. This rate is
+called the \keyword{control rate} (\type{CtrlRate}), and is set in the
+orchestra file header. The audio rate is usually a multiple of the
+control rate, but this is not a requirement.
+
+Each instrument block contains four things: a unique identifying
+integer; an expression giving the amount of extra time the instrument
+should be granted, usually used for reverb; an \type{Output} expression
+that gives the outputs in terms of \keyword{orchestra expressions},
+called \type{SigExp}s; and a list of global signals and the \type{SigExp}s
+that are written out to those signals.
+\begin{haskelllisting}
+
+> type Reverb = SigExp
+> data InstrBlock a =
+> InstrBlock {instrBlockInstr :: Instrument,
+> instrBlockReverb :: Reverb,
+> instrBlockOutput :: a,
+> instrBlockGlobals :: [(GlobalSig, SigExp)]}
+> deriving (Show, Eq)
+
+\end{haskelllisting}
+Recall that \type{Instrument} is a type synonym for an \type{Int}. This value
+may be obtained from a string name and a name map using the function
+\code{getId :: NameMap -> Name -> Maybe Int} discussed earlier.
+
+\paragraph{Orchestra Expressions}
+
+The data type \type{SigExp} is the largest deviation that we will make
+from the actual CSound design. In CSound, instruments are defined
+using a sequence of statements that, in a piecemeal manner, define the
+various oscillators, summers, constants, etc.\ that make up an
+instrument. These pieces can be given names, and these names can be
+referenced from other statements. But despite this rather imperative,
+statement-oriented approach, it is acually completely functional. In
+other words, every CSound instrument can be rewritten as a single
+expression. It is this ``expression language'' that we capture in
+\type{SigExp}. A pleasant attribute of the result is that CSound's ad
+hoc naming mechanism is replaced with Haskell's conventional way of
+naming things.
+
+The entire \type{SigExp} data type declaration, as well as the
+declarations for related datatypes, is shown in \figref{SigExp}.
+In what follows, we describe each of the various constructors in turn.
+
+\begin{figure}
+{\scriptsize\vspace{-.7in}
+\begin{haskelllisting}
+
+> type Function = String
+> type OutCount = Integer
+> type Table = Int
+>
+> type Boolean = BooleanTerm SigExp
+> data BooleanTerm tree =
+> Operator Function (BooleanTerm tree) (BooleanTerm tree)
+> | Comparison Function tree tree
+> deriving (Show, Eq)
+>
+> data GlobalSig =
+> Global EvalRate (SigExp -> SigExp -> SigExp) Int
+> instance Show GlobalSig where
+> show (Global rt _ n) = "Global " ++ show rt ++ " " ++ show n
+> instance Eq GlobalSig where
+> Global r1 _ n1 == Global r2 _ n2 = r1 == r2 && n1 == n2
+>
+> type DelayLine = DelayLineTerm SigExp
+> data DelayLineTerm tree = DelayLine tree tree
+> deriving (Show, Eq)
+>
+> data SigTerm tree =
+> ConstFloat Float
+> | ConstInt Int
+> | TableNumber Table
+> | PField Int
+> | Str String
+> | Read GlobalSig
+> | Tap Function (DelayLineTerm tree) [tree]
+> | Result (DelayLineTerm tree)
+> | Conditional (BooleanTerm tree) tree tree
+> | Infix Function tree tree
+> | Prefix Function tree
+> | SigGen Function EvalRate OutCount [tree]
+> | Index OutCount (SigTerm tree)
+> deriving (Show, Eq)
+
+> instance Functor BooleanTerm where
+> fmap f branch =
+> case branch of
+> Operator nm left right -> Operator nm (fmap f left) (fmap f right)
+> Comparison nm left right -> Comparison nm ( f left) ( f right)
+>
+> instance Functor DelayLineTerm where
+> fmap f (DelayLine x y) = DelayLine (f x) (f y)
+
+> instance Functor SigTerm where
+> fmap f branch =
+> case branch of
+> {- The first cases look like they could be handled
+> by returning just 'branch'. But this does not work,
+> because the result have a different type in general. -}
+> ConstFloat x -> ConstFloat x
+> ConstInt n -> ConstInt n
+> TableNumber t -> TableNumber t
+> PField n -> PField n
+> Str str -> Str str
+> Read t -> Read t
+> Tap nm del xs -> Tap nm (fmap f del) (map f xs)
+> Result del -> Result (fmap f del)
+> Conditional b true false ->
+> Conditional (fmap f b) (f true) (f false)
+> Infix nm left right -> Infix nm (f left) (f right)
+> Prefix nm arg -> Prefix nm (f arg)
+> SigGen nm rate cnt args ->
+> SigGen nm rate cnt (map f args)
+> Index cnt x -> Index cnt (fmap f x)
+
+> instance TreeTag.CollShow SigTerm where
+> collShowsPrec = showsPrec
+
+> instance TreeTag.CollEq SigTerm where
+> collEqual = (==)
+
+> type SigExp = TreeRec.T SigTerm
+
+> tableNumber :: Table -> SigExp
+> tableNumber n = TreeRec.Branch (TableNumber n)
+
+> readGlobal :: GlobalSig -> SigExp
+> readGlobal glob = TreeRec.Branch (Read glob)
+
+\end{haskelllisting}
+}
+\caption{The \type{SigExp} Data Type}
+\figlabel{SigExp}
+\end{figure}
+
+
+\subparagraph{Constants}
+
+\code{ConstFloat x} represents the floating-point constant \code{x}.
+
+\subparagraph{P-field Arguments}
+
+\code{pField n} refers to the $n$th p-field argument. Recall that all
+note characteristics, including pitch, volume, and duration, are
+passed into the orchestra file as p-fields. For example, to access
+the pitch, one would write \code{pField 4}. To make the access of
+these most common p-fields easier, we define the following constants:
+\begin{haskelllisting}
+
+> noteDur, notePit, noteVel :: SigExp
+> noteDur = pField 3
+> notePit = pField 4
+> noteVel = pField 5
+
+> pField :: Int -> SigExp
+> pField n = TreeRec.Branch (PField n)
+
+\end{haskelllisting}
+
+It is also useful to define the following standard names, which are
+identical to those used in CSound:
+
+\begin{haskelllisting}
+
+> p1,p2,p3,p4,p5,p6,p7,p8,p9 :: SigExp
+> p1 = pField 1
+> p2 = pField 2
+> p3 = pField 3
+> p4 = pField 4
+> p5 = pField 5
+> p6 = pField 6
+> p7 = pField 7
+> p8 = pField 8
+> p9 = pField 9
+
+\end{haskelllisting}
+
+\subparagraph{Strings}
+
+\code{Str s} represents a string argument in CSound --- a type of argument that
+is very rarely used, but is included here for the sake of completeness.
+
+\paragraph{Reading and Writing Global Signals}
+
+\code{Read g} is the counterpart to the \type{(GlobalSig, SigExp)} pairs in the
+\type{InstrBlock} statements, reading instead of writing global signals. Together,
+they allow for audio and control signals to be passed from instrument to instrument,
+and used for things like panning or overall envelopes.
+
+\paragraph{Logical and Conditional Statements}
+
+You probably noticed that \type{Boolean} was defined alongside
+\type{SigExp} in Figure \ref{SigExp-fig}. \type{Boolean} is a type of
+expression used in the \constructor{Conditional} \type{SigExp} --- basically,
+it's a comparison or some logical function of two comparisons. In other
+words, a \type{Boolean} is an expression that evaluates to a boolean.
+The syntax is fairly simple --- a \type{Boolean} is either a \constructor{Comparison},
+a function comparing two \type{SigExp}s and returning a \type{Boolean};
+or an \constructor{Operator}, a function from two \type{Boolean}s to a third
+\type{Boolean}, such as the logical ``and'' operator. Thus we can express,
+for example, a query about whether a certain p-value lies within a range
+by evaluating this expression:
+
+\begin{haskelllisting}
+
+ Operator "&&" (Comparison "<" 1 p2) (Comparison "<" p2 3)
+
+\end{haskelllisting}
+
+The above expression will create a CSound expression that is true when p2
+lies between 1 and 3.
+
+\type{Boolean}s can be used inside of a \constructor{Conditional} expression in order
+to choose one of two values based on the trueness or falseness of the
+\type{Boolean}. For example:
+
+\begin{haskelllisting}
+
+ Conditional (Comparison ">" p1 p2) p1 p2
+
+\end{haskelllisting}
+
+will return the maximum of the two values p1 and p2. We are including
+several functions that will perform this automatically:
+
+\begin{haskelllisting}
+
+> (<*), (<=*), (>*), (>=*), (==*), (/=*) ::
+> -- SigExp -> SigExp -> Boolean
+> TreeTerm term =>
+> TreeRec.T term -> TreeRec.T term -> BooleanTerm (TreeRec.T term)
+> (<* ) = comparisonTerm "<"
+> (<=*) = comparisonTerm "<="
+> (>* ) = comparisonTerm ">"
+> (>=*) = comparisonTerm ">="
+> (==*) = comparisonTerm "=="
+> (/=*) = comparisonTerm "!="
+
+> (&&*), (||*) :: Boolean -> Boolean -> Boolean
+> (&&*) = operator "&&"
+> (||*) = operator "||"
+
+> operator :: String -> Boolean -> Boolean -> Boolean
+> operator = Operator
+
+\end{haskelllisting}
+
+\subparagraph{Arithmetic and Transcendental Functions}
+
+Arithmetic functions are represented in various ways, depending on the
+type of function. The standard binary operators --- plus and times, for
+instance --- are infix operators, and so they can be crafted in this
+module using the Infix constructor, specifying the name of the
+function (the text used to express it in CSound) and the two arguments
+to the function. The other mathematical operators, such as \function{sin},
+\function{log}, or \function{sqrt}, can be expressed with a \constructor{Prefix} constructor,
+passing the name of the function in CSound (usually the same as the name
+in Haskell, although not always) and the argument to the given function.
+Examples of this are:
+
+\begin{verbatim}
+Infix "+" (PField 1) (Prefix "sin" 1 (ConstFloat 3.0))
+Prefix "sqrt" (Infix "*" (PField 3) (PField 4))
+\end{verbatim}
+
+To facilitate the use of these arithmetic functions, we can make
+\type{SigExp} an instance of certain numeric type classes, thus providing
+more conventional names for the various operations.
+\begin{haskelllisting}
+
+> sigGen :: Function -> EvalRate -> OutCount -> [SigExp] -> SigExp
+> sigGen nm rate cnt args = TreeRec.Branch (SigGen nm rate cnt args)
+
+> constFloat :: Float -> SigExp
+> constFloat = TreeRec.Branch . ConstFloat
+
+> constInt :: Int -> SigExp
+> constInt = TreeRec.Branch . ConstInt
+
+> constEnum :: Enum a => a -> SigExp
+> constEnum = TreeRec.Branch . ConstInt . fromEnum
+
+> class TreeTerm term where
+> constTerm :: Float -> TreeRec.T term
+> prefixTerm :: Function -> TreeRec.T term -> TreeRec.T term
+> infixTerm :: Function -> TreeRec.T term -> TreeRec.T term -> TreeRec.T term
+> comparisonTerm :: Function -> TreeRec.T term -> TreeRec.T term ->
+> BooleanTerm (TreeRec.T term)
+> ifthen :: BooleanTerm (TreeRec.T term) ->
+> TreeRec.T term -> TreeRec.T term -> TreeRec.T term
+
+> instance TreeTerm SigTerm where
+> constTerm x = TreeRec.Branch (ConstFloat x)
+> prefixTerm nm x = TreeRec.Branch (Prefix nm x)
+> infixTerm nm x y = TreeRec.Branch (Infix nm x y)
+> comparisonTerm nm x y = Comparison nm x y
+> ifthen b x y = TreeRec.Branch (Conditional b x y)
+
+\end{haskelllisting}
+
+We can not request \code{term == SigTerm TreeRec.T}
+that's why we have to define the \code{TreeTerm} class
+and the instance for \code{SigTerm}.
+
+\begin{haskelllisting}
+
+> instance (TreeTag.CollShow term, TreeTag.CollEq term,
+> Functor term, TreeTerm term) =>
+> Num (TreeRec.T term) where
+> (+) = infixTerm "+"
+> (-) = infixTerm "-"
+> (*) = infixTerm "*"
+> negate = prefixTerm "-"
+> abs = prefixTerm "abs"
+> signum x = ifthen (x <* 0) (-1) (ifthen (x >* 0) 1 0)
+> fromInteger = constTerm . fromInteger
+
+> instance (TreeTag.CollShow term, TreeTag.CollEq term,
+> Functor term, TreeTerm term) =>
+> Fractional (TreeRec.T term) where
+> (/) = infixTerm "/"
+> fromRational = constTerm . fromRational
+> {-
+> fromRational x =
+> fromInteger (numerator x) /
+> fromInteger (denominator x)
+> -}
+
+> instance (TreeTag.CollShow term, TreeTag.CollEq term,
+> Functor term, TreeTerm term) =>
+> Floating (TreeRec.T term) where
+> exp = prefixTerm "exp"
+> log = prefixTerm "log"
+> sqrt = prefixTerm "sqrt"
+> (**) = infixTerm "^"
+> pi = constTerm pi
+> sin = prefixTerm "sin"
+> cos = prefixTerm "cos"
+> tan = prefixTerm "tan"
+> asin = prefixTerm "sininv"
+> acos = prefixTerm "cosinv"
+> atan = prefixTerm "taninv"
+> sinh = prefixTerm "sinh"
+> cosh = prefixTerm "cosh"
+> tanh = prefixTerm "tanh"
+> asinh x = log (sqrt (x*x+1) + x)
+> acosh x = log (sqrt (x*x-1) + x)
+> atanh x = (log (1+x) - log (1-x)) / 2
+
+\end{haskelllisting}
+
+Now we can write simpler code, such as: \code{noteDur + sin p6 ** 2}.
+
+\paragraph{Other \constructor{Prefix}s}
+
+\function{sin}, \function{log}, and \function{sqrt} aren't the only functions that
+use \constructor{Prefix} as a constructor --- \constructor{Prefix} is used
+for all functions in CSound that take a single argument and are represented
+like normal mathematical functions. Most of these functions are, indeed,
+mathematical, such as the function converting a CSound pitch value to
+the number of cycles per second, or the function converting decibels
+to the corresponding amplitude.
+
+For convenience, we will define a few common operators here:
+
+\begin{verbatim}
+
+> pchToHz, dbToAmp :: SigExp -> SigExp
+> pchToHz = prefixTerm "cpspch"
+> dbToAmp = prefixTerm "ampdb"
+
+\end{verbatim}
+
+Now, when we want to convert a pitch to its hertz value or a decibel
+level to the desired amplitude, we can simply say \code{pchToHz notePit}
+or \code{dbToAmp noteVel}.
+
+\paragraph{Signal Generation and Modification}
+
+The most sophisticated \type{SigExp} constructor is \function{sigGen},
+which drives most of the functions used for signal generation and
+modification. The constructor takes four arguments: the name of the
+function to be used, such as \csoundfunc{envlpx} or \csoundfunc{oscili}; the rate of output;
+the number of outputs (covered in a later section); and a list of all
+the arguments to be passed.
+
+Most of these we have seen before. But what is the rate of output? Well,
+signals in CSound can be generated at three rates: the note rate (i.e.,
+with, every note event), the control rate, and the audio rate (we discussed
+the latter two earlier). Many of the signal generating routines can
+produce signals at more than one rate, so the rate must be specified
+as an argument. The following simple data structure serves this purpose:
+
+\begin{haskelllisting}
+
+> data EvalRate = NR -- note rate
+> | CR -- control rate
+> | AR -- audio rate
+> deriving (Show, Eq, Ord)
+
+\end{haskelllisting}
+
+All right, so now we know what the arguments are. But what does the
+\function{sigGen} constructor actually do? Like the other kinds of
+\type{SigExp}s, it has an input and an output. In Haskore, it acts
+just the same as any other kind of function. But when written to a CSound
+Orchestra file, each \function{sigGen} receives a variable name that it is
+assigned to, and each \function{sigGen} is written to a single line of the
+CSound file.
+
+\function{sigGen}s can be used for all sorts of things --- CSound has a
+very large variety of functions, most of which are actually \function{sigGen}s.
+They can do anything from generating a simple sine wave to generating complex
+signals. Most of them, however, have to do with signal generation; hence the
+name \function{sigGen}. For the user's sake, we will outline a few of the CSound
+functions here:
+
+\begin{enumerate}
+\item The CSound statement \code{line evalrate start duration finish},
+produces values along a
+straight line from \code{start} to \code{finish}. The values can be
+generated either at control or audio rate, and the line covers a
+period of time equal to \code{duration} seconds. We can translate this into
+CSound like so:
+\begin{haskelllisting}
+
+> line, expon :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp
+> line rate start duration finish =
+> sigGen "line" rate 1 [start, duration, finish]
+
+\end{haskelllisting}
+
+\item \csoundfunc{expon} is similar to \csoundfunc{line},
+but the code \code{expon evalrate start duration finish}
+produces an exponential curve instead of a straight line.
+\begin{haskelllisting}
+
+> expon rate start duration finish =
+> sigGen "expon" rate 1 [start, duration, finish]
+
+\end{haskelllisting}
+
+\item If a more elaborate signal is required, one can use the
+CSound functions \csoundfunc{linseg} or \csoundfunc{expseg}, which take any
+odd number of arguments greater than or equal to three. The first three
+arguments work as before, but only for the first of a number of segments.
+The subsequent segment lengths and endpoints are given in the rest of the
+arguments. A signal containing both straight line and exponential
+segments can be obtained by adding a \csoundfunc{linseg} signal and
+\csoundfunc{expseg} signal together in an appropriate way.
+
+The Haskore code is more complicated for this,
+because there are an arbitrary but odd number of arguments.
+So we will give the first three arguments as we did with the \csoundfunc{line}
+and \csoundfunc{expon} functions, and then have a list of pairs, which will be
+flattened into an argument list:
+\begin{haskelllisting}
+
+> lineSeg, exponSeg :: EvalRate -> SigExp -> SigExp -> SigExp
+> -> [(SigExp, SigExp)] -> SigExp
+> lineSeg rate y0 x1 y1 lst =
+> sigGen "linseg" rate 1 ([y0, x1, y1] ++ flattenTuples2 lst)
+> exponSeg rate y0 x1 y1 lst =
+> sigGen "expseg" rate 1 ([y0, x1, y1] ++ flattenTuples2 lst)
+
+\end{haskelllisting}
+
+\item The Haskore code
+\code{env rate rshape sattn dattn steep dtime rtime durn sig}
+modifies the signal \code{sig} by applying an envelope to it.%
+\footnote{Although this function is widely-used in CSound, the same
+effect can be accomplished by creating a signal that is a combination
+of straight line and exponential curve segments, and multiplying it by
+the signal to be modified.}
+\code{rtime} and \code{dtime} are the rise
+time and decay time, respectively (in seconds), and \code{durn} is the
+overall duration. \code{rshape} is the identifier integer of a
+function table storing the rise shape. \code{sattn} is the
+pseudo-steady state attenuation factor. A value between 0 and 1 will
+cause the signal to exponentially decay over the steady period, a
+value greater than 1 will cause the signal to exponentially rise, and
+a value of 1 is a true steady state maintained at the last rise value.
+\code{steep}, whose value is usually between $-0.9$ and $+0.9$,
+influences the steepness of the exponential trajectory. \code{dattn}
+is the attenuation factor by which the closing steady state value is
+reduced exponentially over the decay period, with value usually around
+0.01.
+
+In Haskore, this becomes a fairly simple function, going from an
+\type{EvalRate} and eight \type{SigExp}s to one single \type{SigExp}:
+\begin{haskelllisting}
+
+> env :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> -> SigExp -> SigExp -> SigExp -> SigExp
+> env rate rshape sattn dattn steep dtime rtime durn sig =
+> sigGen "envlpx" rate 1
+> [sig, rtime, durn, dtime, rshape, sattn, dattn, steep]
+
+\end{haskelllisting}
+
+\item Typing \code{phasor phase freq} into CSound generates a signal moving
+from 0 to 1 at a given frequency and starting at the given initial
+phase offset. When used properly as the index to a table lookup unit,
+the function can simulate the behavior of an oscillator. We implement it
+in Haskore thus:
+\begin{haskelllisting}
+
+> phasor :: EvalRate -> SigExp -> SigExp -> SigExp
+> phasor rate phase freq = sigGen "phasor" rate 1 [freq, phase]
+
+\end{haskelllisting}
+
+\item CSound table lookup functions \csoundfunc{table} and \csoundfunc{tablei}
+both take \code{index}, \code{table}, and \code{indexmode} arguments.
+The \code{indexmode} is either 0 or 1,
+differentiating between raw index and normalized index (zero to one);
+for convenience we define:
+\begin{haskelllisting}
+
+> data IndexMode =
+> RawIndex
+> | NormalIndex
+> deriving (Show, Eq, Enum)
+
+\end{haskelllisting}
+
+Both \csoundfunc{table} and \csoundfunc{tablei} return values stored in
+the specified table at the given index.
+The difference is that \csoundfunc{tablei}
+uses the fractional part of the index to interpolate
+between adjacent table entries, which generates a smoother signal at a
+small cost in execution time. The equivalent Haskore code to the CSound
+functions is:
+\begin{haskelllisting}
+
+> tblLookup, tblLookupI ::
+> EvalRate -> IndexMode -> SigExp -> SigExp -> SigExp
+> tblLookup rate mode table ix =
+> sigGen "table" rate 1 [ix, table, constEnum mode]
+> tblLookupI rate mode table ix =
+> sigGen "tablei" rate 1 [ix, table, constEnum mode]
+
+\end{haskelllisting}
+
+As mentioned, the output of \csoundfunc{phasor} can be used as input to a
+table lookup to simulate an oscillator whose frequency is controlled
+by the note pitch. This can be accomplished easily by the following
+piece of Haskore code:
+\begin{haskelllisting}
+
+ oscil = let index = phasor AR (pchToHz notePit) 0.0
+ in tblLookupI AR NormalIndex table index
+
+\end{haskelllisting}
+where \code{table} is some given function table ID. If \code{oscil} is
+given as argument to an output constructor such as \constructor{MonoOut}, then
+this \type{Output} coupled with an instrument ID number (say, 1)
+produces a complete instrument block:
+\begin{haskelllisting}
+
+ i1 = (1, MonoOut oscil)
+
+\end{haskelllisting}
+Adding a suitable \constructor{Header} would then give us a complete, though
+somewhat sparse, \type{CSound.Orchestra.T} value.
+
+\item Instead of the above design we could use one of the built-in
+CSound oscillators, \csoundfunc{oscil} and \csoundfunc{oscili}, which differ
+in the same way as \csoundfunc{table} and \csoundfunc{tablei}. Both CSound
+functions take the following arguments: raw amplitude, frequency, and
+the index of a table. The result is a signal that oscillates through
+the function table at the given frequency. Let the Haskore functions
+be as follows:
+\begin{haskelllisting}
+
+> osc, oscI :: EvalRate -> SigExp -> SigExp -> SigExp -> SigExp
+> osc rate table amp freq = sigGen "oscil" rate 1 [amp, freq, table]
+> oscI rate table amp freq = sigGen "oscili" rate 1 [amp, freq, table]
+
+\end{haskelllisting}
+Now, the following statement is equivalent to \function{osc}, defined above:
+\begin{haskelllisting}
+ oscil' = oscI AR 1 (pchToHz notePit) table
+\end{haskelllisting}
+
+\item It is often desirable to use the output of one oscillator to
+modulate the frequency of another, a process known as \keyword{frequency
+modulation}.
+The Haskore code \code{fmOsc table modindex carfreq modfreq amp freq}
+produces a signal whose effective modulating frequency is \code{freq*modfreq},
+and whose carrier frequency is \code{freq*carfreq}. \code{modindex} is the
+\keyword{index of modulation}, usually a value between 0 and 4, which
+determines the timbre of the resulting signal. \csoundfunc{oscili}
+behaves similarly to \csoundfunc{oscil}, except that it, like \csoundfunc{tablei}
+and \csoundfunc{oscili}, interpolates between values.
+
+Interestingly enough, these two functions are the first listed here that
+work at audio rate only; thus, we do not have to pass the rate as an argument
+to the helper function, because the rate is always \constructor{AR}. Thus, the Haskore
+code is:
+\begin{haskelllisting}
+
+> fmOsc, fmOscI :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> -> SigExp -> SigExp
+> fmOsc table modindex carfreq modfreq amp freq =
+> sigGen "foscil" AR 1 [amp, freq, carfreq, modfreq, modindex, table]
+> fmOscI table modindex carfreq modfreq amp freq =
+> sigGen "foscili" AR 1 [amp, freq, carfreq, modfreq, modindex, table]
+
+\end{haskelllisting}
+
+\item \code{sampOsc table amp freq} oscillates through a table
+containing an AIFF sampled sound segment. This is the only time a
+table can have a length that is not a power of two, as mentioned
+earlier. Like \function{fmOsc}, \function{sampOsc} can only generate values at
+the audio rate:
+\begin{haskelllisting}
+
+> sampOsc :: SigExp -> SigExp -> SigExp -> SigExp
+> sampOsc table amp freq = sigGen "loscil" AR 1 [amp, freq, table]
+
+\end{haskelllisting}
+
+\item The Haskore code \code{random rate amp} produces a random number series
+between \code{-amp} and \code{+amp} at either control or audio rate.
+\code{randomH rate quantRate amp} does the same but will hold each
+number for \code{quantRate} cycles before generating a new one.
+\code{randomI rate quantRate amp} will in addition provide straight
+line interpolation between successive numbers:
+\begin{haskelllisting}
+
+> random :: EvalRate -> SigExp -> SigExp
+> random rate amp = sigGen "rand" rate 1 [amp]
+
+> randomH, randomI :: EvalRate -> SigExp -> SigExp -> SigExp
+> randomH rate quantRate amp = sigGen "randh" rate 1 [amp, quantRate]
+> randomI rate quantRate amp = sigGen "randi" rate 1 [amp, quantRate]
+
+\end{haskelllisting}
+
+The remaining functions covered in this file only operate at audio rate,
+and thus their Haskore equivalents do not have \code{rate} arguments.
+
+\item \code{genBuzz table multiplier loharm numharms amp freq}
+generates a signal that is an additive set of harmonically related
+cosine partials. \code{freq} is the fundamental frequency,
+\code{numharms} is the number of harmonics, and \code{loharm} is the lowest
+harmonic present. The amplitude coefficients of the harmonics are
+given by the exponential series \code{a}, \code{a * multiplier},
+\code{a * multiplier\^{}2}, $\ldots$, \code{a * multiplier\^{}(numharms-1)}.
+The value \code{a} is chosen so that the sum of the amplitudes is
+\code{amp}. \code{table} is a function table containing a cosine wave.
+\begin{haskelllisting}
+
+> genBuzz :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> -> SigExp -> SigExp
+> genBuzz table multiplier loharm numharms amp freq =
+> sigGen "gbuzz" AR 1 [amp, freq, numharms, loharm, multiplier, table]
+
+\end{haskelllisting}
+\item \function{buzz} is a special case of \function{genBuzz} in which
+\code{loharm = 1.0} and \code{multiplier = 1.0}.
+\code{table} is a function table containing a sine wave:
+\begin{haskelllisting}
+
+> buzz :: SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> buzz table numharms amp freq =
+> sigGen "buzz" AR 1 [amp, freq, numharms, table]
+
+\end{haskelllisting}
+
+Note that the above two constructors have an analog in the generating
+routine \refgen{11} and the related function \function{cosineHarms}
+(see \secref{function-table}). \function{cosineHarms} stores into a table the
+same waveform that would be generated by \function{buzz} or \function{genBuzz}.
+However, although \function{cosineHarms} is more efficient, it has fixed
+arguments and thus lacks the flexibility of \function{buzz} and
+\function{genBuzz} in being able to vary the argument values with time.
+
+\item \code{pluck table freq2 decayMethod amp freq} is an
+audio signal that simulates a plucked string or drum sound,
+constructed using the Karplus-Strong algorithm. The signal has
+amplitude \code{amp} and frequency \code{freq2}. It is produced by
+iterating through an internal buffer that initially contains a copy of
+\code{table} and is smoothed with frequency \code{freq} to simulate the natural
+decay of a plucked string. If 0.0 is used for \code{table}, then the
+initial buffer is filled with a random sequence. There are six
+possible decay modes:
+\begin{enumerate}
+\item \keyword{simple smoothing}, which ignores the two arguments;
+\item \keyword{stretched smoothing}, which stretches the smoothing time by
+a factor of \code{decarg1}, ignoring \code{decarg2};
+\item \keyword{simple drum}, where \code{decarg1} is a ``roughness factor''
+(0 for pitch, 1 for white noise; a value of 0.5 gives an optimal snare
+drum sound);
+\item \keyword{stretched drum}, which contains both roughness ({\tt
+decarg1}) and stretch (\code{decarg2}) factors;
+\item \keyword{weighted smoothing}, in which \code{decarg1} gives the
+weight of the current sample and \code{decarg2} the weight of the
+previous one (\code{decarg1+decarg2} must be $\leq1$); and
+\item \keyword{recursive filter smoothing}, which ignores both arguments.
+\end{enumerate}
+Here again are some helpful constants:
+\begin{haskelllisting}
+
+> data PluckDecayMethod =
+> PluckSimpleSmooth
+> | PluckStretchSmooth SigExp
+> | PluckSimpleDrum SigExp
+> | PluckStretchDrum SigExp SigExp
+> | PluckWeightedSmooth SigExp SigExp
+> | PluckFilterSmooth
+
+\end{haskelllisting}
+And here is the Haskore code for the CSound pluck function:
+\begin{haskelllisting}
+
+> pluck :: SigExp -> SigExp -> PluckDecayMethod
+> -> SigExp -> SigExp -> SigExp
+> pluck table freq2 decayMethod amp freq =
+> sigGen "pluck" AR 1
+> ([amp, freq, freq2, table] ++
+> case decayMethod of
+> PluckSimpleSmooth ->
+> [constInt 1]
+> PluckStretchSmooth stretch ->
+> [constInt 2, stretch]
+> PluckSimpleDrum roughness ->
+> [constInt 3, roughness]
+> PluckStretchDrum roughness stretch ->
+> [constInt 4, roughness, stretch]
+> PluckWeightedSmooth weightCur weightPrev ->
+> [constInt 5, weightCur, weightPrev]
+> PluckFilterSmooth ->
+> [constInt 6])
+
+\end{haskelllisting}
+
+\item \code{delay delayTime sig} takes a signal \code{sig} and
+delays it by \code{delayTime} ---
+basically making it start \code{delayTime} later than it normally would have.
+This is a simple version of delay lines and delay taps, capable
+of performing all of the effects that don't involve feeding the result of a
+delay or a tap back into the input.
+This topic is more complicated and will be considered in the next section.
+In constrast to \function{delay},
+the function \function{vdelay} also allows for a controlled delay.
+But for memory allocation reasons
+it must also know the maximum possible delay (in seconds).
+\begin{haskelllisting}
+
+> delay :: SigExp -> SigExp -> SigExp
+> delay delayTime sig = sigGen "delay" AR 1 [sig, delayTime]
+
+> vdelay :: SigExp -> SigExp -> SigExp -> SigExp
+> vdelay maxDelay delayTime sig =
+> sigGen "vdelay" AR 1 [sig, delayTime, maxDelay*1000]
+
+\end{haskelllisting}
+
+\item Reverberation can be added to a signal using the CSound functions
+\code{comb looptime revtime sig}, \code{alpass looptime revtime sig}, and
+\code{reverb revtime sig}. \code{revtime} is the time in seconds
+it takes a signal to decay to 1/1000th of its original amplitude, and
+\code{looptime} is the echo density. \code{comb} produces a ``colored''
+reverb, \code{alpass} a ``flat'' reverb, and \code{reverb} a ``natural
+room'' reverb:
+\begin{haskelllisting}
+
+> comb :: SigExp -> SigExp -> SigExp -> SigExp
+> comb looptime revtime sig =
+> sigGen "comb" AR 1 [sig, revtime, looptime]
+
+> alpass :: SigExp -> SigExp -> SigExp -> SigExp
+> alpass looptime revtime sig =
+> sigGen "alpass" AR 1 [sig, revtime, looptime]
+
+> reverb :: SigExp -> SigExp -> SigExp
+> reverb revtime sig =
+> sigGen "reverb" AR 1 [sig, revtime]
+
+\end{haskelllisting}
+\end{enumerate}
+
+\subparagraph{Delay Lines and Tapping}
+
+\code{DelayLine deltime audiosig} establishes a digital delay line,
+where \code{audiosig} is the source, and \code{deltime} is the delay
+time in seconds. That \code{DelayLine} can either be simply read,
+by the \code{Result delayline} constructor, or tapped, by the
+\code{Tap tapname delayline args} constructor.
+
+The most common tap functions are \csoundfunc{deltap} and \csoundfunc{deltapi,}
+where \csoundfunc{deltapi} is the interpolating version of \csoundfunc{deltap}.
+Thus we will include helper functions for both of those functions:
+\begin{haskelllisting}
+
+> delTap, delTapI :: DelayLine -> SigExp -> SigExp
+> delTap dl tap = TreeRec.Branch (Tap "deltap" dl [tap])
+> delTapI dl tap = TreeRec.Branch (Tap "deltapi" dl [tap])
+
+\end{haskelllisting}
+
+\subparagraph{Recursive Statements}
+
+In some cases, the user may want their instrument to have certain
+special effects --- such as an infinite echo, going back and forth
+but getting fainter and fainter. It would seem logical that the user
+would, in that case, write something like this:
+\begin{haskelllisting}
+
+ x = sig + delay (0.5 * x) 1.0
+
+\end{haskelllisting}
+
+Unfortunately, the translation process cannot handle statements like
+that, and any kind of statement which is defined in terms of itself
+must be written a different way. {\em Within} Haskore, recursive
+statements are handled using three constructors: \constructor{Loop}, \constructor{Var},
+and \constructor{Rec}. However, these three constructors are not available
+to the users, and so we offer a very simple solution: the \function{rec}
+function:
+\begin{haskelllisting}
+
+> rec :: (SigExp -> SigExp) -> SigExp
+> rec = TreeRec.recurse
+
+\end{haskelllisting}
+
+In order to perform the infinite echo listed above, we would write this
+code:
+\begin{haskelllisting}
+
+ x = rec (\y -> sig + delay (0.5 * y) 1.0)
+
+\end{haskelllisting}
+Thus \function{rec}, in some ways, is a bit like \function{fix}, although it doesn't
+actually do the computation --- instead, it juggles some code around and
+passes the problem off to CSound.
+
+When the \type{SigExp} is processed, all \constructor{Rec} constructors are
+converted into a \type{SigExp} with \constructor{Loop} and \constructor{Var}
+constructors. Each \constructor{Loop} has some number of matching \constructor{Var}
+statements, with the same unique integer referring to both. This is
+done through the \function{runFix} function and its various helper functions:
+
+\begin{haskelllisting}
+
+> type SigFixed = TreeTag.T TreeRec.Tag SigTerm
+>
+> runFix, simpleFix :: SigExp -> SigFixed
+> runFix = addEqTree . TreeRec.toTaggedUnique 1
+> {- some expressions need no loop unwinding,
+> toTagged does unwinding anyway, but with less overhead
+> and shared loop ids -}
+> simpleFix = TreeRec.toTagged 0
+>
+> instance Foldable BooleanTerm where
+> foldMap = Traversable.foldMapDefault
+>
+> instance Traversable BooleanTerm where
+> sequenceA branch =
+> case branch of
+> Operator nm left right ->
+> liftA2 (Operator nm) (sequenceA left) (sequenceA right)
+> Comparison nm left right ->
+> liftA2 (Comparison nm) ( left) ( right)
+>
+> instance Foldable DelayLineTerm where
+> foldMap = Traversable.foldMapDefault
+>
+> instance Traversable DelayLineTerm where
+> sequenceA (DelayLine x y) = liftA2 DelayLine x y
+>
+> instance Foldable SigTerm where
+> foldMap = Traversable.foldMapDefault
+>
+> instance Traversable SigTerm where
+> sequenceA branch =
+> case branch of
+> {- compare with Functor instance -}
+> ConstFloat x -> pure $ ConstFloat x
+> ConstInt n -> pure $ ConstInt n
+> TableNumber t -> pure $ TableNumber t
+> PField n -> pure $ PField n
+> Str str -> pure $ Str str
+> Read t -> pure $ Read t
+> Tap nm del xs -> liftA2 (Tap nm) (sequenceA del) (sequenceA xs)
+> Result del -> liftA Result (sequenceA del)
+> Conditional b true false ->
+> liftA3 Conditional (sequenceA b) true false
+> Infix nm left right -> liftA2 (Infix nm) left right
+> Prefix nm arg -> liftA (Prefix nm) arg
+> SigGen nm rate cnt args ->
+> liftA (SigGen nm rate cnt) (sequenceA args)
+> Index cnt x -> liftA (Index cnt) (sequenceA x)
+
+> -- fixSig (Rec (LoopFunction f)) =
+> -- do n <- get; put (n + 1); fixSig (Loop n (addEq (f (Var n))))
+
+> addEqTree :: SigFixed -> SigFixed
+> addEqTree (TreeTag.Branch x) = TreeTag.Branch (fmap addEqTree x)
+> addEqTree (TreeTag.Tag t x) = TreeTag.Tag t (addEqTree (addEq x))
+> addEqTree (TreeTag.Loop t) = TreeTag.Loop t
+
+> addEq :: SigFixed -> SigFixed
+> addEq ex =
+> case ex of
+> TreeTag.Branch (SigGen _ _ _ _) -> ex
+> TreeTag.Branch (Tap _ _ _) -> ex
+> TreeTag.Branch (Result _) -> ex
+> _ -> TreeTag.Branch (SigGen "="
+> (if CR == getRate ex
+> then CR else AR) 1 [ex])
+
+> getRate :: SigFixed -> EvalRate
+> getRate (TreeTag.Branch branch) = getRateTerm branch
+> getRate (TreeTag.Tag _ arg) = getRate arg
+> getRate (TreeTag.Loop _) = error "getRate: undefined rate"
+
+> getRateTerm :: SigTerm SigFixed -> EvalRate
+> getRateTerm branch =
+> case branch of
+> Tap _ _ _ -> AR
+> Result _ -> AR
+> Conditional _ a b -> max (getRate a) (getRate b)
+> Infix _ a b -> max (getRate a) (getRate b)
+> Prefix _ arg -> getRate arg
+> SigGen _ rt _ _ -> rt
+> Index _ arg -> getRateTerm arg
+> _ -> NR
+
+\end{haskelllisting}
+
+Note that the \function{addEq} function is used to add an equal sign to the
+statement being looped, provided that the statement is not already one
+of the signal generating ones. Also note that if the rate of the
+statement is \constructor{NR}, the new rate will be \constructor{AR} --- this is because
+you cannot have an infinitely recursive statement at the note rate.
+
+Ideally, all \type{SigExp} statements should have \function{runFix} applied
+to them. So we have the \function{getFixedExpressions} function, used as
+a replacement to the standard \function{getChannels} of the \type{Output} class:
+\begin{haskelllisting}
+
+> getFixedExpressions :: Output a => a -> [SigFixed]
+> getFixedExpressions = map (aux . runFix) . getChannels
+> where aux ex =
+> if AR == getRate ex
+> then ex
+> else TreeTag.Branch (SigGen "=" AR 1 [ex])
+
+\end{haskelllisting}
+
+\subparagraph{Signal Generators with Multiple Outputs}
+
+When looking through the CSound documentation, you may notice that there are
+certain functions, such as \csoundfunc{convolve} or \csoundfunc{babo} that do not have the same
+structure in CSound as the most of the rest of the functions. This is because
+those are two operators that actually return multiple outputs. While this type
+of function is not extremely common, we have included code that can, in fact,
+handle such functions. The third argument to the \function{sigGen} constructor
+actually specifies the number of arguments to be returned. In most cases, this
+should simply be set to one; in a few cases, such as \csoundfunc{convolve} or \csoundfunc{babo},
+this should be set to however many outputs you want returned from the function.
+
+But how do you get to those outputs? Well, the \constructor{Index} constructor is
+used from within the code, but the user cannot access that. So we have the
+following function:
+
+\begin{haskelllisting}
+
+> getMultipleOutputs :: SigExp -> [SigExp]
+> getMultipleOutputs (TreeRec.Branch ex@(SigGen _ _ outCount _)) =
+> if outCount==1
+> then error ("cannot get multiple outputs from a function with one output")
+> else map (TreeRec.Branch . flip Index ex) [1..outCount]
+> getMultipleOutputs _ =
+> error ("cannot get multiple outputs from a non-SigGen")
+
+\end{haskelllisting}
+
+Which can be called on any \function{sigGen} statement returning multiple
+arguments, and returns a list of the outputs. In other words, you could
+write something like this:
+\begin{haskelllisting}
+
+ [a1, a2] = getMultipleOutputs
+ (LineStatement "babo" AR 2 [sig, 0, 0, 0, 5, 5, 5])
+
+\end{haskelllisting}
+
+Haskell would then pattern-match, and leave you with two variables,
+\code{a1} and \code{a2}.
+
+\paragraph{Output Operators}
+
+Now that we've got all of those interesting methods of signal generation
+under our belts, we need some way to make CSound play these interesting
+sound waves. Hence, the \keyword{output statements}, all of which must be
+instances of the {\tt Output} class:
+\begin{haskelllisting}
+
+> class (Show c, Eq c) => Output c where
+> getChannels :: c -> [SigExp]
+> getName :: c -> String
+> getChannelCount :: c -> Int
+
+\end{haskelllisting}
+
+The \function{getChannelCount} could be pre-defined
+with \code{length . getChannels}
+but this would require that we have actually an \type{Output} value at hand
+when calling \function{getChannelCount}.
+
+We have defined several common types of output, including
+\type{Mono}, which allows for the writing of one output channel; \type{Stereo},
+which allows for two; and \type{Quad}, which, unsurprisingly, allows four:
+\begin{haskelllisting}
+
+> data Mono = Mono SigExp deriving (Show, Eq)
+> data Stereo = Stereo SigExp SigExp deriving (Show, Eq)
+> data Quad = Quad SigExp SigExp SigExp SigExp deriving (Show, Eq)
+>
+> instance Output Mono where
+> getChannels (Mono x) = [x]
+> getName _ = "out"
+> getChannelCount _ = 1
+>
+> instance Output Stereo where
+> getChannels (Stereo x1 x2) = [x1, x2]
+> getName _ = "outs"
+> getChannelCount _ = 2
+>
+> instance Output Quad where
+> getChannels (Quad x1 x2 x3 x4) = [x1, x2, x3, x4]
+> getName _ = "outq"
+> getChannelCount _ = 4
+
+\end{haskelllisting}
+
+The user is welcome to add more by declaring them instances of the
+{\tt Output} class and then filling out the required methods.
+
+\paragraph{Converting Orchestra Values to Orchestra Files}
+
+We must now convert the \type{SigExp} values into a form which can be
+written into a CSound {\tt .sco} file. As mentioned earlier, each
+signal generation or modification statement in CSound assigns its
+result a string name. This name is used whenever another statement
+takes the signal as an argument. Names of signals generated at note
+rate must begin with the letter \csoundfunc{i}, control rate with letter \csoundfunc{k},
+and audio rate with letter \csoundfunc{a}. The output statements do not
+generate a signal so they do not have a result name.
+
+\begin{figure}
+{\scriptsize\vspace{-.9in}
+\begin{haskelllisting}
+
+> mkList :: SigFixed -> [SigFixed]
+> mkList ex@(TreeTag.Branch n) = ex : mkListTerm n
+> mkList ex@(TreeTag.Tag _ x) = ex : mkList x
+> mkList (TreeTag.Loop _) = []
+
+> mkListTerm :: SigTerm SigFixed -> [SigFixed]
+> mkListTerm term =
+> case term of
+> Tap _ dl lst -> mkListDL dl ++ mkListAll lst
+> Result dl -> mkListDL dl
+> Conditional a b c -> mkListBool a ++ mkListAll [b, c]
+> Infix _ a b -> mkListAll [a, b]
+> Prefix _ x -> mkList x
+> SigGen _ _ outCount lst ->
+> if outCount == 1
+> then mkListAll lst
+> else map (TreeTag.Branch . flip Index term) [1..outCount]
+> ++ mkListAll lst
+> -- cf. getMultipleOutputs
+> Index _ expr -> mkListTerm expr
+> _ -> []
+
+\end{haskelllisting}
+}
+\caption{The \function{mkList} Function}
+\figlabel{mkList}
+\end{figure}
+
+The function \function{mkList} is shown in \figref{mkList}, and
+generates a list containing every single sub-expression of the given
+\type{SigExp}. It uses the following auxiliary functions:
+\begin{haskelllisting}
+
+> type DelayLineFixed = DelayLineTerm SigFixed
+> type BooleanFixed = BooleanTerm SigFixed
+
+> mkListAll :: [SigFixed] -> [SigFixed]
+> mkListAll = concatMap mkList
+
+> mkListDL :: DelayLineFixed -> [SigFixed]
+> mkListDL (DelayLine x1 x2) = mkListAll [x1, x2]
+
+> mkListBool :: BooleanFixed -> [SigFixed]
+> mkListBool (Operator _ a b) = concatMap mkListBool [a, b]
+> mkListBool (Comparison _ a b) = mkListAll [a, b]
+
+> mkListOut :: Output a => InstrBlock a -> [SigFixed]
+> mkListOut (InstrBlock _ xtim chnls lst) =
+> mkListAll (simpleFix xtim : getFixedExpressions chnls ++
+> map (simpleFix . snd) lst)
+> -- there should not be any loop to be unwind in lst
+
+\end{haskelllisting}
+
+Once we have the list of all of the expressions, we need to find the
+signal-generating ones, like \constructor{Tap}s and \function{sigGen}s, and convert
+them into a list of \type{StatementDef}s, with their associated rates.
+This is done using the function \function{getLineRates}.
+
+\begin{haskelllisting}
+
+> type LineFunctionRates = [(EvalRate, StatementDef)]
+
+> data StatementDef = StatementDef Function [SigFixed]
+> | TapDef Function DelayLineFixed [SigFixed]
+> | DelayDef DelayLineFixed
+> | DelayWriteDef DelayLineFixed
+> | MultiDef Function [SigFixed]
+> OutCount (SigTerm SigFixed)
+> | IndexDef OutCount (SigTerm SigFixed)
+> deriving (Show, Eq)
+
+> getLineRates :: [SigFixed] -> LineFunctionRates
+> getLineRates = mapMaybe aux
+> where
+> aux (TreeTag.Branch n) =
+> case n of
+> Tap nm dl lst -> Just (AR, TapDef nm dl lst)
+> Result dl -> Just (AR, DelayDef dl)
+> SigGen nm rt ct lst -> Just (rt,
+> if ct==1
+> then StatementDef nm lst
+> else MultiDef nm lst ct n)
+> Index ct ex@(SigGen _ rt _ _) ->
+> Just (rt, IndexDef ct ex)
+> _ -> Nothing
+> aux _ = Nothing
+
+\end{haskelllisting}
+
+\type{DelayLine}s and \type{Tap}s are a rather complex problem in Haskore.
+In CSound, there is no such thing as an explicit delay line; you establish
+a delay line with a \csoundfunc{delayr} opcode, and then all taps that occur between
+that line and the matching \csoundfunc{delayw} line belong to that particular delay
+line. Thus the translation from the Haskore concept of delay lines to the
+CSound concept is somewhat difficult. Hence \function{procDelay} and its various
+helper functions, which gather all of the taps together and add the requisite
+\type{DelayWriteDef} to the end of them:
+
+\begin{haskelllisting}
+
+> procDelay :: LineFunctionRates -> LineFunctionRates
+> procDelay lst@((_, DelayDef dl) : _) = setUpDelays lst dl
+> procDelay lst@((_, TapDef _ dl _) : _) = setUpDelays lst dl
+> procDelay (hd : tl) = hd : procDelay tl
+> procDelay [] = []
+
+> setUpDelays :: LineFunctionRates -> DelayLineFixed -> LineFunctionRates
+> setUpDelays lst dl =
+> let aux (_, DelayDef dl2) = dl == dl2
+> aux (_, TapDef _ dl2 _) = dl == dl2
+> aux _ = False
+> (dels, rest) = partition aux lst
+> in procTaps dels dl ++ procDelay rest
+
+> procTaps :: LineFunctionRates -> DelayLineFixed -> LineFunctionRates
+> procTaps lst dl =
+> [(AR, DelayDef dl)] ++ filter aux lst ++ [(AR, DelayWriteDef dl)]
+> where aux (_, TapDef _ _ _) = True
+> aux _ = False
+
+\end{haskelllisting}
+
+Putting all of the above together, here is a function that converts an
+\type{SigExp} into a list of proper name / \type{StatementDef} pairs. Each
+one of these will eventually result in one statement in the CSound
+orchestra file. (The result of \function{getLineRates} is reversed to ensure
+that a definition exists before it is used; and this must be done {\em
+before} \function{nub} is applied (which removes duplicates), for the same
+reason.)
+\begin{haskelllisting}
+
+> type StatementDefs = [(Name, StatementDef)]
+
+> extractFunctions :: [SigFixed] -> StatementDefs
+> extractFunctions =
+> zipWith giveName [1 ..] . nub . procDelay . reverse . getLineRates
+
+> giveName :: Int -> (EvalRate, StatementDef) -> (Name, StatementDef)
+> giveName n (er,x) =
+> let var = case er of
+> AR -> 'a'
+> CR -> 'k'
+> NR -> 'i'
+> in (var : show n, x)
+
+\end{haskelllisting}
+
+The functions that follow are used to write the orchestra file.
+\function{saveIA} is similar to \function{Score.saveIA}:
+it asks the user for a file name, opens the file,
+writes the given orchestra value to the file, and then closes the file.
+\begin{haskelllisting}
+
+> saveIA :: Output a => T a -> IO ()
+> saveIA orch =
+> do putStr "\nName your orchestra file "
+> putStr "(.orc extension will be added): "
+> name <- getLine
+> save name orch
+
+> save :: Output a => FilePath -> T a -> IO ()
+> save name orch =
+> writeFile (name ++ ".orc") (toString orch)
+
+\end{haskelllisting}
+
+\function{CSound.Orchestra.toString} splits the task of writing the
+orchestra into two parts: writing the header, and writing the instrument
+blocks.
+\begin{haskelllisting}
+
+> toString :: Output a => T a -> String
+> toString orc@(Cons hdr ibs) =
+> let glob = getGlobal ibs
+> in unlines $
+> headerToString hdr (channelCount orc) ++
+> maybe [] writeGlobalHeader glob ++
+> concatMap instrBlockToString ibs ++
+> maybe [] resetGlobals glob
+
+\end{haskelllisting}
+Writing the header is relatively simple, and is accomplished by the
+following function:
+\begin{haskelllisting}
+
+> headerToString :: Header -> Int -> [String]
+> headerToString (a,k) nc =
+> ["sr = " ++ show a,
+> "kr = " ++ show k,
+> "ksmps = " ++ show (fromIntegral a / fromIntegral k :: Double),
+> "nchnls = " ++ show nc]
+
+> channelCount :: Output a => T a -> Int
+> channelCount (Cons _ instrBlock) =
+> getChannelCount (instrBlockOutput (head instrBlock))
+
+\end{haskelllisting}
+
+If the instance of \function{getChannelCount}
+does not rely on \function{getChannels}
+the \expression{instrBlock} can be empty.
+
+
+\function{instrBlockToString} writes a single instrument block.
+\begin{haskelllisting}
+
+> instrBlockToString :: Output a => InstrBlock a -> [String]
+> instrBlockToString ib@(InstrBlock num xtim _ _) =
+> let ses = mkListOut ib
+> noes = extractFunctions ses
+> lps = getLoops noes ses
+> in "" :
+> showInstrument num :
+> writeLoops lps ++
+> concatMap (writeExp noes lps) noes ++
+> writeOut noes lps ib ++
+> (if xtim /= 0
+> then ["xtratim " ++ showExp noes lps (simpleFix xtim)]
+> else []) ++
+> "endin" :
+> []
+
+> showInstrument :: Instrument -> String
+> showInstrument instr = "instr " ++ showInstrumentNumber instr
+
+\end{haskelllisting}
+
+\constructor{Loop} statements require special handling, including initialization at
+the top of each instrument and a special set of loop definitions which are
+also passed to most of the writing functions. This is handled by the
+following two functions:
+\begin{haskelllisting}
+
+> type LoopDefs = [(TreeRec.Tag, String)]
+
+> writeLoops :: LoopDefs -> [String]
+> writeLoops = map ((++ " init 0") . snd)
+
+> getLoops :: StatementDefs -> [SigFixed] -> LoopDefs
+> getLoops noes =
+> let extractTag (TreeTag.Tag n ex) = Just (n, ex)
+> extractTag _ = Nothing
+> in map (mapSnd (showExp noes []))
+> . nub . mapMaybe extractTag
+> -- map and mapMaybe are separated for efficiency achieved by nub
+
+\end{haskelllisting}
+
+Globals, too, require special handling: they need both a header at the top
+of the CSound orchestra file, and an instrument in which to reset their values.
+Those requirements are fulfilled by the following functions, which are called
+from the \function{instrBlockToString} function.
+
+\begin{haskelllisting}
+
+> globalRate :: EvalRate -> String
+> globalRate AR = "a"
+> globalRate CR = "k"
+> globalRate NR = error ("you cannot use init-rate globals")
+
+> globalWrite, globalRead :: GlobalSig -> String
+> globalWrite (Global rate _ n) = "g" ++ globalRate rate ++ "w" ++ show n
+> globalRead (Global rate _ n) = "g" ++ globalRate rate ++ "r" ++ show n
+
+> resetGlobals :: ([GlobalSig], Instrument) -> [String]
+> resetGlobals (gs,num) =
+> let aux g =
+> (globalRead g ++ " = " ++ globalWrite g) :
+> (globalWrite g ++ " = 0") :
+> []
+> in "" :
+> showInstrument num :
+> concatMap aux gs ++
+> "endin" :
+> []
+
+> numGlobalInstrs :: Output a => [InstrBlock a] -> Instrument
+> numGlobalInstrs lst =
+> head (instruments \\ map instrBlockInstr lst)
+
+> getGlobals :: Output a => [InstrBlock a] -> [GlobalSig]
+> getGlobals = concatMap (map fst . instrBlockGlobals)
+
+> getGlobal :: Output a => [InstrBlock a] -> Maybe ([GlobalSig], Instrument)
+> getGlobal lst =
+> let gs = getGlobals lst
+> in toMaybe (not (null gs)) (gs, numGlobalInstrs lst)
+
+> writeGlobalHeader :: ([GlobalSig], Instrument) -> [String]
+> writeGlobalHeader (gs,num) =
+> let globInit g =
+> (globalWrite g ++ " init 0") :
+> (globalRead g ++ " init 0") :
+> []
+> contents =
+> concatMap globInit gs ++
+> ("turnon " ++ showInstrumentNumber num) :
+> []
+> in "" : contents ++ "" : []
+
+> writeOutGlobals :: StatementDefs -> LoopDefs ->
+> [(GlobalSig, SigFixed)] -> [String]
+> writeOutGlobals noes lps =
+> let aux (g, oe) =
+> globalWrite g ++ " = " ++ globalWrite g ++ " + " ++
+> writeArgs noes lps [oe]
+> in map aux
+
+\end{haskelllisting}
+
+Recall that after processing, the \type{SigExp} becomes a list of
+\code{(Name, StatementDef)} pairs. The last few functions write each of these
+named \type{StatementDef}s as a statement in the orchestra file. Whenever a
+signal generation/modification constructor is encountered in an
+argument list of another constructor, the argument's string name is
+used instead, as found in the list of \type{(Name, StatementDef)} pairs.
+
+\begin{figure}
+{\small
+\begin{haskelllisting}
+
+> writeOut :: Output a => StatementDefs -> LoopDefs -> InstrBlock a -> [String]
+> writeOut noes lps (InstrBlock _ _ chnls lst) =
+> (getName chnls ++ " " ++ writeArgs noes lps (getFixedExpressions chnls)) :
+> writeOutGlobals noes lps (map (mapSnd simpleFix) lst)
+
+> writeExp :: StatementDefs -> LoopDefs -> (Name, StatementDef) -> [String]
+> writeExp noes lps (name, stmt) =
+> case stmt of
+> StatementDef funcName args ->
+> [ifAllowedArgs funcName args
+> (name ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)]
+> DelayDef (DelayLine _ del) ->
+> [name ++ " delayr " ++ showExp noes lps del]
+> TapDef funcName _ args ->
+> [ifAllowedArgs funcName args
+> (name ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)]
+> DelayWriteDef (DelayLine sig _) ->
+> ["delayw " ++ showExp noes lps sig]
+> IndexDef _ _ -> []
+> MultiDef funcName args outCount ex {- 'ex' is always a SigGen -} ->
+> [ifAllowedArgs funcName args
+> (concat (intersperse ", "
+> (map (\x -> showExp noes lps
+> (TreeTag.Branch (Index x ex)))
+> [1..outCount]))
+> ++ " " ++ funcName ++ " " ++ writeArgs noes lps args)]
+>
+> ifAllowedArgs :: String -> [SigFixed] -> String -> String
+> ifAllowedArgs funcName args str =
+> if allowedArgs argCountTable funcName (length args)
+> then str
+> else error ("writeExp: wrong number of arguments " ++
+> "passed to function " ++ funcName)
+
+> writeArgs :: StatementDefs -> LoopDefs -> [SigFixed] -> String
+> writeArgs noes lps =
+> concat . intersperse ", " . map (showExp noes lps)
+
+\end{haskelllisting}
+}
+\caption{The Function \function{writeExp}}
+\figlabel{writeExp}
+\end{figure}
+
+\begin{figure}
+{\small
+\begin{haskelllisting}
+
+> showExp :: StatementDefs -> LoopDefs -> SigFixed -> String
+> showExp noes lps (TreeTag.Branch oe) =
+> case oe of
+> ConstFloat x -> show x
+> ConstInt n -> show n
+> TableNumber n -> show n
+> PField p -> "p" ++ show p
+> Str s -> show s
+> Read var -> globalRead var
+> Conditional b tr fa ->
+> "(" ++ showBool noes lps b ++ " ? "
+> ++ showExp noes lps tr ++ " : "
+> ++ showExp noes lps fa ++ ")"
+> Infix nm x1 x2 ->
+> "(" ++ showExp noes lps x1 ++ " " ++ nm ++ " "
+> ++ showExp noes lps x2 ++ ")"
+> Prefix nm x -> nm ++ "(" ++ showExp noes lps x ++ ")"
+> SigGen nm _ _ args ->
+> lookupDef noes (StatementDef nm args) oe
+> Result dl -> lookupDef noes (DelayDef dl) oe
+> Tap nm dl args -> lookupDef noes (TapDef nm dl args) oe
+> Index x ex -> lookupDef noes (IndexDef x ex) oe
+> showExp noes lps (TreeTag.Tag _ ex) =
+> showExp noes lps ex
+> showExp _ lps (TreeTag.Loop s) =
+> maybe (error "loop not found") id (lookup s lps)
+
+> lookupDef :: (Show a, Eq c) => [(b, c)] -> c -> a -> b
+> lookupDef noes def oe =
+> maybe (error ("showExp " ++ show oe ++ ": constructor not found\n"))
+> id (lookup def (map (\(x, y) -> (y, x)) noes))
+
+> showBool :: StatementDefs -> LoopDefs -> BooleanFixed -> String
+> showBool noes lps bool =
+> case bool of
+> Operator name x1 x2 ->
+> "(" ++ showBool noes lps x1 ++ " " ++ name ++ " "
+> ++ showBool noes lps x2 ++ ")"
+> Comparison name x1 x2 ->
+> "(" ++ showExp noes lps x1 ++ " " ++ name ++ " "
+> ++ showExp noes lps x2 ++ ")"
+
+\end{haskelllisting}
+}
+\caption{The Function \function{showExp}}
+\figlabel{showExp}
+\end{figure}
+
+\paragraph{The \type{Orc} Monad}
+
+The global signals can be somewhat difficult to handle, especially when there
+are quite a few of them. After all, they must all be different; otherwise,
+the user may have two instruments writing completely different things to the
+same signal, and using the same signals for completely different things. However,
+there is an easier way to do this --- a monad that allows for a much simpler way
+of getting global signals:
+
+\begin{haskelllisting}
+
+> type Orc a b = State (OrcState a) b
+> data OrcState a = OrcState [InstrBlock a] Int deriving (Show, Eq)
+
+> mkSignalPlain :: EvalRate -> (SigExp -> SigExp -> SigExp) -> OrcState a
+> -> (GlobalSig, OrcState a)
+> mkSignalPlain rate func (OrcState ibs gCount) =
+> (Global rate func gCount, OrcState ibs (gCount + 1))
+
+> mkSignal :: Output a => EvalRate -> (SigExp -> SigExp -> SigExp)
+> -> Orc a GlobalSig
+> mkSignal rate func = State (mkSignalPlain rate func)
+
+> addInstrPlain :: Output a => InstrBlock a -> OrcState a -> OrcState a
+> addInstrPlain ib (OrcState ibs gCount) =
+> OrcState (ibs ++ [ib]) gCount
+
+> addInstr :: Output a => InstrBlock a -> Orc a ()
+> addInstr ib = modify (addInstrPlain ib)
+
+> runOrc :: Orc a () -> [InstrBlock a]
+> runOrc comp =
+> case execState comp (OrcState [] 1) of
+> (OrcState ibs _) -> ibs
+
+> mkOrc :: Output a => Header -> Orc a () -> T a
+> mkOrc hdr = Cons hdr . runOrc
+
+\end{haskelllisting}
+
+The user can call \function{mkSignal} to get a unique global line, or
+\function{addInstr} to add an instrument to the structure. For example:
+
+\begin{haskelllisting}
+
+> test :: IO ()
+> test =
+> let a1 = oscI AR (tableNumber 1) 1000 440
+> comp =
+> do h <- mkSignal AR (+)
+> addInstr (InstrBlock (instrument 1) 0 (Mono a1) [(h, a1)])
+> addInstr (InstrBlock (instrument 2) 0 (Mono (readGlobal h)) [])
+> in saveIA (mkOrc (44100, 4410) comp)
+
+\end{haskelllisting}
+
+The above example has the first instrument writing a simple oscillation
+to the given audio-rate global signal, and then has the second instrument
+reading from the same global.
+
+\paragraph{An Orchestra Example}
+
+\figref{csound-orc-file} shows a typical CSound orchestra
+file. \figref{orc-def} shows how this same functionality
+would be achieved in Haskore using an \type{CSound.Orchestra.T} value. Finally,
+\figref{orc-file-result} shows the result of applying
+\function{Orchestra.saveIA} to \code{orc1} shown in \figref{orc-def}.
+Figures \ref{fig:csound-orc-file} and \ref{fig:orc-file-result}
+should be compared: you will note that except for name changes, they
+are the same, as they should be.
+
+\begin{figure}
+\begin{verbatim}
+
+sr = 48000
+kr = 24000
+ksmps = 2
+nchnls = 2
+
+instr 4
+
+inote = cpspch(p5)
+
+k1 envlpx ampdb(p4), .001, p3, .05, 6, -.1, .01
+k2 envlpx ampdb(p4), .0005, .1, .1, 6, -.05, .01
+k3 envlpx ampdb(p4), .001, p3, p3, 6, -.3, .01
+
+a1 oscili k1, inote, 1
+a2 oscili k1, inote * 1.004, 1
+a3 oscili k2, inote * 16, 1
+a4 oscili k3, inote, 5
+a5 oscili k3, inote * 1.004, 5
+
+outs (a2 + a3 + a4) * .75, (a1 + a3 + a5) * .75
+
+endin
+
+\end{verbatim}
+\caption{Sample CSound Orchestra File}
+\figlabel{csound-orc-file}
+\end{figure}
+
+\begin{figure}
+\begin{haskelllisting}
+
+> orc1 :: T Stereo
+> orc1 =
+> let hdr = (48000, 24000)
+> inote = pchToHz p5
+> k1 = env CR 6 (-0.1) 0.01 0 0.05 0.001 p3 (dbToAmp p4)
+> k2 = env CR 6 (-0.05) 0.01 0 0.1 0.0005 0.1 (dbToAmp p4)
+> k3 = env CR 6 (-0.3) 0.01 0 p3 0.001 p3 (dbToAmp p4)
+> t1 = tableNumber 1
+> t5 = tableNumber 5
+> a1 = oscI AR t1 k1 inote
+> a2 = oscI AR t1 k1 (inote*1.004)
+> a3 = oscI AR t1 k2 (inote*16)
+> a4 = oscI AR t5 k3 inote
+> a5 = oscI AR t5 k3 (inote*1.004)
+> out = Stereo ((a2+a3+a4) * 0.75) ((a1+a3+a5) * 0.75)
+> ib = InstrBlock (instrument 4) 0 out []
+> in Cons hdr [ib]
+
+> test1 :: StatementDefs
+> test1 = extractFunctions $ mkListOut (head ((\(Cons _ x) -> x) orc1))
+
+\end{haskelllisting}
+\caption{Haskore Orchestra Definition}
+\figlabel{orc-def}
+\end{figure}
+
+\begin{figure}
+\begin{verbatim}
+
+sr = 48000
+kr = 24000
+ksmps = 2.0
+nchnls = 2
+
+instr 4
+k1 envlpx ampdb(p4), 1.0e-3, p3, p3, 6.0, -(0.3), 1.0e-2, 0.0
+a2 oscili k1, (cpspch(p5) * 1.004), 5
+k3 envlpx ampdb(p4), 5.0e-4, 0.1, 0.1, 6.0, -(5.0e-2), 1.0e-2, 0.0
+a4 oscili k3, (cpspch(p5) * 16.0), 1
+k5 envlpx ampdb(p4), 1.0e-3, p3, 5.0e-2, 6.0, -(0.1), 1.0e-2, 0.0
+a6 oscili k5, cpspch(p5), 1
+a7 oscili k1, cpspch(p5), 5
+a8 oscili k5, (cpspch(p5) * 1.004), 1
+outs (((a8 + a4) + a7) * 0.75), (((a6 + a4) + a2) * 0.75)
+endin
+
+\end{verbatim}
+\caption{Result of \code{Orchestra.saveIA orc1}}
+\figlabel{orc-file-result}
+\end{figure}
diff --git a/src/Haskore/Interface/CSound/OrchestraFunction.lhs b/src/Haskore/Interface/CSound/OrchestraFunction.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/OrchestraFunction.lhs
@@ -0,0 +1,590 @@
+> module Haskore.Interface.CSound.OrchestraFunction where
+> import Haskore.General.Utility (headWithDefault)
+> import Data.List (lookup)
+
+> {- a fast variant of 'elem'
+> precondition: list must be sorted
+> This could be replaced by Data.Map when it is widely available. -}
+> elemSorted :: (Ord a) => a -> [a] -> Bool
+> elemSorted x ys =
+> EQ == headWithDefault LT (dropWhile (GT==) (map (compare x) ys))
+
+> allowedArgs :: [(String, [Int])] -> String -> Int -> Bool
+> allowedArgs table name count =
+> maybe True (elemSorted count) (lookup name table)
+
+> -- This should be a Data.Map in future.
+> argCountTable :: [(String, [Int])]
+> argCountTable = [("=", [1]),
+> ("-", [1]),
+> ("a", [1]),
+> ("abs", [1]),
+> ("active", [1]),
+> ("adsr", [4, 5]),
+> ("adsyn", [4]),
+> ("adsynt", [6, 7]),
+> ("aftouch", [0..2]),
+> ("alpass", [3..5]),
+> ("ampdb", [1]),
+> ("ampdbfs", [1]),
+> ("ampmidi", [1, 2]),
+> ("areson", [3..5]),
+> ("aresonk", [3..5]),
+> ("atone", [2, 3]),
+> ("atonek", [2, 3]),
+> ("atonex", [2..4]),
+> ("babo", [7..9]), -- gives two outputs
+> ("balance", [2..4]),
+> ("bamboo", [2..8]),
+> ("bbcutm", [6..9]),
+> ("bbcuts", [7..10]), -- gives two outputs
+> ("betarand", [3]),
+> ("bexprnd", [1]),
+> ("biquad", [7, 8]),
+> ("biquada", [7, 8]),
+> ("birnd", [1]),
+> ("bqrez", [3..5]),
+> ("butterbp", [3, 4]),
+> ("butterbr", [3, 4]),
+> ("butterhp", [2, 3]),
+> ("butterlp", [2, 3]),
+> ("button", [1]), -- gui
+> ("buzz", [4, 5]),
+> ("cabasa", [2..5]),
+> ("cauchy", [1]),
+> ("cent", [1]),
+> ("chanctrl", [2..4]),
+> ("changed", [1..]),
+> ("checkbox", [1]), -- gui
+> ("clear", [1..]), -- no output
+> ("clfilt", [4..8]),
+> ("clip", [3, 4]),
+> ("clockoff", [1]), -- no output
+> ("clockon", [1]), -- no output
+> ("comb", [3..5]),
+> ("control", [1]), -- gui
+> ("convolve", [2, 3]), -- gives 1-4 outputs
+> ("cos", [1]),
+> ("cosh", [1]),
+> ("cosinv", [1]),
+> ("cps2pch", [2]),
+> ("cpsmidi", [0]),
+> ("cpsmidib", [0, 1]),
+> ("cpsoct", [1]),
+> ("cpspch", [1]),
+> ("cpstmid", [1]),
+> ("cpstun", [3]),
+> ("cpstuni", [2]),
+> ("cpsxpch", [4]),
+> ("cpuprc", [2]), -- no output
+> ("cross2", [6]),
+> ("crunch", [2..5]),
+> ("ctrl14", [5, 6]),
+> ("ctrl21", [6, 7]),
+> ("ctrl7", [4, 5]),
+> ("ctrlinit", [3, 5..65]), -- no output
+> ("cuserrnd", [3]),
+> ("dam", [6]),
+> ("db", [1]),
+> ("dbamp", [1]),
+> ("dbfsamp", [1]),
+> ("dcblock", [1, 2]),
+> ("dconv", [3]),
+> ("delay", [1, 2]),
+> ("delay1", [1, 2]),
+> ("delayr", [1]),
+> ("delayw", [1]), -- no output
+> ("deltap", [1]),
+> ("deltap3", [1]),
+> ("deltapi", [1]),
+> ("deltapn", [1]),
+> ("deltapx", [2]),
+> ("deltapxw", [3]), -- no output
+> ("diff", [1, 2]),
+> ("diskin", [2..6]), -- gives 1-4 outputs
+> ("dispfft", [3..6]), -- no output
+> ("display", [2..4]), -- no output
+> ("distort", [5]),
+> ("divz", [3]),
+> ("downsamp", [1, 2]),
+> ("dripwater", [2..8]),
+> ("dumpk", [4]), -- no output
+> -- several other dump functions with no output
+> ("duserrnd", [1]),
+> ("envlpx", [7, 8]),
+> ("envlpxr", [6..8]),
+> -- "event" cannot be created because strings are not OrcExps
+> ("exp", [1]),
+> ("expon", [3]),
+> ("exprand", [1]),
+> ("expseg", [3, 5..]),
+> ("expsega", [3, 5..]),
+> ("expsegr", [5, 7..]),
+> ("filelen", [1]),
+> ("filenchnls", [1]),
+> ("filepeak", [1, 2]),
+> ("filesr", [1]),
+> ("filter2", [3..]),
+> ("fin", [4..]), -- no output
+> ("fini", [4..]), -- no output
+> ("fink", [4..]), -- no output
+> ("fiopen", [2]), -- takes a string argument
+> ("flanger", [3, 4]),
+> ("flashtxt", [2]), -- no output, gui
+> -- several different gui elements occur here
+> ("fmb3", [11]),
+> ("fmbell", [11]),
+> ("fmmetal", [11]),
+> ("fmpercfl", [11]),
+> ("fmrhode", [11]),
+> ("fmvoice", [11]),
+> ("fmwurlie", [11]),
+> ("fof", [12..15]),
+> ("fof2", [14, 15]),
+> ("fofilter", [4, 5]),
+> ("fog", [13..16]),
+> ("fold", [2]),
+> ("follow", [2]),
+> ("follow2", [3]),
+> ("foscil", [6, 7]),
+> ("focsili", [6, 7]),
+> ("fout", [3..]), -- no output
+> ("fouti", [4..]), -- no output
+> ("foutir", [4..]), -- no output
+> ("foutk", [3..]), -- no output
+> ("fprintks", [2..]), -- no output
+> ("fprints", [2..]), -- no output
+> ("frac", [1]),
+> ("ftchnls", [1]),
+> ("ftgen", [5..]),
+> ("ftlen", [1]),
+> ("ftload", [3..]),
+> ("ftloadk", [4..]),
+> ("ftlptim", [1]),
+> ("ftmorf", [3]), -- no output
+> ("ftsave", [3..]), -- no output
+> ("ftsavek", [4..]), -- no output
+> ("ftsr", [1]),
+> ("gain", [2..4]),
+> ("gauss", [1]),
+> ("gbuzz", [6, 7]),
+> ("gogobel", [8]),
+> ("grain", [9, 10]),
+> ("grain2", [6..9]),
+> ("grain3", [11..13]),
+> ("granule", [17..23]),
+> ("guiro", [2..7]),
+> ("harmon", [8]),
+> ("hilbert", [1]), -- gives two outputs
+> ("hrtfer", [4]), -- gives two outputs, takes a string
+> ("hsboscil", [6..8]),
+> ("i", [1]),
+> ("ihold", [0]), -- no output
+> ("in", [0]),
+> ("in32", [0]), -- gives 32 outputs
+> ("inch", [1]),
+> ("inh", [0]), -- gives six outputs
+> ("init", [1]),
+> ("initc14", [4]), -- no output
+> ("initc21", [5]), -- no output
+> ("initc7", [3]), -- no output
+> ("ino", [0]), -- gives eight outputs
+> ("inq", [0]), -- gives four outputs
+> ("ins", [0]), -- gives two outputs
+> ("int", [1]),
+> ("integ", [1, 2]),
+> ("invalue", [1]), -- takes a string
+> ("inx", [0]), -- gives 16 outputs
+> ("inz", [1]), -- no output
+> ("jitter", [3]),
+> ("jitter2", [7]),
+> ("jspline", [3]),
+> ("ktableseg", [3, 5..]), -- no output
+> ("lfo", [2, 3]),
+> ("limit", [3]),
+> ("line", [3]),
+> ("linen", [4]),
+> ("linenr", [4]),
+> ("lineto", [2]),
+> ("linrand", [1]),
+> ("linseg", [3, 5..]),
+> ("linsegr", [5, 7..]),
+> ("locsend", [0]), -- gives 2 or 4 outputs
+> ("locsig", [4]), -- gives 2 or 4 outputs
+> ("log", [1]),
+> ("log10", [1]),
+> ("logbtwo", [1]),
+> ("loopseg", [4, 6..]),
+> ("lorenz", [8, 9]), -- gives three outputs
+> ("loscil", [3..10]), -- gives 1-2 outputs
+> ("loscil3", [3..10]), -- gives 1-2 outputs
+> ("lowpass2", [3, 4]),
+> ("lowres", [3, 4]),
+> ("lowresx", [3..5]),
+> ("lpf18", [3]),
+> ("lpfreson", [2]),
+> ("lphasor", [1..6]),
+> ("lpinterp", [3]),
+> ("lposcil", [5, 6]),
+> ("lposcil3", [5, 6]),
+> ("lpread", [2..4]), -- gives four outputs
+> ("lpreson", [1]),
+> ("lpshold", [4, 6..]),
+> ("lpslot", [1]), -- no output
+> ("mac", [2, 4..]),
+> ("maca", [1..]),
+> ("madsr", [4..6]),
+> ("mandel", [4]), -- gives two outputs
+> ("mandol", [7, 8]),
+> ("marimba", [9..11]),
+> ("massign", [2]),
+> ("maxalloc", [2]), -- no output
+> ("max_k", [3]),
+> ("mclock", [1]), -- no output
+> ("mdelay", [5]), -- no output
+> ("metro", [1, 2]),
+> ("midic14", [4, 5]),
+> ("midic21", [5, 6]),
+> ("midic7", [3, 4]),
+> ("midichannelaftertouch", [1..3]), -- no output
+> ("midichn", [0]),
+> ("midicontrolchange", [2..4]), -- no output
+> ("midictrl", [1..3]),
+> ("mididefault", [2]), -- no output
+> ("midiin", [0]), -- gives four outputs
+> ("midinoteoff", [2]), -- no output
+> ("midinoteoncps", [2]), -- no output
+> ("midinoteonkey", [2]), -- no output
+> ("midinoteonoct", [2]), -- no output
+> ("midinoteonpch", [2]), -- no output
+> ("midion", [3]), -- no output
+> ("midion2", [4]), -- no output
+> ("midiout", [4]), -- no output
+> ("midipitchbend", [1..3]), -- no output
+> ("midipolyaftertouch", [2..4]), -- no output
+> ("midiprogramchange", [1]), -- no output
+> ("mirror", [3]),
+> ("moog", [9]),
+> ("moogladder", [3, 4]),
+> ("moogvcf", [3..5]),
+> ("moscil", [5]), -- no output
+> ("mpulse", [2, 3]),
+> ("mrtmsg", [1]), -- no output
+> ("multitap", [1, 3..]),
+> ("mute", [1, 2]), -- no output
+> ("mxadsr", [4..6]),
+> ("nestedap", [5, 7, 9, 10]),
+> ("nlfilt", [6]),
+> ("noise", [2]),
+> ("noteoff", [3]), -- no output
+> ("noteon", [3]), -- no output
+> ("noteondur", [4]), -- no output
+> ("noteondur2", [4]), -- no output
+> ("notnum", [0]),
+> ("nreverb", [3..8]),
+> ("nrpn", [3]), -- no output
+> ("nsamp", [1]),
+> ("nstrnum", [1]), -- takes string
+> ("ntrpol", [3..5]),
+> ("octave", [1]),
+> ("octcps", [1]),
+> ("octmidi", [0]),
+> ("octmidib", [0, 1]),
+> ("octpch", [1]),
+> ("oscbnk", [19..26]),
+> ("oscil", [3, 4]),
+> ("oscil1", [4]),
+> ("oscil1i", [4]),
+> ("oscil3", [3, 4]),
+> ("oscili", [3, 4]),
+> ("oscilikt", [3..5]),
+> ("osciliktp", [3, 4]),
+> ("oscilikts", [5, 6]),
+> ("osciln", [4]),
+> ("oscils", [3, 4]),
+> ("oscilx", [4]),
+> ("out", [1]), -- no output
+> ("out32", [32]), -- no output
+> ("outc", [1..]), -- no output
+> ("outch", [2, 4..]), -- no output
+> ("outh", [6]), -- no output
+> ("outiat", [4]), -- no output
+> ("outic", [5]), -- no output
+> ("outic14", [6]), -- no output
+> ("outipat", [5]), -- no output
+> ("outipb", [4]), -- no output
+> ("outipc", [4]), -- no output
+> ("outkat", [4]), -- no output
+> ("outkc", [5]), -- no output
+> ("outkc14", [6]), -- no output
+> ("outkpat", [5]), -- no output
+> ("outkpb", [4]), -- no output
+> ("outkpc", [4]), -- no output
+> ("outo", [8]), -- no output
+> ("outq", [4]), -- no output
+> ("outq1", [1]), -- no output
+> ("outq2", [1]), -- no output
+> ("outq3", [1]), -- no output
+> ("outq4", [1]), -- no output
+> ("outs", [2]), -- no output
+> ("outs1", [1]), -- no output
+> ("outs2", [1]), -- no output
+> ("outvalue", [2]), -- no output, takes a string
+> ("outx", [16]), -- no output
+> ("outz", [1]), -- no output
+> ("p", [1]),
+> ("pan", [4..6]), -- gives four outputs
+> ("pareq", [4..6]),
+> ("pcauchy", [1]),
+> ("pchbend", [0..2]),
+> ("pchmidi", [0]),
+> ("pchmidib", [0, 1]),
+> ("pchoct", [1]),
+> ("peak", [1]),
+> ("pgmassign", [2]), -- no output, takes a string
+> ("phaser1", [4, 5]),
+> ("phaser2", [7]),
+> ("phasor", [1, 2]),
+> ("phasorbnk", [3, 4]),
+> ("pinkish", [1..5]),
+> ("pitch", [5..13]), -- gives two outputs
+> ("pitchamdf", [3..8]), -- gives two outputs
+> ("planet", [10..12]), -- gives three outputs
+> ("pluck", [5..7]),
+> ("poisson", [1]),
+> ("polyaft", [1..3]),
+> ("port", [2, 3]),
+> ("portk", [2, 3]),
+> ("poscil", [3, 4]),
+> ("poscil3", [3, 4]),
+> ("pow", [2, 3]),
+> ("powoftwo", [1]),
+> ("prealloc", [2]), -- no output, takes a string
+> ("print", [1..]), -- no output
+> ("printk", [2, 3]), -- no output
+> ("printk2", [1, 2]), -- no output
+> ("printks", [2..]), -- no output
+> ("prints", [1..]), -- no output
+> ("product", [2..]),
+> ("pset", [1..]), -- no output
+> ("pvadd", [5..10]), -- takes a string
+> ("pvbufread", [2]), -- no output
+> ("pvcross", [5, 6]), -- takes a string
+> ("pvinterp", [9]), -- takes a string
+> ("pvoc", [3..7]), -- takes a string
+> ("pvread", [3]), -- takes a string, gives two outputs
+> -- lots of pvoc functions
+> ("rand", [1..4]),
+> ("randh", [2..5]),
+> ("randi", [2..5]),
+> ("random", [2]),
+> ("randomh", [3]),
+> ("randomi", [3]),
+> ("readclock", [1]),
+> ("readk", [3, 4]), -- takes a string
+> -- several readk functions
+> ("reinit", [1]), -- no output
+> ("release", [0]),
+> ("repluck", [6]),
+> ("reson", [3..5]),
+> ("resonk", [3..5]),
+> ("resonr", [3..5]),
+> ("resonx", [3..6]),
+> ("resonxk", [3, 6]),
+> ("resony", [5..8]),
+> ("resonz", [3..5]),
+> ("reverb", [2, 3]),
+> ("rezzy", [3, 5]),
+> ("rms", [1..3]),
+> ("rnd", [1]),
+> ("rnd31", [2, 3]),
+> ("rspline", [4]),
+> ("rtclock", [0]),
+> ("s16b14", [1, 7..]), -- gives 16 outputs
+> ("s32b14", [1, 7..]), -- gives 32 outputs
+> ("samphold", [2..4]),
+> ("sandpaper", [2..5]),
+> ("scanhammer", [4]), -- no output
+> ("scans", [4, 5]),
+> ("scantable", [7]),
+> ("scanu", [18]), -- no output
+> ("schedkwhen", [6..]), -- no output
+> ("schedkwhennamed", [6..]), -- no output, takes a string
+> ("schedule", [3..]), -- no output, takes a string
+> ("schedwhen", [4..]), -- no output, takes a string
+> ("seed", [1]), -- no output
+> ("sekere", [2..5]),
+> ("semitone", [1]),
+> ("sense", [0]),
+> ("sensekey", [0]),
+> ("seqtime", [5]),
+> ("setctrl", [3]), -- gui, no output
+> ("setksmps", [1]), -- no output
+> ("sfilist", [1]), -- no output
+> ("sfinstr", [6..8]), -- gives two outputs
+> ("sfinstr3", [6..8]), -- gives two outputs
+> ("sfinstr3m", [6..8]),
+> ("sfinstrm", [6..8]),
+> ("sfload", [1]), -- takes a string
+> ("sfpassign", [2]), -- no output
+> ("sfplay", [5..7]), -- gives two outputs
+> ("sfplay3", [5..7]), -- gives two outputs
+> ("sfplay3m", [5..7]),
+> ("sfplaym", [5..7]),
+> ("sfplist", [1]), -- no output
+> ("sfpreset", [4]),
+> ("shaker", [5, 6]),
+> ("sin", [1]),
+> ("sinh", [1]),
+> ("sininv", [1]),
+> ("sleighbells", [2..8]),
+> ("slider16", [1, 6..]), -- gives 16 outputs
+> -- lots of sliders with multiple (eg, 32) outputs
+> ("sndwarp", [10]), -- gives 1-2 outputs
+> ("sndwarpst", [10]), -- gives 2-4 outputs
+> ("soundin", [1..4]), -- gives multiple outputs, takes a string
+> ("soundout", [2, 3]), -- takes a string, no output
+> ("space", [6]), -- gives four outputs
+> ("spat3d", [9, 10]), -- gives four outputs
+> ("spat3di", [7, 8]), -- gives four outputs
+> ("spat3dt", [8, 9]), -- no output
+> ("spdist", [4]),
+> ("specaddm", [2, 3]),
+> ("specdiff", [1]),
+> ("specdisp", [2, 3]), -- no output
+> ("specfilt", [2]),
+> ("spechist", [1]),
+> ("specptrk", [8..13]), -- gives two outputs
+> ("specscap", [3]),
+> ("specsum", [1, 2]),
+> ("spectrum", [4..9]),
+> ("splitrig", [5..]), -- no output
+> ("spsend", [0]), -- gives four outputs
+> ("sqrt", [1]),
+> ("statevar", [3, 5]), -- gives four outputs
+> ("stix", [2..5]),
+> ("streson", [3]),
+> ("strset", [2]), -- no output, takes a string
+> ("subinstr", [1..]), -- gives 1-8 outputs, takes a string
+> ("subinstrinit", [1..]), -- no output, takes a string
+> ("sum", [1..]),
+> ("svfilter", [3, 4]), -- gives three outputs
+> ("syncgrain", [8]),
+> ("table", [2..5]),
+> ("table3", [2..5]),
+> ("tablecopy", [2]), -- no output
+> ("tablegpw", [1]), -- no output
+> ("tablei", [2..5]),
+> ("tableicopy", [2]), -- no output
+> ("tableigpw", [1]), -- no output
+> ("tableikt", [2..5]),
+> ("tableimix", [9]), -- no output
+> ("tableiw", [3..6]), -- no output
+> ("tablekt", [2..5]),
+> ("tablemix", [9]), -- no output
+> ("tableng", [1]),
+> ("tablera", [3]),
+> ("tableseg", [3, 5..]), -- no output
+> ("tablew", [3..6]), -- no output
+> ("tablewa", [3]),
+> ("tablewkt", [3..6]), -- no output
+> ("tablexkt", [4..7]),
+> ("tablexseg", [3, 5..]), -- no output
+> ("tambourine", [2..8]),
+> ("tan", [1]),
+> ("tanh", [1]),
+> ("taninv", [1]),
+> ("taninv2", [2]),
+> ("tbvcf", [5, 6]),
+> ("tempest", [10..12]),
+> ("tempo", [2]), -- no output
+> ("tempoval", [0]),
+> ("timeinstk", [0]),
+> ("timeinsts", [0]),
+> ("timek", [0]),
+> ("times", [0]),
+> ("tival", [0]),
+> ("tlineto", [3]),
+> ("tone", [2, 3]),
+> ("tonek", [2, 3]),
+> ("tonex", [2..4]),
+> ("transeg", [4, 7..]),
+> ("trigger", [3]),
+> ("trigseq", [6..]), -- no output
+> ("trirand", [1]),
+> ("turnoff", [0]), -- no output
+> ("turnon", [1, 2]), -- no output
+> ("unirand", [1]),
+> ("upsamp", [1]),
+> ("urd", [1]),
+> ("vadd", [3]),
+> ("valpass", [4..6]),
+> ("vbap16", [2..4]), -- gives 16 outputs
+> -- various vbap functions that give outputs =/= 1
+> ("vco", [4..10]),
+> ("vco2", [2..6]),
+> ("vco2ft", [2, 3]),
+> ("vco2ift", [2, 3]),
+> ("vco2init", [1..6]),
+> ("vcomb", [4..6]),
+> ("vdelay", [3, 4]),
+> ("vdelay3", [3, 4]),
+> ("vdelayx", [4, 5]),
+> ("vdelayxq", [7, 8]), -- gives four outputs
+> ("vdelayxs", [5, 6]), -- gives two outputs
+> ("vdelayxw", [4, 5]),
+> ("vdelayxwq", [7, 8]), -- gives four outputs
+> ("vdelayxqs", [5, 6]), -- gives two outputs
+> ("veloc", [0..2]),
+> ("vexp", [3]), -- no output
+> ("vexpseg", [5, 7..]), -- no output
+> ("vibes", [9]),
+> ("vibr", [3]),
+> ("vibrato", [9, 10]),
+> ("vincr", [2]), -- no output
+> ("vlowres", [5]),
+> ("vlinseg", [5, 7..]), -- no output
+> ("vmult", [3]), -- no output
+> ("voice", [8]),
+> ("vpow", [3]), -- no output
+> -- several functions for reading and writing vectors
+> ("vpvoc", [3..5]), -- takes a string
+> ("waveset", [2, 3]),
+> ("weibull", [2]),
+> ("wgbow", [7, 8]),
+> ("wgbowedbar", [5..9]),
+> ("wgbrass", [7, 8]),
+> ("wgclar", [9, 10]),
+> ("wgflute", [9..12]),
+> ("wgpluck", [7]),
+> ("wgpluck2", [5]),
+> ("wguide1", [4]),
+> ("wguide2", [7]),
+> ("wrap", [3]),
+> ("wterrain", [8]),
+> ("xadsr", [4, 5]),
+> ("xin", [0]), -- gives multiple outputs
+> ("xout", [1..]), -- no output
+> ("xscanmap", [3, 4]), -- gives two outputs
+> ("xscansmap", [5, 6]), -- no output
+> ("xscans", [4, 5]),
+> ("xscanu", [18]), -- no output
+> ("xtratim", [1]), -- no output
+> ("xyin", [5..7]), -- gives two outputs
+> ("zacl", [2]), -- no output
+> ("zakinit", [2]), -- no output
+> ("zamod", [2]),
+> ("zar", [1]),
+> ("zarg", [2]),
+> ("zaw", [2]), -- no output
+> ("zawm", [2, 3]), -- no output
+> ("zfilter2", [5..]),
+> ("zir", [1]),
+> ("ziw", [2]), -- no output
+> ("ziwm", [2, 3]), -- no output
+> ("zkcl", [2]), -- no output
+> ("zkmod", [2]),
+> ("zkr", [1]),
+> ("zkw", [2]), -- no output
+> ("zkwm", [2, 3]) -- no output
+> ]
diff --git a/src/Haskore/Interface/CSound/Score.lhs b/src/Haskore/Interface/CSound/Score.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/Score.lhs
@@ -0,0 +1,293 @@
+\subsubsection{The Score File}
+\seclabel{score-file}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.Score where
+>
+> import Haskore.Interface.CSound (Instrument, showInstrumentNumber, PField, Time)
+> import qualified Haskore.Interface.CSound.Note as CSNote
+> import qualified Haskore.Interface.CSound.Generator as Generator
+> import Haskore.Interface.CSound.Generator
+> (compSine1, lineSeg1, randomTable, PStrength, RandDist(Uniform))
+>
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.BackEnd as PerformanceBE
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Fancy as FancyPf
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Absolute.TimeBody as TimeListAbs
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Interface.CSound.InstrumentMap as InstrMap
+> import qualified Haskore.Interface.CSound.SoundMap as SoundMap
+
+> import qualified Numeric.NonNegative.Class as NonNeg
+
+> import System.IO
+
+\end{haskelllisting}
+
+We will represent a score file as a sequence of \keyword{score statements}:
+\begin{haskelllisting}
+
+> type T = [Statement]
+
+\end{haskelllisting}
+The {\tt Statement} data type is designed to simulate CSound's three
+kinds of score statements:
+\begin{enumerate}
+\item A \keyword{tempo} statement, which sets the tempo. In the absence
+of a tempo statement, the tempo defaults to 60 beats per minute.
+
+\item A \keyword{note event}, which defines the start time, pitch,
+duration (in beats), volume (in decibels), and instrument to play a
+note (and is thus more like a Haskore {\tt Event} than a Midi event,
+thus making the conversion to CSound easier than to Midi, as we shall
+see later). Each note event also contains a number of optional
+arguments called \keyword{p-fields}, which determine other properties of
+the note, and whose interpretation depends on the instrument that
+plays the note. This will be discussed further in a later section.
+
+\item \keyword{Function table} definitions. A function table is used by
+instruments to produce audio signals. For example, sequencing through
+a table containing a perfect sine wave will produce a very pure tone,
+while a table containing an elaborate polynomial will produce a
+complex sound with many overtones. The tables can also be used to
+produce control signals that modify other signals. Perhaps the
+simplest example of this is a tremolo or vibrato effect, but more
+complex sound effects, and FM (frequency modulation) synthesis in
+general, is possible.
+\end{enumerate}
+
+\begin{haskelllisting}
+
+> data Statement = Tempo Bpm
+> | Note Instrument StartTime Duration Pch Volume [PField]
+> | Table Table CreatTime TableSize Normalize Generator.T
+> deriving Show
+>
+> type Bpm = Int
+> type StartTime = Time
+> type Duration = Time
+> data Pch = AbsPch Pitch.Absolute | Cps Float deriving Show
+> type Volume = Float
+> type Table = Int
+> type CreatTime = Time
+> type TableSize = Int
+> type Normalize = Bool
+
+\end{haskelllisting}
+
+This is all rather straightforward, except for function table
+generation, which requires further explanation.
+
+\input{Haskore/Interface/CSound/Generator.lhs}
+
+\subparagraph*{Common Tables}
+
+For convenience, here are some common function tables, which take as
+argument the identifier integer:
+\begin{haskelllisting}
+
+> simpleSine, square, sawtooth, triangle, whiteNoise :: Table -> Statement
+>
+> simpleSine n = Table n 0 8192 True
+> (compSine1 [1])
+> square n = Table n 0 1024 True
+> (lineSeg1 1 [(256, 1), (0, -1), (512, -1), (0, 1), (256, 1)])
+> sawtooth n = Table n 0 1024 True
+> (lineSeg1 0 [(512, 1), (0, -1), (512, 0)])
+> triangle n = Table n 0 1024 True
+> (lineSeg1 0 [(256, 1), (512, -1), (256, 0)])
+> whiteNoise n = Table n 0 1024 True
+> (randomTable Uniform)
+
+\end{haskelllisting}
+The following function for a composite sine has an extra argument, a
+list of harmonic partial strengths:
+\begin{haskelllisting}
+
+> compSine :: Table -> [PStrength] -> Statement
+> compSine _ s = Table 6 0 8192 True (compSine1 s)
+
+\end{haskelllisting}
+
+\input{Haskore/Interface/CSound/InstrumentMap.lhs}
+
+\paragraph{Converting Haskore Music.T to a CSound Score File}
+
+To convert a {\tt Music.T} value into a CSound score file, we need to:
+\begin{enumerate}
+\item Convert the {\tt Music.T} value to a {\tt Performance.T}.
+\item Convert the {\tt Performance.T} value to a {\tt Score.T}.
+\item Write the {\tt Score.T} value to a CSound score file.
+\end{enumerate}
+
+We already know how to do the first step. Steps two and three will be
+achieved by the following two functions:
+\begin{haskelllisting}
+
+> fromPerformanceBE :: (NonNeg.C time) =>
+> (time -> Time) ->
+> PerformanceBE.T time CSNote.T -> T
+
+> saveIA :: T -> IO ()
+
+\end{haskelllisting}
+The three steps can be put together in whatever way the user wishes,
+but the most general way would be this:
+\begin{haskelllisting}
+
+> fromRhythmicMusic ::
+> (RealFrac time, NonNeg.C time, RealFrac dyn, Ord drum, Ord instr) =>
+> Tables ->
+> (InstrMap.SoundTable drum,
+> InstrMap.SoundTable instr,
+> Context.T time dyn (RhyMusic.Note drum instr),
+> RhyMusic.T drum instr) -> T
+> fromRhythmicMusic tables (dMap, iMap, cont, m) =
+> tables ++ fromRhythmicPerformance dMap iMap
+> (Performance.fromMusic FancyPf.map cont m)
+>
+> type Tables = T
+
+\end{haskelllisting}
+The \type{Tables} argument is a user-defined set of function tables,
+represented as a sequence of {\tt Statement}s (specifically, {\tt
+Table} constructors). (See \secref{function-table}.)
+
+\subparagraph*{From Performance.T to Score.T}
+
+The translation between \type{Performance.Event}s and score
+\type{CSoundScore.Note}s is straightforward, the only tricky part being:
+\begin{itemize}
+\item The unit of time in a {\tt Performance.T} is the second, whereas
+in a {\tt Score.T} it is the beat. However, the default CSound tempo is
+60 beats per minute, or one beat per second, as was already mentioned,
+and we use this default for our \keyword{score} files. Thus the two are
+equivalent, and no translation is necessary.
+\item CSound wants to get pitch information in the form 'a.b'
+but it interprets them very different.
+Sometimes it is considered as 'octave.pitchclass'
+sometimes it is considered as fraction frequency.
+We try to cope with it using the two-constructor type Pch.
+\item Like for MIDI data we must
+distinguish between Velocity and Volume.
+Velocity is instrument dependent and
+different velocities might result in different flavors of a sound.
+As a quick work-around we turn the velocity information into volume.
+Cf. {\tt dbamp} in the CSound manual.
+\end{itemize}
+
+\begin{haskelllisting}
+
+> fromPerformanceBE timeMap =
+> map (\(time, event) ->
+> noteToStatement timeMap time
+> (PerformanceBE.eventDur event)
+> (PerformanceBE.eventNote event)) .
+> TimeListAbs.toPairList .
+> TimeList.toAbsoluteEventList 0
+>
+> fromRhythmicPerformance ::
+> (RealFrac time, NonNeg.C time, RealFrac dyn, Ord drum, Ord instr) =>
+> InstrMap.SoundTable drum ->
+> InstrMap.SoundTable instr ->
+> Performance.T time dyn (RhyMusic.Note drum instr) -> T
+> fromRhythmicPerformance dMap iMap =
+> fromPerformanceBE realToFrac .
+> PerformanceBE.fromPerformance
+> (CSNote.fromRhyNote
+> (InstrMap.lookup dMap)
+> (InstrMap.lookup iMap))
+>
+> fromRhythmicPerformanceMap ::
+> (RealFrac time, NonNeg.C time, RealFrac dyn) =>
+> InstrMap.ToSound drum ->
+> InstrMap.ToSound instr ->
+> Performance.T time dyn (RhyMusic.Note drum instr) -> T
+> fromRhythmicPerformanceMap dMap iMap =
+> fromPerformanceBE realToFrac .
+> PerformanceBE.fromPerformance (CSNote.fromRhyNote dMap iMap)
+>
+> fromRhythmicPerformanceWithAttributes ::
+> (RealFrac time, NonNeg.C time, RealFrac dyn) =>
+> SoundMap.DrumTableWithAttributes out drum ->
+> SoundMap.InstrumentTableWithAttributes out instr ->
+> Performance.T time dyn (RhyMusic.Note drum instr) -> T
+> fromRhythmicPerformanceWithAttributes dMap iMap =
+> fromRhythmicPerformanceMap
+> (SoundMap.lookupDrum dMap)
+> (SoundMap.lookupInstrument iMap)
+>
+> noteToStatement ::
+> (time -> Time) -> time -> time ->
+> CSNote.T -> Statement
+> noteToStatement timeMap t d (CSNote.Cons pfs v i p) =
+> Note i (timeMap t) (timeMap d)
+> (maybe (Cps 0 {- dummy -}) AbsPch p) v pfs
+
+\end{haskelllisting}
+
+\subparagraph*{From Score to Score File}
+
+Now that we have a value of type {\tt Score}, we must write it into a
+plain text ASCII file with an extension {\tt .sco} in a way that
+CSound will recognize. This is done by the following function:
+\begin{haskelllisting}
+
+> saveIA s =
+> do putStr "\nName your score file "
+> putStr "(.sco extension will be added): "
+> name <- getLine
+> save (name ++ ".sco") s
+
+> save :: FilePath -> T -> IO ()
+> save name s = writeFile (name ++ ".sco") (toString s)
+
+\end{haskelllisting}
+This function asks the user for the name of the score file, opens that
+file for writing, writes the score into the file using the function
+\function{toString}, and then closes the file.
+
+The score file is a plain text file containing one statement per line.
+Each statement consists of an opcode, which is a single letter that
+determines the action to be taken, and a number of arguments. The
+opcodes we will use are ``e'' for end of score, ``t'' to set tempo,
+``f'' to create a function table, and ``i'' for note events.
+\begin{haskelllisting}
+
+> toString :: T -> String
+> toString s = unlines (map statementToString s ++ ["e"]) -- end of score
+
+\end{haskelllisting}
+
+Finally, the \function{statementToString} function:
+\begin{haskelllisting}
+
+> statementToString :: Statement -> String
+> statementToString = unwords . statementToWords
+>
+> statementToWords :: Statement -> [String]
+> statementToWords (Tempo t) =
+> ["t", "0", show t]
+> statementToWords (Note i st d p v pfs) =
+> ["i", showInstrumentNumber i, show st, show d,
+> pchToString p, show v] ++ map show pfs
+> statementToWords (Table t ct s n gr) =
+> ["f", show t, show ct, show s,
+> (if n then id else ('-':))
+> (unwords (Generator.toStatementWords gr))]
+>
+> -- it's exciting whether CSound knows what we mean with the values
+> -- (0 < note) is for compatibility with older CSound example files
+> pchToString :: Pch -> String
+> pchToString (AbsPch ap) =
+> let (oct, note) = divMod ap 12
+> in show oct ++ "." ++
+> (if 0 < note && note < 10 then "0" else "") ++
+> show note
+> pchToString (Cps freq) = show freq
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound/SoundMap.hs b/src/Haskore/Interface/CSound/SoundMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/SoundMap.hs
@@ -0,0 +1,220 @@
+-- cf. SuperCollider.SoundMap
+-- this module shall replace InstrumentMap in the long term
+module Haskore.Interface.CSound.SoundMap where
+
+import qualified Haskore.Interface.CSound.Orchestra as Orchestra
+
+import Haskore.Interface.CSound.Orchestra
+ (SigExp, noteDur, noteVel, notePit, pField)
+import Haskore.Interface.CSound (PField, Instrument)
+
+import Haskore.General.Utility (toMaybe)
+import Data.Maybe (mapMaybe)
+
+
+type SoundId = Instrument
+type InstrumentId = SoundId
+type DrumId = SoundId
+
+type Attribute = PField
+type AttributeList = [Attribute]
+type ToSound instr = instr -> (AttributeList, SoundId)
+
+
+attributeControl :: Int -> SigExp
+attributeControl n = pField (6+n)
+
+
+type InstrumentTable out instr = [(instr, InstrumentSigExp out)]
+
+type InstrumentTableWithAttributes out instr = [InstrumentAssociation out instr]
+
+type InstrumentSigExp out = SigExp -> SigExp -> SigExp -> out
+
+data InstrumentAssociation out instr =
+ InstrumentAssociation InstrumentId (instr -> Maybe AttributeList) out
+
+lookupInstrument :: InstrumentTableWithAttributes out instr -> ToSound instr
+lookupInstrument table instr =
+ case mapMaybe (\(InstrumentAssociation name toAttributes _) ->
+ fmap (\ps -> (ps,name)) (toAttributes instr)) table of
+ [] -> error "SuperCollider.InstrumentMap.lookup: instrument not found"
+ [x] -> x
+ _ -> error "SuperCollider.InstrumentMap.lookup: multiple instruments found"
+
+instrumentTableToInstrBlocks ::
+ InstrumentTableWithAttributes out instr -> [Orchestra.InstrBlock out]
+instrumentTableToInstrBlocks =
+ map (\(InstrumentAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])
+
+addInstrumentControls :: InstrumentSigExp out -> out
+addInstrumentControls graph = graph noteDur noteVel notePit
+
+
+instrumentAssociation ::
+ (parameterTuple -> AttributeList) ->
+ (graph -> InstrumentSigExp out) ->
+ InstrumentId -> (instr -> Maybe parameterTuple) ->
+ graph ->
+ InstrumentAssociation out instr
+instrumentAssociation makeAttributeList makeInstrumentSigExp name select graph =
+ InstrumentAssociation
+ name
+ (fmap makeAttributeList . select)
+ (addInstrumentControls $ makeInstrumentSigExp graph)
+
+
+instrument ::
+ InstrumentId -> (instr -> Maybe ()) -> (InstrumentSigExp out) ->
+ InstrumentAssociation out instr
+instrument = instrumentAssociation (\() -> []) id
+
+-- simplified variant of 'instrument' for comparable @instrument@ types
+instrumentEq :: Eq instrument =>
+ InstrumentId -> instrument -> (InstrumentSigExp out) ->
+ InstrumentAssociation out instrument
+instrumentEq name instrumentId =
+ instrument name (\x -> toMaybe (instrumentId==x) ())
+
+instrument1 ::
+ InstrumentId -> (instr -> Maybe Attribute) ->
+ (SigExp -> InstrumentSigExp out) ->
+ InstrumentAssociation out instr
+instrument1 =
+ instrumentAssociation
+ (\p0 -> [p0])
+ (\graph -> graph (attributeControl 0))
+
+
+instrument2 ::
+ InstrumentId -> (instr -> Maybe (Attribute, Attribute)) ->
+ (SigExp -> SigExp -> InstrumentSigExp out) ->
+ InstrumentAssociation out instr
+instrument2 =
+ instrumentAssociation
+ (\(p0,p1) -> [p0,p1])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1))
+
+instrument3 ::
+ InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute)) ->
+ (SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
+ InstrumentAssociation out instr
+instrument3 =
+ instrumentAssociation
+ (\(p0,p1,p2) -> [p0,p1,p2])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2))
+
+instrument4 ::
+ InstrumentId -> (instr -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
+ (SigExp -> SigExp -> SigExp -> SigExp -> InstrumentSigExp out) ->
+ InstrumentAssociation out instr
+instrument4 =
+ instrumentAssociation
+ (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2)
+ (attributeControl 3))
+
+
+
+type DrumTable out drum = [(drum, DrumSigExp out)]
+
+type DrumTableWithAttributes out drum = [DrumAssociation out drum]
+
+type DrumSigExp out = SigExp -> SigExp -> out
+
+data DrumAssociation out drum =
+ DrumAssociation DrumId (drum -> Maybe AttributeList) out
+
+lookupDrum :: DrumTableWithAttributes out drum -> ToSound drum
+lookupDrum table drumId =
+ case mapMaybe (\(DrumAssociation name toAttributes _) ->
+ fmap (\ps -> (ps,name)) (toAttributes drumId)) table of
+ [] -> error "SuperCollider.InstrumentMap.lookup: drum not found"
+ [x] -> x
+ _ -> error "SuperCollider.InstrumentMap.lookup: multiple drums found"
+
+drumTableToInstrBlocks :: DrumTableWithAttributes out instr -> [Orchestra.InstrBlock out]
+drumTableToInstrBlocks =
+ map (\(DrumAssociation i _ out) -> Orchestra.InstrBlock i 0 out [])
+
+addDrumControls :: DrumSigExp out -> out
+addDrumControls graph = graph noteDur noteVel
+
+drumAssociation ::
+ (parameterTuple -> AttributeList) ->
+ (graph -> DrumSigExp out) ->
+ DrumId -> (drum -> Maybe parameterTuple) ->
+ graph ->
+ DrumAssociation out drum
+drumAssociation makeAttributeList makeDrumSigExp name select graph =
+ DrumAssociation
+ name
+ (fmap makeAttributeList . select)
+ (addDrumControls $ makeDrumSigExp graph)
+
+
+drum ::
+ DrumId -> (drum -> Maybe ()) -> (DrumSigExp out) ->
+ DrumAssociation out drum
+drum = drumAssociation (\() -> []) id
+
+-- simplified variant of 'drum' for comparable @drum@ types
+drumEq :: Eq drum =>
+ DrumId -> drum -> (DrumSigExp out) ->
+ DrumAssociation out drum
+drumEq name drumId =
+ drum name (\x -> toMaybe (drumId==x) ())
+
+drum1 ::
+ DrumId -> (drum -> Maybe Attribute) ->
+ (SigExp -> DrumSigExp out) ->
+ DrumAssociation out drum
+drum1 =
+ drumAssociation
+ (\p0 -> [p0])
+ (\graph -> graph (attributeControl 0))
+
+drum2 ::
+ DrumId -> (drum -> Maybe (Attribute, Attribute)) ->
+ (SigExp -> SigExp -> DrumSigExp out) ->
+ DrumAssociation out drum
+drum2 =
+ drumAssociation
+ (\(p0,p1) -> [p0,p1])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1))
+
+drum3 ::
+ DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute)) ->
+ (SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
+ DrumAssociation out drum
+drum3 =
+ drumAssociation
+ (\(p0,p1,p2) -> [p0,p1,p2])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2))
+
+drum4 ::
+ DrumId -> (drum -> Maybe (Attribute, Attribute, Attribute, Attribute)) ->
+ (SigExp -> SigExp -> SigExp -> SigExp -> DrumSigExp out) ->
+ DrumAssociation out drum
+drum4 =
+ drumAssociation
+ (\(p0,p1,p2,p3) -> [p0,p1,p2,p3])
+ (\graph -> graph
+ (attributeControl 0)
+ (attributeControl 1)
+ (attributeControl 2)
+ (attributeControl 3))
+
diff --git a/src/Haskore/Interface/CSound/Tutorial.lhs b/src/Haskore/Interface/CSound/Tutorial.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/Tutorial.lhs
@@ -0,0 +1,1429 @@
+\subsubsection{Tutorial}
+\seclabel{csound-tut}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.Tutorial where
+
+> import Haskore.Interface.CSound.Orchestra
+> (SigExp, Mono(Mono), Stereo(Stereo), Output, Name,
+> pchToHz, dbToAmp, sigGen, rec, tableNumber, EvalRate(AR, CR),
+> osc, oscI, randomI, expon, reverb, vdelay, comb, lineSeg,
+> PluckDecayMethod(..), pluck, buzz)
+> import Haskore.Interface.CSound.Generator
+> (compSine1, compSine2, cubicSpline, lineSeg1)
+> import Haskore.Interface.CSound.Score as Score
+
+> import qualified Haskore.Interface.CSound.Orchestra as Orchestra
+> import qualified Haskore.Interface.CSound.SoundMap as SoundMap
+> import qualified Haskore.Interface.CSound as CSound
+
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Fancy as FancyPerformance
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+> import Haskore.Basic.Duration
+> import Haskore.Music ((+:+), (=:=), qnr)
+> import Haskore.Melody as Melody
+
+> import System.IO
+> import System.Cmd( system )
+
+\end{haskelllisting}
+
+ This brief tutorial is designed to introduce the user to the
+capabilities of the CSound software synthesizer and sound synthesis in
+general.
+
+\paragraph{Additive Synthesis}
+\seclabel{add-syn}
+
+ The first part of the tutorial introduces \keyword{additive synthesis}.
+Additive synthesis is the most basic, yet the most powerful synthesis
+technique available, giving complete control over the sound waveform.
+The basic premiss behind additive sound synthesis is quite simple -- defining
+a complex sound by specifying each contributing sine wave. The computer is
+very good at generating pure tones, but these are not very interesting.
+However, any sound imaginable can be reproduced as a sum of pure tones. We
+can define an instrument of pure tones easily in Haskore. First we define
+a \keyword{Function table} containing a lone sine wave. We can do this using
+the \function{simpleSine} function defined in the \module{CSound.Orchestra} module:
+\begin{haskelllisting}
+
+> pureToneTN :: Score.Table
+> pureToneTN = 1
+> pureToneTable :: SigExp
+> pureToneTable = tableNumber pureToneTN
+> pureTone :: Score.Statement
+> pureTone = Score.Table pureToneTN 0 8192 True (compSine1 [1.0])
+
+> oscPure :: SigExp -> SigExp -> SigExp
+> oscPure = osc AR pureToneTable
+
+\end{haskelllisting}
+ \code{pureToneTN} is the table number of the simple sine wave. We will
+adopt the convention in this tutorial that variables ending with \code{TN}
+represent table numbers.
+ Recall that \function{compSine1} is defined in the module \module{CSound} as a
+sine wave generating routine (\refgen{10}). In order to have a complete
+score file, we also need a tune. Here is a simple example:
+\begin{haskelllisting}
+
+> type TutMelody params = Melody.T (TutAttr params)
+>
+> data TutAttr params =
+> TutAttr {attrVelocity :: Rational,
+> attrParameters :: params}
+>
+> tune1 :: TutMelody ()
+> tune1 = Music.line (map ($ TutAttr 1.5 ())
+> [ c 1 hn, e 1 hn, g 1 hn,
+> c 2 hn, a 1 hn, c 2 qn,
+> a 1 qn, g 1 dhn ] ++ [qnr])
+
+\end{haskelllisting}
+ The next step is to convert the melody into a music.
+In our simple tutorial we have only one instrument per song
+in all but one case.
+So we could skip this step,
+but we want to include it in order to show the general processing steps.
+We use the general data type for rhythmic music,
+with no drum definitions (null type \type{()})
+and a custom instrument definition \type{Instrument}.
+We use only the instrument numbers 1 and 2
+but the numbers are associated with different sounds in the examples.
+\begin{haskelllisting}
+
+> data Instrument =
+> Instr1p0
+> | Instr2p0
+> | Instr1p2 Float Float
+> | Instr1p4 Float Float Float Float
+> deriving (Eq, Ord, Show)
+>
+> musicFromMelody :: (params -> Instrument) ->
+> TutMelody params -> RhyMusic.T () Instrument
+> musicFromMelody instr =
+> RhyMusic.fromMelody
+> (\(TutAttr vel params) -> (vel, instr params))
+
+\end{haskelllisting}
+ The melody contains instrument specific parameters.
+They will be embedded in \type{Instrument} values
+by the following functions.
+These functions can be used as \code{instr} arguments
+to \function{musicFromMelody}.
+\begin{haskelllisting}
+
+> type Pair = (Float, Float)
+> type Quadruple = (Float, Float, Float, Float)
+>
+> attrToInstr1p0 :: () -> Instrument
+> attrToInstr1p0 () = Instr1p0
+>
+> attrToInstr2p0 :: () -> Instrument
+> attrToInstr2p0 () = Instr2p0
+>
+> attrToInstr1p2 :: Pair -> Instrument
+> attrToInstr1p2 = uncurry Instr1p2
+>
+> attrToInstr1p4 :: Quadruple -> Instrument
+> attrToInstr1p4 (x,y,z,w) = Instr1p4 x y z w
+
+\end{haskelllisting}
+ There is nothing special about the conversion
+from the music to the performance.
+\begin{haskelllisting}
+
+> performanceFromMusic :: RhyMusic.T () Instrument ->
+> Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument)
+> performanceFromMusic =
+> FancyPerformance.fromMusicModifyContext (Context.setDur 1)
+
+\end{haskelllisting}
+ Now we convert from the performance to the CSound score.
+To this end we must convert the instruments represented by \type{Instrument}
+to sound numbers and parameter fields.
+A \type{SoundMap.InstrumentTableWithAttributes out Instrument}
+must be generated for the conversion.
+The functions like \function{instrAssoc1p0}
+generate one entry for the table
+which assigns an instrument number and a sound algorithm
+to a constructor of \type{Instrument}.
+\begin{haskelllisting}
+
+> type TutOrchestra out =
+> (Orchestra.Header, SoundMap.InstrumentTableWithAttributes out Instrument)
+
+> instrNum1, instrNum2 :: CSound.Instrument
+> instrNum1 = CSound.instrument 1
+> instrNum2 = CSound.instrument 2
+
+> instrAssoc1p0 :: SoundMap.InstrumentSigExp out ->
+> SoundMap.InstrumentAssociation out Instrument
+> instrAssoc1p0 =
+> SoundMap.instrument instrNum1
+> (\i -> do Instr1p0 <- Just i; Just ())
+>
+> instrAssoc2p0 :: SoundMap.InstrumentSigExp out ->
+> SoundMap.InstrumentAssociation out Instrument
+> instrAssoc2p0 =
+> SoundMap.instrument instrNum2
+> (\i -> do Instr2p0 <- Just i; Just ())
+>
+> instrAssoc1p2 :: (SigExp -> SigExp -> SoundMap.InstrumentSigExp out) ->
+> SoundMap.InstrumentAssociation out Instrument
+> instrAssoc1p2 =
+> SoundMap.instrument2 instrNum1
+> (\i -> do Instr1p2 x y <- Just i; Just (x,y))
+>
+> instrAssoc1p4 :: (SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp out) ->
+> SoundMap.InstrumentAssociation out Instrument
+> instrAssoc1p4 =
+> SoundMap.instrument4 instrNum1
+> (\i -> do Instr1p4 x y z w <- Just i; Just (x,y,z,w))
+
+\end{haskelllisting}
+
+The function \function{scored} puts
+the chain from melody to CSound score together.
+Finally the function \function{example} collects
+music and instrument definitions,
+that is a complete example.
+\begin{haskelllisting}
+
+> scored :: TutOrchestra out -> (params -> Instrument) ->
+> TutMelody params -> Score.T
+> scored (_,sndMap) instr =
+> Score.fromRhythmicPerformanceWithAttributes
+> (error "no drum map defined") sndMap .
+> performanceFromMusic .
+> musicFromMelody instr
+>
+> example :: Name -> (TutOrchestra out -> Score.T) -> TutOrchestra out ->
+> (Name, Score.T, TutOrchestra out)
+> example name mkScore orc = (name, mkScore orc, orc)
+
+\end{haskelllisting}
+Let's define an instrument in the orchestra file that will use the function
+table \code{pureTone}:
+\begin{haskelllisting}
+
+> oe1 :: SoundMap.InstrumentSigExp Mono
+> oe1 _noteDur noteVel notePit =
+> let signal = oscPure (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> score1 orc = pureTone : scored orc attrToInstr1p0 tune1
+
+\end{haskelllisting}
+ This instrument will simply oscillate through the function table
+containing the sine wave at the appropriate frequency given by
+\code{notePit}, and the resulting sound will have an amplitude given by
+\code{noteVel}.
+Note that the \code{oe1} expression above is a \code{Mono}, not a complete
+\code{TutOrchestra}. We need to define a \keyword{header} and associate \code{oe1}
+with the instrument that's playing it:
+\begin{haskelllisting}
+
+> hdr :: Orchestra.Header
+> hdr = (44100, 4410)
+>
+> o1, o2, o3, o4, o7, o8, o9, o13, o14, o15, o19, o22
+> :: TutOrchestra Mono
+> o5, o6, o10, o11, o12, o16, o17, o18, o20, o21
+> :: TutOrchestra Stereo
+>
+> tut1, tut2, tut3, tut4, tut7, tut8, tut9, tut13, tut14, tut15, tut19, tut22
+> :: (Name, Score.T, TutOrchestra Mono)
+> tut5, tut6, tut10, tut11, tut12, tut16, tut17, tut18, tut20, tut21
+> :: (Name, Score.T, TutOrchestra Stereo)
+>
+> score1, score2, score3, score4, score5, score6, score7, score8, score9
+> :: TutOrchestra out -> [Score.Statement]
+>
+> o1 = (hdr, [instrAssoc1p0 oe1])
+
+\end{haskelllisting}
+ The header above indicates that the audio signals are generated at
+44,100 Hz (CD quality), the control signals are generated at 4,410 Hz, and
+there are 2 output channels for stereo sound.
+ Now we have a complete score and orchestra that can be converted to a
+sound file by CSound and played as follows:
+\begin{haskelllisting}
+
+> csoundDir :: Name
+> csoundDir = "src/Test/CSound"
+> -- csoundDir = "C:/TEMP/csound"
+>
+> tut1 = example "tut01" score1 o1
+
+\end{haskelllisting}
+ If you listen to the tune, you will notice that it sounds very thin
+and uninteresting. Most musical sounds are not pure. Instead they usually
+contain a sine wave of dominant frequency, called a \keyword{fundamental}, and
+a number of other sine waves called \keyword{partials}. Partials with
+frequencies that are integer multiples of the fundamental are called
+\keyword{harmonics}. In musical terms, the first harmonic lies an octave above
+the fundamental, second harmonic a fifth above the first one, the third
+harmonic lies a major third above the second harmonic etc. This is the
+familiar \keyword{overtone series}. We can add harmonics to our sine wave
+instrument easily using the \function{compSine} function defined in the
+\module{CSound.Orchestra} module. The function takes a list of harmonic strengths as
+arguments. The following creates a function table containing the
+fundamental and the first two harmonics at two thirds and one third of the
+strength of the fundamental:
+\begin{haskelllisting}
+
+> twoHarmsTN :: Score.Table
+> twoHarmsTN = 2
+> twoHarms :: Score.Statement
+> twoHarms = Score.Table twoHarmsTN 0 8192 True (compSine1 [1.0, 0.66, 0.33])
+
+\end{haskelllisting}
+We can again proceed to create complete score and orchestra files as above:
+\begin{haskelllisting}
+
+> score2 orc = twoHarms : scored orc attrToInstr1p0 tune1
+>
+> oe2 :: SoundMap.InstrumentSigExp Mono
+> oe2 _noteDur noteVel notePit =
+> let signal = osc AR (tableNumber twoHarmsTN)
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o2 = (hdr, [instrAssoc1p0 oe2])
+>
+> tut2 = example "tut02" score2 o2
+
+\end{haskelllisting}
+ The orchestra file is the same as before -- a single oscillator scanning
+a function table at a given frequency and volume. This time, however, the
+tune will not sound as thin as before since the table now contains a
+function that is an addition of three sine waves. (Note that the same effect
+could be achieved using a simple sine wave table and three oscillators).
+ Not all musical sounds contain harmonic partials exclusively, and
+never do we encounter instruments with static amplitude envelope like the
+ones we have seen so far. Most sounds, musical or not, evolve and change
+throughout their duration. Let's define an instrument containing both
+harmonic and nonharmonic partials, that starts at maximum amplitude with a
+straight line decay. We will use the function \function{compSine2} from the
+\module{CSound.Orchestra} module to create the function table. \function{compSine2} takes a
+list of triples as an argument. The triples specify the partial number as
+a multiple of the fundamental, relative partial strength, and initial phase
+offset:
+\begin{haskelllisting}
+
+> manySinesTN :: Score.Table
+> manySinesTN = 3
+> manySinesTable :: SigExp
+> manySinesTable = tableNumber manySinesTN
+> manySines :: Score.Statement
+> manySines = Score.Table manySinesTN 0 8192 True (compSine2 [(0.5, 0.9, 0.0),
+> (1.0, 1.0, 0.0), (1.1, 0.7, 0.0), (2.0, 0.6, 0.0),
+> (2.5, 0.3, 0.0), (3.0, 0.33, 0.0), (5.0, 0.2, 0.0)])
+
+\end{haskelllisting}
+ Thus this complex will contain the second, third, and fifth harmonic,
+nonharmonic partials at frequencies of 1.1 and 2.5 times the fundamental,
+and a component at half the frequency of the fundamental. Their strengths
+relative to the fundamental are given by the second argument, and they all
+start in sync with zero offset.
+ Now we can proceed as before to create score and orchestra files. We
+will define an \keyword{amplitude envelope} to apply to each note as we
+oscillate through the table. The amplitude envelope will be a straight line
+signal ramping from 1.0 to 0.0 over the duration of the note. This signal
+will be generated at \keyword{control rate} rather than audio rate, because the
+control rate is more than sufficient (the audio signal will change volume
+4,410 times a second), and the slower rate will improve performance.
+\begin{haskelllisting}
+
+> score3 orc = manySines : scored orc attrToInstr1p0 tune1
+>
+> lineCS :: EvalRate -> SigExp -> SigExp
+> -> SigExp -> SigExp
+> lineCS = Orchestra.line
+>
+> oe3 :: SoundMap.InstrumentSigExp Mono
+> oe3 noteDur noteVel notePit =
+> let ampEnv = lineCS CR 1.0 noteDur 0.0
+> signal = osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o3 = (hdr, [instrAssoc1p0 oe3])
+>
+> tut3 = example "tut03" score3 o3
+
+\end{haskelllisting}
+ Not only do musical sounds usually evolve in terms of overall
+amplitude, they also evolve their \keyword{spectra}. In other words, the
+contributing partials do not usually all have the same amplitude envelope,
+and so their contribution to the overall sound isn't static. Let us
+illustrate the point using the same set of partials as in the above example.
+Instead of creating a table containing a complex waveform, however, we will
+use multiple oscillators going through the simple sine wave table we created
+at the beginning of this tutorial at the appropriate frequencies. Thus
+instead of the partials being fused together, each can have its own
+amplitude envelope, making the sound evolve over time. The score will be
+score1, defined above.
+\begin{haskelllisting}
+
+> oe4 :: SoundMap.InstrumentSigExp Mono
+> oe4 noteDur noteVel notePit =
+> let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> mkLine t = lineSeg CR 0 (noteDur*t) 1 [(noteDur * (1-t), 0)]
+> aenv1 = lineCS CR 1 noteDur 0
+> aenv2 = mkLine 0.17
+> aenv3 = mkLine 0.33
+> aenv4 = mkLine 0.50
+> aenv5 = mkLine 0.67
+> aenv6 = mkLine 0.83
+> aenv7 = lineCS CR 0 noteDur 1
+> mkOsc ae p = oscPure (ae * amp) (pitch * p)
+> a1 = mkOsc aenv1 0.5
+> a2 = mkOsc aenv2 1.0
+> a3 = mkOsc aenv3 1.1
+> a4 = mkOsc aenv4 2.0
+> a5 = mkOsc aenv5 2.5
+> a6 = mkOsc aenv6 3.0
+> a7 = mkOsc aenv7 5.0
+> out = 0.5 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> in Mono out
+>
+> o4 = (hdr, [instrAssoc1p0 oe4])
+>
+> tut4 = example "tut04" score1 o4
+
+\end{haskelllisting}
+ So far, we have only used function tables to generate audio signals,
+but they can come very handy in \keyword{modifying} signals. Let us create a
+function table that we can use as an amplitude envelope to make our
+instrument more interesting. The envelope will contain an immediate sharp
+attack and decay, and then a second, more gradual one, so we'll have two
+attack/decay events per note. We'll use the cubic spline curve generating
+routine to do this:
+\begin{haskelllisting}
+
+> coolEnvTN :: Score.Table
+> coolEnvTN = 4
+> coolEnvTable :: SigExp
+> coolEnvTable = tableNumber coolEnvTN
+> coolEnv :: Score.Statement
+> coolEnv = Score.Table coolEnvTN 0 8192 True
+> (cubicSpline 1 [(1692, 0.2), (3000, 1), (3500, 0)])
+
+> oscCoolEnv :: SigExp -> SigExp -> SigExp
+> oscCoolEnv = osc CR coolEnvTable
+
+\end{haskelllisting}
+ Let us also add some \keyword{p-fields} to the notes in our score. The two
+p-fields we add will be used for \keyword{panning} -- the first one will be the
+starting percentage of the left channel, the second one the ending
+percentage (1 means all left, 0 all right, 0.5 middle. Pfields of 1 and 0
+will cause the note to pan completely from left to right for example)
+\begin{haskelllisting}
+
+> tune2 :: TutMelody Pair
+> tune2 =
+> let attr start end = TutAttr 1.4 (start, end)
+> in c 1 hn (attr 1.0 0.75) +:+
+> e 1 hn (attr 0.75 0.5) +:+
+> g 1 hn (attr 0.5 0.25) +:+
+> c 2 hn (attr 0.25 0.0) +:+
+> a 1 hn (attr 0.0 1.0) +:+
+> c 2 qn (attr 0.0 0.0) +:+
+> a 1 qn (attr 1.0 1.0) +:+
+> (g 1 dhn (attr 1.0 0.0) =:=
+> g 1 dhn (attr 0.0 1.0))+:+ qnr
+
+\end{haskelllisting}
+ So far we have limited ourselves to using only sine waves for our
+audio output, even though Csound places no such restrictions on us. Any
+repeating waveform, of any shape, can be used to produce pitched sounds.
+In essence, when we are adding sinewaves, we are changing the shape of the
+wave. For example, adding odd harmonics to a fundamental at strengths equal
+to the inverse of their partial number (ie. third harmonic would be 1/3 the
+strength of the fundamental, fifth harmonic 1/5 the fundamental etc) would
+produce a \keyword{square} wave which has a raspy sound to it. Another common
+waveform is the \keyword{sawtooth}, and the more mellow sounding \keyword{triangle}.
+The \module{CSound.Orchestra} module already contains functions to create these common
+waveforms. Let's use them to create tables that we can use in an instrument:
+\begin{haskelllisting}
+
+> triangleTN, squareTN, sawtoothTN :: Score.Table
+> triangleTN = 5
+> squareTN = 6
+> sawtoothTN = 7
+> triangleT, squareT, sawtoothT :: Score.Statement
+> triangleT = triangle triangleTN
+> squareT = square squareTN
+> sawtoothT = sawtooth sawtoothTN
+>
+> score4 orc = squareT : triangleT : sawtoothT : coolEnv :
+> scored orc attrToInstr1p2 (Music.changeTempo 0.5 tune2)
+>
+> oe5 :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo
+> oe5 panStart panEnd noteDur noteVel notePit =
+> let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> pan = lineCS CR panStart noteDur panEnd
+> oscF = 1 / noteDur
+> ampen = oscCoolEnv amp oscF
+> signal = osc AR (tableNumber squareTN) ampen pitch
+> left = signal * pan
+> right = signal * (1-pan)
+> in Stereo left right
+>
+> o5 = (hdr, [instrAssoc1p2 oe5])
+>
+> tut5 = example "tut05" score4 o5
+
+\end{haskelllisting}
+ This will oscillate through a table containing the square wave.
+Check out the other waveforms too and see what they sound like. This can be
+done by specifying the table to be used in the orchestra file.
+ As our last example of additive synthesis, we will introduce an
+orchestra with multiple instruments. The bass will be mostly in the left
+channel, and will be the same as the third example instrument in this
+section. It will play the tune two octaves below the instrument in the right
+channel, using an orchestra identical to \code{oe3} with the addition of the
+panning feature:
+\begin{haskelllisting}
+
+> score5 orc = manySines : pureTone : scored orc attrToInstr1p0 tune1 ++
+> scored orc attrToInstr2p0 tune1
+>
+> oe6 :: SoundMap.InstrumentSigExp Stereo
+> oe6 noteDur noteVel notePit =
+> let ampEnv = lineCS CR 1.0 noteDur 0.0
+> signal = osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz (notePit - 2))
+> left = 0.8 * signal
+> right = 0.2 * signal
+> in Stereo left right
+>
+> oe7 :: SoundMap.InstrumentSigExp Stereo
+> oe7 noteDur noteVel notePit =
+> let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> mkLine t = lineSeg CR 0 (noteDur*t) 0.5 [(noteDur * (1-t), 0)]
+> aenv1 = lineCS CR 0.5 noteDur 0
+> aenv2 = mkLine 0.17
+> aenv3 = mkLine 0.33
+> aenv4 = mkLine 0.50
+> aenv5 = mkLine 0.67
+> aenv6 = mkLine 0.83
+> aenv7 = lineCS CR 0 noteDur 0.5
+> mkOsc ae p = oscPure (ae * amp) (pitch * p)
+> a1 = mkOsc aenv1 0.5
+> a2 = mkOsc aenv2 1.0
+> a3 = mkOsc aenv3 1.1
+> a4 = mkOsc aenv4 2.0
+> a5 = mkOsc aenv5 2.5
+> a6 = mkOsc aenv6 3.0
+> a7 = mkOsc aenv7 5.0
+> left = 0.2 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> right = 0.8 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> in Stereo left right
+>
+> o6 = (hdr, [instrAssoc1p0 oe6, instrAssoc2p0 oe7])
+>
+> tut6 = example "tut06" score5 o6
+
+\end{haskelllisting}
+ Additive synthesis is the most powerful tool in computer music and
+sound synthesis in general. It can be used to create any sound imaginable,
+whether completely synthetic or a simulation of a real-world sound, and
+everyone interested in using the computer to synthesize sound should be well
+versed in it. The most significant drawback of additive synthesis is that it
+requires huge amounts of control data, and potentially thousands of
+oscillators. There are other synthesis techniques, such as
+\keyword{modulation synthesis}, that can be used to create rich and interesting
+timbres at a fraction of the cost of additive synthesis, though no other
+synthesis technique provides quite the same degree of control.
+
+\paragraph{Modulation Synthesis}
+\seclabel{mod-syn}
+
+ While additive synthesis provides full control and great flexibility,
+it is quiet clear that the enormous amounts of control data make it
+impractical for even moderately complicated sounds. There is a class of
+synthesis techniques that use \keyword{modulation} to produce rich, time-varying
+timbres at a fraction of the storage and time cost of additive synthesis.
+The basic idea behind modulation synthesis is controlling the
+amplitude and/or frequency of the main periodic signal, called the
+\keyword{carrier}, by another periodic signal, called the \keyword{modulator}.
+The two main kinds of modulation synthesis are \keyword{amplitude modulation}
+and \keyword{frequency modulation} synthesis. Let's start our discussion with
+the simpler one of the two -- amplitude synthesis.
+ We have already shown how to supply a time varying amplitude envelope
+to an oscillator. What would happen if this amplitude envelope was itself
+an oscillating signal? Supplying a low frequency ($<20$Hz) modulating signal
+would create a predictable effect -- we would hear the volume of the carrier
+signal go periodically up and down. However, as the modulator moves into the
+audible frequency range, the carrier changes timbre as new frequencies
+appear in the spectrum. The new frequencies are equal to the sum and
+difference of the carrier and modulator. So for example, if the frequency of
+the main signal (carrier) is C = 500Hz, and the frequency of the modulator
+is M = 100Hz, the audible frequencies will be the carrier C (500Hz),
+C + M (600Hz), and C - M (400Hz). The amplitude of the two new sidebands
+depends on the amplitude of the modulator, but will never exceed half the
+amplitude of the carrier.
+ The following is a simple example that demonstrates amplitude
+modulation. The carrier will be a 10 second pure tone at 500Hz. The
+frequency of the modulator will increase linearly over the 10 second
+duration of the tone from 0 to 200 Hz. Initially, you will be able to hear
+the volume of the signal fluctuate, but after a couple of seconds the volume
+will seem constant as new frequencies appear.
+ Let us first create the score file. It will contain a sine wave table,
+and a single note event:
+\begin{haskelllisting}
+
+> score6 _ =
+> pureTone : [ Score.Note instrNum1 0.0 10.0 (Cps 500.0) 10000.0 [] ]
+
+\end{haskelllisting}
+ The orchestra will contain a single AM instrument. The carrier will
+simply oscillate through the sine wave table at frequency given by the note
+pitch (500Hz, see the score above), and amplitude given by the modulator.
+The modulator will oscillate through the same sine wave table at frequency
+ramping from 0 to 200Hz. The modulator should be a periodic signal that
+varies from 0 to the maximum volume of the carrier. Since the sine wave goes
+from -1 to 1, we will need to add 1 to it and half it, before multiplying it
+by the volume supplied by the note event. This will be the modulating
+signal, and the carrier's amplitude input. (note that we omit the conversion
+functions dbToAmp and notePit, since we supply the amplitude and frequency
+in their raw units in the score file)
+\begin{haskelllisting}
+
+> oe8 :: SoundMap.InstrumentSigExp Mono
+> oe8 noteDur noteVel notePit =
+> let modFreq = lineCS CR 0.0 noteDur 200.0
+> modAmp = oscPure 1.0 modFreq
+> modSig = (modAmp + 1.0) * 0.5 * noteVel
+> carrier = oscPure modSig notePit
+> in Mono carrier
+>
+> o7 = (hdr, [instrAssoc1p0 oe8])
+>
+> tut7 = example "tut07" score6 o7
+
+\end{haskelllisting}
+ Next synthesis technique on the palette is \keyword{frequency modulation}.
+As the name suggests, we modulate the frequency of the carrier. Frequency
+modulation is much more powerful and interesting than amplitude modulation,
+because instead of getting two sidebands, FM gives a {\em number} of
+spectral sidebands. Let us begin with an example of a simple FM. We will
+again use a single 10 second note and a 500Hz carrier. Remember that when we
+talked about amplitude modulation, the amplitude of the sidebands was
+dependent upon the amplitude of the modulator. In FM, the modulator
+amplitude plays a much bigger role, as we will see soon. To negate the
+effect of the modulator amplitude, we will keep the ratio of the modulator
+amplitude and frequency constant at 1.0 (we will explain shortly why). The
+frequency and amplitude of the modulator will ramp from 0 to 200 over the
+duration of the note. This time, though, unlike with AM, we will hear a
+whole series of sidebands. The orchestra is just as before, except we
+modulate the frequency instead of amplitude.
+\begin{haskelllisting}
+
+> oe9 :: SoundMap.InstrumentSigExp Mono
+> oe9 noteDur noteVel notePit =
+> let modFreq = lineCS CR 0.0 noteDur 200.0
+> modAmp = modFreq
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure noteVel (notePit + modSig)
+> in Mono carrier
+>
+> o8 = (hdr, [instrAssoc1p0 oe9])
+>
+> tut8 = example "tut08" score6 o8
+
+\end{haskelllisting}
+ The sound produced by FM is a little richer but still very bland. Let
+us talk now about the role of the \keyword{depth} of the frequency modulation
+(the amplitude of the modulator). Unlike in AM, where we only had one
+spectral band on each side of the carrier frequency (ie we heard C, C+M,
+C-M), FM gives a much richer spectrum with many sidebands. The frequencies
+we hear are C, C+M, C-M, C+2M, C-2M, C+3M, C-3M etc. The amplitudes of the
+sidebands are determined by the \keyword{modulation index} I, which is the ratio
+between the amplitude (also referred to as depth) and frequency of the
+modulator (I = D / M). As a rule of thumb, the number of significant
+sideband pairs (at least 1% the volume of the carrier) is I+1. As I (and the
+number of sidebands) increases, energy is "stolen" from the carrier and
+distributed among the sidebands. Thus if I=1, we have 2 significant sideband
+pairs, and the audible frequencies will be C, C+M, C-M, C+2M, C-2M, with C,
+the carrier, being the dominant frequency. When I=5, we will have a much
+richer sound with about 6 significant sideband pairs, some of which will
+actually be louder than the carrier. Let us explore the effect of the
+modulation index in the following example. We will keep the frequency of
+the carrier and the modulator constant at 500Hz and 80 Hz respectively.
+The modulation index will be a stepwise function from 1 to 10, holding each
+value for one second. So in effect, during the first second (I = D/M = 1),
+the amplitude of the modulator will be the same as its frequency (80).
+During the second second (I = 2), the amplitude will be double the frequency
+(160), then it will go to 240, 320, etc:
+\begin{haskelllisting}
+
+> oe10 :: SoundMap.InstrumentSigExp Mono
+> oe10 _noteDur noteVel notePit =
+> let modInd = lineSeg CR 1 1 1 [(0,2), (1,2), (0,3), (1,3), (0,4),
+> (1,4), (0,5), (1,5), (0,6), (1,6),
+> (0,7), (1,7), (0,8), (0,9), (1,9),
+> (0,10), (1,10)]
+> modAmp = 80.0 * modInd
+> modSig = oscPure modAmp 80.0
+> carrier = oscPure noteVel (notePit + modSig)
+> in Mono carrier
+>
+> o9 = (hdr, [instrAssoc1p0 oe10])
+>
+> tut9 = example "tut09" score6 o9
+
+\end{haskelllisting}
+ Notice that when the modulation index gets high enough, some of the
+sidebands have negative frequencies. For example, when the modulation index
+is 7, there is a sideband present in the sound with a frequency
+C - 7M = 500 - 560 = -60Hz. The negative sidebands get reflected back into
+the audible spectrum but are \keyword{phase shifted} 180 degrees, so it is an
+inverse sine wave. This makes no difference when the wave is on its own, but
+when we add it to its inverse, the two will cancel out. Say we set the
+frequency of the carrier at 100Hz instead of 80Hz. Then at I=6, we would
+have present two sidebands of the same frequency - C-4M = 100Hz, and
+C-6M = -100Hz. When these two are added, they would cancel each other out
+(if they were the same amplitude; if not, the louder one would be attenuated
+by the amplitude of the softer one). The following flexible instrument will
+sum up simple FM. The frequency of the modulator will be determined by the
+C/M ratio supplied as p6 in the score file. The modulation index will be a
+linear slope going from 0 to p7 over the duration of each note. Let us also
+add panning control as in additive synthesis - p8 will be the initial left
+channel percentage, and p9 the final left channel percentage:
+\begin{haskelllisting}
+
+> oe11 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo
+> oe11 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit =
+> let carFreq = pchToHz notePit
+> carAmp = dbToAmp noteVel
+> modFreq = carFreq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure carAmp (carFreq + modSig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * carrier
+> right = mainAmp * (1 - pan) * carrier
+> in Stereo left right
+>
+> o10 = (hdr, [instrAssoc1p4 oe11])
+
+\end{haskelllisting}
+ Let's write a cool tune to show off this instrument. Let's keep it
+simple and play the chord progression Em - C - G - D a few times, each time
+changing some of the parameters:
+\begin{haskelllisting}
+
+> emChord, cChord, gChord, dChord ::
+> Float -> Float -> Float -> Float ->
+> TutMelody Quadruple
+>
+> quickChord ::
+> [Music.Dur -> TutAttr Quadruple -> TutMelody Quadruple] ->
+> Float -> Float -> Float -> Float ->
+> TutMelody Quadruple
+> quickChord ns x y z w = Music.chord $
+> map (\p -> p wn (TutAttr 1.4 (x, y, z, w))) ns
+>
+> emChord = quickChord [e 0, g 0, b 0]
+> cChord = quickChord [c 0, e 0, g 0]
+> gChord = quickChord [g 0, b 0, d 1]
+> dChord = quickChord [d 0, fs 0, a 0]
+>
+> tune3 :: TutMelody Quadruple
+> tune3 =
+> Music.transpose (-12) $
+> emChord 3.0 2.0 0.0 1.0 +:+ cChord 3.0 5.0 1.0 0.0 +:+
+> gChord 3.0 8.0 0.0 1.0 +:+ dChord 3.0 12.0 1.0 0.0 +:+
+> emChord 3.0 4.0 0.0 0.5 +:+ cChord 5.0 4.0 0.5 1.0 +:+
+> gChord 8.0 4.0 1.0 0.5 +:+ dChord 10.0 4.0 0.5 0.0 +:+
+> (emChord 4.0 6.0 1.0 0.0 =:= emChord 7.0 5.0 0.0 1.0) +:+
+> (cChord 5.0 9.0 1.0 0.0 =:= cChord 9.0 5.0 0.0 1.0) +:+
+> (gChord 5.0 5.0 1.0 0.0 =:= gChord 7.0 7.0 0.0 1.0) +:+
+> (dChord 2.0 3.0 1.0 0.0 =:= dChord 7.0 15.0 0.0 1.0)
+
+\end{haskelllisting}
+ Now we can create a score. It will contain two wave tables -- one
+containing the sine wave, and the other containing an amplitude envelope,
+which will be the table coolEnv which we have already seen before
+\begin{haskelllisting}
+
+> score7 orc = pureTone : coolEnv :
+> scored orc attrToInstr1p4 (Music.changeTempo 0.5 tune3)
+>
+> tut10 = example "tut10" score7 o10
+
+\end{haskelllisting}
+ Note that all of the above examples of frequency modulation use a
+single carrier and a single modulator, and both are oscillating through the
+simplest of waveforms -- a sine wave. Already we have achieved some very rich
+and interesting timbres using this simple technique, but the possibilities
+are unlimited when we start using different carrier and modulator waveshapes
+and multiple carriers and/or modulators. Let us include a couple more
+examples that will play the same chord progression as above with multiple
+carriers, and then with multiple modulators.
+ The reason for using multiple carriers is to obtain
+{/em formant regions} in the spectrum of the sound. Recall that when we
+modulate a carrier frequency we get a spectrum with a central peak and a
+number of sidebands on either side of it. Multiple carriers introduce
+additional peaks and sidebands into the composite spectrum of the resulting
+sound. These extra peaks are called formant regions, and are characteristic
+of human voice and most musical instruments
+\begin{haskelllisting}
+
+> oe12 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo
+> oe12 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit =
+> let car1Freq = pchToHz notePit
+> car2Freq = pchToHz (notePit + 1)
+> car1Amp = dbToAmp noteVel
+> car2Amp = dbToAmp noteVel * 0.7
+> modFreq = car1Freq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier1 = oscPure car1Amp (car1Freq + modSig)
+> carrier2 = oscPure car2Amp (car2Freq + modSig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * (carrier1 + carrier2)
+> right = mainAmp * (1 - pan) * (carrier1 + carrier2)
+> in Stereo left right
+>
+> o11 = (hdr, [instrAssoc1p4 oe12])
+>
+> tut11 = example "tut11" score7 o11
+
+\end{haskelllisting}
+ In the above example, there are two formant regions -- one is centered
+around the note pitch frequency provided by the score file, the other an
+octave above. Both are modulated in the same way by the same modulator. The
+sound is even richer than that obtained by simple FM.
+ Let us now turn to multiple modulator FM. In this case, we use a
+signal to modify another signal, and the modified signal will itself become
+a modulator acting on the carrier. Thus the wave that wil be modulating the
+carrier is not a sine wave as above, but is itself a complex waveform
+resulting from simple FM. The spectrum of the sound will contain a central
+peak frequency, surrounded by a number of sidebands, but this time each
+sideband will itself also by surrounded by a number of sidebands of its own.
+So in effect we are talking about "double" modulation, where each sideband
+is a central peak in its own little spectrum. Multiple modulator FM thus
+provides extremely rich spectra
+\begin{haskelllisting}
+
+> oe13 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo
+> oe13 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit =
+> let carFreq = pchToHz notePit
+> carAmp = dbToAmp noteVel
+> mod1Freq = carFreq * modFreqRatio
+> mod2Freq = mod1Freq * 2.0
+> modInd = lineCS CR 0 noteDur modIndEnd
+> mod1Amp = mod1Freq * modInd
+> mod2Amp = mod1Amp * 3.0
+> mod1Sig = oscPure mod1Amp mod1Freq
+> mod2Sig = oscPure mod2Amp (mod2Freq + mod1Sig)
+> carrier = oscPure carAmp (carFreq + mod2Sig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * carrier
+> right = mainAmp * (1 - pan) * carrier
+> in Stereo left right
+>
+> o12 = (hdr, [instrAssoc1p4 oe13])
+>
+> tut12 = example "tut12" score7 o12
+
+\end{haskelllisting}
+ In fact, the spectra produced by multiple modulator FM are so rich and
+complicated that even the moderate values used as arguments in our tune
+produce spectra that are saturated and otherworldly. And we did this while
+keeping the ratios of the two modulators frequencies and amplitudes
+constant; introducing dynamics in those ratios would produce even crazier
+results. It is quite amazing that from three simple sine waves, the purest
+of all tones, we can derive an unlimited number of timbres. Modulation
+synthesis is a very powerful tool and understanding how to use it can prove
+invaluable. The best way to learn how to use FM effectively is to dabble and
+experiment with different ratios, formant regions, dynamic relationships
+betweeen ratios, waveshapes, etc. The possibilities are limitless.
+
+\paragraph{Other Capabilities Of CSound}
+\seclabel{other}
+
+ In our examples of additive and modulation synthesis we only used a
+limited number of functions and routines provided us by CSound, such as
+Osc (oscillator), Line and LineSig (line and line segment signal
+generators) etc. This tutorial intends to briefly explain the
+functionality of some of the other features of CSound. Remember that the
+CSound manual should be the ultimate reference when it comes to using
+these functions.
+ Let us start with the two functions \function{buzz} and \function{genBuzz}.
+These functions will produce a set of harmonically related cosines. Thus
+they really implement simple additive synthesis, except that the number of
+partials can be varied dynamically through the duration of the note,
+rather than staying fixed as in simple additive synthesis. As an example,
+let us perform the tune defined at the very beginning of the tutorial using
+an instrument that will play each note by starting off with the fundamental
+and 70 harmonics, and ending with simply the sine wave fundamental (note
+that cosine and sine waves sound the same). We will use a straight line
+signal going from 70 to 0 over the duration of each note for the number of
+harmonics. The score used will be score1, and the orchestra will be:
+\begin{haskelllisting}
+
+> oe14 :: SoundMap.InstrumentSigExp Mono
+> oe14 noteDur noteVel notePit =
+> let numharms = lineCS CR 70 noteDur 0
+> signal = buzz pureToneTable numharms
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o13 = (hdr, [instrAssoc1p0 oe14])
+>
+> tut13 = example "tut13" score1 o13
+
+\end{haskelllisting}
+ Let's invert the line of the harmonics, and instead of going from 70
+to 0, make it go from 0 to 70. This will produce an interesting effect
+quite different from the one just heard:
+\begin{haskelllisting}
+
+> oe15 :: SoundMap.InstrumentSigExp Mono
+> oe15 noteDur noteVel notePit =
+> let numharms = lineCS CR 0 noteDur 70
+> signal = buzz pureToneTable numharms
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o14 = (hdr, [instrAssoc1p0 oe15])
+>
+> tut14 = example "tut14" score1 o14
+
+\end{haskelllisting}
+ The \function{buzz} expression takes the overall amplitude, fundamental
+frequency, number of partials, and a sine wave table and generates a
+wave complex.
+ In recent years there has been a lot of research conducted in the
+area of \keyword{physical modelling}. This technique attempts to approximate the
+sound of real world musical instruments through mathematical models. One
+of the most widespread, versatile and interesting of these models is the
+\keyword{Karplus-Strong algorithm} that simulates the sound of a plucked string.
+The algorithm starts off with a buffer containing a user-determined
+waveform. On every pass, the waveform is "smoothed out" and flattened by the
+algorithm to simulate the decay. There is a certain degree of randomness
+involved to make the string sound more natural.
+ There are six different "smoothing methods" available in CSound, as
+mentioned in the CSound module. The \function{pluck} constructor accepts the note
+volume, pitch, the table number that is used to initialize the buffer, the
+smoothing method used, and two parameters that depend on the smoothing
+method. If zero is given as the initializing table number, the buffer starts
+off containing a random waveform (white noise). This is the best table when
+simulating a string instrument because of the randomness and percussive
+attack it produces when used with this algorithm, but you should experiment
+with other waveforms as well.
+ Here is an example of what Pluck sounds like with a white noise buffer
+and the simple smoothing method. This method ignores the parameters, which we
+set to zero.
+\begin{haskelllisting}
+
+> oe16 :: SoundMap.InstrumentSigExp Mono
+> oe16 _noteDur noteVel notePit =
+> let signal = pluck 0 (pchToHz notePit)
+> PluckSimpleSmooth
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o15 = (hdr, [instrAssoc1p0 oe16])
+>
+> tut15 = example "tut15" score1 o15
+
+\end{haskelllisting}
+ The second smoothing method is the \keyword{stretched smooth}, which works
+like the simple smooth above, except that the smoothing process is stretched
+by a factor determined by the first parameter. The second parameter is
+ignored. The third smoothing method is the \keyword{snare drum} method. The
+first parameter is the "roughness" parameter, with 0 resulting in a sound
+identical to simple smooth, 0.5 being the perfect snare drum, and 1.0 being
+the same as simple smooth again with reversed polarity (like a graph flipped
+around the x-axis). The fourth smoothing method is the \keyword{stretched drum}
+method which combines the roughness and stretch factors -- the first parameter
+is the roughness, the second is the stretch. The fifth method is
+\keyword{weighted average} -- it combines the current sample (ie. the current pass
+through the buffer) with the previous one, with their weights being determined
+by the parameters. This is a way to add slight reverb to the plucked sound.
+Finally, the last method filters the sound so it doesn't sound as bright.
+The parameters are ignored. You can modify the instrument \code{oe16} easily
+to listen to all these effects by simply replacing the variable
+\function{simpleSmooth} by \function{stretchSmooth, simpleDrum, stretchDrum,
+weightedSmooth} or \function{filterSmooth}.
+ Here is another simple instrument example. This combines a snare drum
+sound with a stretched plucked string sound. The snare drum as a constant
+amplitude, while we apply an amplitude envelope to the string sound. The
+envelope is a spline curve with a hump in the middle, so both the attack and
+decay are gradual. The drum roughness factor is 0.3, so a pitch is still
+discernible (with a factor of 0.5 we would get a snare drum sound with no
+pitch, just a puff of white noise). The drum sound is shifted towards the left
+channel, while the string sound is shifted towards the right.
+\begin{haskelllisting}
+
+> midHumpTN :: Score.Table
+> midHumpTN = 8
+> midHump :: Score.Statement
+> midHump = Score.Table midHumpTN 0 8192 True
+> (cubicSpline 0.0 [(4096, 1.0), (4096, 0.0)])
+>
+> score8 orc = pureTone : midHump : scored orc attrToInstr1p0 tune1
+>
+> oe17 :: SoundMap.InstrumentSigExp Stereo
+> oe17 noteDur noteVel notePit =
+> let string = pluck 0 (pchToHz notePit)
+> (PluckStretchSmooth 1.5)
+> (dbToAmp noteVel) (pchToHz notePit)
+> drum = pluck 0 (pchToHz notePit)
+> (PluckSimpleDrum 0.3)
+> 6000 (pchToHz notePit)
+> ampEnv = osc CR (tableNumber midHumpTN) 1.0 (1 / noteDur)
+> left = (0.65 * drum) + (0.35 * ampEnv * string)
+> right = (0.35 * drum) + (0.65 * ampEnv * string)
+> in Stereo left right
+>
+> o16 = (hdr, [instrAssoc1p0 oe17])
+>
+> tut16 = example "tut16" score8 o16
+
+\end{haskelllisting}
+
+ Let us now turn our attention to the effects we can achieve using a
+\keyword{delay line}.
+Let's define a simple percussive instrument.
+It's strong attack let us easily perceive the reverberation.
+
+\begin{haskelllisting}
+
+> ping :: SigExp -> SigExp -> SigExp
+> ping noteVel notePit =
+> let ampEnv = expon CR 1.0 1.0 (1/100)
+> in osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz notePit)
+
+\end{haskelllisting}
+
+There is still the problem,
+that subsequent notes truncate preceding ones.
+This would suppress the reverb.
+In order to avoid this
+we add a \keyword{legato} effect to the music.
+That is we prolong the notes such that they overlap.
+
+\begin{haskelllisting}
+
+> score9 orc = manySines : scored orc attrToInstr1p0 (Music.legato 1 tune1)
+
+\end{haskelllisting}
+
+Here we take the ping sound and add a little echo to it using delay:
+\begin{haskelllisting}
+
+> oe18 :: SoundMap.InstrumentSigExp Stereo
+> oe18 _noteDur noteVel notePit =
+> let ping' = ping noteVel notePit
+> dping1 = Orchestra.delay 0.05 ping'
+> dping2 = Orchestra.delay 0.1 ping'
+> left = (0.65 * ping') + (0.35 * dping2) + (0.5 * dping1)
+> right = (0.35 * ping') + (0.65 * dping2) + (0.5 * dping1)
+> in Stereo left right
+>
+> o17 = (hdr, [instrAssoc1p0 oe18])
+>
+> tut17 = example "tut17" score9 o17
+
+\end{haskelllisting}
+ The constructor \function{delay} establishes a \keyword{delay line}. A delay
+line is essentially a buffer that contains the signal to be delayed. The first
+argument to the \function{delay} constructor is the length of the delay (which
+determines the size of the buffer), and the second argument is the signal to
+be delayed. So for example, if the delay time is 1.0 seconds, and the sampling
+rate is 44,100 Hz (CD quality), then the delay line will be a buffer containing
+44,100 samples of the delayed signal. The buffer is rewritten at the audio
+rate. Once \code{Delay t sig} writes t seconds of the signal \code{sig} into the
+buffer, the buffer can be \keyword{tapped} using the \function{delTap} or the
+\function{delTapI} constructors. \code{delTap t dline} will extract the signal from
+\code{dline} at time \code{t} seconds. In the exmaple above, we set up a delay
+line containing 0.1 seconds of the audio signal, then we tapped it twice -- once
+at 0.05 seconds and once at 0.1 seconds. The output signal is a combination of
+the original signal (left channel), the signal delayed by 0.05 seconds
+(middle), and the signal delayed by 0.1 seconds (right channel).
+ CSound provides other ways to reverberate a signal besides the delay
+line just demonstrated. One such way is achieved via the Reverb constructor
+introduced in the \module{CSound.Orchestra} module. This constructor tries to emulate
+natural room reverb, and takes as arguments the signal to be reverberated, and
+the reverb time in seconds. This is the time it takes the signal to decay to
+1/1000 its original amplitude. In this example we output both the original and
+the reverberated sound.
+\begin{haskelllisting}
+
+> oe19 :: SoundMap.InstrumentSigExp Stereo
+> oe19 _noteDur noteVel notePit =
+> let ping' = ping noteVel notePit
+> rev = reverb 0.3 ping'
+> left = (0.65 * ping') + (0.35 * rev)
+> right = (0.35 * ping') + (0.65 * rev)
+> in Stereo left right
+>
+> o18 = (hdr, [instrAssoc1p0 oe19])
+>
+> tut18 = example "tut18" score9 o18
+
+\end{haskelllisting}
+ The other two reverb functions are \function{comb} and \function{alpass}. Each
+of these requires as arguments the signal to be reverberated, the reverb time
+as above, and echo loop density in seconds. Here is an example of an instrument
+using \function{comb}.
+\begin{haskelllisting}
+
+> oe20 :: SoundMap.InstrumentSigExp Mono
+> oe20 _noteDur noteVel notePit =
+> Mono (comb 0.22 4.0 (ping noteVel notePit))
+>
+> o19 = (hdr, [instrAssoc1p0 oe20])
+>
+> tut19 = example "tut19" score9 o19
+
+\end{haskelllisting}
+ Delay lines can be used for effects other than simple echo and
+reverberation. Once the delay line has been established, it can be tapped at
+times that vary at control or audio rates. This can be taken advantage of to
+produce effects like chorus, flanger, or the Doppler effect. Here is an
+example of the flanger effect. This instrument adds a slight flange to
+\code{oe11}.
+\begin{haskelllisting}
+
+> oe21 :: SigExp -> SigExp -> SigExp -> SigExp -> SoundMap.InstrumentSigExp Stereo
+> oe21 modFreqRatio modIndEnd panStart panEnd noteDur noteVel notePit =
+> let carFreq = pchToHz notePit
+> ampEnv = oscCoolEnv 1.0 (1/noteDur)
+> carAmp = dbToAmp noteVel * ampEnv
+> modFreq = carFreq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure carAmp (carFreq + modSig)
+> ftime = oscPure (1/10) 2
+> flanger = ampEnv * vdelay 1 (0.5 + ftime) carrier
+> signal = carrier + flanger
+> pan = lineCS CR panStart noteDur panEnd
+> left = pan * signal
+> right = (1 - pan) * signal
+> in Stereo left right
+>
+> o20 = (hdr, [instrAssoc1p4 oe21])
+>
+> tut20 = example "tut20" score7 o20
+
+\end{haskelllisting}
+
+The last two examples use generic delay lines.
+That is we do not rely on special echo effects but build our own ones
+by delaying a signal, filtering it by low pass or high pass filters
+and feeding the result back to the delay function.
+\begin{haskelllisting}
+
+> lowPass, highPass :: EvalRate -> SigExp -> SigExp -> SigExp
+> lowPass rate cutOff sig = sigGen "tone" rate 1 [sig, cutOff]
+> highPass rate cutOff sig = sigGen "atone" rate 1 [sig, cutOff]
+
+> oe22 :: SoundMap.InstrumentSigExp Stereo
+> oe22 _noteDur noteVel notePit =
+> let ping' = ping noteVel notePit
+> left = rec (\x -> ping' + lowPass AR 500 (Orchestra.delay 0.311 x))
+> right = rec (\x -> ping' + highPass AR 1000 (Orchestra.delay 0.271 x))
+> in Stereo left right
+>
+> o21 = (hdr, [instrAssoc1p0 oe22])
+>
+> tut21 = example "tut21" score9 o21
+
+> oe23 :: SoundMap.InstrumentSigExp Mono
+> oe23 _noteDur noteVel notePit =
+> let ping' = ping noteVel notePit
+> rev = rec (\x -> ping' +
+> 0.7 * (lowPass AR 500 (Orchestra.delay 0.311 x)
+> + highPass AR 1000 (Orchestra.delay 0.271 x)))
+> in Mono rev
+>
+> o22 = (hdr, [instrAssoc1p0 oe23])
+>
+> tut22 = example "tut22" score9 o22
+
+\end{haskelllisting}
+
+This completes our discussion of sound synthesis and Csound. For more
+information, please consult the CSound manual or check out
+
+\url{http://mitpress.mit.edu/e-books/csound/frontpage.html}
+
+The function \function{applyOutFunc} applies
+sound expression function to the expressions
+which represent the parameter fields from 6 on.
+These are the fields where the additional instrument parameters
+are put by \function{CSound.Score.statementToWords}.
+\begin{haskelllisting}
+
+> test :: Output out => (Name, Score.T, TutOrchestra out) -> IO ()
+> test = play csoundDir
+>
+> toOrchestra :: Output out => TutOrchestra out -> Orchestra.T out
+> toOrchestra (hd, instrs) =
+> Orchestra.Cons hd (SoundMap.instrumentTableToInstrBlocks instrs)
+>
+> play :: Output out =>
+> FilePath -> (Name, Score.T, TutOrchestra out) -> IO ()
+> play dir (name, s, o') =
+> let scorename = name ++ ".sco"
+> orchname = name ++ ".orc"
+> -- wavename = name ++ ".wav"
+> o = toOrchestra o'
+> -- (Orchestra.Cons (rate, _) _) = o
+> in do writeFile (dir++"/"++scorename) (Score.toString s)
+> writeFile (dir++"/"++orchname) (Orchestra.toString o)
+> {-
+> system ("cd "++dir++" ; csound32 -d -W -o "
+> ++ wavename ++ " " ++ orchname ++ " " ++ scorename
+> ++ " ; play " ++ wavename)
+> -}
+> system ("cd "++dir++" ; csound32 -d -A -o stdout -s "
+> ++ orchname ++ " " ++ scorename
+> ++ " | play -t aiff -")
+> {-
+> system ("cd "++dir++" ; csound32 -d -o stdout -s "
+> ++ orchname ++ " " ++ scorename
+> ++ " | play -r " ++ show rate ++ " -t sw -")
+> -}
+> {-
+> system ("cd "++dir++" ; csound32 -d -o dac " -- /dev/dsp makes some chaotic noise
+> ++ orchname ++ " " ++ scorename)
+> -}
+> {-
+> system (dir ++ "/csound.exe -W -o " ++ wavename
+> ++ " " ++ orchname ++ " " ++ scorename)
+> -}
+> return ()
+
+\end{haskelllisting}
+
+Here are some bonus instruments for your pleasure and enjoyment.
+The first ten instruments are lifted from
+
+\url{http://wings.buffalo.edu/academic/department/AandL/music/pub/accci/01/01_01_1b.txt.html}
+
+The tutorial explains how to add echo/reverb and other effects to the
+instruments if you need to. This instrument sounds like an electric piano and
+is really simple -- \function{pianoEnv} sets the amplitude envelope, and the sound
+waveform is just a series of 10 harmonics. To make the sound brighter,
+increase the weight of the upper harmonics.
+
+\begin{haskelllisting}
+
+> piano, reedy, flute
+> :: (Name, Score.T, TutOrchestra Mono)
+
+> pianoOrc, reedyOrc, fluteOrc
+> :: TutOrchestra Mono
+
+> pianoScore, reedyScore, fluteScore :: TutOrchestra out -> Score.T
+> pianoEnv, reedyEnv, fluteEnv,
+> pianoWave, reedyWave, fluteWave :: Score.Statement
+> pianoEnvTN, reedyEnvTN, fluteEnvTN,
+> pianoWaveTN, reedyWaveTN, fluteWaveTN :: Score.Table
+> pianoEnvTable, reedyEnvTable, fluteEnvTable,
+> pianoWaveTable, reedyWaveTable, fluteWaveTable :: SigExp
+
+> pianoEnvTN = 10; pianoEnvTable = tableNumber pianoEnvTN
+> pianoWaveTN = 11; pianoWaveTable = tableNumber pianoWaveTN
+>
+> pianoEnv = Score.Table pianoEnvTN 0 1024 True (lineSeg1 0 [(20, 0.99),
+> (380, 0.4), (400, 0.2), (224, 0)])
+> pianoWave = Score.Table pianoWaveTN 0 1024 True (compSine1 [0.158, 0.316,
+> 1.0, 1.0, 0.282, 0.112, 0.063, 0.079, 0.126, 0.071])
+>
+> pianoScore orc = pianoEnv : pianoWave : scored orc attrToInstr1p0 tune1
+>
+> pianoOE :: SoundMap.InstrumentSigExp Mono
+> pianoOE noteDur noteVel notePit =
+> let ampEnv = osc CR pianoEnvTable (dbToAmp noteVel) (1/noteDur)
+> signal = osc AR pianoWaveTable ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> pianoOrc = (hdr, [instrAssoc1p0 pianoOE])
+>
+> piano = example "piano" pianoScore pianoOrc
+
+\end{haskelllisting}
+
+Here is another instrument with a reedy sound to it
+
+\begin{haskelllisting}
+
+> reedyEnvTN = 12; reedyEnvTable = tableNumber reedyEnvTN
+> reedyWaveTN = 13; reedyWaveTable = tableNumber reedyWaveTN
+>
+> reedyEnv = Score.Table reedyEnvTN 0 1024 True (lineSeg1 0 [(172, 1.0),
+> (170, 0.8), (170, 0.6), (170, 0.7), (170, 0.6), (172,0)])
+> reedyWave = Score.Table reedyWaveTN 0 1024 True (compSine1 [0.4, 0.3,
+> 0.35, 0.5, 0.1, 0.2, 0.15, 0.0, 0.02, 0.05, 0.03])
+>
+> reedyScore orc = reedyEnv : reedyWave : scored orc attrToInstr1p0 tune1
+>
+> reedyOE :: SoundMap.InstrumentSigExp Mono
+> reedyOE noteDur noteVel notePit =
+> let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur)
+> signal = osc AR reedyWaveTable ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> reedyOrc = (hdr, [instrAssoc1p0 reedyOE])
+>
+> reedy = example "reedy" reedyScore reedyOrc
+
+\end{haskelllisting}
+
+We can use a little trick to make it sound like several reeds playing by
+adding three signals that are slightly out of tune:
+
+\begin{haskelllisting}
+
+> reedy2OE :: SoundMap.InstrumentSigExp Stereo
+> reedy2OE noteDur noteVel notePit =
+> let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur)
+> freq = pchToHz notePit
+> reedyOsc = osc AR reedyWaveTable
+> a1 = reedyOsc ampEnv freq
+> a2 = reedyOsc (ampEnv * 0.44) (freq + (0.023 * freq))
+> a3 = reedyOsc (ampEnv * 0.26) (freq + (0.019 * freq))
+> left = (a1 * 0.5) + (a2 * 0.35) + (a3 * 0.65)
+> right = (a1 * 0.5) + (a2 * 0.65) + (a3 * 0.35)
+> in Stereo left right
+>
+> reedy2Orc :: TutOrchestra Stereo
+> reedy2Orc = (hdr, [instrAssoc1p0 reedy2OE])
+>
+> reedy2 :: (Name, Score.T, TutOrchestra Stereo)
+> reedy2 = example "reedy2" reedyScore reedy2Orc
+
+\end{haskelllisting}
+
+This instrument tries to emulate a flute sound by introducing random
+variations to the amplitude envelope. The score file passes in two
+parameters -- the first one is the depth of the random tremolo in percent of
+total amplitude. The tremolo is implemented using the \function{randomI} function,
+which generates a signal that interpolates between 2 random numbers over a
+certain number of samples that is specified by the second parameter.
+
+\begin{haskelllisting}
+
+> fluteTune :: TutMelody Pair
+>
+> fluteTune = Music.line
+> (map ($ TutAttr 1.6 (30, 40))
+> [c 1 hn, e 1 hn, g 1 hn, c 2 hn,
+> a 1 hn, c 2 qn, a 1 qn, g 1 dhn]
+> ++ [qnr])
+>
+>
+> fluteEnvTN = 14; fluteEnvTable = tableNumber fluteEnvTN
+> fluteWaveTN = 15; fluteWaveTable = tableNumber fluteWaveTN
+>
+> fluteEnv = Score.Table fluteEnvTN 0 1024 True (lineSeg1 0 [(100, 0.8),
+> (200, 0.9), (100, 0.7), (300, 0.2), (324, 0.0)])
+> fluteWave = Score.Table fluteWaveTN 0 1024 True (compSine1 [1.0, 0.4,
+> 0.2, 0.1, 0.1, 0.05])
+>
+> fluteScore orc = fluteEnv : fluteWave : scored orc attrToInstr1p2 fluteTune
+>
+> fluteOE :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Mono
+> fluteOE depth numSam noteDur noteVel notePit =
+> let vol = dbToAmp noteVel
+> rand = randomI AR numSam (vol/100 * depth)
+> ampEnv = oscI AR fluteEnvTable
+> (rand + vol) (1 / noteDur)
+> signal = oscI AR fluteWaveTable
+> ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> fluteOrc = (hdr, [instrAssoc1p2 fluteOE])
+>
+> flute = example "flute" fluteScore fluteOrc
+
+\end{haskelllisting}
+
+Dirty hacks are going on here
+in order to pass the Phoneme values through all functions.
+
+\begin{haskelllisting}
+
+> voice' :: SigExp -> SigExp -> SigExp -> SigExp ->
+> SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> voice' vibWave wave gain vibAmp vibFreq amp freq phoneme =
+> sigGen "voice" AR 1
+> [amp, freq, phoneme, gain, vibFreq, vibAmp, wave, vibWave]
+
+> data Phoneme =
+> Eee | Ihh | Ehh | Aaa |
+> Ahh | Aww | Ohh | Uhh |
+> Uuu | Ooo | Rrr | Lll |
+> Mmm | Nnn | Nng | Ngg |
+> Fff | Sss | Thh | Shh |
+> Xxx | Hee | Hoo | Hah |
+> Bbb | Ddd | Jjj | Ggg |
+> Vvv | Zzz | Thz | Zhh
+> deriving (Show, Eq, Ord, Enum)
+
+> voiceTune :: TutMelody Pair
+> voiceTune = Music.line
+> (map (\(n,ph) ->
+> n (TutAttr 1 (fromIntegral (fromEnum ph), 2)))
+> [(c 1 hn, Aaa), (e 1 hn, Ehh), (g 1 hn, Ohh), (c 2 hn, Ehh),
+> (a 1 hn, Eee), (c 2 qn, Aww), (a 1 qn, Aww), (g 1 dhn, Aaa)]
+> ++ [qnr])
+>
+>
+> voiceVibWaveTN, voiceWaveTN :: Score.Table
+> voiceVibWaveTable, voiceWaveTable :: SigExp
+> voiceVibWaveTN = 14; voiceVibWaveTable = tableNumber voiceVibWaveTN
+> voiceWaveTN = 15; voiceWaveTable = tableNumber voiceWaveTN
+>
+> voiceWave, voiceVibWave :: Score.Statement
+> voiceWave = Score.Table voiceWaveTN 0 1024 True
+> (let width = 50
+> in lineSeg1 0 [(width, 1), (width, 0), (1024-2*width, 0)])
+> voiceVibWave = Score.Table voiceVibWaveTN 0 1024 True (compSine1 [1.0, 0.4])
+>
+> voiceScore :: TutOrchestra out -> Score.T
+> voiceScore orc =
+> voiceVibWave : voiceWave : scored orc attrToInstr1p2 voiceTune
+>
+> voiceOE :: SigExp -> SigExp -> SoundMap.InstrumentSigExp Mono
+> voiceOE phoneme gain _noteDur noteVel notePit =
+> let vol = dbToAmp noteVel
+> signal = voice' voiceVibWaveTable voiceWaveTable
+> gain (3/100) 5 vol (pchToHz notePit) phoneme
+> in Mono signal
+>
+> voiceOrc :: TutOrchestra Mono
+> voiceOrc = (hdr, [instrAssoc1p2 voiceOE])
+>
+> voice :: (Name, Score.T, TutOrchestra Mono)
+> voice = example "voice" voiceScore voiceOrc
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/CSound/TutorialCustom.lhs b/src/Haskore/Interface/CSound/TutorialCustom.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/CSound/TutorialCustom.lhs
@@ -0,0 +1,1470 @@
+\subsubsection{Tutorial}
+\seclabel{csound-tut}
+
+This tutorial is essentially the same like Tutorial.lhs
+but it uses less code from the CSound wrapper modules
+and shows how to implement custom routines for more flexibility.
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.CSound.TutorialCustom where
+
+> import Haskore.Interface.CSound.Orchestra as Orchestra
+> hiding (Instrument)
+> import Haskore.Interface.CSound.Score as Score
+> import Haskore.Interface.CSound.Generator
+> (compSine1, compSine2, cubicSpline, lineSeg1)
+
+> import qualified Haskore.Interface.CSound as CSound
+
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Fancy as FancyPerformance
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+> import Haskore.Basic.Duration
+> import Haskore.Music ((+:+), (=:=), qnr)
+> import Haskore.Melody as Melody
+
+> import System.IO
+> import System.Cmd( system )
+
+> lineCS :: EvalRate -> SigExp -> SigExp
+> -> SigExp -> SigExp
+> lineCS = Orchestra.line
+
+\end{haskelllisting}
+
+ This brief tutorial is designed to introduce the user to the
+capabilities of the CSound software synthesizer and sound synthesis in
+general.
+
+\paragraph{Additive Synthesis}
+\seclabel{add-syn}
+
+ The first part of the tutorial introduces \keyword{additive synthesis}.
+Additive synthesis is the most basic, yet the most powerful synthesis
+technique available, giving complete control over the sound waveform.
+The basic premiss behind additive sound synthesis is quite simple -- defining
+a complex sound by specifying each contributing sine wave. The computer is
+very good at generating pure tones, but these are not very interesting.
+However, any sound imaginable can be reproduced as a sum of pure tones. We
+can define an instrument of pure tones easily in Haskore. First we define
+a \keyword{Function table} containing a lone sine wave. We can do this using
+the \function{simpleSine} function defined in the \module{CSound.Orchestra} module:
+\begin{haskelllisting}
+
+> pureToneTN :: Score.Table
+> pureToneTN = 1
+> pureToneTable :: SigExp
+> pureToneTable = tableNumber pureToneTN
+> pureTone :: Score.Statement
+> pureTone = Score.Table pureToneTN 0 8192 True (compSine1 [1.0])
+
+> oscPure :: SigExp -> SigExp -> SigExp
+> oscPure = osc AR pureToneTable
+
+\end{haskelllisting}
+ \code{pureToneTN} is the table number of the simple sine wave. We will
+adopt the convention in this tutorial that variables ending with \code{TN}
+represent table numbers.
+ Recall that \function{compSine1} is defined in the module \module{CSound} as a
+sine wave generating routine (\refgen{10}). In order to have a complete
+score file, we also need a tune. Here is a simple example:
+\begin{haskelllisting}
+
+> type TutMelody params = Melody.T (TutAttr params)
+>
+> data TutAttr params =
+> TutAttr {attrVelocity :: Rational,
+> attrParameters :: params}
+>
+> tune1 :: TutMelody ()
+> tune1 = Music.line (map ($ TutAttr 1.5 ())
+> [ c 1 hn, e 1 hn, g 1 hn,
+> c 2 hn, a 1 hn, c 2 qn,
+> a 1 qn, g 1 dhn ] ++ [qnr])
+
+\end{haskelllisting}
+ The next step is to convert the melody into a music.
+In our simple tutorial we have only one instrument per song
+in all but one case.
+So we could skip this step,
+but we want to include it in order to show the general processing steps.
+We use the general data type for rhythmic music,
+with no drum definitions (null type \type{()})
+and a custom instrument definition \type{Instrument}.
+We use only the instrument numbers 1 and 2
+but the numbers are associated with different sounds in the examples.
+\begin{haskelllisting}
+
+> data Instrument =
+> Instr1p0
+> | Instr2p0
+> | Instr1p2 Float Float
+> | Instr1p4 Float Float Float Float
+> deriving (Eq, Ord, Show)
+>
+> musicFromMelody :: (params -> Instrument) ->
+> TutMelody params -> RhyMusic.T () Instrument
+> musicFromMelody instr =
+> Music.mapNote
+> (\(Melody.Note (TutAttr vel params) p) ->
+> RhyMusic.Note vel (RhyMusic.Tone (instr params) p))
+
+\end{haskelllisting}
+ The melody contains instrument specific parameters.
+They will be embedded in \type{Instrument} values
+by the following functions.
+These functions can be used as \code{instr} arguments
+to \function{musicFromMelody}.
+\begin{haskelllisting}
+
+> type Pair = (Float, Float)
+> type Quadruple = (Float, Float, Float, Float)
+>
+> attrToInstr1p0 :: () -> Instrument
+> attrToInstr1p0 () = Instr1p0
+>
+> attrToInstr2p0 :: () -> Instrument
+> attrToInstr2p0 () = Instr2p0
+>
+> attrToInstr1p2 :: Pair -> Instrument
+> attrToInstr1p2 = uncurry Instr1p2
+>
+> attrToInstr1p4 :: Quadruple -> Instrument
+> attrToInstr1p4 (x,y,z,w) = Instr1p4 x y z w
+
+\end{haskelllisting}
+ There is nothing special about the conversion
+from the music to the performance.
+\begin{haskelllisting}
+
+> performanceFromMusic :: RhyMusic.T () Instrument ->
+> Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument)
+> performanceFromMusic =
+> FancyPerformance.fromMusicModifyContext (Context.setDur 1)
+
+\end{haskelllisting}
+ Now we convert from the performance to the CSound score.
+To this end we must convert the instruments represented by \type{Instrument}
+to sound numbers and parameter fields.
+\begin{haskelllisting}
+
+> instrNum1, instrNum2 :: CSound.Instrument
+> instrNum1 = CSound.instrument 1
+> instrNum2 = CSound.instrument 2
+>
+> instrToNum :: Instrument -> ([CSound.PField], CSound.Instrument)
+> instrToNum (Instr1p0 ) = ([], instrNum1)
+> instrToNum (Instr2p0 ) = ([], instrNum2)
+> instrToNum (Instr1p2 x y ) = ([x,y], instrNum1)
+> instrToNum (Instr1p4 x y z w) = ([x,y,z,w], instrNum1)
+>
+> scoreFromPerformance ::
+> TutOrchestra out ->
+> Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) -> Score.T
+> scoreFromPerformance _ =
+> Score.fromRhythmicPerformanceMap
+> (error "no drum map defined") instrToNum
+
+\end{haskelllisting}
+
+ We want to provide some more type safety
+by distinction between sound expressions
+with different number of parameters.
+In our tutorial have sounds are controlled
+by three different numbers of parameters: 0, 2, and 4.
+These variants are unified with the data type \type{OutFunc}
+which let us also define a specialised orchestra.
+\begin{haskelllisting}
+
+> data OutFunc out =
+> OutFunc0 out
+> | OutFunc2 (SigExp -> SigExp -> out)
+> | OutFunc4 (SigExp -> SigExp -> SigExp -> SigExp -> out)
+>
+> type TutOrchestra out = (Orchestra.Header, [(CSound.Instrument, OutFunc out)])
+
+\end{haskelllisting}
+ This special data type allows us to check dynamically
+whether the number of arguments specified in the music
+match the parameters expected in the orchestra.
+So define \function{scoreFromPerformanceSafe},
+a safe variant of \function{scoreFromPerformance}.
+\begin{haskelllisting}
+
+> matchInstrOutFunc :: Instrument -> OutFunc out -> Bool
+> matchInstrOutFunc (Instr1p0 ) (OutFunc0 _) = True
+> matchInstrOutFunc (Instr2p0 ) (OutFunc0 _) = True
+> matchInstrOutFunc (Instr1p2 _ _ ) (OutFunc2 _) = True
+> matchInstrOutFunc (Instr1p4 _ _ _ _) (OutFunc4 _) = True
+> matchInstrOutFunc _ _ = False
+>
+> scoreFromPerformanceSafe ::
+> TutOrchestra out ->
+> Performance.T NonNeg.Float Float (RhyMusic.Note () Instrument) -> Score.T
+> scoreFromPerformanceSafe orc =
+> Score.fromRhythmicPerformanceMap (error "no drum map defined")
+> (\instr ->
+> let (params, num) = instrToNum instr
+> in maybe
+> (error ("CSound.Tutorial.scoreFromPerformance: " ++
+> "instrument with number " ++ show instr ++
+> " not in orchestra."))
+> (\outFunc ->
+> if matchInstrOutFunc instr outFunc
+> then (params, num)
+> else error ("CSound.Tutorial.scoreFromPerformance: " ++
+> "number of parameters of instrument " ++
+> show instr ++
+> " differ in instrMap and orchestra."))
+> (lookup num (snd orc)))
+
+\end{haskelllisting}
+
+The function \function{scored} puts
+the chain from melody to CSound score together.
+Finally the function \function{example} collects
+music and instrument definitions,
+that is a complete example.
+\begin{haskelllisting}
+
+> scored :: TutOrchestra out -> (params -> Instrument) ->
+> TutMelody params -> Score.T
+> scored orc instr =
+> scoreFromPerformanceSafe orc .
+> performanceFromMusic .
+> musicFromMelody instr
+>
+> example :: Name -> (TutOrchestra out -> Score.T) -> TutOrchestra out ->
+> (Name, Score.T, TutOrchestra out)
+> example name mkScore orc = (name, mkScore orc, orc)
+
+\end{haskelllisting}
+Let's define an instrument in the orchestra file that will use the function
+table \code{pureTone}:
+\begin{haskelllisting}
+
+> oe1 :: Mono
+> oe1 = let signal = oscPure (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> score1 orc = pureTone : scored orc attrToInstr1p0 tune1
+
+\end{haskelllisting}
+ This instrument will simply oscillate through the function table
+containing the sine wave at the appropriate frequency given by
+\code{notePit}, and the resulting sound will have an amplitude given by
+\code{noteVel}.
+Note that the \code{oe1} expression above is a \code{Mono}, not a complete
+\code{TutOrchestra}. We need to define a \keyword{header} and associate \code{oe1}
+with the instrument that's playing it:
+\begin{haskelllisting}
+
+> hdr :: Orchestra.Header
+> hdr = (44100, 4410)
+>
+> o1, o2, o3, o4, o7, o8, o9, o13, o14, o15, o19, o22
+> :: TutOrchestra Mono
+> o5, o6, o10, o11, o12, o16, o17, o18, o20, o21
+> :: TutOrchestra Stereo
+>
+> tut1, tut2, tut3, tut4, tut7, tut8, tut9, tut13, tut14, tut15, tut19, tut22
+> :: (Name, Score.T, TutOrchestra Mono)
+> tut5, tut6, tut10, tut11, tut12, tut16, tut17, tut18, tut20, tut21
+> :: (Name, Score.T, TutOrchestra Stereo)
+>
+> score1, score2, score3, score4, score5, score6, score7, score8, score9
+> :: TutOrchestra out -> [Score.Statement]
+>
+> o1 = let i = (instrNum1, OutFunc0 oe1)
+> in (hdr, [i])
+
+\end{haskelllisting}
+ The header above indicates that the audio signals are generated at
+44,100 Hz (CD quality), the control signals are generated at 4,410 Hz, and
+there are 2 output channels for stereo sound.
+ Now we have a complete score and orchestra that can be converted to a
+sound file by CSound and played as follows:
+\begin{haskelllisting}
+
+> csoundDir :: Name
+> csoundDir = "src/Test/CSound"
+> -- csoundDir = "C:/TEMP/csound"
+>
+> tut1 = example "tut01" score1 o1
+
+\end{haskelllisting}
+ If you listen to the tune, you will notice that it sounds very thin
+and uninteresting. Most musical sounds are not pure. Instead they usually
+contain a sine wave of dominant frequency, called a \keyword{fundamental}, and
+a number of other sine waves called \keyword{partials}. Partials with
+frequencies that are integer multiples of the fundamental are called
+\keyword{harmonics}. In musical terms, the first harmonic lies an octave above
+the fundamental, second harmonic a fifth above the first one, the third
+harmonic lies a major third above the second harmonic etc. This is the
+familiar \keyword{overtone series}. We can add harmonics to our sine wave
+instrument easily using the \function{compSine} function defined in the
+\module{CSound.Orchestra} module. The function takes a list of harmonic strengths as
+arguments. The following creates a function table containing the
+fundamental and the first two harmonics at two thirds and one third of the
+strength of the fundamental:
+\begin{haskelllisting}
+
+> twoHarmsTN :: Score.Table
+> twoHarmsTN = 2
+> twoHarms :: Score.Statement
+> twoHarms = Score.Table twoHarmsTN 0 8192 True (compSine1 [1.0, 0.66, 0.33])
+
+\end{haskelllisting}
+We can again proceed to create complete score and orchestra files as above:
+\begin{haskelllisting}
+
+> score2 orc = twoHarms : scored orc attrToInstr1p0 tune1
+>
+> oe2 :: Mono
+> oe2 = let signal = osc AR (tableNumber twoHarmsTN)
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o2 = let i = (instrNum1, OutFunc0 oe2)
+> in (hdr, [i])
+>
+> tut2 = example "tut02" score2 o2
+
+\end{haskelllisting}
+ The orchestra file is the same as before -- a single oscillator scanning
+a function table at a given frequency and volume. This time, however, the
+tune will not sound as thin as before since the table now contains a
+function that is an addition of three sine waves. (Note that the same effect
+could be achieved using a simple sine wave table and three oscillators).
+ Not all musical sounds contain harmonic partials exclusively, and
+never do we encounter instruments with static amplitude envelope like the
+ones we have seen so far. Most sounds, musical or not, evolve and change
+throughout their duration. Let's define an instrument containing both
+harmonic and nonharmonic partials, that starts at maximum amplitude with a
+straight line decay. We will use the function \function{compSine2} from the
+\module{CSound.Orchestra} module to create the function table. \function{compSine2} takes a
+list of triples as an argument. The triples specify the partial number as
+a multiple of the fundamental, relative partial strength, and initial phase
+offset:
+\begin{haskelllisting}
+
+> manySinesTN :: Score.Table
+> manySinesTN = 3
+> manySinesTable :: SigExp
+> manySinesTable = tableNumber manySinesTN
+> manySines :: Score.Statement
+> manySines = Score.Table manySinesTN 0 8192 True (compSine2 [(0.5, 0.9, 0.0),
+> (1.0, 1.0, 0.0), (1.1, 0.7, 0.0), (2.0, 0.6, 0.0),
+> (2.5, 0.3, 0.0), (3.0, 0.33, 0.0), (5.0, 0.2, 0.0)])
+
+\end{haskelllisting}
+ Thus this complex will contain the second, third, and fifth harmonic,
+nonharmonic partials at frequencies of 1.1 and 2.5 times the fundamental,
+and a component at half the frequency of the fundamental. Their strengths
+relative to the fundamental are given by the second argument, and they all
+start in sync with zero offset.
+ Now we can proceed as before to create score and orchestra files. We
+will define an \keyword{amplitude envelope} to apply to each note as we
+oscillate through the table. The amplitude envelope will be a straight line
+signal ramping from 1.0 to 0.0 over the duration of the note. This signal
+will be generated at \keyword{control rate} rather than audio rate, because the
+control rate is more than sufficient (the audio signal will change volume
+4,410 times a second), and the slower rate will improve performance.
+\begin{haskelllisting}
+
+> score3 orc = manySines : scored orc attrToInstr1p0 tune1
+>
+> oe3 :: Mono
+> oe3 = let ampEnv = lineCS CR 1.0 noteDur 0.0
+> signal = osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o3 = let i = (instrNum1, OutFunc0 oe3)
+> in (hdr, [i])
+>
+> tut3 = example "tut03" score3 o3
+
+\end{haskelllisting}
+ Not only do musical sounds usually evolve in terms of overall
+amplitude, they also evolve their \keyword{spectra}. In other words, the
+contributing partials do not usually all have the same amplitude envelope,
+and so their contribution to the overall sound isn't static. Let us
+illustrate the point using the same set of partials as in the above example.
+Instead of creating a table containing a complex waveform, however, we will
+use multiple oscillators going through the simple sine wave table we created
+at the beginning of this tutorial at the appropriate frequencies. Thus
+instead of the partials being fused together, each can have its own
+amplitude envelope, making the sound evolve over time. The score will be
+score1, defined above.
+\begin{haskelllisting}
+
+> oe4 :: Mono
+> oe4 = let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> mkLine t = lineSeg CR 0 (noteDur*t) 1 [(noteDur * (1-t), 0)]
+> aenv1 = lineCS CR 1 noteDur 0
+> aenv2 = mkLine 0.17
+> aenv3 = mkLine 0.33
+> aenv4 = mkLine 0.50
+> aenv5 = mkLine 0.67
+> aenv6 = mkLine 0.83
+> aenv7 = lineCS CR 0 noteDur 1
+> mkOsc ae p = oscPure (ae * amp) (pitch * p)
+> a1 = mkOsc aenv1 0.5
+> a2 = mkOsc aenv2 1.0
+> a3 = mkOsc aenv3 1.1
+> a4 = mkOsc aenv4 2.0
+> a5 = mkOsc aenv5 2.5
+> a6 = mkOsc aenv6 3.0
+> a7 = mkOsc aenv7 5.0
+> out = 0.5 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> in Mono out
+>
+> o4 = let i = (instrNum1, OutFunc0 oe4)
+> in (hdr, [i])
+>
+> tut4 = example "tut04" score1 o4
+
+\end{haskelllisting}
+ So far, we have only used function tables to generate audio signals,
+but they can come very handy in \keyword{modifying} signals. Let us create a
+function table that we can use as an amplitude envelope to make our
+instrument more interesting. The envelope will contain an immediate sharp
+attack and decay, and then a second, more gradual one, so we'll have two
+attack/decay events per note. We'll use the cubic spline curve generating
+routine to do this:
+\begin{haskelllisting}
+
+> coolEnvTN :: Score.Table
+> coolEnvTN = 4
+> coolEnvTable :: SigExp
+> coolEnvTable = tableNumber coolEnvTN
+> coolEnv :: Score.Statement
+> coolEnv = Score.Table coolEnvTN 0 8192 True
+> (cubicSpline 1 [(1692, 0.2), (3000, 1), (3500, 0)])
+
+> oscCoolEnv :: SigExp -> SigExp -> SigExp
+> oscCoolEnv = osc CR coolEnvTable
+
+\end{haskelllisting}
+ Let us also add some \keyword{p-fields} to the notes in our score. The two
+p-fields we add will be used for \keyword{panning} -- the first one will be the
+starting percentage of the left channel, the second one the ending
+percentage (1 means all left, 0 all right, 0.5 middle. Pfields of 1 and 0
+will cause the note to pan completely from left to right for example)
+\begin{haskelllisting}
+
+> tune2 :: TutMelody Pair
+> tune2 = let attr start end = TutAttr 1.4 (start, end)
+> in c 1 hn (attr 1.0 0.75) +:+
+> e 1 hn (attr 0.75 0.5) +:+
+> g 1 hn (attr 0.5 0.25) +:+
+> c 2 hn (attr 0.25 0.0) +:+
+> a 1 hn (attr 0.0 1.0) +:+
+> c 2 qn (attr 0.0 0.0) +:+
+> a 1 qn (attr 1.0 1.0) +:+
+> (g 1 dhn (attr 1.0 0.0) =:=
+> g 1 dhn (attr 0.0 1.0))+:+ qnr
+
+\end{haskelllisting}
+ So far we have limited ourselves to using only sine waves for our
+audio output, even though Csound places no such restrictions on us. Any
+repeating waveform, of any shape, can be used to produce pitched sounds.
+In essence, when we are adding sinewaves, we are changing the shape of the
+wave. For example, adding odd harmonics to a fundamental at strengths equal
+to the inverse of their partial number (ie. third harmonic would be 1/3 the
+strength of the fundamental, fifth harmonic 1/5 the fundamental etc) would
+produce a \keyword{square} wave which has a raspy sound to it. Another common
+waveform is the \keyword{sawtooth}, and the more mellow sounding \keyword{triangle}.
+The \module{CSound.Orchestra} module already contains functions to create these common
+waveforms. Let's use them to create tables that we can use in an instrument:
+\begin{haskelllisting}
+
+> triangleTN, squareTN, sawtoothTN :: Score.Table
+> triangleTN = 5
+> squareTN = 6
+> sawtoothTN = 7
+> triangleT, squareT, sawtoothT :: Score.Statement
+> triangleT = triangle triangleTN
+> squareT = square squareTN
+> sawtoothT = sawtooth sawtoothTN
+>
+> score4 orc = squareT : triangleT : sawtoothT : coolEnv :
+> scored orc attrToInstr1p2 (Music.changeTempo 0.5 tune2)
+>
+> oe5 :: SigExp -> SigExp -> Stereo
+> oe5 panStart panEnd =
+> let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> pan = lineCS CR panStart noteDur panEnd
+> oscF = 1 / noteDur
+> ampen = oscCoolEnv amp oscF
+> signal = osc AR (tableNumber squareTN) ampen pitch
+> left = signal * pan
+> right = signal * (1-pan)
+> in Stereo left right
+>
+> o5 = let i = (instrNum1, OutFunc2 oe5)
+> in (hdr, [i])
+>
+> tut5 = example "tut05" score4 o5
+
+\end{haskelllisting}
+ This will oscillate through a table containing the square wave.
+Check out the other waveforms too and see what they sound like. This can be
+done by specifying the table to be used in the orchestra file.
+ As our last example of additive synthesis, we will introduce an
+orchestra with multiple instruments. The bass will be mostly in the left
+channel, and will be the same as the third example instrument in this
+section. It will play the tune two octaves below the instrument in the right
+channel, using an orchestra identical to \code{oe3} with the addition of the
+panning feature:
+\begin{haskelllisting}
+
+> score5 orc = manySines : pureTone : scored orc attrToInstr1p0 tune1 ++
+> scored orc attrToInstr2p0 tune1
+>
+> oe6 :: Stereo
+> oe6 = let ampEnv = lineCS CR 1.0 noteDur 0.0
+> signal = osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz (notePit - 2))
+> left = 0.8 * signal
+> right = 0.2 * signal
+> in Stereo left right
+>
+> oe7 :: Stereo
+> oe7 = let pitch = pchToHz notePit
+> amp = dbToAmp noteVel
+> mkLine t = lineSeg CR 0 (noteDur*t) 0.5 [(noteDur * (1-t), 0)]
+> aenv1 = lineCS CR 0.5 noteDur 0
+> aenv2 = mkLine 0.17
+> aenv3 = mkLine 0.33
+> aenv4 = mkLine 0.50
+> aenv5 = mkLine 0.67
+> aenv6 = mkLine 0.83
+> aenv7 = lineCS CR 0 noteDur 0.5
+> mkOsc ae p = oscPure (ae * amp) (pitch * p)
+> a1 = mkOsc aenv1 0.5
+> a2 = mkOsc aenv2 1.0
+> a3 = mkOsc aenv3 1.1
+> a4 = mkOsc aenv4 2.0
+> a5 = mkOsc aenv5 2.5
+> a6 = mkOsc aenv6 3.0
+> a7 = mkOsc aenv7 5.0
+> left = 0.2 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> right = 0.8 * (a1 + a2 + a3 + a4 + a5 + a6 + a7)
+> in Stereo left right
+>
+> o6 = let i1 = (instrNum1, OutFunc0 oe6)
+> i2 = (instrNum2, OutFunc0 oe7)
+> in (hdr, [i1, i2])
+>
+> tut6 = example "tut06" score5 o6
+
+\end{haskelllisting}
+ Additive synthesis is the most powerful tool in computer music and
+sound synthesis in general. It can be used to create any sound imaginable,
+whether completely synthetic or a simulation of a real-world sound, and
+everyone interested in using the computer to synthesize sound should be well
+versed in it. The most significant drawback of additive synthesis is that it
+requires huge amounts of control data, and potentially thousands of
+oscillators. There are other synthesis techniques, such as
+\keyword{modulation synthesis}, that can be used to create rich and interesting
+timbres at a fraction of the cost of additive synthesis, though no other
+synthesis technique provides quite the same degree of control.
+
+\paragraph{Modulation Synthesis}
+\seclabel{mod-syn}
+
+ While additive synthesis provides full control and great flexibility,
+it is quiet clear that the enormous amounts of control data make it
+impractical for even moderately complicated sounds. There is a class of
+synthesis techniques that use \keyword{modulation} to produce rich, time-varying
+timbres at a fraction of the storage and time cost of additive synthesis.
+The basic idea behind modulation synthesis is controlling the
+amplitude and/or frequency of the main periodic signal, called the
+\keyword{carrier}, by another periodic signal, called the \keyword{modulator}.
+The two main kinds of modulation synthesis are \keyword{amplitude modulation}
+and \keyword{frequency modulation} synthesis. Let's start our discussion with
+the simpler one of the two -- amplitude synthesis.
+ We have already shown how to supply a time varying amplitude envelope
+to an oscillator. What would happen if this amplitude envelope was itself
+an oscillating signal? Supplying a low frequency ($<20$Hz) modulating signal
+would create a predictable effect -- we would hear the volume of the carrier
+signal go periodically up and down. However, as the modulator moves into the
+audible frequency range, the carrier changes timbre as new frequencies
+appear in the spectrum. The new frequencies are equal to the sum and
+difference of the carrier and modulator. So for example, if the frequency of
+the main signal (carrier) is C = 500Hz, and the frequency of the modulator
+is M = 100Hz, the audible frequencies will be the carrier C (500Hz),
+C + M (600Hz), and C - M (400Hz). The amplitude of the two new sidebands
+depends on the amplitude of the modulator, but will never exceed half the
+amplitude of the carrier.
+ The following is a simple example that demonstrates amplitude
+modulation. The carrier will be a 10 second pure tone at 500Hz. The
+frequency of the modulator will increase linearly over the 10 second
+duration of the tone from 0 to 200 Hz. Initially, you will be able to hear
+the volume of the signal fluctuate, but after a couple of seconds the volume
+will seem constant as new frequencies appear.
+ Let us first create the score file. It will contain a sine wave table,
+and a single note event:
+\begin{haskelllisting}
+
+> score6 _ =
+> pureTone : [ Score.Note instrNum1 0.0 10.0 (Cps 500.0) 10000.0 [] ]
+
+\end{haskelllisting}
+ The orchestra will contain a single AM instrument. The carrier will
+simply oscillate through the sine wave table at frequency given by the note
+pitch (500Hz, see the score above), and amplitude given by the modulator.
+The modulator will oscillate through the same sine wave table at frequency
+ramping from 0 to 200Hz. The modulator should be a periodic signal that
+varies from 0 to the maximum volume of the carrier. Since the sine wave goes
+from -1 to 1, we will need to add 1 to it and half it, before multiplying it
+by the volume supplied by the note event. This will be the modulating
+signal, and the carrier's amplitude input. (note that we omit the conversion
+functions dbToAmp and notePit, since we supply the amplitude and frequency
+in their raw units in the score file)
+\begin{haskelllisting}
+
+> oe8 :: Mono
+> oe8 = let modFreq = lineCS CR 0.0 noteDur 200.0
+> modAmp = oscPure 1.0 modFreq
+> modSig = (modAmp + 1.0) * 0.5 * noteVel
+> carrier = oscPure modSig notePit
+> in Mono carrier
+>
+> o7 = let i = (instrNum1, OutFunc0 oe8)
+> in (hdr, [i])
+>
+> tut7 = example "tut07" score6 o7
+
+\end{haskelllisting}
+ Next synthesis technique on the palette is \keyword{frequency modulation}.
+As the name suggests, we modulate the frequency of the carrier. Frequency
+modulation is much more powerful and interesting than amplitude modulation,
+because instead of getting two sidebands, FM gives a {\em number} of
+spectral sidebands. Let us begin with an example of a simple FM. We will
+again use a single 10 second note and a 500Hz carrier. Remember that when we
+talked about amplitude modulation, the amplitude of the sidebands was
+dependent upon the amplitude of the modulator. In FM, the modulator
+amplitude plays a much bigger role, as we will see soon. To negate the
+effect of the modulator amplitude, we will keep the ratio of the modulator
+amplitude and frequency constant at 1.0 (we will explain shortly why). The
+frequency and amplitude of the modulator will ramp from 0 to 200 over the
+duration of the note. This time, though, unlike with AM, we will hear a
+whole series of sidebands. The orchestra is just as before, except we
+modulate the frequency instead of amplitude.
+\begin{haskelllisting}
+
+> oe9 :: Mono
+> oe9 = let modFreq = lineCS CR 0.0 noteDur 200.0
+> modAmp = modFreq
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure noteVel (notePit + modSig)
+> in Mono carrier
+>
+> o8 = let i = (instrNum1, OutFunc0 oe9)
+> in (hdr, [i])
+>
+> tut8 = example "tut08" score6 o8
+
+\end{haskelllisting}
+ The sound produced by FM is a little richer but still very bland. Let
+us talk now about the role of the \keyword{depth} of the frequency modulation
+(the amplitude of the modulator). Unlike in AM, where we only had one
+spectral band on each side of the carrier frequency (ie we heard C, C+M,
+C-M), FM gives a much richer spectrum with many sidebands. The frequencies
+we hear are C, C+M, C-M, C+2M, C-2M, C+3M, C-3M etc. The amplitudes of the
+sidebands are determined by the \keyword{modulation index} I, which is the ratio
+between the amplitude (also referred to as depth) and frequency of the
+modulator (I = D / M). As a rule of thumb, the number of significant
+sideband pairs (at least 1% the volume of the carrier) is I+1. As I (and the
+number of sidebands) increases, energy is "stolen" from the carrier and
+distributed among the sidebands. Thus if I=1, we have 2 significant sideband
+pairs, and the audible frequencies will be C, C+M, C-M, C+2M, C-2M, with C,
+the carrier, being the dominant frequency. When I=5, we will have a much
+richer sound with about 6 significant sideband pairs, some of which will
+actually be louder than the carrier. Let us explore the effect of the
+modulation index in the following example. We will keep the frequency of
+the carrier and the modulator constant at 500Hz and 80 Hz respectively.
+The modulation index will be a stepwise function from 1 to 10, holding each
+value for one second. So in effect, during the first second (I = D/M = 1),
+the amplitude of the modulator will be the same as its frequency (80).
+During the second second (I = 2), the amplitude will be double the frequency
+(160), then it will go to 240, 320, etc:
+\begin{haskelllisting}
+
+> oe10 :: Mono
+> oe10 = let modInd = lineSeg CR 1 1 1 [(0,2), (1,2), (0,3), (1,3), (0,4),
+> (1,4), (0,5), (1,5), (0,6), (1,6),
+> (0,7), (1,7), (0,8), (0,9), (1,9),
+> (0,10), (1,10)]
+> modAmp = 80.0 * modInd
+> modSig = oscPure modAmp 80.0
+> carrier = oscPure noteVel (notePit + modSig)
+> in Mono carrier
+>
+> o9 = let i = (instrNum1, OutFunc0 oe10)
+> in (hdr, [i])
+>
+> tut9 = example "tut09" score6 o9
+
+\end{haskelllisting}
+ Notice that when the modulation index gets high enough, some of the
+sidebands have negative frequencies. For example, when the modulation index
+is 7, there is a sideband present in the sound with a frequency
+C - 7M = 500 - 560 = -60Hz. The negative sidebands get reflected back into
+the audible spectrum but are \keyword{phase shifted} 180 degrees, so it is an
+inverse sine wave. This makes no difference when the wave is on its own, but
+when we add it to its inverse, the two will cancel out. Say we set the
+frequency of the carrier at 100Hz instead of 80Hz. Then at I=6, we would
+have present two sidebands of the same frequency - C-4M = 100Hz, and
+C-6M = -100Hz. When these two are added, they would cancel each other out
+(if they were the same amplitude; if not, the louder one would be attenuated
+by the amplitude of the softer one). The following flexible instrument will
+sum up simple FM. The frequency of the modulator will be determined by the
+C/M ratio supplied as p6 in the score file. The modulation index will be a
+linear slope going from 0 to p7 over the duration of each note. Let us also
+add panning control as in additive synthesis - p8 will be the initial left
+channel percentage, and p9 the final left channel percentage:
+\begin{haskelllisting}
+
+> oe11 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo
+> oe11 modFreqRatio modIndEnd panStart panEnd =
+> let carFreq = pchToHz notePit
+> carAmp = dbToAmp noteVel
+> modFreq = carFreq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure carAmp (carFreq + modSig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * carrier
+> right = mainAmp * (1 - pan) * carrier
+> in Stereo left right
+>
+> o10 = let i = (instrNum1, OutFunc4 oe11)
+> in (hdr, [i])
+
+\end{haskelllisting}
+ Let's write a cool tune to show off this instrument. Let's keep it
+simple and play the chord progression Em - C - G - D a few times, each time
+changing some of the parameters:
+\begin{haskelllisting}
+
+> emChord, cChord, gChord, dChord ::
+> Float -> Float -> Float -> Float ->
+> TutMelody Quadruple
+>
+> quickChord ::
+> [Music.Dur -> TutAttr Quadruple -> TutMelody Quadruple] ->
+> Float -> Float -> Float -> Float ->
+> TutMelody Quadruple
+> quickChord ns x y z w = Music.chord $
+> map (\p -> p wn (TutAttr 1.4 (x, y, z, w))) ns
+>
+> emChord = quickChord [e 0, g 0, b 0]
+> cChord = quickChord [c 0, e 0, g 0]
+> gChord = quickChord [g 0, b 0, d 1]
+> dChord = quickChord [d 0, fs 0, a 0]
+>
+> tune3 :: TutMelody Quadruple
+> tune3 =
+> Music.transpose (-12) $
+> emChord 3.0 2.0 0.0 1.0 +:+ cChord 3.0 5.0 1.0 0.0 +:+
+> gChord 3.0 8.0 0.0 1.0 +:+ dChord 3.0 12.0 1.0 0.0 +:+
+> emChord 3.0 4.0 0.0 0.5 +:+ cChord 5.0 4.0 0.5 1.0 +:+
+> gChord 8.0 4.0 1.0 0.5 +:+ dChord 10.0 4.0 0.5 0.0 +:+
+> (emChord 4.0 6.0 1.0 0.0 =:= emChord 7.0 5.0 0.0 1.0) +:+
+> (cChord 5.0 9.0 1.0 0.0 =:= cChord 9.0 5.0 0.0 1.0) +:+
+> (gChord 5.0 5.0 1.0 0.0 =:= gChord 7.0 7.0 0.0 1.0) +:+
+> (dChord 2.0 3.0 1.0 0.0 =:= dChord 7.0 15.0 0.0 1.0)
+
+\end{haskelllisting}
+ Now we can create a score. It will contain two wave tables -- one
+containing the sine wave, and the other containing an amplitude envelope,
+which will be the table coolEnv which we have already seen before
+\begin{haskelllisting}
+
+> score7 orc = pureTone : coolEnv :
+> scored orc attrToInstr1p4 (Music.changeTempo 0.5 tune3)
+>
+> tut10 = example "tut10" score7 o10
+
+\end{haskelllisting}
+ Note that all of the above examples of frequency modulation use a
+single carrier and a single modulator, and both are oscillating through the
+simplest of waveforms -- a sine wave. Already we have achieved some very rich
+and interesting timbres using this simple technique, but the possibilities
+are unlimited when we start using different carrier and modulator waveshapes
+and multiple carriers and/or modulators. Let us include a couple more
+examples that will play the same chord progression as above with multiple
+carriers, and then with multiple modulators.
+ The reason for using multiple carriers is to obtain
+{/em formant regions} in the spectrum of the sound. Recall that when we
+modulate a carrier frequency we get a spectrum with a central peak and a
+number of sidebands on either side of it. Multiple carriers introduce
+additional peaks and sidebands into the composite spectrum of the resulting
+sound. These extra peaks are called formant regions, and are characteristic
+of human voice and most musical instruments
+\begin{haskelllisting}
+
+> oe12 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo
+> oe12 modFreqRatio modIndEnd panStart panEnd =
+> let car1Freq = pchToHz notePit
+> car2Freq = pchToHz (notePit + 1)
+> car1Amp = dbToAmp noteVel
+> car2Amp = dbToAmp noteVel * 0.7
+> modFreq = car1Freq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier1 = oscPure car1Amp (car1Freq + modSig)
+> carrier2 = oscPure car2Amp (car2Freq + modSig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * (carrier1 + carrier2)
+> right = mainAmp * (1 - pan) * (carrier1 + carrier2)
+> in Stereo left right
+>
+> o11 = let i = (instrNum1, OutFunc4 oe12)
+> in (hdr, [i])
+>
+> tut11 = example "tut11" score7 o11
+
+\end{haskelllisting}
+ In the above example, there are two formant regions -- one is centered
+around the note pitch frequency provided by the score file, the other an
+octave above. Both are modulated in the same way by the same modulator. The
+sound is even richer than that obtained by simple FM.
+ Let us now turn to multiple modulator FM. In this case, we use a
+signal to modify another signal, and the modified signal will itself become
+a modulator acting on the carrier. Thus the wave that wil be modulating the
+carrier is not a sine wave as above, but is itself a complex waveform
+resulting from simple FM. The spectrum of the sound will contain a central
+peak frequency, surrounded by a number of sidebands, but this time each
+sideband will itself also by surrounded by a number of sidebands of its own.
+So in effect we are talking about "double" modulation, where each sideband
+is a central peak in its own little spectrum. Multiple modulator FM thus
+provides extremely rich spectra
+\begin{haskelllisting}
+
+> oe13 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo
+> oe13 modFreqRatio modIndEnd panStart panEnd =
+> let carFreq = pchToHz notePit
+> carAmp = dbToAmp noteVel
+> mod1Freq = carFreq * modFreqRatio
+> mod2Freq = mod1Freq * 2.0
+> modInd = lineCS CR 0 noteDur modIndEnd
+> mod1Amp = mod1Freq * modInd
+> mod2Amp = mod1Amp * 3.0
+> mod1Sig = oscPure mod1Amp mod1Freq
+> mod2Sig = oscPure mod2Amp (mod2Freq + mod1Sig)
+> carrier = oscPure carAmp (carFreq + mod2Sig)
+> mainAmp = oscCoolEnv 1.0 (1/noteDur)
+> pan = lineCS CR panStart noteDur panEnd
+> left = mainAmp * pan * carrier
+> right = mainAmp * (1 - pan) * carrier
+> in Stereo left right
+>
+> o12 = let i = (instrNum1, OutFunc4 oe13)
+> in (hdr, [i])
+>
+> tut12 = example "tut12" score7 o12
+
+\end{haskelllisting}
+ In fact, the spectra produced by multiple modulator FM are so rich and
+complicated that even the moderate values used as arguments in our tune
+produce spectra that are saturated and otherworldly. And we did this while
+keeping the ratios of the two modulators frequencies and amplitudes
+constant; introducing dynamics in those ratios would produce even crazier
+results. It is quite amazing that from three simple sine waves, the purest
+of all tones, we can derive an unlimited number of timbres. Modulation
+synthesis is a very powerful tool and understanding how to use it can prove
+invaluable. The best way to learn how to use FM effectively is to dabble and
+experiment with different ratios, formant regions, dynamic relationships
+betweeen ratios, waveshapes, etc. The possibilities are limitless.
+
+\paragraph{Other Capabilities Of CSound}
+\seclabel{other}
+
+ In our examples of additive and modulation synthesis we only used a
+limited number of functions and routines provided us by CSound, such as
+Osc (oscillator), Line and LineSig (line and line segment signal
+generators) etc. This tutorial intends to briefly explain the
+functionality of some of the other features of CSound. Remember that the
+CSound manual should be the ultimate reference when it comes to using
+these functions.
+ Let us start with the two functions \function{buzz} and \function{genBuzz}.
+These functions will produce a set of harmonically related cosines. Thus
+they really implement simple additive synthesis, except that the number of
+partials can be varied dynamically through the duration of the note,
+rather than staying fixed as in simple additive synthesis. As an example,
+let us perform the tune defined at the very beginning of the tutorial using
+an instrument that will play each note by starting off with the fundamental
+and 70 harmonics, and ending with simply the sine wave fundamental (note
+that cosine and sine waves sound the same). We will use a straight line
+signal going from 70 to 0 over the duration of each note for the number of
+harmonics. The score used will be score1, and the orchestra will be:
+\begin{haskelllisting}
+
+> oe14 :: Mono
+> oe14 = let numharms = lineCS CR 70 noteDur 0
+> signal = buzz pureToneTable numharms
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o13 = let i = (instrNum1, OutFunc0 oe14)
+> in (hdr, [i])
+>
+> tut13 = example "tut13" score1 o13
+
+\end{haskelllisting}
+ Let's invert the line of the harmonics, and instead of going from 70
+to 0, make it go from 0 to 70. This will produce an interesting effect
+quite different from the one just heard:
+\begin{haskelllisting}
+
+> oe15 :: Mono
+> oe15 = let numharms = lineCS CR 0 noteDur 70
+> signal = buzz pureToneTable numharms
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o14 = let i = (instrNum1, OutFunc0 oe15)
+> in (hdr, [i])
+>
+> tut14 = example "tut14" score1 o14
+
+\end{haskelllisting}
+ The \function{buzz} expression takes the overall amplitude, fundamental
+frequency, number of partials, and a sine wave table and generates a
+wave complex.
+ In recent years there has been a lot of research conducted in the
+area of \keyword{physical modelling}. This technique attempts to approximate the
+sound of real world musical instruments through mathematical models. One
+of the most widespread, versatile and interesting of these models is the
+\keyword{Karplus-Strong algorithm} that simulates the sound of a plucked string.
+The algorithm starts off with a buffer containing a user-determined
+waveform. On every pass, the waveform is "smoothed out" and flattened by the
+algorithm to simulate the decay. There is a certain degree of randomness
+involved to make the string sound more natural.
+ There are six different "smoothing methods" available in CSound, as
+mentioned in the CSound module. The \function{pluck} constructor accepts the note
+volume, pitch, the table number that is used to initialize the buffer, the
+smoothing method used, and two parameters that depend on the smoothing
+method. If zero is given as the initializing table number, the buffer starts
+off containing a random waveform (white noise). This is the best table when
+simulating a string instrument because of the randomness and percussive
+attack it produces when used with this algorithm, but you should experiment
+with other waveforms as well.
+ Here is an example of what Pluck sounds like with a white noise buffer
+and the simple smoothing method. This method ignores the parameters, which we
+set to zero.
+\begin{haskelllisting}
+
+> oe16 :: Mono
+> oe16 = let signal = pluck 0 (pchToHz notePit)
+> PluckSimpleSmooth
+> (dbToAmp noteVel) (pchToHz notePit)
+> in Mono signal
+>
+> o15 = let i = (instrNum1, OutFunc0 oe16)
+> in (hdr, [i])
+>
+> tut15 = example "tut15" score1 o15
+
+\end{haskelllisting}
+ The second smoothing method is the \keyword{stretched smooth}, which works
+like the simple smooth above, except that the smoothing process is stretched
+by a factor determined by the first parameter. The second parameter is
+ignored. The third smoothing method is the \keyword{snare drum} method. The
+first parameter is the "roughness" parameter, with 0 resulting in a sound
+identical to simple smooth, 0.5 being the perfect snare drum, and 1.0 being
+the same as simple smooth again with reversed polarity (like a graph flipped
+around the x-axis). The fourth smoothing method is the \keyword{stretched drum}
+method which combines the roughness and stretch factors -- the first parameter
+is the roughness, the second is the stretch. The fifth method is
+\keyword{weighted average} -- it combines the current sample (ie. the current pass
+through the buffer) with the previous one, with their weights being determined
+by the parameters. This is a way to add slight reverb to the plucked sound.
+Finally, the last method filters the sound so it doesn't sound as bright.
+The parameters are ignored. You can modify the instrument \code{oe16} easily
+to listen to all these effects by simply replacing the variable
+\function{simpleSmooth} by \function{stretchSmooth, simpleDrum, stretchDrum,
+weightedSmooth} or \function{filterSmooth}.
+ Here is another simple instrument example. This combines a snare drum
+sound with a stretched plucked string sound. The snare drum as a constant
+amplitude, while we apply an amplitude envelope to the string sound. The
+envelope is a spline curve with a hump in the middle, so both the attack and
+decay are gradual. The drum roughness factor is 0.3, so a pitch is still
+discernible (with a factor of 0.5 we would get a snare drum sound with no
+pitch, just a puff of white noise). The drum sound is shifted towards the left
+channel, while the string sound is shifted towards the right.
+\begin{haskelllisting}
+
+> midHumpTN :: Score.Table
+> midHumpTN = 8
+> midHump :: Score.Statement
+> midHump = Score.Table midHumpTN 0 8192 True
+> (cubicSpline 0.0 [(4096, 1.0), (4096, 0.0)])
+>
+> score8 orc = pureTone : midHump : scored orc attrToInstr1p0 tune1
+>
+> oe17 :: Stereo
+> oe17 = let string = pluck 0 (pchToHz notePit)
+> (PluckStretchSmooth 1.5)
+> (dbToAmp noteVel) (pchToHz notePit)
+> drum = pluck 0 (pchToHz notePit)
+> (PluckSimpleDrum 0.3)
+> 6000 (pchToHz notePit)
+> ampEnv = osc CR (tableNumber midHumpTN) 1.0 (1 / noteDur)
+> left = (0.65 * drum) + (0.35 * ampEnv * string)
+> right = (0.35 * drum) + (0.65 * ampEnv * string)
+> in Stereo left right
+>
+> o16 = let i = (instrNum1, OutFunc0 oe17)
+> in (hdr, [i])
+>
+> tut16 = example "tut16" score8 o16
+
+\end{haskelllisting}
+
+ Let us now turn our attention to the effects we can achieve using a
+\keyword{delay line}.
+Let's define a simple percussive instrument.
+It's strong attack let us easily perceive the reverberation.
+
+\begin{haskelllisting}
+
+> ping :: SigExp
+> ping =
+> let ampEnv = expon CR 1.0 1.0 (1/100)
+> in osc AR manySinesTable
+> (ampEnv * dbToAmp noteVel) (pchToHz notePit)
+
+\end{haskelllisting}
+
+There is still the problem,
+that subsequent notes truncate preceding ones.
+This would suppress the reverb.
+In order to avoid this
+we add a \keyword{legato} effect to the music.
+That is we prolong the notes such that they overlap.
+
+\begin{haskelllisting}
+
+> score9 orc = manySines : scored orc attrToInstr1p0 (Music.legato 1 tune1)
+
+\end{haskelllisting}
+
+Here we take the ping sound and add a little echo to it using delay:
+\begin{haskelllisting}
+
+> oe18 :: Stereo
+> oe18 = let dping1 = Orchestra.delay 0.05 ping
+> dping2 = Orchestra.delay 0.1 ping
+> left = (0.65 * ping) + (0.35 * dping2) + (0.5 * dping1)
+> right = (0.35 * ping) + (0.65 * dping2) + (0.5 * dping1)
+> in Stereo left right
+>
+> o17 = let i = (instrNum1, OutFunc0 oe18)
+> in (hdr, [i])
+>
+> tut17 = example "tut17" score9 o17
+
+\end{haskelllisting}
+ The constructor \function{delay} establishes a \keyword{delay line}. A delay
+line is essentially a buffer that contains the signal to be delayed. The first
+argument to the \function{delay} constructor is the length of the delay (which
+determines the size of the buffer), and the second argument is the signal to
+be delayed. So for example, if the delay time is 1.0 seconds, and the sampling
+rate is 44,100 Hz (CD quality), then the delay line will be a buffer containing
+44,100 samples of the delayed signal. The buffer is rewritten at the audio
+rate. Once \code{Delay t sig} writes t seconds of the signal \code{sig} into the
+buffer, the buffer can be \keyword{tapped} using the \function{delTap} or the
+\function{delTapI} constructors. \code{delTap t dline} will extract the signal from
+\code{dline} at time \code{t} seconds. In the exmaple above, we set up a delay
+line containing 0.1 seconds of the audio signal, then we tapped it twice -- once
+at 0.05 seconds and once at 0.1 seconds. The output signal is a combination of
+the original signal (left channel), the signal delayed by 0.05 seconds
+(middle), and the signal delayed by 0.1 seconds (right channel).
+ CSound provides other ways to reverberate a signal besides the delay
+line just demonstrated. One such way is achieved via the Reverb constructor
+introduced in the \module{CSound.Orchestra} module. This constructor tries to emulate
+natural room reverb, and takes as arguments the signal to be reverberated, and
+the reverb time in seconds. This is the time it takes the signal to decay to
+1/1000 its original amplitude. In this example we output both the original and
+the reverberated sound.
+\begin{haskelllisting}
+
+> oe19 :: Stereo
+> oe19 = let rev = reverb 0.3 ping
+> left = (0.65 * ping) + (0.35 * rev)
+> right = (0.35 * ping) + (0.65 * rev)
+> in Stereo left right
+>
+> o18 = let i = (instrNum1, OutFunc0 oe19)
+> in (hdr, [i])
+>
+> tut18 = example "tut18" score9 o18
+
+\end{haskelllisting}
+ The other two reverb functions are \function{comb} and \function{alpass}. Each
+of these requires as arguments the signal to be reverberated, the reverb time
+as above, and echo loop density in seconds. Here is an example of an instrument
+using \function{comb}.
+\begin{haskelllisting}
+
+> oe20 :: Mono
+> oe20 = Mono (comb 0.22 4.0 ping)
+>
+> o19 = let i = (instrNum1, OutFunc0 oe20)
+> in (hdr, [i])
+>
+> tut19 = example "tut19" score9 o19
+
+\end{haskelllisting}
+ Delay lines can be used for effects other than simple echo and
+reverberation. Once the delay line has been established, it can be tapped at
+times that vary at control or audio rates. This can be taken advantage of to
+produce effects like chorus, flanger, or the Doppler effect. Here is an
+example of the flanger effect. This instrument adds a slight flange to
+\code{oe11}.
+\begin{haskelllisting}
+
+> oe21 :: SigExp -> SigExp -> SigExp -> SigExp -> Stereo
+> oe21 modFreqRatio modIndEnd panStart panEnd =
+> let carFreq = pchToHz notePit
+> ampEnv = oscCoolEnv 1.0 (1/noteDur)
+> carAmp = dbToAmp noteVel * ampEnv
+> modFreq = carFreq * modFreqRatio
+> modInd = lineCS CR 0 noteDur modIndEnd
+> modAmp = modFreq * modInd
+> modSig = oscPure modAmp modFreq
+> carrier = oscPure carAmp (carFreq + modSig)
+> ftime = oscPure (1/10) 2
+> flanger = ampEnv * vdelay 1 (0.5 + ftime) carrier
+> signal = carrier + flanger
+> pan = lineCS CR panStart noteDur panEnd
+> left = pan * signal
+> right = (1 - pan) * signal
+> in Stereo left right
+>
+> o20 = let i = (instrNum1, OutFunc4 oe21)
+> in (hdr, [i])
+>
+> tut20 = example "tut20" score7 o20
+
+\end{haskelllisting}
+
+The last two examples use generic delay lines.
+That is we do not rely on special echo effects but build our own ones
+by delaying a signal, filtering it by low pass or high pass filters
+and feeding the result back to the delay function.
+\begin{haskelllisting}
+
+> lowPass, highPass :: EvalRate -> SigExp -> SigExp -> SigExp
+> lowPass rate cutOff sig = sigGen "tone" rate 1 [sig, cutOff]
+> highPass rate cutOff sig = sigGen "atone" rate 1 [sig, cutOff]
+
+> oe22 :: Stereo
+> oe22 = let left = rec (\x -> ping + lowPass AR 500 (Orchestra.delay 0.311 x))
+> right = rec (\x -> ping + highPass AR 1000 (Orchestra.delay 0.271 x))
+> in Stereo left right
+>
+> o21 = let i = (instrNum1, OutFunc0 oe22)
+> in (hdr, [i])
+>
+> tut21 = example "tut21" score9 o21
+
+> oe23 :: Mono
+> oe23 = let rev = rec (\x -> ping +
+> 0.7 * (lowPass AR 500 (Orchestra.delay 0.311 x)
+> + highPass AR 1000 (Orchestra.delay 0.271 x)))
+> in Mono rev
+>
+> o22 = let i = (instrNum1, OutFunc0 oe23)
+> in (hdr, [i])
+>
+> tut22 = example "tut22" score9 o22
+
+\end{haskelllisting}
+
+This completes our discussion of sound synthesis and Csound. For more
+information, please consult the CSound manual or check out
+
+\url{http://mitpress.mit.edu/e-books/csound/frontpage.html}
+
+The function \function{applyOutFunc} applies
+sound expression function to the expressions
+which represent the parameter fields from 6 on.
+These are the fields where the additional instrument parameters
+are put by \function{CSound.Score.statementToWords}.
+\begin{haskelllisting}
+
+> test :: Output out => (Name, Score.T, TutOrchestra out) -> IO ()
+> test = play csoundDir
+>
+> applyOutFunc :: OutFunc out -> out
+> applyOutFunc (OutFunc0 o) = o
+> applyOutFunc (OutFunc2 o) = o p6 p7
+> applyOutFunc (OutFunc4 o) = o p6 p7 p8 p9
+>
+> toOrchestra :: Output out => TutOrchestra out -> Orchestra.T out
+> toOrchestra (hd, instrs) =
+> Orchestra.Cons hd (map (\(i, out) ->
+> InstrBlock i 0 (applyOutFunc out) []) instrs)
+>
+> play :: Output out =>
+> FilePath -> (Name, Score.T, TutOrchestra out) -> IO ()
+> play dir (name, s, o') =
+> let scorename = name ++ ".sco"
+> orchname = name ++ ".orc"
+> -- wavename = name ++ ".wav"
+> o = toOrchestra o'
+> -- (Orchestra.Cons (rate, _) _) = o
+> in do writeFile (dir++"/"++scorename) (Score.toString s)
+> writeFile (dir++"/"++orchname) (Orchestra.toString o)
+> {-
+> system ("cd "++dir++" ; csound32 -d -W -o "
+> ++ wavename ++ " " ++ orchname ++ " " ++ scorename
+> ++ " ; play " ++ wavename)
+> -}
+> system ("cd "++dir++" ; csound32 -d -A -o stdout -s "
+> ++ orchname ++ " " ++ scorename
+> ++ " | play -t aiff -")
+> {-
+> system ("cd "++dir++" ; csound32 -d -o stdout -s "
+> ++ orchname ++ " " ++ scorename
+> ++ " | play -r " ++ show rate ++ " -t sw -")
+> -}
+> {-
+> system ("cd "++dir++" ; csound32 -d -o dac " -- /dev/dsp makes some chaotic noise
+> ++ orchname ++ " " ++ scorename)
+> -}
+> {-
+> system (dir ++ "/csound.exe -W -o " ++ wavename
+> ++ " " ++ orchname ++ " " ++ scorename)
+> -}
+> return ()
+
+\end{haskelllisting}
+
+Here are some bonus instruments for your pleasure and enjoyment.
+The first ten instruments are lifted from
+
+\url{http://wings.buffalo.edu/academic/department/AandL/music/pub/accci/01/01_01_1b.txt.html}
+
+The tutorial explains how to add echo/reverb and other effects to the
+instruments if you need to. This instrument sounds like an electric piano and
+is really simple -- \function{pianoEnv} sets the amplitude envelope, and the sound
+waveform is just a series of 10 harmonics. To make the sound brighter,
+increase the weight of the upper harmonics.
+
+\begin{haskelllisting}
+
+> piano, reedy, flute
+> :: (Name, Score.T, TutOrchestra Mono)
+
+> pianoOrc, reedyOrc, fluteOrc
+> :: TutOrchestra Mono
+
+> pianoScore, reedyScore, fluteScore :: TutOrchestra out -> Score.T
+> pianoEnv, reedyEnv, fluteEnv,
+> pianoWave, reedyWave, fluteWave :: Score.Statement
+> pianoEnvTN, reedyEnvTN, fluteEnvTN,
+> pianoWaveTN, reedyWaveTN, fluteWaveTN :: Score.Table
+> pianoEnvTable, reedyEnvTable, fluteEnvTable,
+> pianoWaveTable, reedyWaveTable, fluteWaveTable :: SigExp
+
+> pianoEnvTN = 10; pianoEnvTable = tableNumber pianoEnvTN
+> pianoWaveTN = 11; pianoWaveTable = tableNumber pianoWaveTN
+>
+> pianoEnv = Score.Table pianoEnvTN 0 1024 True (lineSeg1 0 [(20, 0.99),
+> (380, 0.4), (400, 0.2), (224, 0)])
+> pianoWave = Score.Table pianoWaveTN 0 1024 True (compSine1 [0.158, 0.316,
+> 1.0, 1.0, 0.282, 0.112, 0.063, 0.079, 0.126, 0.071])
+>
+> pianoScore orc = pianoEnv : pianoWave : scored orc attrToInstr1p0 tune1
+>
+> pianoOE :: Mono
+> pianoOE = let ampEnv = osc CR pianoEnvTable (dbToAmp noteVel) (1/noteDur)
+> signal = osc AR pianoWaveTable ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> pianoOrc = let i = (instrNum1, OutFunc0 pianoOE)
+> in (hdr, [i])
+>
+> piano = example "piano" pianoScore pianoOrc
+
+\end{haskelllisting}
+
+Here is another instrument with a reedy sound to it
+
+\begin{haskelllisting}
+
+> reedyEnvTN = 12; reedyEnvTable = tableNumber reedyEnvTN
+> reedyWaveTN = 13; reedyWaveTable = tableNumber reedyWaveTN
+>
+> reedyEnv = Score.Table reedyEnvTN 0 1024 True (lineSeg1 0 [(172, 1.0),
+> (170, 0.8), (170, 0.6), (170, 0.7), (170, 0.6), (172,0)])
+> reedyWave = Score.Table reedyWaveTN 0 1024 True (compSine1 [0.4, 0.3,
+> 0.35, 0.5, 0.1, 0.2, 0.15, 0.0, 0.02, 0.05, 0.03])
+>
+> reedyScore orc = reedyEnv : reedyWave : scored orc attrToInstr1p0 tune1
+>
+> reedyOE :: Mono
+> reedyOE = let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur)
+> signal = osc AR reedyWaveTable ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> reedyOrc = let i = (instrNum1, OutFunc0 reedyOE)
+> in (hdr, [i])
+>
+> reedy = example "reedy" reedyScore reedyOrc
+
+\end{haskelllisting}
+
+We can use a little trick to make it sound like several reeds playing by
+adding three signals that are slightly out of tune:
+
+\begin{haskelllisting}
+
+> reedy2OE :: Stereo
+> reedy2OE = let ampEnv = osc CR reedyEnvTable (dbToAmp noteVel) (1/noteDur)
+> freq = pchToHz notePit
+> reedyOsc = osc AR reedyWaveTable
+> a1 = reedyOsc ampEnv freq
+> a2 = reedyOsc (ampEnv * 0.44) (freq + (0.023 * freq))
+> a3 = reedyOsc (ampEnv * 0.26) (freq + (0.019 * freq))
+> left = (a1 * 0.5) + (a2 * 0.35) + (a3 * 0.65)
+> right = (a1 * 0.5) + (a2 * 0.65) + (a3 * 0.35)
+> in Stereo left right
+>
+> reedy2Orc :: TutOrchestra Stereo
+> reedy2Orc = let i = (instrNum1, OutFunc0 reedy2OE)
+> in (hdr, [i])
+>
+> reedy2 :: (Name, Score.T, TutOrchestra Stereo)
+> reedy2 = example "reedy2" reedyScore reedy2Orc
+
+\end{haskelllisting}
+
+This instrument tries to emulate a flute sound by introducing random
+variations to the amplitude envelope. The score file passes in two
+parameters -- the first one is the depth of the random tremolo in percent of
+total amplitude. The tremolo is implemented using the \function{randomI} function,
+which generates a signal that interpolates between 2 random numbers over a
+certain number of samples that is specified by the second parameter.
+
+\begin{haskelllisting}
+
+> fluteTune :: TutMelody Pair
+>
+> fluteTune = Music.line
+> (map ($ TutAttr 1.6 (30, 40))
+> [c 1 hn, e 1 hn, g 1 hn, c 2 hn,
+> a 1 hn, c 2 qn, a 1 qn, g 1 dhn]
+> ++ [qnr])
+>
+>
+> fluteEnvTN = 14; fluteEnvTable = tableNumber fluteEnvTN
+> fluteWaveTN = 15; fluteWaveTable = tableNumber fluteWaveTN
+>
+> fluteEnv = Score.Table fluteEnvTN 0 1024 True (lineSeg1 0 [(100, 0.8),
+> (200, 0.9), (100, 0.7), (300, 0.2), (324, 0.0)])
+> fluteWave = Score.Table fluteWaveTN 0 1024 True (compSine1 [1.0, 0.4,
+> 0.2, 0.1, 0.1, 0.05])
+>
+> fluteScore orc = fluteEnv : fluteWave : scored orc attrToInstr1p2 fluteTune
+>
+> fluteOE :: SigExp -> SigExp -> Mono
+> fluteOE depth numSam =
+> let vol = dbToAmp noteVel
+> rand = randomI AR numSam (vol/100 * depth)
+> ampEnv = oscI AR fluteEnvTable
+> (rand + vol) (1 / noteDur)
+> signal = oscI AR fluteWaveTable
+> ampEnv (pchToHz notePit)
+> in Mono signal
+>
+> fluteOrc = let i = (instrNum1, OutFunc2 fluteOE)
+> in (hdr, [i])
+>
+> flute = example "flute" fluteScore fluteOrc
+
+\end{haskelllisting}
+
+Dirty hacks are going on here
+in order to pass the Phoneme values through all functions.
+
+\begin{haskelllisting}
+
+> voice' :: SigExp -> SigExp -> SigExp -> SigExp ->
+> SigExp -> SigExp -> SigExp -> SigExp -> SigExp
+> voice' vibWave wave gain vibAmp vibFreq amp freq phoneme =
+> sigGen "voice" AR 1
+> [amp, freq, phoneme, gain, vibFreq, vibAmp, wave, vibWave]
+
+> data Phoneme =
+> Eee | Ihh | Ehh | Aaa |
+> Ahh | Aww | Ohh | Uhh |
+> Uuu | Ooo | Rrr | Lll |
+> Mmm | Nnn | Nng | Ngg |
+> Fff | Sss | Thh | Shh |
+> Xxx | Hee | Hoo | Hah |
+> Bbb | Ddd | Jjj | Ggg |
+> Vvv | Zzz | Thz | Zhh
+> deriving (Show, Eq, Ord, Enum)
+
+> voiceTune :: TutMelody Pair
+> voiceTune = Music.line
+> (map (\(n,ph) ->
+> n (TutAttr 1 (fromIntegral (fromEnum ph), 2)))
+> [(c 1 hn, Aaa), (e 1 hn, Ehh), (g 1 hn, Ohh), (c 2 hn, Ehh),
+> (a 1 hn, Eee), (c 2 qn, Aww), (a 1 qn, Aww), (g 1 dhn, Aaa)]
+> ++ [qnr])
+>
+>
+> voiceVibWaveTN, voiceWaveTN :: Score.Table
+> voiceVibWaveTable, voiceWaveTable :: SigExp
+> voiceVibWaveTN = 14; voiceVibWaveTable = tableNumber voiceVibWaveTN
+> voiceWaveTN = 15; voiceWaveTable = tableNumber voiceWaveTN
+>
+> voiceWave, voiceVibWave :: Score.Statement
+> voiceWave = Score.Table voiceWaveTN 0 1024 True
+> (let width = 50
+> in lineSeg1 0 [(width, 1), (width, 0), (1024-2*width, 0)])
+> voiceVibWave = Score.Table voiceVibWaveTN 0 1024 True (compSine1 [1.0, 0.4])
+>
+> voiceScore :: TutOrchestra out -> Score.T
+> voiceScore orc =
+> voiceVibWave : voiceWave : scored orc attrToInstr1p2 voiceTune
+>
+> voiceOE :: SigExp -> SigExp -> Mono
+> voiceOE phoneme gain =
+> let vol = dbToAmp noteVel
+> signal = voice' voiceVibWaveTable voiceWaveTable
+> gain (3/100) 5 vol (pchToHz notePit) phoneme
+> in Mono signal
+>
+> voiceOrc :: TutOrchestra Mono
+> voiceOrc = let i = (instrNum1, OutFunc2 voiceOE)
+> in (hdr, [i])
+>
+> voice :: (Name, Score.T, TutOrchestra Mono)
+> voice = example "voice" voiceScore voiceOrc
+
+\end{haskelllisting}
+
diff --git a/src/Haskore/Interface/MED/Text.hs b/src/Haskore/Interface/MED/Text.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MED/Text.hs
@@ -0,0 +1,146 @@
+{- |
+Import Music from text printed by OctaMED.
+It will be certainly easy to adapt that for other trackers
+like SoundTracker, NoiseTracker, DigiBooster, FastTracker.
+
+Take care that you use B not H note name.
+-}
+module Haskore.Interface.MED.Text where
+
+import qualified Haskore.Basic.Pitch as Pitch
+import qualified Haskore.Music as Music
+import qualified Haskore.Melody as Melody
+
+import qualified Haskore.Process.Format as Fmt
+
+import qualified Text.ParserCombinators.Parsec.Combinator as ParseComb
+import qualified Text.ParserCombinators.Parsec.Char as Parse
+import Text.ParserCombinators.Parsec.Char (CharParser)
+import Text.ParserCombinators.Parsec.Prim ((<|>), parse)
+
+import Haskore.General.Utility (splitBy)
+import Haskore.Basic.Duration((%+))
+import Data.Char (ord)
+import Data.Maybe (isJust)
+import qualified Data.List as List
+import Control.Monad.State
+
+
+{- | should be moved to Utility -}
+sieve :: Int -> [a] -> [a]
+sieve k = map head . takeWhile (not . null) . iterate (drop k)
+
+{- | should be moved to Utility -}
+sliceHoriz :: Int -> [a] -> [[a]]
+sliceHoriz n =
+ map (sieve n) . take n . iterate (drop 1)
+
+{- | should be moved to Utility -}
+sliceVert :: Int -> [a] -> [[a]]
+sliceVert n =
+ map (take n) . takeWhile (not . null) . iterate (drop n)
+
+type Instrument = Int
+
+
+splitBlocks ::
+ [String]
+ -> [[String]]
+splitBlocks =
+ map (takeWhile (not . List.isPrefixOf "\f") . tail) .
+ filter ((replicate 33 '=' ==) . head) .
+ List.init .
+ List.tails
+
+
+cellToNote :: String -> (Maybe (Pitch.T,Instrument), String)
+cellToNote =
+ either (error . show) id . parse parseCell "cell"
+
+parseDigit :: CharParser () Int
+parseDigit =
+ fmap (\c -> ord c - ord '0') Parse.digit
+
+parseNote :: CharParser () (Maybe (Pitch.T,Instrument))
+parseNote =
+ (do pitchClass <-
+ liftM2 (\ bc m -> read(bc:m))
+ (Parse.satisfy (\p -> 'A' <= p && p <= 'G'))
+ ((Parse.char '-' >> return "") <|>
+ (Parse.char '#' >> return "s"))
+ octave <- parseDigit
+ instr <-
+ liftM2 (\ instrH instrL -> instrH*32+instrL)
+ ((Parse.char ' ' >> return 0) <|>
+ parseDigit)
+ (parseDigit <|>
+ (fmap (\c -> ord c - ord 'A' + 10)
+ (Parse.satisfy (\p -> 'A' <= p && p <= 'V'))))
+ return (Just ((octave,pitchClass), instr)))
+ <|>
+ (do Parse.char '-'
+ ParseComb.count 4 ParseComb.anyToken
+ return Nothing)
+
+parseCell :: CharParser () (Maybe (Pitch.T,Instrument), String)
+parseCell =
+ liftM2 (,) parseNote (ParseComb.count 4 ParseComb.anyToken)
+
+
+columnToNotes ::
+ [String]
+ -> ([String], [(Pitch.T, Instrument, [String])])
+columnToNotes cells =
+ let notes = splitBy (isJust . fst) . map cellToNote $ cells
+ procNote ((Just (pitch,instr), cmd) : rest) =
+ (pitch, instr, cmd : map snd rest)
+ procNote _ = error "each note must start with Just"
+ in case notes of
+ pause@((Nothing, _) : _) : rest ->
+ (map snd pause, map procNote rest)
+ _ -> ([], map procNote notes)
+
+{- |
+Convert a block of a song to a list of notes.
+-}
+linesToNotes ::
+ [String] {- ^ lines of a block -}
+ -> [([String], [(Pitch.T, Instrument, [String])])]
+linesToNotes =
+ map columnToNotes . List.transpose . map (sliceVert 10 . drop 4)
+
+
+
+
+columnToSimpleSerial ::
+ Integer
+ -> ([String], [(Pitch.T, Instrument, [String])])
+ -> ShowS
+columnToSimpleSerial whole (rest, melody) =
+ (if null rest
+ then id
+ else Fmt.rest 5 (List.genericLength rest %+ whole) . showString " : ") .
+ foldr (.)
+ (showString "[]")
+ (map
+ (\(pitch,_instr,cmds) ->
+ Fmt.note 5
+ (List.genericLength cmds %+ whole)
+ (Melody.Note () pitch) .
+ showString " : ")
+ melody)
+
+{-
+mapM print . map (map (($"") . columnToSimpleSerial 16) . linesToNotes) . splitBlocks . lines =<< readFile "/data2/AmigaEnvironment/Partitions/Data/Songs/Meine/Air.1.txt"
+-}
+
+
+{-
+Convert a block of a song to Music.
+
+blockToMusic ::
+ Int {- ^ length of a whole note -}
+ -> String {- ^ textual representation of a block -}
+ -> [[(Pitch.T, Instrument, [String])]]
+blockToMusic whole text =
+-}
diff --git a/src/Haskore/Interface/MIDI.lhs b/src/Haskore/Interface/MIDI.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI.lhs
@@ -0,0 +1,14 @@
+
+> module Haskore.Interface.MIDI
+> (module Sound.MIDI.File,
+> module Haskore.Interface.MIDI.Read,
+> module Haskore.Interface.MIDI.Write,
+> module Sound.MIDI.File.Load,
+> module Sound.MIDI.File.Save)
+> where
+>
+> import Sound.MIDI.File
+> import Haskore.Interface.MIDI.Read
+> import Haskore.Interface.MIDI.Write
+> import Sound.MIDI.File.Load
+> import Sound.MIDI.File.Save
diff --git a/src/Haskore/Interface/MIDI/InstrumentMap.lhs b/src/Haskore/Interface/MIDI/InstrumentMap.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI/InstrumentMap.lhs
@@ -0,0 +1,178 @@
+\subsubsection{Instrument map}
+\seclabel{user-patch-map}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.MIDI.InstrumentMap where
+
+> import Haskore.Music.Standard(Instr)
+> import qualified Sound.MIDI.Message.Channel as ChannelMsg
+> import qualified Sound.MIDI.General as GeneralMidi
+
+> import Haskore.General.Utility(flipPair)
+> import qualified Haskore.General.Map as Map
+> import Data.Char(toLower)
+> import Data.Maybe(fromMaybe)
+> import qualified Data.List as List
+
+\end{haskelllisting}
+
+A \type{InstrumentMap.ChannelProgramTable} is a user-supplied table for mapping instrument
+names (\type{Instr}s) to Midi channels and General Midi patch names.
+The patch names are by default General Midi names, although the user
+can also provide a \type{PatchMap} for mapping Patch Names to
+unconventional Midi Program Change numbers.
+\begin{haskelllisting}
+
+> type ChannelTable instr =
+> [(instr, ChannelMsg.Channel)]
+> type ChannelProgramTable instr =
+> [(instr, (ChannelMsg.Channel, ChannelMsg.Program))]
+> type ChannelProgramPitchTable instr =
+> [(instr, (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch))]
+>
+> type ToChannel instr =
+> instr -> ChannelMsg.Channel
+> type ToChannelProgram instr =
+> instr -> (ChannelMsg.Channel, ChannelMsg.Program)
+> type ToChannelProgramPitch instr =
+> instr -> (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch)
+>
+> type FromChannel instr =
+> ChannelMsg.Channel -> Maybe instr
+> type FromChannelProgram instr =
+> (ChannelMsg.Channel, ChannelMsg.Program) -> Maybe instr
+> type FromChannelProgramPitch instr =
+> (ChannelMsg.Channel, ChannelMsg.Program, ChannelMsg.Pitch) -> Maybe instr
+
+\end{haskelllisting}
+
+The \function{allValid} is used to test whether or not every instrument
+in a list is found in a \type{InstrumentMap.ChannelProgramTable}.
+
+\begin{haskelllisting}
+
+> repair :: [Instr] -> ChannelProgramTable Instr -> ChannelProgramTable Instr
+> repair insts pMap =
+> if allValid pMap insts
+> then pMap
+> else tableFromInstruments insts
+>
+> allValid :: ChannelProgramTable Instr -> [Instr] -> Bool
+> allValid upm = all (\x -> any (partialMatch x . fst) upm)
+
+\end{haskelllisting}
+
+If a Haskore user only uses General Midi instrument names as
+\type{Instr}s, we can define a function that automatically creates a
+\type{InstrumentMap.ChannelProgramTable} from these names. Note that, since there are only 15
+Midi channels plus percussion, we can handle only 15 instruments.
+Perhaps in the future a function could be written to test whether or
+not two tracks can be combined with a Program Change (tracks can be
+combined if they don't overlap).
+\begin{haskelllisting}
+
+> tableFromInstruments :: [Instr] -> ChannelProgramTable Instr
+> tableFromInstruments instrs =
+> zip instrs (assignChannels GeneralMidi.instrumentChannels instrs)
+> -- 10th channel (#9) is for percussion
+
+> assignChannels :: [ChannelMsg.Channel] -> [Instr] ->
+> [(ChannelMsg.Channel, ChannelMsg.Program)]
+> assignChannels _ [] = []
+> assignChannels [] _ =
+> error "Too many instruments; not enough MIDI channels."
+> assignChannels chans@(c:cs) (i:is) =
+> let percList = ["percussion", "perc", "drum", "drums"]
+> in if map toLower i `elem` percList
+> then (GeneralMidi.drumChannel, GeneralMidi.drumProgram)
+> : assignChannels chans is
+> else (c, fromMaybe
+> (error ("unknown instrument <<" ++ i ++ ">>"))
+> (GeneralMidi.instrumentNameToProgram i))
+> : assignChannels cs is
+
+> fromInstruments :: Ord instr => [instr] -> ToChannel instr
+> fromInstruments instrs =
+> let fm = Map.fromList (zip instrs GeneralMidi.instrumentChannels)
+> in Map.findWithDefault fm (error "More instruments than channels")
+
+\end{haskelllisting}
+
+The following functions lookup \type{Instr}s in \type{InstrumentMap.ChannelProgramTable}s to
+recover channel and program change numbers.
+Note that the function that does string matching ignores case,
+and that instrument name and search pattern match
+if one is a prefix of the other one.
+For example, \code{"chur"} matches \code{"Church Organ"}. Note also
+that the {\em first} match succeeds, so using a substring should be
+done with care to be sure that the correct instrument is selected.
+\begin{haskelllisting}
+
+> partialMatch :: Instr -> Instr -> Bool
+> partialMatch "piano" "Acoustic Grand Piano" = True
+> partialMatch s1 s2 =
+> let s1' = map toLower s1
+> s2' = map toLower s2
+> in all (uncurry (==)) (zip s1' s2')
+>
+> lookupIName :: [(Instr, a)] -> Instr -> a
+> lookupIName ys x =
+> maybe (error ("InstrumentMap.lookupIName: Instrument " ++ x ++ " unknown"))
+> snd (List.find (partialMatch x . fst) ys)
+>
+> lookup :: Eq instr => [(instr, a)] -> instr -> a
+> lookup ys x =
+> fromMaybe (error ("InstrumentMap.lookup: Instrument unknown"))
+> (List.lookup x ys)
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> reverseLookupMaybe :: Eq a => [(instr, a)] -> a -> Maybe instr
+> reverseLookupMaybe ys x =
+> List.lookup x (map flipPair ys)
+
+> reverseLookup :: Eq a => [(instr, a)] -> a -> instr
+> reverseLookup ys x =
+> let instr = reverseLookupMaybe ys x
+> err = error "InstrumentMap.reverseLookup: channel+program not found"
+> in fromMaybe err instr
+
+\end{haskelllisting}
+
+A default \type{InstrumentMap.ChannelProgramTable}.
+Note: the PC sound card I'm using is limited to 9 instruments.
+
+\begin{haskelllisting}
+
+> defltTable :: [(Instr, ChannelMsg.Channel, GeneralMidi.Instrument)]
+> defltTable =
+> map (\(instr,chan,gmInstr) -> (instr, ChannelMsg.toChannel chan, gmInstr))
+> [("piano", 1, GeneralMidi.AcousticGrandPiano),
+> ("vibes", 2, GeneralMidi.Vibraphone),
+> ("bass", 3, GeneralMidi.AcousticBass),
+> ("flute", 4, GeneralMidi.Flute),
+> ("sax", 5, GeneralMidi.TenorSax),
+> ("guitar", 6, GeneralMidi.AcousticGuitarSteel),
+> ("violin", 7, GeneralMidi.Viola),
+> ("violins", 8, GeneralMidi.StringEnsemble1),
+> ("drums", 9, GeneralMidi.AcousticGrandPiano)]
+> -- the GM name for drums is unimportant, only channel 9
+
+> deflt :: ChannelProgramTable Instr
+> deflt =
+> map (\(iName, chan, gmName) ->
+> (iName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable
+
+> defltGM :: ChannelProgramTable GeneralMidi.Instrument
+> defltGM =
+> map (\(_, chan, gmName) ->
+> (gmName, (chan, GeneralMidi.instrumentToProgram gmName))) defltTable
+
+> defltCMap :: [(GeneralMidi.Instrument, ChannelMsg.Channel)]
+> defltCMap =
+> map (\(_, chan, gmName) -> (gmName, chan)) defltTable
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/MIDI/Note.lhs b/src/Haskore/Interface/MIDI/Note.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI/Note.lhs
@@ -0,0 +1,154 @@
+
+A MIDI note is an interim data structure
+which shall be stored in a \type{Performance.BackEnd.T} list of events.
+It stores each note as a single record,
+that is it is not split into note-on and note-off.
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.MIDI.Note where
+
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import qualified Sound.MIDI.General as GeneralMidi
+> import qualified Sound.MIDI.Message.Channel as ChannelMsg
+> import qualified Sound.MIDI.Message.Channel.Voice as Voice
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Basic.Pitch as Pitch
+> import Haskore.General.Utility (limit, toMaybe)
+> import qualified Data.List as List
+
+> data T =
+> Cons {
+> velocityOn :: ChannelMsg.Velocity,
+> velocityOff :: ChannelMsg.Velocity,
+> channel :: ChannelMsg.Channel,
+> program :: ChannelMsg.Program,
+> pitch :: ChannelMsg.Pitch
+> }
+
+\end{haskelllisting}
+
+You can convert a MidiNote from and to a pair of MIDI events.
+This is used in \module{MIDI.Read} and \module{MIDI.Write}, respectively.
+\begin{haskelllisting}
+
+> fromMIDIEvents :: (ChannelMsg.T, ChannelMsg.T) -> Maybe T
+> fromMIDIEvents
+> (ChannelMsg.Cons c0 (ChannelMsg.Voice (Voice.NoteOn p0 v0)),
+> ChannelMsg.Cons c1 (ChannelMsg.Voice (Voice.NoteOff p1 v1))) =
+> let progErr = error ("program depends on channel settings - " ++
+> "still not determined")
+> in toMaybe (c0 == c1 && p0 == p1)
+> (Cons v0 v1 c0 progErr p0)
+> fromMIDIEvents _ = Nothing
+
+> toMIDIEvents :: T -> (ChannelMsg.T, ChannelMsg.T)
+> toMIDIEvents note =
+> let chan = channel note
+> p = pitch note
+> vOn = velocityOn note
+> vOff = velocityOff note
+> me0 = ChannelMsg.Cons chan (ChannelMsg.Voice (Voice.NoteOn p vOn))
+> me1 = ChannelMsg.Cons chan (ChannelMsg.Voice (Voice.NoteOff p vOff))
+> in (me0, me1)
+
+\end{haskelllisting}
+
+A MidiNote can be constructed from several kinds of notes.
+Here are two instances for notes of generic rhythmic music
+and General MIDI notes.
+These converters are also the functions
+where the maps from instrument types to MIDI programs go into.
+The first set of functions is need for writing MIDI files.
+\begin{haskelllisting}
+
+> fromRhyNote :: RealFrac dyn =>
+> InstrMap.ToChannelProgramPitch drum ->
+> InstrMap.ToChannelProgram instr ->
+> dyn -> Pitch.Relative -> RhyMusic.Note drum instr -> T
+> fromRhyNote dMap iMap dyn trans (RhyMusic.Note vel body) =
+> let velMidi = velocityFromStd dyn vel
+> in case body of
+> RhyMusic.Tone instr p ->
+> let (chan, prog) = iMap instr
+> in Cons velMidi velMidi
+> chan prog (pitchFromStd trans p)
+> RhyMusic.Drum drum ->
+> let (chan, prog, key) = dMap drum
+> in Cons velMidi velMidi chan prog key
+
+> fromGMNote :: RealFrac dyn =>
+> InstrMap.ToChannel MidiMusic.Instr ->
+> dyn -> Pitch.Relative -> MidiMusic.Note -> T
+> fromGMNote iMap =
+> fromRhyNote
+> (\drum -> (GeneralMidi.drumChannel,
+> GeneralMidi.drumProgram,
+> GeneralMidi.drumToKey drum))
+> (\instr -> (iMap instr, Voice.toProgram (fromEnum instr)))
+
+> velocityFromStd :: RealFrac dyn =>
+> dyn -> Rational -> Voice.Velocity
+> velocityFromStd dyn vel =
+> Voice.toVelocity $
+> round (limit (0, Voice.maximumVelocity)
+> (dyn * fromRational vel * Voice.normalVelocity))
+
+> pitchFromStd :: Pitch.Relative -> Pitch.T -> Voice.Pitch
+> pitchFromStd trans p =
+> -- MIDI pitch is in range because of range checks on Pitch construction
+> Voice.increasePitch (Pitch.toInt p + trans) Voice.zeroKey
+
+\end{haskelllisting}
+
+The second set of functions is need for reading MIDI files.
+\begin{haskelllisting}
+
+> toRhyNote ::
+> InstrMap.FromChannelProgramPitch drum ->
+> InstrMap.FromChannelProgram instr ->
+> T -> RhyMusic.Note drum instr
+> toRhyNote dMap iMap (Cons v _ ch prog mp) =
+> let drum = dMap (ch, prog, mp)
+> instr = iMap (ch, prog)
+> in RhyMusic.Note (velocityToStd v)
+> (case (drum,instr) of
+> (Nothing, Nothing) ->
+> error "MidiNote.toRhyNote: channel+program not found"
+> (Just _, Just _) ->
+> error "MidiNote.toRhyNote: note can be drum or instrument"
+> (Just drum', Nothing) ->
+> RhyMusic.Drum drum'
+> (Nothing, Just instr') ->
+> RhyMusic.Tone instr' (pitchToStd mp))
+
+> toGMNote :: T -> MidiMusic.Note
+> toGMNote =
+> toRhyNote
+> (\(ch, _, mp) ->
+> toMaybe (ch==GeneralMidi.drumChannel)
+> (GeneralMidi.drumFromKey mp))
+> (\(ch, prog) ->
+> toMaybe (ch/=GeneralMidi.drumChannel)
+> (GeneralMidi.instrumentFromProgram prog))
+
+\end{haskelllisting}
+
+Load the velocity.
+This shouldn't be mixed up with the volume.
+The volume which is controlled by the MIDI Volume controller
+simply scales the signal
+whereas the velocity is an instrument specific value
+that corresponds to the intensity with which the instrument is played.
+
+\begin{haskelllisting}
+
+> velocityToStd :: Fractional a => Voice.Velocity -> a
+> velocityToStd x =
+> fromIntegral (Voice.fromVelocity x) / Voice.normalVelocity
+
+> pitchToStd :: Voice.Pitch -> Pitch.T
+> pitchToStd p = Pitch.fromInt (Voice.subtractPitch Voice.zeroKey p)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/MIDI/Read.lhs b/src/Haskore/Interface/MIDI/Read.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI/Read.lhs
@@ -0,0 +1,433 @@
+\subsubsection{Reading Midi files}
+\seclabel{Haskore.Interface.MIDI.Read}
+
+Now that we have translated a raw Midi file into a \code{MidiFile.T} data type,
+we can translate that \code{MidiFile.T} into a \code{MidiMusic.T} object.
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.MIDI.Read (toRhyMusic, toGMMusic,
+> {- debugging -} retrieveTracks)
+> where
+>
+> import qualified Haskore.Interface.MIDI.Note as MidiNote
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import Sound.MIDI.File as MidiFile
+> import qualified Sound.MIDI.File.Event as MidiFileEvent
+> import qualified Sound.MIDI.File.Event.Meta as MetaEvent
+> import qualified Sound.MIDI.Message.Channel as ChannelMsg
+> import qualified Sound.MIDI.Message.Channel.Voice as Voice
+> import qualified Sound.MIDI.General as GeneralMidi
+> import Sound.MIDI.File.Event (T(MIDIEvent, MetaEvent), ElapsedTime, )
+> import Sound.MIDI.File.Event.Meta (T(SetTempo), ElapsedTime, Tempo, defltST, defltDurT, )
+> import Sound.MIDI.Message.Channel (Body(Voice), Channel, )
+> import Sound.MIDI.Message.Channel.Voice (Program, )
+>
+> import Haskore.Basic.Duration ((%+))
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.MixedBody as TimeList
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.BackEnd as PfBE
+> import qualified Haskore.Performance.Default as DefltPf
+> import qualified Haskore.Process.Optimization as Optimization
+
+> import qualified Numeric.NonNegative.Class as NonNeg
+
+> import Haskore.Music
+> (line, chord, changeTempo, Dur, DurRatio)
+> import Haskore.General.Utility (mapPair, mapSnd, )
+> import qualified Haskore.General.Utility as Utility
+>
+> import Haskore.General.Map (Map)
+> import qualified Haskore.General.Map as Map
+> import Data.Maybe (mapMaybe, fromMaybe)
+
+\end{haskelllisting}
+
+The main function.
+Note that we need drum and instrument maps
+in order to restore a \code{Context.T}
+as well as a \code{RhyMusic.T} object.
+\begin{haskelllisting}
+
+> toRhyMusic ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> InstrMap.ChannelProgramPitchTable drum ->
+> InstrMap.ChannelProgramTable instr ->
+> MidiFile.T ->
+> (Context.T time dyn (RhyMusic.Note drum instr), RhyMusic.T drum instr)
+> toRhyMusic dMap iMap mf@(MidiFile.Cons _ d trks) =
+> let cpm = makeCPM trks
+> m = Music.mapNote
+> (MidiNote.toRhyNote
+> (InstrMap.reverseLookupMaybe dMap)
+> (InstrMap.reverseLookupMaybe iMap))
+> (format (readFullTrack d cpm) (MidiFile.explicitNoteOff mf))
+> in (context, m)
+
+> toGMMusic ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> MidiFile.T -> (InstrMap.ChannelTable MidiMusic.Instr,
+> Context.T time dyn MidiMusic.Note, MidiMusic.T)
+> toGMMusic mf@(MidiFile.Cons _ d trks) =
+> let cpm = makeCPM trks
+> upm = map (\(ch, progNum) ->
+> (GeneralMidi.instrumentFromProgram progNum, ch))
+> (Map.toList cpm)
+> m = Music.mapNote MidiNote.toGMNote
+> (format (readFullTrack d cpm)
+> (MidiFile.explicitNoteOff mf))
+> in (upm, context, m)
+
+> context ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Context.T time dyn note
+> context =
+> Context.setPlayer DefltPf.player $
+> Context.setDur 1 $
+> DefltPf.context
+
+> retrieveTracks :: MidiFile.T -> [[MidiMusic.T]]
+> retrieveTracks (MidiFile.Cons _ d trks) =
+> let cpm = makeCPM trks
+> in map (map (Music.mapNote MidiNote.toGMNote
+> . readTrack (tDiv d) cpm . fst)
+> . prepareTrack) trks
+
+> type ChannelProgramMap = Map ChannelMsg.Channel Voice.Program
+
+> readFullTrack ::
+> Division -> ChannelProgramMap -> Track -> Music.T MidiNote.T
+> readFullTrack dv cpm =
+> let readTempoTrack (t,r) =
+> changeTempo r (readTrack (tDiv dv) cpm t)
+> in Optimization.all . line . map readTempoTrack . prepareTrack
+
+> prepareTrack :: Track -> [(RichTrack, DurRatio)]
+> prepareTrack =
+> map (extractTempo defltST) . segmentBeforeSetTempo .
+> mergeNotes defltST . moveTempoToHead
+
+\end{haskelllisting}
+
+Make one big music out of the individual tracks of a MidiFile,
+using different composition types depending on the format of the MidiFile.
+\begin{haskelllisting}
+
+> format :: (Track -> Music.T note) -> MidiFile.T -> Music.T note
+> format tm (MidiFile.Cons typ _ trks) =
+> let trks' = map tm trks
+> in case typ of
+> MidiFile.Mixed ->
+> case trks' of
+> [trk] -> trk
+> _ -> error ("toRhyMusic: Only one track allowed for MIDI file type 0.")
+> MidiFile.Parallel -> chord trks'
+> MidiFile.Serial -> line trks'
+
+\end{haskelllisting}
+
+
+Look for Program Changes in the given tracks,
+in order to make a \code{ChannelProgramMap}.
+\begin{haskelllisting}
+
+> makeCPM :: [Track] -> ChannelProgramMap
+> makeCPM =
+> Map.fromList . concatMap (mapMaybe getPC . TimeList.getBodies)
+>
+> getPC :: MidiFileEvent.T -> Maybe (Channel, Program)
+> getPC ev =
+> do (ch, Voice.ProgramChange num) <- MidiFileEvent.maybeVoice ev
+> Just (ch, num)
+
+\end{haskelllisting}
+
+Translate \code{Divisions} into the number of ticks per quarter note.
+\begin{haskelllisting}
+
+> tDiv :: Division -> Tempo
+> tDiv (Ticks x) = x
+> tDiv (SMPTE _ _) = error "Sorry, SMPTE not yet implemented."
+
+\end{haskelllisting}
+
+\code{moveTempoToHead} gets the information that occurs at the beginning of
+the piece: the default tempo and the default key signature.
+A \code{SetTempo} in the middle of the piece
+should translate to a tempo change (\code{Tempo r m}),
+but a \code{SetTempo} at time 0 should set the default
+tempo for the entire piece, by translating to \code{Context.T} tempo.
+It remains a matter of taste which tempo of several parallel tracks
+to use for the whole music.
+\code{moveTempoToHead} takes care of all events that occur at time 0
+so that if any \code{SetTempo} appears at time 0,
+it is moved to the front of the list,
+so that it can be easily retrieved from the result of
+\code{segmentBeforeSetTempo}.
+\begin{haskelllisting}
+
+> moveTempoToHead :: Track -> Track
+> moveTempoToHead es =
+> let (tempo, track) = getHeadTempo es
+> in TimeList.cons 0 (MetaEvent (SetTempo tempo)) track
+
+> getHeadTempo :: Track -> (Tempo, Track)
+> getHeadTempo es =
+> maybe
+> (defltST, es)
+> (\ ~(me,rest) ->
+> case me of
+> MetaEvent (SetTempo tempo) -> (tempo, rest)
+> _ -> mapSnd (TimeList.cons 0 me) (getHeadTempo rest))
+> (do ((0,me),rest) <- TimeList.viewL es
+> return (me,rest))
+
+\end{haskelllisting}
+
+Manages the tempo changes in the piece.
+It translates each MidiFile \code{SetTempo}
+into a ratio between the new tempo and the tempo at the beginning.
+\begin{haskelllisting}
+
+> extractTempo :: Tempo -> RichTrack -> (RichTrack, DurRatio)
+> extractTempo d trk =
+> fromMaybe
+> (trk, 1)
+> (do ((_, Event (MetaEvent (SetTempo tempo))), rest) <- TimeList.viewL trk
+> return (rest, toInteger d %+ toInteger tempo))
+
+\end{haskelllisting}
+
+\code{segmentBefore} is used to split a track into sub-tracks by tempo.
+We do not want to add this function to the \code{event-list} package,
+because the precise type would be
+\type{AlternatingList.Disparate (TimeList.T time body) (TimeList.Event time body)}
+and that's inconvenient for our application.
+\begin{haskelllisting}
+
+> segmentBefore ::
+> (body -> Bool) -> TimeList.T time body -> [TimeList.T time body]
+> segmentBefore p =
+> map TimeList.fromPairList .
+> Utility.segmentBefore (p . snd) .
+> TimeList.toPairList
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> isSetTempo :: RichEvent -> Bool
+> isSetTempo (Event (MetaEvent (SetTempo _))) = True
+> isSetTempo _ = False
+
+> segmentBeforeSetTempo :: RichTrack -> [RichTrack]
+> segmentBeforeSetTempo = segmentBefore isSetTempo
+
+\end{haskelllisting}
+
+\code{readTrack} is the heart of the \code{toRhyMusic} operation.
+It reads a track that has been processed by \code{mergeNotes},
+and returns the track as \code{StdMusic.T}.
+A \code{RichEvent} consists either of a normal \code{MIDIEvent}
+or of a note, which in contrast to normal \code{MIDIEvent}s
+contains the information of corresponding \code{NoteOn} and \code{NoteOff} events.
+
+\begin{haskelllisting}
+
+> type RichTrack = TimeList.T ElapsedTime RichEvent
+> data RichEvent =
+> Event MidiFileEvent.T
+> | Note ElapsedTime MidiNote.T
+
+> readTrack :: Tempo -> ChannelProgramMap ->
+> RichTrack -> Music.T MidiNote.T
+> readTrack ticks cpm =
+> PfBE.toMusic . trackTimeToStd ticks
+> . richTrackToBE . applyProgChanges cpm
+
+\end{haskelllisting}
+
+Take the division in ticks and a duration value and
+converts that to a common note duration
+(such as quarter note, eighth note, etc.).
+\begin{haskelllisting}
+
+> fromTicks :: Tempo -> ElapsedTime -> Dur
+> fromTicks ticks d =
+> toInteger d %+ (toInteger ticks * toInteger defltDurT)
+
+ d %+ (fromIntegral ticks * defltDurT))
+
+> trackTimeToStd :: Tempo ->
+> PfBE.T ElapsedTime note -> PfBE.T Dur note
+> trackTimeToStd ticks =
+> TimeList.mapBody (\(PfBE.Event d n) -> PfBE.Event (fromTicks ticks d) n)
+> . TimeList.mapTime (fromTicks ticks)
+
+\end{haskelllisting}
+
+Look up an instrument name from a \code{ChannelProgramMap} given its channel number.
+\begin{haskelllisting}
+
+> lookupChannelProg :: ChannelProgramMap -> Channel -> Program
+> lookupChannelProg cpm =
+> Map.findWithDefault cpm
+> (error "Invalid channel in user patch map")
+
+\end{haskelllisting}
+
+Implement a \keyword{Program Change}: a change in the \code{ChannelProgramMap} in
+which a channel changes from one instrument to another.
+\begin{haskelllisting}
+
+> progChange :: Channel -> Program -> ChannelProgramMap -> ChannelProgramMap
+> progChange = Map.insert
+> -- progChange ch num cpm = Map.insert ch num cpm
+
+\end{haskelllisting}
+
+Process all \code{ProgramChange} events in a track.
+That is, manage a patch map and
+insert in the appropriate program numbers into the \type{MidiNote.T}s.
+
+The function works the following way:
+Split the track into pieces, each beginning with a program change.
+Compute the patch maps that are active after each program change.
+Apply these patch maps to the track parts.
+\begin{haskelllisting}
+
+> isProgChange :: RichEvent -> Bool
+> isProgChange (Event ev) =
+> maybe False (const True) (getPC ev)
+> isProgChange _ = False
+
+> applyProgChanges :: ChannelProgramMap -> RichTrack -> RichTrack
+> applyProgChanges cpm track =
+> let parts@(_:pcParts) = segmentBefore isProgChange track
+> {-
+> updateCPM (Event (MIDIEvent ch (ProgramChange prog))) =
+> progChange ch prog
+> updateCPM _ = error "TimeList.collectCoincident is buggy"
+> -}
+> updateCPM =
+> maybe
+> (error "TimeList.collectCoincident is buggy")
+> (\ ((_, Event ev), _) ->
+> maybe
+> (error "after segmentation, each part should start with ProgramChange event")
+> (uncurry progChange)
+> (getPC ev))
+> . TimeList.viewL
+> cpms =
+> scanl (flip id) cpm (map updateCPM pcParts)
+> setProg localCPM (Note d n) =
+> Note d (n{MidiNote.program =
+> lookupChannelProg localCPM (MidiNote.channel n)})
+> setProg _ e = e
+> in TimeList.concat (zipWith (TimeList.mapBody . setProg) cpms parts)
+
+\end{haskelllisting}
+
+Remove meta events from \type{RichTrack},
+thus converting to a back-end performance.
+\begin{haskelllisting}
+
+> richNoteToBE :: RichEvent -> PfBE.Event ElapsedTime MidiNote.T
+> richNoteToBE (Note d n) = PfBE.Event d n
+> richNoteToBE _ = error "richNoteToBE: only Note constructor allowed"
+
+> isRichNote :: RichEvent -> Bool
+> isRichNote (Note _ _) = True
+> isRichNote _ = False
+
+> richTrackToBE :: RichTrack -> PfBE.T ElapsedTime MidiNote.T
+> richTrackToBE =
+> TimeList.mapBody richNoteToBE . fst
+> . TimeList.partition isRichNote
+
+\end{haskelllisting}
+
+The \code{mergeNotes} function changes the order of the events in a track
+so that they can be handled by readTrack: each \code{NoteOff}
+is put directly after its corresponding \code{NoteOn}. Its first and second
+arguments are the elapsed time and value (in microseconds per quarter
+note) of the \code{SetTempo} currently in effect.
+\begin{haskelllisting}
+
+> mergeNotes :: Tempo -> Track -> RichTrack
+> mergeNotes stv =
+> TimeList.mapTimeTail
+> ((\(e, rest) ->
+> uncurry TimeList.consBody $
+> let deflt = (Event e, mergeNotes stv rest)
+> in case e of
+> MetaEvent (SetTempo newStv) ->
+> (Event e, mergeNotes newStv rest)
+> MIDIEvent chmsg@(ChannelMsg.Cons _ (Voice msg)) ->
+> if Voice.isNoteOn msg
+> then mapPair
+> (uncurry Note, mergeNotes stv)
+> (searchNoteOff 0 stv 1 chmsg rest)
+> else
+> if Voice.isNoteOff msg
+> then error "NoteOff before NoteOn"
+> else deflt
+> _ -> deflt)
+> . TimeList.viewBodyL)
+
+\end{haskelllisting}
+
+The function \code{searchNoteOff} takes a track and
+looks through the list of events to find the \code{NoteOff}
+corresponding to the given \code{NoteOn}.
+A \code{NoteOff} corresponds to an earlier \code{NoteOn}
+if it is the first in the track to have the same channel and pitch.
+If between \code{NoteOn} and \code{NoteOff} are \code{SetTempo} events,
+it calculates what the elapsed-time is,
+expressed in the current tempo.
+This function takes a ridiculous number of arguments,
+I know, but I don't think it can do without any of the information.
+Maybe there is a simpler way.
+\begin{haskelllisting}
+
+> searchNoteOff ::
+> Double {- ^ time interval between NoteOn and now,
+> in terms of the tempo at the NoteOn -}
+> -> Tempo -> Double {- ^ SetTempo values: the one at the NoteOn and
+> the ratio between the current tempo and the first one. -}
+> -> ChannelMsg.T {- ^ channel and pitch of NoteOn (NoteOff must match) -}
+> -> Track {- ^ the track to be searched -}
+> -> ((ElapsedTime, MidiNote.T), Track)
+> -- ^ the needed event and the remainder of the track
+>
+> searchNoteOff int ost str chm0 =
+> maybe
+> (error "ReadMidi.searchNoteOff: no corresponding NoteOff")
+> (\((t1, mev1), es) ->
+> maybe
+> -- if MIDI events don't match, then recurse
+> (mapSnd (TimeList.cons t1 mev1) $
+> searchNoteOff (addInterval str t1 int) ost
+> (case mev1 of
+> -- respect tempo changes
+> MetaEvent (SetTempo nst) ->
+> fromIntegral ost / fromIntegral nst
+> _ -> str)
+> chm0 es)
+> -- if MIDI events match, construct a MidiNote.T
+> (\note ->
+> let d = round (addInterval str t1 int)
+> in ((d, note), TimeList.delay t1 es))
+> -- check whether NoteOn and NoteOff matches
+> (do chm1 <- MidiFileEvent.maybeMIDIEvent mev1
+> MidiNote.fromMIDIEvents (chm0, chm1)))
+> . TimeList.viewL
+
+> addInterval :: Double -> ElapsedTime -> Double -> Double
+> addInterval str t int = int + fromIntegral t * str
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/MIDI/Render.lhs b/src/Haskore/Interface/MIDI/Render.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI/Render.lhs
@@ -0,0 +1,179 @@
+\subsection{Convenient Functions for Getting Started With Haskore and MIDI}
+\seclabel{test-functions}
+
+{\small
+\begin{haskelllisting}
+
+> module Haskore.Interface.MIDI.Render where
+
+> import qualified Haskore.Interface.MIDI.Write as WriteMidi
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import qualified Sound.MIDI.General as GeneralMidi
+
+> import qualified Sound.MIDI.File.Save as SaveMidi
+> import qualified Sound.MIDI.File as MidiFile
+> import qualified Sound.MIDI.Message.Channel as ChannelMsg
+
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Fancy as FancyPerformance
+
+> import qualified Numeric.NonNegative.Class as NonNeg
+> import qualified Numeric.NonNegative.Wrapper as NonNegW
+
+> import System.Cmd (rawSystem)
+
+\end{haskelllisting}
+}
+
+Given a \code{Player.Map}, \code{Context.T}, \code{InstrMap.T},
+and file name, we can write a \code{MidiMusic.T} value into a midi file:
+
+{\small
+\begin{haskelllisting}
+
+> fileFromRhythmicMusic ::
+> (Ord instr, Ord drum, NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> FilePath ->
+> (InstrMap.ChannelProgramPitchTable drum,
+> InstrMap.ChannelProgramTable instr,
+> Context.T time dyn (RhyMusic.Note drum instr),
+> RhyMusic.T drum instr) -> IO ()
+> fileFromRhythmicMusic fn m =
+> SaveMidi.toFile fn (WriteMidi.fromRhythmicMusic m)
+
+\end{haskelllisting} }
+
+\subsubsection{Test routines}
+
+Using the defaults above, from a \code{MidiMusic.T} object, we can:
+
+\begin{enumerate}
+
+\item generate a \code{Performance.T}
+using \code{Haskore.Performance.Default.fancyFromMusic}
+
+\item generate a \code{MidiFile.T} data structure
+
+{\small
+\begin{haskelllisting}
+
+> midi :: MidiMusic.T -> MidiFile.T
+> midi =
+> WriteMidi.fromRhythmicPerformance [] InstrMap.defltGM .
+> FancyPerformance.floatFromMusic
+
+> generalMidi :: MidiMusic.T -> MidiFile.T
+> generalMidi =
+> WriteMidi.fromGMPerformanceAuto .
+> FancyPerformance.floatFromMusic
+
+> generalMidiDeflt :: MidiMusic.T -> MidiFile.T
+> generalMidiDeflt =
+> WriteMidi.fromGMPerformance (InstrMap.lookup InstrMap.defltCMap) .
+> FancyPerformance.floatFromMusic
+
+> mixedMidi :: MidiMusic.T -> MidiFile.T
+> mixedMidi =
+> WriteMidi.fromRhythmicPerformanceMixed [] InstrMap.defltGM .
+> FancyPerformance.floatFromMusic
+
+> mixedGeneralMidi :: MidiMusic.T -> MidiFile.T
+> mixedGeneralMidi =
+> WriteMidi.fromGMPerformanceMixedAuto .
+> FancyPerformance.floatFromMusic
+
+\end{haskelllisting} }
+
+\item generate a MIDI file
+
+{\small
+\begin{haskelllisting}
+
+> fileFromGeneralMIDIMusic :: FilePath -> MidiMusic.T -> IO ()
+> fileFromGeneralMIDIMusic filename = SaveMidi.toFile filename . generalMidi
+
+\end{haskelllisting} }
+
+\item generate and play a MIDI file on Windows 95, Windows NT, or Linux
+
+{\small
+\begin{haskelllisting}
+
+> fileName :: FilePath
+> fileName = "test.mid"
+
+> play :: String -> [String] -> MidiMusic.T -> IO ()
+> play cmd opts m =
+> do fileFromGeneralMIDIMusic fileName m
+> rawSystem cmd (opts ++ [fileName])
+> return ()
+>
+> playWin95, playWinNT,
+> playLinux, playAlsa, playTimidity, playTimidityJack :: MidiMusic.T -> IO ()
+> playWin95 = play "mplayer" []
+> playWinNT = play "mplay32" []
+> playLinux = play "playmidi" ["-rf"]
+> playAlsa = play "pmidi" ["-p 128:0"]
+> playTimidity = play "timidity" ["-B8,9"]
+> playTimidityJack = play "timidity" ["-Oj"]
+
+\end{haskelllisting} }
+
+\end{enumerate}
+
+Alternatively, just run \code{fileFromGeneralMIDIMusic "test.mid" m} manually,
+and then invoke the midi player
+on your system using \code{playTest}, defined below for NT:
+
+{\small
+\begin{haskelllisting}
+
+> playTest :: IO ()
+> playTest =
+> do rawSystem "mplay32" [fileName]
+> return ()
+
+\end{haskelllisting} }
+
+\subsubsection{Some General Midi test functions}
+
+Use these functions with caution.
+
+A General Midi user patch map; i.e. one that maps GM instrument names
+to themselves, using a channel that is the patch number modulo 16.
+This is for use ONLY in the code that follows, o/w channel duplication
+is possible, which will screw things up in general.
+
+{\small
+\begin{haskelllisting}
+
+> gmUpm :: InstrMap.ChannelProgramTable MidiMusic.Instr
+> gmUpm =
+> zipWith
+> (\instr chan ->
+> (instr, (chan, GeneralMidi.instrumentToProgram instr)))
+> GeneralMidi.instruments
+> (cycle $ map ChannelMsg.toChannel [0..15])
+
+\end{haskelllisting} }
+
+Something to play each "instrument group" of 8 GM instruments;
+this function will play a C major arpeggio on each instrument.
+
+{\small
+\begin{haskelllisting}
+
+> gmTest :: Int -> IO ()
+> gmTest i =
+> let gMM = take 8 (drop (i*8) GeneralMidi.instruments)
+> mu = Music.line (map simple gMM)
+> simple instr = MidiMusic.fromMelodyNullAttr instr Melody.cMajArp
+> in fileFromRhythmicMusic fileName
+> ([], gmUpm, FancyPerformance.context ::
+> Context.T NonNegW.Float Float MidiMusic.Note, mu)
+
+\end{haskelllisting} }
diff --git a/src/Haskore/Interface/MIDI/Write.lhs b/src/Haskore/Interface/MIDI/Write.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MIDI/Write.lhs
@@ -0,0 +1,421 @@
+\subsection{Midi}
+\seclabel{midi}
+
+Midi (``musical instrument digital interface'') is a standard protocol
+adopted by most, if not all, manufacturers of electronic instruments.
+At its core is a protocol for communicating \keyword{musical events} (note
+on, note off, key press, etc.) as well as so-called \keyword{meta events}
+(select synthesizer patch, change volume, etc.). Beyond the logical
+protocol, the Midi standard also specifies electrical signal
+characteristics and cabling details. In addition, it specifies what
+is known as a \keyword{standard Midi file} which any Midi-compatible
+software package should be able to recognize.
+
+Over the years musicians and manufacturers decided that they also
+wanted a standard way to refer to {\em common} or {\em general}
+instruments such as ``acoustic grand piano'', ``electric piano'',
+``violin'', and ``acoustic bass'', as well as more exotic ones such as
+``chorus aahs'', ``voice oohs'', ``bird tweet'', and ``helicopter''.
+A simple standard known as \keyword{General Midi} was developed to fill
+this role. It is nothing more than an agreed-upon list of instrument
+names along with a \keyword{program patch number} for each, a parameter in
+the Midi standard that is used to select a Midi instrument's sound.
+
+Most ``sound-blaster''-like sound cards on conventional PC's know
+about Midi, as well as General Midi. However, the sound generated by
+such modules, and the sound produced from the typically-scrawny
+speakers on most PC's, is often quite poor. It is best to use an
+outboard keyboard or tone generator, which are attached to a computer
+via a Midi interface and cables. It is possible to connect several
+Midi instruments to the same computer, with each assigned a different
+\keyword{channel}. Modern keyboards and tone generators are quite amazing
+little beasts. Not only is the sound quite good (when played on a
+good stereo system), but they are also usually \keyword{multi-timbral},
+which means they are able to generate many different sounds
+simultaneously, as well as \keyword{polyphonic}, meaning that simultaneous
+instantiations of the same sound are possible.
+
+If you decide to use the General Midi features of your sound-card, you
+need to know about another set of conventions known as ``General Midi''.
+The most important aspect of General Midi is that Channel 10 (9 in
+Haskore's 0-based numbering) is dedicated to \keyword{percussion}.
+
+Haskore provides a way to specify a Midi channel number and General
+Midi instrument selection for each \code{Instr} in a Haskore
+composition. It also provides a means to generate a Standard Midi
+File, which can then be played using any conventional Midi software.
+Finally, it provides a way for existing Midi files to be read and
+converted into a \code{MidiMusic.T} object in Haskore. In this section the
+top-level code needed by the user to invoke this functionality will be
+described, along with the gory details.
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.MIDI.Write
+> (fromRhythmicPerformance, fromRhythmicPerformanceMixed,
+> fromGMPerformance, fromGMPerformanceMixed,
+> fromGMPerformanceAuto, fromGMPerformanceMixedAuto,
+> fromRhythmicMusic, fromRhythmicMusicMixed,
+> fromGMMusic, fromGMMusicAuto,
+> fromGMMusicMixed, fromGMMusicMixedAuto,
+> volumeHaskoreToMIDI, volumeMIDIToHaskore)
+> where
+
+> import qualified Sound.MIDI.File as MidiFile
+> import qualified Sound.MIDI.File.Event as MidiFileEvent
+> import qualified Sound.MIDI.File.Event.Meta as MetaEvent
+> import qualified Sound.MIDI.Message.Channel as ChannelMsg
+> import qualified Sound.MIDI.Message.Channel.Voice as Voice
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import qualified Haskore.Interface.MIDI.Note as MidiNote
+
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.BackEnd as PerformanceBE
+> import qualified Haskore.Performance.Fancy as FancyPf
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.MixedBody as TimeList
+> import qualified Data.EventList.Relative.BodyBody as BodyBodyList
+> import qualified Haskore.Basic.Pitch as Pitch
+
+> import qualified Numeric.NonNegative.Class as NonNeg
+
+> import Haskore.General.Utility(limit)
+> import qualified Haskore.General.Map as Map
+> import Data.Maybe(mapMaybe)
+> import Control.Monad.State(State(State), evalState, liftM)
+
+\end{haskelllisting}
+
+Instead of converting a Haskore \code{Performance.T} directly into a Midi
+file, Haskore first converts it into a datatype that {\em represents}
+a Midi file, which is then written to a file in a separate pass. This
+separation of concerns makes the structure of the Midi file clearer,
+makes debugging easier, and provides a natural path for extending
+Haskore's functionality with direct Midi capability.
+
+Here is the basic structure of the modules and functions:
+\begin{center}
+\includegraphics{midi}
+\end{center}
+
+Given instrument and drum maps (\secref{user-patch-map}),
+a performance is converted to a datatype
+representing a Standard Midi File
+of type 0 (\code{Mixed} - one track containing data of all channels)
+or type 1 (\code{Parallel} - tracks played simultaneously)
+using the \function{from*PerformanceMixed}
+and \function{from*Performance} functions, respectively.
+The ``\code{Mixed}'' mode is the only one
+which can be used in principle for infinite music,
+since the number of tracks is stored explicitly in the MIDI file
+which depends on the number of instruments actually used in the song.
+Nevertheless such a stream can not be written to a pipe
+(not to speak of a physical disk),
+since the binary MIDI file format stores lengths of tracks.
+
+The functions with names of the form \function{fromRhythmicPerformance*}
+convert from generic rhythmic music performances using appropriate tables.
+In contrast to that,
+for General MIDI music the instrument and drum maps are fixed.
+There are the two variants
+\function{fromGMPerformance*},
+which allows explicit assignment of instruments to channels,
+and \function{fromGMPerformance*Auto},
+which assigns the channels automatically one by one.
+
+\begin{haskelllisting}
+
+> type Perf time dyn drum instr =
+> Performance.T time dyn (RhyMusic.Note drum instr)
+
+> type NotePerfToBE dyn drum instr =
+> dyn -> Pitch.Relative ->
+> RhyMusic.Note drum instr -> MidiNote.T
+
+> getInstrument ::
+> Performance.Event time dyn (RhyMusic.Note drum instr) -> Maybe instr
+> getInstrument =
+> RhyMusic.maybeInstrument . RhyMusic.body . Performance.eventNote
+
+> fromRhythmicPerformance ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn,
+> Eq drum, Eq instr) =>
+> InstrMap.ChannelProgramPitchTable drum ->
+> InstrMap.ChannelProgramTable instr ->
+> Perf time dyn drum instr -> MidiFile.T
+> fromRhythmicPerformance dMap iMap =
+> fromRhythmicPerformanceBase
+> (const (MidiNote.fromRhyNote
+> (InstrMap.lookup dMap) (InstrMap.lookup iMap)))
+
+> fromGMPerformance ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> (MidiMusic.Instrument -> ChannelMsg.Channel) ->
+> Performance.T time dyn MidiMusic.Note -> MidiFile.T
+> fromGMPerformance cMap =
+> fromRhythmicPerformanceBase
+> (const (MidiNote.fromGMNote cMap))
+
+> fromGMPerformanceAuto ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> Performance.T time dyn MidiMusic.Note -> MidiFile.T
+> fromGMPerformanceAuto =
+> fromRhythmicPerformanceBase
+> (\instrs -> MidiNote.fromGMNote
+> (InstrMap.fromInstruments instrs))
+
+> fromRhythmicPerformanceBase ::
+> (NonNeg.C time, RealFrac time, Eq instr) =>
+> ([instr] -> NotePerfToBE dyn drum instr) ->
+> Perf time dyn drum instr -> MidiFile.T
+> fromRhythmicPerformanceBase makeNoteMap pf =
+> let splitList = TimeList.slice getInstrument pf
+> noteMap = makeNoteMap (mapMaybe fst splitList)
+> {- noteMap will always lookup instruments in a map
+> although the instrument will be the same for each track. -}
+> pfBEs = map (PerformanceBE.fromPerformance noteMap)
+> (map snd splitList)
+> in MidiFile.Cons MidiFile.Parallel (MidiFile.Ticks division)
+> (map trackFromPfBE pfBEs)
+
+
+> fromRhythmicPerformanceMixed ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn, Eq drum, Eq instr) =>
+> InstrMap.ChannelProgramPitchTable drum ->
+> InstrMap.ChannelProgramTable instr ->
+> Perf time dyn drum instr -> MidiFile.T
+> fromRhythmicPerformanceMixed dMap iMap =
+> fromRhythmicPerformanceMixedBase
+> (MidiNote.fromRhyNote
+> (InstrMap.lookup dMap) (InstrMap.lookup iMap))
+
+> fromGMPerformanceMixed ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> (MidiMusic.Instrument -> ChannelMsg.Channel) ->
+> Performance.T time dyn MidiMusic.Note -> MidiFile.T
+> fromGMPerformanceMixed cMap =
+> fromRhythmicPerformanceMixedBase (MidiNote.fromGMNote cMap)
+
+> fromGMPerformanceMixedAuto ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> Performance.T time dyn MidiMusic.Note -> MidiFile.T
+> fromGMPerformanceMixedAuto pf =
+> let instrs = mapMaybe fst (TimeList.slice getInstrument pf)
+> cMap = InstrMap.fromInstruments instrs
+> in fromRhythmicPerformanceMixedBase
+> (MidiNote.fromGMNote cMap) pf
+
+> fromRhythmicPerformanceMixedBase ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn, Eq instr) =>
+> NotePerfToBE dyn drum instr ->
+> Perf time dyn drum instr -> MidiFile.T
+> fromRhythmicPerformanceMixedBase noteMap pf =
+> MidiFile.Cons MidiFile.Mixed (MidiFile.Ticks division)
+> [trackFromPfBE (PerformanceBE.fromPerformance noteMap pf)]
+
+\end{haskelllisting}
+
+The more comfortable function \function{fromRhythmicMusic}
+turns a \code{MidiMusic.T} immediately into a \code{MidiFile.T}.
+Thus it needs also a \code{Context} and drum and instrument table.
+The signature of \function{fromGMMusic} is chosen so that it can be used
+as an inverse to \function{ReadMidi.toGMMusic}.
+The function \function{fromGMMusicAuto} is similar
+but doesn't need a \code{InstrMap.ChannelTable}
+because it creates one from the set of instruments
+actually used in the \code{MidiMusic.T}.
+
+\begin{haskelllisting}
+
+> fromRhythmicMusic, fromRhythmicMusicMixed ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn,
+> Ord drum, Ord instr) =>
+> (InstrMap.ChannelProgramPitchTable drum,
+> InstrMap.ChannelProgramTable instr,
+> Context.T time dyn (RhyMusic.Note drum instr),
+> RhyMusic.T drum instr) -> MidiFile.T
+
+> fromGMMusic, fromGMMusicMixed ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> (InstrMap.ChannelTable MidiMusic.Instr,
+> Context.T time dyn MidiMusic.Note, MidiMusic.T) -> MidiFile.T
+
+> fromGMMusicAuto, fromGMMusicMixedAuto ::
+> (NonNeg.C time, RealFrac time, RealFrac dyn) =>
+> (Context.T time dyn MidiMusic.Note, MidiMusic.T) -> MidiFile.T
+
+> fromRhythmicMusic (dm,im,c,m) =
+> fromRhythmicMusicBase (fromRhythmicPerformance dm im) c m
+> fromRhythmicMusicMixed (dm,im,c,m) =
+> fromRhythmicMusicBase (fromRhythmicPerformanceMixed dm im) c m
+> fromGMMusic (cm,c,m) =
+> fromRhythmicMusicBase (fromGMPerformance (InstrMap.lookup cm)) c m
+> fromGMMusicMixed (cm,c,m) =
+> fromRhythmicMusicBase (fromGMPerformanceMixed (InstrMap.lookup cm)) c m
+> fromGMMusicAuto (c,m) =
+> fromRhythmicMusicBase fromGMPerformanceAuto c m
+> fromGMMusicMixedAuto (c,m) =
+> fromRhythmicMusicBase fromGMPerformanceMixedAuto c m
+
+> fromRhythmicMusicBase ::
+> (NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn,
+> Ord drum, Ord instr) =>
+> (Perf time dyn drum instr -> MidiFile.T) ->
+> Context.T time dyn (RhyMusic.Note drum instr) ->
+> RhyMusic.T drum instr -> MidiFile.T
+> fromRhythmicMusicBase p c m = p (Performance.fromMusic FancyPf.map c m)
+
+\end{haskelllisting}
+
+General Midi specific definitions are imported from
+\module{GeneralMidi} (see \secref{general-midi}).
+The Midi file datatype itself is imported from the module \module{MidiFile},
+functions for writing it to files are found in the module \module{SaveMidi},
+and functions for reading MIDI files come from the modules \module{LoadMidi}
+and \module{ReadMidi}. All these modules are described later in this section.
+
+\subsubsection{The Gory Details}
+
+Some preliminaries, otherwise known as constants:
+\begin{haskelllisting}
+
+> division :: MidiFile.Tempo
+> division = 96 -- time-code division: 96 ticks per quarter note
+
+\end{haskelllisting}
+
+When writing Type 1 Midi Files,
+we can associate each instrument with a separate track.
+So first we partition the event list into separate lists for each instrument.
+(Again, due to the limited number of MIDI channels,
+we can handle no more than 15 instruments.)
+
+The crux of the conversion process is \function{trackFromPfBE},
+which converts a \type{Performance.T} into a stream of \type{Midi.Event}s.
+
+As said before, we can't use absolute times,
+but the difficulties with relatively timed events
+are handled by the \module{Data.EventList.Relative.TimeBody}.
+We first convert all Performance events to MIDI events
+preserving the time stamps from the Performance.
+In the second step we discretize the time stamps
+with \function{Data.EventList.Relative.TimeBody.resample},
+yielding a perfect \type{Midi.Track}.
+On the one hand
+with this order of execution it may be that notes with equal duration
+can have slightly different durations in the MIDI file.
+On the other hand
+small rests between notes or small overlappings are avoided.
+
+We manage a \module{Map} which stores
+the active program number of each MIDI channel.
+If a note on a channel needs a new program or
+there was no note before,
+a \code{ProgChange} is inserted in the stream of MIDI events.
+The function \function{updateChannelMap}
+updates this map each time a note occurs
+and it returns the MIDI channel for the note
+and a \code{Maybe} that contains a program change if necessary.
+
+\begin{haskelllisting}
+
+> trackFromPfBE :: (NonNeg.C time, RealFrac time) =>
+> PerformanceBE.T time MidiNote.T -> MidiFile.Track
+> trackFromPfBE =
+> uncurry TimeList.cons setTempo .
+> TimeList.mapBody MidiFileEvent.MIDIEvent .
+> TimeList.resample rate .
+> TimeList.foldr TimeList.consTime addEvent TimeList.empty .
+> progChanges
+>
+> setTempo :: (MidiFile.ElapsedTime, MidiFileEvent.T)
+> setTempo =
+> (0, MidiFileEvent.MetaEvent
+> (MetaEvent.SetTempo MetaEvent.defltST))
+>
+> getChanProg :: MidiNote.T -> (ChannelMsg.Channel, Voice.Program)
+> getChanProg note = (MidiNote.channel note, MidiNote.program note)
+>
+> updateChannelMap ::
+> (ChannelMsg.Channel, Voice.Program) ->
+> Map.Map ChannelMsg.Channel Voice.Program ->
+> (Maybe ChannelMsg.T,
+> Map.Map ChannelMsg.Channel Voice.Program)
+> updateChannelMap (midiChan, progNum) cm =
+> if Just progNum == Map.lookup cm midiChan
+> then (Nothing, cm)
+> else (Just (ChannelMsg.Cons midiChan (ChannelMsg.Voice
+> (Voice.ProgramChange progNum))),
+> Map.insert midiChan progNum cm)
+>
+> progChanges ::
+> PerformanceBE.T time MidiNote.T
+> -> PerformanceBE.T time (MidiNote.T, Maybe ChannelMsg.T)
+> progChanges =
+> flip evalState Map.empty .
+> TimeList.mapBodyM
+> (\(PerformanceBE.Event dur note) ->
+> liftM (\mn -> PerformanceBE.Event dur (note, mn))
+> (State (updateChannelMap (getChanProg note))))
+>
+> rate :: (Num a) => a
+> rate = 2 * fromIntegral division
+> -- ^ compensate defltDurT
+
+\end{haskelllisting}
+
+A source of incompatibility between Haskore and Midi is that Haskore
+represents notes with an onset and a duration, while Midi represents
+them as two separate events, an note-on event and a note-off event.
+Thus \function{addEvent} turns a Haskore \type{Event} into two
+\type{ChannelMsg.T}s, a \code{NoteOn} and a \code{NoteOff}.
+
+The function \function{TimeList.insert} is used to insert a \code{NoteOff}
+into the sequence of following MIDI events.
+It looks a bit cumbersome to insert every single \code{NoteOff}.
+An alternative may be to \function{merge} the list of \code{NoteOn} events
+with the list of \code{NoteOff} events.
+This won't work because the second one isn't ordered.
+Instead one could merge the two-element lists
+defined by \code{NoteOn} and \code{NoteOff} for each note using \function{fold}.
+But there might be infinitely many notes \dots
+
+\begin{haskelllisting}
+
+> addEvent ::
+> (NonNeg.C time) =>
+> PerformanceBE.Event time
+> (MidiNote.T, Maybe ChannelMsg.T) ->
+> TimeList.T time ChannelMsg.T ->
+> BodyBodyList.T time ChannelMsg.T
+> addEvent ev mevs =
+> let (note, progChange)
+> = PerformanceBE.eventNote ev
+> d = PerformanceBE.eventDur ev
+> (mec0, mec1) = MidiNote.toMIDIEvents note
+> in maybe (TimeList.consBody mec0)
+> (\pcME -> TimeList.consBody pcME . TimeList.cons 0 mec0)
+> progChange
+> (TimeList.insert d mec1 mevs)
+
+\end{haskelllisting}
+
+
+*****
+The MIDI volume handling is still missing.
+One cannot express the Volume in terms of the velocity!
+Thus we need some new event constructor for changed controller values.
+*****
+
+\begin{haskelllisting}
+
+> volumeHaskoreToMIDI :: (RealFrac a, Floating a) => a -> Int
+> volumeHaskoreToMIDI v = round (limit (0,127) (64 + 16 * logBase 2 v))
+
+> volumeMIDIToHaskore :: Floating a => Int -> a
+> volumeMIDIToHaskore v = 2 ** ((fromIntegral v - 64) / 16)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Interface/MML.lhs b/src/Haskore/Interface/MML.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Interface/MML.lhs
@@ -0,0 +1,82 @@
+\subsection{MML}
+
+\begin{haskelllisting}
+
+> module Haskore.Interface.MML where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+> import Haskore.Basic.Duration((%+))
+
+> import qualified Data.List as List
+> import Control.Monad.State
+
+\end{haskelllisting}
+
+I found some music notated in a language called MML.
+The description consists of strings.
+
+\begin{itemize}
+\item
+ \code{l}$n$ determines the duration of subsequent notes:
+ \code{l1} - whole note,
+ \code{l2} - half note,
+ \code{l4} - quarter note and so on.
+\item \code{>} switch to the octave above
+\item \code{<} switch to the octave below
+\item Lower case letter \code{a} - \code{g} play the note of the corresponding pitch class.
+\item \code{\#} (sharp) or \code{-} (flat) may follow a note name
+in order to increase or decrease, respectively, the pitch of the note by a semitone.
+\item An additional figure for the note duration may follow.
+\item \code{p} is pause.
+\end{itemize}
+
+See \module{Kantate147} for an example.
+
+%\url{http://www.student.oulu.fi/~vtatila/history_of_game_music.html}
+
+\begin{haskelllisting}
+
+> type Accum = (Music.Dur, Pitch.Octave)
+
+> barToMusic :: String -> Accum -> ([Melody.T ()], Accum)
+> barToMusic [] accum = ([], accum)
+> barToMusic (c:cs) (dur, oct) =
+> let charToDur dc = 1 %+ read (dc:[])
+> prependAtom atom adur (ms, newAccum) =
+> (atom adur : ms, newAccum)
+> procNote ndur pitch c0s =
+> let mkNote c1s = prependAtom (flip (Melody.note (oct, pitch)) ())
+> ndur (barToMusic c1s (dur, oct))
+> in case c0s of
+> '#':c1s -> procNote ndur (succ pitch) c1s
+> '-':c1s -> procNote ndur (pred pitch) c1s
+> c1 :c1s -> if '0'<=c1 && c1<='9'
+> then procNote (charToDur c1) pitch c1s
+> else mkNote c0s
+> [] -> mkNote c0s
+> in case c of
+> 'c' -> procNote dur Pitch.C cs
+> 'd' -> procNote dur Pitch.D cs
+> 'e' -> procNote dur Pitch.E cs
+> 'f' -> procNote dur Pitch.F cs
+> 'g' -> procNote dur Pitch.G cs
+> 'a' -> procNote dur Pitch.A cs
+> 'b' -> procNote dur Pitch.B cs
+> 'p' -> let (c1:c1s) = cs
+> in prependAtom Music.rest (charToDur c1)
+> (barToMusic c1s (dur, oct))
+> '<' -> barToMusic cs (dur, oct-1)
+> '>' -> barToMusic cs (dur, oct+1)
+> 'l' -> let (c1:c1s) = cs
+> in barToMusic c1s (charToDur c1, oct)
+> _ -> error ("unexpected character '"++[c]++"' in Haskore.Interface.MML description")
+
+> toMusicState :: String -> State Accum [Melody.T ()]
+> toMusicState s = State (barToMusic s)
+
+> toMusic :: Pitch.Octave -> String -> Melody.T ()
+> toMusic oct s = Music.line (evalState (toMusicState s) (0, oct))
+
+\end{haskelllisting}
diff --git a/src/Haskore/Melody.lhs b/src/Haskore/Melody.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Melody.lhs
@@ -0,0 +1,149 @@
+\begin{haskelllisting}
+
+> module Haskore.Melody where
+
+> import Haskore.Basic.Pitch hiding (T)
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Basic.Duration as Duration
+> import qualified Haskore.Music as Music
+> import Haskore.General.Utility (mapSnd)
+
+> import qualified Medium
+
+> import qualified Data.List as List
+> import Data.Maybe(fromMaybe)
+
+> import qualified Data.Accessor.Basic as Accessor
+
+> data Note attr = Note {noteAttrs_ :: attr, notePitch_ :: Pitch.T}
+> deriving (Show, Eq, Ord)
+
+> type T attr = Music.T (Note attr)
+
+> noteAttrs :: Accessor.T (Note attr) attr
+> noteAttrs =
+> Accessor.fromSetGet (\x n -> n{noteAttrs_ = x}) noteAttrs_
+>
+> notePitch :: Accessor.T (Note attr) Pitch.T
+> notePitch =
+> Accessor.fromSetGet (\x n -> n{notePitch_ = x}) notePitch_
+
+> toMelodyNullAttr :: T attr -> T ()
+> toMelodyNullAttr =
+> Music.mapNote (\(Note _ p) -> Note () p)
+
+\end{haskelllisting}
+
+For convenience,
+let's create simple names for familiar notes (\figref{note-names}),
+durations, and rests (\figref{durations-rests}).
+Despite the large number of them, these names are sufficiently
+``unusual'' that name clashes are unlikely.
+
+\begin{figure}{\small
+\begin{haskelllisting}
+
+> note :: Pitch.T -> Duration.T -> attr -> T attr
+> note p d' nas = Medium.prim (Music.Atom d' (Just (Note nas p)))
+>
+> note' :: Pitch.Class -> Pitch.Octave ->
+> Duration.T -> attr -> T attr
+> note' = flip (curry note)
+>
+> cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs ::
+> Pitch.Octave -> Duration.T -> attr -> T attr
+>
+> cf = note' Cf; c = note' C; cs = note' Cs
+> df = note' Df; d = note' D; ds = note' Ds
+> ef = note' Ef; e = note' E; es = note' Es
+> ff = note' Ff; f = note' F; fs = note' Fs
+> gf = note' Gf; g = note' G; gs = note' Gs
+> af = note' Af; a = note' A; as = note' As
+> bf = note' Bf; b = note' B; bs = note' Bs
+
+\end{haskelllisting}
+}
+\caption{Convenient note construction functions.}
+\figlabel{note-names}
+\end{figure}
+
+\begin{comment}
+
+> {-
+> o0, o1, o2, o3, o4, o5, o6, o7, o8, o9,
+> s0, s1, s2, s3, s4, s5, s6, s7, s8, s9 ::
+> (Octave -> Duration.T -> attr -> T note)
+> -> (Duration.T -> attr -> T note)
+> o0 n = n 0; s0 n = n (- 1)
+> o1 n = n 1; s1 n = n (- 2)
+> o2 n = n 2; s2 n = n (- 3)
+> o3 n = n 3; s3 n = n (- 4)
+> o4 n = n 4; s4 n = n (- 5)
+> o5 n = n 5; s5 n = n (- 6)
+> o6 n = n 6; s6 n = n (- 7)
+> o7 n = n 7; s7 n = n (- 8)
+> o8 n = n 8; s8 n = n (- 9)
+> o9 n = n 9; s9 n = n (-10)
+> -}
+
+\end{comment}
+
+From the notes in the C major triad in register 4, I can now construct
+a C major arpeggio and chord as well:
+\begin{haskelllisting}
+
+> cMaj :: [T ()]
+> cMaj = map (\n -> n 4 Duration.qn ()) [c,e,g] -- octave 4, quarter notes
+>
+> cMajArp, cMajChd :: T ()
+> cMajArp = Music.line cMaj
+> cMajChd = Music.chord cMaj
+
+\end{haskelllisting}
+
+It is also possible to retrieve the pitch from a melody note.
+But this should be avoided, since it must be dynamically checked,
+whether the Melody value actually contains one note.
+
+\begin{haskelllisting}
+
+> noteToPitch :: T attr -> Pitch.T
+> noteToPitch =
+> let err = error "leastVaryingInversions: melody must consist of a note"
+> in Accessor.get notePitch .
+> Music.switchList (const (fromMaybe err)) err err err
+
+\end{haskelllisting}
+
+
+\paragraph*{Inversion and Retrograde.}
+
+The notions of inversion, retrograde, retrograde inversion, etc. used
+in 12-tone theory are also easily captured in Haskore. First let's
+define a transformation from a line created by \code{line} to a list:
+\begin{haskelllisting}
+
+> invertNote :: Pitch.T -> Note attr -> Note attr
+> invertNote r =
+> Accessor.modify notePitch
+> (\ p -> Pitch.fromInt (2 * Pitch.toInt r - Pitch.toInt p))
+>
+> retro, invert, retroInvert, invertRetro ::
+> [(d, Music.Atom (Note attr))] -> [(d, Music.Atom (Note attr))]
+> retro = List.reverse
+> invert l = let r = maybe
+> (error "invert: first atom must be a note")
+> (Accessor.get notePitch)
+> (snd (head l))
+> in map (mapSnd (fmap (invertNote r))) l
+> retroInvert = retro . invert
+> invertRetro = invert . retro
+
+\end{haskelllisting}
+
+\begin{exercise} Show that ``\code{retro\ .\ retro}'',
+``\code{invert\ .\ invert}'', and ``\code{retroInvert\ .\ invertRetro}''
+are the identity on values created by \code{line}.
+\end{exercise}
+
diff --git a/src/Haskore/Melody/Standard.lhs b/src/Haskore/Melody/Standard.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Melody/Standard.lhs
@@ -0,0 +1,73 @@
+
+\begin{haskelllisting}
+
+> module Haskore.Melody.Standard
+> (Note, T, NoteAttributes, fromMelodyNullAttr,
+> na, velocity1, vibrato, tremolo,
+> cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs) where
+
+> import Haskore.Melody
+> (cf,c,cs,df,d,ds,ef,e,es,ff,f,fs,gf,g,gs,af,a,as,bf,b,bs)
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+
+> import qualified Data.Accessor.Basic as Accessor
+> import qualified Data.Accessor.Show as AccShow
+
+> type Note = Melody.Note NoteAttributes
+
+> type T = Melody.T NoteAttributes
+
+\end{haskelllisting}
+
+% | Dynamics String
+% | Fingering Int
+
+Recall that the \code{Note} constructor contained a field of \code{NoteAttribute}s.
+These are values that are attached to notes for the
+purpose of notation or musical interpretation.
+
+\begin{haskelllisting}
+
+> data NoteAttributes =
+> NoteAttributes {
+> velocity_ :: Rational, -- intensity of playing between 0 and 1
+> vibrato_ :: (Rational, Rational),
+> tremolo_ :: (Rational, Rational)
+> } deriving (Eq, Ord)
+>
+> instance Show NoteAttributes where
+> showsPrec =
+> AccShow.showsPrec
+> [AccShow.field "velocity1" velocity1,
+> AccShow.field "vibrato" vibrato,
+> AccShow.field "tremolo" tremolo]
+> "na" na
+>
+> na :: NoteAttributes
+> na = NoteAttributes 1 (0,0) (0,0)
+>
+> velocity1 :: Accessor.T NoteAttributes Rational
+> velocity1 =
+> Accessor.fromSetGet (\v nas -> nas{velocity_ = v}) velocity_
+>
+> vibrato :: Accessor.T NoteAttributes (Rational, Rational)
+> vibrato =
+> Accessor.fromSetGet (\v nas -> nas{vibrato_ = v}) vibrato_
+>
+> tremolo :: Accessor.T NoteAttributes (Rational, Rational)
+> tremolo =
+> Accessor.fromSetGet (\v nas -> nas{tremolo_ = v}) tremolo_
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> fromMelodyNullAttr :: Melody.T () -> T
+> fromMelodyNullAttr =
+> Music.mapNote (\(Melody.Note _ p) -> Melody.Note na p)
+
+\end{haskelllisting}
+
+% Music.mapNote (Accessor.set Melody.noteAttrs na)
diff --git a/src/Haskore/Music.lhs b/src/Haskore/Music.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Music.lhs
@@ -0,0 +1,684 @@
+\subsubsection{Music}
+\seclabel{music}
+
+\begin{haskelllisting}
+
+> module Haskore.Music where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Basic.Duration as Duration
+
+> import qualified Medium.Temporal as Temporal
+> import qualified Medium.Controlled as CtrlMedium
+> import qualified Medium.Controlled.List as CtrlMediumList
+> import qualified Medium
+> import Medium (prim, serial, parallel)
+
+> import Haskore.General.Utility (mapPair, mapSnd, maximum0, toMaybe)
+> import Data.Maybe (isJust)
+> import qualified Data.List as List
+
+\end{haskelllisting}
+Melodies consist essentially of the musical atoms notes and rests.
+
+\begin{haskelllisting}
+
+> type Dur = Duration.T
+
+> type Atom note = Maybe note
+
+\end{haskelllisting}
+
+If the atom is \code{Nothing} then it means a rest,
+if it is \code{Just} it contains a note.
+A note is described by its pitch and
+a list of \code{NoteAttribute}s (defined later).
+Both notes and rests have a duration of type \type{Dur},
+which is a rational \secref{discussion:dur}.
+The duration is measured in ratios of whole notes.
+
+Notes and rests along with the duration
+are put into the \type{Primitive} type.
+
+\begin{haskelllisting}
+
+> data Primitive note =
+> Atom Dur (Atom note) -- a note or a rest
+> deriving (Show, Eq, Ord)
+
+\end{haskelllisting}
+
+A primitive can not only be an atom
+but also a controller as defined below.
+We had to make controllers alternatives of \constructor{Atom}s
+because the \type{Medium} type doesn't support them
+and it would damage the beauty of \type{Medium}
+if we add it at the same level as parallel and serial compositions.
+
+\begin{haskelllisting}
+
+> data Control =
+> Tempo DurRatio -- scale the tempo
+> | Transpose Pitch.Relative -- transposition
+> | Player PlayerName -- player label
+> | Phrase PhraseAttribute -- phrase attribute
+> deriving (Show, Eq, Ord)
+>
+> type DurRatio = Dur
+> type PlayerName = String
+
+> atom :: Dur -> Atom note -> T note
+> atom d' = prim . Atom d'
+> control :: Control -> T note -> T note
+> control ctrl = CtrlMedium.control ctrl
+
+> mkControl :: (a -> Control) -> (a -> T note -> T note)
+> mkControl ctrl = control . ctrl
+> changeTempo :: DurRatio -> T note -> T note
+> changeTempo = mkControl Tempo
+> transpose :: Pitch.Relative -> T note -> T note
+> transpose = mkControl Transpose
+> setPlayer :: PlayerName -> T note -> T note
+> setPlayer = mkControl Player
+> phrase :: PhraseAttribute -> T note -> T note
+> phrase = mkControl Phrase
+
+\end{haskelllisting}
+
+\begin{itemize}
+\item \code{changeTempo a m} scales the rate at which
+\code{m} is played (i.e.\ its tempo) by a factor of \code{a}.
+\item \code{transpose i m} transposes \code{m} by interval \code{i} (in semitones).
+\item \code{setPlayer pname m} declares that \code{m} is to be performed by
+player \code{pname}.
+\item \code{phrase pa m} declares that \code{m} is to be played using
+the phrase attribute (described later) \code{pa}.
+(cf. \secref{discussion:phrase})
+\end{itemize}
+
+From these primitives we can build more complex musical objects.
+They are captured by the \code{Music.T} datatype:
+\footnote{I prefer to call these ``musical objects''
+rather than ``musical values''
+because the latter may be confused with musical aesthetics.}
+
+\begin{haskelllisting}
+
+> type T note = CtrlMediumList.T Control (Primitive note)
+>
+> infixr 7 +:+ {- like multiplication -}
+> infixr 6 =:= {- like addition -}
+> -- make them visible for importers of Music
+> (+:+), (=:=) :: T note -> T note -> T note
+> (+:+) = (Medium.+:+)
+> (=:=) = (Medium.=:=)
+
+\end{haskelllisting}
+
+\begin{itemize}
+\item Musical objects can be composed sequentially
+by \function{Medium.serial} or by \function{(+:+)}.
+That is both \code{serial [m0, m1]} and \code{m0 +:+ m1}
+denote that \code{m0} and \code{m1} are played in sequence.
+(cf. \secref{discussion:media})
+\item Similarly \code{Medium.parallel} and \function{(=:=)}
+compose parallely.
+E.g.\ both \code{parallel [m0, m1]} and \code{m0 =:= m1}
+mean that \code{m0} and \code{m1} are played simultaneously.
+\end{itemize}
+
+It is convenient to represent these ideas in Haskell
+as a recursive datatype rather then simple function calls
+because we wish to not only construct musical objects,
+but also take them apart, analyze their structure, print them in a
+structure-preserving way, interpret them for performance purposes,
+etc.
+Nonetheless using functions that are mapped to constructors
+has the advantage that song descriptions
+can stay independent from a particular music data structure.
+
+% durations and formatting of durations
+\input{Haskore/Basic/Duration.lhs}
+
+\subsubsection{Rests}
+\seclabel{rests}
+
+\begin{figure}
+\begin{haskelllisting}
+
+> rest :: Dur -> T note
+> rest d' = prim (Atom d' Nothing)
+>
+> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr :: T note
+> dwnr, dhnr, dqnr, denr, dsnr, dtnr :: T note
+> ddhnr, ddqnr, ddenr :: T note
+>
+> bnr = rest Duration.bn -- brevis rest
+> wnr = rest Duration.wn -- whole note rest
+> hnr = rest Duration.hn -- half note rest
+> qnr = rest Duration.qn -- quarter note rest
+> enr = rest Duration.en -- eight note rest
+> snr = rest Duration.sn -- sixteenth note rest
+> tnr = rest Duration.tn -- thirty-second note rest
+> sfnr = rest Duration.sfn -- sixty-fourth note rest
+>
+> dwnr = rest Duration.dwn -- dotted whole note rest
+> dhnr = rest Duration.dhn -- dotted half note rest
+> dqnr = rest Duration.dqn -- dotted quarter note rest
+> denr = rest Duration.den -- dotted eighth note rest
+> dsnr = rest Duration.dsn -- dotted sixteenth note rest
+> dtnr = rest Duration.dtn -- dotted thirty-second note rest
+>
+> ddhnr = rest Duration.ddhn -- double-dotted half note rest
+> ddqnr = rest Duration.ddqn -- double-dotted quarter note rest
+> ddenr = rest Duration.dden -- double-dotted eighth note rest
+
+\end{haskelllisting}
+\caption{Convenient rest definitions.}
+\figlabel{durations-rests}
+\end{figure}
+
+\subsubsection{Some Simple Examples}
+\seclabel{basic-examples}
+
+With this modest beginning, we can already express quite a few musical
+relationships simply and effectively.
+
+\paragraph*{Lines and Chords.}
+
+Two common ideas in music are the construction of notes in a
+horizontal fashion (a \keyword{line} or \keyword{melody}), and in a vertical
+fashion (a \keyword{chord}):
+\begin{haskelllisting}
+
+> line, chord :: [T note] -> T note
+> line = serial
+> chord = parallel
+
+\end{haskelllisting}
+
+\paragraph*{Delay and Repeat.}
+
+Suppose now that we wish to describe a melody \code{m} accompanied by
+an identical voice a perfect 5th higher. In Haskore we simply write
+``\code{m =:= transpose 7 m}''. Similarly, a canon-like structure
+involving \code{m} can be expressed as ``\code{m =:= delay d m}'',
+where:
+\begin{haskelllisting}
+
+> delay :: Dur -> T note -> T note
+> delay d' m = if d' == 0 then m else rest d' +:+ m
+
+\end{haskelllisting}
+
+Of course, Haskell's non-strict semantics also allows us to define
+infinite musical objects. For example, a musical object may be
+repeated \keyword{ad nauseum} using this simple function:
+\begin{haskelllisting}
+
+> repeat :: T note -> T note
+> repeat m = line (List.repeat m)
+
+\end{haskelllisting}
+Thus an infinite ostinato can be expressed in this way, and then used
+in different contexts that extract only the portion that's actually
+needed.
+
+A limitted loop can be defined the same way.
+
+\begin{haskelllisting}
+
+> replicate :: Int -> T note -> T note
+> replicate n m = line (List.replicate n m)
+
+\end{haskelllisting}
+
+
+\paragraph*{Determining Duration}
+
+It is sometimes desirable to compute the duration in beats of a
+musical object; we can do so as follows:
+\begin{haskelllisting}
+
+> dur :: T note -> Dur
+> dur = Temporal.dur
+
+> instance Temporal.C (Primitive note) where
+> dur (Atom d' _) = d'
+> none d' = Atom d' Nothing
+
+> instance Temporal.Control Control where
+> controlDur (Tempo t) d' = d' / t
+> controlDur _ d' = d'
+> anticontrolDur (Tempo t) d' = d' * t
+> anticontrolDur _ d' = d'
+
+\end{haskelllisting}
+
+However, this measurement ignores the temporal effects
+of phrases like ritardando.
+
+
+\paragraph*{Super-retrograde.}
+
+Using \code{dur} we can define a function \function{reverse}
+that reverses any \code{Music.T} value
+(and is thus considerably more useful than \code{retro} defined earlier).
+Note the tricky treatment of parallel compositions.
+Also note that this version wastes time.
+It computes the duration of smaller structures
+in the case of parallel compositions.
+When it descends into a structure of which it has computed the duration
+it computes the duration of its sub-structures again.
+This can lead to a quadratic time consumption.
+\begin{haskelllisting}
+
+> reverse :: T note -> T note
+> reverse = mapList
+> (,)
+> (flip const)
+> List.reverse
+> (\ms -> let durs = map dur ms
+> dmax = maximum0 durs
+> in zipWith (delay . (dmax -)) durs ms)
+
+\end{haskelllisting}
+
+\paragraph*{Truncating Parallel Composition}
+
+Note that the duration of \code{m0 =:= m1} is the maximum of the
+durations of {\\code{m0} and \code{m1} (and thus if one is infinite, so
+is the result). Sometimes we would rather have the result be of
+duration equal to the shorter of the two. This is not as easy as it
+sounds, since it may require interrupting the longer one in the middle
+of a note (or notes).
+
+We will define a ``truncating parallel composition'' operator \code{(/=:)},
+but first we will define an auxiliary function \function{Music.take}
+such that \expression{Music.take d m}
+is the musical object \code{m} ``cut short'' to have at most duration \code{d}.
+The name matches the one of the \module{List}
+because the function is quite similar.
+\begin{haskelllisting}
+
+> take :: Dur -> T note -> T note
+> take newDur m =
+> if newDur < 0
+> then error ("Music.take: newDur " ++ show newDur ++ " must be non-negative")
+> else snd (take' newDur m)
+
+> takeLine :: Dur -> [T note] -> [T note]
+> takeLine newDur = snd . takeLine' newDur
+
+> take' :: Dur -> T note -> (Dur, T note)
+> take' 0 = const (0, rest 0)
+> take' newDur =
+> switchList
+> (\oldDur at -> let takenDur = min oldDur newDur
+> in (takenDur, atom takenDur at))
+> (\ctrl -> case ctrl of
+> Tempo t -> mapPair ((/t), changeTempo t) .
+> take' (newDur * t)
+> _ -> mapSnd (control ctrl) .
+> take' newDur)
+> (mapSnd line . takeLine' newDur)
+> (mapPair (maximum0,chord) . unzip . map (take' newDur))
+
+> takeLine' :: Dur -> [T note] -> (Dur, [T note])
+> takeLine' 0 _ = (0, [])
+> takeLine' _ [] = (0, [])
+> takeLine' newDur (m:ms) =
+> let m' = take' newDur m
+> ms' = takeLine' (newDur - fst m') ms
+> in (fst m' + fst ms', snd m' : snd ms')
+
+\end{haskelllisting}
+Note that \code{Music.take} is ready to handle
+a \type{Music.T} object of infinite length.
+The implementation of \function{takeLine'} and \function{take'} would be simpler
+if one does not compute the duration of the taken part of the music in \function{take'}.
+Instead one could compute the duration of the taken part where it is needed,
+i.e. after \function{takeLine'} calls \function{Music.take'}.
+The drawback of this simplification would be
+analogously to \function{Music.reverse}:
+The duration of sub-structures must be computed again and again,
+which results in quadratic runtime in the worst-case.
+
+
+With \code{Music.take}, the definition of \code{(/=:)} is now straightforward:
+\begin{haskelllisting}
+
+> (/=:) :: T note -> T note -> T note
+> m0 /=: m1 = Haskore.Music.take (min (dur m0) (dur m1)) (m0 =:= m1)
+
+\end{haskelllisting}
+Unfortunately, whereas \code{Music.take} can handle infinite-duration music
+values, \code{(/=:)} cannot.
+
+\begin{exercise}
+Define a version of \code{(/=:)} that shortens correctly when either or
+both of its arguments are infinite in duration.
+\end{exercise}
+
+
+For completeness we want to define a function somehow dual to \function{Music.take}.
+The \function{Music.drop} removes a prefix of the given duration
+from the music.
+Notes that begin in the removed part are lost.
+This is especially important for notes which start in the removed part
+and end in the remainder.
+They are replaced by rests.
+
+We would like to design \function{drop'}
+such that it returns the duration of the remaining music.
+This design fails for infinite music.
+Thus we return the duration of the part that was dropped.
+When going through a serial composition,
+if we could drop less from a music item than we wanted
+then the music item must have been gone completely
+and must drop subsequent items.
+If we dropped as much as we wanted we are ready.
+If we dropped more than we wanted this indicates an error.
+Remaining rests of zero duration, empty compositions and so on
+may be removed by subsequent optimizations.
+
+\begin{haskelllisting}
+
+> drop :: Dur -> T note -> T note
+> drop remDur =
+> if remDur < 0
+> then error ("Music.drop: remDur " ++ show remDur ++ " must be non-negative")
+> else snd . drop' remDur
+
+> dropLine :: Dur -> [T note] -> [T note]
+> dropLine remDur = snd . dropLine' remDur
+
+> drop' :: Dur -> T note -> (Dur, T note)
+> drop' 0 = (,) 0
+> drop' remDur =
+> switchList
+> (\oldDur _ -> let newDur = min oldDur remDur
+> in (newDur, rest (oldDur-newDur)))
+> (\ctrl -> case ctrl of
+> Tempo t -> mapPair ((/t), changeTempo t) .
+> drop' (remDur * t)
+> _ -> mapSnd (control ctrl) .
+> drop' remDur)
+> (mapSnd line . dropLine' remDur)
+> (mapPair (maximum0,chord) . unzip . map (drop' remDur))
+
+> dropLine' :: Dur -> [T note] -> (Dur, [T note])
+> dropLine' 0 m = (0, m)
+> dropLine' _ [] = (0, [])
+> dropLine' remDur (m:ms) =
+> let (dropped, m') = drop' remDur m
+> in case compare dropped remDur of
+> LT -> mapPair ((dropped+), id) (dropLine' (remDur - dropped) ms)
+> EQ -> (dropped, m' : ms)
+> GT -> error "dropLine': program error: dropped more than we wanted"
+
+\end{haskelllisting}
+Note that \function{mapPair} is prepared for infinite lists.
+
+We will now define functions for filtering out notes.
+This way you can e.g. extract all notes for a particular instrument.
+Non-matching notes are replaced by rests.
+You may want to merge them using \function{Optimization.rest}.
+
+\begin{haskelllisting}
+
+> filter :: (note -> Bool) -> T note -> T note
+> filter p =
+> fmap (\(Atom d' mn) -> Atom d' (mn >>= \n -> toMaybe (p n) n))
+> -- fmap (\(Atom d' mn) -> Atom d' (listToMaybe $ filter p $ maybeToList mn))
+
+> partition :: (note -> Bool) -> T note -> (T note, T note)
+> partition p =
+> foldList
+> (\ d' mn ->
+> mapPair
+> (atom d', atom d')
+> (if maybe False p mn
+> then (mn, Nothing)
+> else (Nothing, mn)))
+> (\k -> mapPair (control k, control k))
+> (mapPair (line, line) . unzip)
+> (mapPair (chord, chord) . unzip)
+
+> partitionMaybe :: (noteA -> Maybe noteB) -> T noteA -> (T noteB, T noteA)
+> partitionMaybe f =
+> foldList
+> (\ d' mn ->
+> mapPair
+> (atom d', atom d')
+> (let m = mn >>= f
+> in if isJust m
+> then (m, Nothing)
+> else (Nothing, mn)))
+> (\k -> mapPair (control k, control k))
+> (mapPair (line, line) . unzip)
+> (mapPair (chord, chord) . unzip)
+
+\end{haskelllisting}
+
+
+
+\paragraph*{Inspecting a \type{Music.T}}
+
+Here are some routines which specialize functions from \module{Medium}
+to \module{Music}.
+
+\begin{haskelllisting}
+
+> applyPrimitive ::
+> (Dur -> Atom note -> b) ->
+> Primitive note -> b
+> applyPrimitive fa (Atom d' at) = fa d' at
+
+> switchBinary ::
+> (Dur -> Atom note -> b) ->
+> (Control -> T note -> b) ->
+> (T note -> T note -> b) ->
+> (T note -> T note -> b) ->
+> b -> T note -> b
+> switchBinary fa fc fser fpar =
+> CtrlMedium.switchBinary (applyPrimitive fa) fser fpar fc
+
+> switchList ::
+> (Dur -> Atom note -> b) ->
+> (Control -> T note -> b) ->
+> ([T note] -> b) ->
+> ([T note] -> b) ->
+> T note -> b
+> switchList fa fc fser fpar =
+> CtrlMedium.switchList (applyPrimitive fa) fser fpar fc
+
+> foldBin ::
+> (Dur -> Atom note -> b) ->
+> (Control -> b -> b) ->
+> (b -> b -> b) ->
+> (b -> b -> b) ->
+> b -> T note -> b
+> foldBin fa fc fser fpar none' =
+> CtrlMedium.foldBin (applyPrimitive fa) fser fpar fc none'
+
+> foldList ::
+> (Dur -> Atom note -> b) ->
+> (Control -> b -> b) ->
+> ([b] -> b) ->
+> ([b] -> b) ->
+> T note -> b
+> foldList fa fc fser fpar =
+> CtrlMedium.foldList (applyPrimitive fa) fser fpar fc
+
+> mapListFlat ::
+> (Dur -> Atom noteA -> (Dur, Atom noteB)) ->
+> (Control -> T noteA -> T noteB) ->
+> ([T noteA] -> [T noteB]) ->
+> ([T noteA] -> [T noteB]) ->
+> T noteA -> T noteB
+
+> mapListFlat fa fc fser fpar =
+> CtrlMediumList.mapListFlat (uncurry Atom . applyPrimitive fa) fser fpar fc
+
+> mapList ::
+> (Dur -> Atom noteA -> (Dur, Atom noteB)) ->
+> (Control -> T noteB -> T noteB) ->
+> ([T noteB] -> [T noteB]) ->
+> ([T noteB] -> [T noteB]) ->
+> T noteA -> T noteB
+
+> mapList fa fc fser fpar =
+> CtrlMediumList.mapList (uncurry Atom . applyPrimitive fa) fser fpar fc
+
+> -- Could be an instance of fmap if Music.T would be an algebraic type.
+> mapNote :: (noteA -> noteB) -> T noteA -> T noteB
+> mapNote f' = fmap (\(Atom d' at) -> Atom d' (fmap f' at))
+
+> {-
+> This is useful for duration dependend attributes,
+> and duration dependend instrument sounds.
+> However it seems to be more appropriate to pass the duration in seconds
+> to the sound generators rather than the relative duration.
+> -}
+> mapDurNote :: (Dur -> noteA -> noteB) -> T noteA -> T noteB
+> mapDurNote f' = fmap (\(Atom d' at) -> Atom d' (fmap (f' d') at))
+
+\end{haskelllisting}
+
+
+
+\input{Haskore/Composition/Trill.lhs}
+
+\input{Haskore/Composition/Drum.lhs} % needs \code{roll} from Trill
+
+\subsubsection{Phrasing and Articulation}
+\seclabel{phrasing}
+
+The \code{Phrase} constructor permits
+one to annotate an entire musical object with a \code{PhraseAttribute}.
+This attribute datatype covers a
+wide range of attributions found in common practice notation, and is
+shown in \figref{attributes}. Beware that use of them requires
+the use of a player that knows how to interpret them! Players will be
+described in more detail in \secref{players}.
+
+\begin{figure}
+\begin{haskelllisting}
+
+> data PhraseAttribute = Dyn Dynamic
+> | Tmp Tempo
+> | Art Articulation
+> | Orn Ornament
+> deriving (Eq, Ord, Show)
+>
+> data Dynamic = Loudness Rational | Accent Rational
+> | Crescendo Rational | Diminuendo Rational
+> deriving (Eq, Ord, Show)
+>
+> data Tempo = Ritardando Rational | Accelerando Rational
+> deriving (Eq, Ord, Show)
+>
+> data Articulation = Staccato Dur | Legato Dur | Slurred Dur
+> | Tenuto | Marcato | Pedal | Fermata | FermataDown | Breath
+> | DownBow | UpBow | Harmonic | Pizzicato | LeftPizz
+> | BartokPizz | Swell | Wedge | Thumb | Stopped
+> deriving (Eq, Ord, Show)
+>
+> data Ornament = Trill | Mordent | InvMordent | DoubleMordent
+> | Turn | TrilledTurn | ShortTrill
+> | Arpeggio | ArpeggioUp | ArpeggioDown
+> | Instruction String | Head NoteHead
+> deriving (Eq, Ord, Show)
+>
+> -- this is more a note attribute than a phrase attribute
+> data NoteHead = DiamondHead | SquareHead | XHead | TriangleHead
+> | TremoloHead | SlashHead | ArtHarmonic | NoHead
+> deriving (Eq, Ord, Show)
+
+\end{haskelllisting}
+\caption{Note and Phrase Attributes.}
+\figlabel{attributes}
+\end{figure}
+
+Again, to stay independent from the underlying data structure
+we define some functions that simplify the application of several phrases.
+
+\begin{haskelllisting}
+
+> dynamic :: Dynamic -> T note -> T note
+> dynamic = phrase . Dyn
+
+> tempo :: Tempo -> T note -> T note
+> tempo = phrase . Tmp
+
+> articulation :: Articulation -> T note -> T note
+> articulation = phrase . Art
+
+> ornament :: Ornament -> T note -> T note
+> ornament = phrase . Orn
+
+
+> accent, crescendo, diminuendo, loudness1,
+> ritardando, accelerando ::
+> Rational -> T note -> T note
+
+> accent = dynamic . Accent
+> crescendo = dynamic . Crescendo
+> diminuendo = dynamic . Diminuendo
+> loudness1 = dynamic . Loudness
+
+> ritardando = tempo . Ritardando
+> accelerando = tempo . Accelerando
+
+> staccato, legato :: Dur -> T note -> T note
+>
+> staccato = articulation . Staccato
+> legato = articulation . Legato
+
+\end{haskelllisting}
+
+
+Note that some of the attributes are parameterized with a numeric value.
+This is used by a player to control the degree to which
+an articulation is to be applied.
+For example the articulations \constructor{Staccato}, \constructor{Legato},
+\constructor{Slurred} describe the overlapping between notes.
+We would expect \code{Legato 1.2}
+to create more of a legato feel than \code{Legato 1.1},
+and \code{Staccato 2} to be stronger than \code{Staccato 1}.
+
+The following constants represent default values for some of the
+parameterized attributes:
+\begin{haskelllisting}
+
+> defltLegato, defltStaccato,
+> defltAccent, bigAccent :: T note -> T note
+>
+> defltLegato = legato Duration.sn
+> defltStaccato = staccato Duration.sn
+> defltAccent = accent 1.2
+> bigAccent = accent 1.5
+
+\end{haskelllisting}
+
+To understand exactly how a player interprets an attribute requires
+knowing how players are defined. Haskore defines only a few simple
+players, so in fact many of the attributes in \figref{attributes}
+are to allow the user to give appropriate interpretations of them by
+her particular player. But before looking at the structure of players
+we will need to look at the notion of a \keyword{performance} (these two
+ideas are tightly linked, which is why the \code{Player} and \code{Performance}
+modules are mutually recursive).
+
+
+\begin{exercise}
+Find a simple piece of music written by your favorite composer, and
+transcribe it into Haskore. In doing so, look for repeating patterns,
+transposed phrases, etc. and reflect this in your code, thus revealing
+deeper structural aspects of the music than that found in common
+practice notation.
+\end{exercise}
+
+\secref{chick} shows the first 28 bars of Chick Corea's
+``Children's Song No.~6'' encoded in Haskore.
diff --git a/src/Haskore/Music/GeneralMIDI.lhs b/src/Haskore/Music/GeneralMIDI.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Music/GeneralMIDI.lhs
@@ -0,0 +1,49 @@
+A common instance of Music.T.
+
+> module Haskore.Music.GeneralMIDI
+> (T, Note, NoteBody, Instr,
+> RhyMusic.velocity, RhyMusic.body,
+> RhyMusic.instrument, RhyMusic.pitch, RhyMusic.drum,
+> RhyMusic.noteFromStdMelodyNote,
+> fromStdMelody, fromMelodyNullAttr,
+>
+> GM.Instrument(..), GM.Drum(..),
+> toProgram, toChannel,
+>
+> bn, wn, hn, qn, en, sn, tn, sfn,
+> dwn, dhn, dqn, den, dsn, dtn,
+> ddhn, ddqn, dden,
+> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr,
+> dwnr, dhnr, dqnr, denr, dsnr, dtnr,
+> ddhnr, ddqnr, ddenr,
+> line, chord, changeTempo, transpose, phrase,
+> (Music.+:+), (Music.=:=), Dur,
+>
+> PhraseAttribute(..), Dynamic(..),
+> Tempo(..), Articulation(..), Ornament(..), NoteHead(..),
+> accent, crescendo, diminuendo, loudness1,
+> ritardando, accelerando, staccato, legato,
+> defltLegato, defltStaccato,
+> defltAccent, bigAccent) where
+
+> import qualified Sound.MIDI.General as GM
+> import Sound.MIDI.Message.Channel (toChannel, toProgram, )
+> import Haskore.Basic.Duration hiding (T)
+> import Haskore.Music as Music hiding (T)
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Melody.Standard as StdMelody
+
+> type Instr = GM.Instrument
+> type Drum = GM.Drum
+
+> type Note = RhyMusic.Note Drum Instr
+> type NoteBody = RhyMusic.NoteBody Drum Instr
+> type T = RhyMusic.T Drum Instr
+
+> -- | in contrast to RhyMusic.fromStdMelody it has fixed instrument type
+> fromStdMelody :: Instr -> StdMelody.T -> T
+> fromStdMelody = RhyMusic.fromStdMelody
+
+> fromMelodyNullAttr :: Instr -> Melody.T () -> T
+> fromMelodyNullAttr = RhyMusic.fromMelodyNullAttr
diff --git a/src/Haskore/Music/Rhythmic.lhs b/src/Haskore/Music/Rhythmic.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Music/Rhythmic.lhs
@@ -0,0 +1,116 @@
+A common instance of Music.T.
+It represents rhythmic music, that is melodies plus drums.
+The types for melody instruments and drums can be chosen freely.
+They may be plain strings, enumerations or parametrized instrument descriptions.
+
+\begin{haskelllisting}
+
+> module Haskore.Music.Rhythmic
+> (T, Note(..), NoteBody(..),
+> maybeInstrument,
+> noteFromAttrs, noteFromStdMelodyNote, noteFromMelodyNote,
+> fromStdMelody, fromMelodyNullAttr, fromMelody,
+>
+> bn, wn, hn, qn, en, sn, tn, sfn,
+> dwn, dhn, dqn, den, dsn, dtn,
+> ddhn, ddqn, dden,
+> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr,
+> dwnr, dhnr, dqnr, denr, dsnr, dtnr,
+> ddhnr, ddqnr, ddenr,
+> line, chord, changeTempo, transpose, phrase,
+> (Music.+:+), (Music.=:=), Dur,
+>
+> PhraseAttribute(..), Dynamic(..),
+> Tempo(..), Articulation(..), Ornament(..), NoteHead(..),
+> accent, crescendo, diminuendo, loudness1,
+> ritardando, accelerando, staccato, legato,
+> defltLegato, defltStaccato,
+> defltAccent, bigAccent) where
+
+> import qualified Haskore.Basic.Pitch as Pitch
+> import Haskore.Basic.Duration hiding (T)
+> import Haskore.Music hiding (T, partitionMaybe)
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Melody.Standard as StdMelody
+
+> import qualified Data.Accessor.Basic as Accessor
+
+> import Haskore.General.Utility (compareRecord, compareField, )
+
+> data Note drum instr =
+> Note {velocity :: Rational,
+> body :: NoteBody drum instr}
+> deriving (Show, Eq)
+
+\end{haskelllisting}
+
+A note of a rhythmic music can be
+either a tone of a melody instrument or a drum.
+Every effect, which has no pitch, is considered as a drum.
+Naturally \code{Tone}s are affected by transposition
+whereas \code{Drum}s are not.
+
+\begin{haskelllisting}
+
+> data NoteBody drum instr =
+> Tone {instrument :: instr,
+> pitch :: Pitch.T}
+> | Drum {drum :: drum}
+> deriving (Show, Eq, Ord)
+
+> -- this order is just for the old test cases which rely on it
+> instance (Ord instr, Ord drum) => Ord (Note drum instr) where
+> compare =
+> compareRecord
+> [compareField body,
+> compareField velocity]
+
+> type T drum instr = Music.T (Note drum instr)
+
+> maybeInstrument :: NoteBody drum instr -> Maybe instr
+> maybeInstrument (Tone instr _) = Just instr
+> maybeInstrument (Drum _) = Nothing
+
+\end{haskelllisting}
+
+A rhythmic music can be created by assigning an instrument to a melody.
+The function \function{fromStdMelody} does this while preserving common note attributes,
+and the function \function{fromMelodyNullAttr}
+ignores the note attributes.
+This is useful in case no additional attributes are needed.
+In this case the \type{attr} type variable can be the null type \type{()}.
+
+\begin{haskelllisting}
+
+> noteFromAttrs :: StdMelody.NoteAttributes ->
+> NoteBody drum instr -> Note drum instr
+> noteFromAttrs nas =
+> Note (Accessor.get StdMelody.velocity1 nas)
+
+> noteFromStdMelodyNote :: instr -> StdMelody.Note -> Note drum instr
+> noteFromStdMelodyNote instr (Melody.Note nas p) =
+> noteFromAttrs nas (Tone instr p)
+
+> noteFromMelodyNote ::
+> (attr -> (Rational,instr)) ->
+> Melody.Note attr -> Note drum instr
+> noteFromMelodyNote attrToInstr (Melody.Note x p) =
+> let (vel,instr) = attrToInstr x
+> in Note vel (Tone instr p)
+
+> fromStdMelody :: instr -> StdMelody.T -> T drum instr
+> fromStdMelody instr = Music.mapNote (noteFromStdMelodyNote instr)
+
+> -- | ignores the note attributes
+> fromMelodyNullAttr :: instr -> Melody.T () -> T drum instr
+> fromMelodyNullAttr instr =
+> fromStdMelody instr . StdMelody.fromMelodyNullAttr
+> -- fromMelody (const (1,instr))
+
+> fromMelody ::
+> (attr -> (Rational,instr)) -> Melody.T attr -> T drum instr
+> fromMelody attrToInstr =
+> Music.mapNote (noteFromMelodyNote attrToInstr)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Music/Standard.lhs b/src/Haskore/Music/Standard.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Music/Standard.lhs
@@ -0,0 +1,44 @@
+A common instance of Music.T.
+
+> module Haskore.Music.Standard
+> (T, Note, NoteBody, Instr, Drum,
+> RhyMusic.velocity, RhyMusic.body,
+> RhyMusic.instrument, RhyMusic.pitch, RhyMusic.drum,
+> RhyMusic.noteFromStdMelodyNote,
+> fromStdMelody, fromMelodyNullAttr,
+>
+> bn, wn, hn, qn, en, sn, tn, sfn,
+> dwn, dhn, dqn, den, dsn, dtn,
+> ddhn, ddqn, dden,
+> bnr, wnr, hnr, qnr, enr, snr, tnr, sfnr,
+> dwnr, dhnr, dqnr, denr, dsnr, dtnr,
+> ddhnr, ddqnr, ddenr,
+> line, chord, changeTempo, transpose, phrase,
+> (Music.+:+), (Music.=:=), Dur,
+>
+> PhraseAttribute(..), Dynamic(..),
+> Tempo(..), Articulation(..), Ornament(..), NoteHead(..),
+> accent, crescendo, diminuendo, loudness1,
+> ritardando, accelerando, staccato, legato,
+> defltLegato, defltStaccato,
+> defltAccent, bigAccent) where
+
+> import Haskore.Basic.Duration hiding (T)
+> import Haskore.Music as Music hiding (T)
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Melody.Standard as StdMelody
+
+> type Instr = String
+> type Drum = String
+
+> type Note = RhyMusic.Note Drum Instr
+> type NoteBody = RhyMusic.NoteBody Drum Instr
+> type T = RhyMusic.T Drum Instr
+
+> -- | in contrast to RhyMusic.fromStdMelody it has fixed instrument type
+> fromStdMelody :: Instr -> StdMelody.T -> T
+> fromStdMelody = RhyMusic.fromStdMelody
+
+> fromMelodyNullAttr :: Instr -> Melody.T () -> T
+> fromMelodyNullAttr = RhyMusic.fromMelodyNullAttr
diff --git a/src/Haskore/Performance.lhs b/src/Haskore/Performance.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance.lhs
@@ -0,0 +1,331 @@
+\subsection{Interpretation and Performance}
+\seclabel{performance}
+
+% import Player
+
+\begin{haskelllisting}
+
+> module Haskore.Performance where
+>
+> import Haskore.Music(PlayerName, PhraseAttribute)
+
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Music as Music
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.TimeTime as TimeListPad
+> import qualified Data.EventList.Relative.TimeMixed as TimeListPad
+> import qualified Numeric.NonNegative.Class as NonNeg
+
+> import Haskore.General.Utility (mapPair, maximum0, compareRecord, compareField)
+> import Control.Monad.Reader(Reader(runReader), ask, asks, local)
+> import Control.Applicative(WrappedMonad(WrapMonad), unwrapMonad, )
+> import Data.Traversable(sequenceA)
+> import Data.List (foldl')
+
+> import Prelude hiding (Monad)
+
+\end{haskelllisting}
+
+Now that we have defined the structure of musical objects, let us turn
+to the issue of \keyword{performance}, which we define as a temporally
+ordered sequence of musical \keyword{events}:
+\begin{haskelllisting}
+
+> type T time dyn note = TimeList.T time (Event time dyn note)
+> type Padded time dyn note = TimeListPad.T time (Event time dyn note)
+
+\end{haskelllisting}
+
+The \type{Padded} performance has a trailing time value.
+It can be considered as the duration after the last event
+after which the performance finishes.
+This need not to be the duration of the last event,
+as in the case, where the last note is a short one,
+that is played while an earlier long note remains playing.
+Another exception is a performance which ends with a rest.
+
+\begin{haskelllisting}
+
+> data Event time dyn note =
+> Event {eventDur :: time,
+> eventDynamics :: dyn,
+> eventTranspose :: Pitch.Relative,
+> eventNote :: note}
+> deriving (Eq, Show)
+>
+> -- this order is just for the old test cases which rely on it
+> instance (Ord time, Ord dyn, Ord note) =>
+> Ord (Event time dyn note) where
+> compare =
+> compareRecord
+> [compareField eventNote,
+> compareField eventDynamics,
+> compareField eventTranspose,
+> compareField eventDur]
+
+\end{haskelllisting}
+An event is the lowest of our music representations not yet committed
+to Midi, CSound, or the MusicKit.
+An event \code{Event \{eventDur = d, eventNote = n\}}
+captures the fact that
+the note \code{n} respecting all its attributes is played
+for a duration \code{d}
+(where now duration is measured in seconds, rather than beats).
+
+We introduce the type variables \type{time} and \type{dyn} here
+which are used for time and dynamics quantities.
+For every-day use where only efficiency counts
+you will infer these type variables with \type{Float} or \type{Double}.
+For testing the validity of axioms (see \secref{equivalence})
+we need exact computation which can be achieved with \type{Rational}.
+
+To generate a complete performance of, i.e.\ give an interpretation
+to, a musical object, we must know the time to begin the performance,
+and the proper volume, key and tempo.
+We must also know what \keyword{player}s to use;
+that is, we need a mapping from the \code{PlayerName}s in
+an abstract musical object to the actual players to be used. (We
+don't yet need a mapping from abstract \code{Instr}s to instruments,
+since this is handled in the translation from a performance into, say,
+Midi, such as defined in \secref{midi}.)
+
+We can thus model a performer as a function \code{fromMusic} which maps
+all of this information and a musical object into a performance:
+\begin{haskelllisting}
+
+> fromMusic ::
+> (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) =>
+> PlayerMap time dyn note -> Context time dyn note -> Music.T note -> T time dyn note
+>
+> type PlayerMap time dyn note = PlayerName -> Player time dyn note
+> data Context time dyn note =
+> Context {contextDur :: time,
+> contextPlayer :: Player time dyn note,
+> contextTranspose :: Pitch.Relative,
+> contextDynamics :: dyn}
+> deriving Show
+
+> type UpdateContext time dyn note a =
+> (a -> a) -> Context time dyn note -> Context time dyn note
+>
+> updatePlayer :: UpdateContext time dyn note (Player time dyn note)
+> updatePlayer f c = c {contextPlayer = f (contextPlayer c)}
+> updateDur :: UpdateContext time dyn note time
+> updateDur f c = c {contextDur = f (contextDur c)}
+> updateTranspose :: UpdateContext time dyn note Pitch.Relative
+> updateTranspose f c = c {contextTranspose = f (contextTranspose c)}
+> updateDynamics :: UpdateContext time dyn note dyn
+> updateDynamics f c = c {contextDynamics = f (contextDynamics c)}
+
+ fromMusic pmap c@Context {contextStart = t, contextPlayer = pl, contextDur = dt, contextTranspose = k} m =
+ case m of
+ Note p d nas -> playNote pl c p d nas
+ Rest d -> []
+ m1 :+: m2 -> fromMusic pmap c m1 ++
+ fromMusic pmap (c {contextStart = t + dur m1 * dt}) m2
+ m1 :=: m2 -> merge (fromMusic pmap c m1) (fromMusic pmap c m2)
+ Tempo a m -> fromMusic pmap (c {contextDur = dt / fromRational a}) m
+ Transpose p m -> fromMusic pmap (c {contextTranspose = k + p}) m
+ Instrument nm m -> fromMusic pmap (c {cInst = nm}) m
+ Player nm m -> fromMusic pmap (c {contextPlayer = pmap nm}) m
+ Phrase pas m -> interpretPhrase pl pmap c pas m
+
+\end{haskelllisting}
+
+\begin{figure}
+\begin{haskelllisting}
+
+> fromMusic pmap c = fst . TimeListPad.viewTimeR . paddedFromMusic pmap c
+>
+> paddedFromMusic ::
+> (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) =>
+> PlayerMap time dyn note -> Context time dyn note ->
+> Music.T note -> Padded time dyn note
+> paddedFromMusic pmap c =
+> TimeListPad.catMaybes . fst . flip runReader c . monadFromMusic pmap
+>
+> type PaddedWithRests time dyn note =
+> TimeListPad.T time (Maybe (Event time dyn note))
+>
+> type Monad time dyn note =
+> Reader
+> (Context time dyn note)
+> (PaddedWithRests time dyn note, time)
+
+> sequenceReader :: [Reader r a] -> Reader r [a]
+> sequenceReader = unwrapMonad . sequenceA . map WrapMonad
+
+> combine ::
+> ([performance] -> performance, [time] -> time) ->
+> [Reader r (performance, time)] ->
+> Reader r (performance, time)
+> combine f =
+> fmap (mapPair f . unzip) . sequenceReader
+
+> monadFromMusic ::
+> (NonNeg.C time, RealFrac time, Ord dyn, Fractional dyn, Ord note) =>
+> PlayerMap time dyn note -> Music.T note -> Monad time dyn note
+>
+> monadFromMusic pmap =
+> Music.foldList
+> (\d at -> flip fmap ask $ \c ->
+> let noteDur = Dur.toNumber d * contextDur c
+> events =
+> maybe
+> (TimeList.singleton 0 Nothing)
+> (TimeList.mapBody Just .
+> playNote (contextPlayer c) c d) at
+> in (TimeListPad.snocTime events noteDur, noteDur))
+> (\ctrl ->
+> case ctrl of
+> Music.Tempo a -> local (updateDur (/ Dur.toNumber a))
+> Music.Transpose p -> local (updateTranspose (+ p))
+> Music.Player nm -> local (updatePlayer (const (pmap nm)))
+> Music.Phrase pa -> \m ->
+> asks contextPlayer >>= \pl -> interpretPhrase pl pa m)
+> (combine (TimeListPad.concat, sum))
+> (combine (foldl' TimeListPad.merge (TimeListPad.pause 0), maximum0))
+
+ This implementation fails on
+ mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ mel
+
+> {- this does only work if the performance in the Monad does not have a Maybe for each note
+
+> monadFromMusicOld :: (Ord time, Fractional time, Ord note) =>
+> PlayerMap time dyn note -> Music.T note ->
+> Reader (Context time dyn note) (Padded time dyn note, time)
+>
+> monadFromMusicOld pmap =
+> Music.foldList
+> (\d at -> flip fmap ask $ \c ->
+> let noteDur = fromRational d * contextDur c
+> in ((case at of
+> Just note -> playNote (contextPlayer c) c d note
+> Nothing -> [],
+> noteDur), noteDur))
+> (\ctrl ->
+> case ctrl of
+> Music.Tempo a -> local (updateDur (/ fromRational a))
+> Music.Transpose p -> local (updateTranspose (+ p))
+> Music.Player nm -> local (updatePlayer (const (pmap nm)))
+> Music.Phrase pa -> \m ->
+> asks contextPlayer >>= \pl -> interpretPhrase pl pa m )
+> (combine (TimeListPad.concat, sum))
+> (combine (foldl' TimeListPad.merge ([], 0), maximum0))
+> -}
+
+\end{haskelllisting}
+\caption{The ``real'' \code{fromMusic} function.}
+\figlabel{real-fromMusic}
+\end{figure}
+
+Some things to note:
+\begin{enumerate}
+\item
+The function \function{monadFromMusic} does not simply convert
+a music object to a performance
+but it converts a music to an action (\type{Reader} monad).
+Given a context we can start the action by \function{runReader}
+and we get an event.
+The way \function{monadFromMusic} works
+is to build a big action from many small actions.
+
+\item
+The \code{Context} is the running ``state'' of the performance, and
+gets updated in several different ways. For example, the
+interpretation of the \code{Tempo} constructor involves scaling
+the duration of a whole note appropriately and
+updating the \code{contextDur} field of the context.
+
+It's better not to manipulate the members of \code{Context} directly,
+but to use the abstractions from \code{PerformanceContext}.
+This way we can stay independent of the concrete definition of \code{Context}.
+(I would like to define this data structure in \code{PerformanceContext}
+but the current Haskell compilers
+have a complicated handling of mutually dependent modules.)
+
+\item
+Interpretation of notes and phrases is player dependent. Ultimately a
+single note is played by the \code{playNote} function, which takes the
+player as an argument. Similarly, phrase interpretation is also
+player dependent, reflected in the use of \code{interpretPhrase}.
+Precisely how these two functions work is described in \secref{players}.
+
+\item
+The \code{Dur} component of the context is the duration,
+in seconds, of one whole note.
+See \secref{tempo} for assisting functions.
+
+\item
+In the treatment of \code{Serial}, note that the sub-sequences are
+appended together, with the start time of the second argument delayed
+by the duration of the first. The function \code{dur} (defined in
+\secref{basic-examples}) is used to compute this duration. Note
+that this results in a quadratic time complexity for \code{fromMusic}. A
+more efficient solution is to have \code{fromMusic} compute the duration
+directly, returning it as part of its result. This version of \code{fromMusic}
+is shown in \figref{real-fromMusic}.
+
+\item
+In contrast, the sub-sequences derived from the arguments to \code{Parallel}
+are merged into a time-ordered stream.
+This is done with \function{merge} from the module \module{Data.EventList.Relative.TimeTime}.
+\end{enumerate}
+
+
+% equivalence of musical values
+\input{Test/Equivalence.lhs}
+
+
+% this section should be moved to the Player module
+% as soon as the Haskell interpreters support mutually recursive modules
+
+\subsection{Players}
+\seclabel{players}
+
+In the last section we saw how a performance involved the notion of a
+ \keyword{player}. The reason for this is the same as for real players and
+their instruments: many of the note and phrase attributes
+(see \secref{phrasing}) are player and instrument dependent.
+For example, how should ``legato'' be interpreted in a performance?
+Or ``diminuendo''?
+Different players interpret things in different ways, of course, but
+even more fundamental is the fact that a pianist, for example,
+realizes legato in a way fundamentally different from the way a
+violinist does, because of differences in their instruments.
+Similarly, diminuendo on a piano and a harpsichord are different
+concepts.
+
+With a slight stretch of the imagination, we can even consider a
+``notator'' of a score as a kind of player: exactly how the music is
+rendered on the written page may be a personal, stylized process. For
+example, how many, and which staves should be used to notate a
+particular instrument?
+
+In any case, to handle these issues, Haskore has a notion of a
+\keyword{player} which ``knows'' about differences with respect to performance
+and notation. A Haskore player is a 4-tuple consisting of a name and
+three functions: one for interpreting notes, one for phrases, and one
+for producing a properly notated score.
+\begin{haskelllisting}
+
+> data Player time dyn note =
+> PlayerCons { name :: PlayerName,
+> playNote :: NoteFun time dyn note,
+> interpretPhrase :: PhraseFun time dyn note,
+> notatePlayer :: NotateFun }
+>
+> instance (Show time, Show dyn) => Show (Player time dyn note) where
+> show p = "Player.cons " ++ name p
+
+> type NoteFun time dyn note =
+> Context time dyn note -> Music.Dur -> note -> T time dyn note
+> type PhraseFun time dyn note =
+> PhraseAttribute -> Monad time dyn note -> Monad time dyn note
+> type NotateFun = ()
+
+\end{haskelllisting}
+The last line above is because notation is currently not implemented.
+Note that both \code{NotateFun} and \code{PhraseFun}
+functions return a \code{Performance.T}.
diff --git a/src/Haskore/Performance/BackEnd.lhs b/src/Haskore/Performance/BackEnd.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance/BackEnd.lhs
@@ -0,0 +1,131 @@
+\subsection{Connect Performance to a Back-End}
+\seclabel{performance-backend}
+
+\begin{haskelllisting}
+
+> module Haskore.Performance.BackEnd where
+>
+> import qualified Haskore.Performance as Pf
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.TimeTime as TimeListPad
+
+> import Haskore.Music ((=:=), (+:+))
+
+\end{haskelllisting}
+
+The performance data structure is still bound to music specific data.
+We still have to convert that into back-end specific data,
+such as MIDI events, CSound statements, SuperCollider messages or other.
+The new data type \type{Performance.BackEnd.T}
+is similar to \type{Performance.T},
+but does not contain transposition or dynamics information any longer.
+Also music-specific data is converted to back-end specific data.
+
+Later we have to provide converters from each type of music
+to each back-end.
+This requires combinatorial amount of implementation work
+but it is the most flexible way to do so.
+We expect only a few general types of music which fit to many back-ends,
+and many music types specialised to features of a particular back-end.
+It would be certainly less work to have an universal intermediate,
+but this restricts the flexibility.
+
+\begin{haskelllisting}
+
+> type T time note = TimeList.T time (Event time note)
+> type Padded time note = TimeListPad.T time (Event time note)
+>
+> data Event time note =
+> Event {eventDur :: time,
+> eventNote :: note}
+> deriving (Eq, Ord, Show)
+
+\end{haskelllisting}
+
+Now we provide a function which simplifies conversion
+from a \type{Performance.Event} to a \type{Performance.BackEnd.Event}
+in case that this conversion does not depend on the event time and duration.
+
+\begin{haskelllisting}
+
+> instance Functor (Event time) where
+> fmap f e = e{eventNote = f (eventNote e)}
+
+> mapTime :: (time0 -> time1) -> T time0 note -> T time1 note
+> mapTime f =
+> TimeList.mapBody
+> (\ev -> ev{eventDur = f (eventDur ev)}) .
+> TimeList.mapTime f
+
+> mapTimePadded ::
+> (time0 -> time1) -> Padded time0 note -> Padded time1 note
+> mapTimePadded f =
+> TimeListPad.mapBody
+> (\ev -> ev{eventDur = f (eventDur ev)}) .
+> TimeListPad.mapTime f
+
+> eventFromPerformanceEvent ::
+> (dyn -> Pitch.Relative -> note -> backEndNote) ->
+> Pf.Event time dyn note -> Event time backEndNote
+> eventFromPerformanceEvent f =
+> \ (Pf.Event dur vel trans note)
+> -> Event dur (f vel trans note)
+
+> fromPerformance ::
+> (dyn -> Pitch.Relative -> note -> backEndNote) ->
+> Pf.T time dyn note -> T time backEndNote
+> fromPerformance = TimeList.mapBody . eventFromPerformanceEvent
+
+> fromPaddedPerformance ::
+> (dyn -> Pitch.Relative -> note -> backEndNote) ->
+> Pf.Padded time dyn note -> Padded time backEndNote
+> fromPaddedPerformance = TimeListPad.mapBody . eventFromPerformanceEvent
+
+\end{haskelllisting}
+For symmetry we also provide a function which converts
+a performance back to a music.
+This operation is not uniquely defined,
+and a satisfying implementation is a music theoretical challenge.
+A sophisticated algorithm would have to make assumptions
+about the structure of ``common'' music.
+So you will be able to construct examples of music
+that fool such an algorithm.
+
+The opposite extreme is a version which simply maps
+the stream of notes to a big parallel composition
+where each parallel channel consists of one note.
+(The normal form as described in Hudak's Temporal Media paper.)
+
+The following implementation tries to avoid
+obviously unnecessary parallelism
+by watching for non-overlapping notes.
+Nevertheless the conversion of general polyphonic music
+yields a music that is not very nicely structured.
+So, don't rely on the structure of the restored music,
+only assume that this functions reverts the performance generation.
+\begin{haskelllisting}
+
+> toMusic :: T Music.Dur note -> Music.T note
+> toMusic =
+> maybe
+> (Music.rest 0)
+> (\ ((t0, Event d mn), es0) ->
+> let n = if d>=0
+> then Music.atom d (Just mn)
+> else error "Performance.toMusic: note of negative duration"
+> rmd =
+> maybe n
+> (\((t1, re1), es1) ->
+> if t1 >= d
+> then n +:+ toMusic (TimeList.cons (t1-d) re1 es1)
+> else n =:= toMusic es0)
+> (TimeList.viewL es0)
+> in case compare t0 0 of
+> EQ -> rmd
+> GT -> Music.rest t0 +:+ rmd
+> LT -> error "Performance.toMusic: events in wrong order")
+> . TimeList.viewL
+
+\end{haskelllisting}
diff --git a/src/Haskore/Performance/Context.hs b/src/Haskore/Performance/Context.hs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance/Context.hs
@@ -0,0 +1,44 @@
+module Haskore.Performance.Context
+ (T,
+ setPlayer, setDur, setTranspose, setDynamics,
+ getPlayer, getDur, getTranspose, getDynamics,
+ Pf.updatePlayer, Pf.updateDur, Pf.updateTranspose, Pf.updateDynamics,
+ contextPlayer, contextDur, contextTranspose, contextDynamics, )
+ where
+
+import qualified Haskore.Basic.Pitch as Pitch
+-- import qualified Haskore.Music as Music
+import qualified Haskore.Performance as Pf
+import qualified Haskore.Performance.Player as Player
+import Haskore.Performance(Context(..))
+
+-- import qualified Numeric.NonNegative.Class as NonNeg
+
+
+{- If the Haskell compilers would support mutual depending modules
+ the Context data type would be declared here instead of in Performance. -}
+
+type T time dyn note = Pf.Context time dyn note
+
+type SetContext time dyn note a = a -> T time dyn note -> T time dyn note
+
+setPlayer :: SetContext time dyn note (Player.T time dyn note)
+setPlayer = Pf.updatePlayer . const
+setDur :: SetContext time dyn note time
+setDur = Pf.updateDur . const
+setTranspose :: SetContext time dyn note Pitch.Relative
+setTranspose = Pf.updateTranspose . const
+setDynamics :: SetContext time dyn note dyn
+setDynamics = Pf.updateDynamics . const
+
+
+type GetContext time dyn note a = T time dyn note -> a
+
+getPlayer :: GetContext time dyn note (Player.T time dyn note)
+getPlayer = Pf.contextPlayer
+getDur :: GetContext time dyn note time
+getDur = Pf.contextDur
+getTranspose :: GetContext time dyn note Pitch.Relative
+getTranspose = Pf.contextTranspose
+getDynamics :: GetContext time dyn note dyn
+getDynamics = Pf.contextDynamics
diff --git a/src/Haskore/Performance/Default.lhs b/src/Haskore/Performance/Default.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance/Default.lhs
@@ -0,0 +1,202 @@
+\subsection{Conversion functions with default settings}
+\seclabel{default-performance}
+
+\subsubsection{Examples of Player Construction}
+
+A ``default player'' called \function{Default.player} (not to be confused with
+``deaf player''!) is defined for use when none other is specified in
+the score; it also functions as a base from which other players can be
+derived. \function{Default.player} responds only to the \constructor{Velocity} note
+attribute and to the \constructor{Accent}, \constructor{Staccato}, and \constructor{Legato}
+phrase attributes. It is defined in \figref{default-Player}.
+Before reading this code, recall how players are invoked by the
+\function{Performance.fromMusic} function defined in the last section; in particular, note the
+calls to \function{playNote} and \function{interpretPhase} defined above. Then
+note:
+\begin{enumerate}
+\item \function{defltPlayNote} is the only function (even in the definition
+of \function{Performance.fromMusic}) that actually generates an event. It also modifies
+that event based on an interpretation of each note attribute by the
+function \function{defltNasHandler}.
+
+\item \function{defltNasHandler} only recognizes the \constructor{Velocity} attribute,
+which it uses to set the event velocity accordingly.
+
+\item \function{defltInterpPhrase} calls (mutually recursively)
+\function{Performance.fromMusic} to interpret a phrase,
+and then modifies the result based on
+an interpretation of each phrase attribute by the function
+\function{defltInterpPhrase}.
+
+\item \function{defltInterpPhrase} only recognizes the \constructor{Accent},
+\constructor{Staccato}, and \constructor{Legato} phrase attributes.
+For each of these it uses the numeric argument as a ``scaling'' factor
+of the volume (for
+\constructor{Accent}) and duration (for \constructor{Staccato} and \constructor{Legato}).
+Thus \expression{(Phrase (Legato 1.1) m)} effectively increases the duration
+of each note in \expression{m} by 10\% (without changing the tempo).
+\end{enumerate}
+
+It should be clear that much of the code in Figure
+\ref{default-Player} can be re-used in defining a new player.
+For example, to define a player \function{weird} that interprets note
+attributes just like \function{Default.player} but behaves differently with
+respect to phrase attributes, we could write:
+\begin{haskelllisting}
+ weird :: T
+ weird = Performance.PlayerCons {
+ pname = "Weirdo",
+ playNote = defltPlayNote defltNasHandler,
+ interpretPhrase = liftM . myPhraseInterpreter
+ notatePlayer = defltNotatePlayer ()
+ }
+\end{haskelllisting}
+and then supply a suitable definition of \function{myPhraseInterpreter}. That
+definition could also re-use code, in the following sense: suppose we
+wish to add an interpretation for \constructor{Crescendo}, but otherwise
+have \function{myPhraseInterpreter} behave just like \function{defltInterpPhrase}.
+\begin{haskelllisting}
+ myPhraseInterpreter :: PhraseAttribute -> Performance.T time dyn note -> Performance.T time dyn note
+ myPhraseInterpreter (Dyn (Crescendo x)) pf = ...
+ myPhraseInterpreter pa pf = defltInterpPhrase pa pf
+\end{haskelllisting}
+
+\begin{exercise}
+Fill in the \expression{...} in the definition of \function{myPhraseInterpreter} according
+to the following strategy: Assume $0<\expression{x}<1$. Gradually scale
+the volume of each event by a factor of $1.0$ through $1.0+\expression{x}$,
+using linear interpolation.
+\end{exercise}
+
+\begin{exercise}
+Choose some of the other phrase attributes and provide interpretations
+of them, such as \constructor{Diminuendo}, \constructor{Slurred}, \constructor{Trill}, etc.
+(The \function{trill} functions from \secref{basic-examples} may be
+useful here.)
+\end{exercise}
+
+{\small
+\begin{haskelllisting}
+
+> module Haskore.Performance.Default where
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Player as Player
+
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+
+> import qualified Haskore.Basic.Tempo as Tempo
+> import qualified Haskore.Basic.Duration as Dur
+
+> import qualified Numeric.NonNegative.Class as NonNeg
+> import qualified Numeric.NonNegative.Wrapper as NonNegW
+
+> import Prelude hiding (map)
+
+\end{haskelllisting}
+}
+
+\begin{figure}
+{\small
+\begin{haskelllisting}
+
+> -- default is a reserved keyword
+> player ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Player.T time dyn note
+> player = map "Default"
+>
+> -- a default PMap that makes everything into a Default.player
+> map ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Player.Name -> Player.T time dyn note
+> map pname =
+> Performance.PlayerCons {
+> Performance.name = pname,
+> Performance.playNote = playNote,
+> Performance.interpretPhrase = interpretPhrase,
+> Performance.notatePlayer = notatePlayer ()
+> }
+>
+> playNote :: (Fractional time, Real time) =>
+> Performance.NoteFun time dyn note
+> playNote
+> (Performance.Context curDur _ curKey curVelocity) d note =
+> TimeList.singleton 0
+> (Performance.Event {
+> Performance.eventDur = Dur.toNumber d * curDur,
+> Performance.eventTranspose = curKey,
+> Performance.eventDynamics = curVelocity,
+> Performance.eventNote = note } )
+>
+> interpretPhrase ::
+> (NonNeg.C time, Fractional time, Fractional dyn) =>
+> Performance.PhraseFun time dyn note
+> interpretPhrase (Music.Dyn (Music.Accent x)) = Player.accent x
+> interpretPhrase (Music.Art (Music.Staccato x)) = Player.staccatoAbs x
+> interpretPhrase (Music.Art (Music.Legato x)) = Player.legatoAbs x
+> interpretPhrase _ = id
+>
+> notatePlayer :: () -> Performance.NotateFun
+> notatePlayer _ = ()
+
+> context ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Context.T time dyn note
+> context =
+> Performance.Context {
+> Performance.contextPlayer = player,
+> Performance.contextDur = Tempo.metro 60 Dur.qn,
+> Performance.contextTranspose = 0,
+> Performance.contextDynamics = 1
+> }
+
+\end{haskelllisting}
+}
+\caption{Definition of default Player \function{Default.player}.}
+\figlabel{default-Player}
+\end{figure}
+
+{\small
+\begin{haskelllisting}
+
+> fromMusic ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> Music.T note -> Performance.T time dyn note
+> fromMusic =
+> Performance.fromMusic map context
+>
+> fromMusicModifyContext ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> (Context.T time dyn note -> Context.T time dyn note) ->
+> Music.T note ->
+> Performance.T time dyn note
+> fromMusicModifyContext update =
+> Performance.fromMusic
+> map
+> (update context)
+>
+> floatFromMusic :: (Ord note) =>
+> Music.T note -> Performance.T NonNegW.Float Float note
+> floatFromMusic = fromMusic
+>
+> paddedFromMusic ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> Music.T note -> Performance.Padded time dyn note
+> paddedFromMusic =
+> Performance.paddedFromMusic map context
+>
+> paddedFromMusicModifyContext ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> (Context.T time dyn note -> Context.T time dyn note) ->
+> Music.T note ->
+> Performance.T time dyn note
+> paddedFromMusicModifyContext update =
+> Performance.fromMusic
+> map
+> (update context)
+
+\end{haskelllisting}
+}
diff --git a/src/Haskore/Performance/Fancy.lhs b/src/Haskore/Performance/Fancy.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance/Fancy.lhs
@@ -0,0 +1,222 @@
+\subsection{Conversion functions with default settings}
+\seclabel{fancy-performance}
+
+{\small
+\begin{haskelllisting}
+
+> module Haskore.Performance.Fancy where
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.Player as Player
+> import qualified Haskore.Performance.Default as DefltPf
+
+> import Haskore.Performance (eventDur, )
+
+> -- import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.TimeTime as TimeListPad
+> import qualified Data.EventList.Relative.MixedTime as TimeListPad
+> import qualified Data.EventList.Relative.BodyTime as BodyTimeList
+
+> import Control.Monad.State(State(State), evalState)
+> import Control.Monad.Reader(local, )
+>
+> import qualified Numeric.NonNegative.Class as NonNeg
+> import qualified Numeric.NonNegative.Wrapper as NonNegW
+
+> import Prelude hiding (map)
+
+\end{haskelllisting}
+}
+
+\begin{figure}
+{\small
+\begin{haskelllisting}
+
+> player :: (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Player.T time dyn note
+> player = map "Fancy"
+>
+> -- a PMap that makes everything into a fancyPlayer
+> map ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> String -> Player.T time dyn note
+> map pname =
+> Performance.PlayerCons {
+> Performance.name = pname,
+> Performance.playNote = DefltPf.playNote,
+> Performance.interpretPhrase = fancyInterpretPhrase,
+> Performance.notatePlayer = DefltPf.notatePlayer ()
+> }
+>
+> processPerformance :: (Num time) =>
+> (time ->
+> (time -> time -> time,
+> time -> Performance.Event time dyn note -> Performance.Event time dyn note,
+> time)) ->
+> (Performance.PaddedWithRests time dyn note, time) ->
+> (Performance.PaddedWithRests time dyn note, time)
+> processPerformance f (pf, dur) =
+> let (fTime, fEvent, newDur) = f dur
+> procPf =
+> flip evalState 0 .
+> BodyTimeList.mapM
+> (\dt -> State $ \t -> (fTime t dt, t+dt))
+> (\ev -> State $ \t -> (fmap (fEvent t) ev, t))
+> in (TimeListPad.mapTimeTail procPf pf, newDur)
+>
+> fancyInterpretDynamic ::
+> (Fractional time, Real time, Fractional dyn) =>
+> Music.Dynamic -> Performance.Monad time dyn note -> Performance.Monad time dyn note
+> fancyInterpretDynamic dyn =
+> let loud x = local (Performance.updateDynamics (fromRational x *))
+> inflate add x dur =
+> let r = fromRational x / realToFrac dur
+> in (const id,
+> \t -> Player.changeVelocity (add (realToFrac t * r)),
+> dur)
+> in case dyn of
+> Music.Accent x -> Player.accent x
+> Music.Loudness x -> loud x
+> Music.Crescendo x -> fmap (processPerformance (inflate (+) x))
+> Music.Diminuendo x -> fmap (processPerformance (inflate subtract x))
+> -- Music.Crescendo x -> fmap (processPerformance (inflate x))
+> -- Music.Diminuendo x -> fmap (processPerformance (inflate (-x)))
+>
+> fancyInterpretTempo :: (Fractional time, Real time) =>
+> Music.Tempo -> Performance.Monad time dyn note -> Performance.Monad time dyn note
+> fancyInterpretTempo tmp =
+> let stretch add x dur =
+> let x' = fromRational x
+> r = x' / dur
+> fac t dt = add 1 (r * (2*t + dt))
+> in (\t dt -> dt * fac t dt,
+> \t (e@Performance.Event {eventDur = d}) ->
+> e{eventDur = d * fac t d },
+> dur * add 1 x')
+> in case tmp of
+> Music.Ritardando x -> fmap (processPerformance (stretch (+) x))
+> Music.Accelerando x -> fmap (processPerformance (stretch (-) x))
+> -- Music.Accelerando x -> fmap (processPerformance (stretch (\a b -> if a>=b then a-b else 0) x))
+
+> fancyInterpretArticulation :: (NonNeg.C time, Fractional time) =>
+> Music.Articulation -> Performance.Monad time dyn note -> Performance.Monad time dyn note
+> fancyInterpretArticulation art =
+> case art of
+> Music.Staccato x -> Player.staccatoAbs x
+> Music.Legato x -> Player.legatoAbs x
+> Music.Slurred x -> Player.slurredAbs x
+> _ -> id
+> {- Remaining articulations:
+> Tenuto | Marcato | Pedal | Fermata | FermataDown
+> | Breath | DownBow | UpBow | Harmonic | Pizzicato
+> | LeftPizz | BartokPizz | Swell | Wedge | Thumb | Stopped -}
+
+> fancyInterpretOrnament :: (Fractional time, Real time) =>
+> Music.Ornament -> Performance.Monad time dyn note -> Performance.Monad time dyn note
+> fancyInterpretOrnament _orn = id
+> {- Remaining ornamenations:
+> Trill | Mordent | InvMordent | DoubleMordent | Turn
+> | TrilledTurn | ShortTrill | Arpeggio | ArpeggioUp
+> | ArpeggioDown | Instruction String | Head NoteHead -}
+> {- Design Problem: To do these right we need to keep the KEY SIGNATURE
+> around so that we can determine, for example, what the trill note is.
+> Alternatively, provide an argument to Trill to carry this info. -}
+
+> fancyInterpretPhrase ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Performance.PhraseFun time dyn note
+> fancyInterpretPhrase pa =
+> case pa of
+> Music.Dyn dyn -> fancyInterpretDynamic dyn
+> Music.Tmp tmp -> fancyInterpretTempo tmp
+> Music.Art art -> fancyInterpretArticulation art
+> Music.Orn orn -> fancyInterpretOrnament orn
+
+> context ::
+> (NonNeg.C time, Fractional time, Real time, Fractional dyn) =>
+> Context.T time dyn note
+> context = DefltPf.context {Performance.contextPlayer = player}
+
+\end{haskelllisting}
+}
+\caption{Definition of Player \function{Fancy.player}.}
+\figlabel{fancy-Player}
+\end{figure}
+
+
+{\small
+\begin{haskelllisting}
+
+> fromMusic ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> Music.T note -> Performance.T time dyn note
+> fromMusic =
+> Performance.fromMusic map context
+>
+> fromMusicModifyContext ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> (Context.T time dyn note -> Context.T time dyn note) ->
+> Music.T note ->
+> Performance.T time dyn note
+> fromMusicModifyContext update =
+> Performance.fromMusic
+> map
+> (update context)
+>
+> floatFromMusic :: (Ord note) =>
+> Music.T note -> Performance.T NonNegW.Float Float note
+> floatFromMusic = fromMusic
+>
+> paddedFromMusic ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> Music.T note -> Performance.Padded time dyn note
+> paddedFromMusic =
+> Performance.paddedFromMusic map context
+>
+> doublePaddedFromMusic ::
+> (Ord note) =>
+> Music.T note -> Performance.Padded NonNegW.Double Double note
+> doublePaddedFromMusic =
+> Performance.paddedFromMusic map context
+>
+> paddedFromMusicModifyContext ::
+> (Ord note, NonNeg.C time, RealFrac time, Fractional dyn, Ord dyn) =>
+> (Context.T time dyn note -> Context.T time dyn note) ->
+> Music.T note ->
+> Performance.T time dyn note
+> paddedFromMusicModifyContext update =
+> Performance.fromMusic
+> map
+> (update context)
+
+\end{haskelllisting}
+}
+
+
+
+% fromRhythmicMusic :: (Ord drum, Ord instr, RealFrac time) =>
+% RhyMusic.T drum instr -> Performance.T time (RhyMusic.Note drum instr)
+% fromRhythmicMusic =
+% Performance.fromMusic map context
+%
+% floatFromRhythmicMusic :: (Ord drum, Ord instr) =>
+% RhyMusic.T drum instr -> Performance.T Float (RhyMusic.Note drum instr)
+% floatFromRhythmicMusic = fromRhythmicMusic
+%
+% stateFromRhythmicMusic ::
+% (Ord drum, Ord instr, Fractional time, Real time) =>
+% (RhyMusic.T drum instr) ->
+% ((Performance.T time (RhyMusic.Note drum instr), time),
+% Context.T time (RhyMusic.Note drum instr))
+% stateFromRhythmicMusic m =
+% runState (Performance.monadFromMusic map m) context
+
+% monadFromMusic ::
+% (Ord note, RealFrac time) =>
+% Music.T note ->
+% ((Performance.T time dyn note, time),
+% Context.T time dyn note)
+% monadFromMusic m =
+% runReader (Performance.monadFromMusic map m) context
diff --git a/src/Haskore/Performance/Player.lhs b/src/Haskore/Performance/Player.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Performance/Player.lhs
@@ -0,0 +1,159 @@
+
+\begin{haskelllisting}
+
+> module Haskore.Performance.Player where
+>
+> import Haskore.Music (PhraseAttribute, )
+> import qualified Haskore.Music as Music
+> -- import qualified Haskore.Performance.Context as Context
+> -- this import would cause a cycle
+> import qualified Haskore.Performance as Pf
+> -- import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Data.EventList.Relative.TimeTime as TimeListPad
+> import qualified Data.EventList.Relative.TimeMixed as TimeListPad
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Numeric.NonNegative.Class as NonNeg
+> import Haskore.Performance (eventDur, eventDynamics, )
+> import Haskore.General.Utility(mapFst)
+
+> import Control.Monad.Reader(Reader, asks, liftM)
+>
+> type T time dyn note = Pf.Player time dyn note
+> -- constructors can't be renamed, we might use a function instead
+> -- cons = Pf.PlayerCons
+>
+> type Name = Music.PlayerName
+> type Map time dyn note = Pf.PlayerMap time dyn note
+>
+>
+> type PhraseInterpreter time dyn note =
+> PhraseAttribute -> (Pf.T time dyn note, time) -> (Pf.T time dyn note, time)
+>
+> type EventModifier time dyn note =
+> Pf.Event time dyn note -> Pf.Event time dyn note
+>
+> changeVelocity :: Num dyn => (dyn -> dyn) ->
+> EventModifier time dyn note
+> changeVelocity f =
+> (\e -> e {eventDynamics = f (eventDynamics e)})
+>
+> changeDur :: Num time => (time -> time) ->
+> EventModifier time dyn note
+> changeDur f =
+> (\e -> e {eventDur = f (eventDur e)})
+
+\end{haskelllisting}
+
+
+\figref{fancy-Player} defines a relatively sophisticated player
+called \function{fancyPlayer} that knows all that \function{Player.deflt} knows, and
+much more.
+
+All three articulations \constructor{Staccato}, \constructor{Legato},
+\constructor{Slurred} are interpreted
+as changing the duration of the notes proportionally.
+That's why they have the suffix \code{Rel} for {\em relative}.
+\begin{itemize}
+\item
+The function \function{legatoRel}
+takes a ratio of each note's duration.
+In order to obtain a real Legato effect
+the value must be larger than 1.
+\item
+The function \function{slurredRel} is similar to \function{legatoRel}
+but it doesn't extend the duration of the {\em last} note(s).
+\item
+The function \function{staccatoRel}
+divides the note durations by constant factor.
+In order to obtain a real Staccato effect
+the value must be larger than 1.
+\end{itemize}
+
+
+\begin{haskelllisting}
+
+> staccatoRel, legatoRel, slurredRel :: (NonNeg.C time, Fractional time) =>
+> Dur.T -> Pf.Monad time dyn note -> Pf.Monad time dyn note
+> staccatoRel x = mapEvents (changeDur (/ Dur.toNumber x))
+> legatoRel x = mapEvents (changeDur (* Dur.toNumber x))
+> slurredRel x = mapInitEvents (changeDur (* Dur.toNumber x))
+
+> mapInitEvents :: (NonNeg.C time, Num time) =>
+> EventModifier time dyn note ->
+> Pf.Monad time dyn note -> Pf.Monad time dyn note
+> mapInitEvents f =
+> let -- modify durations of all notes except those with the latest start time
+> aux =
+> TimeListPad.flatten .
+> TimeListPad.mapTimeInit
+> (TimeListPad.mapBodyInit
+> (TimeListPad.mapBody (map (fmap f)))) .
+> TimeListPad.collectCoincident
+> in liftM (mapFst aux)
+
+> mapEvents :: EventModifier time dyn note ->
+> Pf.Monad time dyn note -> Pf.Monad time dyn note
+> mapEvents f = liftM (mapFst (TimeListPad.mapBody (fmap f)))
+
+\end{haskelllisting}
+
+In contrast to the relative interpretations above,
+we feel that somehow absolute changes are more useful.
+That's why we make these functions the default for the fancy player.
+These function expect regular note durations,
+that is ratios of a whole note.
+\begin{itemize}
+\item
+The functions \function{legatoAbs} and \function{slurredAbs}
+prolong notes by a fix amount.
+That is the overlap (if no rests are between) is constant.
+\item
+\function{staccatoAbs} replaces the note durations by a fix amount.
+\end{itemize}
+
+\begin{haskelllisting}
+
+> staccatoAbs, legatoAbs, slurredAbs :: (NonNeg.C time, Fractional time) =>
+> Dur.T -> Pf.Monad time dyn note -> Pf.Monad time dyn note
+> staccatoAbs dur pf =
+> getDurModifier const dur >>= flip mapEvents pf
+> legatoAbs dur pf =
+> getDurModifier (+) dur >>= flip mapEvents pf
+> slurredAbs dur pf =
+> getDurModifier (+) dur >>= flip mapInitEvents pf
+>
+> getDurModifier :: (Fractional time) =>
+> (time -> time -> time) -> Dur.T ->
+> Reader (Pf.Context time dyn note) (EventModifier time dyn note)
+> getDurModifier f dur =
+> do tempo <- asks Pf.contextDur
+> return (changeDur (f (Dur.toNumber dur * tempo)))
+
+\end{haskelllisting}
+
+The behavior of \expression{(Ritardando x)} can be explained as
+follows. We'd like to ``stretch'' the time of each event by a factor
+from $0$ to $x$, linearly interpolated based on how far along the
+musical phrase the event occurs. I.e., given a start time $t_0$ for
+the first event in the phrase, total phrase duration $D$, and event
+time $t$, the new event time $t'$ is given by:
+\[ t' = \left(1 + \frac{t-t_0}{D}\cdot x\right)\cdot(t-t_0) + t_0 \]
+Further, if $d$ is the duration of the event, then the end of
+the event $t+d$ gets stretched to a new time $t_d'$ given by:
+\[ t_d' = \left(1 + \frac{t+d-t_0}{D}\cdot x\right)\cdot(t+d-t_0) + t_0 \]
+The difference $t_d' - t'$ gives us the new, stretched duration $d'$,
+which after simplification is:
+\[ d' = \left(1 + \frac{2\cdot(t-t_0)+d}{D}\cdot x\right)\cdot d \]
+\constructor{Accelerando} behaves in exactly the same way, except that it
+shortens event times rather than lengthening them. And, a similar but
+simpler strategy explains the behaviors of \constructor{Crescendo} and
+\constructor{Diminuendo}.
+
+
+\begin{haskelllisting}
+
+> accent :: (Fractional dyn) =>
+> Rational -> Pf.Monad time dyn note -> Pf.Monad time dyn note
+> accent x = mapEvents (changeVelocity (fromRational x +))
+
+\end{haskelllisting}
diff --git a/src/Haskore/Process/Format.lhs b/src/Haskore/Process/Format.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Process/Format.lhs
@@ -0,0 +1,219 @@
+
+\subsection{Pretty printing Music}
+
+This module aims at formatting (pretty printing) of musical objects with Haskell syntax.
+This is particularly useful for converting algorithmically generated music
+into Haskell code that can be edited and furtherly developed.
+
+\begin{haskelllisting}
+
+> module Haskore.Process.Format where
+>
+> import qualified Language.Haskell.Pretty as Pretty
+> import qualified Language.Haskell.Syntax as Syntax
+> import qualified Language.Haskell.Parser as Parser
+
+> import qualified Haskore.Basic.Duration as Duration
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody as Melody
+> import qualified Haskore.Melody.Standard as StdMelody
+> import qualified Medium.Controlled as CtrlMedium
+
+> import Medium.Controlled.ContextFreeGrammar as Grammar
+> import qualified Haskore.General.Map as Map
+> import qualified Data.Ratio as Ratio
+> import qualified Data.Char as Char
+> import Data.List(intersperse)
+
+\end{haskelllisting}
+
+
+Format a grammar as computed with the \module{Medium.Controlled.ContextFreeGrammar}.
+
+\begin{haskelllisting}
+
+> prettyGrammarMedium :: (Show prim, Show control) =>
+> Grammar.T String control prim -> String
+> prettyGrammarMedium = prettyGrammar controlGen prim
+
+> prettyGrammarMelody ::
+> Grammar.T String Music.Control (Music.Primitive StdMelody.Note) -> String
+> prettyGrammarMelody = prettyGrammar control primMelody
+
+> prettyGrammar ::
+> (Int -> control -> (Int -> ShowS) -> ShowS) ->
+> (Int -> prim -> ShowS) ->
+> Grammar.T String control prim -> String
+> prettyGrammar controlSyntax primSyntax g =
+> let text = unlines (map (flip id "" . bind controlSyntax primSyntax) g)
+> Parser.ParseOk (Syntax.HsModule _ _ _ _ code) =
+> Parser.parseModule text
+> in unlines (map Pretty.prettyPrint code) -- show code
+
+\end{haskelllisting}
+
+Format a \code{Medium} object that contains references to other medium objects.
+
+\begin{haskelllisting}
+
+> bind ::
+> (Int -> control -> (Int -> ShowS) -> ShowS) ->
+> (Int -> prim -> ShowS) ->
+> (String, Grammar.TagMedium String control prim) -> ShowS
+> bind controlSyntax primSyntax (key, ms) =
+> showString key . showString " = " . tagMedium 0 controlSyntax primSyntax ms
+
+> tagMedium ::
+> Int ->
+> (Int -> control -> (Int -> ShowS) -> ShowS) ->
+> (Int -> prim -> ShowS) ->
+> Grammar.TagMedium String control prim -> ShowS
+> tagMedium prec controlSyntax primSyntax m =
+> let primSyntax' _ (Grammar.Call s) = showString s
+> primSyntax' prec' (Grammar.CallMulti n s) =
+> enclose prec' 0
+> (showString "serial $ replicate " . showsPrec 10 n .
+> showString " " . showString s)
+> primSyntax' prec' (Grammar.Prim p) = primSyntax prec' p
+> in CtrlMedium.foldList
+> (flip primSyntax')
+> (listFunc "serial")
+> (listFunc "parallel")
+> (flip . flip controlSyntax)
+> m prec
+
+> list :: [Int -> ShowS] -> ShowS
+> list = foldr (.) (showString "]") . (showString "[" :) .
+> intersperse (showString ",") . map (flip id 0)
+
+> listFunc :: String -> [Int -> ShowS] -> Int -> ShowS
+> listFunc func ps prec =
+> enclose prec 10 (showString func . showString " " . list ps)
+
+> prim :: (Show p) => Int -> p -> ShowS
+> prim prec p = enclose prec 10 (showString "prim " . showsPrec 10 p)
+
+> dummySrcLoc :: Syntax.SrcLoc
+> dummySrcLoc = Syntax.SrcLoc {Syntax.srcFilename = "",
+> Syntax.srcLine = 0,
+> Syntax.srcColumn = 0}
+
+\end{haskelllisting}
+
+Of course we also want to format plain music,
+that is music without tags.
+
+\begin{haskelllisting}
+
+> prettyMelody :: StdMelody.T -> String
+> prettyMelody m = prettyExp (melody 0 m "")
+
+> prettyExp :: String -> String
+> prettyExp text =
+> let Parser.ParseOk (Syntax.HsModule _ _ _ _
+> [Syntax.HsPatBind _ _ (Syntax.HsUnGuardedRhs code) _]) =
+> Parser.parseModule ("dummy = "++text)
+> in Pretty.prettyPrint code
+
+\end{haskelllisting}
+
+Now we go to define functions that handle
+the particular primitives of music.
+Note that \code{Control} information
+and \code{NoteAttribute}s are printed as atoms.
+
+\begin{haskelllisting}
+
+> melody :: Int -> StdMelody.T -> ShowS
+> melody prec m =
+> Music.foldList
+> (flip . flip atom)
+> (flip . flip control)
+> (listFunc "line")
+> (listFunc "chord")
+> m prec
+
+> primMelody :: Int -> Music.Primitive StdMelody.Note -> ShowS
+> primMelody prec (Music.Atom d at) = atom prec d at
+
+> atom :: Show attr =>
+> Int -> Duration.T -> Music.Atom (Melody.Note attr) -> ShowS
+> atom prec d = maybe (rest prec d) (note prec d)
+
+> note :: Show attr =>
+> Int -> Duration.T -> Melody.Note attr -> ShowS
+> note prec d (Melody.Note nas (o,pc)) =
+> enclose prec 10 (showString (map Char.toLower (show pc)) .
+> showString " " . showsPrec 10 o .
+> showString " " . durSyntax id "n" d .
+> showString " " . showsPrec 10 nas)
+
+> rest :: Int -> Duration.T -> ShowS
+> rest prec d =
+> durSyntax (\dStr -> enclose prec 10 (showString "rest " . dStr)) "nr" d
+
+> controlGen :: (Show control) => Int -> control -> (Int -> ShowS) -> ShowS
+> controlGen prec c m =
+> enclose prec 10
+> (showString "control " . showsPrec 10 c .
+> showString " " . m 10)
+
+> control :: Int -> Music.Control -> (Int -> ShowS) -> ShowS
+> control prec c m =
+> let controlSyntax name arg =
+> enclose prec 10
+> (showString name . showString " " . arg . showString " " . m 10)
+> in case c of
+> Music.Tempo d -> controlSyntax "changeTempo" (showDur 10 d)
+> Music.Transpose p -> controlSyntax "transpose" (showsPrec 10 p)
+> Music.Player p -> controlSyntax "setPlayer" (showsPrec 10 p)
+> Music.Phrase p -> controlSyntax "phrase" (showsPrec 10 p)
+
+\end{haskelllisting}
+
+Note that the call to \code{show} can't be moved
+from the \code{controlSyntax} calls in \code{control}
+to \code{controlSyntax}
+because that provokes a compiler problem, namely
+
+\begin{haskelllisting}
+
+ Mismatched contexts
+ When matching the contexts of the signatures for
+ controlSyntax :: forall a.
+ (Show a) =>
+ String -> a -> StdMelody.T -> Language.Haskell.Syntax.HsExp
+ control :: Music.Primitive -> Language.Haskell.Syntax.HsExp
+ The signature contexts in a mutually recursive group should all be identical
+ When generalising the type(s) for controlSyntax, control
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> durSyntax :: (ShowS -> ShowS) -> String -> Duration.T -> ShowS
+> durSyntax showRatio suffix d =
+> maybe
+> (showRatio (showDur 10 d))
+> (\s -> showString (s++suffix))
+> (Map.lookup Duration.nameDictionary d)
+
+> showDur :: Int -> Duration.T -> ShowS
+> showDur prec =
+> (\d -> enclose prec 7
+> (shows (Ratio.numerator d) .
+> showString "%+" .
+> shows (Ratio.denominator d))) .
+> Duration.toRatio
+
+\end{haskelllisting}
+
+Enclose an expression in parentheses if the inner operator
+has at most the precedence of the outer operator.
+
+\begin{haskelllisting}
+
+> enclose :: Int -> Int -> ShowS -> ShowS
+> enclose outerPrec innerPrec = showParen (outerPrec >= innerPrec)
+
+\end{haskelllisting}
diff --git a/src/Haskore/Process/Optimization.lhs b/src/Haskore/Process/Optimization.lhs
new file mode 100644
--- /dev/null
+++ b/src/Haskore/Process/Optimization.lhs
@@ -0,0 +1,262 @@
+
+\subsection{Optimization}
+\seclabel{optimization}
+
+This module provides functions that simplify the structure
+of a \code{Music.T} according to the rules proven in
+\secref{equivalence}
+
+\begin{haskelllisting}
+
+> module Haskore.Process.Optimization where
+
+> import qualified Medium.Controlled.List as CtrlMediumList
+> import qualified Medium.Controlled as CtrlMedium
+> import qualified Haskore.Music as Music
+> import Medium.Controlled.List (serial, parallel)
+> import Haskore.General.Utility (toMaybe, partitionMaybe)
+> import Data.Maybe (catMaybes, fromMaybe)
+
+\end{haskelllisting}
+
+\code{Music.T} objects that come out of \code{ReadMidi.toMusic}
+almost always contain redundancies,
+like rests of zero duration and redundant instrument specifications.
+The function \function{Optimization.all}
+reduces the redundancy to make a \type{Music.T} file
+less cluttered and more efficient to use.
+\begin{haskelllisting}
+
+> all, rest, composition, duration, tempo, transpose, volume ::
+> Music.T note -> Music.T note
+> all = tempo . transpose . volume . singleton . composition . rest
+
+\end{haskelllisting}
+
+Remove rests of zero duration.
+\begin{haskelllisting}
+
+> rest = Music.mapList
+> (,)
+> (flip const)
+> (filter (not . isZeroRest))
+> (filter (not . isZeroRest))
+
+> isZeroRest :: Music.T note -> Bool
+> isZeroRest =
+> Music.switchList
+> (\d at -> d==0 && maybe True (const False) at)
+> (const (const False))
+> (const False)
+> (const False)
+
+\end{haskelllisting}
+
+Remove empty parallel and serial compositions
+and controllers of empty music.
+\begin{haskelllisting}
+
+> composition = fromMaybe (Music.rest 0) . Music.foldList
+> (\d -> Just . Music.atom d)
+> (fmap . Music.control)
+> ((\ms -> toMaybe (not (null ms)) (serial ms)) . catMaybes)
+> ((\ms -> toMaybe (not (null ms)) (parallel ms)) . catMaybes)
+
+\end{haskelllisting}
+
+Remove any atom of zero duration.
+This is not really an optimization but a hack to get rid
+of MIDI NoteOn and NoteOff events at the same time point.
+\begin{haskelllisting}
+
+> duration = fromMaybe (Music.rest 0) . Music.foldList
+> (\d -> toMaybe (d /= 0) . Music.atom d)
+> (fmap . Music.control)
+> (Just . serial . catMaybes)
+> (Just . parallel . catMaybes)
+
+\end{haskelllisting}
+
+The control structures for tempo, transposition and change of instruments
+can be handled very similar using the following routines.
+The function \function{mergeControl'} checks
+if nested controllers are of the same kind.
+If they are then they are merged into one.
+The function would be much simpler
+if it would be implemented for specific constructors,
+but we want to stay independent from the particular data structure,
+which is already quite complex.
+\begin{haskelllisting}
+
+> mergeControl' ::
+> (Music.Control -> Maybe a)
+> -> (a -> Music.T note -> Music.T note)
+> -> (a -> a -> a)
+> -> Music.T note
+> -> Music.T note
+> mergeControl' extract control merge =
+> let fcSub c m = fmap (flip (,) m) (extract c)
+> fc' c0 m0 x0 =
+> maybe (Music.control c0 m0)
+> (\(x1,m1) -> control (merge x0 x1) m1)
+> (Music.switchList (const (const Nothing))
+> fcSub (const Nothing) (const Nothing) m0)
+> fc c m = maybe (Music.control c m)
+> (fc' c m)
+> (extract c)
+> in Music.foldList
+> Music.atom fc Music.line Music.chord
+
+\end{haskelllisting}
+
+The following function collects neighboured controllers into groups,
+extracts controllers of a specific type
+and prepends a controller to the list of neighboured controllers,
+which has the total effect of the extracted controllers.
+This change of ordering is always possible
+because in the current set of controllers
+two neighboured controllers of different type commutes.
+E.g. it is
+\code{transpose n . changeTempo r == changeTempo r . transpose n}
+and thus the following simplification
+\code{transpose 1 . changeTempo 2 . transpose 3 == transpose 4 . changeTempo 2}
+is possible.
+
+\begin{haskelllisting}
+
+> mergeControl, mergeControlCompact ::
+> (Music.Control -> Maybe a)
+> -> (a -> Music.T note -> Music.T note)
+> -> (a -> a -> a)
+> -> Music.T note
+> -> Music.T note
+> mergeControlCompact extract control merge =
+> let collectControl =
+> Music.switchList
+> (\d n -> ([], Music.atom d n))
+> (\c m -> let cm = collectControl m
+> in (c : fst cm, snd cm))
+> ((,) [] . Music.line . map recurse)
+> ((,) [] . Music.chord . map recurse)
+> recurse m =
+> let cm = collectControl m
+> (xs, cs') = partitionMaybe extract (fst cm)
+> x = foldl1 merge xs
+> collectedCtrl = if null xs then id else control x
+> in collectedCtrl (foldr id (snd cm) (map Music.control cs'))
+> in recurse
+
+> -- more intuitive implementation
+> mergeControl extract control merge =
+> -- flattenControllers .
+> -- CtrlMediumList.mapControl
+> CtrlMedium.foldList
+> CtrlMediumList.prim
+> CtrlMediumList.serial
+> CtrlMediumList.parallel
+> (\cs cm ->
+> let (xs, cs') = partitionMaybe extract cs
+> collectedCtrl =
+> if null xs then id else control (foldl1 merge xs)
+> in collectedCtrl (foldr id cm (map Music.control cs'))) .
+> cumulateControllers
+
+> cumulateControllers ::
+> CtrlMediumList.T control a
+> -> CtrlMediumList.T [control] a
+> cumulateControllers =
+> CtrlMedium.foldList
+> CtrlMediumList.prim
+> CtrlMediumList.serial
+> CtrlMediumList.parallel
+> (\c m ->
+> let cm = CtrlMedium.control [c] m
+> in CtrlMedium.switchList
+> (const cm)
+> (const cm)
+> (const cm)
+> (\cs m' -> CtrlMedium.control (c:cs) m')
+> m)
+
+> flattenControllers ::
+> CtrlMediumList.T [control] a
+> -> CtrlMediumList.T control a
+> flattenControllers =
+> CtrlMedium.foldList
+> CtrlMediumList.prim
+> CtrlMediumList.serial
+> CtrlMediumList.parallel
+> (flip (foldr id) . map CtrlMedium.control)
+
+\end{haskelllisting}
+
+The function \function{removeNeutral} removes controllers
+that have no effect.
+\begin{haskelllisting}
+
+> removeNeutral :: (Music.Control -> Bool) -> Music.T note -> Music.T note
+> removeNeutral isNeutral =
+> let fc c m = if isNeutral c
+> then m
+> else Music.control c m
+> in Music.foldList Music.atom fc Music.line Music.chord
+
+\end{haskelllisting}
+
+
+Remove redundant \code{Tempo}s.
+\begin{haskelllisting}
+
+> tempo =
+> let maybeTempo (Music.Tempo t) = Just t
+> maybeTempo _ = Nothing
+> in removeNeutral (== Music.Tempo 1) .
+> mergeControl maybeTempo Music.changeTempo (*)
+
+\end{haskelllisting}
+
+Remove redundant \code{Transpose}s.
+\begin{haskelllisting}
+
+> transpose =
+> let maybeTranspose (Music.Transpose t) = Just t
+> maybeTranspose _ = Nothing
+> in removeNeutral (== Music.Transpose 0) .
+> mergeControl maybeTranspose Music.transpose (+)
+
+\end{haskelllisting}
+
+Change repeated Volume Note Attributes to Phrase Attributes.
+\begin{haskelllisting}
+
+> volume =
+> let maybeLoudness (Music.Phrase (Music.Dyn (Music.Loudness t))) = Just t
+> maybeLoudness _ = Nothing
+> in removeNeutral (== Music.Phrase (Music.Dyn (Music.Loudness 1))) .
+> mergeControl maybeLoudness Music.loudness1 (*)
+
+\end{haskelllisting}
+
+Eliminate \code{Serial} and \code{Parallel} composition
+if they contain only one member.
+This can be done very general for \type{CtrlMedium.T}.
+We have also a version which works on \type{Music.T}.
+Since the medium data type supports controllers
+there is no longer a real difference between these two functions.
+\begin{haskelllisting}
+
+> singletonMedium ::
+> CtrlMediumList.T control a -> CtrlMediumList.T control a
+> singletonMedium =
+> CtrlMedium.foldList CtrlMediumList.prim
+> (\ms -> case ms of {[x] -> x; _ -> serial ms})
+> (\ms -> case ms of {[x] -> x; _ -> parallel ms})
+> (CtrlMedium.control)
+
+> singleton :: Music.T note -> Music.T note
+> singleton =
+> Music.foldList Music.atom Music.control
+> (\ms -> case ms of {[x] -> x; _ -> Music.line ms})
+> (\ms -> case ms of {[x] -> x; _ -> Music.chord ms})
+
+\end{haskelllisting}
diff --git a/src/Medium.hs b/src/Medium.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium.hs
@@ -0,0 +1,59 @@
+module Medium where
+
+import qualified Medium.Temporal as Temporal
+
+
+infixr 7 +:+ {- like multiplication -}
+infixr 6 =:= {- like addition -}
+
+
+class Construct medium where
+ prim :: a -> medium a
+
+ {- for easy compatibility with Haskore 2000 songs
+ replace :+: by +:+ and :=: by =:= -}
+ (+:+), (=:=) :: medium a -> medium a -> medium a
+
+ serial, parallel :: Temporal.C a => [medium a] -> medium a
+ serial1, parallel1 :: [medium a] -> medium a
+
+class Construct medium => C medium where
+ {- Do actions on each (virtual) constructor, don't recurse. -}
+ switchBinary ::
+ (a -> b) -> (medium a -> medium a -> b) -> (medium a -> medium a -> b)
+ -> (b -> medium a -> b)
+ switchList :: (a -> b) -> ([medium a] -> b) -> ([medium a] -> b)
+ -> medium a -> b
+
+
+{- A variant of fmap that does not only allow manipulation of primitives
+ but also of the compositions.
+ Though the structure must be preserved. -}
+mapList :: (Temporal.C b, Medium.C medium) =>
+ (a->b) -> ([medium b]->[medium b]) -> ([medium b]->[medium b]) -> medium a -> medium b
+mapList f g h = foldList (prim . f) (serial . g) (parallel . h)
+
+mapListFlat :: (Temporal.C b, Medium.C medium) =>
+ (a -> b) -> ([medium a] -> [medium b]) -> ([medium a] -> [medium b]) -> medium a -> medium b
+mapListFlat f g h = switchList (prim . f) (serial . g) (parallel . h)
+
+
+{- This is even more general than mapList -}
+foldList :: Medium.C medium => (a->b) -> ([b]->b) -> ([b]->b) -> medium a -> b
+foldList f g h =
+ let recurse = map (foldList f g h)
+ in switchList f (g . recurse) (h . recurse)
+
+foldBin :: Medium.C medium => (a->b) -> (b->b->b) -> (b->b->b) -> b -> medium a -> b
+foldBin f g h z =
+ -- foldList f (foldr1 g) (foldr1 h)
+ -- this implementation preserves the structure of the binary tree
+ let recurse op x y = foldBin f g h z x `op` foldBin f g h z y
+ in switchBinary f (recurse g) (recurse h) z
+
+
+listMediumFromAny :: (Construct dst, C src, Temporal.C a) => src a -> dst a
+listMediumFromAny = foldList prim serial parallel
+
+binaryMediumFromAny :: (Construct dst, C src) => dst a -> src a -> dst a
+binaryMediumFromAny z = foldBin prim (+:+) (=:=) z
diff --git a/src/Medium/Controlled.hs b/src/Medium/Controlled.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Controlled.hs
@@ -0,0 +1,52 @@
+module Medium.Controlled where
+
+-- import qualified Medium
+-- import qualified Medium.Temporal as Temporal
+
+
+class C medium where
+ control :: (control -> medium control a -> medium control a)
+
+ {- Do actions on each (virtual) constructor, don't recurse. -}
+ switchBinary ::
+ (a -> b) ->
+ (medium control a -> medium control a -> b) ->
+ (medium control a -> medium control a -> b) ->
+ (control -> medium control a -> b) ->
+ (b -> medium control a -> b)
+ switchList ::
+ (a -> b) ->
+ ([medium control a] -> b) ->
+ ([medium control a] -> b) ->
+ (control -> medium control a -> b) ->
+ medium control a -> b
+
+
+{-
+{- A variant of fmap that does not only allow manipulation of primitives
+ but also of the compositions.
+ Though the structure must be preserved. -}
+mapList :: (Medium.Temporal.C b, Medium.C medium) =>
+ (a->b) -> ([medium b]->[medium b]) -> ([medium b]->[medium b]) -> medium a -> medium b
+mapList f g h = foldList (prim . f) (serial . g) (parallel . h)
+
+mapListFlat :: (Medium.Temporal.C b, Medium.C medium) =>
+ (a -> b) -> ([medium a] -> [medium b]) -> ([medium a] -> [medium b]) -> medium a -> medium b
+mapListFlat f g h = switchList (prim . f) (serial . g) (parallel . h)
+-}
+
+
+{- This is even more general than mapList -}
+foldList :: C medium =>
+ (a->b) -> ([b]->b) -> ([b]->b) -> (c->b->b) -> medium c a -> b
+foldList f g h k =
+ let recurse = foldList f g h k
+ recurseAll = map recurse
+ in switchList f (g . recurseAll) (h . recurseAll) (\c -> k c . recurse)
+
+foldBin :: C medium =>
+ (a->b) -> (b->b->b) -> (b->b->b) -> (c->b->b) -> b -> medium c a -> b
+foldBin f g h k z =
+ let recurse = foldBin f g h k z
+ recurseAll op x y = recurse x `op` recurse y
+ in switchBinary f (recurseAll g) (recurseAll h) (\c -> k c . recurse) z
diff --git a/src/Medium/Controlled/ContextFreeGrammar.lhs b/src/Medium/Controlled/ContextFreeGrammar.lhs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Controlled/ContextFreeGrammar.lhs
@@ -0,0 +1,131 @@
+
+\subsection{Structure Analysis}
+
+This module contains a function which builds
+a hierarchical music object from a serial one.
+This is achieved by searching for long common infixes.
+A common infix is replaced by a single object
+at each occurence.
+
+This module proofs the sophistication of the separation
+between general arrangement of some objects as provided by the \module{Medium}
+and the special needs of music provided by the \module{Music}.
+It's possible to formulate these algorithms without the knowledge of Music
+and we can insert the type \code{Tag} to distinguish
+between media primitives and macro calls.
+The only drawback is that it is not possible to descend
+into controlled sub-structures, like Tempo and Trans.
+
+\begin{haskelllisting}
+
+> module Medium.Controlled.ContextFreeGrammar
+> (T, Tag(..), TagMedium, fromMedium, toMedium) where
+
+> import qualified Medium.Controlled.List as CtrlMediumList
+> import qualified Medium.Controlled as CtrlMedium
+> import Medium.Plain.ContextFreeGrammar
+> (Tag(..), joinTag, replaceInfix,
+> whileM, smallestCycle, maximumCommonInfixMulti)
+> import Medium (prim, serial1, parallel1)
+
+> import Data.Maybe (fromJust)
+> import qualified Haskore.General.Map as Map
+
+> import Control.Monad.State (State(State), execState)
+
+\end{haskelllisting}
+
+Condense all common infixes down to length 'thres'.
+The infixes are replaced by some marks using the constructor Left.
+They can be considered as macros or
+as non-terminals in a grammar.
+The normal primitives are preserved with constructor Right.
+We end up with a context-free grammar of the media.
+
+\begin{haskelllisting}
+
+> type TagMedium key control prim = CtrlMediumList.T control (Tag key prim)
+
+> type T key control prim = [(key, TagMedium key control prim)]
+
+> fromMedium :: (Ord key, Ord control, Ord prim) =>
+> [key] -> Int -> CtrlMediumList.T control prim -> T key control prim
+> fromMedium (key:keys) thres m =
+> let action = whileM (>= thres) (map (State . condense) keys)
+> -- action = sequence (take 1 (map (State . condense) keys))
+> in reverse $ execState action [(key, fmap Prim m)]
+> fromMedium _ _ _ =
+> error ("No key given."++
+> " Please provide an infinite or at least huge number of macro names.")
+
+\end{haskelllisting}
+
+The inverse of \code{fromMedium}: Expand all macros.
+Cyclic macro references shouldn't be a problem
+if it is possible to resolve the dependencies.
+We manage the grammar in the dictionary \code{dict}.
+Now a naive way for expanding the macros
+is to recurse into each macro call manually
+using lookups to \code{dict}.
+This would imply that we need new memory for each expansion of the same macro.
+We have chosen a different approach:
+We map \code{dict} to a new dictionary \code{dict'}
+which contains the expanded versions of each Medium.
+For expansion we don't use repeated lookups to \code{dict}
+but we use only one lookup to \code{dict'}
+-- which contains the fully expanded version of the considered Medium.
+This method is rather the same as
+if you write Haskell values that invokes each other.
+
+The function \code{expand} computes the expansion for each key and
+the function \code{toMedium} computes the expansion of the first macro.
+Thus \code{toMedium} quite inverts \code{fromMedium}.
+
+\begin{haskelllisting}
+
+> toMedium :: (Show key, Ord key, Ord prim) =>
+> T key control prim -> CtrlMediumList.T control prim
+> toMedium = snd . head . expand
+
+> expand :: (Show key, Ord key, Ord prim) =>
+> T key control prim -> [(key, CtrlMediumList.T control prim)]
+> expand grammar =
+> let notFound key = error ("The non-terminal '" ++ show key ++ "' is unknown.")
+> dict = Map.fromList grammar
+> dict' = Map.map (CtrlMedium.foldList expandSub serial1 parallel1
+> CtrlMedium.control) dict
+> expandSub (Prim p) = prim p
+> expandSub (Call key) =
+> Map.findWithDefault dict' (notFound key) key
+> expandSub (CallMulti n key) =
+> serial1 (replicate n (Map.findWithDefault dict' (notFound key) key))
+> in map (fromJust . Map.lookup (Map.mapWithKey (,) dict') . fst) grammar
+
+\end{haskelllisting}
+
+Find the longest common infix over all parts of the music
+and replace it in all of them.
+
+\begin{haskelllisting}
+
+> condense :: (Ord key, Ord control, Ord prim) =>
+> key
+> -> T key control prim
+> -> (Int, T key control prim)
+> condense key x =
+> let getSerials = CtrlMedium.switchList
+> (const [])
+> (\xs -> xs : concatMap getSerials xs)
+> (\xs -> concatMap getSerials xs)
+> (const getSerials)
+> infx = smallestCycle (maximumCommonInfixMulti length
+> (concatMap (getSerials . snd) x))
+> absorbSingleton _ [m] = m
+> absorbSingleton collect ms = collect ms
+> replaceRec = CtrlMedium.foldList prim
+> (absorbSingleton serial1 . map joinTag . replaceInfix key infx)
+> (absorbSingleton parallel1)
+> (CtrlMedium.control)
+> in (length infx, (key, serial1 infx) : map (\(k, ms) -> (k, replaceRec ms)) x)
+
+\end{haskelllisting}
diff --git a/src/Medium/Controlled/List.hs b/src/Medium/Controlled/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Controlled/List.hs
@@ -0,0 +1,134 @@
+module Medium.Controlled.List where
+
+import qualified Medium.Controlled as CtrlMedium
+import qualified Medium.Plain.List as ListMedium
+import qualified Medium
+import qualified Medium.Temporal as Temporal
+import Haskore.General.Utility(maximum0)
+
+import Control.Applicative (liftA, )
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(sequenceA))
+import qualified Data.Traversable as Traversable
+
+{- |
+Medium type with a controller constructor.
+-}
+data T control content =
+ Primitive content -- ^ primitive content
+ | Serial [T control content] -- ^ sequential composition
+ | Parallel [T control content] -- ^ parallel composition
+ | Control control (T control content) -- ^ controller
+ deriving (Show, Eq, Ord {- for use in FiniteMap -})
+
+
+instance Medium.Construct (T control) where
+ prim = Primitive
+
+ (+:+) x y = serial (serialToList x ++ serialToList y)
+ (=:=) x y = parallel (parallelToList x ++ parallelToList y)
+
+
+ serial = serial
+ parallel = parallel
+
+ serial1 = serial
+ parallel1 = parallel
+
+
+
+instance CtrlMedium.C T where
+ control = Control
+
+ switchBinary f _ _ _ _ (Primitive x) = f x
+ switchBinary _ g _ _ _ (Serial (m:ms)) = g m (Serial ms)
+ switchBinary _ _ h _ _ (Parallel (m:ms)) = h m (Parallel ms)
+ switchBinary _ _ _ k _ (Control c m) = k c m
+ switchBinary _ _ _ _ z _ = z
+
+ switchList f _ _ _ (Primitive x) = f x
+ switchList _ g _ _ (Serial m) = g m
+ switchList _ _ h _ (Parallel m) = h m
+ switchList _ _ _ k (Control c m) = k c m
+
+
+instance Functor (T control) where
+ fmap f = CtrlMedium.foldList (Primitive . f) Serial Parallel Control
+-- fmap = Traversable.fmapDefault
+
+instance Foldable (T control) where
+ foldMap = Traversable.foldMapDefault
+
+instance Traversable (T control) where
+ sequenceA =
+ CtrlMedium.foldList
+ (liftA Primitive)
+ (liftA Serial . sequenceA)
+ (liftA Parallel . sequenceA)
+ (liftA . Control)
+
+instance (Temporal.C a, Temporal.Control control) =>
+ Temporal.C (T control a) where
+ dur = CtrlMedium.foldList Temporal.dur sum maximum0 Temporal.controlDur
+ none = Primitive . Temporal.none
+
+
+{-
+This behaves identical to Medium.Binary,
+if the top most constructor is no serial composition
+it returns a single element list.
+-}
+serialToList, parallelToList :: T control a -> [T control a]
+
+serialToList (Serial ns) = ns
+serialToList n = [n]
+
+parallelToList (Parallel ns) = ns
+parallelToList n = [n]
+
+
+prim :: a -> T control a
+prim = Primitive
+
+serial, parallel :: [T control a] -> T control a
+serial = Serial
+parallel = Parallel
+
+
+
+fromMedium :: (Medium.C src) => src a -> T control a
+fromMedium = Medium.foldList Primitive Serial Parallel
+
+toMediumList :: T control a -> ListMedium.T a
+toMediumList =
+ CtrlMedium.foldList ListMedium.Primitive
+ ListMedium.Serial ListMedium.Parallel (flip const)
+
+
+
+{- A variant of fmap that does not only allow manipulation of primitives
+ but also of the compositions.
+ Though the structure must be preserved. -}
+mapList ::
+ (a -> b) ->
+ ([T control b] -> [T control b]) ->
+ ([T control b] -> [T control b]) ->
+ (control -> T control b -> T control b) ->
+ T control a -> T control b
+mapList f g h k =
+ CtrlMedium.foldList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c)
+
+mapListFlat ::
+ (a -> b) ->
+ ([T control a] -> [T control b]) ->
+ ([T control a] -> [T control b]) ->
+ (control -> T control a -> T control b) ->
+ T control a -> T control b
+mapListFlat f g h k =
+ CtrlMedium.switchList (Primitive . f) (Serial . g) (Parallel . h) (\c -> Control c . k c)
+
+mapControl ::
+ (c0 -> c1) -> T c0 a -> T c1 a
+mapControl f =
+ CtrlMedium.foldList
+ Primitive Serial Parallel (Control . f)
diff --git a/src/Medium/LabeledControlled/List.hs b/src/Medium/LabeledControlled/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/LabeledControlled/List.hs
@@ -0,0 +1,140 @@
+module Medium.LabeledControlled.List where
+
+import qualified Medium.Controlled.List as CtrlMediumList
+import qualified Medium.Controlled as CtrlMedium
+import qualified Medium
+-- import qualified Medium.Temporal as Temporal
+-- import Haskore.General.Utility(maximum0)
+
+import Control.Applicative (liftA, )
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(sequenceA))
+import qualified Data.Traversable as Traversable
+
+{- |
+Medium type with a label
+(e.g. the duration of the represented music),
+a controller constructor
+and direct support for rests.
+-}
+data T label control content =
+ Cons {label :: label,
+ structure :: Structure label control content}
+ deriving (Show, Eq, Ord {- for use in FiniteMap -})
+
+data Structure label control content =
+ Primitive content -- ^ primitive content
+ | Serial [T label control content] -- ^ sequential composition
+ | Parallel [T label control content] -- ^ parallel composition
+ | Control control (T label control content) -- ^ controller
+ deriving (Show, Eq, Ord {- for use in FiniteMap -})
+
+
+class Label label where
+ emptyLabel :: label
+ -- error "We can not automatically assign a label to primitives created by the generic Medium.primitive method"
+ foldLabelSerial :: [label] -> label
+ foldLabelParallel :: [label] -> label
+
+
+serialLabel, parallelLabel :: Label label =>
+ [T label control content] -> T label control content
+serialLabel xs = Cons (foldLabelSerial (map label xs)) (Serial xs)
+parallelLabel xs = Cons (foldLabelParallel (map label xs)) (Parallel xs)
+
+
+instance (Label label) => Medium.Construct (T label control) where
+ prim = Cons emptyLabel . Primitive
+
+ {- If the operands are also Serials or Parallels
+ the lists are joined,
+ since most times the operators are used to construct lists.
+ This definition works also infinite application of (+:+). -}
+ (+:+) x y = serialLabel (serialToList x ++ serialToList y)
+ (=:=) x y = parallelLabel (parallelToList x ++ parallelToList y)
+
+ serial1 = serialLabel
+ parallel1 = parallelLabel
+
+ serial = serialLabel
+ parallel = parallelLabel
+
+
+
+switchList ::
+ (label -> b -> c) ->
+ (a -> b) ->
+ ([T label control a] -> b) ->
+ ([T label control a] -> b) ->
+ (control -> T label control a -> b) ->
+ (T label control a -> c)
+switchList lab f g h k (Cons l s) =
+ lab l $
+ case s of
+ Primitive x -> f x
+ Serial m -> g m
+ Parallel m -> h m
+ Control c m -> k c m
+
+
+foldList ::
+ (label -> b -> c) ->
+ (a -> b) ->
+ ([c] -> b) ->
+ ([c] -> b) ->
+ (control -> c -> b) ->
+ (T label control a -> c)
+foldList lab f g h k =
+ let recurse = foldList lab f g h k
+ in switchList lab f
+ (g . map recurse) (h . map recurse) (\c -> k c . recurse)
+
+
+fromControlledMediumList :: Label label =>
+ (a -> (label, b)) -> (control -> T label control b -> label) ->
+ CtrlMediumList.T control a -> T label control b
+fromControlledMediumList f k =
+ CtrlMedium.foldList
+ ((\(lab,x) -> Cons lab (Primitive x)) . f)
+ serialLabel
+ parallelLabel
+ (\c x -> Cons (k c x) (Control c x))
+
+
+mapLabel :: (i -> j) -> (T i control a -> T j control a)
+mapLabel f =
+ foldList (Cons . f) Primitive Serial Parallel Control
+
+instance Functor (T i control) where
+ fmap f = foldList Cons (Primitive . f) Serial Parallel Control
+-- fmap = Traversable.fmapDefault
+
+instance Foldable (T i control) where
+ foldMap = Traversable.foldMapDefault
+
+instance Traversable (T i control) where
+ sequenceA =
+ foldList
+ (liftA . Cons)
+ (liftA Primitive)
+ (liftA Serial . sequenceA)
+ (liftA Parallel . sequenceA)
+ (liftA . Control)
+
+{-
+instance (Temporal.C a) => Temporal.C (T a) where
+ dur = Medium.foldList Temporal.dur sum maximum0
+ none = Medium.prim . Temporal.none
+-}
+
+
+{- This behaves identical to Medium.Binary,
+ if the top most constructor is no serial composition
+ it returns a single element list. -}
+serialToList, parallelToList :: T label control a -> [T label control a]
+
+serialToList (Cons _ (Serial ns)) = ns
+serialToList n = [n]
+
+parallelToList (Cons _ (Parallel ns)) = ns
+parallelToList n = [n]
diff --git a/src/Medium/Plain/Binary.hs b/src/Medium/Plain/Binary.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Plain/Binary.hs
@@ -0,0 +1,79 @@
+module Medium.Plain.Binary where
+
+import Medium ((+:+), (=:=))
+
+import qualified Medium
+import qualified Medium.Temporal as Temporal
+
+import Control.Applicative (liftA, liftA2, )
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(sequenceA))
+import qualified Data.Traversable as Traversable
+
+infixr 7 :+: {- like multiplication -}
+infixr 6 :=: {- like addition -}
+
+data T a = Primitive a
+ | T a :+: T a -- sequential composition
+ | T a :=: T a -- parallel composition
+ deriving (Show, Eq, Ord {- for use in FiniteMap -})
+
+instance Medium.Construct T where
+ prim = Primitive
+
+ (+:+) = (:+:)
+ (=:=) = (:=:)
+
+ serial [] = Primitive (Temporal.none 0)
+ serial m = foldr1 (+:+) m
+
+ parallel [] = Primitive (Temporal.none 0)
+ parallel m = foldr1 (=:=) m
+
+ serial1 = foldr1 (+:+)
+ parallel1 = foldr1 (=:=)
+
+
+instance Medium.C T where
+ switchBinary f _ _ _ (Primitive x) = f x
+ switchBinary _ g _ _ (m0:+:m1) = g m0 m1
+ switchBinary _ _ h _ (m0:=:m1) = h m0 m1
+
+
+ switchList f _ _ (Primitive x) = f x
+ switchList _ g _ m@(_ :+: _) = g (serialS m [])
+ switchList _ _ h m@(_ :=: _) = h (parallelS m [])
+
+
+errorNone :: a
+errorNone = error "Program bug: This data structure does not contain empty things."
+
+
+instance Functor T where
+ fmap f = Medium.foldBin (Primitive . f) (:+:) (:=:) errorNone
+-- fmap = Traversable.fmapDefault
+
+instance Foldable T where
+ foldMap = Traversable.foldMapDefault
+
+instance Traversable T where
+ sequenceA =
+ Medium.foldBin
+ (liftA Primitive)
+ (liftA2 (:+:))
+ (liftA2 (:=:))
+ errorNone
+
+
+instance Temporal.C a => Temporal.C (T a) where
+ dur = Medium.foldBin Temporal.dur (+) max errorNone
+ none = Medium.prim . Temporal.none
+
+
+serialS, parallelS :: T a -> [T a] -> [T a]
+
+serialS (m0 :+: m1) = serialS m0 . serialS m1
+serialS m0 = (m0 :)
+
+parallelS (m0 :=: m1) = parallelS m0 . parallelS m1
+parallelS m0 = (m0 :)
diff --git a/src/Medium/Plain/ContextFreeGrammar.lhs b/src/Medium/Plain/ContextFreeGrammar.lhs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Plain/ContextFreeGrammar.lhs
@@ -0,0 +1,250 @@
+
+\subsection{Structure Analysis}
+
+This module contains a function which builds
+a hierarchical music object from a serial one.
+This is achieved by searching for long common infixes.
+A common infix is replaced by a single object
+at each occurence.
+
+This module proofs the sophistication of the separation
+between general arrangement of some objects as provided by the \module{Medium}
+and the special needs of music provided by the \module{Music}.
+It's possible to formulate these algorithms without the knowledge of Music
+and we can insert the type \code{Tag} to distinguish
+between media primitives and macro calls.
+The only drawback is that it is not possible to descend
+into controlled sub-structures, like Tempo and Trans.
+
+\begin{haskelllisting}
+
+> module Medium.Plain.ContextFreeGrammar where
+
+> import Data.List (sort, tails, isPrefixOf, findIndex)
+> import Data.Maybe (fromJust)
+> import qualified Haskore.General.Map as Map
+> import Haskore.General.Utility (maximumKey, zapWith)
+
+> import Control.Monad.State (MonadState, put, get, State(State), execState)
+
+> import Medium (prim, serial1, parallel1)
+> import qualified Medium
+> import qualified Medium.Plain.List as ListMedium
+
+\end{haskelllisting}
+
+Condense all common infixes down to length 'thres'.
+The infixes are replaced by some marks using the constructor Left.
+They can be considered as macros or
+as non-terminals in a grammar.
+The normal primitives are preserved with constructor Right.
+We end up with a context-free grammar of the media.
+
+\begin{haskelllisting}
+
+> data Tag key prim =
+> Prim prim
+> | Call key
+> | CallMulti Int key
+> deriving (Eq, Ord, Show)
+> type TagMedium key prim = ListMedium.T (Tag key prim)
+
+> -- True is for cyclic infixes
+> type T key prim = [(key, TagMedium key prim)]
+
+> fromMedium :: (Ord key, Ord prim) =>
+> [key] -> Int -> ListMedium.T prim -> T key prim
+> fromMedium (key:keys) thres m =
+> let action = whileM (>= thres) (map (State . condense) keys)
+> -- action = sequence (take 1 (map (State . condense) keys))
+> in reverse $ execState action [(key, fmap Prim m)]
+> fromMedium _ _ _ =
+> error ("No key given."++
+> " Please provide an infinite or at least huge number of macro names.")
+
+\end{haskelllisting}
+
+The inverse of \code{fromMedium}: Expand all macros.
+Cyclic macro references shouldn't be a problem
+if it is possible to resolve the dependencies.
+We manage the grammar in the dictionary \code{dict}.
+Now a naive way for expanding the macros
+is to recurse into each macro call manually
+using lookups to \code{dict}.
+This would imply that we need new memory for each expansion of the same macro.
+We have chosen a different approach:
+We map \code{dict} to a new dictionary \code{dict'}
+which contains the expanded versions of each Medium.
+For expansion we don't use repeated lookups to \code{dict}
+but we use only one lookup to \code{dict'}
+-- which contains the fully expanded version of the considered Medium.
+This method is rather the same as
+if you write Haskell values that invokes each other.
+
+The function \code{expand} computes the expansion for each key and
+the function \code{toMedium} computes the expansion of the first macro.
+Thus \code{toMedium} quite inverts \code{fromMedium}.
+
+\begin{haskelllisting}
+
+> toMedium :: (Show key, Ord key, Ord prim) =>
+> T key prim -> ListMedium.T prim
+> toMedium = snd . head . expand
+
+> expand :: (Show key, Ord key, Ord prim) =>
+> T key prim -> [(key, ListMedium.T prim)]
+> expand grammar =
+> let notFound key = error ("The non-terminal '" ++ show key ++ "' is unknown.")
+> dict = Map.fromList grammar
+> dict' = Map.map (Medium.foldList expandSub serial1 parallel1) dict
+> expandSub (Prim p) = prim p
+> expandSub (Call key) =
+> Map.findWithDefault dict' (notFound key) key
+> expandSub (CallMulti n key) =
+> serial1 (replicate n (Map.findWithDefault dict' (notFound key) key))
+> in map (fromJust . Map.lookup (Map.mapWithKey (,) dict') . fst) grammar
+
+\end{haskelllisting}
+
+
+Do monadic actions until the condition \code{p} fails.
+This is implemented for State Monads,
+because in plain Monads one could not reset the state
+and thus the state wouldn't be that after
+the last successful (with respect to the predicate \code{p}) action.
+
+\begin{haskelllisting}
+
+> whileM :: (MonadState s m) => (a -> Bool) -> [m a] -> m [a]
+> whileM _ [] = return []
+> whileM p (m:ms) =
+> do s <- get
+> x <- m
+> if p x then whileM p ms >>= return . (x:)
+> else put s -- reset to the old state
+> >> return []
+
+\end{haskelllisting}
+
+Find the longest common infix over all parts of the music
+and replace it in all of them.
+
+\begin{haskelllisting}
+
+> condense :: (Ord key, Ord prim) =>
+> key
+> -> T key prim
+> -> (Int, T key prim)
+> condense key x =
+> let getSerials = Medium.switchList
+> (const [])
+> (\xs -> xs : concatMap getSerials xs)
+> (\xs -> concatMap getSerials xs)
+> infx = smallestCycle (maximumCommonInfixMulti length
+> (concatMap (getSerials . snd) x))
+> absorbSingleton _ [m] = m
+> absorbSingleton collect ms = collect ms
+> replaceRec = Medium.foldList prim
+> (absorbSingleton serial1 . map joinTag . replaceInfix key infx)
+> (absorbSingleton parallel1)
+> in (length infx, (key, serial1 infx) : map (\(k, ms) -> (k, replaceRec ms)) x)
+
+> joinTag :: Medium.Construct medium =>
+> Tag key (medium (Tag key prim)) -> medium (Tag key prim)
+> joinTag (Prim m) = m
+> joinTag (Call k) = prim (Call k)
+> joinTag (CallMulti n k) = prim (CallMulti n k)
+
+\end{haskelllisting}
+
+Replace all occurences of the infix by its key.
+Collect accumulated occurences in one \code{CallMulti}.
+
+\begin{haskelllisting}
+
+> replaceInfix :: (Eq a, Eq b) =>
+> a
+> -> [b]
+> -> [b]
+> -> [Tag a b]
+> replaceInfix key infx sequ =
+> let recurse [] = []
+> recurse xa@(x:xs) =
+> let pref = commonPrefix (cycle infx) xa
+> (num, r) = divMod (length pref) (length infx)
+> len = length pref - r
+> in if num == 0
+> then Prim x : recurse xs
+> else ((if num == 1 then Call key else CallMulti num key)
+> : recurse (drop len xa))
+> in recurse sequ
+
+\end{haskelllisting}
+
+A common infix indicates a loop if its occurences overlap.
+We can detect this by checking if there is a suffix of our list
+which is also a prefix of this list.
+
+\begin{haskelllisting}
+
+> isCyclic :: Eq a => [a] -> Bool
+> isCyclic x = any (flip isPrefixOf x) (init (tail (tails x)))
+
+\end{haskelllisting}
+
+Find the shortest list \code{y},
+where \code{x} is a prefix of \code{cycle y}.
+If \code{x} has no loop, then \code{x == y}.
+
+\begin{haskelllisting}
+
+> smallestCycle :: Eq a => [a] -> [a]
+> smallestCycle x =
+> take (1 + fromJust (findIndex (flip isPrefixOf x) (tail (tails x)))) x
+
+\end{haskelllisting}
+
+Finding common infixes is a prominent application of suffix trees.
+But since I don't have an implementation of suffix trees
+I'll stick to a sorted list of suffices.
+
+\begin{haskelllisting}
+
+> maximumCommonInfix :: (Ord a, Ord b) => ([a] -> b) -> [a] -> [a]
+> maximumCommonInfix mag =
+> maximumKey mag .
+> zapWith commonPrefix .
+> sort . tails
+
+\end{haskelllisting}
+
+Find common infixes across multiple strings.
+This could be a nice application of generalized suffix trees.
+
+\begin{haskelllisting}
+
+> maximumCommonInfixMulti :: (Ord a, Ord b) => ([a] -> b) -> [[a]] -> [a]
+> maximumCommonInfixMulti mag =
+> maximumKey mag .
+> zapWith commonPrefix .
+> sort . concatMap tails
+
+\end{haskelllisting}
+
+Find the longest common prefix.
+(Two implementations that may be used for testing.)
+
+\begin{haskelllisting}
+
+> commonPrefix :: Eq a => [a] -> [a] -> [a]
+> commonPrefix xs ys =
+> map fst $ takeWhile (uncurry (==)) $ zip xs ys
+
+> commonPrefixRec :: Eq a => [a] -> [a] -> [a]
+> commonPrefixRec (x:xs) (y:ys) =
+> if x == y
+> then x : commonPrefix xs ys
+> else []
+> commonPrefixRec _ _ = []
+
+\end{haskelllisting}
diff --git a/src/Medium/Plain/List.hs b/src/Medium/Plain/List.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Plain/List.hs
@@ -0,0 +1,76 @@
+module Medium.Plain.List where
+
+import qualified Medium
+import qualified Medium.Temporal as Temporal
+
+import Haskore.General.Utility(maximum0)
+
+import Control.Applicative (liftA, )
+import Data.Foldable (Foldable(foldMap))
+import Data.Traversable (Traversable(sequenceA))
+import qualified Data.Traversable as Traversable
+
+
+data T a = Primitive a
+ | Serial [T a] -- sequential composition
+ | Parallel [T a] -- parallel composition
+ deriving (Show, Eq, Ord {- for use in FiniteMap -})
+
+instance Medium.Construct T where
+ prim = Primitive
+
+ {- If the operands are also Serials or Parallels
+ the lists are joined,
+ since most times the operators are used to construct lists.
+ This definition works also for infinite application of (+:+). -}
+ (+:+) x y = Serial (serialToList x ++ serialToList y)
+ (=:=) x y = Parallel (parallelToList x ++ parallelToList y)
+
+
+ serial = Serial
+ parallel = Parallel
+
+ serial1 = Serial
+ parallel1 = Parallel
+
+
+instance Medium.C T where
+ switchBinary f _ _ _ (Primitive x) = f x
+ switchBinary _ g _ _ (Serial (m:ms)) = g m (Serial ms)
+ switchBinary _ _ h _ (Parallel (m:ms)) = h m (Parallel ms)
+ switchBinary _ _ _ z _ = z
+
+ switchList f _ _ (Primitive x) = f x
+ switchList _ g _ (Serial m) = g m
+ switchList _ _ h (Parallel m) = h m
+
+
+instance Functor T where
+ fmap f = Medium.foldList (Primitive . f) Serial Parallel
+-- fmap = Traversable.fmapDefault
+
+instance Foldable T where
+ foldMap = Traversable.foldMapDefault
+
+instance Traversable T where
+ sequenceA =
+ Medium.foldList
+ (liftA Primitive)
+ (liftA Serial . sequenceA)
+ (liftA Parallel . sequenceA)
+
+instance (Temporal.C a) => Temporal.C (T a) where
+ dur = Medium.foldList Temporal.dur sum maximum0
+ none = Medium.prim . Temporal.none
+
+
+{- This behaves identical to Medium.Plain.Binary,
+ if the top most constructor is no serial composition
+ it returns a single element list. -}
+serialToList, parallelToList :: T a -> [T a]
+
+serialToList (Serial ns) = ns
+serialToList n = [n]
+
+parallelToList (Parallel ns) = ns
+parallelToList n = [n]
diff --git a/src/Medium/Temporal.hs b/src/Medium/Temporal.hs
new file mode 100644
--- /dev/null
+++ b/src/Medium/Temporal.hs
@@ -0,0 +1,13 @@
+module Medium.Temporal where
+
+import qualified Numeric.NonNegative.Wrapper as NonNeg
+
+type Dur = NonNeg.Rational
+
+class C a where
+ dur :: a -> Dur
+ none :: Dur -> a
+
+class Control control where
+ controlDur :: control -> Dur -> Dur
+ anticontrolDur :: control -> Dur -> Dur
diff --git a/src/Test/Equivalence.lhs b/src/Test/Equivalence.lhs
new file mode 100644
--- /dev/null
+++ b/src/Test/Equivalence.lhs
@@ -0,0 +1,449 @@
+\subsubsection{Equivalence of Literal Performances}
+\seclabel{equivalence}
+
+\newcommand\equivalent{$\ \ \equiv\ \ $}
+
+A \keyword{literal performance} is one in which no aesthetic
+interpretation is given to a musical object.
+The function \function{Pf.fromMusic} in fact yields a literal performance;
+aesthetic nuances must be expressed explicitly using note and phrase attributes.
+
+There are many musical objects whose literal performances we expect to
+be \keyword{equivalent}. For example, the following two musical objects
+are certainly not equal as data structures, but we would expect their
+literal performances to be identical:
+\begin{center}
+\code{(m0 +:+\ m1) +:+\ (m2 +:+\ m3)} \\
+\code{m0 +:+\ m1 +:+\ m2 +:+\ m3}
+\end{center}
+Thus we define a notion of equivalence:
+
+\begin{definition}
+Two musical objects \code{m0} and \code{m1} are \keyword{equivalent},
+written \code{m0}$\ \equiv\ $\code{m1}, if and only if:
+\begin{center}
+($\forall$\code{imap,c})\quad
+\code{Pf.fromMusic imap c m0 = Pf.fromMusic imap c m1}
+\end{center}
+where ``\code{=}'' is equality on values
+(which in Haskell is defined by the underlying equational logic).
+\end{definition}
+
+One of the most useful things we can do with this notion of
+equivalence is establish the validity of certain \keyword{transformations}
+on musical objects. A transformation is {\em valid} if the result of
+the transformation is equivalent (in the sense defined above) to the
+original musical object; i.e.\ it is ``meaning preserving''.
+Some of these connections are used in the \module{Optimization}
+(\secref{optimization}) in order to simplify a musical data structure.
+
+The most basic of these transformation we treat as \keyword{axioms} in an
+\keyword{algebra of music}. For example:
+
+\begin{axiom}
+For any \code{r0}, \code{r1}, and \code{m}:
+\begin{center}
+\code{changeTempo r0 (changeTempo r1 m)} \equivalent \code{changeTempo (r0*r1) m}
+\end{center}
+\end{axiom}
+
+To prove this axiom, we use conventional equational reasoning
+(for clarity we omit \code{imap},
+simplify the context to just \code{dt},
+and omit \code{fromRational}):
+\begin{proof}
+\begin{haskellblock}
+Pf.fromMusic dt (changeTempo r0 (changeTempo r1 m))
+= Pf.fromMusic (dt / r0) (changeTempo r1 m) -- unfolding Pf.fromMusic
+= Pf.fromMusic ((dt / r0) / r1) m -- unfolding Pf.fromMusic
+= Pf.fromMusic (dt / (r0 * r1)) m -- simple arithmetic
+= Pf.fromMusic dt (changeTempo (r0*r1) m) -- folding Pf.fromMusic
+\end{haskellblock}
+\end{proof}
+
+Here is another useful transformation and its validity proof (for
+clarity in the proof we omit \code{imap} and simplify the context to
+just \code{(t,dt)}):
+
+\begin{axiom}
+For any \code{r}, \code{m0}, and \code{m1}:
+\begin{center}
+\code{changeTempo r (m0 +:+\ m1)} \equivalent \code{changeTempo r m0 +:+\ changeTempo r m1}
+\end{center}
+\end{axiom}
+In other words, {\em tempo scaling distributes over sequential composition}.
+\begin{proof}
+\begin{haskellblock}
+Pf.fromMusic (t,dt) (changeTempo r (m0 +:+ m1))
+= Pf.fromMusic (t,dt/r) (m0 +:+ m1) -- unfolding Pf.fromMusic
+= Pf.fromMusic (t,dt/r) m0 ++
+ Pf.fromMusic (t',dt/r) m1 -- unfolding Pf.fromMusic
+= Pf.fromMusic (t,dt) (changeTempo r m0) ++
+ Pf.fromMusic (t',dt) (changeTempo r m1) -- folding Pf.fromMusic
+ where t' = t + dur m0 * dt/r
+= Pf.fromMusic (t,dt) (changeTempo r m0) ++
+ Pf.fromMusic (t'',dt) (changeTempo r m1) -- folding dur
+ where t'' = t + dur (changeTempo r m0) * dt
+= Pf.fromMusic (t,dt)
+ (changeTempo r m0 +:+ changeTempo r m1) -- folding Pf.fromMusic
+\end{haskellblock}
+\end{proof}
+
+An even simpler axiom is given by:
+
+\begin{axiom}
+For any \code{m}:
+\begin{center}
+\code{changeTempo 1 m} \equivalent \code{m}
+\end{center}
+\end{axiom}
+In other words, {\em unit tempo scaling is the identity}.
+\begin{proof}
+\begin{haskellblock}
+Pf.fromMusic (t,dt) (changeTempo 1 m)
+= Pf.fromMusic (t,dt/1) m -- unfolding Pf.fromMusic
+= Pf.fromMusic (t,dt) m -- simple arithmetic
+\end{haskellblock}
+\end{proof}
+
+Note that the above proofs, being used to establish axioms, all
+involve the definition of \function{Pf.fromMusic}. In contrast, we can also
+establish {\em theorems} whose proofs involve only the axioms. For
+example, Axioms 1, 2, and 3 are all needed to prove the following:
+\begin{theorem}
+For any \code{r}, \code{m0}, and \code{m1}:
+\begin{center}
+\code{changeTempo r m0 +:+\ m1} \equivalent \code{changeTempo r (m0 +:+\ changeTempo (recip r) m1)}
+\end{center}
+
+\begin{comment}
+
+% propTempoPartialSerial ::
+% Dur.Ratio -> MidiMusic.T -> MidiMusic.T -> Property
+% propTempoPartialSerial r m0 m1 =
+% r > 0 ==>
+% changeTempo r m0 +:+ m1 =?=
+% changeTempo r (m0 +:+ changeTempo (recip r) m1)
+
+\end{comment}
+
+\end{theorem}
+\begin{proof}
+\begin{haskellblock}
+changeTempo r (m0 +:+ changeTempo (recip r) m1)
+= changeTempo r m0 +:+ changeTempo r (changeTempo (recip r) m1)
+ -- by Axiom 1
+= changeTempo r m0 +:+ changeTempo (r * recip r) m1 -- by Axiom 2
+= changeTempo r m0 +:+ changeTempo 1 m1 -- simple arithmetic
+= changeTempo r m0 +:+ m1 -- by Axiom 3
+\end{haskellblock}
+\end{proof}
+For example, this fact justifies the equivalence of the two phrases
+shown in \figref{equiv}.
+
+\begin{figure*}
+\centerline{
+\includegraphics[height=0.6in]{Doc/Pics/equiv}
+}
+\caption{Equivalent Phrases}
+\figlabel{equiv}
+\end{figure*}
+
+Many other interesting transformations of Haskore musical objects can
+be stated and proved correct using equational reasoning. We leave as
+an exercise for the reader the proof of the following axioms (which
+include the above axioms as special cases).
+
+The following axioms are additionally given in a way
+which allows automatic tests using the QuickCheck package.
+\url{http://www.cs.chalmers.se/~rjmh/QuickCheck/}
+The properties are formulated as functions
+but they can translated one-by-one
+from the axioms stated in mathematical notation.
+
+\begin{haskelllisting}
+
+> module Equivalence where
+
+> import qualified Haskore.Music as Music
+> import Haskore.Music hiding (repeat, reverse, dur)
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> -- should also work for general RhyMusic but is a bit more cumbersome
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Default as DefltPf
+> import qualified Haskore.Performance.Player as Player
+
+> import qualified Haskore.Basic.Duration as Dur
+> import qualified Data.EventList.Relative.TimeTime as TimeListPad
+> import qualified Numeric.NonNegative.Wrapper as NonNeg
+> import Haskore.General.Utility (mapFst)
+
+> import Control.Monad.Reader (runReader)
+
+> import Test.QuickCheck
+
+\end{haskelllisting}
+
+We define operators \function{=?=} and \function{==?==}
+which play the role of our previously defined equivalence sign ``$\equiv$''.
+The operator \function{=?=} compares plain pieces of music,
+whereas the operator \function{==?==} compares functions mapping to music.
+We will use the second one mainly in order to compare
+music transformers like \function{changeTempo} and \function{transpose}.
+
+\begin{haskelllisting}
+
+> infix 4 =?=, ==?==
+
+> (=?=) :: MidiMusic.T -> MidiMusic.T -> Bool
+> (=?=) m0 m1 =
+> let pl = DefltPf.map :: Player.Map NonNeg.Rational Rational MidiMusic.Note
+> perform m =
+> mapFst TimeListPad.catMaybes $
+> runReader (Performance.monadFromMusic pl m) DefltPf.context
+> in perform m0 == perform m1
+
+> (==?==) :: (a -> MidiMusic.T) -> (a -> MidiMusic.T) -> (a -> Bool)
+> (==?==) fm0 fm1 x = fm0 x =?= fm1 x
+
+\end{haskelllisting}
+
+Here we repeat one of the simple axioms,
+now also with a test function ready for quick-checking.
+
+\begin{axiom}
+Changing the tempo by $1$ and transposing by $0$ are identities.
+That is:
+\begin{center}
+\code{changeTempo 1} \equivalent \code{id} \\
+\code{transpose 0} \equivalent \code{id}
+\end{center}
+
+\begin{haskelllisting}
+
+> propTempoNeutral, propTransposeNeutral :: MidiMusic.T -> Bool
+
+> propTempoNeutral = changeTempo 1 ==?== id
+
+> propTransposeNeutral = transpose 0 ==?== id
+
+\end{haskelllisting}
+
+\end{axiom}
+
+The first QuickCheck test function reads as:
+``The property of a neutral tempo change is that
+changing the tempo by one is equivalent to the identity function.''
+It says everything we want to state and not more.
+It is available in a machine readable form
+ready both for static provers and for tests by execution.
+QuickCheck will call these functions on several
+randomly generated pieces of music.
+These songs might sound awful,
+so they should be exotically enough in order to check
+whether our axioms are not only true for common music.
+
+\begin{axiom}
+\function{changeTempo} is \keyword{multiplicative} and
+\function{transpose} is \keyword{additive}.
+That is, for any \code{r0}, \code{r1},
+\code{p0}, \code{p1}:
+\begin{center}
+\code{changeTempo r0 . changeTempo r1} \equivalent \code{changeTempo (r0*r1)}\\
+\code{transpose p0 . transpose p1} \equivalent \code{transpose (p0+p1)}
+\end{center}
+\begin{haskelllisting}
+
+> propTempoTempo ::
+> Dur.Ratio -> Dur.Ratio -> MidiMusic.T -> Property
+> propTempoTempo r0 r1 m =
+> r0 > 0 && r1 > 0 ==>
+> (changeTempo r0 . changeTempo r1 ==?==
+> changeTempo (r0*r1)) m
+
+> propTransposeTranspose ::
+> Int -> Int -> MidiMusic.T -> Bool
+> propTransposeTranspose p0 p1 =
+> transpose p0 . transpose p1 ==?== transpose (p0+p1)
+
+\end{haskelllisting}
+
+\end{axiom}
+
+The first equation needs the precondition of non-zero tempo changes.
+Changing the tempo to zero causes a division by zero
+when \function{Pf.fromMusic} recomputes the duration of a whole note.
+Because of the precondition we can no longer have \type{Bool} as function value
+but we must use \type{Property}
+which stores not only the result of the test
+but also if the precondition was fulfilled.
+Test cases where the precondition fail
+do not count in the maximum number of tests performed per test function.
+
+\begin{axiom}
+Function composition is \keyword{commutative} with respect to both tempo
+scaling and transposition.
+That is, for any \code{r0}, \code{r1}, \code{p0} and \code{p1}:
+\begin{center}
+\code{changeTempo r0 .\ changeTempo r1} \equivalent \code{changeTempo r1 .\ changeTempo r0}\\
+\code{transpose p0 .\ transpose p1} \equivalent \code{transpose p1 .\ transpose p0}\\
+\code{changeTempo r0 .\ transpose p0} \equivalent \code{transpose p0 .\ changeTempo r0}\\
+\end{center}
+
+\begin{haskelllisting}
+
+> propTempoCommutativity :: Dur.Ratio -> Dur.Ratio -> MidiMusic.T -> Property
+> propTempoCommutativity r0 r1 m =
+> r0 > 0 && r1 > 0 ==>
+> (changeTempo r0 . changeTempo r1 ==?==
+> changeTempo r1 . changeTempo r0) m
+
+> propTransposeCommutativity :: Int -> Int -> MidiMusic.T -> Bool
+> propTransposeCommutativity p0 p1 =
+> transpose p0 . transpose p1 ==?== transpose p1 . transpose p0
+
+> propTempoTransposeCommutativity ::
+> Dur.Ratio -> Int -> MidiMusic.T -> Property
+> propTempoTransposeCommutativity r p m =
+> r > 0 ==>
+> (changeTempo r . transpose p ==?==
+> transpose p . changeTempo r) m
+
+\end{haskelllisting}
+
+\end{axiom}
+
+\begin{axiom}
+Tempo scaling and transposition are \keyword{distributive} over both
+sequential and parallel composition.
+That is, for any \code{r}, \code{p}, \code{m0}, and \code{m1}:
+\begin{center}
+\code{changeTempo r (m0 +:+\ m1)} \equivalent \code{changeTempo r m0 +:+\ changeTempo r m1}\\
+\code{changeTempo r (m0 =:=\ m1)} \equivalent \code{changeTempo r m0 =:=\ changeTempo r m1}\\
+\code{transpose p (m0 +:+\ m1)} \equivalent \code{transpose p m0 +:+\ transpose p m1}\\
+\code{transpose p (m0 =:=\ m1)} \equivalent \code{transpose p m0 =:=\ transpose p m1}
+\end{center}
+
+\begin{haskelllisting}
+
+> propTempoSerial, propTempoParallel ::
+> Dur.Ratio -> MidiMusic.T -> MidiMusic.T -> Property
+
+> propTempoSerial r m0 m1 =
+> r > 0 ==>
+> changeTempo r (m0 +:+ m1) =?=
+> changeTempo r m0 +:+ changeTempo r m1
+
+> propTempoParallel r m0 m1 =
+> r > 0 ==>
+> changeTempo r (m0 =:= m1) =?=
+> changeTempo r m0 =:= changeTempo r m1
+
+> propTransposeSerial, propTransposeParallel ::
+> Int -> MidiMusic.T -> MidiMusic.T -> Bool
+> propTransposeSerial p m0 m1 =
+> transpose p (m0 +:+ m1) =?= transpose p m0 +:+ transpose p m1
+> propTransposeParallel p m0 m1 =
+> transpose p (m0 =:= m1) =?= transpose p m0 =:= transpose p m1
+
+\end{haskelllisting}
+
+\end{axiom}
+
+\begin{comment}
+Counter example for propTempoParallel:
+r = 1
+m0 = c 0 0 []
+m1 = d 0 0 [] =:= (d 0 0 [] +:+ c 0 0 [])
+
+This leads to different results
+because (=:=) merges parallel compositions in the operands.
+This is suppressed if an identity like (changeTempo 1) or (transpose 0) is inserted.
+\end{comment}
+
+\begin{axiom}
+Sequential and parallel composition are \keyword{associative}.
+That is, for any \code{m0}, \code{m1}, and \code{m2}:
+\begin{center}
+\code{m0 +:+\ (m1 +:+\ m2)} \equivalent \code{(m0 +:+\ m1) +:+\ m2}\\
+\code{m0 =:=\ (m1 =:=\ m2)} \equivalent \code{(m0 =:=\ m1) =:=\ m2}
+\end{center}
+
+\begin{haskelllisting}
+
+> propSerialAssociativity, propParallelAssociativity ::
+> MidiMusic.T -> MidiMusic.T -> MidiMusic.T -> Bool
+> propSerialAssociativity m0 m1 m2 =
+> m0 +:+ (m1 +:+ m2) =?= (m0 +:+ m1) +:+ m2
+> propParallelAssociativity m0 m1 m2 =
+> m0 =:= (m1 =:= m2) =?= (m0 =:= m1) =:= m2
+
+\end{haskelllisting}
+
+\end{axiom}
+
+\begin{axiom}
+Parallel composition is \keyword{commutative}.
+That is, for any \code{m0} and \code{m1}:
+\begin{center}
+\code{m0 =:=\ m1} \equivalent \code{m1 =:=\ m0}
+\end{center}
+
+\begin{haskelllisting}
+
+> propParallelCommutativity ::
+> MidiMusic.T -> MidiMusic.T -> Bool
+> propParallelCommutativity m0 m1 =
+> m0 =:= m1 =?= m1 =:= m0
+
+\end{haskelllisting}
+
+\end{axiom}
+
+\begin{comment}
+Counter example:
+m0 = d 0 0 []
+m1 = d 0 0 [] +:+ c 0 0 []
+
+When mergeing using sorting the 'c' must be performed before any 'd'
+because all three notes start at the same time.
+But in contrast to that we obtain:
+Performance.fromMusic (m0 =:= m1) -> [d, d, c]
+Performance.fromMusic (m1 =:= m0) -> [d, c, d]
+\end{comment}
+
+\begin{axiom}
+\code{Rest 0} is a \keyword{unit} for \function{changeTempo} and \function{transpose},
+and a \keyword{zero} for sequential and parallel composition.
+That is, for any \code{r}, \code{p}, and \code{m}:
+\begin{center}
+\code{changeTempo r (Rest 0)} \equivalent \code{Rest 0}\\
+\code{transpose p (Rest 0)} \equivalent \code{Rest 0}\\
+\code{m +:+\ Rest 0} \equivalent \code{m} \equivalent \code{Rest 0 +:+\ m}\\
+\code{m =:=\ Rest 0} \equivalent \code{m} \equivalent \code{Rest 0 =:=\ m}
+\end{center}
+
+\begin{haskelllisting}
+
+> propTempoRest0 :: Dur.Ratio -> Property
+> propTempoRest0 r =
+> r > 0 ==>
+> changeTempo r (rest 0) =?= rest 0
+> propTransposeRest0 :: Int -> Bool
+> propTransposeRest0 p = transpose p (rest 0) =?= rest 0
+
+> propSerialNeutral0, propSerialParallel0,
+> propSerialNeutral1, propSerialParallel1 ::
+> MidiMusic.T -> Bool
+> propSerialNeutral0 m = m +:+ rest 0 =?= m
+> propSerialNeutral1 m = rest 0 +:+ m =?= m
+> propSerialParallel0 m = m =:= rest 0 =?= m
+> propSerialParallel1 m = rest 0 =:= m =?= m
+
+\end{haskelllisting}
+
+\end{axiom}
+
+\begin{exercise} Establish the validity of each of the above axioms.
+\end{exercise}
+
diff --git a/src/Test/Suite.lhs b/src/Test/Suite.lhs
new file mode 100644
--- /dev/null
+++ b/src/Test/Suite.lhs
@@ -0,0 +1,1039 @@
+A module that automatically tests the function of several modules.
+
+We use the (standard) package QuickCheck for automatic tests
+on randomly generated data and
+we use HUnit as a framework to run all tests.
+Because of the lack of a package structure
+we included the required modules from the HUnit project in Haskore.
+
+The module must have the name \code{Main}
+in order to be run by \code{runhugs}.
+
+> module Main where
+
+> import System.Cmd (system)
+> import qualified Haskore.General.IO as BinIO
+
+> import Test.QuickCheck hiding (test, label)
+> import qualified Test.QuickCheck as QC
+> import qualified Test.QuickCheck.Batch as QCB
+> import qualified Test.HUnit as HUnit
+> import qualified Test.HUnit.Text as HUnitText
+> import System.Random(Random)
+
+> import Equivalence((=?=),(==?==))
+> import qualified Equivalence
+> import qualified Medium.Controlled as CtrlMedium
+> import qualified Medium.Controlled.List as CtrlMediumList
+> import qualified Medium.Temporal as Temporal
+> import qualified Medium
+
+> import qualified Data.List as List
+> import Data.Ratio(Ratio,(%))
+> import Data.Maybe(isJust)
+> import System.Random(StdGen, mkStdGen, randomR)
+> import Control.Monad.State (liftM, liftM2, replicateM, when)
+> import Haskore.General.Monad (untilM)
+> import Haskore.General.Utility (shuffle, toMaybe, maximum0)
+
+> import Haskore.Music hiding (repeat, reverse)
+> import Haskore.Melody as Melody
+> import Haskore.Basic.Duration (wn, qn, en, (%+), )
+
+> import qualified Haskore.Music as Music
+> import qualified Haskore.Melody.Standard as StdMelody
+> import qualified Haskore.Music.GeneralMIDI as MidiMusic
+> import qualified Haskore.Music.Rhythmic as RhyMusic
+> import qualified Haskore.Basic.Pitch as Pitch
+> import qualified Haskore.Basic.Duration as Duration
+> import qualified Haskore.Performance as Performance
+> import qualified Haskore.Performance.Fancy as FancyPerformance
+> import qualified Haskore.Performance.Default as DefaultPerformance
+> import qualified Haskore.Performance.Context as Context
+> import qualified Haskore.Performance.BackEnd as PfBE
+> import qualified Haskore.Process.Optimization as Optimization
+
+> import qualified Haskore.Example.SelfSim as SelfSim
+> import qualified Haskore.Example.Flip as Flip
+> import qualified Haskore.Example.ChildSong6 as ChildSong6
+> import qualified Haskore.Example.Ssf as Ssf
+> import qualified Haskore.Example.Fractal as Fractal
+> import qualified Haskore.Example.Kantate147 as Kantate147
+> import qualified Haskore.Example.NewResolutions as NewResolutions
+> import Haskore.Example.Guitar as Guitar
+> import Haskore.Example.Miscellaneous
+
+> import qualified Haskore.Interface.MIDI.Render as Render
+> import qualified Haskore.Interface.MIDI.Write as WriteMidi
+> import qualified Haskore.Interface.MIDI.Read as ReadMidi
+> import qualified Haskore.Interface.MIDI.InstrumentMap as InstrMap
+> import qualified Sound.MIDI.File as MidiFile
+> import qualified Sound.MIDI.File.Save as SaveMidi
+> import qualified Sound.MIDI.File.Load as LoadMidi
+> import qualified Sound.MIDI.General as GeneralMidi
+
+> import qualified Haskore.Interface.CSound.Orchestra as CSOrchestra
+> import qualified Haskore.Interface.CSound.Score as CSScore
+> import qualified Haskore.Interface.CSound.Tutorial as CSTutorial
+
+> import qualified Medium.Controlled.ContextFreeGrammar as Grammar
+> import qualified Haskore.Process.Format as MusicFormat
+
+> import qualified Data.EventList.Relative.TimeBody as TimeList
+> import qualified Numeric.NonNegative.Class as NonNeg
+> import qualified Numeric.NonNegative.Wrapper as NonNegW
+> import Numeric.NonNegative.Class ((-|))
+
+> import qualified Data.Accessor.Basic as Accessor
+
+ import Debug.Trace (trace)
+
+
+> midiDir, csoundDir :: FilePath
+> midiDir = "src/Test/MIDI/"
+> csoundDir = "src/Test/CSound/"
+
+> hugsPath :: String
+> hugsPath = ":src:src/Haskore"
+
+Some functions for connecting QuickCheck with HUnit.
+
+> isTestSuccessful :: QCB.TestResult -> Bool
+> isTestSuccessful (QCB.TestOk _ _ _) = True
+> isTestSuccessful _ = False
+
+> showResult :: QCB.TestResult -> String
+> showResult (QCB.TestOk _ _ _) = "ok"
+> showResult (QCB.TestExausted _ _ _) = "exhausted"
+> showResult (QCB.TestFailed msg n) = "failed at test " ++ show n ++ " with the arguments\n" ++ unlines msg
+> showResult (QCB.TestAborted _) = "aborted"
+
+> testUnit :: Testable a => String -> a -> HUnit.Test
+> testUnit = testUnitOpt QCB.defOpt
+
+> testUnitOpt :: Testable a => QCB.TestOptions -> String -> a -> HUnit.Test
+> testUnitOpt opt label t =
+> HUnit.TestLabel label (HUnit.TestCase (
+> do result <- QCB.run t opt
+> HUnit.assertBool (showResult result) (isTestSuccessful result)
+> ))
+
+
+
+> sortLines :: String -> String
+> sortLines = unlines . List.sort . lines
+
+> diffFilesIA :: FilePath -> FilePath -> IO ()
+> diffFilesIA file0 file1 =
+> system ("kompare "++file0++" "++file1) >> return ()
+> -- system ("tkdiff "++file0++" "++file1) >> return ()
+
+> diffIA :: String -> String -> IO Bool
+> diffIA orig new =
+> let file0 = "/tmp/orig.txt"
+> file1 = "/tmp/new.txt"
+> dif = orig/=new
+> in when dif
+> (do writeFile file0 orig
+> writeFile file1 new
+> diffFilesIA file0 file1) >>
+> return (not dif)
+
+> assertEqualText :: String -> String -> String -> HUnit.Assertion
+> assertEqualText preface expected actual =
+> let msg = (if null preface then "" else preface ++ "\n") ++
+> "expected: " ++ show expected ++ "\n but got: " ++ show actual
+> in when (actual /= expected)
+> -- (diffIA expected actual >>
+> (diffIA (sortLines expected) (sortLines actual) >>
+> HUnit.assertFailure msg)
+
+
+
+These tests checks if the MIDI files
+generated for several examples is still the same
+as these generated by the version of 2000.
+
+> sortMidi :: MidiFile.T -> MidiFile.T
+> sortMidi = MidiFile.progChangeBeforeSetTempo . MidiFile.sortEvents
+
+> testMidiBin :: FilePath -> MidiFile.T -> HUnit.Test
+> testMidiBin name stream =
+> HUnit.TestLabel name (HUnit.TestList
+> (testSaveMidi name stream : testReadMidi name : []))
+
+> testSaveMidi :: FilePath -> MidiFile.T -> HUnit.Test
+> testSaveMidi name stream = HUnit.TestCase $
+> do
+> -- diffMidiBin name (sortMidi stream)
+> let path = midiDir++name++".mid"
+> let new = SaveMidi.toByteList (sortMidi stream)
+> -- BinIO.writeBinaryFile path new
+> orig <- BinIO.readBinaryFile path
+> -- putStrLn (show (length orig) ++ " -- " ++ show (length stream))
+> HUnit.assertEqual "saveMidi" orig new
+
+> equalMidi :: MidiFile.T -> MidiFile.T -> IO Bool
+> equalMidi x y =
+> -- diffIA (MidiFile.showLines x) (MidiFile.showLines y) >>
+> return (x == y)
+
+> diffGenMidiBin :: (MidiFile.T -> String) -> FilePath -> MidiFile.T -> IO Bool
+> diffGenMidiBin showFunc name new =
+> do
+> orig <- LoadMidi.fromFile (midiDir++name++".mid")
+> diffIA (showFunc orig) (showFunc new)
+
+> diffMidiBin :: FilePath -> MidiFile.T -> IO Bool
+> diffMidiBin = diffGenMidiBin MidiFile.showLines
+
+Sorts the NoteOn and NoteOff MIDI events in the tracks.
+Their order depends on rounding issues of performance time stamps.
+
+> diffSortMidiBin :: FilePath -> MidiFile.T -> IO Bool
+> diffSortMidiBin = diffGenMidiBin (MidiFile.showLines . MidiFile.sortEvents)
+
+Sorts the lines of the formatted output and
+thus tolerates changes in the order.
+This post-processing is heavier than diffSortMidiBin.
+
+> diffSortMidiBin' :: FilePath -> MidiFile.T -> IO Bool
+> diffSortMidiBin' = diffGenMidiBin (sortLines . MidiFile.showLines)
+
+> writeMusic ::
+> (InstrMap.ChannelTable MidiMusic.Instrument,
+> Context.T NonNegW.Float Float MidiMusic.Note, MidiMusic.T)
+> -> MidiFile.T
+> writeMusic = WriteMidi.fromGMMusic
+
+> testMidiStruct :: String -> MidiFile.T -> MidiFile.T -> HUnit.Assertion
+> testMidiStruct name origFile newFile =
+> -- diffSortMidiBin name newFile >>
+> HUnit.assertEqual
+> ("WriteMidi.fromMusic for "++name)
+> origFile
+> (MidiFile.sortEvents newFile)
+
+Test the ReadMidi.toGMMusic function by reading and writing a test file.
+
+> testReadMidi :: FilePath -> HUnit.Test
+> testReadMidi name = HUnit.TestCase $
+> do
+> contents <- BinIO.readBinaryFile (midiDir++name++".mid")
+> let midiFile = LoadMidi.fromByteList contents
+> let midiFileRewritten = sortMidi (writeMusic (ReadMidi.toGMMusic midiFile))
+> HUnit.assertEqual
+> "loadMidi"
+> contents
+> (SaveMidi.toByteList midiFile)
+> -- diffMidiBin name (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile)))
+> {- Notes of zero duration bring note events out of order
+> if sorted with MidiFile.sortEvents.
+> What can we do against that? -}
+> HUnit.assertEqual
+> "ReadMidi.toGMMusic[0]"
+> midiFile
+> midiFileRewritten
+>
+> HUnit.assertEqual
+> "ReadMidi.toGMMusic[1]"
+> {-
+> (return (SaveMidi.toByteList (MidiFile.sortEvents midiFile)
+> == SaveMidi.toByteList midiFileRewritten))
+> -}
+> contents
+> (SaveMidi.toByteList midiFileRewritten)
+> -- sorting necessary for test14b
+
+> testReadMidiPure :: MidiFile.T -> HUnit.Assertion
+> testReadMidiPure midiFile =
+> do
+> diffIA (MidiFile.showLines (MidiFile.sortEvents midiFile))
+> (MidiFile.showLines (MidiFile.sortEvents
+> (writeMusic (ReadMidi.toGMMusic midiFile))))
+> HUnit.assertEqual
+> ("ReadMidi.toGMMusic test")
+> (MidiFile.sortEvents midiFile)
+> (MidiFile.sortEvents (writeMusic (ReadMidi.toGMMusic midiFile)))
+
+> setInstrMidi :: MidiFile.T
+> setInstrMidi = (Render.generalMidi
+> (MidiMusic.fromMelodyNullAttr MidiMusic.Marimba (c 0 qn ()) +:+
+> MidiMusic.fromMelodyNullAttr MidiMusic.Xylophone (e 0 qn ())))
+
+The velocities of the original tests were too strong.
+MIDI spec says that a non-velocity-sensitive instrument
+gets velocity value 64.
+
+> hackVelocities :: MidiFile.T -> MidiFile.T
+> hackVelocities = MidiFile.changeVelocity (127/64)
+
+The tempo of the original files was made with 500000 microseconds
+as unit.
+
+> hackTempo :: MidiFile.T -> MidiFile.T
+> hackTempo = MidiFile.resampleTime (1/2)
+
+
+> testMIDI :: HUnit.Test
+> testMIDI =
+> HUnit.TestLabel "comparison with MIDI files generated by former Haskore versions"
+> (HUnit.TestList (map (uncurry testMidiBin) (
+> ("test01", hackVelocities t1) :
+> ("test02", t2) :
+> ("test03", t3) :
+> ("test04", t4) :
+> ("test05", t5) :
+> ("test06", hackVelocities SelfSim.t6) :
+> ("test07", hackVelocities SelfSim.t7) :
+> ("test08", SelfSim.t8) :
+> ("test10", hackVelocities SelfSim.t10) :
+> ("test13", hackVelocities t13) :
+> ("test13a", hackVelocities t13a) :
+> ("test13b", hackVelocities t13b) :
+> ("test13c", hackVelocities t13c) :
+> ("test13d", hackVelocities t13d) :
+> ("test13e", hackVelocities t13e) :
+> ("test14", hackVelocities t14) :
+> ("test14b", t14b) :
+> ("test14c", hackVelocities t14c) :
+> ("test14d", hackVelocities t14d) :
+> ("Flip0", Render.generalMidiDeflt (Music.take 1 (withPiano Flip.song))) :
+> ("Flip1", Render.generalMidiDeflt (Music.take 5 (withPiano Flip.song1))) :
+> ("Flip2", Render.generalMidi (Music.take 7 Flip.song2)) :
+> ("Fractal", Render.generalMidiDeflt (Optimization.duration (withPiano Fractal.song))) :
+> ("Ssf", Render.generalMidiDeflt Ssf.song) :
+> ("ChildSong6", Render.generalMidiDeflt ChildSong6.song) :
+> ("NewResolutions", NewResolutions.midi) :
+> ("Kantate147", Kantate147.midi) :
+> -- ("GuitarLegato", Render.generalMidi Guitar.legatoSongMIDI) :
+> ("GuitarParallel", Render.generalMidi Guitar.parallelSongMIDI) :
+> [])))
+
+
+
+
+
+Check generations of CSound files.
+
+> testTutCSound ::
+> CSOrchestra.Output out =>
+> (String, CSScore.T, CSTutorial.TutOrchestra out) -> HUnit.Assertion
+> testTutCSound = processTutCSound verifyResult
+
+
+Three actions can be taken on a file to be compared with an old version.
+All three share the same signature.
+
+> verifyResult, diffResult, updateResult ::
+> String -> FilePath -> String -> HUnit.Assertion
+
+The simple test if the new version is equal to the old one.
+If not, emit an HUnit exception.
+
+> verifyResult title fn str =
+> readFile fn >>=
+> flip (assertEqualText title) str
+> -- HUnit.assertEqual title str
+
+If the tests fail it can be useful to see the difference in detail
+by calling 'kompare' or 'tkdiff'.
+
+> diffResult _ fn str =
+> do str1 <- readFile fn
+> when (str1/=str)
+> (writeFile "/tmp/test" str >>
+> diffFilesIA fn "/tmp/test")
+
+In case the changes are intended
+you can just overwrite the old files with the new ones.
+
+> updateResult _ fn str = writeFile fn str
+
+
+> processTutCSound :: CSOrchestra.Output out =>
+> (String -> FilePath -> String -> HUnit.Assertion) ->
+> (String, CSScore.T, CSTutorial.TutOrchestra out) -> HUnit.Assertion
+> processTutCSound proc (name, newScore, newOrchestra) =
+> do
+> proc
+> ("CSound orchestra: " ++ name)
+> (csoundDir++name++".orc")
+> (CSOrchestra.toString (CSTutorial.toOrchestra newOrchestra))
+>
+> proc
+> ("CSound score: " ++ name)
+> (csoundDir++name++".sco")
+> (CSScore.toString newScore)
+
+> processCSound :: CSOrchestra.Output out =>
+> (String -> FilePath -> String -> HUnit.Assertion) ->
+> (String, CSScore.T, CSOrchestra.T out) -> HUnit.Assertion
+> processCSound proc (name, newScore, newOrchestra) =
+> do
+> proc
+> ("CSound orchestra: " ++ name)
+> (csoundDir++name++".orc")
+> (CSOrchestra.toString newOrchestra)
+>
+> proc
+> ("CSound score: " ++ name)
+> (csoundDir++name++".sco")
+> (CSScore.toString newScore)
+
+
+> diffCSound :: CSOrchestra.Output out =>
+> (String, CSScore.T, CSOrchestra.T out) -> IO ()
+> diffCSound (name, newScore, newOrchestra) =
+> let orcName = csoundDir++name++".orc"
+> scoName = csoundDir++name++".sco"
+> tmpName = "/tmp/test"
+> in do
+> CSOrchestra.save tmpName newOrchestra
+> diffFilesIA orcName (tmpName++".orc")
+> CSScore.save tmpName newScore
+> diffFilesIA scoName (tmpName++".sco")
+
+> diffSortCSound :: CSOrchestra.Output out =>
+> (String, CSScore.T, CSOrchestra.T out) -> IO ()
+> diffSortCSound (name, newScore, newOrchestra) =
+> let orcName = csoundDir++name++".orc"
+> scoName = csoundDir++name++".sco"
+> in do
+> origOrchestra <- readFile orcName
+> diffIA (sortLines origOrchestra)
+> (sortLines $ CSOrchestra.toString newOrchestra)
+> origScore <- readFile scoName
+> diffIA (sortLines origScore)
+> (sortLines $ CSScore.toString newScore)
+> return ()
+
+Compare with several files former versions have produced.
+
+> testCSounds :: HUnit.Test
+> testCSounds =
+> HUnit.TestLabel "comparison with csound files generated by former Haskore versions"
+> (HUnit.TestList (map HUnit.TestCase (
+> testTutCSound CSTutorial.tut1 :
+> testTutCSound CSTutorial.tut2 :
+> testTutCSound CSTutorial.tut3 :
+> testTutCSound CSTutorial.tut4 :
+> testTutCSound CSTutorial.tut5 :
+> testTutCSound CSTutorial.tut6 :
+> testTutCSound CSTutorial.tut7 :
+> testTutCSound CSTutorial.tut8 :
+> testTutCSound CSTutorial.tut9 :
+> testTutCSound CSTutorial.tut10 :
+> testTutCSound CSTutorial.tut11 :
+> testTutCSound CSTutorial.tut12 :
+> testTutCSound CSTutorial.tut13 :
+> testTutCSound CSTutorial.tut14 :
+> testTutCSound CSTutorial.tut15 :
+> testTutCSound CSTutorial.tut16 :
+> testTutCSound CSTutorial.tut17 :
+> testTutCSound CSTutorial.tut18 :
+> testTutCSound CSTutorial.tut19 :
+> testTutCSound CSTutorial.tut20 :
+> testTutCSound CSTutorial.tut21 :
+> testTutCSound CSTutorial.tut22 :
+> testTutCSound CSTutorial.piano :
+> testTutCSound CSTutorial.reedy :
+> testTutCSound CSTutorial.reedy2 :
+> testTutCSound CSTutorial.flute :
+> [])))
+
+
+
+These tests check for certain bugs that have already removed
+and will hopefully never return!
+
+It should be possible get a prefix of some representation of infinite music.
+We define a function which asks for some character
+of the string representation.
+If the implementations are ill, we'll get lost in an infinite loop.
+
+
+> withPiano :: Melody.T () -> MidiMusic.T
+> withPiano = MidiMusic.fromMelodyNullAttr MidiMusic.AcousticGrandPiano
+
+> performanceFromMIDIMusic ::
+> MidiMusic.T -> Performance.T NonNegW.Rational Rational MidiMusic.Note
+> performanceFromMIDIMusic =
+> FancyPerformance.fromMusic
+
+> testShowInf :: Show a => Int -> a -> Bool
+> testShowInf n x = show x !! n /= '\000'
+
+> testInfinitePerformance :: [HUnit.Test]
+> testInfinitePerformance =
+> let -- an infinite rest loop won't eventually result in an empty list
+> -- p = Render.performance (line (repeat wnr))
+> m = withPiano (line (repeat (a 0 wn ())))
+> p = performanceFromMIDIMusic m
+> midi = Render.generalMidiDeflt m
+> in [HUnit.TestCase
+> (HUnit.assertBool "performance" (testShowInf 80 p)),
+> HUnit.TestCase
+> (HUnit.assertBool "MIDI file" (testShowInf 200 midi))]
+
+If the definition of (+:+) is improper
+the check will fail on infinite application.
+
+> testInfiniteConcat :: HUnit.Test
+> testInfiniteConcat =
+> let m = foldr1 (+:+) (repeat (a 0 wn ()))
+> in HUnit.TestCase
+> (HUnit.assertBool "application of (+:+)" (testShowInf 100 m))
+
+Check if the partition of infinite streams works properly.
+
+This one fails
+ mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ mel
+
+whereas this one works
+ mel = a 0 wn () +:+ b 0 wn () =:= rest qn +:+ repeat (c 0 wn ())
+
+*Main> let mel = a 0 wn () +:+ b 0 wn () =:= rest wn +:+ undefined
+
+*Main> mel
+Parallel [Serial [Primitive (Atom (1%1) (Just (Note {noteAttrs = (), notePitch = (0,A)}))),Primitive (Atom (1%1) (Just (Note {noteAttrs = (), notePitch = (0,B)})))],Serial [Primitive (Atom (1%1) Nothing)*** Exception: Prelude.undefined
+*Main> performanceFromMIDIMusic (withPiano mel)
+*** Exception: Prelude.undefined
+
+*Main> Control.Monad.Reader.runReader (Performance.monadFromMusic Haskore.Performance.Player.defltMap mel) Context.deflt
+
+> testInfinitePartition :: HUnit.Test
+> testInfinitePartition =
+> let -- mel = a 0 wn () +:+ b 1 wn () =:= line [rest qn, mel]
+> mel = a 0 wn () +:+ b 1 wn () =:= rest qn +:+ mel
+> p = ((1,Pitch.A)<=) . Accessor.get Melody.notePitch
+> (melA, melB) = Music.partition p mel
+> pfA = performanceFromMIDIMusic (withPiano melA)
+> pfB = performanceFromMIDIMusic (withPiano melB)
+> in HUnit.TestCase
+> (HUnit.assertBool "partition"
+> (testShowInf 200 pfA && testShowInf 200 pfB))
+
+> testInfinitePerformancePartition :: HUnit.Test
+> testInfinitePerformancePartition =
+> let m = withPiano (Music.repeat (a 0 wn () +:+ b 0 wn ()))
+> pf = performanceFromMIDIMusic m
+> p = ((0,Pitch.A)<=) . MidiMusic.pitch .
+> MidiMusic.body . Performance.eventNote
+> pfs = TimeList.partition p pf
+> in HUnit.TestCase
+> (HUnit.assertBool "partition" (testShowInf 200 pfs))
+
+> testInfinity :: HUnit.Test
+> testInfinity = HUnit.TestLabel "infinite music" (HUnit.TestList
+> (testInfiniteConcat :
+> testInfinitePartition :
+> testInfinitePerformancePartition :
+> testInfinitePerformance))
+
+\function{randomTree}
+generates a somehow random tree of notes.
+We use an ascending sequence of pitches,
+because MIDI can't distinguish between parallel notes of the same pitch.
+
+\begin{haskelllisting}
+
+> randomTree :: Pitch.Absolute -> StdGen -> Melody.T ()
+> randomTree p g0 =
+> let (d', g1) = randomR (0, 6) g0
+> (opn, g2) = randomR (0, length ops - 1) g1
+> (tmpNum, g3) = randomR (1, 4) g2
+> (tmpDen, g4) = randomR (1, 4) g3
+> ops = [(+:+), flip (+:+), (=:=),
+> \m0 m1 -> changeTempo (tmpNum%+tmpDen) (m0+:+m1)]
+> in (ops !! opn)
+> (note (Pitch.fromInt p) (d'%+4) ())
+> (randomTree (succ p) g4)
+
+> instance Arbitrary note => Arbitrary (Music.Primitive note) where
+> arbitrary = arbitraryPrimitive
+> coarbitrary = undefined
+
+> arbitraryPrimitive :: Arbitrary note => Gen (Music.Primitive note)
+> arbitraryPrimitive =
+> liftM2 Music.Atom
+> (liftM2 (%+) (choose (1,8)) (choose (1,8)))
+> (frequency
+> [(3, liftM Just arbitrary),
+> (1, return Nothing)])
+
+> instance Arbitrary Music.Control where
+> arbitrary =
+> oneof
+> [liftM Music.Tempo
+> (untilM (0<) (resize 20 arbitrary)),
+> liftM Music.Transpose (resize 20 arbitrary)]
+> coarbitrary = undefined
+
+> instance Arbitrary attr => Arbitrary (Melody.Note attr) where
+> arbitrary =
+> liftM2 (\attr n -> (Melody.Note attr
+> (Pitch.fromInt (mod n 100))))
+> arbitrary (resize 100 arbitrary)
+> coarbitrary = undefined
+
+> {-
+> chooseEnum :: (Enum a, Bounded a) => Gen a
+> chooseEnum =
+> let fromEnumGen :: Enum a => Gen a -> a -> Int
+> fromEnumGen _ = fromEnum
+> gen = liftM toEnum
+> (choose (fromEnumGen gen minBound, fromEnumGen gen maxBound))
+> in gen
+> -}
+
+> instance (Arbitrary instr, Arbitrary drum) =>
+> Arbitrary (RhyMusic.NoteBody drum instr) where
+> arbitrary =
+> liftM2 RhyMusic.Tone
+> arbitrary
+> (liftM (\n -> Pitch.fromInt (mod n 100)) (resize 100 arbitrary))
+> coarbitrary = undefined
+
+> instance (Arbitrary instr, Arbitrary drum) =>
+> Arbitrary (RhyMusic.Note drum instr) where
+> arbitrary =
+> liftM2 RhyMusic.Note
+> (liftM abs arbitrary)
+> arbitrary
+> coarbitrary = undefined
+
+> instance (NonNeg.C time, Arbitrary time, Arbitrary note) =>
+> Arbitrary (PfBE.Event time note) where
+> arbitrary = liftM2 PfBE.Event arbitrary arbitrary
+> coarbitrary = undefined
+
+
+> -- we need this e.g. for Equivalence.propTempoRest0
+> instance (Integral a, Arbitrary a) => Arbitrary (Ratio a) where
+> -- arbitrary = liftM2 (%+) arbitrary (untilM (0/=) arbitrary)
+> {- untilM (0/=) leads to infinite loop in some cases,
+> probably because of 'size' reduced to zero. -}
+> arbitrary =
+> liftM2 (\numer denom -> numer % (if denom==0 then 1 else denom))
+> arbitrary arbitrary
+> coarbitrary = undefined
+
+> {-
+> instance Arbitrary Char where
+> arbitrary =
+> frequency
+> [(26, choose ('a','z')),
+> (26, choose ('A','Z')),
+> (10, choose ('0','9'))]
+> coarbitrary = undefined
+> -}
+
+> instance (Temporal.C a, Arbitrary a, Arbitrary control) =>
+> Arbitrary (CtrlMediumList.T control a) where
+> arbitrary =
+> let sizedTree 0 = liftM Medium.prim arbitrary
+> sizedTree n =
+> let subTree m = replicateM m (resize (div n m) arbitrary)
+> in frequency
+> [(3, liftM Medium.prim arbitrary),
+> (1, liftM Medium.serial (choose (0,n) >>= subTree)),
+> (1, liftM Medium.parallel (choose (0,n) >>= subTree)),
+> (1, liftM2 CtrlMedium.control arbitrary arbitrary)]
+> in sized sizedTree
+> {-
+> arbitrary =
+> let sizedTree 0 = liftM Medium.List.Prim arbitrary
+> sizedTree n =
+> let halfTree = sizedTree (div n 2)
+> in frequency
+> [(3, liftM Medium.List.Prim arbitrary),
+> (1, liftM2 (Medium.+:+) halfTree halfTree),
+> (1, liftM2 (Medium.=:=) halfTree halfTree)]
+> in sized sizedTree
+> -}
+> coarbitrary = undefined
+
+\end{haskelllisting}
+
+> propBackEndPerformance ::
+> PfBE.T NonNegW.Rational MidiMusic.Note -> Bool
+> propBackEndPerformance p =
+> let performanceFromMusic :: MidiMusic.T -> PfBE.T NonNegW.Rational MidiMusic.Note
+> performanceFromMusic =
+> PfBE.fromPerformance (const (const id)) .
+> (flip asTypeOf (undefined ::
+> Performance.T NonNegW.Rational Rational MidiMusic.Note)) .
+> DefaultPerformance.fromMusicModifyContext (Context.setDur 1)
+> in TimeList.normalize p ==
+> TimeList.normalize (performanceFromMusic (PfBE.toMusic p))
+
+> testPerformance :: HUnit.Test
+> testPerformance =
+> HUnit.TestLabel "performance"
+> (testUnit "backend" propBackEndPerformance)
+
+Check certain properties of \function{Music.take}.
+
+> propTakeDurFinite, propDropDurFinite,
+> propTakeDurInfinite, propDropDurInfinite,
+> propTakeDurInfinite', propDropDurInfinite',
+> propTakeTooLong, propDropTooLong :: Dur -> MidiMusic.T -> Property
+
+> propTakeDurFinite d' m =
+> d' >= 0 ==>
+> dur (Music.take d' m) == min d' (dur m)
+> propDropDurFinite d' m =
+> d' >= 0 ==>
+> dur (Music.drop d' m) == dur m -| d'
+
+The following two properties are only true if the music has infinite duration.
+We construct an infinite music
+by cycling all serial compositions of the music.
+In order to get something for cycling
+we have to preserve the existence of a serial composition.
+Empty compositions are also bad for \function{cycle}
+but instead of checking for them we optimize them away.
+I hope that the optimization won't destroy some interesting pathologic examples.
+
+> propTakeDurInfinite d' m =
+> let mOpt = Optimization.composition m
+> in d' >= 0 && atLeastOneSerial mOpt ==>
+> dur (Music.take d' (cycleMusic mOpt)) == d'
+> propDropDurInfinite d' m =
+> let mOpt = Optimization.composition m
+> in d' >= 0 && atLeastOneSerial mOpt ==>
+> dur (Music.take 1 (Music.drop d' (cycleMusic mOpt))) == 1
+
+The preconditions are fulfilled too seldomly.
+
+> propTakeDurInfinite' d' m =
+> d' >= 0 && nonEmptySerials m && atLeastOneSerial m ==>
+> dur (Music.take d' (cycleMusic m)) == d'
+> propDropDurInfinite' d' m =
+> d' >= 0 && nonEmptySerials m && atLeastOneSerial m ==>
+> dur (Music.take 1 (Music.drop d' (cycleMusic m))) == 1
+
+> propTakeTooLong d' m =
+> d' >= 0 ==>
+> Music.take (dur m + d') m =?= m
+> propDropTooLong d' m =
+> d' >= 0 ==>
+> Music.drop (dur m + d') m =?= rest 0
+
+Check if the serial compositions in a music are non-empty,
+otherwise \function{cycle} fails.
+
+> nonEmptySerials :: MidiMusic.T -> Bool
+> nonEmptySerials = isJust .
+> Music.foldList
+> (const . Just) (flip const)
+> (\s -> sequence s >>= ((\d' -> toMaybe (d'/=0) d') . sum))
+> (liftM maximum0 . sequence)
+
+This fails for the music (line [chord []])
+ Music.foldList (const (const True)) (flip const) or and
+
+Check if a music contains at least one serial composition,
+otherwise the music won't become infinite using \function{cycleMusic}.
+
+> atLeastOneSerial :: MidiMusic.T -> Bool
+> atLeastOneSerial =
+> Music.foldList (const (const False)) (flip const) (const True) or
+
+Make music infinite by cycling serial compositions.
+
+> cycleMusic :: MidiMusic.T -> MidiMusic.T
+> cycleMusic = Music.mapList (,) (flip const) cycle id
+
+> testTakeDrop :: HUnit.Test
+> testTakeDrop =
+> -- testUnitBig = testUnitOpt QCB.defOpt{QCB.no_of_tests=10000}
+> HUnit.TestLabel "take, drop" (HUnit.TestList (
+> testUnit "take/dur/finite" propTakeDurFinite :
+> testUnit "drop/dur/finite" propDropDurFinite :
+> testUnit "take/dur/infinite" propTakeDurInfinite :
+> testUnit "drop/dur/infinite" propDropDurInfinite :
+> testUnit "take/too long" propTakeTooLong :
+> testUnit "drop/too long" propDropTooLong :
+> []))
+
+Check certain properties of \function{Music.reverse}.
+
+> propReverse :: MidiMusic.T -> Bool
+> propReverse = Music.reverse . Music.reverse ==?== id
+
+> testReverse :: HUnit.Test
+> testReverse =
+> HUnit.TestLabel "reverse" (testUnit "inverse" propReverse)
+
+Check properties of \function{Music.filter} et al.
+
+> pitchTest :: Pitch.Absolute -> RhyMusic.Note drum instr -> Bool
+> pitchTest pitch =
+> (pitch<=) . Pitch.toInt . MidiMusic.pitch . MidiMusic.body
+
+> propFilterPartition, propParallelPartition, propPartitionMaybe ::
+> Pitch.Absolute -> MidiMusic.T -> Bool
+
+> propFilterPartition pitch m =
+> let p = pitchTest pitch
+> in Music.partition p m ==
+> (Music.filter p m, Music.filter (not . p) m)
+
+> propParallelPartition pitch =
+> let p = pitchTest pitch
+> in id ==?== uncurry (=:=) . Music.partition p
+
+> propPartitionMaybe pitch m =
+> let p = pitchTest pitch
+> in Music.partition p m ==
+> Music.partitionMaybe (\n -> toMaybe (p n) n) m
+
+> testFilter :: HUnit.Test
+> testFilter =
+> HUnit.TestLabel "filter" (HUnit.TestList (
+> testUnit "filter partition" propFilterPartition :
+> testUnit "parallel partition" propParallelPartition :
+> testUnit "partition maybe" propPartitionMaybe :
+> []))
+
+Check if \module{Optimization} simplifies some examples according
+to the laws given in \secref{equivalence}.
+
+> propOptAll, propOptRest, propOptComposition, propOptDuration,
+> propOptTempo, propOptTranspose, propOptVolume
+> :: MidiMusic.T -> Bool
+> propOptAll = id ==?== Optimization.all
+> propOptRest = id ==?== Optimization.rest
+> propOptComposition = id ==?== Optimization.composition
+> propOptDuration = id ==?== Optimization.duration
+> propOptTempo = id ==?== Optimization.tempo
+> propOptTranspose = id ==?== Optimization.transpose
+> propOptVolume = id ==?== Optimization.volume
+
+> testOptimization :: HUnit.Test
+> testOptimization =
+> let controls0 =
+> [Music.changeTempo 3,
+> Music.changeTempo 1,
+> Music.changeTempo (1/3),
+> Music.transpose 1,
+> Music.transpose 2,
+> Music.transpose 3]
+> controls1 =
+> [Music.changeTempo 2,
+> Music.changeTempo 3,
+> Music.changeTempo 5,
+> -- Music.phrase (Music.Accent 1.01),
+> Music.transpose (-3),
+> Music.transpose ( 0),
+> Music.transpose ( 3)]
+> mixer ctrls g' = List.take 10 (map fst
+> (iterate (uncurry shuffle) (ctrls,g')))
+> rcs0 = mixer controls0 (mkStdGen 142)
+> rcs1 = mixer controls1 (mkStdGen 857)
+> mOrig cs0 cs1 =
+> foldr id
+> (c 1 en () =:= rest qn =:= foldr id (a 0 qn () +:+ rest 0) cs1)
+> cs0
+> mOptOrigs = map Optimization.all (zipWith mOrig rcs0 rcs1)
+> mOpt =
+> Music.transpose 6
+> (chord [c 1 en (), qnr, Music.changeTempo 30 (a 0 qn ())])
+> in {-
+> mapM (putStrLn . MusicFormat.prettyMelody) mOptOrigs >>
+> putStrLn (MusicFormat.prettyMelody mOpt) >>
+> -}
+> HUnit.TestLabel "optimization" (HUnit.TestList (
+> HUnit.TestCase (HUnit.assertBool "shuffled controls"
+> (all (mOpt ==) mOptOrigs)) :
+> testUnit "all" propOptAll :
+> testUnit "rest" propOptRest :
+> testUnit "composition" propOptComposition :
+> testUnit "duration" propOptDuration :
+> testUnit "tempo" propOptTempo :
+> testUnit "transpose" propOptTranspose :
+> testUnit "volume" propOptVolume :
+> []))
+
+
+Check if the precedence of serial composition
+is higher than that of parallel composition.
+
+> testPrecedence :: HUnit.Test
+> testPrecedence =
+> HUnit.TestLabel "precedence" (HUnit.TestList [
+> HUnit.TestCase
+> (HUnit.assertBool "+:+/=:="
+> ( c 0 wn () +:+ e 0 wn () =:= g 0 wn () ==
+> (c 0 wn () +:+ e 0 wn ()) =:= g 0 wn ())),
+> HUnit.TestCase
+> (HUnit.assertBool "=:=/+:+"
+> (c 0 wn () =:= e 0 wn () +:+ g 0 wn () ==
+> c 0 wn () =:= (e 0 wn () +:+ g 0 wn ())))])
+
+
+Test for structure analysis.
+To check the integrity of the structure analysis
+we turn a song into grammar and expand it again.
+The original song and the expanded one should be literally equivalent.
+
+\begin{haskelllisting}
+
+> grammarExample0, grammarExample1 :: Melody.T ()
+> grammarExample0 = Music.take 17 Flip.core
+> grammarExample1 = line (List.take 20 (cycle [c 0 qn (), e 0 wn (), g 0 wn ()]))
+
+> propGrammar :: MidiMusic.T -> Bool
+> propGrammar =
+> id ==?== Grammar.toMedium .
+> Grammar.fromMedium (map (("part"++).(:[])) ['A'..]) 2
+
+> testGrammar :: HUnit.Test
+> testGrammar =
+> let test name m0 =
+> HUnit.TestCase
+> (HUnit.assertBool name (propGrammar (withPiano m0)))
+> in {- diffIA (MidiFile.showLines (Render.generalMidiDeflt m0))
+> (MidiFile.showLines (Render.generalMidiDeflt m1)) >>
+> diffIA (MidiFile.showLines (MidiFile.sortEvents (Render.generalMidiDeflt Kantate147.song)))
+> (MidiFile.showLines (MidiFile.sortEvents (Render.generalMidiDeflt (Grammar.toMedium Kantate147.grammar)))) >> -}
+> HUnit.TestLabel "structure analysis" (HUnit.TestList [
+> test "example0" grammarExample0,
+> test "example1" grammarExample1,
+> -- testUnit "inverse" propGrammar,
+> HUnit.TestCase
+> (HUnit.assertBool "kantate147"
+> (withPiano (changeTempo (4%+3) Kantate147.song) =?=
+> withPiano (Grammar.toMedium Kantate147.grammar)))])
+
+\end{haskelllisting}
+
+Check if a music is properly formatted,
+that is check if the output is syntactically correct
+and if the generated module generates the same MIDI file
+as we obtain directly.
+
+\begin{haskelllisting}
+
+> ctrlMusic :: Melody.T ()
+> ctrlMusic =
+> let n0 = c 1 (1/23) ()
+> n1 = c 1 qn ()
+> r0 = rest (1/23)
+> r1 = rest qn
+> in changeTempo (2/3) (n0 +:+ r0) =:= transpose 3 (n1 +:+ r1) =:=
+> chord [changeTempo (2/3) n0, transpose (-3) n1,
+> changeTempo 7 r0, transpose 4 r1]
+
+> testFormatMusic :: HUnit.Test
+> testFormatMusic = HUnit.TestCase $
+> do writeFile "GeneratedTest.hs" (unlines
+> ["module GeneratedTest where",
+> "import Haskore.Basic.Duration((%+))",
+> "import Haskore.Music",
+> "import Haskore.Melody.Standard",
+> "import Haskore.Music.GeneralMIDI as MidiMusic",
+> "import Haskore.Interface.MIDI.Render as Render",
+> "main = Render.fileFromGeneralMIDIMusic \"test.mid\" song",
+> "song = MidiMusic.fromStdMelody MidiMusic.AcousticGrandPiano $ " ++
+> MusicFormat.prettyMelody
+> (StdMelody.fromMelodyNullAttr ctrlMusic)])
+> if False
+> then system ("echo 'main\n:q' | hugs -98 -P"++hugsPath++" GeneratedTest")
+> else system ("ghc -e main -i"++hugsPath++" GeneratedTest")
+> midi <- BinIO.readBinaryFile "test.mid"
+> let expectedMidi =
+> SaveMidi.toByteList (Render.generalMidi (withPiano ctrlMusic))
+> -- BinIO.writeBinaryFile "expected.mid" expectedMidi
+> HUnit.assertEqual
+> "formatting music"
+> expectedMidi
+> midi
+
+> testFormat :: HUnit.Test
+> testFormat =
+> HUnit.TestLabel "composition" $ HUnit.TestList $
+> testFormatMusic :
+> HUnit.TestCase
+> (HUnit.assertBool "formatting duration" Duration.propToString) :
+> []
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> testComposition :: HUnit.Test
+> testComposition =
+> HUnit.TestLabel "composition" (HUnit.TestList (
+> HUnit.TestLabel "tempo" (HUnit.TestList (
+> testUnit "neutral" Equivalence.propTempoNeutral :
+> testUnit "fuse" Equivalence.propTempoTempo :
+> testUnit "commutativity" Equivalence.propTempoCommutativity :
+> testUnit "transpose/commutativity"
+> Equivalence.propTempoTransposeCommutativity :
+> testUnit "serial" Equivalence.propTempoSerial :
+> testUnit "parallel" Equivalence.propTempoParallel :
+> testUnit "rest0" Equivalence.propTempoRest0 :
+> [])) :
+> HUnit.TestLabel "transpose" (HUnit.TestList (
+> testUnit "neutral" Equivalence.propTransposeNeutral :
+> testUnit "fuse" Equivalence.propTransposeTranspose :
+> testUnit "commutativity" Equivalence.propTransposeCommutativity :
+> testUnit "serial" Equivalence.propTransposeSerial :
+> testUnit "parallel" Equivalence.propTransposeParallel :
+> testUnit "rest0" Equivalence.propTransposeRest0 :
+> [])) :
+> HUnit.TestLabel "serial" (HUnit.TestList (
+> testUnit "associativity" Equivalence.propSerialAssociativity :
+> testUnit "neutral0" Equivalence.propSerialNeutral0 :
+> testUnit "neutral1" Equivalence.propSerialNeutral1 :
+> testUnit "parallel0" Equivalence.propSerialParallel0 :
+> testUnit "parallel1" Equivalence.propSerialParallel1 :
+> [])) :
+> HUnit.TestLabel "parallel" (HUnit.TestList (
+> testUnit "associativity" Equivalence.propParallelAssociativity :
+> testUnit "commutativity" Equivalence.propParallelCommutativity :
+> [])) :
+> []))
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> allTests :: HUnit.Test
+> allTests =
+> HUnit.TestList $
+> testComposition :
+> testTakeDrop :
+> testReverse :
+> testFilter :
+> testOptimization :
+> testInfinity :
+> testPrecedence :
+> testPerformance :
+> testGrammar :
+> testFormat :
+> testCSounds :
+> testMIDI :
+> []
+
+\end{haskelllisting}
+
+\begin{haskelllisting}
+
+> main :: IO ()
+> main =
+> do
+> when False $
+> mapM_ putStrLn $
+> zipWith (\num path -> show num ++ " - " ++ HUnitText.showPath path)
+> [(1::Int)..] $
+> HUnit.testCasePaths allTests
+> -- putStrLn "tests disabled"
+> counts <- HUnitText.runTestTT allTests
+> when (HUnit.errors counts + HUnit.failures counts > 0)
+> (error "Test suite encountered errors.")
+
+\end{haskelllisting}