From 4bd1e92bf085cc8957043dd40a25d27f207397a0 Mon Sep 17 00:00:00 2001 From: Ahmet Artu Yildirim Date: Thu, 7 Oct 2021 22:02:10 -0700 Subject: [PATCH] Initialize project --- .gitignore | 14 + AUTHORS | 0 COPYING | 674 +++++ Makefile.am | 24 + README.md | 65 + TODO | 0 bootstrap | 3 + configure.ac | 55 + examples/raster/raster-small.txt | 13 + examples/raster/read-raster.scm | 35 + examples/raster/write-raster.scm | 34 + gdal.scm | 4678 ++++++++++++++++++++++++++++++ gdal/config.scm.in | 11 + gdal/extension.scm | 371 +++ gdal/internal.scm | 209 ++ gdal/ogr.scm | 446 +++ guix.scm | 80 + m4/guile.m4 | 382 +++ m4/m4_ax_lib_gdal.m4 | 153 + pre-inst-env.in | 32 + 20 files changed, 7279 insertions(+) create mode 100644 .gitignore create mode 100644 AUTHORS create mode 100644 COPYING create mode 100644 Makefile.am create mode 100644 README.md create mode 100644 TODO create mode 100755 bootstrap create mode 100644 configure.ac create mode 100644 examples/raster/raster-small.txt create mode 100755 examples/raster/read-raster.scm create mode 100755 examples/raster/write-raster.scm create mode 100644 gdal.scm create mode 100644 gdal/config.scm.in create mode 100644 gdal/extension.scm create mode 100644 gdal/internal.scm create mode 100644 gdal/ogr.scm create mode 100644 guix.scm create mode 100644 m4/guile.m4 create mode 100644 m4/m4_ax_lib_gdal.m4 create mode 100644 pre-inst-env.in 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 "$@" -- 2.20.1