Monadius 0.98 → 0.99
raw patch · 15 files changed
+2356/−2350 lines, 15 filesdep ~GLUTdep ~OpenGLdep ~arraysetup-changed
Dependency ranges changed: GLUT, OpenGL, array, base, directory
Files
- LICENSE +340/−340
- Monadius.cabal +45/−46
- Monadius/Demo.hs +0/−57
- Monadius/Game.hs +0/−12
- Monadius/Main.hs +0/−366
- Monadius/Monadius.hs +0/−1348
- Monadius/Recorder.hs +0/−80
- Monadius/Util.hs +0/−96
- Setup.hs +2/−5
- src/Demo.hs +57/−0
- src/Game.hs +10/−0
- src/Main.hs +366/−0
- src/Monadius.hs +1356/−0
- src/Recorder.hs +84/−0
- src/Util.hs +96/−0
LICENSE view
@@ -1,340 +1,340 @@- GNU GENERAL PUBLIC LICENSE- Version 2, June 1991-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.- 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The licenses for most software are designed to take away your-freedom to share and change it. By contrast, the GNU General Public-License is intended to guarantee your freedom to share and change free-software--to make sure the software is free for all its users. This-General Public License applies to most of the Free Software-Foundation's software and to any other program whose authors commit to-using it. (Some other Free Software Foundation software is covered by-the GNU Library General Public License instead.) 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-this service 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 make restrictions that forbid-anyone to deny you these rights or to ask you to surrender the rights.-These restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.-- For example, if you distribute copies of such a program, whether-gratis or for a fee, you must give the recipients all the rights that-you have. 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.-- We protect your rights with two steps: (1) copyright the software, and-(2) offer you this license which gives you legal permission to copy,-distribute and/or modify the software.-- Also, for each author's protection and ours, we want to make certain-that everyone understands that there is no warranty for this free-software. If the software is modified by someone else and passed on, we-want its recipients to know that what they have is not the original, so-that any problems introduced by others will not reflect on the original-authors' reputations.-- Finally, any free program is threatened constantly by software-patents. We wish to avoid the danger that redistributors of a free-program will individually obtain patent licenses, in effect making the-program proprietary. To prevent this, we have made it clear that any-patent must be licensed for everyone's free use or not licensed at all.-- The precise terms and conditions for copying, distribution and-modification follow.-- GNU GENERAL PUBLIC LICENSE- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION-- 0. This License applies to any program or other work which contains-a notice placed by the copyright holder saying it may be distributed-under the terms of this General Public License. The "Program", below,-refers to any such program or work, and a "work based on the Program"-means either the Program or any derivative work under copyright law:-that is to say, a work containing the Program or a portion of it,-either verbatim or with modifications and/or translated into another-language. (Hereinafter, translation is included without limitation in-the term "modification".) Each licensee is addressed as "you".--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope. The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.-- 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the-notices that refer to this License and to the absence of any warranty;-and give any other recipients of the Program a copy of this License-along with the Program.--You may charge a fee for the physical act of transferring a copy, and-you may at your option offer warranty protection in exchange for a fee.-- 2. You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:-- a) You must cause the modified files to carry prominent notices- stating that you changed the files and the date of any change.-- b) You must cause any work that you distribute or publish, that in- whole or in part contains or is derived from the Program or any- part thereof, to be licensed as a whole at no charge to all third- parties under the terms of this License.-- c) If the modified program normally reads commands interactively- when run, you must cause it, when started running for such- interactive use in the most ordinary way, to print or display an- announcement including an appropriate copyright notice and a- notice that there is no warranty (or else, saying that you provide- a warranty) and that users may redistribute the program under- these conditions, and telling the user how to view a copy of this- License. (Exception: if the Program itself is interactive but- does not normally print such an announcement, your work based on- the Program is not required to print an announcement.)--These requirements apply to the modified work as a whole. If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works. But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.-- 3. You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:-- a) Accompany it with the complete corresponding machine-readable- source code, which must be distributed under the terms of Sections- 1 and 2 above on a medium customarily used for software interchange; or,-- b) Accompany it with a written offer, valid for at least three- years, to give any third party, for a charge no more than your- cost of physically performing source distribution, a complete- machine-readable copy of the corresponding source code, to be- distributed under the terms of Sections 1 and 2 above on a medium- customarily used for software interchange; or,-- c) Accompany it with the information you received as to the offer- to distribute corresponding source code. (This alternative is- allowed only for noncommercial distribution and only if you- received the program in object code or executable form with such- an offer, in accord with Subsection b above.)--The source code for a work means the preferred form of the work for-making modifications to it. For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable. However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.-- 4. You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License. Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.-- 5. You are not required to accept this License, since you have not-signed it. However, nothing else grants you permission to modify or-distribute the Program or its derivative works. These actions are-prohibited by law if you do not accept this License. Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.-- 6. Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions. You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.-- 7. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-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-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all. For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices. Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.-- 8. If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded. In such case, this License incorporates-the limitation as if written in the body of this License.-- 9. The Free Software Foundation may publish revised and/or new versions-of the 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 a version number of this License which applies to it and "any-later version", you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation. If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.-- 10. If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission. For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this. Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.-- NO WARRANTY-- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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.-- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR-REDISTRIBUTE 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.-- 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-convey 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 2 of the License, or- (at your option) any later version.-- This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License- along with this program; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA---Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:-- Gnomovision version 69, Copyright (C) year name of author- Gnomovision 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, the commands you use may-be called something other than `show w' and `show c'; they could even be-mouse-clicks or menu items--whatever suits your program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the program, if-necessary. Here is a sample; alter the names:-- Yoyodyne, Inc., hereby disclaims all copyright interest in the program- `Gnomovision' (which makes passes at compilers) written by James Hacker.-- <signature of Ty Coon>, 1 April 1989- Ty Coon, President of Vice--This 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 Library General-Public License instead of this License.+ GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) 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 +this service 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 make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. 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. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute 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 and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +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 +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the 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 a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, 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. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE 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. + + 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 +convey 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 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision 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, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +This 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 Library General +Public License instead of this License.
Monadius.cabal view
@@ -1,46 +1,45 @@-Name: Monadius-Version: 0.98--Synopsis: 2-D arcade scroller-Description: A fast-paced 2-D scrolling vector graphics clone of the arcade game Gradius;- it is dedicated to the 20th anniversary of Gradius series.--License: GPL-License-file: LICENSE--Author: Takayuki Muranushi & Hideyuki Tanaka-Maintainer: Hideyuki Tanaka <tanaka.hideyuki@gmail.com>--Stability: Stable-Category: Game--Homepage: http://www.geocities.jp/takascience/haskell/monadius_en.html--Build-type: Simple-Cabal-version: >= 1.6--Data-files: readme-e.txt, readme-j.txt--Executable monadius- Build-depends: base >= 4 && < 5- , array >= 0.3 && < 0.5- , directory >= 1.1 && < 1.2- , GLUT >= 2.2 && < 2.4- , OpenGL >= 2.4 && < 2.7-- Hs-source-dirs: Monadius- Ghc-options: -Wall-- if os(windows)- Ghc-options: -optl-mwindows-- Main-is: Main.hs- Other-modules: Demo- Game- Monadius- Recorder- Util--Source-repository head- type: git- location: git://github.com/tanakh/monadius.git+Name: Monadius +Version: 0.99 + +Synopsis: 2-D arcade scroller +Description: A fast-paced 2-D scrolling vector graphics clone of the arcade game Gradius; + it is dedicated to the 20th anniversary of Gradius series. + +License: GPL +License-file: LICENSE + +Author: Takayuki Muranushi & Hideyuki Tanaka +Maintainer: Hideyuki Tanaka <tanaka.hideyuki@gmail.com> + +Stability: Stable +Category: Game + +Homepage: http://www.geocities.jp/takascience/haskell/monadius_en.html + +Build-type: Simple +Cabal-version: >= 1.6 + +Data-files: readme-e.txt, readme-j.txt + +Source-repository head + type: git + location: git://github.com/tanakh/monadius.git + +Executable monadius + Hs-source-dirs: src + Main-is: Main.hs + Other-modules: Demo + Game + Monadius + Recorder + Util + + Build-depends: base >= 4.6 && < 5 + , array >= 0.4 + , directory >= 1.2 + , GLUT >= 2.4 + , OpenGL >= 2.8 + + Ghc-options: -Wall + if os(windows) + Ghc-options: -optl-mwindows
− Monadius/Demo.hs
@@ -1,57 +0,0 @@-module Demo ( - demoData, - ReplayInfo(..) - ) where - --- | Demos are automatically played if you let the title scene run for a minute. -newtype ReplayInfo = ReplayInfo ((Int,Int),String) - deriving (Show,Read) - --- | Infinite list of demos. -demoData :: [ReplayInfo] -demoData = map ReplayInfo $ cycle [d1,d2,d3,d4,d5,d6,dieIn5,laserFool,shieldAttack,three] - -{- import Control.Arrow ((&&&)) - import Data.List (group) - - --| Take a bunch of Ints, and run-length encode them - first member of a pair specifies how many, second what. - rleEncode :: [Int] -> [(Int, Int)] - rleEncode = map (length &&& head) . group -} - -{- | Take a bunch of Int pairs, undo the run-length encoding, and then turn - the resulting [Int] into a String. The pairs are a run-length encoding of a String; - this was an inadvertent re-implementation of Don Stewart's RLE <http://cgi.cse.unsw.edu.au/~dons/blog/2007/07>. -} -rleDecode :: [(Int, Int)] -> String -rleDecode = show . (uncurry replicate =<<) - --- | Data specifying the demo. -d1,d2,d3,d4,d5,d6,dieIn5,laserFool,shieldAttack,three :: ((Int, Int), String) -d1 = ((2,1),d) - where d = rleDecode [(5, 3), (10, 67), (6, 3), (5, 67), (29, 3), (2, 11), (29, 3), (5, 35), (3, 3), (3, 35), (24, 3), (2, 35), (19, 3), (7, 19), (21, 51), (63, 35), (15, 43), (5, 11), (8, 43), (8, 35), (3, 3), (9, 35), (20, 3), (52, 67), (32, 3), (13, 35), (3, 3), (11, 35), (5, 3), (9, 35), (4, 3), (6, 35), (4, 3), (5, 35), (13, 3), (14, 19), (4, 3), (4, 19), (6, 3), (4, 19), (7, 3), (5, 19), (8, 3), (8, 19), (5, 83), (3, 67), (2, 3), (12, 19), (5, 83), (17, 19), (9, 83), (2, 19), (5, 3), (20, 67), (1, 75), (38, 11), (1, 43), (4, 35), (7, 3), (57, 67), (2, 3), (5, 19), (17, 3), (6, 19), (8, 3), (6, 67), (7, 83), (59, 3), (9, 19), (1, 51), (17, 35), (20, 3), (14, 35), (7, 3), (2, 35), (11, 43), (6, 11), (7, 3), (26, 67), (7, 3), (13, 35), (5, 43), (7, 11), (2, 3), (5, 67), (1, 83), (2, 19), (2, 3), (10, 67), (21, 3), (147, 0)] - -d2 = ((2,2),d) - where d = rleDecode [(10, 0), (3, 8), (13, 9), (98, 73), (29, 65), (45, 1), (12, 17), (6, 1), (19, 17), (1, 81), (14, 65), (1, 81), (2, 17), (8, 21), (15, 17), (12, 49), (20, 17), (17, 49), (1, 25), (9, 9), (8, 73), (11, 65), (2, 81), (3, 17), (6, 21), (4, 17), (1, 49), (8, 33), (12, 1), (15, 65), (16, 33), (2, 1), (7, 65), (13, 33), (2, 41), (30, 9), (13, 41), (14, 9), (7, 1), (3, 33), (5, 1), (3, 9), (9, 1), (5, 33), (5, 1), (14, 33), (8, 1), (8, 65), (5, 1), (6, 33), (5, 1), (4, 33), (3, 1), (2, 33), (20, 1), (1, 33), (5, 1), (4, 33), (3, 1), (7, 33), (3, 49), (8, 17), (14, 49), (35, 17), (8, 1), (2, 17), (15, 1), (5, 33), (5, 1), (6, 65), (10, 1), (3, 33), (5, 1), (2, 33), (2, 1), (27, 65), (5, 1), (10, 65), (3, 73), (2, 65), (6, 1), (4, 65), (11, 1), (19, 9), (1, 41), (17, 33), (2, 41), (5, 9), (3, 1), (2, 17), (1, 1), (7, 17), (11, 49), (2, 17), (11, 1), (2, 33), (4, 1), (3, 33), (3, 1), (2, 33), (4, 1), (1, 33), (4, 1), (3, 33), (5, 1), (3, 33), (2, 1), (8, 9), (1, 73), (8, 65), (7, 73), (4, 65), (5, 73), (5, 1), (5, 65), (6, 1), (36, 65), (5, 73), (2, 9), (5, 13), (5, 9), (1, 1), (7, 3), (2, 35), (4, 43), (15, 35), (6, 43), (26, 35), (9, 43), (16, 35), (18, 3), (12, 67), (3, 75), (1, 67), (7, 3), (6, 67), (2, 3), (15, 19), (8, 83), (7, 67), (7, 83), (4, 67), (9, 3), (4, 67), (1, 83), (9, 19), (1, 83), (8, 67), (1, 3), (13, 19), (1, 83), (3, 67), (14, 3), (8, 35), (1, 43), (5, 11), (10, 3), (5, 11), (3, 3), (3, 11), (24, 3), (1, 19), (40, 3), (5, 67), (8, 3), (4, 67), (5, 19), (11, 3), (10, 35), (1, 43), (2, 11), (11, 3), (5, 35), (6, 3), (4, 35), (24, 3), (8, 67), (6, 3), (5, 35), (4, 3), (4, 35), (22, 3), (1, 11), (31, 3), (1, 11), (32, 3), (3, 67), (10, 3), (5, 35), (2, 3), (10, 35), (5, 3), (6, 35), (5, 3), (3, 35), (5, 3), (2, 35), (5, 3), (2, 35), (6, 3), (2, 35), (10, 3), (8, 67), (9, 3), (7, 67), (5, 3), (3, 67), (4, 3), (17, 67), (5, 3), (2, 11), (5, 3), (14, 67), (5, 3), (3, 67), (7, 3), (5, 67), (8, 3), (3, 67), (8, 3), (15, 35), (6, 3), (31, 67), (4, 3), (10, 67), (6, 19), (2, 3), (2, 67), (1, 83), (10, 19), (4, 51), (19, 35), (5, 3), (3, 35), (4, 3), (1, 35), (16, 3), (4, 35), (3, 3), (2, 35), (5, 3), (1, 35), (11, 3), (2, 19), (9, 3), (1, 67), (2, 83), (5, 67), (4, 3), (5, 67), (3, 3), (18, 35), (5, 3), (3, 35), (5, 3), (2, 35), (5, 3), (3, 35), (3, 3), (4, 35), (11, 3), (2, 35), (13, 3), (3, 35), (12, 3), (2, 35), (11, 3), (2, 35), (15, 3), (3, 11), (9, 3), (1, 35), (8, 3), (1, 35), (6, 3), (4, 35), (14, 3), (2, 35), (5, 3), (3, 35), (23, 3), (1, 35), (12, 3), (3, 35), (13, 3), (3, 35), (15, 3), (3, 11), (7, 3), (3, 35), (11, 3), (2, 35), (5, 3), (3, 35), (25, 3), (2, 1), (155, 0)] - -d3 = ((1,2),d) - where d = rleDecode [(13, 0), (2, 8), (16, 9), (77, 73), (25, 65), (5, 1), (3, 9), (15, 1), (5, 65), (15, 1), (4, 65), (13, 1), (5, 65), (10, 1), (5, 17), (2, 1), (6, 65), (1, 1), (16, 17), (2, 1), (9, 65), (1, 1), (5, 17), (4, 21), (13, 17), (16, 49), (29, 17), (4, 49), (2, 33), (2, 41), (6, 9), (4, 73), (11, 65), (1, 1), (16, 17), (5, 1), (3, 17), (7, 1), (6, 33), (5, 1), (3, 33), (4, 1), (8, 65), (10, 1), (4, 33), (7, 1), (2, 33), (1, 1), (8, 65), (26, 33), (3, 41), (31, 9), (13, 41), (21, 9), (11, 41), (19, 9), (4, 1), (5, 33), (8, 1), (48, 65), (1, 97), (2, 33), (4, 1), (13, 33), (1, 49), (24, 17), (12, 49), (41, 17), (6, 1), (5, 9), (11, 73), (3, 9), (1, 73), (8, 65), (1, 73), (32, 9), (9, 41), (15, 9), (6, 41), (3, 33), (4, 1), (13, 65), (1, 97), (4, 33), (28, 49), (19, 33), (11, 49), (5, 33), (16, 49), (4, 17), (5, 81), (13, 65), (7, 73), (16, 33), (9, 49), (2, 33), (2, 1), (1, 65), (1, 1), (4, 17), (1, 49), (6, 33), (1, 1), (4, 9), (5, 73), (66, 65), (2, 73), (13, 9), (6, 41), (13, 9), (6, 13), (4, 9), (6, 1), (3, 9), (10, 1), (21, 65), (16, 1), (4, 65), (6, 1), (3, 33), (10, 1), (3, 33), (10, 1), (3, 33), (6, 1), (1, 33), (13, 1), (1, 33), (10, 1), (4, 33), (11, 1), (4, 33), (5, 1), (1, 33), (12, 1), (3, 33), (10, 1), (2, 33), (11, 1), (5, 33), (8, 1), (3, 33), (8, 1), (2, 33), (8, 1), (3, 33), (15, 1), (2, 33), (5, 1), (3, 33), (5, 1), (45, 33), (20, 49), (27, 17), (42, 81), (6, 65), (6, 73), (26, 65), (8, 73), (27, 9), (35, 41), (11, 33), (4, 41), (18, 33), (2, 41), (2, 33), (1, 1), (4, 65), (8, 69), (6, 65), (7, 67), (14, 83), (23, 19), (18, 83), (4, 67), (11, 3), (4, 35), (1, 3), (7, 67), (5, 3), (2, 67), (16, 3), (4, 35), (4, 3), (8, 67), (5, 3), (11, 35), (5, 3), (2, 35), (3, 51), (7, 35), (13, 3), (5, 67), (5, 3), (3, 67), (13, 3), (5, 67), (5, 3), (3, 67), (5, 3), (27, 67), (1, 83), (8, 19), (25, 51), (25, 3), (5, 35), (18, 3), (1, 67), (6, 83), (3, 67), (22, 3), (32, 35), (5, 3), (5, 35), (1, 3), (7, 35), (7, 3), (4, 11), (5, 3), (4, 35), (5, 3), (3, 35), (3, 3), (4, 19), (16, 3), (1, 19), (14, 3), (8, 67), (8, 3), (4, 19), (1, 3), (15, 67), (2, 83), (11, 67), (2, 75), (1, 11), (6, 3), (1, 11), (16, 3), (5, 67), (5, 3), (3, 35), (5, 3), (3, 11), (4, 3), (5, 11), (11, 3), (9, 19), (8, 3), (2, 35), (18, 43), (22, 35), (12, 43), (20, 35), (27, 51), (1, 19), (7, 3), (2, 19), (7, 3), (13, 67), (5, 75), (5, 67), (1, 75), (5, 11), (5, 43), (2, 35), (7, 3), (4, 67), (12, 83), (10, 67), (5, 83), (23, 67), (3, 75), (24, 67), (2, 99), (3, 35), (7, 39), (1, 35), (2, 43), (5, 3), (11, 35), (1, 43), (1, 11), (5, 3), (5, 35), (3, 3), (6, 35), (4, 3), (11, 35), (5, 3), (3, 35), (5, 3), (10, 67), (38, 3), (2, 35),(121, 3), (1, 2), (49, 0)] - -d4 = ((1,0),d) - where d = rleDecode [(277, 0), (311, 7), (19, 71), (1, 87), (1, 84), (9, 80), (13, 16), (4, 80), (3, 64), (2, 72), (21, 8), (7, 40), (10, 32), (2, 48), (4, 32), (18, 48), (22, 16), (2, 48), (3, 32), (5, 48), (6, 32), (4, 40), (2, 8), (7, 72), (16, 64), (1, 96), (7, 32), (1, 40), (7, 8), (1, 72), (4, 64), (11, 0), (10, 8), (2, 40), (4, 8), (2, 40), (21, 32), (13, 48), (3, 16), (4, 80), (5, 64), (15, 72), (14, 64), (5, 80), (14, 16), (17, 48), (17, 32), (17, 40), (2, 8), (4, 72), (11, 64), (3, 80), (11, 16), (3, 80), (3, 64), (1, 72), (5, 8), (5, 40), (2, 8), (5, 72), (7, 64), (13, 72), (7, 8), (2, 40), (7, 32), (5, 48), (15, 16), (8, 80), (4, 64), (2, 72), (13, 8), (6, 0), (5, 8), (9, 0), (5, 32), (2, 48), (9, 16), (1, 80), (4, 64), (4, 8), (1, 0), (10, 32), (16, 0), (6, 32), (5, 40), (12, 8), (4, 72), (9, 64), (8, 80), (9, 16), (15, 48), (10, 32), (5, 96), (5, 64), (3, 72), (8, 8), (18, 72), (8, 64), (2, 80), (3, 16), (33, 48), (12, 16), (6, 80), (9, 64), (2, 72), (4, 8), (49, 40), (18, 8), (2, 72), (6, 64), (49, 80), (18, 16), (25, 0), (11, 32), (5, 40), (3, 8), (4, 72), (5, 64), (3, 72), (6, 64), (7, 80), (4, 64), (4, 72), (8, 8), (5, 40), (20, 32), (4, 40), (7, 8), (5, 72), (11, 64), (3, 80), (4, 16), (8, 48), (4, 32), (9, 48), (10, 32), (2, 96), (7, 64), (3, 80), (4, 16), (10, 0), (4, 8), (16, 0), (7, 32), (8, 0), (6, 32), (1, 40), (17, 8), (6, 64), (3, 0), (9, 32), (5, 16), (2, 80), (6, 64), (8, 72), (3, 8), (5, 40), (10, 32), (2, 40), (2, 8), (3, 72), (7, 64), (1, 80), (8, 16), (1, 0), (10, 64), (2, 80), (14, 16), (2, 48), (17, 32), (4, 40), (3, 8), (2, 72), (10, 64), (7, 80), (4, 16), (1, 0), (5, 64), (4, 72), (9, 8), (27, 64), (3, 96), (10, 32), (9, 40), (16, 32), (6, 48), (4, 16), (9, 80), (14, 64), (3, 80), (3, 48), (12, 32), (3, 40), (2, 8), (9, 72), (1, 8), (4, 40), (19, 32), (4, 48), (1, 16), (4, 80), (12, 64), (2, 0), (17, 32), (1, 40), (2, 8), (3, 72), (1, 64), (10, 0), (6, 8), (12, 0), (1, 64), (2, 80), (4, 16), (7, 80), (6, 16), (2, 80), (5, 64), (3, 72), (12, 8), (4, 40), (11, 32), (1, 0), (6, 64), (4, 0), (10, 32), (10, 48), (4, 32), (3, 40), (1, 8), (10, 72), (9, 64), (2, 80), (10, 16), (1, 80), (18, 64), (2, 0), (2, 8), (15, 32), (2, 48), (3, 16), (3, 80), (9, 64), (6, 80), (4, 16), (1, 0), (12, 64), (6, 72), (11, 8), (3, 40), (2, 32), (2, 96), (4, 64), (1, 0), (4, 32), (12, 40), (6, 32), (1, 48), (1, 112), (5, 80), (3, 64), (7, 80), (4, 48), (16, 32), (5, 40), (5, 8), (2, 40), (9, 32), (1, 96), (11, 64), (4, 80), (10, 16), (1, 48), (8, 32), (15, 0), (9, 16), (2, 0), (19, 64), (1, 96), (6, 32), (9, 0), (10, 64), (8, 72), (5, 64), (3, 80), (3, 16), (3, 80), (5, 64), (4, 72), (8, 8), (7, 72), (6, 64), (3, 80), (2, 16), (15, 48), (8, 32), (9, 40), (23, 32), (14, 40), (6, 8), (3, 0), (7, 32), (12, 48), (12, 16), (2, 80), (19, 64), (3, 72), (4, 64), (5, 72), (16, 64), (6, 72), (12, 8), (1, 40), (4, 32), (3, 96), (1, 64), (5, 80), (3, 16), (4, 80), (13, 64), (5, 80), (9, 16), (4, 48), (5, 32), (2, 40), (3, 72), (7, 64), (5, 80), (3, 16), (2, 48), (14, 32), (13, 40), (27, 32), (5, 40), (6, 32), (7, 48), (1, 16), (1, 80), (8, 64), (2, 0), (7, 32), (3, 48), (4, 16), (15, 0), (6, 32), (3, 40), (10, 8), (4, 72), (2, 8), (9, 0), (6, 32), (170, 0)] - -d5 = ((2,0),d) - where d = rleDecode [(20,0), (80,8), (13,0), (9,8), (77,0), (5,3), (3,3), (80,6), (2,8), (1,1), (5,2), (20,1), (1,1), (80,4), (11,4), (5,3), (3,1), (31,6), (15,6), (4,0), (40,3), (4,3), (33,0), (50,1), (15,0), (8,3), (17,0), (57,1), (16,6), (1,1), (6,9), (5,1), (3,9), (27,1), (2,3), (2,3), (3,4), (3,8), (1,9), (3,1), (4,9), (10,1), (5,9), (4,1), (3,9), (7,1), (3,9), (5,1), (2,9), (5,1), (11,9), (14,1), (8,6), (1,6), (19,8), (3,1), (28,4), (2,1), (7,8), (4,6), (63,6), (21,6), (2,7), (2,9), (7,4), (10,4), (15,8), (41,4), (5,3), (2,9), (26,6), (12,3), (7,3), (19,3), (3,4), (27,1), (19,4), (13,1), (3,4), (3,3), (26,1), (33,6), (17,7), (5,6), (1,9), (1,15), (8,4), (28,9), (10,4), (2,3), (6,3), (6,3), (2,4), (5,1), (3,8), (38,6), (1,6), (4,3), (7,3), (1,4), (5,4), (9,1), (1,4), (2,4), (5,3), (8,0), (2,1), (6,3), (1,0), (8,3), (14,4), (32,1), (24,0), (12,6), (2,7), (5,8), (7,0), (3,8), (5,0), (5,8), (64,0), (4,3), (6,4), (22,3), (5,4), (5,1), (2,8), (10,6), (20,8), (10,8), (6,8), (2,6), (3,1), (2,3), (5,3), (2,4), (1,1), (15,9), (12,1), (5,4), (2,1), (10,9), (8,4), (2,9), (6,1), (29,3), (19,1), (3,0), (15,3), (1,4), (2,8), (15,0), (12,3), (2,0), (2,6), (17,6), (23,1), (7,3), (38,1), (6,3), (39,1), (7,3), (27,1), (46,6), (1,6), (4,3), (4,1), (3,3), (5,1), (23,3), (3,4), (7,5), (12,4), (10,3), (17,4), (2,3), (3,3), (3,3), (5,1), (3,9), (1,4), (1,9), (10,1), (8,3), (2,1), (2,3), (5,1), (19,6), (21,8), (6,1), (2,1), (3,4), (20,3), (7,4), (4,3), (9,1), (4,3), (3,3), (3,3), (14,1), (23,6), (2,1), (4,1), (1,1), (6,3), (5,1), (7,1), (7,1), (5,6), (1,1), (5,1), (2,1), (7,3), (6,1), (22,9), (18,1), (7,6), (11,1), (3,4), (14,1), (1,1), (4,3), (35,1), (24,9), (6,4), (16,3), (4,4), (12,1), (30,1), (15,9), (3,4), (1,9), (14,1), (17,1), (2,1), (70,1), (5,1), (4,1), (7,3), (10,1), (4,6), (10,7), (30,6), (6,1), (5,6), (5,1), (4,1), (19,1), (24,6), (5,1), (5,6), (3,1), (5,6), (7,1), (3,6), (7,1), (2,6), (9,1), (53,3), (8,3), (6,3), (4,4), (16,9), (3,7), (3,9), (13,1), (3,9), (3,1), (7,3), (16,1), (17,6), (2,6), (5,3), (2,3), (6,1), (19,1), (7,8), (26,1), (6,1), (5,1), (1,3), (1,4), (5,5), (2,3), (19,3), (13,4), (1,4), (5,3), (2,4), (8,9), (2,7), (10,6), (14,1), (9,0), (5,4), (9,0), (5,8), (11,0), (3,8), (17,0), (5,1), (13,1), (32,1), (5,1), (2,6), (11,7), (19,6), (3,7), (39,9), (6,1), (17,3), (2,6), (10,6), (6,6), (5,3), (9,1), (4,3), (6,6), (4,3), (1,6), (5,6), (10,1), (2,6), (1,8), (3,1), (2,1), (7,1), (8,3), (3,1), (15,6), (3,6), (2,3), (3,1), (7,1), (2,4), (27,3), (6,3), (1,3), (11,4), (13,4), (4,4), (10,5), (5,4), (5,4), (5,1), (6,1), (16,0), (10,6), (1,7), (3,6), (4,7), (3,8), (6,0), (3,8), (18,0), (3,8), (3,0), (2,3), (8,3), (10,1), (15,9), (5,1), (14,9), (1,1), (5,3), (5,1), (2,3), (3,1), (2,9), (5,1), (3,9), (5,1), (2,9), (3,1), (10,3), (1,1), (4,3), (6,1), (11,3), (3,6), (4,6), (8,1), (2,1), (5,1), (1,5), (7,4), (21,1), (14,4), (6,5), (4,4), (8,1), (5,1), (7,6), (13,7), (4,9), (29,1), (12,9), (2,1), (2,3), (1,3), (4,4), (1,1), (1,9), (6,1), (3,9), (4,7), (15,6), (4,6), (4,6), (1,8), (2,1), (2,4), (3,3), (1,1), (1,6), (3,1), (12,9), (3,4), (9,3), (1,4), (4,9), (3,1), (5,9), (3,1), (2,9), (14,1), (6,3), (7,1), (5,5), (3,1), (2,9), (11,1), (43,6), (8,1), (1,6), (39,1), (19,3), (24,1), (2,3), (54,1), (19,3), (95,1), (15,3), (2,1), (18,3), (23,4), (6,1), (11,1), (3,8), (15,6), (3,6), (8,7), (1,7), (7,6), (9,6), (7,6), (8,7), (12,9), (3,4), (2,4), (3,3), (5,3), (8,4), (12,3), (2,1), (4,6), (8,6), (5,6), (17,1), (8,3), (3,6), (5,6), (8,1), (4,1), (1,1), (7,3), (3,6), (2,6), (19,1), (4,3), (7,6), (2,8), (1,8), (4,1), (11,1), (9,3), (11,3), (7,1), (3,1), (5,6), (2,1), (9,3), (6,1), (4,1), (2,1), (2,3), (2,4), (2,3), (8,1), (4,6), (2,1), (4,3), (4,6), (2,3), (10,1), (4,9), (9,1), (24,3), (2,4), (15,3), (4,4), (1,4), (10,1), (7,9), (2,3), (6,3), (13,1), (4,3), (3,6), (5,6), (2,8), (8,1), (7,8), (10,1), (1,1), (9,3), (5,1), (3,1), (11,1), (8,3), (4,1), (8,7), (5,6), (6,1), (4,1), (4,8), (10,6), (8,6), (11,6), (1,9), (29,3), (1,4), (2,4), (5,1), (1,7), (4,7), (10,6), (17,1), (33,3), (18,4), (3,9), (2,1), (3,4), (5,3), (8,1), (8,6), (9,6), (2,3), (19,1), (1,3), (8,6), (3,3), (2,1), (8,8), (2,1), (10,1), (9,3), (3,1), (7,1), (6,1), (8,3), (2,6), (5,6), (5,1), (5,3), (6,6), (2,6), (5,1), (2,6), (1,7), (2,9), (5,1), (5,9), (2,1), (4,6), (6,7), (6,6), (3,1), (1,3), (3,6), (6,3), (4,1), (4,3), (1,4), (1,1), (9,1), (3,1), (2,1), (1,3), (7,4), (7,1), (1,4), (2,3), (4,3), (2,5), (12,4), (5,3), (10,4), (5,3), (7,3), (1,3), (5,4), (2,9), (7,7), (7,6), (3,7), (10,9), (3,1), (5,3), (11,1), (4,9), (11,1), (3,9), (2,1), (3,3), (3,1), (2,3), (11,1), (8,3), (2,1), (11,1), (42,6), (14,1), (6,5), (10,1), (11,3), (33,1), (13,3), (7,1), (4,3), (13,3), (7,0), (5,3), (7,0), (1,3), (21,0), (3,3), (5,0), (3,3), (16,0), (18,1), (11,0), (7,3), (5,0), (1,3), (2,0), (6,1), (2,3), (6,2), (43,0), (3,3), (31,0), (3,3), (10,0), (11,3), (10,0), (15,1), (5,3), (2,6), (5,3), (5,6), (10,6), (2,6), (6,3), (3,6), (16,6), (6,8), (10,8), (7,1), (5,4), (10,5), (10,4), (13,5), (7,4), (12,1), (4,3), (3,3), (1,3), (6,1), (2,1), (5,8), (11,6), (5,1), (14,6), (5,7), (7,7), (3,7), (34,8), (5,4), (46,3), (19,4), (5,1), (11,8), (7,8), (3,8), (34,6), (15,7), (4,6), (9,8), (17,1), (3,8), (13,6), (11,7), (7,8), (6,4), (5,3), (51,4), (25,3), (24,4), (8,4), (3,1), (17,8), (11,6), (42,7), (10,6), (17,8), (4,1), (21,4), (10,1), (12,8), (11,6), (1,6), (6,7), (2,8), (2,0), (4,3), (2,0), (5,1), (10,0), (1,6), (16,7), (8,8), (26,4), (21,3), (4,4), (11,4), (8,4), (7,1), (5,8), (8,6), (5,6), (3,7), (4,6), (2,8), (10,8), (2,6), (3,7), (4,8), (3,7), (14,6), (2,8), (7,1), (1,8), (3,6), (7,0), (7,3), (1,4), (5,8), (10,7), (9,8), (25,4), (43,3), (13,4), (2,4), (9,1), (4,1), (11,8), (7,6), (20,7), (2,7), (11,6), (10,6), (16,8), (12,1), (3,8), (6,6), (4,7), (3,8), (2,0), (16,3), (2,4), (8,1), (8,4), (35,3), (7,4), (1,4), (9,9), (15,8), (9,7), (2,7), (5,6), (3,8), (25,8), (13,6), (4,7), (4,6), (12,7), (3,8), (4,0), (5,1), (5,0), (18,1), (3,4), (2,3), (13,0), (9,8), (8,0), (3,1), (1,8), (11,6), (2,0), (3,1), (15,0), (3,3), (4,4), (3,0), (11,6), (4,0), (5,1), (8,0), (4,1), (2,4), (42,3), (2,4), (6,4), (1,9), (20,8), (7,9), (3,7), (1,7), (3,6), (17,8), (4,6), (6,7), (2,6), (24,8), (7,6), (2,0), (4,8), (11,0), (10,1), (1,4), (27,3), (44,4), (3,8), (2,7), (5,6), (1,0), (6,1), (6,8), (1,1), (10,0), (7,4), (21,0), (4,3), (3,4), (13,1), (12,8), (4,6), (3,7), (2,8), (8,4), (8,8), (6,4), (2,3), (57,0), (19,8), (6,0), (3,8), (22,0), (40,6), (10,3), (24,4), (19,1), (2,4), (2,1), (29,0), (4,1), (9,0), (13,6), (5,7), (18,6), (2,0), (3,1), (7,0), (11,3), (29,4), (10,8), (19,4), (2,3), (8,3), (2,3), (6,0), (10,1), (6,8), (20,1), (12,8), (5,6), (10,0), (5,1), (7,0), (6,3), (2,4), (2,4), (6,9), (25,8), (40,0), (10,8), (5,0), (15,1), (15,0), (7,3), (5,4), (14,1), (4,0), (16,6), (1,8), (8,1), (18,4), (4,3), (4,4), (30,8), (1,9), (8,7), (5,7), (4,8), (3,0), (5,6), (1,0), (4,1), (3,0), (3,3), (2,4), (6,3), (6,4), (15,0), (13,6), (6,8), (6,1), (5,0), (22,1), (6,4), (6,1), (9,0), (10,1), (2,0), (5,3), (3,4), (3,8), (7,7), (15,8), (5,0), (2,3), (3,4), (2,3), (8,4), (12,8), (2,7), (4,6), (4,7), (2,6), (2,0), (5,8), (27,0), (11,1), (3,0), (9,1), (4,4), (9,1), (17,8), (16,1), (10,0), (3,3), (2,0), (7,1), (3,3), (2,3), (6,4), (28,8), (6,1), (3,8), (7,4), (5,4), (1,3), (4,4), (1,4), (3,1), (7,8), (23,1), (16,8), (10,6), (3,1), (2,3), (5,4), (5,4), (23,8), (20,7), (6,6), (2,8), (5,4), (27,4), (9,1), (6,8), (12,1), (1,8), (5,6), (5,7), (13,6), (2,0), (5,1), (8,0), (3,6), (51,0), (10,3), (10,4), (7,4), (15,9), (3,4), (10,9), (6,7), (2,9), (4,4), (3,9), (2,4), (8,3), (2,3), (4,5), (4,1), (6,1), (3,1), (1,3), (2,4), (6,1), (3,8), (17,1), (31,1), (2,0), (5,3), (3,0), (5,8), (3,0), (4,8), (1,9), (2,1), (2,3), (2,6), (3,7), (4,1), (2,9), (3,8), (1,7), (15,6), (7,8), (2,8), (8,5), (2,4), (13,4), (4,3), (5,2), (1,3), (10,3), (2,9), (8,1), (3,7), (2,6), (4,3), (3,1), (2,8), (8,0), (5,3), (3,0), (19,6), (2,6), (11,1), (10,0), (2,6), (6,0), (1,1), (8,3), (2,3), (13,3), (2,4), (11,8), (5,0), (2,8), (15,0), (1,8), (1,7), (3,6), (10,6), (10,1), (2,3), (5,1), (4,1), (1,1), (8,3), (5,1), (3,0), (3,1), (5,3), (4,1), (1,5), (12,3), (6,4), (18,9), (5,1), (3,9), (8,1), (2,3), (6,6), (10,6), (4,1), (17,3), (19,1), (2,6), (8,6), (20,6), (12,3), (14,1), (28,3), (1,3), (7,3), (2,1), (3,3), (10,1), (9,3), (6,1), (3,3), (6,1), (4,3), (9,1), (8,3), (2,4), (1,1), (21,1), (1,3), (6,6), (3,3), (3,1), (4,9), (22,1), (4,3), (6,6), (10,6), (1,8), (1,8), (7,1), (8,1), (7,1), (3,3), (5,1), (2,1), (1,1), (5,3), (4,1), (6,6), (2,1), (3,1), (18,1), (2,1), (4,8), (4,6), (4,6), (1,6), (3,1), (2,9), (3,8), (2,4), (23,3), (12,0), (6,8), (3,7), (1,7), (1,6), (4,8), (6,1), (1,1), (9,1), (6,0), (1,1), (2,3), (4,1), (7,3), (2,1), (22,0), (1,6), (4,7), (19,8), (1,4), (6,3), (4,4), (4,3), (3,4), (6,8), (1,4), (5,8), (1,2), (3,1), (6,8), (11,1), (1,8), (12,1), (15,0), (3,1), (101,0), (16,1), (3,3), (4,3), (3,4), (3,8), (2,9), (7,1), (5,7), (3,1), (5,3), (3,1), (12,3), (2,3), (1,5), (14,1), (2,8), (5,6), (5,3), (6,6), (4,3), (8,6), (10,3), (1,6), (7,3), (5,1), (2,3), (6,6), (5,6), (5,6), (8,6), (14,1), (20,3), (12,1), (4,3), (5,1), (3,3), (6,1), (2,3), (3,1), (8,3), (2,1), (2,6), (6,7), (12,9), (5,1), (3,9), (4,1), (3,9), (3,1), (4,9), (4,1), (9,3), (15,1), (15,3), (121,1), (13,3), (4,4), (30,1), (13,3), (16,1), (3,1), (51,1), (10,3), (1,1), (2,1), (9,1), (4,1), (15,1), (8,3), (37,1), (10,3), (10,1), (5,9), (3,1), (2,6), (5,6), (5,3), (6,1), (10,6), (5,6), (1,3), (4,1), (2,6), (7,3), (4,1), (11,6), (1,7), (2,9), (10,1), (8,9), (31,4), (9,3), (4,1), (2,9), (4,1), (4,9), (13,1), (8,3), (3,3), (12,3), (5,1), (3,3), (18,1), (1,6), (4,8), (4,1), (9,1), (3,1), (20,8), (7,8), (2,8), (5,6), (2,7), (1,9), (13,1), (6,6), (4,7), (10,9), (5,1), (5,4), (6,4), (3,9), (4,1), (5,9), (5,1), (3,9), (4,1), (1,9), (12,1), (8,3), (3,1), (11,3), (7,4), (18,1), (5,8), (9,6), (2,6), (2,7), (7,1), (5,9), (4,7), (2,9), (11,1), (9,6), (1,7), (8,9), (2,1), (6,3), (30,3), (2,4), (7,5), (1,4), (3,1), (6,1), (9,6), (4,7), (7,6), (8,8), (2,1), (3,1), (2,8), (5,6), (1,6), (8,1), (21,6), (11,1), (148,0)] - -d6 = ((5,0),d) - where d = rleDecode [(16, 0), (7, 8), (12, 9), (71, 8), (7, 1), (3, 17), (25, 1), (6, 65), (1, 1), (60, 33), (90, 65), (52, 64), (2, 96), (3, 36), (9, 32), (5, 0), (1, 8), (37, 0), (2, 1), (2, 65), (5, 1), (2, 33), (3, 1), (2, 33), (4, 1), (1, 33), (3, 9), (1, 1), (1, 9), (4, 1), (4, 65), (4, 81), (22, 65), (21, 64), (1, 68), (2, 4), (1, 36), (5, 32), (8, 0), (4, 32), (2, 0), (13, 16), (66, 48), (2, 32), (33, 33), (2, 41), (1, 72), (17, 64), (3, 80), (31, 64), (3, 68), (1, 64), (2, 72), (3, 8), (1, 9), (11, 33), (2, 9), (2, 1), (3, 33), (6, 1), (1, 33), (1, 41), (4, 9), (8, 1), (3, 9), (1, 1), (3, 9), (3, 1), (1, 9), (3, 1), (1, 9), (4, 1), (5, 33), (2, 1), (2, 17), (4, 1), (2, 17), (13, 1), (6, 65), (1, 73), (5, 9), (5, 33), (2, 1), (2, 33), (1, 41), (1, 9), (1, 41), (4, 33), (2, 41), (3, 9), (1, 1), (1, 9), (1, 1), (6, 0), (1, 32), (4, 33), (4, 8), (2, 0), (1, 32), (1, 33), (2, 1), (1, 0), (2, 32), (1, 16), (1, 48), (11, 16), (7, 80), (2, 16), (2, 1), (8, 0), (5, 64), (9, 72), (18, 64), (17, 16), (1, 0), (8, 1), (2, 17), (20, 1), (25, 33), (1, 40), (20, 8), (31, 72), (1, 65), (10, 1), (34, 33), (1, 1), (9, 17), (11, 16), (10, 80), (2, 64), (4, 80), (2, 81), (4, 80), (2, 81), (6, 80), (7, 64), (6, 80), (1, 113), (2, 33), (2, 32), (22, 33), (2, 1), (4, 65), (7, 73), (2, 72), (4, 8), (2, 40), (4, 41), (1, 40), (8, 32), (9, 40), (2, 41), (1, 9), (19, 8), (3, 9), (3, 1), (2, 17), (1, 81), (3, 65), (7, 81), (3, 80), (26, 16), (3, 80), (1, 64), (2, 65), (1, 64), (3, 72), (2, 73), (1, 65), (1, 64), (1, 80), (4, 81), (1, 80), (1, 81), (3, 17), (4, 16), (1, 65), (2, 1), (2, 0), (14, 64), (3, 72), (25, 8), (14, 40), (2, 41), (2, 40), (2, 41), (2, 40), (3, 41), (1, 33), (14, 32), (4, 0), (4, 16), (5, 0), (2, 8), (7, 0), (3, 64), (1, 72), (3, 8), (2, 72), (8, 64), (5, 80), (6, 64), (4, 0), (4, 36), (1, 8), (3, 0), (11, 1), (3, 33), (3, 49), (3, 17), (2, 81), (25, 17), (13, 16), (1, 17), (13, 1), (2, 33), (5, 32), (1, 40), (2, 8), (1, 0), (30, 8), (1, 9), (4, 41), (4, 33), (4, 1), (1, 9), (4, 1), (1, 9), (2, 1), (2, 9), (3, 1), (2, 9), (1, 1), (1, 9), (5, 1), (2, 9), (6, 65), (1, 81), (8, 65), (5, 1), (3, 33), (1, 1), (3, 65), (5, 1), (7, 17), (1, 49), (4, 48), (2, 16), (12, 17), (5, 81), (9, 17), (3, 81), (5, 65), (3, 81), (3, 17), (10, 1), (9, 65), (8, 1), (19, 33), (4, 41), (20, 9), (5, 73), (3, 77), (1, 13), (13, 9), (4, 1), (1, 9), (4, 1), (1, 9), (7, 1), (4, 3), (10, 1), (10, 65), (38, 1), (2, 65), (69, 1), (12, 65), (4, 67), (1, 3), (62, 1), (6, 3), (20, 1), (7, 33), (5, 1), (9, 33), (1, 1), (8, 65), (10, 1), (3, 3), (1, 67), (1, 65), (4, 1), (2, 65), (7, 1), (3, 3), (9, 1), (14, 33), (1, 35), (2, 3), (12, 1), (2, 33), (4, 1), (4, 3), (4, 1), (3, 33), (2, 1), (4, 3), (2, 1), (7, 17), (1, 49), (15, 33), (3, 41), (5, 9), (1, 1), (2, 33), (5, 35), (1, 33), (7, 1), (1, 33), (8, 1), (5, 3), (3, 1), (8, 65), (6, 1), (6, 3), (1, 67), (4, 65), (3, 1), (1, 33), (5, 49), (2, 17), (4, 81), (1, 65), (1, 67), (3, 3), (3, 1), (3, 65), (2, 81), (2, 17), (1, 81), (2, 17), (3, 81), (3, 1), (13, 65), (4, 81), (12, 17), (4, 1), (3, 17), (2, 1), (5, 33), (3, 1), (12, 9), (4, 1), (6, 9), (9, 1), (3, 3), (31, 1), (4, 33), (7, 41), (20, 33), (3, 35), (2, 3), (3, 9), (2, 1), (1, 9), (7, 73), (15, 65), (1, 81), (19, 17), (5, 1), (5, 17), (2, 1), (4, 17), (2, 49), (4, 51), (1, 19), (2, 17), (16, 1), (1, 33), (19, 1), (30, 9), (32, 1), (20, 17),(170, 1), (4, 17), (3, 1), (3, 65), (1, 73), (4, 9), (8, 41), (6, 1), (2, 9), (6, 1), (1, 65), (6, 81), (14, 17), (13, 1), (9, 65), (7, 73), (3, 1), (1, 65), (13, 73), (9, 65), (4, 1), (6, 17), (4, 65), (10, 1), (2, 9), (3, 1), (4, 9), (9, 1), (2, 9), (15, 1), (1, 17), (7, 1), (3, 33), (2, 49), (27, 33), (6, 35), (3, 41), (21, 9), (1, 41), (1, 35), (3, 51), (2, 49), (5, 17), (15, 49), (3, 51), (1, 49), (1, 17), (12, 1), (7, 33), (1, 1), (2, 17), (18, 1), (13, 65), (30, 73), (1, 65), (73, 1), (2, 9), (47, 1), (31, 17), (2, 1), (2, 33), (5, 49), (1, 33), (4, 1), (3, 3), (1, 67), (2, 65), (1, 1), (3, 9), (2, 73), (9, 65), (3, 1), (20, 65), (1, 73), (4, 9), (1, 11), (3, 43), (1, 35), (4, 33), (15, 9), (2, 41), (2, 43), (1, 35), (8, 33), (2, 41), (6, 9), (3, 1), (1, 9), (1, 1), (9, 3), (10, 35), (1, 3), (1, 1), (5, 33), (2, 49), (3, 1), (2, 17), (1, 19), (3, 83), (7, 81), (4, 65), (6, 1), (1, 67), (3, 3), (14, 65), (1, 17), (1, 19), (3, 3), (4, 1), (5, 65), (1, 81), (2, 17), (6, 1), (7, 33), (1, 41), (1, 9), (11, 11), (4, 3), (1, 11), (2, 3), (1, 11), (19, 3), (14, 35), (7, 33), (2, 49), (13, 33), (3, 35), (2, 3), (2, 1), (1, 9), (5, 65), (8, 1), (2, 65), (1, 67), (3, 3), (3, 67), (18, 65), (1, 1), (3, 3), (2, 35), (1, 3), (2, 1), (8, 33), (4, 49), (1, 17), (4, 1), (2, 33), (1, 1), (2, 33), (5, 1), (2, 33), (7, 1), (8, 17), (6, 49), (1, 17), (3, 19), (2, 3), (1, 35), (1, 3), (1, 1), (9, 65), (13, 81), (1, 19), (1, 3), (2, 35), (1, 33), (7, 41), (12, 33), (8, 49), (8, 17), (1, 19), (4, 3), (3, 1), (4, 3), (2, 1), (5, 9), (1, 1), (4, 33), (3, 17), (1, 81), (3, 65), (2, 1), (2, 9), (2, 1), (6, 65), (2, 73), (10, 65), (17, 73), (1, 75), (1, 11), (7, 3), (1, 65), (3, 73), (1, 75), (2, 11), (2, 3), (2, 33), (3, 1), (2, 65), (1, 73), (1, 9), (1, 73), (3, 65), (1, 33), (4, 35), (5, 33), (4, 41), (3, 9), (1, 33), (3, 35), (4, 3), (2, 11), (1, 3), (1, 1), (2, 33), (1, 35), (4, 3), (6, 35), (2, 33), (1, 49), (5, 1), (2, 17), (2, 19), (5, 83), (3, 81), (5, 65), (6, 81), (1, 65), (1, 1), (1, 3), (2, 19), (2, 3), (4, 1), (1, 9), (1, 11), (2, 75), (2, 11), (1, 3), (3, 1), (12, 33), (4, 35), (1, 43), (10, 9), (2, 1), (1, 65), (3, 73), (2, 65), (3, 1), (12, 65), (3, 73), (3, 1), (1, 9), (1, 1), (1, 9), (9, 1), (5, 33), (1, 5), (1, 21), (2, 5), (2, 1), (2, 65), (9, 67), (2, 81), (4, 17), (6, 81), (10, 17), (3, 3), (2, 1), (8, 33), (1, 41), (10, 9), (12, 73), (9, 65), (1, 73), (3, 1), (2, 9), (8, 1), (3, 65), (4, 1), (2, 65), (7, 1), (1, 65), (4, 1), (4, 33), (4, 1), (6, 33), (3, 1), (2, 33), (37, 1), (2, 33), (39, 1), (1, 33), (16, 1), (2, 33), (3, 3), (13, 1), (2, 3), (2, 35), (10, 1), (5, 35), (5, 33), (8, 49), (5, 17), (4, 49), (4, 17), (1, 1), (1, 3), (4, 19), (14, 17), (2, 19), (4, 3), (6, 1), (4, 3), (2, 1), (3, 33), (11, 1), (1, 9), (3, 1), (2, 9), (3, 1), (26, 65), (7, 73), (5, 75), (2, 9), (5, 1), (2, 9), (3, 1), (13, 9), (1, 41), (1, 43), (1, 11), (3, 3), (2, 11), (2, 3), (1, 11), (2, 3), (1, 11), (3, 3), (1, 11), (6, 3), (1, 11), (7, 3), (1, 11), (5, 3), (21, 35), (1, 1), (10, 65), (4, 81), (13, 17), (13, 49), (6, 51), (4, 49), (1, 33), (26, 1), (6, 3), (7, 1), (2, 9), (9, 73), (1, 65), (6, 1), (2, 65), (1, 9), (9, 1), (6, 3), (15, 1), (16, 33), (1, 97), (17, 65), (3, 1), (9, 3), (3, 1), (2, 65), (9, 1), (2, 65), (4, 1), (1, 65), (1, 67), (6, 3), (7, 1), (3, 65), (1, 1), (6, 3), (4, 1), (1, 65), (5, 1), (1, 67), (3, 3), (4, 1), (4, 3), (6, 1), (5, 33), (1, 49), (1, 17), (7, 1), (5, 3), (5, 1), (2, 65), (2, 1), (1, 3), (1, 35), (1, 33), (1, 49), (1, 17), (6, 1), (1, 65), (1, 67), (3, 3), (8, 1), (7, 33), (14, 1), (4, 3), (12, 1), (1, 65), (6, 1), (4, 65), (5, 1), (1, 65), (2, 1), (7, 65), (5, 1), (1, 65), (2, 1), (7, 65), (4, 1), (1, 9), (2, 1), (21, 33), (1, 1), (13, 65), (5, 67), (1, 75), (1, 73), (3, 1), (12, 17), (4, 1), (2, 17), (1, 1), (6, 65), (2, 1), (1, 33), (6, 49), (22, 33), (2, 1), (3, 33), (1, 1), (2, 33), (9, 1), (1, 9), (5, 1), (4, 3), (2, 33), (14, 1), (3, 3), (3, 1), (4, 65), (3, 1), (2, 65), (2, 1), (15, 65), (3, 73), (4, 1), (2, 65), (9, 1), (2, 65), (3, 1), (2, 17), (2, 1), (3, 65), (14, 1), (1, 9), (5, 1), (3, 3), (5, 1), (1, 33), (5, 1), (4, 65), (8, 1), (2, 65), (1, 1), (1, 65), (3, 1), (3, 65), (12, 1), (4, 3), (1, 1), (2, 33), (7, 1), (1, 17), (5, 1), (1, 33), (8, 1), (1, 65), (3, 1), (1, 65), (2, 1), (2, 65), (5, 1), (2, 9), (7, 1), (4, 33), (2, 1), (3, 33), (5, 49), (4, 33), (3, 35), (4, 33), (5, 1), (2, 65), (2, 1), (4, 65), (1, 1), (2, 65), (2, 1), (1, 3), (2, 67), (2, 3), (1, 65), (4, 1), (2, 65), (4, 1), (1, 9), (9, 1), (1, 9), (3, 1), (1, 9), (2, 1), (3, 3), (5, 1), (5, 3), (1, 67), (4, 1), (5, 3), (11, 1), (4, 3), (2, 1), (7, 65), (1, 1), (8, 33), (1, 43), (4, 3), (3, 1), (2, 33), (3, 1), (1, 33), (4, 1), (1, 33), (2, 1), (2, 65), (9, 1), (1, 65), (13, 1), (3, 33), (1, 1), (16, 33), (5, 35), (3, 49), (1, 33), (11, 1), (3, 33), (3, 49), (4, 33), (4, 1), (4, 65), (7, 1), (3, 3), (12, 1), (1, 65), (2, 73), (2, 1), (5, 9), (7, 1), (1, 65), (7, 1), (2, 65), (6, 1), (1, 17), (10, 1), (2, 17), (4, 1), (2, 19), (2, 3), (3, 33), (2, 35), (7, 33), (4, 3), (4, 1), (2, 33), (1, 35), (4, 3), (24, 65), (2, 67), (3, 3), (10, 1), (4, 3), (2, 35), (5, 33), (1, 1), (5, 33), (2, 41), (15, 33), (1, 49), (3, 51), (5, 33), (3, 1), (2, 33), (8, 1), (11, 33), (1, 41), (1, 9), (3, 1), (6, 73), (1, 65), (4, 1), (3, 65), (3, 1), (2, 65), (5, 1), (4, 3), (1, 65), (2, 1), (1, 65), (5, 1), (2, 65), (31, 1), (1, 33), (1, 35), (3, 3), (10, 1), (1, 17), (7, 1), (2, 33), (3, 3), (9, 1), (1, 17), (3, 3), (4, 17), (4, 1), (6, 65), (5, 67), (12, 65), (15, 73), (6, 65), (4, 1), (1, 3), (1, 67), (4, 3), (1, 1), (4, 65), (2, 9), (2, 1), (1, 9), (1, 73), (1, 75), (1, 11), (2, 3), (1, 11), (1, 9), (2, 1), (1, 9), (3, 11), (3, 9), (2, 11), (4, 1), (3, 3), (1, 1), (1, 33), (1, 9), (3, 11), (3, 41), (2, 43), (2, 1), (3, 9), (2, 11), (2, 9), (2, 1), (2, 11), (1, 3), (3, 1), (4, 35), (3, 33), (2, 1), (2, 3), (1, 1), (13, 65), (1, 1), (6, 65), (11, 1), (164, 0)] - -dieIn5 = ((5,1),d) - where d = rleDecode [(50,8), (5,9), (19,8), (3,9), (1,8), (1,0), (11,32), (2,48), (1,16), (2,0), (4,72), (16,64), (13,68), (1,76), (6,77), (1,73), (3,9), (29,1), (8,33), (3,49), (1,33), (2,17), (6,1), (4,65), (1,80), (57,16), (26,17), (5,49), (4,33), (2,49), (13,33), (9,1), (17,33), (4,1), (2,9), (4,1), (20,65), (2,73), (26,65), (3,81), (5,65), (1,97), (1,33), (3,37), (1,33), (1,1), (2,65), (2,73), (3,9), (2,11), (1,9), (2,11), (30,9), (10,41), (14,9), (22,41), (4,9), (4,41), (6,33), (3,1), (4,9), (10,1), (3,65), (8,1), (2,33), (7,49), (5,33), (1,41), (2,9), (12,1), (5,9), (7,1), (5,65), (3,81), (51,65), (14,1), (5,3), (24,1), (45,17), (7,1), (2,17), (5,1), (4,3), (4,1), (3,33), (3,1), (1,33), (7,1), (3,33), (2,1), (2,33), (3,1), (2,33), (5,35), (4,33), (4,1), (5,3), (4,1), (14,33), (7,41), (13,33), (9,41), (5,33), (4,41), (6,33), (1,41), (5,43), (3,41), (1,33), (4,41), (6,33), (14,41), (4,9), (13,41), (1,35), (3,43), (4,3), (3,35), (2,3), (2,35), (1,51), (1,19), (4,3), (1,19), (5,3), (1,19), (8,3), (5,19), (2,3), (3,1), (8,17), (3,81), (19,65), (1,73), (3,65), (9,73), (2,65), (5,73), (3,65), (5,67), (1,65), (1,81), (3,73), (7,65), (7,81), (4,17), (1,3), (2,17), (1,1), (5,17), (1,19), (4,3), (3,17), (1,49), (5,33), (5,41), (6,33), (1,1), (4,17), (3,1), (1,17), (5,19), (5,17), (1,1), (2,65), (1,67), (3,3), (1,19), (2,17), (3,1), (3,17), (4,1), (2,17), (2,1), (5,19), (1,17), (1,1), (1,33), (8,41), (10,33), (1,3), (2,19), (2,83), (5,81), (7,1), (3,17), (3,19), (2,3), (7,1), (3,65), (2,1), (1,17), (6,1), (2,9), (3,1), (1,33), (1,49), (8,17), (3,81), (2,83), (4,3), (8,1), (11,9), (6,1), (2,65), (2,73), (2,65), (5,73), (1,9), (3,1), (8,9), (1,41), (1,43), (1,35), (4,43), (3,33), (5,41), (2,9), (4,1), (4,9), (1,73), (9,65), (5,73), (10,65), (21,81), (13,65), (20,81), (3,17), (2,1), (13,17), (1,1), (13,33), (8,41), (13,9), (3,1), (2,9), (1,41), (2,33), (14,32), (18,0), (5,48), (22,32), (10,40), (17,41), (2,40), (5,41), (14,33), (3,41), (1,9), (2,1), (4,17), (4,81), (14,65), (7,81), (4,65), (1,81), (4,85), (19,81), (14,17), (9,1), (4,9), (1,1), (1,81), (1,80), (26,64), (12,72), (12,64), (7,72), (1,8), (7,0), (1,8), (5,0), (1,8), (3,0), (3,8), (2,0), (1,8), (6,0), (57,32), (10,48), (1,49), (1,33), (2,32), (3,41), (5,40), (3,8), (5,9), (2,8), (2,41), (1,33), (1,32), (2,33), (2,41), (3,1), (1,16), (2,49), (1,48), (1,49), (1,17), (3,16), (1,17), (2,16), (5,0), (7,32), (3,0), (2,16), (10,0), (3,8), (6,0), (43,64), (11,72), (2,64), (7,0), (3,64), (4,80), (6,64), (30,0), (6,64), (2,0), (3,16), (8,0), (3,32), (4,0), (6,32), (2,48), (12,32), (22,40), (2,41), (3,40), (1,41), (1,40), (2,41), (2,40), (1,41), (1,40), (1,32), (1,33), (1,32), (3,41), (1,40), (2,41), (1,40), (2,0), (12,16), (1,80), (2,64), (3,72), (15,64), (1,96), (10,32), (11,48), (4,16), (15,48), (9,32), (8,0), (1,8), (2,64), (1,0), (4,16), (6,48), (2,16), (1,17), (5,16), (2,17), (2,0), (2,1), (1,17), (1,1), (4,0), (3,16), (3,0), (2,16), (4,0), (3,8), (2,72), (11,8), (10,72), (4,74), (4,72), (1,8), (9,9), (15,73), (7,75), (7,73), (1,65), (11,1), (4,33), (1,1), (2,3), (3,35), (3,1), (1,33), (2,35), (4,3), (2,33), (1,17), (8,1), (21,65), (5,67), (7,1), (2,17), (17,49), (9,33), (1,49), (1,51), (3,35), (2,33), (2,41), (4,9), (2,41), (10,9), (1,1), (1,33), (5,35), (4,33), (2,1), (1,3), (4,35), (2,33), (5,1), (3,65), (1,1), (6,3), (6,17), (9,49), (1,33), (1,1), (9,65), (5,81), (5,17), (2,19), (2,67), (1,83), (7,81), (2,65), (1,1), (9,17), (1,81), (4,65), (3,19), (5,17), (5,49), (10,17), (1,49), (1,33), (2,1), (1,33), (11,1), (1,65), (7,1), (1,9), (2,1), (3,9), (3,1), (2,33), (4,49), (9,33), (2,1), (25,65), (8,73), (20,9), (1,1), (4,35), (4,33), (2,41), (18,9), (1,41), (8,33), (2,9), (1,1), (1,33), (2,35), (1,3), (2,1), (2,33), (3,1), (6,33), (6,49), (1,17), (5,65), (1,81), (4,17), (2,81), (1,65), (3,1), (5,17), (6,49), (1,17), (5,65), (5,73), (6,65), (1,73), (10,9), (22,73), (7,65), (6,1), (1,9), (5,1), (2,17), (14,81), (17,17), (3,81), (3,65), (4,73), (3,77), (2,70), (8,81), (1,83), (3,19), (9,17), (7,1), (4,65), (5,1), (3,33), (1,1), (15,9), (5,41), (3,9), (3,41), (1,43), (3,35), (6,33), (2,41), (19,9), (2,1), (23,33), (8,1), (2,17), (4,1), (1,33), (1,1), (2,9), (2,1), (1,9), (1,1), (5,65), (4,73), (3,65), (7,1), (9,65), (2,1), (7,65), (30,1), (145,0)] - -shieldAttack = ((1,0),d) - where d = rleDecode [(30,0), (31,1), (5,33), (21,1), (4,17), (50,1), (5,5), (118,1), (7,17), (63,1), (37,65), (5,1), (10,33), (5,37), (5,33), (20,1), (3,33), (15,1), (3,33), (14,1), (3,33), (7,1), (5,17), (15,1), (15,65), (7,1), (9,33), (9,1), (3,5), (52,1), (3,33), (10,1), (4,33), (11,1), (2,33), (35,1), (5,17), (5,1), (3,17), (23,1), (9,65), (4,1), (4,17), (9,1), (6,33), (12,9), (6,41), (2,9), (6,1), (3,9), (5,1), (4,9), (4,1), (5,9), (24,1), (4,9), (15,1), (22,17), (4,1), (10,17), (16,1), (8,33), (9,41), (3,9), (3,41), (2,33), (3,1), (2,9), (14,1), (8,65), (1,81), (4,17), (16,1), (10,9), (7,41), (1,9), (6,1), (3,9), (15,1), (4,5), (1,21), (33,17), (19,1), (3,65), (9,1), (2,65), (16,1), (4,9), (10,1), (7,9), (2,1), (7,9), (8,1), (5,33), (3,41), (2,9), (6,1), (4,5), (12,1), (6,3), (10,9), (5,41), (2,9), (11,1), (5,65), (3,81), (1,17), (6,1), (7,17), (1,1), (6,17), (1,19), (4,3), (8,1), (3,17), (5,1), (5,17), (5,1), (9,17), (30,1), (3,65), (10,1), (12,65), (3,1), (2,17), (7,1), (3,17), (16,1), (5,65), (12,1), (3,33), (2,37), (2,5), (6,1), (2,33), (9,41), (4,33), (1,1), (6,9), (3,1), (4,33), (10,41), (19,9), (8,41), (4,9), (17,1), (5,3), (7,1), (8,65), (5,73), (5,1), (7,17), (14,49), (2,1), (12,65), (8,81), (5,83), (1,19), (1,83), (6,81), (10,17), (3,1), (8,33), (2,41), (21,9), (6,73), (8,9), (3,41), (1,9), (12,65), (10,81), (5,17), (3,49), (2,19), (4,3), (3,1), (10,33), (3,49), (17,17), (1,1), (4,65), (4,1), (4,3), (3,35), (4,33), (6,1), (11,17), (5,1), (6,65), (7,1), (5,3), (3,75), (4,73), (1,9), (8,1), (7,9), (3,11), (1,3), (3,35), (13,33), (3,49), (9,17), (2,3), (4,35), (3,33), (11,1), (15,9), (1,1), (8,65), (2,67), (4,83), (10,17), (5,1), (10,65), (8,17), (10,1), (3,17), (5,1), (5,33), (3,1), (13,9), (9,11), (10,1), (17,65), (2,73), (8,9), (7,33), (20,1), (6,65), (34,1), (5,3), (26,1), (11,65), (8,1), (5,3), (19,1), (7,33), (12,1), (10,33), (7,3), (30,1), (8,33), (11,1), (7,3), (4,1), (12,33), (30,1), (4,35), (2,3), (18,1), (25,65), (29,1), (10,17), (12,1), (14,17), (14,1), (6,3), (25,1), (5,17), (17,1), (6,9), (7,1), (2,9), (18,1), (6,9), (3,1), (5,33), (10,1), (3,9), (8,1), (5,33), (6,1), (5,9), (16,1), (7,33), (1,49), (10,17), (9,1), (9,17), (11,1), (3,17), (13,1), (7,65), (7,1), (3,65), (7,1), (6,65), (4,1), (15,9), (5,33), (11,1), (9,33), (4,1), (5,9), (3,1), (11,33), (8,41), (9,33), (3,41), (2,9), (6,1), (4,9), (6,33), (2,41), (12,9), (3,33), (1,1), (2,9), (8,1), (6,9), (16,1), (4,65), (6,1), (24,17), (8,16), (13,0), (2,64), (48,0), (5,4), (4,0), (2,16), (11,0), (3,8), (38,0), (13,64), (4,65), (8,1), (4,17), (5,1), (6,65), (9,1), (4,9), (16,1), (3,65), (9,1), (5,17), (5,1), (10,33), (5,9), (16,1), (8,0), (2,8), (9,0), (4,64), (7,65), (5,1), (4,3), (8,1), (4,17), (6,1), (7,0), (5,32), (9,8), (12,72), (2,64), (9,65), (7,1), (2,9), (9,1), (6,65), (14,1), (6,33), (6,1), (4,9), (12,1), (3,65), (13,1), (2,17), (15,1), (5,33), (9,1), (3,33), (3,1), (4,17), (11,1), (3,33), (6,1), (5,3), (1,1), (3,33), (13,1), (2,17), (2,19), (1,3), (11,1), (10,17), (10,1), (3,17), (7,1), (7,3), (11,1), (10,33), (2,1), (2,9), (11,73), (7,65), (1,1), (9,17), (14,1), (3,9), (1,73), (2,65), (1,73), (8,9), (6,41), (2,9), (10,1), (8,17), (5,81), (1,83), (4,67), (1,3), (9,1), (7,65), (2,81), (4,17), (6,1), (4,17), (8,1), (3,17), (3,1), (6,65), (3,1), (4,3), (8,1), (2,17), (25,1), (4,17), (7,1), (19,33), (7,41), (4,33), (1,1), (7,33), (13,1), (6,3), (30,1), (6,65), (12,1), (6,33), (3,41), (4,9), (8,1), (6,33), (3,1), (5,17), (6,3), (12,1), (3,17), (13,1), (6,17), (12,1), (7,65), (11,9), (3,1), (6,3), (1,11), (2,9), (15,1), (3,9), (6,1), (2,9), (6,1), (7,3), (18,1), (3,9), (6,1), (9,33), (1,1), (11,17), (1,81), (2,65), (3,67), (3,3), (9,1), (6,17), (3,1), (6,3), (2,19), (1,17), (14,1), (5,9), (5,1), (5,9), (2,1), (4,3), (4,35), (2,33), (6,1), (5,9), (5,1), (2,3), (5,11), (14,1), (7,3), (16,1), (10,33), (2,1), (5,17), (4,19), (3,3), (11,1), (2,9), (8,1), (6,9), (9,1), (11,65), (3,67), (3,3), (7,1), (3,17), (11,1), (2,65), (8,1), (2,17), (15,1), (5,9), (3,1), (6,65), (22,1), (7,33), (8,41), (5,1), (10,9), (11,1), (4,9), (5,1), (2,9), (12,1), (3,9), (6,1), (4,33), (3,1), (7,17), (8,1), (4,17), (1,1), (5,65), (1,81), (6,65), (9,0), (3,16), (9,17), (3,16), (4,0), (2,1), (1,17), (2,81), (6,65), (6,1), (5,17), (5,1), (5,3), (2,1), (3,65), (9,1), (4,17), (26,1), (4,3), (14,1), (4,65), (7,1), (5,65), (8,1), (3,65), (16,1), (4,65), (7,1), (6,3), (7,1), (4,65), (17,1), (4,33), (11,1), (2,33), (10,1), (3,9), (11,1), (2,9), (13,1), (3,17), (15,1), (13,33), (5,1), (3,33), (3,35), (2,3), (5,1), (3,9), (5,1), (2,65), (7,1), (16,65), (6,1), (2,65), (4,73), (1,9), (2,1), (6,3), (3,1), (3,65), (8,1), (3,9), (8,1), (4,65), (9,1), (3,65), (7,1), (2,9), (12,1), (4,3), (2,67), (1,65), (8,1), (2,9), (9,1), (4,9), (12,1), (6,3), (8,1), (3,65), (24,1), (4,3), (26,1), (4,3), (10,1), (2,65), (47,1), (142,0)] - -three = ((3,0),d) - where d = rleDecode [(16, 0), (7, 8), (12, 9), (71, 8), (7, 1), (3, 17), (25, 1), (6, 65), (1, 1), (60, 33), (90, 65), (52, 64), (2, 96), (3, 36), (9, 32), (5, 0), (1, 8), (37, 0), (2, 1), (2, 65), (5, 1), (2, 33), (3, 1), (2, 33), (4, 1), (1, 33), (3, 9), (1, 1), (1, 9), (4, 1), (4, 65), (4, 81), (22, 65), (21, 64), (1, 68), (2, 4), (1, 36), (5, 32), (8, 0), (4, 32), (2, 0), (13, 16), (66, 48), (2, 32), (33, 33), (2, 41), (1, 72), (17, 64), (3, 80), (31, 64), (3, 68), (1, 64), (2, 72), (3, 8), (1, 9), (11, 33), (2, 9), (2, 1), (3, 33), (6, 1), (1, 33), (1, 41), (4, 9), (8, 1), (3, 9), (1, 1), (3, 9), (3, 1), (1, 9), (3, 1), (1, 9), (4, 1), (5, 33), (2, 1), (2, 17), (4, 1), (2, 17), (13, 1), (6, 65), (1, 73), (5, 9), (5, 33), (2, 1), (2, 33), (1, 41), (1, 9), (1, 41), (4, 33), (2, 41), (3, 9), (1, 1), (1, 9), (1, 1), (6, 0), (1, 32), (4, 33), (4, 8), (2, 0), (1, 32), (1, 33), (2, 1), (1, 0), (2, 32), (1, 16), (1, 48), (11, 16), (7, 80), (2, 16), (2, 1), (8, 0), (5, 64), (9, 72), (18, 64), (17, 16), (1, 0), (8, 1), (2, 17), (20, 1), (25, 33), (1, 40), (20, 8), (31, 72), (1, 65), (10, 1), (34, 33), (1, 1), (9, 17), (11, 16), (10, 80), (2, 64), (4, 80), (2, 81), (4, 80), (2, 81), (6, 80), (7, 64), (6, 80), (1, 113), (2, 33), (2, 32), (22, 33), (2, 1), (4, 65), (7, 73), (2, 72), (4, 8), (2, 40), (4, 41), (1, 40), (8, 32), (9, 40), (2, 41), (1, 9), (19, 8), (3, 9), (3, 1), (2, 17), (1, 81), (3, 65), (7, 81), (3, 80), (26, 16), (3, 80), (1, 64), (2, 65), (1, 64), (3, 72), (2, 73), (1, 65), (1, 64), (1, 80), (4, 81), (1, 80), (1, 81), (3, 17), (4, 16), (1, 65), (2, 1), (2, 0), (14, 64), (3, 72), (25, 8), (14, 40), (2, 41), (2, 40), (2, 41), (2, 40), (3, 41), (1, 33), (14, 32), (4, 0), (4, 16), (5, 0), (2, 8), (7, 0), (3, 64), (1, 72), (3, 8), (2, 72), (8, 64), (5, 80), (6, 64), (4, 0), (4, 36), (1, 8), (3, 0), (11, 1), (3, 33), (3, 49), (3, 17), (2, 81), (25, 17), (13, 16), (1, 17), (13, 1), (2, 33), (5, 32), (1, 40), (2, 8), (1, 0), (30, 8), (1, 9), (4, 41), (4, 33), (4, 1), (1, 9), (4, 1), (1, 9), (2, 1), (2, 9), (3, 1), (2, 9), (1, 1), (1, 9), (5, 1), (2, 9), (6, 65), (1, 81), (8, 65), (5, 1), (3, 33), (1, 1), (3, 65), (5, 1), (7, 17), (1, 49), (4, 48), (2, 16), (12, 17), (5, 81), (9, 17), (3, 81), (5, 65), (3, 81), (3, 17), (10, 1), (9, 65), (8, 1), (19, 33), (4, 41), (20, 9), (5, 73), (3, 77), (1, 13), (13, 9), (4, 1), (1, 9), (4, 1), (1, 9), (7, 1), (4, 3), (10, 1), (10, 65), (38, 1), (2, 65), (69, 1), (12, 65), (4, 67), (1, 3), (62, 1), (6, 3), (20, 1), (7, 33), (5, 1), (9, 33), (1, 1), (8, 65), (10, 1), (3, 3), (1, 67), (1, 65), (4, 1), (2, 65), (7, 1), (3, 3), (9, 1), (14, 33), (1, 35), (2, 3), (12, 1), (2, 33), (4, 1), (4, 3), (4, 1), (3, 33), (2, 1), (4, 3), (2, 1), (7, 17), (1, 49), (15, 33), (3, 41), (5, 9), (1, 1), (2, 33), (5, 35), (1, 33), (7, 1), (1, 33), (8, 1), (5, 3), (3, 1), (8, 65), (6, 1), (6, 3), (1, 67), (4, 65), (3, 1), (1, 33), (5, 49), (2, 17), (4, 81), (1, 65), (1, 67), (3, 3), (3, 1), (3, 65), (2, 81), (2, 17), (1, 81), (2, 17), (3, 81), (3, 1), (13, 65), (4, 81), (12, 17), (4, 1), (3, 17), (2, 1), (5, 33), (3, 1), (12, 9), (4, 1), (6, 9), (9, 1), (3, 3), (31, 1), (4, 33), (7, 41), (20, 33), (3, 35), (2, 3), (3, 9), (2, 1), (1, 9), (7, 73), (15, 65), (1, 81), (19, 17), (5, 1), (5, 17), (2, 1), (4, 17), (2, 49), (4, 51), (1, 19), (2, 17), (16, 1), (1, 33), (19, 1), (30, 9), (32, 1), (20, 17),(170, 1), (4, 17), (3, 1), (3, 65), (1, 73), (4, 9), (8, 41), (6, 1), (2, 9), (6, 1), (1, 65), (6, 81), (14, 17), (13, 1), (9, 65), (7, 73), (3, 1), (1, 65), (13, 73), (9, 65), (4, 1), (6, 17), (4, 65), (10, 1), (2, 9), (3, 1), (4, 9), (9, 1), (2, 9), (15, 1), (1, 17), (7, 1), (3, 33), (2, 49), (27, 33), (6, 35), (3, 41), (21, 9), (1, 41), (1, 35), (3, 51), (2, 49), (5, 17), (15, 49), (3, 51), (1, 49), (1, 17), (12, 1), (7, 33), (1, 1), (2, 17), (18, 1), (13, 65), (30, 73), (1, 65), (73, 1), (2, 9), (47, 1), (31, 17), (2, 1), (2, 33), (5, 49), (1, 33), (4, 1), (3, 3), (1, 67), (2, 65), (1, 1), (3, 9), (2, 73), (9, 65), (3, 1), (20, 65), (1, 73), (4, 9), (1, 11), (3, 43), (1, 35), (4, 33), (15, 9), (2, 41), (2, 43), (1, 35), (8, 33), (2, 41), (6, 9), (3, 1), (1, 9), (1, 1), (9, 3), (10, 35), (1, 3), (1, 1), (5, 33), (2, 49), (3, 1), (2, 17), (1, 19), (3, 83), (7, 81), (4, 65), (6, 1), (1, 67), (3, 3), (14, 65), (1, 17), (1, 19), (3, 3), (4, 1), (5, 65), (1, 81), (2, 17), (6, 1), (7, 33), (1, 41), (1, 9), (11, 11), (4, 3), (1, 11), (2, 3), (1, 11), (19, 3), (14, 35), (7, 33), (2, 49), (13, 33), (3, 35), (2, 3), (2, 1), (1, 9), (5, 65), (8, 1), (2, 65), (1, 67), (3, 3), (3, 67), (18, 65), (1, 1), (3, 3), (2, 35), (1, 3), (2, 1), (8, 33), (4, 49), (1, 17), (4, 1), (2, 33), (1, 1), (2, 33), (5, 1), (2, 33), (7, 1), (8, 17), (6, 49), (1, 17), (3, 19), (2, 3), (1, 35), (1, 3), (1, 1), (9, 65), (13, 81), (1, 19), (1, 3), (2, 35), (1, 33), (7, 41), (12, 33), (8, 49), (8, 17), (1, 19), (4, 3), (3, 1), (4, 3), (2, 1), (5, 9), (1, 1), (4, 33), (3, 17), (1, 81), (3, 65), (2, 1), (2, 9), (2, 1), (6, 65), (2, 73), (10, 65), (17, 73), (1, 75), (1, 11), (7, 3), (1, 65), (3, 73), (1, 75), (2, 11), (2, 3), (2, 33), (3, 1), (2, 65), (1, 73), (1, 9), (1, 73), (3, 65), (1, 33), (4, 35), (5, 33), (4, 41), (3, 9), (1, 33), (3, 35), (4, 3), (2, 11), (1, 3), (1, 1), (2, 33), (1, 35), (4, 3), (6, 35), (2, 33), (1, 49), (5, 1), (2, 17), (2, 19), (5, 83), (3, 81), (5, 65), (6, 81), (1, 65), (1, 1), (1, 3), (2, 19), (2, 3), (4, 1), (1, 9), (1, 11), (2, 75), (2, 11), (1, 3), (3, 1), (12, 33), (4, 35), (1, 43), (10, 9), (2, 1), (1, 65), (3, 73), (2, 65), (3, 1), (12, 65), (3, 73), (3, 1), (1, 9), (1, 1), (1, 9), (9, 1), (5, 33), (1, 5), (1, 21), (2, 5), (2, 1), (2, 65), (9, 67), (2, 81), (4, 17), (6, 81), (10, 17), (3, 3), (2, 1), (8, 33), (1, 41), (10, 9), (12, 73), (9, 65), (1, 73), (3, 1), (2, 9), (8, 1), (3, 65), (4, 1), (2, 65), (7, 1), (1, 65), (4, 1), (4, 33), (4, 1), (6, 33), (3, 1), (2, 33), (37, 1), (2, 33), (39, 1), (1, 33), (16, 1), (2, 33), (3, 3), (13, 1), (2, 3), (2, 35), (10, 1), (5, 35), (5, 33), (8, 49), (5, 17), (4, 49), (4, 17), (1, 1), (1, 3), (4, 19), (14, 17), (2, 19), (4, 3), (6, 1), (4, 3), (2, 1), (3, 33), (11, 1), (1, 9), (3, 1), (2, 9), (3, 1), (26, 65), (7, 73), (5, 75), (2, 9), (5, 1), (2, 9), (3, 1), (13, 9), (1, 41), (1, 43), (1, 11), (3, 3), (2, 11), (2, 3), (1, 11), (2, 3), (1, 11), (3, 3), (1, 11), (6, 3), (1, 11), (7, 3), (1, 11), (5, 3), (21, 35), (1, 1), (10, 65), (4, 81), (13, 17), (13, 49), (6, 51), (4, 49), (1, 33), (26, 1), (6, 3), (7, 1), (2, 9), (9, 73), (1, 65), (6, 1), (2, 65), (1, 9), (9, 1), (6, 3), (15, 1), (16, 33), (1, 97), (17, 65), (3, 1), (9, 3), (3, 1), (2, 65), (9, 1), (2, 65), (4, 1), (1, 65), (1, 67), (6, 3), (7, 1), (3, 65), (1, 1), (6, 3), (4, 1), (1, 65), (5, 1), (1, 67), (3, 3), (4, 1), (4, 3), (6, 1), (5, 33), (1, 49), (1, 17), (7, 1), (5, 3), (5, 1), (2, 65), (2, 1), (1, 3), (1, 35), (1, 33), (1, 49), (1, 17), (6, 1), (1, 65), (1, 67), (3, 3), (8, 1), (7, 33), (14, 1), (4, 3), (12, 1), (1, 65), (6, 1), (4, 65), (5, 1), (1, 65), (2, 1), (7, 65), (5, 1), (1, 65), (2, 1), (7, 65), (4, 1), (1, 9), (2, 1), (21, 33), (1, 1), (13, 65), (5, 67), (1, 75), (1, 73), (3, 1), (12, 17), (4, 1), (2, 17), (1, 1), (6, 65), (2, 1), (1, 33), (6, 49), (22, 33), (2, 1), (3, 33), (1, 1), (2, 33), (9, 1), (1, 9), (5, 1), (4, 3), (2, 33), (14, 1), (3, 3), (3, 1), (4, 65), (3, 1), (2, 65), (2, 1), (15, 65), (3, 73), (4, 1), (2, 65), (9, 1), (2, 65), (3, 1), (2, 17), (2, 1), (3, 65), (14, 1), (1, 9), (5, 1), (3, 3), (5, 1), (1, 33), (5, 1), (4, 65), (8, 1), (2, 65), (1, 1), (1, 65), (3, 1), (3, 65), (12, 1), (4, 3), (1, 1), (2, 33), (7, 1), (1, 17), (5, 1), (1, 33), (8, 1), (1, 65), (3, 1), (1, 65), (2, 1), (2, 65), (5, 1), (2, 9), (7, 1), (4, 33), (2, 1), (3, 33), (5, 49), (4, 33), (3, 35), (4, 33), (5, 1), (2, 65), (2, 1), (4, 65), (1, 1), (2, 65), (2, 1), (1, 3), (2, 67), (2, 3), (1, 65), (4, 1), (2, 65), (4, 1), (1, 9), (9, 1), (1, 9), (3, 1), (1, 9), (2, 1), (3, 3), (5, 1), (5, 3), (1, 67), (4, 1), (5, 3), (11, 1), (4, 3), (2, 1), (7, 65), (1, 1), (8, 33), (1, 43), (4, 3), (3, 1), (2, 33), (3, 1), (1, 33), (4, 1), (1, 33), (2, 1), (2, 65), (9, 1), (1, 65), (13, 1), (3, 33), (1, 1), (16, 33), (5, 35), (3, 49), (1, 33), (11, 1), (3, 33), (3, 49), (4, 33), (4, 1), (4, 65), (7, 1), (3, 3), (12, 1), (1, 65), (2, 73), (2, 1), (5, 9), (7, 1), (1, 65), (7, 1), (2, 65), (6, 1), (1, 17), (10, 1), (2, 17), (4, 1), (2, 19), (2, 3), (3, 33), (2, 35), (7, 33), (4, 3), (4, 1), (2, 33), (1, 35), (4, 3), (24, 65), (2, 67), (3, 3), (10, 1), (4, 3), (2, 35), (5, 33), (1, 1), (5, 33), (2, 41), (15, 33), (1, 49), (3, 51), (5, 33), (3, 1), (2, 33), (8, 1), (11, 33), (1, 41), (1, 9), (3, 1), (6, 73), (1, 65), (4, 1), (3, 65), (3, 1), (2, 65), (5, 1), (4, 3), (1, 65), (2, 1), (1, 65), (5, 1), (2, 65), (31, 1), (1, 33), (1, 35), (3, 3), (10, 1), (1, 17), (7, 1), (2, 33), (3, 3), (9, 1), (1, 17), (3, 3), (4, 17), (4, 1), (6, 65), (5, 67), (12, 65), (15, 73), (6, 65), (4, 1), (1, 3), (1, 67), (4, 3), (1, 1), (4, 65), (2, 9), (2, 1), (1, 9), (1, 73), (1, 75), (1, 11), (2, 3), (1, 11), (1, 9), (2, 1), (1, 9), (3, 11), (3, 9), (2, 11), (4, 1), (3, 3), (1, 1), (1, 33), (1, 9), (3, 11), (3, 41), (2, 43), (2, 1), (3, 9), (2, 11), (2, 9), (2, 1), (2, 11), (1, 3), (3, 1), (4, 35), (3, 33), (2, 1), (2, 3), (1, 1), (13, 65), (1, 1), (6, 65), (11, 1),(164, 0)] - -laserFool=((1,0),d) - where d = rleDecode [(26, 0), (3, 1), (5, 9), (3, 8), (9, 0), (6, 8), (2, 72), (7, 64), (1, 80), (17, 16), (8, 17), (1, 49), (14, 33), (3, 41), (18, 9), (3, 73), (11, 65), (1, 1), (29, 17), (3, 49), (7, 33), (5, 41), (14, 9), (3, 1), (7, 9), (22, 1), (5, 9), (13, 1), (5, 9), (19, 1), (5, 9), (11, 1), (13, 33), (5, 41), (11, 9), (2, 1), (38, 65), (1, 81), (6, 17), (7, 21), (2, 17), (46, 49), (7, 1), (3, 17), (16, 49), (4, 17), (1, 81), (8, 65), (10, 73), (24, 65), (1, 73), (10, 65), (3, 73), (4, 9), (1, 41), (2, 33), (6, 37), (4, 33), (5, 41), (11, 9), (25, 1), (5, 33), (2, 1), (7, 9), (1, 1), (5, 33), (13, 49), (11, 17), (7, 49), (3, 17), (25, 1), (5, 65), (3, 73), (7, 65), (1, 73), (27, 65), (3, 73), (2, 9), (8, 41), (5, 9), (11, 41), (6, 33), (2, 41), (9, 9), (1, 41), (4, 33), (3, 41), (2, 9), (2, 1), (3, 33), (2, 1), (4, 73), (10, 65), (10, 73), (2, 9), (2, 41), (2, 33), (17, 49), (9, 17), (22, 49), (2, 33), (16, 1), (7, 17), (21, 65), (3, 73), (2, 9), (3, 41), (3, 33), (15, 1), (6, 73), (5, 9), (2, 1), (12, 33), (2, 1), (2, 65), (3, 69), (3, 77), (4, 73), (8, 65), (3, 81), (5, 17), (15, 16), (14, 48), (5, 49), (5, 41), (8, 40), (7, 8), (14, 72), (6, 73), (6, 72), (5, 8), (9, 40), (8, 8), (6, 40), (11, 41), (3, 33), (4, 32), (5, 16), (9, 80), (10, 81), (12, 80), (4, 81), (2, 65), (1, 81), (13, 80), (3, 16), (4, 17), (1, 81), (15, 16), (3, 48), (2, 32), (8, 33), (8, 32), (8, 40), (8, 8), (5, 40), (8, 41), (1, 9), (7, 13), (2, 45), (8, 40), (8, 8), (3, 40), (8, 41), (1, 9), (7, 73), (4, 72), (10, 64), (4, 80), (21, 16), (11, 17), (16, 16), (11, 17), (2, 25), (1, 24), (17, 8), (40, 9), (3, 41), (7, 33), (18, 65), (7, 81), (1, 85), (6, 69), (1, 73), (7, 9), (1, 41), (3, 33), (4, 35), (4, 33), (3, 49), (8, 17), (13, 81), (6, 65), (1, 1), (10, 17), (32, 49), (2, 48), (14, 16), (2, 0), (1, 64), (6, 72), (10, 8), (32, 72), (15, 8), (1, 24), (1, 56), (6, 48), (8, 0), (2, 16), (8, 0), (2, 16), (2, 48), (8, 32), (8, 0), (8, 32), (12, 40), (1, 41), (1, 33), (16, 49), (3, 17), (2, 16), (15, 0), (4, 16), (12, 0), (16, 64), (10, 72), (6, 73), (2, 89), (5, 17), (9, 49), (6, 17), (2, 81), (3, 65), (3, 73), (1, 1), (1, 3), (4, 19), (5, 17), (7, 1), (5, 17), (10, 1), (5, 33), (1, 49), (4, 17), (10, 1), (3, 65), (3, 73), (15, 9), (1, 41), (3, 43), (8, 41), (27, 9), (4, 41), (21, 1), (8, 33), (16, 1), (19, 17), (3, 19), (2, 17), (18, 65), (9, 73), (11, 9), (5, 1), (4, 9), (11, 1), (2, 9), (22, 1), (27, 33), (1, 1), (44, 65), (1, 67), (4, 3), (1, 35), (9, 33), (46, 49), (2, 17), (5, 1), (6, 33), (7, 1), (7, 65), (5, 73), (2, 9), (13, 1), (1, 65), (1, 73), (2, 9), (6, 1), (20, 65), (7, 1), (1, 3), (3, 67), (2, 19), (3, 17), (15, 1), (6, 17), (16, 1), (3, 17), (15, 1), (5, 17), (3, 1), (6, 33), (7, 41), (8, 9), (15, 41), (5, 43), (1, 3), (4, 0), (11, 64), (6, 0), (3, 32), (23, 40), (1, 9), (4, 1), (7, 0), (8, 64), (5, 80), (24, 16), (7, 0), (1, 8), (2, 0), (11, 32), (5, 0), (4, 32), (1, 40), (2, 8), (10, 0), (11, 16), (17, 17), (8, 1), (1, 0), (5, 8), (29, 72), (24, 0), (10, 1), (17, 0), (18, 1), (11, 0), (1, 32), (1, 0), (2, 16), (5, 48), (8, 32), (8, 40), (14, 41), (6, 9), (9, 41), (6, 9), (14, 1), (10, 65), (8, 1), (19, 17), (6, 21), (21, 17), (11, 81), (10, 65), (11, 73), (20, 9), (4, 1), (4, 9), (19, 1), (4, 33), (1, 35), (5, 3), (20, 1), (13, 65), (5, 81), (14, 17), (9, 49), (6, 33), (4, 41), (10, 9), (7, 73), (2, 65), (7, 1), (5, 3), (23, 1), (4, 65), (4, 81), (10, 17), (7, 49), (5, 33), (7, 41), (14, 9), (1, 73), (6, 65), (34, 73), (1, 41), (4, 33), (11, 49), (1, 17), (4, 81), (2, 65),(122, 1), (31, 65), (5, 33), (33, 49), (4, 51), (10, 49), (7, 41), (6, 73), (10, 65), (5, 81), (10, 17), (1, 33), (1, 35), (4, 43), (2, 41), (37, 9), (9, 41), (1, 33), (2, 35), (3, 43), (2, 11), (2, 3), (11, 1), (2, 33), (1, 1), (11, 65), (11, 81), (5, 83), (1, 19), (2, 3), (16, 1), (8, 65), (1, 97), (32, 33), (22, 49), (8, 51), (2, 49), (2, 33), (8, 1), (7, 9), (6, 73), (9, 65), (8, 1), (4, 9), (1, 73), (2, 65), (1, 1), (32, 17), (7, 51), (1, 43), (10, 9), (4, 8), (6, 72), (12, 73), (10, 75), (2, 11), (1, 43), (1, 41), (3, 33), (1, 32), (2, 48), (10, 16), (6, 17), (4, 19), (2, 3), (2, 65), (3, 73), (3, 65), (8, 73), (11, 9), (1, 11), (6, 35), (6, 3), (2, 1), (9, 65), (1, 81), (3, 17), (8, 19), (7, 1), (3, 65), (1, 67), (9, 3), (5, 1), (11, 65), (8, 1), (2, 3), (9, 67), (2, 3), (3, 1), (3, 33), (7, 1), (7, 33), (3, 1), (2, 33), (11, 35), (11, 33), (3, 1), (5, 33), (8, 35), (2, 3), (6, 1), (7, 33), (2, 1), (5, 65), (17, 73), (5, 9), (2, 41), (5, 33), (6, 35), (1, 33), (7, 1), (3, 9), (4, 1), (21, 33), (52, 1), (170, 0)]
− Monadius/Game.hs
@@ -1,12 +0,0 @@-module Game ( - Game(..) - ) where - -import Graphics.UI.GLUT.Callbacks.Window - --- | An abstracted game as a state machine. -class Game g where - update :: [Key] -> g -> g - render :: g -> IO () - isGameover :: g -> Bool -
− Monadius/Main.hs
@@ -1,366 +0,0 @@-{- Copyright 2005 Hideyuki Tanaka & Takayuki Muranushi - This program is distributed under the terms of the GNU General Public License. - - NOTE - This project meant to list up, not to solve, many possible problems that will appear - while writing a game in Haskell. - Only nushio is responsible to the unreadability of these codes. -} -module Main (main) where - -import Graphics.UI.GLUT hiding (position) -import Control.Exception -- (catch, ExitException(), throwIO) -import Control.Monad (mplus, zipWithM_) -import System.Exit -- (ExitSuccess()) -import Prelude hiding (catch) - -import Data.IORef -import Data.List (isSuffixOf, nub) -import Data.Complex -- ((:+), Complex()) -import Data.Maybe (fromJust, isJust) -import System.Directory (createDirectoryIfMissing, doesFileExist) -import System.Environment (getArgs, getEnv) - -import Demo -- (ReplayInfo(), demoData) -import Game (isGameover, render, update) -import Monadius -import Recorder -import Util (intToGLdouble, padding, putDebugStrLn) - -data GlobalVariables = GlobalVariables{ - saveState :: (Int,Int) ,isCheat :: Bool, demoIndex :: Int, - -- | 'recorderMode' means general gamemode that user wants, - -- 'mode' of a recorder means current gamemode. - -- two are different when temporal demo replays. - recorderMode :: RecorderMode, - playbackKeys :: [[Key]],playbackSaveState :: (Int,Int),playBackName :: Maybe String, - recordSaveState :: (Int,Int),saveHiScore :: Int - } - -replayFileExtension :: String -replayFileExtension = ".replay" - -presentationMode :: Bool -presentationMode = True - -loadReplay :: String-> IO ReplayInfo -loadReplay filename = readFile filename >>= (return . read) - -main :: IO () -main = do - args <- getArgs - putDebugStrLn $ show args - _ <- getArgsAndInitialize - keystate <- newIORef [] - - (recMode,keys,rss,repName) <- if isJust $ getReplayFilename args then do - ReplayInfo (ss,keystr) <- (loadReplay . fromJust . getReplayFilename) args - return (Playback,decode keystr,ss,Just $ (simplify . fromJust . getReplayFilename) args) - else if "-r" `elem` args then do - return (Play,[],(1,0),Nothing) - else - return (Record,[],(1,0),Nothing) - - cp <- newIORef (openingProc 0 0 GlobalVariables{saveState = (1,0) ,isCheat = False, - recorderMode=recMode,playbackKeys=keys,playbackSaveState = rss,recordSaveState=(1,0),demoIndex=0, - playBackName=repName,saveHiScore=0} keystate) - initialWindowSize $= Size 640 480 - initialDisplayMode $= [RGBAMode,DoubleBuffered{-,WithDepthBuffer,WithAlphaComponent-}] - - wnd <- createWindow "Monadius" - - curwnd <- if "-f" `elem` args then do - gameModeCapabilities $= [ - Where' GameModeWidth IsLessThan 650, - Where' GameModeHeight IsLessThan 500 - --Where' GameModeBitsPerPlane IsEqualTo 32, - --Where' GameModeRefreshRate IsAtLeast 30, - --Where' GameModeNum IsAtLeast 2 - ] - - displayCallback $= dispProc cp - (wnd2,_) <- enterGameMode - destroyWindow wnd - return wnd2 - else do - return wnd - - displayCallback $= dispProc cp - keyboardMouseCallback $= Just (keyProc keystate) - - addTimerCallback 16 (timerProc (dispProc cp)) - - initMatrix - - mainLoop - destroyWindow curwnd - - `catch` (\(SomeException _) -> return ()) - - where - getReplayFilename [] = Nothing - getReplayFilename a = (Just . head . candidates) a - - candidates args = filter (replayFileExtension `isSuffixOf`) args - - simplify = (removesuffix . removedir) - - removedir str = if '\\' `elem` str || '/' `elem` str then (removedir . tail) str else str - removesuffix str = if '.' `elem` str then (removesuffix . init) str else str - -exitLoop :: IO a -exitLoop = exitWith ExitSuccess - -initMatrix :: IO () -initMatrix = do - viewport $= (Position 0 0,Size 640 480) - matrixMode $= Projection - loadIdentity - perspective 30.0 (4/3) 600 1400 - lookAt (Vertex3 0 0 (927 :: GLdouble)) (Vertex3 0 0 (0 :: GLdouble)) (Vector3 0 1 (0 :: GLdouble)) - -dispProc :: IORef (IO Scene) -> IO () -dispProc cp = do - m <- readIORef cp - Scene next <- m - writeIORef cp next - --- | Scene is something that does some IO, --- then returns the Scene that are to be executed in next frame. -newtype Scene = Scene (IO Scene) - -openingProc :: Int -> Int -> GlobalVariables -> IORef [Key] -> IO Scene -openingProc clock menuCursor vars ks = do - if recorderMode vars == Playback then gameStart (fst $ playbackSaveState vars) (snd $ playbackSaveState vars) (isCheat vars) Playback vars else do - if clock > demoStartTime then do demoStart vars else do - - keystate <- readIORef ks - clear [ColorBuffer,DepthBuffer] - matrixMode $= Modelview 0 - loadIdentity - - if clock < drawCompleteTime then color $ Color3 (0 :: GLdouble) 0.2 0.8 - else color $ Color3 (0+shine clock :: GLdouble) (0.2+shine clock) (0.8+shine clock) - preservingMatrix $ do - translate (Vector3 0 (120 :: GLdouble) 0) - scale 1.05 1 (1 :: GLdouble) - mapM_ (renderPrimitive LineStrip . renderVertices2D.delayVertices clock) [lambdaLfoot,lambdaRfoot] - color $ Color3 (1.0 :: GLdouble) 1.0 1.0 - preservingMatrix $ do - translate $ Vector3 (-195 :: GLdouble) (130) 0 - scale (0.73 :: GLdouble) 0.56 0.56 - renderStringGrad Roman 0 "Monadius" - preservingMatrix $ do - if menuCursor==0 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 - translate $ Vector3 (-230 :: GLdouble) (-200) 0 - scale (0.2 :: GLdouble) 0.2 0.3 - renderStringGrad Roman 60 $ (if menuCursor==0 then ">" else " ") ++ "New Game" - preservingMatrix $ do - if menuCursor==1 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 - translate $ Vector3 (70 :: GLdouble) (-200) 0 - scale (0.2 :: GLdouble) 0.2 0.3 - renderStringGrad Roman 60 $ (if menuCursor==1 then ">" else " ") ++ "Continue " ++ (show . fst . saveState) vars++ "-" ++ (show . (+1) . snd . saveState) vars - color $ Color3 (1.0 :: GLdouble) 1.0 1.0 - - preservingMatrix $ do - translate $ Vector3 (-250 :: GLdouble) (75) 0 - scale (0.15 :: GLdouble) 0.10 0.15 - renderStringGrad Roman 10 "Dedicated to the makers, the players, the history," - preservingMatrix $ do - translate $ Vector3 (-250 :: GLdouble) (55) 0 - scale (0.15 :: GLdouble) 0.10 0.15 - renderStringGrad Roman 20 " and the 20th anniversary of GRADIUS series." - mapM_ (\ (y,(strA,strB),i) -> preservingMatrix $ do - preservingMatrix $ do - translate $ Vector3 (-180 :: GLdouble) y 0 - scale (0.18 :: GLdouble) 0.18 0.2 - renderStringGrad Roman (20 + i*5) strA - preservingMatrix $ do - translate $ Vector3 (60 :: GLdouble) y 0 - scale (0.18 :: GLdouble) 0.18 0.2 - renderStringGrad Roman (25 + i*5) strB - ) $ zip3 [0,(-35)..] instructions [1..] - - swapBuffers - - if Char ' ' `elem` keystate && clock >= timeLimit then - if menuCursor == 0 then - gameStart 1 0 False (recorderMode vars) vars - else - gameStart savedLevel savedArea (isCheat vars) (recorderMode vars) vars - else if isJust $ getNumberKey keystate then - gameStart (fromJust $ getNumberKey keystate) 0 True (recorderMode vars) vars - else return $ Scene $ openingProc (clock+1) (nextCursor keystate) vars ks - where - instructions = [("Move","Arrow Keys"),("Shot","Z Key"),("Missile","X Key"),("Power Up","C Key"),("Start","Space Bar")] - timeLimit = 30 :: Int - renderStringGrad font delay str = renderString font (take (((clock-delay) * length str) `div` timeLimit) str) - getNumberKey keystate = foldl mplus Nothing $ map keyToNumber keystate - - keyToNumber :: Key -> Maybe Int - keyToNumber k = case k of - Char c -> if c>='0' && c<='9' then Just $ fromEnum c - fromEnum '0' else Nothing - _ -> Nothing - - gameStart level area ischeat recordermode vrs = do - -- it is possible to temporary set (recordermode /= recorderMode vars) - gs <- newIORef $ initialRecorder recordermode (playbackKeys vrs) (initialMonadius GameVariables{ - totalScore=0, flagGameover=False, hiScore=saveHiScore vrs, - nextTag=0, gameClock = savePoints!!area ,baseGameLevel = level, - playTitle = if recordermode /= Playback then Nothing else playBackName vrs}) - - return $ Scene $ mainProc vrs{isCheat=ischeat,recordSaveState=(level,area)} gs ks - - (savedLevel,savedArea) = saveState vars - - demoStart vrs = do - let i = demoIndex vrs - let ReplayInfo ((lv,area),dat) = demoData!!i - gameStart lv area (isCheat vrs) Playback vrs{ - playBackName = Just "Press Space", - playbackKeys = decode dat, - demoIndex = demoIndex vrs+1 - } - - nextCursor keys = - if SpecialKey KeyLeft `elem` keys then 0 else - if SpecialKey KeyRight `elem` keys then 1 else - menuCursor - - delayVertices clck vs = (reverse . take clck . reverse) vs - - lambdaLfoot = moreVertices $ [10:+55,(-15):+0] ++ map (\(x:+y)->((-x):+y)) wing - lambdaRfoot = moreVertices $ [(-15):+70,(-12):+77,(-5):+80,(2:+77),(5:+70)] ++ wing - - shine t = monoshine (drawCompleteTime + t) + monoshine (drawCompleteTime + t+6) - - monoshine t = exp(-0.2*intToGLdouble(t`mod` 240)) - - drawCompleteTime = length lambdaRfoot - - moreVertices (a:b:cs) = if magnitude (a-b) > d then moreVertices (a:((a+b)/(2:+0)):b:cs) else a:moreVertices(b:cs) - where d=6 - - moreVertices x = x - - wing = [(30:+0),(200:+0),(216:+16),(208:+24),(224:+24),(240:+40),(232:+48),(248:+48),(272:+72),(168:+72)] - - renderVertices2D :: [Complex GLdouble] -> IO () - renderVertices2D xys = mapM_ (\(x:+y) -> vertex $ Vertex3 x y 0) xys - - demoStartTime = if presentationMode then 480 else 1800 - -endingProc :: GlobalVariables -> IORef [Key] -> IORef GLdouble -> IO Scene -endingProc vars ks ctr= do - keystate <- readIORef ks - counter <- readIORef ctr - modifyIORef ctr (min 2420 . (+2.0)) - clear [ColorBuffer,DepthBuffer] - matrixMode $= Modelview 0 - loadIdentity - - color $ Color3 (1.0 :: GLdouble) 1.0 1.0 - zipWithM_ (\str pos -> preservingMatrix $ do - translate $ Vector3 (-180 :: GLdouble) (-240+counter-pos) 0 - scale (0.3 :: GLdouble) 0.3 0.3 - renderString Roman str) - stuffRoll [0,60..] - - swapBuffers - - if Char ' ' `elem` keystate then do - return $ Scene $ openingProc 0 1 vars ks - else return $ Scene $ endingProc vars ks ctr - - where - stuffRoll = [ - "", - "", - "Game Designer", - " nushio", - "", - "Frame Programmer", - " tanakh", - "", - "Graphics Designer", - " Just nushio", - "", - "Sound Designer", - " Match Makers", - "", - "Lazy Evaluator", - " GHC 6.8", - "", - "Inspired" , - " Ugo-Tool", - " gradius2.com", - " Gradius series", - "", - "Special thanks to", - " John Peterson", - " Simon Marlow", - " Haskell B. Curry", - " U.Glasgow", - "", - "Presented by", - " team combat", - "", - "", - if (fst . saveState) vars <= 2 then "Congratulations!" else "WE LOVE GAMES!!" , - "", - " press space key"] - -mainProc :: GlobalVariables -> IORef Recorder -> IORef [Key] -> IO Scene -mainProc vars gs ks = do - keystate <- readIORef ks - modifyIORef gs (update keystate) - gamestate <- readIORef gs - - clear [ColorBuffer,DepthBuffer] - matrixMode $= Modelview 0 - loadIdentity - render gamestate - swapBuffers - let currentLevel = baseGameLevel$getVariables$gameBody gamestate - let currentArea = maximum $ filter (\i -> (savePoints !! i) < (gameClock $ getVariables $ gameBody gamestate)) [0..(length savePoints-1)] - let currentSave = if mode gamestate == Playback then saveState vars else (currentLevel,currentArea) - let currentHi = max (saveHiScore vars) (hiScore$getVariables$gameBody gamestate) - if (isGameover gamestate) then do - counter <- newIORef (0.0 :: GLdouble) - if mode gamestate /= Record then return () else do - writeReplay vars gamestate $ show (ReplayInfo (recordSaveState vars,(encode2 . preEncodedKeyBuf) gamestate)) - - if currentLevel>1 && (not . isCheat) vars && (mode gamestate /= Playback) then - return $ Scene $ endingProc vars{saveState=currentSave,saveHiScore = currentHi} ks counter - else return $ Scene $ openingProc 0 1 vars{saveState=currentSave,saveHiScore = currentHi} ks - else return $ Scene $ mainProc vars{saveState=currentSave,saveHiScore = currentHi} gs ks - where - writeReplay vs gamestate str = do - home <- getEnv "HOME" - createDirectoryIfMissing True (home ++ "/.monadius-replay/") - filename <- searchForNewFile ( - "replay\\" ++ (showsave . recordSaveState) vs ++ "-" ++ (showsave . saveState) vs ++ "." ++ - ((padding '0' 8) . show . totalScore . getVariables . gameBody) gamestate ++ "pts") 0 - writeFile (home ++ "/.monadius-replay/" ++ filename) str - showsave (a,b) = show (a,b+1) - searchForNewFile prefix i = do - let fn = prefix ++ (uniqStrs!!i) ++ replayFileExtension - b <- doesFileExist fn - if not b then return fn else do - searchForNewFile prefix $ i + 1 - uniqStrs = ("") : (map (("." ++) . show) ([1..] :: [Int])) - -timerProc :: IO () -> IO () -timerProc m = addTimerCallback 16 $ timerProc m >> m - -keyProc :: IORef [Key] -> Key -> KeyState -> t -> t1 -> IO () -keyProc keystate key ks _ _ = - case (key,ks) of - (Char 'q',_) -> exitLoop - (Char '\ESC',_) -> exitLoop - (_,Down) -> modifyIORef keystate (nub . (++ [key])) - (_,Up) -> modifyIORef keystate (filter (/=key)) - -savePoints :: [Int] -savePoints = [0,1280,3000,6080] - -
− Monadius/Monadius.hs
@@ -1,1348 +0,0 @@-module Monadius ( - Monadius(..) ,initialMonadius,getVariables, - GameVariables(..), - shotButton,missileButton,powerUpButton,upButton,downButton,leftButton,rightButton,selfDestructButton - ) where - -import Data.Array ((!), Array(), array) -import Data.Complex -- ((:+)) -import Data.List (intersect, find) -import Data.Maybe (fromJust, isJust, isNothing) -import Graphics.UI.GLUT hiding (position) -import Prelude hiding (catch) - -import Game -import Util - -instance Game Monadius where - update = updateMonadius - render = renderMonadius - isGameover = isMonadiusOver - -newtype Monadius = Monadius (GameVariables,[GameObject]) - -getVariables :: Monadius -> GameVariables -getVariables (Monadius (vs,_))=vs - -data GameVariables = GameVariables { - totalScore :: Int,hiScore :: Int ,flagGameover :: Bool, - nextTag :: Int, gameClock :: Int,baseGameLevel :: Int,playTitle :: Maybe String - } deriving Eq - -data GameObject = -- objects that are actually rendered and moved. - VicViper{ -- player's fighter. - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int, - trail :: [Complex GLdouble], - speed :: GLdouble, - powerUpPointer :: Int, - powerUpLevels :: Array Int Int, - reloadTime :: Int,weaponEnergy :: Int, - ageAfterDeath :: Int - } | - Option{ -- trailing support device. - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape, - optionTag :: Int, - reloadTime :: Int,weaponEnergy :: Int} | - StandardMissile{ - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,mode :: Int, - velocity :: Complex GLdouble,parentTag :: Int,probe :: GameObject } | -- missile that fly along the terrain - Probe{ -- this lets missile to fly along the terrain - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int - } | - StandardRailgun{ - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - velocity :: Complex GLdouble,parentTag :: Int } | -- normal & double shot - StandardLaser{ - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - velocity :: Complex GLdouble,parentTag :: Int,age :: Int } | -- long blue straight laser - Shield{ - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, - settled :: Bool,size :: GLdouble,placement :: Complex GLdouble, - angle :: GLdouble,omega :: GLdouble} | -- solid state of Reek power that protects enemy atacks - PowerUpCapsule{ - tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,age :: Int} | - PowerUpGauge{ - tag :: Maybe Int,position :: Complex GLdouble} | - - DiamondBomb{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int} | -- Bacterian's most popular warhead - TurnGear{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,mode :: Int, - managerTag :: Int} | -- one of small Bacterian lifeforms, often seen in a squad. - SquadManager{ - tag :: Maybe Int,position :: Complex GLdouble,interval :: Int,age :: Int, - bonusScore :: Int,currentScore :: Int, - members :: [GameObject],items :: [GameObject] - } | - -- 1. generates objects contained in <members> with <interval>, one at each time. - -- 2. sticks to one of the still-alive troop members. - -- 3. counts up <currentScore> every time when one of the squad members are destroyed by lack of hp. - -- 4. doesn't count up <currentScore> if a squad member are destroyed by scrolling out. - -- 5. dies when all squad members were destroyed. at this time, - -- releases <items> if <currentScore> >= <bonusScore>, or - -- doesn't ,if not. - Jumper{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, - touchedLand :: Bool,jumpCounter :: Int - } | -- dangerous multi way mine dispenser. - - Grashia{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, - gunVector :: Complex GLdouble,mode :: Int - } | -- fixed antiaircraft cannon. - - Ducker{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gVelocity :: Complex GLdouble, - charge :: Int,vgun :: Complex GLdouble,touchedLand :: Bool - } | -- 2-feet mobile land to air attack device. - - Flyer{ - tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,mode :: Int - } | -- Baterian's standard interceptor. - - ScrambleHatch{ - tag :: Maybe Int,position :: Complex GLdouble,gateAngle :: GLdouble,gravity :: Complex GLdouble, - hitDisp :: Shape,hp :: Int,age :: Int,launchProgram :: [[GameObject]] - } | -- Where Baterian larvae spend last process of maturation. - - LandScapeBlock{ - tag :: Maybe Int, position :: Complex GLdouble,hitDisp :: Shape,velocity :: Complex GLdouble - } | -- landscape that just look like, and hit like its hitDisp. - - Particle{ - tag :: Maybe Int, position :: Complex GLdouble, velocity :: Complex GLdouble, - size :: GLdouble,particleColor :: Color3 GLdouble,age :: Int,decayTime :: GLdouble,expireAge :: Int - } | -- multi purpose particles that vanishes after expireAge. - - Star{ - tag :: Maybe Int, position :: Complex GLdouble,particleColor :: Color3 GLdouble - } | -- background decoration - SabbathicAgent{ - tag :: Maybe Int, fever :: Int - } | -- generates many flyers for additional fun if there are none of them - DebugMessage {tag :: Maybe Int,debugMessage :: String} | - ScoreFragment{tag :: Maybe Int,score :: Int} - -data HitClass = BacterianShot | - BacterianBody | - LaserAbsorber | - MetalionShot | - MetalionBody | - ItemReceiver | - PowerUp | - LandScape - deriving(Eq) - -data WeaponType = NormalShot | Missile | GLdoubleShot | Laser - deriving (Eq) --- WeaponType NormalShot | Missile | GLdoubleShot | Laser ... represents function of weapon that player selected, while --- GameObject StandardRailgun | StandardLaser ... represents the object that is actually shot and rendered. --- for example; --- shooting NormalShot :: WeaponType and GLdoubleShot :: WeaponType both result in StandardRailgun :: GameObject creation, and --- shooting Laser :: WeaponType creates StandardLaser :: GameObject when player is operating VicViper, or RippleLaser :: GameObject when LordBritish ... etc. - -data ScrollBehavior = Enclosed{doesScroll :: Bool} | NoRollOut{doesScroll :: Bool} - | RollOutAuto{doesScroll :: Bool, range :: GLdouble} | RollOutFold{doesScroll :: Bool} - ------------------------------ --- --- initialization --- ------------------------------- -initialMonadius :: GameVariables -> Monadius -initialMonadius initVs = Monadius (initGameVariables,initGameObjects) - where - initGameVariables = initVs - initGameObjects = - stars ++ [freshVicViper,freshPowerUpGauge] - stars = take 26 $ map (\(t,i) -> Star{tag=Nothing,position = (fix 320 t:+fix 201 t),particleColor=colors!!i}) $ zip (map (\x -> square x + x + 41) [2346,19091..]) [1..] - fix :: Int -> Int -> GLdouble - fix limit value = intToGLdouble $ (value `mod` (2*limit) - limit) - colors = [Color3 1 1 1,Color3 1 1 0,Color3 1 0 0, Color3 0 1 1] ++ colors - -- ++ map (\x -> freshOption{optionTag = x}) [1..4] -- full option inchiki - -{- -Default settings of game objects and constants --} -downButton,leftButton,missileButton,powerUpButton,rightButton,selfDestructButton,shotButton,upButton :: Key -downButton = SpecialKey KeyDown -leftButton = SpecialKey KeyLeft -missileButton = Char 'x' -powerUpButton = Char 'c' -rightButton = SpecialKey KeyRight -selfDestructButton = Char 'g' -shotButton = Char 'z' -upButton = SpecialKey KeyUp - --- Cuteness to add later --- konamiCommand = [upButton,upButton,downButton,downButton,leftButton,rightButton,leftButton,rightButton,missileButton,shotButton] - -gaugeOfMissile,gaugeOfGLdouble,gaugeOfLaser,gaugeOfShield :: Int -gaugeOfMissile = 1 -gaugeOfGLdouble = 2 -gaugeOfLaser = 3 -gaugeOfShield = 5 - -stageClearTime :: Int -stageClearTime = 7800 - --- these lists are game rank modifiers. -bacterianShotSpeedList, duckerShotWay, jumperShotFactor, grashiaShotSpeedFactor :: [GLdouble] -bacterianShotSpeedList = [8,4,6,8] ++ cycle [12,8] -duckerShotCount = [2,1,1,3] ++ repeat 2 -duckerShotWay = [1,1,2,1] ++ cycle [2,2] -jumperShotFactor = [0.5,0.5,0.5,0.5] ++ cycle [0.8,0.5] -grashiaShotSpeedFactor = [1,1,1,1] ++ cycle [1,0.6] - -flyerHitBack, particleHitBack, powerUpCapsuleHitBack, scrambleHatchHitBack, treasure, turnGearHitBack :: [Bool] -flyerHitBack = [False,False,False] ++ repeat True -particleHitBack = True:repeat False -powerUpCapsuleHitBack = [False,False,False,False] ++ cycle [False,True] -scrambleHatchHitBack = [False,False,False,False] ++ cycle [False,True] -treasure = [False,False,False,False] ++ cycle [False,True] -turnGearHitBack = [False,False,False] ++ repeat True - -duckerShotCount, flyerShotInterval, grashiaShotHalt, grashiaShotInterval, inceptorShotInterval, jumperShotWay, landRollShotInterval, scrambleHatchLaunchLimitAge :: [Int] -flyerShotInterval = [30,infinite,30,15] ++ cycle [15,15] -grashiaShotHalt = [50,100,50,50] ++ cycle [0,0] -grashiaShotInterval = [30,60,30,30] ++ cycle [15,5] -inceptorShotInterval = [45,infinite,60,45] ++ cycle [45,45] -jumperShotWay = [16,4,8,16] ++ cycle [24,32] -landRollShotInterval = [60,120,60,60] ++ cycle [30,60] -scrambleHatchLaunchLimitAge = [400,200,400,400] ++ cycle [600,400] - -shotSpeed,laserSpeed,laserBreadth :: GLdouble -shotSpeed = 25 -laserSpeed = 60 -laserBreadth = 20 - -landScapeSensitive :: GameObject -> Bool -landScapeSensitive StandardRailgun{} = True -- these objects has hitDispLand -landScapeSensitive StandardLaser{} = True -- in addition to hitDisp -landScapeSensitive Shield{} = True -landScapeSensitive _ = False - -vicViperSize :: GLdouble -vicViperSize = 6 - -shieldPlacementMargin,shieldHitMargin :: GLdouble -shieldPlacementMargin = 5 -shieldHitMargin = 10 - -shieldMaxHp, hatchHP :: Int -shieldMaxHp = 16 -hatchHP = 15 - -diamondBombSize,smallBacterianSize,hatchHeight :: GLdouble -diamondBombSize = 6 -hatchHeight = 35 -smallBacterianSize = 16 - -freshDiamondBomb, freshFlyer, freshInterceptor, freshOption, freshPowerUpCapsule, freshPowerUpGauge, freshShield, freshStalk, freshStandardLaser, freshStandardMissile, freshStandardRailgun, freshTurnGear, freshTurnGearSquad, freshVicViper :: GameObject -freshDiamondBomb = DiamondBomb{tag=Nothing,position=0:+0,velocity=0:+0,hp=1,hitDisp=Circular (0:+0) diamondBombSize,age=0} -freshFlyer = Flyer{tag=Nothing,position=0:+0,velocity=(-3):+0,hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,mode=0} -freshInterceptor = freshFlyer{mode=1,velocity = 0:+0} -freshOption = Option{tag = Nothing, position=0:+0, hitDisp = Circular (0:+0) 0,optionTag = 0,reloadTime=0,weaponEnergy=100} -freshPowerUpCapsule = PowerUpCapsule{tag = Nothing, hitDisp = Circular (0:+0) 30,position = 0:+0,hp=1,age=0} -freshPowerUpGauge = PowerUpGauge{tag=Nothing, position = (-300):+(-240)} -freshShield = Shield{tag=Nothing,position=380:+0,hitDisp=Circular (0:+0) 0,hitDispLand=Circular (0:+0) 0,hp=shieldMaxHp,settled=False,size=0,placement=0:+0,angle=0,omega=0} -freshStalk = freshFlyer{mode=10,velocity = (-2):+0} -freshStandardLaser = StandardLaser{tag=Nothing,position=0:+0,hitDisp=Rectangular (laserSpeed/(-2):+(-laserBreadth)) (laserSpeed/2:+laserBreadth),hitDispLand = Rectangular (laserSpeed/(-2):+(-vicViperSize)) (laserSpeed/2:+vicViperSize),velocity=laserSpeed:+0,hp=1,parentTag=0,age=0} -freshStandardMissile = StandardMissile{tag=Nothing,position=0:+0,hitDisp=Circular 0 7,velocity=0:+0,hp=1,parentTag=0,probe=Probe{tag=Nothing,position=0:+0,hitDisp=Circular (0:+(-5)) 12,hp=1},mode=0} -freshStandardRailgun = StandardRailgun{tag=Nothing,position=0:+0,hitDisp=Circular 0 12,hitDispLand = Circular (0:+0) vicViperSize,velocity=shotSpeed:+0,hp=1,parentTag=0} -freshTurnGear = TurnGear{tag=Nothing,position=0:+0,velocity=0:+0,hp=1,hitDisp=Circular (0:+0) smallBacterianSize,age=0,managerTag=0,mode=0} -freshTurnGearSquad = SquadManager{tag=Nothing,position=0:+0, interval=10, age=0, - bonusScore=squadSize, currentScore=0, members = replicate squadSize freshTurnGear,items=[freshPowerUpCapsule]} where - squadSize=6 -freshVicViper = VicViper{tag = Nothing, position = 0:+0, hitDisp = Circular (0:+0) vicViperSize,hp=1, trail = repeat $ 0:+0, - speed = 1,powerUpPointer=(-1),powerUpLevels=array (0,5) [(x,0)|x<-[0..5]],reloadTime=0,weaponEnergy=100, - ageAfterDeath = 0} - -freshDucker :: GLdouble -> GameObject -freshDucker vg = Ducker{tag = Nothing, position = 0:+0, velocity= 0:+0, hitDisp = Circular (0:+0) smallBacterianSize, hp = 1, - age = 0, hasItem = False, gVelocity = 0:+(8*vg),charge = 0, vgun = 0:+0,touchedLand=False} -freshScrambleHatch :: GLdouble -> GameObject -freshScrambleHatch sign = ScrambleHatch{tag=Nothing,position=0:+0,hitDisp=regulate $ Rectangular ((-45):+0) (45:+(hatchHeight*(-sign))),gravity=(0:+sign),hp=hatchHP,age=0, - launchProgram = cycle $ replicate 40 [] ++ (concat.replicate 6) ([[freshInterceptor{velocity = 0:+(-6)*sign}]]++replicate 9 []),gateAngle=0 - } - -freshVolcano :: GLdouble -> GameObject -freshVolcano grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= - Shapes $ map (regulate.(\i -> Rectangular ((120 - 33*i + 2*i*i):+ sign*30*i) ((33*i - 2*i*i - 120) :+ sign*30*(i+1)) ) ) [0..4]} - where sign = (-grvty) - -freshTable :: GLdouble -> GameObject -freshTable grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= Shapes $ map (regulate.(\i -> Rectangular ((-2**(i+3)+shiftSinePi i):+sign*30*i) ((2**(i+3)+shiftSinePi i) :+sign*30*(i+1)))) [0..4] -} where - sign = (- grvty) - - shiftSinePi :: (Floating a) => a -> a - shiftSinePi a = 5 * sin (a*0.5*pi) - -freshGrashia, freshJumper, freshLandRoll :: GLdouble -> GameObject -freshGrashia sign= Grashia{tag=Nothing,position=0:+0,velocity=0:+0, - hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,gravity=(0:+sign),gunVector=0:+0,mode=0} -freshJumper sign=Jumper{tag=Nothing,position=0:+0,velocity=0:+0, - hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,gravity=(0:+0.36*sign),touchedLand=False,jumpCounter=0} -freshLandRoll sign = (freshGrashia sign){mode=1} - -freshLandScapeGround, freshSabbathicAgent :: GameObject -freshLandScapeGround = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp=Rectangular ((-158):+(-20)) (158:+20)} -freshSabbathicAgent = SabbathicAgent{tag=Nothing,fever=1} - -freshScore :: Int -> GameObject -freshScore point = ScoreFragment{tag=Nothing,score = point} - ------------------------------ --- --- game progress --- ------------------------------ - -updateMonadius :: [Key] -> Monadius -> Monadius -updateMonadius realKeys (Monadius (variables,objects)) - = Monadius (newVariables,newObjects) where - gameVariables = variables - gameObjects = objects - gameLevel = baseGameLevel gameVariables - bacterianShotSpeed = bacterianShotSpeedList!!gameLevel - - - keys = if hp vicViper<=0 then [] else realKeys - -- almost all operation dies when vicViper dies. use realKeys to fetch unaffected keystates. - - (newNextTag,newObjects) = issueTag (nextTag variables) $ - (loadObjects ++) $ - filterJust.map scroll $ - concatMap updateGameObject $ - gameObjectsAfterCollision - gameObjectsAfterCollision = collide objects - -- * collision must be done BEFORE updateGameObject(moving), for - -- players would like to see the moment of collision. - -- * loading new objects after collision and moving is nice idea, since - -- you then have new objects appear at exact place you wanted them to. - -- * however, some operation would like to refer the result of the collision - -- before it is actually taken effect in updateGameObject. - -- such routine should use gameObjectsAfterCollision. - - - newVariables = variables{ - nextTag = newNextTag, - flagGameover = flagGameover variables || ageAfterDeath vicViper > 240, - gameClock = (\c -> if hp vicViper<=0 then c else if goNextStage then 0 else c+1) $ gameClock variables, - baseGameLevel = (\l -> if goNextStage then l+1 else l) $ baseGameLevel variables, - totalScore = newScore, - hiScore = max (hiScore variables) newScore - } - where - goNextStage = gameClock variables > stageClearTime - newScore = totalScore variables + (sum) (map (\obj -> case obj of - ScoreFragment{score = p} -> p - _ -> 0) objects :: [Int]) - - updateGameObject :: GameObject -> [GameObject] - -- update each of the objects and returns list of resulting objects. - -- the list usually includes the modified object itself, - -- may include several generated objects such as bullets and explosions, - -- or include nothing if the object has vanished. - - updateGameObject vic@VicViper{} = newShields ++ makeMetalionShots vic{ - position=position vic + (vmag*(speed vic):+0) * (vx:+vy) , - trail=(if isMoving then ((position vic-(10:+0)):) else id) $ trail vic, - powerUpLevels = - (modifyArray gaugeOfShield (const (if (shieldCount > 0) then 1 else 0))) $ - (if doesPowerUp then ( - modifyArray (powerUpPointer vic) - (\x -> if x<powerUpLimits!!powerUpPointer vic then x+1 else 0) . -- overpowering-up results in initial powerup level. - (if powerUpPointer vic==gaugeOfGLdouble then modifyArray gaugeOfLaser (const 0) else id) . -- laser and double are - (if powerUpPointer vic==gaugeOfLaser then modifyArray gaugeOfGLdouble (const 0) else id) ) -- exclusive equippment. - else id) (powerUpLevels vic), - powerUpPointer = if doesPowerUp then (-1) else powerUpPointer vic, - speed = speeds !! (powerUpLevels vic!0), - reloadTime = max 0 $ reloadTime vic - 1, - ageAfterDeath = if hp vic>0 then 0 - else ageAfterDeath vic+1, - hitDisp = if treasure!!gameLevel then Circular 0 0 else Circular (0:+0) vicViperSize, - hp = if selfDestructButton `elem` keys then 0 else hp vic - } where - vx = (if (rightButton `elem` keys) then 1 else 0) + - (if (leftButton `elem` keys) then (-1) else 0) - vy = (if (upButton `elem` keys) then 1 else 0) + - (if (downButton `elem` keys) then (-1) else 0) - vmag = if vx*vx+vy*vy>1.1 then sqrt(0.5) else 1 - isMoving = any (\b -> elem b keys) [rightButton,leftButton,upButton,downButton] - doesPowerUp = (powerUpButton `elem` keys) && (powerUpPointer vic >=0) && - (powerUpPointer vic ==0 || - powerUpLevels vic!powerUpPointer vic<powerUpLimits!!powerUpPointer vic) - speeds = [2,4,6,8,11,14] ++ speeds - shieldCount :: Int - shieldCount = sum $ map (\o -> case o of - Shield{} -> 1 - _ -> 0) gameObjects - newShields = if (doesPowerUp && powerUpPointer vic==gaugeOfShield) then - [freshShield{position=350:+260 ,placement=40:+shieldPlacementMargin, angle=30,omega=10 }, - freshShield{position=350:+(-260),placement=40:+(-shieldPlacementMargin),angle=0 ,omega=(-10)}] - else [] - - updateGameObject option@Option{} = makeMetalionShots option{ - position = trail vicViper !! (10*optionTag option), - reloadTime = max 0 $ reloadTime option - 1 - } - - updateGameObject miso@StandardMissile{} = [ - miso{position=newpos, - mode = newmode, - velocity=v, - probe = (probe miso){position=newpos,hp=1} - } - ] where - newmode = if hp(probe miso) <= 0 then 1 else - if mode miso == 0 then 0 else 2 - v = case newmode of - 0 -> 3.5:+(-7) - 1 -> 8:+0 - 2 -> 0:+(-8) - _ -> 0 - newpos = position miso + v - - updateGameObject shot@StandardRailgun{} = if hp shot <=0 then [] else - [shot{position=position shot + velocity shot}] - - updateGameObject laser@StandardLaser{} = if hp laser <=0 then [] else - [laser{position=(\(x:+_) -> x:+parentY) $ position laser + velocity laser,age=age laser+1}] where - myParent = head $ filter (\o -> tag o==Just (parentTag laser)) gameObjects - _:+parentY = position myParent - - updateGameObject shield@Shield{} = if(hp shield<=0) then [] else [ - (if settled shield then - shield{ - position=target,size=shieldPlacementMargin+intToGLdouble (hp shield), - hitDisp = Circular (0:+0) (size shield+shieldHitMargin), - hitDispLand = Circular (0:+0) (size shield) - } - else - shield{hp=shieldMaxHp,size=5+intToGLdouble (hp shield),position=newPosition,settled=chaseFactor>0.6}) - {angle=angle shield + omega shield} - ] where - newPosition = position shield + v - v = difference * (chaseFactor:+0) - chaseFactor = (10/magnitude difference) - difference = target-position shield - target = position vicViper+(realPart (placement shield) :+ additionalPlacementY) - additionalPlacementY = signum (imagPart$placement shield)*size shield - - updateGameObject pow@PowerUpCapsule{} = if(hp pow<=0) then [freshScore 800] else [ - pow{age=age pow + 1} - ] ++ if powerUpCapsuleHitBack!!gameLevel && age pow ==1 then - map (\theta -> freshDiamondBomb{position=position pow,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ - take 8 $ iterate (+(2*pi/8)) (pi/8) else [] - - - updateGameObject bullet@DiamondBomb{} = if hp bullet<=0 then [] else - [bullet{position=position bullet + velocity bullet,age=age bullet+1}] - updateGameObject self@TurnGear{position=pos@(x:+y),mode=m} = if hp self<=0 then - [freshScore 50] ++ freshExplosions pos ++ if turnGearHitBack!!gameLevel then [scatteredNeraiDan pos (bacterianShotSpeed:+0)] else [] - else [ - self{ - position = position self + velocity self, - age = age self + 1, - mode = newmode, - velocity = newv - }] where - newv = case m of - 0 -> ((-4):+0) - 1 -> if (y - (imagPart.position) vicViper) > 0 then (3:+(-5)) else (3:+(5)) - _ -> if isEasy then 2:+0 else 6:+0 - newmode = if m==0 && x < (if not isEasy then -280 else 0) && (realPart.position) vicViper> (-270) then 1 else - if m==1 && abs (y - (imagPart.position) vicViper) < 20 then 2 else m - - updateGameObject me@SquadManager{position=pos,interval=intv,members=membs,age=clock,tag=Just myTag} = - if mySquadIsWipedOut then( - if currentScore me >= bonusScore me then map (\o -> o{position=pos}) (items me) else [] - )else me{ - age = age me + 1, - currentScore = currentScore me + todaysDeaths, - position = if clock <= releaseTimeOfLastMember then pos else warFront - }:dispatchedObjects where - dispatchedObjects = if (clock `div` intv < length membs && clock `mod` intv == 0) then - [(membs!!(clock `div` intv)){position=pos,managerTag=myTag}] else [] - todaysDeaths = sum $ map (\o -> if hp o <=0 then 1 else 0) $ mySquad - mySquadIsWipedOut = clock > releaseTimeOfLastMember && length mySquad <= 0 - warFront = position $ head $ mySquad - releaseTimeOfLastMember = intv * (length membs-1) - mySquad = filter (\o -> case o of - TurnGear{managerTag=hisManagerTag} -> hisManagerTag == myTag -- bad, absolutely bad code - _ -> False) gameObjectsAfterCollision - - updateGameObject this@Flyer{position=pos@(x:+_),age=myAge,mode=m,velocity =v} = - if gameClock variables > stageClearTime - 100 then freshExplosions pos else - if hp this <=0 then ([freshScore (if mode this == 10 then 30 else 110)] ++ freshExplosions pos++(if hasItem this then [freshPowerUpCapsule{position=pos}] else if flyerHitBack!!gameLevel then [scatteredNeraiDan pos (bacterianShotSpeed:+0)] else [])) - else - [this{ - age=myAge+1, - position = pos + v , - velocity = newV, - mode = newMode - }]++myShots where - newV = case m of - 00 -> (realPart v):+sin(intToGLdouble myAge / 5) - 01 -> v --if magnitude v <= 0.01 then if imagPart (position vicViper-pos)>0 then 0:+10 else 0:+(-10) else v - 02 -> (-4):+0 - 10 -> if (not isEasy) || myAge < 10 then stokeV else v - _ -> v - stokeV = angleAccuracy 16 $ (* ((min (speed vicViper*0.75) (intToGLdouble$round$magnitude v)):+0) ) $ unitVector $ position vicViper-pos - newMode = case m of - 01 -> if myAge > 20 && (position vicViper - pos) `innerProduct` v < 0 then 02 else 01 - _ -> m - myShots = if (myAge+13*(fromJust $tag this)) `mod` myInterval == 0 && (x <= (-80) || x <= realPart(position vicViper)) - then [jikiNeraiDan pos (bacterianShotSpeed:+0)] else [] - myInterval = if m==00 || m==03 then flyerShotInterval!!gameLevel else inceptorShotInterval!!gameLevel - - updateGameObject me@Ducker{position=pos@(_:+_),velocity = v,age=myAge,gVelocity= vgrav,touchedLand = touched} = - if hp me <=0 then ([freshScore 130] ++ freshExplosions pos ++ if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else - [me{ - age=myAge+1, - position = pos + v, - charge = if charge me <=0 && aimRate > 0.9 && aimRate < 1.1 then (duckerShotCount!!gameLevel)*7+3 - else ((\x -> if x>0 then x-1 else x) $ charge me), - vgun = unitVector $ aimX:+aimY, - velocity = if charge me >0 then 0:+0 else - if magnitude v <= 0.01 then ( - if realPart(position vicViper - pos)>0 then 3:+0 else (-3):+0 - ) else if touched then - ((realPart v):+(-imagPart vgrav)) - else (realPart v:+(imagPart vgrav)), - touchedLand = False - }]++myShots where - aimX:+aimY = position vicViper - pos - aimRate = (-(signum$realPart v))*aimX / (abs(aimY) +0.1) - myShots = if charge me `mod` 7 /= 6 then [] else - map (\w -> freshDiamondBomb{position=pos,velocity=w}) vs - vs = map (\vy -> (vgun me)*(bacterianShotSpeed:+(1.5*(vy)))) [-duckerShotWay!!gameLevel+1 , -duckerShotWay!!gameLevel+3 .. duckerShotWay!!gameLevel-0.9] - - updateGameObject me@Jumper{position=pos@(_:+_),velocity = v,age=_,gravity= g,touchedLand = touched} = - if hp me <=0 then ([freshScore 300] ++ freshExplosions pos ++if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else - [ - me{ - position = pos + v, - velocity = if touched then (signum(realPart $ position vicViper-pos)*abs(realPart v):+imagPart(jumpSize*g)) else v + g, - jumpCounter = (if touched && v`innerProduct` g >0 then (+1) else id) $ - (if doesShot then (+1) else id) $ jumpCounter me, - touchedLand = False - } - ] ++shots where - jumpSize = if jumpCounter me `mod` 4 == 2 then (-30) else (-20) - doesShot = jumpCounter me `mod` 4 == 2 && v`innerProduct` g >0 - shots = if doesShot then - map (\theta -> freshDiamondBomb{position=pos,velocity=mkPolar (bacterianShotSpeed*jumperShotFactor!!gameLevel) theta}) $ - take way $ iterate (+(2*pi/intToGLdouble way)) 0 - else [] - way=jumperShotWay!!gameLevel - - updateGameObject me@ScrambleHatch{position = pos,age=a} = - if hp me <=0 then [freshScore 3000] ++ freshMiddleExplosions pos ++ - if scrambleHatchHitBack!!gameLevel then hatchHitBacks else [] - else - [me{ - age = a + 1, - gateAngle = max 0$ min pi$ (if length currentLaunches>0 then (+1) else (+(-0.05))) $ gateAngle me - }] ++ currentLaunches where - currentLaunches = if a <= scrambleHatchLaunchLimitAge!!gameLevel then - (map (\obj -> obj{position = pos}) $ launchProgram me!!a) - else [] - hatchHitBacks = - (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) 0 )++ - (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.4) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) (pi/intToGLdouble way) ) - way = 16 - - - updateGameObject me@Grashia{position = pos} = - if hp me <=0 then ([freshScore 150] ++ freshExplosions pos++ if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else - [ - me{ - age=age me+1, - gunVector = unitVector $ position vicViper - pos, - position = position me + ((-3)*sin(intToGLdouble (age me*mode me)/8):+0) - } --V no shotto wo osoku - ] ++ if age me `mod` myInterval == 0 && age me `mod` 200 > grashiaShotHalt!!gameLevel then - [jikiNeraiDanAc (pos+gunVector me*(16:+0)) (grashiaShotSpeedFactor!!gameLevel*bacterianShotSpeed:+0) 64] else [] where - myInterval = if mode me == 0 then grashiaShotInterval!!gameLevel else landRollShotInterval!!gameLevel - - updateGameObject me@Particle{position = pos} = - if age me > expireAge me then (if particleHitBack!!gameLevel then [freshScore 10,scatteredNeraiDan pos (bacterianShotSpeed:+0)] else []) else - [me{ - age = age me + 1, - position = position me + (decay:+0) * velocity me - }] where - decay = exp $ - intToGLdouble (age me) / decayTime me - - updateGameObject me@LandScapeBlock{position = pos,velocity = v} = [me{position = pos+v}] - - updateGameObject DebugMessage{} = [] - - updateGameObject ScoreFragment{} = [] - - updateGameObject me@SabbathicAgent{fever = f} = if gameClock variables>stageClearTime-180 then [] else [ - me{ - fever = if launch then f+1 else f - }] - ++ if launch then map (\pos -> freshStalk{position = pos,velocity=(-4):+0,hasItem = (realPart pos>0 && (round $ imagPart pos :: Int) `mod` (3*round margin)==0)}) $ - concat $ map (\t -> [(340:+t),((-340):+t),(t:+(260)),(t:+(-260))]) $[(-margin*df),(((negate margin) * df) + (margin * 2))..(margin*df+1)] else [] where - launch = (<=0) $ length $ filter (\obj -> case obj of - Flyer{} -> True - _ -> False) objects - df = intToGLdouble f - 1 - margin :: GLdouble - margin = 20 - - updateGameObject x = [x] - - makeMetalionShots :: GameObject -> [GameObject] - {- this generates proper playerside bullets - according to the current power up state of vicviper. - both options and vicviper is updated using this. -} - - makeMetalionShots obj = obj{reloadTime=reloadTime obj+penalty1+penalty2, - weaponEnergy = max 0 $ min 100 $ weaponEnergy obj + if doesLaser then (-10) else 50 } - :(shots ++ missiles) where - (shots,penalty1) = if doesNormal then ([freshStandardRailgun{position=position obj,parentTag=myTag}] ,2) - else if doesGLdouble then ([freshStandardRailgun{position=position obj,parentTag=myTag},freshStandardRailgun{position=position obj,parentTag=myTag,velocity=mkPolar 1 (pi/4)*velocity freshStandardRailgun}] ,2) - else if doesLaser then ([freshStandardLaser{position=position obj+(shotSpeed/2:+0),parentTag=myTag}] ,1) - else ([],0) - penalty2 = if weaponEnergy obj <= 0 then 8 else 0 - missiles = if doesMissile then [freshStandardMissile{position=position obj}] else [] - doesShot = (isJust $tag obj) && (reloadTime obj <=0) && (shotButton `elem` keys) - doesNormal = doesShot && elem NormalShot types && (shotCount<2) - doesGLdouble = doesShot && elem GLdoubleShot types && (shotCount<1) - doesLaser = doesShot && elem Laser types - doesMissile = (isJust $tag obj) && elem Missile types && (missileButton `elem` keys) && (missileCount<=0) - myTag = fromJust $ tag obj - shotCount = length $ filter (\o -> case o of - StandardRailgun{} -> parentTag o==myTag - _ -> False) gameObjects - missileCount = length $ filter (\o -> case o of - StandardMissile{} -> True - _ -> False) gameObjects - - types = weaponTypes vicViper - - jikiNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject - -- an enemy bullet starting at position sourcePos and with relative velocity initVelocity. - -- bullet goes straight to vicviper if initVelocity is a positive real number. - jikiNeraiDanAc sourcePos initVelocity accuracy = freshDiamondBomb{ - position = sourcePos, - velocity = (*initVelocity) $ (angleAccuracy accuracy) $ unitVector $ position vicViper - sourcePos - } - jikiNeraiDan sourcePos initVelocity = jikiNeraiDanAc sourcePos initVelocity 32 - - scatteredNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject - -- a rather scattered jikiNeraiDan. - scatteredNeraiDan sourcePos initVelocity = freshDiamondBomb{ - position = sourcePos, - velocity = scatter $ (*initVelocity) $ (angleAccuracy 32) $ unitVector $ position vicViper - sourcePos - } where - scatter z = let (r,theta)=polar z in - mkPolar r (theta+pi/8*((^(3::Int)).sin)((intToGLdouble $ gameClock variables) + magnitude sourcePos)) - - freshExplosionParticle pos vel a = Particle{tag=Nothing,position=pos,velocity=vel,size=8,particleColor=Color3 1 0.5 0,age=a,decayTime=6,expireAge=20} - - freshExplosions pos = take 5 expls where - expls :: [GameObject] - expls = makeExp randoms - randoms = [square $ sin(9801*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] - makeExp (a:b:c:xs) = (freshExplosionParticle pos (mkPolar (3*a) (2*pi*b)) (round $ -5*c)):makeExp xs - makeExp _ = [] - - freshMiddleExplosions pos = take 16 expls where - expls :: [GameObject] - expls = makeExp randoms 0 - randoms = [square $ sin(8086*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] - makeExp (a:b:xs) i = (freshExplosionParticle (pos+mkPolar 5 (pi/8*i)) (mkPolar (6+3*a) (pi/8*i)) (round $ -5*b)){size=16}:makeExp xs (i+1) - makeExp _ _ = [] - - -- issue tag so that each objcet has unique tag, - -- and every object will continue to hold the same tag. - issueTag :: Int -> [GameObject] -> (Int,[GameObject]) - issueTag nt [] = (nt,[]) - issueTag nt (x:xs) = (newNextTag',taggedX:taggedXs) - where - (nextTagForXs,taggedX) = if(isNothing $ tag x) then (nt+1,x{tag = Just nt}) else (nt,x) - (newNextTag',taggedXs) = issueTag nextTagForXs xs - - collide :: [GameObject] -> [GameObject] - -- collide a list of GameObjects and return the result. - -- it is important NOT to delete any object at the collision -- collide, show then delete - collide = map personalCollide - where - -- each object has its own hitClasses and weakPoints. - -- collision is not symmetric: A may crushed by B while B doesn't feel A. - -- object X is hit by only objectsWhoseHitClassIsMyWeakPoint X. - personalCollide :: GameObject -> GameObject - personalCollide obj = foldr check obj $ objectsWhoseHitClassIsMyWeakPoint obj - - objectsWhoseHitClassIsMyWeakPoint :: GameObject -> [GameObject] - objectsWhoseHitClassIsMyWeakPoint me = - filter (\him -> not $ null $ (weakPoint me) `intersect` (hitClass him)) gameObjects - - hitClass :: GameObject -> [HitClass] - hitClass VicViper{} = [MetalionBody,ItemReceiver] - hitClass StandardMissile{} = [MetalionShot] - hitClass StandardRailgun{} = [MetalionShot] - hitClass StandardLaser{} = [MetalionShot] - hitClass Shield{} = [MetalionBody] - hitClass PowerUpCapsule{} = [PowerUp] - - hitClass DiamondBomb{} = [BacterianShot] - hitClass TurnGear{} = [BacterianBody] - hitClass Flyer{} = [BacterianBody] - hitClass Ducker{} = [BacterianBody] - hitClass Jumper{} = [BacterianBody] - hitClass Grashia{} = [BacterianBody] - hitClass ScrambleHatch{} = [BacterianBody,LaserAbsorber] - - hitClass LandScapeBlock{} = [LandScape] - hitClass _ = [] - - weakPoint :: GameObject -> [HitClass] - weakPoint VicViper{} = [PowerUp,BacterianBody,BacterianShot,LandScape] - weakPoint StandardMissile{} = [BacterianBody,LandScape] - weakPoint Probe{} = [LandScape] - weakPoint StandardRailgun{} = [BacterianBody,LandScape] - weakPoint StandardLaser{} = [LaserAbsorber,LandScape] - weakPoint Shield{} = [BacterianBody,BacterianShot,LandScape] - weakPoint PowerUpCapsule{} = [ItemReceiver] - - weakPoint DiamondBomb{} = [MetalionBody,LandScape] - weakPoint TurnGear{} = [MetalionBody,MetalionShot] - weakPoint Flyer{} = [MetalionBody,MetalionShot] - weakPoint Ducker{} = [MetalionBody,MetalionShot,LandScape] - weakPoint Jumper{} = [MetalionBody,MetalionShot,LandScape] - weakPoint Grashia{} = [MetalionBody,MetalionShot] - weakPoint ScrambleHatch{} = [MetalionBody,MetalionShot] - - weakPoint _ = [] - - -- after matching hitClass-weakPoint, you must check the shape of the pair of object - -- to see if source really hits the target. - check :: GameObject -> GameObject -> GameObject - check source target = case (source, target) of - (LandScapeBlock{},StandardMissile{}) -> if(hit source target) then (affect source target2) else target2 where - target2 = target{probe = if(hit source p) then (affect source p) else p} - p = probe target - _ -> if(hit source target) then (affect source target) else target - - -- if a is really hitting b, a affects b (usually, decreases hitpoint of b). - -- note that landScapeSensitive objects have special hitDispLand other than hitDisp. - -- this allows some weapons to go through narrow land features, and yet - -- wipe out wider area of enemies. - hit :: GameObject -> GameObject -> Bool - hit a b = case (a,b) of - (LandScapeBlock{},c) -> if landScapeSensitive c then (position a +> hitDisp a) >?< (position c +> hitDispLand c) - else (position a +> hitDisp a) >?< (position b +> hitDisp b) - _ -> (position a +> hitDisp a) >?< (position b +> hitDisp b) - - affect :: GameObject -> GameObject -> GameObject - affect VicViper{} obj = case obj of - pow@PowerUpCapsule{} -> pow{hp = hp pow-1} - x -> x - affect PowerUpCapsule{} obj = case obj of - viper@VicViper{} -> viper{powerUpPointer = (\x -> if x >=5 then 0 else x+1)$powerUpPointer viper} - _ -> error "Power capsule should not have been able to affect anything but the player craft." - affect StandardMissile{} obj = obj{hp = hp obj-(hatchHP`div`2 + 2)} -- 2 missiles can destroy a hatch - affect StandardRailgun{} obj = obj{hp = hp obj-(hatchHP`div`4 + 1)} -- 4 shots can also destroy a hatch - affect StandardLaser{} obj = obj{hp = hp obj-1} - affect Shield{} obj = obj{hp = hp obj-1} - - - affect DiamondBomb{} obj = obj{hp = hp obj-1} - affect TurnGear{} obj = obj{hp = hp obj-1} - affect Flyer{} obj = obj{hp = hp obj-1} - affect Ducker{} obj= obj{hp = hp obj-1} - affect Jumper{} obj= obj{hp = hp obj-1} - affect Grashia{} obj= obj{hp = hp obj-1} - affect ScrambleHatch{} obj= obj{hp = hp obj-1} - - affect LandScapeBlock{} obj = case obj of --- miso@StandardMissile{velocity=v} -> miso{velocity = (1:+0)*abs v} - duck@Ducker{} -> duck{touchedLand=True} - that@Jumper{} -> that{touchedLand=True} - _ -> obj{hp = hp obj-1} - - affect _ t = t - - scroll :: GameObject -> Maybe GameObject - -- make an object scroll. - -- if the object is to vanish out of the screen, it becomes Nothing. - scroll obj = let - (x:+y) = position obj - scrollBehavior :: GameObject -> ScrollBehavior - scrollBehavior VicViper{} = Enclosed False - scrollBehavior Option {} = NoRollOut False - -- We use the more verbose way of setting records here to guarantee - -- 'range' is needed so -Wall doesn't get fooled. - scrollBehavior StandardRailgun{} = RollOutAuto {doesScroll = True, range = shotSpeed} - scrollBehavior StandardLaser{} = RollOutAuto True laserSpeed - scrollBehavior PowerUpGauge{} = NoRollOut False - scrollBehavior PowerUpCapsule{} = RollOutAuto True 40 - scrollBehavior Shield{} = NoRollOut False - - scrollBehavior DiamondBomb{} = RollOutAuto False 10 - scrollBehavior TurnGear{} = RollOutAuto False 20 - scrollBehavior SquadManager{} = NoRollOut False - scrollBehavior ScrambleHatch{} = RollOutAuto True 60 - - scrollBehavior LandScapeBlock{} = RollOutAuto True 160 - - scrollBehavior Star{} = RollOutFold True - - scrollBehavior DebugMessage{} = NoRollOut False - scrollBehavior ScoreFragment{} = NoRollOut False - scrollBehavior SabbathicAgent{} = NoRollOut False - - scrollBehavior _ = RollOutAuto True 40 - - scrollSpeed = if hp vicViper <= 0 then 0 else if gameClock variables <=6400 then 1 else 2 - rolledObj = if doesScroll $ scrollBehavior obj then obj{position=(x-scrollSpeed):+y} else obj - in case scrollBehavior obj of - Enclosed _ -> Just rolledObj{position = (max (-300) $ min 280 x):+(max (-230) $ min 230 y)} - NoRollOut _ -> Just rolledObj - RollOutAuto _ r -> if any (>r) [x-320,(-320)-x,y-240,(-240)-y] then Nothing - else Just rolledObj - RollOutFold _ -> Just rolledObj{position = (if x< -320 then x+640 else x):+y} where - (_:+_) = position rolledObj - - loadObjects :: [GameObject] - -- a list of objects that are to newly loaded at this frame. - - loadObjects = if hp vicViper<=0 then [] else (case clock of - -- stage layout. - -- just like old BASIC code. - 150 -> [freshTurnGearSquad{position=340:+(180)}] - 300 -> [freshTurnGearSquad{position=340:+(-180)}] - 400 -> [freshTurnGearSquad{position=340:+(180)}] - 500 -> [freshTurnGearSquad{position=340:+(-180)}] - 633 -> map (\y -> freshStalk{position = 340:+y,hasItem=False }) [-120,120] ++ [freshStalk{position = 340:+0,hasItem=isEasy}] - 666 -> map (\y -> freshStalk{position = 340:+y,hasItem=isEasy}) [-130,130] ++ [freshStalk{position = 340:+0,hasItem=False}] - 700 -> map (\y -> freshStalk{position = 340:+y,hasItem=False }) [-140,140] ++ [freshStalk{position = 340:+0,hasItem=True}] - 733 -> map (\y -> freshStalk{position = 340:+y,hasItem=isEasy}) [-150,150] ++ [freshStalk{position = 340:+0,hasItem=False}] - 900 -> [freshTurnGearSquad{position=340:+(-180)}] - 1000 -> [freshTurnGearSquad{position=340:+(180)}] - 1050 -> map (\y -> freshStalk{position = 340:+y}) [-135,0,135] - 1250 -> map (\y -> freshFlyer{position = 340:+y}) [-150,-100] - 1300 -> map (\y -> freshFlyer{position = 340:+y,hasItem=True}) [100,150] - 1100 -> [freshTurnGearSquad{position=340:+(-180)},freshTurnGearSquad{position=340:+(180)}] - 1400 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshGrashia 1){position = 340:+(185)}] - 1450 -> [(freshGrashia (-1)){position = 340:+(-185),hasItem=True},(freshGrashia 1){position = 340:+(185)}] - 1550 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] - 1700 -> [(freshVolcano (-1)){position=479:+(-200)}] - 1900 -> map (\(g,x) -> (freshDucker g){position=x:+g*100}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] - 1940 -> [(freshLandRoll (1)){position = 340:+(185)}] - 1965 -> [(freshLandRoll (1)){position = 340:+(185)}] - 1990 -> [(freshLandRoll (1)){position = 340:+(185)}] - 2000 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshDucker (-1)){position=(-340):+(-185)}] - 2033 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshDucker 1){position=(-340):+(185)}] - 2100 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] - 2200 -> [(freshVolcano 1){position=479:+(200)}] - 2250 -> map (\y -> freshStalk{position = 340:+y}) [-150,0,150] - 2339 -> [(freshGrashia (1)){position = 340:+35},(freshGrashia (-1)){position = 340:+(-185)}] - - 2433 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] - 2466 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] - 2499 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] - - 2620 -> [(freshDucker 1){position=(-340):+(200)}] - 2640 -> [(freshDucker 1){position=(-340):+(200),hasItem=True}] - 2800 -> map (\(g,x) -> (freshJumper g){position=x:+g*100,velocity=((-3)*signum x):+0}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] - 2999 -> [(freshVolcano 2){position=479:+(20),velocity=(0:+(-0.5))},(freshVolcano (-2)){position=479:+(-20),velocity=(0:+(0.5))}] - - 3200 -> concat $ map (\x -> [freshLandScapeGround{position=(479-x):+220},freshLandScapeGround{position=(479-x):+(-220)}]) [320,640] - - 3210 -> [freshFlyer{position = 340:+150},freshFlyer{position = 340:+100,hasItem=True}] - 3290 -> [freshFlyer{position = 340:+(-150)},freshFlyer{position = 340:+(-100),hasItem=True}] - 3350 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] ++ if isRevival then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] - 3400 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] ++ if isRevival then [] else [(freshJumper (-1)){position = (-340):+(-150),velocity=3:+0}] - 3450 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] - 3500 -> [(freshVolcano (-1)){position=479:+(-200)}] - 3579 -> [(freshGrashia (-1)){position = 340:+(-100)}] - 3639 -> [(freshGrashia (-1)){position = 340:+(-40)}] - 3699 -> [(freshGrashia (-1)){position = 340:+(-100)}] - 3501 -> [(freshScrambleHatch (1)){position = 360:+(200)}] - 3600 -> [(freshScrambleHatch (1)){position = 360:+(200)}] - 3582 -> [(freshDucker (-1)){position=(340):+(-200)}] - 3612 -> [(freshDucker (-1)){position=(340):+(-200)}] - 3642 -> [(freshDucker (-1)){position=(340):+(-200)}] - 3672 -> [(freshDucker (-1)){position=(340):+(-200)}] - 3702 -> [(freshDucker (-1)){position=(340):+(-200),hasItem=True}] - 3703 -> [(freshLandRoll (1)){position=(340):+(185),hasItem=True}] - 3820 -> map (\y -> freshFlyer{position = 340:+y}) [-100,100] - 3840 -> map (\y -> freshFlyer{position = 340:+y}) [-110,110] - 3860 -> map (\y -> freshFlyer{position = 340:+y}) [-120,120] - 3880 -> map (\y -> freshFlyer{position = 340:+y,hasItem = isEasy}) [-130,130] - 3900 -> [freshTurnGearSquad{position=340:+0}] - 4000 -> [(freshTable 1){position=450:+200}] - 4033 -> [(freshGrashia (1)){position = 340:+(185)}] - 4066 -> [(freshGrashia (1)){position = 340:+(185)}] - 4060 -> [(freshGrashia (1)){position = 340:+(40)}] - 4110 -> [(freshGrashia (1)){position = 340:+(40)}] - 4160 -> [(freshGrashia (1)){position = 340:+(40)}] - 4166 -> [(freshGrashia (1)){position = 340:+(185),hasItem=True}] - 4200 -> [(freshGrashia (1)){position = 340:+(185),hasItem=True}] - 4233 -> [(freshGrashia (1)){position = 340:+(185),hasItem=False}] - 4266 -> [(freshGrashia (1)){position = 340:+(185),hasItem=False}] - 4150 -> [freshLandScapeGround{position=479:+(-180)}] - 4203 -> [(freshJumper (-1)){position = 340:+(-180)}] - 4273 -> [(freshJumper (-1)){position = 340:+(-180)}] - 4343 -> [(freshJumper (-1)){position = 340:+(-180)}] - 4490 -> [(freshTable (-1)){position=450:+(-200)}] - 4500 -> [(freshDucker (-1)){position=340:+0}] - 4520 -> [(freshDucker (-1)){position=340:+0}] - 4540 -> [(freshDucker (-1)){position=340:+0}] - 4560 -> [(freshGrashia (-1)){position = 340:+(-185)}] - 4580 -> [(freshScrambleHatch (-1)){position = 360:+(-50)}] - 4603 -> if isRevival then [] else [(freshDucker 1){position = (-340):+0},(freshJumper (1)){position = (-340):+150,velocity=3:+0}] - 4663 -> [(freshDucker 1){position = (-340):+0}]++if isEasy then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] - 4723 -> if isRevival then [] else [(freshDucker 1){position = (-340):+0},(freshJumper (1)){position = (-340):+150,velocity=3:+0}] - 4783 -> [(freshDucker 1){position = (-340):+0}]++if isEasy then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] - 4680 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] - 4900 -> map (\y -> freshFlyer{position = 340:+y}) [-100,100] - 4930 -> map (\y -> freshFlyer{position = 340:+y}) [-66,66] - 4960 -> map (\y -> freshFlyer{position = 340:+y}) [-33,33] - 4990 -> map (\y -> freshFlyer{position = 340:+y,hasItem=True}) [0] - 5041 -> [(freshDucker (-1)){position = 340:+(-180)}] - 5061 -> [(freshDucker (-1)){position = 340:+(-180)}] - 5081 -> [(freshDucker (-1)){position = 340:+(-180)}] - 5101 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) - 5121 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) - 5141 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) - 5261 -> [freshTurnGearSquad{position=340:+(-150)}] - 5364 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] - 5151 -> [(freshDucker (-1)){position = (-340):+(0)}] - 5181 -> [(freshDucker (-1)){position = (-340):+(0)}] - 5211 -> [(freshDucker (-1)){position = (-340):+(0)}] - 5241 -> [(freshDucker (-1)){position = (-340):+(0)}] - 5321 -> [(freshDucker (-1)){position = 340:+150}] ++ if isEasy then [] else [(freshJumper (1)){position = (-340):+(180),velocity = 3:+0}] - 5361 -> [(freshDucker (-1)){position = 340:+150}] - 5401 -> [(freshDucker (-1)){position = 340:+150}] - 5441 -> [(freshDucker (-1)){position = 340:+150}] ++ if isEasy then [] else map (\y -> freshStalk{position = 340:+y}) [-140,-70,0] - 5461 -> [(freshDucker (-1)){position = 340:+150}] - 5451 -> [(freshGrashia (-1)){position = 340:+160,hasItem=True}] - - 5060 -> [(freshVolcano (-1)){position = 480:+(-100)}] - 5200 -> [(freshGrashia (-1)){position = 340:+70}] ++ [(freshDucker (-1)){position = 340:+70}] - 5235 -> [(freshGrashia (-1)){position = 340:+40}] ++ [(freshDucker (-1)){position = 340:+40}] - 5258 -> [(freshGrashia (-1)){position = 340:+10}] ++ [(freshDucker (-1)){position = 340:+10}] - 5285 -> [(freshGrashia (-1)){position = 340:+(-20)}] ++ [(freshDucker (-1)){position = 340:+(-20)}] - 5316 -> [(freshGrashia (-1)){position = 340:+(-50)}] ++ [(freshDucker (-1)){position = 340:+(-50)}] - - 5310 -> [(freshVolcano (1)){position = 480:+(150)}] - 5450 -> [(freshGrashia (1)){position = 340:+(-20)}] - 5485 -> [(freshGrashia (1)){position = 340:+10}] - 5508 -> [(freshGrashia (1)){position = 340:+40}] - 5535 -> [(freshGrashia (1)){position = 340:+70}] - 5566 -> [(freshGrashia (1)){position = 340:+100}] - - 5811 -> [(freshDucker (-1)){position = (-340):+0}] - 5841 -> [(freshDucker (-1)){position = (-340):+0}] - 5871 -> [(freshDucker (-1)){position = (-340):+0}] - 5901 -> [(freshDucker (-1)){position = (-340):+0}] - 6001 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] - 6031 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] - 6061 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] - 6091 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] - - 5800 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] - 5950 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] - 6100 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] - 6116 -> [freshSabbathicAgent] - - _ -> []) ++ - (if(optionCount < powerUpLevels vicViper!4) then - [freshOption{position=position vicViper, optionTag = optionCount+1}] - else []) ++ - (if (clock `mod` 320 == 0 && clock>=1280 && clock <= 6400) then - [freshLandScapeGround{position=479:+220},freshLandScapeGround{position=479:+(-220)}] - else []) - - where - clock = gameClock variables - optionCount = length $ filter (\o -> case o of - Option{} -> True - _ -> False) gameObjects - isRevival = optionCount <= 0 - isEasy = gameLevel <= 1 - - vicViper = fromJust $ find (\obj -> case obj of - VicViper{} -> True - _ -> False) objects - --- things needed both for progress and rendering -powerUpLimits :: [Int] -powerUpLimits = [5,1,1,1,4,1] -weaponTypes :: GameObject -> [WeaponType] -weaponTypes viper@VicViper{} = - [if powerUpLevels viper!gaugeOfGLdouble>0 then GLdoubleShot else - if powerUpLevels viper!gaugeOfLaser>0 then Laser else - NormalShot] ++ - if powerUpLevels viper!gaugeOfMissile>0 then [Missile] else [] - -weaponTypes _ = [] - -------------------------- --- --- drawing --- -------------------------- -renderMonadius :: Monadius -> IO () -renderMonadius (Monadius (variables,objects)) = do - putDebugStrLn $ show $ length objects - mapM_ renderGameObject objects - preservingMatrix $ do - translate (Vector3 (-300) (220) (0 :: GLdouble)) - renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do - scale (0.2 :: GLdouble) 0.2 0.2 - renderString MonoRoman scoreStr - preservingMatrix $ do - translate (Vector3 (0) (220) (0 :: GLdouble)) - renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do - scale (0.2 :: GLdouble) 0.2 0.2 - renderString MonoRoman scoreStr2 - where - scoreStr = "1P " ++ ((padding '0' 8).show.totalScore) variables - scoreStr2 = if isNothing $ playTitle variables then "HI "++((padding '0' 8).show.hiScore) variables else (fromJust $ playTitle variables) - - gameclock = gameClock variables - - -- returns an IO monad that can render the object. - renderGameObject :: GameObject -> IO () - renderGameObject gauge@PowerUpGauge{} = preservingMatrix $ do - let x:+y = position gauge - translate (Vector3 x y 0) - color (Color3 (1.0 :: GLdouble) 1.0 1.0) - mapM_ (\(i,j) -> (if(i==activeGauge)then renderActive else renderNormal) j (isLimit i) i) $ - zip [0..5] [0,90..450] where - w=80 - h=20 - renderNormal x l i = preservingMatrix $ do - color (Color3 0.7 0.8 (0.8 :: GLdouble)) - preservingMatrix $ do - translate (Vector3 x 0 (0 :: GLdouble)) - renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(w,0),(w,h),(0,h)] - if l then renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),(w,h),(w,0),(0,h)] else return() - preservingMatrix $ do - ugoTranslate x 0 0 3 - translate (Vector3 (w/2) 0 (0 :: GLdouble)) - rotate (3 * sin(intToGLdouble gameclock/10)) (Vector3 0 0 (1 :: GLdouble)) - translate (Vector3 (-w/2) 0 (0 :: GLdouble)) - renderPowerUpName i - - renderActive x l i = preservingMatrix $ do - color (Color3 1 1 (0 :: GLdouble)) - preservingMatrix $ do - translate (Vector3 x 0 0) - renderPrimitive LineLoop $ ugoVertices2DFreq 0 5 2 [(0,0),(w,0),(w,h),(0,h)] - if l then renderPrimitive Lines $ ugoVertices2DFreq 0 5 2 [(0,0),(w,h),(w,0),(0,h)] else return() - preservingMatrix $ do - ugoTranslateFreq x 0 0 5 2 - translate (Vector3 (w/2) 0 (0 :: GLdouble)) - rotate (10 * sin(intToGLdouble gameclock/5)) (Vector3 0 0 (1 :: GLdouble)) - scale 1.2 1.2 (0 :: GLdouble) - translate (Vector3 (-w/2) 0 (0 :: GLdouble)) - renderPowerUpName i - activeGauge = powerUpPointer vicViper - isLimit i = powerUpLevels vicViper!i>=powerUpLimits!!i - renderPowerUpName i = do - translate (Vector3 6 3.5 (0 :: GLdouble)) - scale (0.15 :: GLdouble) 0.13 0.15 - renderString Roman $ ["SPEED","MISSILE","DOUBLE","LASER","OPTION"," ?"]!!i - - renderGameObject vic@VicViper{position = x:+y} = if hp vic<=0 then preservingMatrix $ do - translate (Vector3 x y 0) - scale pishaMagnitudeX pishaMagnitudeY 0 - renderWithShade (Color3 (1.0 :: GLdouble) 0 0) (Color3 (1.0 :: GLdouble) 0.6 0.4) $ do - renderPrimitive LineLoop $ ugoVertices2DFreq 0 1 1 - [(0,12),(8,8),(10,4),(20,0),(10,-4),(8,-8),(0,-12),(-8,-8),(-10,-4),(-20,0),(-10,4),(-8,8)] - else preservingMatrix $ do - translate (Vector3 x y 0) - renderWithShade (Color3 (1.0 :: GLdouble) 1.0 1.0) (Color3 (0.4 :: GLdouble) 0.4 0.6) $ do - renderPrimitive LineStrip $ ugoVertices2D 0 2 - [((-14),(-1)),((-12),5),((-20),13),(-14,13),(2,5),(8,1),(32,1),(32,(-1)),(24,(-3)),(16,(-3))] - renderPrimitive LineStrip $ ugoVertices2D 0 2 - [((-10),(-1)),(14,(-1)),(18,(-5)),(4,(-9)),((-2),(-9))] - renderPrimitive LineLoop $ ugoVertices2D 0 2 - [((-18),3),((-16),3),((-16),(-3)),((-18),(-3))] - renderWithShade (Color3 (0.92 :: GLdouble) 0.79 0.62) (Color3 (0.75 :: GLdouble) 0.38 0.19) $ do - renderPrimitive LineStrip $ ugoVertices2D 0 2 - [(4,3),(6,5),(14,5),(22,1)] --cockpit - renderWithShade (Color3 (0.6 :: GLdouble) 0.8 1.0) (Color3 0.19 0.38 (0.75 :: GLdouble)) $ do - renderPrimitive LineLoop $ ugoVertices2D 0 2 - [((-14),(-1)),((-10),(-1)),((-2),(-9)),((-4),(-9)),((-10),(-7)),((-14),(-3))] -- identification blue coting - renderWithShade (Color3 (0 :: GLdouble) 0 0.8) (Color3 (0.0 :: GLdouble) 0.0 0.4) $ do - renderPrimitive LineLoop $ ugoVertices2D 0 4 - [((-36),1),((-28),5),((-24),5),((-20),1),((-20),(-1)),((-24),(-5)),((-28),(-5)),((-36),(-1))] -- backfire - where - pishaMagnitudeX :: GLdouble - pishaMagnitudeY :: GLdouble - pishaMagnitudeX = max 0 $ (8*) $ (\z -> z*(1-z)) $ (/20) $ intToGLdouble $ ageAfterDeath vic - pishaMagnitudeY = max 0 $ (5*) $ (\z -> z*(1-z)) $ (/15) $ intToGLdouble $ ageAfterDeath vic - - renderGameObject Option{position = x:+y} = preservingMatrix $ do - translate (Vector3 x y 0) - renderWithShade (Color3 (0.8 :: GLdouble) 0 0) (Color3 (0.4 :: GLdouble) 0 0) $ - renderPrimitive LineLoop $ ugoVertices2D 0 2 - [(5,9),(9,7),(13,3),(13,(-3)),(9,(-7)),(5,(-9)), - ((-5),(-9)),((-9),(-7)),((-13),(-3)),((-13),3),((-9),7),((-5),9)] - renderWithShade (Color3 (1.0 :: GLdouble) 0.45 0) (Color3 (0.4 :: GLdouble) 0.2 0) $ - renderPrimitive LineStrip $ ugoVertices2D 0 1 - [((-12.0),(3.4)),(0.8,8.7),((-8.1),(-0.9)),(4.0,5.8),(4.3,5.6), - ((-4.4),(-6.8)),((-4.1),(-6.9)),(8.3,0.8),(9.0,0.6),(2.0,(-7.2))] - - renderGameObject StandardMissile{position=x:+y,velocity=v} = preservingMatrix $ do - let dir = (phase v) :: GLdouble - translate (Vector3 x y 0) - rotate (dir / pi * 180) (Vector3 0 0 (1 :: GLdouble)) - color (Color3 (1.0 :: GLdouble) 0.9 0.5) - renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(-7,2),(-7,-2)] - renderPrimitive LineStrip $ ugoVertexFreq (-11) 0 0 1 1 >> ugoVertexFreq (-17) 0 0 7 1 - - renderGameObject StandardRailgun{position=x:+y,velocity=v} = - preservingMatrix $ do - let (_,phse)=polar v - translate (Vector3 x y 0) - rotate (phse / pi * 180) (Vector3 0 0 (1 :: GLdouble)) - color (Color3 (1.0 :: GLdouble) 0.9 0.5) - renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),((-5),0),((-9),0),((-11),0)] - - renderGameObject laser@StandardLaser{position=x:+y,velocity=v} = - if age laser < 1 then return () - else preservingMatrix $ do - let (_,phs)=polar v - translate (Vector3 x y 0) - rotate (phs / pi * 180) (Vector3 0 0 (1 :: GLdouble)) - color (Color3 (0.7 :: GLdouble) 0.9 1.0) - renderPrimitive Lines $ ugoVertices2D 0 0 [(12,0),(-laserSpeed,0)] - - renderGameObject Shield{position=x:+y, size = r,angle = theta} = preservingMatrix $ do - translate (Vector3 x y 0) - rotate theta (Vector3 0 0 (1 :: GLdouble)) - renderWithShade (Color3 (0.375 :: GLdouble) 0.75 0.9375) (Color3 (0.86 :: GLdouble) 0.86 0.86) $ do - scale r r 0 - renderTriangle - rotate 60 (Vector3 0 0 (1 :: GLdouble)) - renderTriangle where - renderTriangle = do - renderPrimitive LineLoop $ ugoVertices2DFreq 0 0.1 1 $ map (\t -> (cos t,sin t)) [0,pi*2/3,pi*4/3] - - renderGameObject powerUpCapsule@PowerUpCapsule{} = preservingMatrix $ do - let x:+y = position powerUpCapsule - translate (Vector3 x y 0) - renderWithShade (Color3 (0.9 :: GLdouble) 0.9 0.9) (Color3 (0.4 :: GLdouble) 0.4 0.4) $ do - futa >> neji >> toge - rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge - rotate (180) (Vector3 0 1 (0 :: GLdouble)) >> futa >> neji >> toge - rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge - renderWithShade (Color3 (1.0 :: GLdouble) 0.0 0.0) (Color3 (0.3 :: GLdouble) 0.3 0.0) $ do - nakami - where - futa = renderPrimitive LineStrip $ ugoVertices2D 0 1 [((-10),6),((-6),10),(6,10),(10,6)] - neji = (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(12,4),(12,(-4))]) >> - (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(16,2),(16,(-2))]) - toge = renderPrimitive LineStrip $ ugoVertices2D 0 1 [(10,8),(16,14)] - nakami = rotate 145 (Vector3 0.2 0.2 (1 :: GLdouble)) >> scale 9 6 (1 :: GLdouble) >> - (renderPrimitive LineStrip $ ugoVertices2D 0 0.2 $ map (\n -> (cos$n*pi/8,sin$n*pi/8)) [1,15,3,13,5,11,7,9]) - - renderGameObject DiamondBomb{position = (x:+y),age=clock} = preservingMatrix $ do - translate (Vector3 x y 0) - rotate (90*intToGLdouble(clock`mod`4)) (Vector3 0 0 (1 :: GLdouble)) - color (Color3 (1 :: GLdouble) 1 1) - renderPrimitive LineLoop $ vertices2D 0 $ [a,b,c] - color (Color3 (0.5 :: GLdouble) 0.5 0.5) - renderPrimitive Lines $ vertices2D 0 $ [a,d,a,e] - renderPrimitive LineStrip $ vertices2D 0 $ [c,d,e,b] - where - [a,b,c,d,e] = [(0,0),(r,0),(0,r),(-r,0),(0,-r)] - r = diamondBombSize - -- c - -- /|\ - -- d-a-b - -- \|/ - -- e - renderGameObject TurnGear{position=x:+y,age=clock} = preservingMatrix $ do - translate (Vector3 x y 0) - color (Color3 1.0 0.7 1.0 :: Color3 GLdouble) - rotate (5 * intToGLdouble clock) (Vector3 0 0 1 :: Vector3 GLdouble) - renderWing - rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) - renderWing - rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) - renderWing - where - renderWing = renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map ((\(t:+u) -> (t,u)) . (\(r,t) -> mkPolar r (pi*t)) ) - [(3,0), (3,2/3), (smallBacterianSize,1/3), (smallBacterianSize,0), (smallBacterianSize+3,-1/3)] - - renderGameObject Flyer{position=x:+y,age=_,velocity = v,hasItem=item} = preservingMatrix $ do - translate (Vector3 x y 0) - color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) - rotate (phase v / pi * 180) (Vector3 0 0 (1 :: GLdouble)) - renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(-2,0),(-6,4),(-10,0),(-6,-4)] - renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,4),(16,4),(4,16),(-10,16)] - renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,-4),(16,-4),(4,-16),(-10,-16)] - - renderGameObject Ducker{position = (x:+y),hitDisp=hd,hasItem=item,velocity = v,gVelocity = g,age = a} = preservingMatrix $ do - translate (Vector3 x y 0) - if signum (imagPart g) > 0 then scale 1 (-1) (1 :: GLdouble) else return () - if signum (realPart v) < 0 then scale (-1) 1 (1 :: GLdouble) else return () - --after this, ducker is on the lower ground, looking right - color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) - renderShape (0:+0) hd - renderPrimitive LineStrip $ vertices2D 0 [(0,0),(kx,ky),(fx,fy)] - where - fx:+fy=foot $ intToGLdouble a/2 - kx:+ky=knee $ intToGLdouble a/2 - foot theta = (16*cos(-theta)):+(-16+8*sin(-theta)) - knee theta = foot theta * (0.5 :+ (- sqrt(square(legLen/magnitude(foot theta)) - 0.25))) - legLen = 16 - - renderGameObject Jumper{position = (x:+y),hitDisp=hd,hasItem=item,gravity = g,velocity=v} = preservingMatrix $ do - translate (Vector3 x y 0) - color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) - renderShape (0:+0) hd - if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down - renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(15,-5),(25,-5+absvy*leg),(25,-25+absvy*leg)] - renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(-15,-5),(-25,-5+absvy*leg),(-25,-25+absvy*leg)] - where - gsign = signum $ imagPart g - absvy = imagPart v * gsign -- if falling (+) ascending (-) - leg = 1.5 - - renderGameObject Grashia{position = (x:+y),hitDisp=hd,hasItem=item,gunVector = nv,gravity = g,mode=m} = preservingMatrix $ do - color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) - translate (Vector3 x y 0) - renderShape (0:+0) hd - renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map (\r -> (nvx*r,nvy*r)) [16,32] - if m == 1 then do - renderShape 0 $ Circular (16:+12*gsign) 4 - renderShape 0 $ Circular ((-16):+12*gsign) 4 - else return () - where - nvx:+nvy = nv - gsign = signum $ imagPart g - - renderGameObject me@ScrambleHatch{position = (x:+y),hitDisp=_,gravity= g,gateAngle = angl} = preservingMatrix $ do - translate (Vector3 x y 0) - color (Color3 (1.2*(1-hpRate)) 0.5 (1.6*hpRate) :: Color3 GLdouble) - if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down - renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*2) 1 $ [(-45,1),(-45,hatchHeight),(45,hatchHeight),(45,1)] - preservingMatrix $ do - translate (Vector3 45 hatchHeight (0 :: GLdouble)) - rotate (-angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) - renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(-45,0),(-45,10)] - preservingMatrix $ do - translate (Vector3 (-45) hatchHeight (0 :: GLdouble)) - rotate (angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) - renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(45,0),(45,10)] - where - gsign = signum $ imagPart g - hpRate = (intToGLdouble $ hp me)/(intToGLdouble hatchHP) - - renderGameObject LandScapeBlock{position=pos,hitDisp=hd} = preservingMatrix $ do - color (Color3 0.6 0.2 0 :: Color3 GLdouble) - renderShape pos hd - if treasure!!(baseGameLevel variables) then do - color (Color3 0.7 0.23 0 :: Color3 GLdouble) - translate (Vector3 0 0 (60 :: GLdouble)) - renderShape pos hd - color (Color3 0.5 0.17 0 :: Color3 GLdouble) - translate (Vector3 0 0 (-120 :: GLdouble)) - renderShape pos hd - else return() - - renderGameObject me@Particle{position = x:+y,particleColor=Color3 mr mg mb} = preservingMatrix $ do - if age me>=0 then do - translate (Vector3 x y 0) - color (Color3 r g b) - renderShape (0:+0) $ Circular (0:+0) (size me*extent) - else return () - where - extent = 0.5 + intCut (intToGLdouble(age me) / decayTime me) - decay = exp $ intCut $ -intToGLdouble (age me) / decayTime me - whiteout = exp $ intCut $ -2*intToGLdouble (age me) / decayTime me - r = mr * decay + whiteout - g = mg * decay + whiteout - b = mb * decay + whiteout - intCut :: GLdouble -> GLdouble - intCut = intToGLdouble.round - - renderGameObject Star{position = x:+y,particleColor=c} = preservingMatrix $ do - color c - renderPrimitive LineStrip $ ugoVertices2D 0 2 [(0.1+x,0+y),(-0.1+x,0+y)] - - - renderGameObject DebugMessage{debugMessage=str} = - putDebugStrLn str - - renderGameObject _ = return () - vicViper = fromJust $ find (\obj -> case obj of - VicViper{} -> True - _ -> False) objects - - renderShape :: Complex GLdouble -> Shape -> IO () - renderShape (x:+y) s = case s of - Rectangular{bottomLeft = (l:+b), topRight = (r:+t)} -> - renderPrimitive LineLoop $ vertices2D 0 [(x+l,y+b),(x+l,y+t),(x+r,y+t),(x+r,y+b)] - Circular{center=cx:+cy, radius = r} -> preservingMatrix $ do - translate (Vector3 (cx+x) (cy+y) 0) - rotate (intToGLdouble gameclock*(45+pi)) (Vector3 0 0 (1 :: GLdouble)) - scale r r 1 - renderPrimitive LineLoop $ vertices2D 0 $ map (\t -> (cos(2/7*t*pi),sin(2/7*t*pi))) [0..6] - Shapes{children=cs} -> mapM_ (renderShape (x:+y)) cs - - - renderWithShade :: ColorComponent a=>Color3 a -> Color3 a -> IO () -> IO () - renderWithShade colorA colorB rndrr = do - color colorB - preservingMatrix $ do - translate $ Vector3 1 (-1) (-1 :: GLdouble) - rndrr - color colorA - preservingMatrix rndrr - --- ugoVertex :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO () --- ugoVertex x y z r = ugoVertexFreq x y z r standardUgoInterval - - ugoVertexFreq :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> Int -> IO () - -- renders a vertex at somewhere near (x y z), - -- but the point wiggles around in ugoRange when each interval comes. - ugoVertexFreq x y z ugoRange intrvl = vertex $ Vertex3 (x+dr*cos theta) (y+dr*sin theta) z where - flipper :: GLdouble - flipper = fromIntegral $ (gameclock `div` intrvl) `mod` 1024 - dr = ugoRange * vibrator(phi) - theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper - phi = (x + sqrt(3)*y + sqrt(7)*z + 106) * 150 * flipper - vibrator a = 0.5 * (1 + sin a) - - ugoTranslate x y z ugoRange = ugoTranslateFreq x y z ugoRange standardUgoInterval - ugoTranslateFreq x y z ugoRange intvl = translate (Vector3 (x+dr*cos theta) (y+dr*sin theta) z) where - flipper :: GLdouble - flipper = fromIntegral $ (gameclock `div` intvl) `mod` 1024 - dr = ugoRange * vibrator(phi) - theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper - phi = (x + sqrt(3)*y + sqrt(7)*z + 106) * 150 * flipper - vibrator a = 0.5 * (1 + sin a) - - ugoVertices2D z r xys = ugoVertices2DFreq z r standardUgoInterval xys - ugoVertices2DFreq z r intrvl xys = mapM_ (\(x,y) -> ugoVertexFreq x y z r intrvl) xys - - vertices2D :: GLdouble -> [(GLdouble,GLdouble)] -> IO () - vertices2D z xys = mapM_ (\(x,y) -> vertex $ Vertex3 x y z) xys - -standardUgoInterval :: Int -standardUgoInterval = 7 - -isMonadiusOver :: Monadius -> Bool -isMonadiusOver (Monadius (vars,_)) = flagGameover vars
− Monadius/Recorder.hs
@@ -1,80 +0,0 @@--- | a replay recording system. -module Recorder (Recorder(..),initialRecorder,RecorderMode(..), - encode2,decode - ) where - -import Graphics.UI.GLUT hiding (position) -import Monadius -import Game -import Util - -data Recorder = Recorder{ - keybuf :: [[Key]], - preEncodedKeyBuf :: [Int], - mode :: RecorderMode, - gameBody :: Monadius, - age :: Int, - isQuitRequested :: Bool} - -data RecorderMode = Play | Playback | Record - deriving (Eq,Show) - -instance Game Recorder where - update = updateRecorder - render = renderRecorder - isGameover = recorderIsGameover - -encode2 :: [Int] -> String -encode2 = show . reverse - -encodeKeySet :: [Key] -> Int -encodeKeySet keys = sum $ map (\i->if (importantKeys!!i) `elem` keys then 2^i else 0) [0..(length importantKeys-1)] - -decode :: String -> [[Key]] -decode str = map decodeKeySet (read str :: [Int]) - -decodeKeySet :: Int -> [Key] -decodeKeySet num = extract num importantKeys where - extract 0 _ = [] - extract _ [] = [] - extract i (c:cs) = (if i `mod` 2 == 1 then [c] else []) ++ extract (i `div` 2) cs - -importantKeys :: [Key] -importantKeys = [shotButton,missileButton,powerUpButton,upButton,downButton,leftButton,rightButton,selfDestructButton] - -initialRecorder :: RecorderMode -> [[Key]] -> Monadius -> Recorder -initialRecorder initialMode keyss initialGame = Recorder{ - keybuf = if initialMode == Playback then keyss ++ repeat [] else [], - preEncodedKeyBuf = [], - mode = initialMode, - gameBody = initialGame, - age=0, - isQuitRequested = False } - -updateRecorder::[Key]->Recorder->Recorder -updateRecorder keys me = me{ - --keybuf = (if mode me == Record then (++ [keys]) else id) $ keybuf me, - preEncodedKeyBuf = (if mode me == Record then (encodeKeySet keys:) else id) $ preEncodedKeyBuf me, - gameBody = (if mode me /= Playback then update keys else update (keybuf me!!age me)) $ gameBody me, - age = age me + 1, - isQuitRequested = (mode me == Playback && (selfDestructButton `elem` keys || Char ' ' `elem` keys)) || isQuitRequested me -} - -renderRecorder :: Recorder -> IO () -renderRecorder me = do - (putDebugStrLn.show.mode) me - if age me==0 || mode me /= Record then return () else preservingMatrix $ do - translate (Vector3 300 (-230) (0::GLdouble)) - scale 0.1 0.1 (0.1 :: GLdouble) - color (Color3 0.4 0.4 (0.4 :: GLdouble)) - renderString Roman $ show $ (head.preEncodedKeyBuf) me - - render $ gameBody me - -recorderIsGameover :: Recorder -> Bool -recorderIsGameover me = (isGameover . gameBody) me || isQuitRequested me - - - - -
− Monadius/Util.hs
@@ -1,96 +0,0 @@--- | Various numeric utility functions, particularly dealing with Complex --- numbers and shapes. -module Util ( - ComplexShape(..), - Shape(..), - angleAccuracy, - filterJust, - infinite, - innerProduct, - intToGLdouble, - isDebugMode, - modifyArray, - padding, - putDebugStrLn, - regulate, - square, - unitVector - ) where - -import Data.Maybe (fromJust, isJust) -import Data.Complex -import Data.Array ( (!), (//), Array(), Ix() ) -import Graphics.Rendering.OpenGL -- Types.GLdouble - --- | Switch this to True to get debug outputs. Be careful: you get a crash under --- Microsoft Windows, because the console is not available. -isDebugMode :: Bool -isDebugMode = False - -putDebugStrLn :: String -> IO () -putDebugStrLn str = if isDebugMode then putStrLn str else return () - -filterJust :: [Maybe a] -> [a] -filterJust = map fromJust.filter isJust - --- | Modify array 'a' at index 'i' by function 'f' -modifyArray :: Ix i => i -> (e -> e) -> Array i e -> Array i e -modifyArray i f a = a // [(i,f $ a!i)] - -class ComplexShape s where - -- | Collision check - (>?<) :: s -> s -> Bool - -- | Translation by a vector - (+>) :: (Complex GLdouble) -> s -> s - -instance ComplexShape Shape where - a >?< b = case (a,b) of - (Circular{},Circular{}) -> magnitude (center a - center b) < radius a + radius b - (Circular{},Rectangular{}) -> b >?< a - (Rectangular{},Circular{}) -> a >?< Rectangular{bottomLeft = center b - vr,topRight = center b + vr} where - vr = radius b :+ radius b - (Rectangular{bottomLeft=aL:+aB,topRight=aR:+aT},Rectangular{bottomLeft=bL:+bB,topRight=bR:+bT}) -> - and [aL < bR, aB < bT, aR > bL, aT > bB] - (Shapes{children = ss}, c) -> or $ map (>?< c) ss - (d, Shapes{children = ss}) -> or $ map (d >?<) ss - v +> a = case a of - Circular{} -> a{center = center a + v} - Rectangular{} -> a{bottomLeft = bottomLeft a + v, topRight = topRight a + v} - Shapes{} -> a{children = map (v +>) $ children a} - -data Shape = Circular {center :: Complex GLdouble, radius :: GLdouble} | - Rectangular {bottomLeft :: Complex GLdouble, topRight :: Complex GLdouble} | - Shapes {children :: [Shape]} - --- | Put a Rectangle coordinates into normal order so that collision will go properly. -regulate :: Shape -> Shape -regulate Rectangular{bottomLeft=(x1:+y1),topRight=(x2:+y2) }= Rectangular (min x1 x2:+min y1 y2) (max x1 x2:+max y1 y2) -regulate ss@Shapes{} = ss{children = map regulate $ children ss} -regulate x = x - -intToGLdouble :: Int -> GLdouble -intToGLdouble = fromIntegral - -unitVector :: Complex GLdouble -> Complex GLdouble -unitVector z - | magnitude z <= 0.00000001 = 1:+0 - | otherwise = z / abs z - -angleAccuracy :: Int -> Complex GLdouble -> Complex GLdouble -angleAccuracy division z = mkPolar r theta - where - (r,t)=polar z - theta = (intToGLdouble $ round (t / (2*pi) * d))/d*2*pi - d = intToGLdouble division - -innerProduct :: Complex GLdouble -> Complex GLdouble -> GLdouble -innerProduct a b = realPart $ a * (conjugate b) - -padding :: Char -> Int -> String -> String -padding pad minLen str = replicate (minLen - length str) pad ++ str - -infinite :: Int -infinite = 9999999 - -square :: (Num a) => a -> a -square a = a * a
Setup.hs view
@@ -1,5 +1,2 @@-#!/usr/bin/runhaskell--import Distribution.Simple--main = defaultMainWithHooks defaultUserHooks+import Distribution.Simple +main = defaultMainWithHooks defaultUserHooks
+ src/Demo.hs view
@@ -0,0 +1,57 @@+module Demo ( + demoData, + ReplayInfo(..), + ) where + +-- | Demos are automatically played if you let the title scene run for a minute. +newtype ReplayInfo = ReplayInfo ((Int,Int),String) + deriving (Show,Read) + +-- | Infinite list of demos. +demoData :: [ReplayInfo] +demoData = map ReplayInfo $ cycle [d1,d2,d3,d4,d5,d6,dieIn5,laserFool,shieldAttack,three] + +{- import Control.Arrow ((&&&)) + import Data.List (group) + + --| Take a bunch of Ints, and run-length encode them - first member of a pair specifies how many, second what. + rleEncode :: [Int] -> [(Int, Int)] + rleEncode = map (length &&& head) . group -} + +{- | Take a bunch of Int pairs, undo the run-length encoding, and then turn + the resulting [Int] into a String. The pairs are a run-length encoding of a String; + this was an inadvertent re-implementation of Don Stewart's RLE <http://cgi.cse.unsw.edu.au/~dons/blog/2007/07>. -} +rleDecode :: [(Int, Int)] -> String +rleDecode = show . (uncurry replicate =<<) + +-- | Data specifying the demo. +d1,d2,d3,d4,d5,d6,dieIn5,laserFool,shieldAttack,three :: ((Int, Int), String) +d1 = ((2,1),d) + where d = rleDecode [(5, 3), (10, 67), (6, 3), (5, 67), (29, 3), (2, 11), (29, 3), (5, 35), (3, 3), (3, 35), (24, 3), (2, 35), (19, 3), (7, 19), (21, 51), (63, 35), (15, 43), (5, 11), (8, 43), (8, 35), (3, 3), (9, 35), (20, 3), (52, 67), (32, 3), (13, 35), (3, 3), (11, 35), (5, 3), (9, 35), (4, 3), (6, 35), (4, 3), (5, 35), (13, 3), (14, 19), (4, 3), (4, 19), (6, 3), (4, 19), (7, 3), (5, 19), (8, 3), (8, 19), (5, 83), (3, 67), (2, 3), (12, 19), (5, 83), (17, 19), (9, 83), (2, 19), (5, 3), (20, 67), (1, 75), (38, 11), (1, 43), (4, 35), (7, 3), (57, 67), (2, 3), (5, 19), (17, 3), (6, 19), (8, 3), (6, 67), (7, 83), (59, 3), (9, 19), (1, 51), (17, 35), (20, 3), (14, 35), (7, 3), (2, 35), (11, 43), (6, 11), (7, 3), (26, 67), (7, 3), (13, 35), (5, 43), (7, 11), (2, 3), (5, 67), (1, 83), (2, 19), (2, 3), (10, 67), (21, 3), (147, 0)] + +d2 = ((2,2),d) + where d = rleDecode [(10, 0), (3, 8), (13, 9), (98, 73), (29, 65), (45, 1), (12, 17), (6, 1), (19, 17), (1, 81), (14, 65), (1, 81), (2, 17), (8, 21), (15, 17), (12, 49), (20, 17), (17, 49), (1, 25), (9, 9), (8, 73), (11, 65), (2, 81), (3, 17), (6, 21), (4, 17), (1, 49), (8, 33), (12, 1), (15, 65), (16, 33), (2, 1), (7, 65), (13, 33), (2, 41), (30, 9), (13, 41), (14, 9), (7, 1), (3, 33), (5, 1), (3, 9), (9, 1), (5, 33), (5, 1), (14, 33), (8, 1), (8, 65), (5, 1), (6, 33), (5, 1), (4, 33), (3, 1), (2, 33), (20, 1), (1, 33), (5, 1), (4, 33), (3, 1), (7, 33), (3, 49), (8, 17), (14, 49), (35, 17), (8, 1), (2, 17), (15, 1), (5, 33), (5, 1), (6, 65), (10, 1), (3, 33), (5, 1), (2, 33), (2, 1), (27, 65), (5, 1), (10, 65), (3, 73), (2, 65), (6, 1), (4, 65), (11, 1), (19, 9), (1, 41), (17, 33), (2, 41), (5, 9), (3, 1), (2, 17), (1, 1), (7, 17), (11, 49), (2, 17), (11, 1), (2, 33), (4, 1), (3, 33), (3, 1), (2, 33), (4, 1), (1, 33), (4, 1), (3, 33), (5, 1), (3, 33), (2, 1), (8, 9), (1, 73), (8, 65), (7, 73), (4, 65), (5, 73), (5, 1), (5, 65), (6, 1), (36, 65), (5, 73), (2, 9), (5, 13), (5, 9), (1, 1), (7, 3), (2, 35), (4, 43), (15, 35), (6, 43), (26, 35), (9, 43), (16, 35), (18, 3), (12, 67), (3, 75), (1, 67), (7, 3), (6, 67), (2, 3), (15, 19), (8, 83), (7, 67), (7, 83), (4, 67), (9, 3), (4, 67), (1, 83), (9, 19), (1, 83), (8, 67), (1, 3), (13, 19), (1, 83), (3, 67), (14, 3), (8, 35), (1, 43), (5, 11), (10, 3), (5, 11), (3, 3), (3, 11), (24, 3), (1, 19), (40, 3), (5, 67), (8, 3), (4, 67), (5, 19), (11, 3), (10, 35), (1, 43), (2, 11), (11, 3), (5, 35), (6, 3), (4, 35), (24, 3), (8, 67), (6, 3), (5, 35), (4, 3), (4, 35), (22, 3), (1, 11), (31, 3), (1, 11), (32, 3), (3, 67), (10, 3), (5, 35), (2, 3), (10, 35), (5, 3), (6, 35), (5, 3), (3, 35), (5, 3), (2, 35), (5, 3), (2, 35), (6, 3), (2, 35), (10, 3), (8, 67), (9, 3), (7, 67), (5, 3), (3, 67), (4, 3), (17, 67), (5, 3), (2, 11), (5, 3), (14, 67), (5, 3), (3, 67), (7, 3), (5, 67), (8, 3), (3, 67), (8, 3), (15, 35), (6, 3), (31, 67), (4, 3), (10, 67), (6, 19), (2, 3), (2, 67), (1, 83), (10, 19), (4, 51), (19, 35), (5, 3), (3, 35), (4, 3), (1, 35), (16, 3), (4, 35), (3, 3), (2, 35), (5, 3), (1, 35), (11, 3), (2, 19), (9, 3), (1, 67), (2, 83), (5, 67), (4, 3), (5, 67), (3, 3), (18, 35), (5, 3), (3, 35), (5, 3), (2, 35), (5, 3), (3, 35), (3, 3), (4, 35), (11, 3), (2, 35), (13, 3), (3, 35), (12, 3), (2, 35), (11, 3), (2, 35), (15, 3), (3, 11), (9, 3), (1, 35), (8, 3), (1, 35), (6, 3), (4, 35), (14, 3), (2, 35), (5, 3), (3, 35), (23, 3), (1, 35), (12, 3), (3, 35), (13, 3), (3, 35), (15, 3), (3, 11), (7, 3), (3, 35), (11, 3), (2, 35), (5, 3), (3, 35), (25, 3), (2, 1), (155, 0)] + +d3 = ((1,2),d) + where d = rleDecode [(13, 0), (2, 8), (16, 9), (77, 73), (25, 65), (5, 1), (3, 9), (15, 1), (5, 65), (15, 1), (4, 65), (13, 1), (5, 65), (10, 1), (5, 17), (2, 1), (6, 65), (1, 1), (16, 17), (2, 1), (9, 65), (1, 1), (5, 17), (4, 21), (13, 17), (16, 49), (29, 17), (4, 49), (2, 33), (2, 41), (6, 9), (4, 73), (11, 65), (1, 1), (16, 17), (5, 1), (3, 17), (7, 1), (6, 33), (5, 1), (3, 33), (4, 1), (8, 65), (10, 1), (4, 33), (7, 1), (2, 33), (1, 1), (8, 65), (26, 33), (3, 41), (31, 9), (13, 41), (21, 9), (11, 41), (19, 9), (4, 1), (5, 33), (8, 1), (48, 65), (1, 97), (2, 33), (4, 1), (13, 33), (1, 49), (24, 17), (12, 49), (41, 17), (6, 1), (5, 9), (11, 73), (3, 9), (1, 73), (8, 65), (1, 73), (32, 9), (9, 41), (15, 9), (6, 41), (3, 33), (4, 1), (13, 65), (1, 97), (4, 33), (28, 49), (19, 33), (11, 49), (5, 33), (16, 49), (4, 17), (5, 81), (13, 65), (7, 73), (16, 33), (9, 49), (2, 33), (2, 1), (1, 65), (1, 1), (4, 17), (1, 49), (6, 33), (1, 1), (4, 9), (5, 73), (66, 65), (2, 73), (13, 9), (6, 41), (13, 9), (6, 13), (4, 9), (6, 1), (3, 9), (10, 1), (21, 65), (16, 1), (4, 65), (6, 1), (3, 33), (10, 1), (3, 33), (10, 1), (3, 33), (6, 1), (1, 33), (13, 1), (1, 33), (10, 1), (4, 33), (11, 1), (4, 33), (5, 1), (1, 33), (12, 1), (3, 33), (10, 1), (2, 33), (11, 1), (5, 33), (8, 1), (3, 33), (8, 1), (2, 33), (8, 1), (3, 33), (15, 1), (2, 33), (5, 1), (3, 33), (5, 1), (45, 33), (20, 49), (27, 17), (42, 81), (6, 65), (6, 73), (26, 65), (8, 73), (27, 9), (35, 41), (11, 33), (4, 41), (18, 33), (2, 41), (2, 33), (1, 1), (4, 65), (8, 69), (6, 65), (7, 67), (14, 83), (23, 19), (18, 83), (4, 67), (11, 3), (4, 35), (1, 3), (7, 67), (5, 3), (2, 67), (16, 3), (4, 35), (4, 3), (8, 67), (5, 3), (11, 35), (5, 3), (2, 35), (3, 51), (7, 35), (13, 3), (5, 67), (5, 3), (3, 67), (13, 3), (5, 67), (5, 3), (3, 67), (5, 3), (27, 67), (1, 83), (8, 19), (25, 51), (25, 3), (5, 35), (18, 3), (1, 67), (6, 83), (3, 67), (22, 3), (32, 35), (5, 3), (5, 35), (1, 3), (7, 35), (7, 3), (4, 11), (5, 3), (4, 35), (5, 3), (3, 35), (3, 3), (4, 19), (16, 3), (1, 19), (14, 3), (8, 67), (8, 3), (4, 19), (1, 3), (15, 67), (2, 83), (11, 67), (2, 75), (1, 11), (6, 3), (1, 11), (16, 3), (5, 67), (5, 3), (3, 35), (5, 3), (3, 11), (4, 3), (5, 11), (11, 3), (9, 19), (8, 3), (2, 35), (18, 43), (22, 35), (12, 43), (20, 35), (27, 51), (1, 19), (7, 3), (2, 19), (7, 3), (13, 67), (5, 75), (5, 67), (1, 75), (5, 11), (5, 43), (2, 35), (7, 3), (4, 67), (12, 83), (10, 67), (5, 83), (23, 67), (3, 75), (24, 67), (2, 99), (3, 35), (7, 39), (1, 35), (2, 43), (5, 3), (11, 35), (1, 43), (1, 11), (5, 3), (5, 35), (3, 3), (6, 35), (4, 3), (11, 35), (5, 3), (3, 35), (5, 3), (10, 67), (38, 3), (2, 35),(121, 3), (1, 2), (49, 0)] + +d4 = ((1,0),d) + where d = rleDecode [(277, 0), (311, 7), (19, 71), (1, 87), (1, 84), (9, 80), (13, 16), (4, 80), (3, 64), (2, 72), (21, 8), (7, 40), (10, 32), (2, 48), (4, 32), (18, 48), (22, 16), (2, 48), (3, 32), (5, 48), (6, 32), (4, 40), (2, 8), (7, 72), (16, 64), (1, 96), (7, 32), (1, 40), (7, 8), (1, 72), (4, 64), (11, 0), (10, 8), (2, 40), (4, 8), (2, 40), (21, 32), (13, 48), (3, 16), (4, 80), (5, 64), (15, 72), (14, 64), (5, 80), (14, 16), (17, 48), (17, 32), (17, 40), (2, 8), (4, 72), (11, 64), (3, 80), (11, 16), (3, 80), (3, 64), (1, 72), (5, 8), (5, 40), (2, 8), (5, 72), (7, 64), (13, 72), (7, 8), (2, 40), (7, 32), (5, 48), (15, 16), (8, 80), (4, 64), (2, 72), (13, 8), (6, 0), (5, 8), (9, 0), (5, 32), (2, 48), (9, 16), (1, 80), (4, 64), (4, 8), (1, 0), (10, 32), (16, 0), (6, 32), (5, 40), (12, 8), (4, 72), (9, 64), (8, 80), (9, 16), (15, 48), (10, 32), (5, 96), (5, 64), (3, 72), (8, 8), (18, 72), (8, 64), (2, 80), (3, 16), (33, 48), (12, 16), (6, 80), (9, 64), (2, 72), (4, 8), (49, 40), (18, 8), (2, 72), (6, 64), (49, 80), (18, 16), (25, 0), (11, 32), (5, 40), (3, 8), (4, 72), (5, 64), (3, 72), (6, 64), (7, 80), (4, 64), (4, 72), (8, 8), (5, 40), (20, 32), (4, 40), (7, 8), (5, 72), (11, 64), (3, 80), (4, 16), (8, 48), (4, 32), (9, 48), (10, 32), (2, 96), (7, 64), (3, 80), (4, 16), (10, 0), (4, 8), (16, 0), (7, 32), (8, 0), (6, 32), (1, 40), (17, 8), (6, 64), (3, 0), (9, 32), (5, 16), (2, 80), (6, 64), (8, 72), (3, 8), (5, 40), (10, 32), (2, 40), (2, 8), (3, 72), (7, 64), (1, 80), (8, 16), (1, 0), (10, 64), (2, 80), (14, 16), (2, 48), (17, 32), (4, 40), (3, 8), (2, 72), (10, 64), (7, 80), (4, 16), (1, 0), (5, 64), (4, 72), (9, 8), (27, 64), (3, 96), (10, 32), (9, 40), (16, 32), (6, 48), (4, 16), (9, 80), (14, 64), (3, 80), (3, 48), (12, 32), (3, 40), (2, 8), (9, 72), (1, 8), (4, 40), (19, 32), (4, 48), (1, 16), (4, 80), (12, 64), (2, 0), (17, 32), (1, 40), (2, 8), (3, 72), (1, 64), (10, 0), (6, 8), (12, 0), (1, 64), (2, 80), (4, 16), (7, 80), (6, 16), (2, 80), (5, 64), (3, 72), (12, 8), (4, 40), (11, 32), (1, 0), (6, 64), (4, 0), (10, 32), (10, 48), (4, 32), (3, 40), (1, 8), (10, 72), (9, 64), (2, 80), (10, 16), (1, 80), (18, 64), (2, 0), (2, 8), (15, 32), (2, 48), (3, 16), (3, 80), (9, 64), (6, 80), (4, 16), (1, 0), (12, 64), (6, 72), (11, 8), (3, 40), (2, 32), (2, 96), (4, 64), (1, 0), (4, 32), (12, 40), (6, 32), (1, 48), (1, 112), (5, 80), (3, 64), (7, 80), (4, 48), (16, 32), (5, 40), (5, 8), (2, 40), (9, 32), (1, 96), (11, 64), (4, 80), (10, 16), (1, 48), (8, 32), (15, 0), (9, 16), (2, 0), (19, 64), (1, 96), (6, 32), (9, 0), (10, 64), (8, 72), (5, 64), (3, 80), (3, 16), (3, 80), (5, 64), (4, 72), (8, 8), (7, 72), (6, 64), (3, 80), (2, 16), (15, 48), (8, 32), (9, 40), (23, 32), (14, 40), (6, 8), (3, 0), (7, 32), (12, 48), (12, 16), (2, 80), (19, 64), (3, 72), (4, 64), (5, 72), (16, 64), (6, 72), (12, 8), (1, 40), (4, 32), (3, 96), (1, 64), (5, 80), (3, 16), (4, 80), (13, 64), (5, 80), (9, 16), (4, 48), (5, 32), (2, 40), (3, 72), (7, 64), (5, 80), (3, 16), (2, 48), (14, 32), (13, 40), (27, 32), (5, 40), (6, 32), (7, 48), (1, 16), (1, 80), (8, 64), (2, 0), (7, 32), (3, 48), (4, 16), (15, 0), (6, 32), (3, 40), (10, 8), (4, 72), (2, 8), (9, 0), (6, 32), (170, 0)] + +d5 = ((2,0),d) + where d = rleDecode [(20,0), (80,8), (13,0), (9,8), (77,0), (5,3), (3,3), (80,6), (2,8), (1,1), (5,2), (20,1), (1,1), (80,4), (11,4), (5,3), (3,1), (31,6), (15,6), (4,0), (40,3), (4,3), (33,0), (50,1), (15,0), (8,3), (17,0), (57,1), (16,6), (1,1), (6,9), (5,1), (3,9), (27,1), (2,3), (2,3), (3,4), (3,8), (1,9), (3,1), (4,9), (10,1), (5,9), (4,1), (3,9), (7,1), (3,9), (5,1), (2,9), (5,1), (11,9), (14,1), (8,6), (1,6), (19,8), (3,1), (28,4), (2,1), (7,8), (4,6), (63,6), (21,6), (2,7), (2,9), (7,4), (10,4), (15,8), (41,4), (5,3), (2,9), (26,6), (12,3), (7,3), (19,3), (3,4), (27,1), (19,4), (13,1), (3,4), (3,3), (26,1), (33,6), (17,7), (5,6), (1,9), (1,15), (8,4), (28,9), (10,4), (2,3), (6,3), (6,3), (2,4), (5,1), (3,8), (38,6), (1,6), (4,3), (7,3), (1,4), (5,4), (9,1), (1,4), (2,4), (5,3), (8,0), (2,1), (6,3), (1,0), (8,3), (14,4), (32,1), (24,0), (12,6), (2,7), (5,8), (7,0), (3,8), (5,0), (5,8), (64,0), (4,3), (6,4), (22,3), (5,4), (5,1), (2,8), (10,6), (20,8), (10,8), (6,8), (2,6), (3,1), (2,3), (5,3), (2,4), (1,1), (15,9), (12,1), (5,4), (2,1), (10,9), (8,4), (2,9), (6,1), (29,3), (19,1), (3,0), (15,3), (1,4), (2,8), (15,0), (12,3), (2,0), (2,6), (17,6), (23,1), (7,3), (38,1), (6,3), (39,1), (7,3), (27,1), (46,6), (1,6), (4,3), (4,1), (3,3), (5,1), (23,3), (3,4), (7,5), (12,4), (10,3), (17,4), (2,3), (3,3), (3,3), (5,1), (3,9), (1,4), (1,9), (10,1), (8,3), (2,1), (2,3), (5,1), (19,6), (21,8), (6,1), (2,1), (3,4), (20,3), (7,4), (4,3), (9,1), (4,3), (3,3), (3,3), (14,1), (23,6), (2,1), (4,1), (1,1), (6,3), (5,1), (7,1), (7,1), (5,6), (1,1), (5,1), (2,1), (7,3), (6,1), (22,9), (18,1), (7,6), (11,1), (3,4), (14,1), (1,1), (4,3), (35,1), (24,9), (6,4), (16,3), (4,4), (12,1), (30,1), (15,9), (3,4), (1,9), (14,1), (17,1), (2,1), (70,1), (5,1), (4,1), (7,3), (10,1), (4,6), (10,7), (30,6), (6,1), (5,6), (5,1), (4,1), (19,1), (24,6), (5,1), (5,6), (3,1), (5,6), (7,1), (3,6), (7,1), (2,6), (9,1), (53,3), (8,3), (6,3), (4,4), (16,9), (3,7), (3,9), (13,1), (3,9), (3,1), (7,3), (16,1), (17,6), (2,6), (5,3), (2,3), (6,1), (19,1), (7,8), (26,1), (6,1), (5,1), (1,3), (1,4), (5,5), (2,3), (19,3), (13,4), (1,4), (5,3), (2,4), (8,9), (2,7), (10,6), (14,1), (9,0), (5,4), (9,0), (5,8), (11,0), (3,8), (17,0), (5,1), (13,1), (32,1), (5,1), (2,6), (11,7), (19,6), (3,7), (39,9), (6,1), (17,3), (2,6), (10,6), (6,6), (5,3), (9,1), (4,3), (6,6), (4,3), (1,6), (5,6), (10,1), (2,6), (1,8), (3,1), (2,1), (7,1), (8,3), (3,1), (15,6), (3,6), (2,3), (3,1), (7,1), (2,4), (27,3), (6,3), (1,3), (11,4), (13,4), (4,4), (10,5), (5,4), (5,4), (5,1), (6,1), (16,0), (10,6), (1,7), (3,6), (4,7), (3,8), (6,0), (3,8), (18,0), (3,8), (3,0), (2,3), (8,3), (10,1), (15,9), (5,1), (14,9), (1,1), (5,3), (5,1), (2,3), (3,1), (2,9), (5,1), (3,9), (5,1), (2,9), (3,1), (10,3), (1,1), (4,3), (6,1), (11,3), (3,6), (4,6), (8,1), (2,1), (5,1), (1,5), (7,4), (21,1), (14,4), (6,5), (4,4), (8,1), (5,1), (7,6), (13,7), (4,9), (29,1), (12,9), (2,1), (2,3), (1,3), (4,4), (1,1), (1,9), (6,1), (3,9), (4,7), (15,6), (4,6), (4,6), (1,8), (2,1), (2,4), (3,3), (1,1), (1,6), (3,1), (12,9), (3,4), (9,3), (1,4), (4,9), (3,1), (5,9), (3,1), (2,9), (14,1), (6,3), (7,1), (5,5), (3,1), (2,9), (11,1), (43,6), (8,1), (1,6), (39,1), (19,3), (24,1), (2,3), (54,1), (19,3), (95,1), (15,3), (2,1), (18,3), (23,4), (6,1), (11,1), (3,8), (15,6), (3,6), (8,7), (1,7), (7,6), (9,6), (7,6), (8,7), (12,9), (3,4), (2,4), (3,3), (5,3), (8,4), (12,3), (2,1), (4,6), (8,6), (5,6), (17,1), (8,3), (3,6), (5,6), (8,1), (4,1), (1,1), (7,3), (3,6), (2,6), (19,1), (4,3), (7,6), (2,8), (1,8), (4,1), (11,1), (9,3), (11,3), (7,1), (3,1), (5,6), (2,1), (9,3), (6,1), (4,1), (2,1), (2,3), (2,4), (2,3), (8,1), (4,6), (2,1), (4,3), (4,6), (2,3), (10,1), (4,9), (9,1), (24,3), (2,4), (15,3), (4,4), (1,4), (10,1), (7,9), (2,3), (6,3), (13,1), (4,3), (3,6), (5,6), (2,8), (8,1), (7,8), (10,1), (1,1), (9,3), (5,1), (3,1), (11,1), (8,3), (4,1), (8,7), (5,6), (6,1), (4,1), (4,8), (10,6), (8,6), (11,6), (1,9), (29,3), (1,4), (2,4), (5,1), (1,7), (4,7), (10,6), (17,1), (33,3), (18,4), (3,9), (2,1), (3,4), (5,3), (8,1), (8,6), (9,6), (2,3), (19,1), (1,3), (8,6), (3,3), (2,1), (8,8), (2,1), (10,1), (9,3), (3,1), (7,1), (6,1), (8,3), (2,6), (5,6), (5,1), (5,3), (6,6), (2,6), (5,1), (2,6), (1,7), (2,9), (5,1), (5,9), (2,1), (4,6), (6,7), (6,6), (3,1), (1,3), (3,6), (6,3), (4,1), (4,3), (1,4), (1,1), (9,1), (3,1), (2,1), (1,3), (7,4), (7,1), (1,4), (2,3), (4,3), (2,5), (12,4), (5,3), (10,4), (5,3), (7,3), (1,3), (5,4), (2,9), (7,7), (7,6), (3,7), (10,9), (3,1), (5,3), (11,1), (4,9), (11,1), (3,9), (2,1), (3,3), (3,1), (2,3), (11,1), (8,3), (2,1), (11,1), (42,6), (14,1), (6,5), (10,1), (11,3), (33,1), (13,3), (7,1), (4,3), (13,3), (7,0), (5,3), (7,0), (1,3), (21,0), (3,3), (5,0), (3,3), (16,0), (18,1), (11,0), (7,3), (5,0), (1,3), (2,0), (6,1), (2,3), (6,2), (43,0), (3,3), (31,0), (3,3), (10,0), (11,3), (10,0), (15,1), (5,3), (2,6), (5,3), (5,6), (10,6), (2,6), (6,3), (3,6), (16,6), (6,8), (10,8), (7,1), (5,4), (10,5), (10,4), (13,5), (7,4), (12,1), (4,3), (3,3), (1,3), (6,1), (2,1), (5,8), (11,6), (5,1), (14,6), (5,7), (7,7), (3,7), (34,8), (5,4), (46,3), (19,4), (5,1), (11,8), (7,8), (3,8), (34,6), (15,7), (4,6), (9,8), (17,1), (3,8), (13,6), (11,7), (7,8), (6,4), (5,3), (51,4), (25,3), (24,4), (8,4), (3,1), (17,8), (11,6), (42,7), (10,6), (17,8), (4,1), (21,4), (10,1), (12,8), (11,6), (1,6), (6,7), (2,8), (2,0), (4,3), (2,0), (5,1), (10,0), (1,6), (16,7), (8,8), (26,4), (21,3), (4,4), (11,4), (8,4), (7,1), (5,8), (8,6), (5,6), (3,7), (4,6), (2,8), (10,8), (2,6), (3,7), (4,8), (3,7), (14,6), (2,8), (7,1), (1,8), (3,6), (7,0), (7,3), (1,4), (5,8), (10,7), (9,8), (25,4), (43,3), (13,4), (2,4), (9,1), (4,1), (11,8), (7,6), (20,7), (2,7), (11,6), (10,6), (16,8), (12,1), (3,8), (6,6), (4,7), (3,8), (2,0), (16,3), (2,4), (8,1), (8,4), (35,3), (7,4), (1,4), (9,9), (15,8), (9,7), (2,7), (5,6), (3,8), (25,8), (13,6), (4,7), (4,6), (12,7), (3,8), (4,0), (5,1), (5,0), (18,1), (3,4), (2,3), (13,0), (9,8), (8,0), (3,1), (1,8), (11,6), (2,0), (3,1), (15,0), (3,3), (4,4), (3,0), (11,6), (4,0), (5,1), (8,0), (4,1), (2,4), (42,3), (2,4), (6,4), (1,9), (20,8), (7,9), (3,7), (1,7), (3,6), (17,8), (4,6), (6,7), (2,6), (24,8), (7,6), (2,0), (4,8), (11,0), (10,1), (1,4), (27,3), (44,4), (3,8), (2,7), (5,6), (1,0), (6,1), (6,8), (1,1), (10,0), (7,4), (21,0), (4,3), (3,4), (13,1), (12,8), (4,6), (3,7), (2,8), (8,4), (8,8), (6,4), (2,3), (57,0), (19,8), (6,0), (3,8), (22,0), (40,6), (10,3), (24,4), (19,1), (2,4), (2,1), (29,0), (4,1), (9,0), (13,6), (5,7), (18,6), (2,0), (3,1), (7,0), (11,3), (29,4), (10,8), (19,4), (2,3), (8,3), (2,3), (6,0), (10,1), (6,8), (20,1), (12,8), (5,6), (10,0), (5,1), (7,0), (6,3), (2,4), (2,4), (6,9), (25,8), (40,0), (10,8), (5,0), (15,1), (15,0), (7,3), (5,4), (14,1), (4,0), (16,6), (1,8), (8,1), (18,4), (4,3), (4,4), (30,8), (1,9), (8,7), (5,7), (4,8), (3,0), (5,6), (1,0), (4,1), (3,0), (3,3), (2,4), (6,3), (6,4), (15,0), (13,6), (6,8), (6,1), (5,0), (22,1), (6,4), (6,1), (9,0), (10,1), (2,0), (5,3), (3,4), (3,8), (7,7), (15,8), (5,0), (2,3), (3,4), (2,3), (8,4), (12,8), (2,7), (4,6), (4,7), (2,6), (2,0), (5,8), (27,0), (11,1), (3,0), (9,1), (4,4), (9,1), (17,8), (16,1), (10,0), (3,3), (2,0), (7,1), (3,3), (2,3), (6,4), (28,8), (6,1), (3,8), (7,4), (5,4), (1,3), (4,4), (1,4), (3,1), (7,8), (23,1), (16,8), (10,6), (3,1), (2,3), (5,4), (5,4), (23,8), (20,7), (6,6), (2,8), (5,4), (27,4), (9,1), (6,8), (12,1), (1,8), (5,6), (5,7), (13,6), (2,0), (5,1), (8,0), (3,6), (51,0), (10,3), (10,4), (7,4), (15,9), (3,4), (10,9), (6,7), (2,9), (4,4), (3,9), (2,4), (8,3), (2,3), (4,5), (4,1), (6,1), (3,1), (1,3), (2,4), (6,1), (3,8), (17,1), (31,1), (2,0), (5,3), (3,0), (5,8), (3,0), (4,8), (1,9), (2,1), (2,3), (2,6), (3,7), (4,1), (2,9), (3,8), (1,7), (15,6), (7,8), (2,8), (8,5), (2,4), (13,4), (4,3), (5,2), (1,3), (10,3), (2,9), (8,1), (3,7), (2,6), (4,3), (3,1), (2,8), (8,0), (5,3), (3,0), (19,6), (2,6), (11,1), (10,0), (2,6), (6,0), (1,1), (8,3), (2,3), (13,3), (2,4), (11,8), (5,0), (2,8), (15,0), (1,8), (1,7), (3,6), (10,6), (10,1), (2,3), (5,1), (4,1), (1,1), (8,3), (5,1), (3,0), (3,1), (5,3), (4,1), (1,5), (12,3), (6,4), (18,9), (5,1), (3,9), (8,1), (2,3), (6,6), (10,6), (4,1), (17,3), (19,1), (2,6), (8,6), (20,6), (12,3), (14,1), (28,3), (1,3), (7,3), (2,1), (3,3), (10,1), (9,3), (6,1), (3,3), (6,1), (4,3), (9,1), (8,3), (2,4), (1,1), (21,1), (1,3), (6,6), (3,3), (3,1), (4,9), (22,1), (4,3), (6,6), (10,6), (1,8), (1,8), (7,1), (8,1), (7,1), (3,3), (5,1), (2,1), (1,1), (5,3), (4,1), (6,6), (2,1), (3,1), (18,1), (2,1), (4,8), (4,6), (4,6), (1,6), (3,1), (2,9), (3,8), (2,4), (23,3), (12,0), (6,8), (3,7), (1,7), (1,6), (4,8), (6,1), (1,1), (9,1), (6,0), (1,1), (2,3), (4,1), (7,3), (2,1), (22,0), (1,6), (4,7), (19,8), (1,4), (6,3), (4,4), (4,3), (3,4), (6,8), (1,4), (5,8), (1,2), (3,1), (6,8), (11,1), (1,8), (12,1), (15,0), (3,1), (101,0), (16,1), (3,3), (4,3), (3,4), (3,8), (2,9), (7,1), (5,7), (3,1), (5,3), (3,1), (12,3), (2,3), (1,5), (14,1), (2,8), (5,6), (5,3), (6,6), (4,3), (8,6), (10,3), (1,6), (7,3), (5,1), (2,3), (6,6), (5,6), (5,6), (8,6), (14,1), (20,3), (12,1), (4,3), (5,1), (3,3), (6,1), (2,3), (3,1), (8,3), (2,1), (2,6), (6,7), (12,9), (5,1), (3,9), (4,1), (3,9), (3,1), (4,9), (4,1), (9,3), (15,1), (15,3), (121,1), (13,3), (4,4), (30,1), (13,3), (16,1), (3,1), (51,1), (10,3), (1,1), (2,1), (9,1), (4,1), (15,1), (8,3), (37,1), (10,3), (10,1), (5,9), (3,1), (2,6), (5,6), (5,3), (6,1), (10,6), (5,6), (1,3), (4,1), (2,6), (7,3), (4,1), (11,6), (1,7), (2,9), (10,1), (8,9), (31,4), (9,3), (4,1), (2,9), (4,1), (4,9), (13,1), (8,3), (3,3), (12,3), (5,1), (3,3), (18,1), (1,6), (4,8), (4,1), (9,1), (3,1), (20,8), (7,8), (2,8), (5,6), (2,7), (1,9), (13,1), (6,6), (4,7), (10,9), (5,1), (5,4), (6,4), (3,9), (4,1), (5,9), (5,1), (3,9), (4,1), (1,9), (12,1), (8,3), (3,1), (11,3), (7,4), (18,1), (5,8), (9,6), (2,6), (2,7), (7,1), (5,9), (4,7), (2,9), (11,1), (9,6), (1,7), (8,9), (2,1), (6,3), (30,3), (2,4), (7,5), (1,4), (3,1), (6,1), (9,6), (4,7), (7,6), (8,8), (2,1), (3,1), (2,8), (5,6), (1,6), (8,1), (21,6), (11,1), (148,0)] + +d6 = ((5,0),d) + where d = rleDecode [(16, 0), (7, 8), (12, 9), (71, 8), (7, 1), (3, 17), (25, 1), (6, 65), (1, 1), (60, 33), (90, 65), (52, 64), (2, 96), (3, 36), (9, 32), (5, 0), (1, 8), (37, 0), (2, 1), (2, 65), (5, 1), (2, 33), (3, 1), (2, 33), (4, 1), (1, 33), (3, 9), (1, 1), (1, 9), (4, 1), (4, 65), (4, 81), (22, 65), (21, 64), (1, 68), (2, 4), (1, 36), (5, 32), (8, 0), (4, 32), (2, 0), (13, 16), (66, 48), (2, 32), (33, 33), (2, 41), (1, 72), (17, 64), (3, 80), (31, 64), (3, 68), (1, 64), (2, 72), (3, 8), (1, 9), (11, 33), (2, 9), (2, 1), (3, 33), (6, 1), (1, 33), (1, 41), (4, 9), (8, 1), (3, 9), (1, 1), (3, 9), (3, 1), (1, 9), (3, 1), (1, 9), (4, 1), (5, 33), (2, 1), (2, 17), (4, 1), (2, 17), (13, 1), (6, 65), (1, 73), (5, 9), (5, 33), (2, 1), (2, 33), (1, 41), (1, 9), (1, 41), (4, 33), (2, 41), (3, 9), (1, 1), (1, 9), (1, 1), (6, 0), (1, 32), (4, 33), (4, 8), (2, 0), (1, 32), (1, 33), (2, 1), (1, 0), (2, 32), (1, 16), (1, 48), (11, 16), (7, 80), (2, 16), (2, 1), (8, 0), (5, 64), (9, 72), (18, 64), (17, 16), (1, 0), (8, 1), (2, 17), (20, 1), (25, 33), (1, 40), (20, 8), (31, 72), (1, 65), (10, 1), (34, 33), (1, 1), (9, 17), (11, 16), (10, 80), (2, 64), (4, 80), (2, 81), (4, 80), (2, 81), (6, 80), (7, 64), (6, 80), (1, 113), (2, 33), (2, 32), (22, 33), (2, 1), (4, 65), (7, 73), (2, 72), (4, 8), (2, 40), (4, 41), (1, 40), (8, 32), (9, 40), (2, 41), (1, 9), (19, 8), (3, 9), (3, 1), (2, 17), (1, 81), (3, 65), (7, 81), (3, 80), (26, 16), (3, 80), (1, 64), (2, 65), (1, 64), (3, 72), (2, 73), (1, 65), (1, 64), (1, 80), (4, 81), (1, 80), (1, 81), (3, 17), (4, 16), (1, 65), (2, 1), (2, 0), (14, 64), (3, 72), (25, 8), (14, 40), (2, 41), (2, 40), (2, 41), (2, 40), (3, 41), (1, 33), (14, 32), (4, 0), (4, 16), (5, 0), (2, 8), (7, 0), (3, 64), (1, 72), (3, 8), (2, 72), (8, 64), (5, 80), (6, 64), (4, 0), (4, 36), (1, 8), (3, 0), (11, 1), (3, 33), (3, 49), (3, 17), (2, 81), (25, 17), (13, 16), (1, 17), (13, 1), (2, 33), (5, 32), (1, 40), (2, 8), (1, 0), (30, 8), (1, 9), (4, 41), (4, 33), (4, 1), (1, 9), (4, 1), (1, 9), (2, 1), (2, 9), (3, 1), (2, 9), (1, 1), (1, 9), (5, 1), (2, 9), (6, 65), (1, 81), (8, 65), (5, 1), (3, 33), (1, 1), (3, 65), (5, 1), (7, 17), (1, 49), (4, 48), (2, 16), (12, 17), (5, 81), (9, 17), (3, 81), (5, 65), (3, 81), (3, 17), (10, 1), (9, 65), (8, 1), (19, 33), (4, 41), (20, 9), (5, 73), (3, 77), (1, 13), (13, 9), (4, 1), (1, 9), (4, 1), (1, 9), (7, 1), (4, 3), (10, 1), (10, 65), (38, 1), (2, 65), (69, 1), (12, 65), (4, 67), (1, 3), (62, 1), (6, 3), (20, 1), (7, 33), (5, 1), (9, 33), (1, 1), (8, 65), (10, 1), (3, 3), (1, 67), (1, 65), (4, 1), (2, 65), (7, 1), (3, 3), (9, 1), (14, 33), (1, 35), (2, 3), (12, 1), (2, 33), (4, 1), (4, 3), (4, 1), (3, 33), (2, 1), (4, 3), (2, 1), (7, 17), (1, 49), (15, 33), (3, 41), (5, 9), (1, 1), (2, 33), (5, 35), (1, 33), (7, 1), (1, 33), (8, 1), (5, 3), (3, 1), (8, 65), (6, 1), (6, 3), (1, 67), (4, 65), (3, 1), (1, 33), (5, 49), (2, 17), (4, 81), (1, 65), (1, 67), (3, 3), (3, 1), (3, 65), (2, 81), (2, 17), (1, 81), (2, 17), (3, 81), (3, 1), (13, 65), (4, 81), (12, 17), (4, 1), (3, 17), (2, 1), (5, 33), (3, 1), (12, 9), (4, 1), (6, 9), (9, 1), (3, 3), (31, 1), (4, 33), (7, 41), (20, 33), (3, 35), (2, 3), (3, 9), (2, 1), (1, 9), (7, 73), (15, 65), (1, 81), (19, 17), (5, 1), (5, 17), (2, 1), (4, 17), (2, 49), (4, 51), (1, 19), (2, 17), (16, 1), (1, 33), (19, 1), (30, 9), (32, 1), (20, 17),(170, 1), (4, 17), (3, 1), (3, 65), (1, 73), (4, 9), (8, 41), (6, 1), (2, 9), (6, 1), (1, 65), (6, 81), (14, 17), (13, 1), (9, 65), (7, 73), (3, 1), (1, 65), (13, 73), (9, 65), (4, 1), (6, 17), (4, 65), (10, 1), (2, 9), (3, 1), (4, 9), (9, 1), (2, 9), (15, 1), (1, 17), (7, 1), (3, 33), (2, 49), (27, 33), (6, 35), (3, 41), (21, 9), (1, 41), (1, 35), (3, 51), (2, 49), (5, 17), (15, 49), (3, 51), (1, 49), (1, 17), (12, 1), (7, 33), (1, 1), (2, 17), (18, 1), (13, 65), (30, 73), (1, 65), (73, 1), (2, 9), (47, 1), (31, 17), (2, 1), (2, 33), (5, 49), (1, 33), (4, 1), (3, 3), (1, 67), (2, 65), (1, 1), (3, 9), (2, 73), (9, 65), (3, 1), (20, 65), (1, 73), (4, 9), (1, 11), (3, 43), (1, 35), (4, 33), (15, 9), (2, 41), (2, 43), (1, 35), (8, 33), (2, 41), (6, 9), (3, 1), (1, 9), (1, 1), (9, 3), (10, 35), (1, 3), (1, 1), (5, 33), (2, 49), (3, 1), (2, 17), (1, 19), (3, 83), (7, 81), (4, 65), (6, 1), (1, 67), (3, 3), (14, 65), (1, 17), (1, 19), (3, 3), (4, 1), (5, 65), (1, 81), (2, 17), (6, 1), (7, 33), (1, 41), (1, 9), (11, 11), (4, 3), (1, 11), (2, 3), (1, 11), (19, 3), (14, 35), (7, 33), (2, 49), (13, 33), (3, 35), (2, 3), (2, 1), (1, 9), (5, 65), (8, 1), (2, 65), (1, 67), (3, 3), (3, 67), (18, 65), (1, 1), (3, 3), (2, 35), (1, 3), (2, 1), (8, 33), (4, 49), (1, 17), (4, 1), (2, 33), (1, 1), (2, 33), (5, 1), (2, 33), (7, 1), (8, 17), (6, 49), (1, 17), (3, 19), (2, 3), (1, 35), (1, 3), (1, 1), (9, 65), (13, 81), (1, 19), (1, 3), (2, 35), (1, 33), (7, 41), (12, 33), (8, 49), (8, 17), (1, 19), (4, 3), (3, 1), (4, 3), (2, 1), (5, 9), (1, 1), (4, 33), (3, 17), (1, 81), (3, 65), (2, 1), (2, 9), (2, 1), (6, 65), (2, 73), (10, 65), (17, 73), (1, 75), (1, 11), (7, 3), (1, 65), (3, 73), (1, 75), (2, 11), (2, 3), (2, 33), (3, 1), (2, 65), (1, 73), (1, 9), (1, 73), (3, 65), (1, 33), (4, 35), (5, 33), (4, 41), (3, 9), (1, 33), (3, 35), (4, 3), (2, 11), (1, 3), (1, 1), (2, 33), (1, 35), (4, 3), (6, 35), (2, 33), (1, 49), (5, 1), (2, 17), (2, 19), (5, 83), (3, 81), (5, 65), (6, 81), (1, 65), (1, 1), (1, 3), (2, 19), (2, 3), (4, 1), (1, 9), (1, 11), (2, 75), (2, 11), (1, 3), (3, 1), (12, 33), (4, 35), (1, 43), (10, 9), (2, 1), (1, 65), (3, 73), (2, 65), (3, 1), (12, 65), (3, 73), (3, 1), (1, 9), (1, 1), (1, 9), (9, 1), (5, 33), (1, 5), (1, 21), (2, 5), (2, 1), (2, 65), (9, 67), (2, 81), (4, 17), (6, 81), (10, 17), (3, 3), (2, 1), (8, 33), (1, 41), (10, 9), (12, 73), (9, 65), (1, 73), (3, 1), (2, 9), (8, 1), (3, 65), (4, 1), (2, 65), (7, 1), (1, 65), (4, 1), (4, 33), (4, 1), (6, 33), (3, 1), (2, 33), (37, 1), (2, 33), (39, 1), (1, 33), (16, 1), (2, 33), (3, 3), (13, 1), (2, 3), (2, 35), (10, 1), (5, 35), (5, 33), (8, 49), (5, 17), (4, 49), (4, 17), (1, 1), (1, 3), (4, 19), (14, 17), (2, 19), (4, 3), (6, 1), (4, 3), (2, 1), (3, 33), (11, 1), (1, 9), (3, 1), (2, 9), (3, 1), (26, 65), (7, 73), (5, 75), (2, 9), (5, 1), (2, 9), (3, 1), (13, 9), (1, 41), (1, 43), (1, 11), (3, 3), (2, 11), (2, 3), (1, 11), (2, 3), (1, 11), (3, 3), (1, 11), (6, 3), (1, 11), (7, 3), (1, 11), (5, 3), (21, 35), (1, 1), (10, 65), (4, 81), (13, 17), (13, 49), (6, 51), (4, 49), (1, 33), (26, 1), (6, 3), (7, 1), (2, 9), (9, 73), (1, 65), (6, 1), (2, 65), (1, 9), (9, 1), (6, 3), (15, 1), (16, 33), (1, 97), (17, 65), (3, 1), (9, 3), (3, 1), (2, 65), (9, 1), (2, 65), (4, 1), (1, 65), (1, 67), (6, 3), (7, 1), (3, 65), (1, 1), (6, 3), (4, 1), (1, 65), (5, 1), (1, 67), (3, 3), (4, 1), (4, 3), (6, 1), (5, 33), (1, 49), (1, 17), (7, 1), (5, 3), (5, 1), (2, 65), (2, 1), (1, 3), (1, 35), (1, 33), (1, 49), (1, 17), (6, 1), (1, 65), (1, 67), (3, 3), (8, 1), (7, 33), (14, 1), (4, 3), (12, 1), (1, 65), (6, 1), (4, 65), (5, 1), (1, 65), (2, 1), (7, 65), (5, 1), (1, 65), (2, 1), (7, 65), (4, 1), (1, 9), (2, 1), (21, 33), (1, 1), (13, 65), (5, 67), (1, 75), (1, 73), (3, 1), (12, 17), (4, 1), (2, 17), (1, 1), (6, 65), (2, 1), (1, 33), (6, 49), (22, 33), (2, 1), (3, 33), (1, 1), (2, 33), (9, 1), (1, 9), (5, 1), (4, 3), (2, 33), (14, 1), (3, 3), (3, 1), (4, 65), (3, 1), (2, 65), (2, 1), (15, 65), (3, 73), (4, 1), (2, 65), (9, 1), (2, 65), (3, 1), (2, 17), (2, 1), (3, 65), (14, 1), (1, 9), (5, 1), (3, 3), (5, 1), (1, 33), (5, 1), (4, 65), (8, 1), (2, 65), (1, 1), (1, 65), (3, 1), (3, 65), (12, 1), (4, 3), (1, 1), (2, 33), (7, 1), (1, 17), (5, 1), (1, 33), (8, 1), (1, 65), (3, 1), (1, 65), (2, 1), (2, 65), (5, 1), (2, 9), (7, 1), (4, 33), (2, 1), (3, 33), (5, 49), (4, 33), (3, 35), (4, 33), (5, 1), (2, 65), (2, 1), (4, 65), (1, 1), (2, 65), (2, 1), (1, 3), (2, 67), (2, 3), (1, 65), (4, 1), (2, 65), (4, 1), (1, 9), (9, 1), (1, 9), (3, 1), (1, 9), (2, 1), (3, 3), (5, 1), (5, 3), (1, 67), (4, 1), (5, 3), (11, 1), (4, 3), (2, 1), (7, 65), (1, 1), (8, 33), (1, 43), (4, 3), (3, 1), (2, 33), (3, 1), (1, 33), (4, 1), (1, 33), (2, 1), (2, 65), (9, 1), (1, 65), (13, 1), (3, 33), (1, 1), (16, 33), (5, 35), (3, 49), (1, 33), (11, 1), (3, 33), (3, 49), (4, 33), (4, 1), (4, 65), (7, 1), (3, 3), (12, 1), (1, 65), (2, 73), (2, 1), (5, 9), (7, 1), (1, 65), (7, 1), (2, 65), (6, 1), (1, 17), (10, 1), (2, 17), (4, 1), (2, 19), (2, 3), (3, 33), (2, 35), (7, 33), (4, 3), (4, 1), (2, 33), (1, 35), (4, 3), (24, 65), (2, 67), (3, 3), (10, 1), (4, 3), (2, 35), (5, 33), (1, 1), (5, 33), (2, 41), (15, 33), (1, 49), (3, 51), (5, 33), (3, 1), (2, 33), (8, 1), (11, 33), (1, 41), (1, 9), (3, 1), (6, 73), (1, 65), (4, 1), (3, 65), (3, 1), (2, 65), (5, 1), (4, 3), (1, 65), (2, 1), (1, 65), (5, 1), (2, 65), (31, 1), (1, 33), (1, 35), (3, 3), (10, 1), (1, 17), (7, 1), (2, 33), (3, 3), (9, 1), (1, 17), (3, 3), (4, 17), (4, 1), (6, 65), (5, 67), (12, 65), (15, 73), (6, 65), (4, 1), (1, 3), (1, 67), (4, 3), (1, 1), (4, 65), (2, 9), (2, 1), (1, 9), (1, 73), (1, 75), (1, 11), (2, 3), (1, 11), (1, 9), (2, 1), (1, 9), (3, 11), (3, 9), (2, 11), (4, 1), (3, 3), (1, 1), (1, 33), (1, 9), (3, 11), (3, 41), (2, 43), (2, 1), (3, 9), (2, 11), (2, 9), (2, 1), (2, 11), (1, 3), (3, 1), (4, 35), (3, 33), (2, 1), (2, 3), (1, 1), (13, 65), (1, 1), (6, 65), (11, 1), (164, 0)] + +dieIn5 = ((5,1),d) + where d = rleDecode [(50,8), (5,9), (19,8), (3,9), (1,8), (1,0), (11,32), (2,48), (1,16), (2,0), (4,72), (16,64), (13,68), (1,76), (6,77), (1,73), (3,9), (29,1), (8,33), (3,49), (1,33), (2,17), (6,1), (4,65), (1,80), (57,16), (26,17), (5,49), (4,33), (2,49), (13,33), (9,1), (17,33), (4,1), (2,9), (4,1), (20,65), (2,73), (26,65), (3,81), (5,65), (1,97), (1,33), (3,37), (1,33), (1,1), (2,65), (2,73), (3,9), (2,11), (1,9), (2,11), (30,9), (10,41), (14,9), (22,41), (4,9), (4,41), (6,33), (3,1), (4,9), (10,1), (3,65), (8,1), (2,33), (7,49), (5,33), (1,41), (2,9), (12,1), (5,9), (7,1), (5,65), (3,81), (51,65), (14,1), (5,3), (24,1), (45,17), (7,1), (2,17), (5,1), (4,3), (4,1), (3,33), (3,1), (1,33), (7,1), (3,33), (2,1), (2,33), (3,1), (2,33), (5,35), (4,33), (4,1), (5,3), (4,1), (14,33), (7,41), (13,33), (9,41), (5,33), (4,41), (6,33), (1,41), (5,43), (3,41), (1,33), (4,41), (6,33), (14,41), (4,9), (13,41), (1,35), (3,43), (4,3), (3,35), (2,3), (2,35), (1,51), (1,19), (4,3), (1,19), (5,3), (1,19), (8,3), (5,19), (2,3), (3,1), (8,17), (3,81), (19,65), (1,73), (3,65), (9,73), (2,65), (5,73), (3,65), (5,67), (1,65), (1,81), (3,73), (7,65), (7,81), (4,17), (1,3), (2,17), (1,1), (5,17), (1,19), (4,3), (3,17), (1,49), (5,33), (5,41), (6,33), (1,1), (4,17), (3,1), (1,17), (5,19), (5,17), (1,1), (2,65), (1,67), (3,3), (1,19), (2,17), (3,1), (3,17), (4,1), (2,17), (2,1), (5,19), (1,17), (1,1), (1,33), (8,41), (10,33), (1,3), (2,19), (2,83), (5,81), (7,1), (3,17), (3,19), (2,3), (7,1), (3,65), (2,1), (1,17), (6,1), (2,9), (3,1), (1,33), (1,49), (8,17), (3,81), (2,83), (4,3), (8,1), (11,9), (6,1), (2,65), (2,73), (2,65), (5,73), (1,9), (3,1), (8,9), (1,41), (1,43), (1,35), (4,43), (3,33), (5,41), (2,9), (4,1), (4,9), (1,73), (9,65), (5,73), (10,65), (21,81), (13,65), (20,81), (3,17), (2,1), (13,17), (1,1), (13,33), (8,41), (13,9), (3,1), (2,9), (1,41), (2,33), (14,32), (18,0), (5,48), (22,32), (10,40), (17,41), (2,40), (5,41), (14,33), (3,41), (1,9), (2,1), (4,17), (4,81), (14,65), (7,81), (4,65), (1,81), (4,85), (19,81), (14,17), (9,1), (4,9), (1,1), (1,81), (1,80), (26,64), (12,72), (12,64), (7,72), (1,8), (7,0), (1,8), (5,0), (1,8), (3,0), (3,8), (2,0), (1,8), (6,0), (57,32), (10,48), (1,49), (1,33), (2,32), (3,41), (5,40), (3,8), (5,9), (2,8), (2,41), (1,33), (1,32), (2,33), (2,41), (3,1), (1,16), (2,49), (1,48), (1,49), (1,17), (3,16), (1,17), (2,16), (5,0), (7,32), (3,0), (2,16), (10,0), (3,8), (6,0), (43,64), (11,72), (2,64), (7,0), (3,64), (4,80), (6,64), (30,0), (6,64), (2,0), (3,16), (8,0), (3,32), (4,0), (6,32), (2,48), (12,32), (22,40), (2,41), (3,40), (1,41), (1,40), (2,41), (2,40), (1,41), (1,40), (1,32), (1,33), (1,32), (3,41), (1,40), (2,41), (1,40), (2,0), (12,16), (1,80), (2,64), (3,72), (15,64), (1,96), (10,32), (11,48), (4,16), (15,48), (9,32), (8,0), (1,8), (2,64), (1,0), (4,16), (6,48), (2,16), (1,17), (5,16), (2,17), (2,0), (2,1), (1,17), (1,1), (4,0), (3,16), (3,0), (2,16), (4,0), (3,8), (2,72), (11,8), (10,72), (4,74), (4,72), (1,8), (9,9), (15,73), (7,75), (7,73), (1,65), (11,1), (4,33), (1,1), (2,3), (3,35), (3,1), (1,33), (2,35), (4,3), (2,33), (1,17), (8,1), (21,65), (5,67), (7,1), (2,17), (17,49), (9,33), (1,49), (1,51), (3,35), (2,33), (2,41), (4,9), (2,41), (10,9), (1,1), (1,33), (5,35), (4,33), (2,1), (1,3), (4,35), (2,33), (5,1), (3,65), (1,1), (6,3), (6,17), (9,49), (1,33), (1,1), (9,65), (5,81), (5,17), (2,19), (2,67), (1,83), (7,81), (2,65), (1,1), (9,17), (1,81), (4,65), (3,19), (5,17), (5,49), (10,17), (1,49), (1,33), (2,1), (1,33), (11,1), (1,65), (7,1), (1,9), (2,1), (3,9), (3,1), (2,33), (4,49), (9,33), (2,1), (25,65), (8,73), (20,9), (1,1), (4,35), (4,33), (2,41), (18,9), (1,41), (8,33), (2,9), (1,1), (1,33), (2,35), (1,3), (2,1), (2,33), (3,1), (6,33), (6,49), (1,17), (5,65), (1,81), (4,17), (2,81), (1,65), (3,1), (5,17), (6,49), (1,17), (5,65), (5,73), (6,65), (1,73), (10,9), (22,73), (7,65), (6,1), (1,9), (5,1), (2,17), (14,81), (17,17), (3,81), (3,65), (4,73), (3,77), (2,70), (8,81), (1,83), (3,19), (9,17), (7,1), (4,65), (5,1), (3,33), (1,1), (15,9), (5,41), (3,9), (3,41), (1,43), (3,35), (6,33), (2,41), (19,9), (2,1), (23,33), (8,1), (2,17), (4,1), (1,33), (1,1), (2,9), (2,1), (1,9), (1,1), (5,65), (4,73), (3,65), (7,1), (9,65), (2,1), (7,65), (30,1), (145,0)] + +shieldAttack = ((1,0),d) + where d = rleDecode [(30,0), (31,1), (5,33), (21,1), (4,17), (50,1), (5,5), (118,1), (7,17), (63,1), (37,65), (5,1), (10,33), (5,37), (5,33), (20,1), (3,33), (15,1), (3,33), (14,1), (3,33), (7,1), (5,17), (15,1), (15,65), (7,1), (9,33), (9,1), (3,5), (52,1), (3,33), (10,1), (4,33), (11,1), (2,33), (35,1), (5,17), (5,1), (3,17), (23,1), (9,65), (4,1), (4,17), (9,1), (6,33), (12,9), (6,41), (2,9), (6,1), (3,9), (5,1), (4,9), (4,1), (5,9), (24,1), (4,9), (15,1), (22,17), (4,1), (10,17), (16,1), (8,33), (9,41), (3,9), (3,41), (2,33), (3,1), (2,9), (14,1), (8,65), (1,81), (4,17), (16,1), (10,9), (7,41), (1,9), (6,1), (3,9), (15,1), (4,5), (1,21), (33,17), (19,1), (3,65), (9,1), (2,65), (16,1), (4,9), (10,1), (7,9), (2,1), (7,9), (8,1), (5,33), (3,41), (2,9), (6,1), (4,5), (12,1), (6,3), (10,9), (5,41), (2,9), (11,1), (5,65), (3,81), (1,17), (6,1), (7,17), (1,1), (6,17), (1,19), (4,3), (8,1), (3,17), (5,1), (5,17), (5,1), (9,17), (30,1), (3,65), (10,1), (12,65), (3,1), (2,17), (7,1), (3,17), (16,1), (5,65), (12,1), (3,33), (2,37), (2,5), (6,1), (2,33), (9,41), (4,33), (1,1), (6,9), (3,1), (4,33), (10,41), (19,9), (8,41), (4,9), (17,1), (5,3), (7,1), (8,65), (5,73), (5,1), (7,17), (14,49), (2,1), (12,65), (8,81), (5,83), (1,19), (1,83), (6,81), (10,17), (3,1), (8,33), (2,41), (21,9), (6,73), (8,9), (3,41), (1,9), (12,65), (10,81), (5,17), (3,49), (2,19), (4,3), (3,1), (10,33), (3,49), (17,17), (1,1), (4,65), (4,1), (4,3), (3,35), (4,33), (6,1), (11,17), (5,1), (6,65), (7,1), (5,3), (3,75), (4,73), (1,9), (8,1), (7,9), (3,11), (1,3), (3,35), (13,33), (3,49), (9,17), (2,3), (4,35), (3,33), (11,1), (15,9), (1,1), (8,65), (2,67), (4,83), (10,17), (5,1), (10,65), (8,17), (10,1), (3,17), (5,1), (5,33), (3,1), (13,9), (9,11), (10,1), (17,65), (2,73), (8,9), (7,33), (20,1), (6,65), (34,1), (5,3), (26,1), (11,65), (8,1), (5,3), (19,1), (7,33), (12,1), (10,33), (7,3), (30,1), (8,33), (11,1), (7,3), (4,1), (12,33), (30,1), (4,35), (2,3), (18,1), (25,65), (29,1), (10,17), (12,1), (14,17), (14,1), (6,3), (25,1), (5,17), (17,1), (6,9), (7,1), (2,9), (18,1), (6,9), (3,1), (5,33), (10,1), (3,9), (8,1), (5,33), (6,1), (5,9), (16,1), (7,33), (1,49), (10,17), (9,1), (9,17), (11,1), (3,17), (13,1), (7,65), (7,1), (3,65), (7,1), (6,65), (4,1), (15,9), (5,33), (11,1), (9,33), (4,1), (5,9), (3,1), (11,33), (8,41), (9,33), (3,41), (2,9), (6,1), (4,9), (6,33), (2,41), (12,9), (3,33), (1,1), (2,9), (8,1), (6,9), (16,1), (4,65), (6,1), (24,17), (8,16), (13,0), (2,64), (48,0), (5,4), (4,0), (2,16), (11,0), (3,8), (38,0), (13,64), (4,65), (8,1), (4,17), (5,1), (6,65), (9,1), (4,9), (16,1), (3,65), (9,1), (5,17), (5,1), (10,33), (5,9), (16,1), (8,0), (2,8), (9,0), (4,64), (7,65), (5,1), (4,3), (8,1), (4,17), (6,1), (7,0), (5,32), (9,8), (12,72), (2,64), (9,65), (7,1), (2,9), (9,1), (6,65), (14,1), (6,33), (6,1), (4,9), (12,1), (3,65), (13,1), (2,17), (15,1), (5,33), (9,1), (3,33), (3,1), (4,17), (11,1), (3,33), (6,1), (5,3), (1,1), (3,33), (13,1), (2,17), (2,19), (1,3), (11,1), (10,17), (10,1), (3,17), (7,1), (7,3), (11,1), (10,33), (2,1), (2,9), (11,73), (7,65), (1,1), (9,17), (14,1), (3,9), (1,73), (2,65), (1,73), (8,9), (6,41), (2,9), (10,1), (8,17), (5,81), (1,83), (4,67), (1,3), (9,1), (7,65), (2,81), (4,17), (6,1), (4,17), (8,1), (3,17), (3,1), (6,65), (3,1), (4,3), (8,1), (2,17), (25,1), (4,17), (7,1), (19,33), (7,41), (4,33), (1,1), (7,33), (13,1), (6,3), (30,1), (6,65), (12,1), (6,33), (3,41), (4,9), (8,1), (6,33), (3,1), (5,17), (6,3), (12,1), (3,17), (13,1), (6,17), (12,1), (7,65), (11,9), (3,1), (6,3), (1,11), (2,9), (15,1), (3,9), (6,1), (2,9), (6,1), (7,3), (18,1), (3,9), (6,1), (9,33), (1,1), (11,17), (1,81), (2,65), (3,67), (3,3), (9,1), (6,17), (3,1), (6,3), (2,19), (1,17), (14,1), (5,9), (5,1), (5,9), (2,1), (4,3), (4,35), (2,33), (6,1), (5,9), (5,1), (2,3), (5,11), (14,1), (7,3), (16,1), (10,33), (2,1), (5,17), (4,19), (3,3), (11,1), (2,9), (8,1), (6,9), (9,1), (11,65), (3,67), (3,3), (7,1), (3,17), (11,1), (2,65), (8,1), (2,17), (15,1), (5,9), (3,1), (6,65), (22,1), (7,33), (8,41), (5,1), (10,9), (11,1), (4,9), (5,1), (2,9), (12,1), (3,9), (6,1), (4,33), (3,1), (7,17), (8,1), (4,17), (1,1), (5,65), (1,81), (6,65), (9,0), (3,16), (9,17), (3,16), (4,0), (2,1), (1,17), (2,81), (6,65), (6,1), (5,17), (5,1), (5,3), (2,1), (3,65), (9,1), (4,17), (26,1), (4,3), (14,1), (4,65), (7,1), (5,65), (8,1), (3,65), (16,1), (4,65), (7,1), (6,3), (7,1), (4,65), (17,1), (4,33), (11,1), (2,33), (10,1), (3,9), (11,1), (2,9), (13,1), (3,17), (15,1), (13,33), (5,1), (3,33), (3,35), (2,3), (5,1), (3,9), (5,1), (2,65), (7,1), (16,65), (6,1), (2,65), (4,73), (1,9), (2,1), (6,3), (3,1), (3,65), (8,1), (3,9), (8,1), (4,65), (9,1), (3,65), (7,1), (2,9), (12,1), (4,3), (2,67), (1,65), (8,1), (2,9), (9,1), (4,9), (12,1), (6,3), (8,1), (3,65), (24,1), (4,3), (26,1), (4,3), (10,1), (2,65), (47,1), (142,0)] + +three = ((3,0),d) + where d = rleDecode [(16, 0), (7, 8), (12, 9), (71, 8), (7, 1), (3, 17), (25, 1), (6, 65), (1, 1), (60, 33), (90, 65), (52, 64), (2, 96), (3, 36), (9, 32), (5, 0), (1, 8), (37, 0), (2, 1), (2, 65), (5, 1), (2, 33), (3, 1), (2, 33), (4, 1), (1, 33), (3, 9), (1, 1), (1, 9), (4, 1), (4, 65), (4, 81), (22, 65), (21, 64), (1, 68), (2, 4), (1, 36), (5, 32), (8, 0), (4, 32), (2, 0), (13, 16), (66, 48), (2, 32), (33, 33), (2, 41), (1, 72), (17, 64), (3, 80), (31, 64), (3, 68), (1, 64), (2, 72), (3, 8), (1, 9), (11, 33), (2, 9), (2, 1), (3, 33), (6, 1), (1, 33), (1, 41), (4, 9), (8, 1), (3, 9), (1, 1), (3, 9), (3, 1), (1, 9), (3, 1), (1, 9), (4, 1), (5, 33), (2, 1), (2, 17), (4, 1), (2, 17), (13, 1), (6, 65), (1, 73), (5, 9), (5, 33), (2, 1), (2, 33), (1, 41), (1, 9), (1, 41), (4, 33), (2, 41), (3, 9), (1, 1), (1, 9), (1, 1), (6, 0), (1, 32), (4, 33), (4, 8), (2, 0), (1, 32), (1, 33), (2, 1), (1, 0), (2, 32), (1, 16), (1, 48), (11, 16), (7, 80), (2, 16), (2, 1), (8, 0), (5, 64), (9, 72), (18, 64), (17, 16), (1, 0), (8, 1), (2, 17), (20, 1), (25, 33), (1, 40), (20, 8), (31, 72), (1, 65), (10, 1), (34, 33), (1, 1), (9, 17), (11, 16), (10, 80), (2, 64), (4, 80), (2, 81), (4, 80), (2, 81), (6, 80), (7, 64), (6, 80), (1, 113), (2, 33), (2, 32), (22, 33), (2, 1), (4, 65), (7, 73), (2, 72), (4, 8), (2, 40), (4, 41), (1, 40), (8, 32), (9, 40), (2, 41), (1, 9), (19, 8), (3, 9), (3, 1), (2, 17), (1, 81), (3, 65), (7, 81), (3, 80), (26, 16), (3, 80), (1, 64), (2, 65), (1, 64), (3, 72), (2, 73), (1, 65), (1, 64), (1, 80), (4, 81), (1, 80), (1, 81), (3, 17), (4, 16), (1, 65), (2, 1), (2, 0), (14, 64), (3, 72), (25, 8), (14, 40), (2, 41), (2, 40), (2, 41), (2, 40), (3, 41), (1, 33), (14, 32), (4, 0), (4, 16), (5, 0), (2, 8), (7, 0), (3, 64), (1, 72), (3, 8), (2, 72), (8, 64), (5, 80), (6, 64), (4, 0), (4, 36), (1, 8), (3, 0), (11, 1), (3, 33), (3, 49), (3, 17), (2, 81), (25, 17), (13, 16), (1, 17), (13, 1), (2, 33), (5, 32), (1, 40), (2, 8), (1, 0), (30, 8), (1, 9), (4, 41), (4, 33), (4, 1), (1, 9), (4, 1), (1, 9), (2, 1), (2, 9), (3, 1), (2, 9), (1, 1), (1, 9), (5, 1), (2, 9), (6, 65), (1, 81), (8, 65), (5, 1), (3, 33), (1, 1), (3, 65), (5, 1), (7, 17), (1, 49), (4, 48), (2, 16), (12, 17), (5, 81), (9, 17), (3, 81), (5, 65), (3, 81), (3, 17), (10, 1), (9, 65), (8, 1), (19, 33), (4, 41), (20, 9), (5, 73), (3, 77), (1, 13), (13, 9), (4, 1), (1, 9), (4, 1), (1, 9), (7, 1), (4, 3), (10, 1), (10, 65), (38, 1), (2, 65), (69, 1), (12, 65), (4, 67), (1, 3), (62, 1), (6, 3), (20, 1), (7, 33), (5, 1), (9, 33), (1, 1), (8, 65), (10, 1), (3, 3), (1, 67), (1, 65), (4, 1), (2, 65), (7, 1), (3, 3), (9, 1), (14, 33), (1, 35), (2, 3), (12, 1), (2, 33), (4, 1), (4, 3), (4, 1), (3, 33), (2, 1), (4, 3), (2, 1), (7, 17), (1, 49), (15, 33), (3, 41), (5, 9), (1, 1), (2, 33), (5, 35), (1, 33), (7, 1), (1, 33), (8, 1), (5, 3), (3, 1), (8, 65), (6, 1), (6, 3), (1, 67), (4, 65), (3, 1), (1, 33), (5, 49), (2, 17), (4, 81), (1, 65), (1, 67), (3, 3), (3, 1), (3, 65), (2, 81), (2, 17), (1, 81), (2, 17), (3, 81), (3, 1), (13, 65), (4, 81), (12, 17), (4, 1), (3, 17), (2, 1), (5, 33), (3, 1), (12, 9), (4, 1), (6, 9), (9, 1), (3, 3), (31, 1), (4, 33), (7, 41), (20, 33), (3, 35), (2, 3), (3, 9), (2, 1), (1, 9), (7, 73), (15, 65), (1, 81), (19, 17), (5, 1), (5, 17), (2, 1), (4, 17), (2, 49), (4, 51), (1, 19), (2, 17), (16, 1), (1, 33), (19, 1), (30, 9), (32, 1), (20, 17),(170, 1), (4, 17), (3, 1), (3, 65), (1, 73), (4, 9), (8, 41), (6, 1), (2, 9), (6, 1), (1, 65), (6, 81), (14, 17), (13, 1), (9, 65), (7, 73), (3, 1), (1, 65), (13, 73), (9, 65), (4, 1), (6, 17), (4, 65), (10, 1), (2, 9), (3, 1), (4, 9), (9, 1), (2, 9), (15, 1), (1, 17), (7, 1), (3, 33), (2, 49), (27, 33), (6, 35), (3, 41), (21, 9), (1, 41), (1, 35), (3, 51), (2, 49), (5, 17), (15, 49), (3, 51), (1, 49), (1, 17), (12, 1), (7, 33), (1, 1), (2, 17), (18, 1), (13, 65), (30, 73), (1, 65), (73, 1), (2, 9), (47, 1), (31, 17), (2, 1), (2, 33), (5, 49), (1, 33), (4, 1), (3, 3), (1, 67), (2, 65), (1, 1), (3, 9), (2, 73), (9, 65), (3, 1), (20, 65), (1, 73), (4, 9), (1, 11), (3, 43), (1, 35), (4, 33), (15, 9), (2, 41), (2, 43), (1, 35), (8, 33), (2, 41), (6, 9), (3, 1), (1, 9), (1, 1), (9, 3), (10, 35), (1, 3), (1, 1), (5, 33), (2, 49), (3, 1), (2, 17), (1, 19), (3, 83), (7, 81), (4, 65), (6, 1), (1, 67), (3, 3), (14, 65), (1, 17), (1, 19), (3, 3), (4, 1), (5, 65), (1, 81), (2, 17), (6, 1), (7, 33), (1, 41), (1, 9), (11, 11), (4, 3), (1, 11), (2, 3), (1, 11), (19, 3), (14, 35), (7, 33), (2, 49), (13, 33), (3, 35), (2, 3), (2, 1), (1, 9), (5, 65), (8, 1), (2, 65), (1, 67), (3, 3), (3, 67), (18, 65), (1, 1), (3, 3), (2, 35), (1, 3), (2, 1), (8, 33), (4, 49), (1, 17), (4, 1), (2, 33), (1, 1), (2, 33), (5, 1), (2, 33), (7, 1), (8, 17), (6, 49), (1, 17), (3, 19), (2, 3), (1, 35), (1, 3), (1, 1), (9, 65), (13, 81), (1, 19), (1, 3), (2, 35), (1, 33), (7, 41), (12, 33), (8, 49), (8, 17), (1, 19), (4, 3), (3, 1), (4, 3), (2, 1), (5, 9), (1, 1), (4, 33), (3, 17), (1, 81), (3, 65), (2, 1), (2, 9), (2, 1), (6, 65), (2, 73), (10, 65), (17, 73), (1, 75), (1, 11), (7, 3), (1, 65), (3, 73), (1, 75), (2, 11), (2, 3), (2, 33), (3, 1), (2, 65), (1, 73), (1, 9), (1, 73), (3, 65), (1, 33), (4, 35), (5, 33), (4, 41), (3, 9), (1, 33), (3, 35), (4, 3), (2, 11), (1, 3), (1, 1), (2, 33), (1, 35), (4, 3), (6, 35), (2, 33), (1, 49), (5, 1), (2, 17), (2, 19), (5, 83), (3, 81), (5, 65), (6, 81), (1, 65), (1, 1), (1, 3), (2, 19), (2, 3), (4, 1), (1, 9), (1, 11), (2, 75), (2, 11), (1, 3), (3, 1), (12, 33), (4, 35), (1, 43), (10, 9), (2, 1), (1, 65), (3, 73), (2, 65), (3, 1), (12, 65), (3, 73), (3, 1), (1, 9), (1, 1), (1, 9), (9, 1), (5, 33), (1, 5), (1, 21), (2, 5), (2, 1), (2, 65), (9, 67), (2, 81), (4, 17), (6, 81), (10, 17), (3, 3), (2, 1), (8, 33), (1, 41), (10, 9), (12, 73), (9, 65), (1, 73), (3, 1), (2, 9), (8, 1), (3, 65), (4, 1), (2, 65), (7, 1), (1, 65), (4, 1), (4, 33), (4, 1), (6, 33), (3, 1), (2, 33), (37, 1), (2, 33), (39, 1), (1, 33), (16, 1), (2, 33), (3, 3), (13, 1), (2, 3), (2, 35), (10, 1), (5, 35), (5, 33), (8, 49), (5, 17), (4, 49), (4, 17), (1, 1), (1, 3), (4, 19), (14, 17), (2, 19), (4, 3), (6, 1), (4, 3), (2, 1), (3, 33), (11, 1), (1, 9), (3, 1), (2, 9), (3, 1), (26, 65), (7, 73), (5, 75), (2, 9), (5, 1), (2, 9), (3, 1), (13, 9), (1, 41), (1, 43), (1, 11), (3, 3), (2, 11), (2, 3), (1, 11), (2, 3), (1, 11), (3, 3), (1, 11), (6, 3), (1, 11), (7, 3), (1, 11), (5, 3), (21, 35), (1, 1), (10, 65), (4, 81), (13, 17), (13, 49), (6, 51), (4, 49), (1, 33), (26, 1), (6, 3), (7, 1), (2, 9), (9, 73), (1, 65), (6, 1), (2, 65), (1, 9), (9, 1), (6, 3), (15, 1), (16, 33), (1, 97), (17, 65), (3, 1), (9, 3), (3, 1), (2, 65), (9, 1), (2, 65), (4, 1), (1, 65), (1, 67), (6, 3), (7, 1), (3, 65), (1, 1), (6, 3), (4, 1), (1, 65), (5, 1), (1, 67), (3, 3), (4, 1), (4, 3), (6, 1), (5, 33), (1, 49), (1, 17), (7, 1), (5, 3), (5, 1), (2, 65), (2, 1), (1, 3), (1, 35), (1, 33), (1, 49), (1, 17), (6, 1), (1, 65), (1, 67), (3, 3), (8, 1), (7, 33), (14, 1), (4, 3), (12, 1), (1, 65), (6, 1), (4, 65), (5, 1), (1, 65), (2, 1), (7, 65), (5, 1), (1, 65), (2, 1), (7, 65), (4, 1), (1, 9), (2, 1), (21, 33), (1, 1), (13, 65), (5, 67), (1, 75), (1, 73), (3, 1), (12, 17), (4, 1), (2, 17), (1, 1), (6, 65), (2, 1), (1, 33), (6, 49), (22, 33), (2, 1), (3, 33), (1, 1), (2, 33), (9, 1), (1, 9), (5, 1), (4, 3), (2, 33), (14, 1), (3, 3), (3, 1), (4, 65), (3, 1), (2, 65), (2, 1), (15, 65), (3, 73), (4, 1), (2, 65), (9, 1), (2, 65), (3, 1), (2, 17), (2, 1), (3, 65), (14, 1), (1, 9), (5, 1), (3, 3), (5, 1), (1, 33), (5, 1), (4, 65), (8, 1), (2, 65), (1, 1), (1, 65), (3, 1), (3, 65), (12, 1), (4, 3), (1, 1), (2, 33), (7, 1), (1, 17), (5, 1), (1, 33), (8, 1), (1, 65), (3, 1), (1, 65), (2, 1), (2, 65), (5, 1), (2, 9), (7, 1), (4, 33), (2, 1), (3, 33), (5, 49), (4, 33), (3, 35), (4, 33), (5, 1), (2, 65), (2, 1), (4, 65), (1, 1), (2, 65), (2, 1), (1, 3), (2, 67), (2, 3), (1, 65), (4, 1), (2, 65), (4, 1), (1, 9), (9, 1), (1, 9), (3, 1), (1, 9), (2, 1), (3, 3), (5, 1), (5, 3), (1, 67), (4, 1), (5, 3), (11, 1), (4, 3), (2, 1), (7, 65), (1, 1), (8, 33), (1, 43), (4, 3), (3, 1), (2, 33), (3, 1), (1, 33), (4, 1), (1, 33), (2, 1), (2, 65), (9, 1), (1, 65), (13, 1), (3, 33), (1, 1), (16, 33), (5, 35), (3, 49), (1, 33), (11, 1), (3, 33), (3, 49), (4, 33), (4, 1), (4, 65), (7, 1), (3, 3), (12, 1), (1, 65), (2, 73), (2, 1), (5, 9), (7, 1), (1, 65), (7, 1), (2, 65), (6, 1), (1, 17), (10, 1), (2, 17), (4, 1), (2, 19), (2, 3), (3, 33), (2, 35), (7, 33), (4, 3), (4, 1), (2, 33), (1, 35), (4, 3), (24, 65), (2, 67), (3, 3), (10, 1), (4, 3), (2, 35), (5, 33), (1, 1), (5, 33), (2, 41), (15, 33), (1, 49), (3, 51), (5, 33), (3, 1), (2, 33), (8, 1), (11, 33), (1, 41), (1, 9), (3, 1), (6, 73), (1, 65), (4, 1), (3, 65), (3, 1), (2, 65), (5, 1), (4, 3), (1, 65), (2, 1), (1, 65), (5, 1), (2, 65), (31, 1), (1, 33), (1, 35), (3, 3), (10, 1), (1, 17), (7, 1), (2, 33), (3, 3), (9, 1), (1, 17), (3, 3), (4, 17), (4, 1), (6, 65), (5, 67), (12, 65), (15, 73), (6, 65), (4, 1), (1, 3), (1, 67), (4, 3), (1, 1), (4, 65), (2, 9), (2, 1), (1, 9), (1, 73), (1, 75), (1, 11), (2, 3), (1, 11), (1, 9), (2, 1), (1, 9), (3, 11), (3, 9), (2, 11), (4, 1), (3, 3), (1, 1), (1, 33), (1, 9), (3, 11), (3, 41), (2, 43), (2, 1), (3, 9), (2, 11), (2, 9), (2, 1), (2, 11), (1, 3), (3, 1), (4, 35), (3, 33), (2, 1), (2, 3), (1, 1), (13, 65), (1, 1), (6, 65), (11, 1),(164, 0)] + +laserFool=((1,0),d) + where d = rleDecode [(26, 0), (3, 1), (5, 9), (3, 8), (9, 0), (6, 8), (2, 72), (7, 64), (1, 80), (17, 16), (8, 17), (1, 49), (14, 33), (3, 41), (18, 9), (3, 73), (11, 65), (1, 1), (29, 17), (3, 49), (7, 33), (5, 41), (14, 9), (3, 1), (7, 9), (22, 1), (5, 9), (13, 1), (5, 9), (19, 1), (5, 9), (11, 1), (13, 33), (5, 41), (11, 9), (2, 1), (38, 65), (1, 81), (6, 17), (7, 21), (2, 17), (46, 49), (7, 1), (3, 17), (16, 49), (4, 17), (1, 81), (8, 65), (10, 73), (24, 65), (1, 73), (10, 65), (3, 73), (4, 9), (1, 41), (2, 33), (6, 37), (4, 33), (5, 41), (11, 9), (25, 1), (5, 33), (2, 1), (7, 9), (1, 1), (5, 33), (13, 49), (11, 17), (7, 49), (3, 17), (25, 1), (5, 65), (3, 73), (7, 65), (1, 73), (27, 65), (3, 73), (2, 9), (8, 41), (5, 9), (11, 41), (6, 33), (2, 41), (9, 9), (1, 41), (4, 33), (3, 41), (2, 9), (2, 1), (3, 33), (2, 1), (4, 73), (10, 65), (10, 73), (2, 9), (2, 41), (2, 33), (17, 49), (9, 17), (22, 49), (2, 33), (16, 1), (7, 17), (21, 65), (3, 73), (2, 9), (3, 41), (3, 33), (15, 1), (6, 73), (5, 9), (2, 1), (12, 33), (2, 1), (2, 65), (3, 69), (3, 77), (4, 73), (8, 65), (3, 81), (5, 17), (15, 16), (14, 48), (5, 49), (5, 41), (8, 40), (7, 8), (14, 72), (6, 73), (6, 72), (5, 8), (9, 40), (8, 8), (6, 40), (11, 41), (3, 33), (4, 32), (5, 16), (9, 80), (10, 81), (12, 80), (4, 81), (2, 65), (1, 81), (13, 80), (3, 16), (4, 17), (1, 81), (15, 16), (3, 48), (2, 32), (8, 33), (8, 32), (8, 40), (8, 8), (5, 40), (8, 41), (1, 9), (7, 13), (2, 45), (8, 40), (8, 8), (3, 40), (8, 41), (1, 9), (7, 73), (4, 72), (10, 64), (4, 80), (21, 16), (11, 17), (16, 16), (11, 17), (2, 25), (1, 24), (17, 8), (40, 9), (3, 41), (7, 33), (18, 65), (7, 81), (1, 85), (6, 69), (1, 73), (7, 9), (1, 41), (3, 33), (4, 35), (4, 33), (3, 49), (8, 17), (13, 81), (6, 65), (1, 1), (10, 17), (32, 49), (2, 48), (14, 16), (2, 0), (1, 64), (6, 72), (10, 8), (32, 72), (15, 8), (1, 24), (1, 56), (6, 48), (8, 0), (2, 16), (8, 0), (2, 16), (2, 48), (8, 32), (8, 0), (8, 32), (12, 40), (1, 41), (1, 33), (16, 49), (3, 17), (2, 16), (15, 0), (4, 16), (12, 0), (16, 64), (10, 72), (6, 73), (2, 89), (5, 17), (9, 49), (6, 17), (2, 81), (3, 65), (3, 73), (1, 1), (1, 3), (4, 19), (5, 17), (7, 1), (5, 17), (10, 1), (5, 33), (1, 49), (4, 17), (10, 1), (3, 65), (3, 73), (15, 9), (1, 41), (3, 43), (8, 41), (27, 9), (4, 41), (21, 1), (8, 33), (16, 1), (19, 17), (3, 19), (2, 17), (18, 65), (9, 73), (11, 9), (5, 1), (4, 9), (11, 1), (2, 9), (22, 1), (27, 33), (1, 1), (44, 65), (1, 67), (4, 3), (1, 35), (9, 33), (46, 49), (2, 17), (5, 1), (6, 33), (7, 1), (7, 65), (5, 73), (2, 9), (13, 1), (1, 65), (1, 73), (2, 9), (6, 1), (20, 65), (7, 1), (1, 3), (3, 67), (2, 19), (3, 17), (15, 1), (6, 17), (16, 1), (3, 17), (15, 1), (5, 17), (3, 1), (6, 33), (7, 41), (8, 9), (15, 41), (5, 43), (1, 3), (4, 0), (11, 64), (6, 0), (3, 32), (23, 40), (1, 9), (4, 1), (7, 0), (8, 64), (5, 80), (24, 16), (7, 0), (1, 8), (2, 0), (11, 32), (5, 0), (4, 32), (1, 40), (2, 8), (10, 0), (11, 16), (17, 17), (8, 1), (1, 0), (5, 8), (29, 72), (24, 0), (10, 1), (17, 0), (18, 1), (11, 0), (1, 32), (1, 0), (2, 16), (5, 48), (8, 32), (8, 40), (14, 41), (6, 9), (9, 41), (6, 9), (14, 1), (10, 65), (8, 1), (19, 17), (6, 21), (21, 17), (11, 81), (10, 65), (11, 73), (20, 9), (4, 1), (4, 9), (19, 1), (4, 33), (1, 35), (5, 3), (20, 1), (13, 65), (5, 81), (14, 17), (9, 49), (6, 33), (4, 41), (10, 9), (7, 73), (2, 65), (7, 1), (5, 3), (23, 1), (4, 65), (4, 81), (10, 17), (7, 49), (5, 33), (7, 41), (14, 9), (1, 73), (6, 65), (34, 73), (1, 41), (4, 33), (11, 49), (1, 17), (4, 81), (2, 65),(122, 1), (31, 65), (5, 33), (33, 49), (4, 51), (10, 49), (7, 41), (6, 73), (10, 65), (5, 81), (10, 17), (1, 33), (1, 35), (4, 43), (2, 41), (37, 9), (9, 41), (1, 33), (2, 35), (3, 43), (2, 11), (2, 3), (11, 1), (2, 33), (1, 1), (11, 65), (11, 81), (5, 83), (1, 19), (2, 3), (16, 1), (8, 65), (1, 97), (32, 33), (22, 49), (8, 51), (2, 49), (2, 33), (8, 1), (7, 9), (6, 73), (9, 65), (8, 1), (4, 9), (1, 73), (2, 65), (1, 1), (32, 17), (7, 51), (1, 43), (10, 9), (4, 8), (6, 72), (12, 73), (10, 75), (2, 11), (1, 43), (1, 41), (3, 33), (1, 32), (2, 48), (10, 16), (6, 17), (4, 19), (2, 3), (2, 65), (3, 73), (3, 65), (8, 73), (11, 9), (1, 11), (6, 35), (6, 3), (2, 1), (9, 65), (1, 81), (3, 17), (8, 19), (7, 1), (3, 65), (1, 67), (9, 3), (5, 1), (11, 65), (8, 1), (2, 3), (9, 67), (2, 3), (3, 1), (3, 33), (7, 1), (7, 33), (3, 1), (2, 33), (11, 35), (11, 33), (3, 1), (5, 33), (8, 35), (2, 3), (6, 1), (7, 33), (2, 1), (5, 65), (17, 73), (5, 9), (2, 41), (5, 33), (6, 35), (1, 33), (7, 1), (3, 9), (4, 1), (21, 33), (52, 1), (170, 0)]
+ src/Game.hs view
@@ -0,0 +1,10 @@+module Game (Game(..)) where + +import Graphics.UI.GLUT.Callbacks.Window + +-- | An abstracted game as a state machine. +class Game g where + update :: [Key] -> g -> g + render :: g -> IO () + isGameover :: g -> Bool +
+ src/Main.hs view
@@ -0,0 +1,366 @@+{- Copyright 2005 Hideyuki Tanaka & Takayuki Muranushi + This program is distributed under the terms of the GNU General Public License. + + NOTE + This project meant to list up, not to solve, many possible problems that will appear + while writing a game in Haskell. + Only nushio is responsible to the unreadability of these codes. +-} + +module Main (main) where + +import Control.Exception (SomeException (..), catch) +import Control.Monad (mplus, zipWithM_) +import Data.Complex +import Data.IORef +import Data.List +import Data.Maybe +import Graphics.UI.GLUT hiding (position) +import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.Environment (getArgs, getEnv) +import System.Exit (exitSuccess) + +import Demo (ReplayInfo (..), demoData) +import Game (isGameover, render, update) +import Monadius +import Recorder +import Util (intToGLdouble, padding, putDebugStrLn) + +data GlobalVariables = GlobalVariables{ + saveState :: (Int,Int) ,isCheat :: Bool, demoIndex :: Int, + -- | 'recorderMode' means general gamemode that user wants, + -- 'mode' of a recorder means current gamemode. + -- two are different when temporal demo replays. + recorderMode :: RecorderMode, + playbackKeys :: [[Key]],playbackSaveState :: (Int,Int),playBackName :: Maybe String, + recordSaveState :: (Int,Int),saveHiScore :: Int + } + +replayFileExtension :: String +replayFileExtension = ".replay" + +presentationMode :: Bool +presentationMode = True + +loadReplay :: String-> IO ReplayInfo +loadReplay filename = readFile filename >>= (return . read) + +main :: IO () +main = do + args <- getArgs + putDebugStrLn $ show args + _ <- getArgsAndInitialize + keystate <- newIORef [] + + (recMode,keys,rss,repName) <- if isJust $ getReplayFilename args then do + ReplayInfo (ss,keystr) <- (loadReplay . fromJust . getReplayFilename) args + return (Playback,decode keystr,ss,Just $ (simplify . fromJust . getReplayFilename) args) + else if "-r" `elem` args then do + return (Play,[],(1,0),Nothing) + else + return (Record,[],(1,0),Nothing) + + cp <- newIORef (openingProc 0 0 GlobalVariables{saveState = (1,0) ,isCheat = False, + recorderMode=recMode,playbackKeys=keys,playbackSaveState = rss,recordSaveState=(1,0),demoIndex=0, + playBackName=repName,saveHiScore=0} keystate) + initialWindowSize $= Size 640 480 + initialDisplayMode $= [RGBAMode,DoubleBuffered{-,WithDepthBuffer,WithAlphaComponent-}] + + wnd <- createWindow "Monadius" + + curwnd <- if "-f" `elem` args then do + gameModeCapabilities $= [ + Where' GameModeWidth IsLessThan 650, + Where' GameModeHeight IsLessThan 500 + --Where' GameModeBitsPerPlane IsEqualTo 32, + --Where' GameModeRefreshRate IsAtLeast 30, + --Where' GameModeNum IsAtLeast 2 + ] + + displayCallback $= dispProc cp + (wnd2,_) <- enterGameMode + destroyWindow wnd + return wnd2 + else do + return wnd + + displayCallback $= dispProc cp + keyboardMouseCallback $= Just (keyProc keystate) + + addTimerCallback 16 (timerProc (dispProc cp)) + + initMatrix + + mainLoop + destroyWindow curwnd + + `catch` (\(SomeException _) -> return ()) + + where + getReplayFilename [] = Nothing + getReplayFilename a = (Just . head . candidates) a + + candidates args = filter (replayFileExtension `isSuffixOf`) args + + simplify = (removesuffix . removedir) + + removedir str = if '\\' `elem` str || '/' `elem` str then (removedir . tail) str else str + removesuffix str = if '.' `elem` str then (removesuffix . init) str else str + +exitLoop :: IO a +exitLoop = exitSuccess + +initMatrix :: IO () +initMatrix = do + viewport $= (Position 0 0,Size 640 480) + matrixMode $= Projection + loadIdentity + perspective 30.0 (4/3) 600 1400 + lookAt (Vertex3 0 0 (927 :: GLdouble)) (Vertex3 0 0 (0 :: GLdouble)) (Vector3 0 1 (0 :: GLdouble)) + +dispProc :: IORef (IO Scene) -> IO () +dispProc cp = do + m <- readIORef cp + Scene next <- m + writeIORef cp next + +-- | Scene is something that does some IO, +-- then returns the Scene that are to be executed in next frame. +newtype Scene = Scene (IO Scene) + +openingProc :: Int -> Int -> GlobalVariables -> IORef [Key] -> IO Scene +openingProc clock menuCursor vars ks = do + if recorderMode vars == Playback then gameStart (fst $ playbackSaveState vars) (snd $ playbackSaveState vars) (isCheat vars) Playback vars else do + if clock > demoStartTime then do demoStart vars else do + + keystate <- readIORef ks + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + + if clock < drawCompleteTime then color $ Color3 (0 :: GLdouble) 0.2 0.8 + else color $ Color3 (0+shine clock :: GLdouble) (0.2+shine clock) (0.8+shine clock) + preservingMatrix $ do + translate (Vector3 0 (120 :: GLdouble) 0) + scale 1.05 1 (1 :: GLdouble) + mapM_ (renderPrimitive LineStrip . renderVertices2D.delayVertices clock) [lambdaLfoot,lambdaRfoot] + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + preservingMatrix $ do + translate $ Vector3 (-195 :: GLdouble) (130) 0 + scale (0.73 :: GLdouble) 0.56 0.56 + renderStringGrad Roman 0 "Monadius" + preservingMatrix $ do + if menuCursor==0 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + translate $ Vector3 (-230 :: GLdouble) (-200) 0 + scale (0.2 :: GLdouble) 0.2 0.3 + renderStringGrad Roman 60 $ (if menuCursor==0 then ">" else " ") ++ "New Game" + preservingMatrix $ do + if menuCursor==1 then color $ Color3 (1.0 :: GLdouble) 1.0 0 else color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + translate $ Vector3 (70 :: GLdouble) (-200) 0 + scale (0.2 :: GLdouble) 0.2 0.3 + renderStringGrad Roman 60 $ (if menuCursor==1 then ">" else " ") ++ "Continue " ++ (show . fst . saveState) vars++ "-" ++ (show . (+1) . snd . saveState) vars + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + + preservingMatrix $ do + translate $ Vector3 (-250 :: GLdouble) (75) 0 + scale (0.15 :: GLdouble) 0.10 0.15 + renderStringGrad Roman 10 "Dedicated to the makers, the players, the history," + preservingMatrix $ do + translate $ Vector3 (-250 :: GLdouble) (55) 0 + scale (0.15 :: GLdouble) 0.10 0.15 + renderStringGrad Roman 20 " and the 20th anniversary of GRADIUS series." + mapM_ (\ (y,(strA,strB),i) -> preservingMatrix $ do + preservingMatrix $ do + translate $ Vector3 (-180 :: GLdouble) y 0 + scale (0.18 :: GLdouble) 0.18 0.2 + renderStringGrad Roman (20 + i*5) strA + preservingMatrix $ do + translate $ Vector3 (60 :: GLdouble) y 0 + scale (0.18 :: GLdouble) 0.18 0.2 + renderStringGrad Roman (25 + i*5) strB + ) $ zip3 [0,(-35)..] instructions [1..] + + swapBuffers + + if Char ' ' `elem` keystate && clock >= timeLimit then + if menuCursor == 0 then + gameStart 1 0 False (recorderMode vars) vars + else + gameStart savedLevel savedArea (isCheat vars) (recorderMode vars) vars + else if isJust $ getNumberKey keystate then + gameStart (fromJust $ getNumberKey keystate) 0 True (recorderMode vars) vars + else return $ Scene $ openingProc (clock+1) (nextCursor keystate) vars ks + where + instructions = [("Move","Arrow Keys"),("Shot","Z Key"),("Missile","X Key"),("Power Up","C Key"),("Start","Space Bar")] + timeLimit = 30 :: Int + renderStringGrad font delay str = renderString font (take (((clock-delay) * length str) `div` timeLimit) str) + getNumberKey keystate = foldl mplus Nothing $ map keyToNumber keystate + + keyToNumber :: Key -> Maybe Int + keyToNumber k = case k of + Char c -> if c>='0' && c<='9' then Just $ fromEnum c - fromEnum '0' else Nothing + _ -> Nothing + + gameStart level area ischeat recordermode vrs = do + -- it is possible to temporary set (recordermode /= recorderMode vars) + gs <- newIORef $ initialRecorder recordermode (playbackKeys vrs) (initialMonadius GameVariables{ + totalScore=0, flagGameover=False, hiScore=saveHiScore vrs, + nextTag=0, gameClock = savePoints!!area ,baseGameLevel = level, + playTitle = if recordermode /= Playback then Nothing else playBackName vrs}) + + return $ Scene $ mainProc vrs{isCheat=ischeat,recordSaveState=(level,area)} gs ks + + (savedLevel,savedArea) = saveState vars + + demoStart vrs = do + let i = demoIndex vrs + let ReplayInfo ((lv,area),dat) = demoData!!i + gameStart lv area (isCheat vrs) Playback vrs{ + playBackName = Just "Press Space", + playbackKeys = decode dat, + demoIndex = demoIndex vrs+1 + } + + nextCursor keys = + if SpecialKey KeyLeft `elem` keys then 0 else + if SpecialKey KeyRight `elem` keys then 1 else + menuCursor + + delayVertices clck vs = (reverse . take clck . reverse) vs + + lambdaLfoot = moreVertices $ [10:+55,(-15):+0] ++ map (\(x:+y)->((-x):+y)) wing + lambdaRfoot = moreVertices $ [(-15):+70,(-12):+77,(-5):+80,(2:+77),(5:+70)] ++ wing + + shine t = monoshine (drawCompleteTime + t) + monoshine (drawCompleteTime + t+6) + + monoshine t = exp(-0.2*intToGLdouble(t`mod` 240)) + + drawCompleteTime = length lambdaRfoot + + moreVertices (a:b:cs) = if magnitude (a-b) > d then moreVertices (a:((a+b)/(2:+0)):b:cs) else a:moreVertices(b:cs) + where d=6 + + moreVertices x = x + + wing = [(30:+0),(200:+0),(216:+16),(208:+24),(224:+24),(240:+40),(232:+48),(248:+48),(272:+72),(168:+72)] + + renderVertices2D :: [Complex GLdouble] -> IO () + renderVertices2D xys = mapM_ (\(x:+y) -> vertex $ Vertex3 x y 0) xys + + demoStartTime = if presentationMode then 480 else 1800 + +endingProc :: GlobalVariables -> IORef [Key] -> IORef GLdouble -> IO Scene +endingProc vars ks ctr= do + keystate <- readIORef ks + counter <- readIORef ctr + modifyIORef ctr (min 2420 . (+2.0)) + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + + color $ Color3 (1.0 :: GLdouble) 1.0 1.0 + zipWithM_ (\str pos -> preservingMatrix $ do + translate $ Vector3 (-180 :: GLdouble) (-240+counter-pos) 0 + scale (0.3 :: GLdouble) 0.3 0.3 + renderString Roman str) + stuffRoll [0,60..] + + swapBuffers + + if Char ' ' `elem` keystate then do + return $ Scene $ openingProc 0 1 vars ks + else return $ Scene $ endingProc vars ks ctr + + where + stuffRoll = [ + "", + "", + "Game Designer", + " nushio", + "", + "Frame Programmer", + " tanakh", + "", + "Graphics Designer", + " Just nushio", + "", + "Sound Designer", + " Match Makers", + "", + "Lazy Evaluator", + " GHC 6.8", + "", + "Inspired" , + " Ugo-Tool", + " gradius2.com", + " Gradius series", + "", + "Special thanks to", + " John Peterson", + " Simon Marlow", + " Haskell B. Curry", + " U.Glasgow", + "", + "Presented by", + " team combat", + "", + "", + if (fst . saveState) vars <= 2 then "Congratulations!" else "WE LOVE GAMES!!" , + "", + " press space key"] + +mainProc :: GlobalVariables -> IORef Recorder -> IORef [Key] -> IO Scene +mainProc vars gs ks = do + keystate <- readIORef ks + modifyIORef gs (update keystate) + gamestate <- readIORef gs + + clear [ColorBuffer,DepthBuffer] + matrixMode $= Modelview 0 + loadIdentity + render gamestate + swapBuffers + let currentLevel = baseGameLevel$getVariables$gameBody gamestate + let currentArea = maximum $ filter (\i -> (savePoints !! i) < (gameClock $ getVariables $ gameBody gamestate)) [0..(length savePoints-1)] + let currentSave = if mode gamestate == Playback then saveState vars else (currentLevel,currentArea) + let currentHi = max (saveHiScore vars) (hiScore$getVariables$gameBody gamestate) + if (isGameover gamestate) then do + counter <- newIORef (0.0 :: GLdouble) + if mode gamestate /= Record then return () else do + writeReplay vars gamestate $ show (ReplayInfo (recordSaveState vars,(encode2 . preEncodedKeyBuf) gamestate)) + + if currentLevel>1 && (not . isCheat) vars && (mode gamestate /= Playback) then + return $ Scene $ endingProc vars{saveState=currentSave,saveHiScore = currentHi} ks counter + else return $ Scene $ openingProc 0 1 vars{saveState=currentSave,saveHiScore = currentHi} ks + else return $ Scene $ mainProc vars{saveState=currentSave,saveHiScore = currentHi} gs ks + where + writeReplay vs gamestate str = do + home <- getEnv "HOME" + createDirectoryIfMissing True (home ++ "/.monadius-replay/") + filename <- searchForNewFile ( + "replay\\" ++ (showsave . recordSaveState) vs ++ "-" ++ (showsave . saveState) vs ++ "." ++ + ((padding '0' 8) . show . totalScore . getVariables . gameBody) gamestate ++ "pts") 0 + writeFile (home ++ "/.monadius-replay/" ++ filename) str + showsave (a,b) = show (a,b+1) + searchForNewFile prefix i = do + let fn = prefix ++ (uniqStrs!!i) ++ replayFileExtension + b <- doesFileExist fn + if not b then return fn else do + searchForNewFile prefix $ i + 1 + uniqStrs = ("") : (map (("." ++) . show) ([1..] :: [Int])) + +timerProc :: IO () -> IO () +timerProc m = addTimerCallback 16 $ timerProc m >> m + +keyProc :: IORef [Key] -> Key -> KeyState -> t -> t1 -> IO () +keyProc keystate key ks _ _ = + case (key,ks) of + (Char 'q',_) -> exitLoop + (Char '\ESC',_) -> exitLoop + (_,Down) -> modifyIORef keystate (nub . (++ [key])) + (_,Up) -> modifyIORef keystate (filter (/=key)) + +savePoints :: [Int] +savePoints = [0,1280,3000,6080] + +
+ src/Monadius.hs view
@@ -0,0 +1,1356 @@+module Monadius ( + Monadius(..), + initialMonadius, + getVariables, + GameVariables(..), + shotButton, + missileButton, + powerUpButton, + upButton, + downButton, + leftButton, + rightButton, + selfDestructButton + ) where + +import Data.Array ((!), Array(), array) +import Data.Complex +import Data.List +import Data.Maybe +import Graphics.UI.GLUT hiding (position) + +import Game +import Util + +instance Game Monadius where + update = updateMonadius + render = renderMonadius + isGameover = isMonadiusOver + +newtype Monadius = Monadius (GameVariables,[GameObject]) + +getVariables :: Monadius -> GameVariables +getVariables (Monadius (vs,_))=vs + +data GameVariables = GameVariables { + totalScore :: Int,hiScore :: Int ,flagGameover :: Bool, + nextTag :: Int, gameClock :: Int,baseGameLevel :: Int,playTitle :: Maybe String + } deriving Eq + +data GameObject = -- objects that are actually rendered and moved. + VicViper{ -- player's fighter. + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int, + trail :: [Complex GLdouble], + speed :: GLdouble, + powerUpPointer :: Int, + powerUpLevels :: Array Int Int, + reloadTime :: Int,weaponEnergy :: Int, + ageAfterDeath :: Int + } | + Option{ -- trailing support device. + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape, + optionTag :: Int, + reloadTime :: Int,weaponEnergy :: Int} | + StandardMissile{ + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,mode :: Int, + velocity :: Complex GLdouble,parentTag :: Int,probe :: GameObject } | -- missile that fly along the terrain + Probe{ -- this lets missile to fly along the terrain + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int + } | + StandardRailgun{ + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + velocity :: Complex GLdouble,parentTag :: Int } | -- normal & double shot + StandardLaser{ + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + velocity :: Complex GLdouble,parentTag :: Int,age :: Int } | -- long blue straight laser + Shield{ + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hitDispLand :: Shape,hp :: Int, + settled :: Bool,size :: GLdouble,placement :: Complex GLdouble, + angle :: GLdouble,omega :: GLdouble} | -- solid state of Reek power that protects enemy atacks + PowerUpCapsule{ + tag :: Maybe Int,position :: Complex GLdouble,hitDisp :: Shape,hp :: Int,age :: Int} | + PowerUpGauge{ + tag :: Maybe Int,position :: Complex GLdouble} | + + DiamondBomb{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int} | -- Bacterian's most popular warhead + TurnGear{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,mode :: Int, + managerTag :: Int} | -- one of small Bacterian lifeforms, often seen in a squad. + SquadManager{ + tag :: Maybe Int,position :: Complex GLdouble,interval :: Int,age :: Int, + bonusScore :: Int,currentScore :: Int, + members :: [GameObject],items :: [GameObject] + } | + -- 1. generates objects contained in <members> with <interval>, one at each time. + -- 2. sticks to one of the still-alive troop members. + -- 3. counts up <currentScore> every time when one of the squad members are destroyed by lack of hp. + -- 4. doesn't count up <currentScore> if a squad member are destroyed by scrolling out. + -- 5. dies when all squad members were destroyed. at this time, + -- releases <items> if <currentScore> >= <bonusScore>, or + -- doesn't ,if not. + Jumper{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, + touchedLand :: Bool,jumpCounter :: Int + } | -- dangerous multi way mine dispenser. + + Grashia{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gravity :: Complex GLdouble, + gunVector :: Complex GLdouble,mode :: Int + } | -- fixed antiaircraft cannon. + + Ducker{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,gVelocity :: Complex GLdouble, + charge :: Int,vgun :: Complex GLdouble,touchedLand :: Bool + } | -- 2-feet mobile land to air attack device. + + Flyer{ + tag :: Maybe Int,position :: Complex GLdouble,velocity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,hasItem :: Bool,mode :: Int + } | -- Baterian's standard interceptor. + + ScrambleHatch{ + tag :: Maybe Int,position :: Complex GLdouble,gateAngle :: GLdouble,gravity :: Complex GLdouble, + hitDisp :: Shape,hp :: Int,age :: Int,launchProgram :: [[GameObject]] + } | -- Where Baterian larvae spend last process of maturation. + + LandScapeBlock{ + tag :: Maybe Int, position :: Complex GLdouble,hitDisp :: Shape,velocity :: Complex GLdouble + } | -- landscape that just look like, and hit like its hitDisp. + + Particle{ + tag :: Maybe Int, position :: Complex GLdouble, velocity :: Complex GLdouble, + size :: GLdouble,particleColor :: Color3 GLdouble,age :: Int,decayTime :: GLdouble,expireAge :: Int + } | -- multi purpose particles that vanishes after expireAge. + + Star{ + tag :: Maybe Int, position :: Complex GLdouble,particleColor :: Color3 GLdouble + } | -- background decoration + SabbathicAgent{ + tag :: Maybe Int, fever :: Int + } | -- generates many flyers for additional fun if there are none of them + DebugMessage {tag :: Maybe Int,debugMessage :: String} | + ScoreFragment{tag :: Maybe Int,score :: Int} + +data HitClass = BacterianShot | + BacterianBody | + LaserAbsorber | + MetalionShot | + MetalionBody | + ItemReceiver | + PowerUp | + LandScape + deriving(Eq) + +data WeaponType = NormalShot | Missile | GLdoubleShot | Laser + deriving (Eq) +-- WeaponType NormalShot | Missile | GLdoubleShot | Laser ... represents function of weapon that player selected, while +-- GameObject StandardRailgun | StandardLaser ... represents the object that is actually shot and rendered. +-- for example; +-- shooting NormalShot :: WeaponType and GLdoubleShot :: WeaponType both result in StandardRailgun :: GameObject creation, and +-- shooting Laser :: WeaponType creates StandardLaser :: GameObject when player is operating VicViper, or RippleLaser :: GameObject when LordBritish ... etc. + +data ScrollBehavior = Enclosed{doesScroll :: Bool} | NoRollOut{doesScroll :: Bool} + | RollOutAuto{doesScroll :: Bool, range :: GLdouble} | RollOutFold{doesScroll :: Bool} + +----------------------------- +-- +-- initialization +-- +------------------------------ +initialMonadius :: GameVariables -> Monadius +initialMonadius initVs = Monadius (initGameVariables,initGameObjects) + where + initGameVariables = initVs + initGameObjects = + stars ++ [freshVicViper,freshPowerUpGauge] + stars = take 26 $ map (\(t,i) -> Star{tag=Nothing,position = (fix 320 t:+fix 201 t),particleColor=colors!!i}) $ zip (map (\x -> square x + x + 41) [2346,19091..]) [1..] + fix :: Int -> Int -> GLdouble + fix limit value = intToGLdouble $ (value `mod` (2*limit) - limit) + colors = [Color3 1 1 1,Color3 1 1 0,Color3 1 0 0, Color3 0 1 1] ++ colors + -- ++ map (\x -> freshOption{optionTag = x}) [1..4] -- full option inchiki + +{- +Default settings of game objects and constants +-} +downButton,leftButton,missileButton,powerUpButton,rightButton,selfDestructButton,shotButton,upButton :: Key +downButton = SpecialKey KeyDown +leftButton = SpecialKey KeyLeft +missileButton = Char 'x' +powerUpButton = Char 'c' +rightButton = SpecialKey KeyRight +selfDestructButton = Char 'g' +shotButton = Char 'z' +upButton = SpecialKey KeyUp + +-- Cuteness to add later +-- konamiCommand = [upButton,upButton,downButton,downButton,leftButton,rightButton,leftButton,rightButton,missileButton,shotButton] + +gaugeOfMissile,gaugeOfGLdouble,gaugeOfLaser,gaugeOfShield :: Int +gaugeOfMissile = 1 +gaugeOfGLdouble = 2 +gaugeOfLaser = 3 +gaugeOfShield = 5 + +stageClearTime :: Int +stageClearTime = 7800 + +-- these lists are game rank modifiers. +bacterianShotSpeedList, duckerShotWay, jumperShotFactor, grashiaShotSpeedFactor :: [GLdouble] +bacterianShotSpeedList = [8,4,6,8] ++ cycle [12,8] +duckerShotCount = [2,1,1,3] ++ repeat 2 +duckerShotWay = [1,1,2,1] ++ cycle [2,2] +jumperShotFactor = [0.5,0.5,0.5,0.5] ++ cycle [0.8,0.5] +grashiaShotSpeedFactor = [1,1,1,1] ++ cycle [1,0.6] + +flyerHitBack, particleHitBack, powerUpCapsuleHitBack, scrambleHatchHitBack, treasure, turnGearHitBack :: [Bool] +flyerHitBack = [False,False,False] ++ repeat True +particleHitBack = True:repeat False +powerUpCapsuleHitBack = [False,False,False,False] ++ cycle [False,True] +scrambleHatchHitBack = [False,False,False,False] ++ cycle [False,True] +treasure = [False,False,False,False] ++ cycle [False,True] +turnGearHitBack = [False,False,False] ++ repeat True + +duckerShotCount, flyerShotInterval, grashiaShotHalt, grashiaShotInterval, inceptorShotInterval, jumperShotWay, landRollShotInterval, scrambleHatchLaunchLimitAge :: [Int] +flyerShotInterval = [30,infinite,30,15] ++ cycle [15,15] +grashiaShotHalt = [50,100,50,50] ++ cycle [0,0] +grashiaShotInterval = [30,60,30,30] ++ cycle [15,5] +inceptorShotInterval = [45,infinite,60,45] ++ cycle [45,45] +jumperShotWay = [16,4,8,16] ++ cycle [24,32] +landRollShotInterval = [60,120,60,60] ++ cycle [30,60] +scrambleHatchLaunchLimitAge = [400,200,400,400] ++ cycle [600,400] + +shotSpeed,laserSpeed,laserBreadth :: GLdouble +shotSpeed = 25 +laserSpeed = 60 +laserBreadth = 20 + +landScapeSensitive :: GameObject -> Bool +landScapeSensitive StandardRailgun{} = True -- these objects has hitDispLand +landScapeSensitive StandardLaser{} = True -- in addition to hitDisp +landScapeSensitive Shield{} = True +landScapeSensitive _ = False + +vicViperSize :: GLdouble +vicViperSize = 6 + +shieldPlacementMargin,shieldHitMargin :: GLdouble +shieldPlacementMargin = 5 +shieldHitMargin = 10 + +shieldMaxHp, hatchHP :: Int +shieldMaxHp = 16 +hatchHP = 15 + +diamondBombSize,smallBacterianSize,hatchHeight :: GLdouble +diamondBombSize = 6 +hatchHeight = 35 +smallBacterianSize = 16 + +freshDiamondBomb, freshFlyer, freshInterceptor, freshOption, freshPowerUpCapsule, freshPowerUpGauge, freshShield, freshStalk, freshStandardLaser, freshStandardMissile, freshStandardRailgun, freshTurnGear, freshTurnGearSquad, freshVicViper :: GameObject +freshDiamondBomb = DiamondBomb{tag=Nothing,position=0:+0,velocity=0:+0,hp=1,hitDisp=Circular (0:+0) diamondBombSize,age=0} +freshFlyer = Flyer{tag=Nothing,position=0:+0,velocity=(-3):+0,hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,mode=0} +freshInterceptor = freshFlyer{mode=1,velocity = 0:+0} +freshOption = Option{tag = Nothing, position=0:+0, hitDisp = Circular (0:+0) 0,optionTag = 0,reloadTime=0,weaponEnergy=100} +freshPowerUpCapsule = PowerUpCapsule{tag = Nothing, hitDisp = Circular (0:+0) 30,position = 0:+0,hp=1,age=0} +freshPowerUpGauge = PowerUpGauge{tag=Nothing, position = (-300):+(-240)} +freshShield = Shield{tag=Nothing,position=380:+0,hitDisp=Circular (0:+0) 0,hitDispLand=Circular (0:+0) 0,hp=shieldMaxHp,settled=False,size=0,placement=0:+0,angle=0,omega=0} +freshStalk = freshFlyer{mode=10,velocity = (-2):+0} +freshStandardLaser = StandardLaser{tag=Nothing,position=0:+0,hitDisp=Rectangular (laserSpeed/(-2):+(-laserBreadth)) (laserSpeed/2:+laserBreadth),hitDispLand = Rectangular (laserSpeed/(-2):+(-vicViperSize)) (laserSpeed/2:+vicViperSize),velocity=laserSpeed:+0,hp=1,parentTag=0,age=0} +freshStandardMissile = StandardMissile{tag=Nothing,position=0:+0,hitDisp=Circular 0 7,velocity=0:+0,hp=1,parentTag=0,probe=Probe{tag=Nothing,position=0:+0,hitDisp=Circular (0:+(-5)) 12,hp=1},mode=0} +freshStandardRailgun = StandardRailgun{tag=Nothing,position=0:+0,hitDisp=Circular 0 12,hitDispLand = Circular (0:+0) vicViperSize,velocity=shotSpeed:+0,hp=1,parentTag=0} +freshTurnGear = TurnGear{tag=Nothing,position=0:+0,velocity=0:+0,hp=1,hitDisp=Circular (0:+0) smallBacterianSize,age=0,managerTag=0,mode=0} +freshTurnGearSquad = SquadManager{tag=Nothing,position=0:+0, interval=10, age=0, + bonusScore=squadSize, currentScore=0, members = replicate squadSize freshTurnGear,items=[freshPowerUpCapsule]} where + squadSize=6 +freshVicViper = VicViper{tag = Nothing, position = 0:+0, hitDisp = Circular (0:+0) vicViperSize,hp=1, trail = repeat $ 0:+0, + speed = 1,powerUpPointer=(-1),powerUpLevels=array (0,5) [(x,0)|x<-[0..5]],reloadTime=0,weaponEnergy=100, + ageAfterDeath = 0} + +freshDucker :: GLdouble -> GameObject +freshDucker vg = Ducker{tag = Nothing, position = 0:+0, velocity= 0:+0, hitDisp = Circular (0:+0) smallBacterianSize, hp = 1, + age = 0, hasItem = False, gVelocity = 0:+(8*vg),charge = 0, vgun = 0:+0,touchedLand=False} +freshScrambleHatch :: GLdouble -> GameObject +freshScrambleHatch sign = ScrambleHatch{tag=Nothing,position=0:+0,hitDisp=regulate $ Rectangular ((-45):+0) (45:+(hatchHeight*(-sign))),gravity=(0:+sign),hp=hatchHP,age=0, + launchProgram = cycle $ replicate 40 [] ++ (concat.replicate 6) ([[freshInterceptor{velocity = 0:+(-6)*sign}]]++replicate 9 []),gateAngle=0 + } + +freshVolcano :: GLdouble -> GameObject +freshVolcano grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= + Shapes $ map (regulate.(\i -> Rectangular ((120 - 33*i + 2*i*i):+ sign*30*i) ((33*i - 2*i*i - 120) :+ sign*30*(i+1)) ) ) [0..4]} + where sign = (-grvty) + +freshTable :: GLdouble -> GameObject +freshTable grvty = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp= Shapes $ map (regulate.(\i -> Rectangular ((-2**(i+3)+shiftSinePi i):+sign*30*i) ((2**(i+3)+shiftSinePi i) :+sign*30*(i+1)))) [0..4] +} where + sign = (- grvty) + + shiftSinePi :: (Floating a) => a -> a + shiftSinePi a = 5 * sin (a*0.5*pi) + +freshGrashia, freshJumper, freshLandRoll :: GLdouble -> GameObject +freshGrashia sign= Grashia{tag=Nothing,position=0:+0,velocity=0:+0, + hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,gravity=(0:+sign),gunVector=0:+0,mode=0} +freshJumper sign=Jumper{tag=Nothing,position=0:+0,velocity=0:+0, + hitDisp=Circular 0 smallBacterianSize,hp=1,age=0,hasItem=False,gravity=(0:+0.36*sign),touchedLand=False,jumpCounter=0} +freshLandRoll sign = (freshGrashia sign){mode=1} + +freshLandScapeGround, freshSabbathicAgent :: GameObject +freshLandScapeGround = LandScapeBlock{tag=Nothing,position=0:+0,velocity=0:+0,hitDisp=Rectangular ((-158):+(-20)) (158:+20)} +freshSabbathicAgent = SabbathicAgent{tag=Nothing,fever=1} + +freshScore :: Int -> GameObject +freshScore point = ScoreFragment{tag=Nothing,score = point} + +----------------------------- +-- +-- game progress +-- +----------------------------- + +updateMonadius :: [Key] -> Monadius -> Monadius +updateMonadius realKeys (Monadius (variables,objects)) + = Monadius (newVariables,newObjects) where + gameVariables = variables + gameObjects = objects + gameLevel = baseGameLevel gameVariables + bacterianShotSpeed = bacterianShotSpeedList!!gameLevel + + + keys = if hp vicViper<=0 then [] else realKeys + -- almost all operation dies when vicViper dies. use realKeys to fetch unaffected keystates. + + (newNextTag,newObjects) = issueTag (nextTag variables) $ + (loadObjects ++) $ + filterJust.map scroll $ + concatMap updateGameObject $ + gameObjectsAfterCollision + gameObjectsAfterCollision = collide objects + -- * collision must be done BEFORE updateGameObject(moving), for + -- players would like to see the moment of collision. + -- * loading new objects after collision and moving is nice idea, since + -- you then have new objects appear at exact place you wanted them to. + -- * however, some operation would like to refer the result of the collision + -- before it is actually taken effect in updateGameObject. + -- such routine should use gameObjectsAfterCollision. + + + newVariables = variables{ + nextTag = newNextTag, + flagGameover = flagGameover variables || ageAfterDeath vicViper > 240, + gameClock = (\c -> if hp vicViper<=0 then c else if goNextStage then 0 else c+1) $ gameClock variables, + baseGameLevel = (\l -> if goNextStage then l+1 else l) $ baseGameLevel variables, + totalScore = newScore, + hiScore = max (hiScore variables) newScore + } + where + goNextStage = gameClock variables > stageClearTime + newScore = totalScore variables + (sum) (map (\obj -> case obj of + ScoreFragment{score = p} -> p + _ -> 0) objects :: [Int]) + + updateGameObject :: GameObject -> [GameObject] + -- update each of the objects and returns list of resulting objects. + -- the list usually includes the modified object itself, + -- may include several generated objects such as bullets and explosions, + -- or include nothing if the object has vanished. + + updateGameObject vic@VicViper{} = newShields ++ makeMetalionShots vic{ + position=position vic + (vmag*(speed vic):+0) * (vx:+vy) , + trail=(if isMoving then ((position vic-(10:+0)):) else id) $ trail vic, + powerUpLevels = + (modifyArray gaugeOfShield (const (if (shieldCount > 0) then 1 else 0))) $ + (if doesPowerUp then ( + modifyArray (powerUpPointer vic) + (\x -> if x<powerUpLimits!!powerUpPointer vic then x+1 else 0) . -- overpowering-up results in initial powerup level. + (if powerUpPointer vic==gaugeOfGLdouble then modifyArray gaugeOfLaser (const 0) else id) . -- laser and double are + (if powerUpPointer vic==gaugeOfLaser then modifyArray gaugeOfGLdouble (const 0) else id) ) -- exclusive equippment. + else id) (powerUpLevels vic), + powerUpPointer = if doesPowerUp then (-1) else powerUpPointer vic, + speed = speeds !! (powerUpLevels vic!0), + reloadTime = max 0 $ reloadTime vic - 1, + ageAfterDeath = if hp vic>0 then 0 + else ageAfterDeath vic+1, + hitDisp = if treasure!!gameLevel then Circular 0 0 else Circular (0:+0) vicViperSize, + hp = if selfDestructButton `elem` keys then 0 else hp vic + } where + vx = (if (rightButton `elem` keys) then 1 else 0) + + (if (leftButton `elem` keys) then (-1) else 0) + vy = (if (upButton `elem` keys) then 1 else 0) + + (if (downButton `elem` keys) then (-1) else 0) + vmag = if vx*vx+vy*vy>1.1 then sqrt(0.5) else 1 + isMoving = any (\b -> elem b keys) [rightButton,leftButton,upButton,downButton] + doesPowerUp = (powerUpButton `elem` keys) && (powerUpPointer vic >=0) && + (powerUpPointer vic ==0 || + powerUpLevels vic!powerUpPointer vic<powerUpLimits!!powerUpPointer vic) + speeds = [2,4,6,8,11,14] ++ speeds + shieldCount :: Int + shieldCount = sum $ map (\o -> case o of + Shield{} -> 1 + _ -> 0) gameObjects + newShields = if (doesPowerUp && powerUpPointer vic==gaugeOfShield) then + [freshShield{position=350:+260 ,placement=40:+shieldPlacementMargin, angle=30,omega=10 }, + freshShield{position=350:+(-260),placement=40:+(-shieldPlacementMargin),angle=0 ,omega=(-10)}] + else [] + + updateGameObject option@Option{} = makeMetalionShots option{ + position = trail vicViper !! (10*optionTag option), + reloadTime = max 0 $ reloadTime option - 1 + } + + updateGameObject miso@StandardMissile{} = [ + miso{position=newpos, + mode = newmode, + velocity=v, + probe = (probe miso){position=newpos,hp=1} + } + ] where + newmode = if hp(probe miso) <= 0 then 1 else + if mode miso == 0 then 0 else 2 + v = case newmode of + 0 -> 3.5:+(-7) + 1 -> 8:+0 + 2 -> 0:+(-8) + _ -> 0 + newpos = position miso + v + + updateGameObject shot@StandardRailgun{} = if hp shot <=0 then [] else + [shot{position=position shot + velocity shot}] + + updateGameObject laser@StandardLaser{} = if hp laser <=0 then [] else + [laser{position=(\(x:+_) -> x:+parentY) $ position laser + velocity laser,age=age laser+1}] where + myParent = head $ filter (\o -> tag o==Just (parentTag laser)) gameObjects + _:+parentY = position myParent + + updateGameObject shield@Shield{} = if(hp shield<=0) then [] else [ + (if settled shield then + shield{ + position=target,size=shieldPlacementMargin+intToGLdouble (hp shield), + hitDisp = Circular (0:+0) (size shield+shieldHitMargin), + hitDispLand = Circular (0:+0) (size shield) + } + else + shield{hp=shieldMaxHp,size=5+intToGLdouble (hp shield),position=newPosition,settled=chaseFactor>0.6}) + {angle=angle shield + omega shield} + ] where + newPosition = position shield + v + v = difference * (chaseFactor:+0) + chaseFactor = (10/magnitude difference) + difference = target-position shield + target = position vicViper+(realPart (placement shield) :+ additionalPlacementY) + additionalPlacementY = signum (imagPart$placement shield)*size shield + + updateGameObject pow@PowerUpCapsule{} = if(hp pow<=0) then [freshScore 800] else [ + pow{age=age pow + 1} + ] ++ if powerUpCapsuleHitBack!!gameLevel && age pow ==1 then + map (\theta -> freshDiamondBomb{position=position pow,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ + take 8 $ iterate (+(2*pi/8)) (pi/8) else [] + + + updateGameObject bullet@DiamondBomb{} = if hp bullet<=0 then [] else + [bullet{position=position bullet + velocity bullet,age=age bullet+1}] + updateGameObject self@TurnGear{position=pos@(x:+y),mode=m} = if hp self<=0 then + [freshScore 50] ++ freshExplosions pos ++ if turnGearHitBack!!gameLevel then [scatteredNeraiDan pos (bacterianShotSpeed:+0)] else [] + else [ + self{ + position = position self + velocity self, + age = age self + 1, + mode = newmode, + velocity = newv + }] where + newv = case m of + 0 -> ((-4):+0) + 1 -> if (y - (imagPart.position) vicViper) > 0 then (3:+(-5)) else (3:+(5)) + _ -> if isEasy then 2:+0 else 6:+0 + newmode = if m==0 && x < (if not isEasy then -280 else 0) && (realPart.position) vicViper> (-270) then 1 else + if m==1 && abs (y - (imagPart.position) vicViper) < 20 then 2 else m + + updateGameObject me@SquadManager{position=pos,interval=intv,members=membs,age=clock,tag=Just myTag} = + if mySquadIsWipedOut then( + if currentScore me >= bonusScore me then map (\o -> o{position=pos}) (items me) else [] + )else me{ + age = age me + 1, + currentScore = currentScore me + todaysDeaths, + position = if clock <= releaseTimeOfLastMember then pos else warFront + }:dispatchedObjects where + dispatchedObjects = if (clock `div` intv < length membs && clock `mod` intv == 0) then + [(membs!!(clock `div` intv)){position=pos,managerTag=myTag}] else [] + todaysDeaths = sum $ map (\o -> if hp o <=0 then 1 else 0) $ mySquad + mySquadIsWipedOut = clock > releaseTimeOfLastMember && length mySquad <= 0 + warFront = position $ head $ mySquad + releaseTimeOfLastMember = intv * (length membs-1) + mySquad = filter (\o -> case o of + TurnGear{managerTag=hisManagerTag} -> hisManagerTag == myTag -- bad, absolutely bad code + _ -> False) gameObjectsAfterCollision + + updateGameObject this@Flyer{position=pos@(x:+_),age=myAge,mode=m,velocity =v} = + if gameClock variables > stageClearTime - 100 then freshExplosions pos else + if hp this <=0 then ([freshScore (if mode this == 10 then 30 else 110)] ++ freshExplosions pos++(if hasItem this then [freshPowerUpCapsule{position=pos}] else if flyerHitBack!!gameLevel then [scatteredNeraiDan pos (bacterianShotSpeed:+0)] else [])) + else + [this{ + age=myAge+1, + position = pos + v , + velocity = newV, + mode = newMode + }]++myShots where + newV = case m of + 00 -> (realPart v):+sin(intToGLdouble myAge / 5) + 01 -> v --if magnitude v <= 0.01 then if imagPart (position vicViper-pos)>0 then 0:+10 else 0:+(-10) else v + 02 -> (-4):+0 + 10 -> if (not isEasy) || myAge < 10 then stokeV else v + _ -> v + stokeV = angleAccuracy 16 $ (* ((min (speed vicViper*0.75) (intToGLdouble$round$magnitude v)):+0) ) $ unitVector $ position vicViper-pos + newMode = case m of + 01 -> if myAge > 20 && (position vicViper - pos) `innerProduct` v < 0 then 02 else 01 + _ -> m + myShots = if (myAge+13*(fromJust $tag this)) `mod` myInterval == 0 && (x <= (-80) || x <= realPart(position vicViper)) + then [jikiNeraiDan pos (bacterianShotSpeed:+0)] else [] + myInterval = if m==00 || m==03 then flyerShotInterval!!gameLevel else inceptorShotInterval!!gameLevel + + updateGameObject me@Ducker{position=pos@(_:+_),velocity = v,age=myAge,gVelocity= vgrav,touchedLand = touched} = + if hp me <=0 then ([freshScore 130] ++ freshExplosions pos ++ if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else + [me{ + age=myAge+1, + position = pos + v, + charge = if charge me <=0 && aimRate > 0.9 && aimRate < 1.1 then (duckerShotCount!!gameLevel)*7+3 + else ((\x -> if x>0 then x-1 else x) $ charge me), + vgun = unitVector $ aimX:+aimY, + velocity = if charge me >0 then 0:+0 else + if magnitude v <= 0.01 then ( + if realPart(position vicViper - pos)>0 then 3:+0 else (-3):+0 + ) else if touched then + ((realPart v):+(-imagPart vgrav)) + else (realPart v:+(imagPart vgrav)), + touchedLand = False + }]++myShots where + aimX:+aimY = position vicViper - pos + aimRate = (-(signum$realPart v))*aimX / (abs(aimY) +0.1) + myShots = if charge me `mod` 7 /= 6 then [] else + map (\w -> freshDiamondBomb{position=pos,velocity=w}) vs + vs = map (\vy -> (vgun me)*(bacterianShotSpeed:+(1.5*(vy)))) [-duckerShotWay!!gameLevel+1 , -duckerShotWay!!gameLevel+3 .. duckerShotWay!!gameLevel-0.9] + + updateGameObject me@Jumper{position=pos@(_:+_),velocity = v,age=_,gravity= g,touchedLand = touched} = + if hp me <=0 then ([freshScore 300] ++ freshExplosions pos ++if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else + [ + me{ + position = pos + v, + velocity = if touched then (signum(realPart $ position vicViper-pos)*abs(realPart v):+imagPart(jumpSize*g)) else v + g, + jumpCounter = (if touched && v`innerProduct` g >0 then (+1) else id) $ + (if doesShot then (+1) else id) $ jumpCounter me, + touchedLand = False + } + ] ++shots where + jumpSize = if jumpCounter me `mod` 4 == 2 then (-30) else (-20) + doesShot = jumpCounter me `mod` 4 == 2 && v`innerProduct` g >0 + shots = if doesShot then + map (\theta -> freshDiamondBomb{position=pos,velocity=mkPolar (bacterianShotSpeed*jumperShotFactor!!gameLevel) theta}) $ + take way $ iterate (+(2*pi/intToGLdouble way)) 0 + else [] + way=jumperShotWay!!gameLevel + + updateGameObject me@ScrambleHatch{position = pos,age=a} = + if hp me <=0 then [freshScore 3000] ++ freshMiddleExplosions pos ++ + if scrambleHatchHitBack!!gameLevel then hatchHitBacks else [] + else + [me{ + age = a + 1, + gateAngle = max 0$ min pi$ (if length currentLaunches>0 then (+1) else (+(-0.05))) $ gateAngle me + }] ++ currentLaunches where + currentLaunches = if a <= scrambleHatchLaunchLimitAge!!gameLevel then + (map (\obj -> obj{position = pos}) $ launchProgram me!!a) + else [] + hatchHitBacks = + (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.5) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) 0 )++ + (map (\theta -> freshDiamondBomb{position=pos-16*gravity me,velocity=mkPolar (bacterianShotSpeed*0.4) theta}) $ take way $ iterate (+2*pi/intToGLdouble way) (pi/intToGLdouble way) ) + way = 16 + + + updateGameObject me@Grashia{position = pos} = + if hp me <=0 then ([freshScore 150] ++ freshExplosions pos++ if hasItem me then [freshPowerUpCapsule{position=pos}] else[]) else + [ + me{ + age=age me+1, + gunVector = unitVector $ position vicViper - pos, + position = position me + ((-3)*sin(intToGLdouble (age me*mode me)/8):+0) + } --V no shotto wo osoku + ] ++ if age me `mod` myInterval == 0 && age me `mod` 200 > grashiaShotHalt!!gameLevel then + [jikiNeraiDanAc (pos+gunVector me*(16:+0)) (grashiaShotSpeedFactor!!gameLevel*bacterianShotSpeed:+0) 64] else [] where + myInterval = if mode me == 0 then grashiaShotInterval!!gameLevel else landRollShotInterval!!gameLevel + + updateGameObject me@Particle{position = pos} = + if age me > expireAge me then (if particleHitBack!!gameLevel then [freshScore 10,scatteredNeraiDan pos (bacterianShotSpeed:+0)] else []) else + [me{ + age = age me + 1, + position = position me + (decay:+0) * velocity me + }] where + decay = exp $ - intToGLdouble (age me) / decayTime me + + updateGameObject me@LandScapeBlock{position = pos,velocity = v} = [me{position = pos+v}] + + updateGameObject DebugMessage{} = [] + + updateGameObject ScoreFragment{} = [] + + updateGameObject me@SabbathicAgent{fever = f} = if gameClock variables>stageClearTime-180 then [] else [ + me{ + fever = if launch then f+1 else f + }] + ++ if launch then map (\pos -> freshStalk{position = pos,velocity=(-4):+0,hasItem = (realPart pos>0 && (round $ imagPart pos :: Int) `mod` (3*round margin)==0)}) $ + concat $ map (\t -> [(340:+t),((-340):+t),(t:+(260)),(t:+(-260))]) $[(-margin*df),(((negate margin) * df) + (margin * 2))..(margin*df+1)] else [] where + launch = (<=0) $ length $ filter (\obj -> case obj of + Flyer{} -> True + _ -> False) objects + df = intToGLdouble f - 1 + margin :: GLdouble + margin = 20 + + updateGameObject x = [x] + + makeMetalionShots :: GameObject -> [GameObject] + {- this generates proper playerside bullets + according to the current power up state of vicviper. + both options and vicviper is updated using this. -} + + makeMetalionShots obj = obj{reloadTime=reloadTime obj+penalty1+penalty2, + weaponEnergy = max 0 $ min 100 $ weaponEnergy obj + if doesLaser then (-10) else 50 } + :(shots ++ missiles) where + (shots,penalty1) = if doesNormal then ([freshStandardRailgun{position=position obj,parentTag=myTag}] ,2) + else if doesGLdouble then ([freshStandardRailgun{position=position obj,parentTag=myTag},freshStandardRailgun{position=position obj,parentTag=myTag,velocity=mkPolar 1 (pi/4)*velocity freshStandardRailgun}] ,2) + else if doesLaser then ([freshStandardLaser{position=position obj+(shotSpeed/2:+0),parentTag=myTag}] ,1) + else ([],0) + penalty2 = if weaponEnergy obj <= 0 then 8 else 0 + missiles = if doesMissile then [freshStandardMissile{position=position obj}] else [] + doesShot = (isJust $tag obj) && (reloadTime obj <=0) && (shotButton `elem` keys) + doesNormal = doesShot && elem NormalShot types && (shotCount<2) + doesGLdouble = doesShot && elem GLdoubleShot types && (shotCount<1) + doesLaser = doesShot && elem Laser types + doesMissile = (isJust $tag obj) && elem Missile types && (missileButton `elem` keys) && (missileCount<=0) + myTag = fromJust $ tag obj + shotCount = length $ filter (\o -> case o of + StandardRailgun{} -> parentTag o==myTag + _ -> False) gameObjects + missileCount = length $ filter (\o -> case o of + StandardMissile{} -> True + _ -> False) gameObjects + + types = weaponTypes vicViper + + jikiNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject + -- an enemy bullet starting at position sourcePos and with relative velocity initVelocity. + -- bullet goes straight to vicviper if initVelocity is a positive real number. + jikiNeraiDanAc sourcePos initVelocity accuracy = freshDiamondBomb{ + position = sourcePos, + velocity = (*initVelocity) $ (angleAccuracy accuracy) $ unitVector $ position vicViper - sourcePos + } + jikiNeraiDan sourcePos initVelocity = jikiNeraiDanAc sourcePos initVelocity 32 + + scatteredNeraiDan :: Complex GLdouble -> Complex GLdouble -> GameObject + -- a rather scattered jikiNeraiDan. + scatteredNeraiDan sourcePos initVelocity = freshDiamondBomb{ + position = sourcePos, + velocity = scatter $ (*initVelocity) $ (angleAccuracy 32) $ unitVector $ position vicViper - sourcePos + } where + scatter z = let (r,theta)=polar z in + mkPolar r (theta+pi/8*((^(3::Int)).sin)((intToGLdouble $ gameClock variables) + magnitude sourcePos)) + + freshExplosionParticle pos vel a = Particle{tag=Nothing,position=pos,velocity=vel,size=8,particleColor=Color3 1 0.5 0,age=a,decayTime=6,expireAge=20} + + freshExplosions pos = take 5 expls where + expls :: [GameObject] + expls = makeExp randoms + randoms = [square $ sin(9801*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] + makeExp (a:b:c:xs) = (freshExplosionParticle pos (mkPolar (3*a) (2*pi*b)) (round $ -5*c)):makeExp xs + makeExp _ = [] + + freshMiddleExplosions pos = take 16 expls where + expls :: [GameObject] + expls = makeExp randoms 0 + randoms = [square $ sin(8086*sqrt t*(intToGLdouble$gameClock variables) + magnitude pos)|t<-[1..]] + makeExp (a:b:xs) i = (freshExplosionParticle (pos+mkPolar 5 (pi/8*i)) (mkPolar (6+3*a) (pi/8*i)) (round $ -5*b)){size=16}:makeExp xs (i+1) + makeExp _ _ = [] + + -- issue tag so that each objcet has unique tag, + -- and every object will continue to hold the same tag. + issueTag :: Int -> [GameObject] -> (Int,[GameObject]) + issueTag nt [] = (nt,[]) + issueTag nt (x:xs) = (newNextTag',taggedX:taggedXs) + where + (nextTagForXs,taggedX) = if(isNothing $ tag x) then (nt+1,x{tag = Just nt}) else (nt,x) + (newNextTag',taggedXs) = issueTag nextTagForXs xs + + collide :: [GameObject] -> [GameObject] + -- collide a list of GameObjects and return the result. + -- it is important NOT to delete any object at the collision -- collide, show then delete + collide = map personalCollide + where + -- each object has its own hitClasses and weakPoints. + -- collision is not symmetric: A may crushed by B while B doesn't feel A. + -- object X is hit by only objectsWhoseHitClassIsMyWeakPoint X. + personalCollide :: GameObject -> GameObject + personalCollide obj = foldr check obj $ objectsWhoseHitClassIsMyWeakPoint obj + + objectsWhoseHitClassIsMyWeakPoint :: GameObject -> [GameObject] + objectsWhoseHitClassIsMyWeakPoint me = + filter (\him -> not $ null $ (weakPoint me) `intersect` (hitClass him)) gameObjects + + hitClass :: GameObject -> [HitClass] + hitClass VicViper{} = [MetalionBody,ItemReceiver] + hitClass StandardMissile{} = [MetalionShot] + hitClass StandardRailgun{} = [MetalionShot] + hitClass StandardLaser{} = [MetalionShot] + hitClass Shield{} = [MetalionBody] + hitClass PowerUpCapsule{} = [PowerUp] + + hitClass DiamondBomb{} = [BacterianShot] + hitClass TurnGear{} = [BacterianBody] + hitClass Flyer{} = [BacterianBody] + hitClass Ducker{} = [BacterianBody] + hitClass Jumper{} = [BacterianBody] + hitClass Grashia{} = [BacterianBody] + hitClass ScrambleHatch{} = [BacterianBody,LaserAbsorber] + + hitClass LandScapeBlock{} = [LandScape] + hitClass _ = [] + + weakPoint :: GameObject -> [HitClass] + weakPoint VicViper{} = [PowerUp,BacterianBody,BacterianShot,LandScape] + weakPoint StandardMissile{} = [BacterianBody,LandScape] + weakPoint Probe{} = [LandScape] + weakPoint StandardRailgun{} = [BacterianBody,LandScape] + weakPoint StandardLaser{} = [LaserAbsorber,LandScape] + weakPoint Shield{} = [BacterianBody,BacterianShot,LandScape] + weakPoint PowerUpCapsule{} = [ItemReceiver] + + weakPoint DiamondBomb{} = [MetalionBody,LandScape] + weakPoint TurnGear{} = [MetalionBody,MetalionShot] + weakPoint Flyer{} = [MetalionBody,MetalionShot] + weakPoint Ducker{} = [MetalionBody,MetalionShot,LandScape] + weakPoint Jumper{} = [MetalionBody,MetalionShot,LandScape] + weakPoint Grashia{} = [MetalionBody,MetalionShot] + weakPoint ScrambleHatch{} = [MetalionBody,MetalionShot] + + weakPoint _ = [] + + -- after matching hitClass-weakPoint, you must check the shape of the pair of object + -- to see if source really hits the target. + check :: GameObject -> GameObject -> GameObject + check source target = case (source, target) of + (LandScapeBlock{},StandardMissile{}) -> if(hit source target) then (affect source target2) else target2 where + target2 = target{probe = if(hit source p) then (affect source p) else p} + p = probe target + _ -> if(hit source target) then (affect source target) else target + + -- if a is really hitting b, a affects b (usually, decreases hitpoint of b). + -- note that landScapeSensitive objects have special hitDispLand other than hitDisp. + -- this allows some weapons to go through narrow land features, and yet + -- wipe out wider area of enemies. + hit :: GameObject -> GameObject -> Bool + hit a b = case (a,b) of + (LandScapeBlock{},c) -> if landScapeSensitive c then (position a +> hitDisp a) >?< (position c +> hitDispLand c) + else (position a +> hitDisp a) >?< (position b +> hitDisp b) + _ -> (position a +> hitDisp a) >?< (position b +> hitDisp b) + + affect :: GameObject -> GameObject -> GameObject + affect VicViper{} obj = case obj of + pow@PowerUpCapsule{} -> pow{hp = hp pow-1} + x -> x + affect PowerUpCapsule{} obj = case obj of + viper@VicViper{} -> viper{powerUpPointer = (\x -> if x >=5 then 0 else x+1)$powerUpPointer viper} + _ -> error "Power capsule should not have been able to affect anything but the player craft." + affect StandardMissile{} obj = obj{hp = hp obj-(hatchHP`div`2 + 2)} -- 2 missiles can destroy a hatch + affect StandardRailgun{} obj = obj{hp = hp obj-(hatchHP`div`4 + 1)} -- 4 shots can also destroy a hatch + affect StandardLaser{} obj = obj{hp = hp obj-1} + affect Shield{} obj = obj{hp = hp obj-1} + + + affect DiamondBomb{} obj = obj{hp = hp obj-1} + affect TurnGear{} obj = obj{hp = hp obj-1} + affect Flyer{} obj = obj{hp = hp obj-1} + affect Ducker{} obj= obj{hp = hp obj-1} + affect Jumper{} obj= obj{hp = hp obj-1} + affect Grashia{} obj= obj{hp = hp obj-1} + affect ScrambleHatch{} obj= obj{hp = hp obj-1} + + affect LandScapeBlock{} obj = case obj of +-- miso@StandardMissile{velocity=v} -> miso{velocity = (1:+0)*abs v} + duck@Ducker{} -> duck{touchedLand=True} + that@Jumper{} -> that{touchedLand=True} + _ -> obj{hp = hp obj-1} + + affect _ t = t + + scroll :: GameObject -> Maybe GameObject + -- make an object scroll. + -- if the object is to vanish out of the screen, it becomes Nothing. + scroll obj = let + (x:+y) = position obj + scrollBehavior :: GameObject -> ScrollBehavior + scrollBehavior VicViper{} = Enclosed False + scrollBehavior Option {} = NoRollOut False + -- We use the more verbose way of setting records here to guarantee + -- 'range' is needed so -Wall doesn't get fooled. + scrollBehavior StandardRailgun{} = RollOutAuto {doesScroll = True, range = shotSpeed} + scrollBehavior StandardLaser{} = RollOutAuto True laserSpeed + scrollBehavior PowerUpGauge{} = NoRollOut False + scrollBehavior PowerUpCapsule{} = RollOutAuto True 40 + scrollBehavior Shield{} = NoRollOut False + + scrollBehavior DiamondBomb{} = RollOutAuto False 10 + scrollBehavior TurnGear{} = RollOutAuto False 20 + scrollBehavior SquadManager{} = NoRollOut False + scrollBehavior ScrambleHatch{} = RollOutAuto True 60 + + scrollBehavior LandScapeBlock{} = RollOutAuto True 160 + + scrollBehavior Star{} = RollOutFold True + + scrollBehavior DebugMessage{} = NoRollOut False + scrollBehavior ScoreFragment{} = NoRollOut False + scrollBehavior SabbathicAgent{} = NoRollOut False + + scrollBehavior _ = RollOutAuto True 40 + + scrollSpeed = if hp vicViper <= 0 then 0 else if gameClock variables <=6400 then 1 else 2 + rolledObj = if doesScroll $ scrollBehavior obj then obj{position=(x-scrollSpeed):+y} else obj + in case scrollBehavior obj of + Enclosed _ -> Just rolledObj{position = (max (-300) $ min 280 x):+(max (-230) $ min 230 y)} + NoRollOut _ -> Just rolledObj + RollOutAuto _ r -> if any (>r) [x-320,(-320)-x,y-240,(-240)-y] then Nothing + else Just rolledObj + RollOutFold _ -> Just rolledObj{position = (if x< -320 then x+640 else x):+y} where + (_:+_) = position rolledObj + + loadObjects :: [GameObject] + -- a list of objects that are to newly loaded at this frame. + + loadObjects = if hp vicViper<=0 then [] else (case clock of + -- stage layout. + -- just like old BASIC code. + 150 -> [freshTurnGearSquad{position=340:+(180)}] + 300 -> [freshTurnGearSquad{position=340:+(-180)}] + 400 -> [freshTurnGearSquad{position=340:+(180)}] + 500 -> [freshTurnGearSquad{position=340:+(-180)}] + 633 -> map (\y -> freshStalk{position = 340:+y,hasItem=False }) [-120,120] ++ [freshStalk{position = 340:+0,hasItem=isEasy}] + 666 -> map (\y -> freshStalk{position = 340:+y,hasItem=isEasy}) [-130,130] ++ [freshStalk{position = 340:+0,hasItem=False}] + 700 -> map (\y -> freshStalk{position = 340:+y,hasItem=False }) [-140,140] ++ [freshStalk{position = 340:+0,hasItem=True}] + 733 -> map (\y -> freshStalk{position = 340:+y,hasItem=isEasy}) [-150,150] ++ [freshStalk{position = 340:+0,hasItem=False}] + 900 -> [freshTurnGearSquad{position=340:+(-180)}] + 1000 -> [freshTurnGearSquad{position=340:+(180)}] + 1050 -> map (\y -> freshStalk{position = 340:+y}) [-135,0,135] + 1250 -> map (\y -> freshFlyer{position = 340:+y}) [-150,-100] + 1300 -> map (\y -> freshFlyer{position = 340:+y,hasItem=True}) [100,150] + 1100 -> [freshTurnGearSquad{position=340:+(-180)},freshTurnGearSquad{position=340:+(180)}] + 1400 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshGrashia 1){position = 340:+(185)}] + 1450 -> [(freshGrashia (-1)){position = 340:+(-185),hasItem=True},(freshGrashia 1){position = 340:+(185)}] + 1550 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] + 1700 -> [(freshVolcano (-1)){position=479:+(-200)}] + 1900 -> map (\(g,x) -> (freshDucker g){position=x:+g*100}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] + 1940 -> [(freshLandRoll (1)){position = 340:+(185)}] + 1965 -> [(freshLandRoll (1)){position = 340:+(185)}] + 1990 -> [(freshLandRoll (1)){position = 340:+(185)}] + 2000 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshDucker (-1)){position=(-340):+(-185)}] + 2033 -> [(freshGrashia (-1)){position = 340:+(-185)},(freshDucker 1){position=(-340):+(185)}] + 2100 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] + 2200 -> [(freshVolcano 1){position=479:+(200)}] + 2250 -> map (\y -> freshStalk{position = 340:+y}) [-150,0,150] + 2339 -> [(freshGrashia (1)){position = 340:+35},(freshGrashia (-1)){position = 340:+(-185)}] + + 2433 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] + 2466 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] + 2499 -> map (\y -> freshFlyer{position = 340:+y}) [-150,0] + + 2620 -> [(freshDucker 1){position=(-340):+(200)}] + 2640 -> [(freshDucker 1){position=(-340):+(200),hasItem=True}] + 2800 -> map (\(g,x) -> (freshJumper g){position=x:+g*100,velocity=((-3)*signum x):+0}) $ [(1,340),(-1,340)] ++ if not isEasy then [(1,-340),(-1,-340)] else [] + 2999 -> [(freshVolcano 2){position=479:+(20),velocity=(0:+(-0.5))},(freshVolcano (-2)){position=479:+(-20),velocity=(0:+(0.5))}] + + 3200 -> concat $ map (\x -> [freshLandScapeGround{position=(479-x):+220},freshLandScapeGround{position=(479-x):+(-220)}]) [320,640] + + 3210 -> [freshFlyer{position = 340:+150},freshFlyer{position = 340:+100,hasItem=True}] + 3290 -> [freshFlyer{position = 340:+(-150)},freshFlyer{position = 340:+(-100),hasItem=True}] + 3350 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] ++ if isRevival then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] + 3400 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] ++ if isRevival then [] else [(freshJumper (-1)){position = (-340):+(-150),velocity=3:+0}] + 3450 -> map (\g -> (freshLandRoll (g)){position = 340:+(g*185)}) [1,-1] + 3500 -> [(freshVolcano (-1)){position=479:+(-200)}] + 3579 -> [(freshGrashia (-1)){position = 340:+(-100)}] + 3639 -> [(freshGrashia (-1)){position = 340:+(-40)}] + 3699 -> [(freshGrashia (-1)){position = 340:+(-100)}] + 3501 -> [(freshScrambleHatch (1)){position = 360:+(200)}] + 3600 -> [(freshScrambleHatch (1)){position = 360:+(200)}] + 3582 -> [(freshDucker (-1)){position=(340):+(-200)}] + 3612 -> [(freshDucker (-1)){position=(340):+(-200)}] + 3642 -> [(freshDucker (-1)){position=(340):+(-200)}] + 3672 -> [(freshDucker (-1)){position=(340):+(-200)}] + 3702 -> [(freshDucker (-1)){position=(340):+(-200),hasItem=True}] + 3703 -> [(freshLandRoll (1)){position=(340):+(185),hasItem=True}] + 3820 -> map (\y -> freshFlyer{position = 340:+y}) [-100,100] + 3840 -> map (\y -> freshFlyer{position = 340:+y}) [-110,110] + 3860 -> map (\y -> freshFlyer{position = 340:+y}) [-120,120] + 3880 -> map (\y -> freshFlyer{position = 340:+y,hasItem = isEasy}) [-130,130] + 3900 -> [freshTurnGearSquad{position=340:+0}] + 4000 -> [(freshTable 1){position=450:+200}] + 4033 -> [(freshGrashia (1)){position = 340:+(185)}] + 4066 -> [(freshGrashia (1)){position = 340:+(185)}] + 4060 -> [(freshGrashia (1)){position = 340:+(40)}] + 4110 -> [(freshGrashia (1)){position = 340:+(40)}] + 4160 -> [(freshGrashia (1)){position = 340:+(40)}] + 4166 -> [(freshGrashia (1)){position = 340:+(185),hasItem=True}] + 4200 -> [(freshGrashia (1)){position = 340:+(185),hasItem=True}] + 4233 -> [(freshGrashia (1)){position = 340:+(185),hasItem=False}] + 4266 -> [(freshGrashia (1)){position = 340:+(185),hasItem=False}] + 4150 -> [freshLandScapeGround{position=479:+(-180)}] + 4203 -> [(freshJumper (-1)){position = 340:+(-180)}] + 4273 -> [(freshJumper (-1)){position = 340:+(-180)}] + 4343 -> [(freshJumper (-1)){position = 340:+(-180)}] + 4490 -> [(freshTable (-1)){position=450:+(-200)}] + 4500 -> [(freshDucker (-1)){position=340:+0}] + 4520 -> [(freshDucker (-1)){position=340:+0}] + 4540 -> [(freshDucker (-1)){position=340:+0}] + 4560 -> [(freshGrashia (-1)){position = 340:+(-185)}] + 4580 -> [(freshScrambleHatch (-1)){position = 360:+(-50)}] + 4603 -> if isRevival then [] else [(freshDucker 1){position = (-340):+0},(freshJumper (1)){position = (-340):+150,velocity=3:+0}] + 4663 -> [(freshDucker 1){position = (-340):+0}]++if isEasy then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] + 4723 -> if isRevival then [] else [(freshDucker 1){position = (-340):+0},(freshJumper (1)){position = (-340):+150,velocity=3:+0}] + 4783 -> [(freshDucker 1){position = (-340):+0}]++if isEasy then [] else [(freshJumper (1)){position = (-340):+150,velocity=3:+0}] + 4680 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] + 4900 -> map (\y -> freshFlyer{position = 340:+y}) [-100,100] + 4930 -> map (\y -> freshFlyer{position = 340:+y}) [-66,66] + 4960 -> map (\y -> freshFlyer{position = 340:+y}) [-33,33] + 4990 -> map (\y -> freshFlyer{position = 340:+y,hasItem=True}) [0] + 5041 -> [(freshDucker (-1)){position = 340:+(-180)}] + 5061 -> [(freshDucker (-1)){position = 340:+(-180)}] + 5081 -> [(freshDucker (-1)){position = 340:+(-180)}] + 5101 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) + 5121 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) + 5141 -> if isRevival then [] else ([(freshDucker (-1)){position = 340:+(-180)}] ++ if isEasy then [] else [(freshDucker (1)){position = (-340):+(180)}]) + 5261 -> [freshTurnGearSquad{position=340:+(-150)}] + 5364 -> [(freshScrambleHatch (-1)){position = 360:+(-200)}] + 5151 -> [(freshDucker (-1)){position = (-340):+(0)}] + 5181 -> [(freshDucker (-1)){position = (-340):+(0)}] + 5211 -> [(freshDucker (-1)){position = (-340):+(0)}] + 5241 -> [(freshDucker (-1)){position = (-340):+(0)}] + 5321 -> [(freshDucker (-1)){position = 340:+150}] ++ if isEasy then [] else [(freshJumper (1)){position = (-340):+(180),velocity = 3:+0}] + 5361 -> [(freshDucker (-1)){position = 340:+150}] + 5401 -> [(freshDucker (-1)){position = 340:+150}] + 5441 -> [(freshDucker (-1)){position = 340:+150}] ++ if isEasy then [] else map (\y -> freshStalk{position = 340:+y}) [-140,-70,0] + 5461 -> [(freshDucker (-1)){position = 340:+150}] + 5451 -> [(freshGrashia (-1)){position = 340:+160,hasItem=True}] + + 5060 -> [(freshVolcano (-1)){position = 480:+(-100)}] + 5200 -> [(freshGrashia (-1)){position = 340:+70}] ++ [(freshDucker (-1)){position = 340:+70}] + 5235 -> [(freshGrashia (-1)){position = 340:+40}] ++ [(freshDucker (-1)){position = 340:+40}] + 5258 -> [(freshGrashia (-1)){position = 340:+10}] ++ [(freshDucker (-1)){position = 340:+10}] + 5285 -> [(freshGrashia (-1)){position = 340:+(-20)}] ++ [(freshDucker (-1)){position = 340:+(-20)}] + 5316 -> [(freshGrashia (-1)){position = 340:+(-50)}] ++ [(freshDucker (-1)){position = 340:+(-50)}] + + 5310 -> [(freshVolcano (1)){position = 480:+(150)}] + 5450 -> [(freshGrashia (1)){position = 340:+(-20)}] + 5485 -> [(freshGrashia (1)){position = 340:+10}] + 5508 -> [(freshGrashia (1)){position = 340:+40}] + 5535 -> [(freshGrashia (1)){position = 340:+70}] + 5566 -> [(freshGrashia (1)){position = 340:+100}] + + 5811 -> [(freshDucker (-1)){position = (-340):+0}] + 5841 -> [(freshDucker (-1)){position = (-340):+0}] + 5871 -> [(freshDucker (-1)){position = (-340):+0}] + 5901 -> [(freshDucker (-1)){position = (-340):+0}] + 6001 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] + 6031 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] + 6061 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] + 6091 -> if isEasy then [(freshDucker (-1)){position = (-340):+150}] else [] + + 5800 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] + 5950 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] + 6100 -> [(freshScrambleHatch (-1)){position = 360:+(-200)},(freshScrambleHatch (1)){position = 360:+(200)}] + 6116 -> [freshSabbathicAgent] + + _ -> []) ++ + (if(optionCount < powerUpLevels vicViper!4) then + [freshOption{position=position vicViper, optionTag = optionCount+1}] + else []) ++ + (if (clock `mod` 320 == 0 && clock>=1280 && clock <= 6400) then + [freshLandScapeGround{position=479:+220},freshLandScapeGround{position=479:+(-220)}] + else []) + + where + clock = gameClock variables + optionCount = length $ filter (\o -> case o of + Option{} -> True + _ -> False) gameObjects + isRevival = optionCount <= 0 + isEasy = gameLevel <= 1 + + vicViper = fromJust $ find (\obj -> case obj of + VicViper{} -> True + _ -> False) objects + +-- things needed both for progress and rendering +powerUpLimits :: [Int] +powerUpLimits = [5,1,1,1,4,1] +weaponTypes :: GameObject -> [WeaponType] +weaponTypes viper@VicViper{} = + [if powerUpLevels viper!gaugeOfGLdouble>0 then GLdoubleShot else + if powerUpLevels viper!gaugeOfLaser>0 then Laser else + NormalShot] ++ + if powerUpLevels viper!gaugeOfMissile>0 then [Missile] else [] + +weaponTypes _ = [] + +------------------------- +-- +-- drawing +-- +------------------------- +renderMonadius :: Monadius -> IO () +renderMonadius (Monadius (variables,objects)) = do + putDebugStrLn $ show $ length objects + mapM_ renderGameObject objects + preservingMatrix $ do + translate (Vector3 (-300) (220) (0 :: GLdouble)) + renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do + scale (0.2 :: GLdouble) 0.2 0.2 + renderString MonoRoman scoreStr + preservingMatrix $ do + translate (Vector3 (0) (220) (0 :: GLdouble)) + renderWithShade (Color3 1 1 (1 :: GLdouble)) (Color3 0 0 (1 :: GLdouble)) $ do + scale (0.2 :: GLdouble) 0.2 0.2 + renderString MonoRoman scoreStr2 + where + scoreStr = "1P " ++ ((padding '0' 8).show.totalScore) variables + scoreStr2 = if isNothing $ playTitle variables then "HI "++((padding '0' 8).show.hiScore) variables else (fromJust $ playTitle variables) + + gameclock = gameClock variables + + -- returns an IO monad that can render the object. + renderGameObject :: GameObject -> IO () + renderGameObject gauge@PowerUpGauge{} = preservingMatrix $ do + let x:+y = position gauge + translate (Vector3 x y 0) + color (Color3 (1.0 :: GLdouble) 1.0 1.0) + mapM_ (\(i,j) -> (if(i==activeGauge)then renderActive else renderNormal) j (isLimit i) i) $ + zip [0..5] [0,90..450] where + w=80 + h=20 + renderNormal x l i = preservingMatrix $ do + color (Color3 0.7 0.8 (0.8 :: GLdouble)) + preservingMatrix $ do + translate (Vector3 x 0 (0 :: GLdouble)) + renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(w,0),(w,h),(0,h)] + if l then renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),(w,h),(w,0),(0,h)] else return() + preservingMatrix $ do + ugoTranslate x 0 0 3 + translate (Vector3 (w/2) 0 (0 :: GLdouble)) + rotate (3 * sin(intToGLdouble gameclock/10)) (Vector3 0 0 (1 :: GLdouble)) + translate (Vector3 (-w/2) 0 (0 :: GLdouble)) + renderPowerUpName i + + renderActive x l i = preservingMatrix $ do + color (Color3 1 1 (0 :: GLdouble)) + preservingMatrix $ do + translate (Vector3 x 0 0) + renderPrimitive LineLoop $ ugoVertices2DFreq 0 5 2 [(0,0),(w,0),(w,h),(0,h)] + if l then renderPrimitive Lines $ ugoVertices2DFreq 0 5 2 [(0,0),(w,h),(w,0),(0,h)] else return() + preservingMatrix $ do + ugoTranslateFreq x 0 0 5 2 + translate (Vector3 (w/2) 0 (0 :: GLdouble)) + rotate (10 * sin(intToGLdouble gameclock/5)) (Vector3 0 0 (1 :: GLdouble)) + scale 1.2 1.2 (0 :: GLdouble) + translate (Vector3 (-w/2) 0 (0 :: GLdouble)) + renderPowerUpName i + activeGauge = powerUpPointer vicViper + isLimit i = powerUpLevels vicViper!i>=powerUpLimits!!i + renderPowerUpName i = do + translate (Vector3 6 3.5 (0 :: GLdouble)) + scale (0.15 :: GLdouble) 0.13 0.15 + renderString Roman $ ["SPEED","MISSILE","DOUBLE","LASER","OPTION"," ?"]!!i + + renderGameObject vic@VicViper{position = x:+y} = if hp vic<=0 then preservingMatrix $ do + translate (Vector3 x y 0) + scale pishaMagnitudeX pishaMagnitudeY 0 + renderWithShade (Color3 (1.0 :: GLdouble) 0 0) (Color3 (1.0 :: GLdouble) 0.6 0.4) $ do + renderPrimitive LineLoop $ ugoVertices2DFreq 0 1 1 + [(0,12),(8,8),(10,4),(20,0),(10,-4),(8,-8),(0,-12),(-8,-8),(-10,-4),(-20,0),(-10,4),(-8,8)] + else preservingMatrix $ do + translate (Vector3 x y 0) + renderWithShade (Color3 (1.0 :: GLdouble) 1.0 1.0) (Color3 (0.4 :: GLdouble) 0.4 0.6) $ do + renderPrimitive LineStrip $ ugoVertices2D 0 2 + [((-14),(-1)),((-12),5),((-20),13),(-14,13),(2,5),(8,1),(32,1),(32,(-1)),(24,(-3)),(16,(-3))] + renderPrimitive LineStrip $ ugoVertices2D 0 2 + [((-10),(-1)),(14,(-1)),(18,(-5)),(4,(-9)),((-2),(-9))] + renderPrimitive LineLoop $ ugoVertices2D 0 2 + [((-18),3),((-16),3),((-16),(-3)),((-18),(-3))] + renderWithShade (Color3 (0.92 :: GLdouble) 0.79 0.62) (Color3 (0.75 :: GLdouble) 0.38 0.19) $ do + renderPrimitive LineStrip $ ugoVertices2D 0 2 + [(4,3),(6,5),(14,5),(22,1)] --cockpit + renderWithShade (Color3 (0.6 :: GLdouble) 0.8 1.0) (Color3 0.19 0.38 (0.75 :: GLdouble)) $ do + renderPrimitive LineLoop $ ugoVertices2D 0 2 + [((-14),(-1)),((-10),(-1)),((-2),(-9)),((-4),(-9)),((-10),(-7)),((-14),(-3))] -- identification blue coting + renderWithShade (Color3 (0 :: GLdouble) 0 0.8) (Color3 (0.0 :: GLdouble) 0.0 0.4) $ do + renderPrimitive LineLoop $ ugoVertices2D 0 4 + [((-36),1),((-28),5),((-24),5),((-20),1),((-20),(-1)),((-24),(-5)),((-28),(-5)),((-36),(-1))] -- backfire + where + pishaMagnitudeX :: GLdouble + pishaMagnitudeY :: GLdouble + pishaMagnitudeX = max 0 $ (8*) $ (\z -> z*(1-z)) $ (/20) $ intToGLdouble $ ageAfterDeath vic + pishaMagnitudeY = max 0 $ (5*) $ (\z -> z*(1-z)) $ (/15) $ intToGLdouble $ ageAfterDeath vic + + renderGameObject Option{position = x:+y} = preservingMatrix $ do + translate (Vector3 x y 0) + renderWithShade (Color3 (0.8 :: GLdouble) 0 0) (Color3 (0.4 :: GLdouble) 0 0) $ + renderPrimitive LineLoop $ ugoVertices2D 0 2 + [(5,9),(9,7),(13,3),(13,(-3)),(9,(-7)),(5,(-9)), + ((-5),(-9)),((-9),(-7)),((-13),(-3)),((-13),3),((-9),7),((-5),9)] + renderWithShade (Color3 (1.0 :: GLdouble) 0.45 0) (Color3 (0.4 :: GLdouble) 0.2 0) $ + renderPrimitive LineStrip $ ugoVertices2D 0 1 + [((-12.0),(3.4)),(0.8,8.7),((-8.1),(-0.9)),(4.0,5.8),(4.3,5.6), + ((-4.4),(-6.8)),((-4.1),(-6.9)),(8.3,0.8),(9.0,0.6),(2.0,(-7.2))] + + renderGameObject StandardMissile{position=x:+y,velocity=v} = preservingMatrix $ do + let dir = (phase v) :: GLdouble + translate (Vector3 x y 0) + rotate (dir / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1.0 :: GLdouble) 0.9 0.5) + renderPrimitive LineLoop $ ugoVertices2D 0 1 [(0,0),(-7,2),(-7,-2)] + renderPrimitive LineStrip $ ugoVertexFreq (-11) 0 0 1 1 >> ugoVertexFreq (-17) 0 0 7 1 + + renderGameObject StandardRailgun{position=x:+y,velocity=v} = + preservingMatrix $ do + let (_,phse)=polar v + translate (Vector3 x y 0) + rotate (phse / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1.0 :: GLdouble) 0.9 0.5) + renderPrimitive Lines $ ugoVertices2D 0 1 [(0,0),((-5),0),((-9),0),((-11),0)] + + renderGameObject laser@StandardLaser{position=x:+y,velocity=v} = + if age laser < 1 then return () + else preservingMatrix $ do + let (_,phs)=polar v + translate (Vector3 x y 0) + rotate (phs / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (0.7 :: GLdouble) 0.9 1.0) + renderPrimitive Lines $ ugoVertices2D 0 0 [(12,0),(-laserSpeed,0)] + + renderGameObject Shield{position=x:+y, size = r,angle = theta} = preservingMatrix $ do + translate (Vector3 x y 0) + rotate theta (Vector3 0 0 (1 :: GLdouble)) + renderWithShade (Color3 (0.375 :: GLdouble) 0.75 0.9375) (Color3 (0.86 :: GLdouble) 0.86 0.86) $ do + scale r r 0 + renderTriangle + rotate 60 (Vector3 0 0 (1 :: GLdouble)) + renderTriangle where + renderTriangle = do + renderPrimitive LineLoop $ ugoVertices2DFreq 0 0.1 1 $ map (\t -> (cos t,sin t)) [0,pi*2/3,pi*4/3] + + renderGameObject powerUpCapsule@PowerUpCapsule{} = preservingMatrix $ do + let x:+y = position powerUpCapsule + translate (Vector3 x y 0) + renderWithShade (Color3 (0.9 :: GLdouble) 0.9 0.9) (Color3 (0.4 :: GLdouble) 0.4 0.4) $ do + futa >> neji >> toge + rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge + rotate (180) (Vector3 0 1 (0 :: GLdouble)) >> futa >> neji >> toge + rotate (180) (Vector3 1 0 (0 :: GLdouble)) >> toge + renderWithShade (Color3 (1.0 :: GLdouble) 0.0 0.0) (Color3 (0.3 :: GLdouble) 0.3 0.0) $ do + nakami + where + futa = renderPrimitive LineStrip $ ugoVertices2D 0 1 [((-10),6),((-6),10),(6,10),(10,6)] + neji = (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(12,4),(12,(-4))]) >> + (renderPrimitive LineStrip $ ugoVertices2D 0 1 [(16,2),(16,(-2))]) + toge = renderPrimitive LineStrip $ ugoVertices2D 0 1 [(10,8),(16,14)] + nakami = rotate 145 (Vector3 0.2 0.2 (1 :: GLdouble)) >> scale 9 6 (1 :: GLdouble) >> + (renderPrimitive LineStrip $ ugoVertices2D 0 0.2 $ map (\n -> (cos$n*pi/8,sin$n*pi/8)) [1,15,3,13,5,11,7,9]) + + renderGameObject DiamondBomb{position = (x:+y),age=clock} = preservingMatrix $ do + translate (Vector3 x y 0) + rotate (90*intToGLdouble(clock`mod`4)) (Vector3 0 0 (1 :: GLdouble)) + color (Color3 (1 :: GLdouble) 1 1) + renderPrimitive LineLoop $ vertices2D 0 $ [a,b,c] + color (Color3 (0.5 :: GLdouble) 0.5 0.5) + renderPrimitive Lines $ vertices2D 0 $ [a,d,a,e] + renderPrimitive LineStrip $ vertices2D 0 $ [c,d,e,b] + where + [a,b,c,d,e] = [(0,0),(r,0),(0,r),(-r,0),(0,-r)] + r = diamondBombSize + -- c + -- /|\ + -- d-a-b + -- \|/ + -- e + renderGameObject TurnGear{position=x:+y,age=clock} = preservingMatrix $ do + translate (Vector3 x y 0) + color (Color3 1.0 0.7 1.0 :: Color3 GLdouble) + rotate (5 * intToGLdouble clock) (Vector3 0 0 1 :: Vector3 GLdouble) + renderWing + rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) + renderWing + rotate 120 (Vector3 0 0 1 :: Vector3 GLdouble) + renderWing + where + renderWing = renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map ((\(t:+u) -> (t,u)) . (\(r,t) -> mkPolar r (pi*t)) ) + [(3,0), (3,2/3), (smallBacterianSize,1/3), (smallBacterianSize,0), (smallBacterianSize+3,-1/3)] + + renderGameObject Flyer{position=x:+y,age=_,velocity = v,hasItem=item} = preservingMatrix $ do + translate (Vector3 x y 0) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) + rotate (phase v / pi * 180) (Vector3 0 0 (1 :: GLdouble)) + renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(-2,0),(-6,4),(-10,0),(-6,-4)] + renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,4),(16,4),(4,16),(-10,16)] + renderPrimitive LineLoop $ ugoVertices2D 0 2 $ [(2,-4),(16,-4),(4,-16),(-10,-16)] + + renderGameObject Ducker{position = (x:+y),hitDisp=hd,hasItem=item,velocity = v,gVelocity = g,age = a} = preservingMatrix $ do + translate (Vector3 x y 0) + if signum (imagPart g) > 0 then scale 1 (-1) (1 :: GLdouble) else return () + if signum (realPart v) < 0 then scale (-1) 1 (1 :: GLdouble) else return () + --after this, ducker is on the lower ground, looking right + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) + renderShape (0:+0) hd + renderPrimitive LineStrip $ vertices2D 0 [(0,0),(kx,ky),(fx,fy)] + where + fx:+fy=foot $ intToGLdouble a/2 + kx:+ky=knee $ intToGLdouble a/2 + foot theta = (16*cos(-theta)):+(-16+8*sin(-theta)) + knee theta = foot theta * (0.5 :+ (- sqrt(square(legLen/magnitude(foot theta)) - 0.25))) + legLen = 16 + + renderGameObject Jumper{position = (x:+y),hitDisp=hd,hasItem=item,gravity = g,velocity=v} = preservingMatrix $ do + translate (Vector3 x y 0) + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) + renderShape (0:+0) hd + if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down + renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(15,-5),(25,-5+absvy*leg),(25,-25+absvy*leg)] + renderPrimitive LineStrip $ ugoVertices2D 0 2 $ [(-15,-5),(-25,-5+absvy*leg),(-25,-25+absvy*leg)] + where + gsign = signum $ imagPart g + absvy = imagPart v * gsign -- if falling (+) ascending (-) + leg = 1.5 + + renderGameObject Grashia{position = (x:+y),hitDisp=hd,hasItem=item,gunVector = nv,gravity = g,mode=m} = preservingMatrix $ do + color (if item then (Color3 1.0 0.2 0.2 :: Color3 GLdouble) else (Color3 0.3 1.0 0.7 :: Color3 GLdouble)) + translate (Vector3 x y 0) + renderShape (0:+0) hd + renderPrimitive LineLoop $ ugoVertices2D 0 2 $ map (\r -> (nvx*r,nvy*r)) [16,32] + if m == 1 then do + renderShape 0 $ Circular (16:+12*gsign) 4 + renderShape 0 $ Circular ((-16):+12*gsign) 4 + else return () + where + nvx:+nvy = nv + gsign = signum $ imagPart g + + renderGameObject me@ScrambleHatch{position = (x:+y),hitDisp=_,gravity= g,gateAngle = angl} = preservingMatrix $ do + translate (Vector3 x y 0) + color (Color3 (1.2*(1-hpRate)) 0.5 (1.6*hpRate) :: Color3 GLdouble) + if gsign >0 then rotate 180 (Vector3 (1 :: GLdouble) 0 0) else return() -- after this you can assume that the object is not upside down + renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*2) 1 $ [(-45,1),(-45,hatchHeight),(45,hatchHeight),(45,1)] + preservingMatrix $ do + translate (Vector3 45 hatchHeight (0 :: GLdouble)) + rotate (-angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) + renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(-45,0),(-45,10)] + preservingMatrix $ do + translate (Vector3 (-45) hatchHeight (0 :: GLdouble)) + rotate (angl/pi*180) (Vector3 0 0 (1 :: GLdouble)) + renderPrimitive LineLoop $ ugoVertices2DFreq 0 (angl*1) 2 $ [(0,0),(45,0),(45,10)] + where + gsign = signum $ imagPart g + hpRate = (intToGLdouble $ hp me)/(intToGLdouble hatchHP) + + renderGameObject LandScapeBlock{position=pos,hitDisp=hd} = preservingMatrix $ do + color (Color3 0.6 0.2 0 :: Color3 GLdouble) + renderShape pos hd + if treasure!!(baseGameLevel variables) then do + color (Color3 0.7 0.23 0 :: Color3 GLdouble) + translate (Vector3 0 0 (60 :: GLdouble)) + renderShape pos hd + color (Color3 0.5 0.17 0 :: Color3 GLdouble) + translate (Vector3 0 0 (-120 :: GLdouble)) + renderShape pos hd + else return() + + renderGameObject me@Particle{position = x:+y,particleColor=Color3 mr mg mb} = preservingMatrix $ do + if age me>=0 then do + translate (Vector3 x y 0) + color (Color3 r g b) + renderShape (0:+0) $ Circular (0:+0) (size me*extent) + else return () + where + extent = 0.5 + intCut (intToGLdouble(age me) / decayTime me) + decay = exp $ intCut $ -intToGLdouble (age me) / decayTime me + whiteout = exp $ intCut $ -2*intToGLdouble (age me) / decayTime me + r = mr * decay + whiteout + g = mg * decay + whiteout + b = mb * decay + whiteout + intCut :: GLdouble -> GLdouble + intCut = intToGLdouble.round + + renderGameObject Star{position = x:+y,particleColor=c} = preservingMatrix $ do + color c + renderPrimitive LineStrip $ ugoVertices2D 0 2 [(0.1+x,0+y),(-0.1+x,0+y)] + + + renderGameObject DebugMessage{debugMessage=str} = + putDebugStrLn str + + renderGameObject _ = return () + vicViper = fromJust $ find (\obj -> case obj of + VicViper{} -> True + _ -> False) objects + + renderShape :: Complex GLdouble -> Shape -> IO () + renderShape (x:+y) s = case s of + Rectangular{bottomLeft = (l:+b), topRight = (r:+t)} -> + renderPrimitive LineLoop $ vertices2D 0 [(x+l,y+b),(x+l,y+t),(x+r,y+t),(x+r,y+b)] + Circular{center=cx:+cy, radius = r} -> preservingMatrix $ do + translate (Vector3 (cx+x) (cy+y) 0) + rotate (intToGLdouble gameclock*(45+pi)) (Vector3 0 0 (1 :: GLdouble)) + scale r r 1 + renderPrimitive LineLoop $ vertices2D 0 $ map (\t -> (cos(2/7*t*pi),sin(2/7*t*pi))) [0..6] + Shapes{children=cs} -> mapM_ (renderShape (x:+y)) cs + + + renderWithShade :: ColorComponent a=>Color3 a -> Color3 a -> IO () -> IO () + renderWithShade colorA colorB rndrr = do + color colorB + preservingMatrix $ do + translate $ Vector3 1 (-1) (-1 :: GLdouble) + rndrr + color colorA + preservingMatrix rndrr + +-- ugoVertex :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO () +-- ugoVertex x y z r = ugoVertexFreq x y z r standardUgoInterval + + ugoVertexFreq :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> Int -> IO () + -- renders a vertex at somewhere near (x y z), + -- but the point wiggles around in ugoRange when each interval comes. + ugoVertexFreq x y z ugoRange intrvl = vertex $ Vertex3 (x+dr*cos theta) (y+dr*sin theta) z where + flipper :: GLdouble + flipper = fromIntegral $ (gameclock `div` intrvl) `mod` 1024 + dr = ugoRange * vibrator(phi) + theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper + phi = (x + sqrt(3)*y + sqrt(7)*z + 106) * 150 * flipper + vibrator a = 0.5 * (1 + sin a) + + ugoTranslate x y z ugoRange = ugoTranslateFreq x y z ugoRange standardUgoInterval + ugoTranslateFreq x y z ugoRange intvl = translate (Vector3 (x+dr*cos theta) (y+dr*sin theta) z) where + flipper :: GLdouble + flipper = fromIntegral $ (gameclock `div` intvl) `mod` 1024 + dr = ugoRange * vibrator(phi) + theta = (x + sqrt(2)*y + sqrt(3)*z + 573) * 400 * flipper + phi = (x + sqrt(3)*y + sqrt(7)*z + 106) * 150 * flipper + vibrator a = 0.5 * (1 + sin a) + + ugoVertices2D z r xys = ugoVertices2DFreq z r standardUgoInterval xys + ugoVertices2DFreq z r intrvl xys = mapM_ (\(x,y) -> ugoVertexFreq x y z r intrvl) xys + + vertices2D :: GLdouble -> [(GLdouble,GLdouble)] -> IO () + vertices2D z xys = mapM_ (\(x,y) -> vertex $ Vertex3 x y z) xys + +standardUgoInterval :: Int +standardUgoInterval = 7 + +isMonadiusOver :: Monadius -> Bool +isMonadiusOver (Monadius (vars,_)) = flagGameover vars
+ src/Recorder.hs view
@@ -0,0 +1,84 @@+-- | a replay recording system. +module Recorder ( + Recorder(..), + initialRecorder, + RecorderMode(..), + encode2, + decode, + ) where + +import Game +import Graphics.UI.GLUT +import Monadius +import Util + +data Recorder = Recorder{ + keybuf :: [[Key]], + preEncodedKeyBuf :: [Int], + mode :: RecorderMode, + gameBody :: Monadius, + age :: Int, + isQuitRequested :: Bool} + +data RecorderMode = Play | Playback | Record + deriving (Eq,Show) + +instance Game Recorder where + update = updateRecorder + render = renderRecorder + isGameover = recorderIsGameover + +encode2 :: [Int] -> String +encode2 = show . reverse + +encodeKeySet :: [Key] -> Int +encodeKeySet keys = sum $ map (\i->if (importantKeys!!i) `elem` keys then 2^i else 0) [0..(length importantKeys-1)] + +decode :: String -> [[Key]] +decode str = map decodeKeySet (read str :: [Int]) + +decodeKeySet :: Int -> [Key] +decodeKeySet num = extract num importantKeys where + extract 0 _ = [] + extract _ [] = [] + extract i (c:cs) = (if i `mod` 2 == 1 then [c] else []) ++ extract (i `div` 2) cs + +importantKeys :: [Key] +importantKeys = [shotButton,missileButton,powerUpButton,upButton,downButton,leftButton,rightButton,selfDestructButton] + +initialRecorder :: RecorderMode -> [[Key]] -> Monadius -> Recorder +initialRecorder initialMode keyss initialGame = Recorder{ + keybuf = if initialMode == Playback then keyss ++ repeat [] else [], + preEncodedKeyBuf = [], + mode = initialMode, + gameBody = initialGame, + age=0, + isQuitRequested = False } + +updateRecorder::[Key]->Recorder->Recorder +updateRecorder keys me = me{ + --keybuf = (if mode me == Record then (++ [keys]) else id) $ keybuf me, + preEncodedKeyBuf = (if mode me == Record then (encodeKeySet keys:) else id) $ preEncodedKeyBuf me, + gameBody = (if mode me /= Playback then update keys else update (keybuf me!!age me)) $ gameBody me, + age = age me + 1, + isQuitRequested = (mode me == Playback && (selfDestructButton `elem` keys || Char ' ' `elem` keys)) || isQuitRequested me +} + +renderRecorder :: Recorder -> IO () +renderRecorder me = do + (putDebugStrLn.show.mode) me + if age me==0 || mode me /= Record then return () else preservingMatrix $ do + translate (Vector3 300 (-230) (0::GLdouble)) + scale 0.1 0.1 (0.1 :: GLdouble) + color (Color3 0.4 0.4 (0.4 :: GLdouble)) + renderString Roman $ show $ (head.preEncodedKeyBuf) me + + render $ gameBody me + +recorderIsGameover :: Recorder -> Bool +recorderIsGameover me = (isGameover . gameBody) me || isQuitRequested me + + + + +
+ src/Util.hs view
@@ -0,0 +1,96 @@+-- | Various numeric utility functions, particularly dealing with Complex +-- numbers and shapes. +module Util ( + ComplexShape(..), + Shape(..), + angleAccuracy, + filterJust, + infinite, + innerProduct, + intToGLdouble, + isDebugMode, + modifyArray, + padding, + putDebugStrLn, + regulate, + square, + unitVector, + ) where + +import Data.Array (Array (), Ix (), (!), (//)) +import Data.Complex +import Data.Maybe +import Graphics.Rendering.OpenGL + +-- | Switch this to True to get debug outputs. Be careful: you get a crash under +-- Microsoft Windows, because the console is not available. +isDebugMode :: Bool +isDebugMode = False + +putDebugStrLn :: String -> IO () +putDebugStrLn str = if isDebugMode then putStrLn str else return () + +filterJust :: [Maybe a] -> [a] +filterJust = map fromJust.filter isJust + +-- | Modify array 'a' at index 'i' by function 'f' +modifyArray :: Ix i => i -> (e -> e) -> Array i e -> Array i e +modifyArray i f a = a // [(i,f $ a!i)] + +class ComplexShape s where + -- | Collision check + (>?<) :: s -> s -> Bool + -- | Translation by a vector + (+>) :: (Complex GLdouble) -> s -> s + +instance ComplexShape Shape where + a >?< b = case (a,b) of + (Circular{},Circular{}) -> magnitude (center a - center b) < radius a + radius b + (Circular{},Rectangular{}) -> b >?< a + (Rectangular{},Circular{}) -> a >?< Rectangular{bottomLeft = center b - vr,topRight = center b + vr} where + vr = radius b :+ radius b + (Rectangular{bottomLeft=aL:+aB,topRight=aR:+aT},Rectangular{bottomLeft=bL:+bB,topRight=bR:+bT}) -> + and [aL < bR, aB < bT, aR > bL, aT > bB] + (Shapes{children = ss}, c) -> or $ map (>?< c) ss + (d, Shapes{children = ss}) -> or $ map (d >?<) ss + v +> a = case a of + Circular{} -> a{center = center a + v} + Rectangular{} -> a{bottomLeft = bottomLeft a + v, topRight = topRight a + v} + Shapes{} -> a{children = map (v +>) $ children a} + +data Shape = Circular {center :: Complex GLdouble, radius :: GLdouble} | + Rectangular {bottomLeft :: Complex GLdouble, topRight :: Complex GLdouble} | + Shapes {children :: [Shape]} + +-- | Put a Rectangle coordinates into normal order so that collision will go properly. +regulate :: Shape -> Shape +regulate Rectangular{bottomLeft=(x1:+y1),topRight=(x2:+y2) }= Rectangular (min x1 x2:+min y1 y2) (max x1 x2:+max y1 y2) +regulate ss@Shapes{} = ss{children = map regulate $ children ss} +regulate x = x + +intToGLdouble :: Int -> GLdouble +intToGLdouble = fromIntegral + +unitVector :: Complex GLdouble -> Complex GLdouble +unitVector z + | magnitude z <= 0.00000001 = 1:+0 + | otherwise = z / abs z + +angleAccuracy :: Int -> Complex GLdouble -> Complex GLdouble +angleAccuracy division z = mkPolar r theta + where + (r,t)=polar z + theta = (intToGLdouble $ round (t / (2*pi) * d))/d*2*pi + d = intToGLdouble division + +innerProduct :: Complex GLdouble -> Complex GLdouble -> GLdouble +innerProduct a b = realPart $ a * (conjugate b) + +padding :: Char -> Int -> String -> String +padding pad minLen str = replicate (minLen - length str) pad ++ str + +infinite :: Int +infinite = 9999999 + +square :: (Num a) => a -> a +square a = a * a