happlets (empty) → 0.1.0.0
raw patch · 13 files changed
+2549/−0 lines, 13 filesdep +basedep +bytestringdep +colour
Dependencies added: base, bytestring, colour, containers, fail, lens, linear, mtl, semigroups, text, time, transformers, unordered-containers
Files
- LICENSE +674/−0
- happlets.cabal +116/−0
- src/Happlets.hs +19/−0
- src/Happlets/Config.hs +154/−0
- src/Happlets/Draw.hs +60/−0
- src/Happlets/Draw/Color.hs +214/−0
- src/Happlets/Draw/SampCoord.hs +34/−0
- src/Happlets/Draw/Text.hs +74/−0
- src/Happlets/Draw/Types2D.hs +174/−0
- src/Happlets/Event.hs +244/−0
- src/Happlets/GUI.hs +490/−0
- src/Happlets/Initialize.hs +239/−0
- src/Happlets/Provider.hs +57/−0
+ LICENSE view
@@ -0,0 +1,674 @@+ GNU GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The GNU General Public License is a free, copyleft license for+software and other kinds of works.++ The licenses for most software and other practical works are designed+to take away your freedom to share and change the works. By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users. We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors. You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++ To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights. Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received. You must make sure that they, too, receive+or can get the source code. And you must show them these terms so they+know their rights.++ Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++ For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software. For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++ Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so. This is fundamentally incompatible with the aim of+protecting users' freedom to change the software. The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable. Therefore, we+have designed this version of the GPL to prohibit the practice for those+products. If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++ Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary. To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++ The precise terms and conditions for copying, distribution and+modification follow.++ TERMS AND CONDITIONS++ 0. Definitions.++ "This License" refers to version 3 of the GNU General Public License.++ "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.++ "The Program" refers to any copyrightable work licensed under this+License. Each licensee is addressed as "you". "Licensees" and+"recipients" may be individuals or organizations.++ To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy. The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++ A "covered work" means either the unmodified Program or a work based+on the Program.++ To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy. Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++ To "convey" a work means any kind of propagation that enables other+parties to make or receive copies. Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++ An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License. If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++ 1. Source Code.++ The "source code" for a work means the preferred form of the work+for making modifications to it. "Object code" means any non-source+form of a work.++ A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++ The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form. A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++ The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities. However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work. For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++ The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++ The Corresponding Source for a work in source code form is that+same work.++ 2. Basic Permissions.++ All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met. This License explicitly affirms your unlimited+permission to run the unmodified Program. The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work. This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++ You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force. You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright. Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++ Conveying under any other circumstances is permitted solely under+the conditions stated below. Sublicensing is not allowed; section 10+makes it unnecessary.++ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.++ No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++ When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++ 4. Conveying Verbatim Copies.++ You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++ You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++ 5. Conveying Modified Source Versions.++ You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++ a) The work must carry prominent notices stating that you modified+ it, and giving a relevant date.++ b) The work must carry prominent notices stating that it is+ released under this License and any conditions added under section+ 7. This requirement modifies the requirement in section 4 to+ "keep intact all notices".++ c) You must license the entire work, as a whole, under this+ License to anyone who comes into possession of a copy. This+ License will therefore apply, along with any applicable section 7+ additional terms, to the whole of the work, and all its parts,+ regardless of how they are packaged. This License gives no+ permission to license the work in any other way, but it does not+ invalidate such permission if you have separately received it.++ d) If the work has interactive user interfaces, each must display+ Appropriate Legal Notices; however, if the Program has interactive+ interfaces that do not display Appropriate Legal Notices, your+ work need not make them do so.++ A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit. Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++ 6. Conveying Non-Source Forms.++ You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++ a) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by the+ Corresponding Source fixed on a durable physical medium+ customarily used for software interchange.++ b) Convey the object code in, or embodied in, a physical product+ (including a physical distribution medium), accompanied by a+ written offer, valid for at least three years and valid for as+ long as you offer spare parts or customer support for that product+ model, to give anyone who possesses the object code either (1) a+ copy of the Corresponding Source for all the software in the+ product that is covered by this License, on a durable physical+ medium customarily used for software interchange, for a price no+ more than your reasonable cost of physically performing this+ conveying of source, or (2) access to copy the+ Corresponding Source from a network server at no charge.++ c) Convey individual copies of the object code with a copy of the+ written offer to provide the Corresponding Source. This+ alternative is allowed only occasionally and noncommercially, and+ only if you received the object code with such an offer, in accord+ with subsection 6b.++ d) Convey the object code by offering access from a designated+ place (gratis or for a charge), and offer equivalent access to the+ Corresponding Source in the same way through the same place at no+ further charge. You need not require recipients to copy the+ Corresponding Source along with the object code. If the place to+ copy the object code is a network server, the Corresponding Source+ may be on a different server (operated by you or a third party)+ that supports equivalent copying facilities, provided you maintain+ clear directions next to the object code saying where to find the+ Corresponding Source. Regardless of what server hosts the+ Corresponding Source, you remain obligated to ensure that it is+ available for as long as needed to satisfy these requirements.++ e) Convey the object code using peer-to-peer transmission, provided+ you inform other peers where the object code and Corresponding+ Source of the work are being offered to the general public at no+ charge under subsection 6d.++ A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++ A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling. In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage. For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product. A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++ "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source. The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++ If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information. But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++ The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed. Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++ Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++ 7. Additional Terms.++ "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law. If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++ When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it. (Additional permissions may be written to require their own+removal in certain cases when you modify the work.) You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++ Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++ a) Disclaiming warranty or limiting liability differently from the+ terms of sections 15 and 16 of this License; or++ b) Requiring preservation of specified reasonable legal notices or+ author attributions in that material or in the Appropriate Legal+ Notices displayed by works containing it; or++ c) Prohibiting misrepresentation of the origin of that material, or+ requiring that modified versions of such material be marked in+ reasonable ways as different from the original version; or++ d) Limiting the use for publicity purposes of names of licensors or+ authors of the material; or++ e) Declining to grant rights under trademark law for use of some+ trade names, trademarks, or service marks; or++ f) Requiring indemnification of licensors and authors of that+ material by anyone who conveys the material (or modified versions of+ it) with contractual assumptions of liability to the recipient, for+ any liability that these contractual assumptions directly impose on+ those licensors and authors.++ All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10. If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term. If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++ If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++ Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++ 8. Termination.++ You may not propagate or modify a covered work except as expressly+provided under this License. Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++ However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++ Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++ Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License. If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++ 9. Acceptance Not Required for Having Copies.++ You are not required to accept this License in order to receive or+run a copy of the Program. Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance. However,+nothing other than this License grants you permission to propagate or+modify any covered work. These actions infringe copyright if you do+not accept this License. Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++ 10. Automatic Licensing of Downstream Recipients.++ Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License. You are not responsible+for enforcing compliance by third parties with this License.++ An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations. If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++ You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License. For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++ 11. Patents.++ A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based. The+work thus licensed is called the contributor's "contributor version".++ A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version. For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++ Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++ In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement). To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++ If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients. "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.++ If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++ A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License. You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++ Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++ 12. No Surrender of Others' Freedom.++ If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all. For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++ 13. Use with the GNU Affero General Public License.++ Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work. The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++ 14. Revised Versions of this License.++ The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++ Each version is given a distinguishing version number. If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation. If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++ If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++ Later license versions may give you additional or different+permissions. However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++ 15. Disclaimer of Warranty.++ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++ 16. Limitation of Liability.++ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++ 17. Interpretation of Sections 15 and 16.++ If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software: you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation, either version 3 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program. If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++ If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++ <program> Copyright (C) <year> <name of author>+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++ You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++ The GNU General Public License does not permit incorporating your program+into proprietary programs. If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License. But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+ happlets.cabal view
@@ -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+-- <http://www.gnu.org/licenses/agpl.html>.++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+}
+ src/Happlets.hs view
@@ -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
+ src/Happlets/Config.hs view
@@ -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 }
+ src/Happlets/Draw.hs view
@@ -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
+ src/Happlets/Draw/Color.hs view
@@ -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
+ src/Happlets/Draw/SampCoord.hs view
@@ -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
+ src/Happlets/Draw/Text.hs view
@@ -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
+ src/Happlets/Draw/Types2D.hs view
@@ -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
+ src/Happlets/Event.hs view
@@ -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)
+ src/Happlets/GUI.hs view
@@ -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
+ src/Happlets/Initialize.hs view
@@ -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
+ src/Happlets/Provider.hs view
@@ -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 ()+ }