diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,8 @@ +{-import Distribution.Simple + +main = defaultMain +-} + +import Distribution.Simple.I18N.GetText (gettextDefaultMain) + +main = gettextDefaultMain diff --git a/i18n/de.po b/i18n/de.po new file mode 100644 --- /dev/null +++ b/i18n/de.po @@ -0,0 +1,473 @@ +# Translation file +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2009-01-13 06:05-0800\n" +"PO-Revision-Date: 2010-07-30 09:16+0200\n" +"Last-Translator: Alexander Bau \n" +"Language-Team: German\n" +"Language: de\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#: src/Run.hs:0 +msgid "File" +msgstr "Datei" + +#: src/Run.hs:0 +msgid "New" +msgstr "Neu" + +#: src/Run.hs:0 src/Controller/Menu/File/Open.hs:0 +msgid "Open" +msgstr "Öffnen" + +#: src/Run.hs:0 src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Import" +msgstr "Importieren" + +#: src/Run.hs:0 +msgid "From CSV file" +msgstr "aus CSV-Datei" + +#: src/Run.hs:0 src/Controller/Menu/File/NewClose.hs:0 +msgid "Save as" +msgstr "Speichern unter" + +#: src/Run.hs:0 src/Controller/Menu/File/Save.hs:0 +msgid "Save" +msgstr "Speichern" + +#: src/Run.hs:0 src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Export" +msgstr "Exportieren" + +#: src/Run.hs:0 +msgid "As image" +msgstr "als Bild" + +#: src/Run.hs:0 +msgid "As bar chart" +msgstr "als Balkendiagramm" + +#: src/Run.hs:0 +msgid "As box plot" +msgstr "als Boxplot" + +#: src/Run.hs:0 +msgid "Close" +msgstr "Schließen" + +#: src/Run.hs:0 +msgid "Close all" +msgstr "Alle schließen" + +#: src/Run.hs:0 +msgid "Quit" +msgstr "Beenden" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Table" +msgstr "Tabelle" + +#: src/Run.hs:0 +msgid "Add" +msgstr "Hinzufügen" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +msgid "Columns" +msgstr "Spalten" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Rows" +msgstr "Zeilen" + +#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy" +msgstr "Kopieren" + +#: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 +msgid "Delete" +msgstr "Löschen" + +#: src/Run.hs:0 src/Controller/Menu/Table/Transpose.hs:0 +msgid "Transpose" +msgstr "Transponieren" + +#: src/Run.hs:0 +msgid "Reevaluate all cells" +msgstr "Alle Zellen auswerten" + +#: src/Run.hs:0 +msgid "Statistics" +msgstr "Statistik" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency Distribution" +msgstr "Häufigkeitsverteilung" + +#: src/Run.hs:0 +msgid "Descriptive" +msgstr "Deskriptive" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Pivot table" +msgstr "Pivot-Tabelle" + +#: src/Util/FileType.hs:0 +msgid "Unknown file type" +msgstr "Unbekannter Dateityp" + +#: src/View/Dialog/Simple.hs:0 src/Model/CellContent.hs:0 +msgid "Error" +msgstr "Fehler" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Ok" +msgstr "&Ok" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Cancel" +msgstr "&Abbrechen" + +#: src/Model/CellContent.hs:0 +msgid "Parse error" +msgstr "Analyse-Fehler" + +#: src/Model/CellContent.hs:0 +msgid "Unknown reference" +msgstr "Unbekannte Referenz" + +#: src/Model/CellContent.hs:0 +msgid "Reference loop" +msgstr "Selbst-Referenz" + +#: src/Model/CellContent.hs:0 +msgid "Compile error" +msgstr "Übersetzer-Fehler" + +#: src/Model/CellContent.hs:0 +msgid "Type error in" +msgstr "Typ-Fehler in" + +#: src/Model/CellContent.hs:0 +msgid "In" +msgstr "In" + +#: src/Model/CellContent.hs:0 +msgid "Unknown identifier" +msgstr "Unbekannter Bezeichner" + +#: src/Model/CellContent.hs:0 +msgid "Empty" +msgstr "Leer" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "formula" +msgstr "Formel" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "argument" +msgstr "Argument" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "function call" +msgstr "Funktionsaufruf" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "number" +msgstr "Nummer" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "string" +msgstr "Zeichenkette" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "reference" +msgstr "Referenz" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell reference" +msgstr "Zellen-Referenz" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell range reference" +msgstr "Zellen-Bereichs-Referenz" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "subexpression" +msgstr "Subausdruck" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "end of input" +msgstr "Ende der Eingabe" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "unexpected" +msgstr "unerwartet" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "expecting" +msgstr "erwarte" + +#: src/Controller/Dialog.hs:0 +msgid "Any file" +msgstr "Alle Dateien" + +#: src/Controller/Dialog.hs:0 +msgid "Column" +msgstr "Spalte" + +#: src/Controller/Dialog.hs:0 +msgid "to" +msgstr "nach" + +#: src/Controller/Dialog.hs:0 +msgid "Preview" +msgstr "Vorschau" + +#: src/Controller/Dialog.hs:0 +msgid "Column(s)" +msgstr "Spalte(n)" + +#: src/Controller/Dialog.hs:0 +msgid "contains non-numeric data" +msgstr "beinhalten nicht-numerische Daten" + +#: src/Controller/Dialog.hs:0 +msgid "No columns selected" +msgstr "Keine Spalten ausgewählt" + +#: src/Controller/Menu/File/NewClose.hs:0 +msgid "Save?" +msgstr "Speichern?" + +#: src/Controller/Menu/File/Open.hs:0 src/Controller/Menu/File/Save.hs:0 +msgid "Tables" +msgstr "Tabellen" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid file" +msgstr "Ungültige Datei" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid s-expression" +msgstr "Ungültiger S-Ausdruck" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Column delimiter" +msgstr "Spalten-Trennzeichen" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Row delimiter" +msgstr "Zeilen-Trennzeichen" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First column contains labels" +msgstr "Erste Spalte enthält Spalten-Beschriftungen" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First row contains labels" +msgstr "Erste Zeile enthält Zeilen-Beschriftungen" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Strip whitespace" +msgstr "Entferne Leerzeichen" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Try parsing numbers" +msgstr "Versuche Zahlen zu interpretieren" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "&Import" +msgstr "&Importieren" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font size (pt)" +msgstr "Font-Größe (pt)" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font color" +msgstr "Font-Farbe" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Background color" +msgstr "Hintergrundfarbe" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Padding (px)" +msgstr "Innenabstand (px)" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (horizontal) (px)" +msgstr "Linienbreite (horizontal) (px)" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (vertical) (px)" +msgstr "Linienbreite (vertikal) (px)" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "File type" +msgstr "Dateityp" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "&Export" +msgstr "&Exportieren" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "&Preview" +msgstr "&Vorschau" + +#: src/Controller/Menu/File/Export/ImageParameters.hs:0 +msgid "By extension" +msgstr "s. Dateierweiterung" + +#: src/Controller/Menu/File/Export/Diagram/Common.hs:0 +msgid "Can not plot diagram" +msgstr "Diagramm kann nicht erstellt werden" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Bar width" +msgstr "Balkenbreite" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Gaps" +msgstr "Lücken" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Legend" +msgstr "Legende" + +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Box width" +msgstr "Boxbreite" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add columns" +msgstr "Spalten hinzufügen" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add columns by" +msgstr "Spalten hinzufügen durch" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows" +msgstr "Zeilen hinzufügen" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows by" +msgstr "Zeilen hinzufügen durch" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Number \"n\"" +msgstr "Anzahl \"n\"" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Labels \"label1[,label2,...]\"" +msgstr "Beschriftungen \"beschriftung1[,beschriftung2,...]\"" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "&Add" +msgstr "&Hinzufügen" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +msgid "Descriptive Statistics" +msgstr "Deskriptive Statistik" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Mean" +msgstr "Mittelwert" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Median" +msgstr "Median" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Standard Deviation" +msgstr "Standardabweichung" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Maximum" +msgstr "Maximum" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Minimum" +msgstr "Minimum" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency" +msgstr "Häufigkeit" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Percentage" +msgstr "Prozent" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Sum" +msgstr "Summe" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Count" +msgstr "Anzahl" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Abscissa column" +msgstr "Abszissen-Spalte" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Ordinate column" +msgstr "Ordinaten-Spalte" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Data column" +msgstr "Daten-Spalte" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Aggregator" +msgstr "Aggregator" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Make totals" +msgstr "Gesamtheiten berechnen" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No abscissa column selected" +msgstr "Keine Abszissen-Spalte ausgewählt" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No ordinate column selected" +msgstr "Keine Ordinaten-Spalte ausgewählt" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No data column selected" +msgstr "Keine Daten-Spalte ausgewählt" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "" +"Can not apply aggregator to selected data column (e.g. because of non-" +"numeric data)." +msgstr "" +"Kann gewählten Aggregator nicht auf Daten-Spalte anwenden (z.B. aufgrund " +"nicht-numerischer Daten)" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Total" +msgstr "Total" diff --git a/i18n/en.po b/i18n/en.po new file mode 100644 --- /dev/null +++ b/i18n/en.po @@ -0,0 +1,493 @@ +# Translation file +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2009-01-13 06:05-0800\n" +"PO-Revision-Date: 2010-07-30 09:16+0200\n" +"Last-Translator: Alexander Bau \n" +"Language-Team: English\n" +"Language: en\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#: src/Run.hs:0 +msgid "File" +msgstr "File" + +#: src/Run.hs:0 +msgid "New" +msgstr "New" + +#: src/Run.hs:0 src/Controller/Menu/File/Open.hs:0 +msgid "Open" +msgstr "Open" + +#: src/Run.hs:0 src/Controller/Menu/File/Import/Csv.hs:0 +#, fuzzy +msgid "Import" +msgstr "Export" + +#: src/Run.hs:0 +msgid "From CSV file" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/NewClose.hs:0 +msgid "Save as" +msgstr "Save as" + +#: src/Run.hs:0 src/Controller/Menu/File/Save.hs:0 +msgid "Save" +msgstr "Save" + +#: src/Run.hs:0 src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Export" +msgstr "Export" + +#: src/Run.hs:0 +#, fuzzy +msgid "As image" +msgstr "As image" + +#: src/Run.hs:0 +msgid "As bar chart" +msgstr "" + +#: src/Run.hs:0 +msgid "As box plot" +msgstr "" + +#: src/Run.hs:0 +msgid "Close" +msgstr "Close" + +#: src/Run.hs:0 +msgid "Close all" +msgstr "Close all" + +#: src/Run.hs:0 +msgid "Quit" +msgstr "Quit" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Table" +msgstr "Table" + +#: src/Run.hs:0 +msgid "Add" +msgstr "" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#, fuzzy +msgid "Columns" +msgstr "Column" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Rows" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy" +msgstr "Copy" + +#: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 +msgid "Delete" +msgstr "Delete" + +#: src/Run.hs:0 src/Controller/Menu/Table/Transpose.hs:0 +msgid "Transpose" +msgstr "" + +#: src/Run.hs:0 +msgid "Reevaluate all cells" +msgstr "Reevaluate all cells" + +#: src/Run.hs:0 +msgid "Statistics" +msgstr "Statistics" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency Distribution" +msgstr "Frequency Distribution" + +#: src/Run.hs:0 +msgid "Descriptive" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Pivot table" +msgstr "" + +#: src/Util/FileType.hs:0 +#, fuzzy +msgid "Unknown file type" +msgstr "File" + +#: src/View/Dialog/Simple.hs:0 src/Model/CellContent.hs:0 +msgid "Error" +msgstr "" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Ok" +msgstr "" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Cancel" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Parse error" +msgstr "" + +#: src/Model/CellContent.hs:0 +#, fuzzy +msgid "Unknown reference" +msgstr "File" + +#: src/Model/CellContent.hs:0 +msgid "Reference loop" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Compile error" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Type error in" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "In" +msgstr "" + +#: src/Model/CellContent.hs:0 +#, fuzzy +msgid "Unknown identifier" +msgstr "File" + +#: src/Model/CellContent.hs:0 +msgid "Empty" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "formula" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "argument" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "function call" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "number" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "string" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell range reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "subexpression" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "end of input" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "unexpected" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "expecting" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Any file" +msgstr "" + +#: src/Controller/Dialog.hs:0 +#, fuzzy +msgid "Column" +msgstr "Column" + +#: src/Controller/Dialog.hs:0 +msgid "to" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Preview" +msgstr "" + +#: src/Controller/Dialog.hs:0 +#, fuzzy +msgid "Column(s)" +msgstr "Column" + +#: src/Controller/Dialog.hs:0 +msgid "contains non-numeric data" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "No columns selected" +msgstr "" + +#: src/Controller/Menu/File/NewClose.hs:0 +#, fuzzy +msgid "Save?" +msgstr "Save" + +#: src/Controller/Menu/File/Open.hs:0 src/Controller/Menu/File/Save.hs:0 +#, fuzzy +msgid "Tables" +msgstr "Table" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid file" +msgstr "" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid s-expression" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Column delimiter" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Row delimiter" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First column contains labels" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First row contains labels" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Strip whitespace" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Try parsing numbers" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +#, fuzzy +msgid "&Import" +msgstr "Export" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font size (pt)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font color" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Background color" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Padding (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (horizontal) (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (vertical) (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#, fuzzy +msgid "File type" +msgstr "File" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +#, fuzzy +msgid "&Export" +msgstr "Export" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "&Preview" +msgstr "" + +#: src/Controller/Menu/File/Export/ImageParameters.hs:0 +msgid "By extension" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/Common.hs:0 +msgid "Can not plot diagram" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Bar width" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Gaps" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Legend" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Box width" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +#, fuzzy +msgid "Add columns" +msgstr "Column" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add columns by" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows by" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Number \"n\"" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Labels \"label1[,label2,...]\"" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "&Add" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#, fuzzy +msgid "Descriptive Statistics" +msgstr "Statistics" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Mean" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Median" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Standard Deviation" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Maximum" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Minimum" +msgstr "" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency" +msgstr "" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Percentage" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Sum" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Count" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Abscissa column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Ordinate column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Data column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Aggregator" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Make totals" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No abscissa column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No ordinate column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No data column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "" +"Can not apply aggregator to selected data column (e.g. because of non-" +"numeric data)." +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Total" +msgstr "" + +#, fuzzy +#~ msgid "Save in" +#~ msgstr "Save" + +#~ msgid "As diagram" +#~ msgstr "As diagram" diff --git a/i18n/messages.pot b/i18n/messages.pot new file mode 100644 --- /dev/null +++ b/i18n/messages.pot @@ -0,0 +1,469 @@ +# Translation file +msgid "" +msgstr "" +"Project-Id-Version: PACKAGE VERSION\n" +"Report-Msgid-Bugs-To: \n" +"POT-Creation-Date: 2009-01-13 06:05-0800\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME \n" +"Language-Team: LANGUAGE \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#: src/Run.hs:0 +msgid "File" +msgstr "" + +#: src/Run.hs:0 +msgid "New" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/Open.hs:0 +msgid "Open" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Import" +msgstr "" + +#: src/Run.hs:0 +msgid "From CSV file" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/NewClose.hs:0 +msgid "Save as" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/Save.hs:0 +msgid "Save" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Export" +msgstr "" + +#: src/Run.hs:0 +msgid "As image" +msgstr "" + +#: src/Run.hs:0 +msgid "As bar chart" +msgstr "" + +#: src/Run.hs:0 +msgid "As box plot" +msgstr "" + +#: src/Run.hs:0 +msgid "Close" +msgstr "" + +#: src/Run.hs:0 +msgid "Close all" +msgstr "" + +#: src/Run.hs:0 +msgid "Quit" +msgstr "" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Table" +msgstr "" + +#: src/Run.hs:0 +msgid "Add" +msgstr "" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +msgid "Columns" +msgstr "" + +#: src/Run.hs:0 src/Controller/Dialog.hs:0 +msgid "Rows" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Table/Copy.hs:0 +msgid "Copy" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Table/Delete.hs:0 +msgid "Delete" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Table/Transpose.hs:0 +msgid "Transpose" +msgstr "" + +#: src/Run.hs:0 +msgid "Reevaluate all cells" +msgstr "" + +#: src/Run.hs:0 +msgid "Statistics" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency Distribution" +msgstr "" + +#: src/Run.hs:0 +msgid "Descriptive" +msgstr "" + +#: src/Run.hs:0 src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Pivot table" +msgstr "" + +#: src/Util/FileType.hs:0 +msgid "Unknown file type" +msgstr "" + +#: src/View/Dialog/Simple.hs:0 src/Model/CellContent.hs:0 +msgid "Error" +msgstr "" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Ok" +msgstr "" + +#: src/View/Dialog/Complex.hs:0 +msgid "&Cancel" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Parse error" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Unknown reference" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Reference loop" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Compile error" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Type error in" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "In" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Unknown identifier" +msgstr "" + +#: src/Model/CellContent.hs:0 +msgid "Empty" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "formula" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "argument" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "function call" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "number" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "string" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "cell range reference" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "subexpression" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "end of input" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "unexpected" +msgstr "" + +#: src/Model/CellExpression/Parser.hs:0 +msgid "expecting" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Any file" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Column" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "to" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Preview" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "Column(s)" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "contains non-numeric data" +msgstr "" + +#: src/Controller/Dialog.hs:0 +msgid "No columns selected" +msgstr "" + +#: src/Controller/Menu/File/NewClose.hs:0 +msgid "Save?" +msgstr "" + +#: src/Controller/Menu/File/Open.hs:0 src/Controller/Menu/File/Save.hs:0 +msgid "Tables" +msgstr "" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid file" +msgstr "" + +#: src/Controller/Menu/File/Open.hs:0 +msgid "Invalid s-expression" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Column delimiter" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Row delimiter" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First column contains labels" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "First row contains labels" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Strip whitespace" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "Try parsing numbers" +msgstr "" + +#: src/Controller/Menu/File/Import/Csv.hs:0 +msgid "&Import" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font size (pt)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Font color" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Background color" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Padding (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (horizontal) (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "Line width (vertical) (px)" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +msgid "File type" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "&Export" +msgstr "" + +#: src/Controller/Menu/File/Export/Image.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "&Preview" +msgstr "" + +#: src/Controller/Menu/File/Export/ImageParameters.hs:0 +msgid "By extension" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/Common.hs:0 +msgid "Can not plot diagram" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Bar width" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Gaps" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BarChart.hs:0 +msgid "Legend" +msgstr "" + +#: src/Controller/Menu/File/Export/Diagram/BoxPlot.hs:0 +msgid "Box width" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add columns" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add columns by" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Add rows by" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Number \"n\"" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "Labels \"label1[,label2,...]\"" +msgstr "" + +#: src/Controller/Menu/Table/Add.hs:0 +msgid "&Add" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +msgid "Descriptive Statistics" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Mean" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Median" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Standard Deviation" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Maximum" +msgstr "" + +#: src/Controller/Menu/Statistics/Descriptive.hs:0 +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Minimum" +msgstr "" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Frequency" +msgstr "" + +#: src/Controller/Menu/Statistics/FrequencyDistribution.hs:0 +msgid "Percentage" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Sum" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Count" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Abscissa column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Ordinate column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Data column" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Aggregator" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Make totals" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No abscissa column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No ordinate column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "No data column selected" +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "" +"Can not apply aggregator to selected data column (e.g. because of non-" +"numeric data)." +msgstr "" + +#: src/Controller/Menu/Statistics/Pivot.hs:0 +msgid "Total" +msgstr "" diff --git a/lhae.cabal b/lhae.cabal new file mode 100644 --- /dev/null +++ b/lhae.cabal @@ -0,0 +1,101 @@ +Name: lhae +Version: 0.0.2 +Cabal-Version: >= 1.6 +License: GPL +License-file: COPYING +Author: Alexander Bau +Maintainer: Alexander Bau +Homepage: http://www.imn.htwk-leipzig.de/~abau/lhae +Synopsis: Simple spreadsheet program +Build-Type: Custom +Category: Data +Description: lhae is a spreadsheet program. It features a simple formula language and some basic statistical methods. + +Extra-Source-Files: i18n/*.po i18n/*.pot + +x-gettext-domain-name: lhae +x-gettext-po-files: i18n/*.po +x-gettext-domain-def: __MESSAGE_CATALOG_DOMAIN__ +x-gettext-msg-cat-def: __MESSAGE_CATALOG_DIR__ + +Executable lhae + Main-Is: Main.hs + Hs-Source-Dirs: src + Ghc-options: -W -fno-warn-incomplete-patterns + + Extensions: CPP + + Build-Depends: base >= 4.2 && < 5.0 + , mtl >= 1.1 && < 2.0 + , wx >= 0.12 && < 1.0 + , wxcore >= 0.12 && < 1.0 + , parsec >= 2.1 && < 3.0 + , containers >= 0.3 && < 1.0 + , array >= 0.3 && < 1.0 + , filepath >= 1.1 && < 2.0 + , directory >= 1.0 && < 2.0 + , setlocale >= 0.0 && < 1.0 + , hgettext >= 0.1 && < 1.0 + , utf8-string >= 0.3 && < 1.0 + , process >= 1.0 && < 2.0 + + + Other-modules: + Util.Gnuplot + Util.DynArray + CellCoordinate + Model.GridHeader + Model.CellContent + Model.CellExpression.Evaluator.Common + Model.CellExpression.Evaluator.Math + Model.CellExpression.Evaluator + Model.Cell + Model.CellExpression.Parser + View.Component.TextWindow + Util.Sexp + Util.Sexpable + Controller.Menu.File.Export.Diagram.BarChartParameters + Controller.Menu.File.Export.Diagram.BoxPlotParameters + Controller.Menu.File.Import.CsvParameters + Util.Color + Util + View.Component.Grid + View.Component.Notebook + View + View.Modes + Model.Grid + Model + View.FormulaInput + View.GridPage + I18n + Util.FileType + Controller.Menu.File.Export.ImageParameters + View.Dialog.Complex + View.Dialog.Simple + Constants + Config + Controller + Controller.Cell + Controller.Menu.Table.Add + Controller.Grid + Controller.FormulaInput + Controller.Menu.Table.Reevaluate + Controller.Canonical + Controller.SaveConfig + Controller.Dialog + Controller.Menu.File.Open + Controller.Menu.File.Save + Controller.Menu.File.NewClose + Controller.Menu.File.Import.Csv + Controller.Menu.File.Export.Image + Controller.Menu.Table.Copy + Controller.Menu.Table.Delete + Controller.Menu.Table.Transpose + Controller.Menu.Statistics.FrequencyDistribution + Controller.Menu.Statistics.Descriptive + Controller.Menu.Statistics.Pivot + Controller.Menu.File.Export.Diagram.Common + Controller.Menu.File.Export.Diagram.BarChart + Controller.Menu.File.Export.Diagram.BoxPlot + Run + Main diff --git a/src/CellCoordinate.hs b/src/CellCoordinate.hs new file mode 100644 --- /dev/null +++ b/src/CellCoordinate.hs @@ -0,0 +1,11 @@ +module CellCoordinate (CellCoord,coordRange) + where + +type CellCoord = (Int,Int) + +coordRange :: (CellCoord,CellCoord) -> [CellCoord] +coordRange ((fromRow,fromCol),(toRow,toCol)) = + do row <- [fromRow..toRow] + col <- [fromCol..toCol] + return (row,col) + diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,94 @@ +module Config (Config,load,save,initI18n + ,getLastHandledPathForDialogs,setLastHandledPath + ,csvImportParameters + ,imageExportParameters,barChartExportParameters + ,boxPlotExportParameters + ) + where + +import System.Directory (createDirectoryIfMissing,doesFileExist) +import System.FilePath (takeDirectory) +import Data.Maybe (fromMaybe) +import qualified I18n +import Util.Sexp (Sexp(..),parseFile,prettyPrint) +import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp,recordFromSexp) +import qualified Controller.Menu.File.Export.ImageParameters as EImage +import qualified Controller.Menu.File.Export.Diagram.BarChartParameters as EBarChart +import qualified Controller.Menu.File.Export.Diagram.BoxPlotParameters as EBoxPlot +import qualified Controller.Menu.File.Import.CsvParameters as ICsv + +data Config = Config { lastHandledPath :: Maybe FilePath + , locale :: String + , csvImportParameters :: ICsv.Parameters + , imageExportParameters :: EImage.Parameters + , barChartExportParameters :: EBarChart.Parameters + , boxPlotExportParameters :: EBoxPlot.Parameters + } + +defaultConfig :: Config +defaultConfig = Config Nothing "" ICsv.defaultParams + EImage.defaultParams EBarChart.defaultParams + EBoxPlot.defaultParams + +instance Sexpable Config where + toSexp = recordToSexp + [ ("lastHandledPath", toSexp . lastHandledPath) + , ("locale", toSexp . locale) + , ("csvImportParameters", toSexp . csvImportParameters) + , ("imageExportParameters", toSexp . imageExportParameters) + , ("barChartExportParameters", toSexp . barChartExportParameters) + , ("boxPlotExportParameters", toSexp . boxPlotExportParameters) + ] + fromSexp = recordFromSexp setOption defaultConfig + +setOption :: Config -> Sexp -> PSE Config +setOption config sexp = + case sexp of + List [Atom "lastHandledPath",path] -> do + option <- fromSexp path + return $ config {lastHandledPath = option} + List [Atom "locale",locale] -> do + option <- fromSexp locale + return $ config {locale = option} + List [Atom "csvImportParameters",params] -> do + option <- fromSexp params + return $ config {csvImportParameters = option} + List [Atom "imageExportParameters",params] -> do + option <- fromSexp params + return $ config {imageExportParameters = option} + List [Atom "barChartExportParameters",params] -> do + option <- fromSexp params + return $ config {barChartExportParameters = option} + List [Atom "boxPlotExportParameters",params] -> do + option <- fromSexp params + return $ config {boxPlotExportParameters = option} + _ -> unexpected sexp + +load :: FilePath -> IO (Either String Config) +load filePath = do + fileExist <- doesFileExist filePath + if fileExist + then do + result <- parseFile filePath + let invalidConfig msg = return $ Left $ "Invalid config file: " ++ msg + case result of + Left error -> invalidConfig error + Right sexp -> case fromSexp sexp of + Left error -> invalidConfig $ show error + Right config -> return $ Right config + else return $ Right defaultConfig + +save :: FilePath -> Config -> IO () +save filePath config = do + createDirectoryIfMissing False $ takeDirectory filePath + writeFile filePath $ prettyPrint $ toSexp config + +initI18n :: Config -> IO () +initI18n = I18n.initI18n . locale + +getLastHandledPathForDialogs :: Config -> FilePath +getLastHandledPathForDialogs = (fromMaybe "") . lastHandledPath + +setLastHandledPath :: FilePath -> Config -> Config +setLastHandledPath filePath config = + config {lastHandledPath = Just filePath} diff --git a/src/Constants.hs b/src/Constants.hs new file mode 100644 --- /dev/null +++ b/src/Constants.hs @@ -0,0 +1,23 @@ +module Constants (programName,programVersion,configFilePath + ,tmpFilePath + ) + where + +import Control.Applicative ((<$>)) +import System.Directory (getAppUserDataDirectory,getTemporaryDirectory) +import System.FilePath (combine,()) + +programName :: String +programName = "lhae" + +programVersion :: String +programVersion = "0.0" + +configFilePath :: IO FilePath +configFilePath = do + appDir <- getAppUserDataDirectory programName + return $ appDir "config" + +tmpFilePath :: String -> IO FilePath +tmpFilePath fileName = + combine `flip` fileName <$> getTemporaryDirectory diff --git a/src/Controller.hs b/src/Controller.hs new file mode 100644 --- /dev/null +++ b/src/Controller.hs @@ -0,0 +1,50 @@ +module Controller (CtrlData,Controller,new,onView,onModel,onGridView + ,onGridModel,setOnConfig,getFromConfig + ,currentConfig) + where + +import Control.Monad.Reader +import Data.IORef +import Config (Config) +import View (View) +import qualified View as V +import qualified View.Component.Grid as GridV +import Model (Model) +import qualified Model as M +import qualified Model.Grid as GridM + +data CtrlData = CtrlData { config :: IORef Config + , model :: Model + , view :: View + } + +type Controller a = ReaderT CtrlData IO a + +new :: Config -> Model -> View -> IO CtrlData +new config model view = do + configRef <- newIORef config + return $ CtrlData configRef model view + +currentConfig :: Controller Config +currentConfig = asks config >>= liftIO . readIORef + +onView :: (View -> IO a) -> Controller a +onView f = asks view >>= liftIO . f + +onModel :: (Model -> IO a) -> Controller a +onModel f = asks model >>= liftIO . f + +onGridView :: (GridV.Grid -> IO a) -> Controller a +onGridView f = asks view >>= liftIO . flip V.onGrid f + +onGridModel :: (GridM.Grid -> IO a) -> Controller a +onGridModel f = asks model >>= liftIO . flip M.onGrid f + +setOnConfig :: (Config -> Config) -> Controller () +setOnConfig setter = do + config <- asks config + liftIO $ modifyIORef config setter + +getFromConfig :: (Config -> a) -> Controller a +getFromConfig getter = + asks config >>= liftIO . readIORef >>= return . getter diff --git a/src/Controller/Canonical.hs b/src/Controller/Canonical.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Canonical.hs @@ -0,0 +1,66 @@ +module Controller.Canonical (Row,Column,RowData,ColumnData + ,getRow,getColumn + ,addRow,addColumn,addRow',addColumn' + ,writeRowData,writeColumnData) + where + +import Control.Monad (forM) +import Controller (Controller,onGridView) +import Controller.Cell (getInput) +import Controller.Grid (writeCells) +import qualified Controller.Menu.Table.Add as Add +import View.Component.Grid (numDataRows,numDataColumns,getColumnLabel + ,getRowLabel) +import CellCoordinate (coordRange) + +type ColumnData = [String] +type Column = (String,ColumnData) +type RowData = [String] +type Row = (String,RowData) + +getRow :: Int -> Controller Row +getRow row = do + label <- onGridView $ getRowLabel row + cells <- do cols <- onGridView numDataColumns + forM [0..cols-1] $ \c -> getInput (row,c) + return (label,cells) + +getColumn :: Int -> Controller Column +getColumn col = do + label <- onGridView $ getColumnLabel col + cells <- do rows <- onGridView numDataRows + forM [0..rows-1] $ \r -> getInput (r,col) + return (label,cells) + +addColumn :: (Maybe String,ColumnData) -> Controller () +addColumn (label,cells) = do + index <- onGridView numDataColumns + Add.addColumn label + writeColumnData index cells + +addColumn' :: Column -> Controller () +addColumn' (label,cells) = addColumn (Just label,cells) + +addRow :: (Maybe String,RowData) -> Controller () +addRow (label,cells) = do + index <- onGridView numDataRows + Add.addRow label + writeRowData index cells + +addRow' :: Row -> Controller () +addRow' (label,cells) = addRow (Just label,cells) + +writeColumnData :: Int -> ColumnData -> Controller () +writeColumnData index columnData = do + rowsInView <- onGridView numDataRows + let range = let numRows = max rowsInView $ length columnData + in coordRange ((0,index),(numRows-1,index)) + writeCells $ zip range columnData + +writeRowData :: Int -> RowData -> Controller () +writeRowData index rowData = do + colsInView <- onGridView numDataColumns + let range = let numCols = max colsInView $ length rowData + in coordRange ((index,0),(index,numCols-1)) + writeCells $ zip range rowData + diff --git a/src/Controller/Cell.hs b/src/Controller/Cell.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Cell.hs @@ -0,0 +1,32 @@ +module Controller.Cell (getInput,updateInView + ,showContent,showSelectedContent) + where + +import Control.Applicative ((<$>)) +import Control.Monad (forM_) +import Controller (Controller,onGridModel,onGridView,onView) +import View.Component.Grid (setValue,getCursorPos) +import View.FormulaInput (logString) +import Model.Grid (getCell) +import Model.Cell (showValue,input,value) +import Model.CellContent (CellValue(Error)) +import CellCoordinate (CellCoord) + +getInput :: CellCoord -> Controller String +getInput coord = input <$> (onGridModel $ getCell coord) + +updateInView :: [CellCoord] -> Controller () +updateInView coords = + forM_ coords $ \c -> do cell <- onGridModel $ getCell c + onGridView $ setValue c $ showValue cell + +showContent :: CellCoord -> Controller () +showContent coords = do + cell <- onGridModel $ getCell coords + let info = case value cell of + Error e -> show e + _ -> input cell + onView $ logString info + +showSelectedContent :: Controller () +showSelectedContent = onGridView getCursorPos >>= showContent diff --git a/src/Controller/Dialog.hs b/src/Controller/Dialog.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Dialog.hs @@ -0,0 +1,135 @@ +module Controller.Dialog (openFileDialog,saveFileDialog + ,chooseColumnDialog + ,chooseColumnsDialog + ,chooseRowsDialog + ,chooseColumnsAndTableDialog +-- ,pushColorButton + ,previewImage,warning + ,nonNumericDataWarningText,nonNumericDataWarning + ,noColumnsSelectedText,noColumnsSelected) + where + +import Control.Applicative ((<$>)) +import Graphics.UI.WX (Prop ((:=)),on) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import System.FilePath (takeDirectory) +import Controller (Controller,onView,onGridView,setOnConfig,getFromConfig) +import View (View,frame) +import View.Component.Grid (getColumnLabels,getRowLabels) +import View.GridPage (captions) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,okButton,cancelButton) +import qualified View.Dialog.Simple as Simple +import Config (getLastHandledPathForDialogs,setLastHandledPath) +import Util (justWhen) +import I18n (__) + +openFileDialog :: String -> [(String,[String])] -> Controller (Maybe FilePath) +openFileDialog caption filters = do + lastPath <- getFromConfig getLastHandledPathForDialogs + result <- onView $ \view -> + WX.fileOpenDialog (frame view) True True caption + ((__ "Any file",["*"]) : filters) lastPath "" + justWhen result $ setOnConfig . setLastHandledPath . takeDirectory + return result + +saveFileDialog :: String -> [(String,[String])] -> Controller (Maybe FilePath) +saveFileDialog caption filters = do + lastPath <- getFromConfig getLastHandledPathForDialogs + result <- onView $ \view -> + WX.fileSaveDialog (frame view) True True caption + ((__ "Any file",["*"]) : filters) lastPath "" + justWhen result $ setOnConfig . setLastHandledPath . takeDirectory + return result + +chooseOneFromListDialog :: String -> String -> [String] -> Controller (Maybe Int) +chooseOneFromListDialog dialogCaption listCaption list = + let listBox = SingleListBox list id $ \_ -> id + dialog = Modifier Margin $ Column + [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox + , Modifier Center $ Row [ okButton (), cancelButton]] + in + maybe Nothing id + <$> (onView $ showSimpleDialog dialogCaption dialog Nothing) + +chooseSomeFromListDialog :: String -> String -> [String] -> Controller [Int] +chooseSomeFromListDialog dialogCaption listCaption list = + let listBox = MultiListBox list id $ \_ -> id + dialog = Modifier Margin $ Column + [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox + , Modifier Center $ Row [ okButton (), cancelButton]] + in + maybe [] id <$> (onView $ showSimpleDialog dialogCaption dialog []) + +chooseColumnDialog :: String -> Controller (Maybe Int) +chooseColumnDialog caption = + onGridView getColumnLabels + >>= chooseOneFromListDialog caption (__ "Column") + +chooseColumnsDialog :: String -> Controller [Int] +chooseColumnsDialog caption = + onGridView getColumnLabels + >>= chooseSomeFromListDialog caption (__ "Columns") + +chooseRowsDialog :: String -> Controller [Int] +chooseRowsDialog caption = + onGridView getRowLabels + >>= chooseSomeFromListDialog caption (__ "Rows") + +chooseSomethingAndTableDialog :: String -> String -> [String] + -> Controller (Maybe ([Int],Maybe Int)) +chooseSomethingAndTableDialog dialogCaption someCaption something = do + tableCaptions <- onView captions + let someList = MultiListBox something fst + $ \(_,table) some -> (some,table) + tableList = SingleListBox tableCaptions snd + $ \(some,_) table -> (some,table) + dialog = Modifier Margin $ Column + [ Modifier Center $ Row + [ Modifier (Boxed someCaption) $ Modifier HFill $ Widget someList + , Label $ __ "to" + , Modifier (Boxed $ __ "Table") $ Widget tableList + ] + , Modifier Center $ Row + [ okButton (), cancelButton]] + onView $ showSimpleDialog dialogCaption dialog ([],Nothing) + +chooseColumnsAndTableDialog :: String + -> Controller (Maybe ([Int],Maybe Int)) +chooseColumnsAndTableDialog caption = + onGridView getColumnLabels + >>= chooseSomethingAndTableDialog caption (__ "Columns") + +previewImage :: WXC.Bitmap () -> Controller () +previewImage bitmap = + let drawBitmap dc _ = WX.drawBitmap dc bitmap WX.pointZero False [] + makeWindow dialog = do + size <- do width <- WXC.bitmapGetWidth bitmap + height <- WXC.bitmapGetHeight bitmap + return (width,height) + + WX.scrolledWindow dialog [ WX.virtualSize := uncurry WX.sz size + , WX.clientSize := uncurry WX.sz size + , on WX.paint := drawBitmap] + dialog = Modifier Margin $ Column + [ Widget $ ScrolledWindow makeWindow + , Modifier Center $ okButton ()] + in + onView (showSimpleDialog (__ "Preview") dialog ()) >> return () + +warning :: String -> Controller () +warning = onView . Simple.warning + +nonNumericDataWarningText :: [String] -> String +nonNumericDataWarningText labels = + unwords [__ "Column(s)",show labels,__ "contains non-numeric data"] + +nonNumericDataWarning :: [String] -> Controller () +nonNumericDataWarning = warning . nonNumericDataWarningText + +noColumnsSelectedText :: String +noColumnsSelectedText = __ "No columns selected" + +noColumnsSelected :: Controller () +noColumnsSelected = warning noColumnsSelectedText diff --git a/src/Controller/FormulaInput.hs b/src/Controller/FormulaInput.hs new file mode 100644 --- /dev/null +++ b/src/Controller/FormulaInput.hs @@ -0,0 +1,15 @@ +module Controller.FormulaInput (eventHandler) + where + +import Controller (Controller,onView,onGridView) +import Controller.Cell (showSelectedContent) +import Controller.Grid (writeCell) +import View.FormulaInput (formula) +import View.Component.Grid (getCursorPos) + +eventHandler :: Controller () +eventHandler = do + input <- onView formula + coords <- onGridView $ getCursorPos + writeCell coords input + showSelectedContent diff --git a/src/Controller/Grid.hs b/src/Controller/Grid.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Grid.hs @@ -0,0 +1,163 @@ +module Controller.Grid (new,changePageEventHandler + ,setFilePath,deleteCurrent,changePageTo + ,writeCell,writeCells + ,updateRowLabel,updateColumnLabel + ,updateRowLabels,updateColumnLabels + ,markAsSaved) + where + +import Control.Monad.Reader +import qualified Graphics.UI.WXCore as WXC +import Controller (Controller,onView,onModel,onGridModel,onGridView) +import Controller.Cell (updateInView,showContent,showSelectedContent) +import Controller.Menu.Table.Add (addRow,addColumn) +import View (onGrid,info) +import qualified View.GridPage as GridPage +import View.Component.Grid (getRowLabel,getColumnLabel,numDataRows + ,numDataColumns) +import qualified View.Component.Grid as GridV +import View.Dialog.Simple (input) +import View.Modes (formulaMode) +import qualified Model as M +import qualified Model.Grid as GridM +import qualified Model.Cell as Cell +import System.FilePath (takeFileName) +import Util (justWhen) +import CellCoordinate (CellCoord) +import View.FormulaInput (logString) + +new :: Maybe FilePath -> Controller () +new filePath = + let addModel id = + do viewInfo <- onView $ return . info + onModel $ M.addGrid id viewInfo + justWhen filePath $ onGridModel . GridM.setFilePath + + addView grid = + do onView $ GridPage.add (fmap takeFileName filePath) grid + ctrl <- ask + onView $ \view -> + onGrid view $ \grid -> + do WXC.gridOnGridEvent grid $ \event -> + runReaderT (eventHandler event) ctrl + WXC.windowOnKeyDown grid + $ GridPage.keyEventHandler view + in do + (gridViewId,gridView) <- onView GridPage.new + addModel gridViewId + addView gridView + +setFilePath :: FilePath -> Controller () +setFilePath filePath = do + onView $ GridPage.setCurrentCaption $ takeFileName filePath + onGridModel $ GridM.setFilePath filePath + +markAsUnsaved :: Controller () +markAsUnsaved = do + caption <- onView GridPage.getCurrentCaption + when (head caption /= '*') + $ onView $ GridPage.setCurrentCaption $ '*':caption + +markAsSaved :: Controller () +markAsSaved = do + x:xs <- onView GridPage.getCurrentCaption + when (x == '*') $ onView $ GridPage.setCurrentCaption xs + +deleteCurrent :: Controller () +deleteCurrent = do + onModel M.deleteCurrent + onView GridPage.deleteCurrent + next <- onView GridPage.currentSelectionId + case next of + Just n -> do onModel $ M.setCurrent n + showSelectedContent + Nothing -> onView $ logString "" + +eventHandler :: WXC.EventGrid -> Controller () +eventHandler event = + case event of + WXC.GridLabelMouse row col (WXC.MouseLeftDown {}) -> + do extendWhenClicked (row,col) + liftIO WXC.propagateEvent + WXC.GridLabelMouse row col (WXC.MouseLeftDClick {}) -> + do value <- if col == -1 + then onGridView $ getRowLabel row + else onGridView $ getColumnLabel col + value' <- onView $ input "Label" value + justWhen value' $ if col == -1 + then updateRowLabel row + else updateColumnLabel col + + WXC.GridCellMouse row col (WXC.MouseLeftDown {}) -> + do extendWhenClicked (row,col) + liftIO WXC.propagateEvent + WXC.GridEditorShown row col veto -> + do extendWhenClicked (row,col) + cell <- onGridModel $ GridM.getCell (row,col) + onView (formulaMode (row,col) $ Cell.input cell) + liftIO veto + WXC.GridCellSelect row col _ -> + do showContent (row,col) + liftIO WXC.propagateEvent + _ -> liftIO WXC.propagateEvent + +changePageEventHandler :: Controller () +changePageEventHandler = do + Just n <- onView $ GridPage.currentSelectionNum + Just id <- onView $ GridPage.currentSelectionId + onView $ GridPage.setCurrent n + onModel $ M.setCurrent id + showSelectedContent + +changePageTo :: Int -> Controller () +changePageTo = onView . GridPage.fireSelectionEvent + +extendWhenClicked :: CellCoord -> Controller () +extendWhenClicked (row,column) = do + rows <- onGridView GridV.numDataRows + cols <- onGridView GridV.numDataColumns + when (row == rows) $ addRow Nothing + when (column == cols) $ addColumn Nothing + +updateRowLabel,updateColumnLabel :: Int -> String -> Controller () +updateRowLabel n to = do + changed <- onGridModel $ GridM.updateRowLabel n to + onGridView $ GridV.setRowLabel n to + updateInView changed + showSelectedContent + markAsUnsaved +updateColumnLabel n to = do + changed <- onGridModel $ GridM.updateColumnLabel n to + onGridView $ GridV.setColumnLabel n to + updateInView changed + showSelectedContent + markAsUnsaved + +updateRowLabels,updateColumnLabels :: [String] -> Controller () +updateRowLabels labels = do + n <- onGridView numDataRows + forM_ (zip [0..n-1] labels) $ uncurry updateRowLabel +updateColumnLabels labels = do + n <- onGridView numDataColumns + forM_ (zip [0..n-1] labels) $ uncurry updateColumnLabel + +writeCell :: CellCoord -> String -> Controller () +writeCell coord input = writeCells [(coord,input)] + +writeCells :: [(CellCoord,String)] -> Controller () +writeCells [] = return () +writeCells cells = + let (maxRow,maxCol) = maximum $ map fst cells + in do + rows <- onGridView numDataRows + cols <- onGridView numDataColumns + + forM_ [rows..maxRow] $ \_ -> addRow Nothing + forM_ [cols..maxCol] $ \_ -> addColumn Nothing + + forM_ cells $ \(coord,input) -> do + changed <- onGridModel $ GridM.setCell coord input + updateInView changed + + markAsUnsaved + diff --git a/src/Controller/Menu/File/Export/Diagram/BarChart.hs b/src/Controller/Menu/File/Export/Diagram/BarChart.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Diagram/BarChart.hs @@ -0,0 +1,99 @@ +module Controller.Menu.File.Export.Diagram.BarChart (eventHandler) + where + +import Control.Applicative ((<$>)) +import Control.Monad (when) +import Text.Printf (printf) +import Data.List (transpose) +import Controller (Controller,getFromConfig,onView + ,onGridView,setOnConfig) +import Controller.Menu.File.Export.Diagram.BarChartParameters + (Parameters(..),gnuplotLegend,legendFromInt,intFromLegend,legendList) +import qualified Controller.Menu.File.Export.Diagram.Common as Common +import Controller.Dialog (nonNumericDataWarningText + ,noColumnsSelectedText,saveFileDialog) +import Config (barChartExportParameters) +import View.Component.Grid (getRowLabels,getColumnLabels) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showDialog,cancelButton) +import Util.FileType (justPngWildcard) +import I18n (__) + +data Action = Preview | Export + +eventHandler :: Controller () +eventHandler = getFromConfig barChartExportParameters + >>= \params -> eventHandlerWith $ params {columns = []} + +eventHandlerWith :: Parameters -> Controller () +eventHandlerWith initParams = do + result <- do d <- dialog <$> onGridView getColumnLabels + onView $ showDialog (__ "Export") d initParams + case result of + Nothing -> return () + Just (params,Export) -> + do saveFile <- saveFileDialog (__ "Export") justPngWildcard + setOnConfig $ \c -> c {barChartExportParameters = params} + case saveFile of + Nothing -> eventHandlerWith params + Just imageFilePath -> + do success <- Common.plot (gpFileContent params) + (dataFileContent params) imageFilePath + when (not success) $ eventHandlerWith params + + Just (params,Preview) -> + do setOnConfig $ \c -> c {barChartExportParameters = params} + _ <- Common.showPreview (gpFileContent params) + (dataFileContent params) + eventHandlerWith params + +dialog :: [String] -> Layout Parameters Action +dialog columnLabels = + let setCols p cols = p {columns = cols} + setBarWidth p w = p {barWidth = w} + setGaps p g = p {gaps = g} + setLegend p i = p {legend = legendFromInt i} + in + Modifier Margin $ Column + [ Row [ Grid [[ Label $ __ "Bar width" + , Widget $ NumberEntry barWidth setBarWidth] + ,[ Label $ __ "Gaps" + , Widget $ Spinner 0 maxBound gaps setGaps] + ,[ Label $ __ "Legend" + , Widget $ Choice legendList + (intFromLegend . legend) setLegend] + ] + , Modifier Center $ Modifier (Boxed $ __ "Columns") + $ Widget $ MultiListBox columnLabels columns setCols + ] + , Modifier Center $ Row + [ Widget $ DefaultButton (__ "&Export") Export + , Widget $ Button (__ "&Preview") Preview + , cancelButton]] + +dataFileContent :: Parameters -> Controller (Either String String) +dataFileContent (Parameters {columns = []}) = return $ Left noColumnsSelectedText +dataFileContent (Parameters {columns = cols}) = do + numericColumns <- Common.getNumericColumns cols + case numericColumns of + Left nonNumeric -> return $ Left $ nonNumericDataWarningText nonNumeric + Right columns -> + do rowLabels <- onGridView getRowLabels + let firstLine = "\"\"" : rowLabels + columnToLine (label,values) = label:(map show values) + dataLines = map columnToLine columns + lines = transpose $ firstLine : dataLines + return $ Right $ unlines $ map unwords lines + +gpFileContent :: Parameters -> FilePath -> String +gpFileContent params dataFilePath = + printf (unlines + [ "set key %s top" + , "set style data histogram" + , "set style histogram clustered gap %d" + , "set boxwidth %f" + , "set style fill solid" + , "plot for [COL=2:%d] \"%s\" using COL:xtic(1) title columnhead" + ]) + (gnuplotLegend $ legend params) (gaps params) (barWidth params) + (1 + (length $ columns params)) dataFilePath diff --git a/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs b/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Diagram/BarChartParameters.hs @@ -0,0 +1,69 @@ +module Controller.Menu.File.Export.Diagram.BarChartParameters + (Parameters(..),defaultParams,LegendPosition(..) + ,legendList,legendFromInt,intFromLegend,gnuplotLegend) + where + +import Prelude hiding (Left,Right) +import Util.Sexp (Sexp(..)) +import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp + ,recordFromSexp) + +data LegendPosition = Left | Center | Right deriving (Show,Read) +type Legend = Maybe LegendPosition + +data Parameters = Parameters { columns :: [Int] + , barWidth :: Double + , gaps :: Int + , legend :: Legend + } + +defaultParams :: Parameters +defaultParams = Parameters [] 1.0 1 (Just Right) + +legendList :: [String] +legendList = ["None","Left","Center","Right"] + +legendFromInt :: Int -> Legend +legendFromInt n = case n of 0 -> Nothing + 1 -> Just Left + 2 -> Just Center + 3 -> Just Right + +intFromLegend :: Legend -> Int +intFromLegend legend = case legend of Nothing -> 0 + Just Left -> 1 + Just Center -> 2 + Just Right -> 3 + +gnuplotLegend :: Legend -> String +gnuplotLegend legend = case legend of Nothing -> "off" + Just Left -> "left" + Just Center -> "center" + Just Right -> "right" + +instance Sexpable LegendPosition where + toSexp = toSexp . show + fromSexp (Atom a) = return $ read a + fromSexp sexp = unexpected sexp + +instance Sexpable Parameters where + toSexp = recordToSexp + [ ("barWidth", toSexp . barWidth) + , ("gaps", toSexp . gaps) + , ("legend", toSexp . legend) + ] + fromSexp = recordFromSexp setParam defaultParams + +setParam :: Parameters -> Sexp -> PSE Parameters +setParam p sexp = + case sexp of + List [Atom "barWidth",w] -> do + parameter <- fromSexp w + return $ p {barWidth = parameter} + List [Atom "gaps",g] -> do + parameter <- fromSexp g + return $ p {gaps = parameter} + List [Atom "legend",legend] -> do + parameter <- fromSexp legend + return $ p {legend = parameter} + _ -> unexpected sexp diff --git a/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs b/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Diagram/BoxPlot.hs @@ -0,0 +1,99 @@ +module Controller.Menu.File.Export.Diagram.BoxPlot (eventHandler) + where + +import Control.Applicative ((<$>)) +import Control.Monad (when) +import Text.Printf (printf) +import Data.List (sort) +import Controller (Controller,getFromConfig,onView + ,onGridView,setOnConfig) +import Controller.Menu.File.Export.Diagram.BoxPlotParameters (Parameters(..)) +import qualified Controller.Menu.File.Export.Diagram.Common as Common +import Controller.Dialog (nonNumericDataWarningText + ,noColumnsSelectedText,saveFileDialog) +import Config (boxPlotExportParameters) +import View.Component.Grid (getColumnLabels) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showDialog,cancelButton) +import Util.FileType (justPngWildcard) +import qualified Model.CellExpression.Evaluator.Math as Math +import I18n (__) + +data Action = Preview | Export + +eventHandler :: Controller () +eventHandler = getFromConfig boxPlotExportParameters + >>= \params -> eventHandlerWith $ params {columns = []} + +eventHandlerWith :: Parameters -> Controller () +eventHandlerWith initParams = do + result <- do d <- dialog <$> onGridView getColumnLabels + onView $ showDialog (__ "Export") d initParams + case result of + Nothing -> return () + Just (params,Export) -> + do saveFile <- saveFileDialog (__ "Export") justPngWildcard + setOnConfig $ \c -> c {boxPlotExportParameters = params} + case saveFile of + Nothing -> eventHandlerWith params + Just imageFilePath -> + do success <- Common.plot (gpFileContent params) + (dataFileContent params) imageFilePath + when (not success) $ eventHandlerWith params + + Just (params,Preview) -> + do setOnConfig $ \c -> c {boxPlotExportParameters = params} + _ <- Common.showPreview (gpFileContent params) + (dataFileContent params) + eventHandlerWith params + +dialog :: [String] -> Layout Parameters Action +dialog columnLabels = + let setCols p cols = p {columns = cols} + setBoxWidth p w = p {boxWidth = w} + setGaps p g = p {gaps = g} + in + Modifier Margin $ Column + [ Row [ Grid [[ Label $ __ "Box width" + , Widget $ NumberEntry boxWidth setBoxWidth] + ,[ Label $ __ "Gaps" + , Widget $ Spinner 1 maxBound gaps setGaps] + ] + , Modifier Center $ Modifier (Boxed $ __ "Columns") + $ Widget $ MultiListBox columnLabels columns setCols + ] + , Modifier Center $ Row + [ Widget $ DefaultButton (__ "&Export") Export + , Widget $ Button (__ "&Preview") Preview + , cancelButton]] + +dataFileContent :: Parameters -> Controller (Either String String) +dataFileContent (Parameters {columns = []}) = return $ Left noColumnsSelectedText +dataFileContent (Parameters {columns = cols,gaps = gaps}) = do + numericColumns <- Common.getNumericColumns cols + case numericColumns of + Left nonNumeric -> return $ Left $ nonNumericDataWarningText nonNumeric + Right columns -> + let toLine (i,(label,values)) = + let sorted = sort values + max = maximum sorted + min = head sorted + firstQuartile = Math.firstQuartileSorted sorted + thirdQuartile = Math.thirdQuartileSorted sorted + median = Math.medianSorted sorted + values' = [firstQuartile,min,max,thirdQuartile,median] + in unwords $ [show label,show i] ++ (map show values') + in + return $ Right $ unlines $ map toLine $ zip [0,gaps..] columns + +gpFileContent :: Parameters -> FilePath -> String +gpFileContent params dataFilePath = + printf (unlines + [ "set key off" + , "set xrange [%d:%d]" + , "set boxwidth %f" + , "plot '%s' using 2:3:4:5:6:xtic(1) with candlesticks whiskerbars," + ++ "'' using 2:7:7:7:7 with candlesticks" + ]) + (-(gaps params)) (length (columns params) + (gaps params) - 1) + (boxWidth params) dataFilePath diff --git a/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs b/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Diagram/BoxPlotParameters.hs @@ -0,0 +1,33 @@ +module Controller.Menu.File.Export.Diagram.BoxPlotParameters + (Parameters(..),defaultParams) + where + +import Util.Sexp (Sexp(..)) +import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp + ,recordFromSexp) + +data Parameters = Parameters { columns :: [Int] + , boxWidth :: Double + , gaps :: Int + } + +defaultParams :: Parameters +defaultParams = Parameters [] 0.5 1 + +instance Sexpable Parameters where + toSexp = recordToSexp + [ ("boxWidth", toSexp . boxWidth) + , ("gaps", toSexp . gaps) + ] + fromSexp = recordFromSexp setParam defaultParams + +setParam :: Parameters -> Sexp -> PSE Parameters +setParam p sexp = + case sexp of + List [Atom "boxWidth",w] -> do + parameter <- fromSexp w + return $ p {boxWidth = parameter} + List [Atom "gaps",g] -> do + parameter <- fromSexp g + return $ p {gaps = parameter} + _ -> unexpected sexp diff --git a/src/Controller/Menu/File/Export/Diagram/Common.hs b/src/Controller/Menu/File/Export/Diagram/Common.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Diagram/Common.hs @@ -0,0 +1,75 @@ +module Controller.Menu.File.Export.Diagram.Common + (MakeGnuPlotFile,showPreview,plot,getNumericColumns) + where + +import Control.Monad (forM,when) +import Control.Monad.Trans (liftIO) +import Data.Either (partitionEithers) +import System.Exit (ExitCode(ExitSuccess,ExitFailure)) +import qualified Graphics.UI.WXCore as WXC +import Controller (Controller,onGridModel,onGridView) +import Controller.Dialog (previewImage,warning) +import Constants (tmpFilePath,programName) +import qualified Util.Gnuplot as GP +import Model.CellExpression.Evaluator.Common (getNumList) +import Model.Grid (getColumnValues) +import View.Component.Grid (getColumnLabel) +import Util ((<.>)) +import I18n (__) + +type MakeGnuPlotFile = FilePath -> String +type MakeDataFile = Controller (Either String String) + +getTmpImageFilePath,getTmpDataFilePath,getTmpGpFilePath :: Controller FilePath +getTmpImageFilePath = liftIO $ tmpFilePath $ programName ++ ".gnuplot.png" +getTmpDataFilePath = liftIO $ tmpFilePath $ programName ++ ".gnuplot.data" +getTmpGpFilePath = liftIO $ tmpFilePath $ programName ++ ".gnuplot" + +showPreview :: MakeGnuPlotFile -> MakeDataFile -> Controller Bool +showPreview makeGpFile makeDataFile = do + tmpImageFilePath <- getTmpImageFilePath + success <- plot makeGpFile makeDataFile tmpImageFilePath + when success $ do + bitmap <- liftIO $ WXC.imageCreateFromFile tmpImageFilePath + >>= WXC.imageConvertToBitmap + previewImage bitmap + return success + +plot :: MakeGnuPlotFile -> MakeDataFile -> FilePath -> Controller Bool +plot makeGpFile makeDataFile imageFilePath = do + dataFilePath <- getTmpDataFilePath + gpFilePath <- getTmpGpFilePath + + makeDataFileContentResult <- makeDataFile + + case makeDataFileContentResult of + Left msg -> warning msg >> return False + Right dataFileContent -> + let dataFile = (dataFilePath,dataFileContent) + gpFileContent = unlines + [ "set terminal png" + , "set output \"" ++ imageFilePath ++ "\"" + , makeGpFile dataFilePath] + gpFile = (gpFilePath,gpFileContent) + in do + result <- liftIO $ GP.run gpFile [dataFile] + + case result of + ExitSuccess -> return True + ExitFailure _ -> + do warning $ concat [__ "Can not plot diagram",": ",show result] + return False + +getNumericColumns :: [Int] -> Controller (Either [String] [(String,[Double])]) +getNumericColumns cols = do + result <- forM cols $ \i -> do + tmp <- onGridModel $ (getNumList <.> getColumnValues i) + label <- onGridView $ getColumnLabel i + case tmp of + Left _ -> return $ Left label + Right nums -> return $ Right (label,nums) + + case partitionEithers result of + (x:xs,_) -> return $ Left (x:xs) + ([],columns) -> return $ Right columns + diff --git a/src/Controller/Menu/File/Export/Image.hs b/src/Controller/Menu/File/Export/Image.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/Image.hs @@ -0,0 +1,247 @@ +module Controller.Menu.File.Export.Image (eventHandler) + where + +import Control.Monad (foldM,foldM_,when) +import Control.Monad.Trans (liftIO) +import Control.Applicative ((<$>)) +import Foreign (Ptr,malloc,peek,nullPtr) +import qualified Graphics.UI.WXCore as WXC +import Config (imageExportParameters) +import Controller (Controller,onGridView,onView,getFromConfig,setOnConfig) +import View.Component.Grid (getColumnValues,numDataRows,numDataColumns + ,getColumnLabel,getRowLabel) +import Controller.Menu.File.Export.ImageParameters + (Parameters(..),fileTypeList,fileTypeFromInt,intFromFileType) +import Controller.Dialog (saveFileDialog,previewImage,warning) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showDialog,cancelButton) +import Util (justWhen) +import Util.FileType (fromFilePath,wildcard,bitmapType,unknownFileTypeIn) +import Util.Color (toWXColor) +import I18n (__) + +data Action = Export | Preview + +eventHandler :: Controller () +eventHandler = getFromConfig imageExportParameters >>= eventHandlerWith + +eventHandlerWith :: Parameters -> Controller () +eventHandlerWith storedParams = do + result <- onView $ showDialog (__ "Export") dialog storedParams + justWhen result $ \(params,action) -> + case action of + Export -> + do saveFile <- saveFileDialog (__ "Export") wildcard + setOnConfig $ \c -> c {imageExportParameters = params} + case saveFile of + Nothing -> eventHandlerWith params + Just file -> writeImage params file + Preview -> + do showPreview params + setOnConfig $ \c -> c {imageExportParameters = params} + eventHandlerWith params + +dialog :: Layout Parameters Action +dialog = + let setFontSize p s = p {fontPointSize = s} + setFontColor p c = p {fontColor = c} + setBackgroundColor p c = p {backgroundColor = c} + setPadding p pa = p {padding = pa} + setRowLineWidth p w = p {rowLineWidth = w} + setColLineWidth p w = p {colLineWidth = w} + setFileType p f = p {fileType = fileTypeFromInt f} + in + Modifier Margin $ Column + [ Grid [[ Label $ __ "Font size (pt)" + , Widget $ Spinner 1 maxBound fontPointSize setFontSize] + ,[ Label $ __ "Font color" + , Widget $ ColorButton fontColor setFontColor] + ,[ Label $ __ "Background color" + , Widget $ ColorButton backgroundColor setBackgroundColor] + ,[ Label $ __ "Padding (px)" + , Widget $ Spinner 0 maxBound padding setPadding] + ,[ Label $ __ "Line width (horizontal) (px)" + , Widget $ Spinner 0 maxBound rowLineWidth setRowLineWidth] + ,[ Label $ __ "Line width (vertical) (px)" + , Widget $ Spinner 0 maxBound colLineWidth setColLineWidth] + ,[ Label $ __ "File type" + , Widget $ Choice fileTypeList + (intFromFileType . fileType) setFileType] + ] + , Modifier Center $ Row + [ Widget $ DefaultButton (__ "&Export") Export + , Widget $ Button (__ "&Preview") Preview + , cancelButton] + ] + + +showPreview :: Parameters -> Controller () +showPreview params = do + size <- getImageSize params + (bitmap,dc) <- liftIO $ getBitmapAndDC params size + exportTable params dc + previewImage bitmap + +writeImage :: Parameters -> FilePath -> Controller () +writeImage params filepath = + case bmpType of + Nothing -> warning $ unknownFileTypeIn filepath + Just bmpType -> + do size <- getImageSize params + (bitmap,dc) <- liftIO $ getBitmapAndDC params size + exportTable params dc + image <- liftIO $ WXC.imageCreateFromBitmap bitmap + _ <- liftIO $ WXC.imageSaveFile image filepath bmpType + return () + where + bmpType = case fileType params of + Nothing -> bitmapType <$> fromFilePath filepath + Just ext -> Just $ bitmapType ext + +getImageSize :: Parameters -> Controller (Int,Int) +getImageSize params = do + (_,dc) <- liftIO $ getBitmapAndDC params (1,1) + rows <- onGridView numDataRows + cols <- onGridView numDataColumns + + colWidth <- sum <$> mapM (getColumnWidth params dc) [0..cols-1] + rowHeight <- (*) rows <$> getRowHeight params dc + + colLabelHeight <- getRowHeight params dc + rowLabelWidth <- exportRowLabels params dc + + let colLineWidth' = colLineWidth params * (cols - 1) + rowLineHeigth = rowLineWidth params * (rows - 1) + + return ( rowLabelWidth + colWidth + colLineWidth' + , colLabelHeight + rowHeight + rowLineHeigth) + +exportTable :: Parameters -> WXC.DC a -> Controller () +exportTable params dc = do + cols <- onGridView numDataColumns + + fstWidth <- exportRowLabels params dc + foldM_ (\xOffset col -> do + x <- nextXOffset params dc xOffset col + exportColumn params dc x col + return x + ) (padding params + fstWidth + (colLineWidth params)) [0..cols-1] + + withPenWidth dc (rowLineWidth params) $ drawRowLines params dc + withPenWidth dc (colLineWidth params) $ drawColumnLines params dc fstWidth + +exportRowLabels :: Parameters -> WXC.DC a -> Controller Int +exportRowLabels params dc = do + rows <- onGridView numDataRows + width <- foldM (\m row -> do + label <- onGridView $ getRowLabel row + (width,_) <- liftIO $ textExtent dc label + y <- textYOffset params dc $ row + 1 + liftIO $ WXC.dcDrawText dc label $ WXC.pt (padding params) y + return $ max m width + ) 0 [0..rows-1] + return $ width + (padding params * 2) + +exportColumn :: Parameters -> WXC.DC a -> Int -> Int -> Controller () +exportColumn params dc xOffset i = do + values <- onGridView $ getColumnValues i + rows <- onGridView numDataRows + exportLabel + + mapM_ (\(row,value) -> do + y <- textYOffset params dc $ row + 1 + liftIO $ WXC.dcDrawText dc value $ WXC.pt xOffset y + ) $ zip [0..rows-1] values + where + exportLabel = do + label <- onGridView $ getColumnLabel i + liftIO $ WXC.dcDrawText dc label $ WXC.pt xOffset $ padding params + +drawRowLines :: Parameters -> WXC.DC a -> Controller () +drawRowLines params dc = do + dcWidth <- WXC.sizeW <$> (liftIO $ WXC.dcGetSize dc) + rows <- onGridView numDataRows + mapM_ (\row -> do + y <- lineYOffset params dc row + liftIO $ WXC.dcDrawLine dc (WXC.pt 0 y) (WXC.pt dcWidth y) + ) [1..rows] + +drawColumnLines :: Parameters -> WXC.DC a -> Int -> Controller () +drawColumnLines params dc xOffset = do + dcHeight <- WXC.sizeH <$> (liftIO $ WXC.dcGetSize dc) + cols <- onGridView numDataColumns + foldM_ (\x col -> do + liftIO $ WXC.dcDrawLine dc (WXC.pt x 0) (WXC.pt x dcHeight) + nextXOffset params dc x col + ) (xOffset + (colLineWidth params `div` 2)) [1..cols] + +textYOffset,lineYOffset :: Parameters -> WXC.DC a -> Int -> Controller Int +textYOffset params dc row = + liftIO $ do + charHeight <- WXC.dcGetCharHeight dc + let paddings = ((2 * row) + 1) * (padding params) + lines = rowLineWidth params * row + textHeights = row * charHeight + return $ paddings + textHeights + lines + +lineYOffset params dc row = do + y <- textYOffset params dc row + return $ y - (padding params) - (rowLineWidth params `div` 2) + +nextXOffset :: Parameters -> WXC.DC a -> Int -> Int -> Controller Int +nextXOffset params dc x i = + if i == 0 then return x + else do width <- getColumnWidth params dc $ i - 1 + return $ x + width + (colLineWidth params) + +getRowHeight :: Parameters -> WXC.DC a -> Controller Int +getRowHeight params dc = do + charHeight <- liftIO $ WXC.dcGetCharHeight dc + return $ charHeight + (padding params * 2) + +getColumnWidth :: Parameters -> WXC.DC a -> Int -> Controller Int +getColumnWidth params dc i = do + (labelWidth,_) <- onGridView (getColumnLabel i) >>= liftIO . textExtent dc + values <- onGridView $ getColumnValues i + maxWidth <- foldM (\m value -> + do (w,_) <- liftIO $ textExtent dc value + return $ max m w) labelWidth values + return $ (padding params * 2) + maxWidth + +getWidthPtr,getHeightPtr :: IO (Ptr Int) +getWidthPtr = malloc +getHeightPtr = malloc + +textExtent :: WXC.DC a -> String -> IO (Int,Int) +textExtent dc s = do + font <- WXC.dcGetFont dc + widthPtr <- getWidthPtr + heightPtr <- getHeightPtr + WXC.dcGetTextExtent dc s widthPtr heightPtr nullPtr nullPtr font + width <- peek widthPtr + height <- peek heightPtr + return (width,height) + +getBitmapAndDC :: Parameters -> (Int,Int) -> IO (WXC.Bitmap (),WXC.MemoryDC ()) +getBitmapAndDC params (width,height) = do + bitmap <- WXC.bitmapCreateEmpty (WXC.sz width height) (-1) + dc <- WXC.memoryDCCreateWithBitmap bitmap + font <- WXC.fontCreate (fontPointSize params) WXC.wxDEFAULT + WXC.wxNORMAL WXC.wxNORMAL False "" WXC.wxFONTENCODING_SYSTEM + bgBrush <- WXC.brushCreateFromColour + (toWXColor $ backgroundColor params) WXC.wxSOLID + WXC.dcSetBackground dc bgBrush + WXC.dcSetFont dc font + WXC.dcSetTextForeground dc $ toWXColor $ fontColor params + WXC.dcClear dc + return (bitmap,dc) + +withPenWidth :: WXC.DC a -> Int -> Controller () -> Controller () +withPenWidth dc width f = + when (width > 0) $ liftIO (setPenWidth dc width) + >> f >> liftIO (setPenWidth dc 1) + where + setPenWidth dc width = do + pen <- WXC.dcGetPen dc + WXC.penSetWidth pen width + WXC.dcSetPen dc pen diff --git a/src/Controller/Menu/File/Export/ImageParameters.hs b/src/Controller/Menu/File/Export/ImageParameters.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Export/ImageParameters.hs @@ -0,0 +1,83 @@ +module Controller.Menu.File.Export.ImageParameters + (Parameters (..),defaultParams,fileTypeList,fileTypeFromInt + ,intFromFileType) + where + +import Util.Color (Color (..)) +import Util.FileType (FileType(..),extension) +import Util.Sexp (Sexp(..)) +import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp + ,recordFromSexp) +import I18n (__) + +data Parameters = Parameters { fontPointSize :: Int + , fontColor :: Color + , backgroundColor :: Color + , padding :: Int + , rowLineWidth :: Int + , colLineWidth :: Int + , fileType :: Maybe FileType + } + +defaultParams :: Parameters +defaultParams = Parameters 10 (Color (0,0,0)) (Color (255,255,255)) + 3 1 1 Nothing + +instance Sexpable Parameters where + toSexp = recordToSexp + [ ("fontPointSize", toSexp . fontPointSize) + , ("fontColor", toSexp . fontColor) + , ("backgroundColor", toSexp . backgroundColor) + , ("padding", toSexp . padding) + , ("rowLineWidth", toSexp . rowLineWidth) + , ("colLineWidth", toSexp . colLineWidth) + , ("fileType", toSexp . fileType) + ] + fromSexp = recordFromSexp setParam defaultParams + +setParam :: Parameters -> Sexp -> PSE Parameters +setParam p sexp = + case sexp of + List [Atom "fontPointSize",fps] -> do + parameter <- fromSexp fps + return $ p {fontPointSize = parameter} + List [Atom "fontColor",color] -> do + parameter <- fromSexp color + return $ p {fontColor = parameter} + List [Atom "backgroundColor",color] -> do + parameter <- fromSexp color + return $ p {backgroundColor = parameter} + List [Atom "padding",padding] -> do + parameter <- fromSexp padding + return $ p {padding = parameter} + List [Atom "rowLineWidth",width] -> do + parameter <- fromSexp width + return $ p {rowLineWidth = parameter} + List [Atom "colLineWidth",width] -> do + parameter <- fromSexp width + return $ p {colLineWidth = parameter} + List [Atom "fileType",fileType] -> do + parameter <- fromSexp fileType + return $ p {fileType = parameter} + _ -> unexpected sexp + +fileTypeList :: [String] +fileTypeList = [ (__ "By extension") + , extension Bmp, extension Jpeg + , extension Png, extension Tif] + +fileTypeFromInt :: Int -> Maybe FileType +fileTypeFromInt i = case i of 0 -> Nothing + 1 -> Just Bmp + 2 -> Just Jpeg + 3 -> Just Png + 4 -> Just Tif + +intFromFileType :: Maybe FileType -> Int +intFromFileType fileType = case fileType of + Nothing -> 0 + Just Bmp -> 1 + Just Jpeg -> 2 + Just Png -> 3 + Just Tif -> 4 + diff --git a/src/Controller/Menu/File/Import/Csv.hs b/src/Controller/Menu/File/Import/Csv.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Import/Csv.hs @@ -0,0 +1,100 @@ +module Controller.Menu.File.Import.Csv (eventHandler) + where + +import Control.Applicative ((<$>)) +import Control.Monad (forM_) +import Control.Monad.Trans (liftIO) +import Controller (Controller,onView,getFromConfig,setOnConfig) +import Controller.Menu.File.Import.CsvParameters (Parameters(..)) +import Controller.Dialog (openFileDialog) +import qualified Controller.Grid as Grid +import Controller.Canonical (addRow) +import Config (csvImportParameters) +import Util (justWhen,breakAt,maybeRead) +import qualified Util +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,cancelButton) +import I18n (__) + +eventHandler :: Controller () +eventHandler = getFromConfig csvImportParameters >>= eventHandlerWith + +eventHandlerWith :: Parameters -> Controller () +eventHandlerWith storedParams = do + action <- onView $ showSimpleDialog (__ "Import") dialog storedParams + justWhen action $ \params -> + do setOnConfig $ \c -> c {csvImportParameters = params} + importFile <- openFileDialog (__ "Import") [] + case importFile of + Nothing -> eventHandlerWith params + Just file -> importCsvFile params file + +dialog :: Layout Parameters () +dialog = + let setColDelimiter p = maybe p (\d -> p {columnDelimiter = d}) . maybeRead + setRowDelimiter p = maybe p (\d -> p {rowDelimiter = d}) . maybeRead + setFirstCol p b = p {firstColumnContainsLabels = b} + setFirstRow p b = p {firstRowContainsLabels = b} + setStripWhitespace p b = p {stripWhitespace = b} + setParseNumbers p b = p {tryParsingNumbers = b} + in + Modifier Margin $ Column + [ Grid [[ Label $ __ "Column delimiter" + , Widget $ TextEntry (show . columnDelimiter) setColDelimiter] + ,[ Label $ __ "Row delimiter" + , Widget $ TextEntry (show . rowDelimiter) setRowDelimiter] + ,[ Label $ __ "First column contains labels" + , Widget $ CheckBox "" firstColumnContainsLabels setFirstCol] + ,[ Label $ __ "First row contains labels" + , Widget $ CheckBox "" firstRowContainsLabels setFirstRow] + ,[ Label $ __ "Strip whitespace" + , Widget $ CheckBox "" stripWhitespace setStripWhitespace] + ,[ Label $ __ "Try parsing numbers" + , Widget $ CheckBox "" tryParsingNumbers setParseNumbers]] + , Modifier Center $ Row + [ Widget $ DefaultButton (__ "&Import") () + , cancelButton]] + +importCsvFile :: Parameters -> FilePath -> Controller () +importCsvFile params filePath = do + Grid.new Nothing + rows <- breakAt (rowDelimiter params) <$> (liftIO $ readFile filePath) + if firstRowContainsLabels params + then let labels = + let values = breakAt (columnDelimiter params) $ head rows + in + map (mayStripWhitespace params) values + in do + forM_ (tail rows) $ importRow params + Grid.updateColumnLabels labels + else forM_ rows $ importRow params + +importRow :: Parameters -> String -> Controller () +importRow params row = + let csvValues = breakAt (columnDelimiter params) row + label = if firstColumnContainsLabels params + then Just $ mayStripWhitespace params $ head csvValues + else Nothing + rowData = if firstColumnContainsLabels params + then map (getCellInput params) $ tail csvValues + else map (getCellInput params) csvValues + in + addRow (label,rowData) + +mayStripWhitespace :: Parameters -> String -> String +mayStripWhitespace params = if stripWhitespace params + then Util.stripWhitespace else id + +getCellInput :: Parameters -> String -> String +getCellInput params = + let mayParseNumber x = + if tryParsingNumbers params + then case maybeRead x :: Maybe Double of + Just number -> show number + Nothing -> show x + else show x + in + mayParseNumber . mayStripWhitespace params + + + diff --git a/src/Controller/Menu/File/Import/CsvParameters.hs b/src/Controller/Menu/File/Import/CsvParameters.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Import/CsvParameters.hs @@ -0,0 +1,55 @@ +module Controller.Menu.File.Import.CsvParameters + (Parameters(..),defaultParams) + where + +import Util.Sexp (Sexp(..)) +import Util.Sexpable (Sexpable(..),PSE,unexpected,recordToSexp + ,recordFromSexp) + +data Parameters = Parameters { columnDelimiter :: Char + , rowDelimiter :: Char + , firstColumnContainsLabels :: Bool + , firstRowContainsLabels :: Bool + , stripWhitespace :: Bool + , tryParsingNumbers :: Bool + } + +defaultParams :: Parameters +defaultParams = Parameters ' ' '\n' True True True True + +instance Sexpable Parameters where + toSexp = recordToSexp + [ ("columnDelimiter", toSexp . columnDelimiter) + , ("rowDelimiter", toSexp . rowDelimiter) + , ("firstColumnContainsLabels", toSexp . firstColumnContainsLabels) + , ("firstRowContainsLabels", toSexp . firstRowContainsLabels) + , ("stripWhitespace", toSexp . stripWhitespace) + , ("tryParsingNumbers", toSexp . tryParsingNumbers) + ] + fromSexp = recordFromSexp setParam defaultParams + +setParam :: Parameters -> Sexp -> PSE Parameters +setParam p sexp = + case sexp of + List [Atom "columnDelimiter",cD] -> do + parameter <- fromSexp cD + return $ p {columnDelimiter = parameter} + List [Atom "rowDelimiter",rD] -> do + parameter <- fromSexp rD + return $ p {rowDelimiter = parameter} + List [Atom "firstColumnContainsLabels",containsLabels] -> do + parameter <- fromSexp containsLabels + return $ p {firstColumnContainsLabels = parameter} + List [Atom "firstRowContainsLabels",containsLabels] -> do + parameter <- fromSexp containsLabels + return $ p {firstRowContainsLabels = parameter} + List [Atom "stripWhitespace",strip] -> do + parameter <- fromSexp strip + return $ p {stripWhitespace = parameter} + List [Atom "tryParsingNumbers",try] -> do + parameter <- fromSexp try + return $ p {tryParsingNumbers = parameter} + _ -> unexpected sexp + + + diff --git a/src/Controller/Menu/File/NewClose.hs b/src/Controller/Menu/File/NewClose.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/NewClose.hs @@ -0,0 +1,34 @@ +module Controller.Menu.File.NewClose + (newEventHandler,closeEventHandler,closeAllEventHandler) + where + +import Control.Monad (forM_,when) +import Controller (Controller,onView,onGridModel) +import qualified Controller.Grid as Grid +import qualified Controller.Menu.File.Save as Save +import qualified Controller.Menu.Table.Add as Add +import Model.Grid (getFilePath) +import View.Dialog.Simple (confirm) +import View (isGridOpen) +import I18n (__) + +newEventHandler,closeEventHandler,closeAllEventHandler :: Controller () +newEventHandler = do + Grid.new Nothing + forM_ [1..5] $ \_ -> Add.addRow Nothing + forM_ [1..5] $ \_ -> Add.addColumn Nothing + +closeEventHandler = do + saveFirst <- + do filePath <- onGridModel getFilePath + case filePath of + Nothing -> onView $ confirm (__ "Save?") (__ "Save?") + Just f -> onView $ confirm (__ "Save?") + $ unwords [__ "Save as",f,"?"] + when saveFirst Save.saveEventHandler + Grid.deleteCurrent + +closeAllEventHandler = do + closeEventHandler + stillOpen <- onView isGridOpen + when stillOpen closeAllEventHandler diff --git a/src/Controller/Menu/File/Open.hs b/src/Controller/Menu/File/Open.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Open.hs @@ -0,0 +1,59 @@ +module Controller.Menu.File.Open (eventHandler) + where + +import Control.Monad (forM_) +import Control.Monad.Trans (liftIO) +import qualified Graphics.UI.WXCore as WXC +import Controller (Controller,onGridView,onGridModel) +import qualified Controller.Grid as Grid +import Controller.Menu.Table.Add (addRow,addColumn) +import Controller.Canonical (writeRowData) +import Controller.Dialog (openFileDialog,warning) +import Model.Grid (resizeTo) +import Util (justWhen) +import Util.Sexp (Sexp(..),ValidSexp(..),parseFile,validate) +import I18n (__) + +eventHandler :: Controller () +eventHandler = do + result <- openFileDialog (__ "Open") [(__ "Tables",["*.table"])] + justWhen result openFile + +validTableSexp :: ValidSexp +validTableSexp = + ValidList [ ValidListOf ValidAtom + , ValidListOf ValidAtom + , ValidListOf $ ValidListOf ValidAtom + ] + +invalidFile :: FilePath -> String -> Controller () +invalidFile filePath msg = + warning $ unwords [__ "Invalid file",filePath ++ ":",msg] + +openFile :: FilePath -> Controller () +openFile filePath = do + content <- liftIO $ parseFile filePath + case content of + Left error -> invalidFile filePath error + Right sexp -> if validate validTableSexp sexp == True + then loadTable filePath sexp + else invalidFile filePath $ __ "Invalid s-expression" + +loadTable :: FilePath -> Sexp -> Controller () +loadTable filePath (List [List rows,List cols,List cells]) = do + Grid.new $ Just filePath + onGridView WXC.gridBeginBatch + onGridModel $ resizeTo (length rows,length cols) + + forM_ rows $ \(Atom a) -> addRow $ Just a + forM_ cols $ \(Atom a) -> addColumn $ Just a + loadCells cells + + onGridView WXC.gridEndBatch + Grid.markAsSaved + +loadCells :: [Sexp] -> Controller () +loadCells rows = do + forM_ (zip [0..] rows) $ \(r,List row) -> + writeRowData r $ map (\(Atom value) -> value) row + diff --git a/src/Controller/Menu/File/Save.hs b/src/Controller/Menu/File/Save.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/File/Save.hs @@ -0,0 +1,52 @@ +module Controller.Menu.File.Save (saveAsEventHandler,saveEventHandler) + where + +import Control.Monad (forM) +import Control.Monad.Trans (liftIO) +import Controller (Controller,onGridView,onGridModel) +import Controller.Grid (setFilePath,markAsSaved) +import Controller.Dialog (saveFileDialog) +import View.Component.Grid (getRowLabel,getColumnLabel + ,numDataRows,numDataColumns) +import Util (justWhen) +import Util.Sexp (Sexp(..),prettyPrint) +import Model.Cell (input) +import Model.Grid (getCell,getFilePath) +import I18n (__) + +saveAsEventHandler,saveEventHandler :: Controller () +saveAsEventHandler = do + result <- saveFileDialog (__ "Save") [(__ "Tables",["*.table"])] + justWhen result saveAs + +saveEventHandler = do + result <- onGridModel getFilePath + case result of + Nothing -> saveAsEventHandler + Just path -> saveAs path + +saveAs :: FilePath -> Controller () +saveAs filePath = do + toSexp >>= liftIO . writeFile filePath . prettyPrint + setFilePath filePath + markAsSaved + +toSexp :: Controller Sexp +toSexp = do + maxRow <- do r <- onGridView numDataRows + return $ r-1 + maxCol <- do c <- onGridView numDataColumns + return $ c-1 + + rows <- forM [0..maxRow] $ onGridView . getRowLabel + cols <- forM [0..maxCol] $ onGridView . getColumnLabel + + rowList <- + forM [0..maxRow] $ \row -> + do cells <- forM [0..maxCol] $ \col -> + onGridModel $ getCell (row,col) + return $ List $ map (Atom . input) cells + + return $ List [ List $ map Atom rows, List $ map Atom cols + , List rowList] + diff --git a/src/Controller/Menu/Statistics/Descriptive.hs b/src/Controller/Menu/Statistics/Descriptive.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Statistics/Descriptive.hs @@ -0,0 +1,114 @@ +module Controller.Menu.Statistics.Descriptive (eventHandler) + where + +import Prelude hiding (max,min) +import Control.Monad (foldM,forM_,when) +import Control.Applicative ((<$>)) +import Data.Maybe (catMaybes) +import Controller (Controller,onView,onGridView,onGridModel) +import qualified Controller.Grid as Grid +import Controller.Dialog (nonNumericDataWarning) +import Controller.Menu.Table.Add (addColumn) +import Controller.Canonical (addRow) +import Util (justWhen) +import Model.Grid (getColumnValues) +import Model.CellExpression.Evaluator.Common (getNumList) +import qualified Model.CellExpression.Evaluator.Math as Math +import View.Component.Grid (getColumnLabel,getColumnLabels) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,okButton,cancelButton) +import I18n (__) + +data Parameters = Parameters { columns :: [Int] + , calcMean :: Bool + , calcMedian :: Bool + , calcStdDeviation :: Bool + , calcMax :: Bool + , calcMin :: Bool + } + +data Descriptive = Descriptive { label :: String + , mean :: Maybe Double + , median :: Maybe Double + , stdDeviation :: Maybe Double + , max :: Maybe Double + , min :: Maybe Double + } + +type Result = ([String],[Descriptive]) + +eventHandler :: Controller () +eventHandler = do + labels <- onGridView getColumnLabels + params <- onView $ showSimpleDialog (__ "Descriptive Statistics") + (dialog (__ "Columns") labels) $ Parameters [] True True True True True + justWhen params calcDescriptiveTable + +dialog :: String -> [String] -> Layout Parameters () +dialog labelsCaption labels = + let setColumns p cols = p {columns = cols} + setCalcMean p b = p {calcMean = b} + setCalcMedian p b = p {calcMedian = b} + setCalcStdDev p b = p {calcStdDeviation = b} + setCalcMax p b = p {calcMax = b} + setCalcMin p b = p {calcMin = b} + in + Modifier Margin $ Column + [ Row [ Grid + [[ Label $ __ "Mean" + , Widget $ CheckBox "" calcMean setCalcMean] + ,[ Label $ __ "Median" + , Widget $ CheckBox "" calcMean setCalcMedian] + ,[ Label $ __ "Standard Deviation" + , Widget $ CheckBox "" calcStdDeviation setCalcStdDev] + ,[ Label $ __ "Maximum", Widget $ CheckBox "" calcMax setCalcMax] + ,[ Label $ __ "Minimum", Widget $ CheckBox "" calcMin setCalcMin]] + , Modifier (Boxed labelsCaption) + $ Widget $ MultiListBox labels columns setColumns] + , Modifier Center $ Row [okButton (),cancelButton]] + +calcDescriptiveTable :: Parameters -> Controller () +calcDescriptiveTable params = do + (invalidCols,result) <- foldM (descriptive params) ([],[]) + $ columns params + + when (not $ null result) $ + do Grid.new Nothing + when (calcMean params) $ addColumn $ Just $ __ "Mean" + when (calcMedian params) $ addColumn $ Just $ __ "Median" + when (calcStdDeviation params) $ addColumn $ Just $ __ "Standard Deviation" + when (calcMax params) $ addColumn $ Just $ __ "Maximum" + when (calcMin params) $ addColumn $ Just $ __ "Minimum" + + forM_ (reverse result) $ \desc -> + do addRow (Just $ label desc,descriptiveToRow desc) + + when (not $ null invalidCols) + $ nonNumericDataWarning $ reverse invalidCols + +descriptive :: Parameters -> Result -> Int -> Controller Result +descriptive params (invalidCols,xs) col = do + colLabel <- onGridView $ getColumnLabel col + result <- getNumList <$> (onGridModel $ getColumnValues col) + case (result) of + Left _ -> return (colLabel : invalidCols,xs) + Right values -> + let calculate condition v = if condition params + then Just v else Nothing + mean = calculate calcMean $ Math.mean values + median = calculate calcMedian $ Math.median values + stdDev = calculate calcStdDeviation $ Math.stdDeviation values + max = calculate calcMax $ maximum values + min = calculate calcMax $ minimum values + in + return ( invalidCols + , Descriptive colLabel mean median stdDev max min : xs + ) + +descriptiveToRow :: Descriptive -> [String] +descriptiveToRow desc = + map show $ catMaybes [ mean desc + , median desc + , stdDeviation desc + , max desc, min desc + ] diff --git a/src/Controller/Menu/Statistics/FrequencyDistribution.hs b/src/Controller/Menu/Statistics/FrequencyDistribution.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Statistics/FrequencyDistribution.hs @@ -0,0 +1,36 @@ +module Controller.Menu.Statistics.FrequencyDistribution (eventHandler) + where + +import Control.Monad (forM_) +import Data.List (nub) +import Controller (Controller,onGridView) +import View.Component.Grid (getColumnValues) +import Util (justWhen) +import qualified Controller.Grid as Grid +import Controller.Canonical (addRow) +import Controller.Menu.Table.Add (addColumn) +import Controller.Dialog (chooseColumnDialog) +import I18n (__) + +eventHandler :: Controller () +eventHandler = do + selection <- chooseColumnDialog $ __ "Frequency Distribution" + justWhen selection $ \colIndex -> + do values <- onGridView $ getColumnValues colIndex + Grid.new Nothing + addColumn $ Just $ __ "Frequency" + addColumn $ Just $ __ "Percentage" + + forM_ (freqDist values) $ \(value,freq,perc) -> + do addRow (Just value,[show freq, show perc]) + +freqDist :: [String] -> [(String,Int,Double)] +freqDist values = + let unique = nub values + frequency = map (\s -> length $ filter ((==) s) values) unique + numValues = length values + percentage = map (\f -> fromIntegral f / (fromIntegral numValues)) frequency + in + zip3 unique frequency percentage + + diff --git a/src/Controller/Menu/Statistics/Pivot.hs b/src/Controller/Menu/Statistics/Pivot.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Statistics/Pivot.hs @@ -0,0 +1,146 @@ +module Controller.Menu.Statistics.Pivot (eventHandler) + where + +import Control.Monad (when,forM_) +import Data.List (nub) +import Data.Maybe (mapMaybe) +import Controller (Controller,onView,onGridView,onGridModel) +import Controller.Canonical (addColumn,addRow) +import qualified Controller.Grid as Grid +import Controller.Dialog (warning) +import View.Component.Grid (getColumnLabels) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,okButton,cancelButton) +import Model.Grid (getColumnValues) +import Model.CellContent (CellValue (NumberValue)) +import qualified Model.CellExpression.Evaluator.Math as Math +import Model.CellExpression.Evaluator.Common (fLength,getNumList) +import Util (justWhen) +import I18n (__) + +data Aggregator = Count + | Numeric ([Double] -> Double) + +data Parameters = Parameters { abscissaColumn :: Maybe Int + , ordinateColumn :: Maybe Int + , dataColumn :: Maybe Int + , aggregatorIndex :: Int + , makeTotals :: Bool + } + +defaultParams :: Parameters +defaultParams = Parameters Nothing Nothing Nothing 0 True + +aggregatorList :: [String] +aggregatorList = [ __ "Sum",__ "Mean",__ "Median",__ "Maximum" + , __ "Minimum",__ "Standard Deviation",__ "Count"] + +aggregatorFromInt :: Int -> Aggregator +aggregatorFromInt i = + case i of 0 -> Numeric sum; 1 -> Numeric Math.mean + 2 -> Numeric Math.median; 3 -> Numeric maximum + 4 -> Numeric minimum; 5 -> Numeric Math.stdDeviation + 6 -> Count + +typecheck :: Aggregator -> [CellValue] -> Bool +typecheck aggregator values = + case aggregator of + Numeric _ -> either (\_ -> False) (\_ -> True) $ getNumList values + _ -> True + +apply :: Aggregator -> [CellValue] -> CellValue +apply aggregator values = + case aggregator of + Count -> NumberValue $ fLength values + Numeric f -> let Right vs = getNumList values + in NumberValue $ f vs + +eventHandler :: Controller () +eventHandler = eventHandlerWith defaultParams + +eventHandlerWith :: Parameters -> Controller () +eventHandlerWith params = do + labels <- onGridView getColumnLabels + result <- onView $ showSimpleDialog (__ "Pivot table") + (dialog labels) params + justWhen result $ \params' -> do success <- processParams params' + when (not success) + $ eventHandlerWith params' + +dialog :: [String] -> Layout Parameters () +dialog labels = + let setAbscissa p a = p {abscissaColumn = a} + setOrdinate p a = p {ordinateColumn = a} + setData p a = p {dataColumn = a} + setAggregator p a = p {aggregatorIndex = a} + setTotals p b = p {makeTotals = b} + in + Modifier Margin $ Column + [ Row [ Modifiers [Boxed $ __ "Abscissa column",HFill] + $ Widget $ SingleListBox labels abscissaColumn setAbscissa + , Modifiers [Boxed $ __ "Ordinate column",HFill] + $ Widget $ SingleListBox labels ordinateColumn setOrdinate + , Modifiers [Boxed $ __ "Data column",HFill] + $ Widget $ SingleListBox labels dataColumn setData] + , Grid [[ Label $ __ "Aggregator" + , Widget $ Choice aggregatorList aggregatorIndex setAggregator] + ,[ Label $ __ "Make totals" + , Widget $ CheckBox "" makeTotals setTotals]] + , Modifier Center $ Row [okButton (),cancelButton]] + +processParams :: Parameters -> Controller Bool +processParams params = + case (abscissaColumn params,ordinateColumn params,dataColumn params) of + (Nothing,_,_) -> warning (__ "No abscissa column selected") >> return False + (_,Nothing,_) -> warning (__ "No ordinate column selected") >> return False + (_,_,Nothing) -> warning (__ "No data column selected") >> return False + (Just absCol,Just ordCol,Just dataCol) -> + do abscissa <- onGridModel $ getColumnValues absCol + ordinate <- onGridModel $ getColumnValues ordCol + datas <- onGridModel $ getColumnValues dataCol + calcPivotTable abscissa ordinate datas + (aggregatorFromInt $ aggregatorIndex params) + (makeTotals params) + +calcPivotTable :: [CellValue] -> [CellValue] -> [CellValue] + -> Aggregator -> Bool -> Controller Bool +calcPivotTable abscissa ordinate datas aggregator makeTotals = + if not $ typecheck aggregator datas + then warning (__ "Can not apply aggregator to selected data column (e.g. because of non-numeric data).") + >> return False + else do + Grid.new Nothing + + let association = zip3 abscissa ordinate datas + nubOrdinate = nub ordinate + nubAbscissa = nub abscissa + aggregateSome select = + let values = mapMaybe (\(a,o,value) -> if select a o + then Just value + else Nothing + ) association + in apply aggregator values + + aggregate abscissaValue ordinateValue = + aggregateSome $ \a o -> a == abscissaValue && o == ordinateValue + aggregateAbs abscissaValue = + aggregateSome $ \a _ -> a == abscissaValue + aggregateOrd ordinateValue = + aggregateSome $ \_ o -> o == ordinateValue + + forM_ nubAbscissa $ \abscissaValue -> + let column = map (show . aggregate abscissaValue) nubOrdinate + in + addColumn (Just $ show abscissaValue,column) + + Grid.updateRowLabels $ map show nubOrdinate + + when makeTotals $ + let column = map (show . aggregateOrd) nubOrdinate + row = map (show . aggregateAbs) nubAbscissa + all = show $ aggregateSome (\_ _ -> True) + in do + addColumn (Just $ __ "Total",column) + addRow (Just $ __ "Total",row ++ [all]) + return True + diff --git a/src/Controller/Menu/Table/Add.hs b/src/Controller/Menu/Table/Add.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Add.hs @@ -0,0 +1,82 @@ +module Controller.Menu.Table.Add (columnEventHandler,rowEventHandler + ,addRow,addColumn) + where + +import Control.Monad (forM_) +import Data.Char (chr,ord) +import Data.List (intercalate) +import Controller (Controller,onView,onGridModel,onGridView) +import Controller.Cell (updateInView) +import qualified Model.Grid as GridM +import qualified View.Component.Grid as GridV +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,cancelButton) +import Util (breakAt) +import I18n (__) + +data AddBy = N | Labels +data Parameters = Parameters { addBy :: AddBy + , n :: Int + , labels :: [String]} + +columnEventHandler :: Controller () +columnEventHandler = do + result <- onView $ showSimpleDialog (__ "Add columns") + (dialog $ __ "Add columns by") $ Parameters N 0 [] + case result of + Nothing -> return () + Just (Parameters {addBy=N, n=n}) -> + forM_ [1..n] $ \_ -> addColumn Nothing + Just (Parameters {addBy=Labels, labels=labels}) -> + forM_ labels $ addColumn . Just + +rowEventHandler :: Controller () +rowEventHandler = do + result <- onView $ showSimpleDialog (__ "Add rows") + (dialog $ __ "Add rows by") $ Parameters N 0 [] + case result of + Nothing -> return () + Just (Parameters {addBy=N, n=n}) -> + forM_ [1..n] $ \_ -> addRow Nothing + Just (Parameters {addBy=Labels, labels=labels}) -> + forM_ labels $ addRow . Just + +dialog :: String -> Layout Parameters () +dialog radioBoxCaption = + let setLabels p labels = p {labels = breakAt ',' labels} + getLabels = intercalate "," . labels + setAddBy p 0 = p {addBy = N} + setAddBy p 1 = p {addBy = Labels} + getAddBy p = case addBy p of N -> 0; Labels -> 1 + setN p n = p {n = n} + in + Modifier Margin $ Column + [ Row [ Widget $ RadioBox radioBoxCaption + [__ "Number \"n\"",__ "Labels \"label1[,label2,...]\""] + getAddBy setAddBy + , Column [ Widget $ Spinner 0 maxBound n setN + , Widget $ TextEntry getLabels setLabels]] + , Modifier Center $ Row [ Widget $ DefaultButton (__ "&Add") () + , cancelButton]] + +{- Reihenfolge wichtig: + 1. zu View hinzufügen + 2. zu Model hinzufügen +-} +addRow,addColumn :: Maybe String -> Controller () +addRow caption = do + rows <- onGridView GridV.numDataRows + let name = maybe (autoRowName rows) id caption + onGridView $ GridV.addRow name + onGridModel (GridM.addRow name) >>= updateInView + where autoRowName i = show $ i+1 + +addColumn caption = do + cols <- onGridView GridV.numDataColumns + let name = maybe (autoColumnName cols) id caption + onGridView $ GridV.addColumn name + onGridModel (GridM.addColumn name) >>= updateInView + where autoColumnName i = + let number = (i `div` 26) + 1 + in + replicate number $ chr $ (i `mod` 26) + ord 'A' diff --git a/src/Controller/Menu/Table/Copy.hs b/src/Controller/Menu/Table/Copy.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Copy.hs @@ -0,0 +1,22 @@ +module Controller.Menu.Table.Copy (eventHandler) + where + +import Control.Monad (forM_,forM) +import Controller (Controller) +import Controller.Dialog (chooseColumnsAndTableDialog) +import Controller.Grid (changePageTo) +import Controller.Canonical (getColumn,addColumn') +import Util (justWhen) +import I18n (__) + +eventHandler :: Controller () +eventHandler = do + result <- chooseColumnsAndTableDialog $ __ "Copy" + justWhen result $ \(cols,table) -> + justWhen table $ copyColumnsTo cols + +copyColumnsTo :: [Int] -> Int -> Controller () +copyColumnsTo cols tableN = do + columnData <- forM cols getColumn + changePageTo tableN + forM_ columnData addColumn' diff --git a/src/Controller/Menu/Table/Delete.hs b/src/Controller/Menu/Table/Delete.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Delete.hs @@ -0,0 +1,28 @@ +module Controller.Menu.Table.Delete (columnEventHandler,rowEventHandler + ,deleteColumns,deleteRows) + where + +import Controller (Controller,onGridModel,onGridView) +import Controller.Dialog (chooseColumnsDialog,chooseRowsDialog) +import qualified Controller.Menu.Table.Reevaluate as Reevaluate +import qualified Model.Grid as GridM +import qualified View.Component.Grid as GridV +import I18n (__) + +columnEventHandler :: Controller () +columnEventHandler = chooseColumnsDialog (__ "Delete") >>= deleteColumns + +deleteColumns :: [Int] -> Controller () +deleteColumns cols = do + onGridModel $ GridM.deleteColumns cols + onGridView $ GridV.deleteColumns $ reverse cols + Reevaluate.eventHandler + +rowEventHandler :: Controller () +rowEventHandler = chooseRowsDialog (__ "Delete") >>= deleteRows + +deleteRows :: [Int] -> Controller () +deleteRows rows = do + onGridModel $ GridM.deleteRows rows + onGridView $ GridV.deleteRows $ reverse rows + Reevaluate.eventHandler diff --git a/src/Controller/Menu/Table/Reevaluate.hs b/src/Controller/Menu/Table/Reevaluate.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Reevaluate.hs @@ -0,0 +1,18 @@ +module Controller.Menu.Table.Reevaluate (eventHandler) + where + +import Control.Monad (forM_) +import Controller (Controller,onGridView,onGridModel) +import Controller.Cell (updateInView,showSelectedContent) +import View.Component.Grid (numDataRows,numDataColumns) +import Model.Grid (rewriteCell) + +eventHandler :: Controller () +eventHandler = do + rows <- onGridView numDataRows + cols <- onGridView numDataColumns + + forM_ [0..rows-1] $ \r -> forM_ [0..cols-1] $ \c -> + do changed <- onGridModel $ rewriteCell (r,c) + updateInView changed + showSelectedContent diff --git a/src/Controller/Menu/Table/Transpose.hs b/src/Controller/Menu/Table/Transpose.hs new file mode 100644 --- /dev/null +++ b/src/Controller/Menu/Table/Transpose.hs @@ -0,0 +1,41 @@ +module Controller.Menu.Table.Transpose (tableEventHandler + ,columnEventHandler + ,rowEventHandler) + where + +import Control.Monad (forM_,forM) +import Controller (Controller,onGridView) +import Controller.Dialog (chooseColumnsDialog,chooseRowsDialog) +import Controller.Canonical (getColumn,getRow,addRow',addColumn') +import qualified Controller.Grid as Grid +import View.Component.Grid (getRowLabels,getColumnLabels + ,numDataColumns) +import I18n (__) + +tableEventHandler :: Controller () +tableEventHandler = do + n <- onGridView numDataColumns + transposeColumns [0..n-1] + +columnEventHandler :: Controller () +columnEventHandler = chooseColumnsDialog (__ "Transpose") >>= transposeColumns + +rowEventHandler :: Controller () +rowEventHandler = chooseRowsDialog (__ "Transpose") >>= transposeRows + +transposeColumns :: [Int] -> Controller () +transposeColumns cols = do + columnData <- forM cols getColumn + rowLabels <- onGridView getRowLabels + Grid.new Nothing + forM_ columnData addRow' + Grid.updateColumnLabels rowLabels + +transposeRows :: [Int] -> Controller () +transposeRows rows = do + rowData <- forM rows getRow + colLabels <- onGridView getColumnLabels + Grid.new Nothing + forM_ rowData addColumn' + Grid.updateRowLabels colLabels + diff --git a/src/Controller/SaveConfig.hs b/src/Controller/SaveConfig.hs new file mode 100644 --- /dev/null +++ b/src/Controller/SaveConfig.hs @@ -0,0 +1,12 @@ +module Controller.SaveConfig (configFilePath,eventHandler) + where + +import Control.Monad.Trans (liftIO) +import Controller (Controller,currentConfig) +import Config (save) +import Constants (configFilePath) + +eventHandler :: Controller () +eventHandler = do + config <- currentConfig + liftIO $ configFilePath >>= save `flip` config diff --git a/src/I18n.hs b/src/I18n.hs new file mode 100644 --- /dev/null +++ b/src/I18n.hs @@ -0,0 +1,18 @@ +module I18n (__,initI18n) + where + +import Text.I18N.GetText (getText,bindTextDomain,textDomain) +import System.Locale.SetLocale (setLocale,Category(LC_ALL)) +import System.IO.Unsafe (unsafePerformIO) +import Codec.Binary.UTF8.String (decodeString) + +__ :: String -> String +__ = decodeString . unsafePerformIO . getText + +initI18n :: String -> IO () +initI18n locale = do + setLocale LC_ALL $ Just locale + bindTextDomain __MESSAGE_CATALOG_DOMAIN__ $ Just __MESSAGE_CATALOG_DIR__ + textDomain $ Just __MESSAGE_CATALOG_DOMAIN__ + return () + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,14 @@ +module Main + where + +import Graphics.UI.WX (start) +import Run (program) +import Config (load) +import Constants (configFilePath) + +main :: IO () +main = do + result <- load =<< configFilePath + case result of + Left withError -> fail withError + Right config -> start $ program config diff --git a/src/Model.hs b/src/Model.hs new file mode 100644 --- /dev/null +++ b/src/Model.hs @@ -0,0 +1,48 @@ +module Model (Model,new,onGrid,setCurrent,addGrid,deleteCurrent) + where + +import Control.Applicative ((<$>)) +import Data.IORef +import Data.IntMap (IntMap,Key) +import qualified Data.IntMap as Map +import Model.Grid (Grid) +import qualified Model.Grid as G +import qualified View +import Util (justWhen) + +type Current = (Key,Grid) + +data Model = Model { grids :: IORef (IntMap Grid) + , current :: IORef (Maybe Current) + } + +new :: IO Model +new = do + grids <- newIORef $ Map.empty + current <- newIORef Nothing + return $ Model grids current + +deleteCurrent :: Model -> IO () +deleteCurrent model = + onCurrent model $ \(key,_) -> + modifyIORef (grids model) $ Map.delete key + +onGrid :: Model -> (Grid -> IO a) -> IO a +onGrid model f = onCurrent model $ f . snd + +onCurrent :: Model -> (Current -> IO a) -> IO a +onCurrent model f = + readIORef (current model) >>= \maybeC -> + case maybeC of Just c -> f c + Nothing -> error "Model.onCurrent: Nothing" + +setCurrent :: Key -> Model -> IO () +setCurrent key model = do + grid <- Map.lookup key <$> (readIORef $ grids model) + justWhen grid $ \g -> writeIORef (current model) $ Just (key,g) + +addGrid :: Key -> View.Info -> Model -> IO () +addGrid key viewInfo model = do + grid <- G.new viewInfo + modifyIORef (grids model) $ Map.insert key grid + setCurrent key model diff --git a/src/Model/Cell.hs b/src/Model/Cell.hs new file mode 100644 --- /dev/null +++ b/src/Model/Cell.hs @@ -0,0 +1,46 @@ +module Model.Cell (Cell(..),empty,showValue + ,setExpression,setRuntimeErrorValue + ,evaluate,addDependent,deleteDependent) + where + +import qualified Data.List as List +import Model.CellContent (CellExpr(EmptyExpr),CellValue(EmptyValue,Error) + ,RuntimeReason,Reference) +import qualified Model.CellContent as CC +import qualified Model.CellExpression.Evaluator as E +import CellCoordinate (CellCoord) + +data Cell = Cell { expression :: CellExpr + , value :: CellValue + , dependent :: [CellCoord] + , dependencies :: [Reference] + , input :: String + } + +empty :: Cell +empty = Cell EmptyExpr EmptyValue [] [] "" + +setExpression :: String -> CellExpr -> Cell -> Cell +setExpression input expr cell = + cell { input = input + , expression = expr + , dependencies = CC.dependencies expr} + +setRuntimeErrorValue :: RuntimeReason -> Cell -> Cell +setRuntimeErrorValue reason cell = cell {value = Error reason} + +showValue :: Cell -> String +showValue = show . value + +evaluate :: E.Lookup -> Cell -> IO Cell +evaluate lookup cell = do + value' <- E.evaluate lookup $ expression cell + return $ cell {value = value'} + +addDependent :: CellCoord -> Cell -> Cell +addDependent coords cell = + cell {dependent = coords : (dependent cell)} + +deleteDependent :: CellCoord -> Cell -> Cell +deleteDependent coords cell = + cell {dependent = List.delete coords $ dependent cell} diff --git a/src/Model/CellContent.hs b/src/Model/CellContent.hs new file mode 100644 --- /dev/null +++ b/src/Model/CellContent.hs @@ -0,0 +1,99 @@ +module Model.CellContent (NamedReference (..),Reference (..) + ,CompileReason (..),RuntimeReason (..) + ,CellExpr (..),CellValue (..) + ,Symbol,dependencies) + where + +import Data.List (intercalate) +import CellCoordinate (CellCoord) +import I18n (__) + +type Symbol = String + +data NamedReference = NamedCell (String,String) + | NamedRange ((String,String),(String,String)) + | NamedColumn String + | NamedRow String + deriving (Eq) + +instance Show NamedReference where + show (NamedCell (r,c)) = concat ["$",r,",",c,"$"] + show (NamedRange (a,b)) = concat [ show $ NamedCell a + , ":",show $ NamedCell b] + show (NamedColumn a) = concat ["$_,",a,"$"] + show (NamedRow a) = concat ["$",a,"_$"] + +data Reference = Cell CellCoord + | Range (CellCoord,CellCoord) + | Column Int + | Row Int + deriving (Eq,Show) + +data CompileReason = ParseError String + | RefConversionError NamedReference + | ReferenceLoop + deriving (Eq) + +instance Show CompileReason where + show (ParseError a) = unwords [(__ "Parse error")++ ":",a] + show (RefConversionError a) = unwords [(__ "Unknown reference") ++ ":",show a] + show ReferenceLoop = __ "Reference loop" + +data RuntimeReason = CompileError CompileReason + | TypeError CellValue + | Inherited CellValue RuntimeReason + | UnknownIdentifier Symbol + deriving (Eq) + +instance Show RuntimeReason where + show (CompileError a) = unwords [(__ "Compile error") ++ ":",show a] + show (TypeError a) = unwords [__ "Type error in",showValueInError a] + show (Inherited a b) = unwords [__ "In",showValueInError a,":",show b] + show (UnknownIdentifier a) = unwords [__ "Unknown identifier",a] + +data CellExpr = EmptyExpr + | NumberExpr Double + | StringExpr String + | ListExpr [CellExpr] + | NamedReference NamedReference + | Reference Reference + | UnaryOp Symbol CellExpr + | BinaryOp Symbol CellExpr CellExpr + | Call Symbol CellExpr + | Sub CellExpr + | CompileErrorExpr CompileReason + deriving (Eq,Show) + +data CellValue = EmptyValue + | NumberValue Double + | StringValue String + | ListValue [CellValue] + | Error RuntimeReason + deriving (Eq) + +instance Show CellValue where + show EmptyValue = "" + show (NumberValue a) = show a + show (StringValue a) = a + show (ListValue a) = concat ["[",intercalate "," $ map show a,"]"] + show (Error _) = __ "Error" + +dependencies :: CellExpr -> [Reference] +dependencies expr = + case expr of + Reference ref -> [ref] + ListExpr a -> concat $ map dependencies a + UnaryOp _ a -> dependencies a + BinaryOp _ a b -> (dependencies a) ++ (dependencies b) + Call _ a -> dependencies a + Sub a -> dependencies a + _ -> [] + +showValueInError :: CellValue -> String +showValueInError value = + case value of + EmptyValue -> __ "Empty" + ListValue a -> + concat ["[",intercalate "," $ map showValueInError a,"]"] + _ -> show value + diff --git a/src/Model/CellExpression/Evaluator.hs b/src/Model/CellExpression/Evaluator.hs new file mode 100644 --- /dev/null +++ b/src/Model/CellExpression/Evaluator.hs @@ -0,0 +1,50 @@ +module Model.CellExpression.Evaluator (evaluate,Lookup) + where + +import Prelude hiding (lookup) +import Control.Applicative ((<$>)) +import Control.Monad (forM) +import Model.CellContent (CellExpr (..),CellValue(..),RuntimeReason(..) + ,Reference(..),Symbol) +import Model.CellExpression.Evaluator.Common + (withNum,withList,withNumList,getNumList,fLength) +import Model.CellExpression.Evaluator.Math (mean,median) + +type Lookup = Reference -> IO CellValue + +evaluate :: Lookup -> CellExpr -> IO CellValue +evaluate lookup e = + let binary f = return . mathBinary f + eval = evaluate lookup + in + case e of + EmptyExpr -> return $ EmptyValue + NumberExpr a -> return $ NumberValue a + StringExpr a -> return $ StringValue a + ListExpr a -> ListValue <$> forM a eval + Reference a -> lookup a + UnaryOp "-" a -> forM [NumberExpr 0,a] eval >>= binary (-) + BinaryOp "+" a b -> forM [a,b] eval >>= binary (+) + BinaryOp "-" a b -> forM [a,b] eval >>= binary (-) + BinaryOp "*" a b -> forM [a,b] eval >>= binary (*) + BinaryOp "/" a b -> forM [a,b] eval >>= binary (/) + BinaryOp "^" a b -> forM [a,b] eval >>= binary (**) + Call f arg -> evaluateFun f <$> eval arg + Sub a -> eval a + NamedReference _ -> error "Model.CellExpression.Evaluator.evaluate: NamedReference" + CompileErrorExpr a -> return $ Error $ CompileError a + +evaluateFun :: Symbol -> CellValue -> CellValue +evaluateFun f arg = + case f of + "sum" -> withNumList arg $ NumberValue . sum + "count" -> withList arg $ NumberValue . fLength + "abs" -> withNum arg $ NumberValue . abs + "mean" -> withNumList arg $ NumberValue . mean + "median" -> withNumList arg $ NumberValue . median + unknown -> Error $ UnknownIdentifier unknown + +mathBinary :: (Double -> Double -> Double) -> [CellValue] -> CellValue +mathBinary f = + either Error (\[a,b] -> NumberValue $ f a b) . getNumList + diff --git a/src/Model/CellExpression/Evaluator/Common.hs b/src/Model/CellExpression/Evaluator/Common.hs new file mode 100644 --- /dev/null +++ b/src/Model/CellExpression/Evaluator/Common.hs @@ -0,0 +1,43 @@ +module Model.CellExpression.Evaluator.Common + (withNum,withString,withList,withNumList,getNumList,fLength) + where + +import Model.CellContent (CellValue (..),RuntimeReason(..)) + +withNum :: CellValue -> (Double -> CellValue) -> CellValue +withNum value f = + case value of NumberValue a -> f a + Error a -> Error $ Inherited value a + a -> Error $ TypeError a + +withString :: CellValue -> (String -> CellValue) -> CellValue +withString value f = + case value of StringValue a -> f a + Error a -> Error $ Inherited value a + a -> Error $ TypeError a + +withList :: CellValue -> ([CellValue] -> CellValue) -> CellValue +withList value f = + case value of ListValue a -> f a + Error a -> Error $ Inherited value a + a -> Error $ TypeError a + +withNumList :: CellValue -> ([Double] -> CellValue) -> CellValue +withNumList value f = + case value of + ListValue a -> either (Error . Inherited value) f $ getNumList a + Error a -> Error $ Inherited value a + a -> Error $ TypeError a + +getNumList :: [CellValue] -> Either RuntimeReason [Double] +getNumList = + foldr (\value accu -> + case (value,accu) of + (NumberValue n,Right list) -> Right $ n:list + (Error a,Right _) -> Left $ Inherited value a + (a,Right _) -> Left $ TypeError a + (_,Left a) -> Left a + ) (Right []) + +fLength :: Num b => [a] -> b +fLength = fromIntegral . length diff --git a/src/Model/CellExpression/Evaluator/Math.hs b/src/Model/CellExpression/Evaluator/Math.hs new file mode 100644 --- /dev/null +++ b/src/Model/CellExpression/Evaluator/Math.hs @@ -0,0 +1,47 @@ +module Model.CellExpression.Evaluator.Math + (mean,median,medianSorted,stdDeviation + ,firstQuartile,firstQuartileSorted + ,thirdQuartile,thirdQuartileSorted) + where + +import Data.List (sort) +import Model.CellExpression.Evaluator.Common (fLength) + +mean :: [Double] -> Double +mean values = sum values / (fLength values) + +median,medianSorted :: [Double] -> Double +medianSorted values = + let l = length values + in + if odd l then values !! (l `div` 2) + else + let x = values !! ((l - 1) `div` 2) + y = values !! (l `div` 2) + in + (x + y) / 2 +median = medianSorted . sort + +firstQuartile,firstQuartileSorted :: [Double] -> Double +firstQuartileSorted values = + let l = length values + in + if odd l then values !! (l `div` 4) + else values !! ((l + 1) `div` 4) +firstQuartile = firstQuartileSorted . sort + +thirdQuartile,thirdQuartileSorted :: [Double] -> Double +thirdQuartileSorted values = + let l = length values + in + if odd l then values !! ((3 * l + 2) `div` 4) + else values !! ((3 * l + 1) `div` 4) +thirdQuartile = thirdQuartileSorted . sort + +stdDeviation :: [Double] -> Double +stdDeviation [_] = 0 +stdDeviation values = + let m = mean values + in + sqrt $ (sum $ map (\v -> (v - m) ** 2) values) / (fLength values - 1) + diff --git a/src/Model/CellExpression/Parser.hs b/src/Model/CellExpression/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Model/CellExpression/Parser.hs @@ -0,0 +1,169 @@ +module Model.CellExpression.Parser (parse) + where + +import Data.List (find,intercalate,nub) +import Control.Applicative ((<$>)) +import Text.ParserCombinators.Parsec ((<|>),(),Parser,try) +import qualified Text.ParserCombinators.Parsec as P +import qualified Text.ParserCombinators.Parsec.Error as Error +import qualified Text.ParserCombinators.Parsec.Expr as E +import qualified Text.ParserCombinators.Parsec.Token as T +import qualified Text.ParserCombinators.Parsec.Language as L +import Model.CellContent (CellExpr (..),NamedReference(..),CompileReason(..)) +import qualified Model.CellContent as CC +import I18n (__) + +program,topLevelFormula,topLevelLiteral :: Parser CellExpr +expression,term,functionCall :: Parser CellExpr +number,stringExpr,list,subExpression :: Parser CellExpr +reference,cellRef,cellRangeRef :: Parser CellExpr + +program = topLevelFormula <|> topLevelLiteral + +topLevelLiteral = (try topLevelNumber) + <|> (StringExpr <$> (P.many1 P.anyChar)) + +topLevelNumber = do + whitespace + n <- NumberExpr <$> signedDouble + P.eof >> return n + +topLevelFormula = do + f <- P.char '=' >> whitespace >> expression + P.eof >> return f + +expression = E.buildExpressionParser table term __ "formula" + +table :: E.OperatorTable Char () CellExpr +table = [[ prefix "-" CC.UnaryOp] + ,[ binary "^" CC.BinaryOp E.AssocRight] + ,[ binary "*" CC.BinaryOp E.AssocLeft + , binary "/" CC.BinaryOp E.AssocLeft] + ,[ binary "+" CC.BinaryOp E.AssocLeft + , binary "-" CC.BinaryOp E.AssocLeft] + ] + where + binary sign f = E.Infix $ do {reservedOp sign; return $ f sign} + prefix sign f = E.Prefix $ do {reservedOp sign; return $ f sign} + +term = subExpression <|> functionCall <|> number <|> list + <|> stringExpr <|> reference __ "formula" + +functionCall = do { name <- identifier + ; arg <- number <|> stringExpr <|> list + <|> reference <|> subExpression __ "argument" + ; return $ Call name arg + } __ "function call" + +number = (NumberExpr <$> double) __ "number" + +stringExpr = (StringExpr <$> stringLiteral) __ "string" + +list = do { symbol "[" + ; l <- P.sepBy1 expression $ symbol "," + ; symbol "]" + ; return $ ListExpr l + } "list" + +reference = try cellRangeRef <|> try cellRef __ "reference" + +cellRef = do { string "$" + ; row <- P.many1 (P.noneOf [',']) + ; string "," + ; column <- P.many1 (P.noneOf ['$']) + ; string "$" + ; whitespace + ; case (row,column) of + ("_",c) -> return $ NamedReference $ NamedColumn c + (r,"_") -> return $ NamedReference $ NamedRow r + _ -> return $ NamedReference $ NamedCell (row,column) + } __ "cell reference" + +cellRangeRef = do { NamedReference (NamedCell from) <- cellRef + ; symbol ":" + ; NamedReference (NamedCell to) <- cellRef + ; return $ NamedReference $ NamedRange (from,to) + } __ "cell range reference" + +subExpression = do { subExpr <- P.between (symbol "(") (symbol ")") expression + ; return $ Sub subExpr + } __ "subexpression" + +lexer :: T.TokenParser () +lexer = T.makeTokenParser $ L.emptyDef + { L.opStart = P.oneOf "+-*/~^:" + , L.opLetter = P.oneOf "+-*/~^:" + , L.reservedOpNames = ["+","-","*","/","~","^",":"] + , L.reservedNames = []} + +double :: Parser Double +double = do + f <- T.naturalOrFloat lexer + case f of + Left i -> return $ realToFrac i + Right d -> return d + +signedDouble :: Parser Double +signedDouble = + let signed = do symbol "-" + ((*) (-1)) <$> double + in + P.choice [signed,double] + +reservedOp :: String -> Parser () +reservedOp = T.reservedOp lexer + +whitespace :: Parser () +whitespace = T.whiteSpace lexer + +symbol :: String -> Parser () +symbol s = T.symbol lexer s >> return () + +identifier :: Parser String +identifier = T.identifier lexer + +stringLiteral :: Parser String +stringLiteral = T.stringLiteral lexer + +string :: String -> Parser () +string s = P.string s >> return () + +parse :: String -> CellExpr +parse "" = EmptyExpr +parse input = + case (P.parse program "" input) of + Left e -> CompileErrorExpr $ ParseError $ errorMessage e + Right x -> x + +errorMessage :: Error.ParseError -> String +errorMessage parseError = + let errors = Error.errorMessages parseError + Just unexpected = find (\e -> case e of + Error.SysUnExpect _ -> True + Error.UnExpect _ -> True + _ -> False) errors + expected = filter (\e -> case e of + Error.Expect "" -> False + Error.Expect _ -> True + _ -> False + ) errors + message e = + case e of + Error.SysUnExpect "" -> __ "end of input" + Error.SysUnExpect a -> a + Error.UnExpect "" -> __ "end of input" + Error.UnExpect a -> a + a -> Error.messageString a + + unexpectedMessage = unwords [ (__ "unexpected") ++ ":" + , message unexpected] + expectedMessage = + case expected of + [] -> "" + _ -> (__ "expecting") ++ " " ++ + (intercalate " or " $ nub $ map message expected) + in + case expectedMessage of + "" -> unexpectedMessage + _ -> unexpectedMessage ++ ", " ++ expectedMessage +-- ++ "#####" ++ show parseError diff --git a/src/Model/Grid.hs b/src/Model/Grid.hs new file mode 100644 --- /dev/null +++ b/src/Model/Grid.hs @@ -0,0 +1,248 @@ +module Model.Grid (Grid,new,getCell,setCell,rewriteCell + ,updateCell,updateCellIO,resizeTo + ,addRow,addColumn,deleteColumns,deleteRows + ,updateRowLabel,updateColumnLabel + ,columnIndex,rowIndex + ,setFilePath,getFilePath + ,getColumnValues) + where + +import Control.Monad (forM,forM_) +import Control.Applicative ((<$>)) +import Data.IORef +import Util.DynArray (DynArray) +import qualified Util.DynArray as Dyn +import Model.Cell (Cell) +import qualified Model.Cell as Cell +import Model.CellContent (CellExpr(..),CellValue(..),Reference(..) + ,NamedReference(..),CompileReason(..)) +import qualified Model.CellContent as CellContent +import Model.CellExpression.Parser (parse) +import Model.GridHeader (Header) +import qualified Model.GridHeader as Header +import CellCoordinate (CellCoord,coordRange) +import qualified View + +data Grid = Grid { cells :: DynArray CellCoord Cell + , rowHeader :: Header + , columnHeader :: Header + , filePath :: IORef (Maybe FilePath) + , numViewGridRows :: IO Int + , numViewGridCols :: IO Int + } + +new :: View.Info -> IO Grid +new viewInfo = do + cells <- Dyn.newMatrix (1,1) Cell.empty + rowHeader <- Header.new + columnHeader <- Header.new + filePath <- newIORef Nothing + return $ Grid cells rowHeader columnHeader filePath + (View.numDataRows viewInfo) (View.numDataColumns viewInfo) + +getCell :: CellCoord -> Grid -> IO Cell +getCell coord = Dyn.read coord . cells + +getCellValue :: CellCoord -> Grid -> IO CellValue +getCellValue coord grid = Cell.value <$> getCell coord grid + +setCell :: CellCoord -> String -> Grid -> IO [CellCoord] +setCell coord string grid = do + cell <- getCell coord grid + deleteDependenciesOn cell + cell' <- do expr <- compile (parse string,coord) grid + return $ Cell.setExpression string expr cell + addDependenciesOn cell' + Dyn.write coord cell' $ cells grid + evaluate coord grid + where + onCoords coords f = forM_ coords $ \c -> updateCell c f grid + + deleteDependenciesOn cell = + let onRef ref = + case ref of + Column a -> Header.deleteDependent coord a $ columnHeader grid + Row a -> Header.deleteDependent coord a $ rowHeader grid + _ -> do cs <- referencedCoords ref grid + onCoords cs $ Cell.deleteDependent coord + in forM_ (Cell.dependencies cell) onRef + + addDependenciesOn cell = + let onRef ref = + case ref of + Column a -> Header.addDependent coord a $ columnHeader grid + Row a -> Header.addDependent coord a $ rowHeader grid + _ -> do cs <- referencedCoords ref grid + onCoords cs $ Cell.addDependent coord + in forM_ (Cell.dependencies cell) onRef + +rewriteCell :: CellCoord -> Grid -> IO [CellCoord] +rewriteCell coord grid = do + input <- Cell.input <$> getCell coord grid + setCell coord input grid + +evaluate :: CellCoord -> Grid -> IO [CellCoord] +evaluate evalCoord grid = + let evaluateCell = Cell.evaluate $ flip referencedCellValue grid + evalRec (coord@(row,col)) = do + cell <- getCell coord grid + updateCellIO coord evaluateCell grid + changed1 <- forM (Cell.dependent cell) evalRec + changed2 <- evaluateHeaderDeps row rowHeader grid + changed3 <- evaluateHeaderDeps col columnHeader grid + return $ coord : ((concat changed1) ++ changed2 ++ changed3) + in + evalRec evalCoord + +evaluateHeaderDeps :: Int -> (Grid -> Header) -> Grid -> IO [CellCoord] +evaluateHeaderDeps i getHeader grid = do + dependents <- Header.dependents i $ getHeader grid + concat <$> (forM dependents $ \d -> evaluate d grid) + +evaluateAllHeaderDeps :: (Grid -> Header) -> Grid -> IO [CellCoord] +evaluateAllHeaderDeps getHeader grid = do + dependents <- Header.allDependents $ getHeader grid + concat <$> (forM dependents $ \d -> evaluate d grid) + +referencedCoords :: Reference -> Grid -> IO [CellCoord] +referencedCoords ref grid = + case ref of + Cell coord -> return [coord] + Range (from,to) -> return $ coordRange (from,to) + Column c -> do rows <- numViewGridRows grid + return $ coordRange ((0,c),(rows-1,c)) + Row r -> do cols <- numViewGridCols grid + return $ coordRange ((r,0),(r,cols-1)) + +referencedCellValue :: Reference -> Grid -> IO CellValue +referencedCellValue ref grid = do + coord <- referencedCoords ref grid + case ref of + (Cell _) -> getCellValue (head coord) grid + _ -> ListValue <$> (forM coord $ flip getCellValue grid) + + +updateCellIO :: CellCoord -> (Cell -> IO Cell) -> Grid -> IO () +updateCellIO coord f = Dyn.updateIO coord f . cells + +updateCell :: CellCoord -> (Cell -> Cell) -> Grid -> IO () +updateCell coord f = Dyn.update coord f . cells + +resizeTo :: CellCoord -> Grid -> IO () +resizeTo (r,c) = Dyn.resizeTo ((0,0),(r-1,c-1)) . cells + +addRow,addColumn :: String -> Grid -> IO [CellCoord] +addRow name grid = do + i <- numViewGridRows grid + Header.setLabel name (i-1) $ rowHeader grid + evaluateAllHeaderDeps columnHeader grid + +addColumn name grid = do + i <- numViewGridCols grid + Header.setLabel name (i-1) $ columnHeader grid + evaluateAllHeaderDeps rowHeader grid + +updateRowLabel,updateColumnLabel :: Int -> String -> Grid -> IO [CellCoord] +updateRowLabel i to grid = do + Header.setLabel to i $ rowHeader grid + changed1 <- do + cols <- numViewGridCols grid + rowDeps <- forM [0..cols] $ \c -> Cell.dependent <$> (getCell (i,c) grid) + forM (concat rowDeps) $ flip rewriteCell grid + changed2 <- do + headerDeps <- Header.dependents i $ rowHeader grid + forM headerDeps $ flip rewriteCell grid + return $ (concat changed1) ++ (concat changed2) + +updateColumnLabel i to grid = do + Header.setLabel to i $ columnHeader grid + changed1 <- do + rows <- numViewGridRows grid + colDeps <- forM [0..rows] $ \r -> Cell.dependent <$> (getCell (r,i) grid) + forM (concat colDeps) $ flip rewriteCell grid + changed2 <- do + headerDeps <- Header.dependents i $ columnHeader grid + forM headerDeps $ flip rewriteCell grid + return $ (concat changed1) ++ (concat changed2) + +rowIndex,columnIndex :: String -> Grid -> IO (Maybe Int) +rowIndex name grid = Header.index name $ rowHeader grid +columnIndex name grid = Header.index name $ columnHeader grid + +labelsToCoord :: (String,String) -> Grid -> IO (Maybe CellCoord) +labelsToCoord (rowName,columnName) grid = do + row <- rowIndex rowName grid + col <- columnIndex columnName grid + return $ case (row,col) of + (Just r,Just c) -> Just (r,c) + _ -> Nothing + +getFilePath :: Grid -> IO (Maybe FilePath) +getFilePath = readIORef . filePath + +setFilePath :: FilePath -> Grid -> IO () +setFilePath path grid = writeIORef (filePath grid) $ Just path + +deleteColumns :: [Int] -> Grid -> IO () +deleteColumns cols grid = do + Header.delete cols $ columnHeader grid + Dyn.deleteColumnsInMatrix cols $ cells grid + +deleteRows :: [Int] -> Grid -> IO () +deleteRows rows grid = do + Header.delete rows $ rowHeader grid + Dyn.deleteRowsInMatrix rows $ cells grid + +getColumnValues :: Int -> Grid -> IO [CellValue] +getColumnValues i grid = do + rows <- numViewGridRows grid + forM [0..rows-1] $ \row -> getCellValue (row,i) grid + +compile :: (CellExpr,CellCoord) -> Grid -> IO CellExpr +compile (expr,coord) grid = do + expr' <- referenceConversion expr grid + referenceLoop <- checkReferenceLoop (expr',coord) grid + if referenceLoop then return $ CompileErrorExpr ReferenceLoop + else return expr' + +checkReferenceLoop :: (CellExpr,CellCoord) -> Grid -> IO Bool +checkReferenceLoop (expr,at) grid = + let searchOnDependencies deps = do + refCoords <- do cs <- forM deps $ referencedCoords `flip` grid + return $ concat cs + or <$> forM refCoords depthFirstSearch + + depthFirstSearch coords | coords == at = return True + depthFirstSearch coords = do + deps <- Cell.dependencies <$> getCell coords grid + searchOnDependencies deps + in + searchOnDependencies $ CellContent.dependencies expr + +referenceConversion :: CellExpr -> Grid -> IO CellExpr +referenceConversion expr grid = + let convert (NamedCell a) = fmap Cell <$> labelsToCoord a grid + convert (NamedRange (a,b)) = + do a' <- labelsToCoord a grid + b' <- labelsToCoord b grid + case (a',b') of + (Just x,Just y) -> return $ Just $ Range (x,y) + _ -> return Nothing + convert (NamedColumn a) = fmap Column <$> columnIndex a grid + convert (NamedRow a) = fmap Row <$> rowIndex a grid + refConversion = flip referenceConversion grid + + in case expr of + NamedReference ref -> + do ref' <- convert ref + case ref' of + Just r -> return $ Reference r + Nothing -> return $ CompileErrorExpr $ RefConversionError ref + ListExpr a -> ListExpr <$> forM a refConversion + UnaryOp s a -> UnaryOp s <$> refConversion a + BinaryOp s a b -> do a' <- refConversion a + b' <- refConversion b + return $ BinaryOp s a' b' + Call s a -> Call s <$> refConversion a + Sub a -> Sub <$> refConversion a + _ -> return expr diff --git a/src/Model/GridHeader.hs b/src/Model/GridHeader.hs new file mode 100644 --- /dev/null +++ b/src/Model/GridHeader.hs @@ -0,0 +1,46 @@ +module Model.GridHeader (Header,new,addDependent,deleteDependent + ,dependents,allDependents,index,setLabel + ,delete,label) + where + +import Control.Applicative ((<$>)) +import Control.Monad (forM) +import qualified Data.List as List +import Data.Ix (range) +import Util.DynArray (DynArray) +import qualified Util.DynArray as DynArray +import CellCoordinate (CellCoord) + +type Label = String +type Info = (Label,[CellCoord]) +type Header = DynArray Int Info + +new :: IO Header +new = DynArray.newLinearArray 0 ("",[]) + +setLabel :: Label -> Int -> Header -> IO () +setLabel label to = DynArray.update to (\(_,deps) -> (label,deps)) + +addDependent :: CellCoord -> Int -> Header -> IO () +addDependent dep to = DynArray.update to (\(l,deps) -> (l,dep:deps)) + +deleteDependent :: CellCoord -> Int -> Header -> IO () +deleteDependent dep from = + DynArray.update from (\(l,deps) -> (l,List.delete dep deps)) + +label :: Int -> Header -> IO Label +label i header = fst <$> DynArray.read i header + +dependents :: Int -> Header -> IO [CellCoord] +dependents i header = snd <$> DynArray.read i header + +allDependents :: Header -> IO [CellCoord] +allDependents header = do + b <- DynArray.bounds header + concat <$> (forM (range b) $ \i -> dependents i header) + +index :: String -> Header -> IO (Maybe Int) +index label = DynArray.indexBy (\(l,_) -> label == l) + +delete :: [Int] -> Header -> IO () +delete = DynArray.deleteInLinearArray diff --git a/src/Run.hs b/src/Run.hs new file mode 100644 --- /dev/null +++ b/src/Run.hs @@ -0,0 +1,159 @@ +module Run (program) + where + +import Control.Monad (when) +import Control.Monad.Reader (runReaderT) +import Graphics.UI.WX (Prop ((:=)),on) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import Config (Config,initI18n) +import I18n (__) + +import qualified Model +import qualified View +import qualified Controller + +import qualified View.Modes as VMode +import qualified View.Component.TextWindow as VTextWindow +import qualified View.Component.Notebook as VNotebook + +import qualified Controller.Grid as CGrid +import qualified Controller.FormulaInput as CFormulaInput +import qualified Controller.SaveConfig as CSaveConfig + +import qualified Controller.Menu.File.NewClose as CFileNewClose +import qualified Controller.Menu.File.Open as CFileOpen +import qualified Controller.Menu.File.Save as CFileSave +import qualified Controller.Menu.File.Import.Csv as CFileImportCsv +import qualified Controller.Menu.File.Export.Image as CFileExportImage +import qualified Controller.Menu.File.Export.Diagram.BarChart as CFileExportBarChart +import qualified Controller.Menu.File.Export.Diagram.BoxPlot as CFileExportBoxPlot + +import qualified Controller.Menu.Table.Add as CAdd +import qualified Controller.Menu.Table.Copy as CCopy +import qualified Controller.Menu.Table.Delete as CDelete +import qualified Controller.Menu.Table.Transpose as CTranspose +import qualified Controller.Menu.Table.Reevaluate as CReevaluate + +import qualified Controller.Menu.Statistics.FrequencyDistribution as CStatsFD +import qualified Controller.Menu.Statistics.Descriptive as CDescriptive +import qualified Controller.Menu.Statistics.Pivot as CPivot + +program :: Config -> IO () +program config = do + initI18n config + + frame <- WX.frame [WX.text := "lhae"] + formulaInput <- VTextWindow.newSingleLine frame [] + notebook <- VNotebook.new frame + current <- WX.varCreate Nothing + + let view = View.View frame formulaInput notebook current + model <- Model.new + ctrl <- Controller.new config model view + let ifGridOpen eventHandler = do + opened <- View.isGridOpen view + when opened $ runReaderT eventHandler ctrl + call eventHandler = runReaderT eventHandler ctrl + + windowEH <- WXC.windowGetEventHandler notebook --frame + notebookId <- WXC.windowGetId notebook + WXC.evtHandlerOnEvent windowEH notebookId notebookId + [WXC.wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED] () + (\_ -> return ()) (\_ -> call CGrid.changePageEventHandler) + + WX.set formulaInput + [ WX.processEnter := True + , WX.enabled := False + , on WX.command := + do call CFormulaInput.eventHandler + VMode.gridMode view + , on WX.focus := + \onFocus -> when (not onFocus) $ VMode.gridMode view + ] + + fileMenu <- WX.menuPane [WX.text := "&" ++ (__ "File")] + fileNew <- WX.menuItem fileMenu [WX.text := "&" ++ (__ "New") ++ "\tCtrl+N"] + fileOpen <- WX.menuItem fileMenu [WX.text := "&" ++ (__ "Open") ++ " ...\tCtrl+O"] + fileImport <- WX.menuPane [WX.text := "&" ++ (__ "Import")] + _ <- WX.menuSub fileMenu fileImport [] + fileImportCsv <- WX.menuItem fileImport [WX.text := (__ "From CSV file") ++ " ..."] + WX.menuLine fileMenu + fileSaveAs <- WX.menuItem fileMenu [WX.text := (__ "Save as") ++ " ..."] + fileSave <- WX.menuItem fileMenu [WX.text := "&" ++ (__ "Save") ++ "\tCtrl+S"] + fileExport <- WX.menuPane [WX.text := "&" ++ (__ "Export")] + _ <- WX.menuSub fileMenu fileExport [] + fileExportImage <- WX.menuItem fileExport [WX.text := (__ "As image") ++ " ..."] + fileExportBarChart <- WX.menuItem fileExport [WX.text := (__ "As bar chart") ++ " ..."] + fileExportBoxPlot <- WX.menuItem fileExport [WX.text := (__ "As box plot") ++ " ..."] + WX.menuLine fileMenu + fileClose <- WX.menuItem fileMenu [WX.text := "&" ++ (__ "Close") ++ "\tCtrl+C"] + fileCloseAll <- WX.menuItem fileMenu [WX.text := (__ "Close all")] + fileQuit <- WX.menuQuit fileMenu [WX.text := "&" ++ (__ "Quit") ++ "\tCtrl+Q"] + + tableMenu <- WX.menuPane [WX.text := "&" ++ (__ "Table")] + tableAdd <- WX.menuPane [WX.text := (__ "Add")] + _ <- WX.menuSub tableMenu tableAdd [] + tableAddColumn <- WX.menuItem tableAdd [WX.text := (__ "Columns") ++ " ..."] + tableAddRow <- WX.menuItem tableAdd [WX.text := (__ "Rows") ++ " ..."] + tableCopy <- WX.menuPane [WX.text := (__ "Copy")] + _ <- WX.menuSub tableMenu tableCopy [] + tableCopyColumn <- WX.menuItem tableCopy [WX.text := (__ "Columns") ++ " ..."] + tableDelete <- WX.menuPane [WX.text := (__ "Delete")] + _ <- WX.menuSub tableMenu tableDelete [] + tableDeleteColumn <- WX.menuItem tableDelete [WX.text := (__ "Columns") ++ " ..."] + tableDeleteRow <- WX.menuItem tableDelete [WX.text := (__ "Rows") ++ " ..."] + tableTranspose <- WX.menuPane [WX.text := (__ "Transpose")] + _ <- WX.menuSub tableMenu tableTranspose [] + tableTransposeTable <- WX.menuItem tableTranspose [WX.text := (__ "Table")] + tableTransposeColumn <- WX.menuItem tableTranspose [WX.text := (__ "Columns") ++ " ..."] + tableTransposeRow <- WX.menuItem tableTranspose [WX.text := (__ "Rows") ++ " ..."] + tableReevalAll <- WX.menuItem tableMenu [WX.text := (__ "Reevaluate all cells")] + + statisticsMenu <- WX.menuPane [WX.text := "&" ++ (__ "Statistics")] + statsFreqDist <- WX.menuItem statisticsMenu [WX.text := (__ "Frequency Distribution") ++ " ..."] + statsDescriptive <- WX.menuItem statisticsMenu [WX.text := (__ "Descriptive") ++ " ..."] + statsPivot <- WX.menuItem statisticsMenu [WX.text := (__ "Pivot table") ++ " ..."] + + WX.set frame + [ WX.menuBar := [fileMenu,tableMenu,statisticsMenu] + , WX.layout := WX.column 0 + [ WX.hfill $ WX.widget formulaInput + , WX.fill $ WX.widget notebook + ] + , on (WX.menu fileNew) := call CFileNewClose.newEventHandler + + , on (WX.menu fileExportBoxPlot) := ifGridOpen CFileExportBoxPlot.eventHandler + + , on (WX.menu fileOpen) := call CFileOpen.eventHandler + , on (WX.menu fileSaveAs) := ifGridOpen CFileSave.saveAsEventHandler + , on (WX.menu fileSave) := ifGridOpen CFileSave.saveEventHandler + , on (WX.menu fileImportCsv) := call CFileImportCsv.eventHandler + , on (WX.menu fileExportImage) := ifGridOpen CFileExportImage.eventHandler + , on (WX.menu fileExportBarChart) := ifGridOpen CFileExportBarChart.eventHandler + , on (WX.menu fileExportBoxPlot) := ifGridOpen CFileExportBoxPlot.eventHandler + , on (WX.menu fileClose) := ifGridOpen CFileNewClose.closeEventHandler + , on (WX.menu fileCloseAll) := ifGridOpen CFileNewClose.closeAllEventHandler + , on (WX.menu fileQuit) := WX.close frame + + , on (WX.menu tableAddColumn) := ifGridOpen CAdd.columnEventHandler + , on (WX.menu tableAddRow) := ifGridOpen CAdd.rowEventHandler + , on (WX.menu tableCopyColumn) := ifGridOpen CCopy.eventHandler + , on (WX.menu tableDeleteColumn) := ifGridOpen CDelete.columnEventHandler + , on (WX.menu tableDeleteRow) := ifGridOpen CDelete.rowEventHandler + , on (WX.menu tableTransposeColumn) := ifGridOpen CTranspose.columnEventHandler + , on (WX.menu tableTransposeRow) := ifGridOpen CTranspose.rowEventHandler + , on (WX.menu tableTransposeTable) := ifGridOpen CTranspose.tableEventHandler + , on (WX.menu tableReevalAll) := ifGridOpen CReevaluate.eventHandler + + , on (WX.menu statsFreqDist) := ifGridOpen CStatsFD.eventHandler + , on (WX.menu statsDescriptive) := ifGridOpen CDescriptive.eventHandler + , on (WX.menu statsPivot) := ifGridOpen CPivot.eventHandler + + , on WX.closing := do ifGridOpen CFileNewClose.closeAllEventHandler + call CSaveConfig.eventHandler + WX.propagateEvent + + + ] + return () diff --git a/src/Util.hs b/src/Util.hs new file mode 100644 --- /dev/null +++ b/src/Util.hs @@ -0,0 +1,46 @@ +module Util (justWhen,whenNothing,(<.>),deleteByIndices,breakAt + ,maybeRead,stripWhitespace) + where + +import Control.Applicative ((<$>)) +import Control.Exception (assert) +import Data.List (sort) +import Data.Char (isSpace) + +justWhen :: Monad m => Maybe a -> (a -> m ()) -> m () +justWhen maybeThis doThis = case maybeThis of + Nothing -> return () + Just a -> doThis a + +whenNothing :: Monad m => Maybe a -> m () -> m () +whenNothing maybeThis doThis = case maybeThis of + Nothing -> doThis + _ -> return () + +(<.>) :: Functor f => (a -> b) -> (c -> f a) -> c -> f b +(<.>) p q arg = p <$> (q arg) + +deleteByIndices :: [Int] -> [a] -> [a] +deleteByIndices indices = + let deleteByIndex (_,l) ([],list) = ([],l:list) + deleteByIndex (lIndex,l) (i:is,list) = + if lIndex == i then (is,list) + else (i:is,l:list) + in + assert (indices == (reverse $ sort indices)) . + snd . foldr deleteByIndex (indices,[]) . zip [0..] + +breakAt :: (Eq a) => a -> [a] -> [[a]] +breakAt partition list = + case dropWhile ((==) partition) list of + [] -> [] + list' -> element : (breakAt partition list'') + where (element,list'') = break ((==) partition) list' + +maybeRead :: (Read a) => String -> Maybe a +maybeRead string = case reads string of + [(a,[])] -> Just a + _ -> Nothing + +stripWhitespace :: String -> String +stripWhitespace = takeWhile (not . isSpace) . dropWhile isSpace diff --git a/src/Util/Color.hs b/src/Util/Color.hs new file mode 100644 --- /dev/null +++ b/src/Util/Color.hs @@ -0,0 +1,32 @@ +module Util.Color (Color (..),fromWXColor,toWXColor,toHexColor) + where + +import qualified Graphics.UI.WX as WX +import Util.Sexp (Sexp (..)) +import Util.Sexpable (Sexpable (..), unexpected) +import Numeric (showHex) + +newtype Color = Color (Int,Int,Int) + +instance Sexpable Color where + toSexp (Color (r,g,b)) = List [toSexp r,toSexp g,toSexp b] + fromSexp (List [red,green,blue]) = + do r <- fromSexp red + g <- fromSexp green + b <- fromSexp blue + return $ Color (r,g,b) + fromSexp sexp = unexpected sexp + +fromWXColor :: WX.Color -> Color +fromWXColor c = Color (WX.colorRed c, WX.colorGreen c, WX.colorBlue c) + +toWXColor :: Color -> WX.Color +toWXColor (Color (r,g,b)) = WX.rgb r g b + +toHexColor :: Color -> String +toHexColor (Color (r,g,b)) = + let hex x = case showHex x "" of + [y] -> ['0',y] + y -> y + in + concat ["#", hex r, hex g, hex b] diff --git a/src/Util/DynArray.hs b/src/Util/DynArray.hs new file mode 100644 --- /dev/null +++ b/src/Util/DynArray.hs @@ -0,0 +1,172 @@ +module Util.DynArray (DynArray,new,newMatrix,newLinearArray,read + ,write,writes + ,resizeTo,updateIO,update,bounds,index,indexBy + ,elements,showDynArray + ,deleteInLinearArray + ,deleteColumnsInMatrix,deleteRowsInMatrix) + where + +import Prelude hiding (init,read) +import Control.Applicative ((<$>)) +import Control.Monad (forM_,when,foldM) +import Control.Exception (assert) +import Data.Array.IO (IOArray,readArray,writeArray,getBounds,getElems) +import qualified Data.Array.IO as ArrayIO +import Data.Ix (Ix,range,inRange) +import Data.IORef +import Data.List (sort) + +data DynArray i e = DynArray { ref :: IORef (IOArray i e) + , grow :: (i,i) -> i -> (i,i) + , init :: e + } + +defaultGrowingSize = 10 + +showDynArray :: (Ix i,Show e) => DynArray i e -> IO String +showDynArray dynArray = show <$> (readIORef (ref dynArray) >>= getElems) + +new :: Ix i => (i,i) -> ((i,i) -> i -> (i,i)) -> e -> IO (DynArray i e) +new ix grow e = do + array <- ArrayIO.newArray ix e + ref <- newIORef array + return $ DynArray ref grow e + +newMatrix :: (Int,Int) -> e -> IO (DynArray (Int,Int) e) +newMatrix (initRows,initColumns) = + let grow (_,(r,c)) (i,j) = ( (0,0) + , ( max r $ i + defaultGrowingSize - 1 + , max c $ j + defaultGrowingSize - 1)) + in + new ((0,0),(initRows-1,initColumns-1)) grow + +newLinearArray :: Int -> e -> IO (DynArray Int e) +newLinearArray numElements = + let grow _ i = (0,i + defaultGrowingSize - 1) + in + new (0,numElements-1) grow + +read :: Ix i => i -> DynArray i e -> IO e +read i dynArray = do + array <- readIORef $ ref dynArray + bounds <- getBounds array + if inRange bounds i then readArray array i + else return $ init dynArray + +write :: Ix i => i -> e -> DynArray i e -> IO () +write i e dynArray = do + array <- readIORef $ ref dynArray + bounds <- getBounds array + if inRange bounds i + then writeArray array i e + else do + array' <- ArrayIO.newArray (grow dynArray bounds i) $ init dynArray + copyUnsafe array array' + writeArray array' i e + writeIORef (ref dynArray) array' + +writes :: (Ix i,Enum i) => i -> [e] -> DynArray i e -> IO () +writes i es dynArray = + forM_ (zip [i..] es) $ \(pos,e) -> write pos e dynArray + +copyUnsafe :: Ix i => IOArray i e -> IOArray i e -> IO () +copyUnsafe from to = do + r <- getBounds from + forM_ (range r) $ \i -> readArray from i >>= writeArray to i + +resizeTo :: Ix i => (i,i) -> DynArray i e -> IO () +resizeTo range dynArray = + ArrayIO.newArray range (init dynArray) >>= writeIORef (ref dynArray) + +updateIO :: Ix i => i -> (e -> IO e) -> DynArray i e -> IO () +updateIO i f dynArray = + read i dynArray >>= f >>= \e -> write i e dynArray + +update :: Ix i => i -> (e -> e) -> DynArray i e -> IO () +update i f = updateIO i (return . f) + +bounds :: Ix i => DynArray i e -> IO (i,i) +bounds dynArray = readIORef (ref dynArray) >>= getBounds + +indexBy :: (Enum i, Ix i) => (e -> Bool) -> DynArray i e -> IO (Maybe i) +indexBy equals dynArray = do + array <- readIORef $ ref dynArray + bounds <- getBounds array + let indexRec i = + if inRange bounds i + then do value <- readArray array i + if equals value then return $ Just i + else indexRec $ succ i + else return Nothing + indexRec $ fst bounds + +index :: (Enum i, Ix i, Eq e) => e -> DynArray i e -> IO (Maybe i) +index e = indexBy ((==) e) + +elements :: Ix i => DynArray i e -> IO [e] +elements dynArray = readIORef (ref dynArray) >>= getElems + +deleteInLinearArray :: [Int] -> DynArray Int e -> IO () +deleteInLinearArray is dynArray = do + assert (is == sort is) $ return () + array <- readIORef $ ref dynArray + (minB,maxB) <- getBounds array + + let deleteElement (x:xs,deleted) index | x == index = + return (xs,deleted+1) + + deleteElement (xs,deleted) index = do + when (deleted > 0) $ + readArray array index >>= writeArray array (index - deleted) + return (xs,deleted) + + (_,deleted) <- foldM deleteElement (is,0) [minB..maxB] + forM_ [maxB-deleted+1..maxB] $ \x -> writeArray array x $ init dynArray + +deleteColumnsInMatrix :: [Int] -> DynArray (Int,Int) e -> IO () +deleteColumnsInMatrix columns dynArray = do + assert (columns == sort columns) $ return () + array <- readIORef $ ref dynArray + ((minRow,minCol),(maxRow,maxCol)) <- getBounds array + + let copyColumn from to = + forM_ [minRow..maxRow] $ \r -> + readArray array (r,from) >>= writeArray array (r,to) + + deleteColumn (col:cols,deleted) index | col == index = + return (cols,deleted+1) + + deleteColumn (cols,deleted) index = do + when (deleted > 0) $ copyColumn index $ index - deleted + return (cols,deleted) + + resetColumnToInit col = + forM_ [minRow..maxRow] $ \r -> + writeArray array (r,col) $ init dynArray + + (_,deleted) <- foldM deleteColumn (columns,0) [minCol..maxCol] + forM_ [maxCol-deleted+1..maxCol] resetColumnToInit + +deleteRowsInMatrix :: [Int] -> DynArray (Int,Int) e -> IO () +deleteRowsInMatrix rowsToDelete dynArray = do + assert (rowsToDelete == sort rowsToDelete) $ return () + array <- readIORef $ ref dynArray + ((minRow,minCol),(maxRow,maxCol)) <- getBounds array + + let copyRow from to = + forM_ [minCol..maxCol] $ \c -> + readArray array (from,c) >>= writeArray array (to,c) + + deleteRow (row:rows,deleted) index | row == index = + return (rows,deleted+1) + + deleteRow (rows,deleted) index = do + when (deleted > 0) $ copyRow index $ index - deleted + return (rows,deleted) + + resetRowToInit row = + forM_ [minCol..maxCol] $ \c -> + writeArray array (row,c) $ init dynArray + + (_,deleted) <- foldM deleteRow (rowsToDelete,0) [minRow..maxRow] + forM_ [maxRow-deleted+1..maxRow] resetRowToInit diff --git a/src/Util/FileType.hs b/src/Util/FileType.hs new file mode 100644 --- /dev/null +++ b/src/Util/FileType.hs @@ -0,0 +1,64 @@ +module Util.FileType ( FileType (..),extension,fromExtension + , fromFilePath,wildcard,bitmapType + , unknownFileType,unknownFileTypeIn + , justPngWildcard) + where + +import qualified Graphics.UI.WXCore as WXC +import Data.Char (toLower) +import System.FilePath (takeExtension) +import Util.Sexp (Sexp(Atom)) +import Util.Sexpable (Sexpable (..),unexpected,unknownAtom) +import I18n(__) + +data FileType = Bmp | Jpeg | Png | Tif deriving (Eq) + +instance Sexpable FileType where + toSexp = Atom . extension + fromSexp (Atom ext) = + case fromExtension ext of + Nothing -> unknownAtom ext + Just ft -> return ft + fromSexp sexp = unexpected sexp + +extension :: FileType -> String +extension ext = + case ext of { Bmp -> "bmp"; Jpeg -> "jpeg" + ; Png -> "png"; Tif -> "tif"} + +fromExtension :: String -> Maybe FileType +fromExtension ext = + case map toLower ext of + "bmp" -> Just Bmp + "jpg" -> Just Jpeg; "jpeg" -> Just Jpeg + "png" -> Just Png; "tif" -> Just Tif + _ -> Nothing + +unknownFileType :: String -> String +unknownFileType ext = (__ "Unknown file type") ++ " '" ++ ext ++ "'" + +unknownFileTypeIn :: FilePath -> String +unknownFileTypeIn filepath = + (__ "Unknown file type")++ " '" ++ (tail $ takeExtension filepath) ++ "'" + +fromFilePath :: FilePath -> Maybe FileType +fromFilePath = fromExtension . tail . takeExtension + +wildcard :: [(String,[String])] +wildcard = [ ("bmp",["*.bmp","*.BMP"]) + , ("jpeg",["*.jpg","*.JPG","*.jpeg","*.JPEG"]) + , ("png",["*.png","*.PNG"]) + , ("tif",["*.tif","*.TIF"]) + ] + +justPngWildcard :: [(String,[String])] +justPngWildcard = [("png",["*.png","*.PNG"])] + +bitmapType :: FileType -> Int +bitmapType ext = + case ext of + Bmp -> WXC.wxBITMAP_TYPE_BMP + Jpeg -> WXC.wxBITMAP_TYPE_JPEG + Png -> WXC.wxBITMAP_TYPE_PNG + Tif -> WXC.wxBITMAP_TYPE_TIF + diff --git a/src/Util/Gnuplot.hs b/src/Util/Gnuplot.hs new file mode 100644 --- /dev/null +++ b/src/Util/Gnuplot.hs @@ -0,0 +1,12 @@ +module Util.Gnuplot (run) + where + +import Control.Monad (forM_) +import System.Exit (ExitCode(..)) +import System.Cmd (rawSystem) + +run :: (FilePath,String) -> [(FilePath,String)] -> IO ExitCode +run (gnuplotFile,gnuplotData) dataFiles = do + writeFile gnuplotFile gnuplotData + forM_ dataFiles $ uncurry writeFile + rawSystem "gnuplot" [gnuplotFile] diff --git a/src/Util/Sexp.hs b/src/Util/Sexp.hs new file mode 100644 --- /dev/null +++ b/src/Util/Sexp.hs @@ -0,0 +1,83 @@ +module Util.Sexp ( Sexp (..),ValidSexp (..),parse,parseFile,prettyPrint + , validate) + where + +import Control.Applicative ((<$>)) +import Text.ParserCombinators.Parsec ((<|>),(),Parser) +import qualified Text.ParserCombinators.Parsec as P +import qualified Text.ParserCombinators.Parsec.Language as L +import qualified Text.ParserCombinators.Parsec.Token as T + +data Sexp = Atom String + | List [Sexp] + +instance Show Sexp where + show (Atom a) = show a + show (List a) = "(" ++ (unwords $ map show a) ++ ")" + +data ValidSexp = ValidAtom + | ValidList [ValidSexp] + | ValidListOf ValidSexp + | ValidSexp + +parse :: String -> Either String Sexp +parse = either (Left . show) Right . P.parse sexp "" + +parseFile :: FilePath -> IO (Either String Sexp) +parseFile filePath = parse <$> readFile filePath + +sexp,simpleSexp,atom,list :: Parser Sexp + +sexp = do { T.whiteSpace lexer + ; e <- simpleSexp + ; P.eof + ; return e + } "s-expression" + +simpleSexp = atom <|> list "simple s-expression" + +atom = (Atom <$> string) <|> (Atom <$> identifier) "atom" + +list = List <$> (P.between (symbol "(") (symbol ")") + $ P.many simpleSexp) "list" + +symbol = T.symbol lexer +string = T.stringLiteral lexer +identifier = T.identifier lexer + +lexer :: T.TokenParser () +lexer = T.makeTokenParser $ L.emptyDef + +prettyPrint :: Sexp -> String +prettyPrint = + let isAtomList (List l) = + let isAtom (Atom _) = True + isAtom _ = False + in + and $ map isAtom l + isAtomList _ = False + + ppList space (List l) = + let lines = map (pp $ " " ++ space) l + in + unlines ([space ++ "("] ++ lines) ++ space ++ ")" + + pp space sexp = + if isAtomList sexp + then space ++ (show sexp) + else case sexp of + List _ -> ppList space sexp + Atom a -> space ++ (show a) + in + pp "" + +validate :: ValidSexp -> Sexp -> Bool +validate valid sexp = + case (valid,sexp) of + (ValidAtom,Atom _) -> True + (ValidList v,List l) -> + if length v /= length l then False + else and $ map (uncurry validate) $ zip v l + (ValidListOf v,List l) -> and $ map (validate v) l + (ValidSexp,_) -> True + _ -> False diff --git a/src/Util/Sexpable.hs b/src/Util/Sexpable.hs new file mode 100644 --- /dev/null +++ b/src/Util/Sexpable.hs @@ -0,0 +1,86 @@ +{-# OPTIONS_GHC -XFlexibleInstances -XOverlappingInstances #-} +module Util.Sexpable ( Sexpable (..),ParseSexpError,PSE + , unexpected,unknownAtom + , recordToSexp,recordFromSexp) + where + +import Control.Monad.Error + +import Util.Sexp (Sexp (..)) + +data ParseSexpError = Unexpected Sexp + | UnknownAtom String + | UnknownError String + +type PSE = Either ParseSexpError + +instance Show ParseSexpError where + show (Unexpected sexp) = "Unexpected s-expression " ++ (show sexp) + show (UnknownAtom atom) = "Unknown atom " ++ atom + show (UnknownError msg) = "Unknown error: " ++ msg + +instance Error ParseSexpError where + noMsg = UnknownError "Unknown s-expression parsing error" + strMsg msg = UnknownError msg + +unexpected :: Sexp -> PSE a +unexpected = throwError . Unexpected + +unknownAtom :: String -> PSE a +unknownAtom = throwError . UnknownAtom + +class Sexpable a where + toSexp :: a -> Sexp + fromSexp :: Sexp -> PSE a + +instance Sexpable Char where + toSexp c = Atom [c] + fromSexp (Atom (a:[])) = return a + fromSexp (Atom a) = throwError $ UnknownError $ "Can not parse character from " ++ (show $ Atom a) + fromSexp sexp = unexpected sexp + +instance Sexpable [Char] where + toSexp = Atom + fromSexp (Atom a) = return a + fromSexp sexp = unexpected sexp + +instance (Sexpable a) => Sexpable [a] where + toSexp = List . map toSexp + fromSexp (List a) = forM a fromSexp + fromSexp sexp = unexpected sexp + +instance Sexpable Int where + toSexp = Atom . show + fromSexp (Atom a) = return $ read a + fromSexp sexp = unexpected sexp + +instance Sexpable Double where + toSexp = Atom . show + fromSexp (Atom a) = return $ read a + fromSexp sexp = unexpected sexp + +instance (Sexpable a) => Sexpable (Maybe a) where + toSexp Nothing = List [Atom "optional"] + toSexp (Just a) = List [Atom "optional",toSexp a] + fromSexp (List [Atom "optional"]) = return Nothing + fromSexp (List [Atom "optional",sexp]) = + fromSexp sexp >>= return . Just + fromSexp sexp = unexpected sexp + +instance Sexpable Bool where + toSexp True = Atom "true" + toSexp False = Atom "false" + fromSexp (Atom "true") = return True + fromSexp (Atom "false") = return False + fromSexp sexp = unexpected sexp + +recordToSexp :: [(String, b -> Sexp)] -> b -> Sexp +recordToSexp assocs record = + List $ (map (\(name, field) -> + List [Atom name, field record] + ) + ) assocs + +recordFromSexp :: (a -> Sexp -> PSE a) -> a -> Sexp -> PSE a +recordFromSexp f init (List options) = foldM f init options +recordFromSexp _ _ sexp = unexpected sexp diff --git a/src/View.hs b/src/View.hs new file mode 100644 --- /dev/null +++ b/src/View.hs @@ -0,0 +1,33 @@ +module View (View(..),Info(..),onGrid,isGridOpen + ,info) + where + +import qualified Graphics.UI.WX as WX +import qualified View.Component.Grid as Grid +import qualified View.Component.TextWindow as TextWindow +import qualified View.Component.Notebook as Notebook + +data View = View { frame :: WX.Frame () + , formulaInput :: TextWindow.TextWindow + , notebook :: Notebook.Notebook + , current :: WX.Var (Maybe Grid.Grid) + } + +data Info = Info { numDataRows :: IO Int + , numDataColumns :: IO Int + } + +onGrid :: View -> (Grid.Grid -> IO a) -> IO a +onGrid view f = WX.varGet (current view) >>= \(Just grid) -> f grid + +isGridOpen :: View -> IO Bool +isGridOpen view = do + current <- WX.varGet $ current view + return $ case current of + Nothing -> False + _ -> True + +info :: View -> Info +info view = Info { numDataRows = onGrid view Grid.numDataRows + , numDataColumns = onGrid view Grid.numDataColumns + } diff --git a/src/View/Component/Grid.hs b/src/View/Component/Grid.hs new file mode 100644 --- /dev/null +++ b/src/View/Component/Grid.hs @@ -0,0 +1,124 @@ +module View.Component.Grid (Grid,new,getCursorPos + ,cycleCursor + ,setValue,getValue + ,getRowValues,getColumnValues + ,getRowLabel,getColumnLabel + ,getRowLabels,getColumnLabels + ,setRowLabel,setColumnLabel + ,addRow,addColumn,numDataRows,numDataColumns + ,deleteColumns,deleteRows + ) + where + +import Control.Exception (assert) +import Control.Monad (forM,forM_) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import Data.List (sort) +import CellCoordinate (CellCoord) +import Util (deleteByIndices) + +type Grid = WXC.Grid () + +new :: WX.Window a -> [WX.Prop Grid] -> IO Grid +new parent props = + let createFromParent id rect props flags = + do g <- WXC.gridCreate parent id rect flags + WXC.gridCreateGrid g 0 0 0 + WX.set g props + return g + in do + grid <- WX.initialWindow createFromParent props 0 + WXC.gridAppendRows grid 1 True + WXC.gridAppendCols grid 1 True + WXC.gridSetRowLabelValue grid 0 "..." + WXC.gridSetColLabelValue grid 0 "..." + return grid + +cycleCursor :: Grid -> IO () +cycleCursor grid = do + (row,col) <- getCursorPos grid + rowCount <- WXC.gridGetNumberRows grid + colCount <- WXC.gridGetNumberCols grid + let (row',col') = + if row+1 >= rowCount + then if col+1 >= colCount then (0,0) else (0,col+1) + else (row+1,col) + WXC.gridSetGridCursor grid row' col' + +getCursorPos :: Grid -> IO CellCoord +getCursorPos grid = do + row <- WXC.gridGetGridCursorRow grid + col <- WXC.gridGetGridCursorCol grid + return (row,col) + +getValue :: CellCoord -> Grid -> IO String +getValue (row,col) grid = WXC.gridGetCellValue grid row col + +setValue :: CellCoord -> String -> Grid -> IO () +setValue (row,col) s grid = WXC.gridSetCellValue grid row col s + +numDataRows,numDataColumns :: Grid -> IO Int +numDataRows grid = WXC.gridGetNumberRows grid >>= \n -> return $ n-1 +numDataColumns grid = WXC.gridGetNumberCols grid >>= \n -> return $ n-1 + +getRowLabel,getColumnLabel :: Int -> Grid -> IO String +getRowLabel = flip WXC.gridGetRowLabelValue +getColumnLabel = flip WXC.gridGetColLabelValue + +getRowLabels,getColumnLabels :: Grid -> IO [String] +getRowLabels grid = do + n <- numDataRows grid + forM [0..n-1] $ flip getRowLabel grid +getColumnLabels grid = do + n <- numDataColumns grid + forM [0..n-1] $ flip getColumnLabel grid + +setRowLabel,setColumnLabel :: Int -> String -> Grid -> IO () +setRowLabel n s grid = WXC.gridSetRowLabelValue grid n s +setColumnLabel n s grid = WXC.gridSetColLabelValue grid n s + +getRowValues,getColumnValues :: Int -> Grid -> IO [String] +getRowValues n grid = do + cols <- numDataColumns grid + forM [0..cols-1] $ \i -> getValue (n,i) grid +getColumnValues n grid = do + rows <- numDataRows grid + forM [0..rows-1] $ \i -> getValue (i,n) grid + +addRow,addColumn :: String -> Grid -> IO () +addRow name grid = do + n <- numDataRows grid + WXC.gridAppendRows grid 1 True + setRowLabel n name grid + setRowLabel (n+1) "..." grid +addColumn name grid = do + n <- numDataColumns grid + WXC.gridAppendCols grid 1 True + setColumnLabel n name grid + setColumnLabel (n+1) "..." grid + +deleteColumns :: [Int] -> Grid -> IO () +deleteColumns cols grid = do + assert (reverse (sort cols) == cols) $ return () + labels <- getColumnLabels grid + + forM_ cols $ \i -> WXC.gridDeleteCols grid i 1 True + + -- Reset labels (because of buggy gridDeleteCols) + forM (zip [0..] $ deleteByIndices cols labels) $ \(col,label) -> + setColumnLabel col label grid + + numDataColumns grid >>= \n -> setColumnLabel n "..." grid + +deleteRows :: [Int] -> Grid -> IO () +deleteRows rows grid = do + assert (reverse (sort rows) == rows) $ return () + labels <- getRowLabels grid + forM_ rows $ \i -> WXC.gridDeleteRows grid i 1 True + + -- Reset labels (because of buggy gridDeleteCols) + forM (zip [0..] $ deleteByIndices rows labels) $ \(row,label) -> + setRowLabel row label grid + + numDataRows grid >>= \n -> setRowLabel n "..." grid diff --git a/src/View/Component/Notebook.hs b/src/View/Component/Notebook.hs new file mode 100644 --- /dev/null +++ b/src/View/Component/Notebook.hs @@ -0,0 +1,65 @@ +module View.Component.Notebook + (Notebook,GridId,new,addGrid,deleteCurrentView + ,currentSelectionNum,currentSelectionId,getGrid + ,getCurrentCaption,setCurrentCaption,pageId,numPages) + where + +import Control.Applicative ((<$>)) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import View.Component.Grid (Grid) + +type Notebook = WXC.Notebook () +type GridId = Int + +new :: WX.Window a -> IO Notebook +new parent = + let createFromParent id rect props _ = do + n <- WXC.notebookCreate parent id rect WXC.wxNB_BOTTOM + WX.set n props + return n + in + WX.initialWindow createFromParent [] 0 + +addGrid :: Grid -> String -> Notebook -> IO () +addGrid grid caption notebook = do + _ <- WXC.notebookAddPage notebook grid caption True (-1) + return () + +deleteCurrentView :: Notebook -> IO () +deleteCurrentView notebook = do + _ <- WXC.notebookGetSelection notebook >>= + WXC.notebookDeletePage notebook + return () + +currentSelectionNum :: Notebook -> IO (Maybe Int) +currentSelectionNum notebook = do + n <- numPages notebook + if n == 0 then return Nothing + else Just <$> WXC.notebookGetSelection notebook + +currentSelectionId :: Notebook -> IO (Maybe GridId) +currentSelectionId notebook = do + n <- numPages notebook + if n == 0 then return Nothing + else Just <$> (WXC.notebookGetSelection notebook >>= + flip pageId notebook) + +pageId :: Int -> Notebook -> IO GridId +pageId n notebook = WXC.notebookGetPage notebook n >>= WXC.windowGetId + +getGrid :: Int -> Notebook -> IO Grid +getGrid n notebook = WX.objectCast <$> WXC.notebookGetPage notebook n + +setCurrentCaption :: String -> Notebook -> IO () +setCurrentCaption caption notebook = do + current <- WXC.notebookGetSelection notebook + _ <- WXC.notebookSetPageText notebook current caption + return () + +getCurrentCaption :: Notebook -> IO String +getCurrentCaption notebook = WXC.notebookGetSelection notebook + >>= WXC.notebookGetPageText notebook + +numPages :: Notebook -> IO Int +numPages = WXC.notebookGetPageCount diff --git a/src/View/Component/TextWindow.hs b/src/View/Component/TextWindow.hs new file mode 100644 --- /dev/null +++ b/src/View/Component/TextWindow.hs @@ -0,0 +1,24 @@ +module View.Component.TextWindow (TextWindow,new,newSingleLine + ,printString,print,text) + where + +import Prelude hiding (print) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC + +type TextWindow = WX.TextCtrl () + +new :: WX.Window a -> [WX.Prop TextWindow] -> IO TextWindow +new = WX.textCtrl + +newSingleLine :: WX.Window a -> [WX.Prop TextWindow] -> IO TextWindow +newSingleLine = WX.textEntry + +printString :: String -> TextWindow -> IO () +printString s win = WXC.textCtrlAppendText win $ s ++ "\n" + +print :: Show a => a -> TextWindow -> IO () +print s win = WXC.textCtrlAppendText win $ show s ++ "\n" + +text :: TextWindow -> IO String +text = WXC.textCtrlGetValue diff --git a/src/View/Dialog/Complex.hs b/src/View/Dialog/Complex.hs new file mode 100644 --- /dev/null +++ b/src/View/Dialog/Complex.hs @@ -0,0 +1,248 @@ +module View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showDialog,showSimpleDialog + ,okButton,cancelButton) + where + +import Control.Applicative ((<$>)) +import Control.Monad (forM,forM_,foldM,when) +import Data.Char (isDigit) +import Graphics.UI.WX (Prop ((:=)),on) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import View (View,frame) +import Util (justWhen,maybeRead) +import Util.Color (Color,fromWXColor,toWXColor) +import I18n (__) + +data Widget a b = + ScrolledWindow (WX.Dialog () -> IO (WX.ScrolledWindow ())) + | TextEntry (a -> String) (a -> String -> a) + | NumberEntry (a -> Double) (a -> Double -> a) + | Button String b + | DefaultButton String b + | TerminationButton String + | ColorButton (a -> Color) (a -> Color -> a) + | SingleListBox [String] (a -> Maybe Int) (a -> Maybe Int -> a) + | MultiListBox [String] (a -> [Int]) (a -> [Int] -> a) + | Spinner Int Int (a -> Int) (a -> Int -> a) + | Choice [String] (a -> Int) (a -> Int -> a) + | CheckBox String (a -> Bool) (a -> Bool -> a) + | RadioBox String [String] (a -> Int) (a -> Int -> a) + +data Modifier = HFill | Center | Margin | Boxed String + +data WXWidget a b = + WXScrolledWindow (WX.ScrolledWindow ()) + | WXTextEntry (WX.TextCtrl ()) (a -> String -> a) + | WXNumberEntry (WX.TextCtrl ()) (a -> Double -> a) + | WXButton (WX.Button ()) b + | WXTerminationButton (WX.Button ()) + | WXColorButton (WX.Button ()) (a -> Color -> a) + | WXSingleListBox (WX.SingleListBox ()) (a -> Maybe Int -> a) + | WXMultiListBox (WX.MultiListBox ()) (a -> [Int] -> a) + | WXSpinCtrl (WX.SpinCtrl ()) (a -> Int -> a) + | WXChoice (WX.Choice ()) (a -> Int -> a) + | WXCheckBox (WX.CheckBox ()) (a -> Bool -> a) + | WXRadioBox (WX.RadioBox ()) (a -> Int -> a) + +instance WX.Widget (WXWidget a b) where + widget (WXScrolledWindow ctrl) = WX.widget ctrl + widget (WXTextEntry ctrl _) = WX.widget ctrl + widget (WXNumberEntry ctrl _) = WX.widget ctrl + widget (WXButton ctrl _) = WX.widget ctrl + widget (WXTerminationButton ctrl) = WX.widget ctrl + widget (WXColorButton ctrl _) = WX.widget ctrl + widget (WXSingleListBox ctrl _) = WX.widget ctrl + widget (WXMultiListBox ctrl _) = WX.widget ctrl + widget (WXSpinCtrl ctrl _) = WX.widget ctrl + widget (WXChoice ctrl _) = WX.widget ctrl + widget (WXCheckBox ctrl _) = WX.widget ctrl + widget (WXRadioBox ctrl _) = WX.widget ctrl + +data Layout a b = Row [Layout a b] + | Column [Layout a b] + | Grid [[Layout a b]] + | Label String + | Modifier Modifier (Layout a b) + | Modifiers [Modifier] (Layout a b) + | Widget (Widget a b) + | FocusOn (Widget a b) + | WXWidget (WXWidget a b) + +showDialog :: String -> Layout a b -> a -> View -> IO (Maybe (a,b)) +showDialog caption layout defaultRecord view = do + dialog <- WX.dialog (frame view) [WX.text := caption] + layout' <- buildWXWidgets dialog layout defaultRecord + + WX.set dialog [WX.layout := buildWXLayout layout'] + + WX.showModal dialog + (\endWith -> setButtonActions endWith defaultRecord layout') + +showSimpleDialog :: String -> Layout a () -> a -> View -> IO (Maybe a) +showSimpleDialog caption layout defaultRecord view = + fmap fst <$> showDialog caption layout defaultRecord view + +buildWXWidgets :: WX.Dialog () -> Layout a b -> a -> IO (Layout a b) +buildWXWidgets dialog layout record = + let recBuild layout' = buildWXWidgets dialog layout' record + in + case layout of + Row a -> Row <$> forM a recBuild + Column a -> Column <$> forM a recBuild + Grid a -> Grid <$> mapM (mapM recBuild) a + Label a -> return $ Label a + Modifier a b -> Modifier a <$> recBuild b + Modifiers a b -> Modifiers a <$> recBuild b + FocusOn a -> do (WXWidget w) <- recBuild $ Widget a + case w of WXTextEntry c _ -> WX.focusOn c + WXNumberEntry c _ -> WX.focusOn c + WXButton c _ -> WX.focusOn c + return $ WXWidget w + Widget (ScrolledWindow makeWindow) -> + (WXWidget . WXScrolledWindow) <$> makeWindow dialog + Widget (TextEntry get set) -> + do ctrl <- WX.textEntry dialog [WX.text := get record] + return $ WXWidget $ WXTextEntry ctrl set + Widget (NumberEntry get set) -> + do ctrl <- WX.textEntry dialog [WX.text := show $ get record] + WX.set ctrl [on WX.anyKey := numberEntryKeyHandler ctrl] + return $ WXWidget $ WXNumberEntry ctrl set + Widget (Button text action) -> + do ctrl <- WX.button dialog [WX.text := text] + return $ WXWidget $ WXButton ctrl action + Widget (DefaultButton text action) -> + do ctrl <- WX.button dialog [WX.text := text] + WXC.buttonSetDefault ctrl + return $ WXWidget $ WXButton ctrl action + Widget (TerminationButton text) -> + do ctrl <- WX.button dialog [WX.text := text] + return $ WXWidget $ WXTerminationButton ctrl + Widget (ColorButton get set) -> + do ctrl <- WX.button dialog [ WX.bgcolor := toWXColor $ get record] + WX.set ctrl [on WX.command := do + color <- WX.get ctrl WX.bgcolor >>= WX.colorDialog dialog + justWhen color $ \c -> WX.set ctrl [WX.bgcolor := c]] + return $ WXWidget $ WXColorButton ctrl set + Widget (SingleListBox items get set) -> + do ctrl <- WX.singleListBox dialog [WX.items := items] + justWhen (get record) $ \selection -> + WX.set ctrl [WX.selection := selection] + return $ WXWidget $ WXSingleListBox ctrl set + Widget (MultiListBox items get set) -> + do ctrl <- WX.multiListBox dialog [WX.items := items] + when (not $ null $ get record) $ + WX.set ctrl [WX.selections := get record] + return $ WXWidget $ WXMultiListBox ctrl set + Widget (Spinner min max get set) -> + do ctrl <- WX.spinCtrl dialog min max [WX.selection := get record] + return $ WXWidget $ WXSpinCtrl ctrl set + Widget (Choice items get set) -> + do ctrl <- WX.choice dialog [ WX.items := items + , WX.selection := get record] + return $ WXWidget $ WXChoice ctrl set + Widget (CheckBox text get set) -> + do ctrl <- WX.checkBox dialog [ WX.text := text + , WX.checked := get record] + return $ WXWidget $ WXCheckBox ctrl set + Widget (RadioBox text items get set) -> + do ctrl <- WX.radioBox dialog WX.Vertical items + [WX.text := text, WX.selection := get record] + return $ WXWidget $ WXRadioBox ctrl set + +buildWXLayout :: Layout a b -> WX.Layout +buildWXLayout layout = + case layout of + Row a -> WX.row 5 $ map buildWXLayout a + Column a -> WX.column 5 $ map buildWXLayout a + Grid rows -> WX.grid 5 5 $ map (map buildWXLayout) rows + Label a -> WX.label a + Modifier HFill a -> WX.hfill $ buildWXLayout a + Modifier Center a -> WX.centre $ buildWXLayout a + Modifier Margin a -> WX.margin 10 $ buildWXLayout a + Modifier (Boxed text) a -> WX.boxed text $ buildWXLayout a + Modifiers xs a -> buildWXLayout $ foldr Modifier a xs + WXWidget a -> WX.widget a + +setButtonActions :: (Maybe (a,b) -> IO ()) -> a -> Layout a b -> IO () +setButtonActions endWith record completeLayout = + let recSet layout = + case layout of + Row a -> forM_ a recSet + Column a -> forM_ a recSet + Grid rows -> mapM_ (mapM_ recSet) rows + Label _ -> return () + Modifier _ a -> recSet a + Modifiers _ a -> recSet a + WXWidget (WXTerminationButton button) -> + WX.set button [on WX.command := endWith Nothing] + WXWidget (WXButton button action) -> + WX.set button [on WX.command := + do result <- buildRecord record completeLayout + endWith $ Just (result,action)] + WXWidget _ -> return () + in + recSet completeLayout + +buildRecord :: a -> Layout a b -> IO a +buildRecord record layout = + case layout of + Row a -> foldM buildRecord record a + Column a -> foldM buildRecord record a + Grid rows -> foldM (foldM buildRecord) record rows + Label _ -> return record + Modifier _ a -> buildRecord record a + Modifiers _ a -> buildRecord record a + WXWidget (WXScrolledWindow _) -> return record + WXWidget (WXTextEntry ctrl set) -> + set record <$> WX.get ctrl WX.text + WXWidget (WXNumberEntry ctrl set) -> do + num <- maybeRead <$> WX.get ctrl WX.text + case num of Just n -> return $ set record n + Nothing -> return record + WXWidget (WXButton _ _) -> return record + WXWidget (WXTerminationButton _) -> return record + WXWidget (WXColorButton ctrl set) -> + (set record . fromWXColor) <$> WX.get ctrl WX.bgcolor + WXWidget (WXSingleListBox ctrl set) -> + set record <$> getMaybeSelection ctrl + WXWidget (WXMultiListBox ctrl set) -> + set record <$> WX.get ctrl WX.selections + WXWidget (WXSpinCtrl ctrl set) -> set record <$> WX.get ctrl WX.selection + WXWidget (WXChoice ctrl set) -> set record <$> WX.get ctrl WX.selection + WXWidget (WXCheckBox ctrl set) -> set record <$> WX.get ctrl WX.checked + WXWidget (WXRadioBox ctrl set) -> set record <$> WX.get ctrl WX.selection + + where + getMaybeSelection ctrl = do + selection <- WX.get ctrl WX.selection + return $ if selection == -1 then Nothing else Just selection + +numberEntryKeyHandler :: (WX.TextCtrl ()) -> WX.Key -> IO () +numberEntryKeyHandler ctrl key = do + text <- WX.get ctrl WX.text + let lastCharIsDigit = (not $ null text) && + (isDigit $ head $ reverse text) + case key of + WX.KeyChar '0' -> WX.propagateEvent + WX.KeyChar '1' -> WX.propagateEvent + WX.KeyChar '2' -> WX.propagateEvent + WX.KeyChar '3' -> WX.propagateEvent + WX.KeyChar '4' -> WX.propagateEvent + WX.KeyChar '5' -> WX.propagateEvent + WX.KeyChar '6' -> WX.propagateEvent + WX.KeyChar '7' -> WX.propagateEvent + WX.KeyChar '8' -> WX.propagateEvent + WX.KeyChar '9' -> WX.propagateEvent + WX.KeyChar '.' -> when (not (elem '.' text) && lastCharIsDigit) + WX.propagateEvent + WX.KeyChar '-' -> when (null text) WX.propagateEvent + WX.KeyChar _ -> return () + WX.KeySpace -> return () + _ -> WX.propagateEvent + +okButton :: b -> Layout a b +okButton = Widget . DefaultButton (__ "&Ok") + +cancelButton :: Layout a b +cancelButton = Widget $ TerminationButton (__ "&Cancel") diff --git a/src/View/Dialog/Simple.hs b/src/View/Dialog/Simple.hs new file mode 100644 --- /dev/null +++ b/src/View/Dialog/Simple.hs @@ -0,0 +1,23 @@ +module View.Dialog.Simple (input,warning,confirm) + where + +import qualified Graphics.UI.WX as WX +import View (View,frame) +import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..) + ,showSimpleDialog,okButton,cancelButton) +import I18n (__) + +input :: String -> String -> View -> IO (Maybe String) +input caption = + let dialog = Modifier Margin $ Column + [ FocusOn $ TextEntry id (\_ -> id) + , Modifier Center + $ Row [okButton (), cancelButton]] + in + showSimpleDialog caption dialog + +warning :: String -> View -> IO () +warning text view = WX.errorDialog (frame view) (__ "Error") text + +confirm :: String -> String -> View -> IO Bool +confirm caption s view = WX.confirmDialog (frame view) caption s True diff --git a/src/View/FormulaInput.hs b/src/View/FormulaInput.hs new file mode 100644 --- /dev/null +++ b/src/View/FormulaInput.hs @@ -0,0 +1,16 @@ +module View.FormulaInput (log,logString,formula) + where + +import Prelude hiding (log) +import qualified Graphics.UI.WXCore as WXC +import View (View,formulaInput) +import qualified View.Component.TextWindow as TW + +logString :: String -> View -> IO () +logString s view = WXC.textCtrlSetValue (formulaInput view) s + +log :: Show a => a -> View -> IO () +log some = logString $ show some + +formula :: View -> IO String +formula = TW.text . formulaInput diff --git a/src/View/GridPage.hs b/src/View/GridPage.hs new file mode 100644 --- /dev/null +++ b/src/View/GridPage.hs @@ -0,0 +1,96 @@ +module View.GridPage (new,add,deleteCurrent,setCurrent + ,getCurrentCaption,setCurrentCaption + ,keyEventHandler,captions + ,currentSelectionNum,currentSelectionId,pageId + ,fireSelectionEvent) + where + +import Control.Applicative ((<$>)) +import Control.Monad (forM) +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import View (View,notebook,current,onGrid) +import Util (justWhen) +import View.Component.Notebook (GridId) +import qualified View.Component.Notebook as Notebook +import View.Component.Grid (Grid) +import qualified View.Component.Grid as Grid +import View.Modes (gridMode) + +new :: View -> IO (GridId,Grid) +new view = do + grid <- Grid.new (notebook view) [] + id <- WXC.windowGetId grid + return (id,grid) + +add :: Maybe String -> Grid -> View -> IO () +add maybeCaption grid view = + let nb = notebook view + in do + caption <- case maybeCaption of + Nothing -> + do id <- show . abs <$> WXC.windowGetId grid + return $ unwords ["unnamed","[" ++ id ++ "]"] + Just c -> return c + Notebook.addGrid grid caption nb + Notebook.currentSelectionNum nb >>= (\(Just n) -> setCurrent n view) + +deleteCurrent :: View -> IO () +deleteCurrent view = do + currentStuff <- WX.varGet $ current view + justWhen currentStuff $ \_ -> + do Notebook.deleteCurrentView $ notebook view + next <- Notebook.currentSelectionNum $ notebook view + case next of + Nothing -> WX.varSet (current view) Nothing + Just n -> setCurrent n view + +setCurrent :: Int -> View -> IO () +setCurrent n view = do + grid <- Notebook.getGrid n $ notebook view + WX.varSet (current view) $ Just grid + gridMode view + +fireSelectionEvent :: Int -> View -> IO () +fireSelectionEvent n view = do + _ <- WXC.notebookSetSelection (notebook view) n + return () + +setCurrentCaption :: String -> View -> IO () +setCurrentCaption c = Notebook.setCurrentCaption c . notebook + +getCurrentCaption :: View -> IO String +getCurrentCaption = Notebook.getCurrentCaption . notebook + +captions :: View -> IO [String] +captions view = do + n <- WXC.notebookGetPageCount $ notebook view + forM [0..n-1] $ WXC.notebookGetPageText $ notebook view + +currentSelectionNum :: View -> IO (Maybe Int) +currentSelectionNum = Notebook.currentSelectionNum . notebook + +currentSelectionId :: View -> IO (Maybe Int) +currentSelectionId = Notebook.currentSelectionId . notebook + +pageId :: Int -> View -> IO Int +pageId n = Notebook.pageId n . notebook + +keyEventHandler :: View -> WXC.EventKey -> IO () +keyEventHandler view (WXC.EventKey key modifier _) = do + case key of + WXC.KeyReturn -> + do isEnabled <- onGrid view WXC.gridIsCellEditControlEnabled + onGrid view $ if isEnabled + then flip WXC.gridEnableCellEditControl False + else flip WXC.gridEnableCellEditControl True + WXC.KeyTab -> + case modifier of + WXC.Modifiers {WXC.controlDown=True} -> + WXC.notebookAdvanceSelection (notebook view) True + _ -> onGrid view Grid.cycleCursor + WXC.KeyLeft -> WXC.propagateEvent + WXC.KeyRight -> WXC.propagateEvent + WXC.KeyUp -> WXC.propagateEvent + WXC.KeyDown -> WXC.propagateEvent + _ -> return () diff --git a/src/View/Modes.hs b/src/View/Modes.hs new file mode 100644 --- /dev/null +++ b/src/View/Modes.hs @@ -0,0 +1,22 @@ +module View.Modes (formulaMode,gridMode) + where + +import qualified Graphics.UI.WX as WX +import qualified Graphics.UI.WXCore as WXC +import View (View,onGrid,formulaInput) +import CellCoordinate (CellCoord) + +formulaMode :: CellCoord -> String -> View -> IO () +formulaMode (row,col) value view = + onGrid view $ \grid -> do + WXC.textCtrlSetValue (formulaInput view) value + WXC.gridSelectBlock grid row col row col False + WXC.windowEnable $ formulaInput view + WX.focusOn $ formulaInput view + +gridMode :: View -> IO () +gridMode view = + onGrid view $ \grid -> do + WXC.gridSelectBlock grid (-1) (-1) (-1) (-1) False + WXC.windowDisable $ formulaInput view + WX.focusOn grid