diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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/happlets.cabal b/happlets.cabal new file mode 100644 --- /dev/null +++ b/happlets.cabal @@ -0,0 +1,116 @@ +-- "happlets.cabal" build configuration for this project. +-- +-- Copyright (C) 2017-2018 Ramin Honary. +-- +-- "happlets" is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License (AGPL) +-- as published by the Free Software Foundation. +-- +-- "happlets" 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 Affero General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program (see the file called "LICENSE"). If not, see +-- . + +NAME: happlets +VERSION: 0.1.0.0 +AUTHOR: Ramin Honary +COPYRIGHT: (C) 2017-2018 Ramin Honary, all rights reserved. +MAINTAINER: RaminHAL9001@gmail.com +HOMEPAGE: https://github.com/RaminHAL9001/happlets +LICENSE: AGPL +LICENSE-FILE: LICENSE +BUILD-TYPE: Simple +CABAL-VERSION: >= 1.18 + +CATEGORY: GUI, Game +SYNOPSIS: "Haskell Applets" provides an event handler and a canvas for building simple GUI apps. + +DESCRIPTION: + . + This package is provides the Happlets API that is common to all Happlet + back-end provider libraries. Along with this package, it is necessary to + install a back-end library such as 'happlets-lib-gtk'. Currently Gtk+ + version 2 with a Cairo-based canvas is the only back-end available. Gtk+ + version 3, Xlib, SDL2, GLUT, and (possibly) Wayland back-ends are all + feasible and may be implemented in the future. + . + The goal of the Happlets project is to allow you to create very simple, + thread-safe applications that contain nothing more than a single window + with a drawing canvas that can respond to user input events, like mouse + clicks, key-presses, or frame animation events. The intention is to + create a minimal programming platform for small, single-purpose + graphical applications which simply displays some interactive graphic, + for example a plot of some data, or a simple game. Naturally, the + Happlet program can be arbitrarily complex, but it may be better to + consider other, FRP-based solutions if managing events becomes too + difficult. + . + A happlet back-end provider may provide additional widget API functions, + but using these APIs will result in your applet being dependent on the + specific back-end and will thus not be as portable as programming for + the "happlets" package alone. Happlets aims to achieve a balance between + being as minimal as possible, but still provide enough graphics drawing + primitives to be useful for the widest range of possible applications. + . + The Gtk+ v2 back-end provider can be downloaded from this link: + . + https://hackage.haskell.org/package/happlets-lib-gtk + . + +Library { + + HS-SOURCE-DIRS: src + DEFAULT-LANGUAGE: Haskell2010 + + GHC-OPTIONS: -Wall + -fno-warn-name-shadowing + -fno-warn-unused-do-bind + + EXPOSED-MODULES: + Happlets + Happlets.Config + Happlets.Draw + Happlets.Draw.Color + Happlets.Draw.SampCoord + Happlets.Draw.Text + Happlets.Draw.Types2D + Happlets.Event + Happlets.Initialize + Happlets.Provider + Happlets.GUI + + BUILD-DEPENDS: + bytestring >=0.10.0.0 && <1.0.0.0, + colour >=2.0.0 && <3.0.0, + containers >=0.5.5.0 && <=0.5.7.0, + fail >=4.7 && <5.0, + lens >=4.0.0.0 && <5.0.0.0, + linear >=1.20.0 && <2.0.0.0, + mtl >=2.2.0 && <=2.2.1, + semigroups >=0.16.0 && <0.19.0, + time >=1.4.0.0 && <=1.6.0.0, + text >=1.1.1.4 && <=2.0.0.0, + transformers >=0.1.1 && <0.5.0, + unordered-containers >=0.2.0.0 && <=0.3.0.0, + base >=4.7 && <4.9 + + DEFAULT-EXTENSIONS: + DeriveDataTypeable + DeriveFunctor + ExistentialQuantification + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GeneralizedNewtypeDeriving + ImplicitParams + LambdaCase + MultiParamTypeClasses + OverloadedStrings + RankNTypes + ScopedTypeVariables + StandaloneDeriving +} diff --git a/src/Happlets.hs b/src/Happlets.hs new file mode 100644 --- /dev/null +++ b/src/Happlets.hs @@ -0,0 +1,19 @@ +-- | This module re-exports all symbols from all modules in the "happlets" package. +module Happlets + ( module Happlets.Event + , module Happlets.Config + , module Happlets.Initialize + , module Happlets.GUI + , module Happlets.Draw.Color + , module Control.Monad.State + , module Control.Lens + ) where + +import Happlets.Event +import Happlets.Config +import Happlets.Initialize +import Happlets.GUI +import Happlets.Draw.Color + +import Control.Monad.State +import Control.Lens diff --git a/src/Happlets/Config.hs b/src/Happlets/Config.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Config.hs @@ -0,0 +1,154 @@ +-- | Methods and data types for working with the configuration. The Happlets configuration was +-- originally designed to be loaded from an INI file, but this functionality has since been moved +-- into a separate package. However many of the primitives for loading a configuration file from +-- disk are still provided here so that they are available universally to all Happlets back-end +-- providers. +module Happlets.Config + ( Config(..), + ConfigException(..), StrictFilePath, + sanitizeName, configErrorsOnLoad, clearConfigErrors, configFilePath, + registeredAppName, windowTitleBar, backgroundTransparency, backgroundGreyValue, + recommendWindowPosition, recommendWindowSize, animationFrameRate, + deleteWindowOnClose, quitOnWindowClose, decorateWindow, + ) + where + +import Control.Arrow +import Control.Exception +import Control.Lens + +import Data.Char (isPrint) +import Data.List (groupBy) +import qualified Data.Text as Strict + +---------------------------------------------------------------------------------------------------- + +type StrictFilePath = Strict.Text + +data ConfigException + = ConfigErrorIO StrictFilePath IOException + | ConfigErrorIniParseFail StrictFilePath Strict.Text + | ConfigErrorIniStructure StrictFilePath [Strict.Text] + | ConfigError Strict.Text + | ConfigMultipleErrors Strict.Text [ConfigException] + deriving (Eq, Show) + +instance Exception ConfigException where {} + +---------------------------------------------------------------------------------------------------- + +-- | This is the data structure used to configure various parameters in the Happlet back-end +-- provider. +data Config + = Config + { theConfigErrorsOnLoad :: [ConfigException] + , theConfigFilePath :: StrictFilePath + , theRegisteredAppName :: Strict.Text + , theWindowTitleBar :: Strict.Text + , theBackgroundTransparency :: (Maybe Double) + , theBackgroundGreyValue :: Double + , theRecommendWindowPosition :: (Int, Int) + , theRecommendWindowSize :: (Int, Int) + , theAnimationFrameRate :: Double + , willDecorateWindow :: Bool + , willQuitOnWindowClose :: Bool + , willDeleteWindowOnClose :: Bool + } + deriving (Eq, Show) + +-- | A string sanitizer for applied to strings assigned to 'registeredAppName' and 'windowTitleBar'. +sanitizeName :: Strict.Text -> Strict.Text +sanitizeName = let sp = ' ' in Strict.unpack >>> + takeWhile (\ c -> c /= '\n' && c /= '\r') >>> -- Take only the first line of text. + fmap (\ c -> if c == '\t' then sp else c) >>> -- Convert tabs to single-spaces. + filter isPrint >>> -- Filter out non-printing characters. + dropWhile (== sp) >>> -- Cut out leading spaces. + groupBy (\ a b -> a == sp && b == sp) >>> -- Group together spaces. + ( let loop stk = \ case + [] -> stk "" + [' ':_] -> stk "" -- Cut out trailing spaces. + (' ':_):more -> loop (stk . (sp : )) more -- Replace multi spaces with single spaces. + txt :more -> loop (stk . (txt ++)) more + in loop id ) >>> + Strict.pack + +-- | This is a list of errors that occurred while trying to load this configuration from the +-- filesystem. +configErrorsOnLoad :: Config -> [ConfigException] +configErrorsOnLoad = theConfigErrorsOnLoad + +-- | The configuration errors are stored into the 'Config' data structure. This function erases the +-- errors. +clearConfigErrors :: Config -> Config +clearConfigErrors c = c{ theConfigErrorsOnLoad = [] } + +-- | Reports the file path from which this config file was loaded, or a null string if this has not +-- been set. +configFilePath :: Config -> StrictFilePath +configFilePath = theConfigFilePath + +-- | Gtk+ apps can register your GHCi/Happlet process with the window manager under a specific name, +-- which you can specify here. Using this lens to set a null name will not result in an error but +-- the update will not occur. +registeredAppName :: Lens' Config Strict.Text +registeredAppName = lens theRegisteredAppName $ \ b -> sanitizeName >>> \ a -> + if Strict.null a then b else b{ theRegisteredAppName = sanitizeName a } + +-- | Most window managers depict a title bar above every window that displays a descriptive name of +-- the content of that window. Specify that name here. Using this lens to set a title name will not +-- result in an error but the update will not occur. +windowTitleBar :: Lens' Config Strict.Text +windowTitleBar = lens theWindowTitleBar $ \ b -> sanitizeName >>> \ a -> + if Strict.null a then b else b{ theWindowTitleBar = sanitizeName a } + +-- | When the window is created, setting this parameter to a non-'Prelude.Nothing' value determines +-- whether an image buffer in memory is allocated with enough memory for an alpha channel, so that +-- the window background can be made partially or fully transparent, and also determines what the +-- default transparency value is, with 0.0 being fully transparent, and 1.0 being fully +-- opaque. However not all window managers will allow for windows with alpha channels, so this may +-- not work depending on how the GUI of your opreating system has been configured. +backgroundTransparency :: Lens' Config (Maybe Double) +backgroundTransparency = lens theBackgroundTransparency $ \ b a -> b{ theBackgroundTransparency=a } + +-- | The default background "color", actually a gray value since no one in their right mind would +-- choose a non-grey solid color background for their applet. 0 is black, 1 is white, and everything +-- in between 0 and 1 are valid grey values. +backgroundGreyValue :: Lens' Config Double +backgroundGreyValue = lens theBackgroundGreyValue $ \ b a -> b{ theBackgroundGreyValue=a } + +-- | Recommend to the window manager where to place the window. Pass @(0,0)@ to let the window +-- manager choose. +recommendWindowPosition :: Lens' Config (Int, Int) +recommendWindowPosition = lens theRecommendWindowPosition $ \ b a -> b{ theRecommendWindowPosition=a } + +-- | Recommend to the window manager how large to make the window. Pass @(0,0)@ to let the +-- window manager choose. +recommendWindowSize :: Lens' Config (Int, Int) +recommendWindowSize = lens theRecommendWindowSize $ \ b a -> b{ theRecommendWindowSize=a } + +-- | Recommend the frame rate to use when installing animation event handlers. +animationFrameRate :: Lens' Config Double +animationFrameRate = lens theAnimationFrameRate $ \ b a -> b{ theAnimationFrameRate=a } + +-- | For window managers that allow windows to be created without a titlebar, close\/minimize\/hide +-- buttons, or other visible controls (on Linux systems, "reparenting" window managers will do +-- this), setting this value to 'Prelude.False' will tell the window manager to not draw these +-- decorations. Non-reparenting window managers like Xmonad are unable to draw a title bar, in which +-- case this parameter will have no effect, the Happlet window will behave as if this parameter is +-- always set to 'Prelude.True'. Other reparenting window managers may simply ignore this option, in +-- which case the Happlet window will behave as if this parameters is always set to 'Prelude.False'. +decorateWindow :: Lens' Config Bool +decorateWindow = lens willDecorateWindow $ \ b a -> b{ willDecorateWindow = a } + +-- | If the Happlet window is closed, halt the Gtk+ event loop, returning control to the @main@ +-- function. If the 'gtkLaunchEventLoop' is the final function called in @main@ the Haskell program +-- will end. +quitOnWindowClose :: Lens' Config Bool +quitOnWindowClose = lens willQuitOnWindowClose $ \ b a -> b{ willQuitOnWindowClose = a } + +-- | If the Happlet window is closed, the image buffer allocated for it should be +-- deleted. Otherwise, the Happlet window is simply made invisible when it is closed, and the image +-- buffer is not deleted. Of course, if 'quitOnWindowClose' is set to 'Prelude.True', the entire +-- program may quit even if this parameter is set to 'Prelude.False'. +deleteWindowOnClose :: Lens' Config Bool +deleteWindowOnClose = lens willDeleteWindowOnClose $ \ b a -> b{ willDeleteWindowOnClose = a } diff --git a/src/Happlets/Draw.hs b/src/Happlets/Draw.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Draw.hs @@ -0,0 +1,60 @@ +-- | This module re-exports the "Happlets.Draw.Color" and "Happlets.Draw.Types2D" modules, and also +-- provides the 'HappletDrawing' class, which is a minimalist set of drawing primitives functions +-- for updateing the graphics in a Happlet window. +-- +-- Future work on the Happlets project may result in the creation of a new package, perhaps called +-- @happlets-draw-ext@, which provides extended drawing primitives for a practical 2D graphics +-- library that can export to and import from SVG data, however no plans for such an extension have +-- been made at the time of this writing. +module Happlets.Draw + ( module Happlets.Draw.Color + , module Happlets.Draw.SampCoord + , module Happlets.Draw.Text + , module Happlets.Draw.Types2D + , Happlet2DGraphics(..), modifyPoint, + ) where + +import Happlets.Draw.Color +import Happlets.Draw.SampCoord +import Happlets.Draw.Text +import Happlets.Draw.Types2D + +import Control.Monad.IO.Class + +---------------------------------------------------------------------------------------------------- + +-- | This is a minimalist set of of drawing primitives functions for updating the graphics in a +-- Happlet window. This class must instantiate 'Control.Monad.Monad' and +-- 'Control.Monad.IO.Class.MonadIO' because it is expected to perform stateful updates to the +-- system, namely changing what graphics are displayed in a Happlet window. +-- +-- The @render@ data type instantiated here is expected to be the the same as the @render@ type +-- instantiated into the 'Happlets.GUI.HappletWindow' type class, which should allow Happlet +-- programmers to evaluate all of these functions using the 'Happlets.GUI.onView' function and +-- perform the expected update on the Happlet window. +class (Functor render, Applicative render, Monad render, MonadIO render) + => Happlet2DGraphics render where + -- | Set all pixels in the screen graphics to the same color value, deleting all graphics that + -- existed prior. + clearScreen :: FillColor -> render () + + -- | Draw a line on the canvas. + drawLine :: LineColor -> LineWidth -> Line2D RealApprox -> render () + + -- | Draw a sequence of lines from a list of points, from head-to-tail, on the canvas. Passing an + -- empty list should result in a no-op. Passing a list with a single point should paint the point. + drawPath :: LineColor -> LineWidth -> [Point2D RealApprox] -> render () + + -- | Draw a rectangle on the canvas. + drawRect :: LineColor -> LineWidth -> FillColor -> Rect2D RealApprox -> render () + + -- | Update a pixel value somewhere on the canvas. + setPoint :: Point2D RealApprox -> PackedRGBA32 -> render () + + -- | Read a pixel value somewhere on the canvas. Out-of-bounds indicies throw an exception. + getPoint :: Point2D RealApprox -> render PackedRGBA32 + +modifyPoint + :: (Monad render, Happlet2DGraphics render) + => Point2D RealApprox -> (PackedRGBA32 -> PackedRGBA32) -> render () +modifyPoint p f = getPoint p >>= setPoint p . f diff --git a/src/Happlets/Draw/Color.hs b/src/Happlets/Draw/Color.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Draw/Color.hs @@ -0,0 +1,214 @@ +-- | This module provides a basic color data type that can be used to build apps without needing to +-- include additional packages into your project. This module is not imported automatically when you +-- import the "Happlets" module, so if you would prefer to use a better alternative color data type +-- it is easier to do so. This module can be imported with the "Happlets.Draw" module. +module Happlets.Draw.Color + ( PackedRGBA32(..), FillColor, LineColor, + unpackRGBA32Color, packRGBA32Color, packRGBA32, unpackRGBA32, + quantizeColorChannel, unquantizeColorChannel, + -- * British Spellings + FillColour, LineColour, + unpackRGBA32Colour, packRGBA32Colour, quantizeColourChannel, unquantizeColourChannel, + -- * Fundamental Colors and Shades, + red, green, blue, cyan, magenta, yellow, white, black, grey, gray, light, dark, + -- * Color Channels + redChannel, greenChannel, blueChannel, alphaChannel, + ) where + +import Control.Arrow +import Control.Lens + +import Data.Bits +import Data.Char +import Data.Word + +import Numeric + +---------------------------------------------------------------------------------------------------- + +-- | For using a type name that describes how the 'PackedRGBA32' value is being used for. +type FillColor = PackedRGBA32 + +-- | For using a type name that describes how the 'PackedRGBA32' value is being used for. +type LineColor = PackedRGBA32 + +newtype PackedRGBA32 = PackedRGBA32{ unwrapPackedRGBA32 :: Word32 } + deriving Eq + +instance Show PackedRGBA32 where + showsPrec _ (PackedRGBA32 w) = (++) + ( case w of + w | w <= 0xF -> "#0000000" + w | w <= 0xFF -> "#000000" + w | w <= 0xFFF -> "#00000" + w | w <= 0xFFFF -> "#0000" + w | w <= 0xFFFFF -> "#000" + w | w <= 0xFFFFFF -> "#00" + w | w <= 0xFFFFFFF -> "#0" + _ -> "#" + ) . showHex w + +instance Read PackedRGBA32 where + readsPrec _ str = case str of + '#' : str -> do + (a, str) <- readHex str + let done str = (PackedRGBA32 a, str) + case str of + "" -> [done ""] + s:str | isSpace s -> [done $ dropWhile isSpace str] + _ -> [] + _ -> [] + +-- | This function evaluates 'unpackRGBA32' and then performs a 'unquantizeColorChannel' +-- computation on each channel, including the alpha channel. +unpackRGBA32Color :: PackedRGBA32 -> (Double, Double, Double, Double) +unpackRGBA32Color p = + let (r,g,b,a) = unpackRGBA32 p + un = unquantizeColorChannel + in (un r, un g, un b, un a) + +-- | This function evaluates 'qunatizeColorChannel' on each given 'Prelude.Double'-precision color +-- channel value, then evaluates 'packRGBA32' on the four resulting quantized values. +packRGBA32Color :: Double -> Double -> Double -> Double -> PackedRGBA32 +packRGBA32Color r g b a = packRGBA32 (q r) (q g) (q b) (q a) where + q = quantizeColorChannel + +-- | This function performs no transformation on the given 'Data.Word.Word8' values, they are simply +-- bit-packed into a 'Data.Word.Word32' data value by bit-shifting and the bitwise-OR operator. +packRGBA32 :: Word8 -> Word8 -> Word8 -> Word8 -> PackedRGBA32 +packRGBA32 r g b a = PackedRGBA32 $! sh r 24 .|. sh g 16 .|. sh b 8 .|. sh a 0 where + sh c s = shift (fromIntegral c) s + +-- | This is the inverse operation of 'packRGBA32'. +unpackRGBA32 :: PackedRGBA32 -> (Word8, Word8, Word8, Word8) +unpackRGBA32 (PackedRGBA32 w) = (unsh 24, unsh 16, unsh 8, unsh 0) where + unsh s = fromIntegral $! 0x000000FF .&. shift w (negate s) + +-- | This function takes a linear color value expressed as a 'Prelude-Double'-precision +-- floating-point value, clamps it to a value between 0 and 1, then computes the square-root on this +-- value, then compresses the square-root to a 'Data.Word.Word8' value (because the human eye is +-- more sensitive to changes in brigher colors than in darker colors). Use this function to convert +-- a linear double-precision color channel intensity value to a value that can be stored efficiently +-- in memory or some other digital computing medium. +quantizeColorChannel :: Double -> Word8 +quantizeColorChannel = + round . (* (realToFrac (maxBound::Word8) :: Double)) . sqrt . min 1.0 . max 0.0 + +-- | This is the inverse operation of 'quantizeColorChannel', the 'Data.Word.Word8' value is +-- converted to a 'Prelude.Double'-precision floating point value between the numbers 0 and 1, then +-- returns the square of this value. +unquantizeColorChannel :: Word8 -> Double +unquantizeColorChannel = (** 2.0) . (/ (realToFrac (maxBound :: Word8) :: Double)) . realToFrac + +---------------------------------------------------------------------------------------------------- + +-- | British spelling of 'FillColor' +type FillColour = FillColor + +-- | British spelling of 'LineColor' +type LineColour = LineColor + +-- | British spelling of 'unpackRGBA32Color' +unpackRGBA32Colour :: PackedRGBA32 -> (Double, Double, Double, Double) +unpackRGBA32Colour = unpackRGBA32Color + +-- | British spelling of 'packRGBA32Color' +packRGBA32Colour :: Double -> Double -> Double -> Double -> PackedRGBA32 +packRGBA32Colour = packRGBA32Color + +-- | British spelling of 'quantizeColorChannel' +quantizeColourChannel :: Double -> Word8 +quantizeColourChannel = quantizeColorChannel + +-- | British spelling of 'unquantizeColorChannel' +unquantizeColourChannel :: Word8 -> Double +unquantizeColourChannel = unquantizeColorChannel + +---------------------------------------------------------------------------------------------------- + +-- | +red :: PackedRGBA32 +red = PackedRGBA32 0xFF0000FF + +-- | +green :: PackedRGBA32 +green = PackedRGBA32 0x00FF00FF + +-- | +blue :: PackedRGBA32 +blue = PackedRGBA32 0x0000FFFF + +-- | +cyan :: PackedRGBA32 +cyan = PackedRGBA32 0x00FFFFFF + +-- | +magenta :: PackedRGBA32 +magenta = PackedRGBA32 0xFF00FFFF + +-- | +yellow :: PackedRGBA32 +yellow = PackedRGBA32 0xFFFF00FF + +-- | +white :: PackedRGBA32 +white = PackedRGBA32 0xFFFFFFFF + +-- | +black :: PackedRGBA32 +black = PackedRGBA32 0x000000FF + +-- | +grey :: PackedRGBA32 +grey = PackedRGBA32 0x808080FF + +-- | +gray :: PackedRGBA32 +gray = grey + +---------------------------------------------------------------------------------------------------- + +bitShiftColorChannelLens :: Int -> Lens' PackedRGBA32 Double +bitShiftColorChannelLens i = lens + (\ (PackedRGBA32 c) -> + unquantizeColorChannel $ fromIntegral $ shift (shift 0xFF i .&. c) (negate i) + ) + (\ (PackedRGBA32 c) a -> PackedRGBA32 $ (c .&. xor 0xFFFFFFFF (shift 0xFF i)) .|. + shift (fromIntegral $ quantizeColorChannel a) i + ) + +-- | A lens to change the linear (unquantized) alpha channel value without needing to unpack then +-- repack the 'PackedRGBA32' value. +alphaChannel :: Lens' PackedRGBA32 Double +alphaChannel = bitShiftColorChannelLens 0 + +-- | A lens to change the linear (unquantized) red channel value without needing to unpack then +-- repack the 'PackedRGBA32' value. +redChannel :: Lens' PackedRGBA32 Double +redChannel = bitShiftColorChannelLens 24 + +-- | A lens to change the linear (unquantized) green channel value without needing to unpack then +-- repack the 'PackedRGBA32' value. +greenChannel :: Lens' PackedRGBA32 Double +greenChannel = bitShiftColorChannelLens 16 + +-- | A lens to change the linear (unquantized) blue channel value without needing to unpack then +-- repack the 'PackedRGBA32' value. +blueChannel :: Lens' PackedRGBA32 Double +blueChannel = bitShiftColorChannelLens 8 + +-- | Shift the color toward white. For example @('light' 'red')@ may look like a "pink" +-- color. Please be aware that this is not necessarily the inverse function of 'dark' due to loss of +-- precision when packing the color channels. +light :: Double -> PackedRGBA32 -> PackedRGBA32 +light = min 1.0 . max 0.0 >>> \ p -> + unpackRGBA32Color >>> \ (r,g,b,a) -> + packRGBA32Color (p * (1 - r) + r) (p * (1 - g) + g) (p * (1 - b) + b) a + +-- | Shift the color toward black. For example @('dark' 'blue')@ may look like a "navy" color. +-- Please be aware that this is not necessarily the inverse function of 'light' due to loss of +-- precision when packing the color channels. +dark :: Double -> PackedRGBA32 -> PackedRGBA32 +dark = min 1.0 . max 0.0 >>> \ p -> + unpackRGBA32Color >>> \ (r,g,b,a) -> + packRGBA32Color (p * r) (p * g) (p * b) a diff --git a/src/Happlets/Draw/SampCoord.hs b/src/Happlets/Draw/SampCoord.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Draw/SampCoord.hs @@ -0,0 +1,34 @@ +-- | This is a primitive data type for representing screen sizes and points on a screen in discrete +-- using 'Data.Int.Int32' values. +module Happlets.Draw.SampCoord where + +import Data.Int + +import Linear.V2 + +---------------------------------------------------------------------------------------------------- + +-- | A sample coordinate: this is a value that is used to count some integral number of units along +-- a 1-dimensional axis of some scan line, for example pixels along the edge of a view screen or +-- canvas. Alone, these elements can represent the amount of time (measured in the units of time +-- samples) of an audio signal. A 'Linear.V2.V2' pair's of 'PixCoords' can specify a 2D point on a +-- screen or canvas, 'Linear.V3.V3' triples of 'PixCoords' can specify a 3D point in a voxel space. +newtype SampCoord = SampCoord Int32 + deriving (Eq, Ord, Show, Read, Enum, Num, Integral, Real) + +-- | A pair of 'SampCoord' indicating the location of a pixel in a raster image. +type PixCoord = V2 SampCoord + +-- | A pair of 'SampCoord' values indicating the size of a rectangle of pixels. +type PixSize = V2 SampCoord + +sampCoord :: Integral i => i -> SampCoord +sampCoord = SampCoord . fromIntegral + +-- | This is a simple type tag used to indicate the difference between a source and target image, +-- for operations like blitting. +type Source image = image + +-- | This is a simple type tag used to indicate the difference between a source and target image, +-- for operations like blitting. +type Target image = image diff --git a/src/Happlets/Draw/Text.hs b/src/Happlets/Draw/Text.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Draw/Text.hs @@ -0,0 +1,74 @@ +-- | This module provides an extended API for rendering text into a Happlet window. +module Happlets.Draw.Text + ( SelectFont, FontExtents(..), TextExtents2D(..), HappletsDrawText(..), + ) where + +import Happlets.Draw.Types2D +import Happlets.Draw.Color + +import Control.Monad.IO.Class + +import qualified Data.Text as Strict + +---------------------------------------------------------------------------------------------------- + +-- | Fonts should be selected with descriptive strings like "Monospace" or "Arial Italic" or +-- "Helvetica Bold". Font sizes are passed as a 'Happlets.Draw.Types2D.RealApprox' parameter. +type SelectFont = Strict.Text + +-- | Contains information about how to align a font in a window. If you construct a command line +-- interface with a monospace font, it should be possible to use the 'fontExtentsXadvance' and +-- 'fontExtentsYadvance' to compute which text character in the window is under the mouse if a mouse +-- coordinate is given. +data FontExtents font + = FontExtents + { fontExtentsIdentifier :: font + , fontExtentsAscent :: RealApprox + , fontExtentsDescent :: RealApprox + , fontExtentsHeight :: RealApprox + , fontExtentsMaxXadvance :: RealApprox + , fontExtentsMaxYadvance :: RealApprox + } + deriving (Eq, Ord, Show, Read) + +-- | A data structure containing informaion on rendered text. +data TextExtents2D + = TextExtents2D + { textFontSelector :: !SelectFont + -- ^ A valid font name. + , textStartPoint :: !(Point2D RealApprox) + -- ^ The point at which to draw the text in order for the 'textBoundingBox' below is to be + -- realized. + , textBoundingBox :: !(Rect2D RealApprox) + -- ^ The minimum bounding box that contains the visual representation of the text. + , textToDraw :: !Strict.Text + } + deriving Eq + +-- | This class must instantiate 'Control.Monad.Monad' and 'Control.Monad.IO.Class.MonadIO' because +-- it is expected to perform stateful updates to the system, namely changing what graphics are +-- displayed in a Happlet window. +-- +-- The @render@ data type instantiated here is expected to be the the same as the @render@ type +-- instantiated into the 'Happlets.GUI.HappletWindow' type class, which should allow Happlet +-- programmers to evaluate all of these functions using the 'Happlets.GUI.onView' function and +-- perform the expected update on the Happlet window. +class (Functor render, Applicative render, Monad render, MonadIO render, Show font) + => HappletsDrawText render font | font -> render where + -- | Obtain a list of fonts available to this @canvas@. + listFonts :: render [font] + + -- | Select a font using a string descriptor of the font. If the selection is successful, return + -- the new 'FontExtents' information. If the font could not be selected, returns + -- 'Prelude.Nothing'. + selectFont :: SelectFont -> render (Maybe (FontExtents font)) + + -- | Obtain general information about the selected font. + fontExtents :: render (FontExtents font) + + -- | Compute the 'TextExtents2D' data structure for this canvas for a given font and text. + textExtents :: Point2D RealApprox -> Strict.Text -> render TextExtents2D + + -- | Draw text on the canvas. The 'LineColor' selects the text color, and the 'FillColor' selects + -- the background color. + drawText :: FillColor -> LineColor -> Point2D RealApprox -> Strict.Text -> render TextExtents2D diff --git a/src/Happlets/Draw/Types2D.hs b/src/Happlets/Draw/Types2D.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Draw/Types2D.hs @@ -0,0 +1,174 @@ +-- | This module provides a bare minimum of 2D drawing primitives for drawing text, lines, and +-- rectangles, along with setting foreground and background colors, and fill and stroke colors. Also +-- provided are functions for determining if points (for example, mouse cursor locations) lie within +-- a rectangular region. These primitives, along with the functionality in the +-- 'Happlets.GUI.CanBufferImages' type class to load from disk and blit to screen bitmap images, +-- should be enough to construct minimalist user interfaces. +module Happlets.Draw.Types2D + ( RealApprox(..), realApprox, + Point2D(..), point2D, pointX, pointY, pointXY, + Line2D(..), line2D, line2DHead, line2DTail, line2DPoints, + Rect2D(..), rect2D, rect2DHead, rect2DTail, pointInRect2D, rect2DPoints, + rect2DMinBoundOf, rect2DIntersect, rect2DDiagonal, + MaybeSingleton2D(..), HasBoundingBox(..), + LineWidth, + ) where + +import Control.Lens +import Control.Monad + +import Data.Semigroup + +import Linear.V2 + +---------------------------------------------------------------------------------------------------- + +-- | This type represents an approximation of a 'Prelude.Real' number. +newtype RealApprox = RealApprox { unwrapRealApprox :: Double } + deriving (Eq, Ord, Enum, Num, Real, Fractional, Floating, RealFrac) + +instance Show RealApprox where { show = show . unwrapRealApprox; } + +instance Read RealApprox where + readsPrec p str = readsPrec p str >>= \ (n, rem) -> [(RealApprox n, rem)] + +-- | This type represents a single point. +newtype Point2D n = Point2D (V2 n) + deriving (Eq, Functor) + +instance Num n => Semigroup (Point2D n) where + (Point2D(V2 xa ya)) <> (Point2D(V2 xb yb)) = Point2D $ V2 (xa + xb) (ya + yb) + +instance Num n => Monoid (Point2D n) where + mempty = Point2D $ V2 0 0 + mappend = (<>) + +-- | This type represents a line segment consisting of two points. +data Line2D n = Line2D !(Point2D n) !(Point2D n) + deriving (Eq, Functor) + +-- | This type represents a rectangle bounded by two where all sides of the rectangle points are +-- parallel to the orthogonal basis vectors of the drawing plane. This data type instantiates +-- 'Data.Semigroup.Semigroup' such that the smallest possible rectangle that can contain both +-- rectangles, no matter how far apart they are, is returned. +data Rect2D n = Rect2D !(Point2D n) !(Point2D n) + deriving (Eq, Functor) + +instance Ord n => Semigroup (Rect2D n) where { (<>) = rect2DMinBoundOf; } + +-- | An initializing 'Point2D' where 'pointX' and 'pointY' are both zero. +point2D :: Num n => Point2D n +point2D = Point2D $ V2 0 0 + +realApprox :: Iso' RealApprox Double +realApprox = iso unwrapRealApprox RealApprox + +-- | The X coordinate of a 'Point2D', a value expressing some distance along the horizontal axis. +pointX :: Lens' (Point2D n) n +pointX = lens (\ (Point2D(V2 x _)) -> x) $ \ (Point2D(V2 _ y)) x -> Point2D (V2 x y) + +-- | The X coordinate of a 'Point2D', a value expressing some distance along the horizontal axis. +pointY :: Lens' (Point2D n) n +pointY = lens (\ (Point2D(V2 _ y)) -> y) $ \ (Point2D(V2 x _)) y -> Point2D (V2 x y) + +-- | Expresses the point as a tuple of @(x, y)@ coordinates +pointXY :: Iso' (Point2D n) (n, n) +pointXY = iso (\ (Point2D (V2 x y)) -> (x, y)) (\ (x,y) -> Point2D $ V2 x y) + +-- | An initializing 'Line2D' where 'lineHead' and 'lineTail' are both the zero 'point2D'. +line2D :: Num n => Line2D n +line2D = Line2D point2D point2D + +-- | The point at which drawing of a line segment begins. +line2DHead :: Lens' (Line2D n) (Point2D n) +line2DHead = lens (\ (Line2D a _) -> a) $ \ (Line2D _ b) a -> Line2D a b + +-- | The point at which drawing of a line segment ends. +line2DTail :: Lens' (Line2D n) (Point2D n) +line2DTail = lens (\ (Line2D _ b) -> b) $ \ (Line2D a _) b -> Line2D a b + +-- | Expresses a 'Line2D' as a tuple of 'Point2D' values. +line2DPoints :: Iso' (Line2D n) (Point2D n, Point2D n) +line2DPoints = iso (\ (Line2D a b) -> (a, b)) (\ (a,b) -> Line2D a b) + +-- | An initializing 'Line2D' where the 'rectLower' and 'rectUpper' values are the zero 'point2D'. +rect2D :: Num n => Rect2D n +rect2D = Rect2D point2D point2D + +-- | The point at which drawing of a bounding rectangle begins. +rect2DHead :: Lens' (Rect2D n) (Point2D n) +rect2DHead = lens (\ (Rect2D a _) -> a) $ \ (Rect2D a _) b -> Rect2D a b + +-- | The point at which drawing of a bounding rectangle ends. +rect2DTail :: Lens' (Rect2D n) (Point2D n) +rect2DTail = lens (\ (Rect2D _ b) -> b) $ \ (Rect2D _ b) a -> Rect2D a b + +-- | Expresses a 'Rect2D' as a tuple of 'Point2D' values. +rect2DPoints :: Iso' (Rect2D n) (Point2D n, Point2D n) +rect2DPoints = iso (\ (Rect2D a b) -> (a, b)) (\ (a,b) -> Rect2D a b) + +-- | Test if the given 'Point2D' lies within, or on the bounding box of, the given 'Rect2D'. +pointInRect2D :: Ord n => Point2D n -> Rect2D n -> Bool +pointInRect2D (Point2D(V2 x y)) (Rect2D(Point2D(V2 xa ya))(Point2D(V2 xb yb))) = + let xlo = min xa xb + ylo = min ya yb + xhi = max xa xb + yhi = max ya yb + between a b c = a <= b && b <= c + in between xlo x xhi && between ylo y yhi + +-- | Computes the smallest possible rectangle that can contain both rectangles, no matter how far +-- apart they are. +rect2DMinBoundOf :: Ord n => Rect2D n -> Rect2D n -> Rect2D n +rect2DMinBoundOf + (Rect2D(Point2D(V2 xa ya))(Point2D(V2 xb yb))) + (Rect2D(Point2D(V2 xc yc))(Point2D(V2 xd yd))) = + let f4 comp a b c d = comp a $ comp b $ comp c d in Rect2D + (Point2D (V2 (f4 min xa xb xc xd) (f4 min ya yb yc yd))) + (Point2D (V2 (f4 max xa xb xc xd) (f4 max ya yb yc yd))) + +-- | Returns an intersection of two 'Rect2D's if the two 'Rect2D's overlap. +rect2DIntersect :: Ord n => Rect2D n -> Rect2D n -> Maybe (Rect2D n) +rect2DIntersect + (Rect2D(Point2D(V2 xa ya))(Point2D(V2 xb yb))) + (Rect2D(Point2D(V2 xc yc))(Point2D(V2 xd yd))) = do + (xa, xb) <- pure (min xa xb, max xa xb) + (ya, yb) <- pure (min ya yb, max ya yb) + (xc, xd) <- pure (min xc xd, max xc xd) + (yc, yd) <- pure (min yc yd, max yc yd) + let between a b c = a <= b && b <= c + let isect a b c d = guard (between a c b || between c b d) >> return (min xa xc, max xb xd) + (xlo, xhi) <- isect xa xb xc xd + (ylo, yhi) <- isect ya yb yc yd + return $ Rect2D (Point2D (V2 xlo ylo)) (Point2D (V2 xhi yhi)) + +-- | Convert a 'Rect2D' to a 'Line2D' +rect2DDiagonal :: Rect2D n -> Line2D n +rect2DDiagonal (Rect2D a b) = Line2D a b + +---------------------------------------------------------------------------------------------------- + +-- | A class providing 'isSingleton2D' which whether a 'Rect2D' or a 'Line2D' are constructed from +-- two identical points. There are theoretically an infinite number of singletons in the 2D +-- plane. The 'line2D' and 'rect2D' constructors are singletons as they both start and end at the +-- zero 'point2D' value. +class MaybeSingleton2D a where { isSingleton2D :: Eq n => a n -> Maybe (Point2D n); } + +instance MaybeSingleton2D Line2D where + isSingleton2D (Line2D a b) = if a == b then Just a else Nothing + +instance MaybeSingleton2D Rect2D where + isSingleton2D (Rect2D a b) = if a == b then Just a else Nothing + +---------------------------------------------------------------------------------------------------- + +class HasBoundingBox a where { theBoundingBox :: a n -> Rect2D n; } + +instance HasBoundingBox Rect2D where { theBoundingBox = id; } + +instance HasBoundingBox Line2D where { theBoundingBox (Line2D a b) = Rect2D a b; } + +---------------------------------------------------------------------------------------------------- + +-- | Values of this type are used when drawing lines or borders around rectangls. +type LineWidth = RealApprox diff --git a/src/Happlets/Event.hs b/src/Happlets/Event.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Event.hs @@ -0,0 +1,244 @@ +-- | The Happlets library can be used with a few different back-end GUI libraries. This module +-- intends to provide an absraction over the most common similarities between all of these GUI +-- libraries. This allows developers using the Happlets library to rely mostly on the symbols +-- provided in this module to program Happlets in a platform-independent way. +module Happlets.Event where + +import Happlets.Draw.SampCoord + +import Control.Monad + +import Data.Bits +import qualified Data.ByteString as Strict +import Data.Time.Clock +import Data.Typeable +import Data.Word + +---------------------------------------------------------------------------------------------------- + +-- | Animations are ultimately a sequence of discrete events, so time is tracked by a 'Prelude.Int' +-- value. Internally to your document @model@, you can keep track of time using a 'Prelude.Double' +-- or 'Data.Time.Clock.UTCTime', but you must instantiate the @model@ into the +-- 'Controller.Wire.Session.HasTime' class such that it converts this time value to an +-- 'Prelude.Int'. +type AnimationMoment = NominalDiffTime + +---------------------------------------------------------------------------------------------------- + +-- | A wrapper type to isolate values that indicate some distance from the left of some window or +-- view screen. +newtype FromLeft num = FromLeft { unwrapFfromLeft :: num } + deriving (Eq, Ord, Show, Read, Typeable, Num, Enum, Bounded) + +-- | A wrapper type to isolate values that indicate some distance from the top of some window or +-- view screen. +newtype FromTop num = FromTop { unwrapFromTop :: num } + deriving (Eq, Ord, Show, Read, Typeable, Num, Enum, Bounded) + +-- | A wrapper type to isolate values that indicate some left-to-right width value of objects +-- visible in a window or on a view screen. +newtype Width num = Width { unwrapWidth :: num } + deriving (Eq, Ord, Show, Read, Typeable, Num, Enum, Bounded) + +-- | A wrapper type to isolate values that indicate some top-to-bottom width value of objects +-- visible in a window or on a view screen. +newtype Height num = Height { unwrapHeight :: num } + deriving (Eq, Ord, Show, Read, Typeable, Num, Enum, Bounded) + +---------------------------------------------------------------------------------------------------- + +-- | Used to encode keyboard event types in a platform independent way. +data Keyboard + = Keyboard !Pressed !ModifierBits !KeyPoint + -- ^ Happlet back-ends should try to encode keyboard events using this constructor. + | RawKey !Pressed !ModifierBits !Word32 + -- ^ For back-ends that cannot encode keyboard events using the above, use this as a fall-back. + deriving (Eq, Show, Typeable) + +-- | True if the keyboard or mouse event was a key/button-down or "pressed" event, False if the event was +-- key/button-up or "released" event. +type Pressed = Bool + +-- | Keyboard event modifier bits. This is just an abstract, opaque, intermediate type used to +-- encode information from various Happlet back-ends. +data ModifierBits = ModifierBits Word32 + deriving (Eq, Ord, Bounded, Typeable) + +instance Show ModifierBits where + show = show . unpackModifiers + +-- | Keyboard event information. This is just an abstract intermediate type used to encode +-- information from various Happlet back-ends in a platform-independent way. It has a small list of +-- symbols found on typical commercial keyboards. +data KeyPoint + = CharKey !Char + | FuncKey !Int + -- ^ Arbitrary function keys. Typical keybords typically have keys labeled "F1" through "F12". + | UpArrowKey + | DownArrowKey + | LeftArrowKey + | RighArrowKey + | TabKey + | EnterKey + | EscapeKey + | BackSpaceKey + | DeleteKey + | HomeKey + | EndKey + | PageUpKey + | PageDownKey + | InsertKey + | PuaseKey + | SymbolKey Strict.ByteString + -- ^ For keys not included in this list. This will typically be the logical name mapped to a raw + -- keyboard point by the operating system. + deriving (Eq, Show, Typeable) + +-- | Typical modifier keys provided by most GUI back-ends, platform-independent. These values are +-- extracted from the 'ModifierBits' bit field +data ModifierTag + = Shift + | CapsLock + | LeftShift + | RightShift + | Ctrl + | LeftCtrl + | RightCtrl + | Alt1 + | LeftAlt1 + | RightAlt1 + | Alt2 + | LeftAlt2 + | RightAlt2 + | Super1 + | LeftSuper1 + | RightSuper1 + | Super2 + | LeftSuper2 + | RightSuper2 + deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable) + +noModifiers :: ModifierBits +noModifiers = ModifierBits 0 + +packModifiers :: [ModifierTag] -> ModifierBits +packModifiers = ModifierBits . (foldl (.|.) 0) . fmap (shift 1 . fromEnum) + +unpackModifiers :: ModifierBits -> [ModifierTag] +unpackModifiers (ModifierBits bits) = [minBound .. maxBound] >>= \ tag -> + guard (shift 1 (fromEnum tag) .&. bits /= 0) >> [tag] + +isAlt1 :: ModifierTag -> Bool +isAlt1 = \ case + Alt1 -> True + LeftAlt1 -> True + RightAlt1 -> True + _ -> False + +isAlt2 :: ModifierTag -> Bool +isAlt2 = \ case + Alt2 -> True + LeftAlt2 -> True + RightAlt2 -> True + _ -> False + +isAlt :: ModifierTag -> Bool +isAlt tag = isAlt1 tag || isAlt2 tag + +isCtrl :: ModifierTag -> Bool +isCtrl = \ case + Ctrl -> True + LeftCtrl -> True + RightCtrl -> True + _ -> False + +isShift :: ModifierTag -> Bool +isShift = \ case + Shift -> True + LeftShift -> True + RightShift -> True + _ -> False + +isSuper1 :: ModifierTag -> Bool +isSuper1 = \ case + Super1 -> True + LeftSuper1 -> True + RightSuper1 -> True + _ -> False + +isSuper2 :: ModifierTag -> Bool +isSuper2 = \ case + Super2 -> True + LeftSuper2 -> True + RightSuper2 -> True + _ -> False + +isSuper :: ModifierTag -> Bool +isSuper tag = isSuper1 tag || isSuper2 tag + +---------------------------------------------------------------------------------------------------- + +type InputDeviceId = Strict.ByteString + +-- | An abstraction for mouse events. Includes whether a button was pressed or released, which +-- keyboard keys were pressed when the button was pressed, which buttons were pressed. An +-- 'InputDeviceId' is also included in the event information in the case that there are multiple +-- mouse devices provided by the back-end, especially for two-player games. +data Mouse + = Mouse !InputDeviceId !Pressed !ModifierBits !MouseButton !PixCoord + deriving (Eq, Ord, Show, Typeable) + +data MouseButton + = MotionOnly -- ^ indicates no button is pressed but there is still a mouse motion event + | LeftClick -- ^ this could also map to a track-pad tap event + | RightClick -- ^ this could also map to a track-pad hold event + | MiddleClick -- ^ this could also map to a track-pad double-tap event + | SideClick -- ^ some mouses have four buttons + | VWheelClick -- ^ the vertical scroller wheel was clicked + | HWheelClick -- ^ the horizontal scroller wheel was clicked + deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable) + +---------------------------------------------------------------------------------------------------- + +-- | Force feedback intensity, for systems which provided this functionality. +type FFIntensity = Double + +-- | Force feedback duration in seconds. +type FFDuration = NominalDiffTime + +-- | Not all Happlet back-end providers will make use of this event type. +-- +-- This could be a track-pad or a joy-stick/joy-pad continuous signal, it usually encodes pinches, +-- swipe velocities, and/or rotations. +-- +-- Really, this type is a catch-all for various other input devices that might be provided by a +-- Happlets back-end. On 64-bit systems, this data point contains 6 full 64-bit (a total of 48 byte) +-- values all passed at once, along with a device ID so it is obviously not the most efficient way +-- of doing reactive programming. +-- +-- It is expceted that lots and lots of events of this type will be generated if it should be +-- provided and installed by a Happlet front-end programmer, and it is expected that perhaps many of +-- the events generated will be thrown away immediately. The 'InputDeviceId' type is provided to +-- mitigate this problem, so when using the 'Happlets.GUI.trackPadEvents' function, you can select +-- which devices from which you want to receive events and reduce the total number of events your +-- Happlet receives. +-- +-- That said, it is still best for back-end providers to provide a 'Mouse' event handler instead, +-- and for front-end Happlet developers to use all 'Mouse' event handlers available to you. +data Trackpad + = Trackpad + { padDeviceID :: !InputDeviceId + -- ^ This is a logical identifier for a trackpad device provided by the back-end. Names may + -- include "raw-trackpad", "player1", "player2", "raw-mouse", "stylus", or "touchscreen". It + -- is entirely platform/back-end dependent what logical 'TrackpadDeviceID's are available, so + -- refer to the back-end provider documentation for how to use this. + , padPinch :: !Double -- ^ Negative value for pinch-in, positive value for pinch-out. + , padTwist :: !Double -- ^ Twisting angle delta in radians. + , padPressure :: !Double + -- ^ How much force is an end-user applying to the device. + , padJoystickForwardLean :: !Double + -- ^ forward-lean angle in radians (accellerometer or joystick value) + , padJoystickSidewaysLean :: !Double + -- ^ left-right lean angle in radians (accellerometer or joystick value) + } + deriving (Eq, Show, Read, Typeable) diff --git a/src/Happlets/GUI.hs b/src/Happlets/GUI.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/GUI.hs @@ -0,0 +1,490 @@ +-- | This module defines the applet data type 'Happlet', and a function type 'GUI'. These two types +-- define what a Happlet is. When writting a Happlet program, you first define the @model@ data type +-- that your 'Happlet' will view and control, and then you define a variety of GUI functions which +-- manipulate the @model@ and then redraw the window in response to events. The 'GUI' function type +-- is the Happlets equivalent of the @IO@ function type. +-- +-- The @model@ is stored into the 'Happlet' and can then be attached to a window using the +-- 'Happlets.Initialize.windowAttach' function in the "Happlets.Initialize" module. When attaching a +-- 'Happlet' to a window, it is also necessary to provide an initial 'GUI' function which will be +-- used to install other 'GUI' functions to be used as event handlers. +-- +-- The "Happlets.Event" module provides a consistent API for all back-end +-- 'Happlets.Provider.Provider's, but the subset of which event data types that your 'Happlet' +-- program will be able to respond to depends on the back-end "Happlets.Provider" you are using and +-- which type classes the @window@ type instantiates. The type classes that provide the API +-- functions for installing 'GUI' event handlers include: +-- +-- * 'Managed' +-- * 'CanResize' +-- * 'CanAnimate' +-- * 'CanMouse' +-- * 'CanKeyboard' +-- * 'CanTrackpad' +-- * 'CanForceFeedback' +-- +-- These type classes provide the functions that allow you to install 'GUI' functions as event +-- handlers into your 'Happlet' when the 'Happlet' is attached to the @window@ using the +-- 'Happlets.Initialize.windowAttach' function. You could also think of this as the functions which +-- allow your 'Happlet' to subscribe to certain event channels. +-- +-- Once you have created a window and attached a happlet to it (see +-- 'Happlets.Initialize.windowAttach' in the "Happlets.Initialize" module), and end-users use the +-- 'Happlet', events come into your 'Happlet' program triggering the 'GUI' functions which can alter +-- the @model@ data stored in the 'Happlet' using the "Control.Monad.State.Class" functions +-- 'Control.Monad.State.Class.get', 'Control.Monad.State.Class.put', +-- 'Control.Monad.State.Class.modify', and the 'Control.Monad.State.Class.state' functions. However +-- the 'getModel', 'putModel', and 'modifyModel' functions are also provided in this module which +-- are 'GUI'-specific versions of the "Contorol.Monad.State.Class" functions. +-- +-- GUI functions update the window using the 'onView' function which evaluates a screen updating +-- function specific to the back-end 'Happlets.Provider.Provider' as defined by the 'HappletWindow' +-- type class. +module Happlets.GUI + ( -- * The Happlet Data Type + Happlet, HappletWindow(..), Display(..), + + -- * The GUI Function Type + GUI, disable, failGUI, getModel, getSubModel, putModel, modifyModel, + + -- * Installing Event Handlers + -- $InstallingEventHandlers + Managed(..), + CanResize(..), + CanAnimate(..), + CanMouse(..), MouseEventPattern(..), + CanKeyboard(..), + CanTrackpad(..), + + -- * Other Capabilities + -- $OtherCapabilities + CanBufferImages(..), + CanForceFeedback(..), + DeviceHandler(..), unrecognizedInputDevices, failUnrecognizedInputDevices, + + -- * Low-level details + -- $LowLevel_Details + GUIState(..), GUIContinue(..), + guiModel, guiWindow, guiIsLive, evalGUI, + makeHapplet, onHapplet, peekModel, sameHapplet, + getGUIState, putGUIState, askHapplet, + + ) where + +import Prelude hiding ((.), id) + +import Happlets.Event +import Happlets.Draw.SampCoord + +import Control.Arrow +import Control.Category +import Control.Concurrent.MVar +import Control.Lens +import Control.Monad.Cont +import qualified Control.Monad.Fail as Monad +import Control.Monad.Reader +import Control.Monad.State + +import Data.Semigroup +import Data.Typeable + +import System.IO.Unsafe (unsafePerformIO) -- used for generating unique Happlet IDs. + +---------------------------------------------------------------------------------------------------- + +-- | This is a handle containing the current @model@ state of the 'Happlet'. It is constructed with +-- 'makeHapplet', but it is better to use 'Happlets.Initialize.makeHapplet' in the +-- "Happlets.Initialize" module in order to construct a 'Happlet' and associate it with a @window@ +-- in a single step. +data Happlet model = Happlet { happletId :: Int, happletMVar :: MVar model } + deriving (Eq, Typeable) + +happletIdGen :: MVar Int +happletIdGen = unsafePerformIO $ newMVar minBound +{-# NOINLINE happletIdGen #-} + +-- | It is possible to switch which 'Happlet' is attached to a window, and the window need not +-- attach to a window with a 'Happlet' of the same type as was attached before, the type may +-- switch. However just because the type could switch doesn't necessarily mean a careless 'Happlet' +-- programmer will ask the window to from the current happlet to itself. Since switching occurs +-- while the 'Happlet' is locked, doing this could result in a deadlock. So a method of being able +-- to tell whether two happlets are exactly the same at runtime has been devised, so that a simple +-- test can be performed to see if the window is being asked to re-attach from a 'Happlet' to the +-- same 'Happlet'. +sameHapplet :: Happlet a -> Happlet b -> Bool +sameHapplet a b = happletId a == happletId b + +-- | Construct a new 'Happlet'. The given initial 'Happlets.GUI.GUI' function is stored with the +-- 'Happlet' value itself, it is not stored in a reference. +makeHapplet :: model -> IO (Happlet model) +makeHapplet mod = do + mvar <- newMVar mod + happId <- modifyMVar happletIdGen $ return . (id &&& id) . (+ 1) + return Happlet{ happletId = happId, happletMVar = mvar } + +-- | Lock the 'Happlet' and perform an IO function on the content of it. +onHapplet :: Happlet model -> (model -> IO (a, model)) -> IO (a, model) +onHapplet (Happlet{happletMVar=mvar}) f = modifyMVar mvar $ + liftM (\ (a, model) -> (model, (a, model))) . f + +-- | Create a copy of the @model@ contained within the 'Happlet' from the current thread. Since this +-- @model@ is always being updated by various other threads, the value returned will only be a +-- snapshot of the @model@ at a particular point in time. +-- +-- For the most part, a @model@ is only useful to the various 'Happlets.GUI.GUI' threads that run in +-- response to input events, but if it is necessary to view a snapshot of the @model@ from outside +-- of the event 'Happlet.GUI.GUI' proper, this is the function to use. +peekModel :: Happlet model -> IO model +peekModel (Happlet{happletMVar=mvar}) = readMVar mvar + +---------------------------------------------------------------------------------------------------- + +-- | All Happlet back-end 'Happlets.Provider.Provider's must instantiate this type class at the very +-- least. +class HappletWindow window render | window -> render where + + -- | Similar to 'doWindowNewHapplet', except places an existing 'Happlet' into the @window@, + -- removing the previous 'Happlet'. This is effectivel a context switch that occurs within a + -- single @window@. This function disables all event handlers, then evaluates the given 'GUI' + -- function which should install new event handlers. This function then evaluates to 'disable', so + -- any line of code in the @do@ block written after this function is called will never execute. + windowChangeHapplet + :: forall newmodel oldmodel . Happlet newmodel + -> (PixSize -> GUI window newmodel ()) + -> GUI window oldmodel () + + -- | Construct a 'GUI' function which evaluates a @render@ function that updates the image of the + -- @window@. + onView :: forall model a . (PixSize -> render a) -> GUI window model a + +-- | This is a type class similar to the 'Prelude.Show' class, except it displays to the 'GUI'. +class Display drawable render | drawable -> render where + display :: HappletWindow window render => drawable -> GUI window model () + +---------------------------------------------------------------------------------------------------- + +newtype GUI window model a + = GUI + { unwrapGUI :: + ( ReaderT (Happlet model) + ( ContT (GUIState window model) (StateT (GUIState window model) IO)) + a + ) + } + deriving (Functor, Applicative, Monad, MonadIO) + +-- | A data type indicating the condition of GUI evaluation. This value is part of the 'GUIState' +-- and is usually set when calling 'breakGUI'. +data GUIContinue + = GUIHalt -- ^ Disable the event handler + | GUIContinue -- ^ Allow the event handler to remain enabled for the next incoming event. + | GUIFail !String -- ^ report a failure + +-- | The 'GUIState' is the state that is constructed during the evaluation of a GUI function. +data GUIState window model + = GUIState + { theGUIModel :: !model + , theGUIWindow :: !window + , theGUIContinue :: !GUIContinue + } + +instance MonadState model (GUI window model) where + state f = GUI $ lift $ lift $ state $ \ st -> + let (a, model) = f (theGUIModel st) in (a, st{ theGUIModel = model }) + +instance MonadReader (Happlet model) (GUI window model) where + ask = GUI ask + local loc = GUI . local loc . unwrapGUI + +instance Monad.MonadFail (GUI window model) where + fail = breakGUI . (guiContinue .~) . GUIFail + +instance Semigroup a => Semigroup (GUI window model a) where + a <> b = (<>) <$> a <*> b + +instance Monoid a => Monoid (GUI window model a) where + mempty = return mempty + mappend a b = mappend <$> a <*> b + +-- | 'Control.Lens.Lens' for manipulating the 'GUIState'. It is better to use 'getModel', +-- 'updateModel', 'putModel', 'subModel', or 'liftGUI' instead of manipulating a 'GUIState' +-- directly. +guiModel :: Lens' (GUIState window model) model +guiModel = lens theGUIModel $ \ a b -> a{ theGUIModel = b } + +-- | 'Control.Lens.Lens' for manipulating the 'GUIState'. It is better to not use this function at +-- all. +guiWindow :: Lens' (GUIState window model) window +guiWindow = lens theGUIWindow $ \ a b -> a{ theGUIWindow = b } + +-- | 'Control.Lens.Lens' for manipulating the 'GUIState'. This will get or set a function that +-- constructs a continuation to be used after evaluation of the 'GUI' function halts. This function +-- is usually called internally by the back-end 'Happlets.Provider.Provider', so it is better to not +-- use this function at all. +guiContinue :: Lens' (GUIState window model) GUIContinue +guiContinue = lens theGUIContinue $ \ a b -> a{ theGUIContinue = b } + +-- | Evaluate a 'GUI' function on a given 'Happlet'. The 'Happlet' is locked durnig evaluation. If +-- the 'GUI' function evaluates to 'Disable', the given halt function (of type @IO ()@) is evaluated +-- before unlocking the 'Happlet', and then 'Prelude.False' is returned. If the 'GUI' function +-- evalautes to anything other than the 'Disable' value, the halt function is not evaluated and +-- 'Prelude.True' is returned. +evalGUI + :: GUI window model void -- ^ the 'GUI' function to evaluate + -> Happlet model + -> window -> model + -> IO (GUIState window model) +evalGUI (GUI f) happ win model = + evalStateT (runContT (runReaderT (f >> lift (lift get)) happ) return) GUIState + { theGUIModel = model + , theGUIWindow = win + , theGUIContinue = GUIContinue + } + +-- | Once you install an event handler, the default behavior is to leave the event handler installed +-- after it has evaluated so that it can continue reacting to events without you needing to re-install the event handler after each reaction. +-- +-- However if you wish for an event handler to remove itself, evaluate this function as the final +-- function call in your 'GUI' procedure. Calling this function tells your 'GUI' function to +-- immediately halt and remove itself from the event handling loop. +-- +-- Under the hood, this function will evaluate 'breakGUI' with a 'GUIHalt' condition set in the +-- 'guiContinue' field. +disable :: GUI window model void +disable = breakGUI $ guiContinue .~ GUIHalt + +-- | Break out of the current 'GUI' evaluation context, performing a final updating function that +-- will be applied to the 'GUIState' before returning to @IO@. This function will never return, and +-- the evaluating context will immediately receive a result as soon as this function is evaluated. +breakGUI + :: (GUIState window model -> GUIState window model) + -> GUI window model void +breakGUI = GUI . ReaderT . const . ContT . const . (>> get) . modify + +-- | Calling this function tells your 'GUI' function to immediately halt, reporting an error +-- condition. Under the hood, this will evaluate 'breakGUI' with a 'GUIFail' message set in the +-- 'guiContinue' field. +failGUI :: String -> GUI window model void +failGUI = breakGUI . (guiContinue .~) . GUIFail + +-- | The 'GUI' function type instantiates the 'Control.Monad.State.Class.MonadState' monad +-- transformer so you can use functions like 'Control.Monad.State.Class.get'. However this function +-- is provided as synonym for the 'Control.Monad.State.Class.get' function for convenience, and +-- perhaps for better readability in your code. +getModel :: GUI window model model +getModel = get + +-- | The 'GUI' function type instantiates the 'Control.Monad.State.Class.MonadState' monad +-- transformer so you can use functions like 'Control.Monad.State.Class.gets'. However this function +-- is provided as synonym for the 'Control.Monad.State.Class.gets' function for convenience, and +-- perhaps for better readability in your code. +getSubModel :: (model -> a) -> GUI window model a +getSubModel = gets + +-- | The 'GUI' function type instantiates the 'Control.Monad.State.Class.MonadState' monad +-- transformer so you can use functions like 'Control.Monad.State.Class.put'. However this function +-- is provided as synonym for the 'Control.Monad.State.Class.put' function for convenience, and +-- perhaps for better readability in your code. +putModel :: model -> GUI window model () +putModel = put + +-- | The 'GUI' function type instantiates the 'Control.Monad.State.Class.MonadState' monad +-- transformer so you can use functions like 'Control.Monad.State.Class.modify'. However this +-- function is provided as synonym for the 'Control.Monad.State.Class.modify' function for +-- convenience, and perhaps for better readability in your code. +modifyModel :: (model -> model) -> GUI window model () +modifyModel = modify + +---------------------------------------------------------------------------------------------------- + +-- $LowLevel_Details +-- +-- These are functions that should only be used by the back-end +-- 'Happlets.Provider.Provider'. If you think you need to use these functions when programming an +-- ordinary Happlet, ask an expert how you might solve your problem without using them. + +-- | Tests if a the 'GUIState' produced after evaluating 'GUI' function with 'evalGUI' is still +-- ready to receive further input signals. +guiIsLive :: GUIState window model -> Bool +guiIsLive = theGUIContinue >>> \ case { GUIContinue -> True; _ -> False; } + +-- | Obtain a copy of the entire 'GUIState' data structure set for the current 'GUI' evaluation +-- context. This function should never be used unless you are programming a Happlet +-- 'Happlets.Provider.Provider'. +getGUIState :: GUI window model (GUIState window model) +getGUIState = GUI $ lift $ lift get + +-- | Update the entire copy of the 'GUIState' data structure for the current context. This +-- function should never be used unless you are programming a Happlet 'Happlets.Provider.Provider'. +putGUIState :: GUIState window model -> GUI window model () +putGUIState = GUI . lift . lift . put + +-- | Obtain a reference to the 'Happlet' in which this 'GUI' function is being evaluated. +askHapplet :: GUI window model (Happlet model) +askHapplet = ask + +---------------------------------------------------------------------------------------------------- + +-- $InstallingEventHandlers +-- +-- These are functions your 'Happlet' can use to subscribe to receive certain types of events that +-- the back-end 'Happlets.Provider.Provider' may provide. Not all back-end +-- 'Happlets.Provider.Provider's provide all types of events. If the @window@ type you are using +-- does instantiate the below classes, you may program your 'Happlet' to receive that type of event. + +-- | Windows that are manageable are part of multi-window GUI operating systems where a window +-- manager can display multiple windows, sending a signal when the window is made visible or +-- invisible, and sending a signal when the window received focus (is made to receive user input) or +-- loses focus. +class Managed window where + -- | This event handler is evaluated when the window becomes visible or invisible + visibleEvents :: (Bool -> GUI window model ()) -> GUI window model () + -- | This event handler is evaluated when the window gains or loses focus. + focusEvents :: (Bool -> GUI window model ()) -> GUI window model () + -- | This function asks the operating system or desktop environment to show or hide the window + -- associated with the given @window@. + windowVisible :: Bool -> GUI window model () + +-- | Windows that can be resized can provide an instance of this class. Even on platforms where +-- there is only one window per screen, it may be possible to change screen sizes if the screen +-- resolutions or screen orientations can change. +class CanResize window where + -- | This event handler is evaluated when the window is resized. It should NOT be called when the + -- window is first initialized, or when it is made visible + resizeEvents :: (PixSize -> GUI window model ()) -> GUI window model () + +-- | This class provides the ability to install animation event handlers which are repeatedly called +-- at fast, regular time intervals, usually 60 frames per second. +class CanAnimate window where + -- | This function will be called repeatedly with a time delta indicating how much time has passed + -- since the animation handler was installed. The given 'GUI' function should update the + -- 'Happlet.View.Readraw' state each time. + stepFrameEvents :: (AnimationMoment -> GUI window model ()) -> GUI window model () + -- | This function returns true of false if there is currently an animation event handler + -- installed and running in the Happlet. To disable a running animation, evaluate + -- @'stepFrameEvents' 'disable'@. + animationIsRunning :: GUI window model Bool + +-- | This class provides the ability to install keyboard event handlers. +class CanKeyboard window where + -- | There may be more than one keyboard, although it is not likely. Just the same, it is possible + -- to specify an 'Happlets.Event.InputDeviceId'. Remember that passing an empty list of + -- 'Happlets.Event.InputDeviceId's will install the 'GUI' function to receive events from the + -- default device. + keyboardEvents :: (Keyboard -> GUI window model ()) -> GUI window model () + -- | This function should return a list of all possible keyboard devices. If an empty list is + -- returned, only one device, the default device, is provided. + providedKeyboardDevices :: GUI window model [InputDeviceId] + providedKeyboardDevices = return [] + +-- | Mouse events can cause a lot of event throughput. To reduce this throughput and improve +-- efficiency, the 'mouseEvents' function take a parameter that lets you filter only certain mouse +-- events, so your 'GUI' function is only called when mouse events matching one of these patterns +-- occur. +data MouseEventPattern + = MouseButton -- ^ Matches only mouse button click events. + | MouseDrag -- ^ Matches mouse motion events only when a button is clicked down. + | MouseAll -- ^ Matches all mouse motion and mouse button events. + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | This class provides the ability to install mouse event handlers. Minimal complete definition is +-- 'mouseEvents'. +class CanMouse window where + -- | Install a 'GUI' function that only responds to mouse button clicks. All mouse cursor motion + -- is ignored. + mouseEvents + :: MouseEventPattern + -> (Mouse -> GUI window model ()) + -> GUI window model () + -- | This function should return a list of all possible mouse devices. If an empty list is + -- returned, only one device, the default device, is provided. + providedMouseDevices :: GUI window model [InputDeviceId] + providedMouseDevices = return [] + +-- | This class provides the ability to provide trackpad events handlers. Happlet programmers should +-- be not expect that many back-end providers will not provide events of this type at all. +-- +-- 'Happlet.Event.Trackpad' events are a catch-all event type which cover all input devices that are +-- not keyboard or mouse devices. Back-end providers should strive to, as often as possible, eschew +-- a 'CanTrackpad' provider and define a 'CanMouse' provider a specific input device instead. +-- +-- However, raw mouse events, stylus events, and touch screen events may all fall under the category +-- of 'CanTrackpad', so if the back-end providers would like to provide this type of event, it may. +class CanTrackpad window where + -- | For 'Happlets.Event.Trackpad' events, it is important (but still not required) for you to + -- specify an 'Happlets.Event.InputDeviceId'. + trackpadEvents :: (Trackpad -> GUI window model ()) -> GUI window model () + -- | This function should return a list of all possible trackpad devices. If an empty list is + -- returned, only one device, the default device, is provided. It is more important that back-end + -- providers specify elements of this list, because of the wide variety of input devices that this + -- event handler could be made to handle. + providedTrackpadDevices :: GUI window model [InputDeviceId] + providedTrackpadDevices = return [] + +---------------------------------------------------------------------------------------------------- + +-- $OtherCapabilities +-- +-- These are functions which can be called when defining a GUI function which has nothing to do with +-- reacting to events. + +class CanBufferImages window image render | window -> image, window -> render where + -- | Create a new image buffer. + newImageBuffer :: forall model a . PixSize -> render a -> GUI window model image + -- | Resize the image buffer. + resizeImageBuffer :: forall model a . image -> PixSize -> render a -> GUI window model a + -- | Draw to the image buffer using a @draw@ function. + drawImage :: forall model a . image -> render a -> GUI window model a + -- | Blit an image buffer to the current @window@. You can offset the location of the blit + -- operation by passing an offset value as the 'Happlets.Readraw.PixCoord'. + blitImage :: image -> PixCoord -> GUI window model () + -- | Like 'blitImage' but blits to another @image@, rather than to the current @window@. The first + -- @image@ parameter is the source from which to blit, the second @image@ is the target to which + -- to blit, followed by the offset and mask. + blitImageTo + :: Source image + -> Target image + -> Target PixCoord + -> GUI window model () + +-- | Some back-end providers may wish to provide force-feedback functionality along with +-- 'CanTrackapd' event handlers. +class CanForceFeedback window where + -- | Happlet programmers should be able to program a force feedback pattern by specifying a list + -- of intensities and durations. Multiple calls to this function __should__ delete later force + -- feedback patterns, and only execute the first call to this function. In multi-threaded systems, + -- it is up to the back-end provider to decide what should happen if multiple threads call + -- 'forceFeedback' at the same time. It is recommended that the force feedback sent to the input + -- device should work on a first-come-first-serve basis, and later patterns should cancle current + -- patterns that are currently being sent to the input device. + forceFeedback :: [(FFIntensity, FFDuration)] -> GUI window model () + +-- | For back-end 'Happlets.Provider.Provider's that allow 'Happlet.GUI.Happlet's to subscribe to +-- events from specific devices, this function asks the back-end 'Happlets.Provider.Provider' to +-- return a list of valid input device identifiers that can be used when installing event handlers. +class DeviceHandler window where + -- | Provide an up-to-date list of available 'Happlets.Event.InputDeviceId's. + providedInputDevices :: GUI window model [InputDeviceId] + -- | Subscriber functions which install 'GUI' event handlers, for example 'keyboardEvents', + -- 'mouseEvents', 'trackpadEvents', or 'forceFeedback', will by default subscribe to events from + -- any and all devices sending input from the back-end 'Happlets.Provider.Provider'. However if + -- you wish for your 'Happlet' to only subscribe to events coming from only certain specific + -- devices, evaluate these subscriber functions within this 'onDevices' function to limit which + -- devices will send input to your 'GUI' functions. + onDevices :: [InputDeviceId] -> GUI window model () -> GUI window model () + +-- | Returns a list of input devices that are not recognized. +unrecognizedInputDevices + :: DeviceHandler window + => [InputDeviceId] -> GUI window model [InputDeviceId] +unrecognizedInputDevices test = do + have <- providedInputDevices + return [device | device <- test, not $ device `elem` have] + +-- | Similar to 'unrecognizedInputDevices' but will throw a runtime exception if any of the given +-- 'InputDeviceId's are not provided by the 'providedInputDevices'. +failUnrecognizedInputDevices + :: DeviceHandler window + => [InputDeviceId] -> GUI window model () +failUnrecognizedInputDevices = unrecognizedInputDevices >=> \ bad -> + if null bad then return () else fail $ "Unrecognized input device IDs"++show bad diff --git a/src/Happlets/Initialize.hs b/src/Happlets/Initialize.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Initialize.hs @@ -0,0 +1,239 @@ +-- | To begin programming your 'Happlet', import the back-end 'Happlets.Provider.Provider' you want +-- to use, for example @import Happlets.Lib.Gtk@. The functions in this module provide a convenient +-- interface for evaluating the functions provided by the 'Happlets.Provider.Provider', making it +-- easy to setup your application from within the "main" function of your executable program. +-- +-- If your Happlet is just a simple, single-window happlet, then use 'simpleHapplet' to initialize +-- your Happlet. The 'simpleHapplet' function takes a 'Happlets.Provider.Provider', a function for +-- setting the 'Happlets.Config.Config' parameters, an initial value for the document model data, +-- and an initializing 'Happlets.GUI.GUI' function for installing event handlers. See the +-- documentation for 'simpleHapplet' for an example. +-- +-- It is also possible to define a Happlets where multiple Happlet windows are placed on screen when +-- the program is executed. To do this, the task of initializing the 'Happlets.GUI.Happlet' +-- container, creating a new window, and attaching a 'Happlets.GUI.Happlet' container to the window, +-- are all separate initialization steps which are evaluated in the 'Initialize' monad. +-- +-- The 'happlet' function takes a back-end 'Happlets.Provider.Provider' and then evaluates an +-- 'Initialize' function, which behaves a lot like an imparative program in which you set parameter +-- variables and then call functions which make inspect the parameter variables. +-- +-- In the 'Initialize' function, you can use the various +-- @'Control.Lens.Lens'' 'Happlets.Config.Config'@ lenses defined in the "Happlets.Config" module +-- with the @'(Control.Lens..=')@ operator to set various configuration settings in a stateful way, +-- much like setting environment variables. +-- +-- After setting the 'Happlets.Config.Config' paramters, you must: +-- +-- 1. call 'newWindow' to create a new window, +-- 2. call 'newHapplet' to create a new 'Happlets.GUI.Happlet' container which contains your +-- document object model. +-- 3. call 'attachWindow' to attach the 'Happlets.GUI.Happlet' to the window, passing an +-- initializing 'Happlets.GUI.GUI' function to setup the event handlers. +-- 4. perform the above 3 steps for as many windows as necessary. +-- 5. call 'launchGUIEventLoop' to start the application +-- 6. if necessary, call 'deleteWindow'. +-- +-- @ +-- main :: IO () +-- main = 'happlet' gtkHapplet $ do +-- --- +-- --- setting the 'Happlets.Config.Config' paramters --- +-- --- +-- 'Happlets.Config.registeredAppName' 'Control.Lens..=' "My First Happlet!" +-- 'Happlets.Config.windowTitleBar' .= "Hello World Happlet" +-- 'Happlets.Config.recommendWindowSize' 'Control.Lens..=' (640, 480) +-- --- +-- --- creating the new window --- +-- --- +-- win <- newWindow +-- --- +-- --- create a new 'Happlets.GUI.Happlet' to contain the document object model --- +-- --- +-- happ <- 'newHapplet' MyDocumentModel +-- { myFoo = emptyFoo +-- , myBar = emptyBar +-- } +-- --- +-- --- attaching the happlet container to the window and initializing the event handlers --- +-- --- +-- 'attachWindow' win happ initMyHapplet +-- --- +-- 'launchGUIEventLoop' -- Will not return until an exit condition halts the event loop. +-- --- +-- --- not always necessary, but delete the windows after the event loop halts --- +-- --- +-- 'deleteWindow' win +-- @ +-- +-- The initializing function passed to 'attachWindow' takes a 'Happlets.Draw.SampCoord.PixSize', so +-- if your document model contains information sensitive to the geometry of the window, you can +-- initialize your document model using the given window size. +-- +-- The document model stored in the 'Happlets.GUI.Happlet' container can be any data type at +-- all. Haskell's static type checker ensures that the 'GUI' function you use to initialize the +-- event handlers must match the content of the 'Happlets.GUI.Happlet' container. As your +-- 'Happlets.GUI.GUI' program begins receiving events from the operating system's window manager, +-- the document model is updated using the ordinary 'Control.Monad.State.Class.MonadState' API +-- functions like 'Control.Monad.State.Class.get', 'Control.Monad.State.Class.put', +-- 'Control.Monad.State.Class.modify', as well as the 'Control.Lens.Lens'' functions +-- 'Control.Lens.use', 'Control.Lens.assign' and it's infix form ('Control.Lens..='), and +-- 'Control.Lens.modifying' and it's infix form ('Control.Lens.%='). +-- +-- Please also refer to the "Happlets.GUI" documentation on the 'Happlets.GUI.GUI' function type +-- which is the Happlets equivalent of the @IO@ function type. There you will find instructions on +-- how to install event handlers. +module Happlets.Initialize where + +import Happlets.Config +import Happlets.Draw.SampCoord +import Happlets.GUI +import Happlets.Provider + +import Control.Monad.Reader +import Control.Monad.State + +---------------------------------------------------------------------------------------------------- + +-- | This function carries around with it a reference to a 'Happlets.Provider.Provider' and a +-- 'Happlets.Config.Config' data structure. +-- +-- The real use of this function type is provided by the various classes that can be instantiated by +-- the back-end provider. +newtype Initialize window a + = Initialize { unwrapGUI :: ReaderT (Provider window) (StateT Config IO) a } + deriving (Functor, Applicative, Monad, MonadIO) + +instance MonadReader (Provider window) (Initialize window) where + ask = Initialize ask + local f = Initialize . local f . unwrapGUI + +instance MonadState Config (Initialize window) where + state = Initialize . state + +-- | This function is an all-in-one setup function that lets you create a 'Happlets.GUI.Happlet' +-- with a single function call. Pass the back-end 'Happlets.Provider.Provider', a stateful function +-- for updating the default 'Happlets.Config.Config', an initial @model@, and an initial +-- 'Happlets.GUI.GUI' function for installing the 'Happlets.GUI.Happlet' event handlers. This +-- function will automatically call 'newHapplet', 'newWindow', 'attachWindow', 'happlet', and then +-- return when the GUI event loop halts. Here is an example of how you might use it: +-- +-- @ +-- import Happlets +-- +-- -- Here you define your document model data type, which will be updated by the 'Happlets.GUI.GUI' +-- -- function whenever an event occurs. +-- data MyDocModel = MyDocModel +-- { someFoo :: FooType +-- someBar :: BarType +-- myDocWinSize :: 'Happlets.Draw.SampCoord.PixSize' +-- } +-- +-- -- Here you define your Haskell "main" function. +-- main :: IO () +-- main = 'simpleHapplet' gtkHapplet <-- let's say we are using the Gtk+ 'Happlets.Provider.Provider' +-- (do registeredAppName 'Control.Lens..=' "My Happlet" +-- windowTitleBar 'Control.Lens..=' "New Document" +-- recommendWindowSize 'Control.Lens..=' (640, 480) +-- -- The type of this "do" block is ('Control.Monad.State.StateT' 'Happlets.Config.Config' IO ()). +-- -- You use the ('Control.Lens..=') function to set the various "Happlets.Config" parameters. +-- -- The configurable parameters are of type ('Control.Lens.Lens'' 'Happlets.Config.Config'). +-- ) +-- MyDocModel +-- { someFoo = initNewFoo +-- , someBar = emptyBar +-- , winSize = 'Linear.V2.V2' (-1) (-1) +-- -- Initialize your document model. Notice that your data type can contain a field +-- -- storing the size of the window. This is helpful for rendering graphics where the +-- -- geometry depends on the size of the window, for example, for graphics that you +-- -- like to center in the window. +-- } +-- (\\ winSiz -> do +-- -- This is the first function that runs before any event handlers are called. +-- -- Use this function to update your document model with the window size (if necessary), +-- -- and install the event handler functions. +-- +-- 'Happlets.GUI.modifyModel' $ \ mydoc -> +-- mydoc{ myDocWinSize = winSiz } -- <-- here you set the window size +-- +-- 'Happlets.GUI.mouseEvents' 'Happlets.GUI.MouseButton' $ \ mousEvt -> do +-- --- +-- --- some code for handling mouse events ... +-- --- +-- +-- 'Happlets.GUI.keyboardEvents' $ \ keyEvt -> do +-- --- +-- --- some code for handling key events ... +-- --- +-- ) +-- @ +simpleHapplet + :: Provider window + -> StateT Config IO () + -> model + -> (PixSize -> GUI window model ()) + -> IO () +simpleHapplet provider updcfg model init = happlet provider $ do + get >>= liftIO . execStateT updcfg >>= put + join $ attachWindow True <$> newWindow <*> newHapplet model <*> pure init + +-- | Run the 'Initialize' function with the given back-end 'Happlets.Happlet.Provider'. +happlet :: Provider window -> Initialize window a -> IO a +happlet provider (Initialize f) = do + doInitializeGUI provider + (a, config) <- runStateT (runReaderT f provider) (defaultConfig provider) + doGUIEventLoopLaunch provider config + return a + +-- | Create a new @window@. The @window@ itself only contains stateful information relevant to the +-- 'Happlets.GUI.GUI' back-end 'Happlets.Provider.Provider', it does not do anything on it's +-- own. This function does not place a window on the screen, only the 'attachWindow' function can do +-- that. +newWindow :: Initialize window window +newWindow = liftIO =<< asks doWindowNew <*> get + +-- | Create a new 'Happlets.GUI.Happlet', which contains a document object model of any type. When +-- you call 'attachWindow' you must supply this 'Happlets.GUI.Happlet' container along with a +-- 'Happlets.GUI.GUI' function that installs all the necessary event handlers into the @window@. As +-- the @window@ begins reciving events from the operating system's window manager, these event +-- handlers are evaluated, and the content of this 'Happlets.GUI.Happlet' can be updated using the +-- 'Control.Monad.State.Class.MonadState' functions like 'Control.Monad.State.Class.get', +-- 'Control.Monad.State.Class.put', 'Control.Monad.State.Class.modify', as well as the +-- 'Control.Lens.Lens'' functions 'Control.Lens.use', 'Control.Lens.assign' and it's infix form +-- ('Control.Lens..='), and 'Control.Lens.modifying' and it's infix form ('Control.Lens.%='). +newHapplet :: model -> Initialize window (Happlet model) +newHapplet = liftIO . makeHapplet + +-- | This function evaluates the given 'Happlets.GUI.GUI' function to install 'Happlets.GUI.GUI' +-- event handlers into the @window@ that can modify the content of the 'Happlets.GUI.Happlet' +-- container in response to events received from the operating system's window manager. +-- +-- Note that it is possible to detach a 'Happlets.GUI.Happlet' container from a @window@ and +-- re-attach the @window@ to an entirely different type of 'Happlets.GUI.Happlet' container using +-- the 'Happlets.GUI.windowChangeHapplet' function as the program is running and receiving +-- events. This allows a single @window@ to switch between multiple 'Happlets.GUI.Happlet's during +-- program execution. Please refer to the 'Happlets.GUI.windowChangeHapplet' function documentation +-- for information about how to do this. +attachWindow + :: Bool + -> window + -> Happlet model + -> (PixSize -> GUI window model ()) + -> Initialize window () +attachWindow vis win happ init = liftIO =<< + asks doWindowAttach <*> pure vis <*> pure win <*> pure happ <*> pure init + +-- | This function launches the GUI event loop. You must call this function once after all of your +-- Happlet setup has been performed. This function will not return until the GUI event loop has +-- halted, so it must be the last function called in the 'Initialize' "do" block, except perhaps for +-- the 'deleteWindow' function which can be evaluated after it. +launchGUIEventLoop :: Initialize window () +launchGUIEventLoop = get >>= \ config -> asks doGUIEventLoopLaunch >>= liftIO . ($ config) + +-- | Delete a window. It often is not necessary to delete a Happlet window because usually once the +-- 'Initialize' function has completed evaluating, there ought not be anything after the 'happlet' +-- function in the @main@ function, and so the executable program will quit, signaling to the +-- operating system window manager to delete all windows associated with this program. None the +-- less, this function exists for the purpose of explicitly deleting windows. +deleteWindow :: window -> Initialize window () +deleteWindow win = liftIO =<< asks doWindowDelete <*> pure win diff --git a/src/Happlets/Provider.hs b/src/Happlets/Provider.hs new file mode 100644 --- /dev/null +++ b/src/Happlets/Provider.hs @@ -0,0 +1,57 @@ +-- | This module provides the 'Provider' data type used by various back-ends to initialize a working +-- GUI. In object-oriented jargon, this module provides an abstract interface for Happlets, and the +-- back-end providers are "factories" which must instantiate all of the methods in this interface. +module Happlets.Provider where + +import Happlets.Config +import Happlets.Draw.SampCoord +import Happlets.GUI + +---------------------------------------------------------------------------------------------------- + +-- | The @provider@ is a data type containing all information necessary for a high-level 'Happlet' to +-- interface with the low-level back-end provider. The @provider@ is associated with a @window@ handle +-- type (usually a wrapper around a 'Control.Concurrent.MVar') and an @image@ type which store image +-- buffers. The @window@ and @image@ types are functionally dependent on the @provider@ type so it is +-- only necessary to specify the @provider@ type to the type checker in ambiguous situations where the +-- type variables cannot be resolved. +-- +-- Furthermore, the @provider@ type may provided different types of @window@ which display different +-- types of @image@. One example of how this might be used is for a Gtk+ back-end might provide a +-- single @window@ type but create two different instances of @provider@, one with Cairo-based @image@ +-- buffers, and one with OpenGL-based @image@ buffers. +data Provider window + = Provider + { -- | The default 'Happlet.Config.Config' parameters best suited for this partuclar back-end. + defaultConfig :: Config + + -- | This is the pre-initialization function that should run before performing any GUI-related + -- action at all. + , doInitializeGUI :: IO () + + -- | This function launches the event loop for the given @window@ and does not return until + -- the GUI application's event handler thread has quit. In the case of Gtk+, since there can + -- only be one event loop per application, calling this function on any window handle will + -- launch the event loop for __all__ window handles. + , doGUIEventLoopLaunch :: Config -> IO () + + -- | This function creates a @window@ without installing any event handlers, and without + -- making the window visible. The @window@ craeted can then have 'Happlet's attached to it + -- using 'doWindowAttach'. + , doWindowNew :: Config -> IO window + + -- | This function asks the operating system or desktop environment to delete the window + -- associated with the given @window@. If the 'Happlets.Config.quitOnWindowClose' configuration + -- parameter is 'Prelude.True', calling this function should also quit the whole application. + , doWindowDelete :: window -> IO () + + -- | This function __must__ delete all event handlers currently installed into the @window@ + -- and evaluate a new 'Happlets.GUI.GUI' function which can install new event handlers. + , doWindowAttach + :: forall model + . Bool -- ^ whether or not to make the window visible + -> window -- ^ the window to which the 'Happlets.Happlet.Happlet' will be attached + -> Happlet model -- ^ the 'Happlets.Happlet.Happlet' to attach. + -> (PixSize -> GUI window model ()) + -> IO () + }