From: jsancho Date: Tue, 18 Aug 2009 15:44:03 +0000 (+0000) Subject: (no commit message) X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=678a1561ca858c34fecf04792831caf68559c2ac;p=gacela.git --- 678a1561ca858c34fecf04792831caf68559c2ac diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/SDL.c b/SDL.c new file mode 100644 index 0000000..f52f1c9 --- /dev/null +++ b/SDL.c @@ -0,0 +1,318 @@ +#define max(a, b) ((a > b) ? a : b) +#define min(a, b) ((a < b) ? a : b) + +int +gacela_SDL_SurfaceFormat (int surface) +{ + SDL_Surface *s = surface; + + return s->format; +} + +void +gacela_SDL_BlitSurface (int src, int srcrect, int dst, int dstrect) +{ + SDL_BlitSurface (src, srcrect, dst, dstrect); +} + +int +gacela_SDL_Rect (int x, int y, int w, int h) +{ + SDL_Rect *rect; + + rect = (SDL_Rect *)malloc (sizeof (SDL_Rect)); + rect->x = x; + rect->y = y; + rect->w = w; + rect->h = h; + + return rect; +} + +int +gacela_TTF_Init (void) +{ + return TTF_Init (); +} + +int +gacela_TTF_OpenFont (char *file, int ptsize) +{ + return TTF_OpenFont (file, ptsize); +} + +void +gacela_TTF_CloseFont (int font) +{ + TTF_CloseFont (font); +} + +void +gacela_TTF_Quit (void) +{ + TTF_Quit (); +} + +int +gacela_Mix_OpenAudio (int frequency, int channels, int chunksize) +{ + return Mix_OpenAudio (frequency, MIX_DEFAULT_FORMAT, channels, chunksize); +} + +int +gacela_Mix_LoadMUS (char *filename) +{ + return Mix_LoadMUS (filename); +} + +int +gacela_Mix_LoadWAV (char *filename) +{ + return Mix_LoadWAV (filename); +} + +int +gacela_Mix_PlayChannel (int channel, int chunk, int loops) +{ + return Mix_PlayChannel (channel, chunk, loops); +} + +int +gacela_Mix_PlayMusic (int music, int loops) +{ + return Mix_PlayMusic (music, loops); +} + +int +gacela_Mix_PlayingMusic (void) +{ + return Mix_PlayingMusic (); +} + +int +gacela_Mix_PausedMusic (void) +{ + return Mix_PausedMusic (); +} + +void +gacela_Mix_PauseMusic (void) +{ + Mix_PauseMusic (); +} + +void +gacela_Mix_ResumeMusic (void) +{ + Mix_ResumeMusic (); +} + +int +gacela_Mix_HaltMusic (void) +{ + return Mix_HaltMusic (); +} + +void +gacela_Mix_FreeChunk (int chunk) +{ + Mix_FreeChunk (chunk); +} + +void +gacela_Mix_FreeMusic (int music) +{ + Mix_FreeMusic (music); +} + +void +gacela_Mix_CloseAudio (void) +{ + Mix_CloseAudio (); +} + +void +gacela_sge_FilledCircle (int surface, int x, int y, int r, int red, int green, int blue) +{ + SDL_Surface *s = surface; + + sge_FilledCircle (s, x, y, r, SDL_MapRGB (s->format, red, green, blue)); +} + +void +gacela_sge_FilledRect (int surface, int x1, int y1, int x2, int y2, int red, int green, int blue) +{ + SDL_Surface *s = surface; + + sge_FilledRect (s, x1, y1, x2, y2, SDL_MapRGB (s->format, red, green, blue)); +} + +void +gacela_free (int pointer) +{ + free (pointer); +} + +void +apply_surface (int x, int y, int source, int destination, \ + int cx, int cy, int cw, int ch, int cid) +{ + SDL_Rect offset; + SDL_Rect *clip = NULL; + SDL_Surface *tmps = source; + int tmpw, tmpx, tmpy; + + if (cw != 0 || ch != 0) + { + clip = (SDL_Rect *)malloc(sizeof(SDL_Rect)); + if (cid == 0) + { + clip->x = cx; + clip->y = cy; + } + else + { + tmpw = tmps->w / cw; + if (tmps->w % cw > 0) tmpw++; + tmpy = cid / tmpw; + tmpx = cid - tmpw*tmpy; + + if (tmpx * cw > tmps->w || tmpy * ch > tmps->h) + { + clip->x = 0; + clip->y = 0; + } + else + { + clip->x = tmpx * cw; + clip->y = tmpy * ch; + } + printf ("Id: %d cx: %d cy: %d\n", cid, clip->x, clip->y); + } + clip->w = cw; + clip->h = ch; + } + + offset.x = x; + offset.y = y; + SDL_BlitSurface (source, clip, destination, &offset); + free(clip); +} + +int +render_text (int font, char *text, int red, int green, int blue) +{ + SDL_Color textColor = {red, green, blue}; + return TTF_RenderText_Solid (font, text, textColor); +} + +int +load_image (char *filename, int red, int green, int blue) +{ + SDL_Surface *loadedImage = NULL; + SDL_Surface *optimizedImage = NULL; + + loadedImage = IMG_Load (filename); + if (loadedImage != NULL) + { + optimizedImage = SDL_DisplayFormat (loadedImage); + SDL_FreeSurface (loadedImage); + if (optimizedImage != NULL) + { + SDL_SetColorKey (optimizedImage, SDL_SRCCOLORKEY, SDL_MapRGB (optimizedImage->format, red, green, blue)); + } + } + return optimizedImage; +} + +void +fill_surface (int surface, int red, int green, int blue) +{ + SDL_Surface *s = surface; + + SDL_FillRect (s, &s->clip_rect, SDL_MapRGB (s->format, red, green, blue)); +} + +int +box_collision (int surface1, int x1, int y1, int surface2, int x2, int y2) +{ + SDL_Surface *s1 = surface1; + SDL_Surface *s2 = surface2; + int left1, left2, bottom1, bottom2; + int xstart, xend, ystart, yend; + int x, y; + + left1 = x1 + s1->w - 1; + bottom1 = y1 + s1->h - 1; + left2 = x2 + s2->w - 1; + bottom2 = y2 + s2->h - 1; + + if ((x1 > left2) || (x2 > left1)) return 0; + if ((y1 > bottom2) || (y2 > bottom1)) return 0; + return 1; +} + +int +transparent_pixel (SDL_Surface *surface, int x, int y) +{ + int bpp = surface->format->BytesPerPixel; + Uint8 *p; + Uint32 pixelcolor; + + if (SDL_MUSTLOCK (surface)) SDL_LockSurface (surface); + assert ((x < surface->w) && (y < surface->h)); + + p = (Uint8 *)surface->pixels + y*surface->pitch + x*bpp; + + switch (bpp) + { + case (1): + pixelcolor = *p; + break; + + case (2): + pixelcolor = *(Uint16 *)p; + break; + + case (3): + if (SDL_BYTEORDER == SDL_BIG_ENDIAN) + pixelcolor = p[0] << 16 | p[1] << 8 | p[2]; + else + pixelcolor = p[0] | p[1] << 8 | p[2] << 16; + break; + + case (4): + pixelcolor = *(Uint32 *)p; + break; + } + + if (SDL_MUSTLOCK (surface)) SDL_UnlockSurface (surface); + + return (pixelcolor == surface->format->colorkey); +} + +int +create_SDL_Surface (int screen, int w, int h, int red, int green, int blue) +{ + SDL_Surface *s = screen; + SDL_Surface *new = NULL; + + new = SDL_CreateRGBSurface (s->flags, w, h, \ + s->format->BitsPerPixel, \ + s->format->Rmask, s->format->Gmask, \ + s->format->Bmask, s->format->Amask); + if (new != NULL) + { + SDL_SetColorKey (new, SDL_SRCCOLORKEY, SDL_MapRGB (new->format, red, green, blue)); + } + + return new; +} + +int +copy_SDL_Surface (int surface) +{ + SDL_Surface *s = surface; + + return SDL_ConvertSurface (s, s->format, s->flags); +} diff --git a/background.bmp b/background.bmp new file mode 100644 index 0000000..3fbfdbc Binary files /dev/null and b/background.bmp differ diff --git a/beat.wav b/beat.wav new file mode 100644 index 0000000..f29a8c9 Binary files /dev/null and b/beat.wav differ diff --git a/bolita.png b/bolita.png new file mode 100644 index 0000000..385ad97 Binary files /dev/null and b/bolita.png differ diff --git a/cstruct.lisp b/cstruct.lisp new file mode 100644 index 0000000..6886391 --- /dev/null +++ b/cstruct.lisp @@ -0,0 +1,157 @@ +;; Sample usage: Create lisp defstructs corresponding to C structures: +(use-package "SLOOP") +;; How to: Create a file foo.c which contains just structures +;; and possibly some externs. +;; cc -E /tmp/foo1.c > /tmp/fo2.c +;; ../xbin/strip-ifdef /tmp/fo2.c > /tmp/fo3.c +;; then (parse-file "/tmp/fo3.c") +;; will return a list of defstructs and appropriate slot offsets. + + +(defun white-space (ch) (member ch '(#\space #\linefeed #\return #\newline #\tab))) + +(defvar *eof* (code-char 255)) +(defun delimiter(ch) (or (white-space ch) + (member ch '(#\, #\; #\{ #\} #\*)))) +(defun next-char (st) + (let ((char (read-char st nil *eof*))) + + (case char + (#\{ char) + ( + #\/ (cond ((eql (peek-char nil st nil) #\*) + (read-char st) + (sloop when (eql (read-char st) #\*) + do (cond ((eql (read-char st) #\/ ) + (return-from next-char (next-char st)))))) + (t char))) + ((#\tab #\linefeed #\return #\newline ) + (cond ((member (peek-char nil st nil) '(#\space #\tab #\linefeed #\return #\newline )) + (return-from next-char (next-char st)))) + #\space) + (t char)))) + +(defun get-token (st &aux tem) + (sloop while (white-space (peek-char nil st nil)) + do (read-char st)) + (cond ((member (setq tem (peek-char nil st nil)) '(#\, #\; #\* #\{ #\} )) + (return-from get-token (coerce (list (next-char st)) 'string)))) + (sloop with x = (make-array 10 :element-type 'character :fill-pointer 0 + :adjustable t) + when (delimiter (setq tem (next-char st))) + do (cond ((> (length x) 0) + (or (white-space tem) (unread-char tem st)) + (return x))) + else + do + (cond ((eql tem *eof*) (return *eof*)) + (t (vector-push-extend tem x))))) +(defvar *parse-list* nil) +(defvar *structs* nil) + +(defun parse-file (fi &optional *structs*) + (with-open-file (st fi) + (let ((*parse-list* + (sloop while (not (eql *eof* (setq tem (get-token st)))) + collect (intern tem)))) + (print *parse-list*) + (let ((structs + (sloop while (setq tem (parse-struct)) + do (push tem *structs*) + collect tem))) + (get-sizes fi structs) + (with-open-file (st "gaz3.lsp") + (prog1 + (list structs (read st)) + (delete-file "gaz3.lsp"))))))) + + + + + +(defparameter *type-alist* '((|short| . signed-short) + (|unsigned short| . unsigned-short) + (|char| . signed-char) + (|unsigned char| . unsigned-char) + (|int| . fixnum) + (|long| . fixnum) + (|object| . t))) + + +(defun parse-type( &aux top) + (setq top (pop *parse-list*)) + (cond ((member top '(|unsigned| |signed|)) + (push (intern (format nil "~a-~a" (pop *parse-list*))) *parse-list*) + (parse-type)) + ((eq '* (car *parse-list*)) (pop *parse-list*) 'fixnum) + ((eq top '|struct|) + (prog1 + (cond ((car (member (car *parse-list*) *STRUCTS* :key 'cadr))) + (t (error "unknown struct ~a " (car *parse-list*)))) + (pop *parse-list*) + )) + ((cdr (assoc top *type-alist*))) + (t (error "unknown type ~a " top)))) +(defun expect (x) (or (eql (car *parse-list*) x) + (error "expected ~a at beginning of ~s" x *parse-list*)) + (pop *parse-list*)) +(defun parse-field ( &aux tem) + (cond ((eql (car *parse-list*) '|}|) + (pop *parse-list*) + (expect '|;|) + nil) + (t + (let ((type (parse-type))) + + (sloop until (eql (setq tem (pop *parse-list*)) '|;|) + append (get-field tem type) + + do (or (eq (car *parse-list*) '|;|) (expect '|,|))))))) +(deftype pointer () `(integer ,most-negative-fixnum most-positive-fixnum)) +(defun get-field (name type) + (cond ((eq name '|*|)(get-field (pop *parse-list*) 'pointer)) + ((and (consp type) (eq (car type) 'defstruct)) + (sloop for w in (cddr type) + append (get-field + (intern (format nil "~a.~a" name (car w))) + (fourth w)))) + (t + `((,name ,(if (eq type t) nil 0) :type ,type))))) + +(defun parse-struct () + (cond ((null *parse-list*) (return-from parse-struct nil))) + (cond ((not (eq (car *parse-list*) '|struct|)) + (sloop until (eq (pop *parse-list*) '|;|)) + (return-from parse-struct (parse-struct)))) + (expect '|struct|) + (let* ((name (prog1 (pop *parse-list*)(expect '|{|)))) + `(defstruct ,name ,@ + (sloop while (setq tem (parse-field)) + append tem)))) + +(defun printf (st x &rest y) + (format st "~%printf(\"~a\"" x) + (sloop for w in y do (princ "," st) (princ y st)) + (princ ");" st)) + +(defun get-sizes (file structs) + (with-open-file (st "gaz0" :direction :output) + (sloop for i from 1 + for u in structs + do (format st "struct ~a SSS~a;~%" (second u) i)) + (format st "~%main() {~%") + (printf st "(") + (sloop for i from 1 + for u in structs + do + (printf st (format nil "(|~a| " (second u))) + (sloop for w in (cddr u) + do + (printf st " %d " + (format nil "(char *)&SSS~a.~a - (char *)&SSS~a" + i (car w) i))) + (printf st ")")) + (printf st ")") + (princ " ;}" st)) + (system + (format nil "cat ~a gaz0 > tmpx.c ; cc tmpx.c -o tmpx ; (./tmpx > gaz3.lsp) ; rm -f gaz0" file))) diff --git a/fondo_tetris.png b/fondo_tetris.png new file mode 100644 index 0000000..627a07e Binary files /dev/null and b/fondo_tetris.png differ diff --git a/foo.c b/foo.c new file mode 100644 index 0000000..f08c62d --- /dev/null +++ b/foo.c @@ -0,0 +1,5 @@ +struct SDL_Rect { + signed int x, y; + unsigned int w, h; +}; + diff --git a/foo2.c b/foo2.c new file mode 100644 index 0000000..c7fdc5b --- /dev/null +++ b/foo2.c @@ -0,0 +1,4 @@ +struct SDL_Rect { + int x, y; + int w, h; +}; diff --git a/gacela.lisp b/gacela.lisp new file mode 100644 index 0000000..62594b5 --- /dev/null +++ b/gacela.lisp @@ -0,0 +1,386 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +;;; Default values for Gacela +(defvar *width-screen* 640) +(defvar *height-screen* 480) +(defvar *bpp-screen* 32) +(defvar *title-screen* "Happy Hacking!!") +(defvar *gacela-freq* 30) +(defvar *transparent-color* '(:red 0 :green 0 :blue 0)) +(defvar *background-color* '(:red 0 :green 0 :blue 0)) +(defvar *zoom* -10) + +;;; SDL Initialization Subsystem +(let (initialized) + + (defun init-sdl () + (cond ((null initialized) (setq initialized (SDL_Init SDL_INIT_EVERYTHING))) + (t initialized))) + + (defun quit-sdl () + (setq initialized (SDL_Quit)))) + + +;;; Video Subsystem +(defstruct surface address clip-w clip-h shape) + +(let (screen flags) + + (defun init-video-mode (&key (width *width-screen*) (height *height-screen*) (bpp *bpp-screen*)) + (cond ((null screen) + (init-sdl) + (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1) + (setq flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE + (if (= (getf (SDL_GetVideoInfo) :hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE) + (if (= (getf (SDL_GetVideoInfo) :blit_hw) 0) 0 SDL_HWACCEL))) + (setq screen (SDL_SetVideoMode width height bpp flags)) + (init-GL) + (resize-screen-GL width height)) + (t t))) + + (defun resize-screen (width height bpp) + (setq screen (SDL_SetVideoMode width height bpp flags)) + (resize-screen-GL width height)) + + (defun fill-screen (color) + (init-video-mode) + (fill-surface screen (getf color :red) (getf color :green) (getf color :blue))) + + (defun flip () + (cond ((null screen) nil) + (t (SDL_Flip screen)))) + + (defun create-surface (width height &key (trans-color *transparent-color*)) + (init-video-mode) + (let ((new-surface (make-surface + :address (create-SDL_Surface + (surface-address screen) + width + height + (getf trans-color :red) + (getf trans-color :green) + (getf trans-color :blue))))) + (set-resource 'image new-surface (gentemp)) + new-surface)) + + (defun print-surface (x y surface) + (apply-surface x y surface screen) + surface) + + (defun quit-video-mode () + (setq screen nil))) + + +(defun init-GL () + (glShadeModel GL_SMOOTH) + (glClearColor 0 0 0 0) + (glClearDepth 1) + (glEnable GL_DEPTH_TEST) + (glDepthFunc GL_LEQUAL) +; (glEnable GL_BLEND) +; (glBlendFunc GL_SRC_ALPHA GL_ONE) + (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST) + t) + +(defun init-textures () + (init-video-mode) + (glEnable GL_TEXTURE_2D)) + +(defun init-lighting () + (init-video-mode) + (glEnable GL_LIGHTING)) + +(defun resize-screen-GL (width height) + (let ((ratio (if (= height 0) width (/ width height)))) + (glViewPort 0 0 width height) + (glMatrixMode GL_PROJECTION) + (glLoadIdentity) + (gluPerspective 45 ratio 0.1 100) + (glMatrixMode GL_MODELVIEW) + (glLoadIdentity) + t)) + +(defun copy-surface (source) + (cond ((surface-p source) + (let ((new-surface + (make-surface :address (copy-SDL_Surface (surface-address source)) + :clip-w (surface-clip-w source) + :clip-h (surface-clip-h source) + :shape (surface-shape source)))) + (set-resource 'image new-surface (gentemp)) + new-surface)))) + +(defun load-image (image-file &key (transparent-color nil)) + (init-video-mode) + (let ((loaded-image (IMG_Load image-file))) + (cond ((= loaded-image 0) nil) + (t (let ((optimized-image (SDL_DisplayFormat loaded-image))) + (SDL_FreeSurface loaded-image) + (cond ((= optimized-image 0) nil) + ((null transparent-color) optimized-image) + (t (SDL_SetColorKey optimized-image + SDL_SRCCOLORKEY + (SDL_MapRGB (surface-format optimized-image) + (car transparent-color) + (cadr transparent-color) + (caddr transparent-color))) + optimized-image))))))) + +(defun load-image2 (image-file &key (transparent-color nil)) + (let ((address-image (load-image image-file :transparent-color transparent-color))) + (list + (lambda (x y) (print-surface x y address-image)) + (lambda () (SDL_FreeSurface address-image))))) + +(defun apply-surface (x y source destination) + (let ((offset (SDL_Rect x y 0 0))) + (SDL_BlitSurface source 0 destination offset) + (free offset) + destination)) + +(defun apply-surface-old (x y source destination &optional (clip nil)) + (cond ((null clip) + (apply-surface2 x y (surface-address source) (surface-address destination) 0 0 0 0 0)) + ((integerp clip) + (apply-surface2 x y (surface-address source) (surface-address destination) 0 0 + (surface-clip-w source) (surface-clip-h source) clip)) + (t + (apply-surface2 x y (surface-address source) (surface-address destination) + (first clip) (second clip) (third clip) (fourth clip) 0))) + destination) + + +(defun print-image (x y image-file &optional (clip nil)) + (init-video-mode) + (let ((image (load-image image-file))) + (print-surface x y image clip) + image)) + + +(defun clean-screen () + (fill-screen *background-color*)) + +(defun refresh-screen () + (clean-screen) + (funcall-procs #'print-mob) + (flip)) + + +(defun filled-circle (radius &optional (color '(:red 255 :green 255 :blue 255))) + (init-video-mode) + (let ((new-surface (create-surface (1+ (* radius 2)) (1+ (* radius 2))))) + (sge_FilledCircle (surface-address new-surface) + radius radius radius + (getf color :red) + (getf color :green) + (getf color :blue)) + (setf (surface-shape new-surface) + `((,radius ,radius) ,radius)) + new-surface)) + + +(defun filled-rect (width height &optional (color '(:red 255 :green 255 :blue 255))) + (init-video-mode) + (let ((new-surface (create-surface width height))) + (sge_FilledRect (surface-address new-surface) + 0 0 width height + (getf color :red) + (getf color :green) + (getf color :blue)) + (setf (surface-shape new-surface) + (make-rectangle 0 0 width height)) + new-surface)) + + +;;; TTF Subsystem +(defstruct font address) + +(let ((ttf nil)) + + (defun init-ttf () + (cond ((null ttf) (progn (init-sdl) (setq ttf (TTF_Init)))) + (t ttf))) + + (defun quit-ttf () + (setq ttf (TTF_Quit)))) + + +(defun open-font (font-name tam) + (init-ttf) + (let ((font (get-resource 'font font-name tam))) + (if (null font) + (progn (setq font (make-font :address (TTF_OpenFont font-name tam))) + (set-resource 'font font font-name tam))) + font)) + + +(defun render-text (text-message + &key (color '(:red 255 :green 255 :blue 255)) + (font-name "lazy.ttf") (tam 28)) + (init-ttf) + (let ((message (get-resource 'text text-message color font-name tam))) + (if (null message) + (progn + (setq message + (make-surface + :address (render-text2 (open-font font-name tam) + text-message + (getf color :red) + (getf color :green) + (getf color :blue)))) + (set-resource 'text message text-message color font-name tam))) + message)) + + +(defun print-text (x y text-message + &key (color '(:red 255 :green 255 :blue 255)) + (font-name "lazy.ttf") (tam 28)) + (init-video-mode) + (init-ttf) + (let ((message (render-text text-message :color color :font-name font-name :tam tam))) + (print-surface x y message) + message)) + + +;;; Audio Subsystem +(let ((audio nil)) + + (defun init-audio () + (cond ((null audio) (progn (init-sdl) (setq audio (Mix_OpenAudio 22050 2 4096)))) + (t audio))) + + (defun quit-audio () + (setq audio (Mix_CloseAudio)))) + + +;;; Resources Manager +(defstruct resource address free-function object) + +(let ((resources-table (make-hash-table :test 'equal))) + + (defun set-resource (type object &rest key) + (let ((res + (cond ((surface-p object) + (make-resource :address (surface-address object) + :free-function #'SDL_FreeSurface + :object object)) + ((font-p object) + (make-resource :address (font-address object) + :free-function #'TTF_CloseFont + :object object)) + ((cp-space-p object) + (make-resource :address (cp-space-address object) + :free-function #'cpSpaceFree + :object object)) + ((cp-body-p object) + (make-resource :address (cp-body-address object) + :free-function #'cpBodyFree + :object object)) + ((cp-shape-p object) + (make-resource :address (cp-shape-address object) + :free-function #'cpShapeFree + :object object)) + (t nil)))) + (cond (res (setf (gethash `(,type ,@key) resources-table) res))))) + + (defun get-resource (type &rest key) + (let ((resource (gethash `(,type ,@key) resources-table))) + (cond ((null resource) nil) + (t (resource-object resource))))) + + (defun free-all-resources () + (maphash (lambda (key res) (funcall (resource-free-function res) (resource-address res))) + resources-table) + (clrhash resources-table))) + + +;;; Connection with the GUI +(let (socket) + (defun connect-to-gui () + (setq socket (si::socket 1984 :host "localhost"))) + + (defun eval-from-gui () + (cond ((and socket (listen socket)) (eval (read socket)))))) + + +;;; GaCeLa Functions +;(defun game-loop (code) +; (process-events) +; (cond ((quit?) nil) +; (t +; (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) +; (glLoadIdentity) +; (translate 0 0 *zoom*) +; (funcall code) +; (SDL_GL_SwapBuffers) +; (SDL_Delay (- *gacela-freq* (rem (SDL_GetTicks) *gacela-freq*))) +; (game-loop code)))) + +(let (commands) + (defun prog-command (command) + (setq commands (cons command commands))) + + (defun run-commands () + (cond (commands + (let (running) + (setq running commands) + (setq commands nil) + (labels ((run-com (comlst) + (cond (comlst (run-com (cdr comlst)) + (eval (read-from-string (concatenate 'string "(progn " (car comlst) ")"))))))) + (run-com running))))))) + +(defmacro run-game (title &body code) + `(progn + (init-video-mode) + (SDL_WM_SetCaption ,title "") + (process-events) + (do () ((quit?)) + (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)) + (glLoadIdentity) + (translate 0 0 *zoom*) + ,@code + (SDL_GL_SwapBuffers) + (SDL_Delay (- *gacela-freq* (rem (SDL_GetTicks) *gacela-freq*))) + (process-events) + (setq running nil)))) + +;(defun run-game () +; (init-video-mode) +; (SDL_WM_SetCaption *title-screen* "") +; (refresh-active-procs) +; (enjoy!) +; (do () ((quit?)) +; (process-events) +; (logic-procs) +; (motion-procs) +; (refresh-active-procs) +; (refresh-screen) +; (SDL_Delay (- *gacela-freq* (rem (SDL_GetTicks) *gacela-freq*))))) + +(defun quit-game () +; (free-all-resources) +; (quit-audio) +; (quit-ttf) + (quit-video-mode) +; (quit-all-procs) +; (clear-events) +; (quit-events) + (quit-sdl)) diff --git a/gacela_GL.lisp b/gacela_GL.lisp new file mode 100644 index 0000000..a14fa09 --- /dev/null +++ b/gacela_GL.lisp @@ -0,0 +1,206 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +(clines "#include ") +(clines "#include ") + +;;; Data types +(defconstant GL_UNSIGNED_BYTE #x1401) + +;;; Primitives +(defconstant GL_POINTS #x0000) +(defconstant GL_LINES #x0001) +(defconstant GL_LINE_LOOP #x0002) +(defconstant GL_LINE_STRIP #x0003) +(defconstant GL_TRIANGLES #x0004) +(defconstant GL_TRIANGLE_STRIP #x0005) +(defconstant GL_TRIANGLE_FAN #x0006) +(defconstant GL_QUADS #x0007) +(defconstant GL_QUAD_STRIP #x0008) +(defconstant GL_POLYGON #x0009) + +;;; Matrix Mode +(defconstant GL_MODELVIEW #x1700) +(defconstant GL_PROJECTION #x1701) + +;;; Depth buffer +(defconstant GL_LEQUAL #x0203) +(defconstant GL_DEPTH_TEST #x0B71) + +;;; Lighting +(defconstant GL_LIGHTING #x0B50) +(defconstant GL_LIGHT1 #x4001) +(defconstant GL_AMBIENT #x1200) +(defconstant GL_DIFFUSE #x1201) +(defconstant GL_POSITION #x1203) +(defconstant GL_SMOOTH #x1D01) + +;;; Blending +(defconstant GL_BLEND #x0BE2) +(defconstant GL_ONE #x1) +(defconstant GL_SRC_ALPHA #x0302) + +;;; Fog +(defconstant GL_LINEAR #x2601) + +;;; Buffers, Pixel Drawing/Reading +(defconstant GL_RGB #x1907) + +;;; Hints +(defconstant GL_PERSPECTIVE_CORRECTION_HINT #x0C50) +(defconstant GL_NICEST #x1102) + +;;; Texture mapping +(defconstant GL_TEXTURE_2D #x0DE1) +(defconstant GL_TEXTURE_MAG_FILTER #x2800) +(defconstant GL_TEXTURE_MIN_FILTER #x2801) +(defconstant GL_LINEAR_MIPMAP_NEAREST #x2701) +(defconstant GL_NEAREST #x2600) + +;;; glPush/PopAttrib bits +(defconstant GL_DEPTH_BUFFER_BIT #x00000100) +(defconstant GL_COLOR_BUFFER_BIT #x00004000) + +;;; OpenGL 1.2 +(defconstant GL_BGR #x80E0) + +;;; OpenGL Functions +(defcfun "void gacela_glBegin (int mode)" 0 + "glBegin (mode);") + +(defcfun "void gacela_glClear (int mask)" 0 + "glClear (mask);") + +(defcfun "void gacela_glClearColor (float red, float green, float blue, float alpha)" 0 + "glClearColor (red, green, blue, alpha);") + +(defcfun "void gacela_glClearDepth (double depth)" 0 + "glClearDepth (depth);") + +(defcfun "void gacela_glColor3f (float red, float green, float blue)" 0 + "glColor3f (red, green, blue);") + +(defcfun "void gacela_glDepthFunc (int func)" 0 + "glDepthFunc (func);") + +(defcfun "void gacela_glEnable (int cap)" 0 + "glEnable (cap);") + +(defcfun "void gacela_glDisable (int cap)" 0 + "glDisable (cap);") + +(defcfun "void gacela_glEnd (void)" 0 + "glEnd ();") + +(defcfun "void gacela_glHint (int target, int mode)" 0 + "glHint (target, mode);") + +(defcfun "void gacela_glLoadIdentity (void)" 0 + "glLoadIdentity ();") + +(defcfun "void gacela_glMatrixMode (int mode)" 0 + "glMatrixMode (mode);") + +(defcfun "void gacela_glRotatef (float angle, float x, float y, float z)" 0 + "glRotatef (angle, x, y, z);") + +(defcfun "void gacela_glShadeModel (int mode)" 0 + "glShadeModel (mode);") + +(defcfun "void gacela_glTranslatef (float x, float y, float z)" 0 + "glTranslatef (x, y, z);") + +(defcfun "void gacela_glVertex3f (float x, float y, float z)" 0 + "glVertex3f (x, y, z);") + +(defcfun "void gacela_glViewport (int x, int y, int width, int height)" 0 + "glViewport (x, y, width, height);") + +(defcfun "static object gacela_glGenTextures (int n)" 0 + "object textures;" + "GLuint text[n];" + "int i, t;" + ('nil textures) + "glGenTextures (n, &text[0]);" + "for (i = n - 1; i >= 0; i--) {" + "t = text[i];" + ((cons (int t) textures) textures) + "}" + "return textures;") + +(defcfun "void gacela_glBindTexture (int target, int texture)" 0 + "glBindTexture (target, texture);") + +(defcfun "void gacela_glTexImage2D (int target, int level, int internalFormat, int width, int height, int border, int format, int type, int pixels)" 0 + "glTexImage2D (target, level, internalFormat, width, height, border, format, type, pixels);") + +(defcfun "void gacela_glTexParameteri (int target, int pname, int param)" 0 + "glTexParameteri (target, pname, param);") + +(defcfun "void gacela_glTexCoord2f (float s, float t)" 0 + "glTexCoord2f (s, t);") + +(defcfun "void gacela_glLightfv (int light, int pname, float param1, float param2, float param3, float param4)" 0 + "GLfloat params[4];" + "params[0] = param1;" + "params[1] = param2;" + "params[2] = param3;" + "params[3] = param4;" + "glLightfv (light, pname, params);") + +(defcfun "void gacela_glNormal3f (float nx, float ny, float nz)" 0 + "glNormal3f (nx, ny, nz);") + +(defcfun "void gacela_glBlendFunc (int sfactor, int dfactor)" 0 + "glBlendFunc (sfactor, dfactor);") + +(defcfun "void gacela_gluPerspective (double fovy, double aspect, double zNear, double zFar)" 0 + "gluPerspective (fovy, aspect, zNear, zFar);") + +(defcfun "int gacela_gluBuild2DMipmaps (int target, int internalFormat, int width, int height, int format, int type, int data)" 0 + "return gluBuild2DMipmaps (target, internalFormat, width, height, format, type, data);") + +(defentry glBegin (int) (void "gacela_glBegin")) +(defentry glClear (int) (void "gacela_glClear")) +(defentry glClearColor (float float float float) (void "gacela_glClearColor")) +(defentry glClearDepth (double) (void "gacela_glClearDepth")) +(defentry glColor3f (float float float) (void "gacela_glColor3f")) +(defentry glDepthFunc (int) (void "gacela_glDepthFunc")) +(defentry glEnable (int) (void "gacela_glEnable")) +(defentry glDisable (int) (void "gacela_glDisable")) +(defentry glEnd () (void "gacela_glEnd")) +(defentry glHint (int int) (void "gacela_glHint")) +(defentry glLoadIdentity () (void "gacela_glLoadIdentity")) +(defentry glMatrixMode (int) (void "gacela_glMatrixMode")) +(defentry glRotatef (float float float float) (void "gacela_glRotatef")) +(defentry glShadeModel (int) (void "gacela_glShadeModel")) +(defentry glTranslatef (float float float) (void "gacela_glTranslatef")) +(defentry glVertex3f (float float float) (void "gacela_glVertex3f")) +(defentry glViewport (int int int int) (void "gacela_glViewport")) +(defentry glGenTextures (int) (object "gacela_glGenTextures")) +(defentry glBindTexture (int int) (void "gacela_glBindTexture")) +(defentry glTexImage2D (int int int int int int int int int) (void "gacela_glTexImage2D")) +(defentry glTexParameteri (int int int) (void "gacela_glTexParameteri")) +(defentry glTexCoord2f (float float) (void "gacela_glTexCoord2f")) +(defentry glLightfv (int int float float float float) (void "gacela_glLightfv")) +(defentry glNormal3f (float float float) (void "gacela_glNormal3f")) +(defentry glBlendFunc (int int) (void "gacela_glBlendFunc")) + +(defentry gluPerspective (double double double double) (void "gacela_gluPerspective")) +(defentry gluBuild2DMipmaps (int int int int int int int) (int "gacela_gluBuild2DMipmaps")) diff --git a/gacela_SDL.lisp b/gacela_SDL.lisp new file mode 100644 index 0000000..adcef19 --- /dev/null +++ b/gacela_SDL.lisp @@ -0,0 +1,207 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +(clines "#include ") +(clines "#include ") +(clines "#include ") +(clines "#include ") +(clines "#include ") + +;;; These are the flags which may be passed to SDL_Init() +(defconstant SDL_INIT_TIMER #x00000001) +(defconstant SDL_INIT_AUDIO #x00000010) +(defconstant SDL_INIT_VIDEO #x00000020) +(defconstant SDL_INIT_CDROM #x00000100) +(defconstant SDL_INIT_JOYSTICK #x00000200) +(defconstant SDL_INIT_NOPARACHUTE #x00100000) +(defconstant SDL_INIT_EVENTTHREAD #x01000000) +(defconstant SDL_INIT_EVERYTHING #x0000FFFF) + + +;;; These are the currently supported flags for the SDL_surface +;;; Available for SDL_CreateRGBSurface() or SDL_SetVideoMode() +(defconstant SDL_SWSURFACE #x00000000) +(defconstant SDL_HWSURFACE #x00000001) +(defconstant SDL_ASYNCBLIT #x00000004) + + +;;; Available for SDL_SetVideoMode() +(defconstant SDL_ANYFORMAT #x10000000) +(defconstant SDL_HWPALETTE #x20000000) +(defconstant SDL_DOUBLEBUF #x40000000) +(defconstant SDL_FULLSCREEN #x80000000) +(defconstant SDL_OPENGL #x00000002) +(defconstant SDL_OPENGLBLIT #x0000000A) +(defconstant SDL_RESIZABLE #x00000010) +(defconstant SDL_NOFRAME #x00000020) + +;;; Used internally (read-only) +(defconstant SDL_HWACCEL #x00000100) +(defconstant SDL_SRCCOLORKEY #x00001000) + +;;; For setting the OpenGL window attributes +(defconstant SDL_GL_DOUBLEBUFFER 5) + +;;; Keyboard +(defconstant SDL_DEFAULT_REPEAT_DELAY 500) +(defconstant SDL_DEFAULT_REPEAT_INTERVAL 30) + + +;;; SDL Functions +(defcfun "int gacela_SDL_Init (int flags)" 0 + "return SDL_Init (flags);") + +(defcfun "void gacela_SDL_Quit (void)" 0 + "SDL_Quit ();") + +(defcfun "int gacela_SDL_SetVideoMode (int width, int height, int bpp, int flags)" 0 + "return SDL_SetVideoMode (width, height, bpp, flags);") + +(defcfun "void gacela_SDL_WM_SetCaption (char *title, char *icon)" 0 + "SDL_WM_SetCaption (title, icon);") + +(defcfun "int gacela_SDL_Flip (int screen)" 0 + "return SDL_Flip (screen);") + +(defcfun "void gacela_SDL_FreeSurface (int surface)" 0 + "SDL_FreeSurface (surface);") + +(defcfun "void gacela_SDL_Delay (int ms)" 0 + "SDL_Delay (ms);") + +(defcfun "int gacela_SDL_GetTicks (void)" 0 + "return SDL_GetTicks ();") + +(defcfun "int gacela_SDL_DisplayFormat (int surface)" 0 + "return SDL_DisplayFormat (surface);") + +(defcfun "int gacela_SDL_MapRGB (int format, int r, int g, int b)" 0 + "return SDL_MapRGB (format, r, g, b);") + +(defcfun "int gacela_SDL_SetColorKey (int surface, int flag, int key)" 0 + "return SDL_SetColorKey (surface, flag, key);") + +(defcfun "int gacela_SDL_LoadBMP (char *file)" 0 + "return SDL_LoadBMP (file);") + +(defcfun "int gacela_IMG_Load (char *filename)" 0 + "return IMG_Load (filename);") + +(defcfun "static object gacela_SDL_GetVideoInfo (void)" 0 + "const SDL_VideoInfo *info;" + "object vi, label;" + "info = SDL_GetVideoInfo ();" + ('nil vi) + ((cons (int info->blit_hw) vi) vi) (':blit_hw label) ((cons label vi) vi) + ((cons (int info->hw_available) vi) vi) (':hw_available label) ((cons label vi) vi) + "return vi;") + +(defcfun "int gacela_SDL_GL_SetAttribute (int attr, int value)" 0 + "return SDL_GL_SetAttribute (attr, value);") + +(defcfun "static object gacela_SDL_PollEvent (void)" 0 + "SDL_Event sdl_event;" + "object event, label;" + ('nil event) + "if (SDL_PollEvent (&sdl_event)) {" + " switch (sdl_event.type) {" + " case SDL_KEYDOWN:" + " case SDL_KEYUP:" + ((cons (int sdl_event.key.keysym.sym) event) event) (':key.keysym.sym label) ((cons label event) event) + " break;" + " }" + ((cons (int sdl_event.type) event) event) (':type label) ((cons label event) event) + "}" + "return event;") + +(defcfun "void gacela_SDL_GL_SwapBuffers (void)" 0 + "SDL_GL_SwapBuffers ();") + +(defcfun "int gacela_SDL_EnableKeyRepeat (int delay, int interval)" 0 + "return SDL_EnableKeyRepeat (delay, interval);") + +(defentry SDL_Init (int) (int "gacela_SDL_Init")) +(defentry SDL_Quit () (void "gacela_SDL_Quit")) +(defentry SDL_SetVideoMode (int int int int) (int "gacela_SDL_SetVideoMode")) +(defentry SDL_WM_SetCaption (string string) (void "gacela_SDL_WM_SetCaption")) +(defentry SDL_Flip (int) (int "gacela_SDL_Flip")) +(defentry SDL_FreeSurface (int) (void "gacela_SDL_FreeSurface")) +(defentry SDL_Delay (int) (void "gacela_SDL_Delay")) +(defentry SDL_GetTicks () (int "gacela_SDL_GetTicks")) +(defentry SDL_DisplayFormat (int) (int "gacela_SDL_DisplayFormat")) +;(defentry SDL_SurfaceFormat (int) (int "gacela_SDL_SurfaceFormat")) +(defentry SDL_MapRGB (int int int int) (int "gacela_SDL_MapRGB")) +(defentry SDL_SetColorKey (int int int) (int "gacela_SDL_SetColorKey")) +;(defentry SDL_BlitSurface (int int int int) (void "gacela_SDL_BlitSurface")) +;(defentry SDL_Rect (int int int int) (int "gacela_SDL_Rect")) +(defentry SDL_LoadBMP (string) (int "gacela_SDL_LoadBMP")) +(defentry IMG_Load (string) (int "gacela_IMG_Load")) +(defentry SDL_GetVideoInfo () (object "gacela_SDL_GetVideoInfo")) +(defentry SDL_GL_SetAttribute (int int) (int "gacela_SDL_GL_SetAttribute")) +(defentry SDL_PollEvent () (object "gacela_SDL_PollEvent")) +;(defentry TTF_Init () (int "gacela_TTF_Init")) +;(defentry TTF_OpenFont (string int) (int "gacela_TTF_OpenFont")) +;(defentry TTF_CloseFont (int) (void "gacela_TTF_CloseFont")) +;(defentry TTF_Quit () (void "gacela_TTF_Quit")) +;(defentry Mix_OpenAudio (int int int) (int "gacela_Mix_OpenAudio")) +;(defentry Mix_LoadMUS (string) (int "gacela_Mix_LoadMUS")) +;(defentry Mix_LoadWAV (string) (int "gacela_Mix_LoadWAV")) +;(defentry Mix_PlayChannel (int int int) (int "gacela_Mix_PlayChannel")) +;(defentry Mix_PlayMusic (int int) (int "gacela_Mix_PlayMusic")) +;(defentry Mix_PlayingMusic () (int "gacela_Mix_PlayingMusic")) +;(defentry Mix_PausedMusic () (int "gacela_Mix_PausedMusic")) +;(defentry Mix_PauseMusic () (void "gacela_Mix_PauseMusic")) +;(defentry Mix_ResumeMusic () (void "gacela_Mix_ResumeMusic")) +;(defentry Mix_HaltMusic () (int "gacela_Mix_HaltMusic")) +;(defentry Mix_FreeMusic (int) (void "gacela_Mix_FreeMusic")) +;(defentry Mix_FreeChunk (int) (void "gacela_Mix_FreeChunk")) +;(defentry Mix_CloseAudio () (void "gacela_Mix_CloseAudio")) +;(defentry sge_FilledCircle (int int int int int int int) (void "gacela_sge_FilledCircle")) +;(defentry sge_FilledRect (int int int int int int int int) (void "gacela_sge_FilledRect")) +;(defentry free (int) (void "gacela_free")) +(defentry SDL_GL_SwapBuffers () (void "gacela_SDL_GL_SwapBuffers")) +(defentry SDL_EnableKeyRepeat (int int) (int "gacela_SDL_EnableKeyRepeat")) + +;;; C-Gacela Functions +(defcfun "int gacela_surface_format (int surface)" 0 + "const SDL_Surface *s = surface;" + "return s->format;") + +(defcfun "int gacela_surface_w (int surface)" 0 + "const SDL_Surface *s = surface;" + "return s->w;") + +(defcfun "int gacela_surface_h (int surface)" 0 + "const SDL_Surface *s = surface;" + "return s->h;") + +(defcfun "int gacela_surface_pixels (int surface)" 0 + "const SDL_Surface *s = surface;" + "return s->pixels;") + +;(defentry apply-surface2 (int int int int int int int int int) (void "apply_surface")) +;(defentry render-text2 (int string int int int) (int "render_text")) +;(defentry fill-surface (int int int int) (void "fill_surface")) +;(defentry box-collision (int int int int int int) (int "box_collision")) +;(defentry create-SDL_Surface (int int int int int int) (int "create_SDL_Surface")) +;(defentry copy-SDL_Surface (int) (int "copy_SDL_Surface")) +(defentry surface-format (int) (int "gacela_surface_format")) +(defentry surface-w (int) (int "gacela_surface_w")) +(defentry surface-h (int) (int "gacela_surface_h")) +(defentry surface-pixels (int) (int "gacela_surface_pixels")) diff --git a/gacela_chip.c b/gacela_chip.c new file mode 100755 index 0000000..f929dfd --- /dev/null +++ b/gacela_chip.c @@ -0,0 +1,294 @@ + +#include "cmpinclude.h" +#include "gacela_chip.h" +void init__home_jsancho_proyectos_gacela_gacela_chip(){do_init((void *)VV);} +#include "gacela_chipmunk.c" +/* function definition for CPINITCHIPMUNK */ + +static void L1() +{ object *old_base=vs_base; + gacela_cpInitChipmunk(); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPRESETSHAPEIDCOUNTER */ + +static void L2() +{ object *old_base=vs_base; + gacela_cpResetShapeIdCounter(); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPSPACENEW */ + +static void L3() +{ object *old_base=vs_base; + int x; + x= + gacela_cpSpaceNew(); + vs_top=(vs_base=old_base)+1; + vs_base[0]=CMPmake_fixnum(x); +} +/* function definition for CPSPACEADDBODY */ + +static void L4() +{ object *old_base=vs_base; + gacela_cpSpaceAddBody( + object_to_int(vs_base[0]), + object_to_int(vs_base[1])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPSPACEADDSHAPE */ + +static void L5() +{ object *old_base=vs_base; + gacela_cpSpaceAddShape( + object_to_int(vs_base[0]), + object_to_int(vs_base[1])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPSPACEFREE */ + +static void L6() +{ object *old_base=vs_base; + gacela_cpSpaceFree( + object_to_int(vs_base[0])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPBODYNEW */ + +static void L7() +{ object *old_base=vs_base; + int x; + x= + gacela_cpBodyNew( + object_to_float(vs_base[0]), + object_to_float(vs_base[1]), + object_to_float(vs_base[2])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=CMPmake_fixnum(x); +} +/* function definition for CPBODYFREE */ + +static void L8() +{ object *old_base=vs_base; + gacela_cpBodyFree( + object_to_int(vs_base[0])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for CPCIRCLESHAPENEW */ + +static void L9() +{ object *old_base=vs_base; + int x; + x= + gacela_cpCircleShapeNew( + object_to_int(vs_base[0]), + object_to_float(vs_base[1]), + object_to_float(vs_base[2]), + object_to_float(vs_base[3])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=CMPmake_fixnum(x); +} +/* function definition for CPPOLYSHAPENEW */ + +static void L10() +{ object *old_base=vs_base; + int x; + x= + gacela_cpPolyShapeNew( + object_to_int(vs_base[0]), + object_to_int(vs_base[1]), + object_to_int(vs_base[2]), + object_to_float(vs_base[3]), + object_to_float(vs_base[4])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=CMPmake_fixnum(x); +} +/* function definition for CPSHAPEFREE */ + +static void L11() +{ object *old_base=vs_base; + gacela_cpShapeFree( + object_to_int(vs_base[0])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for SET-SPACE-PROPERTIES */ + +static void L12() +{ object *old_base=vs_base; + set_space_properties( + object_to_int(vs_base[0]), + object_to_float(vs_base[1]), + object_to_float(vs_base[2])); + vs_top=(vs_base=old_base)+1; + vs_base[0]=Cnil; +} +/* function definition for MAKE-SPACE */ + +static void L13() +{register object *base=vs_base; + register object *sup=base+VM1; VC1 + vs_check; + {object V1; + parse_key(vs_base,FALSE,FALSE,1,VV[3]);vs_top=sup; + V1=(base[0]); + base[2]= ((object)VV[0]); + base[3]= (V1); + vs_top=(vs_base=base+2)+2; + siLmake_structure(); + return; + } +} +/* function definition for MAKE-BODY */ + +static void L14() +{register object *base=vs_base; + register object *sup=base+VM2; VC2 + vs_check; + {object V2; + parse_key(vs_base,FALSE,FALSE,1,VV[3]);vs_top=sup; + V2=(base[0]); + base[2]= ((object)VV[1]); + base[3]= (V2); + vs_top=(vs_base=base+2)+2; + siLmake_structure(); + return; + } +} +/* function definition for MAKE-SHAPE */ + +static void L15() +{register object *base=vs_base; + register object *sup=base+VM3; VC3 + vs_check; + {object V3; + parse_key(vs_base,FALSE,FALSE,1,VV[3]);vs_top=sup; + V3=(base[0]); + base[2]= ((object)VV[2]); + base[3]= (V3); + vs_top=(vs_base=base+2)+2; + siLmake_structure(); + return; + } +} +/* function definition for CREATE-SPACE */ + +static void L16() +{register object *base=vs_base; + register object *sup=base+VM4; VC4 + vs_check; + {object V4; + parse_key(vs_base,FALSE,FALSE,1,VV[7]);vs_top=sup; + V4=(base[0]); + vs_base=vs_top; + (void) (*Lnk8)(); + vs_top=sup; + {object V5; + register object V6; + base[2]= ((object)VV[3]); + vs_base=vs_top; + (void) (*Lnk9)(); + vs_top=sup; + base[3]= vs_base[0]; + vs_top=(vs_base=base+2)+2; + (void) (*Lnk10)(); + vs_top=sup; + V5= vs_base[0]; + V6= Cnil; + base[2]= ((object)VV[0]); + base[3]= (V5); + vs_base=vs_top; + Lgentemp(); + vs_top=sup; + base[4]= vs_base[0]; + vs_top=(vs_base=base+2)+3; + (void) (*Lnk11)(); + vs_top=sup; + if(((V4))==Cnil){ + goto T15;} + V6= (VFUN_NARGS=2,(*(LnkLI12))((V4),(V6))); + goto T15; +T15:; + if(((V6))==Cnil){ + goto T19;} + {object V7; + V7= make_cons(STREF(object,(V5),0),(V6)); + vs_top=base+2; + while(V7!=Cnil) + {vs_push((V7)->c.c_car);V7=(V7)->c.c_cdr;} + vs_base=base+2;} + (void) (*Lnk13)(); + vs_top=sup; + goto T19; +T19:; + base[2]= (V5); + vs_top=(vs_base=base+2)+1; + return;} + } +} +/* function definition for CREATE-BODY */ + +static void L17() +{register object *base=vs_base; + register object *sup=base+VM5; VC5 + vs_check; + {object V8; + object V9; + parse_key(vs_base,FALSE,FALSE,2,VV[14],VV[15]);vs_top=sup; + if(base[2]==Cnil){ + V8= ((object)VV[4]); + }else{ + V8=(base[0]);} + if(base[3]==Cnil){ + V9= ((object)VV[5]); + }else{ + V9=(base[1]);} + vs_base=vs_top; + (void) (*Lnk8)(); + vs_top=sup; + {object V10; + base[4]= ((object)VV[3]); + base[6]= (V8); + base[7]= (V9); + base[8]= ((object)VV[6]); + vs_top=(vs_base=base+6)+3; + (void) (*Lnk16)(); + vs_top=sup; + base[5]= vs_base[0]; + vs_top=(vs_base=base+4)+2; + (void) (*Lnk17)(); + vs_top=sup; + V10= vs_base[0]; + base[4]= ((object)VV[1]); + base[5]= (V10); + vs_base=vs_top; + Lgentemp(); + vs_top=sup; + base[6]= vs_base[0]; + vs_top=(vs_base=base+4)+3; + (void) (*Lnk11)(); + vs_top=sup; + base[4]= (V10); + vs_top=(vs_base=base+4)+1; + return;} + } +} +static void LnkT17(){ call_or_link(((object)VV[17]),(void **)(void *)&Lnk17);} /* MAKE-BODY */ +static void LnkT16(){ call_or_link(((object)VV[16]),(void **)(void *)&Lnk16);} /* CPNEWBODY */ +static void LnkT13(){ call_or_link(((object)VV[13]),(void **)(void *)&Lnk13);} /* SET-SPACE-PROPERTIES */ +static object LnkTLI12(object first,...){object V1;va_list ap;va_start(ap,first);V1=call_vproc_new(((object)VV[12]),(void **)(void *)&LnkLI12,first,ap);va_end(ap);return V1;} /* UNION */ +static void LnkT11(){ call_or_link(((object)VV[11]),(void **)(void *)&Lnk11);} /* SET-RESOURCE */ +static void LnkT10(){ call_or_link(((object)VV[10]),(void **)(void *)&Lnk10);} /* MAKE-SPACE */ +static void LnkT9(){ call_or_link(((object)VV[9]),(void **)(void *)&Lnk9);} /* CPSPACENEW */ +static void LnkT8(){ call_or_link(((object)VV[8]),(void **)(void *)&Lnk8);} /* INIT-CHIPMUNK */ + +#ifdef SYSTEM_SPECIAL_INIT +SYSTEM_SPECIAL_INIT +#endif + diff --git a/gacela_chip.lisp b/gacela_chip.lisp new file mode 100755 index 0000000..e02f4cc --- /dev/null +++ b/gacela_chip.lisp @@ -0,0 +1,52 @@ +(in-package 'chipmunk) + +(clines "#include \"gacela_chipmunk.c\"") + +(defconstant INFINITY MOST-POSITIVE-LONG-FLOAT) + +;;; Chipmunk functions +(defentry cpInitChipmunk () (void "gacela_cpInitChipmunk")) +(defentry cpResetShapeIdCounter () (void "gacela_cpResetShapeIdCounter")) +(defentry cpSpaceNew () (int "gacela_cpSpaceNew")) +(defentry cpSpaceAddBody (int int) (void "gacela_cpSpaceAddBody")) +(defentry cpSpaceAddShape (int int) (void "gacela_cpSpaceAddShape")) +(defentry cpSpaceFree (int) (void "gacela_cpSpaceFree")) +(defentry cpBodyNew (float float float) (int "gacela_cpBodyNew")) +(defentry cpBodyFree (int) (void "gacela_cpBodyFree")) +(defentry cpCircleShapeNew (int float float float) (int "gacela_cpCircleShapeNew")) +(defentry cpPolyShapeNew (int int int float float) (int "gacela_cpPolyShapeNew")) +(defentry cpShapeFree (int) (void "gacela_cpShapeFree")) + +;;; C-Gacela functions +(defentry set-space-properties (int float float) (void "set_space_properties")) + +;;; Physics Subsystem +(defstruct space address) +(defstruct body address) +(defstruct shape address) + +(let ((initialized nil) + (mobs-space nil)) + + (defun init-chipmunk () + (cond ((null initialized) (cpInitChipmunk) (setq initialized t)) + (t initialized))) + + (defun init-mobs-physics (&key (gravity nil)) + (cond ((null mobs-space) (init-chipmunk) (setq mobs-space (create-space))) + (t mobs-space)))) + +(defun create-space (&key (gravity nil)) + (init-chipmunk) + (let ((new-space (make-space :address (cpSpaceNew))) + (properties nil)) + (set-resource 'space new-space (gentemp)) + (cond (gravity (setq properties (union gravity properties)))) + (cond (properties (apply #'set-space-properties (cons (space-address new-space) properties)))) + new-space)) + +(defun create-body (&key (mass INFINITY) (inertia INFINITY)) + (init-chipmunk) + (let ((new-body (make-body :address (cpNewBody mass inertia INFINITY)))) + (set-resource 'body new-body (gentemp)) + new-body)) diff --git a/gacela_chipmunk.c b/gacela_chipmunk.c new file mode 100755 index 0000000..e9f2dcb --- /dev/null +++ b/gacela_chipmunk.c @@ -0,0 +1,81 @@ +#include + +void +gacela_cpInitChipmunk (void) +{ + cpInitChipmunk (); +} + +void +gacela_cpResetShapeIdCounter (void) +{ + cpResetShapeIdCounter (); +} + +int +gacela_cpSpaceNew (void) +{ + return cpSpaceNew (); +} + +void +gacela_cpSpaceAddBody (int space, int body) +{ + cpSpaceAddBody (space, body); +} + +void +gacela_cpSpaceAddShape (int space, int shape) +{ + cpSpaceAddShape (space, shape); +} + +void +gacela_cpSpaceFree (int space) +{ + cpSpaceFree (space); +} + +int +gacela_cpBodyNew (float mass, float inertia, float infinity) +{ + return cpBodyNew ((mass >= infinity ? INFINITY : mass), (inertia >= infinity ? INFINITY : inertia)); +} + +float +gacela_cpMomentForCircle (float mass, float r1, float r2, float x, float y) +{ + return cpMomentForCircle (mass, r1, r2, cpv (x, y)); +} + +void +gacela_cpBodyFree (int space) +{ + cpBodyFree (space); +} + +int +gacela_cpCircleShapeNew (int body, float radius, float x, float y) +{ + return cpCircleShapeNew (body, radius, cpv (x, y)); +} + +int +gacela_cpPolyShapeNew (int body, int numVerts, int verts, float x, float y) +{ + return cpPolyShapeNew (body, numVerts, verts, cpv (x, y)); +} + +void +gacela_cpShapeFree (int shape) +{ + cpShapeFree (shape); +} + +void +set_cp_space_gravity (int space, float x, float y) +{ + cpSpace *s = space; + + s->gravity = cpv (x, y); +} diff --git a/gacela_draw.lisp b/gacela_draw.lisp new file mode 100644 index 0000000..3ec9458 --- /dev/null +++ b/gacela_draw.lisp @@ -0,0 +1,103 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +(defun draw (&rest vertexes) + (begin-draw (length vertexes)) + (draw-vertexes vertexes) + (glEnd)) + +(defun begin-draw (number-of-points) + (cond ((= number-of-points 3) (glBegin GL_TRIANGLES)) + ((= number-of-points 4) (glBegin GL_QUADS)))) + +(defun draw-vertexes (vertexes) + (cond ((null vertexes) nil) + (t (draw-vertex (car vertexes)) + (draw-vertexes (cdr vertexes))))) + +(defun draw-vertex (vertex &key texture-coord) + (cond ((consp (car vertex)) (apply #'glColor3f (car vertex)) (apply #'glVertex3f (cadr vertex))) + (t (cond (texture-coord (apply #'glTexCoord2f texture-coord))) + (apply #'glVertex3f vertex)))) + +(defun draw-color (color) + (apply #'glColor3f color)) + +(defun load-texture (filename &optional (min-filter GL_LINEAR) (mag-filter GL_LINEAR)) +; (init-textures) + (init-video-mode) + (let ((image (IMG_Load filename)) + (texture (car (glGenTextures 1)))) + (cond ((/= image 0) + (glBindTexture GL_TEXTURE_2D texture) + (glTexImage2D GL_TEXTURE_2D 0 3 (surface-w image) (surface-h image) 0 GL_BGR GL_UNSIGNED_BYTE (surface-pixels image)) + (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER min-filter) + (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER mag-filter) + (SDL_FreeSurface image))) + texture)) + +(defun draw-quad (v1 v2 v3 v4 &key texture color) + (cond (texture (glBindTexture GL_TEXTURE_2D texture) + (begin-draw 4) + (draw-vertex v1 :texture-coord '(0 0)) + (draw-vertex v2 :texture-coord '(1 0)) + (draw-vertex v3 :texture-coord '(1 1)) + (draw-vertex v4 :texture-coord '(0 1)) + (glEnd)) + (t (cond (color (draw-color color))) + (draw v1 v2 v3 v4)))) + +(defun draw-square (&key size texture color) + (let ((-size (neg size))) + (draw-quad (list -size size 0) (list size size 0) (list size -size 0) (list -size -size 0) :texture texture :color color))) + +(defun draw-cube (&key size texture color) + (let ((-size (neg size))) + (enable :textures texture) + (glNormal3f 0 0 1) + (draw-quad (list -size size size) (list size size size) (list size -size size) (list -size -size size) :texture texture :color color) + (glNormal3f 0 0 -1) + (draw-quad (list -size -size -size) (list size -size -size) (list size size -size) (list -size size -size) :texture texture :color color) + (glNormal3f 0 1 0) + (draw-quad (list size size size) (list -size size size) (list -size size -size) (list size size -size) :texture texture :color color) + (glNormal3f 0 -1 0) + (draw-quad (list -size -size size) (list size -size size) (list size -size -size) (list -size -size -size) :texture texture :color color) + (glNormal3f 1 0 0) + (draw-quad (list size -size -size) (list size -size size) (list size size size) (list size size -size) :texture texture :color color) + (glNormal3f -1 0 0) + (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) :texture texture :color color))) + +(defun add-light (&key light position ambient (id GL_LIGHT1) (turn-on t)) + (init-lighting) + (and light (glLightfv id GL_DIFFUSE (first light) (second light) (third light) (fourth light))) + (and light position (glLightfv GL_POSITION (first position) (second position) (third position) (fourth position))) + (and ambient (glLightfv id GL_AMBIENT (first ambient) (second ambient) (third ambient) (fourth ambient))) + (and turn-on (glEnable id)) + id) + +(defun translate (x y &optional (z 0)) + (glTranslatef x y z)) + +(defun rotate (xrot yrot &optional zrot) + (glRotatef xrot 1 0 0) + (glRotatef yrot 0 1 0) + (cond (zrot (glRotatef zrot 0 0 1)))) + +(defun enable (&key textures) + (cond (textures (glEnable GL_TEXTURE_2D)))) \ No newline at end of file diff --git a/gacela_events.lisp b/gacela_events.lisp new file mode 100644 index 0000000..4663e53 --- /dev/null +++ b/gacela_events.lisp @@ -0,0 +1,144 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +;;; SDL Events +(defconstant SDL_NOEVENT 0) +(defconstant SDL_ACTIVEEVENT 1) +(defconstant SDL_KEYDOWN 2) +(defconstant SDL_KEYUP 3) +(defconstant SDL_MOUSEMOTION 4) +(defconstant SDL_MOUSEBUTTONDOWN 5) +(defconstant SDL_MOUSEBUTTONUP 6) +(defconstant SDL_JOYAXISMOTION 7) +(defconstant SDL_JOYBALLMOTION 8) +(defconstant SDL_JOYHATMOTION 9) +(defconstant SDL_JOYBUTTONDOWN 10) +(defconstant SDL_JOYBUTTONUP 11) +(defconstant SDL_QUIT 12) +(defconstant SDL_SYSWMEVENT 13) +(defconstant SDL_EVENT_RESERVEDA 14) +(defconstant SDL_EVENT_RESERVEDB 15) +(defconstant SDL_VIDEORESIZE 16) +(defconstant SDL_VIDEOEXPOSE 17) +(defconstant SDL_EVENT_RESERVED2 18) +(defconstant SDL_EVENT_RESERVED3 19) +(defconstant SDL_EVENT_RESERVED4 20) +(defconstant SDL_EVENT_RESERVED5 21) +(defconstant SDL_EVENT_RESERVED6 22) +(defconstant SDL_EVENT_RESERVED7 23) +(defconstant SDL_USEREVENT 24) +(defconstant SDL_NUMEVENTS 32) + +;;; Functions +(defun get-event (events &rest types) + (remove nil (mapcar + (lambda (l) + (cond ((member (getf l :type) types) l))) + events))) + +(defun poll-events () + (let ((event (SDL_PollEvent))) + (cond ((null event) nil) + (t (cons event (poll-events)))))) + +(defun process-events () + (let ((events (poll-events))) + (quit? t (and (get-event events SDL_QUIT) t)) + (clear-key-state) + (process-keyboard-events (get-event events SDL_KEYDOWN SDL_KEYUP)))) + +(let (will-happen happenings) + (defun next-happenings () + (setq happenings will-happen) + (setq will-happen nil)) + + (defun will-happen (happening) + (setq will-happen (cons happening will-happen))) + + (defun is-happening? (happening &optional (test #'eql)) + (remove nil (mapcar + (lambda (l) + (cond ((funcall test happening l) l))) + happenings)))) + +(let (quit) + (defun quit? (&optional change newquit) + (if change (setq quit newquit) quit))) + +(defun process-keyboard-events (events) + (cond (events + (let ((event (car events))) + (cond ((= (getf event :type) SDL_KEYDOWN) (key-press (getf event :key.keysym.sym))) + ((= (getf event :type) SDL_KEYUP) (key-release (getf event :key.keysym.sym))))) + (process-keyboard-events (cdr events))))) + +(let ((keymap (make-hash-table)) + (pressed (make-hash-table)) + (released (make-hash-table))) + (defun key? (key) + (gethash (get-keycode key) keymap)) + + (defun key-pressed? (key) + (gethash (get-keycode key) pressed)) + + (defun key-released? (key) + (gethash (get-keycode key) released)) + + (defun key-press (key-code) + (setf (gethash key-code keymap) t) + (setf (gethash key-code pressed) t) + (setf (gethash key-code released) nil)) + + (defun key-release (key-code) + (setf (gethash key-code keymap) nil) + (setf (gethash key-code pressed) nil) + (setf (gethash key-code released) t)) + + (defun clear-keymap () + (clrhash keymap)) + + (defun clear-key-state () + (clrhash pressed) + (clrhash released))) + +(let ((keys + '((269 . minus) + (270 . plus) + (273 . up) + (274 . down) + (275 . right) + (276 . left) + (282 . f1) + (283 . f2) + (284 . f3) + (285 . f4) + (286 . f5) + (287 . f6) + (288 . f7) + (289 . f8) + (290 . f9) + (291 . f10) + (292 . f11) + (293 . f12)))) + + (defun get-keycode (keyname) + (car (rassoc keyname keys))) + + (defun get-keyname (keycode) + (cdr (assoc keycode keys)))) diff --git a/gacela_make.lisp b/gacela_make.lisp new file mode 100755 index 0000000..9366e93 --- /dev/null +++ b/gacela_make.lisp @@ -0,0 +1,40 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(defmacro compile-gfile (file-name) + `(compile-file ,file-name :system-p t)) + +(defun compile-gacela () + (compile-gfile "gacela.lisp") + (compile-gfile "gacela_SDL.lisp") + (compile-gfile "gacela_GL.lisp") + (compile-gfile "gacela_draw.lisp") + (compile-gfile "gacela_events.lisp") + (compile-gfile "gacela_mobs.lisp") + (compile-gfile "gacela_widgets.lisp") + (compile-gfile "gacela_misc.lisp")) + +(defun link-gacela () + (compiler::link + '("gacela.o" "gacela_SDL.o" "gacela_GL.o" "gacela_draw.o" "gacela_events.o" "gacela_mobs.o" "gacela_widgets.o" "gacela_misc.o") + "gacela" + "" + "-lSDL -lSDL_image -lSDL_ttf -lSDL_mixer -lSGE -lGL -lGLU")) + +(defun build-gacela () + (compile-gacela) + (link-gacela)) diff --git a/gacela_misc.lisp b/gacela_misc.lisp new file mode 100755 index 0000000..6ebcf38 --- /dev/null +++ b/gacela_misc.lisp @@ -0,0 +1,189 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +(defconstant INFINITY MOST-POSITIVE-LONG-FLOAT) + +(defun append-if (new test tree &key (key #'first) (test-if #'equal)) + (cond ((atom tree) tree) + (t (append-if-1 + new + test + (mapcar (lambda (x) (append-if new test x :key key :test-if test-if)) tree) + :key key + :test-if test-if)))) + +(defun append-if-1 (new test tree &key (key #'first) (test-if #'equal)) + (cond ((funcall test-if (funcall key tree) test) (append tree new)) + (t tree))) + +(defun car+ (var) + (if (listp var) (car var) var)) + +(defun avg (&rest numbers) + (let ((total 0)) + (dolist (n numbers) (incf total n)) + (/ total (length numbers)))) + +(defun neg (num) + (* -1 num)) + +(defun signum+ (num) + (let ((sig (signum num))) + (cond ((= sig 0) 1) + (t sig)))) + +(defmacro destructure (destructuring-list &body body) + (let ((lambda-list nil) (exp-list nil)) + (dolist (pair destructuring-list) + (setq exp-list (cons (car pair) exp-list)) + (setq lambda-list (cons (cadr pair) lambda-list))) + `(destructuring-bind ,lambda-list ,(cons 'list exp-list) ,@body))) + +(defun match-pattern (list pattern) + (cond ((and (null list) (null pattern)) t) + ((and (consp list) (consp pattern)) + (and (match-pattern (car list) (car pattern)) (match-pattern (cdr list) (cdr pattern)))) + ((and (atom list) (atom pattern)) + (cond ((or (numberp list) (numberp pattern)) (and (numberp list) (numberp pattern))) + (t t))))) + +;Geometry +(defun dotp (dot) + (match-pattern dot '(0 0))) + +(defun vectorp (vector) + (match-pattern vector '(0 0))) + +(defun circlep (circle) + (match-pattern circle '((0 0) 0))) + +(defun polygonp (polygon) + (cond ((consp polygon) + (and (dotp (car polygon)) + (if (null (cdr polygon)) t (polygonp (cdr polygon))))))) + +(defun make-dot (x y) + `(,x ,y)) + +(defun make-vector (x y) + `(,x ,y)) + +(defun make-line (dot1 dot2) + `(,dot1 ,dot2)) + +(defun make-rectangle (x1 y1 x2 y2) + `((,x1 ,y1) (,x2 ,y1) (,x2 ,y2) (,x1 ,y2))) + +(defun polygon-center (polygon) + (apply #'mapcar #'avg polygon)) + +(defun dots-distance (dot1 dot2) + (destructure ((dot1 (x1 y1)) + (dot2 (x2 y2))) + (sqrt (+ (expt (- x2 x1) 2) + (expt (- y2 y1) 2))))) + +(defun dot-line-distance (dot line) + (destructure ((line ((ax ay) (bx by))) + (dot (cx cy))) + (let* ((r-numerator (+ (* (- cx ax) (- bx ax)) (* (- cy ay) (- by ay)))) + (r-denomenator (+ (expt (- bx ax) 2) (expt (- by ay) 2))) + (r (/ r-numerator r-denomenator))) + (values + (* (abs (/ (- (* (- ay cy) (- bx ax)) (* (- ax cx) (- by ay))) + r-denomenator)) + (sqrt r-denomenator)) + r)))) + +(defun dot-segment-distance (dot segment) + (multiple-value-bind + (dist r) (dot-line-distance dot segment) + (cond ((and (>= r 0) (<= r 1)) dist) + (t (let ((dist1 (dots-distance dot (car segment))) + (dist2 (dots-distance dot (cadr segment)))) + (if (< dist1 dist2) dist1 dist2)))))) + +(defun perpendicular-line (dot line) + (destructure ((line ((ax ay) (bx by)))) + (multiple-value-bind + (dist r) (dot-line-distance dot line) + (make-line dot + (make-dot (+ ax (* r (- bx ax))) + (+ ay (* r (- by ay)))))))) + +(defun line-angle (line) + (destructure ((line ((ax ay) (bx by)))) + (let ((x (- bx ax)) (y (- by ay))) + (if (and (= x 0) (= y 0)) 0 (atan y x))))) + +(defun inverse-angle (angle) + (cond ((< angle pi) (+ angle pi)) + (t (- angle pi)))) + +(defun translate-dot (dot dx dy) + (destructure ((dot (x y))) + (list (+ x dx) (+ y dy)))) + +(defun translate-circle (circle dx dy) + (destructure ((circle (center radius))) + (list (translate-dot center dx dy) radius))) + +(defun translate-polygon (pol dx dy) + (mapcar (lambda (dot) + (translate-dot dot dx dy)) + pol)) + +(defun polygon-edges (pol) + (mapcar (lambda (v1 v2) (list v1 v2)) + pol + (union (cdr pol) (list (car pol))))) + +(defun polygon-dot-intersection (polygon dot) +;Eric Haines algorithm + (let ((edges (polygon-edges + (translate-polygon polygon (neg (car dot)) (neg (cadr dot))))) + (counter 0)) + (dolist (edge edges) + (destructure ((edge ((x1 y1) (x2 y2)))) + (cond ((/= (signum+ y1) (signum+ y2)) + (cond ((and (> x1 0) (> x2 0)) (incf counter)) + ((and (or (> x1 0) (> x2 0)) + (> (- x1 (* y1 (/ (- x2 x1) (- y2 y1)))) 0)) + (incf counter))))))) + (not (evenp counter)))) + +(defun circle-segment-intersection (circle segment) + (destructure ((circle (center radius))) + (<= (dot-segment-distance center segment) radius))) + +(defun circle-edges-intersection (circle polygon) + (let ((edges (polygon-edges polygon)) + (edges-i nil)) + (dolist (edge edges) + (cond ((circle-segment-intersection circle edge) (setq edges-i (cons edge edges-i))))) + edges-i)) + +(defun circle-polygon-intersection (circle polygon) + (or (polygon-dot-intersection polygon (car circle)) + (circle-edges-intersection circle polygon))) + +(defun circle-circle-intersection (circle1 circle2) + (destructure ((circle1 (center1 radius1)) + (circle2 (center2 radius2))) + (<= (dots-distance center1 center2) (+ r1 r2)))) diff --git a/gacela_mobs.lisp b/gacela_mobs.lisp new file mode 100755 index 0000000..558a1b6 --- /dev/null +++ b/gacela_mobs.lisp @@ -0,0 +1,59 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +;;; World of Mob +(defmacro defmob (name variables &key init logic render) + `(let ((make-name ',(intern (concatenate 'string "MAKE-" (string name))))) + (setf (symbol-function make-name) + (makemob ,variables :init ,init :logic ,logic :render ,render)) + make-name)) + +(defmacro makemob (variables &key init logic render) + `(lambda + ,(if (null variables) () (cons '&key variables)) + (mob-structure ,variables ,init ,logic ,render))) + +(defmacro mob-structure (variables init logic render) + `(list + :init (lambda () ,init) + :logic (lambda () ,logic) + :render (lambda () ,render) + :context (lambda () + ,(if variables + `(mapcar #'list + ',(mapcar #'car+ variables) + (multiple-value-list + (values-list ,(cons 'list (mapcar #'car+ variables))))) + nil)))) + +(defun init-mob (mob) + (funcall (getf mob :init))) + +(defun logic-mob (mob) + (funcall (getf mob :logic))) + +(defun render-mob (mob) + (funcall (getf mob :render))) + +(let (running-mobs mobs-to-add mobs-to-quit) + (defun mob-on (mob) + (push mob mobs-to-add)) + + (defun mob-off (mob) + (push mob mobs-to-quit))) diff --git a/gacela_physics.lisp b/gacela_physics.lisp new file mode 100755 index 0000000..f7ed067 --- /dev/null +++ b/gacela_physics.lisp @@ -0,0 +1,81 @@ +;;; +;;; Chipmunk Physics Engine +;;; + +(clines "#include \"gacela_chipmunk.c\"") + +;;; Chipmunk functions +(defentry cpInitChipmunk () (void "gacela_cpInitChipmunk")) +(defentry cpResetShapeIdCounter () (void "gacela_cpResetShapeIdCounter")) +(defentry cpSpaceNew () (int "gacela_cpSpaceNew")) +(defentry cpSpaceAddBody (int int) (void "gacela_cpSpaceAddBody")) +(defentry cpSpaceAddShape (int int) (void "gacela_cpSpaceAddShape")) +(defentry cpSpaceFree (int) (void "gacela_cpSpaceFree")) +(defentry cpBodyNew (float float float) (int "gacela_cpBodyNew")) +(defentry cpMomentForCircle (float float float float float) (float "gacela_cpMomentForCircle")) +(defentry cpBodyFree (int) (void "gacela_cpBodyFree")) +(defentry cpCircleShapeNew (int float float float) (int "gacela_cpCircleShapeNew")) +(defentry cpPolyShapeNew (int int int float float) (int "gacela_cpPolyShapeNew")) +(defentry cpShapeFree (int) (void "gacela_cpShapeFree")) + +;;; C-Gacela functions +(defentry set-cp-space-gravity (int float float) (void "set_cp_space_gravity")) + +;;; Physics Subsystem +(defstruct cp-space address gravity) +(defstruct cp-body address position) +(defstruct cp-shape address) + +(let ((initialized nil) + (mobs-cp-space nil)) + + (defun init-chipmunk () + (cond ((null initialized) (cpInitChipmunk) (setq initialized t)) + (t initialized))) + + (defun init-cp-space (&key (gravity nil)) + (cond ((null mobs-cp-space) (init-chipmunk) (setq mobs-cp-space (create-cp-space))) + (t mobs-cp-space))) + + (defun add-cp-body (body) + (cpSpaceAddBody (cp-space-address mobs-cp-space) (cp-body-address body))) + + (defun add-cp-shape (shape) + (cpSpaceAddShape (cp-space-address mobs-cp-space) (cp-shape-address shape)))) + +(defun create-cp-space (&key (gravity nil)) + (init-chipmunk) + (let ((new-cp-space (make-cp-space :address (cpSpaceNew) :gravity gravity)) + (properties nil)) + (set-resource 'cp-space new-cp-space (gentemp)) + (cond (gravity (setq properties (union gravity properties)))) + (cond (properties (apply #'set-cp-space-properties (cons (cp-space-address new-cp-space) properties)))) + new-cp-space)) + +(defun create-cp-body (&key (mass INFINITY) (inertia INFINITY) (x 0) (y 0)) + (init-chipmunk) + (let ((new-cp-body (make-cp-body :address (cpNewBody mass inertia INFINITY) :position `(,x ,y)))) + (set-resource 'cp-body new-cp-body (gentemp)) + new-cp-body)) + +(defun create-circle-cp-shape (cp-body shape) + (init-chipmunk) + (destructure ((shape ((x y) r))) + (make-cp-shape :address (cpCircleShapeNew cp-body r x y)))) + +(defun create-cp-shape (cp-body shape) + (init-chipmunk) + (let ((new-cp-shape (cond ((circle-p shape) (create-circle-cp-shape cp-body shape))))) + (set-resource 'cp-shape new-cp-shape (gentemp)) + new-cp-shape)) + +(defun cp-moment (mass shape) + (cond ((circle-p shape) (destructure ((shape ((x y) r))) (cpMomentForCircle mass 0.0 r x y))) + t INFINITY)) + +;(defun use-chipmunk () +; (defun physics-add-mob (mass shape x y) +; (init-cp-space) +; (let ((new-cp-body (create-cp-body mass (cp-moment mass shape)))) +; (add-cp-body new-cp-body) + \ No newline at end of file diff --git a/gacela_procs.lisp b/gacela_procs.lisp new file mode 100755 index 0000000..ce58974 --- /dev/null +++ b/gacela_procs.lisp @@ -0,0 +1,71 @@ +(defmacro defproc (name type variables init logic motion) + `(let ((make-name ',(intern (concatenate 'string "MAKE-" (string name))))) + (setf (symbol-function make-name) + (make-proc-constructor ,type ,variables ,init ,logic ,motion)) + make-name)) + +(defmacro make-proc-constructor (type variables init logic motion) + `(lambda + ,(if (null variables) () (cons '&key variables)) + (proc-structure ,type ,variables ,init ,logic ,motion))) + +(defmacro proc-structure (type variables init logic motion) + `(list + :type ,type + :init (lambda () ,init) + :logic (lambda () ,logic) + :motion (lambda () ,motion) + :context (lambda () + ,(if variables + `(mapcar #'list + ',(mapcar #'car+ variables) + (multiple-value-list + (values-list ,(cons 'list (mapcar #'car+ variables))))) + nil)))) + +(defun proc-value (proc label) + (car (cdr (assoc label (funcall (getf proc :context)))))) + +(defun proc-type (proc) + (getf proc :type)) + +(defun init-proc (proc) + (funcall (getf proc :init))) + +(defun logic-proc (proc) + (funcall (getf proc :logic))) + +(defun motion-proc (proc) + (funcall (getf proc :motion))) + +(let ((active-procs nil) (procs-to-add nil) (procs-to-quit nil)) + + (defun add-proc (proc) + (push proc procs-to-add)) + + (defun logic-procs () + (dolist (proc active-procs) (logic-proc proc))) + + (defun motion-procs () + (dolist (proc active-procs) (motion-proc proc))) + + (defun funcall-procs (func) + (dolist (proc active-procs) (funcall func proc))) + + (defun filter-procs (test) + (intersection (mapcar (lambda (p) (cond ((funcall test p) p))) active-procs) active-procs)) + + (defun quit-proc (proc) + (push proc procs-to-quit)) + + (defun refresh-active-procs () + (do ((proc (pop procs-to-add) (pop procs-to-add))) ((null proc)) + (push proc active-procs) + (init-proc proc)) + (do ((proc (pop procs-to-quit) (pop procs-to-quit))) ((null proc)) + (setq active-procs (reverse (set-difference active-procs (list proc) :test #'equal))))) + + (defun quit-all-procs () + (setq active-procs nil) + (setq procs-to-add nil) + (setq procs-to-quit nil))) diff --git a/gacela_tetris.lisp b/gacela_tetris.lisp new file mode 100644 index 0000000..4d83b70 --- /dev/null +++ b/gacela_tetris.lisp @@ -0,0 +1,138 @@ +(in-package :gacela) + +(setq *zoom* -50) + +(defun tetramine-i () + (let ((color '(1 0 0))) + `((,color ,color ,color ,color)))) + +(defun tetramine-j () + (let ((color '(1 0.5 0))) + `((,color ,color ,color) + (nil nil ,color)))) + +(defun tetramine-l () + (let ((color '(1 0 1))) + `((nil nil ,color) + (,color ,color ,color)))) + +(defun tetramine-o () + (let ((color '(0 0 1))) + `((,color ,color) + (,color ,color)))) + +(defun tetramine-s () + (let ((color '(0 1 0))) + `((nil ,color ,color) + (,color ,color nil)))) + +(defun tetramine-t () + (let ((color '(0.5 0 0))) + `((,color ,color ,color) + (nil ,color nil)))) + +(defun tetramine-z () + (let ((color '(0 1 1))) + `((,color ,color nil) + (nil ,color ,color)))) + +(defun random-tetramine () + (let ((n (random 7))) + (cond ((= n 0) (tetramine-i)) + ((= n 1) (tetramine-j)) + ((= n 2) (tetramine-l)) + ((= n 3) (tetramine-o)) + ((= n 4) (tetramine-s)) + ((= n 5) (tetramine-t)) + ((= n 6) (tetramine-z))))) + +(defun draw-cell (cell) + (cond ((null cell) nil) + (t (draw-color cell) (draw-square :size 0.9)))) + +(defun draw-row (row) + (mapcar (lambda (cell) (draw-cell cell) (translate 2 0)) row)) + +(defun draw-grid (grid) + (mapcar (lambda (row) (draw-row row) (translate (* -2 (length row)) -2)) grid)) + +(defun join-rows (source destination &optional (offset 0)) + (cond ((null source) destination) + ((null destination) nil) + ((> offset 0) (cons (car destination) (join-rows source (cdr destination) (- offset 1)))) + (t (cons (or (car source) (car destination)) + (join-rows (cdr source) (cdr destination) offset))))) + +(defun join-grids (source destination &optional (x 0) (y 0)) + (cond ((null source) destination) + ((null destination) nil) + ((> y 0) (cons (car destination) + (join-grids source (cdr destination) x (- y 1)))) + (t (cons (join-rows (car source) (car destination) x) + (join-grids (cdr source) (cdr destination) x y))))) + +(defun collide-rows (row1 row2 &optional (offset 0)) + (cond ((not (or row1 row2)) nil) + ((> offset 0) (collide-rows row1 (cdr row2) (- offset 1))) + (t (or (and (car row1) (car row2)) (collide-rows (cdr row1) (cdr row2)))))) + +(defun collide-grids (grid1 grid2 &optional (x 0) (y 0)) + (cond ((not (or grid1 grid2)) nil) + ((> y 0) (collide-grids grid1 (cdr grid2) x (- y 1))) + (t (or (collide-rows (car grid1) (car grid2) x) + (collide-grids (cdr grid1) (cdr grid2) x y))))) + +(defun rotate-tetramine (grid) + (labels ((rot (grid res) + (cond ((null grid) res) + (t (rot (cdr grid) (mapcar #'cons (car grid) res)))))) + (rot grid (make-list (length (car grid)))))) + +(defun row-completed (row) + (cond ((null row) t) + (t (and (car row) (row-completed (cdr row)))))) + +(defun remove-rows-completed (grid) + (let ((res (remove-if (lambda (x) (row-completed x)) grid))) + (labels ((fill (grid n) + (cond ((< n 1) grid) + (t (fill (cons (make-list 14) grid) (- n 1)))))) + (fill res (- 20 (length res)))))) + +(let ((tetramine (random-tetramine)) (x 6) (y 0) + (next (random-tetramine)) + (timer (make-timer)) + (grid (make-list 20 :initial-element (make-list 14))) + (texture (load-texture "fondo_tetris.png"))) + (defun tetramine () + (cond ((eq (timer-state timer) 'stopped) (start-timer timer))) + + (cond ((key? 'right) + (cond ((not (collide-grids tetramine grid (+ x 1) y)) + (incf x))))) + (cond ((key? 'left) + (cond ((not (collide-grids tetramine grid (- x 1) y)) + (decf x))))) + (cond ((< x 0) (setq x 0)) + ((> (+ x (length (car tetramine))) 14) (setq x (- 14 (length (car tetramine)))))) + + (cond ((key-pressed? 'up) + (let ((t1 (rotate-tetramine tetramine))) + (cond ((not (collide-grids t1 grid x y)) + (setq tetramine t1)))))) + + (cond ((or (key? 'down) (> (get-time timer) 5000)) + (cond ((or (collide-grids tetramine grid x (+ y 1)) + (> (+ y 1 (length tetramine)) 20)) + (setq grid (remove-rows-completed (join-grids tetramine grid x y))) + (setq tetramine next x 6 y 0) + (setq next (random-tetramine))) + (t (incf y) (start-timer timer))))) + + (draw-square :size 1 :texture texture) + (translate -25 19) + (draw-grid (join-grids tetramine grid x y)) + (translate 40 40) + (draw-grid next))) + +(run-game "Gacela Tetris" (tetramine)) diff --git a/gacela_widgets.lisp b/gacela_widgets.lisp new file mode 100755 index 0000000..3589067 --- /dev/null +++ b/gacela_widgets.lisp @@ -0,0 +1,45 @@ +;;; Gacela, a GNU Common Lisp extension for fast games development +;;; Copyright (C) 2009 by Javier Sancho Fernandez +;;; +;;; 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 . + + +(in-package :gacela) + +;;; Timers + +(defstruct timer (start 0) (paused 0) (state 'stopped)) + +(defun start-timer (timer) + (setf (timer-start timer) (SDL_GetTicks)) + (setf (timer-state timer) 'running)) + +(defun stop-timer (timer) + (setf (timer-state timer) 'stopped)) + +(defun get-time (timer) + (cond ((eq (timer-state timer) 'stopped) 0) + ((eq (timer-state timer) 'paused) (timer-paused timer)) + (t (- (SDL_GetTicks) (timer-start timer))))) + +(defun pause-timer (timer) + (cond ((eq (timer-state timer) 'running) + (setf (timer-paused timer) (- (SDL_GetTicks) (timer-start timer))) + (setf (timer-state timer) 'paused)))) + +(defun resume-timer (timer) + (cond ((eq (timer-state timer) 'paused) + (setf (timer-start timer) (- (SDL_GetTicks) (timer-paused timer))) + (setf (timer-state timer) 'running)))) + diff --git a/game.lisp b/game.lisp new file mode 100755 index 0000000..c0cbbed --- /dev/null +++ b/game.lisp @@ -0,0 +1,21 @@ +(show-mob (make-mob :x 0 :y 0 :image (filled-rect 5 420) :tags '(wall))) +(show-mob (make-mob :x 635 :y 0 :image (filled-rect 5 420) :tags '(wall))) +(show-mob (make-mob :x 0 :y 0 :image (filled-rect 640 5) :tags '(wall))) + +(show-mob (make-mob :x 280 :y 420 :image (filled-rect 80 20) :tags '(wall) + :logic (movement-with-cursors :xvel 200 :yvel 0))) + +(let ((xvel 100) (yvel -100)) + (show-mob (make-mob :x 300 :y 200 :image (filled-circle 7) + :logic (progn + (cond ((> y 480) (setq x 300 y 200 xvel 100 yvel -100)) + (t (let ((c (collision '(wall)))) + (cond ((null c) nil) + ((= c (neg (/ pi 2))) (setq yvel (neg (- yvel 10)))) + ((= c (/ pi 2)) (setq yvel (neg (+ yvel 10)))) + ((= c 0) (setq xvel (neg (+ xvel 10)))) + ((= c pi) (setq xvel (neg (- xvel 10)))))))) + (movement :xvel xvel :yvel yvel))))) + +(run-game) +(quit-game) diff --git a/game_GL.lisp b/game_GL.lisp new file mode 100755 index 0000000..d717a81 --- /dev/null +++ b/game_GL.lisp @@ -0,0 +1,68 @@ +(let ((rtri 0) (rquad 0)) + (defun game () + (glTranslatef -1.5 0 -10) + (glRotatef rtri 0 1 0) + (draw '((1 0 0) (0 1 0)) '((0 1 0) (-1 -1 1)) '((0 0 1) (1 -1 1))) + (draw '((1 0 0) (0 1 0)) '((0 0 1) (1 -1 1)) '((0 1 0) (1 -1 -1))) + (draw '((1 0 0) (0 1 0)) '((0 1 0) (1 -1 -1)) '((0 0 1) (-1 -1 -1))) + (draw '((1 0 0) (0 1 0)) '((0 0 1) (-1 -1 -1)) '((0 1 0) (-1 -1 1))) + + (glTranslatef 3 0 0) + (glRotatef rquad 1 0 0) + (draw-color '(0 1 0)) + (draw '(1 1 -1) '(-1 1 -1) '(-1 1 1) '(1 1 1)) + (draw-color '(1 0.5 0)) + (draw '(1 -1 1) '(-1 -1 1) '(-1 -1 -1) '(1 -1 -1)) + (draw-color '(1 0 0)) + (draw '(1 1 1) '(-1 1 1) '(-1 -1 1) '(1 -1 1)) + (draw-color '(1 1 0)) + (draw '(1 -1 -1) '(-1 -1 -1) '(-1 1 -1) '(1 1 -1)) + (draw-color '(0 0 1)) + (draw '(-1 1 1) '(-1 1 -1) '(-1 -1 -1) '(-1 -1 1)) + (draw-color '(1 0 1)) + (draw '(1 1 -1) '(1 1 1) '(1 -1 1) '(1 -1 -1)) + + (incf rtri 0.2) + (incf rquad -0.15))) + +(let ((rquad 0) (texture (load-texture "../nehe/lesson06/data/nehe.bmp"))) + (defun cube-texture () + (glTranslatef -1.5 0 -10) + (glRotatef rquad 0 1 0) + (draw-quad '(1 1 -1) '(-1 1 -1) '(-1 1 1) '(1 1 1) :texture texture) + (draw-quad '(1 -1 1) '(-1 -1 1) '(-1 -1 -1) '(1 -1 -1) :texture texture) + (draw-quad '(1 1 1) '(-1 1 1) '(-1 -1 1) '(1 -1 1) :texture texture) + (draw-quad '(1 -1 -1) '(-1 -1 -1) '(-1 1 -1) '(1 1 -1) :texture texture) + (draw-quad '(-1 1 1) '(-1 1 -1) '(-1 -1 -1) '(-1 -1 1) :texture texture) + (draw-quad '(1 1 -1) '(1 1 1) '(1 -1 1) '(1 -1 -1) :texture texture) + (incf rquad 0.2))) + +(let ((xrot 0) (yrot 0) (zrot 0) + (texture (load-texture "../nehe/lesson07/data/crate.bmp")) + (light (add-light :light '(1 1 1 1) :position '(0 0 2 1) :ambient '(0.5 0.5 0.5 1)))) + (defun quad () + (glLoadIdentity) + (glColor3f 1 1 1) + (glEnable GL_TEXTURE_2D) + (glTranslatef -2 0 -13) + (rotate xrot yrot zrot) + (draw-cube :size 1 :texture texture) + (incf xrot 0.3) + (incf yrot 0.2) + (incf zrot 0.4))) + +(let ((xrot 0) (yrot 0) (zrot 0) + (texture (load-texture "../nehe/lesson08/data/glass.bmp"))) + (defun quad2 () + (glLoadIdentity) + (glColor3f 1 1 1) + (glEnable GL_TEXTURE_2D) + (glTranslatef 2 0 -13) + (rotate xrot yrot zrot) + (draw-cube :size 1 :texture texture) + (incf xrot -0.3) + (incf yrot -0.2) + (incf zrot -0.4))) + +(run-game "GL Test" (quad) (quad2)) +(quit-game) diff --git a/game_test.lisp b/game_test.lisp new file mode 100755 index 0000000..280ef76 --- /dev/null +++ b/game_test.lisp @@ -0,0 +1,18 @@ +(show-mob (make-mob :x 0 :y 0 :image (filled-rect 5 420) :tags '(wall) + :logic (cond ((key 'up) (incf x 5)) + ((key 'down) (decf x 5))))) + +(show-mob (make-mob :x 635 :y 0 :image (filled-rect 5 420) :tags '(wall) + :logic (cond ((key 'up) (decf x 5)) + ((key 'down) (incf x 5))))) + +(let ((xvel 100) (yvel 0)) + (show-mob (make-mob :x 300 :y 200 :image (filled-circle 7) + :logic (progn + (cond ((key 'plus) (if (> xvel 0) (incf xvel 10) (decf xvel 10))) + ((key 'minus) (if (> xvel 0) (decf xvel 10) (incf xvel 10)))) + (cond ((collision '(wall)) (setq xvel (neg xvel)))) + (movement :xvel xvel :yvel yvel))))) + +(run-game) +(quit-game) diff --git a/hello_world.bmp b/hello_world.bmp new file mode 100644 index 0000000..321f7f1 Binary files /dev/null and b/hello_world.bmp differ diff --git a/high.wav b/high.wav new file mode 100644 index 0000000..4fa00d8 Binary files /dev/null and b/high.wav differ diff --git a/lazy.ttf b/lazy.ttf new file mode 100644 index 0000000..eb1000b Binary files /dev/null and b/lazy.ttf differ diff --git a/look.png b/look.png new file mode 100644 index 0000000..a25134a Binary files /dev/null and b/look.png differ diff --git a/low.wav b/low.wav new file mode 100644 index 0000000..ac177ad Binary files /dev/null and b/low.wav differ diff --git a/medium.wav b/medium.wav new file mode 100644 index 0000000..7df5898 Binary files /dev/null and b/medium.wav differ diff --git a/remoto.lisp b/remoto.lisp new file mode 100755 index 0000000..f0773e9 --- /dev/null +++ b/remoto.lisp @@ -0,0 +1,28 @@ +(clines "#include ") +(clines "#include ") + +(clines "#define inheap(pp) ((char *)(pp) < heap_end)") +(clines "static object pepe;") + +(defcfun "static object staticp (object array)" 0 + "if (inheap (array->st.st_self)) return Ct;" + "else return Cnil;") + +(defcfun "static void *eval_code (void *parameter)" 0 + "int t = time (NULL);" + "while (time (NULL) - t < 10);" + (eval pepe)) + +(defcfun "int run_thread (object code)" 0 + "pthread_t tid;" + "int ret;" + "pepe = code;" + "ret = pthread_create (&tid, NULL, eval_code, NULL);" + "return ret;") + +;(defentry eval-code (object) (void "eval_code")) +(defentry run-thread (object) (int "run_thread")) +(defentry staticp (object) (object "staticp")) + +(defun runt (code) + (and (staticp code) (run-thread code))) diff --git a/scratch.wav b/scratch.wav new file mode 100644 index 0000000..64b8e1b Binary files /dev/null and b/scratch.wav differ diff --git a/threads.lisp b/threads.lisp new file mode 100755 index 0000000..758af2c --- /dev/null +++ b/threads.lisp @@ -0,0 +1,36 @@ +(clines "#include ") + +(clines "#define inheap(pp) ((char *)(pp) < heap_end)") +(clines "static object code_for_eval_code;") + +(defcfun "static object staticp (object array)" 0 + "if (inheap (array->st.st_self)) return Ct;" + "else return Cnil;") + +(defcfun "static void *eval_code (void *parameter)" 0 + (eval code_for_eval_code)) + +(defcfun "int run_thread (object code)" 0 + "pthread_t tid;" + "int ret;" + "code_for_eval_code = code;" + "ret = pthread_create (&tid, NULL, eval_code, NULL);" + "return ret;") + +(defcfun "int runprocess (object code)" 0 + "int pid;" + "pid = fork ();" + "if (pid == 0) {" + "close (0);" + (eval code) + "exit (0);" + "} else {" + "return pid;" + "}") + +(defentry run-thread2 (object) (int "run_thread")) +(defentry staticp (object) (object "staticp")) +(defentry run-process (object) (int "runprocess")) + +(defun run-thread (code) + (and (staticp code) (run-thread2 code))) diff --git a/tmpx.c b/tmpx.c new file mode 100644 index 0000000..cb23dbf --- /dev/null +++ b/tmpx.c @@ -0,0 +1,16 @@ +struct SDL_Rect { + int x, y; + int w, h; +}; +struct SDL_Rect SSS1; + +main() { + +printf("("); +printf("(|SDL_Rect| "); +printf(" %d ",((char *)&SSS1.x - (char *)&SSS1)); +printf(" %d ",((char *)&SSS1.y - (char *)&SSS1)); +printf(" %d ",((char *)&SSS1.w - (char *)&SSS1)); +printf(" %d ",((char *)&SSS1.h - (char *)&SSS1)); +printf(")"); +printf(")"); ;} \ No newline at end of file