packages feed

haskore (empty) → 0.0.5

raw patch · 100 files changed

+20629/−0 lines, 100 filesdep +HUnitdep +QuickCheckdep +arraysetup-changed

Dependencies added: HUnit, QuickCheck, array, base, containers, data-accessor, event-list, haskell-src, markov-chain, midi, mtl, non-negative, parsec, process, random, special-functors

Files

+ LICENSE view
@@ -0,0 +1,674 @@+                    GNU GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                            Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++                       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++                     END OF TERMS AND CONDITIONS++            How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Makefile view
@@ -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)
+ Readme view
@@ -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 <paul.hudak@yale.edu>+   and the reviser: Henning Thielemann <haskore@henning-thielemann.de>+   and for more discussion: http://lists.lurk.org/mailman/listinfo/haskell-art
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ haskore.cabal view
@@ -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 <paul.hudak@yale.edu>, Henning Thielemann+Maintainer:     Henning Thielemann <haskore@henning-thielemann.de>+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
+ src/Doc/Discussion.tex view
@@ -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.
+ src/Doc/Introduction.tex view
@@ -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.
+ src/Doc/Macros.tex view
@@ -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
+ src/Doc/Related.tex view
@@ -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}).+
+ src/Doc/Tutorial.tex view
@@ -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}
+ src/Haskore.lhs view
@@ -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.
+ src/Haskore/Basic/Duration.lhs view
@@ -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}
+ src/Haskore/Basic/Dynamics.lhs view
@@ -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
+ src/Haskore/Basic/Interval.lhs view
@@ -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}
+ src/Haskore/Basic/Pitch.lhs view
@@ -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}
+ src/Haskore/Basic/Scale.lhs view
@@ -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}.
+ src/Haskore/Basic/Tempo.lhs view
@@ -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.+
+ src/Haskore/Composition/Chord.lhs view
@@ -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}
+ src/Haskore/Composition/ChordType.lhs view
@@ -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}
+ src/Haskore/Composition/Drum.lhs view
@@ -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}
+ src/Haskore/Composition/Rhythm.lhs view
@@ -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}
+ src/Haskore/Composition/Trill.lhs view
@@ -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}
+ src/Haskore/Example/BesondrerTag.hs view
@@ -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))
+ src/Haskore/Example/ChildSong6.lhs view
@@ -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}
+ src/Haskore/Example/Detail.hs view
@@ -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+
+ src/Haskore/Example/Flip.hs view
@@ -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
+ src/Haskore/Example/Fractal.hs view
@@ -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))
+ src/Haskore/Example/Guitar.lhs view
@@ -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)
+ src/Haskore/Example/Kantate147.hs view
@@ -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"),+  ("<b>e<e",       "ge<b",             "b3ab3ge3d",       "dgf#gd<bgab"),+  ("ab>c",         "a>dc",             "e3f#g3de3<b",     ">cdedc<babg"),+  ("df#d",         "c<a>f#",           "a3>da3ga3f#",     "f#gadf#a>c<ba"),+  ("gec",          "g<g>e",            "d3f#g3f#g3a",     "bgab>dcced"),+  ("<b>ed",        "ge<b",             "b3ab3ge3g",       "dgf#gd<bgab"),+  ("cc#d",         ">ced",             "a3f#g3e<a3>c",    "e>dc<bagdgf#"),+  ("<gp3>g6d3<b6", "dp2b3g6",          "<b3>gb3>dg3d",    "gb>dgd<bgb>d"),+  ("g>f#e",        "d<gg",             "l2<g1g",          "l2<b1>c"),+  ("f#ed",         "agf#",             "a1b",             "d1d"),+  ("ef#g",         "gag",              "bag",             "c1<b"),+  ("dp3d6d3d6",    "f#a3a6>d3d6",      "al6d3ef#3g",      "l6adef#aga>c<b"),+  ("<d>p3d6d3d6",  "f#3a6f#3d6<a3>d6", "a3>c<a3f#d3f#",   ">c<af#df#a>c<ba"),+  ("gf#e",         "dde",              "g3dg3f#g3a",      "bgab>dcced"),+  ("b<b>e",        "gd<b",             "b3ag3f#e3g",      "dgf#gd<bgab"),+  ("cd<d",         "l4>c<a>d<b>c<al2", "a3gf#3ga3c",      "e>dc<bagdgf#"),+  ("g>ge",         "b>de",             "<b3>dg3f#g3a",    "gbab>dcced"),+  ("<b>e<e",       "ge<b",             "b3ab3ge3d",       "dgf#gd<bgab"),+  ("ab>c",         "a>dc",             "e3f#g3de3<b",     ">cdedc<babg"),+  ("df#d",         "c<a>f#",           "a3>f#a3ga3f#",    "f#gadf#a>c<ba"),+  ("gec",          "g<g>e",            "d3f#g3f#g3a",     "bgab>dcced"),+  ("<b>ed",        "ge<b",             "b3ab3ge3g",       "dgf#gd<bgab"),+  ("cc#d",         ">ced",             "a3f#g3e<a3>c",    "e>dc<bagdgf#"),+  ("<g>f#e",       "d<gg",             "l2b1>c",          "l2g1g"),+  ("f#ed",         "agf#",             "d1d",             "a1b"),+  ("ef#g",         "gag",              "c1<b",            "bag"),+  ("dp3d6d3d6",    "f#l6a3a>d3d",      "al6d3ef#3g",      "l6ddef#aga>c<b"),+  ("<dp3>d6d3d6",  "f#3af#3d<a3>d",    "a3>c<a3f#d3f#",   ">c<af#df#a>c<ba"),+  ("gf#e",         "l2dde",            "l2b1>c",          "bgab>dcced"),+  ("b<b>e",        "gd<b",             "d1<b",            "dgf#gd<bgab"),+  ("cd<d",         "l4>c<a>d<b>c<a",   "a4b8>c8<ba",      "e>dc<bagdgf#"),+  ("g>ge",         "l2b>de",           "l6g3dg3f#g3a",    "gbab>dcced"),+  ("<b>e<e",       "ge<b",             "b3ab3ge3d",       "dgf#gd<bgab"),+  ("ab>c",         "a>dc",             "e3f#g3de3<b",     ">cdedc<babg"),+  ("df#d",         "c<a>f#",           "a3>da3ga3f#",     "f#gadf#a>c<ba"),+  ("gec",          "g<g>e",            "d3f#g3f#g3a",     "bgab>dcced"),+  ("<b>ed",        "ge<b",             "b3ab3ge3g",       "dgf#gd<bgab"),+  ("cc#d",         ">ced",             "a3f#g3e<a3>c",    "e>dc<bagdgf#"),+  ("<gp3>g6f#3e6", "dp3g6d3e6",        "<b3>gb3>dg3<g",   "gb>dgd<bdb>c#"),+  ("dc<b",         "f#dd",             "l2a1b",           "d<def#ag#g#ba"),+  ("a>a4g4f4e4",   "e<a>a",            ">c1c",            "a>c<b>c<aecde"),+  ("d<b>e",        "aag#",             "<bb4>c8d8<b",     "f>dcd<bg#ef#g#"),+  ("a>fd",         "e<a>f#",           "al6a3g#a3b",      "a>c<b>ceddfe"),+  ("cfe",          "afc",              ">c3<b>c3<af3a",   "eag#aec<ab>c"),+  ("dd#e",         "df#e",             "a3g#a3f#<b3>d",   "fedc<baeag#"),+  ("<a>ab",        "c<ag",             ">l2c1d",          "a>ceap3l2d"),+  (">c<ae",        ">cag",             "e1e",             "l6ecdegfgb-a"),+  ("fdg",          "df#g",             "dd4e8f8d",        "a>c<b>c<afdef"),+  ("cec",          "geg",              "l6c3<g>c3<ge3d",  "egfgec<gab-"),+  ("fdg",          "fag",              "c3ef3ab3>d",      "a>c<b>c<afdef"),+  ("cp3c6<b3>d6",  "gp3d6d3d6",        "c3<g>c3<a>d3<f#", "ecdegf#gba"),+  ("<g>ge",        "dde",              "l2b1>c",          "bgab>dcced"),+  ("<b>e<e",       "ge<b",             "d1d",             "dgf#gd<bgab"),+  ("ab>c",         "a>dc",             "c<b1",            ">cdedc<babg"),+  ("dp3d6d3d6",    "cl6<a3a>d3d",      "l6a3c#d3ef#3g",   "f#def#aga>c<b"),+  ("<dp3>d6d3d6",  "f#3af#3d<a3>d",    "a3>c<a3f#d3f#",   ">c<af#df#a>c<ba"),+  ("gf#e",         "l2dde",            "l2b1>c",          "bgab>dcced"),+  ("b<b>e",        "gd<b",             "d1<b",            "dgf#gd<bgab"),+  ("cd<d",         "l4>c<a>d<b>c<a",   "a4b8>c8<ba",      "e>dc<bagdgf#"),+  ("g1g2",         "l2gp3>g6d3g6",     "gl6<b3>dg3d",     "gb>dgd<bgb>a"),+  ("g1g2",         "dp3g6e3c6",        "<b3g>d3b>c2",     "fd<bgb>ded<a"),+  ("g1g2",         "<ap3>d6<b3>e6",    "c3<ab2b3g",       "f#a>cd<bgegb"),+  ("g1g2",         "<e3a6f#3>a6f#3d6", "a2a3f#d3f#",      ">c<af#df#a>c<ba"),+  ("g>ge",         "dde",              "g3dg3f#g3a",      "bgab>dcced"),+  ("<b>e<e",       "ge<b",             "b3ab3ge3d",       "dgf#gd<bgab"),+  ("ab>c",         "a>d<c",            "e3f#g3de3<b",     ">cdedc<babg"),+  ("df#d",         "c<a>f#",           "a3>da3ga3f#",     "f#gadf#a>c<ba"),+  ("gec",          "g<g>e",            "d3f#g3f#g3a",     "bgab>dcced"),+  ("<b>ed",        "ge<d",             "b3ab3ge3g",       "dgf#gd<bgab"),+  ("cc#d",         "d1d2",             "a3f#g3e<a3>c",    "e>dc<bagdgf#"),+  ("<g1g2",        "p2",               "<b1b2",           "g1g2"),+  ("p1",           "p1",               "p1",              "p1")+  ]+++musicTracks :: [[[Melody.T ()]]]+musicTracks =+   let (track0, track1, track2, track3) = List.unzip4 songMML+       trackToMusic tr oct =+          (evalState (mapM (MML.toMusicState) tr) (0, oct))+   in  zipWith trackToMusic [track0, track1, track2, track3]+                            initOctaves++song :: Melody.T ()+song = line (map (chord . map line) (List.transpose musicTracks))+++{- Try to reconstruct a structure of the music. -}++grammar :: Grammar.T String Music.Control (Music.Primitive (Melody.Note ()))+grammar =+   let songTrackwise = chord (map (line . concat) musicTracks)+       songConvDurs  = fmap (\(Music.Atom dr at) -> 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
+ src/Haskore/Example/Miscellaneous.lhs view
@@ -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}
+ src/Haskore/Example/NewResolutions.lhs view
@@ -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
+ src/Haskore/Example/Raenzlein.hs view
@@ -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))
+ src/Haskore/Example/SelfSim.lhs view
@@ -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}
+ src/Haskore/Example/Ssf.lhs view
@@ -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)
+ src/Haskore/Example/WhiteChristmas.hs view
@@ -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)
+ src/Haskore/General/GraphRecursiveGen.lhs view
@@ -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)
+ src/Haskore/General/GraphTaggedGen.lhs view
@@ -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
+ src/Haskore/General/IO.hs view
@@ -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)
+ src/Haskore/General/IdGenerator.lhs view
@@ -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}
+ src/Haskore/General/LoopTreeRecursive.lhs view
@@ -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))
+ src/Haskore/General/LoopTreeRecursiveGen.lhs view
@@ -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"
+ src/Haskore/General/LoopTreeTagged.lhs view
@@ -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
+ src/Haskore/General/LoopTreeTaggedGen.lhs view
@@ -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 <roberto.zunino@sns.it>+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
+ src/Haskore/General/Map.hs view
@@ -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
+ src/Haskore/General/Monad.lhs view
@@ -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}
+ src/Haskore/General/TagDictionary.hs view
@@ -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")
+ src/Haskore/General/Utility.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/ChartBar.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/ChordChart.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/ChordSymbol.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/EventChart.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/Instrument.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/Main.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/Option.lhs view
@@ -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...] <infile >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}
+ src/Haskore/Interface/AutoTrack/ScaleChart.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/Style.lhs view
@@ -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}
+ src/Haskore/Interface/AutoTrack/Transposeable.lhs view
@@ -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}
+ src/Haskore/Interface/CSound.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/Generator.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/InstrumentMap.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/Note.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/Orchestra.lhs view
@@ -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 ++ " <function> " ++ 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}
+ src/Haskore/Interface/CSound/OrchestraFunction.lhs view
@@ -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+>                                     ]
+ src/Haskore/Interface/CSound/Score.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/SoundMap.hs view
@@ -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))+
+ src/Haskore/Interface/CSound/Tutorial.lhs view
@@ -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}
+ src/Haskore/Interface/CSound/TutorialCustom.lhs view
@@ -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}+
+ src/Haskore/Interface/MED/Text.hs view
@@ -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 =+-}
+ src/Haskore/Interface/MIDI.lhs view
@@ -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
+ src/Haskore/Interface/MIDI/InstrumentMap.lhs view
@@ -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}
+ src/Haskore/Interface/MIDI/Note.lhs view
@@ -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}
+ src/Haskore/Interface/MIDI/Read.lhs view
@@ -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}
+ src/Haskore/Interface/MIDI/Render.lhs view
@@ -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} }
+ src/Haskore/Interface/MIDI/Write.lhs view
@@ -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}
+ src/Haskore/Interface/MML.lhs view
@@ -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}
+ src/Haskore/Melody.lhs view
@@ -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}+
+ src/Haskore/Melody/Standard.lhs view
@@ -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)
+ src/Haskore/Music.lhs view
@@ -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.
+ src/Haskore/Music/GeneralMIDI.lhs view
@@ -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
+ src/Haskore/Music/Rhythmic.lhs view
@@ -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}
+ src/Haskore/Music/Standard.lhs view
@@ -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
+ src/Haskore/Performance.lhs view
@@ -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}.
+ src/Haskore/Performance/BackEnd.lhs view
@@ -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}
+ src/Haskore/Performance/Context.hs view
@@ -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
+ src/Haskore/Performance/Default.lhs view
@@ -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}+}
+ src/Haskore/Performance/Fancy.lhs view
@@ -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
+ src/Haskore/Performance/Player.lhs view
@@ -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}
+ src/Haskore/Process/Format.lhs view
@@ -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}
+ src/Haskore/Process/Optimization.lhs view
@@ -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}
+ src/Medium.hs view
@@ -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
+ src/Medium/Controlled.hs view
@@ -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
+ src/Medium/Controlled/ContextFreeGrammar.lhs view
@@ -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}
+ src/Medium/Controlled/List.hs view
@@ -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)
+ src/Medium/LabeledControlled/List.hs view
@@ -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]
+ src/Medium/Plain/Binary.hs view
@@ -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 :)
+ src/Medium/Plain/ContextFreeGrammar.lhs view
@@ -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}
+ src/Medium/Plain/List.hs view
@@ -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]
+ src/Medium/Temporal.hs view
@@ -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
+ src/Test/Equivalence.lhs view
@@ -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}+
+ src/Test/Suite.lhs view
@@ -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}