From: Ahmet Artu Yildirim Date: Fri, 8 Oct 2021 05:02:10 +0000 (-0700) Subject: Initialize project X-Git-Url: http://artulab.com/gitweb/?p=guile-gdal;a=commitdiff_plain;h=4bd1e92bf085cc8957043dd40a25d27f207397a0 Initialize project --- 4bd1e92bf085cc8957043dd40a25d27f207397a0 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..52a0c69 --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +Makefile +Makefile.in +aclocal.m4 +autom4te.cache/ +build-aux/ +config.log +config.status +configure +gdal/config.scm +gdal.go +gdal/*.go +pre-inst-env +.vscode/ +examples/raster/new-raster-small.tif diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..e69de29 diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..f288702 --- /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/Makefile.am b/Makefile.am new file mode 100644 index 0000000..9d4aafe --- /dev/null +++ b/Makefile.am @@ -0,0 +1,24 @@ +moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) +godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache + +GOBJECTS = $(SOURCES:%.scm=%.go) + +nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) +nobase_go_DATA = $(GOBJECTS) + +guile_install_go_files = install-nobase_goDATA +$(guile_install_go_files): install-nobase_modDATA + +CLEANFILES = $(GOBJECTS) +EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) +GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat +SUFFIXES = .scm .go +.scm.go: + $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILD) compile $(GUILE_WARNINGS) -o "$@" "$<" + +SOURCES = \ + gdal/config.scm \ + gdal/internal.scm \ + gdal.scm \ + gdal/ogr.scm \ + gdal/extension.scm diff --git a/README.md b/README.md new file mode 100644 index 0000000..bad0e09 --- /dev/null +++ b/README.md @@ -0,0 +1,65 @@ +# Guile GDAL Bindings + +[GDAL](https://gdal.org/) Scheme bindings for [Guile](https://www.gnu.org/software/guile/) programming language. + +This library allows you to perform the following tasks: + +* Open a raster file for reading and writing +* Access metadata of raster files +* Compute statistics of raster files +* Access layers of raster dataset +* Helper functions, providing idiomatic Scheme interface to the GDAL APIs +* TODO: OGR support + +## Example + +Read/write raster files using GDAL binding functions or helper functions + +``` +(use-modules (gdal)) +(use-modules (gdal extension)) + +(use-modules (rnrs bytevectors)) + +;; initialize GDAL by registering GDAL drivers + +(all-register) + +;; read raster dataset using binding functions + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (x-size (get-raster-band-x-size h-band)) + (y-size (get-raster-band-y-size h-band)) + (size (* x-size y-size)) + (bv (make-s32vector size))) + (begin + (raster-io h-band GF_READ 0 0 x-size y-size bv x-size y-size GDT_INT32 0 0) + (for-each (lambda (i) (format #t "~a " (s32vector-ref bv i))) + (iota size)))) + +(newline) + +;; or read raster dataset using helper functions in the extension module +;; providing more convenient way + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (buf (make-buffer-all-from-band h-band GDT_INT32))) + (for-each-pixel (lambda (p) (format #t "~a " p)) buf)) + +;; transform pixels using map-pixel function, returning a new binary buffer +;; of type INT16 with 1 for pixels greater than 0, and 0 otherwise. +;; use write-buffer-to-file to save the buffer into the disk in GeoTIFF format. + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (buf (make-buffer-all-from-band h-band GDT_INT32))) + (begin + (define new-buf (map-pixel (lambda (p) (if (> p 0) 1 0)) + buf #:buf-type GDT_INT16)) + (write-buffer-to-file new-buf GDN_GTIFF + "new-raster-small.tif" #:no-data -1))) +``` + +See examples folder for more code samples. diff --git a/TODO b/TODO new file mode 100644 index 0000000..e69de29 diff --git a/bootstrap b/bootstrap new file mode 100755 index 0000000..872167c --- /dev/null +++ b/bootstrap @@ -0,0 +1,3 @@ +#!/bin/sh + +autoreconf -vif diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..986db45 --- /dev/null +++ b/configure.ac @@ -0,0 +1,55 @@ +# -*- Autoconf -*- +# +# guile-gdal --- FFI bindings for GDAL with extensions +# Copyright (c) 2021 Ahmet Artu Yildirim +# +# This file is part of guile-gdal. +# +# Guile-gdal is free software; you can redistribute it and/or modify +# it under the terms of the GNU Lesser General Public License as +# published by the Free Software Foundation; either version 3 of the +# License, or (at your option) any later version. +# +# Guile-gdal 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 Lesser General Public +# License along with guile-gdal. If not, see +# . + +AC_INIT(guile-gdal, 0.0.1) +AC_CONFIG_SRCDIR(gdal) +AC_CONFIG_AUX_DIR([build-aux]) +AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign]) +AC_CONFIG_MACRO_DIRS([m4]) + +GUILE_PKG([3.0 2.2 2.0]) +GUILE_PROGS +GUILE_SITE_DIR + +if test "x$GUILD" = "x"; then + AC_MSG_ERROR(['guile' binary not found; please check your guile-2.x installation.]) +fi + +AX_LIB_GDAL + +if test "x$GDAL_VERSION" = "x"; then + AC_MSG_ERROR(['gdal' library not found; please check your gdal installation.]) +fi + + +AC_ARG_WITH([libgdal-path], + [AS_HELP_STRING([--with-libgdal-path=PATH], [PATH of gdal dynamic library])], + [LIBGDAL_PATH="$withval"], + [LIBGDAL_PATH="/usr/lib/libgdal.so"]) + +AC_MSG_CHECKING([for libgdal shared library path]) +AC_MSG_RESULT([$LIBGDAL_PATH]) +AC_SUBST([LIBGDAL_PATH]) + +AC_CONFIG_FILES([Makefile gdal/config.scm]) +AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) + +AC_OUTPUT diff --git a/examples/raster/raster-small.txt b/examples/raster/raster-small.txt new file mode 100644 index 0000000..c57a929 --- /dev/null +++ b/examples/raster/raster-small.txt @@ -0,0 +1,13 @@ +ncols 5 +nrows 7 +xllcorner 0.0 +yllcorner 0.0 +cellsize 50.0 +NODATA_value -9999 +-9999 -9999 5 2 1 +-9999 20 100 36 2 +3 8 35 10 3 +32 42 50 6 4 +88 75 27 9 5 +13 5 1 -9999 6 +4 12 5 9 7 \ No newline at end of file diff --git a/examples/raster/read-raster.scm b/examples/raster/read-raster.scm new file mode 100755 index 0000000..bdd632a --- /dev/null +++ b/examples/raster/read-raster.scm @@ -0,0 +1,35 @@ +#!/usr/bin/env -S guile -s +!# + +(add-to-load-path "../..") +(use-modules (gdal)) +(use-modules (rnrs bytevectors)) + +(all-register) + +;; read dataset using the binding functions + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (x-size (get-raster-band-x-size h-band)) + (y-size (get-raster-band-y-size h-band)) + (size (* x-size y-size)) + (bv (make-s32vector size))) + (begin + (raster-io h-band GF_READ 0 0 x-size y-size bv x-size y-size GDT_INT32 0 0) + (for-each (lambda (i) (format #t "~a " (s32vector-ref bv i))) + (iota size)))) + +(newline) + +;; and using the helper functions in the extesion module + +(use-modules (gdal extension)) + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (buf (make-buffer-all-from-band h-band GDT_INT32))) + (for-each-pixel (lambda (p) (format #t "~a " p)) buf)) + +(newline) + \ No newline at end of file diff --git a/examples/raster/write-raster.scm b/examples/raster/write-raster.scm new file mode 100755 index 0000000..de0b492 --- /dev/null +++ b/examples/raster/write-raster.scm @@ -0,0 +1,34 @@ +#!/usr/bin/env -S guile -s +!# + +(add-to-load-path "../..") + +(use-modules (gdal)) +(use-modules (rnrs bytevectors)) +(use-modules (gdal extension)) + +(all-register) + +;; we get the dataset handle of the file "raster-small.txt" in read-only +;; mode, and then get the handle of the first band. make-buffer-all-from-band +;; function reads all the pixels in the input file into the memory in INT32 +;; format. + +;; map-pixel function, here, returns a new binary buffer of type INT16 +;; with 1 for pixels greater than 0, and 0 otherwise. + +;; for-each-pixel method prints all the values of +;; the new raster into the console, and write-buffer-to-file saves the buffer +;; into the disk in GeoTIFF format. + +(let* ((dataset (open-dataset "raster-small.txt" GA_READONLY)) + (h-band (get-raster-band dataset 1)) + (buf (make-buffer-all-from-band h-band GDT_INT32))) + (begin + (define new-buf (map-pixel (lambda (p) (if (> p 0) 1 0)) + buf #:buf-type GDT_INT16)) + (for-each-pixel (lambda (p) (format #t "~a " p)) new-buf) + (write-buffer-to-file new-buf GDN_GTIFF + "new-raster-small.tif" #:no-data -1))) + +(newline) diff --git a/gdal.scm b/gdal.scm new file mode 100644 index 0000000..b302bfb --- /dev/null +++ b/gdal.scm @@ -0,0 +1,4678 @@ +(define-module (gdal) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 q) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-4 gnu) + #:use-module (gdal config) + #:use-module (gdal internal) + #:re-export (GDT_UNKNOWN + GDT_BYTE + GDT_UINT16 + GDT_INT16 + GDT_UINT32 + GDT_INT32 + GDT_FLOAT32 + GDT_FLOAT64 + GDT_CINT16 + GDT_CINT32 + GDT_CFLOAT32 + GDT_CFLOAT64 + GDT_TYPECOUNT)) + +;;------------------------------------------------------------------------------ + +;;; Enums + +;;------------------------------------------------------------------------------ + +;;; GDALAsyncStatusType enums +(define-public GARIO_PENDING 0) +(define-public GARIO_UPDATE 1) +(define-public GARIO_ERROR 2) +(define-public GARIO_COMPLETE 3) +(define-public GARIO_TYPECOUNT 4) + +;;; GDALColorInterp enums +(define-public GCI_UNDEFINED 0) +(define-public GCI_GRAY_INDEX 1) +(define-public GCI_PALETTE_INDEX 2) +(define-public GCI_RED_BAND 3) +(define-public GCI_GREEN_BAND 4) +(define-public GCI_BLUE_BAND 5) +(define-public GCI_ALPHA_BAND 6) +(define-public GCI_HUE_BAND 7) +(define-public GCI_SATURATION_BAND 8) +(define-public GCI_LIGHTNESS_BAND 9) +(define-public GCI_CYAN_BAND 10) +(define-public GCI_MAGENTA_BAND 11) +(define-public GCI_YELLOW_BAND 12) +(define-public GCI_BLACK_BAND 13) +(define-public GCI_YCBCR_Y_BAND 14) +(define-public GCI_YCBCR_CB_Band 15) +(define-public GCI_YCBCR_CR_Band 16) +(define-public GCI_MAX 16) + +;;; GDALPaletteInterp enums +(define-public GPI_GRAY 0) +(define-public GPI_RGB 1) +(define-public GPI_CMYK 2) +(define-public GPI_HLS 3) + +;;; GDALAccess enums +(define-public GA_READONLY 0) +(define-public GA_UPDATE 1) + +;;; CPLErr enums +(define-public CE_NONE 0) +(define-public CE_DEBUG 1) +(define-public CE_WARNING 2) +(define-public CE_FAILURE 3) +(define-public CE_FATAL 4) + +;;; GDALRWFlag enums +(define-public GF_READ 0) +(define-public GF_WRITE 1) + +;;; GDALRIOResampleAlg enums +(define-public GRIORA_NEAREST_NEIGHBOUR 0) +(define-public GRIORA_BILINEAR 1) +(define-public GRIORA_CUBIC 2) +(define-public GRIORA_CUBIC_SPLINE 3) +(define-public GRIORA_LANCZOS 4) +(define-public GRIORA_AVERAGE 5) +(define-public GRIORA_MODE 6) +(define-public GRIORA_GAUSS 7) + +;;; GDALRIOResampleAlg v2 enums +(define-public GRIORAv2_NEAREST_NEIGHBOUR 0) +(define-public GRIORAv2_BILINEAR 1) +(define-public GRIORAv2_CUBIC 2) +(define-public GRIORAv2_CUBIC_SPLINE 3) +(define-public GRIORAv2_LANCZOS 4) +(define-public GRIORAv2_AVERAGE 5) +(define-public GRIORAv2_MODE 6) +(define-public GRIORAv2_GAUSS 7) +(define-public GRIORAv2_AVERAGE_MAGPHASE 8) +(define-public GRIORAv2_NONE 9) + +(define *grioeav2-to-string* + `((,GRIORAv2_NEAREST_NEIGHBOUR . ,"NEAREST") + (,GRIORAv2_BILINEAR . ,"BILINEAR") + (,GRIORAv2_CUBIC . ,"CUBIC") + (,GRIORAv2_CUBIC_SPLINE . ,"CUBICSPLINE") + (,GRIORAv2_LANCZOS . ,"LANCZOS") + (,GRIORAv2_AVERAGE . ,"AVERAGE") + (,GRIORAv2_MODE . ,"MODE") + (,GRIORAv2_GAUSS . ,"GAUSS") + (,GRIORAv2_AVERAGE_MAGPHASE . ,"AVERAGE_MAGPHASE") + (,GRIORAv2_NONE . ,"NONE"))) + +;;; Enums of known driver short names +(define-public GDN_AAIGRID "AAIGrid") +(define-public GDN_ACE2 "ACE2") +(define-public GDN_ADRG "ADRG") +(define-public GDN_AERONAVFAA "AeronavFAA") +(define-public GDN_AIG "AIG") +(define-public GDN_AIRSAR "AirSAR") +(define-public GDN_AMIGOCLOUD "AmigoCloud") +(define-public GDN_ARCGEN "ARCGEN") +(define-public GDN_ARG "ARG") +(define-public GDN_AVCBIN "AVCBin") +(define-public GDN_AVCE00 "AVCE00") +(define-public GDN_BAG "BAG") +(define-public GDN_BIGGIF "BIGGIF") +(define-public GDN_BLX "BLX") +(define-public GDN_BMP "BMP") +(define-public GDN_BNA "BNA") +(define-public GDN_BSB "BSB") +(define-public GDN_BT "BT") +(define-public GDN_CAD "CAD") +(define-public GDN_CALS "CALS") +(define-public GDN_CARTO "Carto") +(define-public GDN_CEOS "CEOS") +(define-public GDN_CLOUDANT "Cloudant") +(define-public GDN_COASP "COASP") +(define-public GDN_COSAR "COSAR") +(define-public GDN_COUCHDB "CouchDB") +(define-public GDN_CPG "CPG") +(define-public GDN_CSV "CSV") +(define-public GDN_CSW "CSW") +(define-public GDN_CTABLE2 "CTable2") +(define-public GDN_CTG "CTG") +(define-public GDN_DERIVED "DERIVED") +(define-public GDN_DGN "DGN") +(define-public GDN_DIMAP "DIMAP") +(define-public GDN_DIPEX "DIPEx") +(define-public GDN_DODS "DODS") +(define-public GDN_DOQ1 "DOQ1") +(define-public GDN_DOQ2 "DOQ2") +(define-public GDN_DTED "DTED") +(define-public GDN_DXF "DXF") +(define-public GDN_E00GRID "E00GRID") +(define-public GDN_ECRGTOC "ECRGTOC") +(define-public GDN_EDIGEO "EDIGEO") +(define-public GDN_EHDR "EHdr") +(define-public GDN_EIR "EIR") +(define-public GDN_ELAS "ELAS") +(define-public GDN_ELASTICSEARCH "ElasticSearch") +(define-public GDN_ENVI "ENVI") +(define-public GDN_EPSILON "EPSILON") +(define-public GDN_ERS "ERS") +(define-public GDN_ESAT "ESAT") +(define-public GDN_ESRI_SHAPEFILE "ESRI Shapefile") +(define-public GDN_ESRIJSON "ESRIJSON") +(define-public GDN_FAST "FAST") +(define-public GDN_FIT "FIT") +(define-public GDN_FUJIBAS "FujiBAS") +(define-public GDN_GENBIN "GenBin") +(define-public GDN_GEOCONCEPT "Geoconcept") +(define-public GDN_GEOJSON "GeoJSON") +(define-public GDN_GEOMEDIA "Geomedia") +(define-public GDN_GEORSS "GeoRSS") +(define-public GDN_GFF "GFF") +(define-public GDN_GFT "GFT") +(define-public GDN_GIF "GIF") +(define-public GDN_GML "GML") +(define-public GDN_GMLAS "GMLAS") +(define-public GDN_GMT "GMT") +(define-public GDN_GNMDATABASE "GNMDatabase") +(define-public GDN_GNMFILE "GNMFile") +(define-public GDN_GPKG "GPKG") +(define-public GDN_GPSBABEL "GPSBabel") +(define-public GDN_GPSTRACKMAKER "GPSTrackMaker") +(define-public GDN_GPX "GPX") +(define-public GDN_GRASSASCIIGRID "GRASSASCIIGrid") +(define-public GDN_GRIB "GRIB") +(define-public GDN_GS7BG "GS7BG") +(define-public GDN_GSAG "GSAG") +(define-public GDN_GSBG "GSBG") +(define-public GDN_GSC "GSC") +(define-public GDN_GTIFF "GTiff") +(define-public GDN_GTX "GTX") +(define-public GDN_GXF "GXF") +(define-public GDN_HDF4 "HDF4") +(define-public GDN_HDF4IMAGE "HDF4Image") +(define-public GDN_HDF5 "HDF5") +(define-public GDN_HDF5IMAGE "HDF5Image") +(define-public GDN_HF2 "HF2") +(define-public GDN_HFA "HFA") +(define-public GDN_HTF "HTF") +(define-public GDN_HTTP "HTTP") +(define-public GDN_IDA "IDA") +(define-public GDN_IDRISI "Idrisi") +(define-public GDN_ILWIS "ILWIS") +(define-public GDN_INGR "INGR") +(define-public GDN_INTERLIS_1 "Interlis 1") +(define-public GDN_INTERLIS_2 "Interlis 2") +(define-public GDN_IRIS "IRIS") +(define-public GDN_ISCE "ISCE") +(define-public GDN_ISIS2 "ISIS2") +(define-public GDN_ISIS3 "ISIS3") +(define-public GDN_JAXAPALSAR "JAXAPALSAR") +(define-public GDN_JDEM "JDEM") +(define-public GDN_JML "JML") +(define-public GDN_JP2OPENJPEG "JP2OpenJPEG") +(define-public GDN_JPEG "JPEG") +(define-public GDN_JPEGLS "JPEGLS") +(define-public GDN_KML "KML") +(define-public GDN_KMLSUPEROVERLAY "KMLSUPEROVERLAY") +(define-public GDN_KRO "KRO") +(define-public GDN_L1B "L1B") +(define-public GDN_LAN "LAN") +(define-public GDN_LCP "LCP") +(define-public GDN_LEVELLER "Leveller") +(define-public GDN_LIBKML "LIBKML") +(define-public GDN_LOSLAS "LOSLAS") +(define-public GDN_MAP "MAP") +(define-public GDN_MAPINFO_FILE "MapInfo File") +(define-public GDN_MBTILES "MBTiles") +(define-public GDN_MEM "MEM") +(define-public GDN_MEMORY "Memory") +(define-public GDN_MFF "MFF") +(define-public GDN_MFF2 "MFF2") +(define-public GDN_MRF "MRF") +(define-public GDN_MSGN "MSGN") +(define-public GDN_MSSQLSPATIAL "MSSQLSpatial") +(define-public GDN_MVT "MVT") +(define-public GDN_MYSQL "MySQL") +(define-public GDN_NAS "NAS") +(define-public GDN_NDF "NDF") +(define-public GDN_NETCDF "netCDF") +(define-public GDN_NGSGEOID "NGSGEOID") +(define-public GDN_NITF "NITF") +(define-public GDN_NTV2 "NTv2") +(define-public GDN_NWT_GRC "NWT_GRC") +(define-public GDN_NWT_GRD "NWT_GRD") +(define-public GDN_ODBC "ODBC") +(define-public GDN_ODS "ODS") +(define-public GDN_OGR_DODS "OGR_DODS") +(define-public GDN_OGR_GMT "OGR_GMT") +(define-public GDN_OGR_OGDI "OGR_OGDI") +(define-public GDN_OGR_PDS "OGR_PDS") +(define-public GDN_OGR_SDTS "OGR_SDTS") +(define-public GDN_OGR_VRT "OGR_VRT") +(define-public GDN_OPENAIR "OpenAir") +(define-public GDN_OPENFILEGDB "OpenFileGDB") +(define-public GDN_OSM "OSM") +(define-public GDN_OZI "OZI") +(define-public GDN_PAUX "PAux") +(define-public GDN_PCIDSK "PCIDSK") +(define-public GDN_PCRASTER "PCRaster") +(define-public GDN_PDF "PDF") +(define-public GDN_PDS "PDS") +(define-public GDN_PDS4 "PDS4") +(define-public GDN_PGDUMP "PGDUMP") +(define-public GDN_PGEO "PGeo") +(define-public GDN_PLMOSAIC "PLMOSAIC") +(define-public GDN_PLSCENES "PLSCENES") +(define-public GDN_PNG "PNG") +(define-public GDN_PNM "PNM") +(define-public GDN_POSTGISRASTER "PostGISRaster") +(define-public GDN_POSTGRESQL "PostgreSQL") +(define-public GDN_PRF "PRF") +(define-public GDN_R "R") +(define-public GDN_RASTERLITE "Rasterlite") +(define-public GDN_RDA "RDA") +(define-public GDN_REC "REC") +(define-public GDN_RIK "RIK") +(define-public GDN_RMF "RMF") +(define-public GDN_ROI_PAC "ROI_PAC") +(define-public GDN_RPFTOC "RPFTOC") +(define-public GDN_RRASTER "RRASTER") +(define-public GDN_RS2 "RS2") +(define-public GDN_RST "RST") +(define-public GDN_S57 "S57") +(define-public GDN_SAFE "SAFE") +(define-public GDN_SAGA "SAGA") +(define-public GDN_SAR_CEOS "SAR_CEOS") +(define-public GDN_SDTS "SDTS") +(define-public GDN_SEGUKOOA "SEGUKOOA") +(define-public GDN_SEGY "SEGY") +(define-public GDN_SELAFIN "Selafin") +(define-public GDN_SENTINEL2 "SENTINEL2") +(define-public GDN_SGI "SGI") +(define-public GDN_SNODAS "SNODAS") +(define-public GDN_SOSI "SOSI") +(define-public GDN_SQLITE "SQLite") +(define-public GDN_SRP "SRP") +(define-public GDN_SRTMHGT "SRTMHGT") +(define-public GDN_SUA "SUA") +(define-public GDN_SVG "SVG") +(define-public GDN_SXF "SXF") +(define-public GDN_TERRAGEN "Terragen") +(define-public GDN_TIGER "TIGER") +(define-public GDN_TIL "TIL") +(define-public GDN_TOPOJSON "TopoJSON") +(define-public GDN_TSX "TSX") +(define-public GDN_UK_NTF "UK .NTF") +(define-public GDN_USGSDEM "USGSDEM") +(define-public GDN_VDV "VDV") +(define-public GDN_VFK "VFK") +(define-public GDN_VICAR "VICAR") +(define-public GDN_VRT "VRT") +(define-public GDN_WALK "Walk") +(define-public GDN_WASP "WAsP") +(define-public GDN_WCS "WCS") +(define-public GDN_WEBP "WEBP") +(define-public GDN_WFS "WFS") +(define-public GDN_WFS3 "WFS3") +(define-public GDN_WMS "WMS") +(define-public GDN_WMTS "WMTS") +(define-public GDN_XLS "XLS") +(define-public GDN_XLSX "XLSX") +(define-public GDN_XPLANE "XPlane") +(define-public GDN_XPM "XPM") +(define-public GDN_XYZ "XYZ") +(define-public GDN_ZMAP "ZMap") + +;;; OGRwkbGeometryType enums +(define-public WKB_UNKNOWN 0) +(define-public WKB_POINT 1) +(define-public WKB_LINE_STRING 2) +(define-public WKB_POLYGON 3) +(define-public WKB_MULTI_POINT 4) +(define-public WKB_MULTI_LINE_STRING 5) +(define-public WKB_MULTI_POLYGON 6) +(define-public WKB_GEOMETRY_COLLECTION 7) +(define-public WKB_COMPOUND_CURVE 9) +(define-public WKB_CURVE_POLYGON 10) +(define-public WKB_MULTI_CURVE 11) +(define-public WKB_MULTI_SURFACE 12) +(define-public WKB_CURVE 13) +(define-public WKB_SURFACE 14) +(define-public WKB_POLYHEDRAL_SURFACE 15) +(define-public WKB_TIN 16) +(define-public WKB_TRIANGLE 17) +(define-public WKB_NONE 100) +(define-public WKB_LINEAR_RING 101) +(define-public WKB_CIRCULAR_STRING_Z 1008) +(define-public WKB_COMPOUND_CURVE_Z 1009) +(define-public WKB_CURVE_POLYGON_Z 1010) +(define-public WKB_MULTI_CURVE_Z 1011) +(define-public WKB_MULTI_SURFACE_Z 1012) +(define-public WKB_CURVE_Z 1013) +(define-public WKB_SURFACE_Z 1014) +(define-public WKB_POLYHEDRAL_SURFACE_Z 1015) +(define-public WKB_TIN_Z 1016) +(define-public WKB_TRIANGLE_Z 1017) +(define-public WKB_POINT_M 2001) +(define-public WKB_LINE_STRING_M 2002) +(define-public WKB_POLYGON_M 2003) +(define-public WKB_MULTI_POINT_M 2004) +(define-public WKB_MULTI_LINE_STRING_M 2005) +(define-public WKB_MULTI_POLYGON_M 2006) +(define-public WKB_GEOMETRY_COLLECTION_M 2007) +(define-public WKB_CIRCULAR_STRING_M 2008) +(define-public WKB_COMPOUND_CURVE_M 2009) +(define-public WKB_CURVE_POLYGON_M 2010) +(define-public WKB_MULTI_CURVE_M 2011) +(define-public WKB_MULTI_SURFACE_M 2012) +(define-public WKB_CURVE_M 2013) +(define-public WKB_SURFACE_M 2014) +(define-public WKB_POLYHEDRAL_SURFACE_M 2015) +(define-public WKB_TIN_M 2016) +(define-public WKB_TRIANGLE_M 2017) +(define-public WKB_POINT_ZM 3001) +(define-public WKB_LINE_STRING_ZM 3002) +(define-public WKB_POLYGON_ZM 3003) +(define-public WKB_MULTI_POINT_ZM 3004) +(define-public WKB_MULTI_LINE_STRING_ZM 3005) +(define-public WKB_MULTI_POLYGON_ZM 3006) +(define-public WKB_GEOMETRY_COLLECTION_ZM 3007) +(define-public WKB_CIRCULAR_STRING_ZM 3008) +(define-public WKB_COMPOUND_CURVE_ZM 3009) +(define-public WKB_CURVE_POLYGON_ZM 3010) +(define-public WKB_MULTI_CURVE_ZM 3011) +(define-public WKB_MULTI_SURFACE_ZM 3012) +(define-public WKB_CURVE_ZM 3013) +(define-public WKB_SURFACE_ZM 3014) +(define-public WKB_POLYHEDRAL_SURFACE_ZM 3015) +(define-public WKB_TIN_ZM 3016) +(define-public WKB_TRIANGLE_ZM 3017) +(define-public WKB_POINT_25D #x80000001) +(define-public WKB_LINE_STRING_25D #x80000002) +(define-public WKB_POLYGON_25D #x80000003) +(define-public WKB_MULTI_POINT_25D #x80000004) +(define-public WKB_MULTI_LINE_STRING_25D #x80000005) +(define-public WKB_MULTI_POLYGON_25D #x80000006) +(define-public WKB_GEOMETRY_COLLECTION_25D #x80000007) + +;;; GMF Enums +(define-public GMF_ALL_VALID #x01) +(define-public GMF_PER_DATASET #x02) +(define-public GMF_ALPHA #x04) +(define-public GMF_NODATA #x08) + +;;; GDAL_OF Enums +(define-public GDAL_OF_READONLY #x00) +(define-public GDAL_OF_UPDATE #x01) +(define-public GDAL_OF_ALL #x00) +(define-public GDAL_OF_RASTER #x02) +(define-public GDAL_OF_VECTOR #x04) +(define-public GDAL_OF_GNM #x08) +(define-public GDAL_OF_MULTIDIM_RASTER #x10) +(define-public GDAL_OF_KIND_MASK #x1e) +(define-public GDAL_OF_SHARED #x20) +(define-public GDAL_OF_VERBOSE_ERROR #x40) +(define-public GDAL_OF_INTERNAL #x80) +(define-public GDAL_OF_DEFAULT_BLOCK_ACCESS 0) +(define-public GDAL_OF_ARRAY_BLOCK_ACCESS #x100) +(define-public GDAL_OF_HASHSET_BLOCK_ACCESS #x200) +(define-public GDAL_OF_BLOCK_ACCESS_MASK #x300) + +;;; ODs Enums +(define-public ODSC_CREATE_LAYER "CreateLayer") +(define-public ODSC_DELETE_LAYER "DeleteLayer") +(define-public ODSC_CREATE_GEOM_FIELD_AFTER_CREATE_LAYER + "CreateGeomFieldAfterCreateLayer") +(define-public ODSC_CURVE_GEOMETRIES "CurveGeometries") +(define-public ODSC_TRANSACTIONS "Transactions") +(define-public ODSC_EMULATED_TRANSACTIONS "EmulatedTransactions") +(define-public ODSC_RANDOM_LAYER_READ "RandomLayerRead") +(define-public ODSC_RANDOM_LAYER_WRITE "RandomLayerWrite") + +;;; OGRERR Enums +(define-public OGRERR_NONE 0) +(define-public OGRERR_NOT_ENOUGH_DATA 1) +(define-public OGRERR_NOT_ENOUGH_MEMORY 2) +(define-public OGRERR_UNSUPPORTED_GEOMETRY_TYPE 3) +(define-public OGRERR_UNSUPPORTED_OPERATION 4) +(define-public OGRERR_CORRUPT_DATA 5) +(define-public OGRERR_FAILURE 6) +(define-public OGRERR_UNSUPPORTED_SRS 7) +(define-public OGRERR_INVALID_HANDLE 8) +(define-public OGRERR_NON_EXISTING_FEATURE 9) + +;;; RAT Enums +(define-public GFU_GENERIC 0) +(define-public GFU_PIXEL_COUNT 1) +(define-public GFU_NAME 2) +(define-public GFU_MIN 3) +(define-public GFU_MAX 4) +(define-public GFU_MIN_MAX 5) +(define-public GFU_RED 6) +(define-public GFU_GREEN 7) +(define-public GFU_BLUE 8) +(define-public GFU_ALPHA 9) +(define-public GFU_RED_MIN 10) +(define-public GFU_GREEN_MIN 11) +(define-public GFU_BLUE_MIN 12) +(define-public GFU_ALPHA_MIN 13) +(define-public GFU_RED_MAX 14) +(define-public GFU_GREEN_MAX 15) +(define-public GFU_BLUE_MAX 16) +(define-public GFU_ALPHA_MAX 17) + +;;; GFT Enums +(define-public GFT_INTEGER 0) +(define-public GFT_REAL 1) +(define-public GFT_STRING 2) + +;;; GRTT Enums +(define-public GRTT_THEMATIC 0) +(define-public GRTT_ATHEMATIC 1) + +;;------------------------------------------------------------------------------ + +;;; Structures + +;;------------------------------------------------------------------------------ + +;;; GCP + +(define-record-type + (%make-gcp id info pixel line x y z) + gcp? + (id gcp-id set-gcp-id!) + (info gcp-info set-gcp-info!) + (pixel gcp-pixel set-gcp-pixel!) + (line gcp-line set-gcp-line!) + (x gcp-x set-gcp-x!) + (y gcp-y set-gcp-y!) + (z gcp-z set-gcp-z!)) + +(define* (make-gcp #:key + (id "") + (info "") + (pixel 0.0) + (line 0.0) + (x 0.0) + (y 0.0) + (z 0.0)) + (%make-gcp id info pixel line x y z)) + +(export make-gcp + gcp? + gcp-id + set-gcp-id! + gcp-info + set-gcp-info! + gcp-pixel + set-gcp-pixel! + gcp-line + set-gcp-line! + gcp-x + set-gcp-x! + gcp-y + set-gcp-y! + gcp-z + set-gcp-z!) + +(define gcp-types (list '* '* double double double double double)) + +(define (gcp->pointer record) + (if (gcp? record) + (make-c-struct + gcp-types + (list (string->pointer (gcp-id record)) + (string->pointer (gcp-info record)) + (gcp-pixel record) + (gcp-line record) + (gcp-x record) + (gcp-y record) + (gcp-z record))) + %null-pointer)) + +(define (pointer->gcp pointer) + (let ((lst (parse-c-struct pointer gcp-types))) + (make-gcp #:id (pointer->string (list-ref lst 0)) + #:info (pointer->string (list-ref lst 1)) + #:pixel (list-ref lst 2) + #:line (list-ref lst 3) + #:x (list-ref lst 4) + #:y (list-ref lst 5) + #:z (list-ref lst 6)))) + +(define (gcp-list->pointer lst) + (struct-list->pointer lst (sizeof gcp-types) gcp->pointer)) + +(define (pointer->gcp-list pointer count) + (pointer->struct-list pointer count (sizeof gcp-types) pointer->gcp)) + +(export pointer->gcp-list) +;;; GDALRasterIOExtraArg + +(define-record-type + (%make-grioea version resample-alg progress-callback progress-data + is-fp-window-valid x-off y-off x-size y-size) + grioea? + (version grioea-version set-grioea-version!) + (resample-alg grioea-resample-alg set-grioea-resample-alg!) + (progress-callback grioea-progress-callback set-grioea-progress-callback!) + (progress-data grioea-progress-data set-grioea-progress-data!) + (is-fp-window-valid grioea-is-fp-window-valid set-grioea-is-fp-window-valid!) + (x-off grioea-x-off set-grioea-x-off!) + (y-off grioea-y-off set-grioea-y-off!) + (x-size grioea-x-size set-grioea-x-size!) + (y-size grioea-y-size set-grioea-y-size!)) + +(define (gdal-progress-func progress-callback) + (if (null? progress-callback) + %null-pointer + (procedure->pointer int + (lambda (complete message progress-arg) + (progress-callback complete + (pointer->string message) + progress-arg)) + (list double '* '*)))) + +(define* (make-grioea #:key + (version 1) + (resample-alg GRIORA_NEAREST_NEIGHBOUR) + (progress-callback '()) + (progress-data %null-pointer) + (is-fp-window-valid #f) + (x-off 0.0) + (y-off 0.0) + (x-size 0.0) + (y-size 0.0)) + (%make-grioea version resample-alg + (gdal-progress-func progress-callback) + progress-data + (boolean->c-bool is-fp-window-valid) + x-off y-off x-size y-size)) + +(export make-grioea + grioea? + grioea-version + set-grioea-version! + grioea-resample-alg + set-grioea-resample-alg! + grioea-progress-callback + set-grioea-progress-callback! + grioea-progress-data + set-grioea-progress-data! + grioea-is-fp-window-valid + set-grioea-is-fp-window-valid! + grioea-x-off + set-grioea-x-off! + grioea-y-off + set-grioea-y-off! + grioea-x-size + set-grioea-x-size! + grioea-y-size + set-grioea-y-size!) + +(define (grioea->foreign-pointer record) + (if (grioea? record) + (make-c-struct + (list int int '* '* int double double double double) + (list (grioea-version record) + (grioea-resample-alg record) + (grioea-progress-callback record) + (grioea-progress-data record) + (grioea-is-fp-window-valid record) + (grioea-x-off record) + (grioea-y-off record) + (grioea-x-size record) + (grioea-y-size record))) + %null-pointer)) + +(define (gdal-term-progress complete message arg) + "Simple progress report to terminal. + +This progress reporter prints simple progress report to the terminal window. +The progress report generally looks something like this: + +17.0...33.0...50.0...67.0...83.0...100.0. + +Use it when you create grioea record via \"make-grioea\" function: + + Sample: + +(make-grioea #:progress-callback gdal-term-progress)" + (let ((perc (round (* complete 100)))) + (display perc) + (if (= perc 100) + (newline) + (display "...")) + 1)) + +(export gdal-term-progress) + +;;------------------------------------------------------------------------------ + +;;; GDAL Function Bindings + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-all-register + void "GDALAllRegister" '() 20) + +(define (all-register) + "Register all known configured GDAL drivers." + (%gdal-all-register)) + +(export all-register) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %cpl-error-reset + void "CPLErrorReset" '() 20) + +(define (reset-error) + "Erase any traces of previous errors. + +This is normally used to ensure that an error which has been recovered from +does not appear to be still in play with high level functions." + (%cpl-error-reset)) + +(export reset-error) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %cpl-get-last-error-msg + '* "CPLGetLastErrorMsg" '() 20) + +(define (get-last-error-message) + "Get the last error message. + +Fetches the last error message posted with CPLError(), that hasn't been cleared +by reset-error." + (let ((ptr (%cpl-get-last-error-msg))) + (if (null-pointer? ptr) + "" + (pointer->string ptr)))) + +(export get-last-error-message) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-size + int "GDALGetDataTypeSize" (list int) 20) + +(define (get-data-type-size data-type) + "Get data type size in bits. + +Deprecated. + +Returns the size of a GDT_* type in bits, not bytes! +Use get-data-type-size-bytes for bytes. Use get-data-type-size-bits for bits. + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-size data-type))) + (if (zero? result) + (error "failed to recognize data type") + result))) + +(export get-data-type-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-size-bits + int "GDALGetDataTypeSizeBits" (list int) 20) + +(define (get-data-type-size-bits data-type) + "Get data type size in bits. + +Returns the size of a GDT_* type in bits, not bytes! +Use get-data-type-size-bytes for bytes. + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-size-bits data-type))) + (if (zero? result) + (error "failed to recognize data type") + result))) + +(export get-data-type-size-bits) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-size-bytes + int "GDALGetDataTypeSizeBytes" (list int) 20) + +(define (get-data-type-size-bytes data-type) + "Get data type size in bytes. + +Returns the size of a GDT_* type in bytes. In contrast, get-data-type-size and +get-data-type-size-bits return the size in bits. + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-size-bytes data-type))) + (if (zero? result) + (error "failed to recognize data type") + result))) + +(export get-data-type-size-bytes) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-is-complex + int "GDALDataTypeIsComplex" (list int) 20) + +(define (data-type-is-complex? data-type) + "Is data type complex? + +Returns #t if the passed type is complex (one of GDT_CINT16, GDT_CINT32, +GDT_CFLOAT32 or GDT_CFLOAT64), that is it consists of a real and imaginary +component. + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-is-complex data-type))) + (if (= result 1) + #t + #f))) + +(export data-type-is-complex?) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-is-integer + int "GDALDataTypeIsInteger" (list int) 23) + +(define (data-type-is-integer? data-type) + "Is data type integer? (might be complex) + +Returns #t if the passed type is integer (one of GDT_BYTE, GDT_INT16, +GDT_UINT16, GDT_INT32, GDT_UINT32, GDT_CINT16 or GDT_CINT32). + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-is-integer data-type))) + (if (= result 1) + #t + #f))) + +(export data-type-is-integer?) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-is-floating + int "GDALDataTypeIsFloating" (list int) 23) + +(define (data-type-is-floating? data-type) + "Is data type floating? (might be complex) + +Returns #t if the passed type is floating (one of GDT_FLOAT32, GDT_FLOAT64, +GDT_CFLOAT32, GDT_CFLOAT64). + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-is-floating data-type))) + (if (= result 1) + #t + #f))) + +(export data-type-is-floating?) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-is-signed + int "GDALDataTypeIsSigned" (list int) 23) + +(define (data-type-is-signed? data-type) + "Is data type signed? + +Returns #t if the passed type is signed. + +Parameters: + data-type: type, such as GDT_BYTE." + (let ((result (%gdal-data-type-is-signed data-type))) + (if (= result 1) + #t + #f))) + +(export data-type-is-signed?) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-data-type-name + '* "GDALGetDataTypeName" (list int) 20) + +(define (get-data-type-name data-type) + "Get name of data type. + +Returns a symbolic name for the data type. This is essentially the enumerated +item name with the GDT_ prefix removed. So GDT_BYTE returns 'Byte'. + +Parameters: + data-type: type to get name of." + (let ((ptr (%gdal-get-data-type-name data-type))) + (if (null-pointer? ptr) + (error "failed to recognize data type") + (pointer->string ptr)))) + +(export get-data-type-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-data-type-by-name + int "GDALGetDataTypeByName" (list '*) 20) + +(define (get-data-type-by-name name) + "Get data type by symbolic name. + +Returns a data type corresponding to the given symbolic name. This function is +opposite to the get-data-type-name. + +Parameters: + name: string containing the symbolic name of the type." + (let ((result (%gdal-get-data-type-by-name (string->pointer name)))) + (if (zero? result) + (error "failed to recognize data type") + result))) + +(export get-data-type-by-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-union + int "GDALDataTypeUnion" (list int int) 20) + +(define (data-type-union data-type-1 data-type-2) + "Return the smallest data type that can fully express both input data +types. + +Parameters: + data-type-1: first data type. + data-type-2: second data type." + (let ((result (%gdal-data-type-union data-type-1 data-type-2))) + (if (zero? result) + (error "failed to recognize data type") + result))) + +(export data-type-union) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-union-with-value + int "GDALDataTypeUnionWithValue" (list int double int) 23) + +(define (data-type-union-with-value data-type value is-complex) + "Union a data type with the one found for a value. + +Parameters: + data-type: the first data type + value: the value for which to find a data type and union with 'data-type' + is-complex: boolean, #t if the value is complex." + (let ((result (%gdal-data-type-union-with-value + data-type value (boolean->c-bool is-complex)))) + (if (zero? result) + (error "failed to union data type") + result))) + +(export data-type-union-with-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-find-data-type + int "GDALFindDataType" (list int int int int) 23) + +(define (find-data-type n-bits is-signed is-floating is-complex) + "Finds the smallest data type able to support the given requirements. + +Parameters: + n-bits: number of bits necessary + is-signed: if negative values are necessary + is-floating: if non-integer values necessary + is-complex: if complex values are necessary." + (let ((result (%gdal-find-data-type n-bits (boolean->c-bool is-signed) + (boolean->c-bool is-floating) (boolean->c-bool is-complex)))) + (if (zero? result) + (error "failed to find data type") + result))) + +(export find-data-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-find-data-type-for-value + int "GDALFindDataTypeForValue" (list double int) 23) + +(define (find-data-type-for-value value is-complex) + "Finds the smallest data type able to support the provided value. + +Parameters: + value: double value to support + is-complex: is the value complex." + (let ((result (%gdal-find-data-type-for-value value + (boolean->c-bool is-complex)))) + (if (zero? result) + (error "failed to find data type") + result))) + +(export find-data-type-for-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-adjust-data-type-to-value + double "GDALAdjustValueToDataType" (list int double '* '*) 20) + +(define (adjust-data-type-to-value data-type value) + "Adjust a value to the output data type. + +Adjustment consist in clamping to minimum/maxmimum values of the data type and +rounding for integral types. + +Returns multiple (3) values as adjusted double value, +boolean value to indicate if clamping has been made, and boolean value to +indicate if rounding has been made. + +Parameters: + data-type: target data type + value: double value to adjust." + (let* ((p-clamped (make-bytevector (sizeof int))) + (p-rounded (make-bytevector (sizeof int))) + (result (%gdal-adjust-data-type-to-value + data-type + value + (bytevector->pointer p-clamped) + (bytevector->pointer p-rounded)))) + (values + result + (c-bool->boolean (bytevector-sint-ref p-clamped + 0 + (native-endianness) + (sizeof int))) + (c-bool->boolean (bytevector-sint-ref p-rounded + 0 + (native-endianness) + (sizeof int)))))) + +(export adjust-data-type-to-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-non-complex-data-type + int "GDALGetNonComplexDataType" (list int) 23) + +(define (get-non-complex-data-type data-type) + "Return the base data type for the specified input. + +If the input data type is complex this function returns the base type i.e. +the data type of the real and imaginary parts (non-complex). If the input data +type is already non-complex, then it is returned unchanged. + +Parameters: + data-type: type, such as GDT_CFLOAT32." + (if (data-type-valid? data-type) + (%gdal-get-non-complex-data-type data-type) + (error "data-type is out of bounds"))) + +(export get-non-complex-data-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-data-type-is-conversion-lossy + int "GDALDataTypeIsConversionLossy" (list int int) 23) + +(define (data-type-is-conversion-lossy? data-type-from data-type-to) + "Is conversion from data-type-from to data-type-to potentially lossy. + +Parameters: + data-type-from: input datatype + data-type-to: output datatype." + (if (and (data-type-valid? data-type-from) (data-type-valid? data-type-to)) + (c-bool->boolean (%gdal-data-type-is-conversion-lossy + data-type-from + data-type-to)) + (error "data-type is out of bounds"))) + +(export data-type-is-conversion-lossy?) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-async-status-type-name + '* "GDALGetAsyncStatusTypeName" (list int) 20) + +(define (get-async-status-type-name async-status-type) + "Get name of AsyncStatus data type. + +Returns a symbolic name for the AsyncStatus data type. This is essentially the +the enumerated item name with the GARIO_ prefix removed. So GARIO_COMPLETE +returns 'COMPLETE'. + +Parameters: + async-status-type: type to get name of." + (let ((ptr (%gdal-get-async-status-type-name async-status-type))) + (if (null-pointer? ptr) + (error "failed to recognize async status type") + (pointer->string ptr)))) + +(export get-async-status-type-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-async-status-type-by-name + int "GDALGetAsyncStatusTypeByName" (list '*) 20) + +(define (get-async-status-type-by-name name) + "Get AsyncStatusType by symbolic name. + +Returns a data type corresponding to the given symbolic name. This function is +opposite to the get-async-status-type-name. + +Parameters: + name: string containing the symbolic name of the type." + (let ((result (%gdal-get-async-status-type-by-name (string->pointer name)))) + (if (= GARIO_ERROR result) + (error "failed to recognize async status type") + result))) + +(export get-async-status-type-by-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-color-interpretation-name + '* "GDALGetColorInterpretationName" (list int) 20) + +(define (get-color-interpretation-name color-interpretation-type) + "Get name of color interpretation. + +Returns a symbolic name for the color interpretation. This is derived from the +enumerated item name with the GCI_ prefix removed, but there are some +variations. So GCI_GRAY_INDEX returns 'Gray' and GCI_RED_BAND returns 'Red'. + +Parameters: + color-interpretation-type: color interpretation to get name of." + (let ((ptr (%gdal-get-color-interpretation-name + color-interpretation-type))) + (if (null-pointer? ptr) + (error "failed to recognize color interpretation type") + (pointer->string ptr)))) + +(export get-color-interpretation-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-color-interpretation-by-name + int "GDALGetColorInterpretationByName" (list '*) 20) + +(define (get-color-interpretation-by-name name) + "Get color interpretation by symbolic name. + +Returns a color interpretation corresponding to the given symbolic name. This +function is opposite to the get-color-interpretation-name. + +Parameters: + name: string containing the symbolic name of the color interpretation." + (let ((result (%gdal-get-color-interpretation-by-name + (string->pointer name)))) + (if (= GCI_UNDEFINED result) + (error "failed to recognize color interpretation type") + result))) + +(export get-color-interpretation-by-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-palette-interpretation-name + '* "GDALGetPaletteInterpretationName" (list int) 20) + +(define (get-palette-interpretation-name palette-interpretation-type) + "Get name of palette interpretation. + +Returns a symbolic name for the palette interpretation. This is the the +enumerated item name with the GPI_ prefix removed. So GPI_Gray returns 'Gray'. + +Parameters: + palette-interpretation-type: palette interpretation to get name of." + (let ((ptr (%gdal-get-palette-interpretation-name + palette-interpretation-type))) + (if (null-pointer? ptr) + (error "failed to recognize palette interpretation type") + (pointer->string ptr)))) + +(export get-palette-interpretation-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-create + '* "GDALCreate" (list '* '* int int int int '*) 20) + +(define (create-dataset driver file-name x-size y-size n-bands band-type) + "Create a new dataset with this driver. + +Parameters: + driver: gdal driver + file-name: the name of the dataset to create + x-size: width of created raster in pixels + y-size: height of created raster in pixels + n-bands: number of bands + band-type: type of raster." + (let ((ptr (%gdal-create driver + (string->pointer file-name) + x-size + y-size + n-bands + band-type + %null-pointer))) + (if (null-pointer? ptr) + (error "failed to create GDAL dataset") + ptr))) + +(export create-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-create-copy + '* "GDALCreateCopy" (list '* '* '* int '* '* '*) 20) + +(define (copy-dataset driver file-name source-dataset is-strict) + "Create a copy of a dataset. + +Parameters: + driver: GDAL driver + file-name: the name for the new dataset + source-dataset: the dataset being duplicated. + is-strict: #t if the copy must be strictly equivalent, or more normally +#f indicating that the copy may adapt as needed for the output format." + (let ((ptr (%gdal-create-copy driver + (string->pointer file-name) + source-dataset + (boolean->c-bool is-strict) + %null-pointer + %null-pointer + %null-pointer))) + (if (null-pointer? ptr) + (error "failed to create GDAL dataset") + ptr))) + +(export copy-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-identify-driver + '* "GDALIdentifyDriver" (list '* '*) 20) + +(define (identify-driver file-name) + "Identify the driver that can open a raster file. + +Parameters: + file-name: the name of the file to access. In the case of exotic drivers +this may not refer to a physical file, but instead contain information for the +driver on how to access a dataset." + (let ((ptr (%gdal-identify-driver + (string->pointer file-name) + %null-pointer))) + (if (null-pointer? ptr) + (error "failed to identify driver") + ptr))) + +(export identify-driver) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-open + '* "GDALOpen" (list '* int) 20) + +(define (open-dataset file-name access) + "Open a raster file as a GDALDataset pointer. + +Parameters: + file-name: the name of the file to access. In the case of exotic drivers +this may not refer to a physical file, but instead contain information for the +driver on how to access a dataset. + access: the desired access, either GA_UPDATE or GA_READONLY. Many drivers +support only read only access." + (let ((ptr (%gdal-open + (string->pointer file-name) + access))) + (if (null-pointer? ptr) + (error "failed to open dataset") + ptr))) + +(export open-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-open-ex + '* "GDALOpenEx" (list '* int '* '* '*) 20) + +(define* (open-dataset-ex file-name flags #:key + (allowed-drivers '()) + (open-options '()) + (sibling-files '())) + "Open a raster or vector file as a GDALDataset. + +Parameters: + file-name: the name of the file to access. In the case of exotic drivers +this may not refer to a physical file, but instead contain information for the +driver on how to access a dataset. + flags: a combination of GDAL_OF_ flags that may be combined through +logical or operator. + allowed-drivers (optional): empty list '() to consider all candidate +drivers, or a list of strings with the driver short names that must be +considered. + open-options (optional): empty list '(), or a list of strings with open +options passed to candidate drivers. + sibling-files (optional): empty list '() or a list of strings that are +filenames that are auxiliary to the main filename." + (let ((ptr (%gdal-open-ex + (string->pointer file-name) + flags + (string-list->pointerpointer allowed-drivers) + (string-list->pointerpointer open-options) + (string-list->pointerpointer sibling-files)))) + (if (null-pointer? ptr) + (error "failed to open dataset") + ptr))) + +(export open-dataset-ex) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-open-shared + '* "GDALOpenShared" (list '* int) 20) + +(define (open-shared-dataset file-name access) + "Open a raster file as a GDALDataset pointer. + +Parameters: + file-name: the name of the file to access. In the case of exotic drivers +this may not refer to a physical file, but instead contain information for the +driver on how to access a dataset. + access: the desired access, either GA_UPDATE or GA_READONLY. Many drivers +support only read only access." + (let ((ptr (%gdal-open-shared + (string->pointer file-name) + access))) + (if (null-pointer? ptr) + (error "failed to open dataset") + ptr))) + +(export open-shared-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-driver-by-name + '* "GDALGetDriverByName" (list '*) 20) + +(define (get-driver-by-name driver-short-name) + "Fetch a driver based on the short name. + +Parameters: + driver-short-name: the short name of the driver, such as 'GTiff' as a +string or GDN_GTIFF as an enum (see GDN_*), being searched for." + (let ((ptr (%gdal-get-driver-by-name + (string->pointer driver-short-name)))) + (if (null-pointer? ptr) + (error "failed to find driver") + ptr))) + +(export get-driver-by-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-driver-count + int "GDALGetDriverCount" '() 20) + +(define (get-driver-count) + "Fetch the number of registered drivers." + (%gdal-get-driver-count)) + +(export get-driver-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-driver + '* "GDALGetDriver" (list int) 20) + +(define (get-driver driver-index) + "Fetch driver by index. + +Parameters: + driver-index: the driver index from 0 to (1- (get-driver-count))." + (let ((ptr (%gdal-get-driver driver-index))) + (if (null-pointer? ptr) + (error "failed to find driver") + ptr))) + +(export get-driver) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-destroy-driver + void "GDALDestroyDriver" (list '*) 20) + +(define (destroy-driver driver) + "Destroy a GDALDriver. + +Parameters: + driver: the driver to destroy" + (%gdal-destroy-driver driver)) + +(export destroy-driver) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-delete-dataset + int "GDALDeleteDataset" (list '* '*) 20) + +(define (delete-dataset driver file-name) + "Delete named dataset. + +Parameters: + driver: the driver to use for deleting file-name + file-name: name of dataset to delete." + (let ((result (%gdal-delete-dataset driver (string->pointer file-name)))) + (unless (= result CE_NONE) + (error "failed to delete dataset")))) + +(export delete-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rename-dataset + int "GDALRenameDataset" (list '* '* '*) 20) + +(define (rename-dataset driver new-file-name old-file-name) + "Rename a dataset. + +Parameters: + driver: the driver to use for deleting file-name + new-file-name: new name for the dataset + old-file-name: old name for the dataset." + (let ((result (%gdal-rename-dataset + driver + (string->pointer new-file-name) + (string->pointer old-file-name)))) + (unless (= result CE_NONE) + (error "failed to rename dataset")))) + +(export rename-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-copy-dataset-files + int "GDALCopyDatasetFiles" (list '* '* '*) 20) + +(define (copy-dataset-files driver new-file-name old-file-name) + "Copy all the files associated with a dataset. + +Parameters: + driver: the driver to use for deleting file-name + new-file-name: new name for the dataset + old-file-name: old name for the dataset." + (let ((result (%gdal-copy-dataset-files + driver + (string->pointer new-file-name) + (string->pointer old-file-name)))) + (unless (= result CE_NONE) + (error "failed to copy dataset files")))) + +(export copy-dataset-files) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-gcps-to-geo-transform + int "GDALGCPsToGeoTransform" (list int '* '* int) 20) + +(define (gcps-to-geo-transform gcp-lst is-approx-ok) + "Generate Geotransform from GCPs. + +Parameters: + gcp-list: list of GCPs + is-approx-ok: If #f the function will fail if the geotransform is not +essentially an exact fit (within 0.25 pixel) for all GCPs." + (cond ((not (pair? gcp-lst)) + (error "input is not a list or empty")) + ((not (= (count gcp? gcp-lst) (length gcp-lst))) + (error "input list has at least one non-gcp record")) + (else (let* ((bv-gcps (make-bytevector (* 6 (sizeof double)))) + (result (%gdal-gcps-to-geo-transform + (length gcp-lst) + (gcp-list->pointer gcp-lst) + (bytevector->pointer bv-gcps) + (boolean->c-bool is-approx-ok)))) + (if (c-bool->boolean result) + (let ((ne (native-endianness)) + (coef-max-index 5) + (coefs-q (make-q))) + (do ((i 0 (1+ i))) + ((> i coef-max-index)) + (enq! coefs-q + (bytevector-ieee-double-ref bv-gcps + (* i (sizeof double)) ne))) + (car coefs-q)) + #f))))) + +(export gcps-to-geo-transform) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-inv-geo-transform + int "GDALInvGeoTransform" (list '* '*) 20) + +(define (inv-geo-transform gt-lst) + "Invert Geotransform. + +Parameters: + gt-lst: list of input geotransform (six doubles)." + (cond ((not (pair? gt-lst)) + (error "input is not a list or empty")) + ((not (= 6 (length gt-lst))) + (error "insufficient number of coefficients in the list (6 doubles)")) + (else (let* ((bv-gp-out (make-bytevector (* 6 (sizeof double)))) + (coef-max-index 5) + (result (%gdal-inv-geo-transform + (list->pointer gt-lst double) + (bytevector->pointer bv-gp-out)))) + (if (c-bool->boolean result) + (let ((coefs-q (make-q))) + (do ((i 0 (1+ i))) + ((> i coef-max-index)) + (enq! coefs-q (bytevector-ieee-double-native-ref + bv-gp-out + (* i (sizeof double))))) + (car coefs-q)) + #f))))) + +(export inv-geo-transform) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-apply-geo-transform + int "GDALApplyGeoTransform" (list '* double double '* '*) 20) + +(define (apply-geo-transform gt-lst pixel line) + "Apply GeoTransform to x/y coordinate. + +Parameters: + gt-lst: list of input geotransform (six doubles) + pixel: input pixel location + line: input line location." + + (cond ((not (pair? gt-lst)) + (error "input is not a list or empty")) + ((not (= 6 (length gt-lst))) + (error "insufficient number of coefficients in the list (6 doubles)")) + (else (let ((bv-geo-x (make-bytevector (sizeof double))) + (bv-geo-y (make-bytevector (sizeof double)))) + (%gdal-apply-geo-transform + (list->pointer gt-lst double) + pixel + line + (bytevector->pointer bv-geo-x) + (bytevector->pointer bv-geo-y)) + `(,(bytevector-ieee-double-native-ref bv-geo-x 0) + . + ,(bytevector-ieee-double-native-ref bv-geo-y 0)))))) + +(export apply-geo-transform) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-compose-geo-transforms + void "GDALComposeGeoTransforms" (list '* '* '*) 20) + +(define (compose-geo-transforms gt1-lst gt2-lst) + "Compose two geotransforms. + +Parameters: + gt1-lst: list of first geotransform (six doubles) + gt2-lst: list of first geotransform (six doubles)" + (cond ((not (pair? gt1-lst)) + (error "input gt1-lst is not a list or empty")) + ((not (pair? gt2-lst)) + (error "input gt2-lst is not a list or empty")) + ((not (= 6 (length gt1-lst))) + (error "insufficient number of coefficients in the list gt1-lst")) + ((not (= 6 (length gt2-lst))) + (error "insufficient number of coefficients in the list gt2-lst")) + (else (let ((bv-gt-out (make-bytevector (* 6 (sizeof double))))) + (%gdal-compose-geo-transforms + (list->pointer gt1-lst double) + (list->pointer gt2-lst double) + (bytevector->pointer bv-gt-out)) + (let ((coefs-q (make-q))) + (do ((i 0 (1+ i))) + ((> i 5)) + (enq! coefs-q (bytevector-ieee-double-native-ref + bv-gt-out + (* i (sizeof double))))) + (car coefs-q)))))) + +(export compose-geo-transforms) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-metadata-domain-list + '* "GDALGetMetadataDomainList" (list '*) 20) + +(define (get-metadata-domain-list h-object) + "Fetch list of metadata domains. + +Returns a string list of metadata domains. + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information." + (pointerpointer->string-list + (%gdal-get-metadata-domain-list h-object))) + +(export get-metadata-domain-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-metadata + '* "GDALGetMetadata" (list '* '*) 20) + +(define (get-metadata h-object domain) + "Return a string list of metadata which is owned by the object, and may +change at any time. It is formatted as a \"Name=value\" list. + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information + domain: the domain of interest. Use empty string \"\" for the default +domain." + (pointerpointer->string-list + (%gdal-get-metadata h-object (string->pointer domain)))) + +(export get-metadata) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-metadata + int "GDALSetMetadata" (list '* '* '*) 20) + +(define (set-metadata h-object metadata domain) + "Sets a string list of a metadata where each member is formatted as +a \"Name=value\". + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information + metadata: the metadata in name=value string list format to apply. + domain: the domain of interest. Use empty string \"\" for the default +domain." + (let ((result (%gdal-set-metadata + h-object + (string-list->pointerpointer metadata) + (string->pointer domain)))) + (unless (= result CE_NONE) + (error "failed to set metadata")))) + +(export set-metadata) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-close + void "GDALClose" (list '*) 20) + +(define (close-dataset h-ds) + "Close GDAL dataset. + +Parameters: + h-ds: the dataset to close." + (%gdal-close h-ds)) + +(export close-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-metadata-item + '* "GDALGetMetadataItem" (list '* '* '*) 20) + +(define (get-metadata-item h-object name domain) + "Fetch single metadata item. + +Parameters: + h-object: a handle representing various GDAL objects + name: the key for the metadata item to fetch + domain: the domain to fetch for, use \"\" for the default domain." + (let ((ptr (%gdal-get-metadata-item + h-object + (string->pointer name) + (string->pointer domain)))) + (if (null-pointer? ptr) + "" + (pointer->string ptr)))) + +(export get-metadata-item) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-metadata-item + int "GDALSetMetadataItem" (list '* '* '* '*) 20) + +(define (set-metadata-item h-object name value domain) + "Sets a single metadata item which is formatted as \"Name=value\". + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information + name: the key for the metadata item to fetch. + value: the value to assign to the key. + domain: the domain to set within, use \"\" for the default domain." + (let ((result (%gdal-set-metadata-item + h-object + (string->pointer name) + (string->pointer value) + (string->pointer domain)))) + (unless (= result CE_NONE) + (error "failed to set metadata item")))) + +(export set-metadata-item) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-description + '* "GDALGetDescription" (list '*) 20) + +(define (get-description h-object) + "Fetch object description. + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information." + (pointer->string (%gdal-get-description h-object))) + +(export get-description) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-description + void "GDALSetDescription" (list '* '*) 20) + +(define (set-description h-object description) + "Set object description. + +Parameters: + h-object: a handle representing various GDAL objects. +See https://www.gdal.org/classGDALMajorObject.html for more information. + description: new description." + (%gdal-set-description h-object (string->pointer description))) + +(export set-description) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-dataset-driver + '* "GDALGetDatasetDriver" (list '*) 20) + +(define (get-dataset-driver h-dataset) + "Fetch the driver to which this dataset relates. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-dataset-driver h-dataset)) + +(export get-dataset-driver) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-file-list + '* "GDALGetFileList" (list '*) 20) + +(define (get-file-list h-dataset) + "Fetch files forming dataset. + +Parameters: + h-dataset: a handle representing GDALDataset." + (pointerpointer->string-list (%gdal-get-file-list h-dataset))) + +(export get-file-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-x-size + int "GDALGetRasterXSize" (list '*) 20) + +(define (get-raster-x-size h-dataset) + "Fetch raster width in pixels. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-raster-x-size h-dataset)) + +(export get-raster-x-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-y-size + int "GDALGetRasterYSize" (list '*) 20) + +(define (get-raster-y-size h-dataset) + "Fetch raster height in pixels. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-raster-y-size h-dataset)) + +(export get-raster-y-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-band-x-size + int "GDALGetRasterBandXSize" (list '*) 20) + +(define (get-raster-band-x-size h-band) + "Fetch raster width in pixels for the band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-band-x-size h-band)) + +(export get-raster-band-x-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-band-y-size + int "GDALGetRasterBandYSize" (list '*) 20) + +(define (get-raster-band-y-size h-band) + "Fetch raster height in pixels for the band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-band-y-size h-band)) + +(export get-raster-band-y-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-count + int "GDALGetRasterCount" (list '*) 20) + +(define (get-raster-count h-dataset) + "Fetch the number of raster bands on this dataset. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-raster-count h-dataset)) + +(export get-raster-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-band + '* "GDALGetRasterBand" (list '* int) 20) + +(define (get-raster-band h-dataset band-id) + "Fetch a band object for a dataset. + +Parameters: + h-dataset: a handle representing GDALDataset. + band-id: the index number of the band to fetch, from 1 to get-raster-count." + (%gdal-get-raster-band h-dataset band-id)) + +(export get-raster-band) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-add-band + int "GDALAddBand" (list '* int '*) 20) + +(define (add-band h-dataset type options) + "Add a band to a dataset. + +Parameters: + h-dataset: a handle representing GDALDataset. + type: the data type of the pixels in the new band. + options: the list of NAME=VALUE option strings. The supported options are +format specific. Empty list '() may be passed by default." + (let ((result (%gdal-add-band h-dataset + type + (string-list->pointerpointer + options)))) + (unless (= result CE_NONE) + (error "failed to add band")))) + +(export add-band) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-raster-io + int "GDALRasterIO" (list '* int int int int int '* + int int int int int) 20) + +(define (raster-io h-band rw-flag x-off y-off x-size y-size data + buf-x-size buf-y-size buf-type pixel-space line-space) + "Read/write a region of image data for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + rw-flag: either GF_READ to read, or GF_WRITE to write a region of data. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + data: the bytevector buffer into which the data should be read, or from +which it should be written. This buffer must contain at least +(* buf-x-size buf-y-size) words of type buf-type. It is organized in left to +right, top to bottom pixel order. Spacing is controlled by the pixel-space, and +line-space parameters. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + pixel-space: the byte offset from the start of one pixel value in data to +the start of the next pixel value within a scanline. If defaulted (0) the size +of the datatype buf-type is used. + line-space: the byte offset from the start of one scanline in pData to the +start of the next. If defaulted (0) the size of the datatype +(* buf-type buf-x-size) is used." + (let ((result (%gdal-raster-io h-band rw-flag x-off y-off x-size y-size + (bytevector->pointer data) + buf-x-size buf-y-size buf-type + pixel-space line-space))) + (unless (= result CE_NONE) + (error "failed to read/write data for this band")))) + +(export raster-io) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-raster-io-ex + int "GDALDatasetRasterIOEx" (list '* int int int int int '* + int int int int '* int64 int64 + int64 '*) 20) + +(define (dataset-raster-io-ex h-dataset rw-flag x-off y-off x-size y-size data + buf-x-size buf-y-size buf-type band-count + band-map pixel-space line-space band-space + extra-arg) + "Read/write a region of image data for multiple bands. + +Parameters: + h-dataset: a handle representing GDALDatasetH. + rw-flag: either GF_READ to read, or GF_WRITE to write a region of data. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + data: the bytevector buffer into which the data should be read, or from +which it should be written. This buffer must contain at least +(* buf-x-size buf-y-size band-count) words of type buf-type. It is organized +in left to right, top to bottom pixel order. Spacing is controlled by the +pixel-space, and line-space parameters. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + band-count: the number of bands being read or written. + band-map: the list of band-count numbers being read/written. Note band +numbers are 1 based. This may be empty list '() to select the first band-count +bands. + pixel-space: the byte offset from the start of one pixel value in data to +the start of the next pixel value within a scanline. If defaulted (0) the size +of the datatype buf-type is used. + line-space: the byte offset from the start of one scanline in pData to the +start of the next. If defaulted (0) the size of the datatype +(* buf-type buf-x-size) is used. + band-space: the byte offset from the start of one bands data to the start +of the next. If defaulted (0) the value will be (* line-space buf-y-size) +implying band sequential organization of the data buffer. + extra-arg: (new in GDAL 2.0) pointer to a GDALRasterIOExtraArg structure +constructed with \"make-grioea\" function which creates grioea record +with additional arguments to specify resampling and progress callback, or +#f for default behaviour. The GDAL_RASTERIO_RESAMPLING configuration option can +also be defined to override the default resampling to one of BILINEAR, CUBIC, +CUBICSPLINE, LANCZOS, AVERAGE or MODE." + (let ((result (%gdal-dataset-raster-io-ex h-dataset rw-flag x-off y-off x-size + y-size (bytevector->pointer data) + buf-x-size buf-y-size buf-type + band-count + (list->pointer band-map int) + pixel-space line-space band-space + (grioea->foreign-pointer extra-arg)) + )) + (unless (= result CE_NONE) + (error "failed to read/write data for this band")))) + +(export dataset-raster-io-ex) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-raster-io + int "GDALDatasetRasterIO" (list '* int int int int int '* + int int int int '* int int int) 20) + +(define (dataset-raster-io h-dataset rw-flag x-off y-off x-size y-size data + buf-x-size buf-y-size buf-type band-count + band-map pixel-space line-space band-space) + "Read/write a region of image data for multiple bands. Use +dataset-raster-io-ex if 64 bit spacings or extra arguments (resampling +resolution, progress callback, etc. are needed). + +Parameters: + h-dataset: a handle representing GDALDatasetH. + rw-flag: either GF_READ to read, or GF_WRITE to write a region of data. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + data: the bytevector buffer into which the data should be read, or from +which it should be written. This buffer must contain at least +(* buf-x-size buf-y-size band-count) words of type buf-type. It is organized +in left to right, top to bottom pixel order. Spacing is controlled by the +pixel-space, and line-space parameters. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + band-count: the number of bands being read or written. + band-map: the list of band-count numbers being read/written. Note band +numbers are 1 based. This may be empty list '() to select the first band-count +bands. + pixel-space: the byte offset from the start of one pixel value in data to +the start of the next pixel value within a scanline. If defaulted (0) the size +of the datatype buf-type is used. + line-space: the byte offset from the start of one scanline in pData to the +start of the next. If defaulted (0) the size of the datatype +(* buf-type buf-x-size) is used. + band-space: the byte offset from the start of one bands data to the start +of the next. If defaulted (0) the value will be (* line-space buf-y-size) +implying band sequential organization of the data buffer." + (let ((result (%gdal-dataset-raster-io h-dataset rw-flag x-off y-off x-size + y-size (bytevector->pointer data) + buf-x-size buf-y-size buf-type + band-count + (list->pointer band-map int) + pixel-space line-space band-space))) + (unless (= result CE_NONE) + (error "failed to read/write data for this band")))) + +(export dataset-raster-io) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-begin-async-reader + '* "GDALBeginAsyncReader" (list '* int int int int '* int int + int int '* int int int '*) 20) + +(define (begin-async-reader h-dataset x-off y-off x-size y-size data + buf-x-size buf-y-size buf-type band-count + band-map pixel-space line-space band-space + options) + "Set up an asynchronous data request and return handle representing the +request. + +Parameters: + h-dataset: a handle representing GDALDatasetH. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + data: the bytevector buffer into which the data should be read, or from +which it should be written. This buffer must contain at least +(* buf-x-size buf-y-size band-count) words of type buf-type. It is organized +in left to right, top to bottom pixel order. Spacing is controlled by the +pixel-space, and line-space parameters. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + band-count: the number of bands being read or written. + band-map: the list of band-count numbers being read/written. Note band +numbers are 1 based. This may be empty list '() to select the first band-count +bands. + pixel-space: the byte offset from the start of one pixel value in data to +the start of the next pixel value within a scanline. If defaulted (0) the size +of the datatype buf-type is used. + line-space: the byte offset from the start of one scanline in pData to the +start of the next. If defaulted (0) the size of the datatype +(* buf-type buf-x-size) is used. + band-space: the byte offset from the start of one bands data to the start +of the next. If defaulted (0) the value will be (* line-space buf-y-size) +implying band sequential organization of the data buffer. + options: driver specific control options in a string list or empty +list '(). Consult driver documentation for options supported." + (%gdal-begin-async-reader h-dataset x-off y-off x-size y-size + (bytevector->pointer data) buf-x-size buf-y-size + buf-type band-count (list->pointer band-map int) + pixel-space line-space band-space + (string-list->pointerpointer options))) + +(export begin-async-reader) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-end-async-reader + void "GDALEndAsyncReader" (list '* '*) 20) + +(define (end-async-reader h-dataset h-async-reader) + "End asynchronous request. + +Parameters: + h-dataset: handle representing GDALDataset. + h-async-reader: handle representing async reader request." + (%gdal-end-async-reader h-dataset h-async-reader)) + +(export end-async-reader) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-raster-io-ex + int "GDALRasterIOEx" (list '* int int int int int '* + int int int int64 int64 '*) 20) + +(define (raster-io-ex h-band rw-flag x-off y-off x-size y-size data + buf-x-size buf-y-size buf-type pixel-space + line-space extra-arg) + "Read/write a region of image data for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + rw-flag: either GF_READ to read, or GF_WRITE to write a region of data. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + data: the bytevector buffer into which the data should be read, or from +which it should be written. This buffer must contain at least +(* buf-x-size buf-y-size) words of type buf-type. It is organized in left to +right, top to bottom pixel order. Spacing is controlled by the pixel-space, and +line-space parameters. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + pixel-space: the byte offset from the start of one pixel value in data to +the start of the next pixel value within a scanline. If defaulted (0) the size +of the datatype buf-type is used. + line-space: the byte offset from the start of one scanline in pData to the +start of the next. If defaulted (0) the size of the datatype +(* buf-type buf-x-size) is used. + extra-arg: (new in GDAL 2.0) pointer to a GDALRasterIOExtraArg structure +constructed with \"make-grioea\" function which creates grioea record +with additional arguments to specify resampling and progress callback, or +#f for default behaviour. The GDAL_RASTERIO_RESAMPLING configuration option can +also be defined to override the default resampling to one of BILINEAR, CUBIC, +CUBICSPLINE, LANCZOS, AVERAGE or MODE." + (let ((result (%gdal-raster-io-ex h-band rw-flag x-off y-off x-size y-size + (bytevector->pointer data) + buf-x-size buf-y-size buf-type + pixel-space line-space + (grioea->foreign-pointer extra-arg)))) + (unless (= result CE_NONE) + (error "failed to read/write data for this band")))) + +(export raster-io-ex) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-advise-read + int "GDALDatasetAdviseRead" (list '* int int int int + int int int int '* '*) 20) + +(define (dataset-advise-read h-dataset x-off y-off x-size y-size + buf-x-size buf-y-size buf-type band-count + band-map options) + "Advise driver of upcoming read requests. Return CE_FAILURE if the request +is invalid and CE_NONE if it works or is ignored. + +Parameters: + h-dataset: a handle representing GDALDatasetH. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + band-count: the number of bands being read or written. + band-map: the list of band-count numbers being read/written. Note band +numbers are 1 based. This may be empty list '() to select the first band-count +bands. + options: driver specific control options in a string list or empty +list '(). Consult driver documentation for options supported." + (%gdal-dataset-advise-read h-dataset x-off y-off x-size y-size + buf-x-size buf-y-size buf-type band-count + (list->pointer band-map int) + (string-list->pointerpointer options))) + +(export dataset-advise-read) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-projection-ref + '* "GDALGetProjectionRef" (list '*) 20) + +(define (get-projection-ref h-dataset) + "Fetch the projection definition string for this dataset. + +The returned string defines the projection coordinate system of the image in +OpenGIS WKT format. + +When a projection definition is not available an empty string is returned. + +Parameters: + h-dataset: a handle representing GDALDataset." + (pointer->string (%gdal-get-projection-ref h-dataset))) + +(export get-projection-ref) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-spatial-ref + '* "GDALGetSpatialRef" (list '*) 30) + +(define (get-spatial-ref h-dataset) + "Fetch the spatial reference for this dataset. Available since GDAL 3.0. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-spatial-ref h-dataset)) + +(export get-spatial-ref) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-projection + int "GDALSetProjection" (list '* '*) 20) + +(define (set-projection h-dataset projection) + "Set the projection reference string in OGC WKT or PROJ.4 format for this +dataset. + +Parameters: + h-dataset: a handle representing GDALDataset. + projection: projection reference string." + (let ((result (%gdal-set-projection h-dataset + (string->pointer projection)))) + (unless (= result CE_NONE) + (error "failed to set projection")))) + +(export set-projection) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-spatial-ref + int "GDALSetSpatialRef" (list '* '*) 30) + +(define (set-spatial-ref h-dataset srs) + "Set the spatial reference system for this dataset. Available since +GDAL 3.0. + +Parameters: + h-dataset: a handle representing GDALDataset. + srs: spatial reference system object. %null-pointer can potentially be +passed for drivers that support unsetting the SRS." + (let ((result (%gdal-set-spatial-ref h-dataset srs))) + (unless (= result CE_NONE) + (error "failed to set spatial reference")))) + +(export set-spatial-ref) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-geo-transform + int "GDALGetGeoTransform" (list '* '*) 20) + +(define (get-geo-transform h-dataset) + "Return a list of transformation coefficients. + +Parameters: + h-dataset: a handle representing GDALDataset." + + (let* ((bv-gp-out (make-bytevector (* 6 (sizeof double)))) + (coef-max-index 5) + (result (%gdal-get-geo-transform + h-dataset + (bytevector->pointer bv-gp-out)))) + (if (= result CE_FAILURE) + (error "failed to fetch transform") + (let ((coefs-q (make-q))) + (do ((i 0 (1+ i))) + ((> i coef-max-index)) + (enq! coefs-q (bytevector-ieee-double-native-ref + bv-gp-out + (* i (sizeof double))))) + (car coefs-q))))) + +(export get-geo-transform) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-geo-transform + int "GDALSetGeoTransform" (list '* '*) 20) + +(define (set-geo-transform h-dataset transform) + "Set the affine transformation coefficients. + +Parameters: + h-dataset: a handle representing GDALDataset. + transform: a list of transformation coefficients." + (cond ((not (pair? transform)) + (error "transform is not a list or empty")) + ((not (= 6 (length transform))) + (error "insufficient number of coefficients in the list (6 doubles)")) + (else (let ((result (%gdal-set-geo-transform + h-dataset + (list->pointer transform double)))) + (unless (= result CE_NONE) + (error "failed to set transform")))))) + +(export set-geo-transform) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-gcp-count + int "GDALGetGCPCount" (list '*) 20) + +(define (get-gcp-count h-dataset) + "Return number of GCPs for this dataset. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-gcp-count h-dataset)) + +(export get-gcp-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-gcp-projection + '* "GDALGetGCPProjection" (list '*) 20) + +(define (get-gcp-projection h-dataset) + "Return internal projection string for GCPs or empty string if there are +no GCPs. + +Parameters: + h-dataset: a handle representing GDALDataset." + (pointer->string (%gdal-get-gcp-projection h-dataset))) + +(export get-gcp-projection) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-gcp-spatial-ref + '* "GDALGetGCPSpatialRef" (list '*) 30) + +(define (get-gcp-spatial-ref h-dataset) + "Return a pointer to an internal object of output spatial reference system +for GCPs. Available since GDAL 3.0. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-gcp-spatial-ref h-dataset)) + +(export get-gcp-spatial-ref) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-gcps + '* "GDALGetGCPs" (list '*) 20) + +(define (get-gcps h-dataset) + "Return a list of internal GCP structure. + +Parameters: + h-dataset: a handle representing GDALDataset." + (pointer->gcp-list (%gdal-get-gcps h-dataset) (get-gcp-count h-dataset))) + +(export get-gcps) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-gcps + int "GDALSetGCPs" (list '* int '* '*) 20) + +(define* (set-gcps h-dataset gcp-lst #:key (projection "")) + "Assign GCPs. + +Parameters: + h-dataset: a handle representing GDALDataset. + gc-lst: list of GCP structures where each structure is created by +\"make-gcp\" function. + projection (optional): string of the new OGC WKT coordinate system to +assign for the GCP output coordinates." + (let ((result (%gdal-set-gcps h-dataset + (length gcp-lst) + (gcp-list->pointer gcp-lst) + (string->pointer projection)))) + (unless (= result CE_NONE) + (error "failed to set GCPs")))) + +(export set-gcps) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-gcps2 + int "GDALSetGCPs2" (list '* int '* '*) 30) + +(define* (set-gcps2 h-dataset gcp-lst #:key (spatial-ref %null-pointer)) + "Assign GCPs. Available since GDAL 3.0. + +Parameters: + h-dataset: a handle representing GDALDataset. + gc-lst: list of GCP structures where each structure is created by +\"make-gcp\" function. + spatial-ref (optional): the new coordinate reference system to assign for +the GCP output coordinates." + (let ((result (%gdal-set-gcps2 h-dataset + (length gcp-lst) + (gcp-list->pointer gcp-lst) + spatial-ref))) + (unless (= result CE_NONE) + (error "failed to set GCPs")))) + +(export set-gcps2) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-internal-handle + '* "GDALGetInternalHandle" (list '* '*) 20) + +(define (get-internal-handle h-dataset request) + "Fetch a format specific internally meaningful handle. + +Parameters: + h-dataset: a handle representing GDALDataset. + request: the handle name desired. The meaningful names will be specific to +the file format." + (%gdal-get-internal-handle h-dataset (string->pointer request))) + +(export get-internal-handle) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-reference-dataset + int "GDALReferenceDataset" (list '*) 20) + +(define (reference-dataset h-dataset) + "Add one to dataset reference count. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-reference-dataset h-dataset)) + +(export reference-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dereference-dataset + int "GDALDereferenceDataset" (list '*) 20) + +(define (dereference-dataset h-dataset) + "Subtract one from dataset reference count. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-dereference-dataset h-dataset)) + +(export dereference-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-release-dataset + int "GDALReleaseDataset" (list '*) 20) + +(define (release-dataset h-dataset) + "Drop a reference to this object, and destroy if no longer referenced. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-release-dataset h-dataset)) + +(export release-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-build-overviews + int "GDALBuildOverviews" (list '* '* int '* int '* '* '*) 20) + +(define* (build-overviews h-dataset resampling overview-list band-list + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Build raster overview(s). + +Parameters: + h-dataset: a handle representing GDALDatasetH. + resampling: one of GRIORAv2 enums controlling the downsampling method +applied. + overview-list: the list of overview decimation factors to build, or '() to +clean overviews. + band-list: list of band numbers to build overviews. Build for all bands if +this is '(). + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let ((result (%gdal-build-overviews h-dataset + (string->pointer (assv-ref + *grioeav2-to-string* resampling)) + (length overview-list) + (list->pointer overview-list int) + (length band-list) + (list->pointer band-list int) + (gdal-progress-func progress-callback) + progress-data))) + (when (= result CE_FAILURE) + (error "failed to build overview")))) + +(export build-overviews) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-open-datasets + void "GDALGetOpenDatasets" (list '* '*) 20) + +(define (get-open-datasets) + "Return a list of all open GDAL dataset handles." + (let ((bv-ds (make-bytevector (sizeof '*))) + (bv-count (make-bytevector (sizeof '*)))) + (%gdal-get-open-datasets (bytevector->pointer bv-ds) + (bytevector->pointer bv-count)) + (pointerpointer->list (bytevector->pointer bv-ds) + dereference-pointer + (bytevector-sint-ref + bv-count 0 + (native-endianness) + (sizeof int))))) + +(export get-open-datasets) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-access + int "GDALGetAccess" (list '*) 20) + +(define (get-access h-dataset) + "Return access flag. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-get-access h-dataset)) +(export get-access) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-flush-cache + void "GDALFlushCache" (list '*) 20) + +(define (flush-cache h-dataset) + "Flush all write cached data to disk. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-flush-cache h-dataset)) + +(export flush-cache) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-create-dataset-mask-band + int "GDALCreateDatasetMaskBand" (list '* int) 20) + +(define (create-dataset-mask-band h-dataset flags) + "Adds a mask band to the dataset. + +Parameters: + h-dataset: a handle representing GDALDataset. + flags: 0 or combination of GMF_PER_DATASET / GMF_ALPHA. GMF_PER_DATASET +will be always set, even if not explicitly specified." + (let ((result (%gdal-create-dataset-mask-band h-dataset flags))) + (unless (= result CE_NONE) + (error "failed to create mask band")))) + +(export create-dataset-mask-band) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-copy-whole-raster + int "GDALDatasetCopyWholeRaster" (list '* '* '* '* '*) 20) + +(define* (dataset-copy-whole-raster src-dataset dst-dataset options + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Copy all dataset raster data. + +Currently the only options value supported are : + + \"INTERLEAVE=PIXEL\" to force pixel interleaved operation + \"COMPRESSED=YES\" to force alignment on target dataset block sizes to +achieve best compression. + \"SKIP_HOLES=YES\" to skip chunks for which \"get-data-coverage-status\" +returns GDAL_DATA_COVERAGE_STATUS_EMPTY (GDAL >= 2.2) + +Parameters: + src-dataset: the source dataset + dst-dataset: the destination dataset. + options: a list of strings for transfer hints in Name=Value format. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let ((result (%gdal-dataset-copy-whole-raster src-dataset + dst-dataset + (string-list->pointerpointer + options) + (gdal-progress-func + progress-callback) + progress-data))) + (unless (= result CE_NONE) + (error "failed to copy raster dataset")))) + +(export dataset-copy-whole-raster) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-raster-band-copy-whole-raster + int "GDALRasterBandCopyWholeRaster" (list '* '* '* '* '*) 20) + +(define* (raster-band-copy-whole-raster src-band dst-band options + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Copy a whole raster band. + +Currently the only options value supported are : + + \"COMPRESSED=YES\" to force alignment on target dataset block sizes to +achieve best compression. + \"SKIP_HOLES=YES\" to skip chunks for which \"get-data-coverage-status\" +returns GDAL_DATA_COVERAGE_STATUS_EMPTY (GDAL >= 2.2) + +Parameters: + src-band: the source band. + dst-band: the destination band. + options: a list of strings for transfer hints in Name=Value format. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let ((result (%gdal-raster-band-copy-whole-raster + src-band + dst-band + (string-list->pointerpointer options) + (gdal-progress-func progress-callback) + progress-data))) + (unless (= result CE_NONE) + (error "failed to copy raster band")))) + +(export raster-band-copy-whole-raster) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-regenerage-overviews + int "GDALRegenerateOverviews" (list '* int '* '* '* '*) 20) + +(define* (regenerage-overviews src-band band-list resampling + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Generate downsampled overviews. + +Parameters: + src-band: the source (base level) band. + band-list: the list of downsampled bands to be generated. + resampling: one of GRIORAv2 enums controlling the downsampling method +applied. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let ((result (%gdal-regenerage-overviews + src-band + (length band-list) + (list->pointer band-list '*) + (string->pointer (assv-ref + *grioeav2-to-string* resampling)) + (gdal-progress-func progress-callback) + progress-data))) + (when (= result CE_FAILURE) + (error "failed to regenerate overview")))) + +(export regenerage-overviews) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-get-layer-count + int "GDALDatasetGetLayerCount" (list '*) 20) + +(define (dataset-get-layer-count h-dataset) + "Get the number of layers in this dataset. + +Parameters: + h-dataset: a dataset handle." + (%gdal-dataset-get-layer-count h-dataset)) + +(export dataset-get-layer-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-get-layer + '* "GDALDatasetGetLayer" (list '* int) 20) + +(define (dataset-get-layer h-dataset layer) + "Fetch a layer by index. Return the layer handle or %null-pointer if layer +is out of range or an error occurs. + +Parameters: + h-dataset: a dataset handle. + layer: a layer number between 0 and (1- dataset-get-layer-count)" + (%gdal-dataset-get-layer h-dataset layer)) + +(export dataset-get-layer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-get-layer-by-name + '* "GDALDatasetGetLayerByName" (list '* '*) 20) + +(define (dataset-get-layer-by-name h-dataset name) + "Fetch a layer by name. Return the layer handle or %null-pointer if layer +is not found or an error occurs. + +Parameters: + h-dataset: a dataset handle. + name: the layer name of the layer to fetch." + (%gdal-dataset-get-layer-by-name h-dataset (string->pointer name))) + +(export dataset-get-layer-by-name) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-delete-layer + int "GDALDatasetDeleteLayer" (list '* int) 20) + +(define (dataset-delete-layer h-dataset layer) + "Delete the indicated layer from the datasource. + +Parameters: + h-dataset: a dataset handle. + layer: the index of the layer to delete." + (let ((result (%gdal-dataset-delete-layer h-dataset layer))) + (unless (= result CE_NONE) + (error "failed to delete layer")))) + +(export dataset-delete-layer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-create-layer + '* "GDALDatasetCreateLayer" (list '* '* '* int '*) 20) + +(define* (dataset-create-layer h-dataset name + #:key (spatial-ref %null-pointer) + (type 0) + (options '())) + "This function attempts to create a new layer on the dataset with the +indicated name, coordinate system, geometry type. Return an handle to the layer +or %null-pointer is returned on failure. + +Parameters: + h-dataset: a dataset handle. + name: the name for the new layer. This should ideally not match any +existing layer on the datasource. + spatial-ref (optional): the coordinate system handle to use for the new +layer. Default is %null-pointer where no coordinate system is available. + type (optional): the geometry type for the layer. Default is WKB_UNKNOWN +providing no constraints on the types geometry to be written. Use the module +(gdal ogr) to access WKB enums. + options (optional): a list of strings in name=value format. Default is +empty list. Options are driver specific" + (%gdal-dataset-create-layer h-dataset + (string->pointer name) + spatial-ref + type + (string-list->pointerpointer options))) + +(export dataset-create-layer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-copy-layer + '* "GDALDatasetCopyLayer" (list '* '* '* '*) 20) + +(define* (dataset-copy-layer h-dataset layer name + #:key (options '())) + "Duplicate an existing layer. Return an handle to the layer or %null-pointer +if an error occurs. + +Parameters: + h-dataset: a dataset handle. + layer: source layer. + name: the name for the new layer. This should ideally not match any +existing layer on the datasource. + options (optional): a list of strings in name=value format. Default is +empty list. Options are driver specific" + (%gdal-dataset-copy-layer h-dataset + layer + (string->pointer name) + (string-list->pointerpointer options))) + +(export dataset-copy-layer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-reset-reading + void "GDALDatasetResetReading" (list '*) 20) + +(define (dataset-reset-reading h-dataset) + "Reset feature reading to start on the first feature. + +Parameters: + h-dataset: a dataset handle." + (%gdal-dataset-reset-reading h-dataset)) + +(export dataset-reset-reading) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-get-next-feature + '* "GDALDatasetGetNextFeature" (list '* '* '* '* '*) 20) + +(define* (dataset-get-next-feature h-dataset #:key (progress-callback '()) + (progress-data %null-pointer)) + "Fetch the next available feature from this dataset. Return multiple values +of feature in a list, belonging layer pointer which the object belongs to and +a double variable for the precentage progress in [0, 1] range, respectively. +Otherwise returns empty list if no more features are available. + +Parameters: + h-dataset: a dataset handle. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let* ((layer (make-bytevector (sizeof '*))) + (progress (make-bytevector (sizeof double))) + (result (%gdal-dataset-get-next-feature + h-dataset + (bytevector->pointer layer) + (bytevector->pointer progress) + (gdal-progress-func progress-callback) + progress-data))) + (if (null-pointer? result) + '() + (list (dereference-pointer (bytevector->pointer layer)) + (bytevector-ieee-double-ref progress 0 (native-endianness)))))) + +(export dataset-get-next-feature) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-test-capability + int "GDALDatasetTestCapability" (list '* '*) 20) + +(define (dataset-test-capability h-dataset cap) + "Test if capability is available. Return #t if capability available +otherwise #f. + +- ODSC_CREATE_LAYER: True if this datasource can create new layers. +- ODSC_DELETE_LAYER: True if this datasource can delete existing layers. +- ODSC_CREATE_GEOM_FIELD_AFTER_CREATE_LAYER: True if the layers of this +datasource support create-geom-field just after layer creation. +- ODSC_CURVE_GEOMETRIES: True if this datasource supports curve geometries. +- ODSC_TRANSACTIONS: True if this datasource supports (efficient) transactions. +- ODSC_EMULATED_TRANSACTIONS: True if this datasource supports transactions +through emulation. +- ODSC_RANDOM_LAYER_READ: True if this datasource has a dedicated +get-next-feature implementation, potentially returning features from layers in +a non sequential way. +- ODSC_RANDOM_LAYER_WRITE: True if this datasource supports calling +create-feature on layers in a non sequential way. + +Parameters: + h-dataset: a dataset handle. + cap: ODCS enum for the capability to test." + (c-bool->boolean (%gdal-dataset-test-capability h-dataset + (string->pointer cap)))) + +(export dataset-test-capability) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-execute-sql + '* "GDALDatasetExecuteSQL" (list '* '* '* '*) 20) + +(define* (dataset-execute-sql h-dataset statement #:key + (spatial-filter %null-pointer) + (dialect %null-pointer)) + "Execute an SQL statement against the data store. Return a pointer +of an OGRLayer containing the results of the query. Deallocate with +\"release-result-set\". + +Parameters: + h-dataset: the dataset handle. + statement: the SQL statement to execute. + spatial-filter: geometry which represents a spatial filter. Default is +%null-pointer. + dialect: a string that allows control of the statement dialect. By default +the OGR SQL engine will be used." + (%gdal-dataset-execute-sql h-dataset + (string->pointer statement) + spatial-filter + (if (null-pointer? dialect) + dialect + (string->pointer dialect)))) + +(export dataset-execute-sql) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-release-result-set + void "GDALDatasetReleaseResultSet" (list '* '*) 20) + +(define (dataset-release-result-set h-dataset h-layer) + "Release results of dataset-execute-sql. + +Parameters: + h-dataset: a dataset handle. + h-layer: the result of a previous dataset-execute-sql call." + (%gdal-dataset-release-result-set h-dataset h-layer)) + +(export dataset-release-result-set) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-get-style-table + '* "GDALDatasetGetStyleTable" (list '*) 20) + +(define (dataset-get-style-table h-dataset) + "Return the OGRStyleTableH handle of dataset style table which should not +be modified or freed by the caller. + +Parameters: + h-dataset: a dataset handle." + (%gdal-dataset-get-style-table h-dataset)) + +(export dataset-get-style-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-set-style-table-directly + void "GDALDatasetSetStyleTableDirectly" (list '* '*) 20) + +(define (dataset-set-style-table-directly h-dataset h-style-table) + "Set dataset style table. + +Parameters: + h-dataset: a dataset handle. + h-style-table: the style table handle to set." + (%gdal-dataset-set-style-table-directly h-dataset h-style-table)) + +(export dataset-set-style-table-directly) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-set-style-table + void "GDALDatasetSetStyleTable" (list '* '*) 20) + +(define (dataset-set-style-table h-dataset h-style-table) + "Set dataset style table. This function operate exactly as +dataset-set-style-table-directly except that it assumes ownership of the +passed table. + +Parameters: + h-dataset: a dataset handle. + h-style-table: the style table handle to set." + (%gdal-dataset-set-style-table h-dataset h-style-table)) + +(export dataset-set-style-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-start-transaction + int "GDALDatasetStartTransaction" (list '* int) 20) + +(define (dataset-start-transaction h-dataset force) + "For datasources which support transactions, dataset-start-transaction +creates a transaction. Return OGRERR_NONE on success. If starting the +transaction fails, will return OGRERR_FAILURE. Datasources which do not +support transactions will always return OGRERR_UNSUPPORTED_OPERATION. + +Parameters: + h-dataset: a handle representing GDALDataset. + force: a boolean value that can be set to #t if an emulation, possibly +slow, of a transaction mechanism is acceptable." + (%gdal-dataset-start-transaction h-dataset + (boolean->c-bool force))) + +(export dataset-start-transaction) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-commit-transaction + int "GDALDatasetCommitTransaction" (list '*) 20) + +(define (dataset-commit-transaction h-dataset) + "For datasources which support transactions, dataset-commit-transaction +commits a transaction. Return OGRERR_NONE on success. If no transaction is +active, or the commit fails, will return OGRERR_FAILURE. Datasources which do +not support transactions will always return OGRERR_UNSUPPORTED_OPERATION. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-dataset-commit-transaction h-dataset)) + +(export dataset-commit-transaction) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-dataset-rollback-transaction + int "GDALDatasetRollbackTransaction" (list '*) 20) + +(define (dataset-rollback-transaction h-dataset) + "For datasources which support transactions, dataset-rollback-transaction +will roll back a datasource to its state before the start of the current +transaction. Return OGRERR_NONE on success. If no transaction is active, or +the rollback fails, will return OGRERR_FAILURE. Datasources which do not +support transactions will always return OGRERR_UNSUPPORTED_OPERATION. + +Parameters: + h-dataset: a handle representing GDALDataset." + (%gdal-dataset-rollback-transaction h-dataset)) + +(export dataset-rollback-transaction) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-data-type + int "GDALGetRasterDataType" (list '*) 20) + +(define (get-raster-data-type h-band) + "Fetch the pixel data type for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-data-type h-band)) + +(export get-raster-data-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-block-size + void "GDALGetBlockSize" (list '* '* '*) 20) + +(define (get-block-size h-band) + "Fetch the \"natural\" block size of this band as values of x size and +y size, respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-x-size (make-bytevector (sizeof int))) + (bv-y-size (make-bytevector (sizeof int)))) + (%gdal-get-block-size h-band + (bytevector->pointer bv-x-size) + (bytevector->pointer bv-y-size)) + (values + (bytevector-sint-ref bv-x-size 0 (native-endianness) (sizeof int)) + (bytevector-sint-ref bv-y-size 0 (native-endianness) (sizeof int))))) + +(export get-block-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-actual-block-size + int "GDALGetActualBlockSize" (list '* int int '* '*) 20) + +(define (get-actual-block-size h-band x-block-off y-block-off) + "Retrieve the actual block size for a given block offset as values of the +number of valid pixels in the x direction and y direction, respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH. + x-block-off: the horizontal block offset for which to calculate the +number of valid pixels, with zero indicating the left most block, 1 the next +block and so forth. + y-block-off: the vertical block offset, with zero indicating the left most +block, 1 the next block and so forth." + (let* ((bv-x-size (make-bytevector (sizeof int))) + (bv-y-size (make-bytevector (sizeof int)))) + (%gdal-get-actual-block-size h-band x-block-off y-block-off + (bytevector->pointer bv-x-size) + (bytevector->pointer bv-y-size)) + (values + (bytevector-sint-ref bv-x-size 0 (native-endianness) (sizeof int)) + (bytevector-sint-ref bv-y-size 0 (native-endianness) (sizeof int))))) + +(export get-actual-block-size) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-raster-advise-read + int "GDALRasterAdviseRead" (list '* int int int int int int int '*) 20) + +(define (raster-advise-read h-band x-off y-off x-size y-size + buf-x-size buf-y-size buf-type options) + "Advise driver of upcoming read requests. Return CE_FAILURE if the request +is invalid and CE_NONE if it works or is ignored. + +Parameters: + h-band: a handle representing GDALRasterBandH. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + buf-x-size: the width of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-y-size: the height of the buffer image into which the desired region is +to be read, or from which it is to be written. + buf-type: the type of the pixel values to be returned. The pixel values +will automatically be translated to/from the GDALRasterBand data type as needed. + options: driver specific control options in a string list or empty +list '(). Consult driver documentation for options supported." + (%gdal-raster-advise-read h-band x-off y-off x-size y-size + buf-x-size buf-y-size buf-type + (string-list->pointerpointer options))) + +(export raster-advise-read) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-read-block + int "GDALReadBlock" (list '* int int '*) 20) + +(define (read-block h-band x-block-off y-block-off data) + "Read a block of image data efficiently. + +Parameters: + h-band: a handle representing GDALRasterBandH. + x-block-off: the horizontal block offset, with zero indicating the left +most block, 1 the next block and so forth + y-block-off: the vertical block offset, with zero indicating the top most +block, 1 the next block and so forth. + data: the bytevector buffer into which the data should be read. The buffer +must be large enough to hold (* block-x-size block-y-size) words of type +raster-data-type." + (let ((result (%gdal-read-block h-band x-block-off y-block-off + (bytevector->pointer data)))) + (unless (= result CE_NONE) + (error "failed to read a block of data for this band")))) + +(export read-block) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-write-block + int "GDALWriteBlock" (list '* int int '*) 20) + +(define (write-block h-band x-block-off y-block-off data) + "Write a block of image data efficiently. + +Parameters: + h-band: a handle representing GDALRasterBandH. + x-block-off: the horizontal block offset, with zero indicating the left +most block, 1 the next block and so forth + y-block-off: the vertical block offset, with zero indicating the top most +block, 1 the next block and so forth. + data: the bytevector buffer from which the data will be written. The buffer +must be large enough to hold (* block-x-size block-y-size) words of type +raster-data-type." + (let ((result (%gdal-write-block h-band x-block-off y-block-off + (bytevector->pointer data)))) + (unless (= result CE_NONE) + (error "failed to write a block of data for this band")))) + +(export write-block) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-access + int "GDALGetRasterAccess" (list '*) 20) + +(define (get-raster-access h-band) + "Find out if we have update permission for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-access h-band)) + +(export get-raster-access) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-band-number + int "GDALGetBandNumber" (list '*) 20) + +(define (get-band-number h-band) + "Fetch the band number for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-band-number h-band)) + +(export get-band-number) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-band-dataset + '* "GDALGetBandDataset" (list '*) 20) + +(define (get-band-dataset h-band) + "Fetch the owning dataset handle for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-band-dataset h-band)) + +(export get-band-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-color-interpretation + '* "GDALGetRasterColorInterpretation" (list '*) 20) + +(define (get-raster-color-interpretation h-band) + "Fetch the handle of GDALColorInterp to figure out how this band is +interpreted as color. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-color-interpretation h-band)) + +(export get-raster-color-interpretation) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-color-interpretation + int "GDALSetRasterColorInterpretation" (list '* '*) 20) + +(define (set-raster-color-interpretation h-band color-interp) + "Set color interpretation of a band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + color-interp: a handle of the new color interpretation to apply to this +band." + (let ((result (%gdal-set-raster-color-interpretation h-band + color-interp))) + (unless (= result CE_NONE) + (error "failed to set color interpretation")))) + +(export set-raster-color-interpretation) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-color-table + '* "GDALGetRasterColorTable" (list '*) 20) + +(define (get-raster-color-table h-band) + "Fetch the color table associated with band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-raster-color-table h-band)) + +(export get-raster-color-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-color-table + int "GDALSetRasterColorTable" (list '* '*) 20) + +(define (set-raster-color-table h-band color-table) + "Set the raster color table of a band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + color-table: the color table to apply. This may be %null-pointer to clear +the color table (where supported)." + (let ((result (%gdal-set-raster-color-table h-band + color-table))) + (unless (= result CE_NONE) + (error "failed to set color table")))) + +(export set-raster-color-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-has-arbitrary-overviews + int "GDALHasArbitraryOverviews" (list '*) 20) + +(define (has-arbitrary-overviews h-band) + "Check for arbitrary overviews. Return #t if arbitrary overviews available +(efficiently), otherwise #f. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (c-bool->boolean (%gdal-has-arbitrary-overviews h-band))) + +(export has-arbitrary-overviews) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-overview-count + int "GDALGetOverviewCount" (list '*) 20) + +(define (get-overview-count h-band) + "Return the number of overview layers available. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-get-overview-count h-band)) + +(export get-overview-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-overview + '* "GDALGetOverview" (list '* int) 20) + +(define (get-overview h-band id) + "Fetch overview raster band object. + +Parameters: + h-band: a handle representing GDALRasterBandH. + id: overview index between 0 and (- (get-overview-count h-band) 1)" + (%gdal-get-overview h-band id)) + +(export get-overview) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-no-data-value + double "GDALGetRasterNoDataValue" (list '* '*) 20) + +(define (get-raster-no-data-value h-band) + "Fetch the no data value as double for this band, or report an error +to indicate if no value is actually associated with this layer. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-success (make-bytevector (sizeof int))) + (no-data (%gdal-get-raster-no-data-value + h-band + (bytevector->pointer bv-success)))) + (if (c-bool->boolean (bytevector-sint-ref bv-success + 0 + (native-endianness) + (sizeof int))) + no-data + (error "failed to fetch no data value")))) + +(export get-raster-no-data-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-no-data-value + int "GDALSetRasterNoDataValue" (list '* double) 20) + +(define (set-raster-no-data-value h-band no-data) + "Set the no data value for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + no-data: the value to set." + (let* ((result (%gdal-set-raster-no-data-value + h-band + no-data))) + (unless (= result CE_NONE) + (error "failed to set no data")))) + +(export set-raster-no-data-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-delete-raster-no-data-value + int "GDALDeleteRasterNoDataValue" (list '*) 20) + +(define (delete-raster-no-data-value h-band) + "Remove the no data value for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let ((result (%gdal-delete-raster-no-data-value h-band))) + (unless (= result CE_NONE) + (error "failed to delete no-data value")))) + +(export delete-raster-no-data-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-category-names + '* "GDALGetRasterCategoryNames" (list '*) 20) + +(define (get-raster-category-names h-band) + "Fetch the list of category names for this raster as a list of strings. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (pointerpointer->string-list (%gdal-get-raster-category-names h-band))) + +(export get-raster-category-names) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-category-names + int "GDALSetRasterCategoryNames" (list '* '*) 20) + +(define* (set-raster-category-names h-band #:key (category-names '())) + "Set the category names for this band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + category-names (optional): a list of strings for category names. Default is +empty list '() that clears the existing list." + (let ((result (%gdal-set-raster-category-names + h-band + (string-list->pointerpointer category-names)))) + (unless (= result CE_NONE) + (error "failed to set category names")))) + +(export set-raster-category-names) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-minimum + double "GDALGetRasterMinimum" (list '* '*) 20) + +(define (get-raster-minimum h-band) + "Return values of minimum value for this band (excluding no data pixels) and +a boolean, to indicate if the returned value is a tight minimum or not, +respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-success (make-bytevector (sizeof int))) + (minimum (%gdal-get-raster-minimum + h-band + (bytevector->pointer bv-success)))) + (values minimum (c-bool->boolean + (bytevector-sint-ref bv-success + 0 + (native-endianness) + (sizeof int)))))) + +(export get-raster-minimum) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-maximum + double "GDALGetRasterMaximum" (list '* '*) 20) + +(define (get-raster-maximum h-band) + "Return values of maximum value for this band (excluding no data pixels) and +a boolean, to indicate if the returned value is a tight maximum or not, +respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-success (make-bytevector (sizeof int))) + (maximum (%gdal-get-raster-maximum + h-band + (bytevector->pointer bv-success)))) + (values maximum (c-bool->boolean + (bytevector-sint-ref bv-success + 0 + (native-endianness) + (sizeof int)))))) + +(export get-raster-maximum) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-statistics + int "GDALGetRasterStatistics" (list '* int int '* '* '* '*) 20) + +(define (get-raster-statistics h-band approx-ok force) + "Fetch image statistics as multiple values of minimum, maximum, mean and +standard deviation, respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH. + approx-ok: a boolean value. If #t statistics may be computed based on +overviews or a subset of all tiles. + force: a boolean value. if #f statistics will only be returned if it can +be done without rescanning the image." + (let* ((bv-min (make-bytevector (sizeof double))) + (bv-max (make-bytevector (sizeof double))) + (bv-mean (make-bytevector (sizeof double))) + (bv-std-dev (make-bytevector (sizeof double))) + (result (%gdal-get-raster-statistics + h-band + (boolean->c-bool approx-ok) + (boolean->c-bool force) + (bytevector->pointer bv-min) + (bytevector->pointer bv-max) + (bytevector->pointer bv-mean) + (bytevector->pointer bv-std-dev)))) + (if (= result CE_NONE) + (values (bytevector-ieee-double-ref bv-min 0 (native-endianness)) + (bytevector-ieee-double-ref bv-max 0 (native-endianness)) + (bytevector-ieee-double-ref bv-mean 0 (native-endianness)) + (bytevector-ieee-double-ref bv-std-dev 0 (native-endianness))) + (error "failed to compute raster statistics")))) + +(export get-raster-statistics) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-compute-raster-statistics + int "GDALComputeRasterStatistics" (list '* int '* '* '* '* '* '*) 20) + +(define* (compute-raster-statistics h-band approx-ok + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Compute image statistics as multiple values of minimum, maximum, mean and +standard deviation, respectively. Once computed, the statistics will generally +be \"set\" back on the raster band using \"set-render-statistics\". + +Parameters: + h-band: a handle representing GDALRasterBandH. + approx-ok: a boolean value. If #t statistics may be computed based on +overviews or a subset of all tiles. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let* ((bv-min (make-bytevector (sizeof double))) + (bv-max (make-bytevector (sizeof double))) + (bv-mean (make-bytevector (sizeof double))) + (bv-std-dev (make-bytevector (sizeof double))) + (result (%gdal-compute-raster-statistics + h-band + (boolean->c-bool approx-ok) + (bytevector->pointer bv-min) + (bytevector->pointer bv-max) + (bytevector->pointer bv-mean) + (bytevector->pointer bv-std-dev) + (gdal-progress-func progress-callback) + progress-data))) + (if (= result CE_NONE) + (values (bytevector-ieee-double-ref bv-min 0 (native-endianness)) + (bytevector-ieee-double-ref bv-max 0 (native-endianness)) + (bytevector-ieee-double-ref bv-mean 0 (native-endianness)) + (bytevector-ieee-double-ref bv-std-dev 0 (native-endianness))) + (error "failed to compute raster statistics")))) + +(export compute-raster-statistics) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-statistics + int "GDALSetRasterStatistics" (list '* double double double double) 20) + +(define (set-raster-statistics h-band minimum maximum mean std-dev) + "Set image statistics on band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + minimum: minimum pixel value. + maximum: maximum pixel value. + mean: mean (average) of all pixel values. + std-dev: standard deviation of all pixel values." + (let ((result (%gdal-set-raster-statistics + h-band + minimum + maximum + mean + std-dev))) + (unless (= result CE_NONE) + (error "failed to set raster statistics")))) + +(export set-raster-statistics) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-raster-band-as-md-array + '* "GDALRasterBandAsMDArray" (list '*) 31) + +(define (raster-band-as-md-array h-band) + "Return a view of this raster band as a 2D multidimensional GDALMDArray. +The returned pointer must be released with \"md-array-release\". + +Parameters: + h-band: a handle representing GDALRasterBandH." + (%gdal-raster-band-as-md-array h-band)) + +(export raster-band-as-md-array) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-unit-type + '* "GDALGetRasterUnitType" (list '*) 20) + +(define (get-raster-unit-type h-band) + "Return raster unit type as a string. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (pointer->string (%gdal-get-raster-unit-type h-band))) + +(export get-raster-unit-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-unit-type + int "GDALSetRasterUnitType" (list '* '*) 18) + +(define (set-raster-unit-type h-band new-value) + "Set unit type. + +Parameters: + h-band: a handle representing GDALRasterBandH. + new-value: the new unit type value." + (unless (= CE_NONE (%gdal-set-raster-unit-type + h-band + (string->pointer new-value))) + (error "failed to set raster unit type"))) + +(export set-raster-unit-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-offset + double "GDALGetRasterOffset" (list '* '*) 20) + +(define (get-raster-offset h-band) + "Fetch the raster value offset. + + Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-success (make-bytevector (sizeof int))) + (offset (%gdal-get-raster-offset + h-band + (bytevector->pointer bv-success)))) + (if (c-bool->boolean (bytevector-sint-ref bv-success + 0 + (native-endianness) + (sizeof int))) + offset + (error "failed to get raster offset")))) + +(export get-raster-offset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-offset + int "GDALSetRasterOffset" (list '* double) 20) + +(define (set-raster-offset h-band new-offset) + "Set scaling offset. + +Parameters: + h-band: a handle representing GDALRasterBandH. + new-offset: the new offset." + (unless (= CE_NONE (%gdal-set-raster-offset + h-band + new-offset)) + (error "failed to set raster offset"))) + +(export set-raster-offset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-scale + double "GDALGetRasterScale" (list '* '*) 20) + +(define (get-raster-scale h-band) + "Fetch the raster value scale. + + Parameters: + h-band: a handle representing GDALRasterBandH." + (let* ((bv-success (make-bytevector (sizeof int))) + (scale (%gdal-get-raster-scale + h-band + (bytevector->pointer bv-success)))) + (if (c-bool->boolean (bytevector-sint-ref bv-success + 0 + (native-endianness) + (sizeof int))) + scale + (error "failed to get raster scale")))) + +(export get-raster-scale) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-raster-scale + int "GDALSetRasterScale" (list '* double) 20) + +(define (set-raster-scale h-band new-scale) + "Set scaling ratio. + +Parameters: + h-band: a handle representing GDALRasterBandH. + new-scale: the new scale." + (unless (= CE_NONE (%gdal-set-raster-scale + h-band + new-scale)) + (error "failed to set raster scale"))) + +(export set-raster-scale) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-compute-raster-min-max + void "GDALComputeRasterMinMax" (list '* int '*) 20) + +(define (compute-raster-min-max h-band approx-ok) + "Compute the min/max values for a band and return as values with minimum +and maximum, respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH. + approx-ok: #t if an approximate (faster) answer is OK, otherwise #f." + (let ((bv-minmax (make-bytevector (* 2 (sizeof double))))) + (%gdal-compute-raster-min-max h-band + (boolean->c-bool approx-ok) + (bytevector->pointer bv-minmax)) + (values + (bytevector-ieee-double-ref bv-minmax + 0 + (native-endianness)) + (bytevector-ieee-double-ref bv-minmax + (sizeof double) + (native-endianness))))) + +(export compute-raster-min-max) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-flush-raster-cache + int "GDALFlushRasterCache" (list '*) 20) + +(define (flush-raster-cache h-band) + "Flush raster data cache. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (unless (= CE_NONE (%gdal-flush-raster-cache h-band)) + (error "failed to flush raster cache"))) + +(export flush-raster-cache) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-histogram-ex + int "GDALGetRasterHistogramEx" (list '* double double int '* + int int '* '*) 20) + +(define* (get-raster-histogram h-band minimum maximum n-buckets + histogram include-out-of-range approx-ok + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Compute raster histogram. + +Parameters: + h-band: a handle representing GDALRasterBandH. + minimum: the lower bound of the histogram. + maximum: the upper bound of the histogram. + n-buckets: the number of buckets in histogram. + histogram: int64 buffer of bytevector into which the histogram totals are +placed. + include-out-of-range: if #t values below the histogram range will mapped +into histogram[0], and values above will be mapped into histogram[n-buckets-1] +otherwise out of range values are discarded. + approx-ok: #t if an approximate, or incomplete histogram OK. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let ((result (%gdal-get-raster-histogram-ex h-band + minimum + maximum + n-buckets + (bytevector->pointer histogram) + (boolean->c-bool + include-out-of-range) + (boolean->c-bool approx-ok) + (gdal-progress-func + progress-callback) + progress-data))) + (when (= result CE_FAILURE) + (error "failed to get raster histogram")))) + +(export get-raster-histogram) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-default-histogram-ex + int "GDALGetDefaultHistogramEx" (list '* '* '* '* '* int '* '*) 20) + +(define* (get-default-histogram h-band is-force + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Fetch default raster histogram. Return values of the lower bound of the +histogram, the upper bound of the histogram, number of buckets and a int +bytevector of histogram, respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH. + is-force: #t to force the computation. If #f and no default histogram is +available, the method will return CE_WARNING. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let* ((bv-min (make-bytevector (sizeof double))) + (bv-max (make-bytevector (sizeof double))) + (bv-n-buckets (make-bytevector (sizeof int))) + (bv-histogram (make-bytevector (sizeof '*))) + (result (%gdal-get-default-histogram-ex + h-band + (bytevector->pointer bv-min) + (bytevector->pointer bv-max) + (bytevector->pointer bv-n-buckets) + (bytevector->pointer bv-histogram) + (boolean->c-bool + is-force) + (gdal-progress-func + progress-callback) + progress-data))) + (if (= result CE_FAILURE) + (error "failed to get default histogram") + (let ((minimum (bytevector-ieee-double-ref + bv-min 0 + (native-endianness))) + (maximum (bytevector-ieee-double-ref + bv-max 0 + (native-endianness))) + (n-buckets (bytevector-sint-ref bv-n-buckets + 0 + (native-endianness) + (sizeof int)))) + (values minimum + maximum + n-buckets + (pointer->list (dereference-pointer + (bytevector->pointer bv-histogram)) + n-buckets + int64)))))) + +(export get-default-histogram) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-default-histogram-ex + int "GDALSetDefaultHistogramEx" (list '* double double int '*) 20) + +(define (set-default-histogram h-band minimum maximum n-buckets histogram) + "Set default histogram. + +Parameters: + h-band: a handle representing GDALRasterBandH. + minimum: the lower bound of the histogram. + maximum: the upper bound of the histogram. + n-buckets: the number of buckets in histogram. + histogram: the int64 bytevector of the histogram." + (let ((result (%gdal-set-default-histogram-ex + h-band + minimum + maximum + n-buckets + (bytevector->pointer histogram)))) + (unless (= result CE_NONE) + (error "failed to set default histogram")))) + +(export set-default-histogram) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-random-raster-sample + int "GDALGetRandomRasterSample" (list '* int '*) 20) + +(define (get-random-raster-sample h-band count) + "Return a list of random pixels as floating point numbers on the band. + +Parameters: + h-band: a handle representing GDALRasterBandH. + count: number of samples." + (let* ((bv-buffer (make-bytevector (* count (sizeof float)))) + (real-count (%gdal-get-random-raster-sample + h-band + count + (bytevector->pointer bv-buffer)))) + (pointer->list (bytevector->pointer bv-buffer) real-count float))) + +(export get-random-raster-sample) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-raster-sample-overview-ex + '* "GDALGetRasterSampleOverviewEx" (list '* int64) 20) + +(define (get-raster-sample-overview h-band desired-samples) + "Fetch best sampling overview. + +Parameters: + h-band: a handle representing GDALRasterBandH. + desired-samples: the returned band will have at least this many pixels." + (%gdal-get-raster-sample-overview-ex h-band desired-samples)) + +(export get-raster-sample-overview) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-fill-raster + int "GDALFillRaster" (list '* double double) 20) + +(define* (fill-raster h-band real #:key (imaginary 0)) + "Fill this band with a constant value. + +Parameters: + h-band: a handle representing GDALRasterBandH. + real: real component of fill value. + imaginary (optional): imaginary component of fill value, defaults to zero." + (let ((result (%gdal-fill-raster h-band real imaginary))) + (unless (= result CE_NONE) + (error "failed to fill raster")))) + +(export fill-raster) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-compute-band-stats + int "GDALComputeBandStats" (list '* int '* '* '* '*) 20) + +(define* (compute-band-stats h-band n-sample-step + #:key (progress-callback '()) + (progress-data %null-pointer)) + "Compute image statistics as multiple values of mean and standard deviation, +respectively. + +Parameters: + h-band: a handle representing GDALRasterBandH. + n-sample-step: a number of sample steps. + progress-callback (optional): a function to call to report progress. + progress-data (optional): application data to pass to the progress +function." + (let* ((bv-mean (make-bytevector (sizeof double))) + (bv-std-dev (make-bytevector (sizeof double))) + (result (%gdal-compute-band-stats + h-band + n-sample-step + (bytevector->pointer bv-mean) + (bytevector->pointer bv-std-dev) + (gdal-progress-func progress-callback) + progress-data))) + (if (= result CE_NONE) + (values (bytevector-ieee-double-ref bv-mean 0 (native-endianness)) + (bytevector-ieee-double-ref bv-std-dev 0 (native-endianness))) + (error "failed to compute band statistics")))) + +(export compute-band-stats) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-default-rat + '* "GDALGetDefaultRAT" (list '*) 20) + +(define (get-default-rat h-band) + "Fetch default Raster Attribute Table. Returns #f if not set. + +Parameters: + h-band: a handle representing GDALRasterBandH." + (let ((ptr (%gdal-get-default-rat h-band))) + (if (null-pointer? ptr) + #f + ptr))) + +(export get-default-rat) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-default-rat + int "GDALSetDefaultRAT" (list '* '*) 20) + +(define (set-default-rat h-band h-rat) + "Set default Raster Attribute Table. + +Parameters: + h-band: a handle representing GDALRasterBandH. + h-rat: a handle for raster attribute table to set." + (let ((result (%gdal-set-default-rat h-band h-rat))) + (unless (= result CE_NONE) + (error "failed to set raster attribute table")))) + +(export set-default-rat) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-create-raster-attribute-table + '* "GDALCreateRasterAttributeTable" '() 20) + +(define (make-raster-attribute-table) + "Construct empty table." + (%gdal-create-raster-attribute-table)) + +(export make-raster-attribute-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-destroy-raster-attribute-table + void "GDALDestroyRasterAttributeTable" (list '*) 20) + +(define (destroy-raster-attribute-table h-rat) + "Destroys a RAT." + (%gdal-destroy-raster-attribute-table h-rat)) + +(export destroy-raster-attribute-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-column-count + int "GDALRATGetColumnCount" (list '*) 20) + +(define (rat-get-column-count h-rat) + "Fetch table column count. + +Parameters: + h-rat: handle representing raster attribute table." + (%gdal-rat-get-column-count h-rat)) + +(export rat-get-column-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-name-of-col + '* "GDALRATGetNameOfCol" (list '* int) 20) + +(define (get-rat-name-of-column h-rat i-col) + "Fetch name of indicated column. + +Parameters: + h-rat: handle representing raster attribute table. + i-col: column index." + (let ((ptr (%gdal-rat-get-name-of-col h-rat i-col))) + (if (null-pointer? ptr) + (error "failed to get name of column") + (pointer->string ptr)))) + +(export get-rat-name-of-column) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-usage-of-col + int "GDALRATGetUsageOfCol" (list '* int) 20) + +(define (rat-get-usage-of-column h-rat i-col) + "Fetch column usage value. See GFU_* enums for possible values. + +Parameters: + h-rat: handle representing raster attribute table. + i-col: column index." + (%gdal-rat-get-usage-of-col h-rat i-col)) + +(export rat-get-usage-of-column) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-type-of-col + int "GDALRATGetTypeOfCol" (list '* int) 20) + +(define (rat-get-type-of-column h-rat i-col) + "Fetch column type. See GFT_* enums for possible values. + +Parameters: + h-rat: handle representing raster attribute table. + i-col: column index." + (%gdal-rat-get-usage-of-col h-rat i-col)) + +(export rat-get-type-of-column) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-col-of-usage + int "GDALRATGetColOfUsage" (list '* int) 20) + +(define (rat-get-col-of-usage h-rat usage) + "Fetch column index for given usage. + +Parameters: + h-rat: handle representing raster attribute table. + usage: field usage. see GFU_* enums for possible values" + (%gdal-rat-get-col-of-usage h-rat usage)) + +(export rat-get-col-of-usage) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-row-count + int "GDALRATGetRowCount" (list '*) 20) + +(define (rat-get-row-count h-rat) + "Fetch table row count. + +Parameters: + h-rat: handle representing raster attribute table." + (%gdal-rat-get-row-count h-rat)) + +(export rat-get-row-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-value-as-string + '* "GDALRATGetValueAsString" (list '* int int) 20) + +(define (rat-get-value-as-string h-rat i-row i-field) + "Fetch field value as a string. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index" + (let ((ptr (%gdal-rat-get-value-as-string h-rat i-row i-field))) + (if (null-pointer? ptr) + (error "failed to get value as string") + (pointer->string ptr)))) + +(export rat-get-value-as-string) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-value-as-int + int "GDALRATGetValueAsInt" (list '* int int) 20) + +(define (rat-get-value-as-int h-rat i-row i-field) + "Fetch field value as an integer. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index." + (%gdal-rat-get-value-as-int h-rat i-row i-field)) + +(export rat-get-value-as-int) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-value-as-double + double "GDALRATGetValueAsDouble" (list '* int int) 20) + +(define (rat-get-value-as-double h-rat i-row i-field) + "Fetch field value as a double. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index." + (%gdal-rat-get-value-as-double h-rat i-row i-field)) + +(export rat-get-value-as-double) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-value-as-string + void "GDALRATSetValueAsString" (list '* int int '*) 20) + +(define (rat-set-value-as-string h-rat i-row i-field value) + "Set field value from string. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index. + value: string value to set." + (%gdal-rat-set-value-as-string h-rat i-row i-field (string->pointer value))) + +(export rat-set-value-as-string) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-value-as-int + void "GDALRATSetValueAsInt" (list '* int int int) 20) + +(define (rat-set-value-as-int h-rat i-row i-field value) + "Set field value from integer. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index. + value: integer value to set." + (%gdal-rat-set-value-as-int h-rat i-row i-field value)) + +(export rat-set-value-as-int) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-value-as-double + void "GDALRATSetValueAsDouble" (list '* int int double) 20) + +(define (rat-set-value-as-double h-rat i-row i-field value) + "Set field value from double. + +Parameters: + h-rat: handle representing raster attribute table. + i-row: row index. + i-field: column index. + value: double value to set." + (%gdal-rat-set-value-as-double h-rat i-row i-field value)) + +(export rat-set-value-as-double) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-changes-are-written-to-file + int "GDALRATChangesAreWrittenToFile" (list '*) 20) + +(define (rat-changes-are-written-to-file h-rat) + "Determine whether changes made to this RAT are reflected directly +in the dataset. + +Parameters: + h-rat: handle representing raster attribute table." + (c-bool->boolean (%gdal-rat-changes-are-written-to-file h-rat))) + +(export rat-changes-are-written-to-file) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-values-io-as-double + int "GDALRATValuesIOAsDouble" (list '* int int int int '*) 20) + +(define (rat-read-values-as-double h-rat i-field i-start-row i-length) + "Read a block of doubles from the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start reading (zero based). + i-length: number of rows to read." + (let* ((bv (make-bytevector (* i-length (sizeof double)))) + (result (%gdal-rat-values-io-as-double h-rat GF_READ + i-field i-start-row + i-length + (bytevector->pointer bv)))) + (if (= result CE_FAILURE) + (error "failed to read values as doubles") + (pointer->list (bytevector->pointer bv) i-length double)))) + +(export rat-read-values-as-double) + +(define (rat-write-values-as-double h-rat i-field i-start-row lst) + "Write a block of doubles to the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start writing (zero based). + lst: list of doubles to write." + (let ((result (%gdal-rat-values-io-as-double + h-rat GF_WRITE + i-field i-start-row + (length lst) + (list->pointer lst double)))) + (if (= result CE_FAILURE) + (error "failed to write values as doubles")))) + +(export rat-write-values-as-double) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-values-io-as-integer + int "GDALRATValuesIOAsInteger" (list '* int int int int '*) 20) + +(define (rat-read-values-as-integer h-rat i-field i-start-row i-length) + "Read a block of integers from the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start reading (zero based). + i-length: number of rows to read." + (let* ((bv (make-bytevector (* i-length (sizeof int)))) + (result (%gdal-rat-values-io-as-integer h-rat GF_READ + i-field i-start-row + i-length + (bytevector->pointer bv)))) + (if (= result CE_FAILURE) + (error "failed to read values as integers") + (bytevector->sint-list bv (native-endianness) i-length)))) + +(export rat-read-values-as-integer) + +(define (rat-write-values-as-integer h-rat i-field i-start-row lst) + "Write a block of integers to the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start writing (zero based). + lst: list of integers to write." + (let ((result (%gdal-rat-values-io-as-integer + h-rat GF_WRITE + i-field i-start-row + (length lst) + (sint-list->bytevector lst (native-endianness) + (length lst))))) + (if (= result CE_FAILURE) + (error "failed to write values as integers")))) + +(export rat-write-values-as-integer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-values-io-as-string + int "GDALRATValuesIOAsString" (list '* int int int int '*) 20) + +(define (rat-read-values-as-string h-rat i-field i-start-row i-length) + "Read a block of strings from the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start reading (zero based). + i-length: number of rows to read." + (let* ((bv (make-bytevector (* i-length (sizeof '*)))) + (result (%gdal-rat-values-io-as-string h-rat GF_READ + i-field i-start-row + i-length + (bytevector->pointer bv)))) + (if (= result CE_FAILURE) + (error "failed to read values as strings") + (pointerpointer->string-list (bytevector->pointer bv))))) + +(export rat-read-values-as-string) + +(define (rat-write-values-as-string h-rat i-field i-start-row lst) + "Write a block of strings to the Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table. + i-field: column index. + i-start-row: row index to start writing (zero based). + lst: list of strings to write." + (let ((result (%gdal-rat-values-io-as-string + h-rat GF_WRITE + i-field i-start-row + (length lst) + (string-list->pointerpointer lst)))) + (if (= result CE_FAILURE) + (error "failed to write values as strings")))) + +(export rat-write-values-as-string) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-row-count + void "GDALRATSetRowCount" (list '* int) 20) + +(define (rat-set-row-count h-rat new-count) + "Set row count. + +Parameters: + h-rat: handle representing raster attribute table. + new-count: the new number of rows." + (%gdal-rat-set-row-count h-rat new-count)) + +(export rat-set-row-count) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-create-column + int "GDALRATCreateColumn" (list '* '* int int) 20) + +(define (rat-create-column h-rat field-name field-type field-usage) + "Create new column. If the table already has rows, all row values for the +new column will be initialized to the default value (\"\", or zero). The new +column is always created as the last column, column index will be +\"(- (get-column-count) 1)\" after rat-create-column has completed successfully. + +Parameters: + h-rat: handle representing raster attribute table. + field-name: the name of the field to create. + field-type: the field type. see GFT_* enums for possible values. + field-usage: the field usage. see GFU_* enums for possible values." + (let ((result (%gdal-rat-create-column h-rat (string->pointer field-name) + field-type + field-usage))) + (if (= result CE_FAILURE) + (error "failed to create column")))) + +(export rat-create-column) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-linear-binning + int "GDALRATSetLinearBinning" (list '* double double) 20) + +(define (rat-set-linear-binning h-rat row-min bin-size) + "Set linear binning information. + +For RATs with equal sized categories (in pixel value space) that are evenly +spaced, this method may be used to associate the linear binning information +with the table. + +Parameters: + h-rat: handle representing raster attribute table. + row-min: the lower bound (pixel value) of the first category. + bin-size:the width of each category (in pixel value units)." + (let ((result (%gdal-rat-set-linear-binning h-rat row-min bin-size))) + (if (= result CE_FAILURE) + (error "failed to set linear binning information")))) + +(export rat-set-linear-binning) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-linear-binning + int "GDALRATGetLinearBinning" (list '* '* '*) 20) + +(define (rat-get-linear-binning h-rat) + "Get linear binning information. Returns values of (#t, row-min, bin-size) +if linear binning information exists or (values #f 0.0 0.0) if there is none. +row-min is the lower bound (pixel value) of the first category, and bin-size +is the width of each category (in pixel value units). + +Parameters: + h-rat: handle representing raster attribute table." + (let* ((row-min ((make-bytevector (sizeof double)))) + (bin-size ((make-bytevector (sizeof double)))) + (result (%gdal-rat-get-linear-binning h-rat + (bytevector->pointer row-min) + (bytevector->pointer bin-size)))) + (if (c-bool->boolean result) + (values #t + (bytevector-ieee-double-ref row-min 0 (native-endianness)) + (bytevector-ieee-double-ref bin-size 0 (native-endianness))) + (values #f 0.0 0.0)))) + +(export rat-get-linear-binning) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-set-table-type + int "GDALRATSetTableType" (list '* int) 24) + +(define (rat-set-table-type h-rat table-type) + "Set whether the RAT is thematic or athematic (continuous). + +Parameters: + h-rat: handle for raster attribute table to set. + table-type: table type to set." + (let ((result (%gdal-rat-set-table-type h-rat table-type))) + (unless (= result CE_NONE) + (error "failed to set table type")))) + +(export rat-set-table-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-table-type + int "GDALRATGetTableType" (list '*) 24) + +(define (rat-get-table-type h-rat) + "Indicates whether the RAT is thematic or athematic (continuous). + +Parameters: + h-rat: handle representing raster attribute table." + (%gdal-rat-get-table-type h-rat)) + +(export rat-get-table-type) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-initialize-from-color-table + int "GDALRATInitializeFromColorTable" (list '* '*) 20) + +(define (make-rat-from-color-table h-rat h-table) + "Initialize from color table. + +This method will setup a whole raster attribute table based on the contents of +the passed color table. The Value (GFU_MIN_MAX), Red (GFU_RED), +Green (GFU_GREEN), Blue (GFU_BLUE), and Alpha (GFU_ALPHA) fields are created, +and a row is set for each entry in the color table. + +The raster attribute table must be empty before calling +make-rat-from-color-table + +The Value fields are set based on the implicit assumption with color tables +that entry 0 applies to pixel value 0, 1 to 1, etc. + +Parameters: + h-rat: handle for raster attribute table to set. + h-table: color table to copy from." + (let ((result (%gdal-rat-initialize-from-color-table h-rat h-table))) + (unless (= result CE_NONE) + (error "failed to make rat from color table")))) + +(export make-rat-from-color-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-translate-to-color-table + '* "GDALRATTranslateToColorTable" (list '* int) 20) + +(define (rat-translate-to-color-table h-rat entry-count) + "Translate to a color table. + +Parameters: + h-rat: handle representing raster attribute table. + entry-count: the number of entries to produce (0 to entry-count - 1)." + (let ((result (%gdal-rat-translate-to-color-table h-rat entry-count))) + (if (null-pointer? result) + (error "failed to translate to color table") + result))) + +(export rat-translate-to-color-table) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-clone + '* "GDALRATClone" (list '*) 20) + +(define (clone-rat h-rat) + "Copy Raster Attribute Table. + +Parameters: + h-rat: handle representing raster attribute table." + (%gdal-rat-clone h-rat)) + +(export clone-rat) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-get-row-of-value + int "GDALRATGetRowOfValue" (list '* double) 20) + +(define (rat-get-row-of-value h-rat value) + "Get row for pixel value. + +Given a raw pixel value, the raster attribute table is scanned to determine +which row in the table applies to the pixel value. The row index is returned. + +Parameters: + h-rat: handle representing raster attribute table. + value: the pixel value." + (%gdal-rat-get-row-of-value h-rat value)) + +(export rat-get-row-of-value) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-rat-remove-statistics + void "GDALRATRemoveStatistics" (list '*) 24) + +(define (rat-remove-statistics h-rat) + "Remove statistics from the RAT. + +Parameters: + h-rat: handle representing raster attribute table." + (%gdal-rat-remove-statistics h-rat)) + +(export rat-remove-statistics) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-cache-max + void "GDALSetCacheMax" (list int) 20) + +(define (set-cache-max new-size-in-bytes) + "Set maximum cache memory. + +This function sets the maximum amount of memory that GDAL is permitted to use +for GDALRasterBlock caching. The unit of the value is bytes. + +The maximum value is 2GB, due to the use of a signed 32 bit integer. + +Parameters: + new-size-in-bytes: the maximum number of bytes for caching." + (%gdal-set-cache-max new-size-in-bytes)) + +(export set-cache-max) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-set-cache-max-64 + void "GDALSetCacheMax64" (list int64) 18) + +(define (set-cache-max-64 new-size-in-bytes) + "Set maximum cache memory. + +This function sets the maximum amount of memory that GDAL is permitted to use +for GDALRasterBlock caching. The unit of the value is bytes. + +Note: On 32 bit platforms, the maximum amount of memory that can be addressed +by a process might be 2 GB or 3 GB, depending on the operating system +capabilities. This function will not make any attempt to check the consistency +of the passed value with the effective capabilities of the OS. + +Parameters: + new-size-in-bytes: the maximum number of bytes for caching." + (%gdal-set-cache-max-64 new-size-in-bytes)) + +(export set-cache-max-64) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-cache-max + int "GDALGetCacheMax" '() 20) + +(define (get-cache-max) + "Get maximum cache memory. + +Gets the maximum amount of memory available to the GDALRasterBlock caching +system for caching GDAL read/write imagery. + +The first type this function is called, it will read the GDAL_CACHEMAX +configuration option to initialize the maximum cache memory. Starting with +GDAL 2.1, the value can be expressed as x% of the usable physical RAM +(which may potentially be used by other processes). Otherwise it is expected to +be a value in MB. + +This function cannot return a value higher than 2 GB. Use get-cache-max-64 to +get a non-truncated value." + (%gdal-get-cache-max)) + +(export get-cache-max) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-cache-max-64 + int64 "GDALGetCacheMax64" '() 18) + +(define (get-cache-max-64) + "Get maximum cache memory. + +Gets the maximum amount of memory available to the GDALRasterBlock caching +system for caching GDAL read/write imagery. + +The first type this function is called, it will read the GDAL_CACHEMAX +configuration option to initialize the maximum cache memory. Starting with +GDAL 2.1, the value can be expressed as x% of the usable physical RAM +(which may potentially be used by other processes). Otherwise it is expected +to be a value in MB." + (%gdal-get-cache-max-64)) + +(export get-cache-max-64) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-cache-used + int "GDALGetCacheUsed" '() 20) + +(define (get-cache-used) + "Get cache memory used." + (%gdal-get-cache-used)) + +(export get-cache-used) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-get-cache-used-64 + int64 "GDALGetCacheUsed64" '() 18) + +(define (get-cache-used-64) + "Get cache memory used." + (%gdal-get-cache-used-64)) + +(export get-cache-used-64) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-flush-cache-block + int "GDALFlushCacheBlock" '() 20) + +(define (flush-cache-block) + "Try to flush one cached raster block. + +This function will search the first unlocked raster block and will flush it to +release the associated memory. + +Returns #t if one block was flushed, #f if there are no cached blocks or if +they are currently locked." + (c-bool->boolean (%gdal-flush-cache-block))) + +(export flush-cache-block) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-create-multi-multidimensional + '* "GDALCreateMultiDimensional" (list '* '* '* '*) 31) + +(define* (make-multidimensional-dataset h-driver file-name #:key + (root-group-options '()) + (options '())) + "Create a new multidimensional dataset with this driver. + +Only drivers that advertise the GDAL_DCAP_MULTIDIM_RASTER capability and +implement the pfnCreateMultiDimensional method might return a non nullptr +GDALDataset. + +Parameters: + file-name: the name of the dataset to create. + root-group-options (optional): driver specific options regarding the +creation of the root group. + options (optional): driver specific options regarding the creation of the +dataset." + (let ((ptr (%gdal-create-multi-multidimensional + h-driver + (string->pointer file-name) + (string-list->pointerpointer root-group-options) + (string-list->pointerpointer options)))) + (if (null-pointer? ptr) + (error "failed to create multidimensional dataset") + ptr))) + +(export make-multidimensional-dataset) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %gdal-group-get-vector-layer-names + '* "GDALGroupGetVectorLayerNames" (list '* '*) 34) + +(define* (group-get-vector-layer-names h-group #:key + (options '())) + "Return the list of layer names contained in this group. + +Parameters: + h-group: handle of the group. + options (optional): driver specific options determining how layers should +be retrieved." + (let ((ptr (%gdal-group-get-vector-layer-names + h-group + (string-list->pointerpointer options)))) + (pointerpointer->string-list ptr))) + +(export group-get-vector-layer-names) + +;;------------------------------------------------------------------------------ diff --git a/gdal/config.scm.in b/gdal/config.scm.in new file mode 100644 index 0000000..60ffec5 --- /dev/null +++ b/gdal/config.scm.in @@ -0,0 +1,11 @@ +(define-module (gdal config) + #:export (*libgdal-path* + *libgdal* + *gdal-version*)) + +(define *libgdal-path* + "@LIBGDAL_PATH@") + +(define *libgdal* (dynamic-link *libgdal-path*)) + +(define *gdal-version* 32) diff --git a/gdal/extension.scm b/gdal/extension.scm new file mode 100644 index 0000000..68dfa43 --- /dev/null +++ b/gdal/extension.scm @@ -0,0 +1,371 @@ +(define-module (gdal extension) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-4 gnu) + #:use-module (ice-9 streams) + #:use-module (gdal config) + #:use-module (gdal internal) + #:use-module (gdal)) + +;;------------------------------------------------------------------------------ + +;;; Helper Functions + +;;------------------------------------------------------------------------------ + +(define *buffer-makers* + `((,GDT_BYTE . ,make-u8vector) + (,GDT_UINT16 . ,make-u16vector) + (,GDT_INT16 . ,make-s16vector) + (,GDT_UINT32 . ,make-u32vector) + (,GDT_INT32 . ,make-s32vector) + (,GDT_FLOAT32 . ,make-f32vector) + (,GDT_FLOAT64 . ,make-f64vector) + (,GDT_CFLOAT32 . ,make-c32vector) + (,GDT_CFLOAT64 . ,make-c64vector))) + +(define *buffer-refs* + `((,GDT_BYTE . ,u8vector-ref) + (,GDT_UINT16 . ,u16vector-ref) + (,GDT_INT16 . ,s16vector-ref) + (,GDT_UINT32 . ,u32vector-ref) + (,GDT_INT32 . ,s32vector-ref) + (,GDT_FLOAT32 . ,f32vector-ref) + (,GDT_FLOAT64 . ,f64vector-ref) + (,GDT_CFLOAT32 . ,c32vector-ref) + (,GDT_CFLOAT64 . ,c64vector-ref))) + +(define *buffer-setters* + `((,GDT_BYTE . ,u8vector-set!) + (,GDT_UINT16 . ,u16vector-set!) + (,GDT_INT16 . ,s16vector-set!) + (,GDT_UINT32 . ,u32vector-set!) + (,GDT_INT32 . ,s32vector-set!) + (,GDT_FLOAT32 . ,f32vector-set!) + (,GDT_FLOAT64 . ,f64vector-set!) + (,GDT_CFLOAT32 . ,c32vector-set!) + (,GDT_CFLOAT64 . ,c64vector-set!))) + +;;------------------------------------------------------------------------------ + +(define* (make-buffer x-size y-size buf-type + #:optional (h-band %null-pointer) + (x-off 0) (y-off 0)) + "Creates a raster buffer of SRFI-4 vector with internal properties for +the use of extension functions. + +Parameters: + x-size: the width of the region. + y-size: the height of the region. + buf-type: the type of the pixel values to be returned. + +Optional Parameters: + h-band: a target band of GDALRasterBandH. + x-off: the pixel offset to the top left corner of the region of the +target band. + y-off: the line offset to the top left corner of the region of the +target band. + +Note: + Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in +SRFI-4 vectors. Use raster-io for reading these values." + (let* ((size (* x-size y-size)) + (bv ((assv-ref *buffer-makers* buf-type) size))) + (set! (%gdal-h-band% bv) h-band) + (set! (%gdal-type% bv) buf-type) + (set! (%gdal-x-off% bv) x-off) + (set! (%gdal-y-off% bv) y-off) + (set! (%gdal-x-size% bv) x-size) + (set! (%gdal-y-size% bv) y-size) + bv)) + +(export make-buffer) + +;;------------------------------------------------------------------------------ + +(define* (copy-buffer data #:optional (copy-data #t) + (buf-type (%gdal-type% data))) + "Copies a raster buffer of SRFI-4 vector with internal properties for +the use of extension functions. + +Parameters: + data: data buffer to copy. + +Optional Parameters: + copy-data: copy pixel values. by default it's true. + buf-type: data type for the destination buffer." + (let* ((size (* (%gdal-x-size% data) (%gdal-y-size% data))) + (buffer-ref (assv-ref *buffer-refs* (%gdal-type% data))) + (buffer-set! (assv-ref *buffer-setters* buf-type)) + (bv ((assv-ref *buffer-makers* buf-type) size))) + (begin + (set! (%gdal-h-band% bv) (%gdal-h-band% data)) + (set! (%gdal-type% bv) buf-type) + (set! (%gdal-x-off% bv) (%gdal-x-off% data)) + (set! (%gdal-y-off% bv) (%gdal-y-off% data)) + (set! (%gdal-x-size% bv) (%gdal-x-size% data)) + (set! (%gdal-y-size% bv) (%gdal-y-size% data)) + (if copy-data + (for-each (lambda (offset) (buffer-set! bv offset + (buffer-ref data offset))) + (iota size))) + bv))) + +(export copy-buffer) + +;;------------------------------------------------------------------------------ + +(define (make-buffer-from-band h-band x-off y-off x-size y-size buf-type) + "Read a region of image data for this band. + +Returns the raster buffer which is also SRFI-4 vector with internal properties +for the use of extension functions. If the access fails, it reports error. + +Parameters: + h-band: a handle representing GDALRasterBandH. + x-off: the pixel offset to the top left corner of the region of the band. + y-off: the line offset to the top left corner of the region of the band. + x-size: the width of the region of the band. + y-size: the height of the region of the band. + buf-type: the type of the pixel values to be returned. + +Note: + Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in +SRFI-4 vectors. Use raster-io for reading these values." + (let* ((size (* x-size y-size)) + (bv ((assv-ref *buffer-makers* buf-type) size))) + (raster-io h-band GF_READ x-off y-off x-size y-size bv + x-size y-size buf-type 0 0) + (set! (%gdal-h-band% bv) h-band) + (set! (%gdal-type% bv) buf-type) + (set! (%gdal-x-off% bv) x-off) + (set! (%gdal-y-off% bv) y-off) + (set! (%gdal-x-size% bv) x-size) + (set! (%gdal-y-size% bv) y-size) + bv)) + +(export make-buffer-from-band) + +;;------------------------------------------------------------------------------ + +(define (make-buffer-all-from-band h-band buf-type) + "Read entire region of image data for this band. + +Returns a raster buffer of SRFI-4 vector with internal properties for the use +of extension functions. If the access fails, it reports error. + +Parameters: + h-band: a handle representing GDALRasterBandH. + buf-type: the type of the pixel values to be returned. + +Note: + Types GDT_CINT16 and GDT_CINT32 are not supported due to limitations in +SRFI-4 vectors. Use raster-io for reading these values." + (let* ((x-size (get-raster-band-x-size h-band)) + (y-size (get-raster-band-y-size h-band)) + (size (* x-size y-size)) + (bv ((assv-ref *buffer-makers* buf-type) size))) + (raster-io h-band GF_READ 0 0 x-size y-size bv + x-size y-size buf-type 0 0) + (set! (%gdal-h-band% bv) h-band) + (set! (%gdal-type% bv) buf-type) + (set! (%gdal-x-off% bv) 0) + (set! (%gdal-y-off% bv) 0) + (set! (%gdal-x-size% bv) x-size) + (set! (%gdal-y-size% bv) y-size) + bv)) + +(export make-buffer-all-from-band) + +;;------------------------------------------------------------------------------ + +(define (overwrite-buffer-in-band data) + "Overwrite raster buffer in the associated band of the data. + +If the access fails, it reports error. Otherwise it returns void. + +Parameters: + data: the raster buffer to be written." + (raster-io (%gdal-h-band% data) GF_WRITE (%gdal-x-off% data) + (%gdal-y-off% data) (%gdal-x-size% data) + (%gdal-y-size% data) data + (%gdal-x-size% data) (%gdal-y-size% data) + (%gdal-type% data) 0 0)) + +(export overwrite-buffer-in-band) + +;;------------------------------------------------------------------------------ + +(define (add-offset-to-geo-transform geo-transform x-off y-off) + (let ((t-0 (list-ref geo-transform 0)) + (t-1 (list-ref geo-transform 1)) + (t-2 (list-ref geo-transform 2)) + (t-3 (list-ref geo-transform 3)) + (t-4 (list-ref geo-transform 4)) + (t-5 (list-ref geo-transform 5))) + (let ((ot-0 (+ t-0 (* x-off t-1) (* y-off t-2))) + (ot-3 (+ t-3 (* x-off t-4) (* y-off t-5)))) + (list ot-0 t-1 t-2 ot-3 t-4 t-5)))) + +;;------------------------------------------------------------------------------ + +(define* (write-buffer-to-file data driver-short-name + file-name #:key (no-data #f)) + "Write raster buffer to a new file. + +If the access fails, it reports error. Otherwise it returns void. + +Parameters: + data: the raster buffer to be written. + driver-short-name: the short name of the driver, such as 'GTiff' as a +string or GDN_GTIFF as an enum (see GDN_*), being searched for. + file-name: the name of the dataset to create. + +Optional Parameters: + no-data: no data value." + (let* ((driver (get-driver-by-name driver-short-name)) + (dataset (create-dataset driver file-name (%gdal-x-size% data) + (%gdal-y-size% data) 1 (%gdal-type% data))) + (h-band (get-raster-band dataset 1)) + (geo-transform + (get-geo-transform (get-band-dataset (%gdal-h-band% data)))) + (projection + (get-projection-ref (get-band-dataset (%gdal-h-band% data))))) + (begin + (set-projection dataset projection) + (if no-data (set-raster-no-data-value h-band no-data)) + (set-geo-transform dataset + (add-offset-to-geo-transform geo-transform + (%gdal-x-off% data) + (%gdal-y-off% data) + )) + (raster-io h-band GF_WRITE 0 + 0 (%gdal-x-size% data) + (%gdal-y-size% data) data + (%gdal-x-size% data) (%gdal-y-size% data) + (%gdal-type% data) 0 0) + (close-dataset dataset)))) + +(export write-buffer-to-file) + +;;------------------------------------------------------------------------------ + +(define (read-buffer-pixel data x-off y-off) + "Read a pixel value of the the raster buffer. + +Parameters: + data: the raster vector. + x-off: the pixel offset to the top left corner of the data. + y-off: the line offset to the top left corner of the data." + (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data))) + (offset (+ x-off (* y-off (%gdal-x-size% data))))) + (buffer-ref data offset))) + +(export read-buffer-pixel) + +;;------------------------------------------------------------------------------ + +(define (for-each-pixel proc data) + "Apply proc to each element in the buffer, discarding the returned value. + +Parameters: + proc: the producedure. + data: the raster vector." + (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data))) + (size (* (%gdal-x-size% data) (%gdal-y-size% data)))) + (for-each (lambda (offset) (proc (buffer-ref data offset))) (iota size)))) + +(export for-each-pixel) + +;;------------------------------------------------------------------------------ + +(define* (map-pixel proc data #:key (buf-type (%gdal-type% data))) + "Apply proc to each element in the buffer and return a new buffer. + +Parameters: + proc: the producedure. + data: the raster vector. + buf-type: data type of pixel values of the destination buffer." + (let ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data))) + (buffer-set! (assv-ref *buffer-setters* buf-type)) + (size (* (%gdal-x-size% data) (%gdal-y-size% data))) + (bv (copy-buffer data #f buf-type))) + (begin + (for-each (lambda (offset) (buffer-set! bv offset + (proc (buffer-ref data offset)))) + (iota size)) + bv))) + +(export map-pixel) + +;;------------------------------------------------------------------------------ + +(define (write-buffer-pixel! data x-off y-off value) + "Write a pixel value in the raster buffer. + +Parameters: + data: the raster vector. + x-off: the pixel offset to the top left corner of the data. + y-off: the line offset to the top left corner of the data. + value: the pixel value." + (let ((buffer-set! (assv-ref *buffer-setters* (%gdal-type% data))) + (offset (+ x-off (* y-off (%gdal-x-size% data))))) + (buffer-set! data offset value))) + +(export write-buffer-pixel!) + +;;------------------------------------------------------------------------------ + +;; TODO: copy the data into temp +(define (buffer->stream data) + "Creates a raster stream with the content of raster buffer. + +Parameters: + data: the raster buffer." + (let* ((buffer-ref (assv-ref *buffer-refs* (%gdal-type% data))) + (size (* (%gdal-x-size% data) (%gdal-y-size% data))) + (stream (make-stream (lambda (offset) + (if (= offset size) + '() + (cons (buffer-ref data offset) + (1+ offset)))) + 0))) + (set! (%gdal-h-band% stream) (%gdal-h-band% data)) + (set! (%gdal-type% stream) (%gdal-type% data)) + (set! (%gdal-x-off% stream) (%gdal-x-off% data)) + (set! (%gdal-y-off% stream) (%gdal-y-off% data)) + (set! (%gdal-x-size% stream) (%gdal-x-size% data)) + (set! (%gdal-y-size% stream) (%gdal-y-size% data)) + stream)) + +(export buffer->stream) + +;;------------------------------------------------------------------------------ + +(define (stream->buffer stream) + "Creates a raster buffer with the content of raster stream. + +Parameters: + stream: the raster stream." + (let* ((size (* (%gdal-x-size% stream) (%gdal-y-size% stream))) + (stream-type (%gdal-type% stream)) + (data ((assv-ref *buffer-makers* stream-type) size)) + (buffer-set! (assv-ref *buffer-setters* stream-type))) + (let loop ((rest stream) + (index 0)) + (if (stream-null? rest) + (begin + (set! (%gdal-h-band% data) (%gdal-h-band% stream)) + (set! (%gdal-type% data) (%gdal-type% stream)) + (set! (%gdal-x-off% data) (%gdal-x-off% stream)) + (set! (%gdal-y-off% data) (%gdal-y-off% stream)) + (set! (%gdal-x-size% data) (%gdal-x-size% stream)) + (set! (%gdal-y-size% data) (%gdal-y-size% stream)) + data) + (begin + (buffer-set! data index (stream-car rest)) + (loop (stream-cdr rest) (1+ index))))))) + +(export stream->buffer) + +;;------------------------------------------------------------------------------ diff --git a/gdal/internal.scm b/gdal/internal.scm new file mode 100644 index 0000000..dd43587 --- /dev/null +++ b/gdal/internal.scm @@ -0,0 +1,209 @@ +(define-module (gdal internal) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (gdal config) + #:use-module (ice-9 q) + #:export (define-gdal-foreign) + #:export (data-type-valid?) + #:export (boolean->c-bool) + #:export (c-bool->boolean) + #:export (list->pointerpointer) + #:export (list->pointer) + #:export (pointer->list) + #:export (pointerpointer->list) + #:export (pointerpointer->string-list) + #:export (string-list->pointerpointer) + #:export (struct-list->pointer) + #:export (pointer->struct-list)) + +;;------------------------------------------------------------------------------ + +;;; Enums + +;;------------------------------------------------------------------------------ + +;;; GDALDataType enums +(define-public GDT_UNKNOWN 0) +(define-public GDT_BYTE 1) +(define-public GDT_UINT16 2) +(define-public GDT_INT16 3) +(define-public GDT_UINT32 4) +(define-public GDT_INT32 5) +(define-public GDT_FLOAT32 6) +(define-public GDT_FLOAT64 7) +(define-public GDT_CINT16 8) +(define-public GDT_CINT32 9) +(define-public GDT_CFLOAT32 10) +(define-public GDT_CFLOAT64 11) +(define-public GDT_TYPECOUNT 12) + +;;------------------------------------------------------------------------------ + +;;; Object properties + +;;------------------------------------------------------------------------------ + +;;; Buffer properties +(define-public %gdal-h-band% (make-object-property)) +(define-public %gdal-type% (make-object-property)) +(define-public %gdal-x-off% (make-object-property)) +(define-public %gdal-y-off% (make-object-property)) +(define-public %gdal-x-size% (make-object-property)) +(define-public %gdal-y-size% (make-object-property)) +(define-public %gdal-pixel-off% (make-object-property)) +(define-public %gdal-line-off% (make-object-property)) +(define-public %is-stream% (make-object-property)) + +;;------------------------------------------------------------------------------ + +;;; Internal definitions + +;;------------------------------------------------------------------------------ + +(define gdal-func + (lambda* (return-type function-name arg-types gdal-version) + (if (>= *gdal-version* gdal-version) + (pointer->procedure return-type + (dynamic-func function-name *libgdal*) + arg-types) + (lambda* (#:rest r) (throw 'unsupported))))) + +(define-syntax-rule (define-gdal-foreign + name return-type func-name arg-types gdal-version) + (define name + (gdal-func return-type func-name arg-types gdal-version))) + +(define (data-type-valid? data-type) + (and (< GDT_UNKNOWN data-type) (> GDT_TYPECOUNT data-type))) + +(define (boolean->c-bool b) + "Convert the boolean to a c boolean." + (if b 1 0)) + +(define (c-bool->boolean b) + "Convert the c boolean to boolean." + (if (zero? b) #f #t)) + +(define bytevector-pointer-ref + (case (sizeof '*) + ((8) (lambda (bv offset) + (make-pointer (bytevector-u64-native-ref bv offset)))) + ((4) (lambda (bv offset) + (make-pointer (bytevector-u32-native-ref bv offset)))) + (else (error "what machine is this?")))) + +(define bytevector-pointer-set! + (case (sizeof '*) + ((8) (lambda (bv offset ptr) + (bytevector-u64-native-set! bv offset (pointer-address ptr)))) + ((4) (lambda (bv offset ptr) + (bytevector-u32-native-set! bv offset (pointer-address ptr)))) + (else (error "what machine is this?")))) + +(define (list->pointerpointer lst item->pointer) + (if (null? lst) + %null-pointer + (let* ((size (length lst)) + (ptr (make-bytevector (* (1+ size) (sizeof '*))))) + (do ((i 0 (1+ i))) + ((>= i size)) + (bytevector-pointer-set! ptr + (* i (sizeof '*)) + (item->pointer (list-ref lst i)))) + (bytevector-pointer-set! ptr (* size (sizeof '*)) %null-pointer) + (bytevector->pointer ptr)))) + +(define* (pointerpointer->list pointer pointer->item + #:optional (count -1)) + (let ((q (make-q))) + (unless (null-pointer? pointer) + (let lp ((sp (dereference-pointer pointer)) + (index 1)) + (unless (or (= count (q-length q)) (null-pointer? sp)) + (enq! q (pointer->item sp)) + (lp (dereference-pointer + (make-pointer + (+ (pointer-address pointer) (* index (sizeof '*))))) + (1+ index))))) + (car q))) + +(define (struct-list->pointer lst struct-size struct->pointer) + (let* ((size (length lst)) + (bv (make-bytevector (* size struct-size)))) + (do ((i 0 (1+ i))) + ((>= i size)) + (let ((index (* i struct-size)) + (item (list-ref lst i))) + (bytevector-copy! (pointer->bytevector + (struct->pointer item) struct-size) + 0 bv index struct-size))) + (bytevector->pointer bv))) + +(define (pointer->struct-list pointer count struct-size pointer->struct) + (let loop ((q (make-q)) + (index 0) + (pointer pointer)) + (if (= index count) + (car q) + (begin + (enq! q (pointer->struct pointer)) + (loop q (1+ index) (make-pointer (+ (pointer-address pointer) + struct-size))))))) + +(define (pointerpointer->string-list string-list-p) + (pointerpointer->list string-list-p pointer->string)) + +(define (string-list->pointerpointer lst) + (list->pointerpointer lst string->pointer)) + +(define *writers* + `((,float . ,bytevector-ieee-single-native-set!) + (,double . ,bytevector-ieee-double-native-set!) + (,int8 . ,bytevector-s8-set!) + (,uint8 . ,bytevector-u8-set!) + (,int16 . ,bytevector-s16-native-set!) + (,uint16 . ,bytevector-u16-native-set!) + (,int32 . ,bytevector-s32-native-set!) + (,uint32 . ,bytevector-u32-native-set!) + (,int64 . ,bytevector-s64-native-set!) + (,uint64 . ,bytevector-u64-native-set!) + (,'* . ,bytevector-pointer-set!))) + +(define *readers* + `((,float . ,bytevector-ieee-single-native-ref) + (,double . ,bytevector-ieee-double-native-ref) + (,int8 . ,bytevector-s8-ref) + (,uint8 . ,bytevector-u8-ref) + (,int16 . ,bytevector-s16-native-ref) + (,uint16 . ,bytevector-u16-native-ref) + (,int32 . ,bytevector-s32-native-ref) + (,uint32 . ,bytevector-u32-native-ref) + (,int64 . ,bytevector-s64-native-ref) + (,uint64 . ,bytevector-u64-native-ref) + (,'* . ,bytevector-pointer-ref))) + +(define (list->pointer lst type) + (cond + ((null? lst) %null-pointer) + ((not (pair? lst)) (error "input is not a pair")) + (else (let* ((size (length lst)) + (bv (make-bytevector (* size (sizeof type))))) + + (do ((i 0 (1+ i))) + ((>= i size)) + ((assv-ref *writers* type) bv + (* i (sizeof type)) + (list-ref lst i))) + (bytevector->pointer bv))))) + +(define (pointer->list pointer count type) + (let loop ((q (make-q)) + (index 0) + (pointer pointer)) + (if (= index count) + (car q) + (begin + (enq! q ((assv-ref *readers* type) + (pointer->bytevector pointer (sizeof type)) 0)) + (loop q (1+ index) (make-pointer (+ (pointer-address pointer) + (sizeof type)))))))) diff --git a/gdal/ogr.scm b/gdal/ogr.scm new file mode 100644 index 0000000..d97aee9 --- /dev/null +++ b/gdal/ogr.scm @@ -0,0 +1,446 @@ +(define-module (gdal ogr) + #:use-module (system foreign) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 q) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-4 gnu) + #:use-module (gdal config) + #:use-module (gdal internal)) + + ;;------------------------------------------------------------------------------ + + ;;; Enums + + ;;------------------------------------------------------------------------------ + + ;;; OGRFieldType enums + (define-public OFT_INTEGER 0) + (define-public OFT_INTEGER_LIST 1) + (define-public OFT_REAL 2) + (define-public OFT_REAL_LIST 3) + (define-public OFT_STRING 4) + (define-public OFT_STRING_LIST 5) + (define-public OFT_WIDE_STRING 6) + (define-public OFT_WIDE_STRING_LIST 7) + (define-public OFT_BINARY 8) + (define-public OFT_DATE 9) + (define-public OFT_TIME 10) + (define-public OFT_DATE_TIME 11) + (define-public OFT_INTEGER64 12) + (define-public OFT_INTEGER64_LIST 13) + + ;;------------------------------------------------------------------------------ + + ;;; Structures + + ;;------------------------------------------------------------------------------ + + ;;; gdal-datetime + + (define-record-type + (make-gdal-datetime year month day hour minute second tz) + gdal-datetime? + (year gdal-datetime-year set-gdal-datetime-year!) + (month gdal-datetime-month set-gdal-datetime-month!) + (day gdal-datetime-day set-gdal-datetime-day!) + (hour gdal-datetime-hour set-gdal-datetime-hour!) + (minute gdal-datetime-minute set-gdal-datetime-minute!) + (second gdal-datetime-second set-gdal-datetime-second!) + (tz gdal-datetime-tz set-gdal-datetime-tz!)) + + (export make-gdal-datetime + gdal-datetime? + gdal-datetime-year + set-gdal-datetime-year! + gdal-datetime-month + set-gdal-datetime-month! + gdal-datetime-day + set-gdal-datetime-day! + gdal-datetime-hour + set-gdal-datetime-hour! + gdal-datetime-minute + set-gdal-datetime-minute! + gdal-datetime-second + set-gdal-datetime-second! + gdal-datetime-tz + set-gdal-datetime-tz!) + +;;------------------------------------------------------------------------------ + +;;; OGR Function Bindings + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-l-reset-reading + void "OGR_L_ResetReading" (list '*) 20) + +(define (reset-layer-reading h-layer) + "Reset feature reading to start on the first feature. + +This affects get-next-feature. + +Parameters: + h-layer: handle to the layer on which features are read." + (%ogr-l-reset-reading h-layer)) + +(export reset-layer-reading) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-l-get-next-feature + '* "OGR_L_GetNextFeature" (list '*) 20) + +(define (get-next-feature h-layer) + "Fetch the next available feature from this layer. + +The returned feature becomes the responsibility of the caller to delete with +\"destroy-feature\". It is critical that all features associated with an +OGRLayer (more specifically an OGRFeatureDefn) be deleted before that +layer/datasource is deleted. + +This function implements sequential access to the features of a layer. The +\"reset-layer-reading\" function can be used to start at the beginning again. + +Returns a handle to a feature, or NULL if no more features are available. + +Parameters: + h-layer: handle to the layer on which features are read." + (%ogr-l-get-next-feature h-layer)) + +(export get-next-feature) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-l-get-layer-defn + '* "OGR_L_GetLayerDefn" (list '*) 20) + +(define (get-feature-definition-of-layer h-layer) + "Fetch the schema information for this layer. + +The returned handle to the OGRFeatureDefn is owned by the OGRLayer, and should +not be modified or freed by the application. It encapsulates the attribute +schema of the features of the layer. + +Parameters: + h-layer: handle to the layer on which features are read." + (%ogr-l-get-layer-defn h-layer)) + +(export get-feature-definition-of-layer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-fd-get-field-count + int "OGR_FD_GetFieldCount" (list '*) 20) + +(define (get-field-count-of-feature-definition h-defn) + "Fetch number of fields on the passed feature definition. + +Parameters: + h-defn: handle to the feature definition to get the fields count from." + (%ogr-fd-get-field-count h-defn)) + +(export get-field-count-of-feature-definition) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-fd-get-field-defn + '* "OGR_FD_GetFieldDefn" (list '* int) 20) + +(define (get-field-definition-of-feature-definition h-defn i-field) + "Fetch field definition of the passed feature definition. + +Parameters: + h-defn: handle to the feature definition to get the field definition from. + i-field: the field to fetch, between 0 and +(- (get-field-count-of-feature-definition) 1)." + (%ogr-fd-get-field-defn h-defn i-field)) + +(export get-field-definition-of-feature-definition) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-fld-get-type + int "OGR_Fld_GetType" (list '*) 20) + +(define (get-type-of-field h-defn) + "Fetch type of this field. See OFT_* enums for possible return values. + +Parameters: + h-defn: handle to the field definition to get type from." + (%ogr-fld-get-type h-defn)) + +(export get-type-of-field) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-integer + int "OGR_F_GetFieldAsInteger" (list '* int) 20) + +(define (get-field-as-integer h-feat i-field) + "Fetch field value as integer. + +OFTString features will be translated using atoi(). OFTReal fields will be cast +to integer. Other field types, or errors will result in a return value of zero. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (%ogr-f-get-field-as-integer h-feat i-field)) + +(export get-field-as-integer) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-integer64 + int64 "OGR_F_GetFieldAsInteger64" (list '* int) 20) + +(define (get-field-as-integer64 h-feat i-field) + "Fetch field value as integer 64 bit. + +OFTInteger are promoted to 64 bit. OFTReal fields will be cast to integer. +Other field types, or errors will result in a return value of zero. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (%ogr-f-get-field-as-integer64 h-feat i-field)) + +(export get-field-as-integer64) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-double + double "OGR_F_GetFieldAsDouble" (list '* int) 20) + +(define (get-field-as-double h-feat i-field) + "Fetch field value as a double. + +OFTString features will be translated using CPLAtof(). OFTInteger fields will +be cast to double. Other field types, or errors will result in a return value +of zero. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (%ogr-f-get-field-as-double h-feat i-field)) + +(export get-field-as-double) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-string + '* "OGR_F_GetFieldAsString" (list '* int) 20) + +(define (get-field-as-string h-feat i-field) + "Fetch field value as a string. + +OFTReal and OFTInteger fields will be translated to string using sprintf(), +but not necessarily using the established formatting rules. Other field types, +or errors will result in a return value of zero. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (pointer->string (%ogr-f-get-field-as-string h-feat i-field))) + +(export get-field-as-string) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-integer-list + '* "OGR_F_GetFieldAsIntegerList" (list '* int '*) 20) + +(define (get-field-as-integer-list h-feat i-field) + "Fetch field value as a list of integers. + +Currently this function only works for OFTIntegerList fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-count (make-bytevector (sizeof int))) + (bv-result (%ogr-f-get-field-as-integer-list h-feat + i-field + (bytevector->pointer + bv-count)))) + (pointer->list bv-result + (bytevector-s32-native-ref bv-count 0) + int32))) + +(export get-field-as-integer-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-integer64-list + '* "OGR_F_GetFieldAsInteger64List" (list '* int '*) 20) + +(define (get-field-as-integer64-list h-feat i-field) + "Fetch field value as a list of 64 bit integers. + +Currently this function only works for OFTInteger64List fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-count (make-bytevector (sizeof int))) + (bv-result (%ogr-f-get-field-as-integer64-list h-feat + i-field + (bytevector->pointer + bv-count)))) + (pointer->list bv-result + (bytevector-s32-native-ref bv-count 0) + int64))) + +(export get-field-as-integer64-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-double-list + '* "OGR_F_GetFieldAsDoubleList" (list '* int '*) 20) + +(define (get-field-as-double-list h-feat i-field) + "Fetch field value as a list of doubles. + +Currently this function only works for OFTRealList fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-count (make-bytevector (sizeof int))) + (bv-result (%ogr-f-get-field-as-double-list h-feat + i-field + (bytevector->pointer + bv-count)))) + (pointer->list bv-result + (bytevector-s32-native-ref bv-count 0) + double))) + +(export get-field-as-double-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-binary + '* "OGR_F_GetFieldAsBinary" (list '* int '*) 20) + +(define (get-field-as-binary h-feat i-field) + "Fetch field value as binary. + +This method only works for OFTBinary and OFTString fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-count (make-bytevector (sizeof int))) + (bv-result (%ogr-f-get-field-as-binary h-feat + i-field + (bytevector->pointer + bv-count)))) + (pointer->bytevector bv-result + (bytevector-s32-native-ref bv-count 0)))) + +(export get-field-as-binary) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-string-list + '* "OGR_F_GetFieldAsStringList" (list '* int) 20) + +(define (get-field-as-string-list h-feat i-field) + "Fetch field value as a list of strings. + +Currently this method only works for OFTStringList fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (pointerpointer->string-list (%ogr-f-get-field-as-string-list h-feat + i-field))) + +(export get-field-as-string-list) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-datetime + int "OGR_F_GetFieldAsDateTime" (list '* int '* '* '* '* '* '* '*) 20) + +(define (get-field-as-datetime h-feat i-field) + "Fetch field value as date and time. + +Currently this method only works for OFTDate, OFTTime and OFTDateTime fields. +Use get-field-as-datetime-ex for second with millisecond accuracy. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-year (make-bytevector (sizeof int))) + (bv-month (make-bytevector (sizeof int))) + (bv-day (make-bytevector (sizeof int))) + (bv-hour (make-bytevector (sizeof int))) + (bv-minute (make-bytevector (sizeof int))) + (bv-second (make-bytevector (sizeof int))) + (bv-tz (make-bytevector (sizeof int))) + (result (%ogr-f-get-field-as-datetime h-feat + i-field + (bytevector->pointer bv-year) + (bytevector->pointer bv-month) + (bytevector->pointer bv-day) + (bytevector->pointer bv-hour) + (bytevector->pointer bv-minute) + (bytevector->pointer bv-second) + (bytevector->pointer bv-tz)))) + (if (c-bool->boolean result) + (make-gdal-datetime (bytevector-s32-native-ref bv-year 0) + (bytevector-s32-native-ref bv-month 0) + (bytevector-s32-native-ref bv-day 0) + (bytevector-s32-native-ref bv-hour 0) + (bytevector-s32-native-ref bv-minute 0) + (bytevector-s32-native-ref bv-second 0) + (bytevector-s32-native-ref bv-tz 0)) + (error "failed to get datetime")))) + +(export get-field-as-datetime) + +;;------------------------------------------------------------------------------ + +(define-gdal-foreign %ogr-f-get-field-as-datetime-ex + int "OGR_F_GetFieldAsDateTimeEx" (list '* int '* '* '* '* '* '* '*) 20) + +(define (get-field-as-datetime-ex h-feat i-field) + "Fetch field value as date and time. + +Currently this method only works for OFTDate, OFTTime and OFTDateTime fields. + +Parameters: + h-feat: handle to the feature that owned the field. + i-field: the field to fetch, from 0 to GetFieldCount()-1" + (let* ((bv-year (make-bytevector (sizeof int))) + (bv-month (make-bytevector (sizeof int))) + (bv-day (make-bytevector (sizeof int))) + (bv-hour (make-bytevector (sizeof int))) + (bv-minute (make-bytevector (sizeof int))) + (bv-second (make-bytevector (sizeof int))) + (bv-tz (make-bytevector (sizeof int))) + (result (%ogr-f-get-field-as-datetime-ex + h-feat + i-field + (bytevector->pointer bv-year) + (bytevector->pointer bv-month) + (bytevector->pointer bv-day) + (bytevector->pointer bv-hour) + (bytevector->pointer bv-minute) + (bytevector->pointer bv-second) + (bytevector->pointer bv-tz)))) + (if (c-bool->boolean result) + (make-gdal-datetime (bytevector-s32-native-ref bv-year 0) + (bytevector-s32-native-ref bv-month 0) + (bytevector-s32-native-ref bv-day 0) + (bytevector-s32-native-ref bv-hour 0) + (bytevector-s32-native-ref bv-minute 0) + (bytevector-s32-native-ref bv-second 0) + (bytevector-s32-native-ref bv-tz 0)) + (error "failed to get datetime")))) + +(export get-field-as-datetime-ex) + +;;------------------------------------------------------------------------------ diff --git a/guix.scm b/guix.scm new file mode 100644 index 0000000..1b9d401 --- /dev/null +++ b/guix.scm @@ -0,0 +1,80 @@ +;;; guile-gdal --- FFI bindings for GDAL +;;; Copyright (c) 2021 Ahmet Artu Yildirim + +;;; Commentary: +;; +;; GNU Guix development package. To build and install, run: +;; +;; guix package -f guix.scm +;; +;; To use as the basis for a development environment, run: +;; +;; guix environment -l guix.scm +;; +;;; Code: + +(use-modules (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1) + (srfi srfi-26) + (guix gexp) + (guix packages) + (guix licenses) + (guix git-download) + (guix build-system gnu) + ((guix build utils) #:select (with-directory-excursion)) + (gnu packages) + (gnu packages autotools) + (gnu packages guile) + (gnu packages pkg-config) + (gnu packages geo) + (gnu packages texinfo)) + +(define %source-dir (dirname (current-filename))) + +(define git-file? + (let* ((pipe (with-directory-excursion %source-dir + (open-pipe* OPEN_READ "git" "ls-files"))) + (files (let loop ((lines '())) + (match (read-line pipe) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + (status (close-pipe pipe))) + (lambda (file stat) + (match (stat:type stat) + ('directory #t) + ((or 'regular 'symlink) + (any (cut string-suffix? <> file) files)) + (_ #f))))) + +(package + (name "guile-gdal") + (version "0.1.0") + (source (local-file %source-dir #:recursive? #t #:select? git-file?)) + (build-system gnu-build-system) + (arguments + '(#:configure-flags + (list (string-append "--with-libgdal-path=" (assoc-ref %build-inputs "gdal") "/lib/libgdal.so")) + #:make-flags '("GUILE_AUTO_COMPILE=0") + #:phases + (modify-phases %standard-phases + (add-after 'unpack 'bootstrap + (lambda _ (zero? (system* "sh" "bootstrap"))))))) + (native-inputs + `(("autoconf" ,autoconf) + ("automake" ,automake) + ("pkg-config" ,pkg-config) + ("texinfo" ,texinfo))) + (inputs + `(("guile" ,guile-2.2) + ("gdal" ,gdal) +)) + (synopsis "Guile bindings for GDAL") + (description "Guile-GDAL provides pure Guile Scheme bindings to the +GDAL C shared library via the foreign function interface.") + (home-page "https://gitlab.com/ayild/guile-gdal.git") + (license gpl3+)) + diff --git a/m4/guile.m4 b/m4/guile.m4 new file mode 100644 index 0000000..81b771d --- /dev/null +++ b/m4/guile.m4 @@ -0,0 +1,382 @@ +## Autoconf macros for working with Guile. +## +## Copyright (C) 1998,2001, 2006, 2010, 2012, 2013, 2014 Free Software Foundation, Inc. +## +## This library is free software; you can redistribute it and/or +## modify it under the terms of the GNU Lesser General Public License +## as published by the Free Software Foundation; either version 3 of +## the License, or (at your option) any later version. +## +## This library 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 +## Lesser General Public License for more details. +## +## You should have received a copy of the GNU Lesser General Public +## License along with this library; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301 USA + +# serial 10 + +## Index +## ----- +## +## GUILE_PKG -- find Guile development files +## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs +## GUILE_FLAGS -- set flags for compiling and linking with Guile +## GUILE_SITE_DIR -- find path to Guile "site" directories +## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value +## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module +## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module +## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable +## GUILE_MODULE_EXPORTS -- check if a module exports a variable +## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable + +## Code +## ---- + +## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged +## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory). + +# GUILE_PKG -- find Guile development files +# +# Usage: GUILE_PKG([VERSIONS]) +# +# This macro runs the @code{pkg-config} tool to find development files +# for an available version of Guile. +# +# By default, this macro will search for the latest stable version of +# Guile (e.g. 2.2), falling back to the previous stable version +# (e.g. 2.0) if it is available. If no guile-@var{VERSION}.pc file is +# found, an error is signalled. The found version is stored in +# @var{GUILE_EFFECTIVE_VERSION}. +# +# If @code{GUILE_PROGS} was already invoked, this macro ensures that the +# development files have the same effective version as the Guile +# program. +# +# @var{GUILE_EFFECTIVE_VERSION} is marked for substitution, as by +# @code{AC_SUBST}. +# +AC_DEFUN([GUILE_PKG], + [PKG_PROG_PKG_CONFIG + _guile_versions_to_search="m4_default([$1], [2.2 2.0 1.8])" + if test -n "$GUILE_EFFECTIVE_VERSION"; then + _guile_tmp="" + for v in $_guile_versions_to_search; do + if test "$v" = "$GUILE_EFFECTIVE_VERSION"; then + _guile_tmp=$v + fi + done + if test -z "$_guile_tmp"; then + AC_MSG_FAILURE([searching for guile development files for versions $_guile_versions_to_search, but previously found $GUILE version $GUILE_EFFECTIVE_VERSION]) + fi + _guile_versions_to_search=$GUILE_EFFECTIVE_VERSION + fi + GUILE_EFFECTIVE_VERSION="" + _guile_errors="" + for v in $_guile_versions_to_search; do + if test -z "$GUILE_EFFECTIVE_VERSION"; then + AC_MSG_NOTICE([checking for guile $v]) + PKG_CHECK_EXISTS([guile-$v], [GUILE_EFFECTIVE_VERSION=$v], []) + fi + done + + if test -z "$GUILE_EFFECTIVE_VERSION"; then + AC_MSG_ERROR([ +No Guile development packages were found. + +Please verify that you have Guile installed. If you installed Guile +from a binary distribution, please verify that you have also installed +the development packages. If you installed it yourself, you might need +to adjust your PKG_CONFIG_PATH; see the pkg-config man page for more. +]) + fi + AC_MSG_NOTICE([found guile $GUILE_EFFECTIVE_VERSION]) + AC_SUBST([GUILE_EFFECTIVE_VERSION]) + ]) + +# GUILE_FLAGS -- set flags for compiling and linking with Guile +# +# Usage: GUILE_FLAGS +# +# This macro runs the @code{pkg-config} tool to find out how to compile +# and link programs against Guile. It sets four variables: +# @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, and +# @var{GUILE_LTLIBS}. +# +# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that +# uses Guile header files. This is almost always just one or more @code{-I} +# flags. +# +# @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program +# against Guile. This includes @code{-lguile-@var{VERSION}} for the +# Guile library itself, and may also include one or more @code{-L} flag +# to tell the compiler where to find the libraries. But it does not +# include flags that influence the program's runtime search path for +# libraries, and will therefore lead to a program that fails to start, +# unless all necessary libraries are installed in a standard location +# such as @file{/usr/lib}. +# +# @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to +# libtool, respectively, to link a program against Guile. It includes flags +# that augment the program's runtime search path for libraries, so that shared +# libraries will be found at the location where they were during linking, even +# in non-standard locations. @var{GUILE_LIBS} is to be used when linking the +# program directly with the compiler, whereas @var{GUILE_LTLIBS} is to be used +# when linking the program is done through libtool. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_FLAGS], + [AC_REQUIRE([GUILE_PKG]) + PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION]) + + dnl GUILE_CFLAGS and GUILE_LIBS are already defined and AC_SUBST'd by + dnl PKG_CHECK_MODULES. But GUILE_LIBS to pkg-config is GUILE_LDFLAGS + dnl to us. + + GUILE_LDFLAGS=$GUILE_LIBS + + dnl Determine the platform dependent parameters needed to use rpath. + dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs + dnl the file gnulib/build-aux/config.rpath. + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LIBS], [$GUILE_LDFLAGS], []) + GUILE_LIBS="$GUILE_LDFLAGS $GUILE_LIBS" + AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes]) + GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS" + + AC_SUBST([GUILE_EFFECTIVE_VERSION]) + AC_SUBST([GUILE_CFLAGS]) + AC_SUBST([GUILE_LDFLAGS]) + AC_SUBST([GUILE_LIBS]) + AC_SUBST([GUILE_LTLIBS]) + ]) + +# GUILE_SITE_DIR -- find path to Guile site directories +# +# Usage: GUILE_SITE_DIR +# +# This looks for Guile's "site" directories. The variable @var{GUILE_SITE} will +# be set to Guile's "site" directory for Scheme source files (usually something +# like PREFIX/share/guile/site). @var{GUILE_SITE_CCACHE} will be set to the +# directory for compiled Scheme files also known as @code{.go} files +# (usually something like +# PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/site-ccache). +# @var{GUILE_EXTENSION} will be set to the directory for compiled C extensions +# (usually something like +# PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/extensions). The latter two +# are set to blank if the particular version of Guile does not support +# them. Note that this macro will run the macros @code{GUILE_PKG} and +# @code{GUILE_PROGS} if they have not already been run. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_SITE_DIR], + [AC_REQUIRE([GUILE_PKG]) + AC_REQUIRE([GUILE_PROGS]) + AC_MSG_CHECKING(for Guile site directory) + GUILE_SITE=`$PKG_CONFIG --print-errors --variable=sitedir guile-$GUILE_EFFECTIVE_VERSION` + AC_MSG_RESULT($GUILE_SITE) + if test "$GUILE_SITE" = ""; then + AC_MSG_FAILURE(sitedir not found) + fi + AC_SUBST(GUILE_SITE) + AC_MSG_CHECKING([for Guile site-ccache directory using pkgconfig]) + GUILE_SITE_CCACHE=`$PKG_CONFIG --variable=siteccachedir guile-$GUILE_EFFECTIVE_VERSION` + if test "$GUILE_SITE_CCACHE" = ""; then + AC_MSG_RESULT(no) + AC_MSG_CHECKING([for Guile site-ccache directory using interpreter]) + GUILE_SITE_CCACHE=`$GUILE -c "(display (if (defined? '%site-ccache-dir) (%site-ccache-dir) \"\"))"` + if test $? != "0" -o "$GUILE_SITE_CCACHE" = ""; then + AC_MSG_RESULT(no) + GUILE_SITE_CCACHE="" + AC_MSG_WARN([siteccachedir not found]) + fi + fi + AC_MSG_RESULT($GUILE_SITE_CCACHE) + AC_SUBST([GUILE_SITE_CCACHE]) + AC_MSG_CHECKING(for Guile extensions directory) + GUILE_EXTENSION=`$PKG_CONFIG --print-errors --variable=extensiondir guile-$GUILE_EFFECTIVE_VERSION` + AC_MSG_RESULT($GUILE_EXTENSION) + if test "$GUILE_EXTENSION" = ""; then + GUILE_EXTENSION="" + AC_MSG_WARN(extensiondir not found) + fi + AC_SUBST(GUILE_EXTENSION) + ]) + +# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs +# +# Usage: GUILE_PROGS([VERSION]) +# +# This macro looks for programs @code{guile} and @code{guild}, setting +# variables @var{GUILE} and @var{GUILD} to their paths, respectively. +# The macro will attempt to find @code{guile} with the suffix of +# @code{-X.Y}, followed by looking for it with the suffix @code{X.Y}, and +# then fall back to looking for @code{guile} with no suffix. If +# @code{guile} is still not found, signal an error. The suffix, if any, +# that was required to find @code{guile} will be used for @code{guild} +# as well. +# +# By default, this macro will search for the latest stable version of +# Guile (e.g. 2.2). x.y or x.y.z versions can be specified. If an older +# version is found, the macro will signal an error. +# +# The effective version of the found @code{guile} is set to +# @var{GUILE_EFFECTIVE_VERSION}. This macro ensures that the effective +# version is compatible with the result of a previous invocation of +# @code{GUILE_FLAGS}, if any. +# +# As a legacy interface, it also looks for @code{guile-config} and +# @code{guile-tools}, setting @var{GUILE_CONFIG} and @var{GUILE_TOOLS}. +# +# The variables are marked for substitution, as by @code{AC_SUBST}. +# +AC_DEFUN([GUILE_PROGS], + [AC_PATH_PROG(GUILE,guile) + _guile_required_version="m4_default([$1], [$GUILE_EFFECTIVE_VERSION])" + if test -z "$_guile_required_version"; then + _guile_required_version=2.0 + fi + if test "$GUILE" = "" ; then + AC_MSG_ERROR([guile required but not found]) + fi + AC_SUBST(GUILE) + + _guile_effective_version=`$GUILE -c "(display (effective-version))"` + if test -z "$GUILE_EFFECTIVE_VERSION"; then + GUILE_EFFECTIVE_VERSION=$_guile_effective_version + elif test "$GUILE_EFFECTIVE_VERSION" != "$_guile_effective_version"; then + AC_MSG_ERROR([found development files for Guile $GUILE_EFFECTIVE_VERSION, but $GUILE has effective version $_guile_effective_version]) + fi + + _guile_major_version=`$GUILE -c "(display (major-version))"` + _guile_minor_version=`$GUILE -c "(display (minor-version))"` + _guile_micro_version=`$GUILE -c "(display (micro-version))"` + _guile_prog_version="$_guile_major_version.$_guile_minor_version.$_guile_micro_version" + + AC_MSG_CHECKING([for Guile version >= $_guile_required_version]) + _major_version=`echo $_guile_required_version | cut -d . -f 1` + _minor_version=`echo $_guile_required_version | cut -d . -f 2` + _micro_version=`echo $_guile_required_version | cut -d . -f 3` + if test "$_guile_major_version" -gt "$_major_version"; then + true + elif test "$_guile_major_version" -eq "$_major_version"; then + if test "$_guile_minor_version" -gt "$_minor_version"; then + true + elif test "$_guile_minor_version" -eq "$_minor_version"; then + if test -n "$_micro_version"; then + if test "$_guile_micro_version" -lt "$_micro_version"; then + AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) + fi + fi + elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then + # Allow prereleases that have the right effective version. + true + else + as_fn_error $? "Guile $_guile_required_version required, but $_guile_prog_version found" "$LINENO" 5 + fi + else + AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) + fi + AC_MSG_RESULT([$_guile_prog_version]) + + AC_PATH_PROG(GUILD,guild) + AC_SUBST(GUILD) + + AC_PATH_PROG(GUILE_CONFIG,guile-config) + AC_SUBST(GUILE_CONFIG) + if test -n "$GUILD"; then + GUILE_TOOLS=$GUILD + else + AC_PATH_PROG(GUILE_TOOLS,guile-tools) + fi + AC_SUBST(GUILE_TOOLS) + ]) + +# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value +# +# Usage: GUILE_CHECK_RETVAL(var,check) +# +# @var{var} is a shell variable name to be set to the return value. +# @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and +# returning either 0 or non-#f to indicate the check passed. +# Non-0 number or #f indicates failure. +# Avoid using the character "#" since that confuses autoconf. +# +AC_DEFUN([GUILE_CHECK], + [AC_REQUIRE([GUILE_PROGS]) + $GUILE -c "$2" > /dev/null 2>&1 + $1=$? + ]) + +# GUILE_MODULE_CHECK -- check feature of a Guile Scheme module +# +# Usage: GUILE_MODULE_CHECK(var,module,featuretest,description) +# +# @var{var} is a shell variable name to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v. +# @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING). +# +AC_DEFUN([GUILE_MODULE_CHECK], + [AC_MSG_CHECKING([if $2 $4]) + GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3)))) + if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi + AC_MSG_RESULT($$1) + ]) + +# GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module +# +# Usage: GUILE_MODULE_AVAILABLE(var,module) +# +# @var{var} is a shell variable name to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# +AC_DEFUN([GUILE_MODULE_AVAILABLE], + [GUILE_MODULE_CHECK($1,$2,0,is available) + ]) + +# GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable +# +# Usage: GUILE_MODULE_REQUIRED(symlist) +# +# @var{symlist} is a list of symbols, WITHOUT surrounding parens, +# like: ice-9 common-list. +# +AC_DEFUN([GUILE_MODULE_REQUIRED], + [GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1)) + if test "$ac_guile_module_required" = "no" ; then + AC_MSG_ERROR([required guile module not found: ($1)]) + fi + ]) + +# GUILE_MODULE_EXPORTS -- check if a module exports a variable +# +# Usage: GUILE_MODULE_EXPORTS(var,module,modvar) +# +# @var{var} is a shell variable to be set to "yes" or "no". +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{modvar} is the Guile Scheme variable to check. +# +AC_DEFUN([GUILE_MODULE_EXPORTS], + [GUILE_MODULE_CHECK($1,$2,$3,exports `$3') + ]) + +# GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable +# +# Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar) +# +# @var{module} is a list of symbols, like: (ice-9 common-list). +# @var{modvar} is the Guile Scheme variable to check. +# +AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT], + [GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2) + if test "$guile_module_required_export" = "no" ; then + AC_MSG_ERROR([module $1 does not export $2; required]) + fi + ]) + +## guile.m4 ends here diff --git a/m4/m4_ax_lib_gdal.m4 b/m4/m4_ax_lib_gdal.m4 new file mode 100644 index 0000000..fbee866 --- /dev/null +++ b/m4/m4_ax_lib_gdal.m4 @@ -0,0 +1,153 @@ +# =========================================================================== +# https://www.gnu.org/software/autoconf-archive/ax_lib_gdal.html +# =========================================================================== +# +# SYNOPSIS +# +# AX_LIB_GDAL([MINIMUM-VERSION]) +# +# DESCRIPTION +# +# This macro provides tests of availability of GDAL/OGR library of +# particular version or newer. +# +# AX_LIB_GDAL macro takes only one argument which is optional. If there is +# no required version passed, then macro does not run version test. +# +# The --with-gdal option takes complete path to gdal-config utility, +# +# This macro calls AC_SUBST for: +# +# GDAL_VERSION +# GDAL_CFLAGS +# GDAL_LDFLAGS +# GDAL_DEP_LDFLAGS +# GDAL_OGR_ENABLED +# +# and AC_DEFINE for: +# +# HAVE_GDAL +# HAVE_GDAL_OGR +# +# LICENSE +# +# Copyright (c) 2011 Mateusz Loskot +# Copyright (c) 2011 Alessandro Candini +# +# Copying and distribution of this file, with or without modification, are +# permitted in any medium without royalty provided the copyright notice +# and this notice are preserved. This file is offered as-is, without any +# warranty. + +#serial 5 + +AC_DEFUN([AX_LIB_GDAL], +[ + dnl If gdal-config path is not given in ---with-gdal option, + dnl check if it is present in the system anyway + AC_ARG_WITH([gdal], + AS_HELP_STRING([--with-gdal=@<:@ARG@:>@], + [Specify full path to gdal-config script]), + [ac_gdal_config_path=$withval], + [gdal_config_system=check]) + + dnl if gdal-config is present in the system, fill the ac_gdal_config_path variable with it full path + AS_IF([test "x$gdal_config_system" = xcheck], + [AC_PATH_PROG([GDAL_CONFIG], [gdal-config])], + [AC_PATH_PROG([GDAL_CONFIG], [gdal-config], + [no], [`dirname $ac_gdal_config_path 2> /dev/null`])] + ) + + if test ! -x "$GDAL_CONFIG"; then + AC_MSG_ERROR([gdal-config does not exist or it is not an executable file]) + GDAL_CONFIG="no" + found_gdal="no" + fi + + GDAL_VERSION="" + GDAL_CFLAGS="" + GDAL_LDFLAGS="" + GDAL_DEP_LDFLAGS="" + GDAL_OGR_ENABLED="" + + + dnl + dnl Check GDAL library (libgdal) + dnl + + if test "$GDAL_CONFIG" != "no"; then + AC_MSG_CHECKING([for GDAL library]) + + GDAL_VERSION="`$GDAL_CONFIG --version`" + GDAL_CFLAGS="`$GDAL_CONFIG --cflags`" + GDAL_LDFLAGS="`$GDAL_CONFIG --libs`" + GDAL_DEP_LDFLAGS="`$GDAL_CONFIG --dep-libs`" + + AC_DEFINE([HAVE_GDAL], [1], [Define to 1 if GDAL library are available]) + + found_gdal="yes" + else + found_gdal="no" + fi + + AC_MSG_RESULT([$found_gdal]) + + if test "$found_gdal" = "yes"; then + AC_MSG_CHECKING([for OGR support in GDAL library]) + + GDAL_OGR_ENABLED="`$GDAL_CONFIG --ogr-enabled`" + AC_DEFINE([HAVE_GDAL_OGR], [1], [Define to 1 if GDAL library includes OGR support]) + + AC_MSG_RESULT([$GDAL_OGR_ENABLED]) + fi + + dnl + dnl Check if required version of GDAL is available + dnl + + gdal_version_req=ifelse([$1], [], [], [$1]) + if test "$found_gdal" = "yes" -a -n "$gdal_version_req"; then + + AC_MSG_CHECKING([if GDAL version is >= $gdal_version_req]) + + dnl Decompose required version string of GDAL + dnl and calculate its number representation + gdal_version_req_major=`expr $gdal_version_req : '\([[0-9]]*\)'` + gdal_version_req_minor=`expr $gdal_version_req : '[[0-9]]*\.\([[0-9]]*\)'` + gdal_version_req_micro=`expr $gdal_version_req : '[[0-9]]*\.[[0-9]]*\.\([[0-9]]*\)'` + if test "x$gdal_version_req_micro" = "x"; then + gdal_version_req_micro="0" + fi + + gdal_version_req_number=`expr $gdal_version_req_major \* 1000000 \ + \+ $gdal_version_req_minor \* 1000 \ + \+ $gdal_version_req_micro` + + dnl Decompose version string of installed GDAL + dnl and calculate its number representation + gdal_version_major=`expr $GDAL_VERSION : '\([[0-9]]*\)'` + gdal_version_minor=`expr $GDAL_VERSION : '[[0-9]]*\.\([[0-9]]*\)'` + gdal_version_micro=`expr $GDAL_VERSION : '[[0-9]]*\.[[0-9]]*\.\([[0-9]]*\)'` + if test "x$gdal_version_micro" = "x"; then + gdal_version_micro="0" + fi + + gdal_version_number=`expr $gdal_version_major \* 1000000 \ + \+ $gdal_version_minor \* 1000 \ + \+ $gdal_version_micro` + + gdal_version_check=`expr $gdal_version_number \>\= $gdal_version_req_number` + if test "$gdal_version_check" = "1"; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + AC_MSG_ERROR([GDAL $GDAL_VERSION found, but required version is $gdal_version_req]) + fi + fi + + AC_SUBST(GDAL_VERSION) + AC_SUBST(GDAL_CFLAGS) + AC_SUBST(GDAL_LDFLAGS) + AC_SUBST(GDAL_DEP_LDFLAGS) + AC_SUBST(GDAL_OGR_ENABLED) +]) diff --git a/pre-inst-env.in b/pre-inst-env.in new file mode 100644 index 0000000..8af0b69 --- /dev/null +++ b/pre-inst-env.in @@ -0,0 +1,32 @@ +#!/bin/sh + +# guile-gdal --- FFI bindings for gdal +# Copyright (c) 2021 Ahmet Artu Yildirim +# +# This file is part of guile-gdal. +# +# Guile-gdal is free software; you can redistribute it and/or modify +# it under the terms of the GNU Lesser General Public License as +# published by the Free Software Foundation; either version 3 of the +# License, or (at your option) any later version. +# +# Guile-gdal 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 Lesser General Public +# License along with guile-gdal. If not, see +# . + +abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" +abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" + +GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" +GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" +export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH + +PATH="$abs_top_builddir:$PATH" +export PATH + +exec "$@"