med-module (empty) → 0.0
raw patch · 47 files changed
+2870/−0 lines, 47 filesdep +arraydep +basedep +filepathsetup-changed
Dependencies added: array, base, filepath, hps, med-module, non-empty, optparse-applicative, storable-endian, transformers, utility-ht
Files
- COPYING +674/−0
- Makefile +22/−0
- README.md +10/−0
- Setup.lhs +3/−0
- example/Animate.hs +271/−0
- example/Animate/Option.hs +74/−0
- example/Unmed.hs +13/−0
- med-module.cabal +127/−0
- src/Sound/MED/Basic/Amiga.hs +92/−0
- src/Sound/MED/Basic/Human.hs +12/−0
- src/Sound/MED/Basic/Pretty.hs +21/−0
- src/Sound/MED/Generic.hs +89/−0
- src/Sound/MED/Generic/Block.hs +100/−0
- src/Sound/MED/Generic/Instrument.hs +71/−0
- src/Sound/MED/Generic/PlaySeq.hs +34/−0
- src/Sound/MED/Generic/Tempo.hs +98/−0
- src/Sound/MED/Raw/BlockCmdPageTable.hs +27/−0
- src/Sound/MED/Raw/BlockInfo.hs +33/−0
- src/Sound/MED/Raw/CmdPageData.hs +16/−0
- src/Sound/MED/Raw/HybridInstr.hs +42/−0
- src/Sound/MED/Raw/InstrExt.hs +43/−0
- src/Sound/MED/Raw/InstrHdr.hs +50/−0
- src/Sound/MED/Raw/MMD0.hs +71/−0
- src/Sound/MED/Raw/MMD0Block.hs +22/−0
- src/Sound/MED/Raw/MMD0NoteData.hs +31/−0
- src/Sound/MED/Raw/MMD0Sample.hs +24/−0
- src/Sound/MED/Raw/MMD0Song.hs +39/−0
- src/Sound/MED/Raw/MMD0exp.hs +82/−0
- src/Sound/MED/Raw/MMD1.hs +71/−0
- src/Sound/MED/Raw/MMD1Block.hs +27/−0
- src/Sound/MED/Raw/MMD1NoteData.hs +30/−0
- src/Sound/MED/Raw/MMD2.hs +71/−0
- src/Sound/MED/Raw/MMD2Song.hs +75/−0
- src/Sound/MED/Raw/MMD3.hs +71/−0
- src/Sound/MED/Raw/MMDARexx.hs +22/−0
- src/Sound/MED/Raw/MMDARexxTrigCmd.hs +31/−0
- src/Sound/MED/Raw/MMDDump.hs +22/−0
- src/Sound/MED/Raw/MMDDumpData.hs +22/−0
- src/Sound/MED/Raw/MMDInfo.hs +23/−0
- src/Sound/MED/Raw/MMDInstrInfo.hs +14/−0
- src/Sound/MED/Raw/MMDMIDICmd3x.hs +24/−0
- src/Sound/MED/Raw/NotationInfo.hs +26/−0
- src/Sound/MED/Raw/PlaySeq.hs +22/−0
- src/Sound/MED/Raw/SampleInstr.hs +18/−0
- src/Sound/MED/Raw/SynthInstr.hs +78/−0
- src/Sound/MED/Raw/SynthWF.hs +16/−0
- src/Sound/MED/modules.sh +16/−0
+ COPYING view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ Makefile view
@@ -0,0 +1,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 $@
+ README.md view
@@ -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.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ example/Animate.hs view
@@ -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
+ example/Animate/Option.hs view
@@ -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+ }
+ example/Unmed.hs view
@@ -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
+ med-module.cabal view
@@ -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:+ <https://en.wikipedia.org/wiki/OctaMED>.+ 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
+ src/Sound/MED/Basic/Amiga.hs view
@@ -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<size) $+ ioError $ userError $ "loadMEM: incomplete load of " ++ s+ return ptr++freeMEM :: MEM -> 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)
+ src/Sound/MED/Basic/Human.hs view
@@ -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"
+ src/Sound/MED/Basic/Pretty.hs view
@@ -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) ' '
+ src/Sound/MED/Generic.hs view
@@ -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
+ src/Sound/MED/Generic/Block.hs view
@@ -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-"]
+ src/Sound/MED/Generic/Instrument.hs view
@@ -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"
+ src/Sound/MED/Generic/PlaySeq.hs view
@@ -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')
+ src/Sound/MED/Generic/Tempo.hs view
@@ -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)
+ src/Sound/MED/Raw/BlockCmdPageTable.hs view
@@ -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
+ src/Sound/MED/Raw/BlockInfo.hs view
@@ -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'
+ src/Sound/MED/Raw/CmdPageData.hs view
@@ -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'
+ src/Sound/MED/Raw/HybridInstr.hs view
@@ -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'
+ src/Sound/MED/Raw/InstrExt.hs view
@@ -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'
+ src/Sound/MED/Raw/InstrHdr.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0Block.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0NoteData.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0Sample.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0Song.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD0exp.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD1.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD1Block.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD1NoteData.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD2.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD2Song.hs view
@@ -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'
+ src/Sound/MED/Raw/MMD3.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDARexx.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDARexxTrigCmd.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDDump.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDDumpData.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDInfo.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDInstrInfo.hs view
@@ -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'
+ src/Sound/MED/Raw/MMDMIDICmd3x.hs view
@@ -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'
+ src/Sound/MED/Raw/NotationInfo.hs view
@@ -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'
+ src/Sound/MED/Raw/PlaySeq.hs view
@@ -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'
+ src/Sound/MED/Raw/SampleInstr.hs view
@@ -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'') }
+ src/Sound/MED/Raw/SynthInstr.hs view
@@ -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+-}
+ src/Sound/MED/Raw/SynthWF.hs view
@@ -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'
+ src/Sound/MED/modules.sh view
@@ -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