diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 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 Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are 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. + + 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. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + 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 Affero 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. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + 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 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 work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero 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 Affero 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 Affero 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 Affero 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 Affero 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + 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 AGPL, see +. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/shady-graphics.cabal b/shady-graphics.cabal new file mode 100644 --- /dev/null +++ b/shady-graphics.cabal @@ -0,0 +1,40 @@ +Name: shady-graphics +Version: 0.5.0 +Cabal-Version: >= 1.2 +Synopsis: Functional GPU programming - DSEL & compiler +Category: Graphics +Description: + Compile functional specifications for GPU execution. + See also shady-render, shady-tv, and shady-examples + . + Copyright 2009-2011 by Conal Elliott; GNU AGPLv3 license (see COPYING). + This license is a place-holder. Let me know if you'd like other terms. +Author: Conal Elliott +Maintainer: conal@conal.net +Homepage: http://haskell.org/haskellwiki/shady +Package-Url: http://conal.net/repos/shady-graphics +Copyright: (c) by Conal Elliott 2009-2011 +License: OtherLicense +License-File: COPYING +Stability: experimental +build-type: Simple + +Library + hs-Source-Dirs: src + + Build-Depends: base >=4 && < 5, containers, mtl, wl-pprint + , applicative-numbers>=0.0.4, vector-space>=0.5.6 + , TypeCompose >= 0.7 + , MemoTrie, ty, data-treify, Boolean + , shady-gen + Exposed-Modules: + + Shady.ITransform + Shady.Color + Shady.Image + Shady.ParamSurf + Shady.Lighting + Shady.CompileSurface + Shady.CompileImage + + diff --git a/src/Shady/Color.hs b/src/Shady/Color.hs new file mode 100644 --- /dev/null +++ b/src/Shady/Color.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE TypeSynonymInstances, TypeOperators, FlexibleInstances + , GeneralizedNewtypeDeriving, TypeFamilies + , MultiParamTypeClasses, UndecidableInstances + #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.Color +-- Copyright : (c) Conal Elliott 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Simple colors +---------------------------------------------------------------------- + +module Shady.Color + ( + -- * Basics + Color, colorToR4, r4ToColor, rgba, rgb, colorR, colorG, colorB, colorA + -- * Color operations + , overC, over + -- * Some colors + , black, white, red, green, blue, clear, grey, gray + -- * Conversion to color + , HasColor(..) + ) where + +import Data.Monoid (Monoid(..)) +import Control.Applicative (liftA2) + +import Control.Compose ((~>)) + +import Data.VectorSpace +import Data.NumInstances () + +import Data.Boolean + +import Shady.Misc (Unop, Binop) +import Shady.Language.Exp + + +-- TODO: Vector space instance + + +{-------------------------------------------------------------------- + Basics +--------------------------------------------------------------------} + +type Float4E = (FloatE,FloatE,FloatE,FloatE) + +-- | Color, as RGBA +newtype Color = C { unC :: Float4E } + deriving ( Eq,Ord,Show,Num,Fractional,Floating + , AdditiveGroup, InnerSpace ) + +-- VectorSpace has an associated type, which @deriving@ currently doesn't handle. +instance VectorSpace Color where + type Scalar Color = Scalar (Float4E) + (*^) s = inC ((*^) s) + +-- | Representation conversion +colorToR4 :: Color -> R4E +colorToR4 (C (r,g,b,a)) = vec4 r g b a + +-- | Representation conversion +r4ToColor :: R4E -> Color +r4ToColor = C . un4 + +inC :: Unop (Float4E) -> Unop Color +inC = unC ~> C + +inC2 :: Binop (Float4E) -> Binop Color +inC2 = unC ~> inC + +-- | Color from red, green, blue, alpha components +rgba :: R1 :=> R1 :=> R1 :=> R1 :=> Color +rgba r g b a = C (r,g,b,a) + +-- | Color from red, green, blue components +rgb :: R1 :=> R1 :=> R1 :=> Color +rgb r g b = rgba r g b 1 + + +-- | Extract the red component +colorR :: Color -> FloatE +colorR (C (r,_,_,_)) = r + +-- | Extract the green component +colorG :: Color -> FloatE +colorG (C (_,g,_,_)) = g + +-- | Extract the blue component +colorB :: Color -> FloatE +colorB (C (_,_,b,_)) = b + +-- | Extract the alpha component +colorA :: Color -> FloatE +colorA (C (_,_,_,a)) = a + + +{-------------------------------------------------------------------- + Color operations +--------------------------------------------------------------------} + +-- | Overlay on two colors +overC :: Binop Color +overC top bot = top ^+^ (1 - colorA top) *^ bot + +-- | Pointwise 'overC', e.g., for images. +over :: Binop (p->Color) +over = liftA2 overC + + +{-------------------------------------------------------------------- + Some colors +--------------------------------------------------------------------} + +-- | Some colors +black, white, red, green, blue, clear :: Color +black = grey 0 +white = grey 1 + +red = rgb 1 0 0 +green = rgb 0 1 0 +blue = rgb 0 0 1 + +clear = rgba 0 0 0 0 + +-- | Shade of grey +grey, gray :: R1 :=> Color +grey x = rgb x x x +gray = grey + + +{-------------------------------------------------------------------- + Instances +--------------------------------------------------------------------} + +instance Monoid Color where + mempty = clear + mappend = overC + +instance IfB BoolE Color where + ifB = inC2 . ifB + +{-------------------------------------------------------------------- + Conversion to color +--------------------------------------------------------------------} + +class HasColor a where toColor :: a -> Color + +instance HasColor Color where toColor = id +instance HasColor BoolE where toColor = boolean nonWhite white + +nonWhite :: Color +nonWhite = clear + -- rgb 0 0.2 0 + -- dark green + -- clear -- black diff --git a/src/Shady/CompileImage.hs b/src/Shady/CompileImage.hs new file mode 100644 --- /dev/null +++ b/src/Shady/CompileImage.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE TypeOperators, ScopedTypeVariables + , FlexibleContexts, TypeFamilies + #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.CompileImage +-- Copyright : (c) Conal Elliott 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Compile a parameterized image +---------------------------------------------------------------------- + +module Shady.CompileImage (ImageB, imageBProg,imSurfB, eyePos) where + +import Data.Derivative (powVal) + +import qualified Shady.Vec as V +import Shady.Language.Type (R1,R2) +import Shady.Language.Exp ((:=>),pureE) +import Shady.Color -- (white,HasColor(..)) +import Shady.Image (Image) +import Shady.CompileE (GLSL) +import Shady.ParamSurf (xyPlane) +import Shady.Lighting (intrinsic,view1) +import Shady.CompileSurface (EyePosE,SurfB,surfBProg) +import Shady.Misc (EyePos) + + +-- Built on top of RunSurface + +-- | 2D animation +type ImageB c = R1 :=> Image c + +eyePos :: EyePos +eyePos = (0, 0.75, 2.5) -- tweak + +eyePosE :: EyePosE +eyePosE = pureE (V.vec3 ex ey ez) where (ex,ey,ez) = eyePos + +imSurfB :: HasColor c => ImageB c -> SurfB +imSurfB imb t = (intrinsic, view1, xyPlane , toColor . imb (powVal t)) + +-- | GLSL program for an 'ImageB'. +imageBProg :: HasColor c => ImageB c -> GLSL R1 R2 +imageBProg = surfBProg eyePosE . imSurfB diff --git a/src/Shady/CompileSurface.hs b/src/Shady/CompileSurface.hs new file mode 100644 --- /dev/null +++ b/src/Shady/CompileSurface.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE TypeOperators, ScopedTypeVariables + , FlexibleContexts, TypeFamilies + #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.CompileSurface +-- Copyright : (c) Conal Elliott 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Assemble shaders and display an image +---------------------------------------------------------------------- + +module Shady.CompileSurface + ( EyePosE, FullSurf + , SurfB + , surfBProg + , wrapSurf + -- * unused but exported to suppress "unused" warning + , wrapSurfExact, wrapSurfIN, wrapSurfIC + ) where + +import Control.Applicative (liftA2) +import Control.Arrow ((&&&)) + +import Control.Compose (result) + +import Data.Derivative (pureD) + +import Shady.Language.Exp hiding (indices) +import Shady.Language.GLSL hiding (Shader) +import Shady.Color (colorToR4) +import Shady.Image (Point,Image) +import Shady.Color (Color) +import Shady.CompileEs + ((:->)(ShaderVF),ShaderVF,shaderProgram,GLSL) -- ,compile + +import Shady.ParamSurf (T, SurfD, surfVN) +import Shady.Lighting -- (View,Shader) + +-- Arbitrary for now. Later do progressive (infinite sequence of grids) +-- and adpative. + +-- -- # of samples, vertically and horizontally +-- rows, cols :: GlIndex +-- rows = 100 +-- cols = 100 + +-- | Eye position as a single expression. See also 'EyePos'. +type EyePosE = R3E + +-- | Renderable surface +type FullSurf = (Lighter Color, EyePosE -> View, SurfD, Image Color) + +splitF :: (a -> (b,c)) -> (a -> b, a -> c) +splitF = result fst &&& result snd + +-- | Surface shader. Vertex stage converts uv into (uv,pos) for +-- fragment stage, which computes normals & lighting per pixel. Function +-- of eye position. +type ShSurf = ShaderVF Point + +-- | Surface wrapper, e.g., 'wrapSurfExact', 'wrapSurfIN', 'wrapSurfIC' +type SurfWrapper u' = (u' -> FullSurf) -> (u' -> ShSurf) + +wrapSurf :: forall u'. EyePosE -> SurfWrapper u' +wrapSurf = wrapSurfExact -- exact lighting (beautiful) +-- wrapSurf = wrapSurfIN -- interpolate normals (faster) +-- wrapSurf = wrapSurfIC -- interpolate colors (terrible) + +-- Change wrapSurf to wrapSurfIN or wrapSurfIC to compare. + + +-- | Wrap up a parameterized surface for compiling. Computes normals and +-- lighting per pixel -- sometimes called "exact shading". +wrapSurfExact :: forall u'. EyePosE -> SurfWrapper u' +wrapSurfExact eyePos f = liftA2 ShaderVF vert frag + where + vert :: u' -> Point -> (E R4, (Point, E R3)) + vert u' p' = (vTrans (pos <+> 1), (p',pos)) + where + (_,_,surfd,_) = f u' + (posF,_) = splitF (surfVN surfd) + pos = posF (toE p') + + frag :: u' -> (Point,E R3) -> (E R4,()) + frag u' (p',pos) = (col, ()) + where + (l,view,surfd,img) = f u' + (_,norF) = splitF (surfVN surfd) + col = colorToR4 (l (view eyePos) (SurfInfo pos (nTrans nor) (img p'))) + nor = norF (toE p') + +-- | Wrap up a parameterized surface for compiling. +-- This variant interpolates normals, as in Phong shading. +wrapSurfIN :: forall u'. EyePosE -> SurfWrapper u' +wrapSurfIN eyePos f = liftA2 ShaderVF vert frag + where + vert :: u' -> Point -> (E R4, (Point, (E R3, E R3))) + vert u' p' = (vTrans (pos <+> 1), (p',(pos,nTrans nor))) + where + (_,_,surfd,_) = f u' + (posF,norF) = splitF (surfVN surfd) + pos = posF p + nor = norF p + p = toE p' + + frag :: u' -> (Point,(E R3, E R3)) -> (E R4,()) + frag u' (p',(pos,nor)) = (col, ()) + where + (sh,view,_,img) = f u' + col = colorToR4 (sh (view eyePos) (SurfInfo pos nor (img p'))) + +-- TODO: wrapSurfIC, interpolating colors, as in Gouraud shading. + +-- | Wrap up a parameterized surface for compiling. +-- This variant interpolates normals, as in Phong shading. +wrapSurfIC :: forall u'. EyePosE -> SurfWrapper u' +wrapSurfIC eyePos f = liftA2 ShaderVF vert frag + where + vert :: u' -> Point -> (E R4, E R4) + vert u' p' = (vTrans (pos <+> 1), col) + where + (sh,view,surfd,img) = f u' + (posF,norF) = splitF (surfVN surfd) + pos = posF p + nor = norF p + p = toE p' + col = colorToR4 (sh (view eyePos) (SurfInfo pos (nTrans nor) (img p'))) + + frag :: u' -> E R4 -> (E R4,()) + frag _ col = (col, ()) + + +-- | 3D animation +type SurfB = T -> FullSurf + +-- | Surface shader program +surfBProg :: EyePosE -> SurfB -> GLSL R1 R2 +surfBProg eyePos s = shaderProgram (wrapSurf eyePos (s . pureD)) diff --git a/src/Shady/ITransform.hs b/src/Shady/ITransform.hs new file mode 100644 --- /dev/null +++ b/src/Shady/ITransform.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies + , UndecidableInstances + #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.ITransform +-- Copyright : (c) Conal Elliott 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Invertible transformations +---------------------------------------------------------------------- + +module Shady.ITransform + ( + ITransform(..), inverse, andInverse + , ITrans(..) + ) where + +import Data.Monoid (Monoid(..)) +import Control.Applicative (liftA2) + +import Shady.Misc +import Shady.Complex (Complex) +import Shady.Language.Exp + +-- | Transform with inverse. The 'Monoid' instances is identity and +-- composition (in the usual order for composition of the forward +-- transformations). +data ITransform a = ITransform { itForward :: Unop a + , itBackward :: Unop a } + +instance Monoid (ITransform a) where + mempty = ITransform id id + ITransform oF oB `mappend` ITransform iF iB = + ITransform (oF.iF) (iB.oB) + +-- | Inverse an 'ITransform' +inverse :: Unop (ITransform a) +inverse (ITransform forw back) = ITransform back forw + +-- | Handy when we invert a transform by modifying the argument to the +-- transform's maker. +andInverse :: (c -> Unop a) -> (c -> c) -> c -> ITransform a +andInverse f inva = liftA2 ITransform f (f.inva) + +infixr 1 *: + +-- | Transformable values +class ITrans w a | a -> w where + (*:) :: ITransform w -> Unop a + +-- Inert on our basic types +instance ITrans w (E a) where + (*:) = const id + + +-- Typical identity instance: + +instance ITrans (Complex s) (Complex s) where (*:) = itForward + +-- Distribute over tuple types. + + + + +instance (ITrans w a, ITrans w b) => ITrans w (a,b) where + ix *: (a,b) = (ix *: a, ix *: b) + +instance (ITrans w a, ITrans w b, ITrans w c) => ITrans w (a,b,c) where + ix *: (a,b,c) = (ix *: a, ix *: b, ix *: c) + +instance (ITrans w a, ITrans w b, ITrans w c, ITrans w d ) => ITrans w (a,b,c,d) where + ix *: (a,b,c,d) = + (ix *: a, ix *: b, ix *: c, ix *: d) + + +-- Function is an interesting case. Inversely transform input. + +instance (ITrans w a, ITrans w b) => ITrans w (a -> b) where + ix *: f = (*:) ix . f . (*:) (inverse ix) + + +-- type Trans = forall a. ITrans w a => a -> a diff --git a/src/Shady/Image.hs b/src/Shady/Image.hs new file mode 100644 --- /dev/null +++ b/src/Shady/Image.hs @@ -0,0 +1,271 @@ +{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts + , TypeSynonymInstances, MultiParamTypeClasses, Rank2Types + #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.Image +-- Copyright : (c) Conal Elliott 2009 +-- License : GPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Images (infinite & continuous) +---------------------------------------------------------------------- + +-- This variation uses Complex + +module Shady.Image + ( + Point, pointToR2, r2ToPoint + , FilterG, Filter, samplerIm, scale2, uscale2, translate2, rotate2 + , bilerp, bilerpC + , ImageG, Image + -- * General regions + , PRegion, Region + , universeR, emptyR, eqF, neqF, intersectR, unionR, xorR, diffR, complementR + , udisk, disk, annulus, checker + , crop + -- * Space-varying transformations + , transformG, translate2Im, scale2Im, uscale2Im, rotate2Im + , swirl -- , uswirl + , utile, tile + ) where + +import Control.Applicative (Applicative(..),liftA2) +import Shady.Complex + +import Data.VectorSpace + +import Data.Boolean + +import Shady.Misc +import Shady.Language.Exp +import Shady.Color +import Shady.ITransform + +type Point = ComplexE R + +pointToR2 :: Point -> R2E +pointToR2 (x :+ y) = vec2 x y + +r2ToPoint :: R2E -> Point +r2ToPoint xy = getX xy :+ getY xy + +-- | Generalized image -- continuous & infinite +type ImageG s a = Complex s -> a + +-- | Continuous, infinite image +type Image a = ImageG FloatE a + + +-- == Point -> a + +-- | Generalized filter, polymorphic over domain +type FilterG p a = Unop (p -> a) + +-- | Image filter +type Filter a = FilterG Point a + -- Unop (Image a) + + +-- | Wrap up a sampler as an image +samplerIm :: Sampler2 :=> Image Color +samplerIm s = r4ToColor . texture s . pointToR2 + + +-- -- | 2D invertible transform +-- type ITransform2 = ITransform Point + +translate2X :: AdditiveGroup a => a -> ITransform a +scale2X :: Fractional s => Complex s -> ITransform (Complex s) +uscale2X :: Fractional s => s -> ITransform (Complex s) +rotate2X :: Floating s => s -> ITransform (Complex s) + +translate2X = andInverse (^+^) negateV +scale2X = andInverse (onRI2 (*)) (onRI recip) +rotate2X = andInverse rotate2C negate +uscale2X = scale2X . \ a -> a :+ a + +rotate2C :: Floating s => s -> Unop (Complex s) +rotate2C theta = (cis theta *) + +-- experiment + +translate2, scale2 :: (Floating s, ITrans (Complex s) a) => Complex s -> Unop a +uscale2,rotate2 :: (Floating s, ITrans (Complex s) a) => s -> Unop a + +translate2 = (*:) . translate2X +scale2 = (*:) . scale2X +rotate2 = (*:) . rotate2X +uscale2 = (*:) . uscale2X + +-- translate2 :: ITransform Point +-- (*:) :: ITransform w -> Unop a + +-- (*:) . translate2 :: ITransform Point +-- :: ITransform w -> Unop a + + +-- | Bilinear interpolation +bilerp :: VectorSpace w => + w -> w -> w -> w -> (Scalar w, Scalar w) -> w +bilerp ll lr ul ur (dx,dy) = + lerp (lerp ll lr dx) (lerp ul ur dx) dy + +-- | Bilinear interpolation image +bilerpC :: (VectorSpace w, Scalar w ~ s) => + w -> w -> w -> w -> ImageG s w +bilerpC ll lr ul ur (dx :+ dy) = bilerp ll lr ul ur (dx,dy) + + +{-------------------------------------------------------------------- + Generalized regions +--------------------------------------------------------------------} + +-- TODO: Move most of these definitions elsewhere, since they're not +-- specific to 2D. + +-- | Region over general space +type PRegion p = p -> BoolE + +-- | 2D spatial region +type Region = Image BoolE + +universeR, emptyR :: Applicative f => f BoolE +universeR = pure true +emptyR = pure false + +eqF, neqF :: (IsNat n, IsScalar a, Eq a, Applicative f) => + f (VecE n a) -> f (VecE n a) -> f BoolE + +eqF = liftA2 (==^) +neqF = liftA2 (/=^) + +-- intersectR, unionR, xorR, diffR +-- :: LiftA2 BoolE BoolE BoolE b b b => b -> b -> b +-- complementR :: LiftA1 BoolE BoolE b b => b -> b + +intersectR, unionR, xorR, diffR :: Applicative f => Binop (f BoolE) +complementR :: Applicative f => Unop (f BoolE) + +intersectR = liftA2 (&&*) +unionR = liftA2 (||*) +complementR = fmap notE +xorR = neqF + +diffR r r' = r `intersectR` complementR r' + + +-- | Generalized unit disk/ball +udisk :: (InnerSpace p, Scalar p ~ FloatE) => PRegion p +udisk p = magnitudeSq p <=* 1 + +-- | Generalized disk/ball, given radius +disk :: (InnerSpace p, Scalar p ~ FloatE) => FloatE -> PRegion p +disk s = udisk . (^/ s) + +-- | Generalized annulus, given outer & inner radii +annulus :: (InnerSpace p, Scalar p ~ FloatE) => FloatE -> FloatE -> PRegion p +annulus o i = disk o `diffR` disk i + + +-- | Checker-board +checker :: Region +checker (x :+ y) = getX c ==* getY c + where c = frac (x <+> y) >* 0.5 + +-- checker (x :+ y) = big x ==* big y +-- where +-- big = (>* 0.5) . frac + + +{-------------------------------------------------------------------- + Some generalized transforms +--------------------------------------------------------------------} + +-- | General domain-varying transformation. +transformG' :: (c -> Unop p) -> (p -> c) -> Unop (p -> a) +transformG' f imc ima p = ima (f (imc p) p) + +-- transformG' :: (c -> Unop Point) -> Image c -> Filter a + +-- | General domain-varying transformation. +transformG :: (c -> ITransform p) -> (p -> c) -> Unop (p -> a) +transformG f = transformG' (itBackward . f) + +-- transformG :: (c -> ITransform2) -> Image c -> Filter a + +-- translate2Im :: Image Point -> Filter a +-- scale2Im :: Image Point -> Filter a +-- uscale2Im :: Image FloatE -> Filter a +-- rotate2Im :: Image FloatE -> Filter a + + +-- | Space-varying 'translate2' +translate2Im :: AdditiveGroup p => Unop p -> Unop (p -> a) +translate2Im = transformG translate2X + +-- | Space-varying 'scale2' +scale2Im :: Fractional s => Unop (Complex s) -> Unop (ImageG s a) +scale2Im = transformG scale2X + +-- | Space-varying 'uscale2' +uscale2Im :: Fractional s => ImageG s s -> Unop (ImageG s a) +uscale2Im = transformG uscale2X + +-- | Space-varying 'rotate2' +rotate2Im :: Floating s => ImageG s s -> Unop (ImageG s a) +rotate2Im = transformG rotate2X + + +{-------------------------------------------------------------------- + Other transformations +--------------------------------------------------------------------} + +-- -- | Unit swirl +-- uswirl :: Filter a +-- uswirl = rotate2Im magnitude + +-- -- | Swirl transformation +-- swirl :: FloatE -> Filter a +-- swirl s = hyperUscale2 s uswirl + +-- *Almost* equivalent, but differs for negative s. + +-- | Swirl transformation +swirl :: Floating s => s -> Unop (ImageG s a) +swirl s = rotate2Im ((2*pi*s*) . magnitude) + +utile' :: Frac p => Unop (p -> a) +utile' = (. frac) + +-- Hm! This utile' definition repeats [0,1), not [-.5,.5). Eep. How can +-- I shift without loss of generality? For instance, the current +-- definition can handle nD. + +-- | Unit, rectangular tiling. +utile :: (Frac p, ITrans (Complex s) p, ITrans (Complex s) a, Floating s) => + Unop (p -> a) +utile = translate2 (negate (0.5 :+ 0.5)) utile' + +-- TODO: Generalize uniform scaling to arbitrary vector spaces, scaling +-- via scalar field. + +-- Rectangle tiling with given size. +-- tile :: ITrans Point a => Point -> Filter a + +tile :: (Floating s, Frac s, ITrans (Complex s) a) => + Complex s -> Unop (ImageG s a) +tile s = scale2 s utile + +-- tile = flip scale2 utile + + +{-------------------------------------------------------------------- + Orphans +--------------------------------------------------------------------} + +-- Standard do-nothing transformation +instance ITrans Point Color where (*:) = const id diff --git a/src/Shady/Lighting.hs b/src/Shady/Lighting.hs new file mode 100644 --- /dev/null +++ b/src/Shady/Lighting.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-} +{-# OPTIONS_GHC -Wall #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.Lighting +-- Copyright : (c) Conal Elliott 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Lighting/shading. Adapted from Vertigo. +---------------------------------------------------------------------- + +module Shady.Lighting + ( LightInfo(..), Light, View(..), SurfInfo(..) + , Lighter, LLighter + , ambient, eye, lights + , surfP, surfN, intrinsic + , colorL, dirL, illuminance + , diffuse, ambDiff, eyeDir, eyeLight, reflection + , specularG, specularRV, specularNH + , BasicSh, basic, basicRV, basicNH + , Liftable(..) + , Dir3E, dirLight, pointLight + , stdViewPos, stdView, view1 + , ma,md,ms,msh + , basicStd + ) where + +import Data.VectorSpace (AdditiveGroup(..),(*^), sumV,(<.>),normalized) +import Data.Boolean + +import Shady.Language.Exp +import Shady.Color + + +{-------------------------------------------------------------------- + Basic types +--------------------------------------------------------------------} + +-- | Info about how one light affects a given point. The surface lighter +-- decides what to do with the light info. Attenuation and relation of +-- light position (if finitely distant) to surface position are already +-- accounted for. 'liDir' is the direction /to/ the light (normalized). +data LightInfo = LI { liColor :: Color, liDir :: Dir3E } + +-- | A light is something that provides light info to every point in space +-- (though to some points it provides blackness), independent of +-- obstructions. Should probably also take an atmosphere argument. +type Light = R3E -> LightInfo + +-- | Viewing environment: ambient, eye, lights +data View = + View { viewAmbient :: Color + , viewEye :: R3E + , viewLights :: [Light] + } + +-- | Info about a surface at a point: position, normal, color +data SurfInfo = SurfInfo { surfPos :: R3E, surfNormal :: Dir3E, surfColor :: Color } + +-- Lighters are functions from contextual info to values. + +-- | View-dependent lighter +type Lighter a = View -> SurfInfo -> a + +-- | Light- and view-dependent lighter +type LLighter a = LightInfo -> Lighter a + + +{-------------------------------------------------------------------- + Extractors +--------------------------------------------------------------------} + + +-- | Ambient color +ambient :: Lighter Color +ambient = lift . viewAmbient + +-- ambient v _ = viewAmbient v +-- ambient v = const (viewAmbient v) + +-- | Eye point +eye :: Lighter R3E +eye = lift . viewEye + +-- | Lights +lights :: Lighter [Light] +lights = lift . viewLights + +-- | Surface point +surfP :: Lighter R3E +surfP = lift surfPos + +-- | Surface normal +surfN :: Lighter Dir3E +surfN = lift surfNormal + +-- | Surface Color +intrinsic :: Lighter Color +intrinsic = lift surfColor + +-- | Light color +colorL :: LLighter Color +colorL = lift . liColor + +-- | Direction /to/ light +dirL :: LLighter R3E +dirL = lift . liDir + +-- | Combine contributions from multiple lights. Patterned after +-- Renderman's @illuminance@ construct. +illuminance :: -- (Num a, VectorSpace IfB (VecE OneT Bool) (Scalar a), Num (Scalar a)) => + (AdditiveGroup a, IfB BoolE a) => + LLighter a -> Lighter a +illuminance llighter v@(View _ _ ls) s@(SurfInfo p _ _) = + -- sumV [ (ifB (lift surfN <.> dirL >* 0) llighter zeroV) (light p) v s | light <- ls ] + sumV [ llighter (light p) v s | light <- ls ] + +-- bsign b = boolean 1 0 b + +-- | Does this bsign multiplier really help? The vertex engine clamps to +-- [0,1] anyway. Oh, with multiple light sources, negative contributions +-- would subtract from positive ones. + + +{-------------------------------------------------------------------- + Composite lighters +--------------------------------------------------------------------} + +-- Two-sided lighting? +twoSided :: Bool +twoSided = True + +-- One-sided or two-sided lighting +sided :: (Ord a, Num a) => a -> a +sided | twoSided = abs + | otherwise = max 0 + +-- | Pure diffuse +diffuse :: Lighter Color +diffuse = illuminance (sided (lift surfN <.> dirL) *^ colorL) + + +-- | Weighted combination of ambient and diffuse +ambDiff :: (Color, Color) -> Lighter Color +ambDiff (ka,kd) = intrinsic * (lift ka * ambient + lift kd * diffuse) + +-- | The Stanford rtsl version, with ambient and weights: +-- +-- surface float4 +-- lightmodel_diffuse (float4 ka, float4 kd) +-- { +-- perlight float diffuse = dot(N,L); +-- perlight float4 fr = kd * select(diffuse > 0, diffuse, 0); +-- return ka * Ca + integrate(fr * Cl); +-- } + +-- | Direction from surface point to eye +eyeDir :: Lighter Dir3E +eyeDir = normalized (eye - surfP) + +-- | Eye/light vector average (CGPP p 731) +eyeLight :: LLighter Dir3E +eyeLight = normalized (dirL + lift eyeDir) + +-- | Reflection vector (CGPP p 730) +reflection :: LLighter Dir3E +reflection = (2 * (n' <.> dirL)) *^ n' - dirL where n' = lift surfN + +-- | Pure specular. Ignores intrinsic surface color. There are different +-- ways to compute the power base. +specularG :: LLighter FloatE -> FloatE -> Lighter Color +specularG base sh = illuminance ((max 0 base ** lift sh) *^ colorL) + + +-- Phong's specular (R.V) model +specularRV :: FloatE -> Lighter Color +specularRV = specularG (reflection <.> lift eyeDir) + +-- | Or the N.H model: +specularNH :: FloatE -> Lighter Color +specularNH = specularG (lift surfN <.> eyeLight) + + +-- | surface floatv +-- lightmodel_specular (floatv s, floatv e, float sh) +-- { +-- perlight float diffuse = dot(N,DIRL); +-- perlight float specular = pow(max(dot(N,H),0),sh); +-- perlight floatv fr = select(diffuse > 0, s * specular, Zero); +-- return integrate(fr * Cl) + e; +-- } + +type BasicSh = (Color,Color,Color,FloatE) -> Lighter Color + +-- | Combine intrinsic, ambient, diffuse and specular, with weightings +basic :: LLighter FloatE -> BasicSh +basic base (ka,kd,ks,sh) = ambDiff (ka,kd) + lift ks * specularG base sh + +basicRV, basicNH :: BasicSh +basicRV = basic (reflection <.> lift eyeDir) -- The R.V model +basicNH = basic (lift surfN <.> eyeLight) -- The N.H model + +-- | surface float4 +-- lightmodel (float4 a, float4 d, float4 s, float4 e, float sh) +-- { +-- perlight float diffuse = dot(N,DIRL); +-- perlight float specular = pow(max(dot(N,H),0),sh); +-- perlight float4 fr = d * max(diffuse, 0) + +-- s * select(diffuse > 0, specular, 0); +-- return a * Ca + integrate(fr * Cl) + e; +-- } + + +{- +-- Phong model, taking normal as parameter +-- WORKING HERE. Coefficients not yet right. + +phongN :: LLighter DirE -> Lighter Color +phongN n = + cs * lift ka * ambient + cs * lift kd ^* illuminance ldotN + + lift ks ^* illuminance (vdotR ** lift sh) +-} + +{-------------------------------------------------------------------- + Lifting. Revisit +--------------------------------------------------------------------} + + +class Liftable k f where lift :: k -> f + +instance Liftable a a where lift = id +instance Liftable b (a->b) where lift = const +instance Liftable c (a->b->c) where lift = const . const +instance Liftable d (a->b->c->d) where lift = const . const . const + + +{-------------------------------------------------------------------- + Some lights +--------------------------------------------------------------------} + +-- | Direction. Assumed normalized. +type Dir3E = R3E + +-- | Directional light, given the direction /from/ the light (opposite 'dirL') +dirLight :: Color -> Dir3E -> Light +dirLight col dir = const (LI col (- dir)) + +-- | Point light +pointLight :: Color -> R3E -> Light +pointLight col lpos p = LI col (normalized (lpos - p)) + + +-- To do: add distance-based fall-off and spot lights + +stdViewPos :: R3E +stdViewPos = vec3 0.5 1 (-2) :: R3E + +-- | View with white ambient light and given eye position and lights +stdView :: R3E -> [Light] -> View +stdView = View white + +-- | View with white ambient light, one directional light, and given eye position. +-- For now, light position is like eye position but more so. +view1 :: R3E -> View +view1 eyePos = stdView eyePos [dirLight lightColor lightDir] + where + lightColor = white + -- lightColor = rgb 1 0.9 0.5 -- light gold + lightDir = normalized (-eyePos + vec3 2 1 0) + +-- view2 :: Anim R3E -> Anim View +-- view2 pos t = stdView [pointLight red (pos t)] + + +-- Standard material properties (from rtsl-shaders.in) + +ma,md,ms :: Color +msh :: FloatE + +ma = gray 0.2 -- ambient +md = gray 0.4 -- diffuse +ms = gray 0.5 -- specular +msh = 15 -- specular exponent + +{- +-- Simple shaders with standard material properties +ambDiffStd = ambDiff ma md +specularStd = specularNH msh +-} + +basicStd :: Lighter Color +basicStd = basicRV (ma,md,ms,msh) diff --git a/src/Shady/ParamSurf.hs b/src/Shady/ParamSurf.hs new file mode 100644 --- /dev/null +++ b/src/Shady/ParamSurf.hs @@ -0,0 +1,307 @@ +{-# LANGUAGE Rank2Types, TypeOperators, FlexibleContexts, TypeFamilies + , TypeSynonymInstances, FlexibleInstances, UndecidableInstances + , MultiParamTypeClasses + #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +---------------------------------------------------------------------- +-- | +-- Module : Shady.ParamSurf +-- Copyright : (c) Conal Elliott 2008, 2009 +-- License : AGPLv3 +-- +-- Maintainer : conal@conal.net +-- Stability : experimental +-- +-- Parametric surfaces with automatic normals +---------------------------------------------------------------------- + +-- This version uses Complex s instead of (s,s). Complex is consistent +-- with Image but inconsistent with 1D and 3D. + +module Shady.ParamSurf where + +import Control.Applicative +import Control.Arrow ((&&&)) + +import Data.NumInstances () +import Data.VectorSpace +import Data.Cross hiding (One,Two,Three) +import Data.Derivative + +-- import Data.MemoTrie +import Data.Basis + +import Shady.Language.Exp +import Shady.Complex +import Shady.ITransform (ITrans(..)) + + +type HeightField s = Complex s -> s +type Surf s = Complex s -> (s,s,s) + +type USurf = forall s. Floating s => Surf s + + +type Curve2 s = s -> Complex s +type Curve3 s = s -> (s,s,s) + +type Warp1 s = s -> s +type Warp2 s = Complex s -> Complex s +type Warp3 s = (s,s,s) -> (s,s,s) + +-- | Trig functions with unit period ([-1,1]) +cosU, sinU :: Floating s => s -> s +cosU = cos . (* pi) +sinU = sin . (* pi) + + +-- | Turn a height field into a surface +hfSurf :: HeightField s -> Surf s +hfSurf field = \ (u :+ v) -> (u, v, field (u :+ v)) + +-- | Like 'hfSurf' but for curve construction +fcurve :: Warp1 s -> Curve2 s +fcurve f = \ u -> u :+ f u + +-- | Unit circle. +circle :: Floating s => Curve2 s +circle = liftA2 (:+) cosU sinU + +-- | Half semi circle, with theta in [-pi/2,pi/2] +semiCircle :: Floating s => Curve2 s +semiCircle = circle . (/ 2) + +-- | Torus, given radius of sweep circle and cross section +torus :: (Floating s, VectorSpace s, Scalar s ~ s) => s -> s -> Surf s +-- torus sr cr = revolve (\ s -> (sr,0) ^+^ cr *^ circle s) +torus sr cr = revolve (const (sr :+ 0) ^+^ const cr *^ circle) + +-- Surface of revolution, formed by rotation around Z axis. The curve is +-- parameterized by u, and the rotation by v. In this generalized +-- version, we have not a single curve, but a function from v to curves. +revolveG :: Floating s => (s -> Curve2 s) -> Surf s +revolveG curveF = \ (u :+ v) -> onXY (rotate (-pi*v)) (addY (curveF v) u) + +revolve :: Floating s => Curve2 s -> Surf s +revolve curve = revolveG (const curve) + +-- A sphere is a revolved semi-circle +sphere1 :: Floating s => Surf s +sphere1 = revolve semiCircle + + +-- | Profile product. +profile :: Num s => Curve2 s -> Curve2 s -> Surf s +profile curve prof (u :+ v) = (cx*px,cy*px,py) + where + cx :+ cy = curve u + px :+ py = prof v + +-- More spheres +sphere2,sphere3 :: Floating s => Surf s +sphere2 = profile circle semiCircle +sphere3 = profile semiCircle circle + +-- | Frustum, given base & cap radii and height. +frustum :: (Floating s, VectorSpace s, Scalar s ~ s) => s -> s -> s -> Surf s +frustum baseR topR h = profile circle rad + where + rad t = lerp baseR topR (t + 1/2) :+ h*t + +-- | Unit cylinder. Unit height and radii +ucylinder :: (Floating s, VectorSpace s) => Surf s +ucylinder = profile circle (const 1) + +-- | XY plane as a surface +xyPlane :: Num s => Surf s +xyPlane = hfSurf (const 0) + +-- | Given a combining op and two curves, make a surface. A sort of +-- Cartesian product with combination. +cartF :: (a -> b -> c) -> (s -> a) -> (s -> b) -> (Complex s -> c) +cartF op f g = \ (u :+ v) -> f u `op` g v + +-- Sweep a basis curve by a sweep curve. Warning: does not reorient the +-- basis curve as cross-section. TODO: Frenet frame. +sweep :: VectorSpace s => Curve3 s -> Curve3 s -> Surf s +sweep = cartF (^+^) + + +-- | One period, unit height eggcrate +eggcrateH :: Floating s => HeightField s +eggcrateH = cartF (*) cosU sinU + +revolveH :: (Floating s, InnerSpace s, Scalar s ~ s) => Warp1 s -> HeightField s +revolveH = (. magnitude) + +rippleH :: (Floating s, InnerSpace s, Scalar s ~ s) => HeightField s +rippleH = revolveH sinU + +-- | Simple ripply pond shape +ripple :: Floating s => Surf s +ripple = -- onXY' (2 *^) $ + revolve (const (0.5 :+ 0) - fcurve sinU) + +-- | Apply a displacement map at a value + +displaceV :: (InnerSpace v, s ~ Scalar v, Floating s, HasNormal v) => + v -> Scalar v -> v +displaceV v s = v ^+^ s *^ normal v + +-- | Apply a displacement map to a function (e.g., 'Curve2' or 'Surf') or +-- other container. +displace :: (InnerSpace v, Scalar v ~ s, Floating s, HasNormal v, Applicative f) => + f v -> f (Scalar v) -> f v +displace = liftA2 displaceV + + + +---- Misc + +-- TODO: Reconcile this version with the one in Image + +rotate :: Floating s => s -> Warp2 s +rotate theta = \ (x :+ y) -> (x * c - y * s) :+ (y * c + x * s) + where c = cos theta + s = sin theta + +addX, addY, addZ :: Num s => (a -> Complex s) -> (a -> (s,s,s)) +addX = fmap (\ (y :+ z) -> (0,y,z)) +addY = fmap (\ (x :+ z) -> (x,0,z)) +addZ = fmap (\ (x :+ y) -> (x,y,0)) + +addYZ,addXZ,addXY :: Num s => (a -> s) -> (a -> (s,s,s)) +addYZ = fmap (\ x -> (x,0,0)) +addXZ = fmap (\ y -> (0,y,0)) +addXY = fmap (\ z -> (0,0,z)) + +onX,onY,onZ :: Warp1 s -> Warp3 s +onX f (x,y,z) = (f x, y, z) +onY f (x,y,z) = (x, f y, z) +onZ f (x,y,z) = (x, y, f z) + +onXY,onYZ,onXZ :: Warp2 s -> Warp3 s +onXY f (x,y,z) = (x',y',z ) where x' :+ y' = f (x :+ y) +onXZ f (x,y,z) = (x',y ,z') where x' :+ z' = f (x :+ z) +onYZ f (x,y,z) = (x ,y',z') where y' :+ z' = f (y :+ z) + + +onX',onY',onZ' :: Warp1 s -> (a -> (s,s,s)) -> (a -> (s,s,s)) +onX' = fmap . onX +onY' = fmap . onY +onZ' = fmap . onZ + +onXY',onXZ',onYZ' :: Warp2 s -> (a -> (s,s,s)) -> (a -> (s,s,s)) +onXY' = fmap . onXY +onXZ' = fmap . onXZ +onYZ' = fmap . onYZ + + +{-------------------------------------------------------------------- + Normals and tessellation +--------------------------------------------------------------------} + +-- -- | Derivative tower of point on a surface +-- type SurfPt = Exp R2 :> Exp R3 + +-- -- | Differentiable surface +-- type SurfD = Surf (Exp R2 :> Exp R) + +-- -- | Vertex and normal +-- data VN = VN (Exp R3) (Exp R3) + +-- -- No instances for (HasBasis (E V R2), +-- -- HasTrie (Basis (E V R2)), +-- -- HasNormal SurfPt) + +-- toVN :: SurfPt -> VN +-- toVN v = VN (powVal v) (powVal (normal v)) + + +-- TODO: move to Exp and remove -fno-warn-orphans + + +type V2 a = (a,a) +type V3 a = (a,a,a) + +type ER = FloatE +type ER2 = V2 ER +type ER3 = V3 ER + +instance HasBasis FloatE where + type Basis FloatE = () + basisValue () = 1 + decompose s = [((),s)] + decompose' s = const s + +instance HasBasis R2E where + type Basis R2E = Basis ER2 + basisValue b = vec2 x y where (x,y) = basisValue b + decompose w = decompose (getX w, getX w) + decompose' w = (w <.>) . basisValue + +-- TODO: are these instances used? + +-- TODO: move these two HasBasis orphans elsewhere. + +-- instance IsNat n => HasBasis (VecE n R) where +-- type Basis (VecE n R) = n +-- basisValue = ??? + +-- TODO: fill out this definition. How to enumerate a basis for Vec n R, +-- for arbitrary IsNat n? + +type TR = ER :> ER -- tower + +type T = ER2 :> ER + +-- Standard do-nothing transformation +instance ITrans (Complex T) T where (*:) = const id + + +-- | Derivative towers of point on a surface +type SurfPt = V3 T + +-- type SurfPt = ER2 :> ER3 + + +-- | Differentiable surface +type SurfD = Surf T + + +-- -- | Vertex and normal +-- data VN = VN ER3 ER3 + +-- powVal3 :: V3 (a :> b) -> V3 b +-- powVal3 (q,r,s) = (powVal q, powVal r, powVal s) + +-- toVN :: SurfPt -> VN +-- toVN v = VN (powVal3 v) (powVal3 (normal v)) + +-- -- type SurfV = ER2 :~> ER3 + +-- type SurfVN = ER2 -> VN + +-- -- or +-- -- type SurfVN = Exp R2 -> (Exp R3, Exp R3) + +-- surfVN :: SurfD -> SurfVN +-- surfVN f p = toVN (f (fstD p, sndD p)) + + +-- | Vertex and normal +type VN = (R3E, R3E) + +toVN :: SurfPt -> VN +toVN = p3 &&& (p3 . normal) + where + p3 (q,r,s) = vec3 (powVal q) (powVal r) (powVal s) + +-- type SurfV = ER2 :~> ER3 + +type SurfVN = R2E -> VN + +surfVN :: SurfD -> SurfVN +surfVN f p = toVN (f (fstD p' :+ sndD p')) + where + p' = (getX p, getY p)