diff --git a/COPYING b/COPYING
new file mode 100644
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ Copyright (C)
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+.
diff --git a/Makefile b/Makefile
new file mode 100644
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,22 @@
+.SECONDARY: %.frames
+
+%.ps: %.mmd?
+ cabal run animed -- --frame-pattern="/tmp/page-%04d.png" $<
+
+%.wav: %.mmd1
+ uade123 --panning=0.5 -f $@ $<
+
+# Resolution is one Postscript point (1/72 inch).
+%.frames: %.ps
+ export width=$$(fgrep '%%DocumentMedia:' $< | head -n1 | cut -f3 -d' '); \
+ gs -sDEVICE=pnggray -sOutputFile=/tmp/page-%04d.png \
+ -dNOPAUSE -dBATCH -dTextAlphaBits=2 -dGraphicsAlphaBits=2 \
+ -g"$$width"x720 -r72 $<
+ touch $@
+
+%.flv: %.frames %.wav
+ ffmpeg -f concat -safe 0 -i $*.cue -i $*.wav \
+ -vcodec flashsv -acodec copy -y $@
+
+README.html: README.md
+ pandoc $< --output $@
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,10 @@
+* unmed2: extract useful information from MED files
+
+* animed: convert a MED module file to an animation in a PostScript file
+
+ Limitations:
+
+ * Ignores the rarely used looping commands `16` and `1E` without notice.
+
+ * Columns of adjacent blocks are not aligned
+ if the number of command pages changes.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#! /usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/example/Animate.hs b/example/Animate.hs
new file mode 100644
--- /dev/null
+++ b/example/Animate.hs
@@ -0,0 +1,271 @@
+module Main where
+
+import qualified Animate.Option as Option
+import qualified Options.Applicative as OP
+import System.FilePath(dropExtension, (<.>))
+
+import qualified Sound.MED.Generic as MED
+import qualified Sound.MED.Generic.Block as MEDBlock
+import qualified Sound.MED.Generic.Tempo as MEDTempo
+import qualified Sound.MED.Generic.PlaySeq as MEDPlaySeq
+import Sound.MED.Generic.Block(Cmd,Val)
+import Sound.MED.Basic.Human(human)
+
+import qualified Graphics.PS as PS
+import Graphics.PS ((+++))
+
+import qualified Data.Array as Array
+import qualified Data.Foldable as Fold
+import qualified Data.NonEmpty as NonEmpty
+import qualified Data.List.Match as Match
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Array (Array, listArray, (!))
+import Data.Maybe.HT (toMaybe)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Tuple.HT (thd3)
+import Text.Printf (printf)
+import Data.Monoid (Any(Any,getAny))
+
+import qualified Control.Monad.Trans.Writer as MW
+import qualified Control.Monad.Trans.Class as MT
+import Control.Monad(when, void, msum)
+import Control.Applicative((<$>), (<|>))
+
+main :: IO ()
+main = do
+ (options, mmds) <- OP.execParser $ Option.info Option.parser
+ mapM_ (animate options) mmds
+
+animate :: Option.Option -> FilePath -> IO ()
+animate opt file = do
+ med <- MED.load file
+ let initTempo = MED.tempo med
+ void $ printf "tempo primary: %d, secondary %d\n"
+ (MEDTempo.primary initTempo) (MEDTempo.secondary initTempo)
+ sequ <-
+ case MED.playseqs med of
+ sequ:_ -> return sequ
+ [] -> ioError $ userError "no play sequence available"
+ putStrLn $ human sequ
+ let blocks = map MEDBlock.seqdata $ MED.blocks med
+ let loop = Option.repeatUntil opt
+ let allLines = flattenLines (isJust loop) blocks $ MEDPlaySeq.indices sequ
+ let durations =
+ maybe id takeUntilTime loop $ map MEDTempo.toTime $
+ NonEmpty.tail $ NonEmpty.scanl (foldl MEDTempo.update) initTempo $
+ map (concatMap thd3 . snd . snd . snd) allLines
+ let formattedLines = map highlightLine allLines
+ let pre = Option.contextSize opt
+ let post = Option.contextSize opt
+ let textWidth =
+ maximum $ map (length . snd) $
+ take (length durations + post) formattedLines
+ writePostscript (dropExtension file <.> "ps")
+ (Option.height opt) (pre,post) textWidth $
+ zip (brightnesses (Option.fadeOut opt) durations) $
+ map (take (pre+1+post)) $ ListHT.tails $
+ replicate pre ((False,False),"") ++ formattedLines
+ when (not $ null $ Option.framePattern opt) $
+ writeFile (dropExtension file <.> "cue") $ concat $
+ zipWith (printf "file '%s'\nduration %.5f\n")
+ (map (formatFramePath $ Option.framePattern opt) [1 ..])
+ durations
+
+brightnesses :: Double -> [Double] -> [Double]
+brightnesses fadeOutDur durations =
+ let totalTime = sum durations
+ fadeOutStart = totalTime - fadeOutDur
+ in map
+ (\time ->
+ if time < fadeOutStart || fadeOutDur <= 0
+ then 1
+ else (totalTime-time) / fadeOutDur) $
+ NonEmpty.init $ NonEmpty.scanl (+) 0 durations
+
+takeUntilTime :: Double -> [Double] -> [Double]
+takeUntilTime =
+ let go _ [] = []
+ go end (dur:durs) = if dur>=end then [end] else dur : go (end-dur) durs
+ in go
+
+{- |
+Traverse playing sequence but ignore control commands.
+If the playing sequence is finite, the flattened list of lines will be, too.
+-}
+flattenLinesSimple :: Bool -> [[line]] -> [Int] -> [(Bool,(Int,line))]
+flattenLinesSimple loop blocks =
+ let blockArr = arrayFromList blocks
+ in (if loop then cycle else id) .
+ concatMap (addTrailingTrue . zip [0..] . (blockArr !))
+
+flattenLinesArr :: Bool -> [[line]] -> [Int] -> [(Bool,(Int,line))]
+flattenLinesArr loop blocks =
+ let blockArr = arrayFromList $ map arrayFromList blocks
+ in (if loop then cycle else id) .
+ concatMap (addTrailingTrue . Array.assocs . (blockArr !))
+
+addTrailingTrue :: [a] -> [(Bool,a)]
+addTrailingTrue xs = zip (Match.replicate (drop 1 xs) False ++ [True]) xs
+
+flattenLines ::
+ Bool -> [[MEDBlock.Line]] -> [Int] -> [(Bool,(Int,MEDBlock.Line))]
+flattenLines loop blocks sequ =
+ let blockArr = arrayFromList $ map arrayFromList blocks
+ sequArr = arrayFromList sequ
+ sequLength = length sequ
+ accessLine (SongPos sequIdx line) =
+ let block = blockArr!(sequArr!sequIdx)
+ in ((line, block!line), Array.rangeSize $ Array.bounds block)
+ in List.unfoldr
+ (fmap $ \pos ->
+ let (line,blockLength) = accessLine pos
+ (endOfBlock, newSongPos) =
+ nextSongPos loop sequLength blockLength pos $
+ concatMap thd3 $ snd $ snd line
+ in ((endOfBlock, line), newSongPos))
+ (Just $ SongPos 0 0)
+
+data SongPos = SongPos {posSequ, posLine :: Int}
+
+nextSongPos ::
+ Bool -> Int -> Int -> SongPos -> [(Cmd, Val)] -> (Bool, Maybe SongPos)
+nextSongPos loop sequLength blockLength pos cmds =
+ let newSongPos =
+ MW.runWriterT $
+ adjustSongPos loop sequLength blockLength =<<
+ cumulatedSongPosUpdate loop pos cmds
+ in (maybe False (getAny.snd) newSongPos, fst<$>newSongPos)
+
+data SongPosCmds =
+ SongPosCmds {
+ posCmd0F00, posCmd0FFE :: Bool,
+ posCmd1Dxx :: Maybe Int,
+ posCmd0Bxx :: Maybe Int
+ }
+
+{-
+If there are multiple flow control commands in a line
+then the behavior of MED is complex and undocumented.
+Here is, what I found out:
+@0FFE@ overrides all other three flow control commands.
+@1Dxx@ overrides @0F00@,
+@0Bxx@ and @1Dxx@ are combined, as well as @0Bxx@ and @0F00@.
+If there are multiple @0Bxx@ commands in a line
+then the right-most and then the deep-most wins
+(deep with respect to command pages).
+The same applies to multiple @1Dxx@ commands.
+-}
+cumulatedSongPosUpdate ::
+ Bool -> SongPos -> [(Cmd, Val)] -> MW.WriterT Any Maybe SongPos
+cumulatedSongPosUpdate loop pos@(SongPos sequIdx _line) cmds0 =
+ let cum = foldl update start cmds0
+ start =
+ SongPosCmds {
+ posCmd0F00 = False, posCmd0FFE = False,
+ posCmd1Dxx = Nothing, posCmd0Bxx = Nothing
+ }
+ update cmds cmdVal =
+ case cmdVal of
+ (0x0F, 0x00) -> cmds{posCmd0F00 = True}
+ (0x0F, 0xFE) -> cmds{posCmd0FFE = True}
+ (0x1D, line) -> cmds{posCmd1Dxx = Just line}
+ (0x0B, idx ) -> cmds{posCmd0Bxx = Just idx}
+ _ -> cmds
+ continue = flip (,) (Any False); break_ = flip (,) (Any True)
+ breakBlock =
+ case (posCmd0Bxx cum, posCmd1Dxx cum <|> toMaybe (posCmd0F00 cum) 0) of
+ (Nothing, Nothing) -> Just $ continue $ incSongPos pos
+ (Just idx, Nothing) -> toMaybe loop $ break_ $ SongPos idx 0
+ (Nothing, Just line) -> Just $ break_ $ SongPos (sequIdx+1) line
+ (Just idx, Just line) -> toMaybe loop $ break_ $ SongPos (idx+1) line
+ in if posCmd0FFE cum
+ then MT.lift Nothing
+ else MW.WriterT breakBlock
+
+
+{- |
+Simpler alternative to 'cumulatedSongPosUpdate'.
+-}
+leftMostSongPosUpdate ::
+ Bool -> SongPos -> [(Cmd, Val)] -> MW.WriterT Any Maybe SongPos
+leftMostSongPosUpdate loop pos =
+ fromMaybe (return $ incSongPos pos) . msum . map (updateSongPos loop pos)
+
+adjustSongPos :: Bool -> Int -> Int -> SongPos -> MW.WriterT Any Maybe SongPos
+adjustSongPos loop sequLength blockLength pos0 =
+ let endOfBlock = posLine pos0 >= blockLength
+ pos1 = if endOfBlock then SongPos (posSequ pos0 + 1) 0 else pos0
+ in MW.WriterT $
+ toMaybe (posSequ pos1 < sequLength) (pos1, Any endOfBlock)
+ <|>
+ toMaybe loop (SongPos 0 0, Any True)
+
+incSongPos :: SongPos -> SongPos
+incSongPos (SongPos sequIdx line) = SongPos sequIdx (line+1)
+
+updateSongPos ::
+ Bool -> SongPos -> (Cmd, Val) -> Maybe (MW.WriterT Any Maybe SongPos)
+updateSongPos loop (SongPos sequIdx _line) cmdVal =
+ fmap (MW.WriterT . fmap (flip (,) (Any True))) $
+ case cmdVal of
+ (0x0F, 0xFE) -> Just Nothing
+ (0x0F, 0x00) -> Just $ Just $ SongPos (sequIdx+1) 0
+ (0x1D, line) -> Just $ Just $ SongPos (sequIdx+1) line
+ (0x0B, idx ) -> Just $ toMaybe loop $ SongPos idx 0
+ _ -> Nothing
+
+
+arrayFromList :: [a] -> Array Int a
+arrayFromList xs = listArray (0, length xs - 1) xs
+
+formatFramePath :: String -> Int -> FilePath
+formatFramePath = printf
+
+
+highlightLine :: (Bool, (Int, MEDBlock.Line)) -> ((Bool,Bool),String)
+highlightLine (endOfBlock, (i, (highlight, ds))) =
+ ((Fold.or highlight, endOfBlock), MEDBlock.humanLine i ds)
+
+writePostscript ::
+ FilePath -> Int -> (Int,Int) -> Int ->
+ [(Double, [((Bool,Bool),String)])] -> IO ()
+writePostscript path heightInt (pre,post) textWidth blocks =
+ let height = fromIntegral heightInt
+ width = fromIntegral textWidth * fontWidth + 2*left
+ top = height - fontHeight - (height - fontHeight*(preR+1+postR))/2
+ left = 80
+ barWidth n = fromIntegral n * fontWidth + 2*barBorderH
+ fontWidth = fontHeight*(3/5)
+ fontHeight = 17
+ barBorderH = 5
+ barBorderV = 3
+ postR = fromIntegral post
+ preR = fromIntegral pre
+ mmFromPt :: Double -> Int
+ mmFromPt pt = round $ pt / PS.mm_pt 1
+ in PS.ps path (PS.Paper (mmFromPt width) (mmFromPt height)) $
+ map
+ (\(brightness,block) ->
+ flip PS.over
+ (PS.Fill (PS.greyGS brightness) $
+ PS.rectangle (PS.Pt 0 0) width height) $
+ foldr PS.over
+ (PS.Fill (PS.greyGS (0.8*brightness))
+ (PS.rectangle
+ (PS.Pt (left-barBorderH) (top-preR*fontHeight-barBorderV))
+ (barWidth $ length $ snd $ block!!pre) fontHeight)) $
+ zipWith
+ (\y ((highlight,endOfBlock),line) ->
+ let font = if highlight then "Courier-Bold" else "Courier"
+ hline =
+ PS.Stroke (PS.greyGS 0) $
+ PS.line [PS.Pt (left-barBorderH) (y-barBorderV),
+ PS.Pt (left-barBorderH+barWidth(length line))
+ (y-barBorderV)]
+ in (if endOfBlock then PS.over hline else id) $
+ (PS.Fill (PS.greyGS 0) $
+ PS.MoveTo (PS.Pt left y) +++
+ PS.Text (PS.Font font fontHeight) line))
+ (iterate (subtract fontHeight) top) block)
+ blocks
diff --git a/example/Animate/Option.hs b/example/Animate/Option.hs
new file mode 100644
--- /dev/null
+++ b/example/Animate/Option.hs
@@ -0,0 +1,74 @@
+module Animate.Option where
+
+import Data.Monoid ((<>))
+
+import qualified Options.Applicative as OP
+
+import Control.Applicative(pure, liftA2, (<$>), (<*>))
+
+info :: OP.Parser a -> OP.ParserInfo a
+info p =
+ OP.info
+ (OP.helper <*> p)
+ (OP.fullDesc <>
+ OP.progDesc "Generate animation of playing MED/OctaMED song.")
+
+parser :: OP.Parser (Option, [FilePath])
+parser =
+ liftA2 (,)
+ oparser
+ (OP.many $
+ OP.strArgument $
+ OP.metavar "FILE" <>
+ OP.help "Input MED module")
+
+oparser :: OP.Parser Option
+oparser =
+ pure Option
+ <*> (OP.strOption $
+ OP.long "frame-pattern" <>
+ OP.metavar "PATHFMT" <>
+ OP.value "" <>
+ OP.help "Format string for frame paths")
+ <*> (OP.option (Just <$> readNonNeg) $
+ OP.long "repeat-until" <>
+ OP.metavar "SECONDS" <>
+ OP.value Nothing <>
+ OP.help "Loop song for a certain maximum time")
+ <*> (OP.option readNonNeg $
+ OP.long "fade-out" <>
+ OP.metavar "SECONDS" <>
+ OP.value 0 <>
+ OP.help "Reduce brightness for a certain duration at the end")
+ <*> (OP.option OP.auto $
+ OP.long "context-size" <>
+ OP.metavar "NATURAL" <>
+ OP.value 16 <>
+ OP.help "Number of lines before and after current one")
+ <*> (OP.option OP.auto $
+ OP.long "height" <>
+ OP.metavar "POINTS" <>
+ OP.value 720 <>
+ OP.help "Height of the paper in typographical points")
+
+{- |
+Also allow numbers like @.123@ instead of @0.123@.
+-}
+readNonNeg :: OP.ReadM Double
+readNonNeg =
+ OP.eitherReader $ \arg -> case reads ('0':arg) of
+ [(r, "")] ->
+ if r<0
+ then Left $ "negative number `" ++ arg ++ "'"
+ else return r
+ _ -> Left $ "not a number `" ++ arg ++ "'"
+
+
+data Option =
+ Option {
+ framePattern :: FilePath,
+ repeatUntil :: Maybe Double,
+ fadeOut :: Double,
+ contextSize :: Int,
+ height :: Int
+ }
diff --git a/example/Unmed.hs b/example/Unmed.hs
new file mode 100644
--- /dev/null
+++ b/example/Unmed.hs
@@ -0,0 +1,13 @@
+module Main where
+
+import qualified Sound.MED.Generic as MED
+import Sound.MED.Basic.Human(human)
+
+import System.Environment(getArgs)
+
+main :: IO ()
+main = mapM_ printMED =<< getArgs
+
+printMED :: String -> IO ()
+printMED file =
+ putStr . human =<< MED.load file
diff --git a/med-module.cabal b/med-module.cabal
new file mode 100644
--- /dev/null
+++ b/med-module.cabal
@@ -0,0 +1,127 @@
+Name: med-module
+Version: 0.0
+Synopsis: Parse song module files from Amiga MED and OctaMED
+Description:
+ MED (Music EDitor) and its successor OctaMED
+ were popular music trackers on the Amiga:
+ .
+ This is a library for parsing the binary module data.
+ .
+ With the Cabal flag @-fbuildExamples@ you can build two example programs:
+ .
+ * @unmed2@:
+ Loads song module files and show their content on standard output.
+ .
+ * @animed@:
+ Create a PostScript document showing how a song is played.
+ Also creates an FFmpeg cue file for the @concat@ input type.
+ This way you can create videos with MED music
+ plus precisely timed animations of the played tracks.
+ See the included @Makefile@ for the command calls
+ for creation of complete music videos from MMD files.
+License: GPL-3
+License-File: COPYING
+Author: Claude Heiland-Allen, Henning Thielemann
+Maintainer: haskell@henning-thielemann.de
+Category: Sound
+Build-Type: Simple
+Extra-Source-Files: README.md, Makefile, src/Sound/MED/modules.sh
+Cabal-Version: >=1.10
+
+Source-Repository this
+ Tag: 0.0
+ Type: darcs
+ Location: http://hub.darcs.net/thielema/med-module
+
+Source-Repository head
+ Type: darcs
+ Location: http://hub.darcs.net/thielema/med-module
+
+Flag buildExamples
+ description: Build example executables
+ default: False
+
+Library
+ Exposed-Modules:
+ Sound.MED.Basic.Amiga
+ Sound.MED.Basic.Human
+ Sound.MED.Raw.BlockCmdPageTable
+ Sound.MED.Raw.BlockInfo
+ Sound.MED.Raw.CmdPageData
+ Sound.MED.Raw.HybridInstr
+ Sound.MED.Raw.InstrExt
+ Sound.MED.Raw.InstrHdr
+ Sound.MED.Raw.MMD0
+ Sound.MED.Raw.MMD0Block
+ Sound.MED.Raw.MMD0NoteData
+ Sound.MED.Raw.MMD0Sample
+ Sound.MED.Raw.MMD0Song
+ Sound.MED.Raw.MMD0exp
+ Sound.MED.Raw.MMD1
+ Sound.MED.Raw.MMD1Block
+ Sound.MED.Raw.MMD1NoteData
+ Sound.MED.Raw.MMD2
+ Sound.MED.Raw.MMD2Song
+ Sound.MED.Raw.MMD3
+ Sound.MED.Raw.MMDARexx
+ Sound.MED.Raw.MMDARexxTrigCmd
+ Sound.MED.Raw.MMDDump
+ Sound.MED.Raw.MMDDumpData
+ Sound.MED.Raw.MMDInfo
+ Sound.MED.Raw.MMDInstrInfo
+ Sound.MED.Raw.MMDMIDICmd3x
+ Sound.MED.Raw.NotationInfo
+ Sound.MED.Raw.PlaySeq
+ Sound.MED.Raw.SampleInstr
+ Sound.MED.Raw.SynthInstr
+ Sound.MED.Raw.SynthWF
+ Sound.MED.Generic
+ Sound.MED.Generic.Block
+ Sound.MED.Generic.Instrument
+ Sound.MED.Generic.PlaySeq
+ Sound.MED.Generic.Tempo
+ Other-Modules:
+ Sound.MED.Basic.Pretty
+
+ Build-Depends:
+ storable-endian >=0.2.6 && <0.3,
+ utility-ht >=0.0.12 && <0.1,
+ base >=4.5 && <5
+ Hs-Source-Dirs: src
+ Default-Language: Haskell2010
+ GHC-Options: -Wall -fwarn-incomplete-uni-patterns -fwarn-tabs
+
+Executable unmed2
+ Main-Is: example/Unmed.hs
+ If flag(buildExamples)
+ Build-Depends:
+ med-module,
+ base >=4.5 && <5
+ Else
+ Buildable: False
+ Default-Language: Haskell2010
+ GHC-Options:
+ -Wall -fwarn-incomplete-uni-patterns
+ -fwarn-tabs -fwarn-missing-import-lists
+
+Executable animed
+ Main-Is: Animate.hs
+ Hs-Source-Dirs: example
+ Other-Modules: Animate.Option
+ If flag(buildExamples)
+ Build-Depends:
+ med-module,
+ hps >=0.15 && <0.16,
+ optparse-applicative >=0.11 && <0.15,
+ filepath >=1.3 && <1.5,
+ array >=0.4 && <0.6,
+ transformers >=0.3 && <0.6,
+ non-empty >=0.2 && <0.4,
+ utility-ht >=0.0.10 && <0.1,
+ base >=4.5 && <5
+ Else
+ Buildable: False
+ Default-Language: Haskell2010
+ GHC-Options:
+ -Wall -fwarn-incomplete-uni-patterns
+ -fwarn-tabs -fwarn-missing-import-lists
diff --git a/src/Sound/MED/Basic/Amiga.hs b/src/Sound/MED/Basic/Amiga.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Basic/Amiga.hs
@@ -0,0 +1,92 @@
+module Sound.MED.Basic.Amiga where
+
+import qualified System.IO as IO
+
+import qualified Foreign.Marshal.Alloc as Alloc
+import Foreign.Storable (Storable, peekByteOff)
+import Foreign.Ptr (Ptr)
+
+import Control.Monad (when)
+import Control.Applicative ((<$>))
+
+import qualified Data.List.Reverse.StrictSpine as ListRev
+import Data.List.HT (sliceVertical)
+import Data.Storable.Endian (HasBigEndian, getBigEndian)
+import Data.Word (Word8, Word16, Word32)
+import Data.Int (Int8, Int16, Int32)
+
+type MEM = Ptr ()
+type PTR = Word32
+type LONG = Int32
+type ULONG = Word32
+type WORD = Int16
+type UWORD = Word16
+type BYTE = Int8
+type UBYTE = Word8
+
+type Peek a = MEM -> PTR -> IO a
+
+peekOffset :: (Storable a) => Peek a
+peekOffset mem ptr = peekByteOff mem (fromIntegral ptr)
+
+peekBig :: (Storable a, HasBigEndian a) => Peek a
+peekBig mem ptr = getBigEndian <$> peekOffset mem ptr
+
+peekPTR :: Peek PTR ; peekPTR = peekBig
+peekLONG :: Peek LONG ; peekLONG = peekBig
+peekULONG :: Peek ULONG ; peekULONG = peekBig
+peekWORD :: Peek WORD ; peekWORD = peekBig
+peekUWORD :: Peek UWORD ; peekUWORD = peekBig
+peekBYTE :: Peek BYTE ; peekBYTE = peekOffset
+peekUBYTE :: Peek UBYTE ; peekUBYTE = peekOffset
+
+infixr 0 $?
+
+($?) :: (PTR -> IO a) -> PTR -> IO (Maybe a)
+f $? ptr = skipIf (ptr == 0) (f ptr)
+
+skipIf :: Bool -> IO a -> IO (Maybe a)
+skipIf cond act =
+ if cond
+ then return Nothing
+ else Just <$> act
+
+loadMEM :: String -> IO MEM
+loadMEM s =
+ IO.withBinaryFile s IO.ReadMode $ \h -> do
+ size <- fromInteger <$> IO.hFileSize h
+ ptr <- Alloc.mallocBytes size
+ readSize <- IO.hGetBuf h ptr size
+ when (readSize IO ()
+freeMEM = Alloc.free
+
+
+pointerRange :: PTR -> ULONG -> Int -> [PTR]
+pointerRange start step len =
+ take len $ iterate (fromIntegral step +) start
+
+pointerRangeGen :: (Integral i) => PTR -> ULONG -> i -> [PTR]
+pointerRangeGen start step len = pointerRange start step (fromIntegral len)
+
+{- |
+Return empty list if start pointer is zero.
+-}
+pointerRangeGenCheck :: (Integral i) => PTR -> ULONG -> i -> [PTR]
+pointerRangeGenCheck start step len =
+ if start == 0 then [] else pointerRangeGen start step len
+
+pointerRangeGen2 :: (Integral i, Integral j) => PTR -> ULONG -> i -> j -> [PTR]
+pointerRangeGen2 start step len0 len1 =
+ pointerRange start step (fromIntegral len0 * fromIntegral len1)
+
+
+chunk :: (Integral i) => i -> [a] -> [[a]]
+chunk k = sliceVertical (fromIntegral k)
+
+-- | Strings tend to be fixed width fields with trailing zeros.
+stringFromBytes :: [UBYTE] -> String
+stringFromBytes = map (toEnum . fromEnum) . ListRev.dropWhile (==0)
diff --git a/src/Sound/MED/Basic/Human.hs b/src/Sound/MED/Basic/Human.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Basic/Human.hs
@@ -0,0 +1,12 @@
+module Sound.MED.Basic.Human where
+
+class Human a where
+ human :: a -> String
+
+
+bold :: String -> String
+bold s = bold_on ++ s ++ bold_off
+
+bold_on, bold_off :: String
+bold_on = "\ESC[1m"
+bold_off = "\ESC[22m"
diff --git a/src/Sound/MED/Basic/Pretty.hs b/src/Sound/MED/Basic/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Basic/Pretty.hs
@@ -0,0 +1,21 @@
+module Sound.MED.Basic.Pretty where
+
+pretty :: String -> String
+pretty = pretty' 0
+
+pretty' :: Int -> String -> String
+pretty' _ [] = "\n"
+pretty' level (c:cs) = case c of
+ ' ' -> pretty' level cs
+ '=' -> " = " ++ pretty' level cs
+ '{' -> "{\n" ++ indent (level+1) ++ pretty' (level+1) cs
+ '}' -> "\n" ++ indent (level-1) ++ "}" ++ pretty' (level-1) cs
+ '[' -> "[\n" ++ indent (level+1) ++ pretty' (level+1) cs
+ ']' -> "\n" ++ indent (level-1) ++ "]" ++ pretty' (level-1) cs
+ '(' -> "(\n" ++ indent (level+1) ++ pretty' (level+1) cs
+ ')' -> "\n" ++ indent (level-1) ++ ")" ++ pretty' (level-1) cs
+ ',' -> ",\n" ++ indent level ++ pretty' level cs
+ _ -> c : pretty' level cs
+
+indent :: Int -> String
+indent level = replicate (level*4) ' '
diff --git a/src/Sound/MED/Generic.hs b/src/Sound/MED/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Generic.hs
@@ -0,0 +1,89 @@
+module Sound.MED.Generic where
+
+import qualified Sound.MED.Raw.MMD0 as MMD0
+import qualified Sound.MED.Raw.MMD1 as MMD1
+import qualified Sound.MED.Raw.MMD2 as MMD2
+import qualified Sound.MED.Raw.MMD3 as MMD3
+
+import qualified Sound.MED.Raw.MMD0exp as MMD0exp
+import qualified Sound.MED.Raw.MMD0Song as MMD0Song
+import qualified Sound.MED.Raw.MMD2Song as MMD2Song
+
+import qualified Sound.MED.Generic.Block as MEDBlock
+import qualified Sound.MED.Generic.Instrument as MEDInstrument
+import qualified Sound.MED.Generic.PlaySeq as MEDPlaySeq
+import qualified Sound.MED.Generic.Tempo as MEDTempo
+import Sound.MED.Generic.Instrument(medinstruments)
+
+import Sound.MED.Basic.Human(Human(human))
+import Sound.MED.Basic.Amiga
+
+import Control.Exception (bracket)
+import Data.Foldable (foldMap)
+import Text.Printf (printf)
+
+
+data MED = MED
+ { instrs :: [MEDInstrument.MEDInstrument]
+ , blocks :: [MEDBlock.MEDBlock]
+ , playseqs :: [MEDPlaySeq.MEDPlaySeq]
+ , tempo :: MEDTempo.MEDTempo
+ }
+
+peek :: MEM -> IO MED
+peek m = do
+ ident <- peekULONG m 0
+ let samples0 song =
+ take (fromIntegral (MMD0Song.numsamples song)) $ MMD0Song.sample song
+ let samples2 song =
+ take (fromIntegral (MMD2Song.numsamples song)) $ MMD2Song.sample song
+ let instrs_ smplarr samples expdata med =
+ medinstruments (smplarr med) (samples med)
+ (foldMap MMD0exp.iinfo $ expdata med)
+ (foldMap MMD0exp.exp_smp $ expdata med)
+ let mmd0PlaySeq song = [MEDPlaySeq.playSeq0 song]
+ let mmd2PlaySeqs = map MEDPlaySeq.playSeq2 . MMD2Song.playseqtable
+ case ident of
+ 0x4D4D4430 -> do
+ med <- MMD0.peek m 0
+ return $ MED
+ { instrs = instrs_ MMD0.smplarr (samples0 . MMD0.song) MMD0.expdata med
+ , blocks = map MEDBlock.medblock0 $ MMD0.blockarr med
+ , playseqs = mmd0PlaySeq $ MMD0.song med
+ , tempo = MEDTempo.song0Tempo $ MMD0.song med
+ }
+ 0x4D4D4431 -> do
+ med <- MMD1.peek m 0
+ return $ MED
+ { instrs = instrs_ MMD1.smplarr (samples0 . MMD1.song) MMD1.expdata med
+ , blocks = map MEDBlock.medblock1 $ MMD1.blockarr med
+ , playseqs = mmd0PlaySeq $ MMD1.song med
+ , tempo = MEDTempo.song0Tempo $ MMD1.song med
+ }
+ 0x4D4D4432 -> do
+ med <- MMD2.peek m 0
+ return $ MED
+ { instrs = instrs_ MMD2.smplarr (samples2 . MMD2.song) MMD2.expdata med
+ , blocks = map MEDBlock.medblock1 $ MMD2.blockarr med
+ , playseqs = mmd2PlaySeqs $ MMD2.song med
+ , tempo = MEDTempo.song2Tempo $ MMD2.song med
+ }
+ 0x4D4D4433 -> do
+ med <- MMD3.peek m 0
+ return $ MED
+ { instrs = instrs_ MMD3.smplarr (samples2 . MMD3.song) MMD3.expdata med
+ , blocks = map MEDBlock.medblock1 $ MMD3.blockarr med
+ , playseqs = mmd2PlaySeqs $ MMD3.song med
+ , tempo = MEDTempo.song2Tempo $ MMD3.song med
+ }
+ _ -> ioError $ userError $ printf "unknown format: %08x" $ toInteger ident
+
+instance Human MED where
+ human m =
+ concatMap human (instrs m) ++
+ concatMap human (blocks m) ++
+ unlines (map human (playseqs m))
+
+
+load :: FilePath -> IO MED
+load path = bracket (loadMEM path) freeMEM peek
diff --git a/src/Sound/MED/Generic/Block.hs b/src/Sound/MED/Generic/Block.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Generic/Block.hs
@@ -0,0 +1,100 @@
+module Sound.MED.Generic.Block where
+
+import qualified Sound.MED.Raw.MMD0Block as MMD0Block
+import qualified Sound.MED.Raw.MMD0NoteData as MMD0NoteData
+import qualified Sound.MED.Raw.MMD1Block as MMD1Block
+import qualified Sound.MED.Raw.MMD1NoteData as MMD1NoteData
+import qualified Sound.MED.Raw.BlockInfo as BlockInfo
+import qualified Sound.MED.Raw.BlockCmdPageTable as BlockCmdPageTable
+import qualified Sound.MED.Raw.CmdPageData as CmdPageData
+
+import Sound.MED.Basic.Human(Human(human),bold)
+import Sound.MED.Basic.Amiga(stringFromBytes)
+
+import Text.Printf(printf)
+import Control.Monad(liftM2)
+import Data.Bits(shiftR, (.&.))
+import Data.Maybe(catMaybes)
+
+type Note = Int
+type Inst = Int
+type Cmd = Int
+type Val = Int
+type Highlight = Bool
+type Line = ( Maybe Highlight, [ ( Note, Inst, [ ( Cmd, Val ) ] ) ])
+
+data MEDBlock = MEDBlock
+ { name :: Maybe String
+ , tracks :: Int
+ , lines :: Int
+ , pages :: Int
+ , seqdata :: [ Line ]
+ }
+
+medblock0 :: MMD0Block.MMD0Block -> MEDBlock
+medblock0 b =
+ let name' = Nothing
+ tracks' = fromIntegral $ MMD0Block.numtracks b
+ lines' = fromIntegral $ MMD0Block.lines b + 1
+ pages' = 1
+ highlights' = repeat Nothing
+ f = fromIntegral
+ g (MMD0NoteData.MMD0NoteData n i c v) = (f n, f i, [(f c, f v)])
+ notedata' = map (map g) (MMD0Block.notedata b)
+ seqdata' = zip highlights' notedata'
+ in MEDBlock name' tracks' lines' pages' seqdata'
+
+
+medblock1 :: MMD1Block.MMD1Block -> MEDBlock
+medblock1 b =
+ let i = MMD1Block.info b
+ name' = fmap stringFromBytes $ BlockInfo.blockname =<< i
+ tracks' = fromIntegral $ MMD1Block.numtracks b
+ lines' = fromIntegral $ MMD1Block.lines b + 1
+ pages' = case BlockInfo.pagetable =<< i of
+ Nothing -> 1
+ Just pt -> 1 + (length . catMaybes $ BlockCmdPageTable.pages pt)
+ hlbit h bpos = ((h `shiftR` bpos) .&. 1) == 1
+ hlbits h = map (hlbit h) [0..31]
+ highlights' = case BlockInfo.hlmask =<< i of
+ Nothing -> repeat Nothing
+ Just hl -> map Just $ concatMap hlbits $ hl
+ fI = fromIntegral
+ nd (MMD1NoteData.MMD1NoteData n j c v) = (fI n, fI j, [(fI c, fI v)])
+ notedata' = map (map nd) (MMD1Block.notedata b)
+ cv (CmdPageData.CmdPageData c v) = (fI c, fI v)
+ cmddata' = case BlockInfo.pagetable =<< i of
+ Nothing -> []
+ Just pt -> map (map (map cv)) (catMaybes (BlockCmdPageTable.pages pt))
+ p (c,v) (n,j,cvs) = (n, j, cvs ++ [(c,v)])
+ ncdata' = foldr (zipWith (zipWith p)) notedata' cmddata'
+ seqdata' = zip highlights' ncdata'
+ in MEDBlock name' tracks' lines' pages' seqdata'
+
+
+instance Human MEDBlock where
+ human b =
+ let name' = maybe "" (' ':) $ name b
+ blocklines = Sound.MED.Generic.Block.lines
+ dim' = printf "%d*%d*%d" (blocklines b) (tracks b) (pages b)
+ seq' = unlines (zipWith highlightLine [0..] (seqdata b))
+ in dim' ++ name' ++ "\n" ++ seq'
+
+highlightLine :: Int -> Line -> String
+highlightLine i (highlight, ds) =
+ let bLine = humanLine i ds
+ in if highlight == Just True then bold bLine else bLine
+
+humanLine :: Int -> [ ( Note, Inst, [ ( Cmd, Val ) ] ) ] -> String
+humanLine i ds =
+ let mapWords fmt = concatMap (' ':) . map fmt
+ hCV (c, v) = printf "%02X%02X" c v
+ hTrack (n, j, cvs) = printf "%s %02X%s" (notes!!n) j (mapWords hCV cvs)
+ in printf "%04X:%s" i (mapWords hTrack ds)
+
+notes :: [String]
+notes =
+ "---" :
+ liftM2 (flip (printf "%s%1X"))
+ [(1::Int) ..]
+ ["C-","C#","D-","D#","E-","F-","F#","G-","G#","A-","A#","B-"]
diff --git a/src/Sound/MED/Generic/Instrument.hs b/src/Sound/MED/Generic/Instrument.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Generic/Instrument.hs
@@ -0,0 +1,71 @@
+module Sound.MED.Generic.Instrument where
+
+import qualified Sound.MED.Raw.MMD0Sample as MMD0Sample
+import qualified Sound.MED.Raw.InstrHdr as InstrHdr
+import qualified Sound.MED.Raw.MMDInstrInfo as MMDInstrInfo
+import qualified Sound.MED.Raw.InstrExt as InstrExt
+
+import Sound.MED.Basic.Human(Human(human))
+import Sound.MED.Basic.Amiga(stringFromBytes)
+
+import qualified Data.List as List
+
+data MEDInstrument = MEDInstrument
+ { rep :: Maybe Int
+ , replen :: Maybe Int
+ , midich :: Maybe Int
+ , midipreset :: Maybe Int
+ , svol :: Maybe Int
+ , strans :: Maybe Int
+ , hold :: Maybe Int
+ , decay :: Maybe Int
+ , suppress_midi_off :: Maybe Int
+ , finetune :: Maybe Int
+ , default_pitch :: Maybe Int
+ , instr_flags :: Maybe Int
+ , long_midi_preset :: Maybe Int
+ , output_device :: Maybe Int
+ , long_repeat :: Maybe Int
+ , long_replen :: Maybe Int
+ , name :: Maybe String
+ }
+ deriving (Show)
+
+medinstruments ::
+ [Maybe InstrHdr.InstrHdr] -> [MMD0Sample.MMD0Sample] ->
+ [MMDInstrInfo.MMDInstrInfo] -> [InstrExt.InstrExt] ->
+ [MEDInstrument]
+medinstruments hdrs samples infos exts =
+ let pad xs = map Just xs ++ repeat Nothing
+ in take (maximum [length hdrs, length samples, length infos, length exts]) $
+ List.zipWith4 medinstrument
+ (hdrs ++ repeat Nothing) (pad samples) (pad infos) (pad exts)
+
+medinstrument ::
+ Maybe InstrHdr.InstrHdr -> Maybe MMD0Sample.MMD0Sample ->
+ Maybe MMDInstrInfo.MMDInstrInfo -> Maybe InstrExt.InstrExt -> MEDInstrument
+medinstrument _h s i e =
+ let rep' = fmap (fromIntegral . MMD0Sample.rep) s
+ replen' = fmap (fromIntegral . MMD0Sample.replen) s
+ midich' = fmap (fromIntegral . MMD0Sample.midich) s
+ midipreset' = fmap (fromIntegral . MMD0Sample.midipreset) s
+ svol' = fmap (fromIntegral . MMD0Sample.svol) s
+ strans' = fmap (fromIntegral . MMD0Sample.strans) s
+ hold' = fmap fromIntegral . InstrExt.hold =<< e
+ decay' = fmap fromIntegral . InstrExt.decay =<< e
+ suppress_midi_off' = fmap fromIntegral . InstrExt.suppress_midi_off =<< e
+ finetune' = fmap fromIntegral . InstrExt.finetune =<< e
+ default_pitch' = fmap fromIntegral . InstrExt.default_pitch =<< e
+ instr_flags' = fmap fromIntegral . InstrExt.instr_flags =<< e
+ long_midi_preset' = fmap fromIntegral . InstrExt.long_midi_preset =<< e
+ output_device' = fmap fromIntegral . InstrExt.output_device =<< e
+ long_repeat' = fmap fromIntegral . InstrExt.long_repeat =<< e
+ long_replen' = fmap fromIntegral . InstrExt.long_replen =<< e
+ name' = fmap stringFromBytes . MMDInstrInfo.name =<< i
+ in MEDInstrument
+ rep' replen' midich' midipreset' svol' strans' hold' decay'
+ suppress_midi_off' finetune' default_pitch' instr_flags'
+ long_midi_preset' output_device' long_repeat' long_replen' name'
+
+instance Human MEDInstrument where
+ human i = show i ++ "\n"
diff --git a/src/Sound/MED/Generic/PlaySeq.hs b/src/Sound/MED/Generic/PlaySeq.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Generic/PlaySeq.hs
@@ -0,0 +1,34 @@
+module Sound.MED.Generic.PlaySeq where
+
+import qualified Sound.MED.Raw.MMD0Song as MMD0Song
+import Sound.MED.Raw.MMD0Song(MMD0Song)
+
+import qualified Sound.MED.Raw.PlaySeq as PlaySeq
+import Sound.MED.Raw.PlaySeq(PlaySeq)
+
+import Sound.MED.Basic.Human(Human(human))
+import Sound.MED.Basic.Amiga(stringFromBytes)
+
+import qualified Data.List as List
+
+data MEDPlaySeq = MEDPlaySeq
+ { name :: String
+ , indices :: [Int] -- ^ block indices
+ }
+
+playSeq0 :: MMD0Song -> MEDPlaySeq
+playSeq0 song =
+ MEDPlaySeq "" $ take (fromIntegral $ MMD0Song.songlen song) $
+ map fromIntegral $ MMD0Song.playseq song
+
+playSeq2 :: PlaySeq -> MEDPlaySeq
+playSeq2 pseq =
+ MEDPlaySeq
+ { name = stringFromBytes (PlaySeq.name pseq)
+ , indices = map fromIntegral (PlaySeq.seq pseq)
+ }
+
+instance Human MEDPlaySeq where
+ human (MEDPlaySeq name' indices') =
+ (if null name' then "playseq" else name') ++ ": " ++
+ List.intercalate ", " (map show indices')
diff --git a/src/Sound/MED/Generic/Tempo.hs b/src/Sound/MED/Generic/Tempo.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Generic/Tempo.hs
@@ -0,0 +1,98 @@
+module Sound.MED.Generic.Tempo (
+ MEDTempo(..),
+ Mode(..),
+ song0Tempo,
+ song2Tempo,
+
+ update,
+ toTime,
+ ) where
+
+import Sound.MED.Generic.Block(Cmd,Val)
+
+import qualified Sound.MED.Raw.MMD0Song as MMD0Song
+import qualified Sound.MED.Raw.MMD2Song as MMD2Song
+
+import Sound.MED.Basic.Amiga
+
+import Data.Bits (testBit, (.&.))
+import Data.Bool.HT (if')
+
+data MEDTempo = MEDTempo
+ { mode :: Mode,
+ primary, secondary :: Int
+ }
+
+data Mode = Speed | Octa | BPM {linesPerBeat :: Int}
+
+tempoMode :: UBYTE -> UBYTE -> Mode
+tempoMode flags flags2 =
+ if' (testBit flags 6) Octa $
+ if' (testBit flags2 5) (BPM $ fromIntegral (flags2 .&. 0x1F) + 1)
+ Speed
+
+song0Tempo :: MMD0Song.MMD0Song -> MEDTempo
+song0Tempo song =
+ MEDTempo
+ { mode = tempoMode (MMD0Song.flags song) (MMD0Song.flags2 song)
+ , primary = fromIntegral $ MMD0Song.deftempo song
+ , secondary = fromIntegral $ MMD0Song.tempo2 song
+ }
+
+song2Tempo :: MMD2Song.MMD2Song -> MEDTempo
+song2Tempo song =
+ MEDTempo
+ { mode = tempoMode (MMD2Song.flags song) (MMD2Song.flags2 song)
+ , primary = fromIntegral $ MMD2Song.deftempo song
+ , secondary = fromIntegral $ MMD2Song.tempo2 song
+ }
+
+
+{- |
+Interpret tempo related commands.
+-}
+update :: MEDTempo -> (Cmd, Val) -> MEDTempo
+update tempo (cmd,val) =
+ case cmd of
+ 0x09 -> tempo{secondary = mod (val-1) 0x20 + 1}
+ 0x0F ->
+ if 0 < val && val < 0xF0
+ then tempo{primary = fromIntegral val}
+ else tempo
+ _ -> tempo
+
+
+toTime :: Fractional a => MEDTempo -> a
+toTime (MEDTempo mode_ tempo1 tempo2) =
+ timeFromPrimary mode_ tempo1 * fromIntegral tempo2
+
+-- numbers taken from uade/amigasrc/players/med/common/proplayer.a
+ciabFreq :: Fractional a => a
+ciabFreq = 715909
+
+timerDiv :: Fractional a => a
+timerDiv = 474326
+
+_sttempo :: Fractional a => a
+_sttempo = 2416.3
+
+{-
+Measured from output of uade.
+In theory it should be 300 (50 Hz times 6 divisions).
+-}
+sttempoMeasured :: Fractional a => a
+sttempoMeasured = 293.70
+
+octaTempo :: Fractional a => a
+octaTempo = 390.70
+
+timeFromPrimary :: Fractional a => Mode -> Int -> a
+timeFromPrimary mode_ tempo =
+ case mode_ of
+ BPM lpb -> 60 / (fromIntegral tempo * 6 * fromIntegral lpb)
+ Octa -> fromIntegral (min 10 tempo) / octaTempo
+ Speed ->
+ if tempo<=10
+ -- then fromIntegral tempo * sttempo / ciabFreq
+ then fromIntegral tempo / sttempoMeasured
+ else timerDiv / (ciabFreq * fromIntegral tempo)
diff --git a/src/Sound/MED/Raw/BlockCmdPageTable.hs b/src/Sound/MED/Raw/BlockCmdPageTable.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/BlockCmdPageTable.hs
@@ -0,0 +1,27 @@
+module Sound.MED.Raw.BlockCmdPageTable where
+
+import qualified Sound.MED.Raw.CmdPageData as CmdPageData
+import Sound.MED.Raw.CmdPageData(CmdPageData)
+
+import Sound.MED.Basic.Amiga
+
+data BlockCmdPageTable = BlockCmdPageTable
+ { num_pages :: UWORD
+ , reserved :: UWORD
+ , pages :: [ Maybe [ [ CmdPageData ] ] ]
+ }
+ deriving (Show)
+
+peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockCmdPageTable
+peek tracks numlines m p = do
+ num_pages' <- peekUWORD m p
+ reserved' <- peekUWORD m (p+2)
+ pages'' <- mapM (peekPTR m) $ pointerRangeGen (p+4) 4 num_pages'
+ pages' <- mapM (peekPage tracks numlines m) pages''
+ return $ BlockCmdPageTable
+ num_pages' reserved' pages'
+
+peekPage :: UWORD -> UWORD -> MEM -> PTR -> IO (Maybe [ [ CmdPageData ] ])
+peekPage tracks numlines m p =
+ skipIf (p == 0) $ fmap (chunk tracks) $
+ mapM (CmdPageData.peek m) $ pointerRangeGen2 p 2 tracks numlines
diff --git a/src/Sound/MED/Raw/BlockInfo.hs b/src/Sound/MED/Raw/BlockInfo.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/BlockInfo.hs
@@ -0,0 +1,33 @@
+module Sound.MED.Raw.BlockInfo where
+
+import qualified Sound.MED.Raw.BlockCmdPageTable as BlockCmdPageTable
+import Sound.MED.Raw.BlockCmdPageTable(BlockCmdPageTable)
+
+import Sound.MED.Basic.Amiga
+
+data BlockInfo = BlockInfo
+ { hlmask :: Maybe [ ULONG ]
+ , blockname :: Maybe [ UBYTE ]
+ , blocknamelen :: ULONG
+ , pagetable :: Maybe BlockCmdPageTable
+ , reserved :: [ ULONG ]
+ }
+ deriving (Show)
+
+peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockInfo
+peek tracks numlines m p = do
+ let hlmasklen = (numlines + 31) `div` 32
+ hlmask''' <- peekPTR m p
+ hlmask' <-
+ skipIf (hlmask''' == 0) $
+ mapM (peekULONG m) $ pointerRangeGen hlmask''' 4 hlmasklen
+ blocknamelen' <- peekULONG m (p+8)
+ blockname''' <- peekPTR m (p+4)
+ blockname' <-
+ skipIf (blockname''' == 0) $
+ mapM (peekUBYTE m) $ pointerRangeGen blockname''' 1 blocknamelen'
+ pagetable''' <- peekPTR m (p+12)
+ pagetable' <- BlockCmdPageTable.peek tracks numlines m $? pagetable'''
+ reserved' <- mapM (peekULONG m) $ pointerRange (p+16) 4 5
+ return $ BlockInfo
+ hlmask' blockname' blocknamelen' pagetable' reserved'
diff --git a/src/Sound/MED/Raw/CmdPageData.hs b/src/Sound/MED/Raw/CmdPageData.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/CmdPageData.hs
@@ -0,0 +1,16 @@
+module Sound.MED.Raw.CmdPageData where
+
+import Sound.MED.Basic.Amiga
+
+data CmdPageData = CmdPageData
+ { command :: UBYTE
+ , databyte :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO CmdPageData
+peek m p = do
+ command' <- peekUBYTE m (p + 0)
+ databyte' <- peekUBYTE m (p + 1)
+ return $ CmdPageData
+ command' databyte'
diff --git a/src/Sound/MED/Raw/HybridInstr.hs b/src/Sound/MED/Raw/HybridInstr.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/HybridInstr.hs
@@ -0,0 +1,42 @@
+module Sound.MED.Raw.HybridInstr where
+
+import qualified Sound.MED.Raw.SynthWF as SynthWF
+import Sound.MED.Raw.SynthWF(SynthWF)
+
+import Sound.MED.Basic.Amiga
+
+data HybridInstr = HybridInstr
+ { defaultdecay :: UBYTE
+ , reserved :: [ UBYTE ]
+ , rep :: UWORD
+ , replen :: UWORD
+ , voltbllen :: UWORD
+ , wftbllen :: UWORD
+ , volspeed :: UBYTE
+ , wfspeed :: UBYTE
+ , wforms :: UWORD
+ , voltbl :: [ UBYTE ]
+ , wftbl :: [ UBYTE ]
+ , wf0 :: PTR -- FIXME
+ , wf :: [ Maybe SynthWF ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO HybridInstr
+peek m p = do
+ defaultdecay' <- peekUBYTE m (p+6)
+ reserved' <- mapM (peekUBYTE m) $ pointerRange (p+7) 1 3
+ rep' <- peekUWORD m (p+10)
+ replen' <- peekUWORD m (p+12)
+ voltbllen' <- peekUWORD m (p+14)
+ wftbllen' <- peekUWORD m (p+16)
+ volspeed' <- peekUBYTE m (p+18)
+ wfspeed' <- peekUBYTE m (p+19)
+ wforms' <- peekUWORD m (p+20)
+ voltbl' <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 128
+ wftbl' <- mapM (peekUBYTE m) $ pointerRange (p+150) 150 128
+ wf0':wf'' <- mapM (peekPTR m) $ pointerRange (p+278) 4 64
+ wf' <- mapM (SynthWF.peek m . (p+) $?) wf''
+ return $ HybridInstr
+ defaultdecay' reserved' rep' replen' voltbllen' wftbllen'
+ volspeed' wfspeed' wforms' voltbl' wftbl' wf0' wf'
diff --git a/src/Sound/MED/Raw/InstrExt.hs b/src/Sound/MED/Raw/InstrExt.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/InstrExt.hs
@@ -0,0 +1,43 @@
+module Sound.MED.Raw.InstrExt where
+
+import Sound.MED.Basic.Amiga
+
+import Foreign.Storable (Storable, sizeOf)
+
+data InstrExt = InstrExt
+ { hold :: Maybe UBYTE
+ , decay :: Maybe UBYTE
+ , suppress_midi_off :: Maybe UBYTE
+ , finetune :: Maybe BYTE
+ , default_pitch :: Maybe UBYTE
+ , instr_flags :: Maybe UBYTE
+ , long_midi_preset :: Maybe UWORD
+ , output_device :: Maybe UBYTE
+ , reserved :: Maybe UBYTE
+ , long_repeat :: Maybe ULONG
+ , long_replen :: Maybe ULONG
+ }
+ deriving (Show)
+
+peek :: UWORD -> MEM -> PTR -> IO InstrExt
+peek size m p = do
+ let peekHelp :: (Storable a) => a -> Peek a -> UWORD -> IO (Maybe a)
+ peekHelp elm peeker offset =
+ skipIf (offset + fromIntegral (sizeOf elm) > size) $
+ peeker m (p + fromIntegral offset)
+ peeker $?? offset = peekHelp undefined peeker offset
+ hold' <- peekUBYTE $?? 0
+ decay' <- peekUBYTE $?? 1
+ suppress_midi_off' <- peekUBYTE $?? 2
+ finetune' <- peekBYTE $?? 3
+ default_pitch' <- peekUBYTE $?? 4
+ instr_flags' <- peekUBYTE $?? 5
+ long_midi_preset' <- peekUWORD $?? 6
+ output_device' <- peekUBYTE $?? 8
+ reserved' <- peekUBYTE $?? 9
+ long_repeat' <- peekULONG $?? 10
+ long_replen' <- peekULONG $?? 14
+ return $ InstrExt
+ hold' decay' suppress_midi_off' finetune' default_pitch'
+ instr_flags' long_midi_preset' output_device' reserved'
+ long_repeat' long_replen'
diff --git a/src/Sound/MED/Raw/InstrHdr.hs b/src/Sound/MED/Raw/InstrHdr.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/InstrHdr.hs
@@ -0,0 +1,50 @@
+module Sound.MED.Raw.InstrHdr where
+
+import qualified Sound.MED.Raw.HybridInstr as HybridInstr
+import Sound.MED.Raw.HybridInstr(HybridInstr)
+import qualified Sound.MED.Raw.SynthInstr as SynthInstr
+import Sound.MED.Raw.SynthInstr(SynthInstr)
+import qualified Sound.MED.Raw.SampleInstr as SampleInstr
+import Sound.MED.Raw.SampleInstr(SampleInstr)
+
+import Sound.MED.Basic.Amiga
+
+import Data.Bits ((.&.))
+
+data Instrument =
+ Unknown
+ | Hybrid HybridInstr
+ | Synthetic SynthInstr
+ | Sample SampleInstr
+ deriving (Show)
+
+data InstrHdr = InstrHdr
+ { len :: ULONG
+ , stype :: WORD
+ , s16 :: Bool
+ , stereo :: Bool
+ , md16 :: Bool
+ , dat :: Instrument
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO InstrHdr
+peek m p = do
+ len' <- peekULONG m p
+ itype' <- peekWORD m (p+4)
+ let s16' = (itype' .&. 0x10) == 0x10
+ let stereo' = (itype' .&. 0x20) == 0x20
+ let md16' = itype' == 0x18
+ let stype' = if itype' < 0 then itype' else itype' .&. 0x7
+ dat' <- case stype' of
+ (-2) -> do
+ hybridinstr' <- HybridInstr.peek m p
+ return $ Hybrid hybridinstr'
+ (-1) -> do
+ synthinstr' <- SynthInstr.peek m p
+ return $ Synthetic synthinstr'
+ _ -> if stype' < 0 || 7 < stype' then return Unknown else do
+ sampleinstr' <- SampleInstr.peek len' stype' s16' stereo' m p
+ return $ Sample sampleinstr'
+ return $ InstrHdr
+ len' stype' s16' stereo' md16' dat'
diff --git a/src/Sound/MED/Raw/MMD0.hs b/src/Sound/MED/Raw/MMD0.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0.hs
@@ -0,0 +1,71 @@
+module Sound.MED.Raw.MMD0 where
+
+import qualified Sound.MED.Raw.MMD0Song as MMD0Song
+import Sound.MED.Raw.MMD0Song(MMD0Song)
+import qualified Sound.MED.Raw.MMD0Block as MMD0Block
+import Sound.MED.Raw.MMD0Block(MMD0Block)
+import qualified Sound.MED.Raw.InstrHdr as InstrHdr
+import Sound.MED.Raw.InstrHdr(InstrHdr)
+import qualified Sound.MED.Raw.MMD0exp as MMD0exp
+import Sound.MED.Raw.MMD0exp(MMD0exp)
+import Sound.MED.Basic.Amiga
+
+data MMD0 = MMD0
+ { id :: ULONG
+ , modlen :: ULONG
+ , song :: MMD0Song
+ , psecnum :: UWORD
+ , pseq :: UWORD
+ , blockarr :: [ MMD0Block ]
+ , mmdflags :: UBYTE
+ , reserved1 :: UBYTE
+ , reserved2 :: UBYTE
+ , reserved3 :: UBYTE
+ , smplarr :: [ Maybe InstrHdr ]
+ , reserved4 :: ULONG
+ , expdata :: Maybe MMD0exp
+ , reserved5 :: ULONG
+ , pstate :: UWORD
+ , pblock :: UWORD
+ , pline :: UWORD
+ , pseqnum :: UWORD
+ , actplayline :: WORD
+ , counter :: UBYTE
+ , extra_songs :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0
+peek m p = do
+ id' <- peekULONG m (p + 0)
+ modlen' <- peekULONG m (p + 4)
+ song'' <- peekPTR m (p + 8)
+ song' <- MMD0Song.peek m song''
+ psecnum' <- peekUWORD m (p + 12)
+ pseq' <- peekUWORD m (p + 14)
+ blockarr''' <- peekPTR m (p + 16)
+ blockarr'' <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')
+ blockarr' <- mapM (MMD0Block.peek m) blockarr''
+ mmdflags' <- peekUBYTE m (p + 20)
+ reserved1' <- peekUBYTE m (p + 21)
+ reserved2' <- peekUBYTE m (p + 22)
+ reserved3' <- peekUBYTE m (p + 23)
+ smplarr''' <- peekPTR m (p + 24)
+ smplarr'' <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')
+ smplarr' <- mapM (InstrHdr.peek m $?) smplarr''
+ reserved4' <- peekULONG m (p + 28)
+ expdata''' <- peekPTR m (p + 32)
+ expdata' <- MMD0exp.peek m $? expdata'''
+ reserved5' <- peekULONG m (p + 36)
+ pstate' <- peekUWORD m (p + 40)
+ pblock' <- peekUWORD m (p + 42)
+ pline' <- peekUWORD m (p + 44)
+ pseqnum' <- peekUWORD m (p + 46)
+ actplayline' <- peekWORD m (p + 48)
+ counter' <- peekUBYTE m (p + 50)
+ extra_songs' <- peekUBYTE m (p + 51)
+ return $ MMD0
+ id' modlen' song' psecnum' pseq' blockarr' mmdflags'
+ reserved1' reserved2' reserved3' smplarr' reserved4'
+ expdata' reserved5' pstate' pblock' pline' pseqnum'
+ actplayline' counter' extra_songs'
diff --git a/src/Sound/MED/Raw/MMD0Block.hs b/src/Sound/MED/Raw/MMD0Block.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0Block.hs
@@ -0,0 +1,22 @@
+module Sound.MED.Raw.MMD0Block where
+
+import qualified Sound.MED.Raw.MMD0NoteData as MMD0NoteData
+import Sound.MED.Raw.MMD0NoteData(MMD0NoteData)
+
+import Sound.MED.Basic.Amiga
+
+data MMD0Block = MMD0Block
+ { numtracks :: UBYTE
+ , lines :: UBYTE -- NOTE: actual number of lines is one greater
+ , notedata :: [ [ MMD0NoteData ] ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0Block
+peek m p = do
+ numtracks' <- peekUBYTE m (p + 0)
+ lines' <- peekUBYTE m (p + 1)
+ notedata'' <- mapM (MMD0NoteData.peek m) $ pointerRangeGen2 (p+2) 3 numtracks' (lines'+1)
+ let notedata' = chunk numtracks' notedata''
+ return $ MMD0Block
+ numtracks' lines' notedata'
diff --git a/src/Sound/MED/Raw/MMD0NoteData.hs b/src/Sound/MED/Raw/MMD0NoteData.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0NoteData.hs
@@ -0,0 +1,31 @@
+module Sound.MED.Raw.MMD0NoteData where
+
+import Sound.MED.Basic.Amiga
+
+import Data.Bits (shiftR, shiftL, (.&.), (.|.))
+
+data MMD0NoteData = MMD0NoteData
+ { note :: UBYTE
+ , instrument :: UBYTE
+ , command :: UBYTE
+ , databyte :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0NoteData
+peek m p = do
+ byte1 <- peekUBYTE m (p + 0)
+ byte2 <- peekUBYTE m (p + 1)
+ byte3 <- peekUBYTE m (p + 2)
+ let x = (byte1 .&. 0x80) `shiftR` 7
+ let y = (byte1 .&. 0x40) `shiftR` 6
+ let nnnnnn = (byte1 .&. 0x3F)
+ let iiii = (byte2 .&. 0xF0) `shiftR` 4
+ let cccc = (byte2 .&. 0x0F)
+ let dddddddd = (byte3 .&. 0xFF)
+ let note' = nnnnnn
+ let instrument' = (y `shiftL` 6) .|. (x `shiftL` 5) .|. iiii
+ let command' = cccc
+ let databyte' = dddddddd
+ return $ MMD0NoteData
+ note' instrument' command' databyte'
diff --git a/src/Sound/MED/Raw/MMD0Sample.hs b/src/Sound/MED/Raw/MMD0Sample.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0Sample.hs
@@ -0,0 +1,24 @@
+module Sound.MED.Raw.MMD0Sample where
+
+import Sound.MED.Basic.Amiga
+
+data MMD0Sample = MMD0Sample
+ { rep :: UWORD
+ , replen :: UWORD
+ , midich :: UBYTE
+ , midipreset :: UBYTE
+ , svol :: UBYTE
+ , strans :: BYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0Sample
+peek m p = do
+ rep' <- peekUWORD m (p+0)
+ replen' <- peekUWORD m (p+2)
+ midich' <- peekUBYTE m (p+4)
+ midipreset' <- peekUBYTE m (p+5)
+ svol' <- peekUBYTE m (p+6)
+ strans' <- peekBYTE m (p+7)
+ return $ MMD0Sample
+ rep' replen' midich' midipreset' svol' strans'
diff --git a/src/Sound/MED/Raw/MMD0Song.hs b/src/Sound/MED/Raw/MMD0Song.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0Song.hs
@@ -0,0 +1,39 @@
+module Sound.MED.Raw.MMD0Song where
+
+import qualified Sound.MED.Raw.MMD0Sample as MMD0Sample
+import Sound.MED.Raw.MMD0Sample(MMD0Sample)
+import Sound.MED.Basic.Amiga
+
+data MMD0Song = MMD0Song
+ { sample :: [ MMD0Sample ]
+ , numblocks :: UWORD
+ , songlen :: UWORD
+ , playseq :: [ UBYTE ]
+ , deftempo :: UWORD
+ , playtransp :: BYTE
+ , flags :: UBYTE
+ , flags2 :: UBYTE
+ , tempo2 :: UBYTE
+ , trkvol :: [ UBYTE ]
+ , mastervol :: UBYTE
+ , numsamples :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0Song
+peek m p = do
+ sample' <- mapM (MMD0Sample.peek m) $ pointerRange p 8 63
+ numblocks' <- peekUWORD m (p+504)
+ songlen' <- peekUWORD m (p+506)
+ playseq' <- mapM (peekUBYTE m) $ pointerRange (p+508) 1 256
+ deftempo' <- peekUWORD m (p+764)
+ playtransp' <- peekBYTE m (p+766)
+ flags' <- peekUBYTE m (p+767)
+ flags2' <- peekUBYTE m (p+768)
+ tempo2' <- peekUBYTE m (p+769)
+ trkvol' <- mapM (peekUBYTE m) $ pointerRange (p+770) 1 16
+ mastervol' <- peekUBYTE m (p+786)
+ numsamples' <- peekUBYTE m (p+787)
+ return $ MMD0Song
+ sample' numblocks' songlen' playseq' deftempo' playtransp' flags'
+ flags2' tempo2' trkvol' mastervol' numsamples'
diff --git a/src/Sound/MED/Raw/MMD0exp.hs b/src/Sound/MED/Raw/MMD0exp.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD0exp.hs
@@ -0,0 +1,82 @@
+module Sound.MED.Raw.MMD0exp where
+
+import qualified Sound.MED.Raw.InstrExt as InstrExt
+import Sound.MED.Raw.InstrExt(InstrExt)
+import qualified Sound.MED.Raw.MMDInstrInfo as MMDInstrInfo
+import Sound.MED.Raw.MMDInstrInfo(MMDInstrInfo)
+import qualified Sound.MED.Raw.NotationInfo as NotationInfo
+import Sound.MED.Raw.NotationInfo(NotationInfo)
+import qualified Sound.MED.Raw.MMDDumpData as MMDDumpData
+import Sound.MED.Raw.MMDDumpData(MMDDumpData)
+import qualified Sound.MED.Raw.MMDInfo as MMDInfo
+import Sound.MED.Raw.MMDInfo(MMDInfo)
+import qualified Sound.MED.Raw.MMDARexx as MMDARexx
+import Sound.MED.Raw.MMDARexx(MMDARexx)
+import qualified Sound.MED.Raw.MMDMIDICmd3x as MMDMIDICmd3x
+import Sound.MED.Raw.MMDMIDICmd3x(MMDMIDICmd3x)
+
+import Sound.MED.Basic.Amiga
+
+data MMD0exp = MMD0exp
+ { nextmod :: PTR -- FIXME
+ , exp_smp :: [ InstrExt ]
+ , s_ext_entries :: UWORD
+ , s_ext_entrsz :: UWORD
+ , annotxt :: [ UBYTE ]
+ , annolen :: ULONG
+ , iinfo :: [ MMDInstrInfo ]
+ , i_ext_entries :: UWORD
+ , i_ext_entrsz :: UWORD
+ , jumpmask :: ULONG
+ , rgbtable :: [ UWORD ]
+ , channelsplit :: [ UBYTE ]
+ , n_info :: Maybe NotationInfo
+ , songname :: [ UBYTE ]
+ , songnamelen :: ULONG
+ , dumps :: Maybe MMDDumpData
+ , mmdinfo :: Maybe MMDInfo
+ , mmdrexx :: Maybe MMDARexx
+ , mmdcmd3x :: Maybe MMDMIDICmd3x
+ , reserved2 :: [ ULONG ]
+ , tag_end :: ULONG
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD0exp
+peek m p = do
+ nextmod' <- peekPTR m (p+0)
+ exp_smp'' <- peekPTR m (p+4)
+ s_ext_entries' <- peekUWORD m (p+8)
+ s_ext_entrsz' <- peekUWORD m (p+10)
+ exp_smp' <- mapM (InstrExt.peek s_ext_entrsz' m) $ pointerRangeGenCheck exp_smp'' (fromIntegral s_ext_entrsz') s_ext_entries'
+ annotxt'' <- peekPTR m (p+12)
+ annolen' <- peekULONG m (p+16)
+ annotxt' <- mapM (peekUBYTE m) $ pointerRangeGenCheck annotxt'' 1 annolen'
+ iinfo'' <- peekPTR m (p+20)
+ i_ext_entries' <- peekUWORD m (p+24)
+ i_ext_entrsz' <- peekUWORD m (p+26)
+ iinfo' <- mapM (MMDInstrInfo.peek i_ext_entrsz' m) $ pointerRangeGenCheck iinfo'' (fromIntegral i_ext_entrsz') i_ext_entries'
+ jumpmask' <- peekULONG m (p+28)
+ rgbtable'' <- peekPTR m (p+32)
+ rgbtable' <- mapM (peekUWORD m) $ pointerRangeGenCheck rgbtable'' 2 (8::Int)
+ channelsplit' <- mapM (peekUBYTE m) $ pointerRange (p+36) 1 4
+ n_info''' <- peekPTR m (p+40)
+ n_info' <- NotationInfo.peek m $? n_info'''
+ songname'' <- peekPTR m (p+44)
+ songnamelen' <- peekULONG m (p+48)
+ songname' <- mapM (peekUBYTE m) $ pointerRangeGenCheck songname'' 1 songnamelen'
+ dumps''' <- peekPTR m (p+52)
+ dumps' <- MMDDumpData.peek m $? dumps'''
+ mmdinfo''' <- peekPTR m (p+56)
+ mmdinfo' <- MMDInfo.peek m $? mmdinfo'''
+ mmdrexx''' <- peekPTR m (p+60)
+ mmdrexx' <- MMDARexx.peek m $? mmdrexx'''
+ mmdcmd3x''' <- peekPTR m (p+64)
+ mmdcmd3x' <- MMDMIDICmd3x.peek m $? mmdcmd3x'''
+ reserved2' <- mapM (peekULONG m) $ pointerRange (p+68) 4 3
+ tag_end' <- peekULONG m (p+80)
+ return $ MMD0exp
+ nextmod' exp_smp' i_ext_entries' s_ext_entrsz' annotxt' annolen'
+ iinfo' i_ext_entries' i_ext_entrsz' jumpmask' rgbtable'
+ channelsplit' n_info' songname' songnamelen' dumps' mmdinfo'
+ mmdrexx' mmdcmd3x' reserved2' tag_end'
diff --git a/src/Sound/MED/Raw/MMD1.hs b/src/Sound/MED/Raw/MMD1.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD1.hs
@@ -0,0 +1,71 @@
+module Sound.MED.Raw.MMD1 where
+
+import qualified Sound.MED.Raw.MMD0Song as MMD0Song
+import Sound.MED.Raw.MMD0Song(MMD0Song)
+import qualified Sound.MED.Raw.MMD1Block as MMD1Block
+import Sound.MED.Raw.MMD1Block(MMD1Block)
+import qualified Sound.MED.Raw.InstrHdr as InstrHdr
+import Sound.MED.Raw.InstrHdr(InstrHdr)
+import qualified Sound.MED.Raw.MMD0exp as MMD0exp
+import Sound.MED.Raw.MMD0exp(MMD0exp)
+import Sound.MED.Basic.Amiga
+
+data MMD1 = MMD1
+ { id :: ULONG
+ , modlen :: ULONG
+ , song :: MMD0Song
+ , psecnum :: UWORD
+ , pseq :: UWORD
+ , blockarr :: [ MMD1Block ]
+ , mmdflags :: UBYTE
+ , reserved1 :: UBYTE
+ , reserved2 :: UBYTE
+ , reserved3 :: UBYTE
+ , smplarr :: [ Maybe InstrHdr ]
+ , reserved4 :: ULONG
+ , expdata :: Maybe MMD0exp
+ , reserved5 :: ULONG
+ , pstate :: UWORD
+ , pblock :: UWORD
+ , pline :: UWORD
+ , pseqnum :: UWORD
+ , actplayline :: WORD
+ , counter :: UBYTE
+ , extra_songs :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD1
+peek m p = do
+ id' <- peekULONG m (p + 0)
+ modlen' <- peekULONG m (p + 4)
+ song'' <- peekPTR m (p + 8)
+ song' <- MMD0Song.peek m song''
+ psecnum' <- peekUWORD m (p + 12)
+ pseq' <- peekUWORD m (p + 14)
+ blockarr''' <- peekPTR m (p + 16)
+ blockarr'' <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')
+ blockarr' <- mapM (MMD1Block.peek m) blockarr''
+ mmdflags' <- peekUBYTE m (p + 20)
+ reserved1' <- peekUBYTE m (p + 21)
+ reserved2' <- peekUBYTE m (p + 22)
+ reserved3' <- peekUBYTE m (p + 23)
+ smplarr''' <- peekPTR m (p + 24)
+ smplarr'' <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')
+ smplarr' <- mapM (InstrHdr.peek m $?) smplarr''
+ reserved4' <- peekULONG m (p + 28)
+ expdata''' <- peekPTR m (p + 32)
+ expdata' <- MMD0exp.peek m $? expdata'''
+ reserved5' <- peekULONG m (p + 36)
+ pstate' <- peekUWORD m (p + 40)
+ pblock' <- peekUWORD m (p + 42)
+ pline' <- peekUWORD m (p + 44)
+ pseqnum' <- peekUWORD m (p + 46)
+ actplayline' <- peekWORD m (p + 48)
+ counter' <- peekUBYTE m (p + 50)
+ extra_songs' <- peekUBYTE m (p + 51)
+ return $ MMD1
+ id' modlen' song' psecnum' pseq' blockarr' mmdflags'
+ reserved1' reserved2' reserved3' smplarr' reserved4'
+ expdata' reserved5' pstate' pblock' pline' pseqnum'
+ actplayline' counter' extra_songs'
diff --git a/src/Sound/MED/Raw/MMD1Block.hs b/src/Sound/MED/Raw/MMD1Block.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD1Block.hs
@@ -0,0 +1,27 @@
+module Sound.MED.Raw.MMD1Block where
+
+import qualified Sound.MED.Raw.BlockInfo as BlockInfo
+import Sound.MED.Raw.BlockInfo(BlockInfo)
+import qualified Sound.MED.Raw.MMD1NoteData as MMD1NoteData
+import Sound.MED.Raw.MMD1NoteData(MMD1NoteData)
+
+import Sound.MED.Basic.Amiga
+
+data MMD1Block = MMD1Block
+ { numtracks :: UWORD
+ , lines :: UWORD -- NOTE: actual number of lines is one greater
+ , info :: Maybe BlockInfo
+ , notedata :: [ [ MMD1NoteData ] ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD1Block
+peek m p = do
+ numtracks' <- peekUWORD m (p + 0)
+ lines' <- peekUWORD m (p + 2)
+ info''' <- peekPTR m (p + 4)
+ info' <- BlockInfo.peek numtracks' (lines'+1) m $? info'''
+ notedata'' <- mapM (MMD1NoteData.peek m) $ pointerRangeGen2 (p+8) 4 numtracks' (lines'+1)
+ let notedata' = chunk numtracks' notedata''
+ return $ MMD1Block
+ numtracks' lines' info' notedata'
diff --git a/src/Sound/MED/Raw/MMD1NoteData.hs b/src/Sound/MED/Raw/MMD1NoteData.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD1NoteData.hs
@@ -0,0 +1,30 @@
+module Sound.MED.Raw.MMD1NoteData where
+
+import Sound.MED.Basic.Amiga
+
+import Data.Bits ((.&.))
+
+data MMD1NoteData = MMD1NoteData
+ { note :: UBYTE
+ , instrument :: UBYTE
+ , command :: UBYTE
+ , databyte :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD1NoteData
+peek m p = do
+ byte1 <- peekUBYTE m (p + 0)
+ byte2 <- peekUBYTE m (p + 1)
+ byte3 <- peekUBYTE m (p + 2)
+ byte4 <- peekUBYTE m (p + 3)
+ let nnnnnnn = byte1 .&. 0x7F
+ let iiiiii = byte2 .&. 0x3F
+ let cccccccc = byte3 .&. 0xFF
+ let dddddddd = byte4 .&. 0xFF
+ let note' = nnnnnnn
+ let instrument' = iiiiii
+ let command' = cccccccc
+ let databyte' = dddddddd
+ return $ MMD1NoteData
+ note' instrument' command' databyte'
diff --git a/src/Sound/MED/Raw/MMD2.hs b/src/Sound/MED/Raw/MMD2.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD2.hs
@@ -0,0 +1,71 @@
+module Sound.MED.Raw.MMD2 where
+
+import qualified Sound.MED.Raw.MMD2Song as MMD2Song
+import Sound.MED.Raw.MMD2Song(MMD2Song)
+import qualified Sound.MED.Raw.MMD1Block as MMD1Block
+import Sound.MED.Raw.MMD1Block(MMD1Block)
+import qualified Sound.MED.Raw.InstrHdr as InstrHdr
+import Sound.MED.Raw.InstrHdr(InstrHdr)
+import qualified Sound.MED.Raw.MMD0exp as MMD0exp
+import Sound.MED.Raw.MMD0exp(MMD0exp)
+import Sound.MED.Basic.Amiga
+
+data MMD2 = MMD2
+ { id :: ULONG
+ , modlen :: ULONG
+ , song :: MMD2Song
+ , psecnum :: UWORD
+ , pseq :: UWORD
+ , blockarr :: [ MMD1Block ]
+ , mmdflags :: UBYTE
+ , reserved1 :: UBYTE
+ , reserved2 :: UBYTE
+ , reserved3 :: UBYTE
+ , smplarr :: [ Maybe InstrHdr ]
+ , reserved4 :: ULONG
+ , expdata :: Maybe MMD0exp
+ , reserved5 :: ULONG
+ , pstate :: UWORD
+ , pblock :: UWORD
+ , pline :: UWORD
+ , pseqnum :: UWORD
+ , actplayline :: WORD
+ , counter :: UBYTE
+ , extra_songs :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD2
+peek m p = do
+ id' <- peekULONG m (p + 0)
+ modlen' <- peekULONG m (p + 4)
+ song'' <- peekPTR m (p + 8)
+ song' <- MMD2Song.peek m song''
+ psecnum' <- peekUWORD m (p + 12)
+ pseq' <- peekUWORD m (p + 14)
+ blockarr''' <- peekPTR m (p + 16)
+ blockarr'' <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')
+ blockarr' <- mapM (MMD1Block.peek m) blockarr''
+ mmdflags' <- peekUBYTE m (p + 20)
+ reserved1' <- peekUBYTE m (p + 21)
+ reserved2' <- peekUBYTE m (p + 22)
+ reserved3' <- peekUBYTE m (p + 23)
+ smplarr''' <- peekPTR m (p + 24)
+ smplarr'' <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')
+ smplarr' <- mapM (InstrHdr.peek m $?) smplarr''
+ reserved4' <- peekULONG m (p + 28)
+ expdata''' <- peekPTR m (p + 32)
+ expdata' <- MMD0exp.peek m $? expdata'''
+ reserved5' <- peekULONG m (p + 36)
+ pstate' <- peekUWORD m (p + 40)
+ pblock' <- peekUWORD m (p + 42)
+ pline' <- peekUWORD m (p + 44)
+ pseqnum' <- peekUWORD m (p + 46)
+ actplayline' <- peekWORD m (p + 48)
+ counter' <- peekUBYTE m (p + 50)
+ extra_songs' <- peekUBYTE m (p + 51)
+ return $ MMD2
+ id' modlen' song' psecnum' pseq' blockarr' mmdflags'
+ reserved1' reserved2' reserved3' smplarr' reserved4'
+ expdata' reserved5' pstate' pblock' pline' pseqnum'
+ actplayline' counter' extra_songs'
diff --git a/src/Sound/MED/Raw/MMD2Song.hs b/src/Sound/MED/Raw/MMD2Song.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD2Song.hs
@@ -0,0 +1,75 @@
+module Sound.MED.Raw.MMD2Song where
+
+import qualified Sound.MED.Raw.MMD0Sample as MMD0Sample
+import Sound.MED.Raw.MMD0Sample(MMD0Sample)
+import qualified Sound.MED.Raw.PlaySeq as PlaySeq
+import Sound.MED.Raw.PlaySeq(PlaySeq)
+import Sound.MED.Basic.Amiga
+
+data MMD2Song = MMD2Song
+ { sample :: [ MMD0Sample ]
+ , numblocks :: UWORD
+ , songlen :: UWORD
+ , playseqtable :: [ PlaySeq ]
+ , sectiontable :: [ UWORD ]
+ , trackvols :: [ UBYTE ]
+ , numtracks :: UWORD
+ , numpseqs :: UWORD
+ , trackpans :: [ BYTE ]
+ , flags3 :: ULONG
+ , voladj :: UWORD
+ , channels :: UWORD
+ , mix_echotype :: UBYTE
+ , mix_echodepth :: UBYTE
+ , mix_echolen :: UWORD
+ , mix_stereosep :: BYTE
+ , pad0 :: [ UBYTE ]
+ , deftempo :: UWORD
+ , playtransp :: BYTE
+ , flags :: UBYTE
+ , flags2 :: UBYTE
+ , tempo2 :: UBYTE
+ , pad1 :: [ UBYTE ]
+ , mastervol :: UBYTE
+ , numsamples :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD2Song
+peek m p = do
+ sample' <- mapM (MMD0Sample.peek m) $ pointerRange p 8 63
+ numblocks' <- peekUWORD m (p+504)
+ songlen' <- peekUWORD m (p+506)
+ numpseqs' <- peekUWORD m (p+522)
+ playseqtable''' <- peekPTR m (p+508)
+ playseqtable'' <- mapM (peekPTR m) $ pointerRangeGen playseqtable''' 4 numpseqs'
+ playseqtable' <- mapM (PlaySeq.peek m) playseqtable''
+ sectiontable'' <- peekPTR m (p+512)
+ sectiontable' <- mapM (peekUWORD m) $ pointerRangeGen sectiontable'' 2 songlen'
+ numtracks' <- peekUWORD m (p+520)
+ trackvols'' <- peekPTR m (p+516)
+ trackvols' <- mapM (peekUBYTE m) $ pointerRangeGen trackvols'' 1 numtracks'
+ trackpans'' <- peekPTR m (p+524)
+ trackpans' <- if trackpans'' == 0 then return $ replicate (fromIntegral numtracks') 0 else mapM (peekBYTE m) $ pointerRangeGen trackpans'' 1 numtracks'
+ flags3' <- peekULONG m (p+528)
+ voladj' <- peekUWORD m (p+532)
+ channels' <- peekUWORD m (p+534)
+ mix_echotype' <- peekUBYTE m (p+536)
+ mix_echodepth' <- peekUBYTE m (p+537)
+ mix_echolen' <- peekUWORD m (p+538)
+ mix_stereosep' <- peekBYTE m (p+540)
+ pad0' <- mapM (peekUBYTE m) $ pointerRange (p+541) 1 223
+ deftempo' <- peekUWORD m (p+764)
+ playtransp' <- peekBYTE m (p+766)
+ flags' <- peekUBYTE m (p+767)
+ flags2' <- peekUBYTE m (p+768)
+ tempo2' <- peekUBYTE m (p+769)
+ pad1' <- mapM (peekUBYTE m) $ pointerRange (p+770) 1 16
+ mastervol' <- peekUBYTE m (p+786)
+ numsamples' <- peekUBYTE m (p+787)
+ return $ MMD2Song
+ sample' numblocks' songlen' playseqtable' sectiontable' trackvols'
+ numtracks' numpseqs' trackpans' flags3' voladj' channels'
+ mix_echotype' mix_echodepth' mix_echolen' mix_stereosep' pad0'
+ deftempo' playtransp' flags' flags2' tempo2' pad1' mastervol'
+ numsamples'
diff --git a/src/Sound/MED/Raw/MMD3.hs b/src/Sound/MED/Raw/MMD3.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMD3.hs
@@ -0,0 +1,71 @@
+module Sound.MED.Raw.MMD3 where
+
+import qualified Sound.MED.Raw.MMD2Song as MMD2Song
+import Sound.MED.Raw.MMD2Song(MMD2Song)
+import qualified Sound.MED.Raw.MMD1Block as MMD1Block
+import Sound.MED.Raw.MMD1Block(MMD1Block)
+import qualified Sound.MED.Raw.InstrHdr as InstrHdr
+import Sound.MED.Raw.InstrHdr(InstrHdr)
+import qualified Sound.MED.Raw.MMD0exp as MMD0exp
+import Sound.MED.Raw.MMD0exp(MMD0exp)
+import Sound.MED.Basic.Amiga
+
+data MMD3 = MMD3
+ { id :: ULONG
+ , modlen :: ULONG
+ , song :: MMD2Song
+ , psecnum :: UWORD
+ , pseq :: UWORD
+ , blockarr :: [ MMD1Block ]
+ , mmdflags :: UBYTE
+ , reserved1 :: UBYTE
+ , reserved2 :: UBYTE
+ , reserved3 :: UBYTE
+ , smplarr :: [ Maybe InstrHdr ]
+ , reserved4 :: ULONG
+ , expdata :: Maybe MMD0exp
+ , reserved5 :: ULONG
+ , pstate :: UWORD
+ , pblock :: UWORD
+ , pline :: UWORD
+ , pseqnum :: UWORD
+ , actplayline :: WORD
+ , counter :: UBYTE
+ , extra_songs :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMD3
+peek m p = do
+ id' <- peekULONG m (p + 0)
+ modlen' <- peekULONG m (p + 4)
+ song'' <- peekPTR m (p + 8)
+ song' <- MMD2Song.peek m song''
+ psecnum' <- peekUWORD m (p + 12)
+ pseq' <- peekUWORD m (p + 14)
+ blockarr''' <- peekPTR m (p + 16)
+ blockarr'' <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')
+ blockarr' <- mapM (MMD1Block.peek m) blockarr''
+ mmdflags' <- peekUBYTE m (p + 20)
+ reserved1' <- peekUBYTE m (p + 21)
+ reserved2' <- peekUBYTE m (p + 22)
+ reserved3' <- peekUBYTE m (p + 23)
+ smplarr''' <- peekPTR m (p + 24)
+ smplarr'' <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')
+ smplarr' <- mapM (InstrHdr.peek m $?) smplarr''
+ reserved4' <- peekULONG m (p + 28)
+ expdata''' <- peekPTR m (p + 32)
+ expdata' <- MMD0exp.peek m $? expdata'''
+ reserved5' <- peekULONG m (p + 36)
+ pstate' <- peekUWORD m (p + 40)
+ pblock' <- peekUWORD m (p + 42)
+ pline' <- peekUWORD m (p + 44)
+ pseqnum' <- peekUWORD m (p + 46)
+ actplayline' <- peekWORD m (p + 48)
+ counter' <- peekUBYTE m (p + 50)
+ extra_songs' <- peekUBYTE m (p + 51)
+ return $ MMD3
+ id' modlen' song' psecnum' pseq' blockarr' mmdflags'
+ reserved1' reserved2' reserved3' smplarr' reserved4'
+ expdata' reserved5' pstate' pblock' pline' pseqnum'
+ actplayline' counter' extra_songs'
diff --git a/src/Sound/MED/Raw/MMDARexx.hs b/src/Sound/MED/Raw/MMDARexx.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDARexx.hs
@@ -0,0 +1,22 @@
+module Sound.MED.Raw.MMDARexx where
+
+import qualified Sound.MED.Raw.MMDARexxTrigCmd as MMDARexxTrigCmd
+import Sound.MED.Raw.MMDARexxTrigCmd(MMDARexxTrigCmd)
+
+import Sound.MED.Basic.Amiga
+
+data MMDARexx = MMDARexx
+ { reserved :: UWORD
+ , trigcmdlen :: UWORD
+ , trigcmd :: Maybe MMDARexxTrigCmd
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDARexx
+peek m p = do
+ reserved' <- peekUWORD m (p+0)
+ trigcmdlen' <- peekUWORD m (p+2)
+ trigcmd''' <- peekPTR m (p+4)
+ trigcmd' <- MMDARexxTrigCmd.peek m $? trigcmd'''
+ return $ MMDARexx
+ reserved' trigcmdlen' trigcmd'
diff --git a/src/Sound/MED/Raw/MMDARexxTrigCmd.hs b/src/Sound/MED/Raw/MMDARexxTrigCmd.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDARexxTrigCmd.hs
@@ -0,0 +1,31 @@
+module Sound.MED.Raw.MMDARexxTrigCmd where
+
+import Sound.MED.Basic.Amiga
+
+data MMDARexxTrigCmd = MMDARexxTrigCmd
+ { next :: Maybe MMDARexxTrigCmd
+ , cmdnum :: UBYTE
+ , pad :: UBYTE
+ , cmdtype :: WORD
+ , cmd :: [ UBYTE ]
+ , port :: [ UBYTE ]
+ , cmd_len :: UWORD
+ , port_len :: UWORD
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDARexxTrigCmd
+peek m p = do
+ next''' <- peekPTR m p
+ next' <- peek m $? next'''
+ cmdnum' <- peekUBYTE m (p+4)
+ pad' <- peekUBYTE m (p+5)
+ cmdtype' <- peekWORD m (p+6)
+ cmd'' <- peekPTR m (p+8)
+ port'' <- peekPTR m (p+12)
+ cmd_len' <- peekUWORD m (p+16)
+ port_len' <- peekUWORD m (p+18)
+ cmd' <- mapM (peekUBYTE m) $ pointerRangeGenCheck cmd'' 1 (cmd_len'+1)
+ port' <- mapM (peekUBYTE m) $ pointerRangeGenCheck port'' 1 (port_len'+1)
+ return $ MMDARexxTrigCmd
+ next' cmdnum' pad' cmdtype' cmd' port' cmd_len' port_len'
diff --git a/src/Sound/MED/Raw/MMDDump.hs b/src/Sound/MED/Raw/MMDDump.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDDump.hs
@@ -0,0 +1,22 @@
+module Sound.MED.Raw.MMDDump where
+
+import Sound.MED.Basic.Amiga
+
+data MMDDump = MMDDump
+ { len :: ULONG
+ , dat :: [ UBYTE ]
+ , ext_len :: UWORD
+ , name :: Maybe [ UBYTE ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDDump
+peek m p = do
+ len' <- peekULONG m (p+0)
+ dat'' <- peekPTR m (p+4)
+ dat' <- mapM (peekUBYTE m) $ pointerRangeGenCheck dat'' 1 len'
+ ext_len' <- peekUWORD m (p+8)
+ name' <-
+ skipIf (ext_len' < 20) $ mapM (peekUBYTE m) $ pointerRange (p+10) 1 20
+ return $ MMDDump
+ len' dat' ext_len' name'
diff --git a/src/Sound/MED/Raw/MMDDumpData.hs b/src/Sound/MED/Raw/MMDDumpData.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDDumpData.hs
@@ -0,0 +1,22 @@
+module Sound.MED.Raw.MMDDumpData where
+
+import qualified Sound.MED.Raw.MMDDump as MMDDump
+import Sound.MED.Raw.MMDDump(MMDDump)
+
+import Sound.MED.Basic.Amiga
+
+data MMDDumpData = MMDDumpData
+ { numdumps :: UWORD
+ , reserved :: [ UWORD ]
+ , dumps :: [ MMDDump ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDDumpData
+peek m p = do
+ numdumps' <- peekUWORD m p
+ reserved' <- mapM (peekUWORD m) $ pointerRange (p+2) 2 3
+ dumps'' <- mapM (peekPTR m) $ pointerRangeGen (p+8) 4 numdumps'
+ dumps' <- mapM (MMDDump.peek m) dumps''
+ return $ MMDDumpData
+ numdumps' reserved' dumps'
diff --git a/src/Sound/MED/Raw/MMDInfo.hs b/src/Sound/MED/Raw/MMDInfo.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDInfo.hs
@@ -0,0 +1,23 @@
+module Sound.MED.Raw.MMDInfo where
+
+import Sound.MED.Basic.Amiga
+
+data MMDInfo = MMDInfo
+ { next :: Maybe MMDInfo
+ , reserved :: UWORD
+ , typ :: UWORD
+ , len :: ULONG
+ , dat :: [ UBYTE ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDInfo
+peek m p = do
+ next''' <- peekPTR m p
+ next' <- peek m $? next'''
+ reserved' <- peekUWORD m (p+4)
+ typ' <- peekUWORD m (p+6)
+ len' <- peekULONG m (p+8)
+ dat' <- mapM (peekUBYTE m) $ pointerRangeGen (p+12) 1 len'
+ return $ MMDInfo
+ next' reserved' typ' len' dat'
diff --git a/src/Sound/MED/Raw/MMDInstrInfo.hs b/src/Sound/MED/Raw/MMDInstrInfo.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDInstrInfo.hs
@@ -0,0 +1,14 @@
+module Sound.MED.Raw.MMDInstrInfo where
+
+import Sound.MED.Basic.Amiga
+
+data MMDInstrInfo = MMDInstrInfo
+ { name :: Maybe [ UBYTE ]
+ }
+ deriving (Show)
+
+peek :: UWORD -> MEM -> PTR -> IO MMDInstrInfo
+peek size m p = do
+ name' <- skipIf (size < 40) $ mapM (peekUBYTE m) $ pointerRange p 1 40
+ return $ MMDInstrInfo
+ name'
diff --git a/src/Sound/MED/Raw/MMDMIDICmd3x.hs b/src/Sound/MED/Raw/MMDMIDICmd3x.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/MMDMIDICmd3x.hs
@@ -0,0 +1,24 @@
+module Sound.MED.Raw.MMDMIDICmd3x where
+
+import Sound.MED.Basic.Amiga
+
+data MMDMIDICmd3x = MMDMIDICmd3x
+ { struct_ver :: UBYTE
+ , pad :: UBYTE
+ , num_of_settings :: UWORD
+ , ctrlr_types :: [ UBYTE ]
+ , ctrlr_numbers :: [ UWORD ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO MMDMIDICmd3x
+peek m p = do
+ struct_ver' <- peekUBYTE m (p+0)
+ pad' <- peekUBYTE m (p+1)
+ num_of_settings' <- peekUWORD m (p+2)
+ ctrlr_types'' <- peekPTR m (p+4)
+ ctrlr_types' <- mapM (peekUBYTE m) $ pointerRangeGen ctrlr_types'' 1 num_of_settings'
+ ctrlr_numbers'' <- peekPTR m (p+8)
+ ctrlr_numbers' <- mapM (peekUWORD m) $ pointerRangeGen ctrlr_numbers'' 2 num_of_settings'
+ return $ MMDMIDICmd3x
+ struct_ver' pad' num_of_settings' ctrlr_types' ctrlr_numbers'
diff --git a/src/Sound/MED/Raw/NotationInfo.hs b/src/Sound/MED/Raw/NotationInfo.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/NotationInfo.hs
@@ -0,0 +1,26 @@
+module Sound.MED.Raw.NotationInfo where
+
+import Sound.MED.Basic.Amiga
+
+data NotationInfo = NotationInfo
+ { n_of_sharps :: UBYTE
+ , flags :: UBYTE
+ , trksel :: [ WORD ]
+ , trkshow :: [ UBYTE ]
+ , trkghost :: [ UBYTE ]
+ , notetr :: [ BYTE ]
+ , pad :: UBYTE
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO NotationInfo
+peek m p = do
+ n_of_sharps' <- peekUBYTE m (p+0)
+ flags' <- peekUBYTE m (p+1)
+ trksel' <- mapM (peekWORD m) $ pointerRange (p+ 2) 2 5
+ trkshow' <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 16
+ trkghost' <- mapM (peekUBYTE m) $ pointerRange (p+38) 1 16
+ notetr' <- mapM (peekBYTE m) $ pointerRange (p+54) 1 63
+ pad' <- peekUBYTE m (p+117)
+ return $ NotationInfo
+ n_of_sharps' flags' trksel' trkshow' trkghost' notetr' pad'
diff --git a/src/Sound/MED/Raw/PlaySeq.hs b/src/Sound/MED/Raw/PlaySeq.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/PlaySeq.hs
@@ -0,0 +1,22 @@
+module Sound.MED.Raw.PlaySeq where
+
+import Sound.MED.Basic.Amiga
+
+data PlaySeq = PlaySeq
+ { name :: [ UBYTE ]
+ , reserved0 :: ULONG
+ , reserved1 :: ULONG
+ , len :: UWORD
+ , seq :: [ UWORD ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO PlaySeq
+peek m p = do
+ name' <- mapM (peekUBYTE m) $ pointerRange p 1 32
+ reserved0' <- peekULONG m (p+32)
+ reserved1' <- peekULONG m (p+36)
+ len' <- peekUWORD m (p+40)
+ seq' <- mapM (peekUWORD m) $ pointerRangeGen (p+42) 2 len'
+ return $ PlaySeq
+ name' reserved0' reserved1' len' seq'
diff --git a/src/Sound/MED/Raw/SampleInstr.hs b/src/Sound/MED/Raw/SampleInstr.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/SampleInstr.hs
@@ -0,0 +1,18 @@
+module Sound.MED.Raw.SampleInstr where
+
+import Sound.MED.Basic.Amiga
+
+data SampleInstr = SampleInstr
+ { octaves :: WORD
+ , chans :: Either [[BYTE]] [[WORD]]
+ }
+ deriving Show
+
+peek :: ULONG -> WORD -> Bool -> Bool -> MEM -> PTR -> IO SampleInstr
+peek len' stype' s16' stereo' m p = do
+ let octaves' = [1,5,3,2,4,6,7,9]!!fromIntegral stype'
+ case (s16',stereo') of
+ (False, False) -> do { dat'' <- mapM (peekBYTE m) $ pointerRangeGen (p+6) 1 len' ; return $ SampleInstr octaves' $ Left [dat''] }
+ (True, False) -> do { dat'' <- mapM (peekWORD m) $ pointerRangeGen (p+6) 2 (len'`div`2) ; return $ SampleInstr octaves' $ Right [dat''] }
+ (False, True ) -> do { dat'' <- mapM (peekBYTE m) $ pointerRangeGen (p+6) 1 (2*len') ; return $ SampleInstr octaves' $ Left (chunk len' dat'') }
+ (True, True ) -> do { dat'' <- mapM (peekWORD m) $ pointerRangeGen (p+6) 2 (2*(len'`div`2)) ; return $ SampleInstr octaves' $ Right (chunk (len'`div`2) dat'') }
diff --git a/src/Sound/MED/Raw/SynthInstr.hs b/src/Sound/MED/Raw/SynthInstr.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/SynthInstr.hs
@@ -0,0 +1,78 @@
+module Sound.MED.Raw.SynthInstr where
+
+import qualified Sound.MED.Raw.SynthWF as SynthWF
+import Sound.MED.Raw.SynthWF(SynthWF)
+
+import Sound.MED.Basic.Amiga
+
+data SynthInstr = SynthInstr
+ { defaultdecay :: UBYTE
+ , reserved :: [ UBYTE ]
+ , rep :: UWORD
+ , replen :: UWORD
+ , voltbllen :: UWORD
+ , wftbllen :: UWORD
+ , volspeed :: UBYTE
+ , wfspeed :: UBYTE
+ , wforms :: UWORD
+ , voltbl :: [ UBYTE ]
+ , wftbl :: [ UBYTE ]
+ , wf :: [ Maybe SynthWF ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO SynthInstr
+peek m p = do
+ defaultdecay' <- peekUBYTE m (p+6)
+ reserved' <- mapM (peekUBYTE m) $ pointerRange (p+7) 1 3
+ rep' <- peekUWORD m (p+10)
+ replen' <- peekUWORD m (p+12)
+ voltbllen' <- peekUWORD m (p+14)
+ wftbllen' <- peekUWORD m (p+16)
+ volspeed' <- peekUBYTE m (p+18)
+ wfspeed' <- peekUBYTE m (p+19)
+ wforms' <- peekUWORD m (p+20)
+ voltbl' <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 128
+ wftbl' <- mapM (peekUBYTE m) $ pointerRange (p+150) 150 128
+ wf'' <- mapM (peekPTR m) $ pointerRange (p+278) 4 64
+ wf' <- mapM (SynthWF.peek m . (p+) $?) wf''
+ return $ SynthInstr
+ defaultdecay' reserved' rep' replen' voltbllen' wftbllen'
+ volspeed' wfspeed' wforms' voltbl' wftbl' wf'
+
+{-
+showVOL :: [UBYTE] -> String
+showVOL vs = "[ " ++ (unwords . map showVOL') vs ++ " ]"
+showVOL' :: UBYTE -> String
+showVOL' 0xF0 = "SPD"
+showVOL' 0xF1 = "WAI"
+showVOL' 0xF2 = "CHD"
+showVOL' 0xF3 = "CDU"
+showVOL' 0xF4 = "EN1"
+showVOL' 0xF5 = "EN2"
+showVOL' 0xF6 = "EST"
+showVOL' 0xFA = "JWS"
+showVOL' 0xFB = "HLT"
+showVOL' 0xFE = "JMP"
+showVOL' 0xFF = "END"
+showVOL' v = show v
+
+showWF :: [UBYTE] -> String
+showWF vs = "[ " ++ (unwords . map showWF') vs ++ " ]"
+showWF' :: UBYTE -> String
+showWF' 0xF0 = "SPD"
+showWF' 0xF1 = "WAI"
+showWF' 0xF2 = "CHD"
+showWF' 0xF3 = "CDU"
+showWF' 0xF4 = "VBD"
+showWF' 0xF5 = "VBS"
+showWF' 0xF6 = "RES"
+showWF' 0xF7 = "VWF"
+showWF' 0xFA = "JVS"
+showWF' 0xFB = "HLT"
+showWF' 0xFC = "ARP"
+showWF' 0xFD = "ARE"
+showWF' 0xFE = "JMP"
+showWF' 0xFF = "END"
+showWF' v = show v
+-}
diff --git a/src/Sound/MED/Raw/SynthWF.hs b/src/Sound/MED/Raw/SynthWF.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/Raw/SynthWF.hs
@@ -0,0 +1,16 @@
+module Sound.MED.Raw.SynthWF where
+
+import Sound.MED.Basic.Amiga
+
+data SynthWF = SynthWF
+ { len2 :: UWORD
+ , wfdata :: [ BYTE ]
+ }
+ deriving (Show)
+
+peek :: MEM -> PTR -> IO SynthWF
+peek m p = do
+ len2' <- peekUWORD m (p+0)
+ wfdata' <- mapM (peekBYTE m) $ pointerRangeGen (p+2) 1 (len2'*2)
+ return $ SynthWF
+ len2' wfdata'
diff --git a/src/Sound/MED/modules.sh b/src/Sound/MED/modules.sh
new file mode 100644
--- /dev/null
+++ b/src/Sound/MED/modules.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+(
+ echo 'digraph G {' &&
+ fgrep import *.hs |
+ sed 's/.hs:import /->/g' |
+ sed 's/(.*)//g' |
+ sed 's/qualified //g' |
+ fgrep -v '.' |
+ fgrep -v 'Sound.MED.Basic.Amiga' |
+ fgrep -v 'Sound.MED.Basic.Human' |
+ sed 's/$/;/g' |
+ sort |
+ uniq &&
+ echo '};'
+) > ../docs/modules.dot &&
+dot -Tpng <../docs/modules.dot >../docs/modules.png