diff options
| -rw-r--r-- | LICENSE | 674 | ||||
| -rw-r--r-- | README.org | 32 | ||||
| -rw-r--r-- | art/font.png | bin | 0 -> 1960 bytes | |||
| -rw-r--r-- | art/swanky.png | bin | 0 -> 4625 bytes | |||
| -rw-r--r-- | art/tiles.png | bin | 0 -> 927 bytes | |||
| -rw-r--r-- | lib/bump.LICENSE | 20 | ||||
| -rw-r--r-- | lib/bump.lua | 773 | ||||
| -rwxr-xr-x | lib/fennel | 82 | ||||
| -rw-r--r-- | lib/fennel.LICENSE | 21 | ||||
| -rw-r--r-- | lib/fennel.lua | 1785 | ||||
| -rw-r--r-- | lib/fennelview.lua | 201 | ||||
| -rw-r--r-- | lib/lume.LICENSE | 20 | ||||
| -rw-r--r-- | lib/lume.lua | 768 | ||||
| -rw-r--r-- | main.lua | 7 | ||||
| -rw-r--r-- | map.fnl | 70 | ||||
| -rw-r--r-- | maps/sandbox.fnl | 1 | ||||
| -rw-r--r-- | maps/sandbox.png | bin | 0 -> 245 bytes | |||
| -rw-r--r-- | sandbox.fnl | 98 | ||||
| -rw-r--r-- | wrap.fnl | 74 |
19 files changed, 4626 insertions, 0 deletions
@@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + <program> Copyright (C) <year> <name of author> + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +<http://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +<http://www.gnu.org/philosophy/why-not-lgpl.html>. diff --git a/README.org b/README.org new file mode 100644 index 0000000..f7bde21 --- /dev/null +++ b/README.org @@ -0,0 +1,32 @@ +#+TITLE: README for swanky +#+AUTHOR: Jakob L. Kreuze +#+EMAIL: zerodaysfordays@sdf.lonestar.org +#+DATE: <2018-10-19 Fri> + +* 1. Thanks! + +** [[https://technomancy.us][Phil Hagelberg]] + +I'm totally new to LÖVE and Fennel, so I borrowed a lot of the boilerplate from +his entry to the [[https://itch.io/jam/lisp-game-jam-2018/results][Lisp Game Jam 2018]], [[https://gitlab.com/technomancy/exo-encounter-667][EXO_encounter 667]]. His post, [[https://technomancy.us/188]["in which a +game jam is recounted further"]], also served as excellent guidance in navigating +the API's for LÖVE as well as a few other excellent Lua libraries, listed below. + +** [[https://github.com/rxi][rxi]] + +Of [[https://github.com/rxi/lume][lume.lua]], which provides some very pleasant functional constructs such as +=map=, as well as typical linear interpolation and vector math. lume is released +under the MIT License. + +** [[http://kiki.to/][Enrique García Cota]] + +Of [[https://github.com/kikito/bump.lua][bump.lua]], a much simpler library for collision detection than the one +provided by LÖVE. + +** [[http://clintbellanger.net/][Clint Bellanger]] + +Of the [[https://opengameart.org/content/boxy-bold-font][Boxy Bold Font]] that I used in this game. + +** [[https://love2d.org/][LOVE Development Team]] + +I really did fall in löve with the LÖVE API's. diff --git a/art/font.png b/art/font.png Binary files differnew file mode 100644 index 0000000..283139d --- /dev/null +++ b/art/font.png diff --git a/art/swanky.png b/art/swanky.png Binary files differnew file mode 100644 index 0000000..250d563 --- /dev/null +++ b/art/swanky.png diff --git a/art/tiles.png b/art/tiles.png Binary files differnew file mode 100644 index 0000000..a9d36c5 --- /dev/null +++ b/art/tiles.png diff --git a/lib/bump.LICENSE b/lib/bump.LICENSE new file mode 100644 index 0000000..2e015c6 --- /dev/null +++ b/lib/bump.LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2012 Enrique García Cota + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/lib/bump.lua b/lib/bump.lua new file mode 100644 index 0000000..6dabca7 --- /dev/null +++ b/lib/bump.lua @@ -0,0 +1,773 @@ +local bump = { + _VERSION = 'bump v3.1.7', + _URL = 'https://github.com/kikito/bump.lua', + _DESCRIPTION = 'A collision detection library for Lua', + _LICENSE = [[ + MIT LICENSE + + Copyright (c) 2014 Enrique García Cota + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the + "Software"), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. + IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY + CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, + TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE + SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + ]] +} + +------------------------------------------ +-- Auxiliary functions +------------------------------------------ +local DELTA = 1e-10 -- floating-point margin of error + +local abs, floor, ceil, min, max = math.abs, math.floor, math.ceil, math.min, math.max + +local function sign(x) + if x > 0 then return 1 end + if x == 0 then return 0 end + return -1 +end + +local function nearest(x, a, b) + if abs(a - x) < abs(b - x) then return a else return b end +end + +local function assertType(desiredType, value, name) + if type(value) ~= desiredType then + error(name .. ' must be a ' .. desiredType .. ', but was ' .. tostring(value) .. '(a ' .. type(value) .. ')') + end +end + +local function assertIsPositiveNumber(value, name) + if type(value) ~= 'number' or value <= 0 then + error(name .. ' must be a positive integer, but was ' .. tostring(value) .. '(' .. type(value) .. ')') + end +end + +local function assertIsRect(x,y,w,h) + assertType('number', x, 'x') + assertType('number', y, 'y') + assertIsPositiveNumber(w, 'w') + assertIsPositiveNumber(h, 'h') +end + +local defaultFilter = function() + return 'slide' +end + +------------------------------------------ +-- Rectangle functions +------------------------------------------ + +local function rect_getNearestCorner(x,y,w,h, px, py) + return nearest(px, x, x+w), nearest(py, y, y+h) +end + +-- This is a generalized implementation of the liang-barsky algorithm, which also returns +-- the normals of the sides where the segment intersects. +-- Returns nil if the segment never touches the rect +-- Notice that normals are only guaranteed to be accurate when initially ti1, ti2 == -math.huge, math.huge +local function rect_getSegmentIntersectionIndices(x,y,w,h, x1,y1,x2,y2, ti1,ti2) + ti1, ti2 = ti1 or 0, ti2 or 1 + local dx, dy = x2-x1, y2-y1 + local nx, ny + local nx1, ny1, nx2, ny2 = 0,0,0,0 + local p, q, r + + for side = 1,4 do + if side == 1 then nx,ny,p,q = -1, 0, -dx, x1 - x -- left + elseif side == 2 then nx,ny,p,q = 1, 0, dx, x + w - x1 -- right + elseif side == 3 then nx,ny,p,q = 0, -1, -dy, y1 - y -- top + else nx,ny,p,q = 0, 1, dy, y + h - y1 -- bottom + end + + if p == 0 then + if q <= 0 then return nil end + else + r = q / p + if p < 0 then + if r > ti2 then return nil + elseif r > ti1 then ti1,nx1,ny1 = r,nx,ny + end + else -- p > 0 + if r < ti1 then return nil + elseif r < ti2 then ti2,nx2,ny2 = r,nx,ny + end + end + end + end + + return ti1,ti2, nx1,ny1, nx2,ny2 +end + +-- Calculates the minkowsky difference between 2 rects, which is another rect +local function rect_getDiff(x1,y1,w1,h1, x2,y2,w2,h2) + return x2 - x1 - w1, + y2 - y1 - h1, + w1 + w2, + h1 + h2 +end + +local function rect_containsPoint(x,y,w,h, px,py) + return px - x > DELTA and py - y > DELTA and + x + w - px > DELTA and y + h - py > DELTA +end + +local function rect_isIntersecting(x1,y1,w1,h1, x2,y2,w2,h2) + return x1 < x2+w2 and x2 < x1+w1 and + y1 < y2+h2 and y2 < y1+h1 +end + +local function rect_getSquareDistance(x1,y1,w1,h1, x2,y2,w2,h2) + local dx = x1 - x2 + (w1 - w2)/2 + local dy = y1 - y2 + (h1 - h2)/2 + return dx*dx + dy*dy +end + +local function rect_detectCollision(x1,y1,w1,h1, x2,y2,w2,h2, goalX, goalY) + goalX = goalX or x1 + goalY = goalY or y1 + + local dx, dy = goalX - x1, goalY - y1 + local x,y,w,h = rect_getDiff(x1,y1,w1,h1, x2,y2,w2,h2) + + local overlaps, ti, nx, ny + + if rect_containsPoint(x,y,w,h, 0,0) then -- item was intersecting other + local px, py = rect_getNearestCorner(x,y,w,h, 0, 0) + local wi, hi = min(w1, abs(px)), min(h1, abs(py)) -- area of intersection + ti = -wi * hi -- ti is the negative area of intersection + overlaps = true + else + local ti1,ti2,nx1,ny1 = rect_getSegmentIntersectionIndices(x,y,w,h, 0,0,dx,dy, -math.huge, math.huge) + + -- item tunnels into other + if ti1 + and ti1 < 1 + and (abs(ti1 - ti2) >= DELTA) -- special case for rect going through another rect's corner + and (0 < ti1 + DELTA + or 0 == ti1 and ti2 > 0) + then + ti, nx, ny = ti1, nx1, ny1 + overlaps = false + end + end + + if not ti then return end + + local tx, ty + + if overlaps then + if dx == 0 and dy == 0 then + -- intersecting and not moving - use minimum displacement vector + local px, py = rect_getNearestCorner(x,y,w,h, 0,0) + if abs(px) < abs(py) then py = 0 else px = 0 end + nx, ny = sign(px), sign(py) + tx, ty = x1 + px, y1 + py + else + -- intersecting and moving - move in the opposite direction + local ti1, _ + ti1,_,nx,ny = rect_getSegmentIntersectionIndices(x,y,w,h, 0,0,dx,dy, -math.huge, 1) + if not ti1 then return end + tx, ty = x1 + dx * ti1, y1 + dy * ti1 + end + else -- tunnel + tx, ty = x1 + dx * ti, y1 + dy * ti + end + + return { + overlaps = overlaps, + ti = ti, + move = {x = dx, y = dy}, + normal = {x = nx, y = ny}, + touch = {x = tx, y = ty}, + itemRect = {x = x1, y = y1, w = w1, h = h1}, + otherRect = {x = x2, y = y2, w = w2, h = h2} + } +end + +------------------------------------------ +-- Grid functions +------------------------------------------ + +local function grid_toWorld(cellSize, cx, cy) + return (cx - 1)*cellSize, (cy-1)*cellSize +end + +local function grid_toCell(cellSize, x, y) + return floor(x / cellSize) + 1, floor(y / cellSize) + 1 +end + +-- grid_traverse* functions are based on "A Fast Voxel Traversal Algorithm for Ray Tracing", +-- by John Amanides and Andrew Woo - http://www.cse.yorku.ca/~amana/research/grid.pdf +-- It has been modified to include both cells when the ray "touches a grid corner", +-- and with a different exit condition + +local function grid_traverse_initStep(cellSize, ct, t1, t2) + local v = t2 - t1 + if v > 0 then + return 1, cellSize / v, ((ct + v) * cellSize - t1) / v + elseif v < 0 then + return -1, -cellSize / v, ((ct + v - 1) * cellSize - t1) / v + else + return 0, math.huge, math.huge + end +end + +local function grid_traverse(cellSize, x1,y1,x2,y2, f) + local cx1,cy1 = grid_toCell(cellSize, x1,y1) + local cx2,cy2 = grid_toCell(cellSize, x2,y2) + local stepX, dx, tx = grid_traverse_initStep(cellSize, cx1, x1, x2) + local stepY, dy, ty = grid_traverse_initStep(cellSize, cy1, y1, y2) + local cx,cy = cx1,cy1 + + f(cx, cy) + + -- The default implementation had an infinite loop problem when + -- approaching the last cell in some occassions. We finish iterating + -- when we are *next* to the last cell + while abs(cx - cx2) + abs(cy - cy2) > 1 do + if tx < ty then + tx, cx = tx + dx, cx + stepX + f(cx, cy) + else + -- Addition: include both cells when going through corners + if tx == ty then f(cx + stepX, cy) end + ty, cy = ty + dy, cy + stepY + f(cx, cy) + end + end + + -- If we have not arrived to the last cell, use it + if cx ~= cx2 or cy ~= cy2 then f(cx2, cy2) end + +end + +local function grid_toCellRect(cellSize, x,y,w,h) + local cx,cy = grid_toCell(cellSize, x, y) + local cr,cb = ceil((x+w) / cellSize), ceil((y+h) / cellSize) + return cx, cy, cr - cx + 1, cb - cy + 1 +end + +------------------------------------------ +-- Responses +------------------------------------------ + +local touch = function(world, col, x,y,w,h, goalX, goalY, filter) + return col.touch.x, col.touch.y, {}, 0 +end + +local cross = function(world, col, x,y,w,h, goalX, goalY, filter) + local cols, len = world:project(col.item, x,y,w,h, goalX, goalY, filter) + return goalX, goalY, cols, len +end + +local slide = function(world, col, x,y,w,h, goalX, goalY, filter) + goalX = goalX or x + goalY = goalY or y + + local tch, move = col.touch, col.move + if move.x ~= 0 or move.y ~= 0 then + if col.normal.x ~= 0 then + goalX = tch.x + else + goalY = tch.y + end + end + + col.slide = {x = goalX, y = goalY} + + x,y = tch.x, tch.y + local cols, len = world:project(col.item, x,y,w,h, goalX, goalY, filter) + return goalX, goalY, cols, len +end + +local bounce = function(world, col, x,y,w,h, goalX, goalY, filter) + goalX = goalX or x + goalY = goalY or y + + local tch, move = col.touch, col.move + local tx, ty = tch.x, tch.y + + local bx, by = tx, ty + + if move.x ~= 0 or move.y ~= 0 then + local bnx, bny = goalX - tx, goalY - ty + if col.normal.x == 0 then bny = -bny else bnx = -bnx end + bx, by = tx + bnx, ty + bny + end + + col.bounce = {x = bx, y = by} + x,y = tch.x, tch.y + goalX, goalY = bx, by + + local cols, len = world:project(col.item, x,y,w,h, goalX, goalY, filter) + return goalX, goalY, cols, len +end + +------------------------------------------ +-- World +------------------------------------------ + +local World = {} +local World_mt = {__index = World} + +-- Private functions and methods + +local function sortByWeight(a,b) return a.weight < b.weight end + +local function sortByTiAndDistance(a,b) + if a.ti == b.ti then + local ir, ar, br = a.itemRect, a.otherRect, b.otherRect + local ad = rect_getSquareDistance(ir.x,ir.y,ir.w,ir.h, ar.x,ar.y,ar.w,ar.h) + local bd = rect_getSquareDistance(ir.x,ir.y,ir.w,ir.h, br.x,br.y,br.w,br.h) + return ad < bd + end + return a.ti < b.ti +end + +local function addItemToCell(self, item, cx, cy) + self.rows[cy] = self.rows[cy] or setmetatable({}, {__mode = 'v'}) + local row = self.rows[cy] + row[cx] = row[cx] or {itemCount = 0, x = cx, y = cy, items = setmetatable({}, {__mode = 'k'})} + local cell = row[cx] + self.nonEmptyCells[cell] = true + if not cell.items[item] then + cell.items[item] = true + cell.itemCount = cell.itemCount + 1 + end +end + +local function removeItemFromCell(self, item, cx, cy) + local row = self.rows[cy] + if not row or not row[cx] or not row[cx].items[item] then return false end + + local cell = row[cx] + cell.items[item] = nil + cell.itemCount = cell.itemCount - 1 + if cell.itemCount == 0 then + self.nonEmptyCells[cell] = nil + end + return true +end + +local function getDictItemsInCellRect(self, cl,ct,cw,ch) + local items_dict = {} + for cy=ct,ct+ch-1 do + local row = self.rows[cy] + if row then + for cx=cl,cl+cw-1 do + local cell = row[cx] + if cell and cell.itemCount > 0 then -- no cell.itemCount > 1 because tunneling + for item,_ in pairs(cell.items) do + items_dict[item] = true + end + end + end + end + end + + return items_dict +end + +local function getCellsTouchedBySegment(self, x1,y1,x2,y2) + + local cells, cellsLen, visited = {}, 0, {} + + grid_traverse(self.cellSize, x1,y1,x2,y2, function(cx, cy) + local row = self.rows[cy] + if not row then return end + local cell = row[cx] + if not cell or visited[cell] then return end + + visited[cell] = true + cellsLen = cellsLen + 1 + cells[cellsLen] = cell + end) + + return cells, cellsLen +end + +local function getInfoAboutItemsTouchedBySegment(self, x1,y1, x2,y2, filter) + local cells, len = getCellsTouchedBySegment(self, x1,y1,x2,y2) + local cell, rect, l,t,w,h, ti1,ti2, tii0,tii1 + local visited, itemInfo, itemInfoLen = {},{},0 + for i=1,len do + cell = cells[i] + for item in pairs(cell.items) do + if not visited[item] then + visited[item] = true + if (not filter or filter(item)) then + rect = self.rects[item] + l,t,w,h = rect.x,rect.y,rect.w,rect.h + + ti1,ti2 = rect_getSegmentIntersectionIndices(l,t,w,h, x1,y1, x2,y2, 0, 1) + if ti1 and ((0 < ti1 and ti1 < 1) or (0 < ti2 and ti2 < 1)) then + -- the sorting is according to the t of an infinite line, not the segment + tii0,tii1 = rect_getSegmentIntersectionIndices(l,t,w,h, x1,y1, x2,y2, -math.huge, math.huge) + itemInfoLen = itemInfoLen + 1 + itemInfo[itemInfoLen] = {item = item, ti1 = ti1, ti2 = ti2, weight = min(tii0,tii1)} + end + end + end + end + end + table.sort(itemInfo, sortByWeight) + return itemInfo, itemInfoLen +end + +local function getResponseByName(self, name) + local response = self.responses[name] + if not response then + error(('Unknown collision type: %s (%s)'):format(name, type(name))) + end + return response +end + + +-- Misc Public Methods + +function World:addResponse(name, response) + self.responses[name] = response +end + +function World:project(item, x,y,w,h, goalX, goalY, filter) + assertIsRect(x,y,w,h) + + goalX = goalX or x + goalY = goalY or y + filter = filter or defaultFilter + + local collisions, len = {}, 0 + + local visited = {} + if item ~= nil then visited[item] = true end + + -- This could probably be done with less cells using a polygon raster over the cells instead of a + -- bounding rect of the whole movement. Conditional to building a queryPolygon method + local tl, tt = min(goalX, x), min(goalY, y) + local tr, tb = max(goalX + w, x+w), max(goalY + h, y+h) + local tw, th = tr-tl, tb-tt + + local cl,ct,cw,ch = grid_toCellRect(self.cellSize, tl,tt,tw,th) + + local dictItemsInCellRect = getDictItemsInCellRect(self, cl,ct,cw,ch) + + for other,_ in pairs(dictItemsInCellRect) do + if not visited[other] then + visited[other] = true + + local responseName = filter(item, other) + if responseName then + local ox,oy,ow,oh = self:getRect(other) + local col = rect_detectCollision(x,y,w,h, ox,oy,ow,oh, goalX, goalY) + + if col then + col.other = other + col.item = item + col.type = responseName + + len = len + 1 + collisions[len] = col + end + end + end + end + + table.sort(collisions, sortByTiAndDistance) + + return collisions, len +end + +function World:countCells() + local count = 0 + for _,row in pairs(self.rows) do + for _,_ in pairs(row) do + count = count + 1 + end + end + return count +end + +function World:hasItem(item) + return not not self.rects[item] +end + +function World:getItems() + local items, len = {}, 0 + for item,_ in pairs(self.rects) do + len = len + 1 + items[len] = item + end + return items, len +end + +function World:countItems() + local len = 0 + for _ in pairs(self.rects) do len = len + 1 end + return len +end + +function World:getRect(item) + local rect = self.rects[item] + if not rect then + error('Item ' .. tostring(item) .. ' must be added to the world before getting its rect. Use world:add(item, x,y,w,h) to add it first.') + end + return rect.x, rect.y, rect.w, rect.h +end + +function World:toWorld(cx, cy) + return grid_toWorld(self.cellSize, cx, cy) +end + +function World:toCell(x,y) + return grid_toCell(self.cellSize, x, y) +end + + +--- Query methods + +function World:queryRect(x,y,w,h, filter) + + assertIsRect(x,y,w,h) + + local cl,ct,cw,ch = grid_toCellRect(self.cellSize, x,y,w,h) + local dictItemsInCellRect = getDictItemsInCellRect(self, cl,ct,cw,ch) + + local items, len = {}, 0 + + local rect + for item,_ in pairs(dictItemsInCellRect) do + rect = self.rects[item] + if (not filter or filter(item)) + and rect_isIntersecting(x,y,w,h, rect.x, rect.y, rect.w, rect.h) + then + len = len + 1 + items[len] = item + end + end + + return items, len +end + +function World:queryPoint(x,y, filter) + local cx,cy = self:toCell(x,y) + local dictItemsInCellRect = getDictItemsInCellRect(self, cx,cy,1,1) + + local items, len = {}, 0 + + local rect + for item,_ in pairs(dictItemsInCellRect) do + rect = self.rects[item] + if (not filter or filter(item)) + and rect_containsPoint(rect.x, rect.y, rect.w, rect.h, x, y) + then + len = len + 1 + items[len] = item + end + end + + return items, len +end + +function World:querySegment(x1, y1, x2, y2, filter) + local itemInfo, len = getInfoAboutItemsTouchedBySegment(self, x1, y1, x2, y2, filter) + local items = {} + for i=1, len do + items[i] = itemInfo[i].item + end + return items, len +end + +function World:querySegmentWithCoords(x1, y1, x2, y2, filter) + local itemInfo, len = getInfoAboutItemsTouchedBySegment(self, x1, y1, x2, y2, filter) + local dx, dy = x2-x1, y2-y1 + local info, ti1, ti2 + for i=1, len do + info = itemInfo[i] + ti1 = info.ti1 + ti2 = info.ti2 + + info.weight = nil + info.x1 = x1 + dx * ti1 + info.y1 = y1 + dy * ti1 + info.x2 = x1 + dx * ti2 + info.y2 = y1 + dy * ti2 + end + return itemInfo, len +end + + +--- Main methods + +function World:add(item, x,y,w,h) + local rect = self.rects[item] + if rect then + error('Item ' .. tostring(item) .. ' added to the world twice.') + end + assertIsRect(x,y,w,h) + + self.rects[item] = {x=x,y=y,w=w,h=h} + + local cl,ct,cw,ch = grid_toCellRect(self.cellSize, x,y,w,h) + for cy = ct, ct+ch-1 do + for cx = cl, cl+cw-1 do + addItemToCell(self, item, cx, cy) + end + end + + return item +end + +function World:remove(item) + local x,y,w,h = self:getRect(item) + + self.rects[item] = nil + local cl,ct,cw,ch = grid_toCellRect(self.cellSize, x,y,w,h) + for cy = ct, ct+ch-1 do + for cx = cl, cl+cw-1 do + removeItemFromCell(self, item, cx, cy) + end + end +end + +function World:update(item, x2,y2,w2,h2) + local x1,y1,w1,h1 = self:getRect(item) + w2,h2 = w2 or w1, h2 or h1 + assertIsRect(x2,y2,w2,h2) + + if x1 ~= x2 or y1 ~= y2 or w1 ~= w2 or h1 ~= h2 then + + local cellSize = self.cellSize + local cl1,ct1,cw1,ch1 = grid_toCellRect(cellSize, x1,y1,w1,h1) + local cl2,ct2,cw2,ch2 = grid_toCellRect(cellSize, x2,y2,w2,h2) + + if cl1 ~= cl2 or ct1 ~= ct2 or cw1 ~= cw2 or ch1 ~= ch2 then + + local cr1, cb1 = cl1+cw1-1, ct1+ch1-1 + local cr2, cb2 = cl2+cw2-1, ct2+ch2-1 + local cyOut + + for cy = ct1, cb1 do + cyOut = cy < ct2 or cy > cb2 + for cx = cl1, cr1 do + if cyOut or cx < cl2 or cx > cr2 then + removeItemFromCell(self, item, cx, cy) + end + end + end + + for cy = ct2, cb2 do + cyOut = cy < ct1 or cy > cb1 + for cx = cl2, cr2 do + if cyOut or cx < cl1 or cx > cr1 then + addItemToCell(self, item, cx, cy) + end + end + end + + end + + local rect = self.rects[item] + rect.x, rect.y, rect.w, rect.h = x2,y2,w2,h2 + + end +end + +function World:move(item, goalX, goalY, filter) + local actualX, actualY, cols, len = self:check(item, goalX, goalY, filter) + + self:update(item, actualX, actualY) + + return actualX, actualY, cols, len +end + +function World:check(item, goalX, goalY, filter) + filter = filter or defaultFilter + + local visited = {[item] = true} + local visitedFilter = function(itm, other) + if visited[other] then return false end + return filter(itm, other) + end + + local cols, len = {}, 0 + + local x,y,w,h = self:getRect(item) + + local projected_cols, projected_len = self:project(item, x,y,w,h, goalX,goalY, visitedFilter) + + while projected_len > 0 do + local col = projected_cols[1] + len = len + 1 + cols[len] = col + + visited[col.other] = true + + local response = getResponseByName(self, col.type) + + goalX, goalY, projected_cols, projected_len = response( + self, + col, + x, y, w, h, + goalX, goalY, + visitedFilter + ) + end + + return goalX, goalY, cols, len +end + + +-- Public library functions + +bump.newWorld = function(cellSize) + cellSize = cellSize or 64 + assertIsPositiveNumber(cellSize, 'cellSize') + local world = setmetatable({ + cellSize = cellSize, + rects = {}, + rows = {}, + nonEmptyCells = {}, + responses = {} + }, World_mt) + + world:addResponse('touch', touch) + world:addResponse('cross', cross) + world:addResponse('slide', slide) + world:addResponse('bounce', bounce) + + return world +end + +bump.rect = { + getNearestCorner = rect_getNearestCorner, + getSegmentIntersectionIndices = rect_getSegmentIntersectionIndices, + getDiff = rect_getDiff, + containsPoint = rect_containsPoint, + isIntersecting = rect_isIntersecting, + getSquareDistance = rect_getSquareDistance, + detectCollision = rect_detectCollision +} + +bump.responses = { + touch = touch, + cross = cross, + slide = slide, + bounce = bounce +} + +return bump diff --git a/lib/fennel b/lib/fennel new file mode 100755 index 0000000..8fd7652 --- /dev/null +++ b/lib/fennel @@ -0,0 +1,82 @@ +#!/usr/bin/env lua + +local fennel_dir = arg[0]:match("(.-)[^\\/]+$") +package.path = fennel_dir .. "?.lua;" .. package.path +local fennel = require('fennel') + +local help = [[ +Usage: fennel [FLAG] [FILE] + + --repl : Launch an interactive repl session + --compile FILES : Compile files and write their Lua to stdout + --help : Display this text + + When not given a flag, runs the file given as the first argument.]] + +local options = { + sourcemap = true, +} + +local function dosafe(filename, opts, arg1) + local ok, val = xpcall(function() + return fennel.dofile(filename, opts, arg1) + end, fennel.traceback) + if not ok then + print(val) + os.exit(1) + end + return val +end + +local compileOptHandlers = { + ['--indent'] = function () + options.indent = table.remove(arg, 3) + if options.indent == "false" then options.indent = false end + table.remove(arg, 2) + end, + ['--sourcemap'] = function () + options.sourcemap = table.remove(arg, 3) + if options.sourcemap == "false" then options.sourcemap = false end + table.remove(arg, 2) + end, + ['--correlate'] = function () + options.correlate = true + table.remove(arg, 2) + end, +} + +if arg[1] == "--repl" or #arg == 0 then + local ppok, pp = pcall(fennel.dofile, fennel_dir .. "fennelview.fnl", options) + if ppok then + options.pp = pp + end + local initFilename = (os.getenv("HOME") or "") .. "/.fennelrc" + local init = io.open(initFilename, "rb") + if init then + init:close() + -- pass in options so fennerlrc can make changes to it + dosafe(initFilename, options, options) + end + print("Welcome to fennel!") + fennel.repl(options) +elseif arg[1] == "--compile" then + -- Handle options + while compileOptHandlers[arg[2]] do + compileOptHandlers[arg[2]]() + end + for i = 2, #arg do + local f = assert(io.open(arg[i], "rb")) + options.filename=arg[i] + local ok, val = xpcall(function() + return fennel.compileString(f:read("*all"), options) + end, fennel.traceback) + print(val) + if not ok then os.exit(1) end + f:close() + end +elseif #arg >= 1 and arg[1] ~= "--help" then + local filename = table.remove(arg, 1) -- let the script have remaining args + dosafe(filename) +else + print(help) +end diff --git a/lib/fennel.LICENSE b/lib/fennel.LICENSE new file mode 100644 index 0000000..44365b3 --- /dev/null +++ b/lib/fennel.LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2018 Calvin Rose and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/lib/fennel.lua b/lib/fennel.lua new file mode 100644 index 0000000..8b6d96a --- /dev/null +++ b/lib/fennel.lua @@ -0,0 +1,1785 @@ +--[[ +Copyright (c) 2016-2018 Calvin Rose and contributors +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +]] + +-- Make global variables local. +local setmetatable = setmetatable +local getmetatable = getmetatable +local type = type +local assert = assert +local pairs = pairs +local ipairs = ipairs +local tostring = tostring +local unpack = unpack or table.unpack + +-- +-- Main Types and support functions +-- + +local function deref(self) return self[1] end + +local SYMBOL_MT = { 'SYMBOL', __tostring = deref } +local EXPR_MT = { 'EXPR', __tostring = deref } +local VARARG = setmetatable({ '...' }, { 'VARARG', __tostring = deref }) +local LIST_MT = { 'LIST', + __tostring = function (self) + local strs = {} + for _, s in ipairs(self) do + table.insert(strs, tostring(s)) + end + return '(' .. table.concat(strs, ', ', 1, #self) .. ')' + end +} + +-- Load code with an environment in all recent Lua versions +local function loadCode(code, environment, filename) + environment = environment or _ENV or _G + if setfenv and loadstring then + local f = assert(loadstring(code, filename)) + setfenv(f, environment) + return f + else + return assert(load(code, filename, "t", environment)) + end +end + +-- Create a new list +local function list(...) + return setmetatable({...}, LIST_MT) +end + +-- Create a new symbol +local function sym(str, scope, meta) + local s = {str, scope = scope} + if meta then + for k, v in pairs(meta) do + if type(k) == 'string' then s[k] = v end + end + end + return setmetatable(s, SYMBOL_MT) +end + +-- Create a new expr +-- etype should be one of +-- "literal", -- literals like numbers, strings, nil, true, false +-- "expression", -- Complex strings of Lua code, may have side effects, etc, but is an expression +-- "statement", -- Same as expression, but is also a valid statement (function calls). +-- "vargs", -- varargs symbol +-- "sym", -- symbol reference +local function expr(strcode, etype) + return setmetatable({ strcode, type = etype }, EXPR_MT) +end + +local function varg() + return VARARG +end + +local function isVarg(x) + return x == VARARG and x +end + +-- Checks if an object is a List. Returns the object if is a List. +local function isList(x) + return type(x) == 'table' and getmetatable(x) == LIST_MT and x +end + +-- Checks if an object is a symbol. Returns the object if it is a symbol. +local function isSym(x) + return type(x) == 'table' and getmetatable(x) == SYMBOL_MT and x +end + +-- Checks if an object any kind of table, EXCEPT list or symbol +local function isTable(x) + return type(x) == 'table' and + x ~= VARARG and + getmetatable(x) ~= LIST_MT and getmetatable(x) ~= SYMBOL_MT and x +end + +-- +-- Parser +-- + +-- Convert a stream of chunks to a stream of bytes. +-- Also returns a second function to clear the buffer in the byte stream +local function granulate(getchunk) + local c = '' + local index = 1 + local done = false + return function () + if done then return nil end + if index <= #c then + local b = c:byte(index) + index = index + 1 + return b + else + c = getchunk() + if not c or c == '' then + done = true + return nil + end + index = 2 + return c:byte(1) + end + end, function () + c = '' + end +end + +-- Convert a string into a stream of bytes +local function stringStream(str) + local index = 1 + return function() + local r = str:byte(index) + index = index + 1 + return r + end +end + +-- Table of delimiter bytes - (, ), [, ], {, } +-- Opener keys have closer as the value, and closers keys +-- have true as their value. +local delims = { + [40] = 41, -- ( + [41] = true, -- ) + [91] = 93, -- [ + [93] = true, -- ] + [123] = 125, -- { + [125] = true -- } +} + +local function iswhitespace(b) + return b == 32 or (b >= 9 and b <= 13) or b == 44 +end + +local function issymbolchar(b) + return b > 32 and + not delims[b] and + b ~= 127 and + b ~= 34 and + b ~= 39 and + b ~= 59 and + b ~= 44 +end + +-- Parse one value given a function that +-- returns sequential bytes. Will throw an error as soon +-- as possible without getting more bytes on bad input. Returns +-- if a value was read, and then the value read. Will return nil +-- when input stream is finished. +local function parser(getbyte, filename) + + -- Stack of unfinished values + local stack = {} + + -- Provide one character buffer and keep + -- track of current line and byte index + local line = 1 + local byteindex = 0 + local lastb + local function ungetb(ub) + if ub == 10 then line = line - 1 end + byteindex = byteindex - 1 + lastb = ub + end + local function getb() + local r + if lastb then + r, lastb = lastb, nil + else + r = getbyte() + end + byteindex = byteindex + 1 + if r == 10 then line = line + 1 end + return r + end + + -- Parse stream + return function () + + -- Dispatch when we complete a value + local done, retval + local function dispatch(v) + if #stack == 0 then + retval = v + done = true + else + table.insert(stack[#stack], v) + end + end + + -- The main parse loop + repeat + local b + + -- Skip whitespace + repeat + b = getb() + until not b or not iswhitespace(b) + if not b then + if #stack > 0 then error 'unexpected end of source' end + return nil + end + + if b == 59 then -- ; Comment + repeat + b = getb() + until not b or b == 10 -- newline + elseif type(delims[b]) == 'number' then -- Opening delimiter + table.insert(stack, setmetatable({ + closer = delims[b], + line = line, + filename = filename, + bytestart = byteindex + }, LIST_MT)) + elseif delims[b] then -- Closing delimiter + if #stack == 0 then error 'unexpected closing delimiter' end + local last = stack[#stack] + local val + if last.closer ~= b then + error('unexpected delimiter ' .. string.char(b) .. ', expected ' .. string.char(last.closer)) + end + last.byteend = byteindex -- Set closing byte index + if b == 41 then -- ) + val = last + elseif b == 93 then -- ] + val = {} + for i = 1, #last do + val[i] = last[i] + end + else -- } + if #last % 2 ~= 0 then + error 'expected even number of values in table literal' + end + val = {} + for i = 1, #last, 2 do + val[last[i]] = last[i + 1] + end + end + stack[#stack] = nil + dispatch(val) + elseif b == 34 or b == 39 then -- Quoted string + local start = b + local state = "base" + local chars = {start} + repeat + b = getb() + chars[#chars + 1] = b + if state == "base" then + if b == 92 then + state = "backslash" + elseif b == start then + state = "done" + end + else + -- state == "backslash" + state = "base" + end + until not b or (state == "done") + if not b then error 'unexpected end of source' end + local raw = string.char(unpack(chars)) + local loadFn = loadCode(('return %s'):format(raw), nil, filename) + dispatch(loadFn()) + else -- Try symbol + local chars = {} + local bytestart = byteindex + repeat + chars[#chars + 1] = b + b = getb() + until not b or not issymbolchar(b) + if b then ungetb(b) end + local rawstr = string.char(unpack(chars)) + if rawstr == 'true' then dispatch(true) + elseif rawstr == 'false' then dispatch(false) + elseif rawstr == '...' then dispatch(VARARG) + elseif rawstr:match('^:.+$') then -- keyword style strings + dispatch(rawstr:sub(2)) + else + local forceNumber = rawstr:match('^%d') + local x + if forceNumber then + x = tonumber(rawstr) or error('could not read token "' .. rawstr .. '"') + else + x = tonumber(rawstr) or sym(rawstr, nil, { + line = line, + filename = filename, + bytestart = bytestart, + byteend = byteindex + }) + end + dispatch(x) + end + end + until done + return true, retval + end +end + +-- +-- Compilation +-- + +-- Create a new Scope, optionally under a parent scope. Scopes are compile time constructs +-- that are responsible for keeping track of local variables, name mangling, and macros. +-- They are accessible to user code via the '*compiler' special form (may change). They +-- use metatables to implement nesting via inheritance. +local function makeScope(parent) + return { + unmanglings = setmetatable({}, { + __index = parent and parent.unmanglings + }), + manglings = setmetatable({}, { + __index = parent and parent.manglings + }), + specials = setmetatable({}, { + __index = parent and parent.specials + }), + symmeta = setmetatable({}, { + __index = parent and parent.symmeta + }), + parent = parent, + vararg = parent and parent.vararg, + depth = parent and ((parent.depth or 0) + 1) or 0 + } +end + +-- Assert a condition and raise a compile error with line numbers. The ast arg +-- should be unmodified so that its first element is the form being called. +local function assertCompile(condition, msg, ast) + -- if we use regular `assert' we can't provide the `level' argument of zero + if not condition then + error(string.format("Compile error in '%s' %s:%s: %s", ast[1][1], + ast.filename or "unknown", ast.line or '?', msg), 0) + end + return condition +end + +local GLOBAL_SCOPE = makeScope() +local SPECIALS = GLOBAL_SCOPE.specials +local COMPILER_SCOPE = makeScope(GLOBAL_SCOPE) + +local luaKeywords = { + 'and', 'break', 'do', 'else', 'elseif', 'end', 'false', 'for', 'function', + 'if', 'in', 'local', 'nil', 'not', 'or', 'repeat', 'return', 'then', 'true', + 'until', 'while' +} +for i, v in ipairs(luaKeywords) do + luaKeywords[v] = i +end + +local function isValidLuaIdentifier(str) + return (str:match('^[%a_][%w_]*$') and not luaKeywords[str]) +end + +-- Allow printing a string to Lua, also keep as 1 line. +local serializeSubst = { + ['\a'] = '\\a', + ['\b'] = '\\b', + ['\f'] = '\\f', + ['\n'] = 'n', + ['\t'] = '\\t', + ['\v'] = '\\v' +} +local function serializeString(str) + local s = ("%q"):format(str) + s = s:gsub('.', serializeSubst):gsub("[\128-\255]", function(c) + return "\\" .. c:byte() + end) + return s +end + +-- A multi symbol is a symbol that is actually composed of +-- two or more symbols using the dot syntax. The main differences +-- from normal symbols is that they cannot be declared local, and +-- they may have side effects on invocation (metatables) +local function isMultiSym(str) + if type(str) ~= 'string' then return end + local parts = {} + for part in str:gmatch('[^%.]+') do + parts[#parts + 1] = part + end + return #parts > 0 and + str:match('%.') and + (not str:match('%.%.')) and + str:byte() ~= string.byte '.' and + str:byte(-1) ~= string.byte '.' and + parts +end + +-- Mangler for global symbols. Does not protect against collisions, +-- but makes them unlikely. This is the mangling that is exposed to +-- to the world. +local function globalMangling(str) + if isValidLuaIdentifier(str) then + return str + end + -- Use underscore as escape character + return '__fnl_global__' .. str:gsub('[^%w]', function (c) + return ('_%02x'):format(c:byte()) + end) +end + +-- Reverse a global mangling. Takes a Lua identifier and +-- returns the fennel symbol string that created it. +local function globalUnmangling(identifier) + local rest = identifier:match('^__fnl_global__(.*)$') + if rest then + return rest:gsub('_[%da-f][%da-f]', function (code) + return string.char(tonumber(code:sub(2), 16)) + end) + else + return identifier + end +end + +-- Creates a symbol from a string by mangling it. +-- ensures that the generated symbol is unique +-- if the input string is unique in the scope. +local function localMangling(str, scope) + if scope.manglings[str] then + return scope.manglings[str] + end + local append = 0 + local mangling = str + if isMultiSym(str) then error 'did not expect a multi symbol' end + + -- Mapping mangling to a valid Lua identifier + if luaKeywords[mangling] or mangling:match('^%d') then + mangling = '_' .. mangling + end + mangling = mangling:gsub('-', '_') + mangling = mangling:gsub('[^%w_]', function (c) + return ('_%02x'):format(c:byte()) + end) + + local raw = mangling + while scope.unmanglings[mangling] do + mangling = raw .. append + append = append + 1 + end + scope.unmanglings[mangling] = str + scope.manglings[str] = mangling + return mangling +end + +-- Combine parts of a symbol +local function combineParts(parts, scope) + local ret = scope.manglings[parts[1]] or globalMangling(parts[1]) + for i = 2, #parts do + if isValidLuaIdentifier(parts[i]) then + ret = ret .. '.' .. parts[i] + else + ret = ret .. '[' .. serializeString(parts[i]) .. ']' + end + end + return ret +end + +-- Generates a unique symbol in the scope. +local function gensym(scope) + local mangling + local append = 0 + repeat + mangling = '_' .. append .. '_' + append = append + 1 + until not scope.unmanglings[mangling] + scope.unmanglings[mangling] = true + return mangling +end + +-- Declare a local symbol +local function declareLocal(symbol, meta, scope, ast) + local name = symbol[1] + assertCompile(not isMultiSym(name), "did not expect mutltisym", ast) + local mangling = localMangling(name, scope) + scope.symmeta[name] = meta + return mangling +end + +-- Convert symbol to Lua code. Will only work for local symbols +-- if they have already been declared via declareLocal +local function symbolToExpression(symbol, scope) + local name = symbol[1] + local parts = isMultiSym(name) or {name} + local etype = (#parts > 1) and "expression" or "sym" + return expr(combineParts(parts, scope), etype) +end + + +-- Emit Lua code +local function emit(chunk, out, ast) + if type(out) == 'table' then + table.insert(chunk, out) + else + table.insert(chunk, {leaf = out, ast = ast}) + end +end + +-- Do some peephole optimization. +local function peephole(chunk) + if chunk.leaf then return chunk end + -- Optimize do ... end in some cases. + if #chunk == 3 and + chunk[1].leaf == 'do' and + not chunk[2].leaf and + chunk[3].leaf == 'end' then + return peephole(chunk[2]) + end + -- Recurse + for i, v in ipairs(chunk) do + chunk[i] = peephole(v) + end + return chunk +end + +-- correlate line numbers in input with line numbers in output +local function flattenChunkCorrelated(mainChunk) + local function flatten(chunk, out, lastLine, file) + if chunk.leaf then + out[lastLine] = (out[lastLine] or "") .. " " .. chunk.leaf + else + for _, subchunk in ipairs(chunk) do + -- Ignore empty chunks + if subchunk.leaf or #subchunk > 0 then + -- don't increase line unless it's from the same file + if subchunk.ast and file == subchunk.ast.file then + lastLine = math.max(lastLine, subchunk.ast.line or 0) + end + lastLine = flatten(subchunk, out, lastLine, file) + end + end + end + return lastLine + end + local out = {} + local last = flatten(mainChunk, out, 1, mainChunk.file) + for i = 1, last do + if out[i] == nil then out[i] = "" end + end + return table.concat(out, "\n") +end + +-- Flatten a tree of indented Lua source code lines. +-- Tab is what is used to indent a block. +local function flattenChunk(sm, chunk, tab, depth) + if type(tab) == 'boolean' then tab = tab and ' ' or '' end + if chunk.leaf then + local code = chunk.leaf + local info = chunk.ast + -- Just do line info for now to save memory + if sm then sm[#sm + 1] = info and info.line or -1 end + return code + else + local parts = {} + for i = 1, #chunk do + -- Ignore empty chunks + if chunk[i].leaf or #(chunk[i]) > 0 then + local sub = flattenChunk(sm, chunk[i], tab, depth + 1) + if depth > 0 then sub = tab .. sub:gsub('\n', '\n' .. tab) end + table.insert(parts, sub) + end + end + return table.concat(parts, '\n') + end +end + +-- Some global state for all fennel sourcemaps. For the time being, +-- this seems the easiest way to store the source maps. +-- Sourcemaps are stored with source being mapped as the key, prepended +-- with '@' if it is a filename (like debug.getinfo returns for source). +-- The value is an array of mappings for each line. +local fennelSourcemap = {} +-- TODO: loading, unloading, and saving sourcemaps? + +local function makeShortSrc(source) + source = source:gsub('\n', ' ') + if #source <= 49 then + return '[fennel "' .. source .. '"]' + else + return '[fennel "' .. source:sub(1, 46) .. '..."]' + end +end + +-- Return Lua source and source map table +local function flatten(chunk, options) + local sm = options.sourcemap and {} + chunk = peephole(chunk) + if(options.correlate) then + return flattenChunkCorrelated(chunk), {} + else + local ret = flattenChunk(sm, chunk, options.indent, 0) + if sm then + local key, short_src + if options.filename then + short_src = options.filename + key = '@' .. short_src + else + key = ret + short_src = makeShortSrc(options.source or ret) + end + sm.short_src = short_src + sm.key = key + fennelSourcemap[key] = sm + end + return ret, sm + end +end + +-- Convert expressions to Lua string +local function exprs1(exprs) + local t = {} + for _, e in ipairs(exprs) do + t[#t + 1] = e[1] + end + return table.concat(t, ', ') +end + +-- Compile side effects for a chunk +local function keepSideEffects(exprs, chunk, start, ast) + start = start or 1 + for j = start, #exprs do + local se = exprs[j] + -- Avoid the rogue 'nil' expression (nil is usually a literal, + -- but becomes an expression if a special form + -- returns 'nil'.) + if se.type == 'expression' and se[1] ~= 'nil' then + emit(chunk, ('do local _ = %s end'):format(tostring(se)), ast) + elseif se.type == 'statement' then + emit(chunk, tostring(se), ast) + end + end +end + +-- Does some common handling of returns and register +-- targets for special forms. Also ensures a list expression +-- has an acceptable number of expressions if opts contains the +-- "nval" option. +local function handleCompileOpts(exprs, parent, opts, ast) + if opts.nval then + local n = opts.nval + if n ~= #exprs then + local len = #exprs + if len > n then + -- Drop extra + keepSideEffects(exprs, parent, n + 1, ast) + for i = n, len do + exprs[i] = nil + end + else + -- Pad with nils + for i = #exprs + 1, n do + exprs[i] = expr('nil', 'literal') + end + end + end + end + if opts.tail then + emit(parent, ('return %s'):format(exprs1(exprs)), ast) + end + if opts.target then + emit(parent, ('%s = %s'):format(opts.target, exprs1(exprs)), ast) + end + if opts.tail or opts.target then + -- Prevent statements and expression from being used twice if they + -- have side-effects. Since if the target or tail options are set, + -- the expressions are already emitted, we should not return them. This + -- is fine, as when these options are set, the caller doesn't need the result + -- anyways. + exprs = {} + end + return exprs +end + +-- Compile an AST expression in the scope into parent, a tree +-- of lines that is eventually compiled into Lua code. Also +-- returns some information about the evaluation of the compiled expression, +-- which can be used by the calling function. Macros +-- are resolved here, as well as special forms in that order. +-- the 'ast' param is the root AST to compile +-- the 'scope' param is the scope in which we are compiling +-- the 'parent' param is the table of lines that we are compiling into. +-- add lines to parent by appending strings. Add indented blocks by appending +-- tables of more lines. +-- the 'opts' param contains info about where the form is being compiled. +-- Options include: +-- 'target' - mangled name of symbol(s) being compiled to. +-- Could be one variable, 'a', or a list, like 'a, b, _0_'. +-- 'tail' - boolean indicating tail position if set. If set, form will generate a return +-- instruction. +local function compile1(ast, scope, parent, opts) + opts = opts or {} + local exprs = {} + + -- Compile the form + if isList(ast) then + -- Function call or special form + local len = #ast + assert(len > 0, "expected a function to call") + -- Test for special form + local first = ast[1] + if isSym(first) then -- Resolve symbol + first = first[1] + end + local special = scope.specials[first] + if special and isSym(ast[1]) then + -- Special form + exprs = special(ast, scope, parent, opts) or expr('nil', 'literal') + -- Be very accepting of strings or expression + -- as well as lists or expressions + if type(exprs) == 'string' then exprs = expr(exprs, 'expression') end + if getmetatable(exprs) == EXPR_MT then exprs = {exprs} end + -- Unless the special form explicitly handles the target, tail, and nval properties, + -- (indicated via the 'returned' flag, handle these options. + if not exprs.returned then + exprs = handleCompileOpts(exprs, parent, opts, ast) + elseif opts.tail or opts.target then + exprs = {} + end + exprs.returned = true + return exprs + else + -- Function call + local fargs = {} + local fcallee = compile1(ast[1], scope, parent, { + nval = 1 + })[1] + assert(fcallee.type ~= 'literal', 'cannot call literal value') + fcallee = tostring(fcallee) + for i = 2, len do + local subexprs = compile1(ast[i], scope, parent, { + nval = i ~= len and 1 or nil + }) + fargs[#fargs + 1] = subexprs[1] or expr('nil', 'literal') + if i == len then + -- Add sub expressions to function args + for j = 2, #subexprs do + fargs[#fargs + 1] = subexprs[j] + end + else + -- Emit sub expression only for side effects + keepSideEffects(subexprs, parent, 2, ast[i]) + end + end + local call = ('%s(%s)'):format(tostring(fcallee), exprs1(fargs)) + exprs = handleCompileOpts({expr(call, 'statement')}, parent, opts, ast) + end + elseif isVarg(ast) then + -- assertCompile(scope.vararg, "unexpected vararg", ast) + exprs = handleCompileOpts({expr('...', 'varg')}, parent, opts, ast) + elseif isSym(ast) then + local e + -- Handle nil as special symbol - it resolves to the nil literal rather than + -- being unmangled. Alternatively, we could remove it from the lua keywords table. + if ast[1] == 'nil' then + e = expr('nil', 'literal') + else + e = symbolToExpression(ast, scope) + end + exprs = handleCompileOpts({e}, parent, opts, ast) + elseif type(ast) == 'nil' or type(ast) == 'boolean' then + exprs = handleCompileOpts({expr(tostring(ast), 'literal')}, parent, opts) + elseif type(ast) == 'number' then + local n = ('%.17g'):format(ast) + exprs = handleCompileOpts({expr(n, 'literal')}, parent, opts) + elseif type(ast) == 'string' then + local s = serializeString(ast) + exprs = handleCompileOpts({expr(s, 'literal')}, parent, opts) + elseif type(ast) == 'table' then + local buffer = {} + for i = 1, #ast do -- Write numeric keyed values. + buffer[#buffer + 1] = tostring(compile1(ast[i], scope, parent, {nval = 1})[1]) + end + local keys = {} + for k, _ in pairs(ast) do -- Write other keys. + if type(k) ~= 'number' or math.floor(k) ~= k or k < 1 or k > #ast then + local kstr + if type(k) == 'string' and isValidLuaIdentifier(k) then + kstr = k + else + kstr = '[' .. tostring(compile1(k, scope, parent, {nval = 1})[1]) .. ']' + end + table.insert(keys, { kstr, k }) + end + end + table.sort(keys, function (a, b) return a[1] < b[1] end) + for _, k in ipairs(keys) do + local v = ast[k[2]] + buffer[#buffer + 1] = ('%s = %s'):format( + k[1], tostring(compile1(v, scope, parent, {nval = 1})[1])) + end + local tbl = '({' .. table.concat(buffer, ', ') ..'})' + exprs = handleCompileOpts({expr(tbl, 'expression')}, parent, opts, ast) + else + error('could not compile value of type ' .. type(ast)) + end + exprs.returned = true + return exprs +end + +-- SPECIALS -- + +-- For statements and expressions, put the value in a local to avoid +-- double-evaluating it. +local function once(val, ast, scope, parent) + if val.type == 'statement' or val.type == 'expression' then + local s = gensym(scope) + emit(parent, ('local %s = %s'):format(s, tostring(val)), ast) + return expr(s, 'sym') + else + return val + end +end + +-- Implements destructuring for forms like let, bindings, etc. +-- Takes a number of options to control behavior. +-- var: Whether or not to mark symbols as mutable +-- declaration: begin each assignment with 'local' in output +-- nomulti: disallow multisyms in the destructuring. Used for (local) and (global). +-- noundef: Don't set undefined bindings. (set) +-- forceglobal: Don't allow local bindings +local function destructure(to, from, ast, scope, parent, opts) + opts = opts or {} + local isvar = opts.isvar + local declaration = opts.declaration + local nomulti = opts.nomulti + local noundef = opts.noundef + local forceglobal = opts.forceglobal + local setter = declaration and "local %s = %s" or "%s = %s" + + -- Get Lua source for symbol, and check for errors + local function getname(symbol, up1) + local raw = symbol[1] + assertCompile(not (nomulti and isMultiSym(raw)), + 'did not expect multisym', up1) + if declaration then + return declareLocal(symbol, {var = isvar}, scope, symbol) + else + local parts = isMultiSym(raw) or {raw} + local meta = scope.symmeta[parts[1]] + if #parts == 1 then + assertCompile(not(forceglobal and meta), + 'expected global, found var', up1) + assertCompile(meta or not noundef, + 'expected local var ' .. parts[1], up1) + assertCompile(not (meta and not meta.var), + 'expected local var', up1) + end + return symbolToExpression(symbol, scope)[1] + end + end + + -- Recursive auxiliary function + local function destructure1(left, rightexprs, up1) + if isSym(left) and left[1] ~= "nil" then + emit(parent, setter:format(getname(left, up1), exprs1(rightexprs)), left) + elseif isTable(left) then -- table destructuring + local s = gensym(scope) + emit(parent, ("local %s = %s"):format(s, exprs1(rightexprs)), left) + for i, v in ipairs(left) do + if isSym(left[i]) and left[i][1] == "&" then + assertCompile(not left[i+2], + "expected rest argument in final position", left) + local subexpr = expr(('{(table.unpack or unpack)(%s, %s)}'):format(s, i), + 'expression') + destructure1(left[i+1], {subexpr}, left) + return + else + local subexpr = expr(('%s[%d]'):format(s, i), 'expression') + destructure1(v, {subexpr}, left) + end + end + elseif isList(left) then -- values destructuring + local leftNames, tables = {}, {} + for i, name in ipairs(left) do + local symname + if isSym(name) then -- binding directly to a name + symname = getname(name, up1) + else -- further destructuring of tables inside values + symname = gensym(scope) + tables[i] = {name, expr(symname, 'sym')} + end + table.insert(leftNames, symname) + end + emit(parent, setter: + format(table.concat(leftNames, ", "), exprs1(rightexprs)), left) + for _, pair in pairs(tables) do -- recurse if left-side tables found + destructure1(pair[1], {pair[2]}, left) + end + else + assertCompile(false, 'unable to destructure ' .. tostring(left), up1) + end + end + + local rexps = compile1(from, scope, parent) + local ret = destructure1(to, rexps, ast) + return ret +end + +-- Unlike most expressions and specials, 'values' resolves with multiple +-- values, one for each argument, allowing multiple return values. The last +-- expression, can return multiple arguments as well, allowing for more than the number +-- of expected arguments. +local function values(ast, scope, parent) + local len = #ast + local exprs = {} + for i = 2, len do + local subexprs = compile1(ast[i], scope, parent, {}) + exprs[#exprs + 1] = subexprs[1] or expr('nil', 'literal') + if i == len then + for j = 2, #subexprs do + exprs[#exprs + 1] = subexprs[j] + end + else + -- Emit sub expression only for side effects + keepSideEffects(subexprs, parent, 2, ast) + end + end + return exprs +end + +-- Compile a list of forms for side effects +local function compileDo(ast, scope, parent, start) + start = start or 2 + local len = #ast + local subScope = makeScope(scope) + for i = start, len do + compile1(ast[i], subScope, parent, { + nval = 0 + }) + end +end + +-- Implements a do statement, starting at the 'start' element. By default, start is 2. +local function doImpl(ast, scope, parent, opts, start, chunk, subScope) + start = start or 2 + subScope = subScope or makeScope(scope) + chunk = chunk or {} + local len = #ast + local outerTarget = opts.target + local outerTail = opts.tail + local retexprs = {returned = true} + + -- See if we need special handling to get the return values + -- of the do block + if not outerTarget and opts.nval ~= 0 and not outerTail then + if opts.nval then + -- Generate a local target + local syms = {} + for i = 1, opts.nval do + local s = gensym(scope) + syms[i] = s + retexprs[i] = expr(s, 'sym') + end + outerTarget = table.concat(syms, ', ') + emit(parent, ('local %s'):format(outerTarget), ast) + emit(parent, 'do', ast) + else + -- We will use an IIFE for the do + local fname = gensym(scope) + emit(parent, ('local function %s()'):format(fname), ast) + retexprs = expr(fname .. '()', 'statement') + outerTail = true + outerTarget = nil + end + else + emit(parent, 'do', ast) + end + -- Compile the body + if start > len then + -- In the unlikely case we do a do with no arguments. + compile1(nil, subScope, chunk, { + tail = outerTail, + target = outerTarget + }) + -- There will be no side effects + else + for i = start, len do + local subopts = { + nval = i ~= len and 0 or opts.nval, + tail = i == len and outerTail or nil, + target = i == len and outerTarget or nil + } + local subexprs = compile1(ast[i], subScope, chunk, subopts) + if i ~= len then + keepSideEffects(subexprs, parent, nil, ast[i]) + end + end + end + emit(parent, chunk, ast) + emit(parent, 'end', ast) + return retexprs +end + +SPECIALS['do'] = doImpl +SPECIALS['values'] = values + +-- The fn special declares a function. Syntax is similar to other lisps; +-- (fn optional-name [arg ...] (body)) +-- Further decoration such as docstrings, meta info, and multibody functions a possibility. +SPECIALS['fn'] = function(ast, scope, parent) + local fScope = makeScope(scope) + local fChunk = {} + local index = 2 + local fnName = isSym(ast[index]) + local isLocalFn + if fnName and fnName[1] ~= 'nil' then + isLocalFn = not isMultiSym(fnName[1]) + if isLocalFn then + fnName = declareLocal(fnName, {}, scope, ast) + else + fnName = symbolToExpression(fnName, scope)[1] + end + index = index + 1 + else + isLocalFn = true + fnName = gensym(scope) + end + local argList = assertCompile(isTable(ast[index]), + 'expected vector arg list [a b ...]', ast) + local argNameList = {} + for i = 1, #argList do + if isVarg(argList[i]) then + assertCompile(i == #argList, "expected vararg in last parameter position", ast) + argNameList[i] = '...' + fScope.vararg = true + elseif isSym(argList[i]) + and argList[i][1] ~= "nil" + and not isMultiSym(argList[i][1]) then + argNameList[i] = declareLocal(argList[i], {}, fScope, ast) + else + assertCompile(false, 'expected symbol for function parameter', ast) + end + end + for i = index + 1, #ast do + compile1(ast[i], fScope, fChunk, { + tail = i == #ast, + nval = i ~= #ast and 0 or nil + }) + end + if isLocalFn then + emit(parent, ('local function %s(%s)') + :format(fnName, table.concat(argNameList, ', ')), ast) + else + emit(parent, ('%s = function(%s)') + :format(fnName, table.concat(argNameList, ', ')), ast) + end + emit(parent, fChunk, ast) + emit(parent, 'end', ast) + return fnName +end + +SPECIALS['luaexpr'] = function(ast) + return tostring(ast[2]) +end + +SPECIALS['luastatement'] = function(ast) + return expr(tostring(ast[2]), 'statement') +end + +-- Wrapper for table access +SPECIALS['.'] = function(ast, scope, parent) + local len = #ast + assertCompile(len > 1, "expected table argument", ast) + local lhs = compile1(ast[2], scope, parent, {nval = 1}) + if len == 2 then + return tostring(lhs[1]) + else + local indices = {} + for i = 3, len do + local index = ast[i] + if type(index) == 'string' and isValidLuaIdentifier(index) then + table.insert(indices, '.' .. index) + else + index = compile1(index, scope, parent, {nval = 1})[1] + table.insert(indices, '[' .. tostring(index) .. ']') + end + end + return tostring(lhs[1]) .. table.concat(indices) + end +end + +SPECIALS['global'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + nomulti = true, + forceglobal = true + }) +end + +SPECIALS['set'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + noundef = true + }) +end + +SPECIALS['local'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + declaration = true, + nomulti = true + }) +end + +SPECIALS['var'] = function(ast, scope, parent) + assertCompile(#ast == 3, "expected name and value", ast) + destructure(ast[2], ast[3], ast, scope, parent, { + declaration = true, + nomulti = true, + isvar = true + }) +end + +SPECIALS['let'] = function(ast, scope, parent, opts) + local bindings = ast[2] + assertCompile(isList(bindings) or isTable(bindings), + 'expected table for destructuring', ast) + assertCompile(#bindings % 2 == 0, + 'expected even number of name/value bindings', ast) + assertCompile(#ast >= 3, 'missing body expression', ast) + local subScope = makeScope(scope) + local subChunk = {} + for i = 1, #bindings, 2 do + destructure(bindings[i], bindings[i + 1], ast, subScope, subChunk, { + declaration = true, + nomulti = true + }) + end + return doImpl(ast, scope, parent, opts, 3, subChunk, subScope) +end + +-- For setting items in a table +SPECIALS['tset'] = function(ast, scope, parent) + local root = compile1(ast[2], scope, parent, {nval = 1})[1] + local keys = {} + for i = 3, #ast - 1 do + local key = compile1(ast[i], scope, parent, {nval = 1})[1] + keys[#keys + 1] = tostring(key) + end + local value = compile1(ast[#ast], scope, parent, {nval = 1})[1] + emit(parent, ('%s[%s] = %s'):format(tostring(root), + table.concat(keys, ']['), + tostring(value)), ast) +end + +-- The if special form behaves like the cond form in +-- many languages +SPECIALS['if'] = function(ast, scope, parent, opts) + local doScope = makeScope(scope) + local branches = {} + local elseBranch = nil + + -- Calculate some external stuff. Optimizes for tail calls and what not + local outerTail = true + local outerTarget = nil + local wrapper = 'iife' + if opts.tail then + wrapper = 'none' + end + + -- Compile bodies and conditions + local bodyOpts = { + tail = outerTail, + target = outerTarget + } + local function compileBody(i) + local chunk = {} + local cscope = makeScope(doScope) + compile1(ast[i], cscope, chunk, bodyOpts) + return { + chunk = chunk, + scope = cscope + } + end + for i = 2, #ast - 1, 2 do + local condchunk = {} + local cond = compile1(ast[i], doScope, condchunk, {nval = 1}) + local branch = compileBody(i + 1) + branch.cond = cond + branch.condchunk = condchunk + branch.nested = i ~= 2 and next(condchunk, nil) == nil + table.insert(branches, branch) + end + local hasElse = #ast > 3 and #ast % 2 == 0 + if hasElse then elseBranch = compileBody(#ast) end + + -- Emit code + local s = gensym(scope) + local buffer = {} + local lastBuffer = buffer + for i = 1, #branches do + local branch = branches[i] + local fstr = not branch.nested and 'if %s then' or 'elseif %s then' + local condLine = fstr:format(tostring(branch.cond[1])) + if branch.nested then + emit(lastBuffer, branch.condchunk, ast) + else + for _, v in ipairs(branch.condchunk) do emit(lastBuffer, v, ast) end + end + emit(lastBuffer, condLine, ast) + emit(lastBuffer, branch.chunk, ast) + if i == #branches then + if hasElse then + emit(lastBuffer, 'else', ast) + emit(lastBuffer, elseBranch.chunk, ast) + end + emit(lastBuffer, 'end', ast) + elseif not branches[i + 1].nested then + emit(lastBuffer, 'else', ast) + local nextBuffer = {} + emit(lastBuffer, nextBuffer, ast) + emit(lastBuffer, 'end', ast) + lastBuffer = nextBuffer + end + end + + if wrapper == 'iife' then + local iifeargs = scope.vararg and '...' or '' + emit(parent, ('local function %s(%s)'):format(tostring(s), iifeargs), ast) + emit(parent, buffer, ast) + emit(parent, 'end', ast) + return expr(('%s(%s)'):format(tostring(s), iifeargs), 'statement') + elseif wrapper == 'none' then + -- Splice result right into code + for i = 1, #buffer do + emit(parent, buffer[i], ast) + end + return {returned = true} + end +end + +-- (each [k v (pairs t)] body...) => [] +SPECIALS['each'] = function(ast, scope, parent) + local binding = assertCompile(isTable(ast[2]), 'expected binding table', ast) + local iter = table.remove(binding, #binding) -- last item is iterator call + local bindVars = {} + for _, v in ipairs(binding) do + assertCompile(isSym(v), 'expected iterator symbol', ast) + table.insert(bindVars, declareLocal(v, {}, scope, ast)) + end + emit(parent, ('for %s in %s do'):format( + table.concat(bindVars, ', '), + tostring(compile1(iter, scope, parent, {nval = 1})[1])), ast) + local chunk = {} + compileDo(ast, scope, chunk, 3) + emit(parent, chunk, ast) + emit(parent, 'end', ast) +end + +-- (while condition body...) => [] +SPECIALS['while'] = function(ast, scope, parent) + local len1 = #parent + local condition = compile1(ast[2], scope, parent, {nval = 1})[1] + local len2 = #parent + local subChunk = {} + if len1 ~= len2 then + -- Compound condition + emit(parent, 'while true do', ast) + -- Move new compilation to subchunk + for i = len1 + 1, len2 do + subChunk[#subChunk + 1] = parent[i] + parent[i] = nil + end + emit(parent, ('if %s then break end'):format(condition[1]), ast) + else + -- Simple condition + emit(parent, 'while ' .. tostring(condition) .. ' do', ast) + end + compileDo(ast, makeScope(scope), subChunk, 3) + emit(parent, subChunk, ast) + emit(parent, 'end', ast) +end + +SPECIALS['for'] = function(ast, scope, parent) + local ranges = assertCompile(isTable(ast[2]), 'expected binding table', ast) + local bindingSym = assertCompile(isSym(table.remove(ast[2], 1)), + 'expected iterator symbol', ast) + local rangeArgs = {} + for i = 1, math.min(#ranges, 3) do + rangeArgs[i] = tostring(compile1(ranges[i], scope, parent, {nval = 1})[1]) + end + emit(parent, ('for %s = %s do'):format( + declareLocal(bindingSym, {}, scope, ast), + table.concat(rangeArgs, ', ')), ast) + local chunk = {} + compileDo(ast, scope, chunk, 3) + emit(parent, chunk, ast) + emit(parent, 'end', ast) +end + +SPECIALS[':'] = function(ast, scope, parent) + assertCompile(#ast >= 3, 'expected at least 3 arguments', ast) + -- Compile object + local objectexpr = compile1(ast[2], scope, parent, {nval = 1})[1] + -- Compile method selector + local methodstring + local methodident = false + if type(ast[3]) == 'string' and isValidLuaIdentifier(ast[3]) then + methodident = true + methodstring = ast[3] + else + methodstring = tostring(compile1(ast[3], scope, parent, {nval = 1})[1]) + objectexpr = once(objectexpr, ast[2], scope, parent) + end + -- Compile arguments + local args = {} + for i = 4, #ast do + local subexprs = compile1(ast[i], scope, parent, { + nval = i ~= #ast and 1 or nil + }) + for j = 1, #subexprs do + args[#args + 1] = tostring(subexprs[j]) + end + end + local fstring + if methodident then + fstring = objectexpr.type == 'literal' + and '(%s):%s(%s)' + or '%s:%s(%s)' + else + -- Make object first argument + table.insert(args, 1, tostring(objectexpr)) + fstring = objectexpr.type == 'sym' + and '%s[%s](%s)' + or '(%s)[%s](%s)' + end + return expr(fstring:format( + tostring(objectexpr), + methodstring, + table.concat(args, ', ')), 'statement') +end + +local function defineArithmeticSpecial(name, unaryPrefix) + local paddedOp = ' ' .. name .. ' ' + SPECIALS[name] = function(ast, scope, parent) + local len = #ast + if len == 1 then + return unaryPrefix or '0' + else + local operands = {} + for i = 2, len do + local subexprs = compile1(ast[i], scope, parent, { + nval = (i == 1 and 1 or nil) + }) + for j = 1, #subexprs do + operands[#operands + 1] = tostring(subexprs[j]) + end + end + if #operands == 1 and unaryPrefix then + return '(' .. unaryPrefix .. paddedOp .. operands[1] .. ')' + else + return '(' .. table.concat(operands, paddedOp) .. ')' + end + end + end +end + +defineArithmeticSpecial('+') +defineArithmeticSpecial('..') +defineArithmeticSpecial('^') +defineArithmeticSpecial('-', '') +defineArithmeticSpecial('*') +defineArithmeticSpecial('%') +defineArithmeticSpecial('/', 1) +defineArithmeticSpecial('//', 1) +defineArithmeticSpecial('or') +defineArithmeticSpecial('and') + +local function defineComparatorSpecial(name, realop) + local op = realop or name + SPECIALS[name] = function(ast, scope, parent) + assertCompile(#ast > 2, 'expected at least two arguments', ast) + local lhs = compile1(ast[2], scope, parent, {nval = 1})[1] + local lastval = compile1(ast[3], scope, parent, {nval = 1})[1] + -- avoid double-eval by introducing locals for possible side-effects + if #ast > 3 then lastval = once(lastval, ast[3], scope, parent) end + local out = ('(%s) %s (%s)'): + format(tostring(lhs), op, tostring(lastval)) + for i = 4, #ast do -- variadic comparison + local nextval = once(compile1(ast[i], scope, parent, {nval = 1})[1], + ast[i], scope, parent) + out = (out .. " and ((%s) %s (%s))"): + format(tostring(lastval), op, tostring(nextval)) + lastval = nextval + end + return out + end +end + +defineComparatorSpecial('>') +defineComparatorSpecial('<') +defineComparatorSpecial('>=') +defineComparatorSpecial('<=') +defineComparatorSpecial('=', '==') +defineComparatorSpecial('~=') + +local function defineUnarySpecial(op, realop) + SPECIALS[op] = function(ast, scope, parent) + assertCompile(#ast == 2, 'expected one argument', ast) + local tail = compile1(ast[2], scope, parent, {nval = 1}) + return (realop or op) .. tostring(tail[1]) + end +end + +defineUnarySpecial('not', 'not ') +defineUnarySpecial('#') + +-- Covert a macro function to a special form +local function macroToSpecial(mac) + return function(ast, scope, parent, opts) + local ok, transformed = pcall(mac, unpack(ast, 2)) + assertCompile(ok, transformed, ast) + return compile1(transformed, scope, parent, opts) + end +end + +local function compile(ast, options) + options = options or {} + if options.indent == nil then options.indent = ' ' end + local chunk = {} + local scope = options.scope or makeScope(GLOBAL_SCOPE) + local exprs = compile1(ast, scope, chunk, {tail = true}) + keepSideEffects(exprs, chunk, nil, ast) + return flatten(chunk, options) +end + +local function compileStream(strm, options) + options = options or {} + if options.indent == nil then options.indent = ' ' end + local scope = options.scope or makeScope(GLOBAL_SCOPE) + local vals = {} + for ok, val in parser(strm, options.filename) do + if not ok then break end + vals[#vals + 1] = val + end + local chunk = {} + for i = 1, #vals do + local exprs = compile1(vals[i], scope, chunk, { + tail = i == #vals + }) + keepSideEffects(exprs, chunk, nil, vals[i]) + end + return flatten(chunk, options) +end + +local function compileString(str, options) + local strm = stringStream(str) + return compileStream(strm, options) +end + +--- +--- Evaluation +--- + +-- A custom traceback function for Fennel that looks similar to +-- the Lua's debug.traceback. +-- Use with xpcall to produce fennel specific stacktraces. +local function traceback(msg, start) + local level = start or 2 -- Can be used to skip some frames + local lines = {} + if msg then + table.insert(lines, msg) + end + table.insert(lines, 'stack traceback:') + while true do + local info = debug.getinfo(level, "Sln") + if not info then break end + local line + if info.what == "C" then + if info.name then + line = (' [C]: in function \'%s\''):format(info.name) + else + line = ' [C]: in ?' + end + else + local remap = fennelSourcemap[info.source] + if remap and remap[info.currentline] then + -- And some global info + info.short_src = remap.short_src + local mapping = remap[info.currentline] + -- Overwrite info with values from the mapping (mapping is now just integer, + -- but may eventually be a table + info.currentline = mapping + end + if info.what == 'Lua' then + local n = info.name and ("'" .. info.name .. "'") or '?' + line = (' %s:%d: in function %s'):format(info.short_src, info.currentline, n) + elseif info.short_src == '(tail call)' then + line = ' (tail call)' + else + line = (' %s:%d: in main chunk'):format(info.short_src, info.currentline) + end + end + table.insert(lines, line) + level = level + 1 + end + return table.concat(lines, '\n') +end + +local function eval(str, options, ...) + options = options or {} + local luaSource = compileString(str, options) + local loader = loadCode(luaSource, options.env, + options.filename and ('@' .. options.filename) or str) + return loader(...) +end + +local function dofile_fennel(filename, options, ...) + options = options or {sourcemap = true} + local f = assert(io.open(filename, "rb")) + local source = f:read("*all") + f:close() + options.filename = options.filename or filename + return eval(source, options, ...) +end + +-- Implements a configurable repl +local function repl(options) + + local opts = options or {} + + local env = opts.env or setmetatable({}, { + __index = _ENV or _G + }) + + local function defaultReadChunk() + io.write('>> ') + io.flush() + local input = io.read() + return input and input .. '\n' + end + + local function defaultOnValues(xs) + io.write(table.concat(xs, '\t')) + io.write('\n') + end + + local function defaultOnError(errtype, err, luaSource) + if (errtype == 'Lua Compile') then + io.write('Bad code generated - likely a bug with the compiler:\n') + io.write('--- Generated Lua Start ---\n') + io.write(luaSource .. '\n') + io.write('--- Generated Lua End ---\n') + end + if (errtype == 'Runtime') then + io.write(traceback(err, 4)) + io.write('\n') + else + io.write(('%s error: %s\n'):format(errtype, tostring(err))) + end + end + + -- Read options + local readChunk = opts.readChunk or defaultReadChunk + local onValues = opts.onValues or defaultOnValues + local onError = opts.onError or defaultOnError + local pp = opts.pp or tostring + + -- Make parser + local bytestream, clearstream = granulate(readChunk) + local chars = {} + local read = parser(function() + local c = bytestream() + chars[#chars + 1] = c + return c + end) + + -- REPL loop + while true do + chars = {} + local ok, parseok, x = pcall(read) + local srcstring = string.char(unpack(chars)) + if not ok then + onError('Parse', parseok) + clearstream() + else + if not parseok then break end -- eof + local compileOk, luaSource = pcall(compile, x, { + sourcemap = opts.sourcemap, + source = srcstring + }) + if not compileOk then + clearstream() + onError('Compile', luaSource) -- luaSource is error message in this case + else + local luacompileok, loader = pcall(loadCode, luaSource, env) + if not luacompileok then + clearstream() + onError('Lua Compile', loader, luaSource) + else + local loadok, ret = xpcall(function () return {loader()} end, + function (runtimeErr) + onError('Runtime', runtimeErr) + end) + if loadok then + env._ = ret[1] + env.__ = ret + for i = 1, #ret do ret[i] = pp(ret[i]) end + onValues(ret) + end + end + end + end + end +end + +local module = { + parser = parser, + granulate = granulate, + stringStream = stringStream, + compile = compile, + compileString = compileString, + compileStream = compileStream, + compile1 = compile1, + mangle = globalMangling, + unmangle = globalUnmangling, + list = list, + sym = sym, + varg = varg, + scope = makeScope, + gensym = gensym, + eval = eval, + repl = repl, + dofile = dofile_fennel, + path = "./?.fnl;./?/init.fnl", + traceback = traceback +} + +local function searchModule(modulename) + modulename = modulename:gsub("%.", "/") + for path in string.gmatch(module.path..";", "([^;]*);") do + local filename = path:gsub("%?", modulename) + local file = io.open(filename, "rb") + if(file) then + file:close() + return filename + end + end +end + +module.make_searcher = function(options) + return function(modulename) + local opts = {} + for k,v in pairs(options or {}) do opts[k] = v end + local filename = searchModule(modulename) + if filename then + return function(modname) + return dofile_fennel(filename, opts, modname) + end + end + end +end + +-- This will allow regular `require` to work with Fennel: +-- table.insert(package.loaders, fennel.searcher) +module.searcher = module.make_searcher() + +local function makeCompilerEnv(ast, scope, parent) + return setmetatable({ + -- State of compiler if needed + _SCOPE = scope, + _CHUNK = parent, + _AST = ast, + _IS_COMPILER = true, + _SPECIALS = SPECIALS, + _VARARG = VARARG, + -- Expose the module in the compiler + fennel = module, + -- Useful for macros and meta programming. All of Fennel can be accessed + -- via fennel.myfun, for example (fennel.eval "(print 1)"). + list = list, + sym = sym, + [globalMangling("list?")] = isList, + [globalMangling("multi-sym?")] = isMultiSym, + [globalMangling("sym?")] = isSym, + [globalMangling("table?")] = isTable, + [globalMangling("varg?")] = isVarg, + }, { __index = _ENV or _G }) +end + +SPECIALS['require-macros'] = function(ast, scope, parent) + for i = 2, #ast do + local filename = assertCompile(searchModule(ast[i]), + ast[i] .. " not found.", ast) + local mod = dofile_fennel(filename, {env=makeCompilerEnv(ast, scope, parent)}) + for k, v in pairs(assertCompile(isTable(mod), 'expected ' .. ast[i] .. + 'module to be table', ast)) do + scope.specials[k] = macroToSpecial(v) + end + end +end + +SPECIALS['eval-compiler'] = function(ast, scope, parent) + local oldFirst = ast[1] + ast[1] = sym('do') + local luaSource = compile(ast, { scope = makeScope(COMPILER_SCOPE) }) + ast[1] = oldFirst + local loader = loadCode(luaSource, makeCompilerEnv(ast, scope, parent)) + loader() +end + +-- Load standard macros +local stdmacros = [===[ +{"->" (fn [val ...] + (var x val) + (each [_ elt (ipairs [...])] + (table.insert elt 2 x) + (set x elt)) + x) + "->>" (fn [val ...] + (var x val) + (each [_ elt (pairs [...])] + (table.insert elt x) + (set x elt)) + x) + :defn (fn [name args ...] + (assert (sym? name) "defn: function names must be symbols") + (list (sym :fn) name args ...)) + :when (fn [condition body1 ...] + (assert body1 "expected body") + (list (sym 'if') condition + (list (sym 'do') body1 ...))) + :partial (fn [f ...] + (let [body (list f ...)] + (table.insert body _VARARG) + (list (sym "fn") [_VARARG] body))) + :lambda (fn [...] + (let [args [...] + has-internal-name? (sym? (. args 1)) + arglist (if has-internal-name? (. args 2) (. args 1)) + arity-check-position (if has-internal-name? 3 2)] + (assert (> (# args) 1) "missing body expression") + (each [i a (ipairs arglist)] + (if (and (not (: (tostring a) :match "^?")) + (~= (tostring a) "...")) + (table.insert args arity-check-position + (list (sym "assert") + (list (sym "~=") (sym "nil") a) + (: "Missing argument %s on %s:%s" + :format (tostring a) + (or a.filename "unknown") + (or a.line "?")))))) + (list (sym "fn") ((or unpack table.unpack) args)))) +} +]===] +for name, fn in pairs(eval(stdmacros, { + env = makeCompilerEnv(nil, GLOBAL_SCOPE, {}) +})) do + SPECIALS[name] = macroToSpecial(fn) +end +SPECIALS['λ'] = SPECIALS['lambda'] + +return module diff --git a/lib/fennelview.lua b/lib/fennelview.lua new file mode 100644 index 0000000..1259f6e --- /dev/null +++ b/lib/fennelview.lua @@ -0,0 +1,201 @@ +local function _0_(str) + return ("\"" .. str:gsub("\"", "\\\"") .. "\"") +end +local quote = _0_ +local short_control_char_escapes = ({["\11"] = "\\v", ["\12"] = "\\f", ["\13"] = "\\r", ["\7"] = "\\a", ["\8"] = "\\b", ["\9"] = "\\t", ["\n"] = "\\n"}) +local function _1_() + local long = ({}) + for i = 0, 31 do + local ch = string.char(i) + local function _2_() + if not short_control_char_escapes[ch] then + short_control_char_escapes[ch] = ("\\" .. i) + long[ch] = ("\\%03d"):format(i) + return nil + end + end + _2_() + end + return long +end +local long_control_char_esapes = _1_() +local function _2_(str) + local str = str:gsub("\\", "\\\\") + local str = str:gsub("(%c)%f[0-9]", long_control_char_esapes) + return str:gsub("%c", short_control_char_escapes) +end +local escape = _2_ +local function _3_(k, len) + return ((type(k)) == ("number") and (1) <= (k) and (k) <= (len) and (math.floor(k)) == (k)) +end +local sequence_key_3f = _3_ +local type_order = ({["function"] = 5, boolean = 2, number = 1, string = 3, table = 4, thread = 7, userdata = 6}) +local function _4_(a, b) + local ta = type(a) + local tb = type(b) + if ((ta) == (tb) and (ta) ~= ("boolean") and ((ta) == ("string") or (ta) == ("number"))) then + return (a) < (b) + else + local dta = type_order[a] + local dtb = type_order[b] + if (dta and dtb) then + return (dta) < (dtb) + elseif dta then + return true + elseif dtb then + return false + elseif "else" then + return (ta) < (tb) + end + end +end +local sort_keys = _4_ +local function _5_(t) + local len = 1 + for i in ipairs(t) do + len = i + end + return len +end +local get_sequence_length = _5_ +local function _6_(t) + local keys = ({}) + local sequence_length = get_sequence_length(t) + for k in pairs(t) do + local function _7_() + if not sequence_key_3f(k, sequence_length) then + return table.insert(keys, k) + end + end + _7_() + end + table.sort(keys, sort_keys) + return keys, sequence_length +end +local get_nonsequential_keys = _6_ +local function recur(t, appearances) + local function _7_() + if (type(t)) == ("table") then + if not appearances[t] then + appearances[t] = 1 + for k, v in pairs(t) do + recur(k, appearances) + recur(v, appearances) + end + return nil + end + else + if (t and (t) == (t)) then + appearances[t] = ((appearances[t] or 0) + 1) + return nil + end + end + end + _7_() + return appearances +end +local count_table_appearances = recur +local put_value = nil +local function _7_(self, ...) + for _, v in ipairs(({...})) do + table.insert(self.buffer, v) + end + return nil +end +local puts = _7_ +local function _8_(self) + return puts(self, "\n", self.indent:rep(self.level)) +end +local tabify = _8_ +local function _9_(self, v) + return (self.ids[v]) ~= (nil) +end +local already_visited_3f = _9_ +local function _10_(self, v) + local id = self.ids[v] + local function _11_() + if not id then + local tv = type(v) + id = ((self["max-ids"][tv] or 0) + 1) + self["max-ids"][tv] = id + self.ids[v] = id + return nil + end + end + _11_() + return tostring(id) +end +local get_id = _10_ +local function _11_(self, t, length) + puts(self, "[") + self.level = (self.level + 1) + for i = 1, length do + puts(self, " ") + put_value(self, t[i]) + end + self.level = (self.level - 1) + return puts(self, " ]") +end +local put_sequential_table = _11_ +local function _12_(self, k) + if ((type(k)) == ("string") and k:find("^[%w?\\^_`!#$%&*+-./@~:|<=>]+$")) then + return puts(self, ":", k) + else + return put_value(self, k) + end +end +local put_key = _12_ +local function _13_(self, t) + puts(self, "{") + self.level = (self.level + 1) + for k, v in pairs(t) do + tabify(self) + put_key(self, k) + puts(self, " ") + put_value(self, v) + end + self.level = (self.level - 1) + tabify(self) + return puts(self, "}") +end +local put_kv_table = _13_ +local function _14_(self, t) + if already_visited_3f(self, t) then + return puts(self, "#<table ", get_id(self, t), ">") + elseif (self.level) >= (self.depth) then + return puts(self, "{...}") + elseif "else" then + local non_seq_keys, length = get_nonsequential_keys(t) + local id = get_id(self, t) + if (self.appearances[t]) > (1) then + return puts(self, "#<", id, ">") + elseif ((#non_seq_keys) == (0) and (#t) == (0)) then + return puts(self, "{}") + elseif (#non_seq_keys) == (0) then + return put_sequential_table(self, t, length) + elseif "else" then + return put_kv_table(self, t) + end + end +end +local put_table = _14_ +local function _15_(self, v) + local tv = type(v) + if (tv) == ("string") then + return puts(self, quote(escape(v))) + elseif ((tv) == ("number") or (tv) == ("boolean") or (tv) == ("nil")) then + return puts(self, tostring(v)) + elseif (tv) == ("table") then + return put_table(self, v) + elseif "else" then + return puts(self, "#<", tv, " ", get_id(self, v), ">") + end +end +put_value = _15_ +local function _16_(root, options) + local options = (options or ({})) + local inspector = ({["max-ids"] = ({}), appearances = count_table_appearances(root, ({})), buffer = ({}), depth = (options.depth or 128), ids = ({}), indent = (options.indent or " "), level = 0}) + put_value(inspector, root) + return table.concat(inspector.buffer) +end +return _16_ diff --git a/lib/lume.LICENSE b/lib/lume.LICENSE new file mode 100644 index 0000000..8ce02b9 --- /dev/null +++ b/lib/lume.LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2018 rxi + + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies +of the Software, and to permit persons to whom the Software is furnished to do +so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/lib/lume.lua b/lib/lume.lua new file mode 100644 index 0000000..a5f0d9a --- /dev/null +++ b/lib/lume.lua @@ -0,0 +1,768 @@ +-- +-- lume +-- +-- Copyright (c) 2015 rxi +-- +-- This library is free software; you can redistribute it and/or modify it +-- under the terms of the MIT license. See LICENSE for details. +-- + +local lume = { _version = "2.2.3" } + +local pairs, ipairs = pairs, ipairs +local type, assert, unpack = type, assert, unpack or table.unpack +local tostring, tonumber = tostring, tonumber +local math_floor = math.floor +local math_ceil = math.ceil +local math_random = math.random +local math_atan2 = math.atan2 or math.atan +local math_sqrt = math.sqrt +local math_abs = math.abs + +local noop = function() +end + +local identity = function(x) + return x +end + +local patternescape = function(str) + return str:gsub("[%(%)%.%%%+%-%*%?%[%]%^%$]", "%%%1") +end + +local absindex = function(len, i) + return i < 0 and (len + i + 1) or i +end + +local iscallable = function(x) + if type(x) == "function" then return true end + local mt = getmetatable(x) + return mt and mt.__call ~= nil +end + +local getiter = function(x) + if lume.isarray(x) then + return ipairs + elseif type(x) == "table" then + return pairs + end + error("expected table", 3) +end + +local iteratee = function(x) + if x == nil then return identity end + if iscallable(x) then return x end + if type(x) == "table" then + return function(z) + for k, v in pairs(x) do + if z[k] ~= v then return false end + end + return true + end + end + return function(z) return z[x] end +end + + + +function lume.clamp(x, min, max) + return x < min and min or (x > max and max or x) +end + + +function lume.round(x, increment) + if increment then return lume.round(x / increment) * increment end + return x >= 0 and math_floor(x + .5) or math_ceil(x - .5) +end + + +function lume.sign(x) + return x < 0 and -1 or 1 +end + + +function lume.lerp(a, b, amount) + return a + (b - a) * lume.clamp(amount, 0, 1) +end + + +function lume.smooth(a, b, amount) + local t = lume.clamp(amount, 0, 1) + local m = t * t * (3 - 2 * t) + return a + (b - a) * m +end + + +function lume.pingpong(x) + return 1 - math_abs(1 - x % 2) +end + + +function lume.distance(x1, y1, x2, y2, squared) + local dx = x1 - x2 + local dy = y1 - y2 + local s = dx * dx + dy * dy + return squared and s or math_sqrt(s) +end + + +function lume.angle(x1, y1, x2, y2) + return math_atan2(y2 - y1, x2 - x1) +end + + +function lume.random(a, b) + if not a then a, b = 0, 1 end + if not b then b = 0 end + return a + math_random() * (b - a) +end + + +function lume.randomchoice(t) + return t[math_random(#t)] +end + + +function lume.weightedchoice(t) + local sum = 0 + for _, v in pairs(t) do + assert(v >= 0, "weight value less than zero") + sum = sum + v + end + assert(sum ~= 0, "all weights are zero") + local rnd = lume.random(sum) + for k, v in pairs(t) do + if rnd < v then return k end + rnd = rnd - v + end +end + + +function lume.isarray(x) + return (type(x) == "table" and x[1] ~= nil) and true or false +end + + +function lume.push(t, ...) + local n = select("#", ...) + for i = 1, n do + t[#t + 1] = select(i, ...) + end + return ... +end + + +function lume.remove(t, x) + local iter = getiter(t) + for i, v in iter(t) do + if v == x then + if lume.isarray(t) then + table.remove(t, i) + break + else + t[i] = nil + break + end + end + end + return x +end + + +function lume.clear(t) + local iter = getiter(t) + for k in iter(t) do + t[k] = nil + end + return t +end + + +function lume.extend(t, ...) + for i = 1, select("#", ...) do + local x = select(i, ...) + if x then + for k, v in pairs(x) do + t[k] = v + end + end + end + return t +end + + +function lume.shuffle(t) + local rtn = {} + for i = 1, #t do + local r = math_random(i) + if r ~= i then + rtn[i] = rtn[r] + end + rtn[r] = t[i] + end + return rtn +end + + +function lume.sort(t, comp) + local rtn = lume.clone(t) + if comp then + if type(comp) == "string" then + table.sort(rtn, function(a, b) return a[comp] < b[comp] end) + else + table.sort(rtn, comp) + end + else + table.sort(rtn) + end + return rtn +end + + +function lume.array(...) + local t = {} + for x in ... do t[#t + 1] = x end + return t +end + + +function lume.each(t, fn, ...) + local iter = getiter(t) + if type(fn) == "string" then + for _, v in iter(t) do v[fn](v, ...) end + else + for _, v in iter(t) do fn(v, ...) end + end + return t +end + + +function lume.map(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + for k, v in iter(t) do rtn[k] = fn(v) end + return rtn +end + + +function lume.all(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for _, v in iter(t) do + if not fn(v) then return false end + end + return true +end + + +function lume.any(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for _, v in iter(t) do + if fn(v) then return true end + end + return false +end + + +function lume.reduce(t, fn, first) + local acc = first + local started = first and true or false + local iter = getiter(t) + for _, v in iter(t) do + if started then + acc = fn(acc, v) + else + acc = v + started = true + end + end + assert(started, "reduce of an empty table with no first value") + return acc +end + + +function lume.set(t) + local rtn = {} + for k in pairs(lume.invert(t)) do + rtn[#rtn + 1] = k + end + return rtn +end + + +function lume.filter(t, fn, retainkeys) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + if retainkeys then + for k, v in iter(t) do + if fn(v) then rtn[k] = v end + end + else + for _, v in iter(t) do + if fn(v) then rtn[#rtn + 1] = v end + end + end + return rtn +end + + +function lume.reject(t, fn, retainkeys) + fn = iteratee(fn) + local iter = getiter(t) + local rtn = {} + if retainkeys then + for k, v in iter(t) do + if not fn(v) then rtn[k] = v end + end + else + for _, v in iter(t) do + if not fn(v) then rtn[#rtn + 1] = v end + end + end + return rtn +end + + +function lume.merge(...) + local rtn = {} + for i = 1, select("#", ...) do + local t = select(i, ...) + local iter = getiter(t) + for k, v in iter(t) do + rtn[k] = v + end + end + return rtn +end + + +function lume.concat(...) + local rtn = {} + for i = 1, select("#", ...) do + local t = select(i, ...) + if t ~= nil then + local iter = getiter(t) + for _, v in iter(t) do + rtn[#rtn + 1] = v + end + end + end + return rtn +end + + +function lume.find(t, value) + local iter = getiter(t) + for k, v in iter(t) do + if v == value then return k end + end + return nil +end + + +function lume.match(t, fn) + fn = iteratee(fn) + local iter = getiter(t) + for k, v in iter(t) do + if fn(v) then return v, k end + end + return nil +end + + +function lume.count(t, fn) + local count = 0 + local iter = getiter(t) + if fn then + fn = iteratee(fn) + for _, v in iter(t) do + if fn(v) then count = count + 1 end + end + else + if lume.isarray(t) then + return #t + end + for _ in iter(t) do count = count + 1 end + end + return count +end + + +function lume.slice(t, i, j) + i = i and absindex(#t, i) or 1 + j = j and absindex(#t, j) or #t + local rtn = {} + for x = i < 1 and 1 or i, j > #t and #t or j do + rtn[#rtn + 1] = t[x] + end + return rtn +end + + +function lume.first(t, n) + if not n then return t[1] end + return lume.slice(t, 1, n) +end + + +function lume.last(t, n) + if not n then return t[#t] end + return lume.slice(t, -n, -1) +end + + +function lume.invert(t) + local rtn = {} + for k, v in pairs(t) do rtn[v] = k end + return rtn +end + + +function lume.pick(t, ...) + local rtn = {} + for i = 1, select("#", ...) do + local k = select(i, ...) + rtn[k] = t[k] + end + return rtn +end + + +function lume.keys(t) + local rtn = {} + local iter = getiter(t) + for k in iter(t) do rtn[#rtn + 1] = k end + return rtn +end + + +function lume.clone(t) + local rtn = {} + for k, v in pairs(t) do rtn[k] = v end + return rtn +end + + +function lume.fn(fn, ...) + assert(iscallable(fn), "expected a function as the first argument") + local args = { ... } + return function(...) + local a = lume.concat(args, { ... }) + return fn(unpack(a)) + end +end + + +function lume.once(fn, ...) + local f = lume.fn(fn, ...) + local done = false + return function(...) + if done then return end + done = true + return f(...) + end +end + + +local memoize_fnkey = {} +local memoize_nil = {} + +function lume.memoize(fn) + local cache = {} + return function(...) + local c = cache + for i = 1, select("#", ...) do + local a = select(i, ...) or memoize_nil + c[a] = c[a] or {} + c = c[a] + end + c[memoize_fnkey] = c[memoize_fnkey] or {fn(...)} + return unpack(c[memoize_fnkey]) + end +end + + +function lume.combine(...) + local n = select('#', ...) + if n == 0 then return noop end + if n == 1 then + local fn = select(1, ...) + if not fn then return noop end + assert(iscallable(fn), "expected a function or nil") + return fn + end + local funcs = {} + for i = 1, n do + local fn = select(i, ...) + if fn ~= nil then + assert(iscallable(fn), "expected a function or nil") + funcs[#funcs + 1] = fn + end + end + return function(...) + for _, f in ipairs(funcs) do f(...) end + end +end + + +function lume.call(fn, ...) + if fn then + return fn(...) + end +end + + +function lume.time(fn, ...) + local start = os.clock() + local rtn = {fn(...)} + return (os.clock() - start), unpack(rtn) +end + + +local lambda_cache = {} + +function lume.lambda(str) + if not lambda_cache[str] then + local args, body = str:match([[^([%w,_ ]-)%->(.-)$]]) + assert(args and body, "bad string lambda") + local s = "return function(" .. args .. ")\nreturn " .. body .. "\nend" + lambda_cache[str] = lume.dostring(s) + end + return lambda_cache[str] +end + + +local serialize + +local serialize_map = { + [ "boolean" ] = tostring, + [ "nil" ] = tostring, + [ "string" ] = function(v) return string.format("%q", v) end, + [ "number" ] = function(v) + if v ~= v then return "0/0" -- nan + elseif v == 1 / 0 then return "1/0" -- inf + elseif v == -1 / 0 then return "-1/0" end -- -inf + return tostring(v) + end, + [ "table" ] = function(t, stk) + stk = stk or {} + if stk[t] then error("circular reference") end + local rtn = {} + stk[t] = true + for k, v in pairs(t) do + rtn[#rtn + 1] = "[" .. serialize(k, stk) .. "]=" .. serialize(v, stk) + end + stk[t] = nil + return "{" .. table.concat(rtn, ",") .. "}" + end +} + +setmetatable(serialize_map, { + __index = function(_, k) error("unsupported serialize type: " .. k) end +}) + +serialize = function(x, stk) + return serialize_map[type(x)](x, stk) +end + +function lume.serialize(x) + return serialize(x) +end + + +function lume.deserialize(str) + return lume.dostring("return " .. str) +end + + +function lume.split(str, sep) + if not sep then + return lume.array(str:gmatch("([%S]+)")) + else + assert(sep ~= "", "empty separator") + local psep = patternescape(sep) + return lume.array((str..sep):gmatch("(.-)("..psep..")")) + end +end + + +function lume.trim(str, chars) + if not chars then return str:match("^[%s]*(.-)[%s]*$") end + chars = patternescape(chars) + return str:match("^[" .. chars .. "]*(.-)[" .. chars .. "]*$") +end + + +function lume.wordwrap(str, limit) + limit = limit or 72 + local check + if type(limit) == "number" then + check = function(s) return #s >= limit end + else + check = limit + end + local rtn = {} + local line = "" + for word, spaces in str:gmatch("(%S+)(%s*)") do + local s = line .. word + if check(s) then + table.insert(rtn, line .. "\n") + line = word + else + line = s + end + for c in spaces:gmatch(".") do + if c == "\n" then + table.insert(rtn, line .. "\n") + line = "" + else + line = line .. c + end + end + end + table.insert(rtn, line) + return table.concat(rtn) +end + + +function lume.format(str, vars) + if not vars then return str end + local f = function(x) + return tostring(vars[x] or vars[tonumber(x)] or "{" .. x .. "}") + end + return (str:gsub("{(.-)}", f)) +end + + +function lume.trace(...) + local info = debug.getinfo(2, "Sl") + local t = { info.short_src .. ":" .. info.currentline .. ":" } + for i = 1, select("#", ...) do + local x = select(i, ...) + if type(x) == "number" then + x = string.format("%g", lume.round(x, .01)) + end + t[#t + 1] = tostring(x) + end + print(table.concat(t, " ")) +end + + +function lume.dostring(str) + return assert((loadstring or load)(str))() +end + + +function lume.uuid() + local fn = function(x) + local r = math_random(16) - 1 + r = (x == "x") and (r + 1) or (r % 4) + 9 + return ("0123456789abcdef"):sub(r, r) + end + return (("xxxxxxxx-xxxx-4xxx-yxxx-xxxxxxxxxxxx"):gsub("[xy]", fn)) +end + + +function lume.hotswap(modname) + local oldglobal = lume.clone(_G) + local updated = {} + local function update(old, new) + if updated[old] then return end + updated[old] = true + local oldmt, newmt = getmetatable(old), getmetatable(new) + if oldmt and newmt then update(oldmt, newmt) end + for k, v in pairs(new) do + if type(v) == "table" then update(old[k], v) else old[k] = v end + end + end + local err = nil + local function onerror(e) + for k in pairs(_G) do _G[k] = oldglobal[k] end + err = lume.trim(e) + end + local ok, oldmod = pcall(require, modname) + oldmod = ok and oldmod or nil + xpcall(function() + package.loaded[modname] = nil + local newmod = require(modname) + if type(oldmod) == "table" then update(oldmod, newmod) end + for k, v in pairs(oldglobal) do + if v ~= _G[k] and type(v) == "table" then + update(v, _G[k]) + _G[k] = v + end + end + end, onerror) + package.loaded[modname] = oldmod + if err then return nil, err end + return oldmod +end + + +local ripairs_iter = function(t, i) + i = i - 1 + local v = t[i] + if v then return i, v end +end + +function lume.ripairs(t) + return ripairs_iter, t, (#t + 1) +end + + +function lume.color(str, mul) + mul = mul or 1 + local r, g, b, a + r, g, b = str:match("#(%x%x)(%x%x)(%x%x)") + if r then + r = tonumber(r, 16) / 0xff + g = tonumber(g, 16) / 0xff + b = tonumber(b, 16) / 0xff + a = 1 + elseif str:match("rgba?%s*%([%d%s%.,]+%)") then + local f = str:gmatch("[%d.]+") + r = (f() or 0) / 0xff + g = (f() or 0) / 0xff + b = (f() or 0) / 0xff + a = f() or 1 + else + error(("bad color string '%s'"):format(str)) + end + return r * mul, g * mul, b * mul, a * mul +end + + +function lume.rgba(color) + local a = math_floor((color / 16777216) % 256) + local r = math_floor((color / 65536) % 256) + local g = math_floor((color / 256) % 256) + local b = math_floor((color) % 256) + return r, g, b, a +end + + +local chain_mt = {} +chain_mt.__index = lume.map(lume.filter(lume, iscallable, true), + function(fn) + return function(self, ...) + self._value = fn(self._value, ...) + return self + end + end) +chain_mt.__index.result = function(x) return x._value end + +function lume.chain(value) + return setmetatable({ _value = value }, chain_mt) +end + +setmetatable(lume, { + __call = function(_, ...) + return lume.chain(...) + end +}) + + +return lume diff --git a/main.lua b/main.lua new file mode 100644 index 0000000..79cc40c --- /dev/null +++ b/main.lua @@ -0,0 +1,7 @@ +-- bootstrap the compiler +fennel = require("lib.fennel") +table.insert(package.loaders, fennel.make_searcher({correlate=true})) +pp = function(x) print(require("lib.fennelview")(x)) end +lume = require("lib.lume") + +require("wrap") @@ -0,0 +1,70 @@ +;;;; Copyright (C) 2018 Jakob L. Kreuze, All Rights Reserved. +;;;; +;;;; This file is part of swanky. +;;;; +;;;; swanky 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. +;;;; +;;;; swanky 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 swanky. If not, see <http://www.gnu.org/licenses/>. + +(local tileset-values + {:empty [1 0 0 0] + :bricks [0 0 0 1]}) + +;; Returns the keyword for a given tile pixel. +(fn get-tile [image x y] + (var res :empty) + (let [(r g b a) (: image :getPixel x y)] + (each [name colors (pairs tileset-values)] + (when (and (= (. colors 1) r) + (= (. colors 2) g) + (= (. colors 3) b) + (= (. colors 4) a)) + (set res name)))) + res) + +;; Loads the tile layout of the level from the given ImageData, returning a +;; rectangular two-dimensional array. +(fn load-tiles [image] + (var tiles []) + (let [width (: image :getWidth) + height (: image :getHeight)] + (for [y 0 (- height 1)] + (var row []) + (for [x 0 (- width 1)] + (table.insert row (get-tile image x y))) + (table.insert tiles row)) + (values tiles width height))) + +;; (for [y 0 (- height 1)] +;; (for [x 0 (- width 1)] +;; (let [tile (. tiles (+ 1 y) (+ 1 x))] +;; (if (= tile :empty) +;; (io.write " ") +;; :else +;; (io.write "b")))) +;; (print)) + +;; Returns the metadata and objects stored in the metadata file at the given +;; path. +(fn load-meta [path] + (fennel.dofile path)) + +(fn load [name] + (let [tiles-path (.. "maps/" name ".png") + meta-path (.. "maps/" name ".fnl")] + (let [(tiles width height) (load-tiles (love.image.newImageData tiles-path))] + {:tiles tiles + :width width + :height height + :meta (load-meta meta-path)}))) + +{:load load} diff --git a/maps/sandbox.fnl b/maps/sandbox.fnl new file mode 100644 index 0000000..a0a2221 --- /dev/null +++ b/maps/sandbox.fnl @@ -0,0 +1 @@ +{:name "The Sandbox"} diff --git a/maps/sandbox.png b/maps/sandbox.png Binary files differnew file mode 100644 index 0000000..4aade9c --- /dev/null +++ b/maps/sandbox.png diff --git a/sandbox.fnl b/sandbox.fnl new file mode 100644 index 0000000..f633a0c --- /dev/null +++ b/sandbox.fnl @@ -0,0 +1,98 @@ +;;;; Copyright (C) 2018 Jakob L. Kreuze, All Rights Reserved. +;;;; +;;;; This file is part of swanky. +;;;; +;;;; swanky 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. +;;;; +;;;; swanky 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 swanky. If not, see <http://www.gnu.org/licenses/>. + +(local bump (require :lib.bump)) +(local map (require :map)) + +(local sandbox (map.load "sandbox")) + +;; (var swanky-frame 0) + +;; (fn load-sprite [name frame-width frame-height] +;; (let [img (love.graphics.newImage name)] +;; {:img img +;; :frame-width frame-width +;; :frame-height frame-height})) + +;; (fn draw-animated [x y sprite animation frame] +;; (let [img (. sprite :img) +;; width (. sprite :frame-width) +;; height (. sprite :frame-height)] +;; (let [quad (love.graphics.newQuad (* frame width) +;; (* animation height) +;; width +;; height +;; (: img :getWidth) +;; (: img :getHeight))] +;; (love.graphics.draw img quad x y 0 1 1 0 0)))) + +;; (fn load-player []) + +(local tiles (love.graphics.newImage "art/tiles.png")) +(local tile-width 32) +(local tile-height 32) +(local tile-offsets {:bricks 0}) + +;; Drawing routine for rendering the tiles visible from a given camera offset. +(fn draw-tiles [map camera-x camera-y] + (let [how-many-x (math.floor (/ canvas-width tile-width)) + how-many-y (math.floor (/ canvas-height tile-height)) + start-x (math.floor (/ camera-x tile-width)) + start-y (math.floor (/ camera-y tile-height)) + width (. map :width) + height (. map :height)] + (for [x 0 how-many-x] + (for [y 0 how-many-y] + (each [tile offset (pairs tile-offsets)] + (when (and (and (>= (+ x start-x) 0) (< (+ x start-x) width)) + (and (>= (+ y start-y) 0) (< (+ y start-y) height)) + (= tile (. map :tiles (+ y start-y 1) (+ x start-x 1)))) + (let [x (- (* x tile-width) (% camera-x tile-width)) + y (- (* y tile-height) (% camera-y tile-height)) + quad (love.graphics.newQuad (* tile-width offset) + 0 + tile-width + tile-height + (: tiles :getWidth) + (: tiles :getHeight))] + (love.graphics.draw tiles quad x y 0 1 1 0 0)))))))) + +(var camera-x 64) +(var camera-y 64) +(var camera-x-vel 0) +(var camera-y-vel 0) +(var camera-animation-theta 0) + +(fn draw [message] + (love.graphics.clear 255 255 255) + (draw-tiles sandbox camera-x camera-y) + (love.graphics.print (.. "Welcome to " (. sandbox :meta :name)) 0 0)) + +(fn update [dt set-mode] + (set camera-animation-theta (+ camera-animation-theta (/ math.pi 16))) + (when (>= camera-animation-theta (* 2 math.pi)) + (set camera-animation-theta 0)) + (set camera-x-vel (* 8 (math.sin camera-animation-theta))) + (set camera-y-vel (* 8 (math.cos camera-animation-theta))) + (set camera-x (+ camera-x camera-x-vel)) + (set camera-y (+ camera-y camera-y-vel))) + +(fn keypressed [key set-mode]) + +{:draw draw + :update update + :keypressed keypressed} diff --git a/wrap.fnl b/wrap.fnl new file mode 100644 index 0000000..3fe2cb1 --- /dev/null +++ b/wrap.fnl @@ -0,0 +1,74 @@ +;;;; Copyright (C) 2018 Jakob L. Kreuze, All Rights Reserved. +;;;; +;;;; This file is part of swanky. +;;;; +;;;; swanky 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. +;;;; +;;;; swanky 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 swanky. If not, see <http://www.gnu.org/licenses/>. + +;;;; --- + +;;;; This module contains non-game-specific bits and mode-changing logic. + +(global canvas-width 640) +(global canvas-height 480) + +(local canvas (love.graphics.newCanvas 640 480)) +(local font (love.graphics.newImageFont "art/font.png" + (.. " !\"#$%&*()*+,-./" + "0123456789" + ":;<=>?@" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "abcdefghijklmnopqrstuvwxyz" + "[\\]^_`{|}~"))) + +(var scale 2) +(var mode (require :sandbox)) + +(fn set-mode [mode-name ...] + (set mode (require mode-name)) + (when mode.activate + (mode.activate ...))) + +(fn love.load [] + (: canvas :setFilter "nearest" "nearest") + (love.graphics.setFont font)) + +(fn love.draw [] + (love.graphics.setCanvas canvas) + (love.graphics.clear) + (love.graphics.setColor 1 1 1) + (mode.draw) + (love.graphics.setCanvas) + (love.graphics.setColor 1 1 1) + (love.graphics.draw canvas 0 0 0 scale scale)) + +(fn love.update [dt] + (mode.update dt set-mode)) + +(fn love.keypressed [key] + (if (and (= key "f11") (= scale 2)) + (let [(dw dh) (love.window.getDesktopDimensions)] + (love.window.setMode dw dh {:fullscreen true :fullscreentype :desktop}) + (set scale (/ dh 225))) + + (= key "f11") + (do (set scale 2) (love.window.setMode (* 720 scale) (* 450 scale))) + + (and (love.keyboard.isDown "lctrl" "rctrl" "capslock") (= key "q")) + (love.event.quit) + + (love.keyboard.isDown "m") + (sound.toggle) + + :else + (mode.keypressed key set-mode))) |
