cairo-ocaml-1.2.0/000077500000000000000000000000001136043615400137035ustar00rootroot00000000000000cairo-ocaml-1.2.0/.cvsignore000066400000000000000000000001151136043615400157000ustar00rootroot00000000000000aclocal.m4 autom4te.cache config.log config.make config.status configure doc cairo-ocaml-1.2.0/.gitignore000066400000000000000000000003151136043615400156720ustar00rootroot00000000000000# ignore build-related files src/.depend # ignore object files *.[oa] *.so *.cm[iox] *.cma *.cmxa # ignore autoconf-related files aclocal.m4 autom4te.cache config.log config.make config.status configure cairo-ocaml-1.2.0/COPYING000066400000000000000000000636401136043615400147470ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, 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 this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), 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 distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser 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 Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "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 LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY 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 LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey 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 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 2.1 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! cairo-ocaml-1.2.0/ChangeLog000066400000000000000000000214361136043615400154630ustar00rootroot000000000000002007-11-04 Olivier Andrieu * src/ml_cairo.c: fix a C compiler warning * src/cairo.ml, src/ml_cairo_font.c: fix typos 2007-08-27 Olivier Andrieu * src/ml_cairo_bigarr.c: fix compilation with OCaml 3.10 2006-11-09 Olivier Andrieu * configure.ac: require cairo 1.2, bump version number to 1.2 * src/*: syc with cairo 1.2 * src/ml_cairo_lablgtk.c: require GTK+ 2.8 now 2006-02-09 Olivier Andrieu * src/cairo_svg.mli, src/cairo_svg.mli, src/ml_cairo_svg.c: support for the SVG backend. * test/basket.ml: test SVG output. 2005-12-13 Olivier Andrieu * src/cairo_ps.mli, src/cairo_ps.mli, src/ml_cairo_ps.c: add Cairo_ps.set_dpi * src/Makefile, src*gtkcairo*: drop gtkcairo support. * src/*lablgtk*: sync cairo_lablgtk module with the gdk_cairo_* API of GTK+ 2.8. * test/*: adapt 2005-11-03 Olivier Andrieu * configure.ac: require cairo 1.0, bump version number to 1.0 * src/cairo.ml, src/cairo.mli, src/ml_cairo.c: version information APIs 2005-11-03 Olivier Andrieu * src/ml_cairo_pattern.c, src/ml_cairo_matrix.c, src/ml_cairo.c: fixes for archs with ARCH_ALIGN_DOUBLE (patch from Samuel Mimram). 2005-09-14 Carl Worth * configure.ac: Add freetype2 to PKG_CHECK_MODULES call in addition to cairo. * src/Makefile: Remove .depend as part of make clean. 2005-08-11 Olivier Andrieu * src/* : adapt to cairo-0.9.0 * configure.ac: bump version number to 0.9.0.0 2005-08-11 Olivier Andrieu * src/* : adapt to cairo-0.6.0 * Makefile, config.make.in, configure.ac: specify version number in the configure.ac file 2005-07-18 Olivier Andrieu * src/cairo_ft.ml, src/cairo_ft.mli, src/ml_cairo_ft.c: re-enable freetype font backend bindings * test/font.ml: adapt * src/cairo.mli, src/cairo_png.mli: use `Any surface instead of 'a surface everywhere 2005-07-18 Olivier Andrieu * configure.ac, README: require cairo 0.5.2 * src/*: adapt to cairo 0.5.1 and 0.5.2 API changes (new status values and functions, new pattern functions) * test/knockout.ml: adapt to API change 2005-05-27 Olivier Andrieu * src/cairo.ml, src/cairo.mli: remove BAD_NESTING error status * src/cairo_pdf.*, src/cairo_ps.*, src/cairo_png.*: surface creation function take an ocaml channel as argument * src/ml_cairo.c: new stream functions for ocaml channels support * src/ml_cairo_*.c: adapt, some code cleanups * test/basket.ml: adapt, some fixes 2005-05-22 Olivier Andrieu * src/*: adjust to big API shakeup. Remove Cairo_channel module, add Cairo_ps, Cairo_pdf, Cairo_png. GtkCairo and Cairo_ft disabled for now. * test/*: adjust to big API shakeup. * configure.ac, README: require cairo 0.5.0 2005-03-08 Olivier Andrieu * src/ml_cairo_ft.c, src/cairo_ft.ml, src/cairo_ft.mli: * src/ml_cairo.c, src/cairo.ml, src/cairo.mli: adjust to API changes * src/ml_cairo.c (cairo_current_font): adjust reference counting 2005-03-01 Olivier Andrieu * src/ml_svg_cairo.c, src/svg_cairo.ml, src/svg_cairo.mli : add libsvg-cairo bindings * test/svg2png.ml : ocaml version of svg2png * * : configure stuff 2005-02-27 Olivier Andrieu * test/Makefile, test/kapow.ml : add the kapow example program. 2005-01-26 Olivier Andrieu * configure.ac: require cairo 0.3.0 * support/ocaml.m4 : quote stuff to stop auto* moaning. * src/cairo_channel.ml*: add .ml file, add convenience function Cairo_channel.open_out. * src/cairo.ml*, src/ml_cairo.c: add PDF backend, add status querying functions, a Cairo.copy convenience function. * src/*.c: some tidying. 2004-11-08 Olivier Andrieu * configure.ac: require Cairo 0.2.0 * src/ml_cairo.c (ml_cairo_current_font): do not increase the refcount. 2004-11-01 Olivier Andrieu * src/cairo.ml, src/cairo.mli, src/ml_cairo.c: use int instead of float for the width and height of the PNG target * src/cairo_ft.ml, src/cairo_ft.mli, src/ml_cairo_ft.c: minimal support for freetype/fontconfig font backend. * test/font.ml: example/test program 2004-10-28 Olivier Andrieu * src/*.c: beautify code, run it through indent. * src/ml_cairo.[ch]: direcly map enums to caml variants. * configure.ac: do not fail if GTK+ is missing. * test/spline.ml: do not use POINTER_MOTION_HINT, apparently that's evil. 2004-10-18 Olivier Andrieu * src/cairo.ml, src/cairo.mli: s/ct/cr/ * src/ml_cairo_wrappers.[ch]: add comparison and hash function for custom values. * src/cairo.{ml,mli}, src/ml_cairo.[ch], src/ml_cairo_status.[ch]: allow suspending raise of exception on error. 2004-07-06 Olivier Andrieu * src/cairo_gtkcairo.ml, src/cairo_gtkcairo.mli: the signal is now "paint" 2004-06-18 Olivier Andrieu * src/cairo.mli: doc formatting * src/ml_cairo.c, src/ml_cairo_wrappers.h: silence compiler warnings 2004-04-16 Olivier Andrieu * src/cairo.ml, src/cairo.mli: support patterns * configure.ac: require Cairo 0.1.21 * test/knockout.ml: update for pattern 2004-03-24 Olivier Andrieu * src/cairo.ml, src/cairo.mli: add line_to_point and curve_to_point for consistency. 2004-03-24 Olivier Andrieu * src/Makefile, src/ocairo*, src/cairo_lablgtk.*, src/cairo_gtkcairo.*: get rid of the mostly useless OO version of the API. * test/Makefile, test/oknockout.ml, test/spline.ml, test/cube.ml: update examples accordingly. 2004-02-22 Olivier Andrieu * Makefile, src/cairo.ml, src/cairo.mli, src/ocairo.ml, src/ocairo.mli, src/ml_cairo.c, src/ml_cairo_bigarr.c, src/ml_cairo_channel.c, src/ml_cairo_wrappers.h: * make the code safer for exotic archs (WIN32, ARCH_ALIGN_DOUBLE) * rename ps_finalise to finalise * test/Makefile, test/demo.ml: added a translation of cairo-demo.c * src/cairo.ml, src/cairo.mli, src/ml_cairo.c, src/ml_cairo.h, src/ml_cairo_lablgtk.c, src/Makefile, src/ml_cairo_path.c, test/basket.ml: added support for cairo_current_path and cairo_current_path_flat. 2003-12-17 02:15 Olivier Andrieu * configure.ac, src/cairo.ml, src/cairo.mli, src/ml_cairo.c, src/ml_cairo_bigarr.c, src/ocairo.ml, src/ocairo.mli, test/Makefile, test/text.ml: text API work 2003-12-13 15:10 Olivier Andrieu * configure.ac, src/ml_cairo.c: optional PS backend 2003-12-05 23:34 Olivier Andrieu * src/ml_cairo_lablgtk.c: drop cairo-config.h 2003-12-05 17:54 Carl Worth * configure.ac, src/ml_cairo_lablgtk.c, ChangeLog: * src/ml_cairo_lablgtk.c (cairo_lablgtk_surface_create_for_drawable): Track cairo change from CAIRO_HAS_XLIB_BACKEND to CAIRO_HAS_XLIB_SURFACE. * configure.ac: Now depend on cairo >= 0.1.15 2003-12-05 01:02 Olivier Andrieu * src/ml_cairo_lablgtk.c: add missing cairo-config include 2003-12-04 19:35 Olivier Andrieu * configure.ac, src/ml_cairo_lablgtk.c: new xlib backend config stuff 2003-12-03 23:17 Olivier Andrieu * .cvsignore, src/ocairo_gtkcairo.ml, src/ocairo_gtkcairo.mli, test/cube.ml: support redraw signal of GtkCairo 2003-11-26 20:45 tag cairo-ocaml-0-2 2003-11-26 20:45 Olivier Andrieu * Makefile, config.make.in, src/Makefile: added dist Makefile target 2003-11-22 16:28 Olivier Andrieu * support/ocaml.m4: update ocaml.m4 2003-11-22 16:27 Olivier Andrieu * src/ml_cairo.c: forgot some Double_array_tag 2003-11-22 16:24 Olivier Andrieu * src/: ml_cairo.h, ml_cairo_lablgtk.c: use a Val_cairo_format_t 2003-11-18 20:18 Olivier Andrieu * configure.ac: check for lablgtk2 specifically 2003-11-18 20:15 Olivier Andrieu * src/: cairo.ml, cairo.mli, ocairo.ml, ocairo.mli: add Cairo.move_to_point and changed field names for Cairo.glyph 2003-11-18 20:14 Olivier Andrieu * src/ml_cairo.c: missing bytecode functions 2003-11-18 20:02 tag cairo-ocaml-0-1 cairo-ocaml-1.2.0/Makefile000066400000000000000000000013011136043615400153360ustar00rootroot00000000000000 all opt doc install clean : $(MAKE) -C src $@ DISTSRC = aclocal.m4 config.make.in configure configure.ac Makefile Makefile.rules \ doc support/install-sh support/ocaml.m4 \ src/*.ml src/*.mli src/*.c src/*.h src/Makefile src/.depend_c \ test/Makefile test/*.ml dist : doc export DIRNAME=$${PWD##*/} && \ cd .. && mv $$DIRNAME cairo-ocaml-$(VERSION) && \ tar zcvf cairo-ocaml-$(VERSION).tar.gz $(addprefix cairo-ocaml-$(VERSION)/,$(DISTSRC)) && \ mv cairo-ocaml-$(VERSION) $$DIRNAME configure : configure.ac aclocal -I support autoconf config.make : config.make.in configure $(error run ./configure) include config.make .PHONY : all opt doc install clean cairo-ocaml-1.2.0/Makefile.rules000066400000000000000000000002531136043615400164740ustar00rootroot00000000000000%.cmo : %.ml $(OCAMLC) -c $(INCFLAGS) $< %.cmx : %.ml $(OCAMLOPT) -c $(INCFLAGS) $< %.cmi : %.mli $(OCAMLC) $(INCFLAGS) $< %.o : %.c $(OCAMLC) -ccopt "$(CPPFLAGS)" $< cairo-ocaml-1.2.0/README000066400000000000000000000016571136043615400145740ustar00rootroot00000000000000cairo-ocaml -- Objective Caml bindings for Cairo http://cairographics.org/cairo-ocaml Compiling ========= $ aclocal -I support $ autoconf $ ./configure $ make configure will try to detect a LablGTK installation by scanning some directories (+lablgtk2 and +lablgtk). If LablGTK is installed elsewhere, specify the path with the LABLGTKDIR environment variable. If you want to disable LablGTK support, run configure with --without-gtk option. Dependencies ============ ocaml >= 3.10 cairo >= 1.2.0 libsvg-cairo optional >= 0.1.5 libpangocairo optional LablGTK optional, GTK+ >= 2.8 Documentation ============= Reference documentation can be generated by ocamldoc with a: $ make doc and is also available here: http://oandrieu.nerim.net/ocaml/cairo/doc/ Author ====== Olivier Andrieu Pango_cairo support started by: Richard Jones or cairo-ocaml-1.2.0/config.make.in000066400000000000000000000016041136043615400164150ustar00rootroot00000000000000 VERSION = @PACKAGE_VERSION@ OCAMLC = @OCAMLC@ OCAMLOPT = @OCAMLOPT@ OCAMLMKLIB = @OCAMLMKLIB@ OCAMLLIB = @OCAMLLIB@ OCAMLDOC = @OCAMLDOC@ OCAMLDEP = @OCAMLDEP@ INSTALLDIR = $(OCAMLLIB)/cairo LABLGTKDIR = @LABLGTKDIR@ C_LABLGTKDIR = $(subst +,$(OCAMLLIB)/,$(LABLGTKDIR)) # stop ocamlmklib moaning FILT = -Wl,--export-dynamic CAIRO_CFLAGS = @CAIRO_CFLAGS@ CAIRO_LIBS = $(filter-out $(FILT),@CAIRO_LIBS@) GDK_CFLAGS = @GDK_CFLAGS@ GDK_LIBS = $(filter-out $(FILT),@GDK_LIBS@) LIBSVG_CAIRO_CFLAGS = @LIBSVG_CAIRO_CFLAGS@ LIBSVG_CAIRO_LIBS = @LIBSVG_CAIRO_LIBS@ LIBPANGOCAIRO_CFLAGS = @LIBPANGOCAIRO_CFLAGS@ LIBPANGOCAIRO_LIBS = @LIBPANGOCAIRO_LIBS@ cobjs = $(patsubst %.c, %.o, $(filter %.c,$(1))) mlintfs = $(patsubst %.mli, %.cmi, $(filter %.mli,$(1))) mlobjs = $(patsubst %.ml, %.cmo, $(filter %.ml,$(1))) mloptobjs = $(patsubst %.ml, %.cmx, $(filter %.ml,$(1))) cairo-ocaml-1.2.0/configure.ac000066400000000000000000000021661136043615400161760ustar00rootroot00000000000000AC_INIT(CAIRO_OCAML, 1.2.0) AC_CONFIG_SRCDIR(src/cairo.ml) AC_CONFIG_AUX_DIR(support) # Check for OCaml programs AC_PROG_OCAML() # Check for cairo PKG_CHECK_MODULES(CAIRO, cairo >= 1.2 freetype2) # Optional GTK support (for the X11 backend) AC_ARG_WITH(gtk, AS_HELP_STRING([--with-gtk],[Cairo/GTK+ integration via LablGTK]), use_gtk=$withval, use_gtk=yes) AC_ARG_VAR(LABLGTKDIR,[Location of the LablGTK library]) if test $use_gtk = yes ; then # Check for LablGTK AC_CHECK_OCAML_MODULE(lablgtk, LABLGTKDIR, Gobject, +lablgtk2 +lablgtk) if test "$LABLGTKDIR" ; then # Check for gdk-pixbuf PKG_CHECK_MODULES(GDK, cairo gdk-2.0 >= 2.8 gdk-pixbuf-2.0, :, use_gtk=no) else use_gtk=no fi fi # Optional libsvg-cairo support PKG_CHECK_MODULES(LIBSVG_CAIRO, libsvg-cairo, use_libsvg_cairo=yes, use_libsvg_cairo=no) # Optional pango-cairo support PKG_CHECK_MODULES(LIBPANGOCAIRO, pangocairo, use_libpangocairo=yes, use_libpangocairo=no) echo echo " GTK+ support: $use_gtk" echo " libsvg-cairo support: $use_libsvg_cairo" echo " libpangocairo support: $use_libpangocairo" echo AC_OUTPUT(config.make) cairo-ocaml-1.2.0/src/000077500000000000000000000000001136043615400144725ustar00rootroot00000000000000cairo-ocaml-1.2.0/src/.depend_c000066400000000000000000000022611136043615400162350ustar00rootroot00000000000000ml_cairo_bigarr.o: ml_cairo_bigarr.c ml_cairo.h ml_cairo_wrappers.h ml_cairo.o: ml_cairo.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_font.o: ml_cairo_font.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_ft.o: ml_cairo_ft.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_glitz.o: ml_cairo_glitz.c ml_cairo_wrappers.h ml_cairo_glitz.h \ glitz.tags ml_cairo.h ml_cairo_gtkcairo.o: ml_cairo_gtkcairo.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_lablgtk.o: ml_cairo_lablgtk.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_matrix.o: ml_cairo_matrix.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_path.o: ml_cairo_path.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_pattern.o: ml_cairo_pattern.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_pdf.o: ml_cairo_pdf.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_png.o: ml_cairo_png.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_ps.o: ml_cairo_ps.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_status.o: ml_cairo_status.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_surface.o: ml_cairo_surface.c ml_cairo.h ml_cairo_wrappers.h ml_cairo_wrappers.o: ml_cairo_wrappers.c ml_cairo_wrappers.h ml_glitz_glx.o: ml_glitz_glx.c ml_cairo_wrappers.h ml_cairo_glitz.h ml_svg_cairo.o: ml_svg_cairo.c ml_cairo.h ml_cairo_wrappers.h cairo-ocaml-1.2.0/src/Makefile000066400000000000000000000113431136043615400161340ustar00rootroot00000000000000 include ../config.make CPPFLAGS = -g TARGETS = cairo ifdef LABLGTKDIR TARGETS += lablgtk endif ifdef LIBSVG_CAIRO_CFLAGS TARGETS += svgcairo endif ifdef LIBPANGOCAIRO_CFLAGS TARGETS += pangocairo endif all : $(TARGETS) $(if $(OCAMLOPT),opt) opt : $(addsuffix .opt,$(TARGETS)) cairo : cairo.cma libmlcairo.a cairo.opt : cairo.cmxa dllmlcairo.so lablgtk : cairo_lablgtk.cma libmlcairo_lablgtk.a lablgtk.opt : cairo_lablgtk.cmxa dllmlcairo_lablgtk.so gtkcairo : gtkcairo.cma libmlgtkcairo.a gtkcairo.opt : gtkcairo.cmxa dllmlgtkcairo.so svgcairo : svg_cairo.cma libmlsvgcairo.a svgcairo.opt : svg_cairo.cmxa dllmlsvgcairo.so pangocairo : pango_cairo.cma libmlpangocairo.a pangocairo.opt : pango_cairo.cmxa dllmlpangocairo.so cairo_SRC = cairo.mli cairo.ml \ cairo_bigarray.mli cairo_bigarray.ml \ cairo_png.mli cairo_png.ml \ cairo_pdf.mli cairo_pdf.ml \ cairo_ps.mli cairo_ps.ml \ cairo_svg.mli cairo_svg.ml \ cairo_ft.mli cairo_ft.ml \ ml_cairo_wrappers.c \ ml_cairo.c ml_cairo_status.c ml_cairo_bigarr.c ml_cairo_path.c \ ml_cairo_surface.c ml_cairo_pattern.c ml_cairo_matrix.c \ ml_cairo_font.c ml_cairo_ft.c \ ml_cairo_png.c ml_cairo_pdf.c ml_cairo_ps.c ml_cairo_svg.c cairo.cma : $(call mlobjs,$(cairo_SRC)) $(OCAMLMKLIB) -o cairo -oc mlcairo $^ $(CAIRO_LIBS) cairo.cmxa : $(call mloptobjs,$(cairo_SRC)) $(OCAMLMKLIB) -o cairo -oc mlcairo $^ $(CAIRO_LIBS) libmlcairo.a dllmlcairo.so : $(call cobjs,$(cairo_SRC)) $(OCAMLMKLIB) -o cairo -oc mlcairo $^ $(CAIRO_LIBS) lablgtk_SRC = cairo_lablgtk.mli cairo_lablgtk.ml ml_cairo_lablgtk.c cairo_lablgtk.cma : $(call mlobjs,$(lablgtk_SRC)) $(OCAMLMKLIB) -o cairo_lablgtk -oc mlcairo_lablgtk $^ cairo_lablgtk.cmxa : $(call mloptobjs,$(lablgtk_SRC)) $(OCAMLMKLIB) -o cairo_lablgtk -oc mlcairo_lablgtk $^ libmlcairo_lablgtk.a dllmlcairo_lablgtk.so : $(call cobjs,$(lablgtk_SRC)) $(OCAMLMKLIB) -o cairo_lablgtk -oc mlcairo_lablgtk $^ svgcairo_SRC = svg_cairo.mli svg_cairo.ml ml_svg_cairo.c svg_cairo.cma : $(call mlobjs,$(svgcairo_SRC)) $(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS) svg_cairo.cmxa : $(call mloptobjs,$(svgcairo_SRC)) $(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS) libmlsvgcairo.a dllmlsvgcairo.so : $(call cobjs,$(svgcairo_SRC)) $(OCAMLMKLIB) -o svg_cairo -oc mlsvgcairo $^ $(LIBSVG_CAIRO_LIBS) pangocairo_SRC = pango_cairo.mli pango_cairo.ml ml_pango_cairo.c pango_cairo.cma : $(call mlobjs,$(pangocairo_SRC)) $(OCAMLMKLIB) -o pango_cairo -oc mlpangocairo $^ $(LIBPANGOCAIRO_LIBS) pango_cairo.cmxa : $(call mloptobjs,$(pangocairo_SRC)) $(OCAMLMKLIB) -o pango_cairo -oc mlpangocairo $^ $(LIBPANGO_CAIRO_LIBS) libmlpangocairo.a dllmlpangocairo.so : $(call cobjs,$(pangocairo_SRC)) $(OCAMLMKLIB) -o pango_cairo -oc mlpangocairo $^ $(LIBPANGOCAIRO_LIBS) $(call cobjs,$(cairo_SRC)) : CPPFLAGS+=$(CAIRO_CFLAGS) $(call cobjs,$(lablgtk_SRC)) : CPPFLAGS+=$(GDK_CFLAGS) -I$(C_LABLGTKDIR) $(call cobjs,$(svgcairo_SRC)) : CPPFLAGS+=$(LIBSVG_CAIRO_CFLAGS) $(call cobjs,$(pangocairo_SRC)) : CPPFLAGS+=$(LIBPANGOCAIRO_CFLAGS) $(GDK_CFLAGS) -I$(C_LABLGTKDIR) $(call mlobjs,$(lablgtk_SRC)) : INCFLAGS=-I $(LABLGTKDIR) $(call mlintfs,$(lablgtk_SRC)) : INCFLAGS=-I $(LABLGTKDIR) $(call mloptobjs,$(lablgtk_SRC)) : INCFLAGS=-I $(LABLGTKDIR) $(call mlobjs,$(pangocairo_SRC)) : INCFLAGS=-I $(LABLGTKDIR) $(call mlintfs,$(pangocairo_SRC)) : INCFLAGS=-I $(LABLGTKDIR) $(call mloptobjs,$(pangocairo_SRC)) : INCFLAGS=-I $(LABLGTKDIR) install: all mkdir -p $(DESTDIR)$(INSTALLDIR) $(DESTDIR)$(OCAMLLIB)/stublibs install -m 644 *.mli *.cmi *.cma lib*.a $(DESTDIR)$(INSTALLDIR) ifdef OCAMLOPT install -m644 *.cmxa *.a *.cmx $(DESTDIR)$(INSTALLDIR) endif install -m 755 dll*.so $(DESTDIR)$(INSTALLDIR) if test -w $(DESTDIR)$(OCAMLLIB)/stublibs ; then \ for lib in dll*.so ; do \ ln -s $(INSTALLDIR)/$$lib $(DESTDIR)$(OCAMLLIB)/stublibs ; done ; fi DOCFILES = cairo.mli cairo_bigarray.mli cairo_png.mli cairo_pdf.mli cairo_ps.mli cairo_ft.mli ifdef LABLGTKDIR DOCFILES += cairo_lablgtk.mli endif ifdef LIBSVG_CAIRO_CFLAGS DOCFILES += svg_cairo.mli endif ifdef LIBPANGOCAIRO_CFLAGS DOCFILES += pango_cairo.mli endif doc: $(DOCFILES:%.mli=%.cmi) mkdir -p ../doc/html ocamldoc -v -html -d ../doc/html -t Cairo-ocaml $(if $(LABLGTKDIR),-I $(LABLGTKDIR)) $(DOCFILES) clean : rm -f *.cm* *.o *.a *.so .depend .depend : $(wildcard *.ml *.mli) @echo "making deps" @$(OCAMLDEP) $(if $(LABLGTKDIR),-I $(LABLGTKDIR)) $^ > $@ -include .depend -include .depend_c depend : .depend $(wildcard *.h *.c) gcc -MM -isystem $(OCAMLLIB) -isystem $(C_LABLGTKDIR) $(patsubst -I%,-isystem %,$(GDK_CFLAGS)) $(filter %.c,$^) > .depend_c .PHONY : cairo lablgtk gtkcairo doc include ../Makefile.rules cairo-ocaml-1.2.0/src/cairo.ml000066400000000000000000000526441136043615400161340ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type status = SUCCESS | NO_MEMORY | INVALID_RESTORE | INVALID_POP_GROUP | NO_CURRENT_POINT | INVALID_MATRIX | INVALID_STATUS | NULL_POINTER | INVALID_STRING | INVALID_PATH_DATA | READ_ERROR | WRITE_ERROR | SURFACE_FINISHED | SURFACE_TYPE_MISMATCH | PATTERN_TYPE_MISMATCH | INVALID_CONTENT | INVALID_FORMAT | INVALID_VISUAL | FILE_NOT_FOUND | INVALID_DASH | INVALID_DSC_COMMENT | INVALID_INDEX | CLIP_NOT_REPRESENTABLE exception Error of status let init = Callback.register_exception "cairo_status_exn" (Error NULL_POINTER) external version_encode : int -> int -> int -> int = "ml_CAIRO_VERSION_ENCODE" external run_time_version : unit -> int = "ml_cairo_version" external run_time_version_string : unit -> string = "ml_cairo_version_string" external _version : unit -> int = "ml_CAIRO_VERSION" external _version_string : unit -> string = "ml_CAIRO_VERSION_STRING" let compile_time_version = _version () let compile_time_version_string = _version_string () type t type -'a surface type -'a pattern type -'a font_face type surface_type = [ | `Image | `PDF | `PS | `SVG | `Xlib | `XCB | `Glitz | `Quartz | `Win32 | `BeOS | `DirectFB ] type pattern_type = [ | `Solid | `Surface | `Linear | `Radial ] type font_type = [ | `TOY | `FT | `Win32 | `ATSUI ] type content = CONTENT_COLOR | CONTENT_ALPHA | CONTENT_COLOR_ALPHA type point = { x : float ; y : float } type matrix = { xx : float ; yx : float ; xy : float ; yy : float ; x0 : float ; y0 : float } external create : [> `Any] surface -> t = "ml_cairo_create" external save : t -> unit = "ml_cairo_save" external restore : t -> unit = "ml_cairo_restore" external _push_group : t -> unit = "ml_cairo_push_group" external _push_group_with_content : t -> content -> unit = "ml_cairo_push_group_with_content" let push_group ?content cr = match content with | None -> _push_group cr | Some c -> _push_group_with_content cr c external pop_group : t -> [`Any] pattern = "ml_cairo_pop_group" external pop_group_to_source : t -> unit = "ml_cairo_pop_group_to_source" type operator = OPERATOR_CLEAR | OPERATOR_SOURCE | OPERATOR_OVER | OPERATOR_IN | OPERATOR_OUT | OPERATOR_ATOP | OPERATOR_DEST | OPERATOR_DEST_OVER | OPERATOR_DEST_IN | OPERATOR_DEST_OUT | OPERATOR_DEST_ATOP | OPERATOR_XOR | OPERATOR_ADD | OPERATOR_SATURATE external set_operator : t -> operator -> unit = "ml_cairo_set_operator" external set_source_rgb : t -> red:float -> green:float -> blue:float -> unit = "ml_cairo_set_source_rgb" external set_source_rgba : t -> red:float -> green:float -> blue:float -> alpha:float ->unit = "ml_cairo_set_source_rgba" external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source" external set_source_surface : t -> [> `Any] surface -> float -> float -> unit = "ml_cairo_set_source_surface" external set_tolerance : t -> float -> unit = "ml_cairo_set_tolerance" type antialias = ANTIALIAS_DEFAULT | ANTIALIAS_NONE | ANTIALIAS_GRAY | ANTIALIAS_SUBPIXEL external set_antialias : t -> antialias -> unit = "ml_cairo_set_antialias" type fill_rule = FILL_RULE_WINDING | FILL_RULE_EVEN_ODD external set_fill_rule : t -> fill_rule -> unit = "ml_cairo_set_fill_rule" external set_line_width : t -> float -> unit = "ml_cairo_set_line_width" type line_cap = LINE_CAP_BUTT | LINE_CAP_ROUND | LINE_CAP_SQUARE external set_line_cap : t -> line_cap -> unit = "ml_cairo_set_line_cap" type line_join = LINE_JOIN_MITER | LINE_JOIN_ROUND | LINE_JOIN_BEVEL external set_line_join : t -> line_join -> unit = "ml_cairo_set_line_join" external set_dash : t -> float array -> float -> unit = "ml_cairo_set_dash" external set_miter_limit : t -> float -> unit = "ml_cairo_set_miter_limit" external translate : t -> tx:float -> ty:float -> unit = "ml_cairo_translate" external scale : t -> sx:float -> sy:float -> unit = "ml_cairo_scale" external rotate : t -> angle:float -> unit = "ml_cairo_rotate" external transform : t -> matrix -> unit = "ml_cairo_transform" external set_matrix : t -> matrix -> unit = "ml_cairo_set_matrix" external identity_matrix : t -> unit = "ml_cairo_identity_matrix" external user_to_device : t -> point -> point = "ml_cairo_user_to_device" external user_to_device_distance : t -> point -> point = "ml_cairo_user_to_device_distance" external device_to_user : t -> point -> point = "ml_cairo_device_to_user" external device_to_user_distance : t -> point -> point = "ml_cairo_device_to_user_distance" external new_path : t -> unit = "ml_cairo_new_path" external move_to : t -> x:float -> y:float -> unit = "ml_cairo_move_to" let move_to_point cr { x = x ; y = y } = move_to cr ~x ~y external new_sub_path : t -> unit = "ml_cairo_new_sub_path" external line_to : t -> x:float -> y:float -> unit = "ml_cairo_line_to" let line_to_point cr { x = x ; y = y } = line_to cr ~x ~y external curve_to : t -> x1:float -> y1:float -> x2:float -> y2:float -> x3:float -> y3:float -> unit = "ml_cairo_curve_to_bc" "ml_cairo_curve_to" let curve_to_point cr {x=x1; y=y1} {x=x2; y=y2} {x=x3; y=y3} = curve_to cr ~x1 ~y1 ~x2 ~y2 ~x3 ~y3 external arc : t -> xc:float -> yc:float -> radius:float -> angle1:float -> angle2:float -> unit = "ml_cairo_arc_bc" "ml_cairo_arc" external arc_negative : t -> xc:float -> yc:float -> radius:float -> angle1:float -> angle2:float -> unit = "ml_cairo_arc_negative_bc" "ml_cairo_arc_negative" external rel_move_to : t -> dx:float -> dy:float -> unit = "ml_cairo_rel_move_to" external rel_line_to : t -> dx:float -> dy:float -> unit = "ml_cairo_rel_line_to" external rel_curve_to : t -> dx1:float -> dy1:float -> dx2:float -> dy2:float -> dx3:float -> dy3:float -> unit = "ml_cairo_rel_curve_to_bc" "ml_cairo_rel_curve_to" external rectangle : t -> x:float -> y:float -> width:float -> height:float -> unit = "ml_cairo_rectangle" external close_path : t -> unit = "ml_cairo_close_path" external paint : t -> unit = "ml_cairo_paint" external paint_with_alpha : t -> float -> unit = "ml_cairo_paint_with_alpha" external mask : t -> [> `Any] pattern -> unit = "ml_cairo_mask" external mask_surface : t -> [> `Any] surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface" external stroke : t -> unit = "ml_cairo_stroke" external stroke_preserve : t -> unit = "ml_cairo_stroke_preserve" external fill : t -> unit = "ml_cairo_fill" external fill_preserve : t -> unit = "ml_cairo_fill_preserve" external copy_page : t -> unit = "ml_cairo_copy_page" external show_page : t -> unit = "ml_cairo_show_page" external in_stroke : t -> point -> bool = "ml_cairo_in_stroke" external in_fill : t -> point -> bool = "ml_cairo_in_fill" external stroke_extents : t -> float * float * float * float = "ml_cairo_stroke_extents" external fill_extents : t -> float * float * float * float = "ml_cairo_fill_extents" external clip : t -> unit = "ml_cairo_clip" external clip_preserve : t -> unit = "ml_cairo_clip_preserve" external reset_clip : t -> unit = "ml_cairo_reset_clip" type glyph = { index : int; glyph_x : float; glyph_y : float; } type text_extents = { x_bearing : float ; y_bearing : float ; text_width : float ; text_height : float ; x_advance : float ; y_advance : float } type font_extents = { ascent : float; descent : float; font_height : float; max_x_advance : float; max_y_advance : float } type font_slant = FONT_SLANT_NORMAL | FONT_SLANT_ITALIC | FONT_SLANT_OBLIQUE type font_weight = FONT_WEIGHT_NORMAL | FONT_WEIGHT_BOLD type subpixel_order = SUBPIXEL_ORDER_DEFAULT | SUBPIXEL_ORDER_RGB | SUBPIXEL_ORDER_BGR | SUBPIXEL_ORDER_VRGB | SUBPIXEL_ORDER_VBGR type hint_style = HINT_STYLE_DEFAULT | HINT_STYLE_NONE | HINT_STYLE_SLIGHT | HINT_STYLE_MEDIUM | HINT_STYLE_FULL type hint_metrics = HINT_METRICS_DEFAULT | HINT_METRICS_OFF | HINT_METRICS_ON let font_type_of_int = function | 0 -> `TOY | 1 -> `FT | 2 -> `Win32 | 3 -> `ATSUI | _ -> `Any external _font_face_get_type : [> `Any] font_face -> int = "ml_cairo_font_face_get_type" let font_face_get_type f = font_type_of_int (_font_face_get_type f) let font_face_downcast_to_toy f = match font_face_get_type f with | `TOY -> (Obj.magic f : [`Any|`TOY] font_face) | _ -> invalid_arg "Cairo: font face downcast" module Font_Options = struct type t external create : unit -> t = "ml_cairo_font_options_create" external merge : t -> t -> unit = "ml_cairo_font_options_merge" external get_antialias : t -> antialias = "ml_cairo_font_options_get_antialias" external set_antialias : t -> antialias -> unit = "ml_cairo_font_options_set_antialias" external get_subpixel_order : t -> subpixel_order = "ml_cairo_font_options_get_subpixel_order" external set_subpixel_order : t -> subpixel_order -> unit = "ml_cairo_font_options_set_subpixel_order" external get_hint_style : t -> hint_style = "ml_cairo_font_options_get_hint_style" external set_hint_style : t -> hint_style -> unit = "ml_cairo_font_options_set_hint_style" external get_hint_metrics : t -> hint_metrics = "ml_cairo_font_options_get_hint_metrics" external set_hint_metrics : t -> hint_metrics -> unit = "ml_cairo_font_options_set_hint_metrics" type all = [ `ANTIALIAS_DEFAULT | `ANTIALIAS_GRAY | `ANTIALIAS_NONE | `ANTIALIAS_SUBPIXEL | `HINT_METRICS_DEFAULT | `HINT_METRICS_OFF | `HINT_METRICS_ON | `HINT_STYLE_DEFAULT | `HINT_STYLE_FULL | `HINT_STYLE_MEDIUM | `HINT_STYLE_NONE | `HINT_STYLE_SLIGHT | `SUBPIXEL_ORDER_BGR | `SUBPIXEL_ORDER_DEFAULT | `SUBPIXEL_ORDER_RGB | `SUBPIXEL_ORDER_VBGR | `SUBPIXEL_ORDER_VRGB ] let make l = let o = create () in List.iter (function | `ANTIALIAS_DEFAULT -> set_antialias o ANTIALIAS_DEFAULT | `ANTIALIAS_NONE -> set_antialias o ANTIALIAS_NONE | `ANTIALIAS_GRAY -> set_antialias o ANTIALIAS_GRAY | `ANTIALIAS_SUBPIXEL -> set_antialias o ANTIALIAS_SUBPIXEL | `SUBPIXEL_ORDER_DEFAULT -> set_subpixel_order o SUBPIXEL_ORDER_DEFAULT | `SUBPIXEL_ORDER_RGB -> set_subpixel_order o SUBPIXEL_ORDER_RGB | `SUBPIXEL_ORDER_BGR -> set_subpixel_order o SUBPIXEL_ORDER_BGR | `SUBPIXEL_ORDER_VRGB -> set_subpixel_order o SUBPIXEL_ORDER_VRGB | `SUBPIXEL_ORDER_VBGR -> set_subpixel_order o SUBPIXEL_ORDER_VBGR | `HINT_STYLE_DEFAULT -> set_hint_style o HINT_STYLE_DEFAULT | `HINT_STYLE_NONE -> set_hint_style o HINT_STYLE_NONE | `HINT_STYLE_SLIGHT -> set_hint_style o HINT_STYLE_SLIGHT | `HINT_STYLE_MEDIUM -> set_hint_style o HINT_STYLE_MEDIUM | `HINT_STYLE_FULL -> set_hint_style o HINT_STYLE_FULL | `HINT_METRICS_DEFAULT -> set_hint_metrics o HINT_METRICS_DEFAULT | `HINT_METRICS_OFF -> set_hint_metrics o HINT_METRICS_OFF | `HINT_METRICS_ON -> set_hint_metrics o HINT_METRICS_ON) l ; o end (* scaled fonts *) module Scaled_Font = struct type -'a t external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" external _get_type : [> `Any] t -> int = "ml_cairo_scaled_font_get_type" let get_type f = font_type_of_int (_get_type f) let downcast_to_toy f = if get_type f = `TOY then (Obj.magic f : [`Any|`TOY] t) else invalid_arg "Cairo: scaled font downcast" external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" external text_extents : [> `Any] t -> string -> text_extents = "ml_cairo_scaled_font_text_extents" external glyph_extents : [> `Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" external get_font_face : ([>`Any] as 'a) t -> 'a font_face = "ml_cairo_scaled_font_get_font_face" external get_font_matrix : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_font_matrix" external get_ctm : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_ctm" external _get_font_options : ([>`Any] as 'a) t -> Font_Options.t -> unit = "ml_cairo_scaled_font_get_font_options" let get_font_options sf = let o = Font_Options.create () in _get_font_options sf o ; o end external select_font_face : t -> string -> font_slant -> font_weight -> unit = "ml_cairo_select_font_face" external set_font_size : t -> float -> unit = "ml_cairo_set_font_size" external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix" external get_font_matrix : t -> matrix = "ml_cairo_get_font_matrix" external set_font_options : t -> Font_Options.t -> unit = "ml_cairo_set_font_matrix" external _get_font_options : t -> Font_Options.t -> unit = "ml_cairo_get_font_options" let merge_font_options cr o' = let o = Font_Options.create () in _get_font_options cr o ; Font_Options.merge o o' ; set_font_options cr o let get_font_options cr = let o = Font_Options.create () in _get_font_options cr o ; o external set_scaled_font : t -> [> `Any] Scaled_Font.t -> unit = "ml_cairo_set_scaled_font" external show_text : t -> string -> unit = "ml_cairo_show_text" external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs" external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face" external font_extents : t -> font_extents = "ml_cairo_font_extents" external set_font_face : t -> [> `Any] font_face -> unit = "ml_cairo_set_font_face" external text_extents : t -> string -> text_extents = "ml_cairo_text_extents" external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_extents" external text_path : t -> string -> unit = "ml_cairo_text_path" external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path" external get_operator : t -> operator = "ml_cairo_get_operator" external get_source : t -> [`Any] pattern = "ml_cairo_get_source" external get_tolerance : t -> float = "ml_cairo_get_tolerance" external get_antialias : t -> antialias = "ml_cairo_get_antialias" external get_current_point : t -> point = "ml_cairo_get_current_point" external get_fill_rule : t -> fill_rule = "ml_cairo_get_fill_rule" external get_line_width : t -> float = "ml_cairo_get_line_width" external get_line_cap : t -> line_cap = "ml_cairo_get_line_cap" external get_line_join : t -> line_join = "ml_cairo_get_line_join" external get_miter_limit : t -> float = "ml_cairo_get_miter_limit" external get_matrix : t -> matrix = "ml_cairo_get_matrix" external get_target : t -> [`Any] surface = "ml_cairo_get_target" external get_group_target : t -> [`Any] surface = "ml_cairo_get_group_target" type flat_path = [ | `MOVE_TO of point | `LINE_TO of point | `CLOSE ] type path = [ | flat_path | `CURVE_TO of point * point * point ] external fold_path : t -> ('a -> [> path] -> 'a) -> 'a -> 'a = "ml_cairo_copy_path" external fold_path_flat : t -> ('a -> [> flat_path] -> 'a) -> 'a -> 'a = "ml_cairo_copy_path_flat" let append_path cr = function | `MOVE_TO p -> move_to_point cr p | `LINE_TO p -> line_to_point cr p | `CLOSE -> close_path cr | `CURVE_TO (p1, p2, p3) -> curve_to_point cr p1 p2 p3 external status : t -> status = "ml_cairo_status" external surface_status : [> `Any] surface -> status = "ml_cairo_surface_status" external pattern_status : [> `Any] pattern -> status = "ml_cairo_pattern_status" external font_face_status : [> `Any] font_face -> status = "ml_cairo_font_face_status" external scaled_font_status : [> `Any] Scaled_Font.t -> status = "ml_cairo_scaled_font_status" external font_options_status : Font_Options.t -> status = "ml_cairo_font_options_status" external string_of_status : status -> string = "ml_cairo_status_to_string" (* surface *) external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar" external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish" external _surface_get_type : [> `Any] surface -> int = "ml_cairo_surface_get_type" let surface_get_type s = match _surface_get_type s with | 0 -> `Image | 1 -> `PDF | 2 -> `PS | 3 -> `Xlib | 4 -> `XCB | 5 -> `Glitz | 6 -> `Quartz | 7 -> `Win32 | 8 -> `BeOS | 9 -> `DirectFB | 10 -> `SVG | _ -> `Any external surface_get_content : [> `Any] surface -> content = "ml_cairo_surface_get_content" external _surface_get_font_options : [> `Any] surface -> Font_Options.t -> unit = "ml_cairo_surface_get_font_options" let surface_get_font_options s = let o = Font_Options.create () in _surface_get_font_options s o ; o external surface_flush : [> `Any] surface -> unit = "ml_cairo_surface_flush" external mark_dirty : [> `Any] surface -> unit = "ml_cairo_surface_mark_dirty" external mark_dirty_rectangle : [> `Any] surface -> int -> int -> int -> int -> unit = "ml_cairo_surface_mark_dirty_rectangle" external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset" external surface_get_device_offset : [> `Any] surface -> float * float = "ml_cairo_surface_get_device_offset" external surface_set_fallback_resolution : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_fallback_resolution" type image_surface = [`Any|`Image] surface type format = FORMAT_ARGB32 | FORMAT_RGB24 | FORMAT_A8 | FORMAT_A1 external image_surface_create : format -> width:int -> height:int -> image_surface = "ml_cairo_image_surface_create" external image_surface_get_format : [>`Image] surface -> format = "ml_cairo_image_surface_get_format" external image_surface_get_width : [>`Image] surface -> int = "ml_cairo_image_surface_get_width" external image_surface_get_height : [>`Image] surface -> int = "ml_cairo_image_surface_get_height" external image_surface_get_stride : [>`Image] surface -> int = "ml_cairo_image_surface_get_stride" (* pattern *) type extend = EXTEND_NONE | EXTEND_REPEAT | EXTEND_REFLECT type filter = FILTER_FAST | FILTER_GOOD | FILTER_BEST | FILTER_NEAREST | FILTER_BILINEAR | FILTER_GAUSSIAN type solid_pattern = [`Any|`Solid] pattern type surface_pattern = [`Any|`Surface] pattern type gradient_pattern = [`Any|`Gradient] pattern module Pattern = struct external _get_type : [> `Any] pattern -> int = "ml_cairo_pattern_get_type" let get_type p = match _get_type p with | 0 -> `Solid | 1 -> `Surface | 2 -> `Linear | 3 -> `Radial | _ -> `Any let downcast_to_solid p = if get_type p = `Solid then (Obj.magic p : [`Solid|`Any] pattern) else invalid_arg "Cairo.Pattern: pattern downcast" let downcast_to_surface p = if get_type p = `Surface then (Obj.magic p : [`Surface|`Any] pattern) else invalid_arg "Cairo.Pattern: pattern downcast" let downcast_to_gradient p = match get_type p with | `Linear | `Radial -> (Obj.magic p : gradient_pattern) | _ -> invalid_arg "Cairo.Pattern: pattern downcast" external create_rgb : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb" external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba" external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface" external create_linear : x0:float -> y0:float -> x1:float -> y1:float -> gradient_pattern = "ml_cairo_pattern_create_linear" external create_radial : cx0:float -> cy0:float -> radius0:float -> cx1:float -> cy1:float -> radius1:float -> gradient_pattern = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial" external add_color_stop_rgb : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> unit = "ml_cairo_pattern_add_color_stop_rgb" external add_color_stop_rgba : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_cairo_pattern_add_color_stop_rgba_bc" "ml_cairo_pattern_add_color_stop_rgba" external set_matrix : [> `Any] pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix" external get_matrix : [> `Any] pattern -> matrix = "ml_cairo_pattern_get_matrix" external set_extend : [> `Surface] pattern -> extend -> unit = "ml_cairo_pattern_set_extend" external get_extend : [> `Surface] pattern -> extend = "ml_cairo_pattern_get_extend" external set_filter : [> `Surface] pattern -> filter -> unit = "ml_cairo_pattern_set_filter" external get_filter : [> `Surface] pattern -> filter = "ml_cairo_pattern_get_filter" end (* matrix *) module Matrix = struct let init_identity = { xx = 1.; yx = 0.; xy = 0.; yy = 1.; x0 = 0.; y0 = 0. } let init_translate x y = { xx = 1.; yx = 0.; xy = 0.; yy = 1.; x0 = x; y0 = y } let init_scale x y = { xx = x; yx = 0.; xy = 0.; yy = y; x0 = 0.; y0 = 0. } let init_rotate a = let s = sin a in let c = cos a in { xx = c; yx = s; xy = ~-. s; yy = c; x0 = 0.; y0 = 0. } external translate : matrix -> float -> float -> matrix = "ml_cairo_matrix_translate" external scale : matrix -> float -> float -> matrix = "ml_cairo_matrix_scale" external rotate : matrix -> float -> matrix = "ml_cairo_matrix_rotate" external invert : matrix -> matrix = "ml_cairo_matrix_invert" external multiply : matrix -> matrix -> matrix = "ml_cairo_matrix_multiply" external transform_distance : matrix -> point -> point = "ml_cairo_matrix_transform_distance" external transform_point : matrix -> point -> point = "ml_cairo_matrix_transform_point" end cairo-ocaml-1.2.0/src/cairo.mli000066400000000000000000000437251136043615400163050ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** Cairo Graphics *) (** {3 Error reporting} *) type status = SUCCESS | NO_MEMORY | INVALID_RESTORE | INVALID_POP_GROUP | NO_CURRENT_POINT | INVALID_MATRIX | INVALID_STATUS | NULL_POINTER | INVALID_STRING | INVALID_PATH_DATA | READ_ERROR | WRITE_ERROR | SURFACE_FINISHED | SURFACE_TYPE_MISMATCH | PATTERN_TYPE_MISMATCH | INVALID_CONTENT | INVALID_FORMAT | INVALID_VISUAL | FILE_NOT_FOUND | INVALID_DASH | INVALID_DSC_COMMENT | INVALID_INDEX | CLIP_NOT_REPRESENTABLE exception Error of status val init : unit external version_encode : int -> int -> int -> int = "ml_CAIRO_VERSION_ENCODE" external run_time_version : unit -> int = "ml_cairo_version" external run_time_version_string : unit -> string = "ml_cairo_version_string" val compile_time_version : int val compile_time_version_string : string (** {3 Types} *) type t type -'a surface type -'a pattern type -'a font_face type surface_type = [ | `Image | `PDF | `PS | `SVG | `Xlib | `XCB | `Glitz | `Quartz | `Win32 | `BeOS | `DirectFB ] type pattern_type = [ | `Solid | `Surface | `Linear | `Radial ] type font_type = [ | `TOY | `FT | `Win32 | `ATSUI ] type content = CONTENT_COLOR | CONTENT_ALPHA | CONTENT_COLOR_ALPHA type point = { x : float ; y : float } type matrix = { xx : float ; yx : float ; xy : float ; yy : float ; x0 : float ; y0 : float } (** {3 Core API} *) val create : [> `Any] surface -> t external save : t -> unit = "ml_cairo_save" external restore : t -> unit = "ml_cairo_restore" val push_group : ?content:content -> t -> unit external pop_group : t -> [`Any] pattern = "ml_cairo_pop_group" external pop_group_to_source : t -> unit = "ml_cairo_pop_group_to_source" external status : t -> status = "ml_cairo_status" external surface_status : [> `Any] surface -> status = "ml_cairo_surface_status" external pattern_status : [> `Any] pattern -> status = "ml_cairo_pattern_status" external font_face_status : [> `Any] font_face -> status = "ml_cairo_font_face_status" external string_of_status : status -> string = "ml_cairo_status_to_string" (** {3 Renderer state} *) type operator = OPERATOR_CLEAR | OPERATOR_SOURCE | OPERATOR_OVER | OPERATOR_IN | OPERATOR_OUT | OPERATOR_ATOP | OPERATOR_DEST | OPERATOR_DEST_OVER | OPERATOR_DEST_IN | OPERATOR_DEST_OUT | OPERATOR_DEST_ATOP | OPERATOR_XOR | OPERATOR_ADD | OPERATOR_SATURATE external set_operator : t -> operator -> unit = "ml_cairo_set_operator" external set_source : t -> [> `Any] pattern -> unit = "ml_cairo_set_source" external set_source_rgb : t -> red:float -> green:float -> blue:float -> unit = "ml_cairo_set_source_rgb" external set_source_rgba : t -> red:float -> green:float -> blue:float -> alpha:float ->unit = "ml_cairo_set_source_rgba" external set_source_surface : t -> [> `Any] surface -> float -> float -> unit = "ml_cairo_set_source_surface" external set_tolerance : t -> float -> unit = "ml_cairo_set_tolerance" type antialias = ANTIALIAS_DEFAULT | ANTIALIAS_NONE | ANTIALIAS_GRAY | ANTIALIAS_SUBPIXEL external set_antialias : t -> antialias -> unit = "ml_cairo_set_antialias" type fill_rule = FILL_RULE_WINDING | FILL_RULE_EVEN_ODD external set_fill_rule : t -> fill_rule -> unit = "ml_cairo_set_fill_rule" external set_line_width : t -> float -> unit = "ml_cairo_set_line_width" type line_cap = LINE_CAP_BUTT | LINE_CAP_ROUND | LINE_CAP_SQUARE external set_line_cap : t -> line_cap -> unit = "ml_cairo_set_line_cap" type line_join = LINE_JOIN_MITER | LINE_JOIN_ROUND | LINE_JOIN_BEVEL external set_line_join : t -> line_join -> unit = "ml_cairo_set_line_join" external set_dash : t -> float array -> float -> unit = "ml_cairo_set_dash" external set_miter_limit : t -> float -> unit = "ml_cairo_set_miter_limit" (** {3 Transformations} *) external translate : t -> tx:float -> ty:float -> unit = "ml_cairo_translate" external scale : t -> sx:float -> sy:float -> unit = "ml_cairo_scale" external rotate : t -> angle:float -> unit = "ml_cairo_rotate" external transform : t -> matrix -> unit = "ml_cairo_transform" external set_matrix : t -> matrix -> unit = "ml_cairo_set_matrix" external identity_matrix : t -> unit = "ml_cairo_identity_matrix" external user_to_device : t -> point -> point = "ml_cairo_user_to_device" external user_to_device_distance : t -> point -> point = "ml_cairo_user_to_device_distance" external device_to_user : t -> point -> point = "ml_cairo_device_to_user" external device_to_user_distance : t -> point -> point = "ml_cairo_device_to_user_distance" (** {3 Paths} *) external new_path : t -> unit = "ml_cairo_new_path" external move_to : t -> x:float -> y:float -> unit = "ml_cairo_move_to" val move_to_point : t -> point -> unit external new_sub_path : t -> unit = "ml_cairo_new_sub_path" external line_to : t -> x:float -> y:float -> unit = "ml_cairo_line_to" val line_to_point : t -> point -> unit external curve_to : t -> x1:float -> y1:float -> x2:float -> y2:float -> x3:float -> y3:float -> unit = "ml_cairo_curve_to_bc" "ml_cairo_curve_to" val curve_to_point : t -> point -> point -> point -> unit external arc : t -> xc:float -> yc:float -> radius:float -> angle1:float -> angle2:float -> unit = "ml_cairo_arc_bc" "ml_cairo_arc" external arc_negative : t -> xc:float -> yc:float -> radius:float -> angle1:float -> angle2:float -> unit = "ml_cairo_arc_negative_bc" "ml_cairo_arc_negative" external rel_move_to : t -> dx:float -> dy:float -> unit = "ml_cairo_rel_move_to" external rel_line_to : t -> dx:float -> dy:float -> unit = "ml_cairo_rel_line_to" external rel_curve_to : t -> dx1:float -> dy1:float -> dx2:float -> dy2:float -> dx3:float -> dy3:float -> unit = "ml_cairo_rel_curve_to_bc" "ml_cairo_rel_curve_to" external rectangle : t -> x:float -> y:float -> width:float -> height:float -> unit = "ml_cairo_rectangle" external close_path : t -> unit = "ml_cairo_close_path" external paint : t -> unit = "ml_cairo_paint" external paint_with_alpha : t -> float -> unit = "ml_cairo_paint_with_alpha" external mask : t -> [> `Any] pattern -> unit = "ml_cairo_mask" external mask_surface : t -> [> `Any] surface -> surface_x:float -> surface_y:float -> unit = "ml_cairo_mask_surface" external stroke : t -> unit = "ml_cairo_stroke" external stroke_preserve : t -> unit = "ml_cairo_stroke_preserve" external fill : t -> unit = "ml_cairo_fill" external fill_preserve : t -> unit = "ml_cairo_fill_preserve" external copy_page : t -> unit = "ml_cairo_copy_page" external show_page : t -> unit = "ml_cairo_show_page" external in_stroke : t -> point -> bool = "ml_cairo_in_stroke" external in_fill : t -> point -> bool = "ml_cairo_in_fill" external stroke_extents : t -> float * float * float * float = "ml_cairo_stroke_extents" external fill_extents : t -> float * float * float * float = "ml_cairo_fill_extents" external reset_clip : t -> unit = "ml_cairo_reset_clip" external clip : t -> unit = "ml_cairo_clip" external clip_preserve : t -> unit = "ml_cairo_clip_preserve" (** {3 Text API} *) type glyph = { index : int; glyph_x : float; glyph_y : float; } type text_extents = { x_bearing : float ; y_bearing : float ; text_width : float ; text_height : float ; x_advance : float ; y_advance : float } type font_extents = { ascent : float; descent : float; font_height : float; max_x_advance : float; max_y_advance : float; } type font_slant = | FONT_SLANT_NORMAL | FONT_SLANT_ITALIC | FONT_SLANT_OBLIQUE type font_weight = | FONT_WEIGHT_NORMAL | FONT_WEIGHT_BOLD type subpixel_order = SUBPIXEL_ORDER_DEFAULT | SUBPIXEL_ORDER_RGB | SUBPIXEL_ORDER_BGR | SUBPIXEL_ORDER_VRGB | SUBPIXEL_ORDER_VBGR type hint_style = HINT_STYLE_DEFAULT | HINT_STYLE_NONE | HINT_STYLE_SLIGHT | HINT_STYLE_MEDIUM | HINT_STYLE_FULL type hint_metrics = HINT_METRICS_DEFAULT | HINT_METRICS_OFF | HINT_METRICS_ON val font_face_get_type : [> `Any] font_face -> [font_type|`Any] val font_face_downcast_to_toy : [> `Any] font_face -> [`Any|`TOY] font_face (** {4 Font options} *) (** Font options functions *) module Font_Options : sig type t external create : unit -> t = "ml_cairo_font_options_create" external merge : t -> t -> unit = "ml_cairo_font_options_merge" external get_antialias : t -> antialias = "ml_cairo_font_options_get_antialias" external set_antialias : t -> antialias -> unit = "ml_cairo_font_options_set_antialias" external get_subpixel_order : t -> subpixel_order = "ml_cairo_font_options_get_subpixel_order" external set_subpixel_order : t -> subpixel_order -> unit = "ml_cairo_font_options_set_subpixel_order" external get_hint_style : t -> hint_style = "ml_cairo_font_options_get_hint_style" external set_hint_style : t -> hint_style -> unit = "ml_cairo_font_options_set_hint_style" external get_hint_metrics : t -> hint_metrics = "ml_cairo_font_options_get_hint_metrics" external set_hint_metrics : t -> hint_metrics -> unit = "ml_cairo_font_options_set_hint_metrics" type all = [ `ANTIALIAS_DEFAULT | `ANTIALIAS_GRAY | `ANTIALIAS_NONE | `ANTIALIAS_SUBPIXEL | `HINT_METRICS_DEFAULT | `HINT_METRICS_OFF | `HINT_METRICS_ON | `HINT_STYLE_DEFAULT | `HINT_STYLE_FULL | `HINT_STYLE_MEDIUM | `HINT_STYLE_NONE | `HINT_STYLE_SLIGHT | `SUBPIXEL_ORDER_BGR | `SUBPIXEL_ORDER_DEFAULT | `SUBPIXEL_ORDER_RGB | `SUBPIXEL_ORDER_VBGR | `SUBPIXEL_ORDER_VRGB ] val make : [< all] list -> t end (** {4 Scaled Fonts API} *) (** Scaled fonts functions *) module Scaled_Font : sig type -'a t external create : ([>`Any] as 'a) font_face -> matrix -> matrix -> Font_Options.t -> 'a t = "ml_cairo_scaled_font_create" val get_type : [> `Any] t -> [font_type|`Any] val downcast_to_toy : [> `Any] t -> [`Any|`TOY] t external font_extents : [> `Any] t -> font_extents = "ml_cairo_scaled_font_extents" external text_extents : [> `Any] t -> string -> text_extents = "ml_cairo_scaled_font_text_extents" external glyph_extents : [>`Any] t -> glyph array -> text_extents = "ml_cairo_scaled_font_glyph_extents" external get_font_face : ([>`Any] as 'a) t -> 'a font_face = "ml_cairo_scaled_font_get_font_face" external get_font_matrix : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_font_matrix" external get_ctm : ([>`Any] as 'a) t -> matrix = "ml_cairo_scaled_font_get_ctm" val get_font_options : ([>`Any] as 'a) t -> Font_Options.t end external select_font_face : t -> string -> font_slant -> font_weight -> unit = "ml_cairo_select_font_face" external set_font_size : t -> float -> unit = "ml_cairo_set_font_size" external set_font_matrix : t -> matrix -> unit = "ml_cairo_set_font_matrix" external get_font_matrix : t -> matrix = "ml_cairo_get_font_matrix" external set_font_options : t -> Font_Options.t -> unit = "ml_cairo_set_font_matrix" val merge_font_options : t -> Font_Options.t -> unit val get_font_options : t -> Font_Options.t external set_scaled_font : t -> [> `Any] Scaled_Font.t -> unit = "ml_cairo_set_scaled_font" external show_text : t -> string -> unit = "ml_cairo_show_text" external show_glyphs : t -> glyph array -> unit = "ml_cairo_show_glyphs" external get_font_face : t -> [`Any] font_face = "ml_cairo_get_font_face" external font_extents : t -> font_extents = "ml_cairo_font_extents" external set_font_face : t -> [> `Any] font_face -> unit = "ml_cairo_set_font_face" external text_extents : t -> string -> text_extents = "ml_cairo_text_extents" external glyph_extents : t -> glyph array -> text_extents = "ml_cairo_glyph_extents" external text_path : t -> string -> unit = "ml_cairo_text_path" external glyph_path : t -> glyph array -> unit = "ml_cairo_glyph_path" (** {3 Renderer state querying} *) external get_operator : t -> operator = "ml_cairo_get_operator" external get_source : t -> [`Any] pattern = "ml_cairo_get_source" external get_tolerance : t -> float = "ml_cairo_get_tolerance" external get_antialias : t -> antialias = "ml_cairo_get_antialias" external get_current_point : t -> point = "ml_cairo_get_current_point" external get_fill_rule : t -> fill_rule = "ml_cairo_get_fill_rule" external get_line_width : t -> float = "ml_cairo_get_line_width" external get_line_cap : t -> line_cap = "ml_cairo_get_line_cap" external get_line_join : t -> line_join = "ml_cairo_get_line_join" external get_miter_limit : t -> float = "ml_cairo_get_miter_limit" external get_matrix : t -> matrix = "ml_cairo_get_matrix" external get_target : t -> [`Any] surface = "ml_cairo_get_target" external get_group_target : t -> [`Any] surface = "ml_cairo_get_group_target" type flat_path = [ | `MOVE_TO of point | `LINE_TO of point | `CLOSE ] type path = [ | flat_path | `CURVE_TO of point * point * point ] external fold_path : t -> ('a -> [> path] -> 'a) -> 'a -> 'a = "ml_cairo_copy_path" external fold_path_flat : t -> ('a -> [> flat_path] -> 'a) -> 'a -> 'a = "ml_cairo_copy_path_flat" val append_path : t -> [< path] -> unit (** {3 Surface API} *) external surface_create_similar : [> `Any] surface -> content -> width:int -> height:int -> [`Any] surface = "ml_cairo_surface_create_similar" external surface_finish : [> `Any] surface -> unit = "ml_cairo_surface_finish" val surface_get_type : [> `Any] surface -> [surface_type | `Any] external surface_get_content : [> `Any] surface -> content = "ml_cairo_surface_get_content" val surface_get_font_options : [> `Any] surface -> Font_Options.t external surface_flush : [> `Any] surface -> unit = "ml_cairo_surface_flush" external mark_dirty : [> `Any] surface -> unit = "ml_cairo_surface_mark_dirty" external mark_dirty_rectangle : [> `Any] surface -> int -> int -> int -> int -> unit = "ml_cairo_surface_mark_dirty_rectangle" external surface_set_device_offset : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_device_offset" external surface_get_device_offset : [> `Any] surface -> float * float = "ml_cairo_surface_get_device_offset" external surface_set_fallback_resolution : [> `Any] surface -> float -> float -> unit = "ml_cairo_surface_set_fallback_resolution" (** {4 Image surface} *) type image_surface = [`Any|`Image] surface type format = FORMAT_ARGB32 | FORMAT_RGB24 | FORMAT_A8 | FORMAT_A1 external image_surface_create : format -> width:int -> height:int -> image_surface = "ml_cairo_image_surface_create" external image_surface_get_format : [>`Image] surface -> format = "ml_cairo_image_surface_get_format" external image_surface_get_width : [>`Image] surface -> int = "ml_cairo_image_surface_get_width" external image_surface_get_height : [>`Image] surface -> int = "ml_cairo_image_surface_get_height" external image_surface_get_stride : [>`Image] surface -> int = "ml_cairo_image_surface_get_stride" (** {3 Patterns} *) type solid_pattern = [`Any|`Solid] pattern type surface_pattern = [`Any|`Surface] pattern type gradient_pattern = [`Any|`Gradient] pattern type extend = EXTEND_NONE | EXTEND_REPEAT | EXTEND_REFLECT type filter = FILTER_FAST | FILTER_GOOD | FILTER_BEST | FILTER_NEAREST | FILTER_BILINEAR | FILTER_GAUSSIAN (** Patterns functions *) module Pattern : sig val get_type : [> `Any] pattern -> [pattern_type|`Any] val downcast_to_solid : [> `Any] pattern -> solid_pattern val downcast_to_surface : [> `Any] pattern -> surface_pattern val downcast_to_gradient : [> `Any] pattern -> gradient_pattern external create_rgb : red:float -> green:float -> blue:float -> solid_pattern = "ml_cairo_pattern_create_rgb" external create_rgba : red:float -> green:float -> blue:float -> alpha:float -> solid_pattern = "ml_cairo_pattern_create_rgba" external create_for_surface : [> `Any] surface -> surface_pattern = "ml_cairo_pattern_create_for_surface" external create_linear : x0:float -> y0:float -> x1:float -> y1:float -> gradient_pattern = "ml_cairo_pattern_create_linear" external create_radial : cx0:float -> cy0:float -> radius0:float -> cx1:float -> cy1:float -> radius1:float -> gradient_pattern = "ml_cairo_pattern_create_radial_bc" "ml_cairo_pattern_create_radial" external add_color_stop_rgb : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> unit = "ml_cairo_pattern_add_color_stop_rgb" external add_color_stop_rgba : [>`Gradient] pattern -> off:float -> red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_cairo_pattern_add_color_stop_rgba_bc" "ml_cairo_pattern_add_color_stop_rgba" external set_matrix : [> `Any] pattern -> matrix -> unit = "ml_cairo_pattern_set_matrix" external get_matrix : [> `Any] pattern -> matrix = "ml_cairo_pattern_get_matrix" external set_extend : [> `Surface] pattern -> extend -> unit = "ml_cairo_pattern_set_extend" external get_extend : [> `Surface] pattern -> extend = "ml_cairo_pattern_get_extend" external set_filter : [> `Surface] pattern -> filter -> unit = "ml_cairo_pattern_set_filter" external get_filter : [> `Surface] pattern -> filter = "ml_cairo_pattern_get_filter" end (** {3 Matrix API} *) (** Matrix functions *) module Matrix : sig val init_identity : matrix val init_translate : float -> float -> matrix val init_scale : float -> float -> matrix val init_rotate : float -> matrix external translate : matrix -> float -> float -> matrix = "ml_cairo_matrix_translate" external scale : matrix -> float -> float -> matrix = "ml_cairo_matrix_scale" external rotate : matrix -> float -> matrix = "ml_cairo_matrix_rotate" external invert : matrix -> matrix = "ml_cairo_matrix_invert" external multiply : matrix -> matrix -> matrix = "ml_cairo_matrix_multiply" external transform_distance : matrix -> point -> point = "ml_cairo_matrix_transform_distance" external transform_point : matrix -> point -> point = "ml_cairo_matrix_transform_point" end cairo-ocaml-1.2.0/src/cairo_bigarray.ml000066400000000000000000000050541136043615400200050ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) open Bigarray external bigarray_kind_float : ('a, 'b, c_layout) Array2.t -> bool = "ml_bigarray_kind_float" external bigarray_byte_size : ('a, 'b, c_layout) Array2.t -> int = "ml_bigarray_byte_size" external image_surface_create : ('a, 'b, c_layout) Array2.t -> Cairo.format -> width:int -> height:int -> stride:int -> Cairo.image_surface = "ml_cairo_image_surface_create_for_data" let of_bigarr arr format ~width ~height ~stride = if bigarray_kind_float arr then invalid_arg "wrong Bigarray kind" ; if bigarray_byte_size arr < stride * height then invalid_arg "Bigarray too small" ; image_surface_create arr format width height stride let of_bigarr_32 ~alpha (arr : (int32, int32_elt, c_layout) Array2.t) = let h = Array2.dim1 arr in let w = Array2.dim2 arr in of_bigarr arr (if alpha then Cairo.FORMAT_ARGB32 else Cairo.FORMAT_RGB24) w h (4 * w) let of_bigarr_24 (arr : (int, int_elt, c_layout) Array2.t) = if Sys.word_size <> 32 then failwith "your ints have 63 bits" ; let h = Array2.dim1 arr in let w = Array2.dim2 arr in of_bigarr arr Cairo.FORMAT_RGB24 w h (4 * w) let of_bigarr_8 (arr : (int, int8_unsigned_elt, c_layout) Array2.t) = let h = Array2.dim1 arr in let w = Array2.dim2 arr in of_bigarr arr Cairo.FORMAT_A8 w h w let output_pixel oc p = let r = (p lsr 16) land 0xff in output_byte oc r ; let g = (p lsr 8) land 0xff in output_byte oc g ; let b = p land 0xff in output_byte oc b let write_ppm_int32 oc (arr : (int32, int32_elt, c_layout) Array2.t) = let h = Array2.dim1 arr in let w = Array2.dim2 arr in Printf.fprintf oc "P6 %d %d 255\n" w h ; for i=0 to pred h do for j=0 to pred w do output_pixel oc (Int32.to_int arr.{i, j}) done done ; flush oc let write_ppm_int oc (arr : (int, int_elt, c_layout) Array2.t) = let h = Array2.dim1 arr in let w = Array2.dim2 arr in Printf.fprintf oc "P6 %d %d 255\n" w h ; for i=0 to pred h do for j=0 to pred w do output_pixel oc arr.{i, j} done done ; flush oc cairo-ocaml-1.2.0/src/cairo_bigarray.mli000066400000000000000000000021711136043615400201530ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** image backend, via Bigarray *) open Bigarray val of_bigarr : ('a, 'b, c_layout) Array2.t -> Cairo.format -> width:int -> height:int -> stride:int -> Cairo.image_surface val of_bigarr_32 : alpha:bool -> (int32, int32_elt, c_layout) Array2.t -> Cairo.image_surface val of_bigarr_24 : (int, int_elt, c_layout) Array2.t -> Cairo.image_surface val of_bigarr_8 : (int, int8_unsigned_elt, c_layout) Array2.t -> Cairo.image_surface val write_ppm_int32 : out_channel -> (int32, int32_elt, c_layout) Array2.t -> unit val write_ppm_int : out_channel -> (int, int_elt, c_layout) Array2.t -> unit cairo-ocaml-1.2.0/src/cairo_ft.ml000066400000000000000000000036361136043615400166220ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) exception FT_Error of int let _ = Callback.register_exception "FT_exn" (FT_Error 0) type ft_library type ft_face external init_freetype : unit -> ft_library = "ml_FT_Init_FreeType" external done_freetype : ft_library -> unit = "ml_FT_Done_FreeType" external new_face : ft_library -> ?index:int -> string -> ft_face = "ml_FT_New_Face" external done_face : ft_face -> unit = "ml_FT_Done_Face" type fc_pattern external fc_name_parse : ?options:Cairo.Font_Options.t -> string -> fc_pattern = "ml_FcNameParse" external fc_name_unparse : fc_pattern -> string = "ml_FcNameUnparse" type font_face = [`Any|`FT] Cairo.font_face external font_face_create_for_pattern : fc_pattern -> font_face = "ml_cairo_ft_font_face_create_for_pattern" external font_face_create_for_ft_face : ft_face -> int -> font_face = "ml_cairo_ft_font_face_create_for_ft_face" let downcast_font_face f = match Cairo.font_face_get_type f with | `FT -> (Obj.magic f : font_face) | _ -> invalid_arg "Cairo_ft: font face downcast" let downcast_scaled_font sf = match Cairo.Scaled_Font.get_type sf with | `FT -> (Obj.magic sf : [`Any|`FT] Cairo.Scaled_Font.t) | _ -> invalid_arg "Cairo_ft: scaled font downcast" external font_lock_face : [> `FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face" external font_unlock_face : [> `FT] Cairo.Scaled_Font.t -> unit = "ml_cairo_ft_scaled_font_unlock_face" cairo-ocaml-1.2.0/src/cairo_ft.mli000066400000000000000000000036201136043615400167640ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** Minimal support for the Fontconfig/Freetype font interface *) exception FT_Error of int type ft_library type ft_face val init_freetype : unit -> ft_library external done_freetype : ft_library -> unit = "ml_FT_Done_FreeType" external new_face : ft_library -> ?index:int -> string -> ft_face = "ml_FT_New_Face" external done_face : ft_face -> unit = "ml_FT_Done_Face" type fc_pattern external fc_name_parse : ?options:Cairo.Font_Options.t -> string -> fc_pattern = "ml_FcNameParse" (** this is a hack: this actually calls FcNameParse, FcConfigSubstitute, cairo_ft_font_options_substitute, FcDefaultSubstitute and FcFontMatch *) external fc_name_unparse : fc_pattern -> string = "ml_FcNameUnparse" (* font_options_substitute *) type font_face = [`Any|`FT] Cairo.font_face external font_face_create_for_pattern : fc_pattern -> font_face = "ml_cairo_ft_font_face_create_for_pattern" external font_face_create_for_ft_face : ft_face -> int -> font_face = "ml_cairo_ft_font_face_create_for_ft_face" val downcast_font_face : [> `Any] Cairo.font_face -> font_face val downcast_scaled_font : [> `Any] Cairo.Scaled_Font.t -> [`Any|`FT] Cairo.Scaled_Font.t external font_lock_face : [>`FT] Cairo.Scaled_Font.t -> ft_face = "ml_cairo_ft_scaled_font_lock_face" external font_unlock_face : [>`FT] Cairo.Scaled_Font.t -> unit = "ml_cairo_ft_scaled_font_unlock_face" cairo-ocaml-1.2.0/src/cairo_lablgtk.ml000066400000000000000000000017641136043615400176310ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) external create : [> `drawable] Gobject.obj -> Cairo.t = "ml_gdk_cairo_create" external set_source_color : Cairo.t -> Gdk.color -> unit = "ml_gdk_cairo_set_source_color" external rectangle : Cairo.t -> Gdk.Rectangle.t -> unit = "ml_gdk_cairo_rectangle" external region : Cairo.t -> Gdk.region -> unit = "ml_gdk_cairo_region" external set_source_pixbuf : Cairo.t -> GdkPixbuf.pixbuf -> float -> float -> unit = "ml_gdk_cairo_set_source_pixbuf" cairo-ocaml-1.2.0/src/cairo_lablgtk.mli000066400000000000000000000023121136043615400177700ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** GTK/Cairo integration *) (** These functions are available with GTK+ 2.8. cf. {{:http://developer.gnome.org/doc/API/2.0/gdk/gdk-Cairo-Interaction.html}Cairo Interaction} in the GDK Reference Manual. *) external create : [> `drawable] Gobject.obj -> Cairo.t = "ml_gdk_cairo_create" external set_source_color : Cairo.t -> Gdk.color -> unit = "ml_gdk_cairo_set_source_color" external rectangle : Cairo.t -> Gdk.Rectangle.t -> unit = "ml_gdk_cairo_rectangle" external region : Cairo.t -> Gdk.region -> unit = "ml_gdk_cairo_region" external set_source_pixbuf : Cairo.t -> GdkPixbuf.pixbuf -> float -> float -> unit = "ml_gdk_cairo_set_source_pixbuf" cairo-ocaml-1.2.0/src/cairo_pdf.ml000066400000000000000000000025651136043615400167620ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type surface = [`Any|`PDF] Cairo.surface external surface_create_for_stream_unsafe : (string -> int -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream_unsafe" external unsafe_output : out_channel -> string -> int -> int -> unit = "caml_ml_output" let unsafe_output_string oc s n = unsafe_output oc s 0 n let surface_create_for_channel oc ~width_in_points ~height_in_points = surface_create_for_stream_unsafe (unsafe_output_string oc) ~width_in_points ~height_in_points external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream" external set_size : [> `PDF] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_pdf_surface_set_size" cairo-ocaml-1.2.0/src/cairo_pdf.mli000066400000000000000000000020011136043615400171140ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** PDF backend *) type surface = [`Any|`PDF] Cairo.surface val surface_create_for_channel : out_channel -> width_in_points:float -> height_in_points:float -> surface external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_pdf_surface_create_for_stream" external set_size : [> `PDF] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_pdf_surface_set_size" cairo-ocaml-1.2.0/src/cairo_png.ml000066400000000000000000000036051136043615400167710ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) external image_surface_create_from_stream_unsafe : (string -> int -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream_unsafe" let image_surface_create_from_channel ic = image_surface_create_from_stream_unsafe (fun s n -> for i = 0 to n - 1 do String.unsafe_set s i (input_char ic) done) let image_surface_create_from_file fname = let ic = open_in fname in try let surf = image_surface_create_from_channel ic in close_in ic ; surf with exn -> close_in_noerr ic ; raise exn external image_surface_create_from_stream : (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream" external surface_write_to_stream_unsafe : [> `Any] Cairo.surface -> (string -> int -> unit) -> unit = "ml_cairo_surface_write_to_png_stream_unsafe" let unsafe_output_string oc s n = for i = 0 to n - 1 do output_char oc (String.unsafe_get s i) done let surface_write_to_channel surf oc = surface_write_to_stream_unsafe surf (unsafe_output_string oc) let surface_write_to_file surf fname = let oc = open_out_bin fname in try surface_write_to_channel surf oc ; close_out oc with exn -> close_out_noerr oc ; raise exn external surface_write_to_stream : [> `Any] Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream" cairo-ocaml-1.2.0/src/cairo_png.mli000066400000000000000000000021771136043615400171450ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** PNG reading/writing functions *) val image_surface_create_from_channel : in_channel -> Cairo.image_surface val image_surface_create_from_file : string -> Cairo.image_surface external image_surface_create_from_stream : (string -> unit) -> Cairo.image_surface = "ml_cairo_image_surface_create_from_png_stream" val surface_write_to_channel : [> `Any] Cairo.surface -> out_channel -> unit val surface_write_to_file : [> `Any] Cairo.surface -> string -> unit external surface_write_to_stream : [> `Any] Cairo.surface -> (string -> unit) -> unit = "ml_cairo_surface_write_to_png_stream" cairo-ocaml-1.2.0/src/cairo_ps.ml000066400000000000000000000032401136043615400166220ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type surface = [`Any|`PS] Cairo.surface external surface_create_for_stream_unsafe : (string -> int -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream_unsafe" external unsafe_output : out_channel -> string -> int -> int -> unit = "caml_ml_output" let unsafe_output_string oc s n = unsafe_output oc s 0 n let surface_create_for_channel oc ~width_in_points ~height_in_points = surface_create_for_stream_unsafe (unsafe_output_string oc) ~width_in_points ~height_in_points external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream" external set_size : [> `PS] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_ps_surface_set_size" external dsc_comment : [> `PS] Cairo.surface -> string -> unit = "ml_cairo_ps_surface_dsc_comment" external scb_begin_setup : [> `PS] Cairo.surface -> unit = "ml_cairo_ps_surface_dsc_begin_setup" external scb_begin_page_setup : [> `PS] Cairo.surface -> unit = "ml_cairo_ps_surface_dsc_begin_page_setup" cairo-ocaml-1.2.0/src/cairo_ps.mli000066400000000000000000000020041136043615400167700ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** PostScript backend *) type surface = [`Any|`PS] Cairo.surface val surface_create_for_channel : out_channel -> width_in_points:float -> height_in_points:float -> surface external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_ps_surface_create_for_stream" external set_size : [> `PS] Cairo.surface -> width_in_points:float -> height_in_points:float -> unit = "ml_cairo_ps_surface_set_size" cairo-ocaml-1.2.0/src/cairo_svg.ml000066400000000000000000000026771136043615400170140ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type surface = [`Any|`SVG] Cairo.surface external surface_create_for_stream_unsafe : (string -> int -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream_unsafe" let unsafe_output_string oc s n = for i = 0 to n - 1 do output_char oc (String.unsafe_get s i) done let surface_create_for_channel oc ~width_in_points ~height_in_points = surface_create_for_stream_unsafe (unsafe_output_string oc) ~width_in_points ~height_in_points external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream" type version = | VERSION_1_1 | VERSION_1_2 external restrict_to_version : [> `SVG] Cairo.surface -> version -> unit = "ml_cairo_svg_surface_restrict_to_version" external string_of_version : version -> string = "ml_cairo_svg_version_to_string" cairo-ocaml-1.2.0/src/cairo_svg.mli000066400000000000000000000021621136043615400171520ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** SVG backend *) type surface = [`Any|`SVG] Cairo.surface val surface_create_for_channel : out_channel -> width_in_points:float -> height_in_points:float -> surface external surface_create_for_stream : (string -> unit) -> width_in_points:float -> height_in_points:float -> surface = "ml_cairo_svg_surface_create_for_stream" type version = | VERSION_1_1 | VERSION_1_2 external restrict_to_version : [> `SVG] Cairo.surface -> version -> unit = "ml_cairo_svg_surface_restrict_to_version" external string_of_version : version -> string = "ml_cairo_svg_version_to_string" cairo-ocaml-1.2.0/src/ml_cairo.c000066400000000000000000000350151136043615400164270ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" wML_0(cairo_version_string, caml_copy_string) wML_0(cairo_version, Val_int) CAMLprim value ml_CAIRO_VERSION_STRING (value unit) { return caml_copy_string (CAIRO_VERSION_STRING); } CAMLprim value ml_CAIRO_VERSION (value unit) { return Val_int (CAIRO_VERSION); } CAMLprim value ml_CAIRO_VERSION_ENCODE (value maj, value min, value mic) { return Val_int (CAIRO_VERSION_ENCODE (Int_val(maj), Int_val(min), Int_val(mic))); } wMake_Val_final_pointer(cairo_t, cairo_destroy, 0) CAMLprim value ml_cairo_create (value surf) { cairo_t *p = cairo_create (cairo_surface_t_val (surf)); cairo_treat_status (cairo_status (p)); return Val_cairo_t (p); } /* cairo_reference */ /* cairo_destroy */ wML_0_cairo(save) wML_0_cairo(restore) wML_0_cairo(push_group) wML_1_cairo(push_group_with_content, cairo_content_t_val) CAMLprim value ml_cairo_pop_group (value cr) { cairo_pattern_t *p = cairo_pop_group (cairo_t_val (cr)); check_cairo_status (cr); return Val_cairo_pattern_t (p); } wML_0_cairo(pop_group_to_source) #define cairo_operator_t_val(v) ((cairo_operator_t) Int_val(v)) #define Val_cairo_operator_t(v) Val_int(v) wML_1_cairo(set_operator, cairo_operator_t_val) wML_1_cairo(set_source, cairo_pattern_t_val) wML_3_cairo(set_source_rgb, Double_val, Double_val, Double_val) wML_4_cairo(set_source_rgba, Double_val, Double_val, Double_val, Double_val) wML_3_cairo(set_source_surface, cairo_surface_t_val, Double_val, Double_val) wML_1_cairo(set_tolerance, Double_val) wML_1_cairo(set_antialias, cairo_antialias_t_val) #define cairo_fill_rule_t_val(v) ((cairo_fill_rule_t) Int_val(v)) #define Val_cairo_fill_rule_t(v) Val_int(v) wML_1_cairo(set_fill_rule, cairo_fill_rule_t_val) wML_1_cairo(set_line_width, Double_val) #define cairo_line_cap_t_val(v) ((cairo_line_cap_t) Int_val(v)) #define Val_cairo_line_cap_t(v) Val_int(v) wML_1_cairo(set_line_cap, cairo_line_cap_t_val) #define cairo_line_join_t_val(v) ((cairo_line_join_t) Int_val(v)) #define Val_cairo_line_join_t(v) Val_int(v) wML_1_cairo(set_line_join, cairo_line_join_t_val) CAMLprim value ml_cairo_set_dash (value cr, value d, value off) { #ifndef ARCH_ALIGN_DOUBLE cairo_set_dash (cairo_t_val (cr), Double_array_val (d), Double_array_length (d), Double_val (off)); #else int i, ndash = Double_array_length (d); double *dashes = caml_stat_alloc (ndash * sizeof (double)); for (i = 0; i < ndash; i++) dashes[i] = Double_field (d, i); cairo_set_dash (cairo_t_val (cr), dashes, ndash, Double_val (off)); caml_stat_free (dashes); #endif check_cairo_status (cr); return Val_unit; } wML_1_cairo(set_miter_limit, Double_val) wML_2_cairo(translate, Double_val, Double_val) wML_2_cairo(scale, Double_val, Double_val) wML_1_cairo(rotate, Double_val) CAMLprim value ml_cairo_transform (value v_cr, value v_matrix) { #ifndef ARCH_ALIGN_DOUBLE cairo_transform (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (v_matrix, &mat); cairo_transform (cairo_t_val (v_cr), &mat); #endif check_cairo_status (v_cr); return Val_unit; } CAMLprim value ml_cairo_set_matrix (value v_cr, value v_matrix) { #ifndef ARCH_ALIGN_DOUBLE cairo_set_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (v_matrix, &mat); cairo_set_matrix (cairo_t_val (v_cr), &mat); #endif check_cairo_status (v_cr); return Val_unit; } wML_0_cairo (identity_matrix) value ml_cairo_point (double x, double y) { value p; p = caml_alloc_small (2 * Double_wosize, Double_array_tag); Store_double_field (p, 0, x); Store_double_field (p, 1, y); return p; } CAMLprim value ml_cairo_user_to_device (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); cairo_user_to_device (cairo_t_val (cr), &x, &y); check_cairo_status (cr); return ml_cairo_point (x, y); } CAMLprim value ml_cairo_user_to_device_distance (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); cairo_user_to_device_distance (cairo_t_val (cr), &x, &y); check_cairo_status (cr); return ml_cairo_point (x, y); } CAMLprim value ml_cairo_device_to_user (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); cairo_device_to_user (cairo_t_val (cr), &x, &y); check_cairo_status (cr); return ml_cairo_point (x, y); } CAMLprim value ml_cairo_device_to_user_distance (value cr, value p) { double x, y; x = Double_field (p, 0); y = Double_field (p, 1); cairo_device_to_user_distance (cairo_t_val (cr), &x, &y); check_cairo_status (cr); return ml_cairo_point (x, y); } wML_0_cairo(new_path) wML_2_cairo(move_to, Double_val, Double_val) wML_0_cairo(new_sub_path) wML_2_cairo(line_to, Double_val, Double_val) wML_6_cairo(curve_to, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val) wML_5_cairo(arc, Double_val, Double_val, Double_val, Double_val, Double_val) wML_5_cairo(arc_negative, Double_val, Double_val, Double_val, Double_val, Double_val) wML_2_cairo(rel_move_to, Double_val, Double_val) wML_2_cairo(rel_line_to, Double_val, Double_val) wML_6_cairo(rel_curve_to, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val) wML_4_cairo(rectangle, Double_val, Double_val, Double_val, Double_val) wML_0_cairo(close_path) wML_0_cairo(paint) wML_1_cairo(paint_with_alpha, Double_val) wML_1_cairo(mask, cairo_pattern_t_val) wML_3_cairo(mask_surface, cairo_surface_t_val, Double_val, Double_val) wML_0_cairo(stroke) wML_0_cairo(stroke_preserve) wML_0_cairo(fill) wML_0_cairo(fill_preserve) wML_0_cairo(copy_page) wML_0_cairo(show_page) CAMLprim value ml_cairo_in_stroke (value v_cr, value p) { cairo_bool_t c_ret; c_ret = cairo_in_stroke (cairo_t_val (v_cr), Double_field (p, 0), Double_field (p, 1)); check_cairo_status (v_cr); return Val_bool (c_ret); } CAMLprim value ml_cairo_in_fill (value v_cr, value p) { cairo_bool_t c_ret; c_ret = cairo_in_fill (cairo_t_val (v_cr), Double_field (p, 0), Double_field (p, 1)); check_cairo_status (v_cr); return Val_bool (c_ret); } CAMLprim value ml_cairo_stroke_extents (value v_cr) { double x1, y1, x2, y2; cairo_stroke_extents (cairo_t_val (v_cr), &x1, &y1, &x2, &y2); check_cairo_status (v_cr); { CAMLparam0 (); CAMLlocal1 (t); t = caml_alloc_tuple (4); Store_field (t, 0, caml_copy_double (x1)); Store_field (t, 1, caml_copy_double (y1)); Store_field (t, 2, caml_copy_double (x2)); Store_field (t, 3, caml_copy_double (y2)); CAMLreturn (t); } } CAMLprim value ml_cairo_fill_extents (value v_cr) { double x1, y1, x2, y2; cairo_fill_extents (cairo_t_val (v_cr), &x1, &y1, &x2, &y2); check_cairo_status (v_cr); { CAMLparam0 (); CAMLlocal1 (t); t = caml_alloc_tuple (4); Store_field (t, 0, caml_copy_double (x1)); Store_field (t, 1, caml_copy_double (y1)); Store_field (t, 2, caml_copy_double (x2)); Store_field (t, 3, caml_copy_double (y2)); CAMLreturn (t); } } wML_0_cairo(reset_clip) wML_0_cairo(clip) wML_0_cairo(clip_preserve) #define cairo_font_weight_t_val(v) ((cairo_font_weight_t) Int_val(v)) #define Val_cairo_font_weight_t(v) Val_int(v) #define cairo_font_slant_t_val(v) ((cairo_font_slant_t) Int_val(v)) #define Val_cairo_font_slant_t(v) Val_int(v) wML_3_cairo(select_font_face, String_val, cairo_font_slant_t_val, cairo_font_weight_t_val) wML_1_cairo(set_font_size, Double_val) CAMLprim value ml_cairo_set_font_matrix (value v_cr, value v_matrix) { #ifndef ARCH_ALIGN_DOUBLE cairo_set_font_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v_matrix)); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (v_matrix, &mat); cairo_set_font_matrix (cairo_t_val (v_cr), &mat); #endif check_cairo_status (v_cr); return Val_unit; } CAMLprim value ml_cairo_get_font_matrix (value v_cr) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam1(v_cr); value v = cairo_matrix_alloc(); cairo_get_font_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v)); CAMLreturn(v); #else cairo_matrix_t mat; cairo_get_font_matrix (cairo_t_val (v_cr), &mat); check_cairo_status (v_cr); return ml_convert_cairo_matrix_out (&mat); #endif } wML_1_cairo (set_font_options, cairo_font_options_t_val) wML_1_cairo (get_font_options, cairo_font_options_t_val) wML_1_cairo (set_scaled_font, cairo_scaled_font_t_val) wML_1_cairo(show_text, String_val) cairo_glyph_t * ml_convert_cairo_glypth_in (value v, int *num_glyphs) { size_t i, n = Wosize_val (v); cairo_glyph_t *g = caml_stat_alloc (n * sizeof (cairo_glyph_t)); for (i = 0; i < n; i++) { value vg = Field (v, i); g[i].index = Unsigned_long_val (Field (vg, 0)); g[i].x = Double_val (Field (vg, 1)); g[i].y = Double_val (Field (vg, 2)); } *num_glyphs = n; return g; } CAMLprim value ml_cairo_show_glyphs (value v_cr, value v_glyphs) { int num_glyphs; cairo_glyph_t *c_glyphs; c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); cairo_show_glyphs (cairo_t_val (v_cr), c_glyphs, num_glyphs); caml_stat_free (c_glyphs); check_cairo_status (v_cr); return Val_unit; } wML_1 (cairo_get_font_face, cairo_t_val, Val_cairo_font_face_ref) value Val_cairo_font_extents (cairo_font_extents_t * s) { value v = caml_alloc_small (5 * Double_wosize, Double_array_tag); Store_double_field (v, 0, s->ascent); Store_double_field (v, 1, s->descent); Store_double_field (v, 2, s->height); Store_double_field (v, 3, s->max_x_advance); Store_double_field (v, 4, s->max_y_advance); return v; } CAMLprim value ml_cairo_font_extents (value cr) { cairo_font_extents_t e; cairo_font_extents (cairo_t_val (cr), &e); check_cairo_status (cr); return Val_cairo_font_extents (&e); } wML_1_cairo (set_font_face, cairo_font_face_t_val) value Val_cairo_text_extents (cairo_text_extents_t * s) { value v = caml_alloc_small (6 * Double_wosize, Double_array_tag); Store_double_field (v, 0, s->x_bearing); Store_double_field (v, 1, s->y_bearing); Store_double_field (v, 2, s->width); Store_double_field (v, 3, s->height); Store_double_field (v, 4, s->x_advance); Store_double_field (v, 5, s->y_advance); return v; } CAMLprim value ml_cairo_text_extents (value v_cr, value v_utf8) { cairo_text_extents_t c_extents; cairo_text_extents (cairo_t_val (v_cr), String_val (v_utf8), &c_extents); check_cairo_status (v_cr); return Val_cairo_text_extents (&c_extents); } CAMLprim value ml_cairo_glyph_extents (value v_cr, value v_glyphs) { int num_glyphs; cairo_glyph_t *c_glyphs; cairo_text_extents_t c_extents; c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); cairo_glyph_extents (cairo_t_val (v_cr), c_glyphs, num_glyphs, &c_extents); caml_stat_free (c_glyphs); check_cairo_status (v_cr); return Val_cairo_text_extents (&c_extents); } wML_1_cairo(text_path, String_val) CAMLprim value ml_cairo_glyph_path (value v_cr, value v_glyphs) { int num_glyphs; cairo_glyph_t *c_glyphs; c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); cairo_glyph_path (cairo_t_val (v_cr), c_glyphs, num_glyphs); caml_stat_free (c_glyphs); check_cairo_status (v_cr); return Val_unit; } #define cairo_get(cname, conv) wML_1(cairo_get_##cname, cairo_t_val, conv) cairo_get(operator, Val_cairo_operator_t) cairo_get(source, Val_cairo_pattern_ref) cairo_get(tolerance, caml_copy_double) cairo_get(antialias, Val_cairo_antialias_t) CAMLprim value ml_cairo_get_current_point (value cr) { double x, y; cairo_get_current_point (cairo_t_val (cr), &x, &y); return ml_cairo_point (x, y); } cairo_get(fill_rule, Val_cairo_fill_rule_t) cairo_get(line_width, caml_copy_double) cairo_get(line_cap, Val_cairo_line_cap_t) cairo_get(line_join, Val_cairo_line_join_t) cairo_get(miter_limit, caml_copy_double) CAMLprim value ml_cairo_get_matrix (value v_cr) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam1(v_cr); value v = cairo_matrix_alloc(); cairo_get_matrix (cairo_t_val (v_cr), cairo_matrix_t_val (v)); CAMLreturn(v); #else cairo_matrix_t mat; cairo_get_matrix (cairo_t_val (v_cr), &mat); return ml_convert_cairo_matrix_out (&mat); #endif } cairo_get(target, Val_cairo_surface_ref) cairo_get(group_target, Val_cairo_surface_ref) /* ml_cairo_path */ /* ml_cairo_status */ value * ml_cairo_make_root (value v) { value *root = caml_stat_alloc (sizeof (value *)); *root = v; caml_register_global_root (root); return root; } value * ml_cairo_make_closure (value f) { CAMLparam1(f); value c, *r; c = caml_alloc_small (2, 0); Field (c, 0) = f; Field (c, 1) = Val_unit; r = ml_cairo_make_root (c); #ifdef CAMLreturnT CAMLreturnT (value*, r); #else CAMLreturn (r); #endif } cairo_status_t ml_cairo_write_func (void *closure, const unsigned char *data, unsigned int length) { value s, res, *c = closure; s = caml_alloc_string (length); memcpy (String_val (s), data, length); res = caml_callback_exn (Field (*c, 0), s); if (Is_exception_result (res)) { Store_field (*c, 1, res); return CAIRO_STATUS_WRITE_ERROR; } return CAIRO_STATUS_SUCCESS; } cairo_status_t ml_cairo_read_func (void *closure, unsigned char *data, unsigned int length) { value s, res, *c = closure; s = caml_alloc_string (length); res = caml_callback_exn (Field (*c, 0), s); if (Is_exception_result (res)) { Store_field (*c, 1, res); return CAIRO_STATUS_READ_ERROR; } memcpy (data, String_val (s), length); return CAIRO_STATUS_SUCCESS; } cairo_status_t ml_cairo_unsafe_write_func (void *closure, const unsigned char *data, unsigned int length) { value res, *c = closure; res = caml_callback2_exn (Field (*c, 0), Val_bp (data), Val_int (length)); if (Is_exception_result (res)) { Store_field (*c, 1, res); return CAIRO_STATUS_WRITE_ERROR; } return CAIRO_STATUS_SUCCESS; } cairo_status_t ml_cairo_unsafe_read_func (void *closure, unsigned char *data, unsigned int length) { value res, *c = closure; res = caml_callback2_exn (Field (*c, 0), Val_bp (data), Val_int (length)); if (Is_exception_result (res)) { Store_field (*c, 1, res); return CAIRO_STATUS_READ_ERROR; } return CAIRO_STATUS_SUCCESS; } cairo-ocaml-1.2.0/src/ml_cairo.h000066400000000000000000000100161136043615400164260ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include #include #define CAML_NAME_SPACE #include #include #include #include #include #include "ml_cairo_wrappers.h" #include /* cairo */ #define cairo_t_val(v) wPointer_val(cairo_t, v) value Val_cairo_t (cairo_t *); #define cairo_surface_t_val(v) wPointer_val(cairo_surface_t, v) value Val_cairo_surface_t (cairo_surface_t *); #define Val_cairo_surface_ref(p) Val_cairo_surface_t (cairo_surface_reference(p)) #define cairo_pattern_t_val(v) wPointer_val(cairo_pattern_t, v) value Val_cairo_pattern_t (cairo_pattern_t *); #define Val_cairo_pattern_ref(p) Val_cairo_pattern_t (cairo_pattern_reference(p)) #define cairo_format_t_val(v) ((cairo_format_t) Int_val(v)) #define Val_cairo_format_t(v) Val_int(v) #define cairo_antialias_t_val(v) ((cairo_antialias_t) Int_val(v)) #define Val_cairo_antialias_t(v) Val_int(v) /* cairo_font */ #define cairo_font_face_t_val(v) wPointer_val(cairo_font_face_t, v) value Val_cairo_font_face_t (cairo_font_face_t *); #define Val_cairo_font_face_ref(p) Val_cairo_font_face_t (cairo_font_face_reference(p)) #define cairo_scaled_font_t_val(v) wPointer_val(cairo_scaled_font_t, v) value Val_cairo_scaled_font_t (cairo_scaled_font_t *); #define cairo_font_options_t_val(v) wPointer_val(cairo_font_options_t, v) value Val_cairo_font_options_t (cairo_font_options_t *); /* cairo_surface */ cairo_content_t cairo_content_t_val (value); /* cairo_matrix */ #ifdef ARCH_ALIGN_DOUBLE void ml_convert_cairo_matrix_in (value, cairo_matrix_t *); value ml_convert_cairo_matrix_out (const cairo_matrix_t *); #else # define cairo_matrix_t_val(v) (cairo_matrix_t *)(v) # define cairo_matrix_alloc() caml_alloc_small (6 * Double_wosize, Double_array_tag) # define cairo_copy_matrix(dst, src) memcpy (Bp_val(dst), Bp_val(src), 6 * Double_wosize * sizeof (value)) #endif value ml_cairo_point (double, double); cairo_glyph_t * ml_convert_cairo_glypth_in (value v, int *); value Val_cairo_font_extents (cairo_font_extents_t *); value Val_cairo_text_extents (cairo_text_extents_t *); /* cairo_status */ void ml_cairo_treat_status (cairo_status_t) Noreturn; #define cairo_treat_status(s) if (s != CAIRO_STATUS_SUCCESS) ml_cairo_treat_status (s) #define check_cairo_status(cr) cairo_treat_status (cairo_status (cairo_t_val (cr))) #define check_surface_status(cr) cairo_treat_status (cairo_surface_status (cairo_surface_t_val (cr))) #define check_pattern_status(cr) cairo_treat_status (cairo_pattern_status (cairo_pattern_t_val (cr))) #define check_font_face_status(cr) cairo_treat_status (cairo_font_face_status (cairo_font_face_t_val (cr))) #define check_scaled_font_status(cr) cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (cr))) #define check_font_options_status(cr) cairo_treat_status (cairo_font_options_status (cairo_font_options_t_val (cr))) #define report_null_pointer() ml_cairo_treat_status (CAIRO_STATUS_NULL_POINTER) /* stream callbacks */ value *ml_cairo_make_closure (value); value *ml_cairo_make_root (value); cairo_status_t ml_cairo_write_func (void *, const unsigned char *, unsigned int); cairo_status_t ml_cairo_read_func (void *, unsigned char *, unsigned int); cairo_status_t ml_cairo_unsafe_write_func (void *, const unsigned char *, unsigned int); cairo_status_t ml_cairo_unsafe_read_func (void *, unsigned char *, unsigned int); void ml_cairo_surface_set_stream_data (cairo_surface_t *, value *); void ml_cairo_surface_set_image_data (cairo_surface_t *, value); cairo-ocaml-1.2.0/src/ml_cairo_bigarr.c000066400000000000000000000030621136043615400177520ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #include /* This prototype is only exported since OCaml 3.11 */ uintnat caml_ba_byte_size (struct caml_ba_array *); CAMLprim value ml_bigarray_byte_size (value b) { return Val_long (caml_ba_byte_size (Caml_ba_array_val (b))); } CAMLprim value ml_bigarray_kind_float (value v) { struct caml_ba_array *ba = Caml_ba_array_val (v); switch (ba->flags & CAML_BA_KIND_MASK) { case CAML_BA_FLOAT32: case CAML_BA_FLOAT64: case CAML_BA_COMPLEX32: case CAML_BA_COMPLEX64: return Val_true; default: return Val_false; } } CAMLprim value ml_cairo_image_surface_create_for_data (value img, value fmt, value w, value h, value stride) { cairo_surface_t *surf; surf = cairo_image_surface_create_for_data (Caml_ba_data_val (img), cairo_format_t_val (fmt), Int_val (w), Int_val (h), Int_val (stride)); ml_cairo_surface_set_image_data (surf, img); return Val_cairo_surface_t (surf); } /* cairo_image_surface_get_data */ cairo-ocaml-1.2.0/src/ml_cairo_font.c000066400000000000000000000134301136043615400174520ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" /* cairo_font_options */ static long ml_cairo_font_options_hash (value fo) { return cairo_font_options_hash (cairo_font_options_t_val (fo)); } wMake_Val_final_pointer_full(cairo_font_options_t, cairo_font_options_destroy, 0, \ ml_pointer_compare, ml_cairo_font_options_hash) CAMLprim value ml_cairo_font_options_create (value unit) { cairo_font_options_t *o = cairo_font_options_create(); cairo_treat_status (cairo_font_options_status (o)); return Val_cairo_font_options_t (o); } wML_2(cairo_font_options_merge, cairo_font_options_t_val, cairo_font_options_t_val, Unit) wML_2(cairo_font_options_equal, cairo_font_options_t_val, cairo_font_options_t_val, Val_bool) #define cairo_subpixel_order_t_val(v) ((cairo_subpixel_order_t) Int_val(v)) #define Val_cairo_subpixel_order_t(v) Val_int(v) #define cairo_hint_style_t_val(v) ((cairo_hint_style_t) Int_val(v)) #define Val_cairo_hint_style_t(v) Val_int(v) #define cairo_hint_metrics_t_val(v) ((cairo_hint_metrics_t) Int_val(v)) #define Val_cairo_hint_metrics_t(v) Val_int(v) wML_2(cairo_font_options_set_antialias, cairo_font_options_t_val, cairo_antialias_t_val, Unit) wML_1(cairo_font_options_get_antialias, cairo_font_options_t_val, Val_cairo_antialias_t) wML_2(cairo_font_options_set_subpixel_order, cairo_font_options_t_val, cairo_subpixel_order_t_val, Unit) wML_1(cairo_font_options_get_subpixel_order, cairo_font_options_t_val, Val_cairo_subpixel_order_t) wML_2(cairo_font_options_set_hint_style, cairo_font_options_t_val, cairo_hint_style_t_val, Unit) wML_1(cairo_font_options_get_hint_style, cairo_font_options_t_val, Val_cairo_hint_style_t) wML_2(cairo_font_options_set_hint_metrics, cairo_font_options_t_val, cairo_hint_metrics_t_val, Unit) wML_1(cairo_font_options_get_hint_metrics, cairo_font_options_t_val, Val_cairo_hint_metrics_t) /* cairo_font_face */ wMake_Val_final_pointer(cairo_font_face_t, cairo_font_face_destroy, 0) /* font_face_reference */ /* font_face_destroy */ /* font_face_status */ #define Val_cairo_font_type_t(v) Val_int(v) wML_1(cairo_font_face_get_type, cairo_font_face_t_val, Val_cairo_font_type_t) /* font_face_get_user_data */ /* font_face_set_user_data */ /* cairo_scaled_font */ wMake_Val_final_pointer(cairo_scaled_font_t, cairo_scaled_font_destroy, 0) CAMLprim value ml_cairo_scaled_font_create (value f, value fmat, value ctm, value fo) { cairo_scaled_font_t *sf; #ifndef ARCH_ALIGN_DOUBLE sf = cairo_scaled_font_create (cairo_font_face_t_val (f), cairo_matrix_t_val (fmat), cairo_matrix_t_val (ctm), cairo_font_options_t_val (fo)); #else cairo_matrix_t c_fmat, c_ctm; ml_convert_cairo_matrix_in (fmat, &c_fmat); ml_convert_cairo_matrix_in (ctm, &c_ctm); sf = cairo_scaled_font_create (cairo_font_face_t_val (f), &c_fmat, &c_ctm, cairo_font_options_t_val (fo)); #endif return Val_cairo_scaled_font_t (sf); } /* scaled_font_face_reference */ /* scaled_font_face_destroy */ /* scaled_font_face_status */ wML_1 (cairo_scaled_font_get_type, cairo_scaled_font_t_val, Val_cairo_font_type_t) CAMLprim value ml_cairo_scaled_font_extents (value sf) { cairo_font_extents_t e; cairo_scaled_font_extents (cairo_scaled_font_t_val (sf), &e); cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); return Val_cairo_font_extents (&e); } CAMLprim value ml_cairo_scaled_font_text_extents (value sf, value v_utf8) { cairo_text_extents_t c_extents; cairo_scaled_font_text_extents (cairo_scaled_font_t_val (sf), String_val (v_utf8), &c_extents); cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); return Val_cairo_text_extents (&c_extents); } CAMLprim value ml_cairo_scaled_font_glyph_extents (value sf, value v_glyphs) { int num_glyphs; cairo_glyph_t *c_glyphs; cairo_text_extents_t c_extents; c_glyphs = ml_convert_cairo_glypth_in (v_glyphs, &num_glyphs); cairo_scaled_font_glyph_extents (cairo_scaled_font_t_val (sf), c_glyphs, num_glyphs, &c_extents); caml_stat_free (c_glyphs); cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); return Val_cairo_text_extents (&c_extents); } wML_1 (cairo_scaled_font_get_font_face, cairo_scaled_font_t_val, Val_cairo_font_face_ref) CAMLprim value ml_cairo_scaled_font_get_font_matrix (value sf) { CAMLparam1(sf); CAMLlocal1(m); #ifndef ARCH_ALIGN_DOUBLE m = cairo_matrix_alloc(); cairo_scaled_font_get_font_matrix (cairo_scaled_font_t_val (sf), cairo_matrix_t_val (m)); #else cairo_matrix_t c_m; cairo_scaled_font_get_font_matrix (cairo_scaled_font_t_val (sf), &c_m); m = ml_convert_cairo_matrix_out (&c_m); #endif cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); CAMLreturn(m); } CAMLprim value ml_cairo_scaled_font_get_ctm (value sf) { CAMLparam1(sf); CAMLlocal1(m); #ifndef ARCH_ALIGN_DOUBLE m = cairo_matrix_alloc(); cairo_scaled_font_get_ctm (cairo_scaled_font_t_val (sf), cairo_matrix_t_val (m)); #else cairo_matrix_t c_m; cairo_scaled_font_get_ctm (cairo_scaled_font_t_val (sf), &c_m); m = ml_convert_cairo_matrix_out (&c_m); #endif cairo_treat_status (cairo_scaled_font_status (cairo_scaled_font_t_val (sf))); CAMLreturn(m); } wML_2 (cairo_scaled_font_get_font_options, cairo_scaled_font_t_val, cairo_font_options_t_val, Unit) cairo-ocaml-1.2.0/src/ml_cairo_ft.c000066400000000000000000000073451136043615400171250ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #if CAIRO_HAS_FT_FONT # include /* minimal Freetype interface */ static void ml_raise_FT_Error (FT_Error err) { static value *caml_exn; if (err == FT_Err_Ok) return; if (caml_exn == NULL) { caml_exn = caml_named_value ("FT_exn"); if (caml_exn == NULL) caml_failwith ("freetype error"); } caml_raise_with_arg (*caml_exn, Val_int (err)); } static value Val_ptr (void *p) { value v = caml_alloc_small (1, Abstract_tag); Field (v, 0) = Val_bp (p); return v; } #define FT_Library_val(v) (FT_Library)(Field(v, 0)) CAMLprim value ml_FT_Init_FreeType (value unit) { FT_Library lib; ml_raise_FT_Error (FT_Init_FreeType (&lib)); return Val_ptr (lib); } CAMLprim value ml_FT_Done_FreeType (value lib) { ml_raise_FT_Error (FT_Done_FreeType (FT_Library_val (lib))); return Val_unit; } #define FT_Face_val(v) (FT_Face)(Field(v, 0)) CAMLprim value ml_FT_New_Face (value lib, value o_index, value path) { FT_Face face; FT_Long index = Is_block(o_index) ? Long_val(Field(o_index, 0)) : 0; ml_raise_FT_Error (FT_New_Face (FT_Library_val (lib), String_val (path), index, &face)); return Val_ptr (face); } CAMLprim value ml_FT_Done_Face (value face) { ml_raise_FT_Error (FT_Done_Face (FT_Face_val (face))); return Val_unit; } /* minimal Fontconfig interface */ wMake_Val_final_pointer (FcPattern, FcPatternDestroy, 10) #define FcPattern_val(v) wPointer_val(FcPattern,v) #define UString_val(v) ((unsigned char *) (v)) CAMLprim value ml_FcNameParse (value fo, value s) { FcPattern *p1, *p2; FcResult res; p1 = FcNameParse (UString_val(s)); FcConfigSubstitute (NULL, p1, FcMatchPattern); if (Is_block (fo)) { cairo_ft_font_options_substitute (cairo_font_options_t_val (Field (fo, 0)), p1); } FcDefaultSubstitute (p1); p2 = FcFontMatch (NULL, p1, &res); FcPatternDestroy (p1); return Val_FcPattern (p2); } CAMLprim value ml_FcNameUnparse (value patt) { FcChar8 *s; value r; s = FcNameUnparse (FcPattern_val (patt)); if (s == NULL) caml_failwith ("FcNameUnparse"); r = caml_copy_string ((char *) s); free (s); return r; } /* cairo Fontconfig/Freetype font backend */ wML_1 (cairo_ft_font_face_create_for_pattern, FcPattern_val, Val_cairo_font_face_t) wML_2 (cairo_ft_font_face_create_for_ft_face, FT_Face_val, Int_val, Val_cairo_font_face_t) wML_1 (cairo_ft_scaled_font_lock_face, cairo_scaled_font_t_val, Val_ptr) wML_1 (cairo_ft_scaled_font_unlock_face, cairo_scaled_font_t_val, Unit) #else Cairo_Unsupported (FT_Init_FreeType, "FT backend not supported") Cairo_Unsupported (FT_Done_FreeType, "FT backend not supported") Cairo_Unsupported (FT_New_Face, "FT backend not supported") Cairo_Unsupported (FT_Done_Face, "FT backend not supported") Cairo_Unsupported (FcNameParse, "FT backend not supported") Cairo_Unsupported (FcNameUnparse, "FT backend not supported") Cairo_Unsupported (cairo_ft_font_create_for_pattern, "FT backend not supported") Cairo_Unsupported (cairo_ft_font_create_for_ft_face, "FT backend not supported") Cairo_Unsupported (cairo_ft_scaled_font_lock_face, "FT backend not supported") Cairo_Unsupported (cairo_ft_scaled_font_unlock_face, "FT backend not supported") #endif /* CAIRO_HAS_FT_FONT */ cairo-ocaml-1.2.0/src/ml_cairo_lablgtk.c000066400000000000000000000020321136043615400201200ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_gdkpixbuf.h" #include "ml_gdk.h" wML_1(gdk_cairo_create, GdkDrawable_val, Val_cairo_t) wML_2(gdk_cairo_set_source_color, cairo_t_val, GdkColor_val, Unit) wML_2(gdk_cairo_rectangle, cairo_t_val, GdkRectangle_val, Unit) wML_2(gdk_cairo_region, cairo_t_val, GdkRegion_val, Unit) wML_4(gdk_cairo_set_source_pixbuf, cairo_t_val, GdkPixbuf_val, Double_val, Double_val, Unit) cairo-ocaml-1.2.0/src/ml_cairo_matrix.c000066400000000000000000000105101136043615400200040ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #ifdef ARCH_ALIGN_DOUBLE void ml_convert_cairo_matrix_in (value v, cairo_matrix_t *mat) { mat->xx = Double_field (v, 0); mat->yx = Double_field (v, 1); mat->xy = Double_field (v, 2); mat->yy = Double_field (v, 3); mat->x0 = Double_field (v, 4); mat->y0 = Double_field (v, 5); } value ml_convert_cairo_matrix_out (const cairo_matrix_t *mat) { value v; v = caml_alloc_small (6 * Double_wosize, Double_array_tag); Store_double_field (v, 0, mat->xx); Store_double_field (v, 1, mat->yx); Store_double_field (v, 2, mat->xy); Store_double_field (v, 3, mat->yy); Store_double_field (v, 4, mat->x0); Store_double_field (v, 5, mat->y0); return v; } #endif /* matrix_init */ /* matrix_init_identity */ /* matrix_init_translate */ /* matrix_init_scale */ /* matrix_init_rotate */ CAMLprim value ml_cairo_matrix_translate (value m, value x, value y) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam3(m, x, y); value v = cairo_matrix_alloc(); cairo_copy_matrix (v, m); cairo_matrix_translate (cairo_matrix_t_val (v), Double_val (x), Double_val (y)); CAMLreturn (v); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_matrix_translate (&mat, Double_val (x), Double_val (y)); return ml_convert_cairo_matrix_out (&mat); #endif } CAMLprim value ml_cairo_matrix_scale (value m, value x, value y) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam3(m, x, y); value v = cairo_matrix_alloc(); cairo_copy_matrix (v, m); cairo_matrix_scale (cairo_matrix_t_val (v), Double_val (x), Double_val (y)); CAMLreturn (v); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_matrix_scale (&mat, Double_val (x), Double_val (y)); return ml_convert_cairo_matrix_out (&mat); #endif } CAMLprim value ml_cairo_matrix_rotate (value m, value a) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam2(m, a); value v = cairo_matrix_alloc(); cairo_copy_matrix (v, m); cairo_matrix_rotate (cairo_matrix_t_val (v), Double_val (a)); CAMLreturn (v); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_matrix_rotate (&mat, Double_val (a)); return ml_convert_cairo_matrix_out (&mat); #endif } CAMLprim value ml_cairo_matrix_invert (value m) { cairo_status_t st; #ifndef ARCH_ALIGN_DOUBLE CAMLparam1(m); value v = cairo_matrix_alloc(); cairo_copy_matrix (v, m); st = cairo_matrix_invert (cairo_matrix_t_val (v)); cairo_treat_status (st); CAMLreturn (v); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); st = cairo_matrix_invert (&mat); cairo_treat_status (st); return ml_convert_cairo_matrix_out (&mat); #endif } CAMLprim value ml_cairo_matrix_multiply (value a, value b) { #ifndef ARCH_ALIGN_DOUBLE CAMLparam2(a, b); value r = cairo_matrix_alloc(); cairo_matrix_multiply (cairo_matrix_t_val (r), cairo_matrix_t_val (a), cairo_matrix_t_val (b)); CAMLreturn (r); #else cairo_matrix_t r, m_a, m_b; ml_convert_cairo_matrix_in (a, &m_a); ml_convert_cairo_matrix_in (b, &m_b); cairo_matrix_multiply (&r, &m_a, &m_b); return ml_convert_cairo_matrix_out (&r); #endif } CAMLprim value ml_cairo_matrix_transform_distance (value m, value p) { double x = Double_field (p, 0); double y = Double_field (p, 1); #ifndef ARCH_ALIGN_DOUBLE cairo_matrix_transform_distance (cairo_matrix_t_val (m), &x, &y); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_matrix_transform_distance (&mat, &x, &y); #endif return ml_cairo_point (x, y); } CAMLprim value ml_cairo_matrix_transform_point (value m, value p) { double x = Double_field (p, 0); double y = Double_field (p, 1); #ifndef ARCH_ALIGN_DOUBLE cairo_matrix_transform_point (cairo_matrix_t_val (m), &x, &y); #else cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_matrix_transform_point (&mat, &x, &y); #endif return ml_cairo_point (x, y); } cairo-ocaml-1.2.0/src/ml_cairo_path.c000066400000000000000000000047521136043615400174470ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #define CAML_MOVE_TO_TAG -1795134893L #define CAML_LINE_TO_TAG 1059315789L #define CAML_CLOSE_TAG -1110065659L #define CAML_CURVE_TO_TAG -2065449769L static value ml_cairo_fold_path (cairo_path_t *path, value f, value acc) { CAMLparam2(f, acc); CAMLlocal5(var, t, p1, p2, p3); int i; cairo_treat_status (path->status); for (i = 0; i < path->num_data; i += path->data[i].header.length) { cairo_path_data_t *data = &path->data[i]; switch (data->header.type) { case CAIRO_PATH_MOVE_TO: { p1 = ml_cairo_point (data[1].point.x, data[1].point.y); var = caml_alloc_small (2, 0); Field (var, 0) = CAML_MOVE_TO_TAG; Field (var, 1) = p1; break; } case CAIRO_PATH_LINE_TO: { p1 = ml_cairo_point (data[1].point.x, data[1].point.y); var = caml_alloc_small (2, 0); Field (var, 0) = CAML_LINE_TO_TAG; Field (var, 1) = p1; break; } case CAIRO_PATH_CURVE_TO: { p1 = ml_cairo_point (data[1].point.x, data[1].point.y); p2 = ml_cairo_point (data[2].point.x, data[2].point.y); p3 = ml_cairo_point (data[3].point.x, data[3].point.y); t = caml_alloc_small (3, 0); Field (t, 0) = p1; Field (t, 1) = p2; Field (t, 2) = p3; var = caml_alloc_small (2, 0); Field (var, 0) = CAML_CURVE_TO_TAG; Field (var, 1) = t; break; } case CAIRO_PATH_CLOSE_PATH: var = CAML_CLOSE_TAG; break; } acc = caml_callback2_exn (f, acc, var); if (Is_exception_result (acc)) break; } cairo_path_destroy (path); if (Is_exception_result (acc)) caml_raise (Extract_exception (acc)); CAMLreturn (acc); } CAMLprim value ml_cairo_copy_path (value cr, value f, value init) { return ml_cairo_fold_path (cairo_copy_path (cairo_t_val (cr)), f, init); } CAMLprim value ml_cairo_copy_path_flat (value cr, value f, value init) { return ml_cairo_fold_path (cairo_copy_path_flat (cairo_t_val (cr)), f, init); } /* append_path */ cairo-ocaml-1.2.0/src/ml_cairo_pattern.c000066400000000000000000000074171136043615400201710ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #define W_CHECK_STATUS check_pattern_status #define W_CONV_CAIRO cairo_pattern_t_val #include "ml_cairo.h" wMake_Val_final_pointer(cairo_pattern_t, cairo_pattern_destroy, 0) CAMLprim value ml_cairo_pattern_create_rgb (value r, value g, value b) { cairo_pattern_t *p = cairo_pattern_create_rgb (Double_val (r), Double_val (g), Double_val (b)); cairo_treat_status (cairo_pattern_status (p)); return Val_cairo_pattern_t (p); } CAMLprim value ml_cairo_pattern_create_rgba (value r, value g, value b, value a) { cairo_pattern_t *p = cairo_pattern_create_rgba (Double_val (r), Double_val (g), Double_val (b), Double_val (a)); cairo_treat_status (cairo_pattern_status (p)); return Val_cairo_pattern_t (p); } CAMLprim value ml_cairo_pattern_create_for_surface (value surf) { cairo_pattern_t *p = cairo_pattern_create_for_surface (cairo_surface_t_val (surf)); cairo_treat_status (cairo_pattern_status (p)); return Val_cairo_pattern_t (p); } CAMLprim value ml_cairo_pattern_create_linear (value x0, value y0, value x1, value y1) { cairo_pattern_t *p = cairo_pattern_create_linear (Double_val (x0), Double_val (y0), Double_val (x1), Double_val (y1)); cairo_treat_status (cairo_pattern_status (p)); return Val_cairo_pattern_t (p); } CAMLprim value ml_cairo_pattern_create_radial (value cx0, value cy0, value r0, value cx1, value cy1, value r1) { cairo_pattern_t *p = cairo_pattern_create_radial (Double_val (cx0), Double_val (cy0), Double_val (r0), Double_val (cx1), Double_val (cy1), Double_val (r1)); cairo_treat_status (cairo_pattern_status (p)); return Val_cairo_pattern_t (p); } wML_bc6(cairo_pattern_create_radial) /* pattern_reference */ /* pattern_destroy */ #define Val_cairo_pattern_type_t(v) Val_int(v) wML_1(cairo_pattern_get_type, cairo_pattern_t_val, Val_cairo_pattern_type_t) wML_4_cairo(pattern_add_color_stop_rgb, Double_val, Double_val, Double_val, Double_val) wML_5_cairo(pattern_add_color_stop_rgba, Double_val, Double_val, Double_val, Double_val, Double_val) CAMLprim value ml_cairo_pattern_set_matrix (value p, value m) { #ifdef ARCH_ALIGN_DOUBLE cairo_matrix_t mat; ml_convert_cairo_matrix_in (m, &mat); cairo_pattern_set_matrix (cairo_pattern_t_val (p), &mat); #else cairo_pattern_set_matrix (cairo_pattern_t_val (p), cairo_matrix_t_val (m)); #endif check_pattern_status (p); return Val_unit; } CAMLprim value ml_cairo_pattern_get_matrix (value p) { #ifdef ARCH_ALIGN_DOUBLE cairo_matrix_t mat; cairo_pattern_get_matrix (cairo_pattern_t_val (p), &mat); check_pattern_status (p); return ml_convert_cairo_matrix_out (&mat); #else CAMLparam1(p); value m = caml_alloc_small (6 * Double_wosize, Double_array_tag); cairo_pattern_get_matrix (cairo_pattern_t_val (p), cairo_matrix_t_val (m)); check_pattern_status (p); CAMLreturn (m); #endif } #define cairo_extend_t_val(v) ((cairo_extend_t) Int_val(v)) #define Val_cairo_extend_t(v) Val_int(v) wML_1_cairo(pattern_set_extend, cairo_extend_t_val) wML_1(cairo_pattern_get_extend, cairo_pattern_t_val, Val_cairo_extend_t) #define cairo_filter_t_val(v) ((cairo_filter_t) Int_val(v)) #define Val_cairo_filter_t(v) Val_int(v) wML_1_cairo(pattern_set_filter, cairo_filter_t_val) wML_1(cairo_pattern_get_filter, cairo_pattern_t_val, Val_cairo_filter_t) cairo-ocaml-1.2.0/src/ml_cairo_pdf.c000066400000000000000000000032741136043615400172620ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #if CAIRO_HAS_PDF_SURFACE # include static value _ml_cairo_pdf_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe) { CAMLparam3(f, w, h); value *c; cairo_surface_t *surf; c = ml_cairo_make_closure (f); surf = cairo_pdf_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func, c, Double_val (w), Double_val (h)); ml_cairo_surface_set_stream_data (surf, c); CAMLreturn (Val_cairo_surface_t (surf)); } CAMLprim value ml_cairo_pdf_surface_create_for_stream_unsafe (value f, value w, value h) { return _ml_cairo_pdf_surface_create_for_stream (f, w, h, 1); } CAMLprim value ml_cairo_pdf_surface_create_for_stream (value f, value w, value h) { return _ml_cairo_pdf_surface_create_for_stream (f, w, h, 0); } wML_3(cairo_pdf_surface_set_size, cairo_surface_t_val, Double_val, Double_val, Unit) #else Cairo_Unsupported(cairo_pdf_surface_create_for_stream_unsafe, "PDF backend not supported"); Cairo_Unsupported(cairo_pdf_surface_create_for_stream, "PDF backend not supported"); Cairo_Unsupported(cairo_pdf_surface_set_size, "PDF backend not supported"); #endif cairo-ocaml-1.2.0/src/ml_cairo_png.c000066400000000000000000000050251136043615400172710ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #if CAIRO_HAS_PNG_FUNCTIONS static value _ml_cairo_image_surface_create_from_png_stream (value f, cairo_bool_t unsafe) { CAMLparam1(f); CAMLlocal1(c); cairo_surface_t *surf; c = caml_alloc_small (2, 0); Field (c, 0) = f; Field (c, 1) = Val_unit; surf = cairo_image_surface_create_from_png_stream (unsafe ? ml_cairo_unsafe_read_func : ml_cairo_read_func, &c); if (Is_exception_result (Field (c, 1))) caml_raise (Extract_exception (Field (c, 1))); CAMLreturn (Val_cairo_surface_t (surf)); } CAMLprim value ml_cairo_image_surface_create_from_png_stream_unsafe (value f) { return _ml_cairo_image_surface_create_from_png_stream (f, 1); } CAMLprim value ml_cairo_image_surface_create_from_png_stream (value f) { return _ml_cairo_image_surface_create_from_png_stream (f, 0); } static value _ml_cairo_surface_write_to_png_stream (value surf, value f, cairo_bool_t unsafe) { CAMLparam2(surf, f); CAMLlocal1(c); cairo_status_t s; c = caml_alloc_small (2, 0); Field (c, 0) = f; Field (c, 1) = Val_unit; s = cairo_surface_write_to_png_stream (cairo_surface_t_val (surf), unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func, &c); if (Is_exception_result (Field (c, 1))) caml_raise (Extract_exception (Field (c, 1))); cairo_treat_status (s); CAMLreturn (Val_unit); } CAMLprim value ml_cairo_surface_write_to_png_stream_unsafe (value surf, value f) { return _ml_cairo_surface_write_to_png_stream (surf, f, 1); } CAMLprim value ml_cairo_surface_write_to_png_stream (value surf, value f) { return _ml_cairo_surface_write_to_png_stream (surf, f, 0); } #else Cairo_Unsupported(cairo_image_surface_create_from_png_stream_unsafe, "PNG functions not supported") Cairo_Unsupported(cairo_image_surface_create_from_png_stream, "PNG functions not supported") Cairo_Unsupported(cairo_surface_write_to_png_stream_unsafe, "PNG functions not supported") Cairo_Unsupported(cairo_surface_write_to_png_stream, "PNG functions not supported") #endif cairo-ocaml-1.2.0/src/ml_cairo_ps.c000066400000000000000000000041701136043615400171270ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #if CAIRO_HAS_PS_SURFACE # include static value _ml_cairo_ps_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe) { CAMLparam3(f, w, h); value *c; cairo_surface_t *surf; c = ml_cairo_make_closure (f); surf = cairo_ps_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func, c, Double_val (w), Double_val (h)); ml_cairo_surface_set_stream_data (surf, c); CAMLreturn (Val_cairo_surface_t (surf)); } CAMLprim value ml_cairo_ps_surface_create_for_stream_unsafe (value f, value w, value h) { return _ml_cairo_ps_surface_create_for_stream (f, w, h, 1); } CAMLprim value ml_cairo_ps_surface_create_for_stream (value f, value w, value h) { return _ml_cairo_ps_surface_create_for_stream (f, w, h, 0); } wML_3(cairo_ps_surface_set_size, cairo_surface_t_val, Double_val, Double_val, Unit) wML_2(cairo_ps_surface_dsc_comment, cairo_surface_t_val, String_val, Unit) wML_1(cairo_ps_surface_dsc_begin_setup, cairo_surface_t_val, Unit) wML_1(cairo_ps_surface_dsc_begin_page_setup, cairo_surface_t_val, Unit) #else Cairo_Unsupported(cairo_ps_surface_create_for_stream_unsafe, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_create_for_stream, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_set_size, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_dsc_comment, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_dsc_begin_setup, "PS backend not supported"); Cairo_Unsupported(cairo_ps_surface_dsc_begin_page_setup, "PS backend not supported"); #endif cairo-ocaml-1.2.0/src/ml_cairo_status.c000066400000000000000000000025661136043615400200370ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" wML_1 (cairo_status, cairo_t_val, Val_int) wML_1 (cairo_surface_status, cairo_surface_t_val, Val_int) wML_1 (cairo_pattern_status, cairo_pattern_t_val, Val_int) wML_1 (cairo_font_face_status, cairo_font_face_t_val, Val_int) wML_1 (cairo_scaled_font_status, cairo_scaled_font_t_val, Val_int) wML_1 (cairo_font_options_status, cairo_font_options_t_val, Val_int) wML_1 (cairo_status_to_string, Int_val, caml_copy_string) void ml_cairo_treat_status (cairo_status_t status) { static value *cairo_exn; assert (status != CAIRO_STATUS_SUCCESS); if (status == CAIRO_STATUS_NO_MEMORY) caml_raise_out_of_memory (); if (cairo_exn == NULL) { cairo_exn = caml_named_value ("cairo_status_exn"); if (cairo_exn == NULL) caml_failwith ("cairo exception"); } caml_raise_with_arg (*cairo_exn, Val_int (status)); } cairo-ocaml-1.2.0/src/ml_cairo_surface.c000066400000000000000000000077621136043615400201470ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" wMake_Val_final_pointer(cairo_surface_t, cairo_surface_destroy, 0) cairo_content_t cairo_content_t_val (value v) { switch (Long_val (v)) { case 0: return CAIRO_CONTENT_COLOR; case 1: return CAIRO_CONTENT_ALPHA; case 2: return CAIRO_CONTENT_COLOR_ALPHA; default: assert (0); } } value Val_cairo_content_t (cairo_content_t c) { switch (c) { case CAIRO_CONTENT_COLOR : return Val_long(0); case CAIRO_CONTENT_ALPHA : return Val_long(1); case CAIRO_CONTENT_COLOR_ALPHA: return Val_long(2); default: assert(0); } } wML_4(cairo_surface_create_similar, \ cairo_surface_t_val, cairo_content_t_val, \ Int_val, Int_val, Val_cairo_surface_t) /* surface_reference */ /* surface_destroy */ CAMLprim value ml_cairo_surface_finish (value surf) { cairo_surface_finish (cairo_surface_t_val (surf)); check_surface_status (surf); return Val_unit; } #define Val_cairo_surface_type_t(v) Val_int(v) wML_1 (cairo_surface_get_type, cairo_surface_t_val, Val_cairo_surface_type_t) wML_1 (cairo_surface_get_content, cairo_surface_t_val, Val_cairo_content_t) static void ml_cairo_destroy_user_data (void *data) { caml_remove_global_root (data); caml_stat_free (data); } void ml_cairo_surface_set_stream_data (cairo_surface_t *surf, value *root) { static const cairo_user_data_key_t ml_cairo_stream_data_key; cairo_status_t s; s = cairo_surface_set_user_data (surf, &ml_cairo_stream_data_key, root, ml_cairo_destroy_user_data); if (s != CAIRO_STATUS_SUCCESS) { cairo_surface_destroy (surf); ml_cairo_destroy_user_data (root); cairo_treat_status (s); } } void ml_cairo_surface_set_image_data (cairo_surface_t *surf, value v) { static const cairo_user_data_key_t ml_cairo_image_data_key; cairo_status_t s; value *root; root = ml_cairo_make_root (v); s = cairo_surface_set_user_data (surf, &ml_cairo_image_data_key, root, ml_cairo_destroy_user_data); if (s != CAIRO_STATUS_SUCCESS) { cairo_surface_destroy (surf); ml_cairo_destroy_user_data (root); cairo_treat_status (s); } } /* surface_get_user_data */ wML_2(cairo_surface_get_font_options, cairo_surface_t_val, cairo_font_options_t_val, Unit) wML_1(cairo_surface_flush, cairo_surface_t_val, Unit) wML_1(cairo_surface_mark_dirty, cairo_surface_t_val, Unit) wML_5(cairo_surface_mark_dirty_rectangle, cairo_surface_t_val, Int_val, Int_val, Int_val, Int_val, Unit) wML_3(cairo_surface_set_device_offset, cairo_surface_t_val, Double_val, Double_val, Unit) CAMLprim value ml_cairo_surface_get_device_offset (value s) { double x, y; CAMLparam1(s); CAMLlocal1(v); cairo_surface_get_device_offset (cairo_surface_t_val(s), &x, &y); v = caml_alloc_tuple(2); Store_field(v, 0, caml_copy_double(x)); Store_field(v, 1, caml_copy_double(y)); CAMLreturn (v); } wML_3(cairo_surface_set_fallback_resolution, cairo_surface_t_val, Double_val, Double_val, Unit) /* Image surface */ wML_3(cairo_image_surface_create, cairo_format_t_val, Int_val, Int_val, Val_cairo_surface_t) /* cairo_image_surface_create_for_data -> in ml_cairo_bigarr.c */ /* cairo_image_surface_get_data -> in ml_cairo_bigarr.c */ wML_1 (cairo_image_surface_get_format, cairo_surface_t_val, Val_cairo_format_t) wML_1 (cairo_image_surface_get_width, cairo_surface_t_val, Val_int) wML_1 (cairo_image_surface_get_height, cairo_surface_t_val, Val_int) wML_1 (cairo_image_surface_get_stride, cairo_surface_t_val, Val_int) cairo-ocaml-1.2.0/src/ml_cairo_svg.c000066400000000000000000000040001136043615400172740ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #include "ml_cairo.h" #if CAIRO_HAS_SVG_SURFACE # include static value _ml_cairo_svg_surface_create_for_stream (value f, value w, value h, cairo_bool_t unsafe) { CAMLparam3(f, w, h); value *c; cairo_surface_t *surf; c = ml_cairo_make_closure (f); surf = cairo_svg_surface_create_for_stream (unsafe ? ml_cairo_unsafe_write_func : ml_cairo_write_func, c, Double_val (w), Double_val (h)); ml_cairo_surface_set_stream_data (surf, c); CAMLreturn (Val_cairo_surface_t (surf)); } CAMLprim value ml_cairo_svg_surface_create_for_stream_unsafe (value f, value w, value h) { return _ml_cairo_svg_surface_create_for_stream (f, w, h, 1); } CAMLprim value ml_cairo_svg_surface_create_for_stream (value f, value w, value h) { return _ml_cairo_svg_surface_create_for_stream (f, w, h, 0); } #define cairo_svg_version_t_val(v) ((cairo_svg_version_t) Int_val(v)) #define Val_cairo_svg_version_t(v) Val_int(v) wML_2(cairo_svg_surface_restrict_to_version, cairo_surface_t_val, cairo_svg_version_t_val, Unit) /* cairo_svg_get_versions */ wML_1(cairo_svg_version_to_string, cairo_svg_version_t_val, caml_copy_string) #else Cairo_Unsupported(cairo_svg_surface_create_for_stream_unsafe, "SVG backend not supported"); Cairo_Unsupported(cairo_svg_surface_create_for_stream, "SVG backend not supported"); Cairo_Unsupported(cairo_svg_surface_restrict_to_version, "SVG backend not supported"); Cairo_Unsupported(cairo_svg_version_to_string, "SVG backend not supported"); #endif cairo-ocaml-1.2.0/src/ml_cairo_wrappers.c000066400000000000000000000016271136043615400203540ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #define CAML_NAME_SPACE #include #include "ml_cairo_wrappers.h" int ml_pointer_compare (value a, value b) { void *p1 = wPointer_val (void, a); void *p2 = wPointer_val (void, b); if (p1 == p2) return 0; else if (p1 < p2) return -1; else return 1; } long ml_pointer_hash (value a) { void *p = wPointer_val (void, a); return (long) p; } cairo-ocaml-1.2.0/src/ml_cairo_wrappers.h000066400000000000000000000171731136043615400203640ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #define wPointer_val(t, val) (* ((t **) Data_custom_val(val))) int ml_pointer_compare (value, value); long ml_pointer_hash (value); #define wMake_Val_final_pointer_full(type, final, adv, cmp_method, hash_method) \ static void ml_final_##type (value val) \ { type **p = Data_custom_val(val); \ if (*p) final (*p); } \ static struct custom_operations ml_custom_##type = \ { #type "/001", ml_final_##type, \ cmp_method, hash_method, \ custom_serialize_default, custom_deserialize_default }; \ value Val_##type (type *p) \ { type **store; value ret; \ if (!p) report_null_pointer(); \ ret = caml_alloc_custom (&ml_custom_##type, sizeof p, adv, 100); \ store = Data_custom_val(ret); \ *store = p; return ret; } #define wMake_Val_final_pointer(type, final, adv) wMake_Val_final_pointer_full(type, final, adv, ml_pointer_compare, ml_pointer_hash) #ifndef ARCH_ALIGN_DOUBLE #define Double_array_val(v) ((double *)(v)) #endif #define Double_array_length(v) (Wosize_val(v) / Double_wosize) #define Ignore(x) #define Unit(x) ((x), Val_unit) #define Cairo_Unsupported(fun, msg) \ CAMLprim value ml_##fun() { caml_failwith (msg); return Val_unit; } #define wML_0(cname, conv) \ CAMLprim value ml_##cname (value unit) { return conv (cname ()); } #define wML_1(cname, conv1, conv) \ CAMLprim value ml_##cname (value arg1) { return conv (cname (conv1 (arg1))); } #define wML_1_post(cname, conv1, conv, t, post) \ CAMLprim value ml_##cname (value arg1) \ { t ret = cname (conv1(arg1)); post; return conv(ret); } #define wML_2(cname, conv1, conv2, conv) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { return conv (cname (conv1(arg1), conv2(arg2))); } #define wML_2_post(cname, conv1, conv2, t, conv) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { t ret = cname (conv1(arg1), conv2(arg2)); post; return conv(ret); } #define wML_3(cname, conv1, conv2, conv3, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } #define wML_3_post(cname, conv1, conv2, conv3, conv, t, post) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { t ret = cname (conv1(arg1), conv2(arg2), conv3(arg3)); post; return conv(t); } #define wML_4(cname, conv1, conv2, conv3, conv4, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } #define wML_4_post(cname, conv1, conv2, conv3, conv4, conv, t, post) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { t ret = cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4)); post; return conv(ret); } #define wML_5(cname, conv1, conv2, conv3, conv4, conv5, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5))); } #define wML_5_post(cname, conv1, conv2, conv3, conv4, conv5, conv, t, post) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { t ret = cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5)); \ post; return conv(ret); } #define wML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6))); } #define wML_6_post(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv, t, post) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { t ret = cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6)); post; return conv(ret); } #define wML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7))); } #define wML_7_post(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv, t, post) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { t ret = cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7)); post; return conv(ret); } #define wML_bc6(cname) \ CAMLprim value ml_##cname##_bc (value *argv, int argn) \ { return ml_##cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } #define wML_bc7(cname) \ CAMLprim value ml_##cname##_bc (value *argv, int argn) \ { return ml_##cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); } #ifndef W_CHECK_STATUS # define W_CHECK_STATUS check_cairo_status #endif #ifndef W_CONV_CAIRO # define W_CONV_CAIRO cairo_t_val #endif #define wML_0_cairo(cname) \ CAMLprim value ml_cairo_##cname (value v_cr) \ { cairo_##cname (W_CONV_CAIRO(v_cr)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } #define wML_1_cairo(cname, conv1) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } #define wML_2_cairo(cname, conv1, conv2) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1, value arg2) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1), conv2 (arg2)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } #define wML_3_cairo(cname, conv1, conv2, conv3) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1, value arg2, value arg3) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1), conv2 (arg2), conv3 (arg3)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } #define wML_4_cairo(cname, conv1, conv2, conv3, conv4) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1, value arg2, value arg3, value arg4) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1), conv2 (arg2), conv3 (arg3), conv4 (arg4)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } #define wML_5_cairo(cname, conv1, conv2, conv3, conv4, conv5) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1, value arg2, value arg3, value arg4, value arg5) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1), conv2 (arg2), conv3 (arg3), conv4 (arg4), conv5 (arg5)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } \ CAMLprim value ml_cairo_##cname##_bc (value *argv, int argn) \ { return ml_cairo_##cname (argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } #define wML_6_cairo(cname, conv1, conv2, conv3, conv4, conv5, conv6) \ CAMLprim value ml_cairo_##cname (value v_cr, value arg1, value arg2, value arg3, value arg4, value arg5, value arg6) \ { cairo_##cname (W_CONV_CAIRO(v_cr), conv1 (arg1), conv2 (arg2), conv3 (arg3), conv4 (arg4), conv5 (arg5), conv6 (arg6)); \ W_CHECK_STATUS(v_cr); \ return Val_unit; \ } \ CAMLprim value ml_cairo_##cname##_bc (value *argv, int argn) \ { return ml_cairo_##cname (argv[0],argv[1],argv[2],argv[3],argv[4],argv[5], argv[6]); } cairo-ocaml-1.2.0/src/ml_pango_cairo.c000066400000000000000000000024251136043615400176120ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #define CAML_NAME_SPACE #include "ml_cairo.h" #include #include #include #include #include #define PangoCairoFontMap_val(val) check_cast(PANGO_CAIRO_FONT_MAP, val) #define Val_PangoCairoFontMap Val_GAnyObject wML_0(pango_cairo_font_map_new, Val_PangoCairoFontMap) wML_0(pango_cairo_font_map_get_default, Val_PangoCairoFontMap) wML_1(pango_cairo_font_map_create_context, PangoCairoFontMap_val, Val_PangoContext) wML_2(pango_cairo_update_context, cairo_t_val, PangoContext_val, Unit) wML_1(pango_cairo_create_layout, cairo_t_val, Val_PangoLayout) wML_2(pango_cairo_update_layout, cairo_t_val, PangoLayout_val, Unit) wML_2(pango_cairo_show_layout, cairo_t_val, PangoLayout_val, Unit) cairo-ocaml-1.2.0/src/ml_svg_cairo.c000066400000000000000000000067331136043615400173130ustar00rootroot00000000000000/**************************************************************************/ /* cairo-ocaml -- Objective Caml bindings for Cairo */ /* Copyright © 2004-2005 Olivier Andrieu */ /* */ /* This code is free software and is licensed under the terms of the */ /* GNU Lesser General Public License version 2.1 (the "LGPL"). */ /**************************************************************************/ #define CAML_NAME_SPACE #include "ml_cairo.h" #include static value ml_svg_cairo_status (svg_cairo_status_t) Noreturn; static value ml_svg_cairo_status (svg_cairo_status_t s) { static value *exn; assert (s != SVG_CAIRO_STATUS_SUCCESS); if (s == SVG_CAIRO_STATUS_NO_MEMORY) caml_raise_out_of_memory (); if (exn == NULL) { exn = caml_named_value ("svg_cairo_status_exn"); if (exn == NULL) caml_failwith ("svg-cairo exception"); } caml_raise_with_arg (*exn, Val_int (s)); } #define check_svg_cairo_status(s) if (s != SVG_CAIRO_STATUS_SUCCESS) ml_svg_cairo_status (s) wMake_Val_final_pointer (svg_cairo_t, svg_cairo_destroy, 0) #define svg_cairo_t_val(v) wPointer_val(svg_cairo_t, v) CAMLprim value ml_svg_cairo_create (value unit) { svg_cairo_status_t status; svg_cairo_t *s; status = svg_cairo_create (&s); check_svg_cairo_status (status); return Val_svg_cairo_t (s); } CAMLprim value ml_svg_cairo_parse (value v, value f) { svg_cairo_status_t status; status = svg_cairo_parse (svg_cairo_t_val (v), String_val (f)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_parse_buffer (value v, value b) { svg_cairo_status_t status; status = svg_cairo_parse_buffer (svg_cairo_t_val (v), String_val (b), caml_string_length (b)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_parse_chunk_begin (value v) { svg_cairo_status_t status; status = svg_cairo_parse_chunk_begin (svg_cairo_t_val (v)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_parse_chunk (value v, value b, value o, value l) { svg_cairo_status_t status; if (Unsigned_int_val (o) + Unsigned_int_val (l) > caml_string_length (b)) caml_invalid_argument ("Svg_cairo.parse_chunk: invalid substring"); status = svg_cairo_parse_chunk (svg_cairo_t_val (v), String_val (b) + Unsigned_int_val (o), Unsigned_int_val (l)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_parse_chunk_end (value v) { svg_cairo_status_t status; status = svg_cairo_parse_chunk_end (svg_cairo_t_val (v)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_render (value v, value cr) { svg_cairo_status_t status; status = svg_cairo_render (svg_cairo_t_val (v), cairo_t_val (cr)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_set_viewport_dimension (value v, value w, value h) { svg_cairo_status_t status; status = svg_cairo_set_viewport_dimension (svg_cairo_t_val (v), Unsigned_int_val (w), Unsigned_int_val (h)); check_svg_cairo_status (status); return Val_unit; } CAMLprim value ml_svg_cairo_get_size (value s) { unsigned int w, h; value r; svg_cairo_get_size (svg_cairo_t_val (s), &w, &h); r = caml_alloc_small (2, 0); Field (r, 0) = Val_long (w); Field (r, 1) = Val_long (h); return r; } cairo-ocaml-1.2.0/src/pango_cairo.ml000066400000000000000000000023451136043615400173110ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) open Gaux open Gobject type font_map = [`pangocairofontmap] obj module FontMap = struct external new_ : unit -> font_map = "ml_pango_cairo_font_map_new" external get_default : unit -> font_map = "ml_pango_cairo_font_map_get_default" external create_context : font_map -> Pango.context = "ml_pango_cairo_font_map_create_context" end external update_context : Cairo.t -> Pango.context -> unit = "ml_pango_cairo_update_context" external create_layout : Cairo.t -> Pango.layout = "ml_pango_cairo_create_layout" external update_layout : Cairo.t -> Pango.layout -> unit = "ml_pango_cairo_update_layout" external show_layout : Cairo.t -> Pango.layout -> unit = "ml_pango_cairo_show_layout" cairo-ocaml-1.2.0/src/pango_cairo.mli000066400000000000000000000020311136043615400174520ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** Cairo rendering backend for Pango. For more details please see: [http://developer.gnome.org/doc/API/2.0/pango/pango-Cairo-Rendering.html] *) type font_map module FontMap : sig val new_ : unit -> font_map val get_default : unit -> font_map val create_context : font_map -> Pango.context end val update_context : Cairo.t -> Pango.context -> unit val create_layout : Cairo.t -> Pango.layout val update_layout : Cairo.t -> Pango.layout -> unit val show_layout : Cairo.t -> Pango.layout -> unit cairo-ocaml-1.2.0/src/svg_cairo.ml000066400000000000000000000026401136043615400170020ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type status = SUCCESS | NO_MEMORY | IO_ERROR | FILE_NOT_FOUND | INVALID_VALUE | INVALID_CALL | PARSE_ERROR exception Error of status let init = Callback.register_exception "svg_cairo_status_exn" (Error NO_MEMORY) type t external create : unit -> t = "ml_svg_cairo_create" external parse : t -> string -> unit = "ml_svg_cairo_parse" external parse_string : t -> string -> unit = "ml_svg_cairo_parse_buffer" external parse_chunk_begin : t -> unit = "ml_svg_cairo_parse_chunk_begin" external parse_chunk : t -> string -> int -> int -> unit = "ml_svg_cairo_parse_chunk" external parse_chunk_end : t -> unit = "ml_svg_cairo_parse_chunk_end" external render : t -> Cairo.t -> unit = "ml_svg_cairo_render" external set_viewport_dimenstion : t -> int -> int -> unit = "ml_svg_cairo_set_viewport_dimension" external get_size : t -> int * int = "ml_svg_cairo_get_size" cairo-ocaml-1.2.0/src/svg_cairo.mli000066400000000000000000000026661136043615400171630ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) (** Rendering SVG documents with cairo *) type status = SUCCESS | NO_MEMORY | IO_ERROR | FILE_NOT_FOUND | INVALID_VALUE | INVALID_CALL | PARSE_ERROR exception Error of status val init : unit type t external create : unit -> t = "ml_svg_cairo_create" (** {3 Parsing} *) external parse : t -> string -> unit = "ml_svg_cairo_parse" external parse_string : t -> string -> unit = "ml_svg_cairo_parse_buffer" external parse_chunk_begin : t -> unit = "ml_svg_cairo_parse_chunk_begin" external parse_chunk : t -> string -> int -> int -> unit = "ml_svg_cairo_parse_chunk" external parse_chunk_end : t -> unit = "ml_svg_cairo_parse_chunk_end" (** {3 Rendering} *) external render : t -> Cairo.t -> unit = "ml_svg_cairo_render" external set_viewport_dimenstion : t -> int -> int -> unit = "ml_svg_cairo_set_viewport_dimension" external get_size : t -> int * int = "ml_svg_cairo_get_size" cairo-ocaml-1.2.0/support/000077500000000000000000000000001136043615400154175ustar00rootroot00000000000000cairo-ocaml-1.2.0/support/install-sh000077500000000000000000000127011136043615400174240ustar00rootroot00000000000000#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else : fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: chmodcmd="" else instcmd=$mkdirprog fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f "$src" ] || [ -d "$src" ] then : else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else : fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else : fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else : fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else : ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else : ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else : ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else : ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else : fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else :;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else :;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else :;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else :;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 cairo-ocaml-1.2.0/support/ocaml.m4000066400000000000000000000124571136043615400167650ustar00rootroot00000000000000dnl autoconf macros for OCaml dnl dnl Copyright © 2009 Richard W.M. Jones dnl Copyright © 2009 Stefano Zacchiroli dnl Copyright © 2000-2005 Olivier Andrieu dnl Copyright © 2000-2005 Jean-Christophe Filliâtre dnl Copyright © 2000-2005 Georges Mariano dnl dnl For documentation, please read the ocaml.m4 man page. AC_DEFUN([AC_PROG_OCAML], [dnl # checking for ocamlc AC_CHECK_TOOL([OCAMLC],[ocamlc],[no]) if test "$OCAMLC" != "no"; then OCAMLVERSION=$($OCAMLC -version) AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) # If OCAMLLIB is set, use it if test "$OCAMLLIB" = ""; then OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` else AC_MSG_RESULT([OCAMLLIB previously set; preserving it.]) fi AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) AC_SUBST([OCAMLVERSION]) AC_SUBST([OCAMLLIB]) # checking for ocamlopt AC_CHECK_TOOL([OCAMLOPT],[ocamlopt],[no]) OCAMLBEST=byte if test "$OCAMLOPT" = "no"; then AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) else TMPVERSION=$($OCAMLOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) OCAMLOPT=no else OCAMLBEST=opt fi fi AC_SUBST([OCAMLBEST]) # checking for ocamlc.opt AC_CHECK_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no]) if test "$OCAMLCDOTOPT" != "no"; then TMPVERSION=$($OCAMLCDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) else OCAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$OCAMLOPT" != "no" ; then AC_CHECK_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) if test "$OCAMLOPTDOTOPT" != "no"; then TMPVERSION=$($OCAMLOPTDOTOPT -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) else OCAMLOPT=$OCAMLOPTDOTOPT fi fi fi fi # checking for ocaml toplevel AC_CHECK_TOOL([OCAML],[ocaml],[no]) # checking for ocamldep AC_CHECK_TOOL([OCAMLDEP],[ocamldep],[no]) # checking for ocamlmktop AC_CHECK_TOOL([OCAMLMKTOP],[ocamlmktop],[no]) # checking for ocamlmklib AC_CHECK_TOOL([OCAMLMKLIB],[ocamlmklib],[no]) # checking for ocamldoc AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no]) # checking for ocamlbuild AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no]) ]) AC_DEFUN([AC_PROG_OCAMLLEX], [dnl # checking for ocamllex AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no]) if test "$OCAMLLEX" != "no"; then AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) if test "$OCAMLLEXDOTOPT" != "no"; then OCAMLLEX=$OCAMLLEXDOTOPT fi fi ]) AC_DEFUN([AC_PROG_OCAMLYACC], [dnl AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no]) ]) AC_DEFUN([AC_PROG_CAMLP4], [dnl AC_REQUIRE([AC_PROG_OCAML])dnl # checking for camlp4 AC_CHECK_TOOL([CAMLP4],[camlp4],[no]) if test "$CAMLP4" != "no"; then TMPVERSION=$($CAMLP4 -version) if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT([versions differs from ocamlc]) CAMLP4=no fi fi # checking for companion tools AC_CHECK_TOOL([CAMLP4BOOT],[camlp4boot],[no]) AC_CHECK_TOOL([CAMLP4O],[camlp4o],[no]) AC_CHECK_TOOL([CAMLP4OF],[camlp4of],[no]) AC_CHECK_TOOL([CAMLP4OOF],[camlp4oof],[no]) AC_CHECK_TOOL([CAMLP4ORF],[camlp4orf],[no]) AC_CHECK_TOOL([CAMLP4PROF],[camlp4prof],[no]) AC_CHECK_TOOL([CAMLP4R],[camlp4r],[no]) AC_CHECK_TOOL([CAMLP4RF],[camlp4rf],[no]) ]) AC_DEFUN([AC_PROG_FINDLIB], [dnl AC_REQUIRE([AC_PROG_OCAML])dnl # checking for ocamlfind AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no]) ]) dnl Thanks to Jim Meyering for working this next bit out for us. dnl XXX We should define AS_TR_SH if it's not defined already dnl (eg. for old autoconf). AC_DEFUN([AC_CHECK_OCAML_PKG], [dnl AC_REQUIRE([AC_PROG_FINDLIB])dnl AC_MSG_CHECKING([for OCaml findlib package $1]) unset found unset pkg found=no for pkg in $1 $2 ; do if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then AC_MSG_RESULT([found]) AS_TR_SH([OCAML_PKG_$1])=$pkg found=yes break fi done if test "$found" = "no" ; then AC_MSG_RESULT([not found]) AS_TR_SH([OCAML_PKG_$1])=no fi AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) ]) AC_DEFUN([AC_CHECK_OCAML_MODULE], [dnl AC_MSG_CHECKING([for OCaml module $1]) cat > conftest.ml <&5 2>&5 ; then found=yes break fi done if test "$found" ; then AC_MSG_RESULT([$$2]) else AC_MSG_RESULT([not found]) $1=no fi AC_SUBST([$2]) ]) dnl XXX Cross-compiling AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], [dnl AC_REQUIRE([AC_PROG_OCAML])dnl AC_MSG_CHECKING([for OCaml compiler word size]) cat > conftest.ml < conftest.ml < Format.printf "@ move_to (%f, %f)" p.x p.y | `LINE_TO p -> Format.printf "@ line_to (%f, %f)" p.x p.y | `CURVE_TO (p1, p2, p3) -> Format.printf "@ curve_to (%f, %f, %f, %f, %f, %f)" p1.x p1.y p2.x p2.y p3.x p3.y | `CLOSE -> Format.printf "@ close\n" let print_path c = Format.printf "@[current_path:" ; let nb = Cairo.fold_path c (fun nb el -> print_path_elem el ; nb+1) 0 in Format.printf "@]%d elements@." nb let draw ?(print=false) c = Cairo.move_to c 50. 50. ; Cairo.line_to c 550. 50. ; Cairo.curve_to c 450. 240. 150. 240. 50. 50. ; Cairo.close_path c ; if print then print_path c ; Cairo.save c ; begin Cairo.set_source_rgb c 0.8 0.1 0.1 ; Cairo.fill_preserve c end ; Cairo.restore c ; Cairo.set_line_width c 6. ; Cairo.set_source_rgb c 0. 0. 0. ; Cairo.stroke c let do_file_out fname f = let oc = open_out fname in try let r = f oc in close_out oc ; r with exn -> close_out_noerr oc ; raise exn let x_inches = 8. let y_inches = 3. let file_backend ?(verbose=false) ~backend_name ~filename surface_create = prerr_endline backend_name ; do_file_out filename (fun oc -> let width_in_points = x_inches *. 72. in let height_in_points = y_inches *. 72. in let s = surface_create oc ~width_in_points ~height_in_points in let c = Cairo.create s in draw ~print:verbose c ; Cairo.show_page c ; Cairo.surface_finish s) let main () = file_backend ~verbose:true ~backend_name:"PS" ~filename:"basket.ps" Cairo_ps.surface_create_for_channel ; file_backend ~backend_name:"PDF" ~filename:"basket.pdf" Cairo_pdf.surface_create_for_channel ; file_backend ~backend_name:"SVG" ~filename:"basket.svg" Cairo_svg.surface_create_for_channel ; begin prerr_endline "Bigarray, PPM and PNG (ARGB32) " ; let arr = Bigarray.Array2.create Bigarray.int32 Bigarray.c_layout (int_of_float y_inches * 72) (int_of_float x_inches * 72) in Bigarray.Array2.fill arr 0xffffffl ; let s = Cairo_bigarray.of_bigarr_32 ~alpha:true arr in let c = Cairo.create s in draw c ; do_file_out "basket.ppm" (fun oc -> Cairo_bigarray.write_ppm_int32 oc arr) ; Cairo_png.surface_write_to_file s "basket.png" end (* begin prerr_endline "GdkPixbuf and PNG" ; let pb = GdkPixbuf.create ~width:(int_of_float width) ~height:(int_of_float height) ~bits:8 ~has_alpha:true () in GdkPixbuf.fill pb (Int32.of_string "0xffffffff") ; let img = Cairo_lablgtk.image_of_pixbuf pb in Cairo.set_target_image c img ; draw c ; Cairo_lablgtk.shuffle_pixels pb ; GdkPixbuf.save ~filename:"basket.png" ~typ:"png" pb end *) let () = try main () with Cairo.Error s -> Printf.eprintf "Fatal error: cairo exception: '%d'\n" (Obj.magic s) cairo-ocaml-1.2.0/test/cube.ml000066400000000000000000000051441136043615400161360ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let animate_rotate_step = 0.05 let animate_frame_delay = 40 let rotate_max = 8. *. atan 1. let initial_size = 200 let get_cairo w = Cairo_lablgtk.create w#misc#window let redraw w range _ = let cr = get_cairo w in let { Gtk.width = width ; Gtk.height = height } = w#misc#allocation in let box_size = float (width + height) /. 6. in Cairo.save cr ; begin Cairo.identity_matrix cr ; let off = float width /. 2. in Cairo.translate cr off off ; Cairo.rotate cr range#adjustment#value ; Cairo.rectangle cr (~-. box_size) (~-. box_size) box_size box_size ; Cairo.set_source_rgb cr 1. 0. 0. ; Cairo.fill cr end ; Cairo.restore cr ; true let slider_changed w () = GtkBase.Widget.queue_draw w#as_widget let animate_step range () = let nv = range#adjustment#value +. animate_rotate_step in range#adjustment#set_value (mod_float nv rotate_max) ; true let animate_toggled button range = let timeout = ref None in fun () -> match !timeout with | None when button#active -> timeout := Some ( Glib.Timeout.add animate_frame_delay (animate_step range)) | Some id when not button#active -> Glib.Timeout.remove id ; timeout := None | _ -> () let main = let w = GWindow.window ~title:"GtkCairo Demo" () in ignore (w#connect#destroy GMain.quit) ; let b = GPack.vbox ~spacing:6 ~border_width:12 ~packing:w#add () in let f = GBin.frame ~shadow_type:`IN ~packing:(b#pack ~expand:true ~fill:true) () in let area = GMisc.drawing_area ~width:initial_size ~height:initial_size ~packing:f#add () in let slider = GRange.scale `HORIZONTAL ~draw_value:false ~packing:b#pack () in slider#adjustment#set_bounds ~lower:0. ~upper:rotate_max ~step_incr:animate_rotate_step () ; let button = GButton.check_button ~label:"Animate" ~packing:b#pack () in ignore (area#event#connect#expose (redraw area slider)) ; ignore (slider#connect#value_changed (slider_changed area)) ; ignore (button#connect#toggled (animate_toggled button slider)) ; w#show () ; GMain.main () cairo-ocaml-1.2.0/test/demo.ml000066400000000000000000000066661136043615400161560ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let size = 20. let cairo_path cr = function | [] -> invalid_arg "empty path" | (x, y) :: t -> Cairo.move_to cr x y ; List.iter (fun (x, y) -> Cairo.rel_line_to cr x y) t ; Cairo.close_path cr let triangle cr = cairo_path cr [ size, 0. ; size, (2. *. size) ; ((-2.) *. size), 0. ] let square cr = cairo_path cr [ 0., 0. ; (2. *. size), 0. ; 0., (2. *. size); ((-2.) *. size), 0. ] let bowtie cr = cairo_path cr [ 0., 0. ; (2. *. size), (2. *. size) ; ((-2.) *. size), 0. ; (2. *. size), ((-2.) *. size) ] let inf cr = Cairo.move_to cr 0. size ; Cairo.rel_curve_to cr 0. size size size (2. *. size) 0. ; Cairo.rel_curve_to cr size (~-. size) (2. *. size) (~-. size) (2. *. size) 0. ; Cairo.rel_curve_to cr 0. size (~-. size) size ((-2.) *. size) 0. ; Cairo.rel_curve_to cr (~-. size) (~-. size) ((-2.) *. size) (~-. size) ((-2.) *. size) 0. ; Cairo.close_path cr let draw_shapes cr x y fill = let paint = if fill then Cairo.fill else Cairo.stroke in Cairo.save cr ; begin Cairo.new_path cr ; Cairo.translate cr (x +. size) (y +. size) ; List.iter (fun draw -> draw cr ; paint cr ; Cairo.new_path cr ; Cairo.translate cr (4. *. size) 0.) [ bowtie ; square ; triangle; inf ] end ; Cairo.restore cr let pi = 4. *. atan 1. let redraw (px : GDraw.pixmap) = begin px#set_foreground `BLACK ; let width, height = px#size in px#rectangle ~x:0 ~y:0 ~width ~height ~filled:true () end ; let cr = Cairo_lablgtk.create px#pixmap in Cairo.set_source_rgb cr 1. 1. 1. ; Cairo.save cr ; begin Cairo.set_font_size cr 20. ; Cairo.move_to cr 10. 10. ; Cairo.rotate cr (pi /. 2.) ; Cairo.show_text cr "Hello World !" end ; Cairo.restore cr ; Cairo.set_line_width cr (size /. 4.) ; Cairo.set_tolerance cr 1. ; Cairo.set_line_join cr Cairo.LINE_JOIN_ROUND ; Cairo.set_dash cr [| size /. 4. ; size /. 4. |] 0. ; draw_shapes cr 0. 0. false ; Cairo.translate cr 0. (4. *. size) ; Cairo.set_dash cr [||] 0. ; draw_shapes cr 0. 0. false ; Cairo.translate cr 0. (4. *. size) ; Cairo.set_line_join cr Cairo.LINE_JOIN_BEVEL ; draw_shapes cr 0. 0. false ; Cairo.translate cr 0. (4. *. size) ; Cairo.set_line_join cr Cairo.LINE_JOIN_MITER ; draw_shapes cr 0. 0. false ; Cairo.translate cr 0. (4. *. size) ; draw_shapes cr 0. 0. true ; Cairo.translate cr 0. (4. *. size) ; Cairo.set_line_join cr Cairo.LINE_JOIN_BEVEL ; draw_shapes cr 0. 0. true ; Cairo.set_source_rgb cr 1. 0. 0. ; draw_shapes cr 0. 0. false let main () = let w = GWindow.window ~title:"Cairo demo" () in w#connect#destroy GMain.quit ; let px = GDraw.pixmap ~width:400 ~height:500 ~window:w () in begin try redraw px with Cairo.Error _ -> prerr_endline "Cairo is unhappy" end ; ignore (GMisc.pixmap px ~packing:w#add ()) ; w#show () ; GMain.main () let _ = main () cairo-ocaml-1.2.0/test/font.ml000066400000000000000000000030451136043615400161640ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let pi = 4. *. atan 1. let main font_arg = let ft = Cairo_ft.init_freetype () in let font, clean_up = if Sys.file_exists font_arg then let face = Cairo_ft.new_face ft font_arg in let font = Cairo_ft.font_face_create_for_ft_face face 0 in (font, (fun () -> Cairo_ft.done_face face)) else begin let pattern = Cairo_ft.fc_name_parse font_arg in let font = Cairo_ft.font_face_create_for_pattern pattern in (font, ignore) end in let s = Cairo.image_surface_create Cairo.FORMAT_ARGB32 ~width:200 ~height:200 in let cr = Cairo.create s in Cairo.set_font_face cr font ; Cairo.set_font_size cr 20. ; Cairo.move_to cr 10. 10. ; Cairo.rotate cr (pi /. 2.) ; Cairo.show_text cr "Hello World !" ; Cairo_png.surface_write_to_file s "test_font.png" ; clean_up () ; Cairo_ft.done_freetype ft let _ = if Array.length Sys.argv < 2 then exit 1 ; try main Sys.argv.(1) with Cairo.Error s -> Printf.eprintf "Cairo error: '%s'\n%!" (Cairo.string_of_status s) cairo-ocaml-1.2.0/test/kapow.ml000066400000000000000000000100451136043615400163350ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let filename = "kapow.png" let fontname = "Sans" let default_text = "KAPOW" let width = 384. let height = 256. let spikes = 10 let shadow_offset = 10. let x_fuzz = 16. let y_fuzz = 16. let x_outer_radius = width /. 2. -. x_fuzz -. shadow_offset let y_outer_radius = height /. 2. -. y_fuzz -. shadow_offset let x_inner_radius = x_outer_radius *. 0.7 let y_inner_radius = y_outer_radius *. 0.7 let pi = 4. *. atan 1. let make_star_path cr = Random.init 42 ; for i = 0 to spikes - 1 do let x = width /. 2. +. cos (pi *. float (2 * i) /. float spikes) *. x_inner_radius +. Random.float x_fuzz in let y = height /. 2. +. sin (pi *. float (2 * i) /. float spikes) *. y_inner_radius +. Random.float y_fuzz in if i = 0 then Cairo.move_to cr x y else Cairo.line_to cr x y ; let x = width /. 2. +. cos (pi *. float (2 * i + 1) /. float spikes) *. x_outer_radius +. Random.float x_fuzz in let y = height /. 2. +. sin (pi *. float (2 * i + 1) /. float spikes) *. y_outer_radius +. Random.float y_fuzz in Cairo.line_to cr x y done ; Cairo.close_path cr let bend_it { Cairo.x = x ; Cairo.y = y } = let cx = width /. 2. in let cy = 500. in let angle = pi /. 2. -. (x -. cx) /. width in let t = 3. *. pi /. 4. -. angle +. 0.05 in let angle = 3. *. pi /. 4. -. t ** 1.8 in let radius = cy -. (height /. 2. +. (y -. height /. 2.) *. t *. 2.) in { Cairo.x = cx +. cos angle *. radius; Cairo.y = cy -. sin angle *. radius } let make_text_path cr x y text = Cairo.move_to cr x y ; Cairo.text_path cr text ; ignore (Cairo.fold_path_flat cr (fun first -> function | `MOVE_TO p -> if first then Cairo.new_path cr ; Cairo.move_to_point cr (bend_it p) ; false | `LINE_TO p -> Cairo.line_to_point cr (bend_it p) ; false | `CLOSE -> Cairo.close_path cr ; false) true) let draw text = let cr = Cairo.create (Cairo.image_surface_create Cairo.FORMAT_ARGB32 (int_of_float width) (int_of_float height))in Cairo.set_line_width cr 2. ; Cairo.save cr ; begin Cairo.translate cr shadow_offset shadow_offset ; make_star_path cr ; Cairo.set_source_rgba cr 0. 0. 0. 0.5 ; Cairo.fill cr end ; Cairo.restore cr ; make_star_path cr ; let pattern = Cairo.Pattern.create_radial (width /. 2.) (height /. 2.) 10. (width /. 2.) (height /. 2.) 230. in Cairo.Pattern.add_color_stop_rgba pattern 0. 1. 1. 0.2 1. ; Cairo.Pattern.add_color_stop_rgba pattern 1. 1. 0. 0. 1. ; Cairo.set_source cr pattern ; Cairo.fill cr ; make_star_path cr ; Cairo.set_source_rgb cr 0. 0. 0. ; Cairo.stroke cr ; Cairo.select_font_face cr fontname Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_BOLD ; Cairo.set_font_size cr 50. ; let extents = Cairo.text_extents cr text in let x = width /. 2. -. (extents.Cairo.text_width /. 2. +. extents.Cairo.x_bearing) in let y = height /. 2. -. (extents.Cairo.text_height /. 2. +. extents.Cairo.y_bearing) in make_text_path cr x y text ; let pattern = Cairo.Pattern.create_linear (width /. 2. -. 10.) (height /. 4.) (width /. 2. +. 10.) (3. *. height /. 4.) in Cairo.Pattern.add_color_stop_rgba pattern 0. 1. 1. 1. 1. ; Cairo.Pattern.add_color_stop_rgba pattern 1. 0. 0. 0.4 1. ; Cairo.set_source cr pattern ; Cairo.fill cr ; make_text_path cr x y text ; Cairo.set_source_rgb cr 0. 0. 0. ; Cairo.stroke cr ; Cairo_png.surface_write_to_file (Cairo.get_target cr) filename let _ = draw (if Array.length Sys.argv > 1 then Sys.argv.(1) else default_text) cairo-ocaml-1.2.0/test/knockout.ml000066400000000000000000000075411136043615400170600ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let pi = 4. *. atan 1. let oval_path cr xc yc xr yr = let m = Cairo.get_matrix cr in Cairo.translate cr xc yc ; Cairo.scale cr 1. (yr /. xr) ; Cairo.move_to cr xr 0. ; Cairo.arc cr 0. 0. xr 0. (2. *. pi) ; Cairo.close_path cr ; Cairo.set_matrix cr m let check_size = 32 let fill_checks c x y width height = Cairo.save c ; begin let check = Cairo.surface_create_similar (Cairo.get_target c) Cairo.CONTENT_COLOR (2 * check_size) (2 * check_size) in begin let f_size = float check_size in let cr2 = Cairo.create check in Cairo.set_operator cr2 Cairo.OPERATOR_SOURCE ; Cairo.set_source_rgb cr2 0.4 0.4 0.4 ; Cairo.rectangle cr2 0. 0. (2. *. f_size) (2. *. f_size) ; Cairo.fill cr2 ; Cairo.set_source_rgb cr2 0.7 0.7 0.7 ; Cairo.rectangle cr2 x y f_size f_size ; Cairo.fill cr2 ; Cairo.rectangle cr2 (x +. f_size) (y +. f_size) f_size f_size ; Cairo.fill cr2 end ; let pattern = Cairo.Pattern.create_for_surface check in Cairo.Pattern.set_extend pattern Cairo.EXTEND_REPEAT ; Cairo.set_source c pattern ; Cairo.rectangle c 0. 0. (float width) (float height) ; Cairo.fill c end ; Cairo.restore c let draw_3circles c xc yc radius alpha = let subradius = radius *. (2. /. 3. -. 0.1) in List.iter (fun (r, g, b, off) -> Cairo.set_source_rgba c r g b alpha ; oval_path c (xc +. radius /. 3. *. cos (pi *. (0.5 +. off))) (yc -. radius /. 3. *. sin (pi *. (0.5 +. off))) subradius subradius ; Cairo.fill c) [ 1., 0., 0., 0. ; 0., 1., 0., 2./.3. ; 0., 0., 1., 4./.3. ; ] let draw c width height = let radius = 0.5 *. float (min width height) -. 10. in let xc = float width /. 2. in let yc = float height /. 2. in let sur = Cairo.get_target c in let overlay = Cairo.surface_create_similar sur Cairo.CONTENT_COLOR_ALPHA width height in let punch = Cairo.surface_create_similar sur Cairo.CONTENT_ALPHA width height in let circles = Cairo.surface_create_similar sur Cairo.CONTENT_COLOR_ALPHA width height in fill_checks c 0. 0. width height ; begin let cr_o = Cairo.create overlay in Cairo.set_source_rgb cr_o 0. 0. 0. ; oval_path cr_o xc yc radius radius ; Cairo.fill cr_o ; begin let cr_p = Cairo.create punch in draw_3circles cr_p xc yc radius 1. end ; Cairo.set_operator cr_o Cairo.OPERATOR_DEST_OUT ; Cairo.set_source_surface cr_o punch 0. 0. ; Cairo.paint cr_o ; begin let cr_c = Cairo.create circles in Cairo.set_operator cr_c Cairo.OPERATOR_OVER ; draw_3circles cr_c xc yc radius 0.5 end ; Cairo.set_operator cr_o Cairo.OPERATOR_ADD ; Cairo.set_source_surface cr_o circles 0. 0.; Cairo.paint cr_o end ; Cairo.set_source_surface c overlay 0. 0. ; Cairo.paint c let expose d_area ev = let c = Cairo_lablgtk.create d_area#misc#window in let allocation = d_area#misc#allocation in draw c allocation.Gtk.width allocation.Gtk.height ; true let main () = let w = GWindow.window ~title:"Knockout Groups" ~width:400 ~height:400 () in ignore (w#connect#destroy GMain.quit) ; let d = GMisc.drawing_area ~packing:w#add () in d#misc#set_double_buffered false ; ignore (d#event#connect#expose (expose d)) ; w#show () ; GMain.main () let _ = if not !Sys.interactive then main () cairo-ocaml-1.2.0/test/pangocairo.ml000066400000000000000000000033661136043615400173460ustar00rootroot00000000000000(* This is a direct translation of the example Pango-Cairo program * which can be found on this page: * http://developer.gnome.org/doc/API/2.0/pango/pango-Cairo-Rendering.html * $Id$ * By Richard W.M. Jones or *) let pi = 4. *. atan 1. (* Annoying omission from the stdlib. *) let radius = 150 let n_words = 10 let font = "Sans Bold 27" let radius_f = float radius let n_words_f = float n_words let scale_f = float Pango.scale let draw_text cr = Cairo.translate cr radius_f radius_f; let layout = Pango_cairo.create_layout cr in Pango.Layout.set_text layout "Text"; let desc = Pango.Font.from_string font in Pango.Layout.set_font_description layout desc; (* Draw the layout n_words times in a circle. *) for i = 0 to n_words-1; do let angle = (360. *. float i) /. n_words_f in Cairo.save cr; begin (* Gradient from red at angle == 60 to blue at angle == 240 *) let red = (1. +. cos ((angle -. 60.) *. pi /. 180.)) /. 2. in Cairo.set_source_rgb cr red 0. (1.0 -. red); Cairo.rotate cr (angle *. pi /. 180.); (* Inform Pango to re-layout the text with the new transformation *) Pango_cairo.update_layout cr layout; let width, height = Pango.Layout.get_size layout in Cairo.move_to cr ~-.((float width/.scale_f) /. 2.) ~-.radius_f; Pango_cairo.show_layout cr layout; end; Cairo.restore cr done let () = if Array.length Sys.argv <> 2 then failwith "Usage: pangocairo OUTPUT_FILENAME.png"; let filename = Sys.argv.(1) in let surface = Cairo.image_surface_create Cairo.FORMAT_ARGB32 (2 * radius) (2 * radius) in let cr = Cairo.create surface in Cairo.set_source_rgb cr 1. 1. 1.; Cairo.paint cr; draw_text cr; Cairo_png.surface_write_to_file surface filename cairo-ocaml-1.2.0/test/spline.ml000066400000000000000000000205631136043615400165140ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type point = Cairo.point = { x : float ; y : float } type spl = { mutable pm : GDraw.pixmap ; pt : point array ; mutable tolerance : float ; mutable line_width : float ; line_cap : Cairo.line_cap ; mutable zoom : float ; mutable xtrans : float ; mutable ytrans : float ; mutable click : bool ; mutable drag_pt : point ; mutable active : int ; mutable width : int ; mutable height : int ; mutable need_update : bool ; } let ribbon = [| 110., 20. ; 310., 300. ; 10. , 310. ; 210., 20. |] let spline_copy arr = Array.map (fun (x, y) -> { x = x ; y = y }) arr let new_pixmap width height = let drawable = GDraw.pixmap ~width ~height () in drawable#set_foreground `WHITE ; drawable#rectangle ~x:0 ~y:0 ~width ~height ~filled:true () ; drawable let init_spl () = let width = 400 in let height = 400 in { pm = new_pixmap width height ; pt = spline_copy ribbon ; tolerance = 0.1 ; line_width = 10. ; line_cap = Cairo.LINE_CAP_ROUND ; zoom = 1. ; xtrans = 0. ; ytrans = 0. ; click = false ; drag_pt = { x = 0. ; y = 0. } ; active = 0 ; width = width ; height = height ; need_update = true ; } let draw_control_line cr a b w = Cairo.save cr ; begin Cairo.set_source_rgb cr 0. 0. 1. ; Cairo.set_line_width cr w ; Cairo.move_to cr a.x a.y ; Cairo.line_to cr b.x b.y ; Cairo.stroke cr end ; Cairo.restore cr let two_pi = 8. *. atan 1. let draw_spline cr spl = let drag_pt = { x = spl.drag_pt.x ; y = spl.drag_pt.y } in let drag_pt = Cairo.device_to_user cr drag_pt in Cairo.save cr ; begin Cairo.move_to cr spl.pt.(0).x spl.pt.(0).y ; Cairo.curve_to cr spl.pt.(1).x spl.pt.(1).y spl.pt.(2).x spl.pt.(2).y spl.pt.(3).x spl.pt.(3).y ; if spl.click && Cairo.in_stroke cr drag_pt then spl.active <- 0xf ; Cairo.stroke cr ; draw_control_line cr spl.pt.(0) spl.pt.(1) (2. /. spl.zoom) ; draw_control_line cr spl.pt.(3) spl.pt.(2) (2. /. spl.zoom) ; for i=0 to 3 do Cairo.save cr ; begin Cairo.set_source_rgba cr 1. 0. 0. 0.5 ; Cairo.new_path cr ; Cairo.arc cr spl.pt.(i).x spl.pt.(i).y (spl.line_width /. 1.25) 0. two_pi ; if spl.click && Cairo.in_fill cr drag_pt then begin spl.active <- 1 lsl i ; spl.click <- false end ; Cairo.fill cr end ; Cairo.restore cr done end ; Cairo.restore cr let paint spl = let cr = Cairo_lablgtk.create spl.pm#pixmap in spl.pm#rectangle ~x:0 ~y:0 ~width:spl.width ~height:spl.height ~filled:true () ; Cairo.set_source_rgb cr 0. 0. 0. ; Cairo.set_line_width cr spl.line_width ; Cairo.set_line_cap cr spl.line_cap ; Cairo.translate cr spl.xtrans spl.ytrans ; Cairo.scale cr spl.zoom spl.zoom ; Cairo.set_tolerance cr spl.tolerance ; try draw_spline cr spl ; spl.need_update <- false with Cairo.Error _ -> prerr_endline "Cairo is unhappy" let trans_horiz_cb dir spl = let delta = float spl.width /. 16. in begin match dir with | `LEFT -> spl.xtrans <- spl.xtrans -. delta | `RIGHT -> spl.xtrans <- spl.xtrans +. delta end ; true let trans_vert_cb dir spl = let delta = float spl.height /. 16. in begin match dir with | `UP -> spl.ytrans <- spl.ytrans -. delta | `DOWN -> spl.ytrans <- spl.ytrans +. delta end ; true let zoom_cb dir spl = begin match dir with | `OUT -> spl.zoom <- spl.zoom /. 1.1 | `IN -> spl.zoom <- spl.zoom *. 1.1 end ; true let smooth_cb dir spl = begin match dir with | `INC -> spl.tolerance <- spl.tolerance *. 10. | `DEC -> spl.tolerance <- spl.tolerance /. 10. end ; true let line_width_cb dir spl = begin match dir with | `W -> spl.line_width <- spl.line_width *. 2. | `N -> spl.line_width <- spl.line_width /. 2. end ; true let print_spline_cb { pt = pt } = let pt_f fmt p = Format.fprintf fmt "{@[ %.20g,@ %.20g @]}" p.x p.y in Format.printf "@[{ %a,@ %a,@ %a,@ %a }@]@." pt_f pt.(0) pt_f pt.(1) pt_f pt.(2) pt_f pt.(3) ; false module K = GdkKeysyms let keybindings = [ K._q, ("Q", (fun _ -> GMain.quit () ; false), "Exit the program") ; K._Left, ("Left", trans_horiz_cb `LEFT, "Translate left") ; K._Right, ("Right", trans_horiz_cb `RIGHT, "Translate right" ) ; K._Up, ("Up", trans_vert_cb `UP, "Translate up" ) ; K._Down, ("Down", trans_vert_cb `DOWN, "Translate down") ; K._Return, ("Return", print_spline_cb, "Print current spline coordinates on stdout") ; K._plus, ("plus", zoom_cb `IN, "Zoom in") ; K._minus, ("minus", zoom_cb `OUT, "Zoom out") ; K._greater, ("greater", smooth_cb `DEC, "Increase rendering accuracy, (tolerance /= 10)") ; K._less, ("less", smooth_cb `INC, "Decrease rendering accuracy, (tolerance *= 10)") ; K._w, ("W", line_width_cb `W, "Widen line width") ; K._n, ("N", line_width_cb `N, "Narrow line width") ; ] let refresh da spl = spl.need_update <- true ; GtkBase.Widget.queue_draw da#as_widget let grow_pixmap spl = spl.pm <- new_pixmap spl.width spl.height ; spl.need_update <- true (* no need to queue a redraw here, an expose event should follow the configure, right ? *) let config_cb spl ev = let w = GdkEvent.Configure.width ev in let h = GdkEvent.Configure.height ev in let has_grown = w > spl.width || h > spl.height in spl.width <- w ; spl.height <- h ; if has_grown then grow_pixmap spl ; true let expose da spl x y width height = let gwin = da#misc#window in let d = new GDraw.drawable gwin in d#put_pixmap ~x ~y ~xsrc:x ~ysrc:y ~width ~height spl.pm#pixmap let expose_cb da spl ev = let area = GdkEvent.Expose.area ev in let module GR = Gdk.Rectangle in if spl.need_update then paint spl ; expose da spl (GR.x area) (GR.y area) (GR.width area) (GR.height area) ; true let key_press_cb da spl ev = try let (_, cb, _) = List.assoc (GdkEvent.Key.keyval ev) keybindings in let need_refresh = cb spl in if need_refresh then refresh da spl ; true with Not_found -> false let button_ev da spl ev = match GdkEvent.get_type ev with | `BUTTON_PRESS -> spl.click <- true ; spl.drag_pt <- { x = GdkEvent.Button.x ev ; y = GdkEvent.Button.y ev } ; true | `BUTTON_RELEASE -> spl.click <- false ; spl.active <- 0 ; true | _ -> false let motion_notify_cb da spl ev = let x = GdkEvent.Motion.x ev in let y = GdkEvent.Motion.y ev in for i=0 to 3 do if (1 lsl i) land spl.active != 0 then begin let x = spl.pt.(i).x +. (x -. spl.drag_pt.x) /. spl.zoom in let y = spl.pt.(i).y +. (y -. spl.drag_pt.y) /. spl.zoom in spl.pt.(i) <- { x = x ; y = y } end done ; spl.drag_pt <- { x = x ; y = y } ; refresh da spl ; true let init spl packing = let da = GMisc.drawing_area ~width:spl.width ~height:spl.height ~packing () in da#misc#set_can_focus true ; da#event#add [ `KEY_PRESS ; `BUTTON_MOTION ; `BUTTON_PRESS ; `BUTTON_RELEASE ] ; da#event#connect#expose (expose_cb da spl) ; da#event#connect#configure (config_cb spl) ; da#event#connect#button_press (button_ev da spl) ; da#event#connect#button_release (button_ev da spl) ; da#event#connect#motion_notify (motion_notify_cb da spl) ; da#event#connect#key_press (key_press_cb da spl) let show_help kb = Format.printf "@[" ; List.iter (fun (_, (key, _, descr)) -> Format.printf "%10s: %s@ " key descr) kb ; Format.printf "@." let main = let w = GWindow.window ~title:"Cairo spline demo" ~allow_grow:true ~allow_shrink:true () in w#connect#destroy GMain.quit ; init (init_spl ()) w#add ; show_help keybindings ; w#show () ; GMain.main () cairo-ocaml-1.2.0/test/svg2png.ml000066400000000000000000000061741136043615400166120ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) type args = { svg_file : string ; png_file : string ; scale : float ; width : int ; height : int ; } let parse_args () = let svg_file = ref "" in let png_file = ref "" in let scale = ref 1. in let width = ref (-1) in let height = ref (-1) in let spec = [ "-s", Arg.Set_float scale, "scale"; "-w", Arg.Set_int width, "width"; "-h", Arg.Set_int height, "height" ] in let msg = Printf.sprintf "usage: %s [options] [png_file]" (Filename.basename Sys.executable_name) in Arg.parse spec (fun arg -> if !svg_file = "" then svg_file := arg else if !png_file = "" then png_file := arg else ()) msg ; if !svg_file = "" then begin Arg.usage spec msg ; exit 1 end ; if !png_file = "" then png_file := begin if Filename.check_suffix !svg_file ".svg" then Filename.chop_suffix !svg_file ".svg" else !svg_file end ^ ".png" ; { svg_file = !svg_file ; png_file = !png_file ; scale = !scale ; width = !width ; height = !height } let render_to_png args = let svgc = Svg_cairo.create () in Svg_cairo.parse svgc args.svg_file ; let svg_width, svg_height = Svg_cairo.get_size svgc in let scale = ref args.scale in let width = ref args.width in let height = ref args.height in let dx = ref 0. in let dy = ref 0. in begin if args.width < 0 && args.height < 0 then begin width := int_of_float (float svg_width *. args.scale +. 0.5) ; height := int_of_float (float svg_height *. args.scale +. 0.5) end else if args.width < 0 then begin scale := float args.height /. float svg_height ; width := int_of_float (float svg_width *. args.scale +. 0.5) ; end else if args.height < 0 then begin scale := float args.width /. float svg_width ; height := int_of_float (float svg_height *. args.scale +. 0.5) ; end else begin scale := min (float args.height /. float svg_height) (float args.width /. float svg_width) ; dx := (float args.width -. (float svg_width *. args.scale +. 0.5)) /. 2. ; dy := (float args.height -. (float svg_height *. args.scale +. 0.5)) /. 2. end end ; let surf = Cairo.image_surface_create Cairo.FORMAT_ARGB32 !width !height in let cr = Cairo.create surf in Cairo.save cr ; begin Cairo.set_operator cr Cairo.OPERATOR_CLEAR ; Cairo.paint cr end ; Cairo.restore cr ; Cairo.translate cr !dx !dy ; Cairo.scale cr !scale !scale ; Cairo.set_source_rgb cr 1. 1. 1. ; Svg_cairo.render svgc cr ; Cairo_png.surface_write_to_file surf args.png_file let _ = render_to_png (parse_args ()) cairo-ocaml-1.2.0/test/text.ml000066400000000000000000000075751136043615400162160ustar00rootroot00000000000000(**************************************************************************) (* cairo-ocaml -- Objective Caml bindings for Cairo *) (* Copyright © 2004-2005 Olivier Andrieu *) (* *) (* This code is free software and is licensed under the terms of the *) (* GNU Lesser General Public License version 2.1 (the "LGPL"). *) (**************************************************************************) let num_glyphs = 10 let text = "hello, world" let box_text cr txt x y = Cairo.save cr ; begin let ext = Cairo.text_extents cr text in let line_width = Cairo.get_line_width cr in Cairo.rectangle cr (x +. ext.Cairo.x_bearing -. line_width) (y +. ext.Cairo.y_bearing -. line_width) (ext.Cairo.text_width +. 2. *. line_width) (ext.Cairo.text_height +. 2. *. line_width) ; Cairo.stroke cr ; Cairo.move_to cr x y ; Cairo.show_text cr txt ; Cairo.text_path cr txt ; Cairo.set_source_rgb cr 1. 0. 0. ; Cairo.set_line_width cr 1.0 ; Cairo.stroke cr end ; Cairo.restore cr let box_glyphs cr gly x y = Cairo.save cr ; begin let ext = Cairo.glyph_extents cr gly in let line_width = Cairo.get_line_width cr in Cairo.rectangle cr (x +. ext.Cairo.x_bearing -. line_width) (y +. ext.Cairo.y_bearing -. line_width) (ext.Cairo.text_width +. 2. *. line_width) (ext.Cairo.text_height +. 2. *. line_width) ; Cairo.stroke cr ; let gly = Array.map (fun g -> { g with Cairo.glyph_x = g.Cairo.glyph_x +. x ; Cairo.glyph_y = g.Cairo.glyph_y +. y }) gly in Cairo.show_glyphs cr gly ; Cairo.glyph_path cr gly ; Cairo.set_source_rgb cr 1. 0. 0. ; Cairo.set_line_width cr 1. ; Cairo.stroke cr end ; Cairo.restore cr let draw cr w h = Cairo.set_source_rgb cr 0. 0. 0. ; Cairo.set_line_width cr 2. ; Cairo.save cr ; begin Cairo.set_source_rgb cr 1. 1. 1. ; Cairo.rectangle cr 0. 0. w h ; Cairo.set_operator cr Cairo.OPERATOR_SOURCE ; Cairo.fill cr end ; Cairo.restore cr ; Cairo.select_font_face cr "serif" Cairo.FONT_SLANT_NORMAL Cairo.FONT_WEIGHT_NORMAL ; Cairo.set_font_size cr 40. ; let { Cairo.font_height = height } = Cairo.font_extents cr in let glyphs = begin let dx = ref 0. in let dy = ref 0. in Array.init num_glyphs (fun i -> let g = { Cairo.index = i + 4 ; Cairo.glyph_x = !dx ; Cairo.glyph_y = !dy } in let ext = Cairo.glyph_extents cr [| g |] in dx := !dx +. ext.Cairo.x_advance ; dy := !dy +. ext.Cairo.y_advance ; g) end in box_text cr text 10. height ; Cairo.translate cr 0. height ; Cairo.save cr ; begin Cairo.translate cr 10. height ; Cairo.rotate cr (10. *. atan 1. /. 45.) ; box_text cr text 0. 0. end ; Cairo.restore cr ; Cairo.translate cr 0. (2. *. height) ; Cairo.save cr ; begin let m = Cairo.Matrix.init_rotate (10. *. atan 1. /. 45.) in Cairo.set_font_matrix cr m ; box_text cr text 10. height end ; Cairo.restore cr ; Cairo.translate cr 0. (2. *. height) ; box_glyphs cr glyphs 10. height ; Cairo.translate cr 10. (2. *. height) ; Cairo.save cr ; begin Cairo.rotate cr (10. *. atan 1. /. 45.) ; box_glyphs cr glyphs 0. 0. end ; Cairo.restore cr ; Cairo.translate cr 0. height ; box_glyphs cr (Array.mapi (fun i g -> { g with Cairo.glyph_y = g.Cairo.glyph_y +. float (i * 5) }) glyphs) 10. height let width = 450 let height = 600 let main () = let w = GWindow.window ~title:"Cairo Text API" () in w#connect#destroy GMain.quit ; let p = GDraw.pixmap ~width ~height ~window:w () in let cr = Cairo_lablgtk.create p#pixmap in draw cr (float width) (float height) ; GMisc.pixmap p ~packing:w#add () ; w#show () ; GMain.main () let _ = main ()