diff --git a/CONTRIBUTING b/CONTRIBUTING new file mode 100644 --- /dev/null +++ b/CONTRIBUTING @@ -0,0 +1,62 @@ +=========================================== +If you want to contriubute to the source +code of venzone you are in the right +place. If you want to design levels inste- +ad, check the guide at `stories/editor.vns` +=========================================== + + + +1. Get Haskell and Darcs, from your repos or from: + https://www.haskell.org/downloads/#minimal + http://darcs.net + +2. Clone the code with `darcs get https://hub.darcs.net/ffaf/venzone` + +3. Modify the game, add features. + + lentil src/ test/ # to see open issues + # no lentil? `cabal new-install lentil` to get it. + +4. If needed, update your package list: + + cabal new-update + +5. Build your executable: + + cabal new-build venzone + # when it finishes, you will find your executable in `release/`. + # Use --allow-newer if cabal cannot solve the dependency tree + +6. Run the tests with: + + cabal new-run test + # you might get a `missing hspec-discover` error, in that case + # run `cabal new-install hspec-discover`. + + # if you want to watch the replay of a specific test, do + `cabal new-repl test` and then + λ> narrateGymnasium "test/records/ladder-exit.vr" + +7. send me a diff or patch in any format you prefer. With darcs the + usual workflow is to set up a repo at https://hub.darcs.net/ , + push your patches there and let me know. + If you prefer plain email: + + darcs record # records your changes + darcs send -o some-change.dpatch # creates a textual patch + # and then write to me () + # with some-change.dpatch attached. + +8. if you compiled venzone for a new system and want to send me a release + of it just type: + + cabal new-run packerino + + and a .zip will be automatically created. + + +If you get stuck, don't hesitate to contact me: + + http://ariis.it/static/articles/mail/page.html + diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Packerino.hs b/Packerino.hs new file mode 100644 --- /dev/null +++ b/Packerino.hs @@ -0,0 +1,101 @@ +module Main where + + +import Data.Char +import Data.List +import System.Directory +import System.FilePath +import System.FilePath.Find as F +import System.Info +import System.IO.Temp +import System.Process + + +main :: IO () +main = putStrLn "-- Creating venzone release --\n" >> + + if isWin + then error "Sorry, this packing script doesn't yet work on Windows." + else + + -- rebuild + callCommand "cabal new-clean" >> + callCommand "cabal new-build venzone" >> + + -- find exe + F.find always exec "dist-newstyle" >>= \(e:_) -> + + -- temp folder + withSystemTempDirectory + "vpack" + (callb e) >> + return () + + where + exec :: FindClause Bool + exec = -- correct name + ( fileName ==? "venzone" ||? + fileName ==? "venzone.exe" ) &&? + -- correct filetype + fileType ==? RegularFile + + -- exe filepath, tmpdir path + callb :: FilePath -> FilePath -> IO () + callb we fp = + -- crea dir structure + let rd = fp "venzone" + sd = rd "stories" in + createDirectory rd >> + createDirectory sd >> + + -- muovi eseguibile qui + copyFile we (rd "venzone") >> + + -- muovi readme qui + copyFile ("." "assets" "readme.txt") + (rd "readme.txt") >> + + -- muovi livelli qui + let ls = "." "stories" + f lp = copyFile (ls lp) (sd lp) in + listDirectory ls >>= \ss -> + mapM_ f ss >> + + -- elimina gymnasium + removeFile (sd "t_gymnasium.vns") >> + + sysCompress fp >> + return () + + +-- tmp-dir +sysCompress :: FilePath -> IO () +sysCompress fp = + withCurrentDirectory fp stripZip >> + copyFile (fp aName) ("." aName) >> + putStrLn ("\n" ++ aName ++ " created!") + where + aName :: String + aName = "venzone-" ++ os ++ "-" ++ arch ++ ".zip" + + stripZip :: IO () + stripZip = + strip ("venzone" "venzone") >> + callCommand ("zip -r " ++ aName ++ " venzone/") + + +-- hackish but works on wine +zipCommand :: String -> String -> String +zipCommand an fl + | isWin = "\"C:\\Program Files\\7-Zip\\7za.exe\" a -r " ++ + an ++ " -w " ++ fl ++ " -mem=AES256" + | otherwise = "zip -r " ++ an ++ " " ++ fl + + +strip :: FilePath -> IO () +strip fp | isWin = return () + | otherwise = callCommand ("strip " ++ fp) + +isWin :: Bool +isWin = isPrefixOf "windows" (map toLower os) + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,26 @@ +======= +Venzone +======= + +ASCII adventure-platformer set in the Carnic Alps. +To play, visit: + + http://www.ariis.it/static/articles/venzone/page.html + + and download a binary. If you prefer compiling it yourself, get + Haskell on your system and then: + + cabal new-update + cabal new-run venzone + + or: + + stack run venzone + +If you want to hack it, follow the instructions in CONTRIBUTING. + +Feedback welcome, contact me at: + + http://ariis.it/static/articles/mail/page.html + +Authors, copyright and other info in assets/readme.txt. diff --git a/assets/art/menu.scr b/assets/art/menu.scr new file mode 100644 --- /dev/null +++ b/assets/art/menu.scr @@ -0,0 +1,24 @@ + + +.--._ + + '-._ _.-''-._ | + '---.___.- '-__ __ /V\ + _.-' '--._ __.-' '-_ |v| + __-' '--.___.--' '-_ /vVv\ __ + ' '-./vVvVv\ __.-' + | |_-' + |O O| + -| |- + / |o o| \ + _j____ /__| |__\ + ///////\ | | .|. | | + __j ///////()\|# | -O- | #| __j___ + /\\\\ /////// \ | '|' | |/\\\\\\ + /()\\\\ | # |# #| | _ | |()\\\\\ + | | | | | | | (|) | | \\\\ + _____|__|[]|_|_____|_[]_|__|_|||_|__|[]_|___ + _/-------------------------------------------- + |. . .. . . .. +.-._.-._.-._.-._.-._.-._.-._.-._.-| . . .. . . .. . . +_.-._.-._.-._.-._.-._.-._.-._.-._./ . . . . + / . . diff --git a/assets/readme.txt b/assets/readme.txt new file mode 100644 --- /dev/null +++ b/assets/readme.txt @@ -0,0 +1,51 @@ +============ +Venzone v1.0 +============ + +Friuli, 1748. +The evil Orcolat has awaken again. Reach the top of the Alps and steal +his Poleaxe, or watch your town suffer a devastating earthquake. + +Running the game +---------------- + +Double click on the "venzone" (Linux) or "venzone.exe" (Windows). On +macOS instead you need to *right* click on it and then select "Open". + +Controls +-------- + +- Move using "WASD". Tap *once* to start moving, tap again or press "Space" + to stop moving. French layout compatible. +- "R" restarts from last savepoint. +- "L" leaves the story / exits the game. + +Authors +------- + +Francesco Ariis ............. design & programming +JimReed ..................... ASCII art / additional design +sm .......................... alpha feedback / additional design +Franciman +mzan ........................ build resources +Rampoina +rick +ibispi +vinicio ..................... beta testing + +Licence +------- + +This game is released under the GPLv3. You can find the source code at: + + https://hub.darcs.net/ffaf/venzone + +Contact +------- + +You can contact me with bug reports or feedback at: + + http://ariis.it/static/articles/mail/page.html + + +© 2019 http://www.ariis.it diff --git a/src/Art.hs b/src/Art.hs new file mode 100644 --- /dev/null +++ b/src/Art.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Art where + +import Data.FileEmbed +import Terminal.Game + + +menuArt :: Plane +menuArt = stringPlane $(embedStringFile "assets/art/menu.scr") + +-- not really art but +readme :: String +readme = $(embedStringFile "assets/readme.txt") diff --git a/src/Gymnasium.hs b/src/Gymnasium.hs new file mode 100644 --- /dev/null +++ b/src/Gymnasium.hs @@ -0,0 +1,68 @@ +module Gymnasium ( playGymnasium, + recordGymnasium, + testGymnasium, + narrateGymnasium + ) + where + +-- Gymnasium testing utilities + +import Venzone +import Story +import Menu + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Data.List as L +import qualified NonEmptyZipper as Z + + +playGymnasium :: IO () +playGymnasium = gymnasiumDo Nothing + +recordGymnasium :: FilePath -> IO () +recordGymnasium fp = gymnasiumDo (Just fp) + +-- it is not pure only because load IO +testGymnasium :: FilePath -> IO Story +testGymnasium fp = + loadGymnasium >>= \vg -> + readRecord fp >>= \r -> + return (testGame vg r ^?! story . each) + +narrateGymnasium :: FilePath -> IO () +narrateGymnasium fp = + loadGymnasium >>= \vg -> + readRecord fp >>= \r -> + () <$ narrateGame vg r + + + +----------------- +-- ANCILLARIES -- +----------------- + +gymnasiumDo :: Maybe FilePath -> IO () +gymnasiumDo mf = + errorPress $ + loadGymnasium >>= \vg -> + action vg + where + action :: Game s -> IO () + action | (Just fp) <- mf = \g -> recordGame g fp >> return () + | otherwise = playGame + +loadGymnasium :: IO (Game Venzone) +loadGymnasium = + prepareVenzone >>= \gv -> + return (gv { gInitState = gInitState gv & story ?~ gym gv }) + where + gym :: Game Venzone -> Story + gym g = + let ss = gInitState g ^. menu . stories . to Z.toList in + case L.find (\s -> (s ^. name) == "Gymnasium") ss of + Just s -> s + Nothing -> error "loadGymnasium: no Gymnasium found" + + diff --git a/src/Input.hs b/src/Input.hs new file mode 100644 --- /dev/null +++ b/src/Input.hs @@ -0,0 +1,51 @@ +module Input where + +import Terminal.Game + + +data Input = KUp | KDown | KLeft | KRight | KSpace | + KRestart | KHelp | KExit | + NoKey + deriving (Eq, Show) + +data Cardinal = N | S | W | E + deriving (Eq, Show) + + +----------- +-- Input -- +----------- + +eventInput :: Event -> Input +eventInput Tick = NoKey +eventInput (KeyPress c) + + | c == 'w' = KUp + | c == 'z' = KUp -- azerty support + | c == 's' = KDown + | c == 'a' = KLeft + | c == 'q' = KLeft + | c == 'd' = KRight + | c == ' ' = KSpace + + | c == 'r' = KRestart + | c == 'h' = KHelp + | c == 'l' = KExit + + | otherwise = NoKey + + +-- WASD +isMovKey :: Input -> Bool +isMovKey k = elem k [KUp, KDown, KLeft, KRight, KSpace] + +-- non WASD +isMenuKey :: Input -> Bool +isMenuKey k = elem k [KRestart, KHelp, KExit] + +turnAround :: Cardinal -> Cardinal +turnAround N = S +turnAround S = N +turnAround E = W +turnAround W = E + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,74 @@ +{-# Language LambdaCase #-} + +-- GPLv3, this and all the repo + + +module Main where + +import Venzone +import Watcher + +import Terminal.Game + +import System.Environment as E + +-- todo [release] jr quest + +main :: IO () +main = E.getArgs >>= \case + [] -> normalMode + ["--watch", fp] -> watchMode fp + ["--record", fp] -> recordMode fp + ["--narrate", fp] -> narrateMode fp + ["--help"] -> displayHelp + _ -> putStrLn "Unrecognised option!" >> + displayHelp + + +----------- +-- MODES -- +----------- + +normalMode :: IO () +normalMode = errorPress $ + prepareVenzone >>= \gv -> + playGame gv >> + return () + +-- record venzone playthrough +recordMode :: FilePath -> IO () +recordMode fp = errorPress $ + prepareVenzone >>= \gv -> + recordGame gv fp >> + return () + +-- record venzone playthrough +narrateMode :: FilePath -> IO () +narrateMode fp = errorPress $ + prepareVenzone >>= \gv -> + readRecord fp >>= \es -> + narrateGame gv es >> + return () + + +----------------- +-- ANCILLARIES -- +----------------- + +displayHelp :: IO () +displayHelp = putStr . unlines $ + ["\nvenzone - an adventure in the Carnic Alps", + "(C) 2019 Francesco Ariis - http://www.ariis.it", + "released under the GNU General Public License v3", + "", + "To run the game, just type ./venzone (or venzone.exe if you", + "use Windows).", + "", + "Options:", + "--help Display this help.", + "--watch path/to/story.vns Watch mode: autoreload story", + " when file is saved.", + "--record PATH Record mode: play the game", + " and save a record to PATH.", + "--narrate PATH Play back a recorded game.", + ""] diff --git a/src/Meeple/Operate.hs b/src/Meeple/Operate.hs new file mode 100644 --- /dev/null +++ b/src/Meeple/Operate.hs @@ -0,0 +1,193 @@ +module Meeple.Operate ( module M, module Meeple.Operate ) where + +import Meeple.Primitives as M + +import Lens.Micro.Platform +import Terminal.Game + +import qualified Data.Char as C +import qualified Line.Draw as D + + +casualRandom :: (Random a, HasCasual c) => (a, a) -> c -> (a, c) +casualRandom bs c = let g = c ^. seed + (i, g') = getRandom bs g in + (i, c & seed .~ g') + + +-- bool: long lock ani? +updateLockAni :: Bool -> Meeple -> Meeple +updateLockAni b (MLock l) = + let i = l ^. currNumeral + a' | i >= 0 = lockAni i + | otherwise = creaStaticAnimation (cell '?') + l' = l & draw .~ a' + in + + if b then MLock l' + else MLock (l' & draw %~ lapse) + where + lockAni 0 = + creaAnimation + [(1, cell '\\'), + (1, cell '-'), + (1, cell '/')] + lockAni wi = let n = 1 + c = C.intToDigit . fromIntegral $ wi in + creaAnimation + [(n, cell '\\'), + (n, cell '-'), + (n, cell '/'), + (n, cell c)] +updateLockAni _ m = m + +isDead :: Meeple -> Bool +isDead (MDead _) = True +isDead _ = False + +isPlayer :: Meeple -> Bool +isPlayer (MPlayer _) = True +isPlayer _ = False + +-- if you have moved, unset new property +oldPlayer :: Player -> Player +oldPlayer p + | not (p ^. isNew) = p + | p ^. speed == (0, 0) = p + | otherwise = p & isNew .~ False + + +hasSteps :: Meeple -> Bool +hasSteps (MDead _) = False +hasSteps (MBird b) = (not . null) (b ^. steps) +hasSteps (MDumb d) = (not . null) (d ^. steps) +hasSteps (MKram k) = (not . null) (k ^. steps) +hasSteps (MLock _) = False +hasSteps (MNettle _) = False +hasSteps (MPlayer p) = (not . null) (p ^. steps) +hasSteps (MSave _) = False +hasSteps (MSmart s) = (not . null) (s ^. steps) +hasSteps (MSickle s) = (not . null) (s ^. steps) +hasSteps (MStar _) = False +hasSteps (MStone s) = (not . null) (s ^. steps) +hasSteps (MWin w) = (not . null) (w ^. steps) +hasSteps (MWitch b) = (not . null) (b ^. steps) + +dropStep :: Meeple -> Meeple +dropStep m@(MDead _) = m +dropStep m@(MBird _) = m & steps %~ tail +dropStep m@(MDumb _) = m & steps %~ tail +dropStep m@(MKram _) = m & steps %~ tail +dropStep m@(MLock _) = m +dropStep m@(MNettle _) = m +dropStep m@(MPlayer _) = m & steps %~ tail +dropStep m@(MSave _) = m +dropStep m@(MSmart _) = m & steps %~ tail +dropStep m@(MSickle _) = m & steps %~ tail +dropStep m@(MStar _) = m +dropStep m@(MStone _) = m & steps %~ tail +dropStep m@(MWin _) = m & steps %~ tail +dropStep m@(MWitch _) = m & steps %~ tail + +safePrevPos :: Meeple -> Coords +safePrevPos (MDead _) = error "safePrevPos" +safePrevPos m@(MBird _) = m ^. prevPos +safePrevPos m@(MDumb _) = m ^. prevPos +safePrevPos m@(MKram _) = m ^. prevPos +safePrevPos m@(MLock _) = m ^. position +safePrevPos m@(MNettle _) = m ^. position +safePrevPos m@(MPlayer _) = m ^. prevPos +safePrevPos m@(MSave _) = m ^. position +safePrevPos m@(MSickle _) = m ^. prevPos +safePrevPos m@(MStar _) = m ^. position +safePrevPos m@(MSmart _) = m ^. prevPos +safePrevPos m@(MStone _) = m ^. prevPos +safePrevPos m@(MWin _) = m ^. prevPos +safePrevPos m@(MWitch _) = m ^. prevPos + +-- this generates the projectile and decides whether it is gonna be +-- spawned or aborted +genProj :: Meeple -> Meeple +genProj (MBird b) = let cs = b ^. position + b' = b & ready ?~ MRStone cs + in MBird $ spawnOrNot (1, 8) b' +genProj (MKram k) = let cs = k ^. position + -- (sh, k') = casualRandom (-1, 1) k + -- non un bel effetto grafico + k' = k & ready ?~ MRSickle cs (-1, 0) + in MKram $ spawnOrNot (1, 5) k' +genProj m@MDead {} = m +genProj m@MPlayer {} = m +genProj m@MStar {} = m +genProj m@MLock {} = m +genProj m@MNettle {} = m +genProj m@MSickle {} = m +genProj m@MStone {} = m +genProj m@MDumb {} = m +genProj m@MSmart {} = m +genProj m@MWin {} = m +genProj m@MWitch {} = m +genProj m@MSave {} = m + +-- let the generated meeplelive or else +spawnOrNot :: (HasGenerator g, HasCasual g) => (Integer, Integer) -> g -> g +spawnOrNot (t, n) g = + let (i, g') = casualRandom (1, n) g + in if i <= t then g' -- let it live + else g' & ready .~ Nothing -- cull it + + +------------- +-- OPERATE -- +------------- + +generateSteps :: Meeple -> Meeple +generateSteps m = let ss = D.bresenham (0, 0) (m ^. speed) + mf (a, b) (c, d) = (a-c, b-d) + in m & steps .~ zipWith mf (tail ss) ss + +-- touch animation +touchSave :: Save -> Save +touchSave s = s & draw .~ ani + where + ani = creaAnimation + [(2, cell '@' # color Blue Vivid), + (3, cell '+' # color Yellow Vivid # bold), + (3, cell '@' # color Blue Vivid), + (3, cell '+' # color Yellow Vivid # bold), + (3, cell '@' # color Blue Vivid)] + + +-- inquire -- + +-- similar folks don't hit each other +isSimilar :: Meeple -> Meeple -> Bool +isSimilar ma mb = meepleCategory ma == meepleCategory mb + +isStingy :: Nettle -> Bool +isStingy n = (n ^. draw . to fetchFrame . to paperPlane) == "A\n" + +------------------ +-- CONSTRUCTORS -- +------------------ + +-- ASCII Chars: +-- !"#$%&'()*+,-./ +-- 0123456789 +-- :;<=>?@ +-- ABCDEFGHIJKLMNOPQRSTUVWXYZ +-- [\]^_` +-- abcdefghijklmnopqrstuvwxyz +-- {|} + +creaRef :: MeepRef -> [Meeple] +creaRef (MRStone cs) = [s (-1), s 0, s 1] + where + s :: Integer -> Meeple + s mh = MStone $ defaultStone (cs & _1 %~ (+1) + & _2 %~(+mh)) +creaRef (MRSickle cs sp) = [MSickle $ defaultSickle + (cs & _1 %~ subtract 1) + sp] + + diff --git a/src/Meeple/Primitives.hs b/src/Meeple/Primitives.hs new file mode 100644 --- /dev/null +++ b/src/Meeple/Primitives.hs @@ -0,0 +1,477 @@ +{-# Language RankNTypes #-} +{-# Language TemplateHaskell #-} +{-# Language ConstraintKinds #-} + +module Meeple.Primitives where + +-- NPC/PC/Objects primitives + +import Input +import Lens.Micro.Platform +import Terminal.Game + +import qualified Data.Function as F +import qualified Data.Char as C + + +------------- +-- CLASSES -- +------------- + +-- Classes: +-- - stationary +-- - moving +-- - delayed +-- - walker +-- - casual + + +data Stationary = Stationary { _position :: Coords, + _draw :: Animation } + deriving (Eq, Show) +makeClassy ''Stationary + +defaultStationary :: Coords -> Animation -> Stationary +defaultStationary c a = Stationary c a + +-- speed in row/column +type Speed = (Row, Column) +type Step = Speed -- movement relative to last step + +data Moving = Moving + { _movingStationary :: Stationary, + _speed :: Speed, + _steps :: [Step], + _prevPos :: Coords } + deriving (Eq, Show) +makeClassy ''Moving +instance HasStationary Moving where stationary = movingStationary + +defaultMoving :: Coords -> Animation -> Moving +defaultMoving c a = Moving (defaultStationary c a) + (0, 0) [] c + +-- delayed moving (once every x frames) +data Delayed = Delayed + { _delayedMoving :: Moving, + _delay :: Timed Bool } + -- will wait x cycles before acting + deriving (Eq, Show) +makeClassy ''Delayed +instance HasMoving Delayed where moving = delayedMoving +instance HasStationary Delayed where + stationary = delayedMoving . movingStationary + +defaultDelayed :: Coords -> Animation -> Integer -> Delayed +defaultDelayed c a i = Delayed (defaultMoving c a) (creaBoolTimerLoop i) + +data Walker = Walker + { _walkerDelayed :: Delayed, + _cardinal :: Cardinal } + deriving (Eq, Show) +makeClassy ''Walker +instance HasDelayed Walker where delayed = walkerDelayed +instance HasMoving Walker where moving = walkerDelayed . delayedMoving +instance HasStationary Walker where + stationary = walkerDelayed . movingStationary + +defaultWalker :: Coords -> Animation -> Integer -> Cardinal -> Walker +defaultWalker c a i k = Walker (defaultDelayed c a i) k + + +newtype Casual = Casual { _seed :: StdGen } + deriving (Show) +makeClassy ''Casual + +-- dirty way of setting up an rng +defaultCasual :: Coords -> Casual +defaultCasual (r, c) = Casual $ mkStdGen (fromIntegral $ r + c) + +-- cosa vado a creare? Non posso usare Meeple direttamente, perché grouping +-- of TH non lascia spazio per def circolari. + +data MeepRef = MRStone Coords + | MRSickle Coords Speed + deriving (Eq, Show) + +data Generator = Generator + { _generatorCasual :: Casual, + _ready :: Maybe MeepRef } + deriving (Show) +makeClassy ''Generator +instance HasCasual Generator where casual = generatorCasual +instance Eq Generator where + ga == gb = F.on (==) _ready ga gb + +defaultGenerator :: Coords -> Generator +defaultGenerator cs = Generator (defaultCasual cs) Nothing + + +-------------------- +-- ACTUAL MEEPLES -- +-------------------- + +-- STATIONARY -- + +newtype Star = Star { _starStationary :: Stationary } + deriving (Eq, Show) +makeLenses ''Star +instance HasStationary Star where stationary = starStationary +defaultStar :: Coords -> Star +defaultStar cs = Star $ + defaultStationary + cs + (creaStaticAnimation $ cell '*' # color Yellow Vivid) + +data Lock = Lock { _lockStationary :: Stationary, + _origNumeral :: Integer, -- stars to collect to open it + _currNumeral :: Integer } + deriving (Eq, Show) +makeLenses ''Lock +instance HasStationary Lock where stationary = lockStationary + +defaultLock :: Coords -> Integer -> Lock +defaultLock cs i = Lock sta i i + where + sta = defaultStationary + cs + (creaStaticAnimation $ cell 'L') + +newtype Stone = Stone { _stoneMoving :: Moving } + deriving (Eq, Show) +makeLenses ''Stone +instance HasMoving Stone where moving = stoneMoving +instance HasStationary Stone where + stationary = stoneMoving . movingStationary + +defaultStone :: Coords -> Stone +defaultStone cs = Stone $ + defaultMoving cs + (creaStaticAnimation $ cell 'o' # color Cyan Vivid) + +newtype Sickle = Sickle { _sickleMoving :: Moving } + deriving (Eq, Show) +makeLenses ''Sickle +instance HasMoving Sickle where moving = sickleMoving +instance HasStationary Sickle where + stationary = sickleMoving . movingStationary + +defaultSickle :: Coords -> Speed -> Sickle +defaultSickle cs s = Sickle def + where + sickAni = creaLoopAnimation + [(1, cell '<' # color Cyan Vivid), + (1, cell '^' # color Cyan Vivid), + (1, cell '>' # color Cyan Vivid), + (1, cell 'v' # color Cyan Vivid) + ] + + def = (defaultMoving cs sickAni) { _speed = s } + +data NetStatus = NNo | NWake | NYes + deriving (Eq, Show) +newtype Nettle = Nettle { _nettleStationary :: Stationary } + deriving (Eq, Show) +makeLenses ''Nettle +instance HasStationary Nettle where stationary = nettleStationary + +defaultNettle :: Coords -> Nettle +defaultNettle c = Nettle (defaultStationary c ia) + where + ia = creaLoopAnimation + [(19, cell ',' # color Green Dull), + ( 5, cell ';' # color Green Dull), + (26, cell 'A' # color Green Dull), + ( 5, cell ';' # color Green Dull)] + +-- MOVING -- + +newtype Dumb = Dumb { _dumbWalker :: Walker } + deriving (Eq, Show) +makeLenses ''Dumb +instance HasWalker Dumb where walker = dumbWalker +instance HasDelayed Dumb where delayed = dumbWalker . walkerDelayed +instance HasMoving Dumb where moving = dumbWalker . delayedMoving +instance HasStationary Dumb where stationary = dumbWalker . movingStationary + +defaultDumb :: Coords -> Cardinal -> Dumb +defaultDumb cs k = Dumb $ + defaultWalker + cs + (creaStaticAnimation $ cell 'd' # color Red Dull) + 2 k + +newtype Smart = Smart { _smartWalker :: Walker } + deriving (Eq, Show) +makeLenses ''Smart +instance HasWalker Smart where walker = smartWalker +instance HasDelayed Smart where delayed = smartWalker . walkerDelayed +instance HasMoving Smart where moving = smartWalker . delayedMoving +instance HasStationary Smart where stationary = smartWalker . movingStationary + + +defaultSmart :: Coords -> Cardinal -> Smart +defaultSmart cs k = Smart $ + defaultWalker + cs + (creaStaticAnimation $ cell 'd' # color Cyan Dull) + 2 k + +data Krampus = Krampus { _krampusWalker :: Walker, + _krampusGenerator :: Generator } + deriving (Eq, Show) +makeLenses ''Krampus +instance HasWalker Krampus where walker = krampusWalker +instance HasDelayed Krampus where delayed = krampusWalker . walkerDelayed +instance HasMoving Krampus where moving = krampusWalker . delayedMoving +instance HasStationary Krampus where + stationary = krampusWalker . movingStationary +instance HasGenerator Krampus where generator = krampusGenerator +instance HasCasual Krampus where casual = krampusGenerator . generatorCasual + +defaultKrampus :: Coords -> Cardinal -> Krampus +defaultKrampus cs d = Krampus wlk gen + where wlk = defaultWalker + cs + (creaStaticAnimation $ cell 'k' # color Blue Vivid # bold) + 2 d + gen = defaultGenerator cs + + +-- bird state is "where I spawned". Should be "read", not state, but it's ok. +data Bird = Bird { _birdDelayed :: Delayed, + _birdGenerator :: Generator, + _spawnpoint :: Coords } + deriving (Eq, Show) +makeLenses ''Bird +instance HasDelayed Bird where delayed = birdDelayed +instance HasMoving Bird where moving = birdDelayed . delayedMoving +instance HasStationary Bird where stationary = birdDelayed . movingStationary +instance HasGenerator Bird where generator = birdGenerator +instance HasCasual Bird where casual = birdGenerator . generatorCasual +defaultBird :: Coords -> Bird +defaultBird cs = Bird del gen cs + where del = defaultDelayed + cs + (creaStaticAnimation $ cell 'v' # color Magenta Vivid) + 2 + gen = defaultGenerator cs + +data Witch = Witch { _witchDelayed :: Delayed, + _witchCasual :: Casual } + deriving (Show) +makeLenses ''Witch +instance Eq Witch where + ga == gb = F.on (==) _witchDelayed ga gb +instance HasDelayed Witch where delayed = witchDelayed +instance HasMoving Witch where moving = witchDelayed . moving +instance HasStationary Witch where stationary = witchDelayed . stationary +instance HasCasual Witch where casual = witchCasual +defaultWitch :: Coords -> Witch +defaultWitch cs = Witch del gen + where del = defaultDelayed + cs + (creaStaticAnimation $ cell 'X' # color Yellow Dull # bold) + 2 + gen = defaultCasual cs + + + +data Win = Win { _winDelayed :: Delayed, + _floatino :: Cardinal } + deriving (Eq, Show) +makeLenses ''Win +instance HasDelayed Win where delayed = winDelayed +instance HasMoving Win where moving = winDelayed . delayedMoving +instance HasStationary Win where stationary = winDelayed . movingStationary +defaultWin :: Coords -> Win +defaultWin cs = Win del N + where + del = defaultDelayed + cs + (creaLoopAnimation + [(2, cell '+' # color Red Vivid), + (2, cell '*' # color Yellow Vivid), + (2, cell '+' # color Green Vivid), + (2, cell '*' # color Blue Vivid)]) + 30 + +newtype Save = Save { _saveStationary :: Stationary } + deriving (Eq, Show) +makeLenses ''Save +instance HasStationary Save where stationary = saveStationary +defaultSave :: Coords -> Save +defaultSave cs = Save sta + where + sta = defaultStationary cs + (creaStaticAnimation $ cell '@' # color Blue Vivid ) + +-- PLAYER -- + +data PAction = ANoAction | AJumpL | AJumpR | AJumpX | AClimb | ADescend | AGoW | AGoE + deriving (Eq, Show) + +data Player = Player { + _playerDelayed :: Delayed, + _action :: PAction, + -- AGI direction + _IsClimbing :: Bool, + _IsNew :: Bool, -- no moves yet: True + _AmSaving :: Bool, + + -- slow gimmick for orcolat + _AmSlow :: Bool + } + deriving (Eq, Show) +makeLenses ''Player +instance HasDelayed Player where delayed = playerDelayed +instance HasMoving Player where moving = playerDelayed . moving +instance HasStationary Player where + stationary = playerDelayed . movingStationary + +defaultPlayer :: Coords -> Player +defaultPlayer cs = Player + (defaultDelayed cs (creaStaticAnimation $ cell '@' # invert) 2) + -- ricorda di modificare anche a' in simpleMove + ANoAction + False True False + False + + +-------------- +-- SUM TYPE -- +-------------- + +-- If you add anything to this you must +-- 1) add the relevant data (see e.g. Bird) +-- 2) add a wrapper here (e.g. MBird) +-- 3) add the relevant parsing char to charMeeple +-- 4) then everything will be just fixing "non-exhaustive pattern matches" +-- (turn -WAll on for this) +-- 5) add collisions in Screen/Collision.hs collTable +data Meeple = MBird Bird + | MDead Message + | MDumb Dumb + | MKram Krampus + | MLock Lock + | MNettle Nettle + | MPlayer Player + | MSave Save + | MSmart Smart + | MSickle Sickle + | MStar Star + | MStone Stone + | MWin Win + | MWitch Witch + deriving (Eq, Show) + +-- sort is needed when drawing, player should always come on top +instance Ord Meeple where + compare (MPlayer _) _ = GT + compare _ (MPlayer _) = LT + compare _ _ = EQ + +data Message = PlusStar Coords -- String: Name of the Room + | NeutralStar Coords + | Won + | None + deriving (Eq, Show) + +-- parsing helper +charMeeple :: Char -> Coords -> Maybe Meeple +charMeeple '*' cs = Just . MStar $ defaultStar cs +charMeeple '+' cs = Just . MWin $ defaultWin cs +charMeeple 'd' cs = Just . MDumb $ defaultDumb cs W +charMeeple 'b' cs = Just . MDumb $ defaultDumb cs E +charMeeple 'f' cs = Just . MSmart $ defaultSmart cs W +charMeeple 'j' cs = Just . MSmart $ defaultSmart cs E +charMeeple 'v' cs = Just . MBird $ defaultBird cs +charMeeple 'o' cs = Just . MStone $ defaultStone cs +charMeeple 'k' cs = Just . MKram $ defaultKrampus cs E +charMeeple 'y' cs = Just . MKram $ defaultKrampus cs W +charMeeple '^' cs = Just . MSickle $ defaultSickle cs (2, 0) +charMeeple ',' cs = Just . MNettle $ defaultNettle cs +charMeeple '@' cs = Just . MSave $ defaultSave cs +charMeeple 'X' cs = Just . MWitch $ defaultWitch cs +charMeeple c cs | C.isDigit c = + Just . MLock $ defaultLock cs (read [c]) +charMeeple _ _ = Nothing + + +------------------------ +-- SUM TYPE INSTANCES -- +------------------------ + + +-- "id setter, no getter" lens +els :: forall a s. String -> Lens' a s +els t = lens (error t) const + +instance HasStationary Meeple where + stationary f (MDead x) = MDead <$> els "HasStationary on Dead" f x + stationary f (MBird b) = MBird <$> stationary f b + stationary f (MDumb d) = MDumb <$> stationary f d + stationary f (MKram k) = MKram <$> stationary f k + stationary f (MLock l) = MLock <$> stationary f l + stationary f (MNettle n) = MNettle <$> stationary f n + stationary f (MPlayer p) = MPlayer <$> stationary f p + stationary f (MSave s) = MSave <$> stationary f s + stationary f (MSickle s) = MSickle <$> stationary f s + stationary f (MSmart s) = MSmart <$> stationary f s + stationary f (MStar s) = MStar <$> stationary f s + stationary f (MStone s) = MStone <$> stationary f s + stationary f (MWin w) = MWin <$> stationary f w + stationary f (MWitch w) = MWitch <$> stationary f w + +instance HasMoving Meeple where + moving f (MDead x) = MDead <$> els "HasMoving on Dead" f x + moving f (MBird d) = MBird <$> moving f d + moving f (MDumb d) = MDumb <$> moving f d + moving f (MKram k) = MKram <$> moving f k + moving f (MLock l) = MLock <$> els "HasMoving on Lock" f l + moving f (MNettle n) = MNettle <$> els "HasMoving on Nettle" f n + moving f (MPlayer p) = MPlayer <$> moving f p + moving f (MSave s) = MSave <$> els "HasMoving on Save" f s + moving f (MSmart s) = MSmart <$> moving f s + moving f (MSickle s) = MSickle <$> moving f s + moving f (MStar s) = MStar <$> els "HasMoving on Star" f s + moving f (MStone s) = MStone <$> moving f s + moving f (MWin w) = MWin <$> moving f w + moving f (MWitch w) = MWitch <$> moving f w + +---------------- +-- CATEGORIES -- +---------------- + +data MCategory = Aether | Baddie | Bonus | Projectile | CPlayer | Static + deriving (Show, Eq) + +meepleCategory :: Meeple -> MCategory +meepleCategory (MDead _) = Aether +meepleCategory (MBird _) = Baddie +meepleCategory (MDumb _) = Baddie +meepleCategory (MKram _) = Baddie +meepleCategory (MLock _) = Static +meepleCategory (MNettle _) = Baddie +meepleCategory (MPlayer _) = CPlayer +meepleCategory (MSave _) = Bonus +meepleCategory (MSickle _) = Projectile +meepleCategory (MStar _) = Bonus +meepleCategory (MSmart _) = Baddie +meepleCategory (MStone _) = Projectile +meepleCategory (MWin _) = Bonus +meepleCategory (MWitch _) = Baddie + +class Meepeable a where + a2m :: a -> Meeple + +type Coo m = (HasStationary m, Meepeable m) + +instance Meepeable Dumb where + a2m = MDumb +instance Meepeable Krampus where + a2m = MKram +instance Meepeable Smart where + a2m = MSmart +instance Meepeable Meeple where + a2m = id diff --git a/src/Menu.hs b/src/Menu.hs new file mode 100644 --- /dev/null +++ b/src/Menu.hs @@ -0,0 +1,78 @@ +{-# Language TemplateHaskell #-} + +module Menu where + +import Art +import Story +import Input + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Data.List as L +import qualified NonEmptyZipper as Z + +data Menu = Menu { _stories :: Z.NonEmptyZipper Story, + _selected :: Maybe Story } + deriving (Eq, Show) +makeLenses ''Menu + +defaultMenu :: Menu +defaultMenu = Menu (Z.wrap defaultStory) Nothing + + +menuStories :: [Story] -> Menu +menuStories [] = error "No stories found in story folder!" +menuStories (s:ss) = Menu (s Z.|: ss) Nothing + + +----------- +-- LOGIC -- +----------- + +menuLogic :: Menu -> Input -> Menu +menuLogic m KUp = m & stories %~ Z.previousMod +menuLogic m KDown = m & stories %~ Z.nextMod +menuLogic m KRight = + let c = m ^. stories . to Z.current in + m & selected ?~ c + -- ?~ == .~ (Just ...) +menuLogic m _ = m + +---------- +-- DRAW -- +---------- + +drawMenu :: Menu -> Plane + +drawMenu m = menuArt & + (11, 6) % drawSelector 25 10 m + +-- selector -- + +drawSelector :: Width -> Height -> Menu -> Plane +drawSelector w h m = + blankPlane w h & + (1, 1) % textBox tbt w 3 & + (4, 2) % mergePlanes (blankPlane w (h-2)) + [((r, 1), p) | (r, p) <- zip [1..] ls] + where + tbt :: String + tbt = "W/S to select story,\nD to play, L leaves." + + iss :: [(Int, Story)] + iss = zip [0..] (m ^. stories . to Z.toList) + + ls :: [Plane] + ls = map (\(i,s) -> drawEntry w s (hi == i)) iss + + hi :: Int + hi = m ^. stories . to Z.getPosition + +type IsSelected = Bool +drawEntry :: Width -> Story -> IsSelected -> Plane +drawEntry w s sb | not sb = entry + | otherwise = entry # bold + where + entry = makeOpaque $ textBox (L.genericTake w $ s ^. name) w 1 + diff --git a/src/NonEmptyZipper.hs b/src/NonEmptyZipper.hs new file mode 100644 --- /dev/null +++ b/src/NonEmptyZipper.hs @@ -0,0 +1,45 @@ +-- todo [refactor] Un giorno risponderà... +-- https://gitlab.com/fresheyeball/non-empty-zipper/merge_requests/2 + +module NonEmptyZipper where + +type NonEmptyZipper a = (Int, [a]) + +-- ~pure +wrap :: a -> NonEmptyZipper a +wrap x = (0, [x]) + +-- Make a NonEmptyZipper from a focus item (which will be the head) +-- and ADDITIONAL options. +(|:) :: a -> [a] -> NonEmptyZipper a +x |: xs = (0, x:xs) + +-- Move the current element backward by one. If the current is the first +-- element in the list, we loop to the last element. +nextMod, previousMod :: NonEmptyZipper a -> NonEmptyZipper a +nextMod z = moveMod z 1 +previousMod z = moveMod z (-1) + +-- todo elimina quando ti accettano la patch [refactor] +-- https://gitlab.com/fresheyeball/non-empty-zipper/issues +current :: NonEmptyZipper a -> a +current (i, xs) = xs !! i + +toList :: NonEmptyZipper a -> [a] +toList (_, xs) = xs + +getPosition :: NonEmptyZipper a -> Int +getPosition (i, _) = i + + +-- ANCILLARIES -- + +moveMod :: NonEmptyZipper a -> Int -> NonEmptyZipper a +moveMod (i, xs) m = + let i' = i + m + -- fixme [refactor] non valido per tutti i wrap! + ib | i' < 0 = length xs - 1 + | i' >= length xs = 0 + | otherwise = i' + in (ib, xs) + diff --git a/src/Parse.hs b/src/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Parse.hs @@ -0,0 +1,265 @@ +{-# Language LambdaCase #-} + +module Parse where + +import Tile +import Room +import Story +import Plant +import Meeple.Operate +import Input + +import Terminal.Game +import Text.Megaparsec hiding (State) +import Text.Megaparsec.Char +import Lens.Micro.Platform + +import qualified Codec.Binary.UTF8.Light as U8 +import qualified Control.Monad.State as S +import qualified Data.Void as V +import qualified Data.List.NonEmpty as LN +import qualified Data.Set as DS + +-- proparse: we are in between ®® +type PropParse = Bool +data ParseState = ParseState { psCoords :: Coords, + psProp :: PropParse } + deriving (Eq, Show) + +-- coords: for map parsing +type Parser a = ParsecT V.Void String (S.State ParseState) a + + +--------------- +-- INTERFACE -- +--------------- + +readStory :: FilePath -> IO Story +readStory fp = + parseRun fp pstory <$> U8.readUTF8File fp + +-- run parse and crash on error +parseRun :: FilePath -> Parser a -> String -> a +parseRun fp p t = + let eps = runParserT p fp t + ep = fst $ S.runState eps pstate + a = either (error . (errProl ++) . errorBundlePretty) id ep + in a + where + pstate = ParseState (1, 1) False + + errProl = unlines + ["", + "", + "Error in parsing Story file!", + "Read what's written below; if the error is unclear or you", + "found a bug, contact me at .", + ""] + + +----------- +-- STORY -- +----------- + +pstory :: Parser Story +pstory = option () noncode *> st + "Story file" + where + ps = proom <* (noncode <|> eof) + "room (and maybe noncode)" + st = buildStory <$> pstoryname + <*> (proomsize <* eol) + <*> pstartroom + <* noncode + <*> some ps + <* eof + "Story body" + +pstoryname :: Parser String +pstoryname = string "story_name:" *> space1 *> someTill anySingle eol + "story_name instruction" + +proomsize :: Parser Coords +proomsize = string "room_size:" >> + space1 >> num >>= \r -> + space1 >> num >>= \c -> + return (r, c) + "room_size instruction" + where + num :: Parser Integer + num = read <$> some digitChar + +pstartroom :: Parser String +pstartroom = string "start_room:" *> space1 *> someTill anySingle eol + "start_room instruction" + + +pcomment :: Parser () +pcomment = string "@@" *> + manyTill anySingle (() <$ eol <|> eof) *> + pure () + "Comment" + +-- a number of comments/whitespace +noncode :: Parser () +noncode = () <$ some (space1 <|> pcomment) + "Whitespace or Comment" + + + +---------- +-- ROOM -- +---------- + +proom :: Parser Room +proom = ptitle >>= \t -> + S.lift (S.put initState) >> + pelements >>= \es -> + let r = elemsRoom es in + some pexit >>= \xs -> + return (r & title .~ t + & exits .~ xs) + "Room" + where + initState = ParseState (1, 1) False + +-- title +ptitle :: Parser String +ptitle = char '#' *> space1 *> someTill anySingle eol + "Room title" + +pelements :: Parser [RoomElem] +pelements = some pelem + "Room ASCII elements" + + +----------- +-- PLANT -- +----------- + +-- fill architecture/player/baddies +elemsRoom :: [RoomElem] -> Room +elemsRoom ces = foldr elemRoom defaultRoom ces + +elemRoom :: RoomElem -> Room -> Room +elemRoom Blank r = r +elemRoom (ETile t cs) r = r & plant %~ addTile cs t +elemRoom (EMeeple m) r = addMeeple m r + + +----------- +-- EXITS -- +----------- + +pexit :: Parser Exit +pexit = string ">>>" *> space1 >> + pcard <* space1 >>= \c -> + string "->" *> space1 >> + someTill anySingle fin >>= \t -> + return (Exit c t) + "Room exit (>>>)" + where + fin = () <$ eol <|> eof + +pcard :: Parser Cardinal +pcard = choice [N <$ char' 'N', + S <$ char' 'S', + E <$ char' 'E', + W <$ char' 'W'] + "Cardinal direction (NWSE)" + + +-------------- +-- ELEMENTS -- +-------------- + +data RoomElem = ETile Tile Coords + | EMeeple Meeple + | Blank + deriving (Show, Eq) + +-- to be invoked after succesfull parsing of a char +pcoords :: Parser Coords +pcoords = S.lift (S.gets psCoords) >>= \cs -> + return cs + "ASCII Room coordinates" + +pelem :: Parser RoomElem +pelem = choice [try epropmode, try pprop, + try etile, try emeeple, + try eNewLine, espace] + "Room ASCII element (simple)" + +eNewLine :: Parser RoomElem +eNewLine = eol >> + advance ARow >> + return Blank + "enew line" + +espace :: Parser RoomElem +espace = Blank <$ char ' ' <* advance ACol + "space (none) element" + +epropmode :: Parser RoomElem +epropmode = Blank <$ char '®' <* + (toggleprop <* advance ACol) + "text-mode marker" + +emeeple :: Parser RoomElem +emeeple = EMeeple <$> pmeeple <* advance ACol + "meeple (creature)" + +etile :: Parser RoomElem +etile = ETile <$> ltile <*> pcoords <* advance ACol + "Tile element" + +pprop :: Parser RoomElem +pprop = anySingle >>= \c -> + S.lift (S.gets psProp) >>= \case + True -> ETile (creaProp c) <$> pcoords <* advance ACol + False -> expected [c] "prop element (we're not in prop mode)" + "Prop (background) char" + +toggleprop :: Parser () +toggleprop = let tog (ParseState c p) = ParseState c (not p) in + S.lift (S.modify tog) + "Toggle Prop character (after ®)" + + +------------------- +-- TILES/MEEPLES -- +------------------- + +ltile :: Parser Tile +ltile = anySingle >>= \c -> + case charTile c of + Just t -> return t + Nothing -> expected [c] "tile" + "Single tile" + +pmeeple :: Parser Meeple +pmeeple = anySingle >>= \c -> + pcoords >>= \cs -> + case charMeeple c cs of + Just m -> return m + Nothing -> expected [c] "meeple" + "Meeple" + +-- wrong element / expected one +expected :: String -> String -> Parser a +expected cs t = failure (Just . Tokens $ LN.fromList cs) + (DS.fromList [Label $ LN.fromList t]) + "expected error" + + +----------------- +-- ANCILLARIES -- +----------------- + +data Adv = ARow | ACol +advance :: Adv -> Parser () +advance ARow = S.lift . S.modify $ + \(ParseState (r, _) b) -> ParseState (r+1, 1) b +advance ACol = S.lift . S.modify $ + \(ParseState (r, c) b) -> ParseState (r, c+1) b + diff --git a/src/Paths.hs b/src/Paths.hs new file mode 100644 --- /dev/null +++ b/src/Paths.hs @@ -0,0 +1,47 @@ +{-# Language LambdaCase #-} + +module Paths where + +import qualified Control.Monad as CM +import qualified Data.List as L +import qualified System.Directory as D +import qualified System.Environment as E +import qualified System.FilePath as F +import qualified Paths_venzone as PS + +import Story +import Parse + +storyExt :: FilePath +storyExt = "vns" + +-- tries to find data in 3 folders +findStoriesFolder :: IO FilePath +findStoriesFolder = + -- local stories folder + let lf = "." in + -- where-exe-is one + F.dropFileName <$> E.getExecutablePath >>= \ef -> + -- data-folder + PS.getDataFileName "" >>= \tf -> + + let sfs = map (F. "stories") [lf, ef, tf] in + CM.filterM D.doesDirectoryExist sfs >>= \case + (d:_) -> return d + [] -> error $ "Could not find story folder! Tried:" ++ + show sfs + +findStories :: IO [Story] +findStories = -- get files + findStoriesFolder >>= \sd -> + D.listDirectory sd >>= \fs -> + let fs' = L.sort fs + sfs = filter (F.isExtensionOf storyExt) fs' + sffs = map (sd F.) sfs + in + mapM readStory sffs + +-- single story (watch mode) +findSingleStory :: FilePath -> IO Story +findSingleStory fp = readStory fp + diff --git a/src/Plant.hs b/src/Plant.hs new file mode 100644 --- /dev/null +++ b/src/Plant.hs @@ -0,0 +1,69 @@ +module Plant where + +import Input +import Tile + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Data.Map as M +import qualified Data.Tuple as T + +-- Everything non-modifiable (reader-ish) about a Screen. + +-- Room structure +newtype Plant = Plant (M.Map Coords Tile) + deriving (Eq, Show) + +defaultPlant :: Plant +defaultPlant = Plant M.empty + + +--------------- +-- FUNCTIONS -- +--------------- + +plantBoundaries :: Plant -> Coords +plantBoundaries (Plant p) = (maximum rl, maximum cl) + where + (rl, cl) = unzip (M.keys p) + +plantList :: Plant -> [(Coords, Tile)] +plantList (Plant p) = M.toList p + +addTile :: Coords -> Tile -> Plant -> Plant +addTile cs t (Plant p) = Plant $ M.insert cs t p + +getTile :: Plant -> Coords -> Maybe Tile +getTile (Plant p) cs = M.lookup cs p + +tickPlant :: Plant -> Plant +tickPlant (Plant p) = Plant $ p & each %~ tickTile + +-- gluePlants is used to generate a "bigger map" (map + neighbours) when +-- we perform, e.g., solid checks. Coords: size +gluePlants :: Coords -> Plant -> [(Cardinal, Plant)] -> Plant +gluePlants (rp, cp) (Plant p) cps = Plant $ M.unions (p : map f cps) + where + f :: (Cardinal, Plant) -> M.Map Coords Tile + f (d, Plant wp) = M.mapKeys (u d) wp + + u :: Cardinal -> Coords -> Coords + u N (r, c) = (r - rp, c ) + u S (r, c) = (r + rp, c ) + u W (r, c) = (r , c - cp) + u E (r, c) = (r , c + cp) + + +---------- +-- DRAW -- +---------- + +drawPlant :: Plant -> Plane +drawPlant p = mergePlanes (blankPlane mw mh) planeCoordPlant + where + (mw, mh) = T.swap . plantBoundaries $ p + + planeCoordPlant :: [(Coords, Plane)] + planeCoordPlant = plantList p & each . _2 %~ tilePlane + diff --git a/src/Room.hs b/src/Room.hs new file mode 100644 --- /dev/null +++ b/src/Room.hs @@ -0,0 +1,80 @@ +{-# Language TemplateHaskell #-} + +module Room where + +import Plant +import Meeple.Operate +import Input + +import Terminal.Game +import Lens.Micro.Platform + +import Data.List as L + + +-- Everything non-modifiable (reader-ish) about a Screen. + +---------- +-- DATA -- +---------- + +data Exit = Exit { eCardinal :: Cardinal, + eTitle :: Title } + deriving (Eq, Show) + +-- Room structure +type Title = String +data Room = Room { _title :: Title, + _plant :: Plant, + _frozenMeeples :: [Meeple], + -- initial chars positions + _exits :: [Exit] } + deriving (Eq, Show) +makeLenses ''Room + +defaultRoom :: Room +defaultRoom = Room "" defaultPlant [] [] + +addMeeple :: Meeple -> Room -> Room +addMeeple m r = r & frozenMeeples %~ (m:) + +--------------- +-- FUNCTIONS -- +--------------- + +cardinalTitle :: Room -> Cardinal -> Maybe Title +cardinalTitle r c = + r ^? exits . each . filtered ((==c) . eCardinal) . to eTitle + +-- use this instead of plantBoundaries, as it will fail with useful +-- info. +boundaries :: Room -> Coords +boundaries r + | null rl || + null cl = error $ "boundaries, empty plant in room " ++ + show (r ^. title) + | otherwise = (maximum rl, maximum cl) + where + p = r ^. plant + (rl, cl) = unzip (map fst $ plantList p) + +isOOBRoom :: Room -> Coords -> Bool +isOOBRoom ro (r, c) = let (rr, rc) = boundaries ro + in r < 1 || r > rr || + c < 1 || c > rc + +findSpawn :: Room -> Maybe Coords +findSpawn r = (^. position) <$> L.find isSpawn (r ^. frozenMeeples) + where + -- isQualcosa possono essere generalizzatr + isSpawn (MSave _) = True + isSpawn _ = False + + +---------- +-- DRAW -- +---------- + +drawRoom :: Room -> Plane +drawRoom r = r ^. plant . to drawPlant + diff --git a/src/Screen.hs b/src/Screen.hs new file mode 100644 --- /dev/null +++ b/src/Screen.hs @@ -0,0 +1,141 @@ +{-# Language ScopedTypeVariables #-} + +module Screen ( module Screen, + module Screen.Primitives, + module Screen.ProcessKeys, + module Screen.Check + ) + where + +import Input +import Meeple.Operate +import Room +import Plant +import Screen.Check +import Screen.Decide +import Screen.Move +import Screen.Primitives +import Screen.ProcessKeys + +import Lens.Micro.Platform +import Terminal.Game + +import qualified Data.List as L + + +----------- +-- LOGIC -- +----------- + +screenLogic :: (Show s, HasScreen s) => Input -> s -> s +screenLogic k s + -- key processing + | isMovKey k = s & player %~ fmap (processMovKeys k s) + | isMenuKey k = playerDie s + -- logic + | otherwise = + L.foldl' (flip ($)) s + [ -- I decide where to move + mappedScreen cogitate, + + -- II actually move (and collision) + moveCollideGeneral, + + -- III spawn phase (for projectile-launching + -- enemies + spawnProjectiles, + + -- IV clean-up (reset + mark deads) + cleanUp + ] + where + mappedScreen :: HasScreen s => (s -> Meeple -> Meeple) -> s -> s + mappedScreen f sw = sw & meeples . each %~ f sw + +cleanUp :: HasScreen s => s -> s +cleanUp s = s & room . plant %~ tickPlant + & meeples . each %~ (resetClimb s . + (\m -> m & draw %~ tick) . + oobDead . + uselessLock . + oldMPlayer) + where + oobDead :: Meeple -> Meeple + oobDead m@(MDead _) = m + oobDead m = + let (tr, tc) = s ^. room . to boundaries + (mr, mc) = m ^. position + in + if mr < -5 || mc < -10 || + mr > (tr + 5) || mc > (tc + 5) + then MDead None + else m + + uselessLock :: Meeple -> Meeple + uselessLock m@(MLock l) + | l ^. currNumeral <= 0 && + l ^. draw . to isExpired = MDead None + | otherwise = m + uselessLock m = m + + oldMPlayer :: Meeple -> Meeple + oldMPlayer (MPlayer p) = MPlayer $ oldPlayer p + oldMPlayer m = m + +resetClimb :: HasScreen s => s -> Meeple -> Meeple +resetClimb _ m@(MDead _) = m +resetClimb s m | amOutOfBounds s m = m + | not (canClimb s m) = noClimb m + | otherwise = m + where + noClimb (MPlayer p) = MPlayer $ p & isClimbing .~ False + noClimb mw = mw + +spawnProjectiles :: HasScreen s => s -> s +spawnProjectiles s = + let s' = s & meeples . each %~ genProj + sp :: [Meeple] + sp = concat $ s ^.. meeples . each . to fetchProj . _Just + in s' & meeples %~ (++ sp) + where + fetchProj :: Meeple -> Maybe [Meeple] + fetchProj (MBird b) = creaRef <$> b ^. ready + fetchProj (MKram k) = creaRef <$> k ^. ready + fetchProj MDead {} = Nothing + fetchProj MDumb {} = Nothing + fetchProj MLock {} = Nothing + fetchProj MNettle {} = Nothing + fetchProj MPlayer {} = Nothing + fetchProj MSave {} = Nothing + fetchProj MSmart {} = Nothing + fetchProj MSickle {} = Nothing + fetchProj MStar {} = Nothing + fetchProj MStone {} = Nothing + fetchProj MWin {} = Nothing + fetchProj MWitch {} = Nothing + + +---------- +-- DRAW -- +---------- + +drawScreen :: HasScreen s => s -> Plane +drawScreen s = blankPlane 80 24 & + (r, c) % mergePlanes (drawRoom (s ^. room)) pcs + where + (r, c) = let (aw, ah) = planeSize actionPlane + in (div (24-ah) 2 + 1, + div (80-aw) 2 + 1) + + actionPlane = mergePlanes (drawRoom (s ^. room)) pcs + + meepOrd :: [Meeple] + meepOrd = let ms = (s ^.. meeples . each . filtered (not . isDead)) + in L.sort ms + + pcs :: [(Coords, Plane)] + pcs = map f meepOrd + + f :: Meeple -> (Coords, Plane) + f m = (m ^. position, m ^. draw . to fetchFrame) + diff --git a/src/Screen/Check.hs b/src/Screen/Check.hs new file mode 100644 --- /dev/null +++ b/src/Screen/Check.hs @@ -0,0 +1,165 @@ + +module Screen.Check where + +import Meeple.Operate +import Screen.Primitives +import Plant +import Room +import Tile + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Data.Maybe as M + + +-- Checks are generally polymorphic on every creature (player, baddies, +-- stars, etc.). + + +------------ +-- PLAYER -- +------------ + +-- convenience, player specific -- + +playerDead :: HasScreen s => s -> Bool +playerDead s = M.isNothing (s ^. player) + +playerTile :: HasScreen s => s -> (TileType -> Bool) -> Bool +playerTile s bf = maybe False (\m -> meepleTile s m bf) (s ^. mplayer) + + +------------ +-- MEEPLE -- +------------ + +-- tile under the player bool check +meepleTile :: HasScreen s => s -> Meeple -> (TileType -> Bool) -> Bool +meepleTile s m bf = checkCoords s (m ^. position) bf + +-- am -- + +amGrounded :: (HasScreen s, Meepeable m, HasStationary m) => s -> m -> Bool +amGrounded s m = checkGround s m (m ^. position . to (_1 +~ 1)) + +amOutOfBounds :: HasScreen s => s -> Meeple -> Bool +amOutOfBounds s m = + let (pr, pc) = m ^. position + (rr, rc) = s ^. room . to boundaries + in pr > rr || pc > rc || + pr < 1 || pc < 1 + +-- can -- + +canClimb :: HasScreen s => s -> Meeple -> Bool +canClimb s m = meepleTile s m (== Ladder) && notSlow m + where + notSlow (MPlayer p) = p ^. amSlow . to not + notSlow _ = True + +canDescend :: HasScreen s => s -> Meeple -> Bool +canDescend s m = checkCoords s (m ^. position & _1 +~ 1) (==Ladder) + +-- can I move (1x1 move there? Diagonally, only if there passage is +-- not narrow (so if we want to go to 1,1 from 0,0, only if 1,0 or 0,1 +-- are not blocked and 1,1 is not blocked too). +canGoThere :: (HasScreen s, Meepeable m, HasStationary m) => s -> m -> Coords -> Bool +canGoThere s m c@(x, y) + | meepleCategory (a2m m) == Projectile = True + | otherwise = close && free && wide + where + -- relative position + (rx, ry) = let (mx, my) = m ^. position + in (mx - x, my - y) + + close = abs rx <= 1 && abs ry <= 1 + free = not (checkGround s m c) && + not (checkSimilar s m c) + + wide = not diag || open + open = not (checkSolid s (c & _1 +~ rx)) || + not (checkSolid s (c & _2 +~ ry)) + diag = rx /= 0 || ry /= 0 + +-- exists -- + +isPlayerDead :: HasScreen s => s -> Bool +isPlayerDead s = s ^. meeples . to (any isP) . to not + where + isP (MPlayer _) = True + isP _ = False + + +------------------ +-- COORDS BASED -- +------------------ + +-- bool: if tile does not exist +checkCoords :: HasScreen s => s -> Coords -> (TileType -> Bool) -> Bool +checkCoords s cs bf = maybe False (bf . tType) t + where + t :: Maybe Tile + t = getTile (s ^. neighbourPlant) cs + +-- specific -- + +checkBaddie :: HasScreen s => s -> Coords -> Bool +checkBaddie s cs = checkCoordsMeeple s cs (not . isPlayer) + +checkSolid :: HasScreen s => s -> Coords -> Bool +checkSolid s cs = checkCoords s cs isSolid || + checkLock s cs + +-- checks for solid or meeples I prefer to avoid (same as me) +checkSolidMeeps :: (HasScreen s, Meepeable m) => s -> m -> Coords -> Bool +checkSolidMeeps s m cs = checkSolid s cs || + (checkBaddie s cs && + checkSimilar s m cs) + + +----------------- +-- ANCILLARIES -- +----------------- + +checkLock :: HasScreen s => s -> Coords -> Bool +checkLock s cs = checkCoordsMeeple s cs isLock + where + isLock MLock {} = True + isLock _ = False + +-- or solid, or ground *below* meeple level +checkGround :: (HasScreen s, Coo m) => s -> m -> Coords -> Bool +checkGround s m cs = checkSolid s cs || groundBelow cs + where + groundBelow :: Coords -> Bool + groundBelow (r, c) = + let (pr, _) = m ^. position + in + -- ground + ground cs && + -- below + r > pr && + + -- is not rope and we're climbing + (not (isMeepClim (a2m m)) && + checkCoords s (r, c) (==Ladder)) + + isMeepClim (MPlayer p) = p ^. isClimbing + isMeepClim _ = False + + ground :: Coords -> Bool + ground wcs = checkCoords s wcs isGround || + checkLock s wcs + +-- meeples of the same class in there? +checkSimilar :: (HasScreen s, Meepeable m) => s -> m -> Coords -> Bool +checkSimilar s m c = checkCoordsMeeple s c (isSimilar (a2m m)) + +-- check wheter meeple at coords has certain properties +checkCoordsMeeple :: HasScreen s => s -> Coords -> (Meeple -> Bool) -> Bool +checkCoordsMeeple s c bf = + let ms = s ^.. meeples . each . + filtered bf + ps = map (view position) ms + in elem c ps diff --git a/src/Screen/Collision.hs b/src/Screen/Collision.hs new file mode 100644 --- /dev/null +++ b/src/Screen/Collision.hs @@ -0,0 +1,172 @@ +module Screen.Collision where + +import Meeple.Operate +import Screen.Check +import Screen.Primitives +import Tile + +import Lens.Micro.Platform +import Terminal.Game + +import qualified Data.Ix as I +import qualified Data.List as L +import qualified Data.Tuple as T + + +-- Index of the meeple in [Meeples] +type Index = Int + +----------------------- +-- MEEPLE COLLISIONS -- +----------------------- + +-- single you-on-everything collision +meepleCollision :: Index -> [Meeple] -> [Meeple] +meepleCollision i ms = + let + ei = length ms - 1 + pp = [(i, j) | j <- [0..ei], j /= i] -- all possible pairs + ppf = filter (areColliding ms) pp -- only overlapping + in + L.foldl' collideMod ms ppf + +-- Takes the position of two meeples and a list of meeples, +-- Sees if something has to happen, if so it can mark one or both the +-- indices ad 'Dead', or add to the list, but never shrink it or modify +-- it otherwise +collideMod :: [Meeple] -> (Index, Index) -> [Meeple] +collideMod ms (ia, ib) = ms & ix ia .~ na + & ix ib .~ nb + where + (na, nb) = collTable False (ms !! ia) (ms !! ib) + + +--------------------- +-- COLLISION TABLE -- +--------------------- + +type SecondRound = Bool +collTable :: Bool -> Meeple -> Meeple -> (Meeple, Meeple) + +-- PLAYER -- +collTable _ (MPlayer p) (MStar s) = + (MPlayer p, MDead $ PlusStar (s ^. position)) +collTable _ (MPlayer p) (MWin _) = + (MPlayer p, MDead Won) +collTable _ (MPlayer _) m@(MDumb _) = + (MDead None, m) +collTable _ (MPlayer _) m@(MSmart _) = + (MDead None, m) +collTable _ (MPlayer _) m@(MBird _) = + (MDead None, m) +collTable _ (MPlayer _) m@(MStone _) = + (MDead None, m) +collTable _ (MPlayer _) m@(MKram _) = + (MDead None, m) +collTable _ (MPlayer _) m@(MSickle _) = + (MDead None, m) +collTable _ p@(MPlayer _) m@(MNettle n) + | isStingy n = (MDead None, m) + | otherwise = (p, m) +collTable _ p@(MPlayer v) m@(MSave s) + | v ^. isNew = (p, m) + | otherwise = (MPlayer $ v & amSaving .~ True, + MSave $ touchSave s) +collTable _ (MPlayer _) m@(MWitch _) = + (MDead None, m) + +-- DUMB -- +collTable _ d@(MDumb _) (MStar _) = + (d, MDead $ NeutralStar (d ^. position)) +collTable _ (MDumb _) (MStone _) = + (MDead None, MDead None) +collTable _ (MDumb _) (MSickle _) = + (MDead None, MDead None) + +-- SMART -- +collTable _ s@(MSmart _) (MStar _) = + (s, MDead $ NeutralStar (s ^. position)) +collTable _ (MSmart _) (MStone _) = + (MDead None, MDead None) +collTable _ (MSmart _) (MSickle _) = + (MDead None, MDead None) + +-- BIRD -- +collTable _ b@(MBird _) (MStar _) = + (b, MDead $ NeutralStar (b ^. position)) +collTable _ (MBird _) (MSickle _) = + (MDead None, MDead None) + +-- KRAMPUS -- +collTable _ k@(MKram _) (MStar _) = + (k, MDead $ NeutralStar (k ^. position)) + + +-- REPEAT? -- +collTable False a b = T.swap $ collTable True b a -- inverted! +collTable True a b = (a, b) -- no effect + + +--------------------- +-- ROOM COLLISIONS -- +--------------------- + +roomCollision :: HasScreen s => s -> Meeple -> Meeple +roomCollision _ m@(MDead _) = m +roomCollision s m = generalCollide s m + +generalCollide :: HasScreen s => s -> Meeple -> Meeple +generalCollide _ m@(MDead _) = m +generalCollide s m@(MStone _) + | checkSolid s (m ^. position) = MDead None +generalCollide s m + | meepleTile s m (==Water) = MDead None + | meepleTile s m (==Spike) = MDead None + | meepleTile s m (==Slow) = slowDown m +generalCollide _ m = m + +slowDown :: Meeple -> Meeple +slowDown (MPlayer p) = MPlayer $ p & amSlow .~ True +slowDown m = m + +----------------- +-- ANCILLARIES -- +----------------- + +-- are two meeples in a collection (by index) colliding? +areColliding :: [Meeple] -> (Int, Int) -> Bool +areColliding ms (ia, ib) | isDead a || + isDead b = False + -- dead stuff can't collide + | pa == pb = True + | isDiagonal && + elem pb pas = True + | otherwise = False + where + a, b :: Meeple + a = ms ^?! ix ia + b = ms ^?! ix ib + + pa, pb :: Coords + pa = a ^. position + pb = b ^. position + + -- diagonal collision -- + + + isDiagonal :: Bool + isDiagonal = let (px, py) = safePrevPos a + (cx, cy) = pa + in px /= cx && py /= cy + + pas :: [Coords] + pas = diagonalArea pa (safePrevPos a) + +-- rectangle between two points +diagonalArea :: Coords -> Coords -> [Coords] +diagonalArea (ra, ca) (rb, cb) = + let p1 = (min ra rb, min ca cb) + p2 = (max ra rb, max ca cb) + in I.range (p1, p2) + + diff --git a/src/Screen/Decide.hs b/src/Screen/Decide.hs new file mode 100644 --- /dev/null +++ b/src/Screen/Decide.hs @@ -0,0 +1,210 @@ +{-# Language FlexibleContexts #-} +{-# Language RankNTypes #-} + +-- decide where to move kaj ktp + +module Screen.Decide where + +import Terminal.Game +import Lens.Micro.Platform + +import Input +import Meeple.Operate +import Screen.Check +import Screen.Primitives + +import qualified Line.Draw as D + + +-- cogitate = the part of r/c speed inluenced by the player (i.e. not +-- gravity). +cogitate :: HasScreen s => s -> Meeple -> Meeple +cogitate _ m@(MDead _) = m +cogitate s (MBird b) = periodicMove s b MBird decideMoveBird stopAll +cogitate s (MDumb d) = periodicMove s d MDumb decideMoveDumbWalker stopH +cogitate s (MKram k) = periodicMove s k MKram decideMoveSmartWalker stopH +cogitate _ m@(MLock _) = m +cogitate _ m@(MNettle _) = m +cogitate s (MPlayer p) = dmp s p +cogitate _ m@(MSave _) = m +cogitate s (MSmart m) = periodicMove s m MSmart decideMoveSmartWalker stopH +cogitate _ m@(MStar _) = m +cogitate _ m@(MStone _) = m +cogitate _ m@(MSickle _) = m +cogitate s (MWin w) = periodicMove s w MWin decideMoveWin stopV +cogitate s (MWitch w) = periodicMove s w MWitch decideMoveWitch stopAll + +periodicMove :: forall s a. (HasScreen s, + HasDelayed a, + HasMoving a) => + s -> a -> -- input + (a -> Meeple) -> -- constructor + (s -> a -> a) -> -- decide mov function + (s -> a -> a) -> -- wait function + Meeple +periodicMove s a mc fmov wmov = + let t = a ^. delay in + if fetchFrame t + then mc $ fmov s a & delay %~ tick + else mc $ wmov s a & delay %~ tick + & speed . _2 .~ 0 + +--------------- +-- MOVEMENTS -- +--------------- + +dmp :: HasScreen s => s -> Player -> Meeple +dmp s p | p ^. amSlow = periodicMove s p MPlayer decideMovePlayer stopH + | otherwise = MPlayer $ decideMovePlayer s p + +-- non delayed +decideMovePlayer :: HasScreen s => s -> Player -> Player +decideMovePlayer _ p = p & nuSpeed + where + mc = p ^. action + nuSpeed = case mc of + AJumpL -> jumpMod AGoW + AJumpR -> jumpMod AGoE + AJumpX -> jumpMod ANoAction + AClimb -> \lp -> lp & speed . _1 .~ (-1) + & speed . _2 .~ 0 + ADescend -> \lp -> lp & speed . _1 .~ 1 + & speed . _2 .~ 0 + AGoW -> speed . _2 .~ (-1) + AGoE -> speed . _2 .~ 1 + ANoAction -> id + + -- what action after jumping? follow horizontal speed + jumpMod na wp = + wp & speed . _1 .~ (-3) + & action .~ na + + +decideMoveBird :: HasScreen s => s -> Bird -> Bird +decideMoveBird _ b = + -- move randomly + let (vs, b') = casualRandom (-1,1) b + (hs, b'') = casualRandom (-1,1) b' + (r, c) = b ^. position in + + -- don't go too far away from where you spawned + if ellOut (r+vs, c+hs) + then b'' & speed .~ (0, 0) + -- do not move, pop the seed + else b'' & speed . _1 .~ vs + & speed . _2 .~ hs + where + dist :: Coords -> Coords -> Int + dist pa pb = length (D.bresenham pa pb) - 1 + + -- I am outside an ellipse? + ellOut :: Coords -> Bool + ellOut cs = + let -- focals + cc = b ^. spawnpoint + md = 10 + f1 = cc & _1 %~ subtract md + f2 = cc & _1 %~ (+md) + + in dist cs f1 + dist cs f2 > 20 + +decideMoveWitch :: HasScreen s => s -> Witch -> Witch +decideMoveWitch s w = + let -- possible random move + (vsr, w') = casualRandom (-1,1) w + (hsr, w'') = casualRandom (-1,1) w' in + case s ^. player of + Nothing -> w & speed .~ (vsr, hsr) + (Just p) -> + + let -- possible towards player move + (pr, pc) = p ^. position + (wr, wc) = w ^. position + vsp = signum (pr - wr) + hsp = signum (pc - wc) + + sn :: Integer + (sn, w''') = casualRandom (1, 10) w'' + in + + if sn > 7 then w''' & speed .~ (vsr, hsr) + else w''' & speed .~ (vsp, hsp) + + + + +decideMoveDumbWalker :: (HasScreen s, Meepeable m, HasWalker m, HasMoving m, HasStationary m) => s -> m -> m +decideMoveDumbWalker s b = + let b' = updateDumbWalker s b + nhs = b' ^. cardinal . to projhs + in b' & speed . _2 .~ nhs + +decideMoveSmartWalker :: (HasScreen s, Meepeable m, HasWalker m, HasMoving m, HasStationary m) => s -> m -> m +decideMoveSmartWalker s m = + let m' = updateSmartWalker s m + nhs = m' ^. cardinal . to projhs + in m' & speed . _2 .~ nhs + +decideMoveWin :: HasScreen s => s -> Win -> Win +decideMoveWin _ w = + let nvs = w ^. floatino . to projvs + in w & speed . _1 .~ nvs + & floatino %~ turnAround + +-- decide = update state / update speed (auto) +-- update its state +updateDumbWalker :: (HasScreen s, Meepeable m, HasWalker m, HasStationary m) => s -> m -> m +updateDumbWalker s m = + let hs = m ^. cardinal . to projhs + ucs = m ^. position & _2 +~ hs + -- projected state + in + + if checkSolidMeeps s m ucs + then m & cardinal %~ turnAround + else m + +-- all smart (don't fallon ledges) walkers +updateSmartWalker :: (HasScreen s, Meepeable m, HasWalker m, HasStationary m) => s -> m -> m +updateSmartWalker s m = + if checkSolidMeeps s m ucs || + not stepVoid + then m & cardinal %~ turnAround + else m + where + hs = m ^. cardinal . to projhs + ucs = m ^. position & _2 +~ hs + + stepVoid :: Bool + stepVoid = checkGround s m (ucs & _1 +~ 1) + + +----------------- +-- ANCILLARIES -- +----------------- + +-- meeples don't move as fast as player, usually the move once per couple +-- of frames. What do we do when it's not our turn to move? Allow some stuff +-- (gravity, etc.) but not our "sentient" movement. +stopV :: (HasScreen s, HasMoving a) => s -> a -> a +stopV _ m = m & speed . _1 .~ 0 + +stopH :: (HasScreen s, HasMoving a) => s -> a -> a +stopH _ m = m & speed . _2 .~ 0 + +stopAll :: (HasScreen s, HasMoving a) => s -> a -> a +stopAll _ m = m & speed .~ (0, 0) + + +-- projected horizontal speed +projhs :: Cardinal -> Integer +projhs E = 1 +projhs W = -1 +projhs _ = error "Cardinal not valid hs" + +-- projected horizontal speed +projvs :: Cardinal -> Integer +projvs S = 1 +projvs N = -1 +projvs _ = error "Cardinal not valid vs" + diff --git a/src/Screen/Move.hs b/src/Screen/Move.hs new file mode 100644 --- /dev/null +++ b/src/Screen/Move.hs @@ -0,0 +1,195 @@ +{-# Language FlexibleContexts #-} + +module Screen.Move where + +import Terminal.Game +import Lens.Micro.Platform + +import Meeple.Operate +import Room +import Screen.Check +import Screen.Collision +import Screen.Primitives + +import qualified Data.List as L + + +-- moves, check for room and meeples collision <= one by one +moveCollideGeneral :: HasScreen s => s -> s +moveCollideGeneral s = + let -- motion (non step) action + s' = s & meeples . each %~ applyGravity (s ^. room) + & meeples . each %~ limitSpeed + -- steps + s'' = exhaustSteps (generateAllSteps s') + -- dead cleaning will be done in story, + -- since messages are collected there + in s'' + where + -- step actions + exhaustSteps :: HasScreen s => s -> s + exhaustSteps sw = + if any hasSteps (sw ^. meeples) + then exhaustSteps (oneStep sw) + else sw + + oneStep :: HasScreen s => s -> s + oneStep sw = let ms = sw ^. meeples + ei = length ms - 1 + in + L.foldl' stepCollide sw [0..ei] + + +------------ +-- MOTION -- +------------ + +-- *non* stepped stuff + +gravity :: Integer +gravity = 1 + +-- room:: jus for oob check +-- todo [refactor] refactor +applyGravity :: Room -> Meeple -> Meeple +applyGravity _ m@(MDead _) = m +applyGravity _ m@(MBird _) = m +applyGravity _ m@(MDumb _) = m & speed . _1 +~ gravity +applyGravity _ m@(MKram _) = m & speed . _1 +~ gravity +applyGravity _ m@(MLock _) = m +applyGravity _ m@(MNettle _) = m +applyGravity r m@(MPlayer p) + | p ^. isClimbing = m + | isOOBRoom r + (p ^. position) = m -- do not apply in between room or we can't + -- high jump between rooms + | otherwise = m & speed . _1 +~ gravity +applyGravity _ m@(MSave _) = m +applyGravity _ m@(MSmart _) = m & speed . _1 +~ gravity +applyGravity _ m@(MStar _) = m +applyGravity _ m@(MSickle _) = m & speed . _1 +~ gravity +applyGravity _ m@(MStone _) = m & speed . _1 +~ gravity +applyGravity _ m@(MWin _) = m +applyGravity _ m@(MWitch _) = m + +limitSpeed :: Meeple -> Meeple +limitSpeed m@(MDead _) = m +limitSpeed m = m & speed . _1 %~ im (>=) 1 + & speed . _2 %~ im (>=) 1 + & speed . _2 %~ im (<=) (-1) + where + im :: (Integer -> Integer -> Bool) -> + Integer -> Integer -> Integer + im o t x = if x `o` t then t else x + + +----------- +-- STEPS -- +----------- + +generateAllSteps :: HasScreen s => s -> s +generateAllSteps s = s & meeples . each %~ generateSteps + + +-- single meeple, *one* step +stepCollide :: HasScreen s => s -> Index -> s +stepCollide s i = s & meeples . ix i %~ savePosition + & meeples . ix i %~ step s + & meeples . ix i %~ roomCollision s + & meeples %~ meepleCollision i + +savePosition :: Meeple -> Meeple +savePosition m@(MDead _) = m +savePosition m = m & prevPos .~ m ^. position + +-- this is a single step! +step :: HasScreen s => s -> Meeple -> Meeple +step _ m@(MDead _) = m +step s m@(MBird _) = simpleMove s m +step s m@(MDumb _) = simpleMove s m +step s m@(MKram _) = simpleMove s m +step _ m@(MLock _) = m +step _ m@(MNettle _) = m +step s m@(MPlayer _) = simpleMove s m +step _ m@(MSave _) = m +step s m@(MSickle _) = simpleMove s m +step s m@(MSmart _) = simpleMove s m +step _ m@(MStar _) = m +step s m@(MStone _) = simpleMove s m +step s m@(MWin _) = simpleMove s m +step s m@(MWitch _) = everyMove s m + + +----------------- +-- ANCILLARIES -- +----------------- + +-- move everywhere, regardless of boundaries (spirit) +everyMove :: HasScreen s => s -> Meeple -> Meeple +everyMove _ m + | not (hasSteps m) = m + | otherwise = + let (sr, sc) = m ^. speed + in m & position . _1 %~ (+sr) + & position . _2 %~ (+sc) + & id %~ dropStep + +-- try to move in a direction fallback to other solutions if possible +simpleMove :: (HasScreen s) => s -> Meeple -> Meeple +simpleMove s a + | not (hasSteps a) = a + | (fp:_) <- fps = dropStep $ snd fp + | otherwise = dropStep $ a' & speed .~ (0, 0) + -- stuck? Just don't move + where + ps :: [(Coords, Meeple)] + ps = map (uncurry $ makePosa a) + -- we first try the expected, the no vert, etc. + [(False, False), + (True, False), + (False, True), + (True, True)] + + fps :: [(Coords, Meeple)] + fps = filter (\(c, _) -> canGoThere s a c) ps + + -- stop agi mov + a' | (MPlayer p) <- a = + if p ^. amSlow . to not || + (p ^. delay . to (ticks 2) . to fetchFrame) + -- todo [refactor] no idea why ticks 3 + then MPlayer $ p & action .~ ANoAction + else MPlayer p + | otherwise = a + +-- given Meeple we modify slightly its speed and obtain projected landing +-- places. Uper functions can check these are sensible (against walls etc.) +-- and pick the right move. +type VerticalOffset = Bool +type HorizontalOffset = Bool +makePosa :: Meeple -> VerticalOffset -> VerticalOffset -> (Coords, Meeple) +makePosa m vo ho = (cs, m & vm & hm & position .~ cs) + where + pr = m ^. position . _1 + pc = m ^. position . _2 + + stepSpeed = steps . to head + + sr | vo = 0 + | otherwise = m ^. stepSpeed . _1 + + sc | ho = 0 + | otherwise = m ^. stepSpeed . _2 + + cs = (pr + sr, pc + sc) + + vm | vo = speed . _1 .~ 0 + | otherwise = id + + hm | ho = \bm -> bm & speed . _2 .~ 0 + & id %~ pActStop + | otherwise = id + + pActStop (MPlayer p) = MPlayer $ p & action .~ ANoAction + pActStop wm = wm + diff --git a/src/Screen/Primitives.hs b/src/Screen/Primitives.hs new file mode 100644 --- /dev/null +++ b/src/Screen/Primitives.hs @@ -0,0 +1,68 @@ +{-# Language TemplateHaskell #-} +{-# Language ScopedTypeVariables #-} + +module Screen.Primitives where + +import Plant +import Room +import Meeple.Operate + +import Terminal.Game +import Lens.Micro.Platform + + +----------- +-- TYPES -- +----------- + +-- stuff that can change +data Screen = Screen { -- "read" part + _room :: Room, + + -- state part: PC/NPCs + _meeples :: [Meeple], + + -- oob check Plant + _NeighbourPlant :: Plant + } + deriving (Eq, Show) +makeClassy ''Screen + + +defaultScreen :: Screen +defaultScreen = Screen defaultRoom [] defaultPlant + + +----------------- +-- CONVENIENCE -- +----------------- + +-- convenience lenses -- + +-- Wrapped in Meeple. Returns Maybe / does nothing if player is dead +mplayer :: HasScreen s => Lens' s (Maybe Meeple) +mplayer = lens gt st + where + gt :: HasScreen s => s -> Maybe Meeple + gt s = s ^? meeples . each . filtered isPlayer + + st :: HasScreen s => s -> Maybe Meeple -> s + st s (Just m) = s & meeples . each . filtered isPlayer .~ m + st s Nothing = s + +-- same as mplayer, just not wrapped in Meeple +player :: HasScreen s => Lens' s (Maybe Player) +player = lens (\s -> s ^. mplayer & mapped %~ getPlayer) + (\s mp -> s & mplayer .~ fmap MPlayer mp) + where + getPlayer (MPlayer p) = p + getPlayer _ = error "getPlayer on non MPlayer" + + +-- convenience actions -- + +-- to be abstracted in .Action o .Outcomes if grows + +playerDie :: HasScreen s => s -> s +playerDie s = s & meeples %~ filter (not . isPlayer) + diff --git a/src/Screen/ProcessKeys.hs b/src/Screen/ProcessKeys.hs new file mode 100644 --- /dev/null +++ b/src/Screen/ProcessKeys.hs @@ -0,0 +1,56 @@ +module Screen.ProcessKeys where + +-- .Decide, for players + +import Input +import Meeple.Operate +import Screen.Check +import Screen.Primitives + +import Terminal.Game +import Lens.Micro.Platform + + +processMovKeys :: HasScreen s => Input -> s -> Player -> Player +processMovKeys KLeft _ p = agiMov p AGoW +processMovKeys KRight _ p = agiMov p AGoE +processMovKeys KUp s p + | canClimb s (MPlayer p) = agiMov p AClimb & isClimbing .~ True + | amGrounded s (MPlayer p) = jumpAct p +processMovKeys KDown s p + | canClimb s (MPlayer p) || + canDescend s (MPlayer p) = agiMov p ADescend & isClimbing .~ True +processMovKeys KSpace _ p = stopPlayer p +processMovKeys _ _ p = p + +jumpAct :: Player -> Player +jumpAct p | ca == AGoW = p & action .~ AJumpL + | ca == AGoE = p & action .~ AJumpR + | otherwise = p & action .~ AJumpX + where + ca = p ^. action + +----------------- +-- ANCILLARIES -- +----------------- + +-- ~= Sierra AGI movement, tap once to start moving, tap again to stop. +agiMov :: Player -> PAction -> Player +agiMov p nc | oc == nc = stop p + | otherwise = p & action .~ nc + where + oc = p ^. action + + stop :: Player -> Player + stop pw = pw & stopSpeed -- xxx [refactor] questo andrebbe in + -- Decide + & action .~ ANoAction + + stopSpeed + | elem nc [AClimb, ADescend] = speed . _1 .~ 0 + | otherwise = speed . _2 .~ 0 + +-- stop him in any case +stopPlayer :: Player -> Player +stopPlayer p = agiMov p (p ^. action) + diff --git a/src/Story.hs b/src/Story.hs new file mode 100644 --- /dev/null +++ b/src/Story.hs @@ -0,0 +1,321 @@ +{-# Language TemplateHaskell #-} + +module Story where + +import Meeple.Operate +import Input +import Plant +import Room +import Screen + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Data.List as L +import qualified Data.Set as S + + +-- SWinning = win animation +data Status = SRunning | SWon Animation | SQuit + deriving (Eq, Show) + +type Name = String +data Story = Story { -- read + _name :: Name, + _size :: Coords, + _rooms :: [Room], + + -- state + _storyScreen :: Screen, + _spawnRoom :: Room, + + -- playerstate + _stars :: Integer, + _collected :: S.Set (Name, Coords), + -- collected stars + _status :: Status + } + deriving (Eq, Show) +makeLenses ''Story +instance HasScreen Story where screen = storyScreen + + +defaultStory :: Story +defaultStory = buildStory "no-name" (1,1) "" [defaultRoom] + +-- constructor + sanity check +buildStory :: Name -> Coords -> Title -> [Room] -> Story +buildStory n c st rs + | null rs = -- check we have at least one screen + ef "no screen found" + | otherwise = + + -- spawn at the initial coordinates + -- (it will check spawn in room one exists) + let s = spawn r S.empty in + + -- check sizes of screen + case checkRoomSize c rs of + [] -> let lst = Story n c rs s r 0 S.empty SRunning + in -- todo [refactor] starify and fetchNeighburs + -- should be generalised, maybe inside spawn + lst & id %~ starifyScreen False + & id %~ fetchNeighbours + es -> error (mismErr c es) + where + ef s = error $ "buildStory: " ++ s ++ + " in Story \"" ++ n ++ "\"!" + + -- non posso usare fetchroom perché non ho ancora + -- costruito Story + r = case filter (^. title . to (== st)) rs of + (x:_) -> x + _ -> ef $ "no starting room" ++ show st + +--------------- +-- FUNCTIONS -- +--------------- + +fetchRoom :: Story -> Title -> Room +fetchRoom s t = fetchRoomSafe s t ^. non e + where + e = error $ "Cannot find room named " ++ show t ++ "!" + +fetchRoomSafe :: Story -> Title -> Maybe Room +fetchRoomSafe s t = + case filter f (s ^. rooms) of + (r:_) -> Just r + [] -> Nothing + where + f r = r ^. title . to (== t) + +-- fetch neighbour of current room +fetchNeighbours :: Story -> Story +fetchNeighbours s = + let op = s ^. room . plant + ps = s ^. size + in s & neighbourPlant .~ gluePlants ps op ns + where + ns :: [(Cardinal, Plant)] + ns = map f (s ^. room . exits) + + f :: Exit -> (Cardinal, Plant) + f (Exit c t) = (c, fr s t ^. plant) + + fr :: Story -> Title -> Room + fr ws t = fetchRoomSafe ws t ^. non defaultRoom + +----------- +-- LOGIC -- +----------- + +storyLogic :: Story -> Input -> Story +storyLogic s KExit = s & status .~ SQuit +storyLogic s _ | isWinning s = s & status %~ tickWinning +storyLogic s e = (buryDeads . deadCheck . saveCheck . oobCheck) s & + storyScreen %~ screenLogic e + +isWinning :: Story -> Bool +isWinning s = case s ^. status of + SWon {} -> True + _ -> False + +tickWinning :: Status -> Status +tickWinning (SWon a) = SWon $ tick a +tickWinning s = s + +isWinOver :: Story -> Bool +isWinOver s = case s ^. status of + SWon a -> isExpired a + _ -> False + + +-- todo [refactor] hack +saveCheck :: Story -> Story +saveCheck s = case s ^. mplayer of + Nothing -> s + Just _ -> + if s ^. player ^?! _Just . amSaving + then s & spawnRoom .~ (s ^. screen . room) + & player . mapped . amSaving .~ False + else s + +-- todo [refactor] refactor starify e in generale spawn +deadCheck :: Story -> Story +deadCheck s | playerDead s = s & storyScreen .~ spawn (s ^. spawnRoom) + (s ^. collected) + & id %~ starifyScreen False + & id %~ fetchNeighbours + | otherwise = s + +oobCheck :: Story -> Story +oobCheck s | playerDead s = s + | pr < 1 = changeRoom N + | pr > mr = changeRoom S + | pc < 1 = changeRoom W + | pc > mc = changeRoom E + | otherwise = s + where + (pr, pc) = s ^. player . + non (error "oobCheck - no player") . + position + (mr, mc) = s ^. size + + changeRoom :: Cardinal -> Story + changeRoom c = + let r = s ^. screen . room + p = s ^. screen . player . + non (error "changeRoom - no Player") + sps = s ^. collected in + case cardinalTitle r c of + Nothing -> playerDie s + Just t -> s & storyScreen .~ enter p sps (fetchRoom s t) + & id %~ starifyScreen False + & id %~ fetchNeighbours + -- xxx [refactor] really abstract this + +-- from Dead elements we will get score info and such +-- (or cleanDeads) +buryDeads :: Story -> Story +buryDeads s = s & meeples .~ rs + & id %~ processDead dm + where + (dm, rs) = s ^. meeples . to (L.partition isDead) + -- todo [refactor] anche qui, dovrei swrapparli e poi + -- passarli a processdead + +-- meeple +processDead :: [Meeple] -> Story -> Story +processDead ms s = foldl f s ms + where + f :: Story -> Meeple -> Story + f ws (MDead x) = g ws x + f _ _ = error "processDeads passed a non dead" + + -- che succede se raccolgo una stella? + g :: Story -> Message -> Story + g ws None = ws + g ws (PlusStar cs) = consumeStar True cs ws + g ws (NeutralStar cs) = consumeStar False cs ws + g ws Won = ws & status .~ SWon winAni + +winAni :: Animation +winAni = creaAnimation [(26, box ' ' 80 24)] + + +-- add a star: True = the player collected it +consumeStar :: Bool -> Coords -> Story -> Story +consumeStar b cs s = + if b + then s & stars +~ 1 + & collected %~ S.insert (rname, cs) + & id %~ starifyScreen True + else s & collected %~ S.insert (rname, cs) + where + rname = s ^. screen . room . title + +-- apply the relevant Screen changes, given a story state (i.e., locks +-- to open if we collected enough stars). +-- Bool: long lock animation? +starifyScreen :: Bool -> Story -> Story +starifyScreen b s = s & screen . meeples . each %~ f + where + -- xxx [refactor] anche qui vorrei un "is xyz" map + f :: Meeple -> Meeple + f (MLock l) = let on = l ^. origNumeral + ps = s ^. stars + lo = MLock $ l & currNumeral .~ (on - ps) + in updateLockAni b lo + f m = m + + +---------- +-- DRAW -- +---------- + +drawStory :: Story -> Plane +drawStory s | isWinning s = let (SWon a) = s ^. status in fetchFrame a + | otherwise = drawScreen $ s ^. storyScreen + + +----------------- +-- SPAWN/ENTER -- +----------------- + +-- spawns inside a room. Set is "stars not to create, because already +-- taken". +spawn :: Room -> S.Set (Name, Coords) -> Screen +spawn r tcs = case findSpawn r of + Just cs -> let p = defaultPlayer cs + in thaw r tcs p + Nothing -> error $ + "respawn: no spawn-point found in room \"" ++ + r ^. title ++ "\"!" + + +enter :: Player -> S.Set (Title, Coords) -> Room -> Screen +enter p tcs r = ts + where + -- since every room has the same dimensions + -- mandatory coords + (mr, mc) = boundaries r + + -- 'mirror' the overflown coordinate + (pr, pc) = p ^. position + + -- north/south exit + nr | pr > mr = pr - mr + | pr < 1 = mr - pr + | otherwise = pr + + -- west/east exit + nc | pc > mc = pc - mc + | pc < 1 = mc - pc + | otherwise = pc + + p' = p & position .~ (nr, nc) + + ts = thaw r tcs p' + +thaw :: Room -> S.Set (Title, Coords) -> Player -> Screen +thaw r tcs p = defaultScreen + & room .~ r + & meeples .~ (r ^. frozenMeeples) + & meeples %~ filter notColl + & meeples %~ (MPlayer p :) + where + tcs' = S.filter ((== r ^. title) . fst) tcs + css = S.toList (S.map snd tcs') + + notColl (MStar s) = notElem (s ^. position) css + notColl _ = True + + +----------------- +-- ANCILLARIES -- +----------------- + +-- checks if screens are sane (mandatory size) +-- returns ill ones +checkRoomSize :: Coords -> [Room] -> [(Title, Coords)] +checkRoomSize ms rs = rs ^.. (each . filtered ff . to bf) + where + -- filter function + ff r = r ^. to boundaries . to (/=ms) + + -- return function + bf :: Room -> (Title, Coords) + bf r = (r ^. title, r ^. to boundaries) + +-- for mismatch errors +mismErr :: Coords -> [(Title, Coords)] -> String +mismErr cs es = + "Found rooms of mismatched dimensions!\n" ++ + "Expected dimension: " ++ dim2str cs ++ "\n" ++ + "--\n" ++ unlines (map romErr es) + where + dim2str (wr, wc) = show wr ++ " rows, " ++ show wc ++ " cols." + + romErr (t, wcs) = t ++ ": " ++ dim2str wcs + + diff --git a/src/Tile.hs b/src/Tile.hs new file mode 100644 --- /dev/null +++ b/src/Tile.hs @@ -0,0 +1,98 @@ +module Tile where + +import Terminal.Game + +data Tile = Tile { tType :: TileType, + tAnimation :: Animation } + deriving (Show, Eq) + + +-- Keep then in alphabetical order. Complete every function in this +-- module. +data TileType + = Background + | ColRed + | ColGreen + | ColYellow + | ColBlue + | ColPurple + | ColCerulean + | Floor + | Heaven + | Invisible + | Ladder + | Prop + | Solid + | Slow + | Spike + | Thick + | Transparent + | Water + deriving (Eq, Show) + + +tilePlane :: Tile -> Plane +tilePlane t = fetchFrame . tAnimation $ t + +charTile :: Char -> Maybe Tile +charTile '.' = creaSipTile Background (cell '.') +charTile 'R' = creaSipTile ColRed (cell '.' # color Red Vivid) +charTile 'G' = creaSipTile ColGreen (cell '.' # color Green Vivid) +charTile 'Y' = creaSipTile ColYellow (cell '.' # color Yellow Vivid) +charTile 'B' = creaSipTile ColBlue (cell '.' # color Blue Vivid) +charTile 'P' = creaSipTile ColPurple (cell '.' # color Magenta Vivid) +charTile 'C' = creaSipTile ColCerulean (cell '.' # color Cyan Vivid) +charTile '-' = creaSipTile Floor (cell '-' # bold) +charTile 'i' = creaSipTile Invisible (cell ' ') +charTile '|' = creaSipTile Ladder (cell '|') +charTile 'S' = creaSipTile Slow (cell '.') +charTile ':' = creaSipTile Solid (cell ':') +charTile 'A' = creaSipTile Spike (cell 'A' # color Cyan Vivid # bold) +charTile '=' = creaSipTile Thick (cell '=') +charTile 'x' = creaSipTile Transparent (cell ' ') + -- no prop, since there is no single char +charTile 'w' = creaSipTile Water (cell '~' # color Blue Dull) +charTile '~' = let n = 5 + ha = creaLoopAnimation + [(n*3, cell '~' # color Black Dull), + (n , cell '~' # color Blue Vivid), + (n , cell '~' # color Yellow Vivid), + (n*3, cell '~' # color White Vivid), + (n , cell '~' # color Yellow Vivid), + (n , cell '~' # color Blue Vivid)] + in Just $ Tile Heaven ha + -- prop plus +charTile 'q' = Just $ creaPropPlus 'a' (color Red Vivid) +charTile 'h' = Just $ creaPropPlus 'f' (\p -> p # color Green Dull # bold # invert) +charTile _ = Nothing + +creaProp :: Char -> Tile +creaProp c = Tile Prop (creaStaticAnimation $ cell c) + +type Colour = Plane -> Plane +creaPropPlus :: Char -> Colour -> Tile +creaPropPlus k c = Tile Prop (creaStaticAnimation $ cell k # c) + +creaSipTile :: TileType -> Plane -> Maybe Tile +creaSipTile tt p = Just $ Tile tt (creaStaticAnimation p) + +tickTile :: Tile -> Tile +tickTile (Tile tt a) = Tile tt (tick a) + +---------------- +-- PROPERTIES -- +---------------- + +isSolid :: TileType -> Bool +isSolid Floor = True +isSolid Heaven = True +isSolid Invisible = True +isSolid Solid = True +isSolid Thick = True +isSolid _ = False + +isGround :: TileType -> Bool +isGround Floor = True +isGround Ladder = True +isGround t = isSolid t + diff --git a/src/Venzone.hs b/src/Venzone.hs new file mode 100644 --- /dev/null +++ b/src/Venzone.hs @@ -0,0 +1,94 @@ +-- GPLv3, this and all the repo + +{-# Language TemplateHaskell #-} +{-# Language LambdaCase #-} + +module Venzone where + +import Menu +import Story +import Paths +import Input + +import Terminal.Game +import Lens.Micro.Platform + + +---------- +-- GAME -- +---------- + +-- main Game State +data Venzone = Venzone { _quit :: Bool, + _menu :: Menu, + -- Nothing; we are in menu + _story :: Maybe Story } + deriving (Eq, Show) +makeLenses ''Venzone + +defaultVenzone :: Venzone +defaultVenzone = Venzone False defaultMenu Nothing + +prepareVenzone :: IO (Game Venzone) +prepareVenzone = bundleStories <$> findStories + +bundleStories :: [Story] -> Game Venzone +bundleStories ss = + let m = menuStories ss + gs = defaultVenzone & menu .~ m in + + makeVenzone gs + where + logicWrapper :: Venzone -> Event -> Venzone + logicWrapper s e = logicFun s (eventInput e) + + makeVenzone :: Venzone -> Game Venzone + makeVenzone gs = Game 80 24 13 + gs + logicWrapper drawFun (^. quit) + + +----------- +-- LOGIC -- +----------- + + +logicFun :: Venzone -> Input -> Venzone +logicFun gs KExit | gs ^. story == Nothing || + gs ^. story . non defaultStory . name == "Gymnasium" + -- debug + = gs & quit .~ True +logicFun gs _ | (Just s) <- gs ^. menu . selected = + gs & menu . selected .~ Nothing + & story ?~ s + -- ?~ = wraps in maybe +logicFun gs e = menuCase gs + (gs & menu %~ flip menuLogic e) + (if gs ^. story . non (error "menuCase non-story") . + status . to fsb + then gs & story .~ Nothing + else gs & story . mapped %~ flip storyLogic e) + where + fsb :: Status -> Bool + fsb SQuit = True + fsb (SWon a) = isExpired a + fsb _ = False + +---------- +-- DRAW -- +---------- + +drawFun :: Venzone -> Plane +drawFun gs = menuCase gs + (drawMenu (gs ^. menu)) + (drawStory (gs ^?! story . _Just)) + +----------------- +-- ANCILLARIES -- +----------------- + +menuCase :: Venzone -> a -> a -> a +menuCase gs ca cb = + if has (story . _Nothing) gs + then ca + else cb diff --git a/src/Watcher.hs b/src/Watcher.hs new file mode 100644 --- /dev/null +++ b/src/Watcher.hs @@ -0,0 +1,85 @@ +module Watcher where + +-- Venzone level REPLer, requested by sm + +import Paths +import Venzone + +import Terminal.Game hiding ( Event ) +import System.FSNotify + +import qualified Control.Concurrent as CC +import qualified Control.Monad as CM +import qualified Data.Function as F +import qualified System.FilePath as FP + + +watchMode :: FilePath -> IO () +watchMode fp = + -- kill/launch venzone instance part + CC.newChan >>= \chan -> + CC.forkIO (levelSpawner fp chan) >> + + -- file watcher + watcher fp chan + +-- watch file `fp` and sends events to chan `chan` +watcher :: FilePath -> CC.Chan Event -> IO () +watcher fp chan = withManagerConf conf repJob + where + -- debounces to 5/100 of a second, again to counter vim frenzy + conf :: WatchConfig + conf = defaultConfig { confDebounce = Debounce ( 5 / 100 ) } + + -- repeated IO action + repJob :: WatchManager -> IO a + repJob mgr = let oneSec = 10 ^ (6 :: Int) in + watchChan mgr >> + CM.forever (CC.threadDelay oneSec) + + watchChan :: WatchManager -> IO () + watchChan mgr = () <$ watchDirChan mgr dir ff chan + + -- dir to watch + dir :: FilePath + dir = FP.dropFileName fp + + -- only match our specific file (and not vim crap) + -- and only add/mod events + ff :: Event -> Bool + ff e = let ep = eventPath e + in isAddMod e && + F.on (==) FP.takeFileName ep fp + + isAddMod :: Event -> Bool + isAddMod Modified {} = True + isAddMod Added {} = True + isAddMod _ = False + +levelSpawner :: FilePath -> CC.Chan Event -> IO () +levelSpawner fp chan = + instanceVenzone >>= \ti -> + loop ti + where + instanceVenzone :: IO CC.ThreadId + instanceVenzone = CC.forkIO (levelMode fp) + + loop :: CC.ThreadId -> IO () + loop ti = CC.readChan chan >> + -- blocks until. We don't care about the specific + -- event since it is filtered above + CC.killThread ti >> + -- to counter vim + CC.threadDelay 1000 >> + instanceVenzone >>= \ti2 -> + loop ti2 + +-- todo [refactor] [refactor] astrai con normalMode +levelMode :: FilePath -> IO () +levelMode fp = errorPress $ + (bundleStories . (:[]) <$> findSingleStory fp) >>= \gv -> + -- todo [refactor] astrarre questa keypress? + let gv' = setupGame gv [KeyPress 'd'] in + playGame gv' >> + return () + diff --git a/stories/a_first-stroll.vns b/stories/a_first-stroll.vns new file mode 100644 --- /dev/null +++ b/stories/a_first-stroll.vns @@ -0,0 +1,113 @@ +story_name: First stroll +room_size: 24 79 +start_room: Cradle + + +# Cradle +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + -- +i -- +i -- + ----- +i -- --- ----------------------- +i -------------------------- +i +i GGG GGG ® Go ® +i ® Controls: WASD. ® GGGGG GGGGG ®East® +i ® Tap *once* to start ® GGGGGGG GGGGGGG +i ® moving. ® GGGGGGG GGGGGGG +i ® Tap again or Space ® GGGGGGG GGGGGGG +i ® to stop. ® GGGGGGG GGGGGGG +i GGGGGGG GGGGGGG +::::::::: GGGGGGG GGGGGGG +:::::::::: @ GGGGG GGGGG ::::::: +:::::::::::::: RRR RRR ::::::::: +:::::::::::::::::::: RRR RRR ::::::::::::::: +::::::::::::::::::::: RRR RRR ::::::::::::::::: +:::::::::::::::::::::: :::: :::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::®Cradle®: +>>> E -> Stinging nettle + +# Stinging nettle +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + + ** +-------------------- ------------------------------------------- + ------------------ + + + ®Remember, tap® + ®again or Space® + ® to stop! ® + + + + ,,,,,,,,,,,,,, +:: ::::::::::::::::::: +:: :::::::::::::::::::,,,,,,,,,,,,,,,, +:: :::::::::::::::::::::::::::::::::::::::: +:: ::::::::::::::::::::::::::::::::::::::::::,,,,,,,,,,,,,,,,,,,, : +:: ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::®Stinging nettle®: +>>> W -> Cradle (revisited) +>>> E -> Ladder + +# Ladder +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC::::::: +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC::::::: + ::::::: + :::::: + :::::: + ,,,, ,,,,, ,,,, ,,,,, :::::: +---------------------------------------------------------------------|----::::: + | ::::: + | ::::: + | :::: + | :::: + | :::: + | :::: + | :::: + | :::: + -------- | :::: + | :::: + ------------------ --- | :::: + | ::::: + | ::::: + ::::::wwwwwwwwwwwwwwwwwwwwwwwwwwwww::::::::::::::::::::::: | :::::: +:::::::::::::::wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww:::::::::::::::::::::::::::::: +:::::::::::::::::wwwwwwwwwwwwwwwwwwwwwwwwwwwww::::::::::::::::::::::::::::::::: +::::::::::::::::::::wwwwwwwwwwwwwwwwwwwwwwwww:::::::::::::::::::::::::®Ladder®: +>>> W -> Stinging nettle + +# Cradle (revisited) +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + -- +i ®Very good! Catch the® -- +i ®firefly to conclude ® -- + ----- +i ® this story! ® -- --- ----------------------- +i ---------------------------- +i +i ® Happy adventures! ® GGG GGG +i GGGGG GGGGG +i GGGGGGG GGGGGGG +i GGGGGGG GGGGGGG +i GGGGGGG GGGGGGG +i GGGGGGG GGGGGGG +i GGGGGGG GGGGGGG +::::::::: GGGGGGG GGGGGGG +:::::::::: @ GGGGG GGGGG ::::::: +:::::::::::::: RRR RRR ::::::::: +:::::::::::::::::::: RRR RRR ::::::::::::::: +::::::::::::::::::::: RRR RRR ::::::::::::::::: +:::::::::::::::::::::: :::: :::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::®Cradle®: +>>> E -> Stinging nettle diff --git a/stories/b_bidin.vns b/stories/b_bidin.vns new file mode 100644 --- /dev/null +++ b/stories/b_bidin.vns @@ -0,0 +1,442 @@ +story_name: Bidin and the Witch +room_size: 20 60 +start_room: D2 + +# A1 +wwwwwwwwwwwww:::::::wwwwwwwwwwwwww:::::::::::wwwwwwwwwwwwwww +wwww:::::::::::::::::::::::::::::::::::::::::::::::::wwwwwww +::::::::::::::::::: :::::::::::::::::::::::::::::::::: +::::::::::::: :::::::::: +::::::: R R R R +::::: v +::::: +::::: R R R R +:::: +:::: R R R R +:::: +:::: R R R R +::::: R R R R +:::::: R R R R +:::::::: RRRRRRRR +::::::::: : R R R R :::: ::::::: +::::::::::::::RRRRRRRR:::::::::::::::::::::::::::::::: +::::::::::::::RRRRRRRR:::::::::::::::::::::::::::::::::::::: +::::::::::::::RRRRRRRR:::::::::::::::::::::::::::::::::::::: +::::::::::::::RRRRRRRR:::::::::::::::::::::::®Magical bore®: +>>> E -> B1 +>>> S -> A4 + +# A2 +i | | +i | | +i | | +i iiiiiiii iiiiiiiiiii-------iiiiiiiiiiii iiiiiii | +i i i i i i | +i i i i iiiiiiiiiiiiiiii iiiiiii | +i i iiii iiiiiii i i | +i i i iiiiiiiii i | +i i i i iiiiiiiiiiiiiiiiii i | +i i i i* i i i | +i i i iiiiiiii i iiiiiiiiiii i i | +i i i iiiiiiii i i i | +i i i i ®R to restart from® iiii | +i i i i ® last save-point.® | +i i i i | +i ------------------------------------------------------- +i +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww®Waters of illusion®w +>>> N -> A3 +>>> E -> B2 + +# A3 +i +i +i YYYYYYY +i YYYYY YYY +i YYYYYY Y +i YYYY BBBB +i YYYY BB +i YYYYYY Y BBB +i YYYYYYYYYY BBBBBBBBBBB BBBB +i YYYYYYY BB BB BB +i BB--------|---------------------------|---- +i BBBBBBB | BBBBBB | +B BB BB | | +iBBBB B ®|® | ®^® | +i ®v® | ®|® | +i | | +i | | +i | | +i | | +®Sister moon® | | x +>>> S -> A2 +>>> E -> B3 + +# A4 +i ::RRRRRRRR:: +i RRRRRRRR +i RRRRRRRR +i R R R R +i R R R R +i R R R R +i +i R R R R +i +i R R R R +i * +i R R R R ~~~~~ +i +i ~~~~~~~ +i +i ~~~~~~~~~~~~~~~~~~~ +i ~~~~~~~~~~~~~~~~~~~~~ +i ~~~~~~~~~~~~ +i +i ®A heavenly place®x +>>> S -> A3 +>>> E -> B4 + +# B1 +wwwwwwwwwwwwwwwwwwwwwwww:::::: ::::wwwwwwwwwwwwwwwwwww +wwwwwwwwwwwwww:::::::::::::::: :::::::wwwwwwwwwwwww +::::::::::::::::::::::::::::: :::::::::::::wwwwww +::::::::::::::::::::::::::: :::::::::::::www + :::::::: :: :::::::::::::: + ::::::::::::: + :::::::::::: + :::::::::::: + ::::::::: + * :::::::: + ----|----- :::::: + | + | + | + | @ + AAA :::::::::::::: j + :::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::®Sbilf hall®: +>>> E -> C1 +>>> W -> A1 + +# B2 + :::::::::::::::: + ::::::::::::::: + ::::::::::::: + + + + GGGGGGG + GGGGGGGGGG + GGGGGGGGGGG + GGGGGGGGGGGGG + GGGGGGGGGGGGG + GGGGGGGGGGG + GGGGGGG + RRR + RRR + RRR + RRR +wwwwwwwwwwwwwwwww::::::::::::: :::::::::::wwwwwwwwwwww +wwwwwwwwwwwwwwwwwww:::::::::: ::::::wwwwwwwwwwwwwwwwww +wwwwwwwwwwwwwwwwwwwwwwww:::::: ::::www®Cave entrance®w +>>> S -> B1 +>>> E -> C2 +>>> W -> A2 + +# B3 + ::::::::::::: + :::::::::::::: + ::::::::::::: + :::::::::: + :::::::: + ::: :::::::: + :::: ::::::: + ::::::: ::::::: + :::::::::::::::::: :::: :: + @ * ::::::::::::::::::: :: : +-- ::::::::::::::::::::: :::::::::::::::::::: + ::::::::::::::::::::: :::::::::::::::::::: + ::::::::::::::::::: :::::::::::::::::::::: :: + ::::::::::::::: :::::::::::::::::::::::::::: + ::::: ::::::::::::::::::::::::::::::: + ::::::::::::::::::::::: + ::::::::::::::::::: + ::::::::::::::::: + :::::::::::::::: + :::::®Foothold®: +>>> N -> B4 +>>> S -> B2 +>>> W -> A3 +>>> E -> C3 + +# B4 +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + . . + .... .. . + .. .. .. . . + ... .. ... . . .. + .. .. .. .. .. + ... + ... + :: + :::::::::: + ::::::::::: + ::::::::::: + :::::::::::: + :::::::::::: + :::::::::::: + ::::::::::::: + :®Mt Sernio®: +>>> S -> B3 +>>> W -> A4 +>>> E -> C4 + +# C1 +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww:::::::::: | ::::: +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww::::::::::::: | ::::: +wwwwwwwwwwwwwwwwwwwwwwwwwwwww:::::::::::::::: | +wwwwwwwww::::::::::::::w:::::::::::::::::::: | +:::::::::::::::::::::::::::::::::::::::::::: | +::::::::::::::::::::::::::::::::::::::::::: | : +::::::::::::::::::::::::::::::::::::::::::: | :::: +:::::::::::::CCCCCCCCCCCCCC:::::::::::::::::::::::===::::::: +::::::::::::::::::::CCCCC::::::::::::::::::::::::::::::::::: +:::::::::::::::CCCC:C::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + ::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + ::::::::::::::::::::::::::::::::::::::::::::::::::::: + : ::::::::::: ::::::::::::: :::::::::::::: + :::::::: :::::::::: + + ::: ,,,,,,,,,,,,, ,,,,,,,,,,,,,, ,,,, +::::::::::::::::::::::::::::::::::::::::::::::::::::: :: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::®Alleyway®: +>>> W -> B1 +>>> E -> D1 +>>> N -> C2 + +# C2 +:::::::::: +::::::::: +::::::: + + + + + + + + + + + * == + ==================:::::::::::::: + ::::::::::::::::::::::::::::: + ::::::::::::::: ::::::: +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww:::::::::::: * ::::: +wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww:::::::::::---|---::::: +w®Tagliamento river®wwwwwwwwwwwwwwwwww:::::::::: | ::::: +>>> S -> C1 +>>> E -> D2 +>>> W -> B2 + +# C3 +::::::::: | :::::::::: +::::::::: | ::::::::::: +::::::::: | ::::::::::: +::::::::: | :::::::::::: +::::::::: | :::::::::: +:::::::::: | ::::::::: +:::::::::: | ::::::: +::::::::::: | :::::::: +::::::::::: | :::::::: +::::::::::: | :::::::: + :::: | ::::::: + | ::::: + ::: +:::: === * ::: +::::::::===== ::: +:::::::::: ::: +:::::::: :: +::::::::: +:::::::::: +:::::::::: ®Precipice®x +>>> N -> C4 +>>> S -> C2 +>>> W -> B3 + +# C4 +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + + + + + + + + +::::: +:::::::----- +:::::::: b j ==========:::::::::::: +:::::::: --------|---------- | | ::::::::::: +:::::::: | ---------:::::::::: +::::::::: | ::::::::::: +::::::::: | :::::::::: +::::::::: | :®Bridge®: +>>> E -> D4 +>>> W -> B4 +>>> S -> C3 + +# D1 +::::::::::::::::::::::::::::::::::::::::::::::::::C::::::::: +::::::: : :::::::::::::::::: :: :::: C :::::::: + :: C :::: + C ::::: + b b b b C ::::: +::::::: :::::::::::: C :::: +:::::::::::: ::::::::::::::::::::::::::: C :::: +:::::::::::::::::::::::::::::::::::::::::::::: CC :::: +:::::::::::::::::::::::::::::::::::::::::::::: C::::::::: +::::::::::::::::::C::::::::::::::::::::::::::: C :::: +::::::::::::::::CC:::::::::::::::::::::::::::: C ::::: +::::::::::::::::C:::::::::::::::::::::::::::::::::C :::: +:::::::::::::::C::::::::::::::::::::::::: C :::: +:::::::::::::::C ::::::: C :::: + C C ::::::::: + C C ::::::: + CC C :::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::®Hiding place®: +>>> W -> C1 + +# D2 + :::::::::::::::::::::::::::::: | :::::::::: + :::::::::::: | ::::::::: + | ::::::: + ®Bring me 9 Alpine Star® | * :::::: + ®flowers if you want to® ---------------|---------::::: + ® get home! ® | ::::: + | 9::: + | 999: + ®That will teach you® | 999: + ® not to trespass a ® | 9999 + ® witch's garden! ® | 9999 + | 9999 + | 9999 + ::: @ | 9999 +::::::::::::::::::::::::: | * 9999 +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::CC::::::: +::::::::::::::::::::::::::::::::::::::::::::::::::C::::::::: +::::::::::::::::::::::::::::::::::::::::::::::®Locked gate®: +>>> N -> D3 +>>> E -> End +>>> W -> C2 + +# D3 +:::::::::::::::::::::::: :::: | :::::::::::::::::::::::::::: +::::::::: ::::::::::::::::::: | :::::::::::::::::::::::::::: +:::::::::::: :::::::::::::::: | :::::::::::::::::::::::::::: +:::::::: : :::::::::: : | :::::: ::: +::::: | ::: +:::::: | ::: +::::::: | :::::: +:: dC:: | :::::: +::::C:: --|------------------------- == :::::::::: +::::C:: | ::::::::: ::::::::::::: ====== :::::::::: +::::C::: | ::::::::: ::::::::::::::::::::::::::::::::: :: +::::C:::::: | :::::::::::::::::::::::::::::::::::::::::::::: +::::C:::::: | :::::::::::::::::::::::::::::::::::::::::::::: +::::C:::: | :::::::::::::::::::::::::::::::::::::::::::: +::::CC :: | ::: :::::::::::: ::::: +::::::CCCCC | :::::::::::::::: +:::::::::::::::::: :::::::::::::::: + ::::::::::::::::::::::::::::::::::::::|:::::::::::::::::::: + ::::::::::::::::::::::::::::::::::::: | ::::::::::::::::: + :::::::::::::::::::::::::::::::: | ::®Quarry®: +>>> S -> D2 +>>> N -> D4 + +# D4 +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +CCCCCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC®+®CCCCCCCCCCC + YYYY | ::: + YYYYYYYY ::: :::: + YYYYYYYYYY :::: ::::::::::::::::: + YYYYYYYYYY :::::::::::::::::::::::: + YYYYYYYY :=====================:: + YYYY =: + ®St. Hilarius will ®:: + ®save your progress.®:: + :: + :: + :: + @ :::::: +::::::::::: ::::::::::::::::::::: +:::::::::::::::::::::::::::===|===:::::::::::::::::::::::::: +::::::::::::::::::::::::::::::|::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::|::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::|::::::::::::::::::::::::::::: +:::::::::::::::::::::::: :::::|::::::::::::::®Stone chapel®: +>>> S -> D3 +>>> W -> C4 + +# End + GGG i + GGGGG i + GGGGG ®At home I ate nettle soup® i + GGGGGGG ® and roasted chestnuts. ® i + GGGGGGG i + GGGGGGGGG i + GGGGGGGGG ® They tasted delicious. ® i + GGGGGGGGGG i + GGGGGGGGGGG G i + GGGGGGGGGGGG G i + GGGGGGGGGGGGGG G + i + GGGGGGGRRRGGGGGG G i + RRR GG ::::::: i + RRR GGGRRGGG ::::::: i + RRR RR ::::::: i +:::::: RRR RR ::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::®Spurces trail®: +>>> W -> D2 + +# Template + + + + + + + + + + + + + + + + + + + + x +>>> N -> Exit + diff --git a/stories/orcolat.vns b/stories/orcolat.vns new file mode 100644 --- /dev/null +++ b/stories/orcolat.vns @@ -0,0 +1,1126 @@ +story_name: The Orcolat +room_size: 20 60 +start_room: Hearth + +# Hearth + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +i +i ® -Venzone, 1768- ® +i +i ==== ®o® ®At dawn, I closed the book® +i === ===®j® ® and decided to set off. ® +i === === +i === === +i === BBB === +i = BBB = +i = @ = +i =-------- ::::::::::::: +i = --- ::::::::::::::::::: +:: = --- :::::::::::::::::::::::: +::::=::::::::::::::=:::::::::::::::::::::::::::::::::::::::: +::::=::::::::::::::=:::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::®Hearth®: +>>> E -> Service ditch + +# Service ditch +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + * + --------|--------- + | + | + ®It was clear: the Orcolat® | + ®awoke once again, another® | + ® earthquake was looming. ® | + | + | +:: | +:: | +:: :::::::::::::::::: +::: :::::::::::::::::::::::::::::::::::R::::::::::::: +:::GGGGGGGG::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::®Service ditch®: +>>> W -> Hearth +>>> E -> Little creek + +# Little creek +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCC CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + GGGGGGGGGG + GGGPGGGGGPGGGG + GGPPPGGGPPPGGGGG + GGGGPGGGGGPGGGGPGG + GGGGPGGGPGGGGGGPPPG + GGGPPPGPGGGGPGGGPGG + GGGPGPPPGGPPPGGGG + GGGGPGRGGPGGG ====== + GGRRRGG + RRR @ + RRR ====== ============= + RRR YYYYYYYY + RRR =========YYYYYYYYYYYYY +:: RRR YYYYYYYYYYYYYYYYYYY +::: ::::::::::::::::::wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww +:::::::::::::::::::::::::::wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww +:::::::::::::::::::::::::::::::wwwwwwwwwwwwww®Little creek®w +>>> W -> Service ditch +>>> E -> Prominence + +# Prominence +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + ®His Poleaxe already® + ®claimed many souls® + ® in this valley. ® + + = +========== = + =======|= + | ,,,,,,,,,,,,,,,,,, + ®I had to ® | :::::::::::::::::: + ®stop him,® | :::::::::::::::::::::::: + ®but how? ® | ::::::::::::::::::::::::::::::: + b| b ::::::::::::::::::::::::::::::: +wwwwwwwwwww:::::::::::::::::::::::::::::::C:::::::::::::Y::: +wwwwwwwwwwww:::::::::::::::::::::::::::::C:::::::::::::::::: +wwwwwwwwwww:::::::::::::::::::::::::::::CC:::::®Prominence®: +>>> W -> Little creek +>>> E -> Via ferrata + +# Via ferrata + | | + | | + A | | + A A | | ®and began ® + A A A | | ®to ascend.® + AAAAAAA | | + | | + | ®I loaded my® | + | ® pistol, ® | + | | + | | + ® I did not want ® | | + ®to think about it.® | | + | | + | | +::::::::::::: | ::===:: +:::::::::::::::::: | ::::::: :::::: +::::::::::::::::::::::===::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::®Via ferrata®: +>>> N -> South face +>>> W -> Prominence +>>> E -> Tarn + +# Tarn +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC:::::::::::::: + ::::::::::::: +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC::::::::::::: + :::::::::::: + ::::::::::: + BBBBBBBBBB :::::::: + BC C C C C B v :C:::: + B C C C CB CC:::: + BBBBBB C C CB C:::::: + BBBBB C::::::: + C::::::: + C::::::: + C :::::: + C :::::: + C :::::: + @ * C :::::: +:::::::::: :::: CCC:::::: +:::::::::::::::::: :::::::wwwwwwwwwwwwwwwwC:::::::: +::::::::::::::::::::::::: ::::::::::wwwwwwwwwwwww::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::®Tarn®: +>>> W -> Via ferrata + +# South face + | ::: + | :: + B | :: + BB | :: + BB B B | : + B B BB B | + B B B | + B GGGGG B | f @ + GGGGGGG GG BB ------------|--------- + | + * | + ::::::::::|:::: | + ::::::::::|::::: | + | | + | | + | | + | | + | | + | | + | | ®South face®x +>>> N -> Ambush! +>>> S -> Via ferrata +>>> W -> Wind I +>>> E -> Wind II + +# Wind I +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + + v + + + + + + + + + + + + + ®Wind®x +>>> E -> South face +>>> S -> Prominence + +# Wind II +::::::::::::::::::::::::::: CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +::::::::::::::::::::::::: +::::::::::::::::: CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +:::::::: + + + + + + + + + + + + + + + + ®Wind®x +>>> W -> South face +>>> S -> Tarn + +# Ambush! + d ::: +CCCCCCCCCCCCCCCCC b CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC::: + :::: b d :::: +CCCCCCCCCCCCCCC ::::::: CCCCCCCCCCCCCCC :::::::: CCCCC::: + :::::::::: d:::::::: G::: + ::::::::::: :::::::::: G:::: + :::::::::: ::::::::: G::::: + :::::::: ::::::: :::::: + :::: :::::: + . ::::: + . ::::: + . :::: + :::: + . . :::: + . ::: + ::: + ::: + ::: +::::: ---------------------------|--------------------::: +::: | ®Ambush!®: +>>> S -> South face +>>> W -> Old path + +# Old path + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + ®The trails of my youth® + v ® were now throdden by ® + v ® malevolent creatures.® + + + df f + ::::::::::::::::======|====== + :::::::::::::::::::::::::::::: | + ::::::::::::::::::::::::::::: | + ::::::::::::::::::::::::::::::::::::: | +::::::::::::::::::::::::::::::: :::::: | +:::::::::::: :::::: @ | +:::::::::::: * ::::::::::::::::::::::: +::::::::::::: ---|--- ::::::::::::R:::::::::::::: +::::::::::::: | ::::::::::::::::::::: :R::::®Old path®: +>>> E -> Ambush! +>>> W -> Gallery entrance +>>> S -> Sbilf's dwelling + +# Gallery entrance + ::::: +:::::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +:::::: +::::::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC YYYY CCCCC +:::::: YYYYYYYY +::::: YYYYYYYYYY +::::: ::: YYYYYYYYYY +::::: :::::: YYYYYYYY +:::: YYYY +:::: +:::: R +:::: R R R +:::: R R +:::: R R ::: +::::: R R R ::::::::::::: +::::: R R R :::::::::::::::::::::::::::: +:::::: ::::::::::::::::::::::::::::: +:::::::::::=====|=========:::::::::::::::::::::::::::::::::: +::::::::::::: | R :::::::::::::::::::::::::::::::::::: +::::::::::::: R | :::::::::::::::::®Gallery entrance®: +>>> E -> Old path +>>> S -> Ferrous pocket + +# Ferrous pocket +::::::::::::: | :::::::::::::::::::::::::::::::::::: +:::::::: | :::::::::::::: ::::::::::::::::::::: +::::::: | o:::::::::::::R::::: :::R::::CCCC:: +:::::: R | :::::::::::::::::::::::::::CCC::: +:::::: R| ::::::::::::::::::C::: +:::::: --------- R R :::::::::::::C::: +::::: o ::::::::C:: +::::: R R ------------|-- ::::::C:: +:::: R | o ::::C:: +::: ®-What if he struck® | R :::::C: +:: ®the Poleaxe while ® | R :::CC: + R ®I am in the cave?-® | CCCC: + R | R @ RC:::CC + R R -------|------- C::::C + ®I did not stop.® | ::::::C + R R | R ::::::C: +::::: R | :::::C:: +:::R:::::::::::: :::::::: | R ::::::C::: +:::::::::::::::::::::::::::::::: R |:::::::::::::::::C::: +:::::::::::::::R:::::::::::::::::::::::::::®Ferrous pocket®: +>>> N -> Gallery entrance +>>> E -> Sbilf's dwelling +>>> W -> Longana's well + +# Sbilf's dwelling +::::::::::::: | ::::::::::::::::::::: :R::::::::::::::: +::::::::::::: | : :::::::::::::::::::R::::: ::::::: +::::Y::::::: | ::::::::::::::::::::: +:::Y:::::: | : ::::: ::::: +::::::::: | ®A friendly Sbilf offered ® ::::::: +::::::::: | ® me some cheese, I was ® ::::: +::::::::: | ® grateful. ® Y :::: +::::::::: | YYY :::: +:::: :: | Pq YYYYY ::: +::: :: -----------|--------------------------------:: +:: : | ::: + | ®"Trinku kun mi!"® ::: + | ::: +CC | ®-Mi nun ne povas,® ::: +CCCCCCC = | ® eble poste.- ® :::: +:::::::CCCC === | ::::: +:::::::::::: ===== | Y :Y:::: +:::::::::::: ======= | YYY :::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::®Sbilf's dwelling®: +>>> W -> Ferrous pocket +>>> N -> Old path + +# Longana's well +::::= | =:::::::::::::::::::::::::::::::::::::::::::: +::::= | =C::::::::::::::::::::: :::::::::::::::::X::: +::::: | C:::::::::::::::::::::::::::: ::::::::::::R:: +::::: | C::::::::::::: :::::::::::::::::::::::::::::: +::::: | C:::::::::::::::::::::::::::::::::::::::::::: +:::: | C::::::::::::::::::::::::::::::: :::::::::::: +:::: | C :::::::::::::::::::::::::::::::::::::R::: :: +:::: | :::::::::::::::::::::::::::::::::::::R:::::: +::::* | C ::::::::::::::::::::::::::::::::::::::::::: +::::: | C :::::::::::::::::::::::::::::::::::::::::: +::::: | ::: :::::: :::::::::::::::::::::::::: +::::: | C ::: :::::::: +:::: | C R +::: | +::: | C R R +:::: | +::::CCCCCC|CCCCCC::: ::::::::::::: :::::::: +:::::CCCCCCCCCCC:::::::::::::::::::::::::::::::::::::::::::: +:::::::CCCCCCC:::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::®Longana's well®: +>>> E -> Ferrous pocket +>>> N -> Waterfall + +# Waterfall + + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + = = ®A slender figure® + ::=----|----=:::: ® peered me from ® +:::::= | =:::::: ® afar. ® +:::::= | =::::::::GG +:::::= . | =::::::::::G h +:::::= | =::::::::::: G::::::: +:::::= | . =:::::::::::G G:::::::: +:::::= | =::::::::::::GG ::::::::: +:::::= | =:::::::::::::: GG::::::::: +:::::: | :::::::::::::::www www www w:::::::R::: +:::::: .| :::::::::::::::wwwwwwwwwwwwwwwwwwww:::::::Y:: +:::::: .| :::::::::::::::wwwwwwwwwwwwwwwwwwww:::::::::: +:::::: | :::::::::::::::CCCwwwCCCwwwCCCwww®Waterfall®: +>>> S -> Longana's well +>>> W -> Krampuses + +# Krampuses +::: | +:::: | +:A::CCCCCC|CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +:A: | y k +:::CC -----------------------|-------------- CCCCCCCCCCCCCC +::: | +::: | +::: | +:A: ----------- ::: @ +::: GG G:::::::::::: +:: ---|--------------- G:::::::::::::::: +::: | GGGG::::::::::::::::: +::: | GGdGGGG::::::::::::::::::::: +:::: | GGGGGG:::::::::::::::::::::::::::: +:::: | GGfGG:::::::::::::::::::::::::::::::::: +:::: | GGGGGG:::::::::::::::::::RRRR:::::::::::::::: +:::: | jGGGG::::::::::::::::::::::RRRRRRR:::::::::::::::: +::::GGG|GG::::::::::::::::::::::::::RRRRRRRR:::::::::::::::: +:::::::::::::::::::::::::::::::::::RRRRRRRRR:::::::::::::::: +:::::::::::::::::::::::::::::::::::RRRRRRR::::::®Krampuses®: +>>> N -> West face +>>> E -> Waterfall + +# West face +:: | +::X | +:CCCCCCCCCCCCCCCCCCCCCCC | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC +:: | X +: CCCCCCCCCCCCCCCCCCCCC | CCCCCCCCCCCCCCCCCCCCCCCCCC C +:: | :::: +A: f| :::: +::: :::::::::::::::::::::: ::::: +:A: :::::::::::::::::::::::::::: :::::: +:A: :::::::::::::::::::::::::::::::::: :::::: +:A: ::::::: +::: :::::::: +::: ::::::::: +:: ::::: +:: f ::::::: +:: :::::: +:: @ :::::::::::::::::::::::::: +:: ::::|::::::::::::::::::::: +:: :::::|::::::::::::::::: +::: | ®West face®x +>>> N -> A prayer of hope +>>> S -> Krampuses +>>> E -> Air 1 + +# Air 1 + AAAAAAAAAA + . AAAAAAAAA + AAAAAAAA + AAAAAAA + AAAA . + AAA + . AA + AA . + AA . + . AA + AAA + AAA + AAA + AAAAAA + AAAA AAAA . + AAAAAAAAAAA + . AAAAAAA . + AAA + . + ®Air®x +>>> W -> West face +>>> S -> Waterfall + +# A prayer of hope +:: | +:: | +::CCCCCCCCCCCCCCCCCCCCCCCCCCCCC | CCCCCCCCCCCCCCCCCCCCCCCCCC +:: | +::CCCCCCCCCCCCCCCCCCCCCCCCCCCCC | CCCCCCCCCCCCCCCCCCCCCCCCCC +:: | +: | ®+® +:: | | +:: ®-Every step is the® | ::::::::::: +::: ® summit, resist!- ® | ::::::::::: +::: | ::::::: ::: +::: | :::: +::::: | @ :::: +:::: -----|----------------------::: +::: | :::: :::::: +::: | ::::::: +:: | +:: | +:: | +:: | ®A prayer of hope®x +>>> N -> Unfamiliar trail +>>> S -> West face +>>> E -> Air 2 + +# Air 2 + AAAAAAAAAAAAAA . + AAAAAAAAAAAAA + AAAAAAAAAAAA + . AAAAAAAAAAAA + AAAAAAAAAA + AAAAAAAA v + AAAAAAA + AAAAAAA + . AAAAAA . + AAAAAA . + AAAAAAA + AAAAAA + . AAAAAA + AAAAAA + . AAAAAA + AAAAAAA . + AAAAAAA + . AAAAAAAA + AAAAAAAAA + AAAAAAAAA ®Air®x +>>> W -> A prayer of hope +>>> S -> Air 1 + +# Unfamiliar trail + | + | + ®Climbing the last® | + ® face, I kept my ® | +: ® gun close to me.® | @ +: | :::::::::::: +:: ::::::::::::::::::::::::::: +:: ::::::::::::::::::::::::::::::: +:: ::::::::::::::=::=::::::::: +:: ---|--::::::::::::: = = +::: | = = . +:: bb bb b| = = * +:: ======|====== . -----|----- +:: | . | +:: | | ®=® +::: | | ®===® +:: f | | ®=====® +:: ==========================|======================== +::: | +::: | ®Unfamiliar trail®i +>>> N -> Summit pass +>>> S -> A prayer of hope +>>> E -> Air 3 + +# Air 3 + AAAAAAAAAAAAA + AAAAAAAAAAA . + . AAAAAAAAAAA + AAAAAAAAAA + AAAAAAAAAA + AAAAAAAAA + . AAAAAAAA + AAAAAAAAA + AAAAAAAAA + . AAAAAAAA + AAAAAAAA + AAAAAAAA + AAAAAAAA . + AAAAAAAAA + AAAAAAAAA + . AAAAAAAAAA + AAAAAAAAAAA + AAAAAAAAAAA + . AAAAAAAAAAAA + AAAAAAAAAAAAAA ®Air®x +>>> W -> Unfamiliar trail +>>> S -> Air 2 + +# Summit pass + + R +RRRRRRRR RRRRR R RRRRRR + R RRR R RRRR : + BBBBBB RRR RRRRR RRRRRRR RRRR : + BBBBBBBBBB RR RRRR RR :: + RRR BBBBBBBBBBBB RR :: +R BBBBBBBBBBBB RRRRR R RRRRRRRRR RR : + BBBBBBBBBB RRR R RRRR RRRRRRRRR RRRR : + BBBBBB RRR :: + :: + :: + ®I advanced carefully.® :: + :: + ::: + :::::: + :::::::::::::::: :::::::: +:::::::::::::::::::::::::::::::: :::::::::::: +::::::::::::::::::::::::::::::::::::|::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::|j::::::::®Summit pass®: +>>> S -> Unfamiliar trail +>>> W -> Stronghold + +# Stronghold + + + RRRRRR RRRRRRRR RRR + RRRRR RR RRRRRRRRRRRRR RR +RRRRRRRRRR RRRR + RRRRRRRR = k R=RRR + ================= RRRRRRRR + RRR RRRRRR============== +RRR RRR RRRRRR == ===== == + RRRRRRRRRRRRR == ===== == + == ===== == + ®I seized the moment!® ============= + ============= + ============= + j . . + :::::::::::: . . + ::::::::::::::::::: . . :::: +::::::::::::::::::::::::::::::::::=:::::::::::=::::::::::::: +::::::::::::::::::::::::::::::::::=:::::::::::=::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::®Stronghold®: +>>> E -> Summit pass +>>> W -> Orcolat's hovel + +# Orcolat's hovel +::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::: +:::Y::::::::::: RRR ::::::::::::: +::Y:::::: :::::::::RR RRRRRRRR RRRRRR +::::::::RRRRRRRRRRRRR ::::: RRR RRRR +:::::::R :: RR +::::::: ®THE ORCOLAT® : +:::: : RRRR RRRRRRR +::: ® WAS NOT ® RRR RRRR RR RR RRRR +::: RR RRRRRR RRR +::: ®IN HIS CAVE.® +:::: ®--->® +::::AA +::::::A ®I tracked back.® +:::::::AA ®|® +::::::::: ®|® +:::Y:::::AA ®v® :::::: :::::::::::::: +:::Y::::::: ::::::::::::::::::::::::::::::::::: +:::::::::::®I despaired.®::::::::::::::::::::::::::::::::::: +::::::::::: ::::::::::::::::::®Orcolat's hove®: +>>> E -> Stronghold (reloaded) +>>> S -> Despair + +# Despair + i iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + i i + i i + i i + i i + i i + i i + i i + i i ®Teeming despair.® + i i + i i + i i + i i + i i + i i + i + i + i + i + iiiiiiiiiiiiiiiiiiiiiiii iiii®Despair®i +>>> N -> Orcolat's hove +>>> S -> Temblor + +# Temblor + iiiiiiiiiii i + i i + i i + i i + i ®Before long I could® i + i ® feel the tremor. ® i® \ ® + iiiii i® = \\\\ ® + i i®==== = \\ ® + i i®= == ® + i i® == ® + i i® \® + h i i® \ \® +®= == ® i ®Could I have® i® \ || ® +®===\ ® i ® done more? ® i® | ® +® === = \ ® i i® | ® +® \\ ||\ ® i + i® = | ® +® ||\ \\ ® i i® =| ® +® | \ ® iiiiiiiiiiiiiiiiiiiiiiiiiiiiii +® ||||| ® +® ® ®Ending #1: Temblor®x +>>> N -> Despair + +# Stronghold (reloaded) + + + RRRRRR RRRRRRRR RRR + RRRRR RR RRRRRRRRRRRRR RR +RRRRRRRRRR RRRR + RRRRRRRR = k R=RRR + ================= RRRRRRRR + RRR RRRRRR============== +RRR RRR RRRRRR == ===== == + RRRRRRRRRRRRR == ===== == + == ===== == + ============= + ============= + ============= + j . . + :::::::::::: . . + ::::::::::::::::::: . . :::: +::::::::::::::::::::::::::::::::::=:::::::::::=::::::::::::: +::::::::::::::::::::::::::::::::::=:::::::::::=::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::®Stronghold®: +>>> E -> Summit pass (reloaded) +>>> W -> Orcolat's hovel + +# Summit pass (reloaded) + + R +RRRRRRRR RRRRR R RRRRRR + R RRR R RRRR : + BBBBBB RRR RRRRR RRRRRRR RRRR : + BBBBBBBBBB RR RRRR RR :: + RRR BBBBBBBBBBBB RR :: +R BBBBBBBBBBBB RRRRR R RRRRRRRRR RR : + BBBBBBBBBB RRR R RRRR RRRRRRRRR RoRR : + BBBBBB RRR o:: + o :: + + + + :: + @ :::::: + ::::::::::::::: :::::::: +:::::::::::::::::::::::::::::::: :::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::::®Summit pass®: +>>> E -> Stone casket +>>> W -> Stronghold (reloaded) + +# Stone casket + :: i + RRRRRRRRR : ::: i + RRRRRRRRRRRR j RRRR:: ::::RRR RRRR +RRRRR -------- :::::::::: RR RRRRRR i + f :::::::::::::: RRRRRRRR i + -------- RR ::::::::::::::: i + RRRRRR RR :::: ::::: i + RRRRRRR ::: ::: RRR i +RRRRRR -------|-- ::: :: RRR RRRi + | ::: RR RRRRRRRR i + | ::: RRR i + | ::: i + ®His Pickaxe!® | ::: i + | ::: i + --------- ::: ®I clinged to the® i + ::: ®Pickaxe, together® i + ::: ®falling into the ® i +:::::::::::::::::::: ::: ® void. ® i +::::::::::::::::::::::::====::: i +::::::::::::::::::::::::::::::::: ®Stone casket®i +>>> N -> Clear and precious and beautiful +>>> S -> Landslide +>>> W -> Summit pass (reloaded) + +# Clear and precious and beautiful + ®Clear and precious and beautiful®x + + Y Y BB +BB Y Y BBBBBBBBBBBBB Y BBB + BBBBBBBB B BBB BBBBBY Y BBBBBBBBB + BBBB YBBBBB YBBBBB Y Y Y Y +Y Y YY Y + Y Y BB Y +BBB Y Y BBBBBBB BBBBB B + BBBBB BBBB BB BBBB BBYYBBBBB + BB B BBBBBBBBBBBBBB Y BBB + Y + Y Y Y + + + + + + + x +>>> S -> Stone casket + +# Landslide +i® | / | || | ®i +i® | | | | | ®i +i® | // | || | ®i +i® || / | || ®i +i® / \ | / | ®i +i® | / | | ®i +i® | // | | ®i +i® \ | /| \ / | ®i +i® / | / | | | ®i +i® / / | / | | ®i +i® ®i +i® / \\ / | | | ®i +i® \\ | || ®i +i® \| / | |\ | | | ®i +i® \ | | ®i +i® \ | |/ | |/ | ®i +i® \ |// | ®i +i® \ | / | / || ®i +i® | / | ®i +i® | | / Landslide®i +>>> S -> Landslide (cont.) + +# Landslide (cont.) +i® / / /®i +i® || /. . / . . | / ®i +i® . . | .. / . / ®i +i® / . / | / / ®i +i® . | . . / / . ®i +i® | / . . | / ®i +i® . ||/ | . ®i +i® . . | / . / / .. ®i +i® .| . | . . .| . . ®i +i® ./ / // / / / ®i +i® | | / . .®i +i® . / | / / | . ®i +i® . | | / / / / . ®i +i® | | / . . . ®i +i® qqq qq q qqq. / . .. / / . ®i +i® | / / / | ®i +i® / / | | / /. . ®i +i® / | . . |. / ®i +i® / . ®i +i® | . . / | / Landslide®i +>>> S -> Intercession + +# Intercession +~~~ YY ~~~ +~~~ ~ YYYY ~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YY YY ~~ ~~~ +~~~ ~~ YYYYYYYYYYYYYYYYYY ~~ ~~~ +~~~~~ ~~~~~ +~~~~~~~~~ ~~~~~~~ ~~~~~~~~~ +~~~~~~~~~~~~~ ~~~~~~~~~~~~~~ ~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~ +~~~~~~ ~~~~~~ ~~~~~~~ ~~~~ +66 ® I held to ® ®I fell, I® ~~~~ +66 ®the Pickaxe.® ®fell for a® ~~~~ +66 ®long time.® ~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~ +®Intercession®~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~ +>>> S -> Fall +>>> W -> Frammezzo + +# Frammezzo + + + + + + + + + + + + + + + + + + + + x +>>> S -> Memories +>>> W -> Intercession + +# Memories +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~ ~~ +~~~~~~~~~ ~~ +~~~~~~~ ®I still have got a® ~~ +~~~~~~ ® shard of the ® ~~ +~~~~~ ® Pickaxe with me. ® ~~ +~~~~ ~~ +~~~ ~~~~~~~~~~~~~~~~~~~~ ~~ +~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~ ~~ +~~ ~~ +~~ ® It is malleable and ® ~~ ~~ ~~ +~~ ® exhibits a beryl ® ~~ ~~ ~~ +~~ ®luminescence at night.® ~~ ~~ ~~ +~~~ ~~ ~~ ~~~ +~~~~ ~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~ +~®Memories®~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~ +>>> S -> Memento + +# Memento +i i ~ +i i ~ i +i®______________________________® i ~ i +®(______________________________)® i ~ i +i ®| \|® i ~ i +i ®| |® i ~ i +i ®| I enclose it in this |® i ~ i +i ®| diary, to corroborate |® i ~ i +i ®| my words about today. |® ~ i +i ®| |® ~ i +i ®| |® ~ i +i ®| |® ~ i +i ®| ..........|® ~ i +i ®|............... ® ~ i +i ~~ i +i ~~~~~~~~~~~~~~~~~~ i +i ~~~~~~~~~~~~~~~~~~~~~ i +i i +i i +i ®Ending addendum: Memento®i +>>> S -> Fall + +# Fall +iSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSi +i® : | ®i +i®| : | ||®i +i®| :| : | : |®i +i®| | :: | | | | | ::: |®i +i® | ::: || || :| ||: : :| : |®i +i® | |:: : : | : :: : | |:: |®i +i® : :: ::: |:::: :: : | ®i +i®| | : :::| : ::: | | | : |®i +i®| | :: :: ::: | | || : ®i +i® : :: : | :::: | : |®i +i® | : : : :: : : : ®i +i® | | : : : |: | : | || | ®i +i® | |: : :: | | : : | ®i +i® | : |:| :| || : | ®i +i® | : :: : :: | | :: : | | ®i +i® | : | : : | : ||| ::::: : ®i +i® | ::|: : :| : | ®i +i® | | | | | ®i +i® | | : | : Fall®i +>>> S -> Fall (cont.) + +# Fall (cont.) +i® . | | || . ®i +i® . ¨. . | | ||| ¨¨¨. ®i +i®|. ¨ . ¨ . | ¨ . .®i +i® |. . | | . .. ®i +i® ¨ . | ¨ . ¨ .. ®i +i® .| . ¨ ¨ | . ®i +i® . .| . ¨ . . ®i +i® | | ¨ . ¨ | ®i +i® . ¨ . ¨ ¨ |. . ®i +i® | || . . ¨ ®i +i® . ¨ . . . . | . ®i +i® | .... ¨. | . ®i +i® | . . . ®i +i® . | ¨ . ¨ | . ®i +i® | . ¨ ¨ || ®i +i® . | . .¨. ¨. | ®i +i® |¨ . . ¨ . || . ®i +i® . . ¨ ... . . ®i +i® . | | ¨ .. |. . ®i +i® .. | ¨ | . | . Fall®i +>>> S -> Scree + +# Scree +i®: : :: : : : | : ®i +i®: :: : : : ..: : ®i +i® : |: : ::. : : : : || :: ®i +i® : .:. :: : ||: |: : ®i +i® : | : .: :: : || :. . : ®i +i® : | .. : : | .|: . : ®i +i® : .: : : : : : . ®i +i® . : : :| : .::: . : ®i +i® : :| : : : . | . |: : : ®i +i® | : . : : . : : . : ®i +i® : :. : |: : : : : ®i +i®: : . | : . | . : ®i +i® | : : : : : . :: : ®i +i® : : .: : | : : : : ®i +i® : : :| : : |:. : ®i +i® : . : | :. : : . : : : ®i +i® : .| : : : | : : . :|: : : : ®i +i® : . : : |: : .. : : ®i +i® : : : : . .:: : : : ®i +i® : : . : :: Scree®i +>>> S -> Scree (cont.) + +# Scree (cont.) +i® : . .. : . . : ®i +i® :.- . . ::: : : : ®i +i® . :..:: . : : .- : ®i +i® : .- : : : :: : - : ®i +i® : : . : .- : :: - . : ®i +i® ..- . :: . ::- : : : - . : ®i +i® : : : ..:: - : : - : ®i +i® : . : . : : : :: - . : ®i +i® . -: . .: - : : ®i +i® : . - : q : : : . ®i +i® . ::: : : : -: . : ®i +i®:: qq : . : : - : ®i +i® . :- :: . : : - : : ®i +i®: . - : qq . : : : ®i +i®: . : : q . : - : ®i +i®: : :: --: q : : : : : ®i +i®: : .: ::. q . : -: - : ®i +i®: : .: .- : : . --: . : : ®i +i®: :. . -- : .: - : . : :: ®i +i® : :. - : --- :: .. :: Scree®i +>>> S -> Little creek (revisited) + +# Little creek (revisited) +iBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB=:: +i =-= +iBBB BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB=-=.- -= +i GGGGGGGGGG == -==-- +i GGGPGGGGGPGGGG ®I still do not know® -= --=.-- + GGPPPGGGPPPGGGGG ®how I survived the® :....= .-. + GGGGPGGGGGPGGGGPGG ® landslide. ® = == -.. + GGGGPGGGPGGGGGGPPPG =:-- = --.-- + GGGPPPGPGGGGPGGGPGG == -- --- ..-- + GGGPGPPPGGPPPGGGG ®My right leg® =: ----- .. - - + GGGGPGRGGPGGG ®was broken. ® == ---...===--- + GGRRRGG :=®//®..- - --- + RRR ®The Pickaxe® == -.. ------- + RRR ® in pieces.® ==:::=::== ==-.===-=---= + RRR = YY==.==...- --- -- + RRR = ::::=====.======Y==Y-- ---- --- +:: RRR :: ==--::...=====Y::==:-:YYY --- +::: ::::::::::::::::===......w====w:w::::---GG::::::=--GG +:::::::::::::::::::::==:----w=====--::::w----ww========www== +:::::::::::::::::::::::::::====--::::---wwwww®Little creek®w +>>> W -> Service ditch (revisited) + +# Service ditch (revisited) +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + +CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC + + + ®The earthquake which® + ®threatened the valley® + ® is averted! ® + + + ----------|---------- + | + | + ®I am in pain while ® | +:: ®I write these notes.® | +:: | +:: :::::::::::::::::: +::: :::::::::::::::::::::::::::::::::::R::::::::::::: +:::GGGGGGGG::::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::::::::::®Service ditch®: +>>> W -> Hearth (revisited) +>>> E -> Little creek (revisited) + + +# Hearth (revisited) + +BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB + +BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB +i +i +i +i ==== ®o® +i === ===®j® ®It is time to put the® +i === === ®candle out, and rest. ® +i === === +i === BBB === ® -G ® +i = + BBB = +i = = +i =-------- ::::::::::::: +i = --- ::::::::::::::::::: +:: = --- :::::::::::::::::::::::: +::::=::::::::::::::=:::::::::::::::::::::::::::::::::::::::: +::::=::::::::::::::=:::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::::::::::®Ending #2: Fullfilled®: +>>> E -> Service ditch (revisited) + +# Template + + + + + + + + + + + + + + + + + + + + x +>>> N -> Exit + +# Fall/scree template +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +i® ®i +>>> S -> Exit + diff --git a/stories/t_gymnasium.vns b/stories/t_gymnasium.vns new file mode 100644 --- /dev/null +++ b/stories/t_gymnasium.vns @@ -0,0 +1,242 @@ +@@ +@@ Level for automated test +@@ + +story_name: Gymnasium +room_size: 24 79 +start_room: Gymnasium uno + +@@ +@@ Each room is composed by: +@@ - a title (starting with # ...); +@@ - the level itself (expressed in plain characters); +@@ - and exits (starting with >>> ...). +@@ + +# Gymnasium uno +........®1®.......®2®.......®3®.......®4®.......®5®....|..®6®.......®7®........ + . . . . . | . . + . . . . . | . . + . . . . . | . . +®5®....................................................|....................... + . . . . . | . . + . . . . . | . . + . . . . . | . j. + . . . . . | . --|---- +®10®...................................................|...........|........... + . . . . . | . * | . + . . . . . | . | .- + . . . . . ----------|----- + . . . . . . | . +®15®............................................................|.............. + . . *. . b b. : . | . + . . ---------------------------- . | . + . . . . . . | . + . . . . . . | . +®20®............................................................|.............. + . * . . . . . | . + . * . . . . . | . +b . @ . . . . . | . +----wwwww---------------------------------------------------------------------- +>>> N -> Gymnasium tre +>>> E -> Gymnasium due +>>> W -> Gymnasium quattro +>>> S -> Non existant room + +@@ "Non existant room" is a test/check against "fails on neighbourPlant". + +# Gymnasium due +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . . . . + . . . . . . . + . . . . . . . +®5®............................................................................ + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®10®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + .-|----|---|-- . . . . . +®15®.......|....|...|.......................................................... + . | | .f . . . . . + . | 22222 22 . . . . . + . | wwwww . . . . . + .-|--------- . . . . . +®20®.......|..........................................................:::...... + . | . . . . . . *:: + . | . . . . . . *:: + . | . . .@ . ----wwww- . ::: +------------------------------------------------------------------------------- +>>> W -> Gymnasium uno + +# Gymnasium tre +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . . . . + . . . . . . . + . . . . . . . +®5®............................................................................ + . . . . . . . + .-b d- . . . . . . + . ----- . . . . . . + . . . . . . . +®10®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®15®........................................................................... + . . . . . . . + .®<----® . . . . .® ----> ®. + .®Witch® . . . . .®Krampus®. + . . . . . . . +®20®........................................................................... + . . . . . . . + . . . . . . . + . . . . ww . . . +-------------------------------------------------------|----------------------- +>>> S -> Gymnasium uno +>>> E -> Gymnasium sei +>>> W -> Gymnasium sette + + +# Gymnasium quattro +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . =======. -|- . . + . . . . =======. | . . + . . . . =======. | . . +®5®.......................................=======....|......................... + . . . . =======. | . . + . . . . . | . . + . . . . . | . . + . . . . . | . . +®10®.................................................|......................... + . . . . . | . . + . . . . . | . . + . . . . - d*- . | . . + . . . . ------- . | . . +®15®.................................................|......................... + . . . . . | . . + .® Bird ®. . . . | . . + .®<------®. . . . | . . + . . :. . . | . . +®20®.....................::::........................|......................... + . . ::::: . . | . . + . . +:::::: . . | . . + @ . . ::::::: . . | . . +------------------------------------------------------------------------------- +>>> E -> Gymnasium uno +>>> W -> Gymnasium cinque +>>> N -> Gymnasium sette + +# Gymnasium cinque +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . . . . + . . . . . . .o + . . . . . . . +®5®............................................................................ + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®10®........................................................................... + . . . . . . . + . v . . . . . . + . . . . . . . + . . . . . . . +®15®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®20®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . +------------------------------------------------------------------------------- +>>> E -> Gymnasium quattro + +# Gymnasium sei +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + ^ . ^^. . . . . . + . . . . . . . + . . . . . . . +®5®............................................................................ + . . . . . . . + . . . . . . . + . . . . k . w . . + . . . . ---------------- . . +®10®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®15®........................................................................... + . . . . . . . + . . . . . . . + . . . ,,,,,, . . . . + . . ----|-------- . . . . +®20®.........................|................................................. + . . | . . . . + . f . | . . . . + . --. | . S . . * . +------------------------------------------------------------------------------- +>>> W -> Gymnasium tre + +# Gymnasium sette +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . . . . + . . . . . . . + . X . . . . . . +®5®............................................................................ + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®10®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®15®........................................................................... + . . . . . . . + . . . ----|----- . . . + . . . | . . . . + . . . | . . . . +®20®................................|.......................................... + . . . | . . . . + . . . | . . * . . :: + . . . | . . * . :::::::::::::: +----------------------------------------------------- ------------------------- +>>> E -> Gymnasium tre +>>> S -> Gymnasium quattro + +# Gymnasium standard +........®1®.......®2®.......®3®.......®4®.......®5®.......®6®.......®7®........ + . . . . . . . + . . . . . . . + . . . . . . . +®5®............................................................................ + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®10®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®15®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . + . . . . . . . +®20®........................................................................... + . . . . . . . + . . . . . . . + . . . . . . . +------------------------------------------------------------------------------- +>>> W -> Gymnasium uno + diff --git a/stories/z_editor.vns b/stories/z_editor.vns new file mode 100644 --- /dev/null +++ b/stories/z_editor.vns @@ -0,0 +1,208 @@ +@@ +@@ STORY WRITING EXPLAINED +@@ ----------------------- +@@ +@@ By reading this file you will be able to write your own Stories. +@@ Consider sending them to me (fa-ml@ariis.it) when finished! +@@ + +@@ +@@ Lines starting with @@ are comments and thus ignored by the +@@ interpreter. +@@ Comments *cannot* appear inside rooms, just between them. +@@ + +@@ + +@@ +@@ Story files have `.vns` extension and use a UTF-8 encoding. +@@ Your editor is probably already doing the Right Thing®. +@@ If problems arise, you can easily check/convert (e.g. on notepad++ +@@ the encoding is shown on bottom-right corner and you can change +@@ it with "Format > Encode in UTF-8"). +@@ + +@@ +@@ At the beginning of each Story file you will find three global +@@ arguments: story_name, room_size, start_room. +@@ Each argument follows this syntax: +@@ +@@ argument_name: value +@@ +@@ `room_size` is the mandatory size (rows by columns) of each Room. +@@ Tip: have your text editor display trailing whitespace! +@@ + +story_name: Story editor +room_size: 24 48 +start_room: Editor one + +@@ +@@ Each room is composed by: +@@ - a title (starting with "# "); +@@ - the level itself (expressed in plain characters); +@@ - and exits (starting with ">>> "). +@@ +@@ so the levelmap is sandwiched between the title and the exits. Note +@@ that you can have multiple exits by simply stacking them, like e.g. +@@ +@@ >>> N -> Big room +@@ >>> S -> Beach +@@ >>> E -> Prison cell +@@ + +# Editor one +: +: +: @ ®Want to write your® +: --- ® own levels? ® +: +: : +: : +: b : +------------------------ : + : + : + : + : + ----------------|--------- +: | +: | +: ®Open ./stories/editor.vns with® | +: ®a text editor for instructions® | +: ® and examples. ® | +: | ®-->® +: | +:wwwwwwwwwwwwwwww- | +:wwwwwwwwwwwwwwww::::::::::::::::::::::::::::::: +:wwwwwwwwwwwwwwww:::::::::::::::::®Square room®: +>>> E -> Editor two + +@@ +@@ Whenever '@' reached the edge of the room map, the game will try to find +@@ the appropriate exit listed beneath the level data. If such room does +@@ exist, you will get a crash with an error! +@@ + +@@ +@@ VALID LEVEL TILES: +@@ +@@ - solid platform. +@@ +@@ : another kind of solid platform. +@@ +@@ = yet another kind of solid platform. +@@ +@@ i invisible solid platform. +@@ +@@ . background tile (non-solid). +@@ +@@ % (where % is any of R Y G B P C), color dot (`.`). Colours are +@@ Red, Yellow, Green, Blue, Purple, Cerulean +@@ +@@ * Stars, collectible, used to unlock Lock platforms. +@@ +@@ # (where # is any digit from 1 to 9), Lock platform: will behave +@@ like a solid platform and dissolve when player collects at least +@@ # stars. +@@ +@@ @ spawn point. Character will restart here after dying. +@@ +@@ | ladder tile (can be climbed). +@@ +@@ w water tile, hazardous +@@ +@@ A spike tile, hazardous +@@ +@@ x transparent, non-solid tile. The parser will check for rooms with +@@ mismatched dimensions. This is quite useful, but how to draw a room +@@ with an unoccupied, empty space on the right then? +@@ Here is where 'x' is useful: add one to the bottom-right of your +@@ room to state "this is not an error, I am fine with this room +@@ design" to the game. +@@ Since the tile is not otherwise useful, use it only when the +@@ parser complains about your map. +@@ +@@ prop chars: any character sandwiched between '®'s loses any function +@@ and becomes a non-solid, background tile. +@@ Useful when you want to write something in the room and +@@ not having it treated as a real tile. +@@ +@@ d or f: dumb enemy (falls off ledges). 'd' moves West, 'b' +@@ moves East. +@@ +@@ f or j: smart version of 'd', 'f' moves West, 'j' moves East. +@@ +@@ v Flying animal, drops pellets which kill the player. +@@ +@@ o falling projectile. +@@ +@@ k or y: blade-throwing Krampus, 'k' moves East, 'y' moves West. +@@ +@@ , Stinging nettle (a poisonus plant), cycles between states ('.', +@@ ';' and 'A'), hazardous when fully grown (green `A`). +@@ +@@ X Longana (a water witch), hunts the player, flying. She is not +@@ stopped by walls or any solid tile. +@@ +@@ S (experimental -- will be displayed in game as '.') permanently slows +@@ the player down for this Story. + +# Editor two + +® A ® +® / \ ® +® / \ A ® +® / \ / \ Happy writing! ® +® | / \ : ® +®,_*.| / \ .:. ® +® \_ | c ,:, ® +® \| cSs ,:, ® +® \_ s|s .:. ® +® \*__|___|___ ® : +® \ ® :: + :: + :: + + :: + ::: + -|----------------::: + | ::: + | ::: + | ** ::: + | ** ::: + | ::: +:::::::::::::::::::::::::::::::::::::::::::::::: +::::::::::::::::::::::::::::®Glimpse of forest®: +>>> W -> Editor one + +@@ +@@ For obvious reasons, do not use tabs while writing Story files. +@@ Of course you can use your ASCII-art editor of choice too, and +@@ paste he result in the relevant section of your Story file. +@@ Find the ASCII editor I used for "The Orcolat" here: +@@ +@@ http://www.ariis.it/static/articles/venzone/ascii-mapper/index.html +@@ + +@@ +@@ A useful tool to develop stories is `watch mode`. +@@ Open your editor on the story you are modifying and start venzone +@@ like this: +@@ +@@ venzone --watch path/to/story.vns +@@ +@@ Watch mode automatically reloads the map every time the .vns file +@@ is saved. Now just edit the story on the left, see the game automatically +@@ update on the right, play test immediately! +@@ Tip: change `start_room` to play test different parts of the game. +@@ You can exit this loop by using Ctrl-C. +@@ + +@@ +@@ If you find a bug or feel need new features, contact me at +@@ +@@ fa-ml@ariis.it. +@@ +@@ Happy writing! +@@ + diff --git a/test/GymnasiumSpec.hs b/test/GymnasiumSpec.hs new file mode 100644 --- /dev/null +++ b/test/GymnasiumSpec.hs @@ -0,0 +1,209 @@ +{-# Language RankNTypes #-} + +module GymnasiumSpec where + +import Gymnasium +import Meeple.Operate +import Room +import Story +import Screen + +import Lens.Micro.Platform + +import Test.Hspec + + +ng :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation +ng fp a o = (a <$> testGymnasium fp) `shouldReturn` o + +ngFalse :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation +ngFalse fp a o = (a <$> testGymnasium fp) `shouldNotReturn` o + +vmap :: Functor f => SimpleGetter b c -> SimpleGetter (f b) (f c) +vmap lf = to (\a -> a ^. to (fmap (view lf))) + +spec :: Spec +spec = do + + -- To replay these: + -- `cabal new-repl test` and then + -- λ> :m +Gymnasium + -- λ> narrateGymnasium "test/records/ladder-exit.vr" + + describe "gymnasium tests" $ do + + + -- COLLISION -- + + it "does not collide with similar meeple" $ + ng "test/records/solid-similar.vr" + (\s -> let ms = s ^.. screen . meeples + . each . filtered (not . isPlayer) + in map (view position) ms) + [(7,14), (7, 15)] + it "collides diagonally" $ + ng "test/records/diagonal-collision.vr" + (^. screen . player . vmap position) (Just (23, 15)) + it "baddies eat star" $ + ng "test/records/eat-star.vr" + (^. screen . meeples . to length) 4 + + -- HAZARDS -- + + it "dies in the water" $ + ng "test/records/water.vr" + (^. screen . player . vmap position) (Just (23, 15)) + it "baddies die in the water" $ + ng "test/records/baddies-die.vr" + (^. screen . meeples . to length) 4 + + -- JUMP -- + + it "does not skip cells while jumping" $ + ng "test/records/jump-tick.vr" (^. stars) 2 + it "jumps at 2 height" $ + ng "test/records/jump-2.vr" (^. stars) 1 + it "jumps at 3 height" $ + ng "test/records/jump-2.vr" (^. stars) 1 + it "jumps on top of rope" $ + ng "test/records/jump-after-rope.vr" (^. stars) 1 + it "resets direction when hitting obstacle (fall)" $ + ng "test/records/reset-direction.vr" + (^. screen . player . vmap position) (Just (23, 50)) + + -- LADDER -- + + it "climbs a ladder" $ + ng "test/records/ladder.vr" + (^. screen . player . vmap position) (Just (12, 65)) + it "climbs a ladder connecting two rooms" $ + ng "test/records/ladder-exit.vr" + (^. screen . room . title) "Gymnasium tre" + it "descends a ladder" $ + ng "test/records/down-ladder.vr" + (^. screen . player . vmap position) (Just (23, 65)) + it "falls off a ladder" $ + ng "test/records/falls-off-ladder.vr" (^. stars) 0 + + -- MOVEMENT -- + + it "stands doing nothing" $ + ng "test/records/stand.vr" + (^. screen . player . vmap position) (Just (23, 15)) + it "space to stop" $ + ng "test/records/space-stop.vr" + (^. screen . player . vmap position) (Just (23, 30)) + it "does not fall through diagonal holes" $ + ng "test/records/diagonal-hole.vr" + (^. screen . player . vmap position) (Just (12, 70)) + it "does not fall through floow in switching rooms" $ + ng "test/records/room-switch-ground.vr" + (^. screen . room . title) "Gymnasium due" + it "allows different-direction meeples" $ + ng "test/records/dumb-direction.vr" + (^. screen . meeples . to length) 9 + it "resets SCI on obstacle" $ + ng "test/records/sci-stop.vr" + (^. screen . player . vmap position) (Just (20, 30)) + it "get stopped by a wall in the next room" $ + ng "test/records/stop-next-room.vr" + (^. screen . room . title) "Gymnasium tre" + it "jumps full height between rooms" $ + ng "test/records/jump-between.vr" (^. stars) 2 + it "is slow" $ + ng "test/records/slow.vr" (^. stars) 0 + it "is slow when changing rooms too" $ + ng "test/records/slow-rooms.vr" + (^. screen . room . title) "Gymnasium tre" + + -- SPAWNS -- + + it "respawns in new spawn-point if dead" $ + ng "test/records/respawn.vr" + (\s -> (s ^. screen . player . vmap position, + s ^. screen . room . title)) + (Just (23, 41), "Gymnasium due") + it "respawns in new old spawn-point if new one not touched" $ + ng "test/records/no-touch-spawn.vr" + (^. screen . room . title) "Gymnasium uno" + it "restarts from last-savepoint" $ + ng "test/records/restarts.vr" + (\s -> (s ^. screen . player . vmap position, + s ^. screen . room . title)) + (Just (23, 41), "Gymnasium due") + + -- BEASTS -- + + it "smart d walks on rope" $ + ng "test/records/smart-rope.vr" + (^. screen . player . vmap position) (Just (23, 15)) + + let isB :: Meeple -> Bool + isB (MBird _) = True + isB _ = False + bird :: HasScreen s => SimpleGetter s Bird + bird = meeples . to (filter isB) . to head . to (\(MBird b) -> b) + it "bird does not start stuck" $ + ngFalse "test/records/bird-start-stuck.vr" + (^. screen . bird . position) (12, 18) + it "bird does not get stuck" $ + ngFalse "test/records/bird-get-stuck.vr" + (^. screen . bird . position) (13, 11) + it "gets killed by stone" $ + ng "test/records/stone-kill.vr" + (^. screen . player . vmap position) (Just (23, 4)) + it "stone gets destroyes on ground" $ + ng "test/records/stone-safe.vr" + (^. screen . player . vmap position) (Just (23, 71)) + + -- krampus + it "blades get destroyed on screen exit" $ + ng "test/records/blades-destroyed.vr" + (^. screen . meeples . to length) 8 + it "blades kill player" $ + ng "test/records/blades-kill.vr" + (^. screen . room . title) "Gymnasium uno" + it "blades kill meeple" $ + ng "test/records/blades-kill-meeple.vr" + (^. screen . room . title) "Gymnasium sei" + + -- locks + it "lock is ground" $ + ng "test/records/lock-ground.vr" + (^. screen . room . title) "Gymnasium due" + it "lock is ground for meeples" $ + ng "test/records/lock-ground-meeples.vr" + (^. screen . room . title) "Gymnasium uno" + it "lock is ground after 1 star" $ + ng "test/records/lock-ground-1-star.vr" + (^. screen . room . title) "Gymnasium due" + it "lock dissipates" $ + ng "test/records/lock-away.vr" + (^. screen . room . title) "Gymnasium uno" + + -- star/lock interaction + it "Can open lock from another room" $ + ng "test/records/star-lock-away.vr" + (^. screen . room . title) "Gymnasium uno" + it "stars are collectible only once" $ + ng "test/records/star-collect.vr" + (^. screen . room . title) "Gymnasium due" + it "stars are collectible only once (meeple)" $ + ng "test/records/star-collect-meeple.vr" + (^. stars) 0 + + -- nettle + it "Nettle kills you" $ + ng "test/records/nettle-kills.vr" + (^. screen . room . title) "Gymnasium uno" + it "Nettle kills you not when sleeping" $ + ng "test/records/nettle-kills-not.vr" + (^. screen . room . title) "Gymnasium sei" + + -- witch + it "kills player" $ + ng "test/records/witch-kill.vr" + (^. screen . room . title) "Gymnasium uno" + it "floats through obstacles" $ + ng "test/records/witch-spirit.vr" + (^. screen . room . title) "Gymnasium uno" diff --git a/test/ParseSpec.hs b/test/ParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/ParseSpec.hs @@ -0,0 +1,152 @@ +module ParseSpec where + +import Test.Hspec + +import Tile +import Parse +import Room +import Plant +import Story +import Input +import Meeple.Operate + +import Terminal.Game +import Lens.Micro.Platform + +import qualified Control.Monad.State as S + + +myp :: Parser a -> String -> a +myp p c = parseRun "" p c + +ct :: Char -> Tile +ct c = maybe (error "ct - ParseSpec") id (charTile c) + + +spec :: Spec +spec = do + + -- STORY -- + + describe "pcomment" $ do + it "parses a comment" $ + myp pcomment "@@ comment\n" `shouldBe` () + it "eof is ok too" $ + myp pcomment "@@ comment" `shouldBe` () + + describe "pstoryname" $ do + it "parses a story name" $ + myp pstoryname "story_name: Proclo\n" `shouldBe` "Proclo" + + describe "proomsize" $ do + it "parses a mandatory room size" $ + myp proomsize "room_size: 11 18\n" `shouldBe` (11, 18) + + describe "pstory" $ do + it "parse a story" $ + (^. rooms . to length) <$> + readStory "stories/a_first-stroll.vns" `shouldReturn` 4 + it "can end on EOF" $ + let tt = init . unlines $ + ["story_name: test", + "room_size: 2 2", + "start_room: Uno", + "", + "# Uno", + "xx", + "xx", + ">>> N -> Uno"] in + myp (_name <$> pstory) tt `shouldBe` "test" + + + -- SCREEN -- + + + -- ROOM -- + + describe "ptitle" $ do + it "parses a screen title" $ + myp ptitle "# alloro\n" `shouldBe` "alloro" + + describe "ptile" $ do + it "parse a single tile" $ + tType (myp ltile ".") `shouldBe` Background + + describe "proom" $ do + it "parses a room" $ + myp proom "# aaa\n \n>>> E -> bbb" + `shouldBe` + let p = defaultPlant + r = defaultRoom & title .~ "aaa" + & plant .~ p + & exits .~ [Exit E "bbb"] + in r + + -- PLANT -- + + describe "pelements" $ do + it "parses a plant" $ + myp pelements "\n @-" + `shouldBe` [Blank, Blank, + EMeeple (MSave $ defaultSave (2,2)), + ETile (ct '-') (2,3)] + it "parses a prop" $ + myp pelements " ®-®" + `shouldBe` [Blank, Blank, + ETile (creaProp '-') (1,3), + Blank] + it "parses a multichar prop" $ + myp pelements "®12®" + `shouldBe` [Blank, + ETile (creaProp '1') (1,2), + ETile (creaProp '2') (1,3), + Blank] + + + -- EXITS -- + + describe "pcard" $ do + it "parses a cardinal element" $ + myp pcard "N" `shouldBe` N + it "it is case unsensitive" $ + myp pcard "n" `shouldBe` N + + describe "pexit" $ do + it "parses an exit" $ + myp pexit ">>> N -> qoo" `shouldBe` + Exit N "qoo" + + -- ELEM/TILE -- + + describe "pelem" $ do + it "parses a prop, if we are in prop-mode" $ + myp (toggleprop >> pelem) "-" `shouldBe` ETile (creaProp '-') (1,1) + it "parses a space too" $ + myp pelem " " `shouldBe` Blank + it "parses a newline too" $ + myp pelem "\n" `shouldBe` Blank + it "parses a meeple too" $ + myp pelem "*" `shouldBe` + EMeeple (MStar $ defaultStar (1,1)) + + describe "etile" $ do + it "parse a single tile" $ + myp etile ":" `shouldBe` ETile (ct ':') (1,1) + + describe "pmeeple" $ do + it "parses a meeple" $ + myp (Just <$> pmeeple) "d" `shouldBe` charMeeple 'd' (1,1) + + -- ANCILLARIES -- + + describe "advance" $ do + it "advances a col" $ + myp (advance ACol >> S.lift S.get) "" `shouldBe` + ParseState (1, 2) False + it "advances a row" $ + myp (advance ARow >> S.lift S.get) "" `shouldBe` + ParseState (2, 1) False + it "resets column" $ + myp (advance ACol >> + advance ARow >> + S.lift S.get) "" `shouldBe` ParseState (2, 1) False diff --git a/test/PlantSpec.hs b/test/PlantSpec.hs new file mode 100644 --- /dev/null +++ b/test/PlantSpec.hs @@ -0,0 +1,39 @@ +module PlantSpec where + +import Test.Hspec + +import Terminal.Game + +import Input +import Plant +import Tile + +fakeTile :: Tile +fakeTile = error "Plant - fakeTile" + +spec :: Spec +spec = do + + describe "plantBoundaries" $ do + it "returns correct val even it is not bottom-right" $ + plantBoundaries + (foldr (uncurry addTile) + defaultPlant + [((5,1), fakeTile), ((1, 10), fakeTile)]) + `shouldBe` (5, 10) + + describe "gluePlants" $ do + let t = Tile Solid (creaStaticAnimation $ cell 'x') + p1 = addTile (1, 1) t defaultPlant + p2 = addTile (1, 2) t defaultPlant + g1 = gluePlants (2, 3) p1 [(W, p2)] + g2 = gluePlants (2, 3) p1 [(W, p2), (S, p2)] + it "does not modify main plant" $ + getTile p1 (1, 1) `shouldBe` getTile g1 (1, 1) + it "glues a single plant" $ + getTile g1 (1, -1) `shouldBe` Just t + it "glues multiple plants" $ + getTile g2 (3, 2) `shouldBe` Just t + it "glues multiple plants (Nothing)" $ + getTile g2 (3, 3) `shouldBe` Nothing + diff --git a/test/StorySpec.hs b/test/StorySpec.hs new file mode 100644 --- /dev/null +++ b/test/StorySpec.hs @@ -0,0 +1,25 @@ +module StorySpec where + +import Test.Hspec + +import Story +import Room +import Plant +import Tile + +import Lens.Micro.Platform + +fakeTile :: Tile +fakeTile = error "Story - fakeTile" + +spec :: Spec +spec = do + + describe "checkRoomSize" $ do + let r1 = defaultRoom & plant %~ addTile (3, 4) fakeTile + r2 = defaultRoom & plant %~ addTile (2, 2) fakeTile + & title .~ "due" + it "checks every Screen has the same dimension" $ + checkRoomSize (2, 2) [r2] `shouldBe` [] + it "returns offending screen" $ + checkRoomSize (3, 4) [r1, r2] `shouldBe` [("due", (2, 2))] diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/VenzoneSpec.hs b/test/VenzoneSpec.hs new file mode 100644 --- /dev/null +++ b/test/VenzoneSpec.hs @@ -0,0 +1,42 @@ +module VenzoneSpec where + +import Test.Hspec +import Test.QuickCheck + +import Venzone +import Terminal.Game +import Lens.Micro.Platform + +-- for completion +testRecord :: FilePath -> Expectation +testRecord fp = io `shouldReturn` True + where + io :: IO Bool + io = prepareVenzone >>= \gv -> + readRecord fp >>= \es -> + let s = testGame gv es in + pure (s ^. quit) + +spec :: Spec +spec = do + + describe "prepareVenzone" $ do + gv <- runIO prepareVenzone + -- modifyMaxSize (const 1000) $ + it "prepares a game that does not immediately crash" $ property $ + \e -> let a = testGame gv e in a == a + -- We should use NFData but it would be another dependency + + -- test playthroughs + describe "play-throughs" $ do + it "completes \"First stroll\"" $ + testRecord "test/records/playthrough/first-stroll.vr" + it "completes \"Bidin\"" $ + testRecord "test/records/playthrough/bidin.vr" + it "completes \"Orcolat\" (bad ending)" $ + testRecord "test/records/playthrough/orcolat-bad.vr" + it "completes \"Orcolat\" (good ending)" $ + testRecord "test/records/playthrough/orcolat-good.vr" + it "completes \"Orcolat\" (better ending)" $ + testRecord "test/records/playthrough/orcolat-better.vr" + diff --git a/test/records/baddies-die.vr b/test/records/baddies-die.vr new file mode 100644 Binary files /dev/null and b/test/records/baddies-die.vr differ diff --git a/test/records/bird-get-stuck.vr b/test/records/bird-get-stuck.vr new file mode 100644 Binary files /dev/null and b/test/records/bird-get-stuck.vr differ diff --git a/test/records/bird-start-stuck.vr b/test/records/bird-start-stuck.vr new file mode 100644 Binary files /dev/null and b/test/records/bird-start-stuck.vr differ diff --git a/test/records/blades-destroyed.vr b/test/records/blades-destroyed.vr new file mode 100644 Binary files /dev/null and b/test/records/blades-destroyed.vr differ diff --git a/test/records/blades-kill-meeple.vr b/test/records/blades-kill-meeple.vr new file mode 100644 Binary files /dev/null and b/test/records/blades-kill-meeple.vr differ diff --git a/test/records/blades-kill.vr b/test/records/blades-kill.vr new file mode 100644 Binary files /dev/null and b/test/records/blades-kill.vr differ diff --git a/test/records/diagonal-collision.vr b/test/records/diagonal-collision.vr new file mode 100644 Binary files /dev/null and b/test/records/diagonal-collision.vr differ diff --git a/test/records/diagonal-hole.vr b/test/records/diagonal-hole.vr new file mode 100644 Binary files /dev/null and b/test/records/diagonal-hole.vr differ diff --git a/test/records/down-ladder.vr b/test/records/down-ladder.vr new file mode 100644 Binary files /dev/null and b/test/records/down-ladder.vr differ diff --git a/test/records/dumb-direction.vr b/test/records/dumb-direction.vr new file mode 100644 Binary files /dev/null and b/test/records/dumb-direction.vr differ diff --git a/test/records/eat-star.vr b/test/records/eat-star.vr new file mode 100644 Binary files /dev/null and b/test/records/eat-star.vr differ diff --git a/test/records/falls-off-ladder.vr b/test/records/falls-off-ladder.vr new file mode 100644 Binary files /dev/null and b/test/records/falls-off-ladder.vr differ diff --git a/test/records/jump-2.vr b/test/records/jump-2.vr new file mode 100644 Binary files /dev/null and b/test/records/jump-2.vr differ diff --git a/test/records/jump-3.vr b/test/records/jump-3.vr new file mode 100644 Binary files /dev/null and b/test/records/jump-3.vr differ diff --git a/test/records/jump-after-rope.vr b/test/records/jump-after-rope.vr new file mode 100644 Binary files /dev/null and b/test/records/jump-after-rope.vr differ diff --git a/test/records/jump-between.vr b/test/records/jump-between.vr new file mode 100644 Binary files /dev/null and b/test/records/jump-between.vr differ diff --git a/test/records/jump-tick.vr b/test/records/jump-tick.vr new file mode 100644 Binary files /dev/null and b/test/records/jump-tick.vr differ diff --git a/test/records/ladder-exit.vr b/test/records/ladder-exit.vr new file mode 100644 Binary files /dev/null and b/test/records/ladder-exit.vr differ diff --git a/test/records/ladder.vr b/test/records/ladder.vr new file mode 100644 Binary files /dev/null and b/test/records/ladder.vr differ diff --git a/test/records/lock-away.vr b/test/records/lock-away.vr new file mode 100644 Binary files /dev/null and b/test/records/lock-away.vr differ diff --git a/test/records/lock-ground-1-star.vr b/test/records/lock-ground-1-star.vr new file mode 100644 Binary files /dev/null and b/test/records/lock-ground-1-star.vr differ diff --git a/test/records/lock-ground-meeples.vr b/test/records/lock-ground-meeples.vr new file mode 100644 Binary files /dev/null and b/test/records/lock-ground-meeples.vr differ diff --git a/test/records/lock-ground-star.vr b/test/records/lock-ground-star.vr new file mode 100644 Binary files /dev/null and b/test/records/lock-ground-star.vr differ diff --git a/test/records/lock-ground.vr b/test/records/lock-ground.vr new file mode 100644 Binary files /dev/null and b/test/records/lock-ground.vr differ diff --git a/test/records/nettle-kills-not.vr b/test/records/nettle-kills-not.vr new file mode 100644 Binary files /dev/null and b/test/records/nettle-kills-not.vr differ diff --git a/test/records/nettle-kills.vr b/test/records/nettle-kills.vr new file mode 100644 Binary files /dev/null and b/test/records/nettle-kills.vr differ diff --git a/test/records/no-touch-spawn.vr b/test/records/no-touch-spawn.vr new file mode 100644 Binary files /dev/null and b/test/records/no-touch-spawn.vr differ diff --git a/test/records/playthrough/bidin.vr b/test/records/playthrough/bidin.vr new file mode 100644 Binary files /dev/null and b/test/records/playthrough/bidin.vr differ diff --git a/test/records/playthrough/first-stroll.vr b/test/records/playthrough/first-stroll.vr new file mode 100644 Binary files /dev/null and b/test/records/playthrough/first-stroll.vr differ diff --git a/test/records/playthrough/orcolat-bad.vr b/test/records/playthrough/orcolat-bad.vr new file mode 100644 Binary files /dev/null and b/test/records/playthrough/orcolat-bad.vr differ diff --git a/test/records/playthrough/orcolat-better.vr b/test/records/playthrough/orcolat-better.vr new file mode 100644 Binary files /dev/null and b/test/records/playthrough/orcolat-better.vr differ diff --git a/test/records/playthrough/orcolat-good.vr b/test/records/playthrough/orcolat-good.vr new file mode 100644 Binary files /dev/null and b/test/records/playthrough/orcolat-good.vr differ diff --git a/test/records/reset-direction.vr b/test/records/reset-direction.vr new file mode 100644 Binary files /dev/null and b/test/records/reset-direction.vr differ diff --git a/test/records/respawn.vr b/test/records/respawn.vr new file mode 100644 Binary files /dev/null and b/test/records/respawn.vr differ diff --git a/test/records/restarts.vr b/test/records/restarts.vr new file mode 100644 Binary files /dev/null and b/test/records/restarts.vr differ diff --git a/test/records/room-switch-ground.vr b/test/records/room-switch-ground.vr new file mode 100644 Binary files /dev/null and b/test/records/room-switch-ground.vr differ diff --git a/test/records/sci-stop.vr b/test/records/sci-stop.vr new file mode 100644 Binary files /dev/null and b/test/records/sci-stop.vr differ diff --git a/test/records/slow-rooms.vr b/test/records/slow-rooms.vr new file mode 100644 Binary files /dev/null and b/test/records/slow-rooms.vr differ diff --git a/test/records/slow.vr b/test/records/slow.vr new file mode 100644 Binary files /dev/null and b/test/records/slow.vr differ diff --git a/test/records/smart-rope.vr b/test/records/smart-rope.vr new file mode 100644 Binary files /dev/null and b/test/records/smart-rope.vr differ diff --git a/test/records/solid-similar.vr b/test/records/solid-similar.vr new file mode 100644 Binary files /dev/null and b/test/records/solid-similar.vr differ diff --git a/test/records/space-stop.vr b/test/records/space-stop.vr new file mode 100644 Binary files /dev/null and b/test/records/space-stop.vr differ diff --git a/test/records/stair.vr b/test/records/stair.vr new file mode 100644 Binary files /dev/null and b/test/records/stair.vr differ diff --git a/test/records/stand.vr b/test/records/stand.vr new file mode 100644 Binary files /dev/null and b/test/records/stand.vr differ diff --git a/test/records/star-collect-meeple.vr b/test/records/star-collect-meeple.vr new file mode 100644 Binary files /dev/null and b/test/records/star-collect-meeple.vr differ diff --git a/test/records/star-collect.vr b/test/records/star-collect.vr new file mode 100644 Binary files /dev/null and b/test/records/star-collect.vr differ diff --git a/test/records/star-lock-away.vr b/test/records/star-lock-away.vr new file mode 100644 Binary files /dev/null and b/test/records/star-lock-away.vr differ diff --git a/test/records/stone-kill.vr b/test/records/stone-kill.vr new file mode 100644 Binary files /dev/null and b/test/records/stone-kill.vr differ diff --git a/test/records/stone-safe.vr b/test/records/stone-safe.vr new file mode 100644 Binary files /dev/null and b/test/records/stone-safe.vr differ diff --git a/test/records/stop-next-room.vr b/test/records/stop-next-room.vr new file mode 100644 Binary files /dev/null and b/test/records/stop-next-room.vr differ diff --git a/test/records/water.vr b/test/records/water.vr new file mode 100644 Binary files /dev/null and b/test/records/water.vr differ diff --git a/test/records/win.vr b/test/records/win.vr new file mode 100644 Binary files /dev/null and b/test/records/win.vr differ diff --git a/test/records/witch-kill.vr b/test/records/witch-kill.vr new file mode 100644 Binary files /dev/null and b/test/records/witch-kill.vr differ diff --git a/test/records/witch-spirit.vr b/test/records/witch-spirit.vr new file mode 100644 Binary files /dev/null and b/test/records/witch-spirit.vr differ diff --git a/venzone.cabal b/venzone.cabal new file mode 100644 --- /dev/null +++ b/venzone.cabal @@ -0,0 +1,136 @@ +cabal-version: 2.2 +name: venzone +version: 1.0.0.0 +synopsis: ASCII platform-adventure game +description: Steal the Earthquake Hammer from the Orcolat + and save your valley. Binaries and more info in the + . +homepage: none yet +license: GPL-3.0-only +license-file: COPYING +author: Francesco Ariis +maintainer: fa-ml@ariis.it +copyright: © 2019 Francesco Ariis et al. (check README) +category: Game +build-type: Simple +extra-source-files: assets/art/*.scr, + assets/readme.txt, + test/records/*.vr, + test/records/playthrough/*.vr, + CONTRIBUTING, + README +data-files: stories/*.vns + +source-repository head + type: darcs + location: https://hub.darcs.net/ffaf/venzone + +executable venzone + main-is: Main.hs + autogen-modules: Paths_venzone + other-modules: Art, + Gymnasium, + Input, + Meeple.Primitives, + Meeple.Operate, + Menu, + NonEmptyZipper, + Parse, + Paths, + Paths_venzone, + Plant, + Room, + Screen, + Screen.Check, + Screen.Collision, + Screen.Decide, + Screen.Move, + Screen.Primitives, + Screen.ProcessKeys, + Story, + Tile, + Venzone, + Watcher + build-depends: base == 4.*, + ansi-terminal-game >= 1.0 && < 1.1, + containers >= 0.6.0 && < 0.7, + directory >= 1.3.3 && < 1.4, + file-embed >= 0.0.11 && < 0.1, + filepath >= 1.4.2 && < 1.5, + fsnotify >= 0.3.0 && < 0.4, + line-drawing >= 0.4.0 && < 0.5, + megaparsec >= 7.0.5 && < 8.0, + microlens-platform >= 0.4.0 && < 0.5, + microlens >= 0.4.11.2 && < 0.5, + mtl >= 2.2.2 && < 2.3, + utf8-light >= 0.4.2 && < 0.5, + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -threaded + -Wall + +test-suite test + main-is: Test.hs + autogen-modules: Paths_venzone + other-modules: Art, + Gymnasium, + GymnasiumSpec, + Input, + Meeple.Primitives, + Meeple.Operate, + Menu, + NonEmptyZipper, + Paths, + Paths_venzone, + Parse, + ParseSpec, + Plant, + PlantSpec, + Room, + Screen, + Screen.Check, + Screen.Collision, + Screen.Decide, + Screen.Move, + Screen.Primitives, + Screen.ProcessKeys, + Story, + StorySpec, + Tile, + Venzone, + VenzoneSpec + build-depends: base == 4.*, + ansi-terminal-game >= 1.0 && < 1.1, + containers >= 0.6.0 && < 0.7, + directory >= 1.3.3 && < 1.4, + file-embed >= 0.0.11 && < 0.1, + filepath >= 1.4.2 && < 1.5, + line-drawing >= 0.4.0 && < 0.5, + megaparsec >= 7.0.5 && < 8.0, + microlens-platform >= 0.4.0 && < 0.5, + microlens >= 0.4.11.2 && < 0.5, + mtl >= 2.2.2 && < 2.3, + utf8-light >= 0.4.2 && < 0.5 + -- the above + hspec/quickcheck + , hspec >= 2.7.0 && < 2.8, + QuickCheck > 2.13 && < 2.14 + hs-source-dirs: src, test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + -- needed by fsnotify and + -- a-terminal-game + -Wall + +executable packerino + main-is: Packerino.hs + build-depends: base == 4.*, + directory >= 1.3 && < 1.4, + filemanip >= 0.3 && < 0.4, + filepath >= 1.4 && < 1.5, + process >= 1.6 && < 1.7, + temporary >= 1.3 && < 1.4 + default-language: Haskell2010 + ghc-options: -threaded + -Wall +