ocaml-cairo/ 0000755 0001750 0001750 00000000000 13475240342 013142 5 ustar treinen treinen ocaml-cairo/LICENSE.md 0000644 0001750 0001750 00000016710 13446257732 014564 0 ustar treinen treinen GNU LESSER GENERAL PUBLIC LICENSE, Version 3, 29 June 2007
==========================================================
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
This version of the GNU Lesser General Public License incorporates
the terms and conditions of version 3 of the GNU General Public
License, supplemented by the additional permissions listed below.
## 0. Additional Definitions.
As used herein, "this License" refers to version 3 of the GNU Lesser
General Public License, and the "GNU GPL" refers to version 3 of the GNU
General Public License.
"The Library" refers to a covered work governed by this License,
other than an Application or a Combined Work as defined below.
An "Application" is any work that makes use of an interface provided
by the Library, but which is not otherwise based on the Library.
Defining a subclass of a class defined by the Library is deemed a mode
of using an interface provided by the Library.
A "Combined Work" is a work produced by combining or linking an
Application with the Library. The particular version of the Library
with which the Combined Work was made is also called the "Linked
Version".
The "Minimal Corresponding Source" for a Combined Work means the
Corresponding Source for the Combined Work, excluding any source code
for portions of the Combined Work that, considered in isolation, are
based on the Application, and not on the Linked Version.
The "Corresponding Application Code" for a Combined Work means the
object code and/or source code for the Application, including any data
and utility programs needed for reproducing the Combined Work from the
Application, but excluding the System Libraries of the Combined Work.
## 1. Exception to Section 3 of the GNU GPL.
You may convey a covered work under sections 3 and 4 of this License
without being bound by section 3 of the GNU GPL.
## 2. Conveying Modified Versions.
If you modify a copy of the Library, and, in your modifications, a
facility refers to a function or data to be supplied by an Application
that uses the facility (other than as an argument passed when the
facility is invoked), then you may convey a copy of the modified
version:
1. under this License, provided that you make a good faith effort to
ensure that, in the event an Application does not supply the
function or data, the facility still operates, and performs
whatever part of its purpose remains meaningful, or
2. under the GNU GPL, with none of the additional permissions of
this License applicable to that copy.
## 3. Object Code Incorporating Material from Library Header Files.
The object code form of an Application may incorporate material from
a header file that is part of the Library. You may convey such object
code under terms of your choice, provided that, if the incorporated
material is not limited to numerical parameters, data structure
layouts and accessors, or small macros, inline functions and templates
(ten or fewer lines in length), you do both of the following:
1. Give prominent notice with each copy of the object code that the
Library is used in it and that the Library and its use are
covered by this License.
2. Accompany the object code with a copy of the GNU GPL and this license
document.
## 4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
1. Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
2. Accompany the Combined Work with a copy of the GNU GPL and this license
document.
3. For a Combined Work that displays copyright notices during
execution, include the copyright notice for the Library among
these notices, as well as a reference directing the user to the
copies of the GNU GPL and this license document.
4. Do one of the following:
1. Convey the Minimal Corresponding Source under the terms of this
License, and the Corresponding Application Code in a form
suitable for, and under terms that permit, the user to
recombine or relink the Application with a modified version of
the Linked Version to produce a modified Combined Work, in the
manner specified by section 6 of the GNU GPL for conveying
Corresponding Source.
2. Use a suitable shared library mechanism for linking with the
Library. A suitable mechanism is one that (a) uses at run time
a copy of the Library already present on the user's computer
system, and (b) will operate properly with a modified version
of the Library that is interface-compatible with the Linked
Version.
5. Provide Installation Information, but only if you would otherwise
be required to provide such information under section 6 of the
GNU GPL, and only to the extent that such information is
necessary to install and execute a modified version of the
Combined Work produced by recombining or relinking the
Application with a modified version of the Linked Version. (If
you use option 4d0, the Installation Information must accompany
the Minimal Corresponding Source and Corresponding Application
Code. If you use option 4d1, you must provide the Installation
Information in the manner specified by section 6 of the GNU GPL
for conveying Corresponding Source.)
## 5. Combined Libraries.
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 that are not Applications and are not covered by this
License, and convey such a combined library under terms of your
choice, if you do both of the following:
1. Accompany the combined library with a copy of the same work based
on the Library, uncombined with any other library facilities,
conveyed under the terms of this License.
2. Give prominent notice with the combined library that part of it
is a work based on the Library, and explaining where to find the
accompanying uncombined form of the same work.
## 6. Revised Versions of the GNU Lesser General Public License.
The Free Software Foundation may publish revised and/or new versions
of the GNU 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 as you received it specifies that a certain numbered version
of the GNU Lesser General Public License "or any later version"
applies to it, you have the option of following the terms and
conditions either of that published version or of any later version
published by the Free Software Foundation. If the Library as you
received it does not specify a version number of the GNU Lesser
General Public License, you may choose any version of the GNU Lesser
General Public License ever published by the Free Software Foundation.
If the Library as you received it specifies that a proxy can decide
whether future versions of the GNU Lesser General Public License shall
apply, that proxy's public statement of acceptance of any version is
permanent authorization for you to choose that version for the
Library.
ocaml-cairo/.travis.yml 0000644 0001750 0001750 00000000714 13446257732 015266 0 ustar treinen treinen language: c
sudo: required
install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh
script: bash -ex .travis-opam.sh
env:
global:
- PACKAGE=cairo2
- DEPOPTS='conf-freetype'
- PKG_CONFIG_PATH=/usr/local/opt/libffi/lib/pkgconfig
matrix:
- OCAML_VERSION=4.02
- OCAML_VERSION=4.03
- OCAML_VERSION=4.04
- OCAML_VERSION=4.05
- OCAML_VERSION=4.06
- OCAML_VERSION=4.07
os:
- linux
- osx
ocaml-cairo/examples-gtk/ 0000755 0001750 0001750 00000000000 13446257732 015554 5 ustar treinen treinen ocaml-cairo/examples-gtk/gtk_demo.ml 0000644 0001750 0001750 00000001630 13446257732 017677 0 ustar treinen treinen open Cairo
let pi2 = 8. *. atan 1.
let draw cr width height =
let r = 0.25 *. width in
set_source_rgba cr 0. 1. 0. 0.5;
arc cr (0.5 *. width) (0.35 *. height) ~r ~a1:0. ~a2:pi2;
fill cr;
set_source_rgba cr 1. 0. 0. 0.5;
arc cr (0.35 *. width) (0.65 *. height) ~r ~a1:0. ~a2:pi2;
fill cr;
set_source_rgba cr 0. 0. 1. 0.5;
arc cr (0.65 *. width) (0.65 *. height) ~r ~a1:0. ~a2:pi2;
fill cr;
;;
let expose drawing_area _ev =
let cr = Cairo_gtk.create drawing_area#misc#window in
let allocation = drawing_area#misc#allocation in
draw cr (float allocation.Gtk.width) (float allocation.Gtk.height);
true
let () =
ignore(GMain.init());
let w = GWindow.window ~title:"Gtk demo" ~width:500 ~height:400 () in
ignore(w#connect#destroy ~callback:GMain.quit);
let d = GMisc.drawing_area ~packing:w#add () in
ignore(d#event#connect#expose ~callback:(expose d));
w#show();
GMain.main()
ocaml-cairo/examples-gtk/dune 0000644 0001750 0001750 00000000152 13446257732 016430 0 ustar treinen treinen
(executables
(names gtk_demo)
(libraries cairo2-gtk))
(alias
(name examples)
(deps gtk_demo.exe))
ocaml-cairo/src/ 0000755 0001750 0001750 00000000000 13446257732 013742 5 ustar treinen treinen ocaml-cairo/src/cairo.mli 0000644 0001750 0001750 00000351524 13446257732 015554 0 ustar treinen treinen (* File: cairo.mli
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
(** Cairo: A Vector Graphics Library (bindings).
{b Drawing:}
- {{!cairo_t}Cairo.context}: The cairo drawing context
- {{!paths}Path}: Creating paths and manipulating path data
- {!Pattern}: Sources for drawing.
- Regions — Representing a pixel-aligned area (TODO).
- {{!transformations}Transformations}: Manipulating the current
transformation matrix.
- {{!text}Text}: Rendering text and glyphs.
- Raster Sources — Supplying arbitrary image data (TODO).
{b Fonts:}
- {!Font_face}: Base module for font faces.
- {!Scaled_font}: Font face at particular size and options.
- {!Font_options}: How a font should be rendered.
- {!Ft}: FreeType Fonts — Font support for FreeType.
- {!Win32_font}: Win32 Fonts — Font support for Microsoft Windows.
- {!Quartz_font}: Quartz (CGFont) Fonts — Font support via CGFont on OS X.
- {!User_font}: Font support with font data provided by the user.
{b {!surfaces}} (platform independent {!surface_backends} and others):
- {!Surface}: Base module for surfaces.
- {!Image}: Image Surfaces — Rendering to memory buffers.
- {!PDF}: PDF Surfaces — Rendering PDF documents.
- {!PNG}: PNG Support — Reading and writing PNG images.
- {!PS}: PostScript Surfaces — Rendering PostScript documents.
- {!SVG}: SVG Surfaces — Rendering SVG documents.
Surfaces that Cairo supports but for which no OCaml binding has
been created (yet, please contribute!):
- {!XLib}: XLib Surfaces — X Window System rendering using XLib.
- {!Win32}: Win32 Surfaces — Microsoft Windows surface support.
- {!Quartz}: Quartz Surfaces — Rendering to Quartz surfaces.
In order to get acquainted with Cairo's concepts we recommend that
you read the {{:http://archimedes.forge.ocamlcore.org/cairo/}
Cairo OCaml tutorial}.
@author Christophe Troestler
@version %%VERSION%%
*)
type status =
| 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 (* should not be raised — fobidden by types *)
| INVALID_CONTENT
| INVALID_FORMAT
| INVALID_VISUAL
| FILE_NOT_FOUND
| INVALID_DASH
| INVALID_DSC_COMMENT
| INVALID_INDEX
| CLIP_NOT_REPRESENTABLE
| TEMP_FILE_ERROR
| INVALID_STRIDE
| FONT_TYPE_MISMATCH
| USER_FONT_IMMUTABLE
| USER_FONT_ERROR
| NEGATIVE_COUNT
| INVALID_CLUSTERS
| INVALID_SLANT
| INVALID_WEIGHT
| INVALID_SIZE
| USER_FONT_NOT_IMPLEMENTED
| DEVICE_TYPE_MISMATCH
| DEVICE_ERROR
| INVALID_MESH_CONSTRUCTION
| DEVICE_FINISHED
| JBIG2_GLOBAL_MISSING
exception Error of status
(** [Error status]: raised by functions of this module to indicate a
cause of failure. *)
val status_to_string : status -> string
(** Provides a human-readable description of a status. *)
exception Unavailable
(** Exception raised by functions of backend modules when they are not
available in the installed Cairo library. *)
type context
(** The cairo drawing context. This is the main object used when
drawing with cairo. To draw with cairo, you create a [Surface.t],
{!create} a [context] from it and create shapes with functions
such as {!Cairo.move_to} and {!Cairo.line_to}, and then actually
draw them with {!Cairo.stroke} or {!Cairo.fill}. *)
(* ---------------------------------------------------------------------- *)
(** {2:matrix Generic matrix operations} *)
(** Holds an affine transformation, such as a scale, rotation, shear,
or a combination of those. The transformation of a point (x, y) is
given by:
{[
x_new = xx *. x +. xy *. y +. x0;
y_new = yx *. x +. yy *. y +. y0;
]} *)
type matrix = { mutable xx: float; mutable yx: float;
mutable xy: float; mutable yy: float;
mutable x0: float; mutable y0: float; }
(** This is used throughout cairo to convert between different
coordinate spaces. *)
module Matrix :
sig
type t = matrix
val init_identity : unit -> t
(** [init_identity()] returns the identity transformation. *)
val init_translate : float -> float -> t
(** [init_translate tx ty] return a transformation that translates
by [tx] and [ty] in the X and Y dimensions, respectively. *)
val init_scale : float -> float -> t
(** [init_scale sx sy] return a transformation that scales by [sx]
and [sy] in the X and Y dimensions, respectively. *)
val init_rotate : float -> t
(** [init_rotate radians] returns a a transformation that rotates by
[radians]. *)
val translate : t -> float -> float -> unit
(** [translate matrix tx ty] applies a translation by [tx], [ty] to
the transformation in [matrix]. The effect of the new
transformation is to first translate the coordinates by [tx] and
[ty], then apply the original transformation to the
coordinates. *)
val scale : t -> float -> float -> unit
(** [scale matrix sx sy] applies scaling by [sx], [sy] to the
transformation in [matrix]. The effect of the new transformation
is to first scale the coordinates by [sx] and [sy], then apply
the original transformation to the coordinates. *)
val rotate : t -> float -> unit
(** [rotate matrix radians] applies rotation by [radians] to the
transformation in [matrix]. The effect of the new transformation
is to first rotate the coordinates by [radians], then apply the
original transformation to the coordinates. *)
val invert : t -> unit
(** [invert matrix] changes [matrix] to be the inverse of it's
original value. Not all transformation matrices have inverses;
if the matrix collapses points together (it is degenerate), then
it has no inverse and this function will raise [Error
INVALID_MATRIX]. *)
val multiply : t -> t -> t
(** [multiply a b] multiplies the affine transformations in [a] and
[b] together and return the result. The effect of the resulting
transformation is to first apply the transformation in [a] to the
coordinates and then apply the transformation in [b] to the
coordinates. *)
val transform_distance : t -> dx:float -> dy:float -> float * float
(** [transform_distance matrix dx dy] transforms the distance
vector ([dx],[dy]) by [matrix]. This is similar to
{!Cairo.Matrix.transform_point} except that the translation
components of the transformation are ignored. The calculation
of the returned vector is as follows:
{[
dx2 = dx1 * a + dy1 * c;
dy2 = dx1 * b + dy1 * d;
]}
Affine transformations are position invariant, so the same
vector always transforms to the same vector. If (x1,y1)
transforms to (x2,y2) then (x1+dx1,y1+dy1) will transform to
(x1+dx2,y1+dy2) for all values of x1 and x2. *)
val transform_point : t -> float -> float -> float * float
(** [transform_point matrix x y] transforms the point ([x], [y]) by
[matrix]. *)
end
(* ---------------------------------------------------------------------- *)
(** {2:text Rendering text and glyphs} *)
(** The [Cairo.text_extents] structure stores the extents of a single
glyph or a string of glyphs in user-space coordinates. Because text
extents are in user-space coordinates, they are mostly, but not
entirely, independent of the current transformation matrix. If you
call {!Cairo.scale}[cr 2.0 2.0], text will be drawn twice as big, but
the reported text extents will not be doubled. They will change
slightly due to hinting (so you can't assume that metrics are
independent of the transformation matrix), but otherwise will remain
unchanged. *)
type text_extents = {
x_bearing : float;
(** The horizontal distance from the origin of the text to the
leftmost part of the glyphs as drawn. Positive if the glyphs
lie entirely to the right of the origin. *)
y_bearing : float;
(** The vertical distance from the origin to the topmost part of the
glyphs as drawn. Positive only if the glyphs lie completely below
the origin; will usually be negative. *)
width : float; (** width of the glyphs as drawn *)
height : float; (** height of the glyphs as drawn *)
x_advance : float;
(** Distance to advance in the X direction after drawing these glyphs. *)
y_advance : float;
(** Distance to advance in the Y direction after drawing these
glyphs. Will typically be zero except for vertical text layout
as found in East-Asian languages. *)
}
(** {3 Low-level text API} *)
(** This is Cairo low-level text API. The low-level API relies on the
user to convert text to a set of glyph indexes and positions. This is
a very hard problem and is best handled by external libraries, like
the pangocairo that is part of the Pango text layout and rendering
library. Pango is available from http://www.pango.org/
See also the {!text_toy}. *)
module Glyph :
sig
(** The [Glyph.t] structure holds information about a single glyph
when drawing or measuring text. A font is (in simple terms) a
collection of shapes used to draw text. A glyph is one of these
shapes. There can be multiple glyphs for a single character
(alternates to be used in different contexts, for example), or a
glyph can be a ligature of multiple characters. Cairo doesn't
expose any way of converting input text into glyphs, so in order
to use the Cairo interfaces that take arrays of glyphs, you must
directly access the appropriate underlying font system.
Note that the offsets given by x and y are not cumulative. When
drawing or measuring text, each glyph is individually positioned
with respect to the overall origin. *)
type t = {
index: int; (** glyph index in the font. The exact interpretation
of the glyph index depends on the font technology
being used. *)
x: float; (** the offset in the X direction between the origin
used for drawing or measuring the string and the
origin of this glyph. *)
y: float; (** the offset in the Y direction between the origin
used for drawing or measuring the string and the
origin of this glyph. *)
}
(** The [cluster] record holds information about a single {i text
cluster}. A text cluster is a minimal mapping of some glyphs
corresponding to some UTF-8 text.
For a cluster to be valid, both [num_bytes] and [num_glyphs]
should be non-negative, and at least one should be non-zero.
Note that clusters with zero glyphs are not as well supported as
normal clusters. For example, PDF rendering applications
typically ignore those clusters when PDF text is being selected.
See {!Cairo.Glyph.show_text} for how clusters are used in
advanced text operations. *)
type cluster = {
num_bytes : int; (** the number of bytes of UTF-8 text covered by cluster *)
num_glyphs : int; (** the number of glyphs covered by cluster *)
}
(** Specifies properties of a text cluster mapping. *)
type cluster_flags =
| BACKWARD (** The clusters in the cluster array map to glyphs in
the glyph array from end to start. *)
val extents : context -> t array -> text_extents
(** Gets the extents for an array of glyphs. The extents describe a
user-space rectangle that encloses the "inked" portion of the
glyphs (as they would be drawn by {!Cairo.Glyph.show}).
Additionally, the [x_advance] and [y_advance] values indicate the
amount by which the current point would be advanced by
{!Cairo.Glyph.show}.
Note that whitespace glyphs do not contribute to the size of
the rectangle (extents.width and extents.height). *)
val show : context -> t array -> unit
(** A drawing operator that generates the shape from an array of
glyphs, rendered according to the current font face, font size
(font matrix), and font options. *)
val show_text : context -> string -> t array -> cluster array ->
cluster_flags -> unit
(** [show_text cr utf8 glyphs clusters cluster_flags]: This
operation has rendering effects similar to {!Cairo.Glyph.show}
but, if the target surface supports it, uses the provided text
and cluster mapping to embed the text for the glyphs shown in the
output. If the target does not support the extended attributes,
this function acts like the basic {!Cairo.Glyph.show} as if it
had been passed [glyphs].
The mapping between [utf8] and [glyphs] is provided by an
array of [clusters]. Each cluster covers a number of text bytes
and glyphs, and neighboring clusters cover neighboring areas of
[utf8] and [glyphs]. The clusters should collectively cover
[utf8] and [glyphs] in entirety.
The first cluster always covers bytes from the beginning of
[utf8]. If [cluster_flags] do not have the [BACKWARD] set, the
first cluster also covers the beginning of glyphs, otherwise it
covers the end of the glyphs array and following clusters move
backward.
See {!Cairo.Glyph.cluster} for constraints on valid clusters. *)
end
(** {3:text_toy "Toy" text API}
This is cairo's toy text API. The toy API takes UTF-8 encoded text
and is limited in its functionality to rendering simple
left-to-right text with no advanced features. That means for
example that most complex scripts like Hebrew, Arabic, and Indic
scripts are out of question. No kerning or correct positioning of
diacritical marks either. The font selection is pretty limited
too and doesn't handle the case that the selected font does not
cover the characters in the text. This set of functions are
really that, a toy text API, for testing and demonstration
purposes. Any serious application should avoid them.
See the {!Glyph} module for the low-level text API. *)
(** Specifies the type of antialiasing to do when rendering text or shapes. *)
type antialias =
| ANTIALIAS_DEFAULT (** Use the default antialiasing for the
subsystem and target device *)
| ANTIALIAS_NONE (** Use a bilevel alpha mask *)
| ANTIALIAS_GRAY (** Perform single-color antialiasing (using
shades of gray for black text on a white
background, for example). *)
| ANTIALIAS_SUBPIXEL (** Perform antialiasing by taking advantage of
the order of subpixel elements on devices
such as LCD panels *)
(** The subpixel order specifies the order of color elements within
each pixel on the display device when rendering with an
antialiasing mode of [ANTIALIAS_SUBPIXEL] (see {!Cairo.antialias}). *)
type subpixel_order =
| SUBPIXEL_ORDER_DEFAULT (** Use the default subpixel order for for
the target device *)
| SUBPIXEL_ORDER_RGB (** Subpixel elements are arranged horizontally
with red at the left *)
| SUBPIXEL_ORDER_BGR (** Subpixel elements are arranged horizontally
with blue at the left *)
| SUBPIXEL_ORDER_VRGB (** Subpixel elements are arranged vertically
with red at the top *)
| SUBPIXEL_ORDER_VBGR (** Subpixel elements are arranged vertically
with blue at the top *)
(** Specifies the type of hinting to do on font outlines. Hinting is
the process of fitting outlines to the pixel grid in order to improve
the appearance of the result. Since hinting outlines involves
distorting them, it also reduces the faithfulness to the original
outline shapes. Not all of the outline hinting styles are supported by
all font backends. *)
type hint_style =
| HINT_STYLE_DEFAULT (** Use the default hint style for font backend
and target device *)
| HINT_STYLE_NONE (** Do not hint outlines *)
| HINT_STYLE_SLIGHT (** Hint outlines slightly to improve contrast
while retaining good fidelity to the
original shapes. *)
| HINT_STYLE_MEDIUM (** Hint outlines with medium strength giving a
compromise between fidelity to the original
shapes and contrast. *)
| HINT_STYLE_FULL (** Hint outlines to maximize contrast. *)
(** Specifies whether to hint font metrics; hinting font metrics means
quantizing them so that they are integer values in device space.
Doing this improves the consistency of letter and line spacing,
however it also means that text will be laid out differently at
different zoom factors. *)
type hint_metrics =
| HINT_METRICS_DEFAULT (** Hint metrics in the default manner for
the font backend and target device. *)
| HINT_METRICS_OFF (** Do not hint font metrics. *)
| HINT_METRICS_ON (** Hint font metrics. *)
(** The font options specify how fonts should be rendered. Most of the
time the font options implied by a surface are just right and do not
need any changes, but for pixel-based targets tweaking font options
may result in superior output on a particular display. *)
module Font_options :
sig
type t
(** An opaque type holding all options that are used when rendering
fonts.
Individual features of a [Cairo.Font_options.t] can be set or
accessed using functions below, like
{!Cairo.Font_options.set_antialias} and
{!Cairo.Font_options.get_antialias}.
New features may be added to a [font_options] in the future. For
this reason, {!Cairo.Font_options.copy} and
{!Cairo.Font_options.merge} should be used to copy or merge of
[Cairo.Font_options.t] values. *)
val set : context -> t -> unit
(** [set_font_options cr opt] sets a set of custom font rendering
options for [cr]. Rendering options are derived by merging these
options with the options derived from underlying surface; if the
value in options has a default value (like [ANTIALIAS_DEFAULT]),
then the value from the surface is used. *)
val get : context -> t
(** Retrieves font rendering options set via
{!Cairo.Font_options.set}. Note that the returned options do not
include any options derived from the underlying surface; they are
literally the options passed to {!Cairo.Font_options.set}. *)
val create : unit -> t
(** Allocates a new font options object with all options initialized
to default values. *)
val make : ?antialias:antialias -> ?subpixel_order:subpixel_order ->
?hint_style:hint_style -> ?hint_metrics:hint_metrics -> unit -> t
(** Convenience function to create an options object with properties set.
@param antialias default: [ANTIALIAS_DEFAULT]
@param subpixel_order default: [SUBPIXEL_ORDER_DEFAULT]
@param hint_style default: [HINT_STYLE_DEFAULT]
@param hint_metrics default: [HINT_METRICS_DEFAULT] *)
val copy : t -> t
(** [copy original] allocates a new font options object copying the
option values from [original]. *)
val merge : t -> t -> unit
(** [merge options other] merges non-default options from other into
options, replacing existing values. This operation can be
thought of as somewhat similar to compositing other onto options
with the operation of [OVER] (see {!Cairo.operator}). *)
val set_antialias : t -> antialias -> unit
(** Sets the antialiasing mode for the font options object. This
specifies the type of antialiasing to do when rendering text. *)
val get_antialias : t -> antialias
(** Gets the antialiasing mode for the font options object. *)
val set_subpixel_order : t -> subpixel_order -> unit
(** Sets the subpixel order for the font options object. The
subpixel order specifies the order of color elements within each
pixel on the display device when rendering with an antialiasing
mode of [ANTIALIAS_SUBPIXEL] (see {!Cairo.antialias}). See the
documentation for {!Cairo.subpixel_order} for full details. *)
val get_subpixel_order : t -> subpixel_order
(** Gets the subpixel order for the font options object. See the
documentation for {!Cairo.subpixel_order} for full details. *)
val set_hint_style : t -> hint_style -> unit
(** Sets the hint style for font outlines for the font options
object. This controls whether to fit font outlines to the pixel
grid, and if so, whether to optimize for fidelity or contrast.
See the documentation for {!Cairo.hint_style} for full
details. *)
val get_hint_style : t -> hint_style
(** Gets the hint style for font outlines for the font options
object. See the documentation for {!Cairo.hint_style} for full
details. *)
val set_hint_metrics : t -> hint_metrics -> unit
(** Sets the metrics hinting mode for the font options object. This
controls whether metrics are quantized to integer values in
device units. See the documentation for {!Cairo.hint_metrics} for
full details. *)
val get_hint_metrics : t -> hint_metrics
(** Gets the metrics hinting mode for the font options object. See the
documentation for {!Cairo.hint_metrics} for full details. *)
end
(** Specifies variants of a font face based on their slant. *)
type slant = Upright | Italic | Oblique
(** Specifies variants of a font face based on their weight. *)
type weight = Normal | Bold
(** {!Cairo.font_type} is used to describe the type of a given font
face or scaled font. The font types are also known as "font
backends" within cairo.
The type of a font face is determined by the function used to
create it, which will generally be of the form
[Cairo.*.font_face_create]. The font face type can be queried
with {!Cairo.Font_face.get_type}
The various {!Cairo.Font_face} functions can be used with a font
face of any type.
The type of a scaled font is determined by the type of the font
face passed to {!Cairo.Scaled_font.create}. The scaled font type
can be queried with {!Cairo.Scaled_font.get_type}.
The various {!Cairo.Scaled_font} functions can be used with scaled
fonts of any type, but some font backends also provide
type-specific functions (such as {!Cairo.Ft.scaled_font_lock_face})
that must only be called with a scaled font of the appropriate type.
FIXME: The behavior of calling a type-specific function with a scaled
font of the wrong type is undefined. *)
type font_type =
[ `Toy (** The font was created using cairo's toy font api *)
| `Ft (** The font is of type FreeType *)
| `Win32 (** The font is of type Win32 *)
| `Quartz (** The font is of type Quartz *)
| `User (** The font was create using cairo's user font api *)
]
(** {!Cairo.Font_face.t} represents a particular font at a particular
weight, slant, and other characteristic but no size,
transformation, or size. *)
module Font_face :
sig
type 'a t
(** A {!Cairo.Font_face.t} specifies all aspects of a font other
than the size or font matrix (a font matrix is used to distort a
font by sheering it or scaling it unequally in the two
directions). A font face can be set on a {!Cairo.context} by
using {!Cairo.Font_face.set}; the size and font matrix are set
with {!Cairo.set_font_size} and {!Cairo.set_font_matrix}.
Font faces are created using font-backend-specific
constructors, or implicitly using the toy text API by way of
{!Cairo.select_font_face}.
There are various types of font faces, depending on the font
backend they use. The type of a font face can be queried using
{!Cairo.Font_face.get_type}. *)
val set : context -> _ t -> unit
(** Replaces the current {!Cairo.Font_face.t} object in the
{!Cairo.context} with font_face. *)
val get : context -> font_type t
(** Gets the current font face for a {!Cairo.context}. *)
val get_type : 'a t -> font_type
(** This function returns the type of the backend used to create a
font face. See {!Cairo.font_type} for available types. If ['a]
contains a single variant, it will be the returned value. *)
val create : ?family:string -> slant -> weight -> [`Toy] t
(** [create family slant weight] creates a font face from a triplet
of family, slant, and weight. These font faces are used in
implementation of the the cairo "toy" font API.
If family is not given or is the zero-length string "", the
platform-specific default family is assumed. The default family
then can be queried using {!Cairo.Font_face.get_family}.
The {!Cairo.select_font_face} function uses this to create font
faces. See that function for limitations of toy font faces. *)
val get_family : [`Toy] t -> string
(** Gets the familly name of a toy font. *)
val get_slant : [`Toy] t -> slant
(** Gets the slant a toy font. *)
val get_weight : [`Toy] t -> weight
(** Gets the weight a toy font. *)
end
(** The [Cairo.font_extents] structure stores metric information for a
font. Values are given in the current user-space coordinate
system.
Because font metrics are in user-space coordinates, they are
mostly, but not entirely, independent of the current
transformation matrix. If you call {!Cairo.scale}[cr 2.0 2.0],
text will be drawn twice as big, but the reported text extents
will not be doubled. They will change slightly due to hinting
(so you can't assume that metrics are independent of the
transformation matrix), but otherwise will remain unchanged. *)
type font_extents = {
ascent : float;
(** the distance that the font extends above the baseline. Note that
this is not always exactly equal to the maximum of the extents
of all the glyphs in the font, but rather is picked to express
the font designer's intent as to how the font should align with
elements above it. *)
descent : float;
(** the distance that the font extends below the baseline. This
value is positive for typical fonts that include portions
below the baseline. Note that this is not always exactly equal
to the maximum of the extents of all the glyphs in the font,
but rather is picked to express the font designer's intent as
to how the the font should align with elements below it. *)
baseline : float;
(** the recommended vertical distance between baselines when
setting consecutive lines of text with the font. This is greater
than ascent+descent by a quantity known as the line spacing or
external leading. When space is at a premium, most fonts can be
set with only a distance of ascent+descent between lines. *)
max_x_advance : float;
(** the maximum distance in the X direction that the the origin is
advanced for any glyph in the font. *)
max_y_advance : float;
(** the maximum distance in the Y direction that the the origin is
advanced for any glyph in the font. this will be zero for normal
fonts used for horizontal writing. (The scripts of East Asia are
sometimes written vertically.) *)
}
(** {!Cairo.Scaled_font.t} represents a realization of a font face at
a particular size and transformation and a certain set of font
options. *)
module Scaled_font :
sig
type 'a t
(** A [Cairo.Scaled_font.t] is a font scaled to a particular size
and device resolution. It is most useful for low-level font
usage where a library or application wants to cache a reference
to a scaled font to speed up the computation of metrics.
There are various types of scaled fonts, depending on the font
backend they use. The type of a scaled font can be queried using
{!Cairo.Scaled_font.get_type}. *)
val set : context -> _ t -> unit
(** Replaces the current font face, font matrix, and font options in
the {!Cairo.context} with those of the {!Cairo.Scaled_font.t}.
Except for some translation, the current CTM of the
{!Cairo.context} should be the same as that of the
{!Cairo.Scaled_font.t}, which can be accessed using
{!Cairo.Scaled_font.get_ctm}. *)
val get : context -> 'a t
(** Gets the current scaled font for a cairo_t. *)
val create : 'a Font_face.t -> Matrix.t -> Matrix.t -> Font_options.t -> 'a t
(** [create font_face font_matrix ctm options] creates a
{!Cairo.Scaled_font.t} object from a font face and matrices that
describe the size of the font and the environment in which it
will be used. *)
val extents : _ t -> font_extents
(** [extents sf] gets the metrics for [sf]. *)
val text_extents : _ t -> string -> text_extents
(** [text_extents scaled_font utf8] gets the [extents] for a string
of text. The extents describe a user-space rectangle that
encloses the "inked" portion of the text drawn at the origin
(0,0) (as it would be drawn by {!Cairo.show_text} if the cairo
graphics state were set to the same font_face, font_matrix, ctm,
and font_options as [scaled_font]). Additionally, the x_advance
and y_advance values indicate the amount by which the current
point would be advanced by {!Cairo.show_text}. The string [utf8]
should not contain ['\000'] characters.
Note that whitespace characters do not directly contribute to the
size of the rectangle ([extents.width] and [extents.height]).
They do contribute indirectly by changing the position of
non-whitespace characters. In particular, trailing whitespace
characters are likely to not affect the size of the rectangle,
though they will affect the [x_advance] and [y_advance]
values. *)
val glyph_extents : _ t -> Glyph.t array -> text_extents
(** [glyph_extents scaled_font glyphs] gets the [extents] for an
array of glyphs. The extents describe a user-space rectangle that
encloses the "inked" portion of the glyphs (as they would be
drawn by {!Cairo.Glyph.show} if the cairo graphics state were set
to the same font_face, font_matrix, ctm, and font_options as
[scaled_font]). Additionally, the [x_advance] and [y_advance]
values indicate the amount by which the current point would be
advanced by {!Cairo.Glyph.show}.
Note that whitespace glyphs do not contribute to the size of
the rectangle ([extents.width] and [extents.height]). *)
val text_to_glyphs : _ t -> x:float -> y:float -> string
-> Glyph.t array * Glyph.cluster array * Glyph.cluster_flags
(** [text_to_glyphs scaled_font x y utf8] converts UTF-8 text to an
array of glyphs, optionally with cluster mapping, that can be
used to render later using [scaled_font]. See
{!Cairo.Glyph.show_text}. *)
val get_font_face : 'a t -> 'a Font_face.t
(** Gets the font face that this scaled font was created for. *)
val get_font_options : _ t -> Font_options.t
(** [get_font_options scaled_font] returns the font options with
which [scaled_font] was created. *)
val get_font_matrix : _ t -> Matrix.t
(** [get_font_matrix scaled_font] return the font matrix with which
[scaled_font] was created. *)
val get_ctm : _ t -> Matrix.t
(** [get_ctm scaled_font] returns the CTM with which [scaled_font]
was created. *)
val get_scale_matrix : _ t -> Matrix.t
(** [get_scale_matrix scaled_font] returns the scale matrix of
[scaled_font]. The scale matrix is product of the font matrix
and the ctm associated with the scaled font, and hence is the
matrix mapping from font space to device space. *)
val get_type : 'a t -> font_type
(** This function returns the type of the backend used to create a
scaled font. See {!Cairo.font_type} for available types. *)
end
(** A minimal Interface to FreeType/Fontconfig. Functions in this
module will raie {!Unavailable} if Cairo has not been compiled with
FreeType support (and fonconfig is available). This module is not
thread safe. *)
module Ft : sig
type face
(** A FreeType face. *)
type library
(** A FreeType library value. *)
val init_freetype : unit -> library
(** [init_freetype()] Initialize a new FreeType library value. In
multi-threaded applications it is recommended to use a different
library value for each thread. *)
val face : ?library:library -> ?index:int -> string -> face
(** [face pathname] open the face contained in the [pathname].
@param index See the documentation for
{{:https://www.freetype.org/freetype2/docs/reference/ft2-base_interface.html#FT_Open_Face}face_index}.
@param library Use the provided library as the "root" of the font. *)
type flag = [`Vertical_layout | `Force_autohint]
val create_for_ft_face : ?flags:flag list -> face -> [`Ft] Font_face.t
(** [create_for_ft_face face] create a new font face for the
FreeType font backend from a FreeType [face]. *)
val create_for_pattern : ?options:Font_options.t ->
string -> [`Ft] Font_face.t
(** [create_for_pattern pattern] creates a new font face for the
FreeType font backend based on a fontconfig [pattern] (in text
form). *)
val scaled_font_lock_face : [`Ft] Scaled_font.t -> face
val scaled_font_unlock_face : [`Ft] Scaled_font.t -> unit
(** [scaled_font_unlock_face font] releases a face obtained with
{!scaled_font_lock_face}. *)
module Synthesize : sig
type t = { bold: bool;
oblique: bool }
val get : [`Ft] Font_face.t -> t
(** [get font] returns the synthesized information. *)
val set : ?bold:bool -> ?oblique:bool -> [`Ft] Font_face.t -> unit
(** [set font] synthesize different glyphs from a base [font],
which is useful if you lack those glyphs from a true bold or
oblique font. *)
val unset : ?bold:bool -> ?oblique:bool -> [`Ft] Font_face.t -> unit
(** [unset font] undo what {!set} did. *)
end
end
val select_font_face : context -> ?slant:slant -> ?weight:weight -> string ->
unit
(** [select_font_face cr family ?slant ?weight] selects a family and
style of font from a simplified description as a family name, slant
and weight. Cairo provides no operation to list available family
names on the system (this is a "toy", remember), but the standard
CSS2 generic family names, ("serif", "sans-serif", "cursive",
"fantasy", "monospace"), are likely to work as expected.
@param slant default [Upright].
@param weight default [Normal].
For "real" font selection, see the font-backend-specific
[font_face_create] functions for the font backend you are using.
(For example, if you are using the freetype-based cairo-ft font
backend, see {!Cairo.Ft.create_for_ft_face} or
{!Cairo.Ft.create_for_pattern}.) The resulting font face
could then be used with {!Cairo.Scaled_font.create} and
{!Cairo.Scaled_font.set}.
Similarly, when using the "real" font support, you can call
directly into the underlying font system (such as fontconfig or
freetype), for operations such as listing available fonts, etc.
It is expected that most applications will need to use a more
comprehensive font handling and text layout library (for example,
pango) in conjunction with cairo.
If text is drawn without a call to {!Cairo.select_font_face},
(nor {!Cairo.Font_face.set} nor {!Cairo.Scaled_font.set}), the
default family is platform-specific, but is essentially
"sans-serif". Default slant is [Upright], and default weight is
[Normal]. *)
val set_font_size : context -> float -> unit
(** [set_font_size cr size] sets the current font matrix to a scale by
a factor of size, replacing any font matrix previously set with
[set_font_size] or {!Cairo.set_font_matrix}. This results in a
font size of size user space units. (More precisely, this matrix
will result in the font's em-square being a size by size square in
user space.)
If text is drawn without a call to [set_font_size] (nor
{!Cairo.set_font_matrix}, nor {!Cairo.Scaled_font.set}), the
default font size is 10.0. *)
val set_font_matrix : context -> Matrix.t -> unit
(** [set_font_matrix cr matrix] sets the current font matrix to
[matrix]. The font matrix gives a transformation from the design
space of the font (in this space, the em-square is 1 unit by 1
unit) to user space. Normally, a simple scale is used (see
{!Cairo.set_font_size}), but a more complex font matrix can be used
to shear the font or stretch it unequally along the two axes. *)
val get_font_matrix : context -> Matrix.t
(** Returns the current font matrix. See {!Cairo.set_font_matrix}. *)
val show_text : context -> string -> unit
(** A drawing operator that generates the shape from a string of UTF-8
characters, rendered according to the current [font_face],
[font_size] (font_matrix), and [font_options].
This function first computes a set of glyphs for the string of
text. The first glyph is placed so that its origin is at the
current point. The origin of each subsequent glyph is offset from
that of the previous glyph by the advance values of the previous
glyph.
After this call the current point is moved to the origin of where
the next glyph would be placed in this same progression. That is,
the current point will be at the origin of the final glyph offset
by its advance values. This allows for easy display of a single
logical string with multiple calls to [show_text]. *)
val font_extents : context -> font_extents
(** Gets the font extents for the currently selected font. *)
val text_extents : context -> string -> text_extents
(** [text_extents cr utf8] gets the extents for a string of text. The
extents describe a user-space rectangle that encloses the "inked"
portion of the text (as it would be drawn by {!Cairo.show_text}).
Additionally, the [x_advance] and [y_advance] values indicate the
amount by which the current point would be advanced by
{!Cairo.show_text}.
Note that whitespace characters do not directly contribute to the
size of the rectangle ([extents.width] and [extents.height]). They
do contribute indirectly by changing the position of non-whitespace
characters. In particular, trailing whitespace characters are
likely to not affect the size of the rectangle, though they will
affect the [x_advance] and [y_advance] values. *)
(* ---------------------------------------------------------------------- *)
(** {2:surfaces Surfaces} *)
(** A data structure for holding a rectangle. *)
type rectangle = {
x:float; (** X coordinate of the left side of the rectangle *)
y:float; (** Y coordinate of the the top side of the rectangle *)
w:float; (** width of the rectangle *)
h:float; (** height of the rectangle *)
}
(** {3 Base module for surfaces} *)
(** This is used to describe the content that a surface will contain,
whether color information, alpha information (translucence
vs. opacity), or both. *)
type content = COLOR | ALPHA | COLOR_ALPHA
(** Abstract representation of all different drawing targets that
cairo can render to; the actual drawings are performed using a
cairo context. *)
module Surface :
sig
type t
(** A {!Cairo.Surface.t} represents an image, either as the
destination of a drawing operation or as source when drawing onto
another surface. To draw to a {!Cairo.Surface.t}, create a cairo
context with the surface as the target, using {!Cairo.create}.
There are different subtypes of {!Cairo.Surface.t} for
different drawing backends; for example, {!Cairo.Image.create}
creates a bitmap image in memory. The type of a surface can be
queried with {!Cairo.Surface.get_type}. *)
val create_similar : t -> content -> w:int -> h:int -> t
(** [create_similar other content width height] create a new surface
that is as compatible as possible with the existing surface
[other]. For example the new surface will have the same fallback
resolution and font options as [other]. Generally, the new
surface will also use the same backend as other, unless that is
not possible for some reason. The type of the returned surface
may be examined with {!Cairo.Surface.get_type}.
Initially the surface contents are all 0 (transparent if contents
have transparency, black otherwise.) *)
val finish : t -> unit
(** This function finishes the surface and drops all references to
external resources. For example, for the Xlib backend it means
that cairo will no longer access the drawable. After calling
{!Cairo.Surface.finish} the only valid operations on a surface
are flushing and finishing it. Further drawing to the surface
will not affect the surface but will instead raise
[Error(SURFACE_FINISHED)]. *)
val flush : t -> unit
(** Do any pending drawing for the surface and also restore any
temporary modification's cairo has made to the surface's state.
This function must be called before switching from drawing on the
surface with cairo to drawing on it directly with native APIs.
If the surface doesn't support direct access, then this function
does nothing. *)
val get_font_options : t -> Font_options.t
(** [get_font_options surface] retrieves the default font rendering
options for the [surface]. This allows display surfaces to
report the correct subpixel order for rendering on them, print
surfaces to disable hinting of metrics and so forth. The result
can then be used with {!Cairo.Scaled_font.create}. *)
val get_content : t -> content
(** This function returns the content type of surface which
indicates whether the surface contains color and/or alpha
information. See {!Cairo.content}. *)
val mark_dirty : t -> unit
(** Tells cairo that drawing has been done to surface using means
other than cairo, and that cairo should reread any cached areas.
Note that you must call {!Cairo.Surface.flush} before doing such
drawing. *)
val mark_dirty_rectangle : t -> int -> int -> w:int -> h:int -> unit
(** [mark_dirty_rectangle x y w h] like {!Cairo.Surface.mark_dirty},
but drawing has been done only to the specified rectangle, so
that cairo can retain cached contents for other parts of the surface.
Any cached clip set on the surface will be reset by this
function, to make sure that future cairo calls have the clip set
that they expect. *)
val set_device_offset : t -> float -> float -> unit
(** Sets an offset that is added to the device coordinates
determined by the CTM when drawing to surface. One use case for
this function is when we want to create a {!Cairo.Surface.t} that
redirects drawing for a portion of an onscreen surface to an
offscreen surface in a way that is completely invisible to the
user of the cairo API. Setting a transformation via
{!Cairo.translate} isn't sufficient to do this, since functions
like {!Cairo.device_to_user} will expose the hidden offset.
Note that the offset affects drawing to the surface as well
as using the surface in a source pattern.
@param x the offset in the X direction, in device units.
@param y the offset in the Y direction, in device units. *)
val get_device_offset : t -> float * float
(** This function returns the previous device offset set by
{!Cairo.Surface.set_device_offset}. *)
val set_fallback_resolution : t -> x:float -> y:float -> unit
(** [set_fallback_resolution surface x_pixels_per_inch
y_pixels_per_inch] sets the horizontal and vertical resolution
for image fallbacks.
When certain operations aren't supported natively by a backend,
cairo will fallback by rendering operations to an image and then
overlaying that image onto the output. For backends that are
natively vector-oriented, this function can be used to set the
resolution used for these image fallbacks (larger values will
result in more detailed images, but also larger file sizes).
Some examples of natively vector-oriented backends are the ps,
pdf, and svg backends.
For backends that are natively raster-oriented, image fallbacks
are still possible, but they are always performed at the native
device resolution. So this function has no effect on those
backends.
Note: The fallback resolution only takes effect at the time of
completing a page (with {!Cairo.show_page} or {!Cairo.copy_page})
so there is currently no way to have more than one fallback
resolution in effect on a single page.
The default fallback resoultion is 300 pixels per inch in both
dimensions. *)
val get_fallback_resolution : t -> float * float
(** This function returns the previous fallback resolution set by
{!Cairo.Surface.set_fallback_resolution}, or default fallback
resolution if never set. *)
(** This is used to describe the type of a given surface. The
surface types are also known as "backends" or "surface backends"
within cairo.
The type of a surface is determined by the function used to
create it, which will generally be of the form [cairo_]{i
type}[_surface_create] (though see {!Cairo.Surface.create_similar}
as well). *)
type kind =
[ `Image
| `PDF
| `PS
| `XLib
| `XCB
| `GLITZ
| `Quartz
| `Win32
| `BEOS
| `DirectFB
| `SVG
| `OS2
| `Win32_printing
| `Quartz_image
| `Recording
]
val get_type : t -> kind
(** This function returns the type of the backend used to create a
surface. See {!Cairo.Surface.kind} for available types. *)
val copy_page : t -> unit
(** Emits the current page for backends that support multiple pages,
but doesn't clear it, so that the contents of the current page
will be retained for the next page. Use
{!Cairo.Surface.show_page} if you want to get an empty page after
the emission.
There is a convenience function for this that takes a
{!Cairo.context}, namely {!Cairo.copy_page}. *)
val show_page : t -> unit
(** Emits and clears the current page for backends that support
multiple pages. Use {!Cairo.Surface.copy_page} if you don't want
to clear the page.
There is a convenience function for this that takes a
{!Cairo.context}, namely {!Cairo.show_page}. *)
val has_show_text_glyphs : t -> bool
(** Returns whether the surface supports sophisticated
{!Cairo.Glyph.show_text} operations. That is, whether it
actually uses the provided text and cluster data to a
{!Cairo.Glyph.show_text} call.
Note: Even if this function returns [false], a
{!Cairo.Glyph.show_text} operation targeted at surface will still
succeed. It just will act like a {!Cairo.Glyph.show} operation.
Users can use this function to avoid computing UTF-8 text and
cluster mapping if the target surface does not use it. *)
end
(** {3:surface_backends Surface backends}
Below are the surface backends that do not depend of a particular
platform. {!XLib}, {!Win32}, and {!Quartz} are defined in their
own modules.
*)
(** Image surfaces provide the ability to render to memory buffers
either allocated by cairo or by the calling code. The supported
image formats are those defined in {!Cairo.Image.format}. *)
module Image :
sig
(** This is used to identify the memory format of image data. *)
type format =
| ARGB32 (** each pixel is a 32-bit quantity, with alpha in the
upper 8 bits, then red, then green, then blue. The
32-bit quantities are stored native-endian.
Pre-multiplied alpha is used. (That is, 50%
transparent red is 0x80800000, not 0x80ff0000.) *)
| RGB24 (** each pixel is a 32-bit quantity, with the upper 8 bits
unused. Red, Green, and Blue are stored in the
remaining 24 bits in that order. *)
| A8 (** each pixel is a 8-bit quantity holding an alpha value. *)
| A1 (** each pixel is a 1-bit quantity holding an alpha
value. Pixels are packed together into 32-bit quantities.
The ordering of the bits matches the endianess of the
platform. On a big-endian machine, the first pixel is in
the uppermost bit, on a little-endian machine the first
pixel is in the least-significant bit. *)
val create : format -> w:int -> h:int -> Surface.t
(** Creates an image surface of the specified format and
dimensions. Initially the surface contents are all 0.
(Specifically, within each pixel, each color or alpha channel
belonging to format will be 0. The contents of bits within a
pixel, but not belonging to the given format are undefined). *)
type data8 =
(int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
(** Images represented as an array of 8 bytes values. *)
type data32 =
(int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array2.t
(** Images represented as an array of 32 bytes (RGB or RGBA) values. *)
val create_for_data8 : data8 -> ?stride:int ->
format -> w:int -> h:int -> Surface.t
(** [create_for_data8 data format ?stride width height] creates an
image surface for the provided pixel data. The initial contents
of buffer will be used as the initial image contents; you must
explicitly clear the buffer, using, for example,
{!Cairo.rectangle} and {!Cairo.fill} if you want it cleared.
@param stride the number of bytes between the start of rows in
the buffer as allocated. This value should always be computed by
{!stride_for_width} before allocating the data buffer. (that's
what this function does if the argument is not provided). *)
val create_for_data32 : ?w:int -> ?h:int -> ?alpha:bool ->
data32 -> Surface.t
(** [create_for_data32 ?w ?h ?alpha data] same as
{!Cairo.Image.create_for_data8} except that the stride will be
set so that [data.{y,x}] refers to the pixel ([x],[y]) (where
(0,0) is the top left pixel and the Y axis is directed downwards).
@param w the width of the image (default: [Array2.dim2 data]).
@param h the height of the image (default: [Array2.dim1 data]).
@param alpha if true (default), the [ARGB32] format is selected,
otherwise [RGB24] is used. *)
val get_data8 : Surface.t -> data8
(** Get the data of the image surface (shared), for direct
inspection or modification. A call to {!Cairo.Surface.mark_dirty}
or {!Cairo.Surface.mark_dirty_rectangle} is required after the
data is modified. *)
val get_data32 : Surface.t -> data32
(** Get the data of the image surface (shared), for direct
inspection or modification. The 1st (resp. 2nd) dimension of the
bigarray correspond to the height (resp. width) of the surface. A
call to {!Cairo.Surface.mark_dirty} or
{!Cairo.Surface.mark_dirty_rectangle} is required after the data
is modified.
@raise Invalid_argument if the format is not [ARGB32] or
[RGB24] because the array dimensions would not reflect the image
coordinates. *)
val get_format : Surface.t -> format
(** Get the format of the image surface. *)
val get_width : Surface.t -> int
(** Get the width of the image surface in pixels. *)
val get_height : Surface.t -> int
(** Get the height of the image surface in pixels. *)
val get_stride : Surface.t -> int
(** Get the stride of the image surface in bytes. Note that in
order to convert this stride in bytes to a stride in the
bigarray indices, the type of the surface has to be taken into
account: for [ARGB32] and [RGB24], the stride has to be divided
by 4. *)
val stride_for_width : format -> int -> int
(** [stride_for_width format w] a stride value that will respect
all alignment requirements of the accelerated image-rendering code
within cairo. See {!create_for_data8}. *)
val output_ppm : out_channel -> ?w:int -> ?h:int -> data32 -> unit
(** [output_ppm ch width height data] convenience function to write
the subarray of size ([width], [height]) representing an image to
the PPM format. The possible alpha channel is ignored. *)
end
(** The PDF surface is used to render cairo graphics to Adobe PDF
files and is a multi-page vector surface backend.
To create a cairo context [cr] that will write the the PDF file
[fname] with dimensions [w]×[h] points, do [let cr =
Cairo.create(Cairo.PDF.create fname w h)]. Do not forget to call
[Surface.finish(get_target cr)] when you are done drawing because
the file may not be fully written before. *)
module PDF :
sig
val create : string -> w:float -> h:float -> Surface.t
(** [create fname w h] creates a PDF surface of the specified size
in points to be written to [fname].
@param w width of the surface, in points (1 point = 1/72.0 inch)
@param h height of the surface, in points (1 point = 1/72.0 inch)
*)
val create_for_stream : (string -> unit) -> w:float -> h:float -> Surface.t
(** [create_for_stream output width height] creates a PDF surface of
the specified size in points to be written incrementally to the
stream represented by [output]. Any exception that [output]
raises is considered as a write error.
@param w width of the surface, in points (1 point = 1/72.0 inch)
@param h height of the surface, in points (1 point = 1/72.0 inch) *)
val set_size : Surface.t -> w:float -> h:float -> unit
(** Changes the size of a PDF surface for the current (and
subsequent) pages.
@param w width of the surface, in points (1 point = 1/72.0 inch)
@param h height of the surface, in points (1 point = 1/72.0 inch)
This function should only be called before any drawing operations
have been performed on the current page. The simplest way to do
this is to call this function immediately after creating the
surface or immediately after completing a page with either
{!Cairo.show_page} or {!Cairo.copy_page}. *)
end
(** The PNG functions allow reading PNG images into image surfaces,
and writing any surface to a PNG file.
To create a new PNG file, start by creating an image surface,
providing its [format] (see {!Image.format}) and dimensions
[w]×[h] with [let surface = Cairo.Image.create format w h]. From
this you can create a Cairo context to do your drawing: [let cr =
Cairo.create surface]. Then, when you are done, call
[Cairo.PNG.write surface fname] to write the surface to the PNG
file [fname]. *)
module PNG :
sig
val create : string -> Surface.t
(** [create filename] creates a new image surface and initializes
the contents to the given PNG file. *)
val create_from_stream : input:(string -> int -> unit) -> Surface.t
(** Creates a new image surface from PNG data read incrementally via
the [input] function. The [input s l] function receives a string
[s] whose first [l] bytes must be filled with PNG data. Any
exception raised by [input] is considered as a read error. *)
val write : Surface.t -> string -> unit
(** [write surface filename] writes the contents of [surface] to a
new file [filename] as a PNG image. *)
val write_to_stream : Surface.t -> (string -> unit) -> unit
(** Writes the image surface using the [output] function. *)
end
(** The PostScript surface is used to render cairo graphics to Adobe
PostScript files and is a multi-page vector surface backend.
To create a cairo context [cr] that will write the the PS file
[fname] with dimensions [w]×[h] points, do [let cr =
Cairo.create(Cairo.PS.create fname w h)]. Do not forget to call
[Surface.finish(get_target cr)] when you are done drawing because
the file may not be fully written before. *)
module PS :
sig
val create : string -> w:float -> h:float -> Surface.t
(** [create fname w h] creates a PostScript surface of the specified
size in points to be written to [fname].
@param w width of the surface, in points (1 point = 1/72 inch)
@param h height of the surface, in points (1 point = 1/72 inch) *)
val create_for_stream : (string -> unit) -> w:float -> h:float -> Surface.t
(** [create_for_stream output w h] creates a PostScript surface of
the specified size in points to be written incrementally to the
stream represented by [output]. Any exception that [output]
raises is considered as a write error.
@param w width of the surface, in points (1 point = 1/72 inch)
@param h height of the surface, in points (1 point = 1/72 inch) *)
(** Describe the language level of the PostScript Language Reference
that a generated PostScript file will conform to. *)
type level = LEVEL_2 | LEVEL_3
val restrict_to_level : Surface.t -> level -> unit
(** [restrict_to_level level] restricts the generated PostSript file
to [level]. See {!Cairo.PS.get_levels} for a list of available
level values that can be used here.
This function should only be called before any drawing
operations have been performed on the given surface. The simplest
way to do this is to call this function immediately after
creating the surface. *)
val get_levels : unit -> level list
(** Retrieves the list of supported levels. *)
val level_to_string : level -> string
(** [level_to_string level] return the string representation of the
given [level] id. *)
val set_eps : Surface.t -> eps:bool -> unit
(** If [eps] is [true], the PostScript surface will output
Encapsulated PostScript.
This function should only be called before any drawing
operations have been performed on the current page. The simplest
way to do this is to call this function immediately after
creating the surface. An Encapsulated PostScript file should
never contain more than one page. *)
val get_eps : Surface.t -> bool
(** Check whether the PostScript surface will output Encapsulated
PostScript. *)
val set_size : Surface.t -> w:float -> h:float -> unit
(** Changes the size of a PostScript surface for the current (and
subsequent) pages.
This function should only be called before any drawing
operations have been performed on the current page. The simplest
way to do this is to call this function immediately after
creating the surface or immediately after completing a page with
either {!Cairo.show_page} or {!Cairo.copy_page}. *)
(** PostScript comments. *)
module Dsc :
sig
val begin_setup : Surface.t -> unit
(** This function indicates that subsequent calls to
{!Cairo.PS.Dsc.comment} should direct comments to the Setup
section of the PostScript output.
This function should be called at most once per surface, and
must be called before any call to
{!Cairo.PS.Dsc.begin_page_setup} and before any drawing is
performed to the surface.
See {!Cairo.PS.Dsc.comment} for more details. *)
val begin_page_setup : Surface.t -> unit
(** This function indicates that subsequent calls to
{!Cairo.PS.Dsc.comment} should direct comments to the PageSetup
section of the PostScript output.
This function call is only needed for the first page of a
surface. It should be called after any call to
{!Cairo.PS.Dsc.begin_setup} and before any drawing is performed
to the surface.
See {!Cairo.PS.Dsc.comment} for more details. *)
val comment : Surface.t -> string -> unit
(** Emit a comment into the PostScript output for the given surface.
The comment is expected to conform to the PostScript Language
Document Structuring Conventions (DSC). Please see that manual
for details on the available comments and their meanings. In
particular, the [%IncludeFeature] comment allows a
device-independent means of controlling printer device
features. So the PostScript Printer Description Files
Specification will also be a useful reference.
The comment string must begin with a percent character (%) and
the total length of the string (including any initial percent
characters) must not exceed 255 characters. Violating either
of these conditions will raise en exception. But beyond these
two conditions, this function will not enforce conformance of
the comment with any particular specification.
The comment string should not have a trailing newline.
The DSC specifies different sections in which particular
comments can appear. This function provides for comments to be
emitted within three sections: the header, the Setup section,
and the PageSetup section. Comments appearing in the first two
sections apply to the entire document while comments in the
BeginPageSetup section apply only to a single page.
For comments to appear in the header section, this function
should be called after the surface is created, but before a
call to {!Cairo.PS.Dsc.begin_setup}.
For comments to appear in the Setup section, this function
should be called after a call to {!Cairo.PS.Dsc.begin_setup}
but before a call to {!Cairo.PS.Dsc.begin_page_setup}.
For comments to appear in the PageSetup section, this function
should be called after a call to {!Cairo.PS.Dsc.begin_page_setup}.
Note that it is only necessary to call
{!Cairo.PS.Dsc.begin_page_setup} for the first page of any
surface. After a call to {!Cairo.show_page} or
{!Cairo.copy_page} comments are unambiguously directed to the
PageSetup section of the current page. But it doesn't hurt to
call this function at the beginning of every page as that
consistency may make the calling code simpler.
As a final note, cairo automatically generates several comments
on its own. As such, applications must not manually generate
any of the following comments:
- Header section: %!PS-Adobe-3.0, %Creator, %CreationDate, %Pages,
%BoundingBox, %DocumentData, %LanguageLevel, %EndComments.
- Setup section: %BeginSetup, %EndSetup
- PageSetup section: %BeginPageSetup, %PageBoundingBox,
%EndPageSetup.
- Other sections: %BeginProlog, %EndProlog, %Page, %Trailer, %EOF
Here is an example sequence showing how this function might
be used:
{[
let surface = Cairo.PS.create filename width height in
...
Cairo.PS.Dsc.comment surface "%%Title: My excellent document";
Cairo.PS.Dsc.comment surface
"%%Copyright: Copyright (C) 2006 Cairo Lover";
...
Cairo.PS.Dsc.begin_setup surface;
Cairo.PS.Dsc.comment surface "%%IncludeFeature: *MediaColor White";
...
Cairo.PS.Dsc.begin_page_setup surface;
Cairo.PS.Dsc.comment surface "%%IncludeFeature: *PageSize A3";
Cairo.PS.Dsc.comment surface
"%%IncludeFeature: *InputSlot LargeCapacity";
Cairo.PS.Dsc.comment surface "%%IncludeFeature: *MediaType Glossy";
Cairo.PS.Dsc.comment surface "%%IncludeFeature: *MediaColor Blue";
... (* draw to first page here *) ...
Cairo.show_page cr;
...
Cairo.PS.Dsc.comment surface "%%IncludeFeature: *PageSize A5";
...
]}
*)
end
end
(** The SVG surface is used to render cairo graphics to SVG files and
is a multi-page vector surface backend.
To create a cairo context [cr] that will write the the SVG file
[fname] with dimensions [w]×[h] points, do [let cr =
Cairo.create(Cairo.SVG.create fname w h)]. Do not forget to call
[Surface.finish(get_target cr)] when you are done drawing because
the file may not be fully written before. *)
module SVG :
sig
val create : string -> w:float -> h:float -> Surface.t
(** [create fname w h] creates a SVG surface of the specified size
in points to be written to [fname].
@param w width of the surface, in points (1 point = 1/72 inch)
@param h height of the surface, in points (1 point = 1/72 inch) *)
val create_for_stream : (string -> unit) ->
w:float -> h:float -> Surface.t
(** [create_for_stream output w h] Creates a SVG surface of
the specified size in points to be written incrementally to the
stream represented by [output]. Any exception that [output]
raises is considered as a write error.
@param w width of the surface, in points (1 point = 1/72 inch)
@param h height of the surface, in points (1 point = 1/72 inch) *)
(** The version number of the SVG specification that a generated SVG
file will conform to. *)
type version = VERSION_1_1 | VERSION_1_2
val restrict_to_version : Surface.t -> version -> unit
(** Restricts the generated SVG file to version. See
{!Cairo.SVG.get_versions} for a list of available version values
that can be used here.
This function should only be called before any drawing
operations have been performed on the given surface. The simplest
way to do this is to call this function immediately after
creating the surface. *)
val get_versions : unit -> version list
(** Retrieve the list of supported versions. *)
val version_to_string : version -> string
(** Get the string representation of the given version id. *)
end
(** The recording surface is a surface that records all drawing operations at
the highest level of the surface backend interface. The surface can then
be "replayed" against any target surface by using it as a source
surface.
A recording surface is logically unbounded, i.e. it has no
implicit constraint on the size of the drawing surface. *)
module Recording :
sig
val create : ?extents:rectangle -> content -> Surface.t
(** Creates a recording surface with the specified [content]. It
can record all drawing operations at the highest level (that is,
the level of {!paint}, {!mask}, {!stroke}, {!fill} and
{!Glyph.show_text}). The surface is unbounded (no constraints
on the size of the drawing surface) unless the [extents]
argument is provided. Copying to another surface (see
{!set_source_surface}) will be more efficient (and sometime
required) if the extents are specified when the recording
surface is created. *)
val ink_extents : Surface.t -> rectangle
(** Measures the extents of the operations stored within the recording
surface. This is useful to compute the required size of another
drawing surface into which to replay the full sequence of drawing
operations. *)
end
(* ---------------------------------------------------------------------- *)
(** {2 Sources for drawing} *)
(** Paint (and also mask and brush) with which cairo draws and
associated function. *)
module Pattern :
sig
type 'a t constraint 'a = [<`Solid | `Surface | `Gradient | `Linear | `Radial]
(** This is the paint with which cairo draws. The primary use of
patterns is as the source for all cairo drawing operations,
although they can also be used as masks, that is, as the brush
too.
A cairo pattern is created by using one of the many functions,
of the form [Cairo.Pattern.create_type] or implicitly through
[Cairo.set_source_*] functions. *)
type any = [`Solid | `Surface | `Gradient | `Linear | `Radial] t
(** {!Cairo.Group.pop} and {!Cairo.get_source} retrieve patterns
whose properties we do not know. In this case, we can only
assume the pattern has potentially all properties and the
functions below may raise an exception if it turns out that the
needed property is not present. *)
val add_color_stop_rgb : [> `Gradient] t -> ?ofs:float ->
float -> float -> float -> unit
(** Adds an opaque color stop to a gradient pattern. The offset
[ofs] specifies the location along the gradient's control vector
(default: [0.0]). For example, a linear gradient's control
vector is from (x0,y0) to (x1,y1) while a radial gradient's
control vector is from any point on the start circle to the
corresponding point on the end circle.
The color is specified in the same way as in {!Cairo.set_source_rgb}.
If two (or more) stops are specified with identical offset
values, they will be sorted according to the order in which the
stops are added (stops added earlier will compare less than stops
added later). This can be useful for reliably making sharp color
transitions instead of the typical blend. *)
val add_color_stop_rgba : [> `Gradient] t -> ?ofs:float ->
float -> float -> float -> float -> unit
(** Adds a translucent color stop to a gradient pattern. The offset
specifies the location along the gradient's control vector. For
example, a linear gradient's control vector is from (x0,y0) to
(x1,y1) while a radial gradient's control vector is from any
point on the start circle to the corresponding point on the end
circle.
The color is specified in the same way as in {!Cairo.set_source_rgba}.
If two (or more) stops are specified with identical offset
values, they will be sorted according to the order in which the
stops are added (stops added earlier will compare less than stops
added later). This can be useful for reliably making sharp color
transitions instead of the typical blend. *)
val get_color_stop_count : [> `Gradient] t -> int
(** Return the number of color stops specified in the given gradient
pattern. *)
val get_color_stop_rgba : [> `Gradient] t -> idx:int ->
float * float * float * float * float
(** Gets the color and offset information at the given index for a
gradient pattern. Values of index are 0 to 1 less than the number
returned by {!Cairo.Pattern.get_color_stop_count}.
@return (offset, red, green, blue, alpha) *)
val create_rgb : float -> float -> float -> [`Solid] t
(** [create_rgb r g b] creates a new {!Cairo.Pattern.t}
corresponding to an opaque color. The color components are
floating point numbers in the range 0 to 1. If the values passed
in are outside that range, they will be clamped. *)
val create_rgba : float -> float -> float -> float -> [`Solid] t
(** [create_rgba r g b a] creates a new {!Cairo.Pattern.t}
corresponding to a translucent color. The color components are
floating point numbers in the range 0 to 1. If the values passed
in are outside that range, they will be clamped. *)
val get_rgba : [> `Solid] t -> float * float * float * float
(** Return the solid color for a solid color pattern.
@return (red, green, blue, alpha) *)
val create_for_surface : Surface.t -> [`Surface] t
(** Create a new {!Cairo.Pattern.t} for the given surface. *)
val get_surface : [`Surface] t -> Surface.t
(** Gets the surface of a surface pattern. *)
val create_linear : x0:float -> y0:float -> x1:float -> y1:float ->
[`Linear | `Gradient] t
(** Create a new linear gradient {!Cairo.Pattern.t} along the line
defined by (x0, y0) and (x1, y1). Before using the gradient
pattern, a number of color stops should be defined using
{!Cairo.Pattern.add_color_stop_rgb} or
{!Cairo.Pattern.add_color_stop_rgba}.
Note: The coordinates here are in pattern space. For a new
pattern, pattern space is identical to user space, but the
relationship between the spaces can be changed with
{!Cairo.Pattern.set_matrix}. *)
val get_linear_points : [> `Linear|`Gradient] t
-> float * float * float * float
(** Gets the gradient endpoints for a linear gradient.
@return (x0, y0, x1, y1). *)
val create_radial :
x0:float -> y0:float -> r0:float ->
x1:float -> y1:float -> r1:float -> [`Radial | `Gradient] t
(** Creates a new radial gradient {!Cairo.Pattern.t} between the two
circles defined by (cx0, cy0, radius0) and (cx1, cy1,
radius1). Before using the gradient pattern, a number of color
stops should be defined using {!Cairo.Pattern.add_color_stop_rgb}
or {!Cairo.Pattern.add_color_stop_rgba}.
Note: The coordinates here are in pattern space. For a new
pattern, pattern space is identical to user space, but the
relationship between the spaces can be changed with
{!Cairo.Pattern.set_matrix}. *)
val get_radial_circles : [> `Radial|`Gradient] t ->
float * float * float * float * float * float
(** Gets the gradient endpoint circles for a radial gradient,
each specified as a center coordinate and a radius.
@return (x0, y0, r0, x1, y1, r1). *)
(** This is used to describe how pattern color/alpha will be
determined for areas "outside" the pattern's natural area (for
example, outside the surface bounds or outside the gradient
geometry). *)
type extend =
| NONE (** pixels outside of the source pattern are fully transparent. *)
| REPEAT (** the pattern is tiled by repeating. *)
| REFLECT (** the pattern is tiled by reflecting at the edges. *)
| PAD (** pixels outside of the pattern copy the closest pixel
from the source. *)
val set_extend : 'a t -> extend -> unit
(** Sets the mode to be used for drawing outside the area of a
pattern. See {!Cairo.Pattern.extend} for details on the
semantics of each extend strategy.
The default extend mode is [NONE] for surface patterns and [PAD]
for gradient patterns. *)
val get_extend : 'a t -> extend
(** Gets the current extend mode for a pattern. See
{!Cairo.Pattern.extend} for details on the semantics of each
extend strategy. *)
(** This is used to indicate what filtering should be applied when
reading pixel values from patterns. See
{!Cairo.Pattern.set_filter} for indicating the desired filter to
be used with a particular pattern. *)
type filter =
| FAST (** A high-performance filter, with quality similar to NEAREST *)
| GOOD (** A reasonable-performance filter, with quality similar
to BILINEAR *)
| BEST (** The highest-quality available, performance may not be
suitable for interactive use. *)
| NEAREST (** Nearest-neighbor filtering *)
| BILINEAR (** Linear interpolation in two dimensions *)
(* | GAUSSIAN *)
val set_filter : 'a t -> filter -> unit
(** Sets the filter to be used for resizing when using this
pattern. See {!Cairo.Pattern.filter} for details on each
filter.
Note that you might want to control filtering even when you do
not have an explicit {!Cairo.Pattern.t} value (for example
when using {!Cairo.set_source_surface}). In these cases, it
is convenient to use {!Cairo.get_source} to get access to the
pattern that cairo creates implicitly. For example:
{[
Cairo.set_source_surface cr image x y;
Cairo.Pattern.set_filter (Cairo.get_source cr) Cairo.Pattern.NEAREST;
]} *)
val get_filter : 'a t -> filter
(** Gets the current filter for a pattern. See
{!Cairo.Pattern.filter} for details on each filter. *)
val set_matrix : 'a t -> Matrix.t -> unit
(** Sets the pattern's transformation matrix to matrix. This
matrix is a transformation from user space to pattern space.
When a pattern is first created it always has the identity
matrix for its transformation matrix, which means that pattern
space is initially identical to user space.
Important: Please note that the direction of this
transformation matrix is from user space to pattern
space. This means that if you imagine the flow from a pattern
to user space (and on to device space), then coordinates in
that flow will be transformed by the inverse of the pattern
matrix.
For example, if you want to make a pattern appear twice as
large as it does by default the correct code to use is:
{[
let matrix = Cairo.Matrix.init_scale 0.5 0.5 in
Cairo.Pattern.set_matrix pattern matrix;
]} *)
val get_matrix : 'a t -> Matrix.t
(** Returns the pattern's transformation matrix. *)
(* FIXME: is get_type needed ? *)
end
(* ---------------------------------------------------------------------- *)
(** {2:cairo_t The cairo drawing context functions} *)
val create : Surface.t -> context
(** [create target] creates a new context with all graphics state
parameters set to default values and with [target] as a target
surface. The target surface should be constructed with a
backend-specific function such as {!Cairo.Image.create} (or any
other {i Backend}[.create] variant). For many backends, you should
not forget to call {!Cairo.Surface.finish} for the data to be
completely outputted.
@raise Out_of_memory if the context could not be allocated. *)
val save : context -> unit
(** [save cr] makes a copy of the current state of [cr] and saves it
on an internal stack of saved states for [cr]. When [restore] is
called, [cr] will be restored to the saved state. Multiple calls
to [save] and [restore] can be nested; each call to [restore]
restores the state from the matching paired [save]. *)
val restore : context -> unit
(** [restore cr] restores [cr] to the state saved by a preceding call
to [save] and removes that state from the stack of saved states. *)
val get_target : context -> Surface.t
(** Gets the target surface for the cairo context as passed to [create]. *)
(** Temporary redirection of drawing commands to intermediate surfaces. *)
module Group :
sig
val push : ?content:content -> context -> unit
(** Temporarily redirects drawing to an intermediate surface known
as a group. The redirection lasts until the group is completed
by a call to {!Cairo.Group.pop} or {!Cairo.Group.pop_to_source}.
These calls provide the result of any drawing to the group as a
pattern (either as an explicit object, or set as the source
pattern).
This group functionality can be convenient for performing
intermediate compositing. One common use of a group is to render
objects as opaque within the group (so that they occlude each
other) and then blend the result with translucence onto the
destination.
Groups can be nested arbitrarily deep by making balanced calls to
[Group.push]/[Group.pop]. Each call pushes/pops the new target
group onto/from a stack.
The [Group.push] function calls [save] so that any changes to the
graphics state will not be visible outside the group, (the
[Group.pop] function call [restore]).
@param content The content type of the group. By default the
intermediate group will have a content type of [COLOR_ALPHA] (see
{!Cairo.content}). *)
val pop : context -> Pattern.any
(** Terminates the redirection begun by a call to
{!Cairo.Group.push} and returns a new pattern containing the
results of all drawing operations performed to the group.
The [Group.pop] function calls {!Cairo.restore} (balancing a call
to {!Cairo.save} by the [Group.push] function), so that any
changes to the graphics state will not be visible outside the
group.
@return a newly created (surface) pattern containing the results
of all drawing operations performed to the group. *)
val pop_to_source : context -> unit
(** Terminates the redirection begun by a call to [Group.push] and
installs the resulting pattern as the source pattern in the
given cairo context.
The behavior of this function is equivalent to the sequence of
operations:
{[
let group = Cairo.Group.pop cr in
Cairo.set_source cr group;
]} *)
val get_target : context -> Surface.t
(** Gets the current destination surface for the context. This is
either the original target surface as passed to [create] or the
target surface for the current group as started by the most
recent call to [Group.push]. *)
end
val set_source_rgb : context -> float -> float -> float -> unit
(** [set_source_rgb cr r g b] sets the source pattern within [cr] to
an opaque color. This opaque color will then be used for any
subsequent drawing operation until a new source pattern is set.
The color components are floating point numbers in the range 0
to 1. If the values passed in are outside that range, they will be
clamped.
The default source pattern is opaque black (that is, it is
equivalent to [set_source_rgb cr 0. 0. 0.]). *)
val set_source_rgba : context -> float -> float -> float -> float -> unit
(** [set_source_rgba cr r g b a] sets the source pattern within [cr]
to a translucent color. This color will then be used for any
subsequent drawing operation until a new source pattern is set.
The color and alpha components are floating point numbers in the
range 0 to 1. If the values passed in are outside that range, they
will be clamped.
The default source pattern is opaque black (that is, it is
equivalent to [set_source_rgba cr 0. 0. 0. 1.0]). *)
val set_source : context -> 'a Pattern.t -> unit
(** [set_source cr source] sets the source pattern within [cr] to
[source]. This pattern will then be used for any subsequent
drawing operation until a new source pattern is set.
Note: The pattern's transformation matrix will be locked to the
user space in effect at the time of [set_source]. This means that
further modifications of the current transformation matrix will not
affect the source pattern. See {!Pattern.set_matrix}.
The default source pattern is a solid pattern that is opaque black
(that is, it is equivalent to [set_source_rgb cr 0. 0. 0.]). *)
val set_source_surface : context -> Surface.t -> x:float -> y:float -> unit
(** [set_source_surface cr surface x y] is a convenience for creating
a pattern from surface and setting it as the source in [cr] with
[set_source].
The [x] and [y] parameters give the user-space coordinate at which
the surface origin should appear. (The surface origin is its
upper-left corner before any transformation has been applied.) The
x and y patterns are negated and then set as translation values in
the pattern matrix.
Other than the initial translation pattern matrix, as described
above, all other pattern attributes (such as its extend mode) are
set to the default values as in {!Pattern.create_for_surface}. The
resulting pattern can be queried with {!Cairo.get_source} so that
these attributes can be modified if desired (e.g. to create a
repeating pattern with {!Cairo.Pattern.set_extend}). *)
val get_source : context -> Pattern.any
(** [get_source cr] gets the current source pattern for [cr]. *)
val set_antialias : context -> antialias -> unit
(** Set the antialiasing mode of the rasterizer used for drawing
shapes. This value is a hint, and a particular backend may or may
not support a particular value. At the current time, no backend
supports [ANTIALIAS_SUBPIXEL] when drawing shapes.
Note that this option does not affect text rendering, instead see
{!Cairo.Font_options.set_antialias}. *)
val get_antialias : context -> antialias
(** Gets the current shape antialiasing mode, as set by
{!Cairo.set_antialias}. *)
val set_dash : context -> ?ofs:float -> float array -> unit
(** [set_dash cr dashes] sets the dash pattern to be used by
{!Cairo.stroke}. A dash pattern is specified by dashes, an array
of positive values. Each value provides the length of alternate
"on" and "off" portions of the stroke. The offset [ofs] specifies
an offset into the pattern at which the stroke begins (default: [0.]).
[set_dash [| |]] disable dashing. [set_dash [|l|]] sets a
symmetric pattern with alternating on and off portions of the size [l].
Each "on" segment will have caps applied as if the segment were a
separate sub-path. In particular, it is valid to use an "on" length
of 0.0 with {!Cairo.line_cap} being [ROUND] or [SQUARE] in order to
distributed dots or squares along a path.
Note: The length values are in user-space units as evaluated at the
time of stroking. This is not necessarily the same as the user
space at the time of [set_dash]. *)
val get_dash : context -> float array * float
(** Gets the current dash array ([( [| |], 0.)] if dashing is not
currently in effect). *)
(** Used to select how paths are filled. For both fill rules, whether
or not a point is included in the fill is determined by taking a
ray from that point to infinity and looking at intersections with
the path. The ray can be in any direction, as long as it doesn't
pass through the end point of a segment or have a tricky
intersection such as intersecting tangent to the path. (Note that
filling is not actually implemented in this way. This is just a
description of the rule that is applied.)
The default fill rule is [WINDING]. *)
type fill_rule =
| WINDING (** If the path crosses the ray from left-to-right,
counts +1. If the path crosses the ray from right to
left, counts -1. (Left and right are determined from
the perspective of looking along the ray from the
starting point.) If the total count is non-zero, the
point will be filled. *)
| EVEN_ODD (** Counts the total number of intersections, without
regard to the orientation of the contour. If the
total number of intersections is odd, the point will
be filled. *)
val set_fill_rule : context -> fill_rule -> unit
(** [set_fill_rule cr fill_rule] sets the current fill rule within the
cairo context [cr]. The fill rule is used to determine which
regions are inside or outside a complex (potentially
self-intersecting) path. The current fill rule affects both
{!Cairo.fill} and {!Cairo.clip}. See {!Cairo.fill_rule} for
details on the semantics of each available fill rule. *)
val get_fill_rule : context -> fill_rule
(** Gets the current fill rule, as set by [set_fill_rule]. *)
(** Specifies how to render the endpoints of the path when stroking.
The default line cap style is [BUTT]. *)
type line_cap =
| BUTT (** start(stop) the line exactly at the start(end) point *)
| ROUND (** use a round ending, the center of the circle is the end point *)
| SQUARE (** use squared ending, the center of the square is the end point *)
val set_line_cap : context -> line_cap -> unit
(** [set_line_cap cr line_cap] sets the current line cap style within
the cairo context [cr]. See {!Cairo.line_cap} for details about
how the available line cap styles are drawn.
As with the other stroke parameters, the current line cap style is
examined by {!Cairo.stroke}, {!Cairo.stroke_extents}, and
{!Cairo.stroke_to_path}, but does not have any effect during path
construction.
The default line cap style is [BUTT]. *)
val get_line_cap : context -> line_cap
(** Gets the current line cap style, as set by {!Cairo.set_line_cap}. *)
(** Specifies how to render the junction of two lines when stroking.
The default line join style is [MITER]. *)
type line_join =
| JOIN_MITER (** use a sharp (angled) corner, see {!Cairo.set_miter_limit} *)
| JOIN_ROUND (** use a rounded join, the center of the circle is the
joint point *)
| JOIN_BEVEL (** use a cut-off join, the join is cut off at half the line
width from the joint point *)
val set_line_join : context -> line_join -> unit
(** Sets the current line join style within the cairo context. See
{!Cairo.line_join} for details about how the available line join
styles are drawn.
As with the other stroke parameters, the current line join style is
examined by {!Cairo.stroke}, {!Cairo.stroke_extents}, and
{!Cairo.stroke_to_path}, but does not have any effect during path
construction.
The default line join style is [MITER]. *)
val get_line_join : context -> line_join
(** Gets the current line join style, as set by {!Cairo.set_line_join}. *)
val set_line_width : context -> float -> unit
(** Sets the current line width within the cairo context. The line
width value specifies the diameter of a pen that is circular in
user space (though device-space pen may be an ellipse in general
due to scaling/shear/rotation of the CTM).
Note: When the description above refers to user space and CTM it
refers to the user space and CTM in effect at the time of the
stroking operation, not the user space and CTM in effect at the
time of the call to [set_line_width]. The simplest usage makes
both of these spaces identical. That is, if there is no change to
the CTM between a call to [set_line_with] and the stroking
operation, then one can just pass user-space values to
[set_line_width] and ignore this note.
As with the other stroke parameters, the current line width is
examined by {!Cairo.stroke}, {!Cairo.stroke_extents}, and
{!Cairo.stroke_to_path}, but does not have any effect during path
construction.
The default line width value is [2.0]. *)
val get_line_width : context -> float
(** This function returns the current line width value exactly as set
by {!Cairo.set_line_width}. Note that the value is unchanged even
if the CTM has changed between the calls to [set_line_width] and
[get_line_width]. *)
val set_miter_limit : context -> float -> unit
(** Sets the current miter limit within the cairo context.
If the current line join style is set to [MITER] (see
{!Cairo.set_line_join}), the miter limit is used to determine
whether the lines should be joined with a bevel instead of a miter.
Cairo divides the length of the miter by the line width. If the
result is greater than the miter limit, the style is converted to a
bevel.
As with the other stroke parameters, the current line miter limit
is examined by {!Cairo.stroke}, {!Cairo.stroke_extents}, and
{!Cairo.stroke_to_path}, but does not have any effect during path
construction.
The default miter limit value is [10.0], which will convert joins
with interior angles less than 11 degrees to bevels instead of
miters. For reference, a miter limit of 2.0 makes the miter cutoff
at 60 degrees, and a miter limit of 1.414 makes the cutoff at 90
degrees.
A miter limit for a desired angle can be computed as: miter limit =
1/sin(angle/2). *)
val get_miter_limit : context -> float
(** Gets the current miter limit, as set by {!Cairo.set_miter_limit}. *)
(** {3 Drawing operations} *)
(** Compositing operator for all cairo drawing operations.
The default operator is [Cairo.Operator.OVER].
The operators marked as unbounded modify their destination even
outside of the mask layer (that is, their effect is not bound by the
mask layer). However, their effect can still be limited by way of
clipping.
To keep things simple, the operator descriptions here document
the behavior for when both source and destination are either
fully transparent or fully opaque. The actual implementation
works for translucent layers too. For a more detailed
explanation of the effects of each operator, including the
mathematical definitions, see http://cairographics.org/operators/ *)
type operator =
| CLEAR (** clear destination layer (bounded) *)
| SOURCE (** replace destination layer (bounded) *)
| OVER (** draw source layer on top of destination layer (bounded) *)
| IN (** draw source where there was destination content (unbounded) *)
| OUT (** draw source where there was no destination content (unbounded) *)
| ATOP (** draw source on top of destination content and only there *)
| DEST (** ignore the source *)
| DEST_OVER (** draw destination on top of source *)
| DEST_IN (** leave destination only where there was source content
(unbounded) *)
| DEST_OUT (** leave destination only where there was no source content *)
| DEST_ATOP (** leave destination on top of source content and
only there (unbounded) *)
| XOR (** source and destination are shown where there is only one
of them *)
| ADD (** source and destination layers are accumulated *)
| SATURATE (** like over, but assuming source and dest are
disjoint geometries *)
val set_operator : context -> operator -> unit
(** Sets the compositing operator to be used for all drawing
operations. See {!Cairo.operator} for details on the semantics of
each available compositing operator.
The default operator is [OVER]. *)
val get_operator : context -> operator
(** Gets the current compositing operator for a cairo context. *)
val set_tolerance : context -> float -> unit
(** Sets the tolerance used when converting paths into trapezoids.
Curved segments of the path will be subdivided until the maximum
deviation between the original path and the polygonal approximation
is less than tolerance. The default value is [0.1]. A larger
value will give better performance, a smaller value, better
appearance. (Reducing the value from the default value of [0.1] is
unlikely to improve appearance significantly.) *)
val get_tolerance : context -> float
(** Gets the current tolerance value, as set by {!Cairo.set_tolerance}. *)
val clip : context -> unit
(** Establishes a new clip region by intersecting the current clip
region with the current path as it would be filled by {!Cairo.fill}
and according to the current fill rule (see
{!Cairo.set_fill_rule}).
After [clip], the current path will be cleared from the cairo
context.
Calling {!Cairo.clip} can only make the clip region smaller,
never larger. But the current clip is part of the graphics state,
so a temporary restriction of the clip region can be achieved by
calling {!Cairo.clip} within a {!Cairo.save} / {!Cairo.restore}
pair. The only other means of increasing the size of the clip
region is {!Cairo.clip_reset}. *)
val clip_preserve : context -> unit
(** Establishes a new clip region by intersecting the current clip
region with the current path as it would be filled by {!Cairo.fill}
and according to the current fill rule (see
{!Cairo.set_fill_rule}).
Unlike {!Cairo.clip}, preserves the path within the cairo context.
Calling {!Cairo.clip_preserve} can only make the clip region
smaller, never larger. But the current clip is part of the
graphics state, so a temporary restriction of the clip region can
be achieved by calling {!Cairo.clip_preserve} within a
{!Cairo.save} / {!Cairo.restore} pair. The only other means of
increasing the size of the clip region is {!Cairo.clip_reset}. *)
val clip_extents : context -> rectangle
(** Computes a bounding box in user coordinates covering the area
inside the current clip. *)
val clip_reset : context -> unit
(** Reset the current clip region to its original, unrestricted state.
That is, set the clip region to an infinitely large shape
containing the target surface. Equivalently, if infinity is too
hard to grasp, one can imagine the clip region being reset to the
exact bounds of the target surface.
Note that code meant to be reusable should not call [clip_reset] as
it will cause results unexpected by higher-level code which calls
{!Cairo.clip}. Consider using {!Cairo.save} and {!Cairo.restore}
around {!Cairo.clip} as a more robust means of temporarily
restricting the clip region.
(This function binds Cairo [cairo_reset_clip].) *)
val clip_rectangle_list : context -> rectangle list
(** Gets the current clip region as a list of rectangles in user
coordinates.
Raises [Error(CLIP_NOT_REPRESENTABLE)] to indicate that the clip
region cannot be represented as a list of user-space rectangles. *)
val fill : context -> unit
(** A drawing operator that fills the current path according to the
current fill rule (each sub-path is implicitly closed before being
filled). After [fill], the current path will be cleared from the
cairo context.
See also {!Cairo.set_fill_rule}. *)
val fill_preserve : context -> unit
(** A drawing operator that fills the current path according to the
current fill rule (each sub-path is implicitly closed before being
filled). Unlike {!Cairo.fill}, [fill_preserve] preserves the path
within the cairo context.
See also {!Cairo.set_fill_rule}. *)
val fill_extents : context -> rectangle
(** Computes a bounding box in user coordinates covering the area that
would be affected (the "inked" area) by a [fill] operation given
the current path and fill parameters. If the current path is
empty, returns an empty rectangle [{ x=0.; y=0.; w=0.; h=0. }].
Surface dimensions and clipping are not taken into account.
Contrast with {!Cairo.Path.extents}, which is similar, but returns
non-zero extents for some paths with no inked area, (such as a
simple line segment).
Note that [fill_extents] must necessarily do more work to compute
the precise inked areas in light of the fill rule, so
{!Cairo.Path.extents} may be more desirable for sake of performance
if the non-inked path extents are desired.
See {!Cairo.fill} and {!Cairo.set_fill_rule}. *)
val in_fill : context -> float -> float -> bool
(** Tests whether the given point is inside the area that would be
affected by a [fill] operation given the current path and filling
parameters. Surface dimensions and clipping are not taken into account.
See also {!Cairo.fill} and {!Cairo.set_fill_rule}. *)
val mask : context -> 'a Pattern.t -> unit
(** [mask cr pattern]: a drawing operator that paints the current
source using the alpha channel of [pattern] as a mask. (Opaque
areas of [pattern] are painted with the source, transparent areas
are not painted.) *)
val mask_surface : context -> Surface.t -> x:float -> y:float -> unit
(** [mask_surface cr surface x y]: a drawing operator that paints
the current source using the alpha channel of [surface] as a
mask. (Opaque areas of [surface] are painted with the source,
transparent areas are not painted.)
@param x X coordinate at which to place the origin of [surface].
@param y Y coordinate at which to place the origin of [surface]. *)
val paint : ?alpha:float -> context -> unit
(** A drawing operator that paints the current source everywhere
within the current clip region. If [alpha] is set, the drawing is
faded out using the alpha value.
@param alpha alpha value, between 0 (transparent) and 1 (opaque). *)
val stroke : context -> unit
(** A drawing operator that strokes the current path according to the
current line width, line join, line cap, and dash settings. After
[stroke], the current path will be cleared from the cairo context.
See {!Cairo.set_line_width}, {!Cairo.set_line_join},
{!Cairo.set_line_cap}, and {!Cairo.set_dash}.
Note: Degenerate segments and sub-paths are treated specially and
provide a useful result. These can result in two different
situations:
1. Zero-length "on" segments set in {!Cairo.set_dash}. If the cap
style is [ROUND] or [SQUARE] then these segments will be drawn as
circular dots or squares respectively. In the case of [SQUARE],
the orientation of the squares is determined by the direction of
the underlying path.
2. A sub-path created by {!Cairo.move_to} followed by either a
{!Cairo.Path.close} or one or more calls to {!Cairo.line_to} to the
same coordinate as the {!Cairo.move_to}. If the cap style is
[ROUND] then these sub-paths will be drawn as circular dots. Note
that in the case of [SQUARE] line cap, a degenerate sub-path will
not be drawn at all (since the correct orientation is
indeterminate).
In no case will a cap style of [BUTT] cause anything to be drawn in
the case of either degenerate segments or sub-paths. *)
val stroke_preserve : context -> unit
(** Like {!Cairo.stroke} except that it preserves the path within the
cairo context. *)
val stroke_extents : context -> rectangle
(** Computes a bounding box in user coordinates covering the area that
would be affected (the "inked" area) by a {!Cairo.stroke} operation
operation given the current path and stroke parameters. If the
current path is empty, returns an empty rectangle [{ x=0.; y=0.;
w=0.; h=0. }]. Surface dimensions and clipping are not taken into
account.
Note that if the line width is set to exactly zero, then
[stroke_extents] will return an empty rectangle. Contrast with
{!Cairo.Path.extents} which can be used to compute the non-empty
bounds as the line width approaches zero.
Note that [stroke_extents] must necessarily do more work to compute
the precise inked areas in light of the stroke parameters, so
{!Cairo.Path.extents} may be more desirable for sake of performance
if non-inked path extents are desired.
See {!Cairo.stroke}, {!Cairo.set_line_width}, {!Cairo.set_line_join},
{!Cairo.set_line_cap}, and {!Cairo.set_dash}. *)
val in_stroke : context -> float -> float -> bool
(** Tests whether the given point is inside the area that would be
affected by a {!Cairo.stroke} operation given the current path and
stroking parameters. Surface dimensions and clipping are not taken
into account. *)
val copy_page : context -> unit
(** [copy_page cr] emits the current page for backends that support
multiple pages, but doesn't clear it, so, the contents of the
current page will be retained for the next page too. Use
{!Cairo.show_page} if you want to get an empty page after the
emission.
This is a convenience function that simply calls
{!Cairo.Surface.copy_page} on [cr]'s target. *)
val show_page : context -> unit
(** [show_page cr] emits and clears the current page for backends that
support multiple pages. Use {!Cairo.copy_page} if you don't want
to clear the page.
This is a convenience function that simply calls
{!Cairo.Surface.show_page} on [cr]'s target. *)
(* ---------------------------------------------------------------------- *)
(** {2:paths Creating paths and manipulating path data}
Paths are the most basic drawing tools and are primarily used to
implicitly generate simple masks.
*)
type path_data =
| MOVE_TO of float * float
| LINE_TO of float * float
| CURVE_TO of float * float * float * float * float * float
| CLOSE_PATH
module Path :
sig
type t
val copy : context -> t
(** Creates a copy of the current path. See cairo_path_data_t for
hints on how to iterate over the returned data structure. *)
val copy_flat : context -> t
(** Gets a flattened copy of the current path.
This function is like {!Cairo.Path.copy} except that any curves
in the path will be approximated with piecewise-linear
approximations (accurate to within the current tolerance value).
That is, the result is guaranteed to not have any elements of
type [CURVE_TO] which will instead be replaced by a series of
[LINE_TO] elements. *)
val append : context -> t -> unit
(** Append the path onto the current path. The path may be either
the return value from one of {!Cairo.Path.copy} or
{!Cairo.Path.copy_flat} or it may be constructed manually. *)
val get_current_point : context -> float * float
(** [get_current_point cr] gets the (x,y) coordinates of the current
point of the current path, which is conceptually the final point
reached by the path so far. The current point is returned in the
user-space coordinate system.
Raise [Error NO_CURRENT_POINT] if there is no defined current
point.
Most path construction functions alter the current point. See
the following for details on how they affect the current point:
{!Cairo.Path.clear}, {!Cairo.Path.sub}, {!Cairo.Path.append},
{!Cairo.Path.close}, {!Cairo.move_to}, {!Cairo.line_to},
{!Cairo.curve_to}, {!Cairo.rel_move_to}, {!Cairo.rel_line_to},
{!Cairo.rel_curve_to}, {!Cairo.arc}, {!Cairo.arc_negative},
{!Cairo.rectangle}, {!Cairo.Path.text}, {!Cairo.Path.glyph}.
Some functions use and alter the current point but do not
otherwise change current path: {!Cairo.show_text}.
Some functions unset the current path and as a result, current
point: {!Cairo.fill}, {!Cairo.stroke}. *)
val clear : context -> unit
(** Clears the current path. After this call there will be no path
and no current point. *)
val sub : context -> unit
(** Begin a new sub-path. Note that the existing path is not
affected. After this call there will be no current point.
In many cases, this call is not needed since new sub-paths are
frequently started with {!Cairo.move_to}.
A call to {!Cairo.Path.sub} is particularly useful when
beginning a new sub-path with one of the {!Cairo.arc} calls.
This makes things easier as it is no longer necessary to manually
compute the arc's initial coordinates for a call to
{!Cairo.move_to}. *)
val close : context -> unit
(** Adds a line segment to the path from the current point to the
beginning of the current sub-path (the most recent point passed
to {!Cairo.move_to}) and closes this sub-path. After this call
the current point will be at the joined endpoint of the sub-path.
The behavior of {!Cairo.Path.close} is distinct from simply
calling {!Cairo.line_to} with the equivalent coordinate in the
case of stroking. When a closed sub-path is stroked, there are
no caps on the ends of the sub-path. Instead, there is a line
join connecting the final and initial segments of the sub-path.
If there is no current point before the call to [close], this
function will have no effect.
Note: As of cairo version 1.2.4 any call to [close] will place an
explicit [MOVE_TO] element into the path immediately after the
[CLOSE_PATH] element (which can be seen in {!Cairo.Path.copy} for
example). This can simplify path processing in some cases as it
may not be necessary to save the "last move_to point" during
processing as the [MOVE_TO] immediately after the [CLOSE_PATH]
will provide that point. *)
val glyph : context -> Glyph.t array -> unit
(** Adds closed paths for the glyphs to the current path. The
generated path if filled, achieves an effect similar to that of
{!Cairo.Glyph.show}. *)
val text : context -> string -> unit
(** [text cr utf8] adds closed paths for text to the current path.
The generated path if filled, achieves an effect similar to that
of {!Cairo.show_text}. [utf8] should be a valid UTF8 string
containing no ['\000'] characters.
Text conversion and positioning is done similar to {!Cairo.show_text}.
Like {!Cairo.show_text}, after this call the current point is
moved to the origin of where the next glyph would be placed in
this same progression. That is, the current point will be at the
origin of the final glyph offset by its advance values. This
allows for chaining multiple calls to to [text] without having to
set current point in between.
Note: The [text] function call is part of what the cairo
designers call the "toy" text API. It is convenient for short
demos and simple programs, but it is not expected to be adequate
for serious text-using applications. See {!Cairo.Path.glyph} for
the "real" text path API in cairo. *)
val extents : context -> rectangle
(** Computes a bounding box in user-space coordinates covering the
points on the current path. If the current path is empty, returns
an empty rectangle [{ x=0.; y=0.; w=0.; h=0. }]. Stroke
parameters, fill rule, surface dimensions and clipping are not
taken into account.
Contrast with {!Cairo.fill_extents} and {!Cairo.stroke_extents}
which return the extents of only the area that would be "inked"
by the corresponding drawing operations.
The result of [Cairo.Path.extents] is defined as equivalent to
the limit of {!Cairo.stroke_extents} with [ROUND] as the line
width approaches 0.0 (but never reaching the empty-rectangle
returned by {!Cairo.stroke_extents} for a line width of 0.0).
Specifically, this means that zero-area sub-paths such as
{!Cairo.move_to} and {!Cairo.line_to} segments (even degenerate
cases where the coordinates to both calls are identical) will be
considered as contributing to the extents. However, a lone
{!Cairo.move_to} will not contribute to the results of
[Cairo.Path.extents]. *)
val fold : t -> ('a -> path_data -> 'a) -> 'a -> 'a
(** [fold cr f] folds [f] over all elements of the path. *)
val to_array : t -> path_data array
val of_array : path_data array -> t
end
val arc : context ->
float -> float -> r:float -> a1:float -> a2:float -> unit
(** [arc xc yc radius angle1 angle2] adds a circular arc of the given
radius to the current path. The arc is centered at [(xc, yc)],
begins at [angle1] and proceeds in the direction of increasing
angles to end at [angle2]. If [angle2] is less than [angle1] it
will be progressively increased by 2*PI until it is greater than
[angle1].
If there is a current point, an initial line segment will be added
to the path to connect the current point to the beginning of the
arc. If this initial line is undesired, it can be avoided by
calling {!Cairo.Path.sub} before calling [arc].
Angles are measured in radians. An angle of 0.0 is in the
direction of the positive X axis (in user space). An angle of
π/2 radians (90 degrees) is in the direction of the positive Y
axis (in user space). Angles increase in the direction from the
positive X axis toward the positive Y axis. So with the default
transformation matrix, angles increase in a clockwise direction.
(To convert from degrees to radians, use degrees * (π / 180.).)
This function gives the arc in the direction of increasing angles;
see {!Cairo.arc_negative} to get the arc in the direction of
decreasing angles.
The arc is circular in user space. To achieve an elliptical arc,
you can scale the current transformation matrix by different
amounts in the X and Y directions. For example, to draw an ellipse
in the box given by [x], [y], [width], [height] (we suppose [pi]
holds the value of π):
{[
open Cairo
save cr;
translate cr (x +. width /. 2.) (y +. height /. 2.);
scale cr (width /. 2.) (height /. 2.);
arc cr 0. 0. 1. 0. (2 * pi);
restore cr;
]} *)
val arc_negative : context ->
float -> float -> r:float -> a1:float -> a2:float -> unit
(** [arc_negative xc yc radius angle1 angle2] adds a circular arc of
the given radius to the current path. The arc is centered at [(xc,
yc)], begins at [angle1] and proceeds in the direction of
decreasing angles to end at [angle2]. If [angle2] is greater than
[angle1] it will be progressively decreased by 2*PI until it is
less than [angle1].
See {!Cairo.arc} for more details. This function differs only in
the direction of the arc between the two angles. *)
val curve_to : context ->
float -> float -> float -> float -> float -> float -> unit
(** [curve_to ctx x1 y1 x2 y2 x3 y3] Adds a cubic Bézier spline to the
path from the current point to position (x3, y3) in user-space
coordinates, using (x1, y1) and (x2, y2) as the control points.
After this call the current point will be (x3, y3).
If there is no current point before the call to [curve_to] this
function will behave as if preceded by a call to
{!Cairo.move_to}[ cr x1 y1]. *)
val line_to : context -> float -> float -> unit
(** Adds a line to the path from the current point to position (x, y)
in user-space coordinates. After this call the current point will
be (x, y).
If there is no current point before the call to [Cairo.line_to],
this function will behave as {!Cairo.move_to}[ cr x y]. *)
val move_to : context -> float -> float -> unit
(** Begin a new sub-path. After this call the current point will be (x, y). *)
val rectangle : context ->
float -> float -> w:float -> h:float -> unit
(** [rectangle x y w h] adds a closed sub-path rectangle of the given
size to the current path at position (x, y) in user-space
coordinates.
This function is logically equivalent to:
{[
move_to cr x y;
rel_line_to cr width 0;
rel_line_to cr 0 height;
rel_line_to cr (-. width) 0;
Path.close cr;
]} *)
val rel_curve_to : context ->
float -> float -> float -> float -> float -> float -> unit
(** [rel_curve_to x1 y1 x2 y2 x3 y3] relative-coordinate version of
{!Cairo.curve_to}. All offsets are relative to the current point.
Adds a cubic Bézier spline to the path from the current point to a
point offset from the current point by (dx3, dy3), using points
offset by (dx1, dy1) and (dx2, dy2) as the control points. After
this call the current point will be offset by (dx3, dy3).
Given a current point of (x, y), [rel_curve_to cr dx1 dy1 dx2 dy2
dx3 dy3] is logically equivalent to [curve_to cr (x+.dx1) (y+.dy1)
(x+.dx2) (y+.dy2) (x+.dx3) (y+.dy3)].
It is an error to call this function with no current point. Doing
so will cause [Error NO_CURRENT_POINT] to be raised. *)
val rel_line_to : context -> float -> float -> unit
(** Relative-coordinate version of {!Cairo.line_to}. Adds a line to
the path from the current point to a point that is offset from the
current point by (dx, dy) in user space. After this call the
current point will be offset by (dx, dy).
Given a current point of (x, y), [rel_line_to cr dx dy] is
logically equivalent to [line_to cr (x +. dx) (y +. dy)].
It is an error to call this function with no current point. Doing
so will cause [Error NO_CURRENT_POINT] to be raised. *)
val rel_move_to : context -> float -> float -> unit
(** Begin a new sub-path. After this call the current point will
offset by (x, y).
Given a current point of (x, y), [rel_move_to cr dx dy] is
logically equivalent to [move_to cr (x +. dx) (y +. dy)].
It is an error to call this function with no current point. Doing
so will cause [Error NO_CURRENT_POINT] to be raised. *)
(* ---------------------------------------------------------------------- *)
(** {2:transformations Manipulating the current transformation matrix}
The current transformation matrix, {i ctm}, is a two-dimensional
affine transformation that maps all coordinates and other drawing
instruments from the {i user space} into the surface's canonical
coordinate system, also known as the {i device space}.
See also {!Cairo.Matrix}. *)
val translate : context -> float -> float -> unit
(** [translate cr tx ty] modifies the current transformation matrix
(CTM) by translating the user-space origin by ([tx], [ty]). This
offset is interpreted as a user-space coordinate according to the
CTM in place before the new call to [translate]. In other words,
the translation of the user-space origin takes place after any
existing transformation. *)
val scale : context -> float -> float -> unit
(** [scale sx sy] modifies the current transformation matrix (CTM) by
scaling the X and Y user-space axes by [sx] and [sy] respectively.
The scaling of the axes takes place after any existing
transformation of user space. *)
val rotate : context -> float -> unit
(** [rotate ctx angle] modifies the current transformation matrix
(CTM) by rotating the user-space axes by [angle] radians. The
rotation of the axes takes places after any existing transformation
of user space. The rotation direction for positive angles is from
the positive X axis toward the positive Y axis. *)
val transform : context -> Matrix.t -> unit
(** [transform cr matrix] modifies the current transformation matrix
(CTM) by applying [matrix] as an additional transformation. The
new transformation of user space takes place after any existing
transformation. *)
val set_matrix : context -> Matrix.t -> unit
(** [set_matrix cr matrix] Modifies the current transformation matrix
(CTM) by setting it equal to [matrix]. *)
val get_matrix : context -> Matrix.t
(** Return the current transformation matrix (CTM). *)
val identity_matrix : context -> unit
(** Resets the current transformation matrix (CTM) by setting it equal
to the identity matrix. That is, the user-space and device-space
axes will be aligned and one user-space unit will transform to one
device-space unit. *)
val user_to_device : context -> float -> float -> float * float
(** [user_to_device cr x y] transform a coordinate from user space to
device space by multiplying the given point by the current
transformation matrix (CTM). *)
val user_to_device_distance : context -> float -> float -> float * float
(** [user_to_device_distance cr dx dy] transform a distance vector
from user space to device space. This function is similar to
{!Cairo.user_to_device} except that the translation components of
the CTM will be ignored when transforming ([dx],[dy]). *)
val device_to_user : context -> float -> float -> float * float
(** Transform a coordinate from device space to user space by
multiplying the given point by the inverse of the current
transformation matrix (CTM). *)
val device_to_user_distance : context -> float -> float -> float * float
(** [device_to_user_distance cr dx dy] transform a distance vector
from device space to user space. This function is similar to
{!Cairo.device_to_user} except that the translation components of
the inverse CTM will be ignored when transforming ([dx],[dy]). *)
ocaml-cairo/src/cairo_ocaml_types.h 0000644 0001750 0001750 00000032314 13446257732 017612 0 ustar treinen treinen /* Generic functions for types */
#include "cairo_ocaml.h"
static int caml_cairo_compare_pointers(value v1, value v2)
{
void *p1 = * (void **) Data_custom_val(v1);
void *p2 = * (void **) Data_custom_val(v2);
if (p1 == p2) return(0);
else if (p1 < p2) return(-1);
else return(1);
}
static intnat caml_cairo_hash_pointer(value v)
{
return((intnat) (* (void **) Data_custom_val(v)));
}
#define CUSTOM_OPERATIONS(name) \
struct custom_operations caml_##name##_ops = { \
#name "_t", /* identifier for serialization and deserialization */ \
&caml_cairo_##name##_finalize, \
&caml_cairo_compare_pointers, \
&caml_cairo_hash_pointer, \
custom_serialize_default, \
custom_deserialize_default };
#define DEFINE_CUSTOM_OPERATIONS(name, destroy, val) \
static void caml_cairo_##name##_finalize(value v) \
{ \
/* fprintf(stderr, "DESTROY %s\n", #name); fflush(stderr); */ \
destroy(val(v)); \
} \
CUSTOM_OPERATIONS(name)
#define ALLOC(name) alloc_custom(&caml_##name##_ops, sizeof(void*), 1, 50)
/* Type cairo_t
***********************************************************************/
#define CAIRO_ASSIGN(v, x) v = ALLOC(cairo); CAIRO_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(cairo, cairo_destroy, CAIRO_VAL)
/* raise [Error] if the status indicates a failure. */
void caml_cairo_raise_Error(cairo_status_t status)
{
static value * exn = NULL;
if (status != CAIRO_STATUS_SUCCESS) {
if (exn == NULL) {
/* First time around, look up by name */
exn = caml_named_value("Cairo.Error");
}
if (status == CAIRO_STATUS_NO_MEMORY)
caml_raise_out_of_memory();
else
/* Keep in sync with the OCaml def of [status]; variant without
arguments == int. The first 2 values of cairo_status_t are
deleted. */
caml_raise_with_arg(*exn, Val_int(status - 2));
}
}
/* Raise the corresponding OCaml exception for errors. */
static void caml_check_status(cairo_t *cr)
{
caml_cairo_raise_Error(cairo_status(cr));
}
CAMLexport value caml_cairo_status_to_string(value vstatus)
{
CAMLparam1(vstatus);
cairo_status_t status = (cairo_status_t) (Int_val(vstatus) + 2);
const char* msg = cairo_status_to_string(status);
CAMLreturn(caml_copy_string(msg));
}
/* Type cairo_pattern_t
***********************************************************************/
#define PATTERN_ASSIGN(v, x) v = ALLOC(pattern); PATTERN_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(pattern, cairo_pattern_destroy, PATTERN_VAL)
/* Type cairo_surface_t
***********************************************************************/
#define SURFACE_ASSIGN(v, x) v = ALLOC(surface); SURFACE_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(surface, cairo_surface_destroy, SURFACE_VAL)
/* Some surfaces have a callback attached. We must store its value at
a location that exists for the lifetime of the surface so one can
pass a pointer to it to the *_for_stream functions and the
finalizer may unregister it. Wrapping cairo_surface_t is not
possible because such values are returned by C functions. Thus
store it in the surface (thanks Cairo!). */
static const cairo_user_data_key_t surface_callback;
static void caml_destroy_surface_callback(void *data)
{
/* fprintf(stderr, "DESTROY surface callback\n"); fflush(stderr); */
caml_remove_generational_global_root((value *)data);
free(data);
}
/* [output] is a pointer on the callback [value], already allocated
(and assigned). */
#define SET_SURFACE_CALLBACK(surf, output) \
caml_register_generational_global_root(output); \
caml_cairo_raise_Error( \
cairo_surface_set_user_data (surf, &surface_callback, output, \
&caml_destroy_surface_callback))
static value caml_cairo_surface_kind[15];
CAMLexport value caml_cairo_surface_kind_init(value unit)
{
/* noalloc */
caml_cairo_surface_kind[0] = caml_hash_variant("Image");
caml_cairo_surface_kind[1] = caml_hash_variant("PDF");
caml_cairo_surface_kind[2] = caml_hash_variant("PS");
caml_cairo_surface_kind[3] = caml_hash_variant("XLib");
caml_cairo_surface_kind[4] = caml_hash_variant("XCB");
caml_cairo_surface_kind[5] = caml_hash_variant("GLITZ");
caml_cairo_surface_kind[6] = caml_hash_variant("Quartz");
caml_cairo_surface_kind[7] = caml_hash_variant("Win32");
caml_cairo_surface_kind[8] = caml_hash_variant("BEOS");
caml_cairo_surface_kind[9] = caml_hash_variant("DirectFB");
caml_cairo_surface_kind[10] = caml_hash_variant("SVG");
caml_cairo_surface_kind[11] = caml_hash_variant("OS2");
caml_cairo_surface_kind[12] = caml_hash_variant("Win32_printing");
caml_cairo_surface_kind[13] = caml_hash_variant("Quartz_image");
caml_cairo_surface_kind[14] = caml_hash_variant("Recording");
return(Val_unit);
}
#define VAL_SURFACE_KIND(k) caml_cairo_surface_kind[k]
/* Type cairo_path_t
***********************************************************************/
#define PATH_ASSIGN(v, x) v = ALLOC(path); PATH_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(path, cairo_path_destroy, PATH_VAL)
/* Type cairo_glyph_t
***********************************************************************/
#define SET_GLYPH_VAL(p, v) \
p->index = Int_val(Field(v,0)); \
p->x = Double_val(Field(v,1)); \
p->y = Double_val(Field(v,2))
#define ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs) \
num_glyphs = Wosize_val(vglyphs); \
SET_MALLOC(glyphs, num_glyphs, cairo_glyph_t); \
for(i=0, p = glyphs; i < num_glyphs; i++, p++) { \
SET_GLYPH_VAL(p, Field(vglyphs, i)); \
}
#define GLYPH_ASSIGN(v, glyph) \
v = caml_alloc_tuple(3); \
Store_field(v, 0, Val_int(glyph.index)); \
Store_field(v, 1, caml_copy_double(glyph.x)); \
Store_field(v, 2, caml_copy_double(glyph.y))
#define SET_CLUSTER_VAL(p, v) \
p->num_bytes = Int_val(Field(v, 0)); \
p->num_glyphs = Int_val(Field(v, 1))
#define ARRAY_CLUSTER_VAL(clusters, q, vglyphs, num_glyphs) \
num_clusters = Wosize_val(vclusters); \
SET_MALLOC(clusters, num_clusters, cairo_text_cluster_t); \
for(i=0, q = clusters; i < num_clusters; i++, q++) { \
SET_CLUSTER_VAL(q, Field(vclusters, i)); \
}
#define CLUSTER_ASSIGN(v, cluster) \
v = caml_alloc_tuple(2); \
Store_field(v, 0, Val_int(cluster.num_bytes)); \
Store_field(v, 1, Val_int(cluster.num_glyphs))
#define CLUSTER_FLAGS_VAL(v) ((cairo_text_cluster_flags_t) Int_val(v))
#define VAL_CLUSTER_FLAGS(v) Val_int(v)
/* Type cairo_matrix_t
***********************************************************************/
#ifdef ARCH_ALIGN_DOUBLE
#define SET_CAIRO_MATRIX_(v) \
matrix_##v.xx = Double_field(v, 0); \
matrix_##v.yx = Double_field(v, 1); \
matrix_##v.xy = Double_field(v, 2); \
matrix_##v.yy = Double_field(v, 3); \
matrix_##v.x0 = Double_field(v, 4); \
matrix_##v.y0 = Double_field(v, 5);
#define ALLOC_CAIRO_MATRIX(v) \
cairo_matrix_t matrix_##v; \
SET_CAIRO_MATRIX_(v)
#define ALLOC_CAIRO_MATRIX2(v1, v2) \
cairo_matrix_t matrix_##v1, matrix_##v2; \
SET_CAIRO_MATRIX_(v1); \
SET_CAIRO_MATRIX_(v2)
/* `f' may use `GET_MATRIX(v)' */
#define WITH_MATRIX_DO(v, f) \
cairo_matrix_t matrix_##v; \
f; \
v = caml_alloc(6 * sizeof(double) / sizeof(void *), Double_array_tag); \
Store_double_field(v, 0, matrix_##v.xx); \
Store_double_field(v, 1, matrix_##v.yx); \
Store_double_field(v, 2, matrix_##v.xy); \
Store_double_field(v, 3, matrix_##v.yy); \
Store_double_field(v, 4, matrix_##v.x0); \
Store_double_field(v, 5, matrix_##v.y0)
#define GET_MATRIX(v) &matrix_##v
#else /* not def ARCH_ALIGN_DOUBLE */
#define ALLOC_CAIRO_MATRIX(v) /* nothing to do */
#define ALLOC_CAIRO_MATRIX2(v1, v2) /* nothing to do */
#define WITH_MATRIX_DO(v, f) \
v = caml_alloc(6 * sizeof(double) / sizeof(void *), Double_array_tag); \
f /* `f' may use `GET_MATRIX(v)' */
/* Optimize by using a pointer to OCaml data */
#define GET_MATRIX(v) (cairo_matrix_t *)(v)
#endif
/* Text
***********************************************************************/
#define FONT_OPTIONS_ASSIGN(vfo, fo) \
vfo = ALLOC(font_options); \
FONT_OPTIONS_VAL(vfo) = fo
static void caml_cairo_font_options_finalize(value v)
{
cairo_font_options_destroy(FONT_OPTIONS_VAL(v));
}
static int caml_cairo_font_options_compare(value v1, value v2)
{
cairo_font_options_t *fo1 = FONT_OPTIONS_VAL(v1);
cairo_font_options_t *fo2 = FONT_OPTIONS_VAL(v2);
/* fo1 == fo2 => cairo_font_options_equal(fo1, fo2) ; thus this
remains a total order. */
if (cairo_font_options_equal(fo1, fo2)) return(0);
else if (fo1 < fo2) return(-1);
else return(1);
}
static intnat caml_cairo_font_options_hash(value v)
{
return(cairo_font_options_hash(FONT_OPTIONS_VAL(v)));
}
struct custom_operations caml_font_options_ops = {
"font_options_t", /* identifier for serialization and deserialization */
&caml_cairo_font_options_finalize,
&caml_cairo_font_options_compare,
&caml_cairo_font_options_hash,
custom_serialize_default,
custom_deserialize_default };
/* caml_cairo_font_type is defined in "cairo_ocaml.h". */
CAMLexport value caml_cairo_font_type_init(value unit)
{
/* noalloc */
caml_cairo_font_type[CAIRO_FONT_TYPE_TOY] = caml_hash_variant("Toy");
caml_cairo_font_type[CAIRO_FONT_TYPE_FT] = caml_hash_variant("Ft");
caml_cairo_font_type[CAIRO_FONT_TYPE_WIN32] = caml_hash_variant("Win32");
caml_cairo_font_type[CAIRO_FONT_TYPE_QUARTZ] = caml_hash_variant("Quartz");
caml_cairo_font_type[CAIRO_FONT_TYPE_USER] = caml_hash_variant("User");
return(Val_unit);
}
cairo_font_type_t caml_cairo_font_type_val(value vft)
{
if (vft == caml_cairo_font_type[0]) return(CAIRO_FONT_TYPE_TOY);
else if (vft == caml_cairo_font_type[1]) return(CAIRO_FONT_TYPE_FT);
else if (vft == caml_cairo_font_type[2]) return(CAIRO_FONT_TYPE_WIN32);
else if (vft == caml_cairo_font_type[3]) return(CAIRO_FONT_TYPE_QUARTZ);
else if (vft == caml_cairo_font_type[4]) return(CAIRO_FONT_TYPE_USER);
caml_failwith("Cairo.font_type conversion failed. Contact the developers.");
}
#define FONT_FACE_VAL(v) (* (cairo_font_face_t**) Data_custom_val(v))
#define FONT_FACE_ASSIGN(v, x) v = ALLOC(font_face); FONT_FACE_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(font_face, cairo_font_face_destroy, FONT_FACE_VAL)
DEFINE_CUSTOM_OPERATIONS(scaled_font,
cairo_scaled_font_destroy, SCALED_FONT_VAL)
#define FONT_EXTENTS_ASSIGN(vfe, fe) \
vfe = caml_alloc(5 * Double_wosize, Double_array_tag); \
Store_double_field(vfe, 0, fe.ascent); \
Store_double_field(vfe, 1, fe.descent); \
Store_double_field(vfe, 2, fe.height); \
Store_double_field(vfe, 3, fe.max_x_advance); \
Store_double_field(vfe, 4, fe.max_y_advance)
#define TEXT_EXTENTS_ASSIGN(vte, te) \
vte = caml_alloc(6 * Double_wosize, Double_array_tag); \
Store_double_field(vte, 0, te.x_bearing); \
Store_double_field(vte, 1, te.y_bearing); \
Store_double_field(vte, 2, te.width); \
Store_double_field(vte, 3, te.height); \
Store_double_field(vte, 4, te.x_advance); \
Store_double_field(vte, 5, te.y_advance)
#define SLANT_VAL(v) ((cairo_font_slant_t) Int_val(v))
#define VAL_SLANT(v) Val_int(v)
#define WEIGHT_VAL(v) ((cairo_font_weight_t) Int_val(v))
#define VAL_WEIGHT(v) Val_int(v)
/* FreeType
***********************************************************************/
#ifdef OCAML_CAIRO_HAS_FT
#include
#include
#define FT_LIBRARY_ASSIGN(v, x) \
v = ALLOC(cairo_ft_library); FT_LIBRARY_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(cairo_ft_library, FT_Done_Library, FT_LIBRARY_VAL)
#define FT_FACE_ASSIGN(v, x) v = ALLOC(cairo_ft_face); FT_FACE_VAL(v) = x
DEFINE_CUSTOM_OPERATIONS(cairo_ft_face, FT_Done_Face, FT_FACE_VAL)
#endif
/* Local Variables: */
/* compile-command: "make -k -C.." */
/* End: */
ocaml-cairo/src/cairo_ocaml.h.p 0000644 0001750 0001750 00000015527 13446257732 016633 0 ustar treinen treinen /* File: cairo_ocaml.h -*-c-*-
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umons.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation. See the file
LICENCE for more details.
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 file
LICENSE for more details. */
#ifndef __CAIRO_OCAML_H__
#define __CAIRO_OCAML_H__
#include
#include
#include
/* cairo_t
***********************************************************************/
#define CAIRO_VAL(v) (* (cairo_t **) Data_custom_val(v))
struct custom_operations caml_cairo_ops;
void caml_cairo_raise_Error(cairo_status_t status);
/* raise [Cairo.Error] if the status indicates a failure. */
/* cairo_pattern_t
***********************************************************************/
#define PATTERN_VAL(v) (* (cairo_pattern_t **) Data_custom_val(v))
struct custom_operations caml_pattern_ops;
#define EXTEND_VAL(v) ((cairo_extend_t) Int_val(v))
#define VAL_EXTEND(v) Val_int(v)
#define FILTER_VAL(v) ((cairo_filter_t) Int_val(v))
#define VAL_FILTER(v) Val_int(v)
/* cairo_font_options_t
***********************************************************************/
#define FONT_OPTIONS_VAL(v) (* (cairo_font_options_t**) Data_custom_val(v))
struct custom_operations caml_font_options_ops;
/* cairo_font_type_t
***********************************************************************/
value caml_cairo_font_type[5];
cairo_font_type_t caml_cairo_font_type_val(value vft);
#define FONT_TYPE_VAL(vft) caml_cairo_font_type_val(vft)
#define VAL_FONT_TYPE(v) caml_cairo_font_type[v]
/* cairo_scaled_font_t
***********************************************************************/
#define SCALED_FONT_VAL(v) (* (cairo_scaled_font_t**) Data_custom_val(v))
struct custom_operations caml_scaled_font_ops;
/* cairo_surface_t
***********************************************************************/
#define SURFACE_VAL(v) (* (cairo_surface_t **) Data_custom_val(v))
struct custom_operations caml_surface_ops;
/* Type cairo_content_t */
#define SET_CONTENT_VAL(c, vcontent) \
switch (Int_val(vcontent)) \
{ \
case 0 : c = CAIRO_CONTENT_COLOR; break; \
case 1 : c = CAIRO_CONTENT_ALPHA; break; \
case 2 : c = CAIRO_CONTENT_COLOR_ALPHA; break; \
default : caml_failwith(__FILE__ ": Decode Cairo.content"); \
}
#define CONTENT_ASSIGN(vcontent, content) \
switch (content) \
{ \
case CAIRO_CONTENT_COLOR: vcontent = Val_int(0); break; \
case CAIRO_CONTENT_ALPHA: vcontent = Val_int(1); break; \
case CAIRO_CONTENT_COLOR_ALPHA: vcontent = Val_int(2); break; \
default : caml_failwith(__FILE__ ": Assign Cairo.content"); \
}
/* cairo_path_t
***********************************************************************/
#define PATH_VAL(v) (* (cairo_path_t **) Data_custom_val(v))
struct custom_operations caml_path_ops;
#define PATH_DATA_ASSIGN(vdata, data) \
switch (data->header.type) { \
/* keep in sync the tags with the OCaml def of path_data */ \
case CAIRO_PATH_MOVE_TO: \
vdata = caml_alloc(2, 0); \
Store_field(vdata, 0, caml_copy_double(data[1].point.x)); \
Store_field(vdata, 1, caml_copy_double(data[1].point.y)); \
break; \
case CAIRO_PATH_LINE_TO: \
vdata = caml_alloc(2, 1); \
Store_field(vdata, 0, caml_copy_double(data[1].point.x)); \
Store_field(vdata, 1, caml_copy_double(data[1].point.y)); \
break; \
case CAIRO_PATH_CURVE_TO: \
vdata = caml_alloc(6, 2); \
Store_field(vdata, 0, caml_copy_double(data[1].point.x)); \
Store_field(vdata, 1, caml_copy_double(data[1].point.y)); \
Store_field(vdata, 2, caml_copy_double(data[2].point.x)); \
Store_field(vdata, 3, caml_copy_double(data[2].point.y)); \
Store_field(vdata, 4, caml_copy_double(data[3].point.x)); \
Store_field(vdata, 5, caml_copy_double(data[3].point.y)); \
break; \
case CAIRO_PATH_CLOSE_PATH: \
vdata = Val_int(0); /* first constant constructor */ \
break; \
}
#define SWITCH_PATH_DATA(v, move, line, curve, close) \
if(Is_long(v)) { \
close; \
} else switch(Tag_val(v)) { \
case 0: \
move(Field(v,0), Field(v,1)); \
break; \
case 1: \
line(Field(v,0), Field(v,1)); \
break; \
case 2: \
curve(Field(v,0), Field(v,1), \
Field(v,2), Field(v,3), \
Field(v,4), Field(v,5)); \
break; \
default: \
caml_failwith(__FILE__ ": SWITCH_PATH_DATA"); \
}
/* FreeType
***********************************************************************/
/* #define OCAML_CAIRO_HAS_FT 1 */
#ifdef OCAML_CAIRO_HAS_FT
#include
#define FT_LIBRARY_VAL(v) (* (FT_Library*) Data_custom_val(v))
struct custom_operations caml_cairo_ft_library_ops;
#define FT_FACE_VAL(v) (* (FT_Face*) Data_custom_val(v))
struct custom_operations caml_cairo_ft_face_ops;
#endif /* OCAML_CAIRO_HAS_FT */
#endif /* __CAIRO_OCAML_H__ */
ocaml-cairo/src/cairo.ml 0000644 0001750 0001750 00000104333 13446257732 015375 0 ustar treinen treinen (* File: cairo.ml
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
(* Keep in sync with the C function caml_cairo_raise_Error *)
type status =
(* Programmer error *)
| INVALID_RESTORE
| INVALID_POP_GROUP
| NO_CURRENT_POINT
| INVALID_MATRIX
| INVALID_STATUS
(* Language binding implementation *)
| NULL_POINTER
| INVALID_STRING
| INVALID_PATH_DATA
(* Other *)
| 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
| TEMP_FILE_ERROR
| INVALID_STRIDE
| FONT_TYPE_MISMATCH
| USER_FONT_IMMUTABLE
| USER_FONT_ERROR
| NEGATIVE_COUNT
| INVALID_CLUSTERS
| INVALID_SLANT
| INVALID_WEIGHT
| INVALID_SIZE
| USER_FONT_NOT_IMPLEMENTED
| DEVICE_TYPE_MISMATCH
| DEVICE_ERROR
| INVALID_MESH_CONSTRUCTION
| DEVICE_FINISHED
| JBIG2_GLOBAL_MISSING
exception Error of status
let () = Callback.register_exception "Cairo.Error" (Error INVALID_RESTORE)
let error_of_status = function
| INVALID_RESTORE -> "Cairo.Error(INVALID_RESTORE)"
| INVALID_POP_GROUP -> "Cairo.Error(INVALID_POP_GROUP)"
| NO_CURRENT_POINT -> "Cairo.Error(NO_CURRENT_POINT)"
| INVALID_MATRIX -> "Cairo.Error(INVALID_MATRIX)"
| INVALID_STATUS -> "Cairo.Error(INVALID_STATUS)"
| NULL_POINTER -> "Cairo.Error(NULL_POINTER)"
| INVALID_STRING -> "Cairo.Error(INVALID_STRING)"
| INVALID_PATH_DATA -> "Cairo.Error(INVALID_PATH_DATA)"
| READ_ERROR -> "Cairo.Error(READ_ERROR)"
| WRITE_ERROR -> "Cairo.Error(WRITE_ERROR)"
| SURFACE_FINISHED -> "Cairo.Error(SURFACE_FINISHED)"
| SURFACE_TYPE_MISMATCH -> "Cairo.Error(SURFACE_TYPE_MISMATCH)"
| PATTERN_TYPE_MISMATCH -> "Cairo.Error(PATTERN_TYPE_MISMATCH)"
| INVALID_CONTENT -> "Cairo.Error(INVALID_CONTENT)"
| INVALID_FORMAT -> "Cairo.Error(INVALID_FORMAT)"
| INVALID_VISUAL -> "Cairo.Error(INVALID_VISUAL)"
| FILE_NOT_FOUND -> "Cairo.Error(FILE_NOT_FOUND)"
| INVALID_DASH -> "Cairo.Error(INVALID_DASH)"
| INVALID_DSC_COMMENT -> "Cairo.Error(INVALID_DSC_COMMENT)"
| INVALID_INDEX -> "Cairo.Error(INVALID_INDEX)"
| CLIP_NOT_REPRESENTABLE -> "Cairo.Error(CLIP_NOT_REPRESENTABLE)"
| TEMP_FILE_ERROR -> "Cairo.Error(TEMP_FILE_ERROR)"
| INVALID_STRIDE -> "Cairo.Error(INVALID_STRIDE)"
| FONT_TYPE_MISMATCH -> "Cairo.Error(FONT_TYPE_MISMATCH)"
| USER_FONT_IMMUTABLE -> "Cairo.Error(USER_FONT_IMMUTABLE)"
| USER_FONT_ERROR -> "Cairo.Error(USER_FONT_ERROR)"
| NEGATIVE_COUNT -> "Cairo.Error(NEGATIVE_COUNT)"
| INVALID_CLUSTERS -> "Cairo.Error(INVALID_CLUSTERS)"
| INVALID_SLANT -> "Cairo.Error(INVALID_SLANT)"
| INVALID_WEIGHT -> "Cairo.Error(INVALID_WEIGHT)"
| INVALID_SIZE -> "Cairo.Error(INVALID_SIZE)"
| USER_FONT_NOT_IMPLEMENTED -> "Cairo.Error(USER_FONT_NOT_IMPLEMENTED)"
| DEVICE_TYPE_MISMATCH -> "Cairo.Error(DEVICE_TYPE_MISMATCH)"
| DEVICE_ERROR -> "Cairo.Error(DEVICE_ERROR)"
| INVALID_MESH_CONSTRUCTION -> "Cairo.Error(INVALID_MESH_CONSTRUCTION)"
| DEVICE_FINISHED -> "Cairo.Error(DEVICE_FINISHED)"
| JBIG2_GLOBAL_MISSING -> "Cairo.Error(JBIG2_GLOBAL_MISSING)"
let () =
Printexc.register_printer (function
| Error s -> Some(error_of_status s)
| _ -> None)
external status_to_string : status -> string = "caml_cairo_status_to_string"
exception Unavailable
let () = Callback.register_exception "Cairo.Unavailable" Unavailable
type context
type surface
type content = COLOR | ALPHA | COLOR_ALPHA
type 'a pattern
constraint 'a = [<`Solid | `Surface | `Gradient | `Linear | `Radial]
type any_pattern = [`Solid | `Surface | `Gradient | `Linear | `Radial] pattern
type glyph = { index: int; x: float; y: float }
external create : surface -> context = "caml_cairo_create"
external save : context -> unit = "caml_cairo_save"
external restore : context -> unit = "caml_cairo_restore"
external get_target : context -> surface = "caml_cairo_get_target"
module Group =
struct
external push_group : context -> unit = "caml_cairo_push_group"
external push_group_with_content : context -> content -> unit
= "caml_cairo_push_group_with_content"
let push ?content cr =
match content with
| None -> push_group cr
| Some c -> push_group_with_content cr c
external pop : context -> any_pattern = "caml_cairo_pop_group"
external pop_to_source : context -> unit = "caml_cairo_pop_group_to_source"
external get_target : context -> surface = "caml_cairo_get_group_target"
end
external set_source_rgb : context -> float -> float -> float -> unit
= "caml_cairo_set_source_rgb"
external set_source_rgba :
context -> float -> float -> float -> float -> unit
= "caml_cairo_set_source_rgba"
external set_source : context -> 'a pattern -> unit = "caml_cairo_set_source"
external set_source_surface : context -> surface -> x:float -> y:float -> unit
= "caml_cairo_set_source_surface"
external get_source : context -> any_pattern = "caml_cairo_get_source"
type antialias =
| ANTIALIAS_DEFAULT
| ANTIALIAS_NONE
| ANTIALIAS_GRAY
| ANTIALIAS_SUBPIXEL
external set_antialias : context -> antialias -> unit
= "caml_cairo_set_antialias"
external get_antialias : context -> antialias = "caml_cairo_get_antialias"
external set_dash_stub : context -> float array -> ofs:float -> unit
= "caml_cairo_set_dash"
let set_dash cr ?(ofs=0.0) dashes = set_dash_stub cr dashes ~ofs
external get_dash : context -> float array * float = "caml_cairo_get_dash"
type fill_rule =
| WINDING
| EVEN_ODD
external set_fill_rule : context -> fill_rule -> unit
= "caml_cairo_set_fill_rule"
external get_fill_rule : context -> fill_rule = "caml_cairo_get_fill_rule"
type line_cap =
| BUTT
| ROUND
| SQUARE
external set_line_cap : context -> line_cap -> unit = "caml_cairo_set_line_cap"
external get_line_cap : context -> line_cap = "caml_cairo_get_line_cap"
type line_join =
| JOIN_MITER
| JOIN_ROUND
| JOIN_BEVEL
external set_line_join : context -> line_join -> unit
= "caml_cairo_set_line_join"
external get_line_join : context -> line_join = "caml_cairo_get_line_join"
external set_line_width : context -> float -> unit = "caml_cairo_set_line_width"
external get_line_width : context -> float = "caml_cairo_get_line_width"
external set_miter_limit : context -> float -> unit
= "caml_cairo_set_miter_limit"
external get_miter_limit : context -> float = "caml_cairo_get_miter_limit"
type operator =
| CLEAR
| SOURCE
| OVER
| IN
| OUT
| ATOP
| DEST
| DEST_OVER
| DEST_IN
| DEST_OUT
| DEST_ATOP
| XOR
| ADD
| SATURATE
external set_operator : context -> operator -> unit = "caml_cairo_set_operator"
external get_operator : context -> operator = "caml_cairo_get_operator"
external set_tolerance : context -> float -> unit = "caml_cairo_set_tolerance"
external get_tolerance : context -> float = "caml_cairo_get_tolerance"
external clip : context -> unit = "caml_cairo_clip"
external clip_preserve : context -> unit = "caml_cairo_clip_preserve"
type rectangle = {
x:float;
y:float;
w:float;
h:float
}
external clip_extents : context -> rectangle = "caml_cairo_clip_extents"
external clip_reset : context -> unit = "caml_cairo_reset_clip"
external clip_rectangle_list : context -> rectangle list
= "caml_cairo_copy_clip_rectangle_list"
external fill : context -> unit = "caml_cairo_fill"
external fill_preserve : context -> unit = "caml_cairo_fill_preserve"
external fill_extents : context -> rectangle = "caml_cairo_fill_extents"
external in_fill : context -> float -> float -> bool = "caml_cairo_in_fill"
external mask : context -> 'a pattern -> unit = "caml_cairo_mask"
external mask_surface : context -> surface -> x:float -> y:float -> unit
= "caml_cairo_mask_surface"
external paint_stub : context -> unit = "caml_cairo_paint"
external paint_with_alpha : context -> float -> unit
= "caml_cairo_paint_with_alpha"
let paint ?alpha cr =
match alpha with
| None -> paint_stub cr
| Some a -> paint_with_alpha cr a
external stroke : context -> unit = "caml_cairo_stroke"
external stroke_preserve : context -> unit = "caml_cairo_stroke_preserve"
external stroke_extents : context -> rectangle = "caml_cairo_stroke_extents"
external in_stroke : context -> float -> float -> bool
= "caml_cairo_in_stroke"
external copy_page : context -> unit = "caml_cairo_copy_page"
external show_page : context -> unit = "caml_cairo_show_page"
(* ---------------------------------------------------------------------- *)
type path_data =
| MOVE_TO of float * float
| LINE_TO of float * float
| CURVE_TO of float * float * float * float * float * float
| CLOSE_PATH
module Path =
struct
type t
external copy : context -> t = "caml_cairo_copy_path"
external copy_flat : context -> t = "caml_cairo_copy_path_flat"
external append : context -> t -> unit = "caml_cairo_append_path"
external get_current_point : context -> float * float
= "caml_cairo_get_current_point"
external clear : context -> unit = "caml_cairo_new_path"
external sub : context -> unit = "caml_cairo_new_sub_path"
external close : context -> unit = "caml_cairo_close_path"
external glyph : context -> glyph array -> unit = "caml_cairo_glyph_path"
external text : context -> string -> unit = "caml_cairo_text_path"
external extents : context -> rectangle = "caml_cairo_path_extents"
external fold : t -> ('a -> path_data -> 'a) -> 'a -> 'a
= "caml_cairo_path_fold"
external to_array : t -> path_data array = "caml_cairo_path_to_array"
external of_array : path_data array -> t = "caml_cairo_path_of_array"
end
external arc : context -> float -> float -> r:float -> a1:float -> a2:float
-> unit = "caml_cairo_arc_bc" "caml_cairo_arc"
external arc_negative : context -> float -> float -> r:float -> a1:float ->
a2:float -> unit = "caml_cairo_arc_negative_bc" "caml_cairo_arc_negative"
external curve_to : context -> float -> float -> float -> float ->
float -> float -> unit
= "caml_cairo_curve_to_bc" "caml_cairo_curve_to"
external line_to : context -> float -> float -> unit = "caml_cairo_line_to"
external move_to : context -> float -> float -> unit = "caml_cairo_move_to"
external rectangle :
context -> float -> float -> w:float -> h:float -> unit
= "caml_cairo_rectangle"
external rel_curve_to : context -> float -> float ->
float -> float -> float -> float -> unit
= "caml_cairo_rel_curve_to_bc" "caml_cairo_rel_curve_to"
external rel_line_to : context -> float -> float -> unit
= "caml_cairo_rel_line_to"
external rel_move_to : context -> float -> float -> unit
= "caml_cairo_rel_move_to"
(* ---------------------------------------------------------------------- *)
type matrix = { mutable xx: float; mutable yx: float;
mutable xy: float; mutable yy: float;
mutable x0: float; mutable y0: float }
module Matrix =
struct
type t = matrix
(* x_new = xx *. x +. xy *. y +. x0;
y_new = yx *. x +. yy *. y +. y0; *)
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 angle =
{ xx=cos(angle); yx=sin(angle);
xy= -. sin(angle); yy=cos(angle); x0=0.; y0=0. }
let translate m x y =
m.x0 <- m.x0 +. m.xx *. x +. m.xy *. y;
m.y0 <- m.y0 +. m.yx *. x +. m.yy *. y
let scale m x y =
m.xx <- m.xx *. x;
m.yx <- m.yx *. x;
m.xy <- m.xy *. y;
m.yy <- m.yy *. y
let rotate m angle =
let cosa = cos angle and sina = sin angle in
let xx = m.xx in
m.xx <- xx *. cosa +. m.xy *. sina;
m.xy <- m.xy *. cosa -. xx *. sina;
let yx = m.yx in
m.yx <- yx *. cosa +. m.yy *. sina;
m.yy <- m.yy *. cosa -. yx *. sina
let invert m =
(* Optimize for scaling|translation matrices just like cairo... *)
if m.xy = 0. && m.yx = 0. then (
m.x0 <- -. m.x0;
m.y0 <- -. m.y0;
if m.xx <> 1. then (
if m.xx = 0. then raise(Error INVALID_MATRIX);
m.xx <- 1. /. m.xx;
m.x0 <- m.x0 *. m.xx;
);
if m.yy <> 1. then (
if m.yy = 0. then raise(Error INVALID_MATRIX);
m.yy <- 1. /. m.yy;
m.y0 <- m.y0 *. m.yy;
);
)
else
let det = m.xx *. m.yy -. m.yx *. m.xy in
if det = 0. || 1. /. det = 0. (* infinite det *) then
raise(Error INVALID_MATRIX);
let yy = m.xx /. det in
m.xx <- m.yy /. det;
m.xy <- -. m.xy /. det;
m.yx <- -. m.yx /. det;
m.yy <- yy;
let y0 = -. m.yx *. m.x0 -. yy *. m.y0 in
m.x0 <- -. m.xx *. m.x0 -. m.xy *. m.y0;
m.y0 <- y0
let multiply a b =
{ xx = b.xx *. a.xx +. b.xy *. a.yx;
xy = b.xx *. a.xy +. b.xy *. a.yy;
yx = b.yx *. a.xx +. b.yy *. a.yx;
yy = b.yx *. a.xy +. b.yy *. a.yy;
x0 = b.xx *. a.x0 +. b.xy *. a.y0 +. b.x0;
y0 = b.yx *. a.x0 +. b.yy *. a.y0 +. b.y0; }
let transform_distance m ~dx ~dy =
(m.xx *. dx +. m.xy *. dy, m.yx *. dx +. m.yy *. dy)
let transform_point m x y =
(m.xx *. x +. m.xy *. y +. m.x0, m.yx *. x +. m.yy *. y +. m.y0)
end
(* ---------------------------------------------------------------------- *)
(* Rendering text and glyphs *)
type text_extents = {
x_bearing : float;
y_bearing : float;
width : float;
height : float;
x_advance : float;
y_advance : float;
}
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
module Font_options =
struct
type t
external set : context -> t -> unit = "caml_cairo_set_font_options"
external get : context -> t = "caml_cairo_get_font_options"
external create : unit -> t = "caml_cairo_font_options_create"
external copy : t -> t = "caml_cairo_font_options_copy"
external merge : t -> t -> unit = "caml_cairo_font_options_merge"
external set_antialias : t -> antialias -> unit
= "caml_cairo_font_options_set_antialias"
external get_antialias : t -> antialias
= "caml_cairo_font_options_get_antialias"
external set_subpixel_order : t -> subpixel_order -> unit
= "caml_cairo_font_options_set_subpixel_order"
external get_subpixel_order : t -> subpixel_order
= "caml_cairo_font_options_get_subpixel_order"
external set_hint_style : t -> hint_style -> unit
= "caml_cairo_font_options_set_hint_style"
external get_hint_style : t -> hint_style
= "caml_cairo_font_options_get_hint_style"
external set_hint_metrics : t -> hint_metrics -> unit
= "caml_cairo_font_options_set_hint_metrics"
external get_hint_metrics : t -> hint_metrics
= "caml_cairo_font_options_get_hint_metrics"
let make ?(antialias=ANTIALIAS_DEFAULT)
?(subpixel_order=SUBPIXEL_ORDER_DEFAULT)
?(hint_style=HINT_STYLE_DEFAULT) ?(hint_metrics=HINT_METRICS_DEFAULT) () =
let fo = create() in
set_antialias fo antialias;
set_subpixel_order fo subpixel_order;
set_hint_style fo hint_style;
set_hint_metrics fo hint_metrics;
fo
end
type slant = Upright | Italic | Oblique
type weight = Normal | Bold
type font_type =
[ `Toy
| `Ft
| `Win32
| `Quartz
| `User
]
external font_type_init : unit -> unit = "caml_cairo_font_type_init" [@@noalloc]
let () = font_type_init()
module Font_face =
struct
type 'a t
external set : context -> _ t -> unit = "caml_cairo_set_font_face"
external get : context -> font_type t = "caml_cairo_get_font_face"
external get_type : 'a t -> font_type = "caml_cairo_font_face_get_type"
external create_stub : family:string -> slant -> weight -> [`Toy] t
= "caml_cairo_toy_font_face_create"
let create ?(family="") slant weight =
create_stub ~family slant weight
external get_family : [`Toy] t -> string
= "caml_cairo_toy_font_face_get_family"
external get_slant : [`Toy] t -> slant
= "caml_cairo_toy_font_face_get_slant"
external get_weight : [`Toy] t -> weight
= "caml_cairo_toy_font_face_get_weight"
end
module Glyph =
struct
(* type array (\* FIXME: abstract type for cairo_glyph_t* ? *\) *)
type t = glyph = { index: int; x: float; y: float }
type cluster = {
num_bytes : int;
num_glyphs : int;
}
type cluster_flags =
| BACKWARD
external extents : context -> t array -> text_extents
= "caml_cairo_glyph_extents"
external show : context -> t array -> unit = "caml_cairo_show_glyphs"
external show_text : context -> string -> t array ->
cluster array -> cluster_flags -> unit = "caml_cairo_show_text_glyphs"
end
type font_extents = {
ascent : float;
descent : float;
baseline : float;
max_x_advance : float;
max_y_advance : float;
}
module Scaled_font =
struct
type 'a t
external set : context -> _ t -> unit = "caml_cairo_set_scaled_font"
external get : context -> _ t = "caml_cairo_get_scaled_font"
external create : 'a Font_face.t -> Matrix.t -> Matrix.t -> Font_options.t
-> 'a t = "caml_cairo_scaled_font_create"
external extents : _ t -> font_extents = "caml_cairo_scaled_font_extents"
external text_extents : _ t -> string -> text_extents
= "caml_cairo_scaled_font_text_extents"
external glyph_extents : _ t -> Glyph.t array -> text_extents
= "caml_cairo_scaled_font_glyph_extents"
external text_to_glyphs : _ t -> x:float -> y:float -> string
-> Glyph.t array * Glyph.cluster array * Glyph.cluster_flags
= "caml_cairo_scaled_font_text_to_glyphs"
external get_font_face : 'a t -> 'a Font_face.t
= "caml_cairo_scaled_font_get_font_face"
external get_font_options : _ t -> Font_options.t
= "caml_cairo_scaled_font_get_font_options"
external get_font_matrix : _ t -> Matrix.t
= "caml_cairo_scaled_font_get_font_matrix"
external get_ctm : _ t -> Matrix.t = "caml_cairo_scaled_font_get_ctm"
external get_scale_matrix : _ t -> Matrix.t
= "caml_cairo_scaled_font_get_scale_matrix"
external get_type : _ t -> font_type = "caml_cairo_scaled_font_get_type"
end
module Ft = struct
type face
type library
let ft_library = ref None
(* FIXME: is it important to have to possibility to create more than
one library resource? *)
external init_freetype : unit -> library = "caml_cairo_Ft_init_FreeType"
let get_ft_library () = match !ft_library with
| None -> let ft = init_freetype() in
ft_library := Some ft;
ft
| Some ft -> ft
external new_face : library -> string -> int -> face
= "caml_cairo_Ft_new_face"
let face ?library ?(index=0) pathname =
let ft = match library with
| Some l -> l
| None -> get_ft_library() in
new_face ft pathname index
external create_for_ft_face_ :
face -> vertical:bool -> autohint:bool -> [`Ft] Font_face.t
= "caml_cairo_ft_create_for_ft_face"
type flag = [`Vertical_layout | `Force_autohint]
let create_for_ft_face ?(flags=[]) face =
let vertical = ref false in
let autohint = ref false in
List.iter (function `Vertical_layout -> vertical := true
| `Force_autohint -> autohint := true) flags;
create_for_ft_face_ face ~vertical:!vertical ~autohint:!autohint
external create_for_pattern :
?options:Font_options.t -> string -> [`Ft] Font_face.t
= "caml_cairo_ft_create_for_pattern"
external scaled_font_lock_face : [`Ft] Scaled_font.t -> face
= "caml_cairo_ft_scaled_font_lock_face"
external scaled_font_unlock_face : [`Ft] Scaled_font.t -> unit
= "caml_cairo_ft_scaled_font_unlock_face"
module Synthesize = struct
type t = { bold: bool;
oblique: bool }
external get : [`Ft] Font_face.t -> t
= "caml_cairo_ft_synthesize_get"
external set_ : [`Ft] Font_face.t -> bold:bool -> oblique:bool -> unit
= "caml_cairo_ft_synthesize_set"
external unset_ : [`Ft] Font_face.t -> bold:bool -> oblique:bool -> unit
= "caml_cairo_ft_synthesize_unset"
let set ?(bold=false) ?(oblique=false) ff = set_ ff ~bold ~oblique
let unset ?(bold=false) ?(oblique=false) ff = unset_ ff ~bold ~oblique
end
end
external select_font_face : context -> slant -> weight -> string -> unit
= "caml_cairo_select_font_face"
let select_font_face cr ?(slant=Upright) ?(weight=Normal) family =
select_font_face cr slant weight family
external set_font_size : context -> float -> unit
= "caml_cairo_set_font_size"
external set_font_matrix : context -> Matrix.t -> unit
= "caml_cairo_set_font_matrix"
external get_font_matrix : context -> Matrix.t = "caml_cairo_get_font_matrix"
external show_text : context -> string -> unit = "caml_cairo_show_text"
external font_extents : context -> font_extents
= "caml_cairo_font_extents"
external text_extents : context -> string -> text_extents
= "caml_cairo_text_extents"
(* ---------------------------------------------------------------------- *)
module Surface =
struct
type t = surface
external create_similar : t -> content -> w:int -> h:int -> t
= "caml_cairo_surface_create_similar"
external finish : t -> unit = "caml_cairo_surface_finish"
external flush : t -> unit = "caml_cairo_surface_flush"
external get_font_options : t -> Font_options.t
= "caml_cairo_surface_get_font_options"
external get_content : t -> content = "caml_cairo_surface_get_content"
external mark_dirty : t -> unit = "caml_cairo_surface_mark_dirty"
external mark_dirty_rectangle : t -> int -> int -> w:int -> h:int -> unit
= "caml_cairo_surface_mark_dirty_rectangle"
external set_device_offset : t -> float -> float -> unit
= "caml_cairo_surface_set_device_offset"
external get_device_offset : t -> float * float
= "caml_cairo_surface_get_device_offset"
external set_fallback_resolution : t -> x:float -> y:float -> unit
= "caml_cairo_surface_set_fallback_resolution"
external get_fallback_resolution : t -> float * float
= "caml_cairo_surface_get_fallback_resolution"
type kind =
[ `Image
| `PDF
| `PS
| `XLib
| `XCB
| `GLITZ
| `Quartz
| `Win32
| `BEOS
| `DirectFB
| `SVG
| `OS2
| `Win32_printing
| `Quartz_image
| `Recording
]
external init : unit -> unit = "caml_cairo_surface_kind_init"
let () = init()
external get_type : t -> kind = "caml_cairo_surface_get_type"
external copy_page : t -> unit = "caml_cairo_surface_copy_page"
external show_page : t -> unit = "caml_cairo_surface_show_page"
external has_show_text_glyphs : t -> bool
= "caml_cairo_surface_has_show_text_glyphs"
end
module Image =
struct
type format =
| ARGB32
| RGB24
| A8
| A1
external create : format -> w:int -> h:int -> Surface.t
= "caml_cairo_image_surface_create"
external get_format : Surface.t -> format
= "caml_cairo_image_surface_get_format"
external get_width : Surface.t -> int = "caml_cairo_image_surface_get_width"
external get_height : Surface.t -> int = "caml_cairo_image_surface_get_height"
external get_stride : Surface.t -> int = "caml_cairo_image_surface_get_stride"
external stride_for_width : format -> int -> int
= "caml_cairo_format_stride_for_width" [@@noalloc]
open Bigarray
type data8 =
(int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
type data32 =
(int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array2.t
(* These direct bindings assume that the bigarray is large enough *)
external create_for_data8_unsafe : data8 ->
format -> w:int -> h:int -> stride:int -> Surface.t
= "caml_cairo_image_surface_create_for_data8"
external create_for_data32_unsafe : data32 ->
format -> w:int -> h:int -> stride:int -> Surface.t
= "caml_cairo_image_surface_create_for_data32"
let create_for_data8 data ?stride format ~w ~h =
if w <= 0 then invalid_arg "Cairo.Image.create_for_data8: width <= 0";
if h <= 0 then invalid_arg "Cairo.Image.create_for_data8: height <= 0";
let stride = match stride with
| None -> stride_for_width format w
| Some s ->
if s < w (* thus if s <= 0 *) then raise(Error INVALID_STRIDE);
s in
if stride * h > Array1.dim data then
invalid_arg(Printf.sprintf "Cairo.Image.create_for_data8: bigarray too \
small for the required stride=%i and height=%i" stride h);
create_for_data8_unsafe data format ~w ~h ~stride
let create_for_data32 ?w ?h ?(alpha=true) data =
let width = match w with
| None -> Array2.dim2 data
| Some w ->
if w < 0 then
invalid_arg "Cairo.Image.create_for_data32: width < 0";
if w > Array2.dim2 data then
invalid_arg "Cairo.Image.create_for_data32: given width too large";
w in
let height = match h with
| None -> Array2.dim1 data
| Some h ->
if h < 0 then
invalid_arg "Cairo.Image.create_for_data32: height < 0";
if h > Array2.dim1 data then
invalid_arg "Cairo.Image.create_for_data32: given height too large";
h in
let format = if alpha then ARGB32 else RGB24 in
(* Both format use 32 bits = 4 bytes *)
create_for_data32_unsafe data format ~w:width ~h:height
~stride:(4 * Array2.dim2 data)
external get_data8 : Surface.t -> (int, int8_unsigned_elt, c_layout) Array1.t
= "caml_cairo_image_surface_get_UINT8"
external get_data32 : Surface.t -> (int32, int32_elt, c_layout) Array2.t
= "caml_cairo_image_surface_get_INT32"
let get_data32 surface =
let format = get_format surface in
if format <> ARGB32 && format <> RGB24 then
invalid_arg "Cairo.Image.get_data32: image format must be \
ARGB32 or RGB24";
get_data32 surface
let output_ppm fh ?w ?h (data: data32) =
let width = match w with
| None -> Array2.dim1 data
| Some w ->
if w > Array2.dim1 data then
invalid_arg "Cairo.Image.output_ppm: width > Array2.dim1 data";
if w <= 0 then
invalid_arg "Cairo.Image.output_ppm: width <= 0";
w in
let height = match h with
| None -> Array2.dim2 data
| Some h ->
if h > Array2.dim2 data then
invalid_arg "Cairo.Image.output_ppm: height > Array2.dim2 data";
if h <= 0 then
invalid_arg "Cairo.Image.output_ppm: height <= 0";
h in
Printf.fprintf fh "P6 %d %d 255\n" width height;
for i = 0 to width - 1 do
for j = 0 to height - 1 do
(* Output pixel RGB *)
let p = Int32.to_int data.{i, j} in
output_byte fh ((p lsr 16) land 0xFF);
output_byte fh ((p lsr 8) land 0xFF);
output_byte fh (p land 0xFF)
done
done
(* flush fh ?? *)
end
module PDF =
struct
external create_for_stream : (string -> unit) ->
w:float -> h:float -> Surface.t
= "caml_cairo_pdf_surface_create_for_stream"
external create : string -> w:float -> h:float -> Surface.t
= "caml_cairo_pdf_surface_create"
(* Do we want to implement it in terms of [create_for_stream]?
The "problem" is the absence of close function... *)
external set_size : Surface.t -> w:float -> h:float -> unit
= "caml_cairo_pdf_surface_set_size" [@@noalloc]
end
module PNG =
struct
external create : string -> Surface.t
= "caml_cairo_image_surface_create_from_png"
external create_from_stream : input:(string -> int -> unit) -> Surface.t
= "caml_cairo_image_surface_create_from_png_stream"
(* FIXME: must hold the input function to avoid it is being
reclaimed before the surface? *)
external write : Surface.t -> string -> unit
= "caml_cairo_surface_write_to_png"
external write_to_stream : Surface.t -> (string -> unit) -> unit
= "caml_cairo_surface_write_to_png_stream"
end
module PS =
struct
external create_for_stream : (string -> unit) ->
w:float -> h:float -> Surface.t
= "caml_cairo_ps_surface_create_for_stream"
external create : string -> w:float -> h:float -> Surface.t
= "caml_cairo_ps_surface_create"
type level = LEVEL_2 | LEVEL_3
external restrict_to_level : Surface.t -> level -> unit
= "caml_cairo_ps_surface_restrict_to_level"
external get_levels : unit -> level list
= "caml_cairo_ps_get_levels"
external level_to_string : level -> string = "caml_cairo_ps_level_to_string"
external set_eps : Surface.t -> eps:bool -> unit
= "caml_cairo_ps_surface_set_eps"
external get_eps : Surface.t -> bool = "caml_cairo_ps_surface_get_eps"
external set_size : Surface.t -> w:float -> h:float -> unit
= "caml_cairo_ps_surface_set_size"
module Dsc =
struct
external begin_setup : Surface.t -> unit
= "caml_cairo_ps_surface_dsc_begin_setup"
external begin_page_setup : Surface.t -> unit
= "caml_cairo_ps_surface_dsc_begin_page_setup"
external comment : Surface.t -> string -> unit
= "caml_cairo_ps_surface_dsc_comment"
end
end
module SVG =
struct
external create : string -> w:float -> h:float -> Surface.t
= "caml_cairo_svg_surface_create"
external create_for_stream : (string -> unit) ->
w:float -> h:float -> Surface.t
= "caml_cairo_svg_surface_create_for_stream"
type version = VERSION_1_1 | VERSION_1_2
external restrict_to_version : Surface.t -> version -> unit
= "caml_cairo_svg_surface_restrict_to_version"
external get_versions : unit -> version list
= "caml_cairo_svg_get_versions"
external version_to_string : version -> string
= "caml_cairo_svg_version_to_string"
end
module Recording =
struct
external create : ?extents:rectangle -> content -> Surface.t
= "caml_cairo_recording_surface_create"
external ink_extents : Surface.t -> rectangle
= "caml_cairo_recording_surface_ink_extents"
end
(* ---------------------------------------------------------------------- *)
module Pattern =
struct
type 'a t = 'a pattern
type any = any_pattern
external add_color_stop_rgb_stub : [> `Gradient] t -> ofs:float ->
float -> float -> float -> unit
= "caml_cairo_pattern_add_color_stop_rgb" [@@noalloc]
let add_color_stop_rgb cr ?(ofs=0.0) r g b =
add_color_stop_rgb_stub cr ~ofs r g b
external add_color_stop_rgba_stub : [> `Gradient] t -> ofs:float ->
float -> float -> float -> float -> unit
= "caml_cairo_pattern_add_color_stop_rgba_bc"
"caml_cairo_pattern_add_color_stop_rgba" [@@noalloc]
let add_color_stop_rgba cr ?(ofs=0.0) r g b a =
add_color_stop_rgba_stub cr ~ofs r g b a
external get_color_stop_count : [> `Gradient] t -> int
= "caml_cairo_pattern_get_color_stop_count"
external get_color_stop_rgba : [> `Gradient] t -> idx:int ->
float * float * float * float * float
= "caml_cairo_pattern_get_color_stop_rgba"
(* FIXME: do we want to iterate over the colors instead ?? *)
external create_rgb : float -> float -> float -> [`Solid] t
= "caml_cairo_pattern_create_rgb"
external create_rgba : float -> float -> float -> float -> [`Solid] t
= "caml_cairo_pattern_create_rgba"
external get_rgba : [> `Solid] t -> float * float * float * float
= "caml_cairo_pattern_get_rgba"
external create_for_surface : Surface.t -> [`Surface] t
= "caml_cairo_pattern_create_for_surface"
external get_surface : [`Surface] t -> Surface.t
= "caml_cairo_pattern_get_surface"
external create_linear : x0:float -> y0:float -> x1:float -> y1:float ->
[`Linear | `Gradient] t = "caml_cairo_pattern_create_linear"
external get_linear_points : [> `Linear|`Gradient] t
-> float * float * float * float = "caml_cairo_pattern_get_linear_points"
external create_radial : x0:float -> y0:float -> r0:float ->
x1:float -> y1:float -> r1:float -> [`Radial | `Gradient] t
= "caml_cairo_pattern_create_radial_bc" "caml_cairo_pattern_create_radial"
external get_radial_circles : [> `Radial|`Gradient] t ->
float * float * float * float * float * float
= "caml_cairo_pattern_get_radial_circles"
type extend =
| NONE
| REPEAT
| REFLECT
| PAD
external set_extend : 'a t -> extend -> unit
= "caml_cairo_pattern_set_extend" [@@noalloc]
external get_extend : 'a t -> extend = "caml_cairo_pattern_get_extend"
type filter =
| FAST
| GOOD
| BEST
| NEAREST
| BILINEAR
(* | GAUSSIAN *)
external set_filter : 'a t -> filter -> unit
= "caml_cairo_pattern_set_filter" [@@noalloc]
external get_filter : 'a t -> filter = "caml_cairo_pattern_get_filter"
external set_matrix : 'a t -> Matrix.t -> unit
= "caml_cairo_pattern_set_matrix" [@@noalloc]
external get_matrix : 'a t -> Matrix.t = "caml_cairo_pattern_get_matrix"
end
(* ---------------------------------------------------------------------- *)
(* Transformations - Manipulating the current transformation matrix *)
external translate : context -> float -> float -> unit
= "caml_cairo_translate"
external scale : context -> float -> float -> unit = "caml_cairo_scale"
external rotate : context -> float -> unit = "caml_cairo_rotate"
external transform : context -> Matrix.t -> unit
= "caml_cairo_transform" [@@noalloc]
external set_matrix : context -> Matrix.t -> unit
= "caml_cairo_set_matrix" [@@noalloc]
external get_matrix : context -> Matrix.t = "caml_cairo_get_matrix"
external identity_matrix : context -> unit = "caml_cairo_identity_matrix"
external user_to_device : context -> float -> float -> float * float
= "caml_cairo_user_to_device"
external user_to_device_distance :
context -> float -> float -> float * float
= "caml_cairo_user_to_device_distance"
external device_to_user : context -> float -> float -> float * float
= "caml_cairo_device_to_user"
external device_to_user_distance :
context -> float -> float -> float * float
= "caml_cairo_device_to_user_distance"
ocaml-cairo/src/dune 0000644 0001750 0001750 00000000776 13446257732 014632 0 ustar treinen treinen (library
(name cairo)
(public_name cairo2)
(flags :standard -w -50); Remove warning 50 for OCaml 4.02.3
(c_names cairo_stubs)
(c_flags :standard (:include c_flags.sexp))
(c_library_flags :standard (:include c_library_flags.sexp))
(install_c_headers cairo_ocaml)
(libraries bigarray)
(synopsis "Binding to Cairo, a 2D Vector Graphics Library"))
(rule
(targets c_flags.sexp c_library_flags.sexp cairo_ocaml.h)
(deps cairo_ocaml.h.p)
(action (run ../config/discover.exe)))
ocaml-cairo/src/cairo_macros.h 0000644 0001750 0001750 00000024365 13446257732 016566 0 ustar treinen treinen #define SET_MALLOC(x, size, type) \
x = (type *) malloc(size * sizeof(type)); \
if (x == NULL) caml_raise_out_of_memory()
#define FLOAT_ARRAY_LENGTH(a) Wosize_val(a) / Double_wosize
#define SET_FLOAT_ARRAY(p, varray, length) \
SET_MALLOC(p, length, double); \
for(i = 0; i < length; i++) p[i] = Double_field(varray, i)
#define FREE_FLOAT_ARRAY(p) free(p)
#define DO_CONTEXT(name) \
CAMLexport value caml_##name(value vcr) \
{ \
CAMLparam1(vcr); \
cairo_t *cr = CAIRO_VAL(vcr); \
name(cr); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
}
#define DO1_CONTEXT(name, of_value) \
CAMLexport value caml_##name(value vcr, value v) \
{ \
CAMLparam2(vcr, v); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_value(v)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
}
#define DO2_CONTEXT(name, of_val1, of_val2) \
CAMLexport value caml_##name(value vcr, value v1, value v2) \
{ \
CAMLparam3(vcr, v1, v2); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
}
#define DO3_CONTEXT(name, of_val1, of_val2, of_val3) \
CAMLexport value caml_##name(value vcr, value v1, value v2, value v3) \
{ \
CAMLparam4(vcr, v1, v2, v3); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2), of_val3(v3)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
}
#define DO4_CONTEXT(name, of_val1, of_val2, of_val3, of_val4) \
CAMLexport value caml_##name(value vcr, value v1, value v2, value v3, \
value v4) \
{ \
CAMLparam5(vcr, v1, v2, v3, v4); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2), of_val3(v3), of_val4(v4)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
}
#define DO5_CONTEXT(name, of_val1, of_val2, of_val3, of_val4, of_val5) \
CAMLexport value caml_##name(value vcr, value v1, value v2, value v3, \
value v4, value v5) \
{ \
CAMLparam5(vcr, v1, v2, v3, v4); \
CAMLxparam1(v5); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2), of_val3(v3), of_val4(v4), \
of_val5(v5)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
} \
\
CAMLexport value caml_##name##_bc(value * argv, int argn) \
{ \
return caml_##name(argv[0], argv[1], argv[2], argv[3], argv[4], \
argv[5]); \
}
#define DO6_CONTEXT(name, of_val1, of_val2, of_val3, of_val4, of_val5, \
of_val6) \
CAMLexport value caml_##name(value vcr, value v1, value v2, value v3, \
value v4, value v5, value v6) \
{ \
CAMLparam5(vcr, v1, v2, v3, v4); \
CAMLxparam2(v5, v6); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2), of_val3(v3), of_val4(v4), \
of_val5(v5), of_val6(v6)); \
caml_check_status(cr); \
CAMLreturn(Val_unit); \
} \
\
CAMLexport value caml_##name##_bc(value * argv, int argn) \
{ \
return caml_##name(argv[0], argv[1], argv[2], argv[3], argv[4], \
argv[5], argv[6]); \
}
/* The return value should not require special alloc. */
#define GET_CONTEXT(name, value_of, ty) \
CAMLexport value caml_##name(value vcr) \
{ \
CAMLparam1(vcr); \
cairo_t* cr = CAIRO_VAL(vcr); \
ty r = name(cr); \
caml_check_status(cr); \
CAMLreturn(value_of(r)); \
}
/* As recommended in the section "Multiple return values" of the cairo
* documentation, map the "extents" to the "rectangle" representation. */
#define GET_EXTENTS(name) \
CAMLexport value caml_##name(value vcr) \
{ \
CAMLparam1(vcr); \
CAMLlocal1(bb); \
cairo_t* cr = CAIRO_VAL(vcr); \
double x1, y1, x2, y2; \
name(cr, &x1, &y1, &x2, &y2); \
caml_check_status(cr); \
/* Create record (of only floats) */ \
bb = caml_alloc(4 * Double_wosize, Double_array_tag); \
Store_double_field(bb, 0, x1); \
Store_double_field(bb, 1, y1); \
Store_double_field(bb, 2, x2 - x1); \
Store_double_field(bb, 3, y2 - y1); \
CAMLreturn(bb); \
}
/* Surface
***********************************************************************/
#define DO_SURFACE(name) \
CAMLexport value caml_##name(value vsurf) \
{ \
/* noalloc */ \
cairo_surface_t *surface = SURFACE_VAL(vsurf); \
name(surface); \
caml_cairo_raise_Error(cairo_surface_status(surface)); \
return(Val_unit); \
}
#define DO1_SURFACE(name, of_val1) \
CAMLexport value caml_##name(value vsurf, value v1) \
{ \
/* noalloc */ \
cairo_surface_t *surface = SURFACE_VAL(vsurf); \
name(surface, of_val1(v1)); \
caml_cairo_raise_Error(cairo_surface_status(surface)); \
return(Val_unit); \
}
#define DO2_SURFACE(name, of_val1, of_val2) \
CAMLexport value caml_##name(value vsurf, value v1, value v2) \
{ \
/* noalloc */ \
cairo_surface_t *surface = SURFACE_VAL(vsurf); \
name(surface, of_val1(v1), of_val2(v2)); \
caml_cairo_raise_Error(cairo_surface_status(surface)); \
return(Val_unit); \
}
/* Unavailable Cairo backend functions
***********************************************************************/
/* holds the pointer to the Unavailable exception; shared several
functions. */
value * caml_cairo_Unavailable = NULL;
#define RAISE_UNAVAILABLE(name, args ...) \
CAMLexport value caml_##name(args) \
{ \
if (caml_cairo_Unavailable == NULL) \
caml_cairo_Unavailable = caml_named_value("Cairo.Unavailable"); \
caml_raise_constant(* caml_cairo_Unavailable); \
} \
#define UNAVAILABLE1(name) RAISE_UNAVAILABLE(name, value v1)
#define UNAVAILABLE2(name) RAISE_UNAVAILABLE(name, value v1, value v2)
#define UNAVAILABLE3(name) RAISE_UNAVAILABLE(name, value v1, value v2, value v3)
#define UNAVAILABLE4(name) RAISE_UNAVAILABLE(name, value v1, value v2, \
value v3, value v4)
#define UNAVAILABLE5(name) RAISE_UNAVAILABLE(name, value v1, value v2, \
value v3, value v4, value v5)
ocaml-cairo/src/cairo_stubs.c 0000644 0001750 0001750 00000177343 13446257732 016442 0 ustar treinen treinen /* File: cairo_stubs.c
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation. See the file
LICENCE for more details.
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 file
LICENSE for more details. */
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include "cairo_macros.h"
#include "cairo_ocaml_types.h"
/* cairo_t functions.
***********************************************************************/
CAMLexport value caml_cairo_create(value vsurf)
{
CAMLparam1(vsurf);
CAMLlocal1(vcontext);
cairo_t *cr;
cr = cairo_create(SURFACE_VAL(vsurf));
caml_check_status(cr);
/* Cairo documentation says that [cairo_create] "references target,
so you can immediately call cairo_surface_destroy() on it if you
don't need to maintain a separate reference to it". We leave
destroying the surface to the GC but that means there is no need
to increase the reference of [vsurf]. */
CAIRO_ASSIGN(vcontext, cr);
CAMLreturn(vcontext);
}
DO_CONTEXT(cairo_save)
DO_CONTEXT(cairo_restore)
CAMLexport value caml_cairo_get_target(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vsurf);
cairo_t *cr = CAIRO_VAL(vcr);
cairo_surface_t* surf = cairo_get_target(cr);
caml_check_status(cr);
/* This returns a surface value [vsurf] which will be GC. In order
to avoid that GC [vsurf] destroy the underlying surface too soon,
one must increase its ref count. */
cairo_surface_reference(surf);
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
DO_CONTEXT(cairo_push_group)
CAMLexport value caml_cairo_push_group_with_content(value vcr, value vcontent)
{
CAMLparam2(vcr, vcontent);
cairo_t *cr = CAIRO_VAL(vcr);
cairo_content_t content;
SET_CONTENT_VAL(content, vcontent);
cairo_push_group_with_content(cr, content);
caml_check_status(cr);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_pop_group(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vpat);
cairo_t *cr = CAIRO_VAL(vcr);
cairo_pattern_t* pat = cairo_pop_group(cr);
caml_check_status(cr);
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
DO_CONTEXT(cairo_pop_group_to_source)
CAMLexport value caml_cairo_get_group_target(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vsurf);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_surface_t* surf = cairo_get_group_target(cr);
caml_check_status(cr);
/* New GC value [vsurf] depending on a (shared) surface => incr ref
count (see caml_cairo_get_target). */
cairo_surface_reference(surf);
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
DO3_CONTEXT(cairo_set_source_rgb, Double_val, Double_val, Double_val)
DO4_CONTEXT(cairo_set_source_rgba, Double_val, Double_val,
Double_val, Double_val)
DO3_CONTEXT(cairo_set_source_surface, SURFACE_VAL, Double_val, Double_val)
DO1_CONTEXT(cairo_set_source, PATTERN_VAL)
CAMLexport value caml_cairo_get_source(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vpat);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_pattern_t* pat = cairo_get_source(cr);
caml_check_status(cr);
/* New value [vpat] sharing the pattern => incr ref count. */
cairo_pattern_reference(pat);
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
#define ANTIALIAS_VAL(v) ((cairo_antialias_t) Int_val(v))
#define VAL_ANTIALIAS(v) Val_int(v)
DO1_CONTEXT(cairo_set_antialias, ANTIALIAS_VAL)
GET_CONTEXT(cairo_get_antialias, VAL_ANTIALIAS, cairo_antialias_t)
CAMLexport value caml_cairo_set_dash(value vcr, value vdashes, value voffset)
{
CAMLparam3(vcr, vdashes, voffset);
cairo_t* cr = CAIRO_VAL(vcr);
double *dashes;
const int num_dashes = FLOAT_ARRAY_LENGTH(vdashes);
int i;
SET_FLOAT_ARRAY(dashes, vdashes, num_dashes);
cairo_set_dash(cr, dashes, num_dashes, Double_val(voffset));
FREE_FLOAT_ARRAY(dashes);
caml_check_status(cr);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_get_dash(value vcr)
{
CAMLparam1(vcr);
CAMLlocal2(couple, vdashes);
cairo_t* cr = CAIRO_VAL(vcr);
int num_dashes = cairo_get_dash_count(cr);
double *dashes;
double offset;
int i;
couple = caml_alloc_tuple(2);
if (num_dashes == 0) { /* return ([||], 0.) */
Store_field(couple, 0, caml_alloc_tuple(0)); /* [||] */
Store_field(couple, 1, caml_copy_double(0.0));
}
else {
/* Alloc the Caml value first in case it raises an exn */
vdashes = caml_alloc(num_dashes * Double_wosize, Double_array_tag);
SET_MALLOC(dashes, num_dashes, double);
cairo_get_dash(cr, dashes, &offset);
for(i = 0; i < num_dashes; i++)
Store_double_field(vdashes, i, dashes[i]);
Store_field(couple, 0, vdashes);
Store_field(couple, 1, caml_copy_double(offset));
free(dashes);
}
CAMLreturn(couple);
}
#define FILL_RULE_VAL(v) ((cairo_fill_rule_t) Int_val(v))
#define VAL_FILL_RULE(v) Val_int(v)
DO1_CONTEXT(cairo_set_fill_rule, FILL_RULE_VAL)
GET_CONTEXT(cairo_get_fill_rule, VAL_FILL_RULE, cairo_fill_rule_t)
#define LINE_CAP_VAL(v) ((cairo_line_cap_t) Int_val(v))
#define VAL_LINE_CAP(v) Val_int(v)
DO1_CONTEXT(cairo_set_line_cap, LINE_CAP_VAL)
GET_CONTEXT(cairo_get_line_cap, VAL_LINE_CAP, cairo_line_cap_t)
#define LINE_JOIN_VAL(v) ((cairo_line_join_t) Int_val(v))
#define VAL_LINE_JOIN(v) Val_int(v)
DO1_CONTEXT(cairo_set_line_join, LINE_JOIN_VAL)
GET_CONTEXT(cairo_get_line_join, VAL_LINE_JOIN, cairo_line_join_t)
DO1_CONTEXT(cairo_set_line_width, Double_val)
GET_CONTEXT(cairo_get_line_width, caml_copy_double, double)
DO1_CONTEXT(cairo_set_miter_limit, Double_val)
GET_CONTEXT(cairo_get_miter_limit, caml_copy_double, double)
#define OPERATOR_VAL(v) ((cairo_operator_t) Int_val(v))
#define VAL_OPERATOR(v) Val_int(v)
DO1_CONTEXT(cairo_set_operator, OPERATOR_VAL)
GET_CONTEXT(cairo_get_operator, VAL_OPERATOR, cairo_operator_t)
DO1_CONTEXT(cairo_set_tolerance, Double_val)
GET_CONTEXT(cairo_get_tolerance, caml_copy_double, double)
DO_CONTEXT(cairo_clip)
DO_CONTEXT(cairo_clip_preserve)
GET_EXTENTS(cairo_clip_extents)
DO_CONTEXT(cairo_reset_clip)
CAMLexport value caml_cairo_copy_clip_rectangle_list(value vcr)
{
CAMLparam1(vcr);
CAMLlocal3(vlist, vrec, cons);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_rectangle_list_t* list = cairo_copy_clip_rectangle_list(cr);
int i;
cairo_rectangle_t *r;
/* assert(list != NULL); */
caml_cairo_raise_Error(list->status);
vlist = Val_int(0); /* [] */
for(i = 0, r = list->rectangles; i < list->num_rectangles; i++, r++) {
/* New rectangle (pure float record) */
vrec = caml_alloc(4 * Double_wosize, Double_array_tag);
Store_double_field(vrec, 0, r->x);
Store_double_field(vrec, 1, r->y);
Store_double_field(vrec, 2, r->width);
Store_double_field(vrec, 3, r->height);
/* New cons cell */
cons = caml_alloc_tuple(2);
Store_field(cons, 0, vrec);
Store_field(cons, 1, vlist);
vlist = cons;
}
cairo_rectangle_list_destroy(list);
CAMLreturn(vlist);
}
DO_CONTEXT(cairo_fill)
DO_CONTEXT(cairo_fill_preserve)
GET_EXTENTS(cairo_fill_extents)
CAMLexport value caml_cairo_in_fill(value vcr, value vx, value vy)
{
CAMLparam3(vcr, vx, vy);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_bool_t b = cairo_in_fill(cr, Double_val(vx), Double_val(vy));
caml_check_status(cr);
/* doc of cairo_bool_t: b=0 or 1 */
CAMLreturn(Val_int(b));
}
DO1_CONTEXT(cairo_mask, PATTERN_VAL)
CAMLexport value caml_cairo_mask_surface(value vcr, value vsurf,
value vx, value vy)
{
CAMLparam4(vcr, vsurf, vx, vy);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_mask_surface(cr, SURFACE_VAL(vsurf), Double_val(vx), Double_val(vy));
caml_check_status(cr);
CAMLreturn(Val_unit);
}
DO_CONTEXT(cairo_paint)
DO1_CONTEXT(cairo_paint_with_alpha, Double_val)
DO_CONTEXT(cairo_stroke)
DO_CONTEXT(cairo_stroke_preserve)
GET_EXTENTS(cairo_stroke_extents)
CAMLexport value caml_cairo_in_stroke(value vcr, value vx, value vy)
{
CAMLparam3(vcr, vx, vy);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_bool_t b = cairo_in_stroke(cr, Double_val(vx), Double_val(vy));
caml_check_status(cr);
/* doc of cairo_bool_t: b=0 or 1 */
CAMLreturn(Val_int(b));
}
DO_CONTEXT(cairo_copy_page)
DO_CONTEXT(cairo_show_page)
/* Paths -- Creating paths and manipulating path data
***********************************************************************/
CAMLexport value caml_cairo_copy_path(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vpath);
cairo_path_t* path = cairo_copy_path(CAIRO_VAL(vcr));
caml_cairo_raise_Error(path->status);
PATH_ASSIGN(vpath, path);
CAMLreturn(vpath);
}
CAMLexport value caml_cairo_copy_path_flat(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vpath);
cairo_path_t* path = cairo_copy_path_flat(CAIRO_VAL(vcr));
caml_cairo_raise_Error(path->status);
PATH_ASSIGN(vpath, path);
CAMLreturn(vpath);
}
DO1_CONTEXT(cairo_append_path, PATH_VAL)
CAMLexport value caml_cairo_get_current_point(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vcouple);
cairo_t* cr = CAIRO_VAL(vcr);
double x, y;
cairo_get_current_point(cr, &x, &y);
caml_check_status(cr);
/* Couple (x,y) */
vcouple = caml_alloc_tuple(2);
Store_field(vcouple, 0, caml_copy_double(x));
Store_field(vcouple, 1, caml_copy_double(y));
CAMLreturn(vcouple);
}
DO_CONTEXT(cairo_new_path)
DO_CONTEXT(cairo_new_sub_path)
DO_CONTEXT(cairo_close_path)
CAMLexport value caml_cairo_glyph_path(value vcr, value vglyphs)
{
CAMLparam2(vcr, vglyphs);
cairo_t* cr = CAIRO_VAL(vcr);
cairo_glyph_t *glyphs, *p;
int i, num_glyphs;
ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs);
cairo_glyph_path(cr, glyphs, num_glyphs);
free(glyphs);
caml_check_status(cr);
CAMLreturn(Val_unit);
}
DO1_CONTEXT(cairo_text_path, String_val)
GET_EXTENTS(cairo_path_extents)
DO5_CONTEXT(cairo_arc, Double_val, Double_val, Double_val, Double_val,
Double_val)
DO5_CONTEXT(cairo_arc_negative, Double_val, Double_val, Double_val,
Double_val, Double_val)
DO6_CONTEXT(cairo_curve_to, Double_val, Double_val, Double_val,
Double_val, Double_val, Double_val)
DO2_CONTEXT(cairo_line_to, Double_val, Double_val)
DO2_CONTEXT(cairo_move_to, Double_val, Double_val)
DO4_CONTEXT(cairo_rectangle, Double_val, Double_val, Double_val, Double_val)
DO6_CONTEXT(cairo_rel_curve_to, Double_val, Double_val, Double_val,
Double_val, Double_val, Double_val)
DO2_CONTEXT(cairo_rel_line_to, Double_val, Double_val)
DO2_CONTEXT(cairo_rel_move_to, Double_val, Double_val)
/* Interacting with the paths content from OCaml. */
CAMLexport value caml_cairo_path_fold(value vpath, value fn, value va)
{
CAMLparam3(vpath, fn, va);
CAMLlocal2(vacc, vdata);
cairo_path_t * path = PATH_VAL(vpath);
cairo_path_data_t *data;
int i;
vacc = va;
for(i = 0; i < path->num_data; i += path->data[i].header.length) {
data = &path->data[i];
PATH_DATA_ASSIGN(vdata, data);
vdata = caml_callback2(fn, vacc, vdata);
}
CAMLreturn(vacc);
}
CAMLexport value caml_cairo_path_to_array(value vpath)
{
CAMLparam1(vpath);
CAMLlocal2(varray, vdata);
cairo_path_t * path = PATH_VAL(vpath);
cairo_path_data_t *data;
int i, el;
/* Determine the number of elements in the path. */
el = 0;
for(i = 0; i < path->num_data; i += path->data[i].header.length)
el++;
varray = caml_alloc_tuple(el);
/* Assign each element of the array. */
el = 0;
for(i = 0; i < path->num_data; i += path->data[i].header.length) {
data = &path->data[i];
PATH_DATA_ASSIGN(vdata, data);
Store_field(varray, el, vdata);
el++;
}
CAMLreturn(varray);
}
CAMLexport value caml_cairo_path_of_array(value varray)
{
CAMLparam1(varray);
CAMLlocal2(vpath, vdata);
int length = Wosize_val(varray);
cairo_path_t* path;
cairo_path_data_t *data;
int i, j, num_data;
SET_MALLOC(path, 1, cairo_path_t);
path->status = CAIRO_STATUS_SUCCESS;
/* Compute the total length */
num_data = 0;
#define ADD1 num_data += 1
#define ADD2(x,y) num_data += 2 /* 1 header + 1 point */
#define ADD4(x1,y1, x2,y2, x3,y3) num_data += 4 /* 1 header + 3 point */
for(i = 0; i < length; i++) {
vdata = Field(varray, i);
SWITCH_PATH_DATA(vdata, ADD2, ADD2, ADD4, ADD1);
}
path->num_data = num_data;
#define MOVE(x1,y1) \
data->header.type = CAIRO_PATH_MOVE_TO; \
data->header.length = 2; \
data[1].point.x = Double_val(x1); \
data[1].point.y = Double_val(y1)
#define LINE(x1,y1) \
data->header.type = CAIRO_PATH_LINE_TO; \
data->header.length = 2; \
data[1].point.x = Double_val(x1); \
data[1].point.y = Double_val(y1)
#define CURVE(x1,y1, x2,y2, x3,y3) \
data->header.type = CAIRO_PATH_CURVE_TO; \
data->header.length = 4; \
data[1].point.x = Double_val(x1); \
data[1].point.y = Double_val(y1); \
data[2].point.x = Double_val(x2); \
data[2].point.y = Double_val(y2); \
data[3].point.x = Double_val(x3); \
data[3].point.y = Double_val(y3)
#define CLOSE \
data->header.type = CAIRO_PATH_CLOSE_PATH; \
data->header.length = 1;
path->data = malloc(num_data * sizeof(cairo_path_data_t));
if (path->data == NULL) {
free(path); /* free previously allocated memory */
caml_raise_out_of_memory();
}
for(i = 0, j = 0; j < num_data; i++, j += data->header.length) {
vdata = Field(varray, i);
data = &path->data[j];
SWITCH_PATH_DATA(vdata, MOVE, LINE, CURVE, CLOSE);
}
PATH_ASSIGN(vpath, path); /* vpath points to path */
CAMLreturn(vpath);
}
/* Patterns -- Sources for drawing
***********************************************************************/
CAMLexport value caml_cairo_pattern_add_color_stop_rgb
(value vpat, value vofs, value vr, value vg, value vb)
{
/* noalloc */
cairo_pattern_add_color_stop_rgb(PATTERN_VAL(vpat), Double_val(vofs),
Double_val(vr), Double_val(vg),
Double_val(vb));
return(Val_unit);
}
CAMLexport value caml_cairo_pattern_add_color_stop_rgba
(value vpat, value vofs, value vr, value vg, value vb, value va)
{
/* noalloc */
cairo_pattern_add_color_stop_rgba(PATTERN_VAL(vpat), Double_val(vofs),
Double_val(vr), Double_val(vg),
Double_val(vb), Double_val(va));
return(Val_unit);
}
CAMLexport value caml_cairo_pattern_add_color_stop_rgba_bc
(value * argv, int argn)
{
return caml_cairo_pattern_add_color_stop_rgba
(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]);
}
CAMLexport value caml_cairo_pattern_get_color_stop_count(value vpat)
{
CAMLparam1(vpat);
int count;
cairo_status_t st = cairo_pattern_get_color_stop_count(PATTERN_VAL(vpat),
&count);
caml_cairo_raise_Error(st);
CAMLreturn(Val_int(count));
}
CAMLexport value caml_cairo_pattern_get_color_stop_rgba(value vpat,
value vidx)
{
CAMLparam2(vpat, vidx);
CAMLlocal1(vcolors);
double offset, red, green, blue, alpha;
cairo_status_t st = cairo_pattern_get_color_stop_rgba
(PATTERN_VAL(vpat), Int_val(vidx), &offset, &red, &green, &blue, &alpha);
caml_cairo_raise_Error(st);
/* tuple (offset, red, green, blue, alpha) */
vcolors = caml_alloc_tuple(5);
Store_field(vcolors, 0, caml_copy_double(offset));
Store_field(vcolors, 1, caml_copy_double(red));
Store_field(vcolors, 2, caml_copy_double(green));
Store_field(vcolors, 3, caml_copy_double(blue));
Store_field(vcolors, 4, caml_copy_double(alpha));
CAMLreturn(vcolors);
}
CAMLexport value caml_cairo_pattern_create_rgb(value vr, value vg, value vb)
{
CAMLparam3(vr,vg,vb);
CAMLlocal1(vpat);
cairo_pattern_t* pat = cairo_pattern_create_rgb(Double_val(vr),
Double_val(vg),
Double_val(vb));
caml_cairo_raise_Error(cairo_pattern_status(pat));
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
CAMLexport value caml_cairo_pattern_create_rgba(value vr, value vg, value vb,
value va)
{
CAMLparam4(vr,vg,vb,va);
CAMLlocal1(vpat);
cairo_pattern_t* pat = cairo_pattern_create_rgba(Double_val(vr),
Double_val(vg),
Double_val(vb),
Double_val(va));
caml_cairo_raise_Error(cairo_pattern_status(pat));
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
CAMLexport value caml_cairo_pattern_get_rgba(value vpat)
{
CAMLparam1(vpat);
CAMLlocal1(vrgba);
double red, green, blue, alpha;
cairo_status_t st = cairo_pattern_get_rgba(PATTERN_VAL(vpat),
&red, &green, &blue, &alpha);
caml_cairo_raise_Error(st);
vrgba = caml_alloc_tuple(4);
Store_field(vrgba, 0, caml_copy_double(red));
Store_field(vrgba, 1, caml_copy_double(green));
Store_field(vrgba, 2, caml_copy_double(blue));
Store_field(vrgba, 3, caml_copy_double(alpha));
CAMLreturn(vrgba);
}
CAMLexport value caml_cairo_pattern_create_for_surface(value vsurf)
{
CAMLparam1(vsurf);
CAMLlocal1(vpat);
cairo_pattern_t* pat = cairo_pattern_create_for_surface(SURFACE_VAL(vsurf));
caml_cairo_raise_Error(cairo_pattern_status(pat));
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
CAMLexport value caml_cairo_pattern_get_surface(value vpat)
{
CAMLparam1(vpat);
CAMLlocal1(vsurf);
cairo_surface_t *surface;
cairo_status_t st = cairo_pattern_get_surface(PATTERN_VAL(vpat),
&surface);
caml_cairo_raise_Error(st);
/* The surface is shared with the pattern => incr ref count. */
cairo_surface_reference(surface);
SURFACE_ASSIGN(vsurf, surface);
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_pattern_create_linear
(value vx0, value vy0, value vx1, value vy1)
{
CAMLparam4(vx0, vy0, vx1, vy1);
CAMLlocal1(vpat);
cairo_pattern_t* pat = cairo_pattern_create_linear
(Double_val(vx0), Double_val(vy0), Double_val(vx1), Double_val(vy1));
caml_cairo_raise_Error(cairo_pattern_status(pat));
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
CAMLexport value caml_cairo_pattern_get_linear_points(value vpat)
{
CAMLparam1(vpat);
CAMLlocal1(vcoord);
double x0, y0, x1, y1;
cairo_status_t st = cairo_pattern_get_linear_points
(PATTERN_VAL(vpat), &x0, &y0, &x1, &y1);
caml_cairo_raise_Error(st);
vcoord = caml_alloc_tuple(4);
Store_field(vcoord, 0, caml_copy_double(x0));
Store_field(vcoord, 1, caml_copy_double(y0));
Store_field(vcoord, 2, caml_copy_double(x1));
Store_field(vcoord, 3, caml_copy_double(y1));
CAMLreturn(vcoord);
}
CAMLexport value caml_cairo_pattern_create_radial
(value vx0, value vy0, value vr0, value vx1, value vy1, value vr1)
{
CAMLparam5(vx0, vy0, vr0, vx1, vy1);
CAMLxparam1(vr1);
CAMLlocal1(vpat);
cairo_pattern_t* pat = cairo_pattern_create_radial
(Double_val(vx0), Double_val(vy0), Double_val(vr0),
Double_val(vx1), Double_val(vy1), Double_val(vr1));
caml_cairo_raise_Error(cairo_pattern_status(pat));
PATTERN_ASSIGN(vpat, pat);
CAMLreturn(vpat);
}
CAMLexport value caml_cairo_pattern_create_radial_bc(value * argv, int argn)
{
return caml_cairo_pattern_create_radial(argv[0], argv[1], argv[2], argv[3],
argv[4], argv[5]);
}
CAMLexport value caml_cairo_pattern_get_radial_circles(value vpat)
{
CAMLparam1(vpat);
CAMLlocal1(vcircles);
double x0, y0, r0, x1, y1, r1;
cairo_status_t st = cairo_pattern_get_radial_circles
(PATTERN_VAL(vpat), &x0, &y0, &r0, &x1, &y1, &r1);
caml_cairo_raise_Error(st);
vcircles = caml_alloc_tuple(6);
Store_field(vcircles, 0, caml_copy_double(x0));
Store_field(vcircles, 1, caml_copy_double(y0));
Store_field(vcircles, 2, caml_copy_double(r0));
Store_field(vcircles, 3, caml_copy_double(x1));
Store_field(vcircles, 4, caml_copy_double(y1));
Store_field(vcircles, 5, caml_copy_double(r1));
CAMLreturn(vcircles);
}
CAMLexport value caml_cairo_pattern_set_extend(value vpat, value vextend)
{
/* noalloc */
cairo_pattern_set_extend(PATTERN_VAL(vpat), EXTEND_VAL(vextend));
return(Val_unit);
}
CAMLexport value caml_cairo_pattern_get_extend(value vpat)
{
CAMLparam1(vpat);
cairo_extend_t extend = cairo_pattern_get_extend(PATTERN_VAL(vpat));
CAMLreturn(VAL_EXTEND(extend));
}
CAMLexport value caml_cairo_pattern_set_filter(value vpat, value vfilter)
{
/* noalloc */
cairo_pattern_set_filter(PATTERN_VAL(vpat), FILTER_VAL(vfilter));
return(Val_unit);
}
CAMLexport value caml_cairo_pattern_get_filter(value vpat)
{
CAMLparam1(vpat);
cairo_filter_t filter = cairo_pattern_get_filter(PATTERN_VAL(vpat));
CAMLreturn(VAL_FILTER(filter));
}
CAMLexport value caml_cairo_pattern_set_matrix(value vpat, value vmat)
{
/* noalloc */
ALLOC_CAIRO_MATRIX(vmat);
cairo_pattern_set_matrix(PATTERN_VAL(vpat), GET_MATRIX(vmat));
return(Val_unit);
}
CAMLexport value caml_cairo_pattern_get_matrix(value vpat)
{
CAMLparam1(vpat);
CAMLlocal1(vmat);
WITH_MATRIX_DO(vmat,
cairo_pattern_get_matrix(PATTERN_VAL(vpat), GET_MATRIX(vmat)));
CAMLreturn(vmat);
}
/* Transformations - Manipulating the current transformation matrix
***********************************************************************/
DO2_CONTEXT(cairo_translate, Double_val, Double_val)
DO2_CONTEXT(cairo_scale, Double_val, Double_val)
DO1_CONTEXT(cairo_rotate, Double_val)
CAMLexport value caml_cairo_transform(value vcr, value vmat)
{
/* noalloc */
ALLOC_CAIRO_MATRIX(vmat);
cairo_transform(CAIRO_VAL(vcr), GET_MATRIX(vmat));
return(Val_unit);
}
CAMLexport value caml_cairo_set_matrix(value vcr, value vmat)
{
/* noalloc */
ALLOC_CAIRO_MATRIX(vmat);
cairo_set_matrix(CAIRO_VAL(vcr), GET_MATRIX(vmat));
return(Val_unit);
}
CAMLexport value caml_cairo_get_matrix(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vmat);
WITH_MATRIX_DO(vmat,
cairo_get_matrix(CAIRO_VAL(vcr), GET_MATRIX(vmat)));
CAMLreturn(vmat);
}
DO_CONTEXT(cairo_identity_matrix)
#define COORD_TRANSFORM(name) \
CAMLexport value caml_##name(value vcr, value vx, value vy) \
{ \
CAMLparam3(vcr, vx, vy); \
CAMLlocal1(vcouple); \
cairo_t* cr = CAIRO_VAL(vcr); \
double x = Double_val(vx); \
double y = Double_val(vy); \
name(cr, &x, &y); \
vcouple = caml_alloc_tuple(2); \
Store_field(vcouple, 0, caml_copy_double(x)); \
Store_field(vcouple, 1, caml_copy_double(y)); \
CAMLreturn(vcouple); \
}
COORD_TRANSFORM(cairo_user_to_device)
COORD_TRANSFORM(cairo_user_to_device_distance)
COORD_TRANSFORM(cairo_device_to_user)
COORD_TRANSFORM(cairo_device_to_user_distance)
/* Font options
***********************************************************************/
DO1_CONTEXT(cairo_set_font_options, FONT_OPTIONS_VAL)
CAMLexport value caml_cairo_get_font_options(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vfont_option);
cairo_font_options_t *options = cairo_font_options_create();
caml_cairo_raise_Error(cairo_font_options_status(options));
cairo_get_font_options(CAIRO_VAL(vcr), options);
FONT_OPTIONS_ASSIGN(vfont_option, options);
CAMLreturn(vfont_option);
}
CAMLexport value caml_cairo_font_options_create(value vunit)
{
CAMLparam1(vunit);
CAMLlocal1(vfo);
cairo_font_options_t* fo = cairo_font_options_create();
caml_cairo_raise_Error(cairo_font_options_status(fo));
FONT_OPTIONS_ASSIGN(vfo, fo);
CAMLreturn(vfo);
}
CAMLexport value caml_cairo_font_options_copy(value vorig)
{
CAMLparam1(vorig);
CAMLlocal1(vcopy);
cairo_font_options_t* copy = cairo_font_options_copy(FONT_OPTIONS_VAL(vorig));
caml_cairo_raise_Error(cairo_font_options_status(copy));
FONT_OPTIONS_ASSIGN(vcopy, copy);
CAMLreturn(vcopy);
}
#define SET_FONT_OPTIONS(name, of_val) \
CAMLexport value caml_##name(value vfo, value v) \
{ \
CAMLparam2(vfo, v); \
name(FONT_OPTIONS_VAL(vfo), of_val(v)); \
CAMLreturn(Val_unit); \
}
#define GET_FONT_OPTIONS(name, val_of, type) \
CAMLexport value caml_##name(value vfo) \
{ \
CAMLparam1(vfo); \
type ret = name(FONT_OPTIONS_VAL(vfo)); \
CAMLreturn(val_of(ret)); \
}
SET_FONT_OPTIONS(cairo_font_options_merge, FONT_OPTIONS_VAL)
SET_FONT_OPTIONS(cairo_font_options_set_antialias, ANTIALIAS_VAL)
GET_FONT_OPTIONS(cairo_font_options_get_antialias,
VAL_ANTIALIAS, cairo_antialias_t)
#define SUBPIXEL_ORDER_VAL(v) ((cairo_subpixel_order_t) Int_val(v))
#define VAL_SUBPIXEL_ORDER(v) Val_int(v)
SET_FONT_OPTIONS(cairo_font_options_set_subpixel_order, SUBPIXEL_ORDER_VAL)
GET_FONT_OPTIONS(cairo_font_options_get_subpixel_order,
VAL_SUBPIXEL_ORDER, cairo_subpixel_order_t)
#define HINT_STYLE_VAL(v) ((cairo_hint_style_t) Int_val(v))
#define VAL_HINT_STYLE(v) Val_int(v)
SET_FONT_OPTIONS(cairo_font_options_set_hint_style, HINT_STYLE_VAL)
GET_FONT_OPTIONS(cairo_font_options_get_hint_style,
VAL_HINT_STYLE, cairo_hint_style_t)
#define HINT_METRICS_VAL(v) ((cairo_hint_metrics_t) Int_val(v))
#define VAL_HINT_METRICS(v) Val_int(v)
SET_FONT_OPTIONS(cairo_font_options_set_hint_metrics, HINT_METRICS_VAL)
GET_FONT_OPTIONS(cairo_font_options_get_hint_metrics,
VAL_HINT_METRICS, cairo_hint_metrics_t)
/* Font face
***********************************************************************/
CAMLexport value caml_cairo_font_face_get_type(value vff)
{
CAMLparam1(vff);
cairo_font_type_t ft = cairo_font_face_get_type(FONT_FACE_VAL(vff));
CAMLreturn(VAL_FONT_TYPE(ft));
}
DO1_CONTEXT(cairo_set_font_face, FONT_FACE_VAL)
CAMLexport value caml_cairo_get_font_face(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vff);
cairo_font_face_t* ff = cairo_get_font_face(CAIRO_VAL(vcr));
caml_cairo_raise_Error(cairo_font_face_status(ff));
/* Since we are going to create a value with the [ff] and this value
is shared with the one hold inside the cairo context, one must
increase the reference count (to avoid that destroying one of
these object leaves a dangling pointer for the other). */
cairo_font_face_reference(ff);
FONT_FACE_ASSIGN(vff, ff);
CAMLreturn(vff);
}
CAMLexport value caml_cairo_toy_font_face_create
(value vfamily, value vslant, value vweight)
{
CAMLparam3(vfamily, vslant, vweight);
CAMLlocal1(vff);
cairo_font_face_t* ff;
ff = cairo_toy_font_face_create(String_val(vfamily), SLANT_VAL(vslant),
WEIGHT_VAL(vweight));
caml_cairo_raise_Error(cairo_font_face_status(ff));
FONT_FACE_ASSIGN(vff, ff);
CAMLreturn(vff);
}
CAMLexport value caml_cairo_toy_font_face_get_family(value vff)
{
CAMLparam1(vff);
const char* family = cairo_toy_font_face_get_family(FONT_FACE_VAL(vff));
/* Since the string is going to be copied, it does not matter that
it belongs to the font face. */
CAMLreturn(caml_copy_string(family));
}
CAMLexport value caml_cairo_toy_font_face_get_slant(value vff)
{
CAMLparam1(vff);
cairo_font_slant_t slant = cairo_toy_font_face_get_slant(FONT_FACE_VAL(vff));
CAMLreturn(VAL_SLANT(slant));
}
CAMLexport value caml_cairo_toy_font_face_get_weight(value vff)
{
CAMLparam1(vff);
cairo_font_weight_t w = cairo_toy_font_face_get_weight(FONT_FACE_VAL(vff));
CAMLreturn(VAL_WEIGHT(w));
}
/* Scaled font
***********************************************************************/
DO1_CONTEXT(cairo_set_scaled_font, SCALED_FONT_VAL)
CAMLexport value caml_cairo_get_scaled_font(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vsf);
cairo_scaled_font_t* sf = cairo_get_scaled_font(CAIRO_VAL(vcr));
/* create a value with shared [sf] => must increase ref. count */
cairo_scaled_font_reference(sf);
vsf = ALLOC(scaled_font);
SCALED_FONT_VAL(vsf) = sf;
CAMLreturn(vsf);
}
CAMLexport value caml_cairo_scaled_font_create
(value vff, value vfont_matrix, value vctm, value voptions)
{
CAMLparam4(vff, vfont_matrix, vctm, voptions);
CAMLlocal1(vsf);
ALLOC_CAIRO_MATRIX2(vfont_matrix, vctm);
cairo_scaled_font_t* sf = cairo_scaled_font_create
(FONT_FACE_VAL(vff), GET_MATRIX(vfont_matrix), GET_MATRIX(vctm),
FONT_OPTIONS_VAL(voptions));
vsf = ALLOC(scaled_font);
SCALED_FONT_VAL(vsf) = sf;
CAMLreturn(vsf);
}
CAMLexport value caml_cairo_scaled_font_extents(value vsf)
{
CAMLparam1(vsf);
CAMLlocal1(vfe);
cairo_font_extents_t fe;
cairo_scaled_font_extents(SCALED_FONT_VAL(vsf), &fe);
FONT_EXTENTS_ASSIGN(vfe, fe);
CAMLreturn(vfe);
}
CAMLexport value caml_cairo_scaled_font_text_extents(value vsf, value vutf8)
{
CAMLparam2(vsf, vutf8);
CAMLlocal1(vte);
cairo_text_extents_t te;
cairo_scaled_font_text_extents(SCALED_FONT_VAL(vsf), String_val(vutf8), &te);
TEXT_EXTENTS_ASSIGN(vte, te);
CAMLreturn(vte);
}
CAMLexport value caml_cairo_scaled_font_glyph_extents(value vsf, value vglyphs)
{
CAMLparam2(vsf, vglyphs);
CAMLlocal1(vte);
cairo_text_extents_t te;
cairo_glyph_t *glyphs, *p;
int i, num_glyphs;
ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs);
cairo_scaled_font_glyph_extents(SCALED_FONT_VAL(vsf),
glyphs, num_glyphs, &te);
free(glyphs);
vte = caml_alloc(6 * Double_wosize, Double_array_tag);
Store_double_field(vte, 0, te.x_bearing);
Store_double_field(vte, 1, te.y_bearing);
Store_double_field(vte, 2, te.width);
Store_double_field(vte, 3, te.height);
Store_double_field(vte, 4, te.x_advance);
Store_double_field(vte, 5, te.y_advance);
CAMLreturn(vte);
}
CAMLexport value caml_cairo_scaled_font_text_to_glyphs
(value vsf, value vx, value vy, value vutf8)
{
CAMLparam4(vsf, vx, vy, vutf8);
CAMLlocal4(vglyphs, vclusters, vtriplet, v);
cairo_glyph_t *glyphs = NULL;
int i, num_glyphs;
cairo_text_cluster_t *clusters = NULL;
int num_clusters;
cairo_text_cluster_flags_t cluster_flags;
cairo_status_t status;
status = cairo_scaled_font_text_to_glyphs
(SCALED_FONT_VAL(vsf), Double_val(vx), Double_val(vy),
String_val(vutf8), string_length(vutf8),
&glyphs, &num_glyphs, &clusters, &num_clusters, &cluster_flags);
caml_cairo_raise_Error(status);
vglyphs = caml_alloc_tuple(num_glyphs);
for(i = 0; i < num_glyphs; i++) {
GLYPH_ASSIGN(v, glyphs[i]);
Store_field(vglyphs, i, v);
}
cairo_glyph_free(glyphs);
vclusters = caml_alloc_tuple(num_clusters);
for(i = 0; i < num_clusters; i++) {
CLUSTER_ASSIGN(v, clusters[i]);
Store_field(vclusters, i, v);
}
cairo_text_cluster_free(clusters);
/* FIXME: cluster_flags */
/* (glyphs, clusters, cluster_flags) */
vtriplet = caml_alloc_tuple(3);
Store_field(vtriplet, 0, vglyphs);
Store_field(vtriplet, 1, vclusters);
Store_field(vtriplet, 2, VAL_CLUSTER_FLAGS(cluster_flags));
CAMLreturn(vtriplet);
}
CAMLexport value caml_cairo_scaled_font_get_font_face(value vsf)
{
CAMLparam1(vsf);
CAMLlocal1(vff);
cairo_font_face_t* ff;
ff = cairo_scaled_font_get_font_face(SCALED_FONT_VAL(vsf));
/* FIXME: The documentation does not say whether it is shared or
not; assuming it is as for other functions. */
cairo_font_face_reference(ff);
vff = ALLOC(font_face);
FONT_FACE_VAL(vff) = ff;
CAMLreturn(vff);
}
CAMLexport value caml_cairo_scaled_font_get_font_options(value vsf)
{
CAMLparam1(vsf);
CAMLlocal1(vfo);
cairo_font_options_t *fo = cairo_font_options_create();
caml_cairo_raise_Error(cairo_font_options_status(fo));
cairo_scaled_font_get_font_options(SCALED_FONT_VAL(vsf), fo);
FONT_OPTIONS_ASSIGN(vfo, fo);
CAMLreturn(vfo);
}
#define SCALED_FONT_GET_MATRIX(name) \
CAMLexport value caml_##name(value vsf) \
{ \
CAMLparam1(vsf); \
CAMLlocal1(vmatrix); \
WITH_MATRIX_DO(vmatrix, \
name(SCALED_FONT_VAL(vsf), GET_MATRIX(vmatrix))); \
CAMLreturn(vmatrix); \
}
SCALED_FONT_GET_MATRIX(cairo_scaled_font_get_font_matrix)
SCALED_FONT_GET_MATRIX(cairo_scaled_font_get_ctm)
SCALED_FONT_GET_MATRIX(cairo_scaled_font_get_scale_matrix)
CAMLexport value caml_cairo_scaled_font_get_type(value vff)
{
CAMLparam1(vff);
cairo_font_type_t ft = cairo_scaled_font_get_type(SCALED_FONT_VAL(vff));
CAMLreturn(VAL_FONT_TYPE(ft));
}
/* Ft : TrueType fonts
***********************************************************************/
#if CAIRO_HAS_FT_FONT && CAIRO_HAS_FC_FONT
#include
CAMLexport value caml_cairo_Ft_init_FreeType(value unit)
{
CAMLparam1(unit);
CAMLlocal1(vft);
FT_Library ft;
if (FT_Init_FreeType (&ft) != 0) {
caml_failwith("Cairo.Ft: cannot initialize the FreeType library");
}
FT_LIBRARY_ASSIGN(vft, ft);
CAMLreturn(vft);
}
CAMLexport
value caml_cairo_Ft_new_face(value vftlib, value vpath, value vindex)
{
CAMLparam3(vftlib, vpath, vindex);
CAMLlocal1(vface);
FT_Face face;
if (FT_New_Face(FT_LIBRARY_VAL(vftlib),
(const char*) String_val(vpath),
Int_val(vindex),
&face) != 0) {
caml_failwith("Cairo.Ft.face");
}
FT_FACE_ASSIGN(vface, face);
CAMLreturn(vface);
}
CAMLexport value caml_cairo_ft_create_for_ft_face(
value vface, value vertical, value autohint)
{
CAMLparam3(vface, vertical, autohint);
CAMLlocal1(vff);
FT_Int32 flags = FT_LOAD_DEFAULT;
cairo_font_face_t *ff;
if (Bool_val(vertical)) flags |= FT_LOAD_VERTICAL_LAYOUT;
if (Bool_val(autohint)) flags |= FT_LOAD_FORCE_AUTOHINT;
ff = cairo_ft_font_face_create_for_ft_face(FT_FACE_VAL(vface), flags);
caml_cairo_raise_Error(cairo_font_face_status(ff));
FONT_FACE_ASSIGN(vff, ff);
CAMLreturn(vff);
}
CAMLexport value caml_cairo_ft_create_for_pattern(
value voptions, value vpattern)
{
CAMLparam2(voptions, vpattern);
CAMLlocal1(vff);
FcPattern *p1, *p2;
FcResult res;
cairo_font_face_t *ff;
p1 = FcNameParse((const FcChar8 *) String_val(vpattern));
if (FcConfigSubstitute(NULL, p1, FcMatchPattern) == FcFalse)
caml_failwith("Cairo.Ft.create_for_pattern:");
if (Is_block (voptions)) {
cairo_ft_font_options_substitute(FONT_OPTIONS_VAL(Field(voptions, 0)),
p1);
}
FcDefaultSubstitute(p1);
p2 = FcFontMatch(NULL, p1, &res);
FcPatternDestroy(p1);
switch (res) {
case FcResultMatch: break;
case FcResultNoMatch:
caml_failwith("Cairo.Ft.create_for_pattern: no match");
case FcResultTypeMismatch:
caml_failwith("Cairo.Ft.create_for_pattern: type mismatch");
case FcResultNoId:
caml_failwith("Cairo.Ft.create_for_pattern: font exists but does not "
"have enough values");
case FcResultOutOfMemory:
caml_failwith("Cairo.Ft.create_for_pattern: out of memory ");
}
ff = cairo_ft_font_face_create_for_pattern(p2);
FONT_FACE_ASSIGN(vff, ff);
FcPatternDestroy(p2);
CAMLreturn(vff);
}
CAMLexport value caml_cairo_ft_scaled_font_lock_face(value vsf)
{
CAMLparam1(vsf);
CAMLlocal1(vface);
FT_Face face;
face = cairo_ft_scaled_font_lock_face(SCALED_FONT_VAL(vsf));
FT_FACE_ASSIGN(vface, face);
CAMLreturn(vface);
}
CAMLexport value caml_cairo_ft_scaled_font_unlock_face(value vsf)
{
CAMLparam1(vsf);
cairo_ft_scaled_font_unlock_face(SCALED_FONT_VAL(vsf));
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_ft_synthesize_get(value vff)
{
CAMLparam1(vff);
CAMLlocal1(vsyn);
unsigned int syn;
syn = cairo_ft_font_face_get_synthesize(FONT_FACE_VAL(vff));
vsyn = caml_alloc(2, 0);
Store_field(vsyn, 0, Val_bool(syn & CAIRO_FT_SYNTHESIZE_BOLD));
Store_field(vsyn, 1, Val_bool(syn & CAIRO_FT_SYNTHESIZE_OBLIQUE));
CAMLreturn(vsyn);
}
CAMLexport value caml_cairo_ft_synthesize_set(
value vff, value vbold, value voblique)
{
CAMLparam3(vff, vbold, voblique);
unsigned int synth_flags = 0;
if (Bool_val(vbold)) synth_flags |= CAIRO_FT_SYNTHESIZE_BOLD;
if (Bool_val(voblique)) synth_flags |= CAIRO_FT_SYNTHESIZE_OBLIQUE;
cairo_ft_font_face_set_synthesize(FONT_FACE_VAL(vff), synth_flags);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_ft_synthesize_unset(
value vff, value vbold, value voblique)
{
CAMLparam3(vff, vbold, voblique);
unsigned int synth_flags = 0;
if (Bool_val(vbold)) synth_flags |= CAIRO_FT_SYNTHESIZE_BOLD;
if (Bool_val(voblique)) synth_flags |= CAIRO_FT_SYNTHESIZE_OBLIQUE;
cairo_ft_font_face_unset_synthesize(FONT_FACE_VAL(vff), synth_flags);
CAMLreturn(Val_unit);
}
#else
UNAVAILABLE1(Ft_init_FreeType)
UNAVAILABLE2(caml_Ft_new_face)
UNAVAILABLE3(caml_cairo_ft_create_for_ft_face)
UNAVAILABLE2(caml_cairo_ft_create_for_pattern)
UNAVAILABLE1(caml_cairo_ft_scaled_font_lock_face)
UNAVAILABLE1(caml_cairo_ft_scaled_font_unlock_face)
UNAVAILABLE1(caml_cairo_ft_synthesize_get)
UNAVAILABLE3(caml_cairo_ft_synthesize_set)
UNAVAILABLE3(caml_cairo_ft_synthesize_unset)
#endif
/* Glyphs
***********************************************************************/
CAMLexport value caml_cairo_show_glyphs(value vcr, value vglyphs)
{
CAMLparam1(vcr);
cairo_t *cr = CAIRO_VAL(vcr);
int i, num_glyphs = Wosize_val(vglyphs);
cairo_glyph_t *glyphs, *p;
ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs);
cairo_show_glyphs(cr, glyphs, num_glyphs);
free(glyphs);
caml_check_status(cr);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_show_text_glyphs
(value vcr, value vutf8, value vglyphs, value vclusters, value vcluster_flags)
{
CAMLparam5(vcr, vutf8, vglyphs, vclusters, vcluster_flags);
CAMLlocal1(v);
cairo_t *cr = CAIRO_VAL(vcr);
cairo_glyph_t *glyphs, *p;
cairo_text_cluster_t *clusters, *q;
int i, num_glyphs, num_clusters;
ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs);
ARRAY_CLUSTER_VAL(clusters, q, vglyphs, num_glyphs);
cairo_show_text_glyphs(cr, String_val(vutf8), string_length(vutf8),
glyphs, num_glyphs, clusters, num_clusters,
/* FIXME: is it a binary | ? */
CLUSTER_FLAGS_VAL(vcluster_flags));
free(glyphs);
free(clusters);
caml_check_status(cr);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_glyph_extents(value vcr, value vglyphs)
{
CAMLparam2(vcr, vglyphs);
CAMLlocal1(vte);
cairo_glyph_t *glyphs, *p;
int i, num_glyphs;
cairo_text_extents_t te;
ARRAY_GLYPH_VAL(glyphs, p, vglyphs, num_glyphs);
cairo_glyph_extents(CAIRO_VAL(vcr), glyphs, num_glyphs, &te);
free(glyphs);
TEXT_EXTENTS_ASSIGN(vte, te);
CAMLreturn(vte);
}
/* Toy text API
***********************************************************************/
CAMLexport value caml_cairo_select_font_face
(value vcr, value vslant, value vweight, value vfamily)
{
CAMLparam4(vcr, vslant, vweight, vfamily);
cairo_t *cr = CAIRO_VAL(vcr);
cairo_select_font_face(cr, String_val(vfamily),
SLANT_VAL(vslant), WEIGHT_VAL(vweight));
caml_check_status(cr);
CAMLreturn(Val_unit);
}
DO1_CONTEXT(cairo_set_font_size, Double_val)
CAMLexport value caml_cairo_set_font_matrix(value vcr, value vmatrix)
{
CAMLparam2(vcr, vmatrix);
cairo_t *cr = CAIRO_VAL(vcr);
ALLOC_CAIRO_MATRIX(vmatrix);
cairo_set_font_matrix(cr, GET_MATRIX(vmatrix));
caml_check_status(cr);
CAMLreturn(Val_unit);
}
CAMLexport value caml_cairo_get_font_matrix(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vmatrix);
cairo_t *cr = CAIRO_VAL(vcr);
WITH_MATRIX_DO(vmatrix,
cairo_get_font_matrix(cr, GET_MATRIX(vmatrix)));
CAMLreturn(vmatrix);
}
DO1_CONTEXT(cairo_show_text, String_val)
CAMLexport value caml_cairo_font_extents(value vcr)
{
CAMLparam1(vcr);
CAMLlocal1(vfe);
cairo_font_extents_t fe;
cairo_font_extents(CAIRO_VAL(vcr), &fe);
FONT_EXTENTS_ASSIGN(vfe, fe);
CAMLreturn(vfe);
}
CAMLexport value caml_cairo_text_extents(value vcr, value vutf8)
{
CAMLparam2(vcr, vutf8);
CAMLlocal1(vte);
cairo_text_extents_t te;
cairo_text_extents(CAIRO_VAL(vcr), String_val(vutf8), &te);
TEXT_EXTENTS_ASSIGN(vte, te);
CAMLreturn(vte);
}
/* Surface
***********************************************************************/
static cairo_user_data_key_t image_bigarray_key;
/* See the Image surfaces below */
CAMLexport value caml_cairo_surface_create_similar
(value vother, value vcontent, value vwidth, value vheight)
{
CAMLparam4(vother, vcontent, vwidth, vheight);
CAMLlocal1(vsurf);
cairo_content_t content;
cairo_surface_t* surf;
SET_CONTENT_VAL(content, vcontent);
surf = cairo_surface_create_similar(SURFACE_VAL(vother), content,
Int_val(vwidth), Int_val(vheight));
caml_cairo_raise_Error(cairo_surface_status(surf));
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_surface_finish(value vsurf)
{
/* noalloc */
cairo_surface_t *surface = SURFACE_VAL(vsurf);
cairo_surface_finish(surface);
/* Remove the user data with the bigarray key. That will cause the
finalizer to be executed (and release the proxy) and the
finalizing function not to be called again when the value is
garbage collected. */
cairo_surface_set_user_data(surface, &image_bigarray_key, NULL, NULL);
return(Val_unit);
}
DO_SURFACE(cairo_surface_flush)
CAMLexport value caml_cairo_surface_get_font_options(value vsurf)
{
CAMLparam1(vsurf);
CAMLlocal1(vfo);
cairo_surface_t *surface = SURFACE_VAL(vsurf);
cairo_font_options_t *fo = cairo_font_options_create();
caml_cairo_raise_Error(cairo_font_options_status(fo));
cairo_surface_get_font_options(surface, fo);
FONT_OPTIONS_ASSIGN(vfo, fo);
CAMLreturn(vfo);
}
CAMLexport value caml_cairo_surface_get_content(value vsurf)
{
CAMLparam1(vsurf);
CAMLlocal1(vcontent);
cairo_surface_t *surface = SURFACE_VAL(vsurf);
cairo_content_t content = cairo_surface_get_content(surface);
CONTENT_ASSIGN(vcontent, content);
CAMLreturn(vcontent);
}
DO_SURFACE(cairo_surface_mark_dirty)
CAMLexport value caml_cairo_surface_mark_dirty_rectangle
(value vsurf, value vx, value vy, value vwidth, value vheight)
{
/* noalloc */
cairo_surface_mark_dirty_rectangle
(SURFACE_VAL(vsurf), Int_val(vx), Int_val(vy),
Int_val(vwidth), Int_val(vheight));
return(Val_unit);
}
#define SET_SURFACE_XY(name) \
CAMLexport value caml_##name(value vsurf, value vx, value vy) \
{ \
/* noalloc */ \
name(SURFACE_VAL(vsurf), Double_val(vx), Double_val(vy)); \
return(Val_unit); \
}
#define GET_SURFACE_XY(name) \
CAMLexport value caml_##name(value vsurf) \
{ \
CAMLparam1(vsurf); \
CAMLlocal1(vcouple); \
double x, y; \
name(SURFACE_VAL(vsurf), &x, &y); \
vcouple = caml_alloc_tuple(2); \
Store_field(vcouple, 0, caml_copy_double(x)); \
Store_field(vcouple, 1, caml_copy_double(y)); \
CAMLreturn(vcouple); \
}
SET_SURFACE_XY(cairo_surface_set_device_offset)
GET_SURFACE_XY(cairo_surface_get_device_offset)
SET_SURFACE_XY(cairo_surface_set_fallback_resolution)
GET_SURFACE_XY(cairo_surface_get_fallback_resolution)
CAMLexport value caml_cairo_surface_get_type(value vsurf)
{
/* noalloc */
cairo_surface_type_t k = cairo_surface_get_type(SURFACE_VAL(vsurf));
return(VAL_SURFACE_KIND(k));
}
DO_SURFACE(cairo_surface_copy_page)
DO_SURFACE(cairo_surface_show_page)
CAMLexport value caml_cairo_surface_has_show_text_glyphs(value vsurf)
{
/* noalloc */
cairo_bool_t b = cairo_surface_has_show_text_glyphs(SURFACE_VAL(vsurf));
return(Val_bool(b));
}
/* Image surfaces
***********************************************************************/
#define FORMAT_VAL(x) ((cairo_format_t) Int_val(x))
#define VAL_FORMAT(x) Val_int(x)
#ifdef CAIRO_HAS_IMAGE_SURFACE
/* Any image surface may be queried for its data (which is returned
shared with the surface). We cannot track the data unless we
allocate it ourselves. Since it can be shared with other surfaces
and bigarrays, we will see an image surface as a kind of bigarray:
it will hold a bigarray proxy that will be referenced by all
bigarrays and surfaces created from them (and ref count the data). */
/* Finalize the proxy attached to the image surface. */
static void caml_cairo_image_bigarray_finalize(void *data)
{
#define proxy ((struct caml_ba_proxy *) data)
/* Adapted from caml_ba_finalize in the OCaml library sources. */
if (-- proxy->refcount == 0) {
free(proxy->data);
caml_stat_free(proxy);
}
#undef proxy
}
CAMLexport value caml_cairo_image_surface_create(value vformat,
value vwidth, value vheight)
{
CAMLparam3(vformat, vwidth, vheight);
CAMLlocal1(vsurf);
cairo_format_t format = FORMAT_VAL(vformat);
int stride = cairo_format_stride_for_width(format, Int_val(vwidth));
unsigned char *data;
cairo_surface_t *surf;
struct caml_ba_proxy *proxy;
cairo_status_t status;
vsurf = ALLOC(surface); /* alloc this first in case it raises an exn */
/* Use calloc to initialize the surface to all black. */
data = calloc(1, stride * Int_val(vheight));
if (data == NULL) caml_raise_out_of_memory();
surf = cairo_image_surface_create_for_data(data, format, Int_val(vwidth),
Int_val(vheight), stride);
status = cairo_surface_status(surf);
if (status != CAIRO_STATUS_SUCCESS) {
free(data);
caml_cairo_raise_Error(status);
}
/* Create a proxy and attach it to the surface */
proxy = malloc(sizeof(struct caml_ba_proxy));
if (proxy == NULL) {
cairo_surface_destroy(surf);
free(data);
caml_cairo_raise_Error(CAIRO_STATUS_NO_MEMORY);
}
proxy->refcount = 1; /* surface */
proxy->data = data;
proxy->size = 0;
status = cairo_surface_set_user_data(surf, &image_bigarray_key, proxy,
caml_cairo_image_bigarray_finalize);
if (status != CAIRO_STATUS_SUCCESS) {
cairo_surface_destroy(surf);
free(data);
free(proxy);
caml_cairo_raise_Error(status);
}
SURFACE_VAL(vsurf) = surf;
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_format_stride_for_width(value vformat, value vw)
{
/* noalloc */
return Val_int(cairo_format_stride_for_width(FORMAT_VAL(vformat),
Int_val(vw)));
}
/* Attach a proxy to the bigarray (no need to create another bigarray
refering to the same proxy as for sub-arrays). This proxy is
finalized when the surface is destroyed. */
static cairo_status_t caml_cairo_image_bigarray_attach_proxy
(cairo_surface_t* surf, struct caml_ba_array * b)
{
struct caml_ba_proxy * proxy;
if ((b->flags & CAML_BA_MANAGED_MASK) == CAML_BA_EXTERNAL)
return(CAIRO_STATUS_SUCCESS);
if (b->proxy != NULL) {
/* If b is already a proxy, increment refcount. */
++ b->proxy->refcount;
}
else {
/* Otherwise, create proxy and attach it to b and the surface.
(Adapted from caml_ba_update_proxy in the OCaml std lib.) */
proxy = malloc(sizeof(struct caml_ba_proxy));
if (proxy == NULL) return(CAIRO_STATUS_NO_MEMORY);
proxy->refcount = 2; /* original array + surface */
proxy->data = b->data;
proxy->size = 0; /* CAML_BA_MANAGED_MASK excluded by the calling fun */
b->proxy = proxy;
}
return cairo_surface_set_user_data(surf, &image_bigarray_key, b->proxy,
caml_cairo_image_bigarray_finalize);
}
#define SURFACE_CREATE_DATA(name) \
CAMLexport value caml_cairo_image_surface_create_for_##name \
(value vb, value vformat, value vwidth, value vheight, value vstride) \
{ \
CAMLparam5(vb, vformat, vwidth, vheight, vstride); \
CAMLlocal1(vsurf); \
cairo_surface_t* surf; \
const int width = Int_val(vwidth); \
struct caml_ba_array *b = Caml_ba_array_val(vb); \
cairo_status_t status; \
\
if ((b->flags & CAML_BA_MANAGED_MASK) == CAML_BA_MAPPED_FILE) \
caml_invalid_argument("Cairo.Image.create_for_" #name \
": cannot use a memory mapped file."); \
vsurf = ALLOC(surface); /* alloc this first in case it raises an exn */ \
surf = cairo_image_surface_create_for_data \
((unsigned char *) b->data, FORMAT_VAL(vformat), \
width, Int_val(vheight), Int_val(vstride)); \
caml_cairo_raise_Error(cairo_surface_status(surf)); \
status = caml_cairo_image_bigarray_attach_proxy(surf, b); \
if (status != CAIRO_STATUS_SUCCESS) { \
cairo_surface_destroy(surf); \
caml_cairo_raise_Error(status); \
} \
SURFACE_VAL(vsurf) = surf; \
CAMLreturn(vsurf); \
}
SURFACE_CREATE_DATA(data8)
SURFACE_CREATE_DATA(data32)
#define SURFACE_GET_DATA(type, num_dims, dims ...) \
CAMLexport value caml_cairo_image_surface_get_##type(value vsurf) \
{ \
CAMLparam1(vsurf); \
CAMLlocal1(vb); \
unsigned char* data = cairo_image_surface_get_data(SURFACE_VAL(vsurf)); \
intnat dim[num_dims] = {dims}; \
struct caml_ba_proxy * proxy = (struct caml_ba_proxy *) \
cairo_surface_get_user_data(SURFACE_VAL(vsurf), &image_bigarray_key); \
\
if (data == NULL) \
invalid_argument("Cairo.Image.get_data: not an image surface."); \
if (proxy == NULL) \
invalid_argument("Cairo.Image.get_data: not created from a bigarray"); \
vb = caml_ba_alloc(CAML_BA_##type | CAML_BA_C_LAYOUT | CAML_BA_MANAGED, \
num_dims, data, dim); \
/* Attach the proxy of the surface to the bigarray */ \
++ proxy->refcount; \
(Caml_ba_array_val(vb))->proxy = proxy; \
CAMLreturn(vb); \
}
SURFACE_GET_DATA(UINT8, 1,
cairo_image_surface_get_stride(SURFACE_VAL(vsurf))
* cairo_image_surface_get_height(SURFACE_VAL(vsurf)) )
SURFACE_GET_DATA(INT32, 2,
cairo_image_surface_get_height(SURFACE_VAL(vsurf)),
cairo_image_surface_get_stride(SURFACE_VAL(vsurf)) / 4 )
#define GET_SURFACE(name, val_of, type) \
CAMLexport value caml_##name(value vsurf) \
{ \
CAMLparam1(vsurf); \
CAMLlocal1(vret); \
type ret = name(SURFACE_VAL(vsurf)); \
vret = val_of(ret); \
CAMLreturn(vret); \
}
GET_SURFACE(cairo_image_surface_get_format, VAL_FORMAT, cairo_format_t)
GET_SURFACE(cairo_image_surface_get_width, Val_int, int)
GET_SURFACE(cairo_image_surface_get_height, Val_int, int)
GET_SURFACE(cairo_image_surface_get_stride, Val_int, int)
#else
UNAVAILABLE3(cairo_image_surface_create)
UNAVAILABLE2(cairo_format_stride_for_width)
UNAVAILABLE5(cairo_image_surface_create_for_data8)
UNAVAILABLE5(cairo_image_surface_create_for_data32)
UNAVAILABLE1(cairo_image_surface_get_UINT8)
UNAVAILABLE1(cairo_image_surface_get_INT32)
UNAVAILABLE1(cairo_image_surface_get_format)
UNAVAILABLE1(cairo_image_surface_get_width)
UNAVAILABLE1(cairo_image_surface_get_height)
UNAVAILABLE1(cairo_image_surface_get_stride)
#endif /* CAIRO_HAS_IMAGE_SURFACE */
/* PDF surface
***********************************************************************/
static cairo_status_t caml_cairo_output_string
(void *fn, const unsigned char *data, unsigned int length)
{
CAMLparam0();
CAMLlocal2(s, r);
s = caml_alloc_string(length);
memmove(String_val(s), data, length);
r = caml_callback_exn(* ((value *) fn), s);
if (Is_exception_result(r))
CAMLreturn(CAIRO_STATUS_WRITE_ERROR);
else
CAMLreturn(CAIRO_STATUS_SUCCESS);
}
#define SURFACE_CREATE_FROM_STREAM(name) \
CAMLexport value caml_##name(value voutput, value vwidth, value vheight) \
{ \
CAMLparam3(voutput, vwidth, vheight); \
CAMLlocal1(vsurf); \
cairo_surface_t* surf; \
value *output; \
\
output = malloc(sizeof(value)); \
output[0] = voutput; \
surf = name(&caml_cairo_output_string, output, \
Double_val(vwidth), Double_val(vheight)); \
caml_cairo_raise_Error(cairo_surface_status(surf)); \
SET_SURFACE_CALLBACK(surf, output); \
SURFACE_ASSIGN(vsurf, surf); \
CAMLreturn(vsurf); \
}
#define SURFACE_CREATE(name) \
CAMLexport value caml_##name(value vfname, value vwidth, value vheight) \
{ \
CAMLparam3(vfname, vwidth, vheight); \
CAMLlocal1(vsurf); \
cairo_surface_t* surf; \
\
surf = name(String_val(vfname), Double_val(vwidth), Double_val(vheight)); \
caml_cairo_raise_Error(cairo_surface_status(surf)); \
SURFACE_ASSIGN(vsurf, surf); \
CAMLreturn(vsurf); \
}
#ifdef CAIRO_HAS_PDF_SURFACE
SURFACE_CREATE_FROM_STREAM(cairo_pdf_surface_create_for_stream)
SURFACE_CREATE(cairo_pdf_surface_create)
DO2_SURFACE(cairo_pdf_surface_set_size, Double_val, Double_val)
#else
UNAVAILABLE3(cairo_pdf_surface_create_for_stream)
UNAVAILABLE3(cairo_pdf_surface_create)
UNAVAILABLE3(cairo_pdf_surface_set_size)
#endif /* CAIRO_HAS_PDF_SURFACE */
/* PNG functions
***********************************************************************/
static cairo_status_t caml_cairo_input_string
(void *fn, unsigned char *data, unsigned int length)
{
value s, r;
/* Contrarily to what is customary, it is the caller which specifies
the length of the data to read and we know no upper bound, so
there is no way to preallocate a single OCaml string for all read
operations. */
s = caml_alloc_string(length);
r = caml_callback2_exn(* ((value *) fn), s, Val_int(length));
if (Is_exception_result(r)) return(CAIRO_STATUS_READ_ERROR);
else {
memmove(data, String_val(s), length);
return(CAIRO_STATUS_SUCCESS);
}
}
#ifdef CAIRO_HAS_PNG_FUNCTIONS
CAMLexport value caml_cairo_image_surface_create_from_png(value fname)
{
CAMLparam1(fname);
CAMLlocal1(vsurf);
cairo_surface_t* surf;
surf = cairo_image_surface_create_from_png(String_val(fname));
caml_cairo_raise_Error(cairo_surface_status(surf));
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_image_surface_create_from_png_stream(value vinput)
{
CAMLparam1(vinput);
CAMLlocal1(vsurf);
cairo_surface_t* surf;
surf = cairo_image_surface_create_from_png_stream(&caml_cairo_input_string,
&vinput);
if (surf == NULL) caml_cairo_raise_Error(CAIRO_STATUS_READ_ERROR);
caml_cairo_raise_Error(cairo_surface_status(surf));
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_surface_write_to_png(value vsurf, value vfname)
{
/* noalloc */
cairo_status_t status;
status = cairo_surface_write_to_png(SURFACE_VAL(vsurf), String_val(vfname));
caml_cairo_raise_Error(status);
return(Val_unit);
}
CAMLexport value caml_cairo_surface_write_to_png_stream(value vsurf,
value voutput)
{
CAMLparam2(vsurf, voutput);
cairo_status_t status = cairo_surface_write_to_png_stream
(SURFACE_VAL(vsurf), &caml_cairo_output_string, &voutput);
caml_cairo_raise_Error(status);
CAMLreturn(Val_unit);
}
#else
UNAVAILABLE1(cairo_image_surface_create_from_png)
UNAVAILABLE1(cairo_image_surface_create_from_png_stream)
UNAVAILABLE1(cairo_surface_write_to_png)
UNAVAILABLE2(cairo_surface_write_to_png_stream)
#endif /* CAIRO_HAS_PNG_FUNCTIONS */
/* Postscript surface
***********************************************************************/
#ifdef CAIRO_HAS_PS_SURFACE
SURFACE_CREATE(cairo_ps_surface_create)
SURFACE_CREATE_FROM_STREAM(cairo_ps_surface_create_for_stream)
#define PS_LEVEL_VAL(v) ((cairo_ps_level_t) Int_val(v))
#define VAL_PS_LEVEL(v) Val_int(v)
DO1_SURFACE(cairo_ps_surface_restrict_to_level, PS_LEVEL_VAL)
#define GET_LIST(name, val_of, type) \
CAMLexport value caml_##name(value unit) \
{ \
CAMLparam1(unit); \
CAMLlocal2(vlist, vcons); \
type *array; \
int num, i; \
/* Fill array */ \
name(&array, &num); \
/* Create OCaml list */ \
vlist = Val_int(0); /* [] */ \
for(i = 0; i < num; i++) { \
vcons = caml_alloc_tuple(2); \
Store_field(vcons, 0, val_of(array[i])); \
Store_field(vcons, 1, vlist); \
vlist = vcons; /* new head */ \
} \
CAMLreturn(vlist); \
}
GET_LIST(cairo_ps_get_levels, VAL_PS_LEVEL, cairo_ps_level_t const)
CAMLexport value caml_cairo_ps_level_to_string(value vlevel)
{
CAMLparam1(vlevel);
const char* s = cairo_ps_level_to_string(PS_LEVEL_VAL(vlevel));
CAMLreturn(caml_copy_string(s));
}
DO1_SURFACE(cairo_ps_surface_set_eps, Bool_val)
CAMLexport value caml_cairo_ps_surface_get_eps(value vsurf)
{
/* noalloc */
cairo_bool_t b = cairo_ps_surface_get_eps(SURFACE_VAL(vsurf));
return(Val_bool(b));
}
DO2_SURFACE(cairo_ps_surface_set_size, Double_val, Double_val)
DO_SURFACE(cairo_ps_surface_dsc_begin_setup)
DO_SURFACE(cairo_ps_surface_dsc_begin_page_setup)
DO1_SURFACE(cairo_ps_surface_dsc_comment, String_val)
#else
UNAVAILABLE3(cairo_ps_surface_create)
UNAVAILABLE3(cairo_ps_surface_create_for_stream)
UNAVAILABLE2(cairo_ps_surface_restrict_to_level)
UNAVAILABLE1(cairo_ps_get_levels)
UNAVAILABLE1(cairo_ps_level_to_string)
UNAVAILABLE2(cairo_ps_surface_set_eps)
UNAVAILABLE1(cairo_ps_surface_get_eps)
UNAVAILABLE3(cairo_ps_surface_set_size)
UNAVAILABLE1(cairo_ps_surface_dsc_begin_setup)
UNAVAILABLE1(cairo_ps_surface_dsc_begin_page_setup)
UNAVAILABLE2(cairo_ps_surface_dsc_comment)
#endif /* CAIRO_HAS_PS_SURFACE */
/* SVG surface
***********************************************************************/
#ifdef CAIRO_HAS_SVG_SURFACE
SURFACE_CREATE(cairo_svg_surface_create)
SURFACE_CREATE_FROM_STREAM(cairo_svg_surface_create_for_stream)
#define SVG_VERSION_VAL(v) ((cairo_svg_version_t) Int_val(v))
#define VAL_SVG_VERSION(v) Val_int(v)
DO1_SURFACE(cairo_svg_surface_restrict_to_version, SVG_VERSION_VAL)
GET_LIST(cairo_svg_get_versions, VAL_SVG_VERSION, cairo_svg_version_t const)
CAMLexport value caml_cairo_svg_version_to_string(value vversion)
{
CAMLparam1(vversion);
const char* s = cairo_svg_version_to_string(SVG_VERSION_VAL(vversion));
CAMLreturn(caml_copy_string(s));
}
#else
UNAVAILABLE3(cairo_svg_surface_create)
UNAVAILABLE3(cairo_svg_surface_create_for_stream)
UNAVAILABLE2(cairo_svg_surface_restrict_to_version)
UNAVAILABLE1(cairo_svg_get_versions)
UNAVAILABLE1(cairo_svg_version_to_string)
#endif /* CAIRO_HAS_SVG_SURFACE */
/* Recording surface
***********************************************************************/
#ifdef CAIRO_HAS_RECORDING_SURFACE
CAMLexport value caml_cairo_recording_surface_create(
value vextents, value vcontent)
{
CAMLparam2(vcontent, vextents);
CAMLlocal2(vsurf, vrectangle);
cairo_surface_t *surf;
cairo_content_t content;
cairo_rectangle_t *extents = NULL;
SET_CONTENT_VAL(content, vcontent);
/* Get extents rectangle, if given. */
if (Is_block(vextents)) /* = Some _ */ {
vrectangle = Field(vextents, 0);
SET_MALLOC(extents, 1, cairo_rectangle_t);
extents->x = Double_field(vrectangle, 0);
extents->y = Double_field(vrectangle, 1);
extents->width = Double_field(vrectangle, 2);
extents->height = Double_field(vrectangle, 3);
}
surf = cairo_recording_surface_create(content, extents);
if (extents != NULL) {
free(extents);
}
caml_cairo_raise_Error(cairo_surface_status(surf));
SURFACE_ASSIGN(vsurf, surf);
CAMLreturn(vsurf);
}
CAMLexport value caml_cairo_recording_surface_ink_extents(value vsurf)
{
CAMLparam1(vsurf);
CAMLlocal1(vextents);
double x, y, w, h;
cairo_recording_surface_ink_extents(SURFACE_VAL(vsurf), &x, &y, &w, &h);
vextents = caml_alloc(4 * Double_wosize, Double_array_tag);
Store_double_field(vextents, 0, x);
Store_double_field(vextents, 1, y);
Store_double_field(vextents, 2, w);
Store_double_field(vextents, 3, h);
CAMLreturn(vextents);
}
#else
UNAVAILABLE2(cairo_recording_surface_create)
UNAVAILABLE1(cairo_recording_surface_ink_extents)
#endif /* CAIRO_HAS_RECORDING_SURFACE */
/* Local Variables: */
/* compile-command: "make -k -C.." */
/* End: */
ocaml-cairo/cairo2-gtk.opam 0000644 0001750 0001750 00000001610 13446257732 015771 0 ustar treinen treinen opam-version: "2.0"
maintainer: "Christophe Troestler "
authors: [ "Christophe Troestler "
"Pierre Hauweele " ]
license: "LGPL-3.0 with OCaml linking exception"
homepage: "https://github.com/Chris00/ocaml-cairo"
dev-repo: "git+https://github.com/Chris00/ocaml-cairo.git"
bug-reports: "https://github.com/Chris00/ocaml-cairo/issues"
doc: "https://Chris00.github.io/ocaml-cairo/doc"
tags: ["Cairo" "stroke" "drawing" "tutorial"]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "build" "@doc"] {with-doc}
]
depends: [
"ocaml" {>= "4.02"}
"base-bigarray"
"dune" {build}
"conf-pkg-config" {build}
"conf-cairo"
"cairo2" {= version}
"lablgtk"
]
synopsis: "Rendering Cairo on Gtk2 canvas"
description: """
This provides the link between Cairo and Lablgtk.
"""
ocaml-cairo/.gitignore 0000644 0001750 0001750 00000000102 13446257732 015134 0 ustar treinen treinen # -*-conf-unix-*-
.merlin
_build/
*.install
packages
*.png
ocaml-cairo/tests-gtk/ 0000755 0001750 0001750 00000000000 13446257732 015100 5 ustar treinen treinen ocaml-cairo/tests-gtk/alloc.ml 0000644 0001750 0001750 00000000774 13446257732 016534 0 ustar treinen treinen
let expose drawing_area _ev =
Printf.eprintf "Expose callback run\n%!";
let cr = Cairo_gtk.create drawing_area#misc#window in
Gc.major();
Cairo.arc cr 150. 150. ~r:100. ~a1:0. ~a2:6.;
Cairo.fill cr;
true
let () =
ignore(GMain.init());
let w = GWindow.window ~title:"Gtk demo" ~width:500 ~height:400 () in
ignore(w#connect#destroy ~callback:GMain.quit);
let d = GMisc.drawing_area ~packing:w#add () in
ignore(d#event#connect#expose ~callback:(expose d));
w#show();
GMain.main()
ocaml-cairo/tests-gtk/dune 0000644 0001750 0001750 00000000232 13446257732 015753 0 ustar treinen treinen
(executables
(names alloc)
(libraries cairo2-gtk))
(alias
(name tests-gtk)
(deps alloc.exe)
(action (progn
(run %{dep:alloc.exe}))))
ocaml-cairo/pango/ 0000755 0001750 0001750 00000000000 13446257732 014257 5 ustar treinen treinen ocaml-cairo/pango/cairo_pango.mli 0000644 0001750 0001750 00000015232 13446257732 017246 0 ustar treinen treinen (* File: cairo_pango.mli
Copyright (C) 2018-
Christophe Troestler
WWW: http://math.umons.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
(** Interaction with Pango, a library for laying out and rendering of text. *)
(** Interacting with [Pango.font_map]. *)
module Font_map : sig
type t = [`pangofontmap | `cairo] Gobject.obj
(** A PangoCairoFontMap. *)
val get_default : unit -> Pango.font_map
(** [get_default()] gets a default Cairo fontmap to use with Cairo.
The default Cairo fontmap can be changed by using {!set_default}.
This can be used to change the Cairo font backend that the
default fontmap uses for example.
Note that the default fontmap is per-thread. Each thread gets
its own default fontmap. In this way, Pango-Cairo can be used
safely from multiple threads. *)
val set_default : t -> unit
(** [set_default fm] sets [fm] as the default fontmap to use with
Cairo. The default fontmap is per-thread. *)
val create : unit -> Pango.font_map
(** Creates a new fontmap; a fontmap is used to cache information
about available fonts, and holds certain global parameters such
as the resolution. In most cases, you can use {!get_default}
instead.
Note that the type of the returned value will depend on the
particular font backend Cairo was compiled to use. You can
override the type of backend returned by using an environment
variable PANGOCAIRO_BACKEND. Supported types, based on your
build, are fc (fontconfig), win32, and coretext. *)
val create_for_font_type : Cairo.font_type -> Pango.font_map
(** [create_for_font_type fonttype] creates a new fontmap object of
the type suitable to be used with cairo font backend of type
[fonttype]. In most cases one should simply use {!create}, or in
fact in most of those cases, just use {!get_default}. *)
val get_font_type : t -> Cairo.font_type
(** Gets the type of Cairo font backend that fontmap uses. *)
val set_resolution : t -> float -> unit
(** Sets the resolution for the fontmap. This is a scale factor
between points specified in a [Pango.font_description] and Cairo
units. The default value is 96, meaning that a 10 point font
will be 13 units high. (10 * 96. / 72. = 13.3). *)
val get_resolution : t -> float
(** Gets the resolution for the fontmap. See {!set_resolution}. *)
val create_context : Pango.font_map -> Pango.context
(** [create_context fm] creates a Pango context connected to the
fontmap [fm]. *)
end
type cairo_font = [`pangofont | `cairo] Gobject.obj
val get_scaled_font : cairo_font -> _ Cairo.Scaled_font.t
val set_resolution : Pango.context -> float -> unit
(** Sets the resolution for the context. This is a scale factor
between points specified in a [Pango.font_description] and Cairo
units. The default value is 96, meaning that a 10 point font will
be 13 units high. (10 * 96. / 72. = 13.3). *)
val get_resolution : Pango.context -> float
(** Gets the resolution for the context. *)
val set_font_options : Pango.context -> Cairo.Font_options.t -> unit
(** [set_font_options cr options] sets the font options used when
rendering text with [cr]. These options override any options that
{!update_context} derives from the target surface. *)
val get_font_options : Pango.context -> Cairo.Font_options.t
(** Retrieves any font rendering options previously set with
{!set_font_options}. This function does not report options that
are derived from the target surface by {!update_context}. *)
val create_context : Cairo.context -> Pango.context
(** Creates a context object set up to match the current
transformation and target surface of the Cairo context. This
context can then be used to create a layout using
[Pango.Layout.create]. *)
val update_context : Cairo.context -> Pango.context -> unit
(** Updates a [Pango.context] previously created for use with Cairo to
match the current transformation and target surface of a Cairo
context. If any layouts have been created for the context, it's
necessary to call {!context_changed} on those layouts. *)
val create_layout : Cairo.context -> Pango.layout
(** [create_layout cr] creates a layout object set up to match the
current transformation and target surface of the Cairo context [cr].
This layout can then be used for text measurement with functions
like [Pango.Layout.get_size] or drawing with functions like
{!show_layout}. If you change the transformation or target surface
for [cr], you need to call {!update_layout}. *)
val update_layout : Cairo.context -> Pango.layout -> unit
(** [update_layout cr layout] updates the private [Pango.context] of
[layout] created with {!create_layout} to match the current
transformation and target surface of a Cairo context [cr]. *)
val show_layout : Cairo.context -> Pango.layout -> unit
(** [show_layout cr layout] draws a [layout] in the specified cairo
context [cr]. The top-left corner of [layout] will be drawn at the
current point of the cairo context. *)
val show_error_underline :
Cairo.context -> float -> float -> w:float -> h:float -> unit
(** [show_error_underline cr x y w h] draw a squiggly line in the
cairo context [cr] that approximately covers the given rectangle in
the style of an underline used to indicate a spelling error. (The
width [w] of the underline is rounded to an integer number of
up/down segments and the resulting rectangle is centered in the
original rectangle). *)
val layout_path : Cairo.context -> Pango.layout -> unit
(** [layout_path cr layout] adds the text in a [layout] to the current
path in [cr]. The top-left corner of the [layout] will be at the
current point of the cairo context. *)
val error_underline_path :
Cairo.context -> float -> float -> w:float -> h:float -> unit
(** [error_underline_path cr x y w h] add a squiggly line to the
current path in the cairo context [cr] that approximately covers
the given rectangle in the style of an underline used to indicate a
spelling error. (The width [w] of the underline is rounded to an
integer number of up/down segments and the resulting rectangle is
centered in the original rectangle). *)
ocaml-cairo/pango/cairo_pango_stubs.c 0000644 0001750 0001750 00000013124 13446257732 020125 0 ustar treinen treinen /* File: cairo_pango_stubs.c
Copyright (C) 2018-
Christophe Troestler
WWW: http://math.umons.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation. See the file
LICENCE for more details.
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 file
LICENSE for more details. */
#include
#include
#include
#include
#include
#include
/* OCaml labgtk stubs */
#include
#include
#include
/* OCaml Cairo bindings */
#include "cairo_ocaml.h"
/* https://developer.gnome.org/pango/stable/pango-Cairo-Rendering.html */
#define ALLOC(name) alloc_custom(&caml_##name##_ops, sizeof(void*), 1, 50)
#define DO2_NOALLOC(fn, of_val1, of_val2) \
CAMLexport value caml_##fn (value v1, value v2) \
{ \
/* noalloc */ \
fn(of_val1(v1), of_val2(v2)); \
return(Val_unit); \
}
#define DO5_NOALLOC(fn, of_val1, of_val2, of_val3, of_val4, of_val5) \
CAMLexport value caml_##fn (value v1, value v2, value v3, value v4, \
value v5) \
{ \
/* noalloc */ \
fn(of_val1(v1), of_val2(v2), of_val3(v3), of_val4(v4), of_val5(v5)); \
return(Val_unit); \
}
#define PANGO_CAIRO_FONT_MAP_VAL(v) check_cast(PANGO_CAIRO_FONT_MAP, v)
#define VAL_PANGO_CAIRO_FONT_MAP Val_GAnyObject
#define PANGO_CAIRO_FONT_VAL(v) check_cast(PANGO_CAIRO_FONT, v)
#define VAL_PANGO_CAIRO_FONT Val_GAnyObject
CAMLexport value caml_pango_cairo_font_map_get_default(value unit)
{
PangoFontMap *fm;
fm = pango_cairo_font_map_get_default();
return(Val_PangoFontMap(fm));
}
CAMLexport value caml_pango_cairo_font_map_set_default(value vfm)
{
/* noalloc */
pango_cairo_font_map_set_default(PANGO_CAIRO_FONT_MAP_VAL(vfm));
return(Val_unit);
}
CAMLexport value caml_pango_cairo_font_map_new(value unit)
{
CAMLparam1(unit);
PangoFontMap *fm = pango_cairo_font_map_new();
CAMLreturn(Val_PangoFontMap(fm));
}
CAMLexport value caml_pango_cairo_font_map_new_for_font_type(value vft)
{
CAMLparam1(vft);
PangoFontMap *fm =
pango_cairo_font_map_new_for_font_type(FONT_TYPE_VAL(vft));
CAMLreturn(Val_PangoFontMap(fm));
}
CAMLexport value caml_pango_cairo_font_map_get_font_type (value vfm)
{
CAMLparam1(vfm);
cairo_font_type_t ft =
pango_cairo_font_map_get_font_type(PANGO_CAIRO_FONT_MAP_VAL(vfm));
CAMLreturn(VAL_FONT_TYPE(ft));
}
DO2_NOALLOC(pango_cairo_font_map_set_resolution,
PANGO_CAIRO_FONT_MAP_VAL, Double_val)
CAMLexport value caml_pango_cairo_font_map_get_resolution (value vfm)
{
CAMLparam1(vfm);
double dpi =
pango_cairo_font_map_get_resolution(PANGO_CAIRO_FONT_MAP_VAL(vfm));
CAMLreturn(caml_copy_double(dpi));
}
CAMLexport value caml_cairo_pango_font_map_create_context (value vfm)
{
CAMLparam1(vfm);
/* 'pango_cairo_font_map_create_context' is deprecated in favor of
* 'pango_font_map_create_context' */
PangoContext *c =
pango_font_map_create_context(PangoFontMap_val(vfm));
CAMLreturn(Val_PangoContext(c));
}
CAMLexport value caml_pango_cairo_font_get_scaled_font (value vfont)
{
CAMLparam1(vfont);
CAMLlocal1(vf);
cairo_scaled_font_t *f =
pango_cairo_font_get_scaled_font(PANGO_CAIRO_FONT_VAL(vfont));
vf = ALLOC(scaled_font);
SCALED_FONT_VAL(vf) = f;
CAMLreturn(vf);
}
DO2_NOALLOC(pango_cairo_context_set_resolution,PangoContext_val, Double_val)
CAMLexport value caml_pango_cairo_context_get_resolution (value vc)
{
CAMLparam1(vc);
double dpi = pango_cairo_context_get_resolution(PangoContext_val(vc));
CAMLreturn(caml_copy_double(dpi));
}
DO2_NOALLOC(pango_cairo_context_set_font_options,
PangoContext_val, FONT_OPTIONS_VAL)
CAMLexport value caml_pango_cairo_context_get_font_options (value vc)
{
CAMLparam1(vc);
CAMLlocal1(vfo);
const cairo_font_options_t *fo =
pango_cairo_context_get_font_options(PangoContext_val(vc));
vfo = ALLOC(font_options);
FONT_OPTIONS_VAL(vfo) = (cairo_font_options_t *) fo;
CAMLreturn(vfo);
}
CAMLexport value caml_pango_cairo_create_context (value vcr)
{
CAMLparam1(vcr);
PangoContext *c = pango_cairo_create_context(CAIRO_VAL(vcr));
CAMLreturn(Val_PangoContext(c));
}
DO2_NOALLOC(pango_cairo_update_context, CAIRO_VAL, PangoContext_val)
CAMLexport value caml_pango_cairo_create_layout (value vcr)
{
CAMLparam1(vcr);
PangoLayout *l = pango_cairo_create_layout(CAIRO_VAL(vcr));
CAMLreturn(Val_PangoLayout(l));
}
DO2_NOALLOC(pango_cairo_update_layout, CAIRO_VAL, PangoLayout_val)
DO2_NOALLOC(pango_cairo_show_layout, CAIRO_VAL, PangoLayout_val)
DO5_NOALLOC(pango_cairo_show_error_underline,
CAIRO_VAL, Double_val, Double_val, Double_val, Double_val)
DO2_NOALLOC(pango_cairo_layout_path, CAIRO_VAL, PangoLayout_val)
DO5_NOALLOC(pango_cairo_error_underline_path,
CAIRO_VAL, Double_val, Double_val, Double_val, Double_val)
ocaml-cairo/pango/dune 0000644 0001750 0001750 00000000612 13446257732 015134 0 ustar treinen treinen
(library
(name cairo_pango)
(public_name cairo2-pango)
(c_names cairo_pango_stubs)
(c_flags :standard (:include c_flags.sexp))
(c_library_flags :standard (:include c_library_flags.sexp))
(libraries threads lablgtk2 cairo2)
(synopsis "Interface between Cairo and Pango"))
(rule
(targets c_flags.sexp c_library_flags.sexp)
(action (run ../config/discover.exe --gtk)))
ocaml-cairo/pango/cairo_pango.ml 0000644 0001750 0001750 00000005764 13446257732 017106 0 ustar treinen treinen (* File: cairo_pango.ml
Copyright (C) 2018-
Christophe Troestler
WWW: http://math.umons.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
module Font_map = struct
type t = [`pangofontmap | `cairo] Gobject.obj
external get_default : unit -> Pango.font_map
= "caml_pango_cairo_font_map_get_default"
external set_default : t -> unit
= "caml_pango_cairo_font_map_set_default" [@@noalloc]
external create : unit -> Pango.font_map
= "caml_pango_cairo_font_map_new"
external create_for_font_type : Cairo.font_type -> Pango.font_map
= "caml_pango_cairo_font_map_new_for_font_type"
external get_font_type : t -> Cairo.font_type
= "caml_pango_cairo_font_map_get_font_type"
external set_resolution : t -> float -> unit
= "caml_pango_cairo_font_map_set_resolution" [@@noalloc]
external get_resolution : t -> float
= "caml_pango_cairo_font_map_get_resolution"
external create_context : Pango.font_map -> Pango.context
= "caml_cairo_pango_font_map_create_context"
end
type cairo_font = [`pangofont | `cairo] Gobject.obj
external get_scaled_font : cairo_font -> _ Cairo.Scaled_font.t
= "caml_pango_cairo_font_get_scaled_font"
external set_resolution : Pango.context -> float -> unit
= "caml_pango_cairo_context_set_resolution" [@@noalloc]
external get_resolution : Pango.context -> float
= "caml_pango_cairo_context_get_resolution"
external set_font_options : Pango.context -> Cairo.Font_options.t -> unit
= "caml_pango_cairo_context_set_font_options" [@@noalloc]
external get_font_options : Pango.context -> Cairo.Font_options.t
= "caml_pango_cairo_context_get_font_options"
external create_context : Cairo.context -> Pango.context
= "caml_pango_cairo_create_context"
external update_context : Cairo.context -> Pango.context -> unit
= "caml_pango_cairo_update_context" [@@noalloc]
external create_layout : Cairo.context -> Pango.layout
= "caml_pango_cairo_create_layout"
external update_layout : Cairo.context -> Pango.layout -> unit
= "caml_pango_cairo_update_layout" [@@noalloc]
external show_layout : Cairo.context -> Pango.layout -> unit
= "caml_pango_cairo_show_layout" [@@noalloc]
external show_error_underline :
Cairo.context -> float -> float -> w:float -> h:float -> unit
= "caml_pango_cairo_show_error_underline"
external layout_path : Cairo.context -> Pango.layout -> unit
= "caml_pango_cairo_layout_path"
external error_underline_path :
Cairo.context -> float -> float -> w:float -> h:float -> unit
= "caml_pango_cairo_error_underline_path"
ocaml-cairo/tests/ 0000755 0001750 0001750 00000000000 13446257732 014315 5 ustar treinen treinen ocaml-cairo/tests/test_path.ml 0000644 0001750 0001750 00000001745 13446257732 016651 0 ustar treinen treinen
open Format
open Cairo
let print_path ppf p =
fprintf ppf "@[<2>[|";
for i = 0 to Array.length p - 1 do
if i > 0 then fprintf ppf ";@ ";
match p.(i) with
| MOVE_TO(x,y) -> fprintf ppf "MOVE_TO(%g,%g)" x y
| LINE_TO(x,y) -> fprintf ppf "LINE_TO(%g,%g)" x y
| CURVE_TO (x1,y1, x2,y2, x3,y3) ->
fprintf ppf "CURVE_TO(%g,%g, %g,%g, %g,%g)" x1 y1 x2 y2 x3 y3
| CLOSE_PATH -> fprintf ppf "CLOSE_PATH"
done;
fprintf ppf "@]|]"
let () =
let tmp = Filename.get_temp_dir_name() in
let surface = Cairo.PDF.create (Filename.concat tmp "test_path.pdf")
~w:300. ~h:300. in
let cr = Cairo.create surface in
move_to cr 0. 0.;
line_to cr 100. 100.;
let p = Path.to_array (Path.copy cr) in
printf "Current path: %a\n%!" print_path p;
let q = [| LINE_TO(110., 200.); LINE_TO(50., 150.) |] in
Path.append cr (Path.of_array q);
assert(Path.to_array (Path.copy cr) = Array.append p q);
Cairo.stroke cr;
Cairo.Surface.finish surface
ocaml-cairo/tests/matrix_set.ml 0000644 0001750 0001750 00000001221 13446257732 017022 0 ustar treinen treinen open Cairo
let () =
let cr = create (Image.create Image.ARGB32 ~w:100 ~h:100) in
let m = { xx = 1.; xy = 2.; yx = 3.; yy = 4.; x0 = 5.; y0 = 6. } in
set_matrix cr m;
assert(get_matrix cr = m)
(* Font *)
let () =
let m1 = Matrix.init_identity() in
let m2 = Matrix.init_translate 10. 20. in
let ff = Font_face.create Upright Normal in
let fo = Font_options.create() in
let sf = Scaled_font.create ff m1 m2 fo in
assert(Scaled_font.get_font_matrix sf = m1);
assert(Scaled_font.get_ctm sf = Matrix.init_identity());
assert(Scaled_font.get_font_options sf = fo)
(* Local Variables: *)
(* compile-command: "make -k -C.." *)
(* End: *)
ocaml-cairo/tests/test_finish.ml 0000644 0001750 0001750 00000001104 13446257732 017162 0 ustar treinen treinen open Printf
let () =
let surface = Cairo.Image.(create ARGB32 ~w:100 ~h:100) in
let ctx = Cairo.create surface in
Cairo.set_line_width ctx 1.;
Cairo.move_to ctx 0. 0.;
Cairo.line_to ctx 100. 100.;
Cairo.stroke ctx;
Cairo.Surface.finish surface;
Cairo.line_to ctx 100. 0.;
(* The following command should raise Error(SURFACE_FINISHED) but
does not currently because of a bug in Cairo
https://bugs.freedesktop.org/show_bug.cgi?id=68014 *)
try Cairo.stroke ctx
with Cairo.Error(Cairo.SURFACE_FINISHED) ->
printf "OK, correct exception raised\n"
ocaml-cairo/tests/test_exn.ml 0000644 0001750 0001750 00000000407 13446257732 016501 0 ustar treinen treinen open Printf
let () =
try
let cr = Cairo.create(Cairo.PNG.create "curve_to.png") in
Cairo.Surface.finish(Cairo.get_target cr);
exit 1; (* should no reach this *)
with e ->
printf "As expected, raise the exception: %s\n" (Printexc.to_string e)
ocaml-cairo/tests/test_for_stream.ml 0000644 0001750 0001750 00000001157 13446257732 020053 0 ustar treinen treinen open Printf
let make create fname =
let fh = open_out fname in
let surface = create (output_string fh) ~w:100. ~h:100. in
let ctx = Cairo.create surface in
Cairo.set_line_width ctx 1.;
Cairo.move_to ctx 0. 0.;
Cairo.line_to ctx 100. 100.;
Cairo.stroke ctx;
Cairo.Surface.finish surface; (* Important for the data to be written *)
flush fh;
close_out fh;
printf "Wrote %S.\n" fname
let () =
let tmp = Filename.get_temp_dir_name() in
make Cairo.SVG.create_for_stream (Filename.concat tmp "cairo-test.svg");
Gc.major();
make Cairo.PDF.create_for_stream (Filename.concat tmp "cairo-test.pdf");
ocaml-cairo/tests/dune 0000644 0001750 0001750 00000001075 13446257732 015176 0 ustar treinen treinen
(executables
(names image_create matrix_set surface_gc test_for_stream
test_finish test_path test_exn)
(libraries cairo2))
(alias
(name runtest)
(deps image_create.exe matrix_set.exe surface_gc.exe test_for_stream.exe
test_finish.exe test_path.exe test_exn.exe)
(action (progn
(run %{dep:image_create.exe})
(run %{dep:matrix_set.exe})
(run %{dep:surface_gc.exe})
(run %{dep:test_for_stream.exe})
(run %{dep:test_finish.exe})
(run %{dep:test_path.exe})
(run %{dep:test_exn.exe}))))
ocaml-cairo/tests/surface_gc.ml 0000644 0001750 0001750 00000001201 13446257732 016742 0 ustar treinen treinen open Printf
open Cairo
(* Test that using the ref-count of the surface to express its
dependency on the context works. *)
let image_context () =
let surf = Image.create Image.ARGB32 ~w:100 ~h:100 in
Gc.finalise (fun _ -> eprintf "`surf' is collected by the GC.\n%!") surf;
create surf
let () =
let cr = image_context() in
Gc.finalise (fun _ -> eprintf "`cr' is collected by the GC.\n%!") cr;
printf "`surf' should be garbage collected but the surface still held \
by `cr'.\n%!";
Gc.compact(); Gc.compact();
Surface.finish(get_target cr);
printf "`cr' should be garbage collected.\n%!";
Gc.compact(); Gc.compact()
ocaml-cairo/tests/image_create.ml 0000644 0001750 0001750 00000002212 13446257732 017251 0 ustar treinen treinen open Printf
open Cairo
open Bigarray
let create() =
let data = Array1.create int8_unsigned c_layout 360_000 in
Gc.finalise (fun _ -> eprintf "DESTROY bigarray 'data'\n%!") data;
let surf = Image.create_for_data8 data Image.RGB24 ~w:300 ~h:300 in
Cairo.create surf
let () =
let cr = create() in
set_source_rgb cr 1. 1. 1.;
rectangle cr 0. 0. ~w:300. ~h:300.;
fill cr;
Gc.compact(); Gc.compact();
set_source_rgb cr 1. 0. 0.;
move_to cr 10. 150.;
set_font_size cr 100.;
show_text cr "Hello";
Gc.compact(); Gc.compact();
eprintf "Write image\n%!";
PNG.write (get_target cr) "test_image.png";
eprintf "Finish surface\n%!";
Surface.finish (get_target cr);
Gc.compact()
(* Test for stride < 0 (not handled for now) and for incoherent width
/ stride *)
let () =
let mat = Array1.create int8_unsigned c_layout 80_000 in
let test_stride stride =
try
let surf = Image.create_for_data8 mat Image.A8 ~w:100 ~h:100 ~stride in
assert(Image.get_stride surf = stride)
with Error INVALID_STRIDE ->
assert(stride < 100)
in
test_stride 108;
test_stride 99;
test_stride 0;
test_stride (-108);
ocaml-cairo/README.md 0000644 0001750 0001750 00000012417 13446257732 014437 0 ustar treinen treinen [](https://travis-ci.org/Chris00/ocaml-cairo)
[](https://ci.appveyor.com/project/Chris00/ocaml-cairo)
OCaml interface to Cairo
========================
This is an OCaml binding for the
[Cairo](http://www.cairographics.org/) library, a 2D graphics library
with support for multiple output devices.
You can read the API of
[Cairo](http://chris00.github.io/ocaml-cairo/doc/cairo2/Cairo/),
[Cairo_gtk](http://chris00.github.io/ocaml-cairo/doc/cairo2-gtk/Cairo_gtk/),
and
[Cairo_pango](http://chris00.github.io/ocaml-cairo/doc/cairo2-pango/Cairo_pango/)
online.
Prerequisites
-------------
You need the development files of Cairo (see the
[conf-cairo](https://github.com/ocaml/opam-repository/blob/master/packages/conf-cairo/conf-cairo.1/opam#L7)
package)
and the OCaml package
``lablgtk2`` (in the [OPAM](https://opam.ocaml.org/) package
``lablgtk``).
Compilation & Installation
--------------------------
The easier way to install this library — once the prerequisites are set
up — is to use [opam](http://opam.ocaml.org/):
opam install cairo2
If you would like to compile from the sources, install [Dune][]
opam install dune
and do:
dune build @install
or just `make`. You can then install it with:
dune install
[Dune]: https://github.com/ocaml/dune
Examples
--------
You can read a version of the
[Cairo tutorial](http://chris00.github.io/ocaml-cairo/) using
this module. The code of this tutorial is available in the
``examples/`` directory. To compile it, just do
dune build @examples
All the examples below are available (with some comments) by clicking
on images in the [tutorial](http://cairo.forge.ocamlcore.org/tutorial/).
### Basic examples
- [stroke.ml](examples/stroke.ml) shows how to draw (stroke) a simple
rectangle on a PNG surface.
- [stroke.ml](examples/stroke.ml) shows how to fill a simple
rectangle on a PNG surface.
- [showtext.ml](examples/showtext.ml) illustrates how to select a font
and draw some text on a PNG surface.
- [paint.ml](examples/paint.ml) shows how to paint the current source
everywhere within the current clip region.
- [mask.ml](examples/mask.ml) shows how to apply a radial transparency
mask on top of a linear gradient.
- [setsourcergba.ml](examples/setsourcergba.ml) produces
- [setsourcegradient.ml](examples/setsourcegradient.ml) shows how to use
radial and linear patterns. It generates:
- [path_close.ml](examples/path_close.ml) shows how to draw a closed
path. It produces the PNG:
- [textextents.ml](examples/textextents.ml) displays graphically the various
dimensions one can request about text. It generates the PNG:
- [text_extents.ml](examples/text_extents.ml) exemplifies drawing
consecutive UTF-8 strings in a PDF file. Some helping lines are
also added to show the text extents.
- [tips_ellipse.ml](examples/tips_ellipse.ml) shows the action of
dilation on the line width and how to properly draw ellipses.
It generates the PNG:
- [tips_letter.ml](examples/tips_letter.ml) illustrates the wrong way
of centering characters based on their individual extents:
Instead, one should combine them with the font extents as shown in
[tips_font.ml](examples/tips_font.ml) to have:
### Examples generating the images of the tutorial
- [diagram.ml](examples/diagram.ml) draw the images of the section
[Cairo's Drawing Model](http://cairo.forge.ocamlcore.org/tutorial/#drawing_model):
- [draw.ml](examples/draw.ml) generates the various images in
[Drawing with Cairo](http://cairo.forge.ocamlcore.org/tutorial/#drawing_with_cairo), namely:
ocaml-cairo/examples-pango/ 0000755 0001750 0001750 00000000000 13446257732 016073 5 ustar treinen treinen ocaml-cairo/examples-pango/dune 0000644 0001750 0001750 00000000211 13446257732 016743 0 ustar treinen treinen
(executables
(names pango_demo rendering)
(libraries cairo2-pango))
(alias
(name examples)
(deps pango_demo.exe rendering.exe))
ocaml-cairo/examples-pango/pango_demo.ml 0000644 0001750 0001750 00000002463 13446257732 020542 0 ustar treinen treinen open Cairo
let two_pi = 2. *. acos(-1.)
let radius = 150.
(* Based on the example given at
https://developer.gnome.org/pango/stable/pango-Cairo-Rendering.html *)
let draw_text (cr: context) =
let n_words = 10 in
let font = "Sans Bold 26" in
Cairo.translate cr radius radius;
let layout = Cairo_pango.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 = 1 to n_words do
let angle = two_pi *. float i /. float n_words in
Cairo.save cr;
let red = (1. +. cos(angle -. two_pi /. 6.)) /. 2. in
Cairo.set_source_rgb cr red 0. (1. -. red);
Cairo.rotate cr angle;
(* Inform Pango to re-layout the text with the new transformation. *)
Cairo_pango.update_layout cr layout;
let width, _height = Pango.Layout.get_size layout in
Cairo.move_to cr (-. (float width /. float Pango.scale) /. 2.) (-. radius);
Cairo_pango.show_layout cr layout;
Cairo.restore cr;
done
let () =
let diam = truncate(2. *. radius) in
let surface = Cairo.Image.(create ARGB32 ~w:diam ~h:diam) in
let cr = Cairo.create surface in
Cairo.set_source_rgb cr 1. 1. 1.;
Cairo.paint cr;
draw_text cr;
Cairo.PNG.write surface "pango_demo.png"
ocaml-cairo/examples-pango/rendering.ml 0000644 0001750 0001750 00000001627 13446257732 020410 0 ustar treinen treinen (* Based on https://cairographics.org/cookbook/pycairo_pango/ *)
let () =
let surface = Cairo.Image.(create ARGB32 ~w:320 ~h:120) in
let cr = Cairo.create surface in
(* Draw a background rectangle: *)
Cairo.rectangle cr 0. 0. ~w:320. ~h:120.;
Cairo.set_source_rgb cr 1. 1. 1.;
Cairo.fill cr;
(* Get font families: *)
let font_map = Cairo_pango.Font_map.get_default() in
Cairo.translate cr 50. 25.;
let pc = Cairo_pango.Font_map.create_context font_map in
let layout = Pango.Layout.create pc in
let fontname = if Array.length Sys.argv >= 2 then Sys.argv.(1) else "Sans" in
let font = Pango.Font.from_string fontname in
Pango.Layout.set_font_description layout font;
Pango.Layout.set_text layout "Hello world こんにちは世界";
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo_pango.update_layout cr layout;
Cairo_pango.show_layout cr layout;
Cairo.PNG.write surface "rendering.png"
ocaml-cairo/config/ 0000755 0001750 0001750 00000000000 13446257732 014420 5 ustar treinen treinen ocaml-cairo/config/dune 0000644 0001750 0001750 00000000135 13446257732 015275 0 ustar treinen treinen
(executable
(name discover)
(modules discover)
(libraries dune.configurator str))
ocaml-cairo/config/discover.ml 0000644 0001750 0001750 00000011037 13446257732 016572 0 ustar treinen treinen module C = Configurator.V1
module P = C.Pkg_config
let write ~cflags ~libs =
C.Flags.write_sexp "c_flags.sexp" cflags;
C.Flags.write_sexp "c_library_flags.sexp" libs
(* let write ~cflags:_ ~libs:_ = () *)
let default_cairo c =
(* In case pkg-config fails *)
let sys = C.ocaml_config_var_exn c "system" in
if sys = "msvc" || sys = "win64" then
{ P.cflags = ["-I"; "C:\\gtk\\include\\cairo"];
libs = ["/LC:\\gtk\\lib"; "cairo.lib"] }
else { P.cflags = ["-I/usr/include/cairo"]; libs = ["-lcairo"] }
let c_header_has_ft () =
let fh = open_in "cairo_ocaml.h.p" in
let s = really_input_string fh (in_channel_length fh) in
close_in fh;
let re = Str.regexp "/\\* *#define *OCAML_CAIRO_HAS_FT .*\\*/" in
let s = Str.global_replace re "#define OCAML_CAIRO_HAS_FT 1" s in
let fh = open_out "cairo_ocaml.h" in
output_string fh s;
close_out fh
let discover_cairo c =
let p = match P.get c with
| Some p -> (match P.query p ~package:"cairo" with
| Some p -> p | None -> default_cairo c)
| None -> default_cairo c in
let cflags =
match Sys.getenv "CAIRO_CFLAGS" with
| exception Not_found -> p.P.cflags
| alt_cflags -> C.Flags.extract_blank_separated_words alt_cflags in
let libs =
match Sys.getenv "CAIRO_LIBS" with
| exception Not_found -> p.P.libs
| alt_libs -> C.Flags.extract_blank_separated_words alt_libs in
(* Check Cairo version *)
let d = C.C_define.(import c ~includes:["cairo.h"] ~c_flags:cflags
["CAIRO_VERSION_MAJOR", Type.Int;
"CAIRO_VERSION_MINOR", Type.Int ]) in
let version_major = match List.assoc "CAIRO_VERSION_MAJOR" d with
| C.C_define.Value.Int d -> d
| _ -> assert false in
let version_minor = match List.assoc "CAIRO_VERSION_MINOR" d with
| C.C_define.Value.Int d -> d
| _ -> assert false in
if not(version_major > 1 || (version_major = 1 && version_minor >= 6)) then
C.die "Cairo version us %d.%02d but must be at least 1.06\n"
version_major version_minor;
(*
* Add fontconfig flags and libs if available in Cairo.
*)
let d = C.C_define.(import c ~includes:["cairo-ft.h"] ~c_flags:cflags
["CAIRO_HAS_FT_FONT", Type.Switch;
"CAIRO_HAS_FC_FONT", Type.Switch ]) in
let has_ft_font = match List.assoc "CAIRO_HAS_FT_FONT" d with
| C.C_define.Value.Switch b -> b
| _ -> false in
let has_fc_font = match List.assoc "CAIRO_HAS_FC_FONT" d with
| C.C_define.Value.Switch b -> b
| _ -> false in
let cflags, libs =
if has_ft_font && has_fc_font then (
match P.get c with
| Some p ->
(match P.query p ~package:"fontconfig" with
| Some fc ->
(match P.query p ~package:"freetype2" with
| Some ft ->
(* freetype/ftmodapi.h on Debian but no prefix
directory on Ubuntu. *)
let freetype l f =
if String.length f > 2 && f.[0] = '-' && f.[1] = 'I' then
f :: (f ^ "/freetype") :: l
else f :: l in
c_header_has_ft ();
(List.fold_left freetype [] ft.cflags @ ft.cflags @ cflags,
ft.libs @ fc.libs @ libs)
| None -> cflags, libs)
| None -> C.die "Cairo was compiled with FreeType but \
fontconfig cannot be found.")
| None -> cflags, libs
)
else cflags, libs in
write ~cflags ~libs
let default_gtk c =
let sys = C.ocaml_config_var_exn c "system" in
if sys = "msvc" || sys = "win64" then
{ P.cflags = ["-I"; "C:\\gtk\\include"];
libs = ["/LC:\\gtk\\lib"; "gtk.lib"] }
else C.die "Please set Gtk flags through the environment variables \
GTK_CFLAGS and GTK_LIBS."
let discover_gtk c =
let p = match P.get c with
| Some p -> (match P.query p ~package:"gtk+-2.0" with
| Some p -> p | None -> default_gtk c)
| None -> default_gtk c in
let cflags =
match Sys.getenv "GTK_CFLAGS" with
| exception Not_found -> p.P.cflags
| alt_cflags -> C.Flags.extract_blank_separated_words alt_cflags in
let libs =
match Sys.getenv "GTK_LIBS" with
| exception Not_found -> p.P.libs
| alt_libs -> C.Flags.extract_blank_separated_words alt_libs in
write ~cflags ~libs
let () =
let gtk = ref false in
let specs = [
("--gtk", Arg.Set gtk, " add flags for Gtk")] in
Arg.parse specs (fun _ -> raise(Arg.Bad "no anonymous arg"))
"discover";
C.main ~name:"cairo"
(if !gtk then discover_gtk else discover_cairo)
ocaml-cairo/examples/ 0000755 0001750 0001750 00000000000 13446257732 014771 5 ustar treinen treinen ocaml-cairo/examples/text.ml 0000644 0001750 0001750 00000001442 13446257732 016310 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "text.pdf" ~w:400. ~h:300.) in
(* Take the cont from the command line if given: *)
let font = try Sys.argv.(1) with _ -> "Sans" in
select_font_face cr font ~weight:Bold;
set_font_size cr 90.0;
move_to cr 10. 135.;
show_text cr "Hello";
move_to cr 70. 165.;
Path.text cr "void";
set_source_rgb cr 0.5 0.5 1.;
fill_preserve cr;
set_source_rgb cr 0. 0. 0.;
set_line_width cr 2.56;
stroke cr;
(* draw helping lines *)
set_source_rgba cr 1. 0.2 0.2 0.6;
arc cr 10. 135. ~r:5.12 ~a1:0. ~a2:two_pi;
Path.close cr;
arc cr 70. 165. ~r:5.12 ~a1:0. ~a2:two_pi;
fill cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/paint.ml 0000644 0001750 0001750 00000000666 13446257732 016446 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.paint cr ~alpha:0.5;
(* Write output *)
Cairo.PNG.write surface "paint.png"
ocaml-cairo/examples/tips_ellipse.ml 0000644 0001750 0001750 00000001235 13446257732 020020 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let two_pi = 8. *. atan 1.
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_line_width cr 0.1;
Cairo.save cr;
Cairo.scale cr 0.5 1.;
Cairo.arc cr 0.5 0.5 ~r:0.40 ~a1:0. ~a2:two_pi;
Cairo.stroke cr;
Cairo.translate cr 1. 0.;
Cairo.arc cr 0.5 0.5 ~r:0.40 ~a1:0. ~a2:two_pi;
Cairo.restore cr;
Cairo.stroke cr;
(* Write output *)
Cairo.PNG.write surface "tips_ellipse.png"
ocaml-cairo/examples/arcs.ml 0000644 0001750 0001750 00000002025 13446257732 016252 0 ustar treinen treinen (* Examples by Øyvind Kolås taken from http://cairographics.org/samples/ *)
let pi = 4. *. atan 1.
let draw_arc cr arc =
let xc = 128.
and yc = 128. in
let radius = 100. in
let angle1 = 45. *. pi /. 180.0 in
let angle2 = 180. *. pi /. 180.0 in
Cairo.set_line_width cr 10.;
arc cr xc yc ~r:radius ~a1:angle1 ~a2:angle2;
Cairo.stroke cr;
(* draw helping lines *)
Cairo.set_source_rgba cr 1. 0.2 0.2 0.6;
Cairo.set_line_width cr 6.;
Cairo.arc cr xc yc ~r:10. ~a1:0. ~a2:(2. *. pi);
Cairo.fill cr;
Cairo.arc cr xc yc ~r:radius ~a1:angle1 ~a2:angle1;
Cairo.line_to cr xc yc;
Cairo.arc cr xc yc ~r:radius ~a1:angle2 ~a2:angle2;
Cairo.line_to cr xc yc;
Cairo.stroke cr
let () =
let surface = Cairo.SVG.create "arcs.svg" ~w:500. ~h:300. in
let cr = Cairo.create surface in
(* Arc *)
draw_arc cr Cairo.arc;
Cairo.translate cr 200. 0.;
(* Arc negative *)
Cairo.set_source_rgb cr 0. 0.8 0.;
draw_arc cr Cairo.arc_negative;
Cairo.PNG.write surface "arcs.png";
Cairo.Surface.finish surface
ocaml-cairo/examples/graphics_demo.ml 0000644 0001750 0001750 00000004107 13446257732 020131 0 ustar treinen treinen (* Demo to show how one could achieve cairo drawing on a Graphics
window. Note that using XLib or GTK would be *much* faster. *)
open Printf
open Bigarray
open Cairo
let pi2 = 8. *. atan 1.
let lastfps = ref (Unix.gettimeofday ())
let frames = ref 0
let fps = ref 0.
let update_fps () =
let t = Unix.gettimeofday () in
let dt = t -. !lastfps in
if dt > 0.5 then (
fps := float !frames /. dt;
frames := 0;
lastfps := t
);
incr frames
let draw cr width height x y =
let x = x -. width *. 0.5 and y = y -. height *. 0.5 in
let r = 0.5 *. sqrt (x *. x +. y *. y) in
set_source_rgba cr 0. 1. 0. 0.5;
arc cr (0.5 *. width) (0.35 *. height) r 0. pi2;
fill cr;
set_source_rgba cr 1. 0. 0. 0.5;
arc cr (0.35 *. width) (0.65 *. height) r 0. pi2;
fill cr;
set_source_rgba cr 0. 0. 1. 0.5;
arc cr (0.65 *. width) (0.65 *. height) r 0. pi2;
fill cr;
set_source_rgba cr 1. 1. 0. 1.;
move_to cr (0.05 *. width) (0.95 *. height);
show_text cr (sprintf "%gx%g -- %.0f fps" width height !fps)
let expose () =
let sx = Graphics.size_x ()
and sy = Graphics.size_y ()
and mx, my = Graphics.mouse_pos () in
(* Create a cairo context from a cairo surface and do our drawings
on it. Note: we may cache it between expose events for
incremental drawings but its creation and initialization is not
the time bottleneck here. *)
let cr_img = Image.create Image.RGB24 sx sy in
let cr = create cr_img in
draw cr (float sx) (float sy) (float mx) (float my);
(* Don't forget to flush the surface before using its content. *)
Surface.flush cr_img;
(* Now, access the surface data and convert it to a Graphics.image
that can be drawn on the Graphics window. *)
let data32 = Image.get_data32 cr_img in
let data_img =
Array.init sy
(fun y -> Array.init sx (fun x -> Int32.to_int (data32.{y, x})))
in
Graphics.draw_image (Graphics.make_image data_img) 0 0;
Graphics.synchronize ();
(* Update our fps counter. *)
update_fps ()
let () =
Graphics.open_graph "";
Graphics.auto_synchronize false;
while true do
expose ()
done
ocaml-cairo/examples/fill.ml 0000644 0001750 0001750 00000000727 13446257732 016257 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.fill cr;
(* Write output *)
Cairo.PNG.write surface "fill.png"
ocaml-cairo/examples/setsourcergba.ml 0000644 0001750 0001750 00000001557 13446257732 020203 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.move_to cr 0. 0.;
Cairo.line_to cr 1. 1.;
Cairo.move_to cr 1. 0.;
Cairo.line_to cr 0. 1.;
Cairo.set_line_width cr 0.2;
Cairo.stroke cr;
Cairo.rectangle cr 0. 0. ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 1. 0. 0. 0.80;
Cairo.fill cr;
Cairo.rectangle cr 0. 0.5 ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 0. 1. 0. 0.60;
Cairo.fill cr;
Cairo.rectangle cr 0.5 0. ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 0. 0. 1. 0.40;
Cairo.fill cr;
(* Write output *)
Cairo.PNG.write surface "setsourcergba.png"
ocaml-cairo/examples/fill_stroke.ml 0000644 0001750 0001750 00000001146 13446257732 017642 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let () =
let cr = Cairo.create(Cairo.PDF.create "fill_stroke.pdf" ~w:400. ~h:300.) in
move_to cr 128.0 25.6;
line_to cr 230.4 230.4;
rel_line_to cr (-102.4) 0.;
curve_to cr 51.2 230.4 51.2 128.0 128.0 128.0;
Path.close cr;
move_to cr 64.0 25.6;
rel_line_to cr 51.2 51.2;
rel_line_to cr (-51.2) 51.2;
rel_line_to cr (-51.2) (-51.2);
Path.close cr;
set_line_width cr 10.0;
set_source_rgb cr 0. 0. 1.;
fill_preserve cr;
set_source_rgb cr 0. 0. 0.;
stroke cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/recording.ml 0000644 0001750 0001750 00000002125 13446257732 017277 0 ustar treinen treinen (* Demonstrate the use of recording surfaces. *)
open Printf
let () =
let extents = { Cairo.x = 0.0; y = 0.0; w = 120.0; h = 120.0 } in
let surface = Cairo.Recording.create ~extents Cairo.COLOR_ALPHA in
let cr = Cairo.create surface in
(* Drawing code goes here *)
Cairo.set_line_width cr 2.;
Cairo.set_source_rgb cr 1. 0. 0.;
Cairo.move_to cr 25. 25.;
Cairo.line_to cr 120. 120.;
Cairo.stroke cr;
let r = Cairo.Recording.ink_extents surface in
printf "extents = {x=%g; y=%g; w=%g; h=%g}\n"
r.Cairo.x r.Cairo.y r.Cairo.w r.Cairo.h;
(* Replay the recorded content to a PNG and PDF output *)
(* PNG *)
let png_surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create png_surface in
Cairo.set_source_surface cr surface ~x:0.0 ~y:0.0;
Cairo.paint cr;
Cairo.PNG.write png_surface "recording.png";
(* PDF *)
let pdf_surface = Cairo.PDF.create "recording.pdf" ~w:120.0 ~h:120.0 in
let cr = Cairo.create pdf_surface in
Cairo.set_source_surface cr surface ~x:0.0 ~y:0.0;
Cairo.paint cr;
Cairo.Surface.finish (Cairo.get_target cr)
ocaml-cairo/examples/text_extents.ml 0000644 0001750 0001750 00000001547 13446257732 020070 0 ustar treinen treinen (* -*- coding:utf-8 -*- *)
(* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "text_extents.pdf" ~w:400. ~h:300.) in
(* Take the cont from the command line if given: *)
let font = try Sys.argv.(1) with _ -> "Sans" in
let utf8 = "cairo" in
select_font_face cr font;
set_font_size cr 100.0;
let e = text_extents cr utf8 in
let x = 25. in
let y = 150. in
move_to cr x y; show_text cr utf8;
show_text cr "∫";
(* draw helping lines *)
set_source_rgba cr 1. 0.2 0.2 0.6;
set_line_width cr 6.0;
arc cr x y ~r:10. ~a1:0. ~a2:two_pi;
fill cr;
move_to cr x y;
rel_line_to cr 0. (-. e.height);
rel_line_to cr e.width 0.;
rel_line_to cr e.x_bearing (-. e.y_bearing);
stroke cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/curve_to.ml 0000644 0001750 0001750 00000001074 13446257732 017153 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let x = 25.6 and y = 128.0
let x1 = 102.4 and y1 = 230.4
let x2 = 153.6 and y2 = 25.6
let x3 = 230.4 and y3 = 128.0
let () =
let cr = Cairo.create(Cairo.PDF.create "curve_to.pdf" ~w:400. ~h:300.) in
move_to cr x y;
curve_to cr x1 y1 x2 y2 x3 y3;
set_line_width cr 10.0;
stroke cr;
set_source_rgba cr 1. 0.2 0.2 0.6;
set_line_width cr 6.0;
move_to cr x y; line_to cr x1 y1;
move_to cr x2 y2; line_to cr x3 y3;
stroke cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/pythagoras_tree.ml 0000644 0001750 0001750 00000004224 13446257732 020525 0 ustar treinen treinen (* Example inspired from
http://www.ffconsultancy.com/products/fsharp_for_visualization/demo6.html
*)
open Cairo
let pi = acos(-1.)
let set_green cr = Cairo.set_source_rgb cr 0. 0.7 0.
let set_darkgreen cr = Cairo.set_source_rgb cr 0. 0.5 0.
let set_burlywood cr = Cairo.set_source_rgb cr 0.87 0.72 0.53
let transform_data m = function
| MOVE_TO (x, y) -> let x, y = Matrix.transform_point m x y in
MOVE_TO (x, y)
| LINE_TO (x, y) -> let x, y = Matrix.transform_point m x y in
LINE_TO (x, y)
| CURVE_TO (x1,y1, x2,y2, x3,y3) ->
let x1, y1 = Matrix.transform_point m x1 y1
and x2, y2 = Matrix.transform_point m x2 y2
and x3, y3 = Matrix.transform_point m x3 y3 in
CURVE_TO (x1,y1, x2,y2, x3,y3)
| CLOSE_PATH -> CLOSE_PATH
let transform m path = Array.map (transform_data m) path
(* Transform matrices (in "abstract" coordinates) *)
let m1 = Matrix.(let m = init_translate 0. 1. in (* last *)
scale m (4. /. 5.) (4. /. 5.);
rotate m (0.5 *. pi -. asin(4. /. 5.)); (* first *)
m)
let m2 = Matrix.(let m = init_translate 1. 1. in
scale m (3. /. 5.) (3. /. 5.);
rotate m (-0.5 *. pi +. asin(3. /. 5.));
translate m (-1.) 0.;
m)
let rec tree cr n square =
if n = 0 then (
set_darkgreen cr;
Path.append cr (Path.of_array square);
fill cr;
)
else (
set_burlywood cr;
Path.append cr (Path.of_array square);
fill_preserve cr;
set_green cr;
stroke cr;
(* Simple (but not very efficient) to ensure that all squares of a
given level is drawn at the same time. *)
let m = Array.append (transform m1 square) (transform m2 square) in
tree cr (n - 1) m
)
let () =
let surface = Cairo.PDF.create "pythagoras_tree.pdf" ~w:300. ~h:250. in
let cr = Cairo.create surface in
translate cr 150. 220.;
scale cr 45. (-45.);
set_line_width cr 0.01; (* compensate scaling *)
let square = [| MOVE_TO (0., 0.); LINE_TO (1., 0.); LINE_TO (1., 1.);
LINE_TO (0., 1.); CLOSE_PATH |] in
tree cr 12 square;
Cairo.Surface.finish surface
ocaml-cairo/examples/fill_style.ml 0000644 0001750 0001750 00000001255 13446257732 017474 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "fill_style.pdf" ~w:400. ~h:300.) in
set_line_width cr 6.;
let figure fill_style r g b =
rectangle cr 12. 12. ~w:232. ~h:70.;
Path.sub cr; arc cr 64. 64. ~r:40. ~a1:0. ~a2:two_pi;
Path.sub cr; arc_negative cr 192. 64. ~r:40. ~a1:0. ~a2:(-. two_pi);
set_fill_rule cr fill_style;
set_source_rgb cr r g b; fill_preserve cr;
set_source_rgb cr 0. 0. 0.; stroke cr
in
figure EVEN_ODD 0. 0.7 0.;
translate cr 0. 128.;
figure WINDING 0. 0. 0.9;
Surface.finish(get_target cr)
ocaml-cairo/examples/showtext.ml 0000644 0001750 0001750 00000001171 13446257732 017210 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
open Cairo
let () =
let surface = Image.create Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
scale cr 120. 120.;
(* Drawing code goes here *)
set_source_rgb cr 0.0 0.0 0.0;
select_font_face cr "Georgia" ~weight:Bold;
set_font_size cr 1.2;
let te = text_extents cr "a" in
move_to cr (0.5 -. te.width /. 2. -. te.x_bearing)
(0.5 -. te.height /. 2. -. te.y_bearing);
show_text cr "a";
(* Write output and clean up *)
PNG.write surface "showtext.png"
ocaml-cairo/examples/textextents.ml 0000644 0001750 0001750 00000004321 13446257732 017722 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
open Cairo
let () =
let text = "joy" in
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:600 ~h:600 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 600. 600.;
Cairo.set_font_size cr 0.5;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0.0 0.0 0.0;
Cairo.select_font_face cr "Georgia" ~weight:Bold;
let ux, uy = Cairo.device_to_user_distance cr 1. 1. in
let px = max ux uy in
let fe = Cairo.font_extents cr in
let te = Cairo.text_extents cr text in
(* The position of the text will be (x, y) *)
let x = 0.5 -. te.x_bearing -. te.width /. 2.
and y = 0.5 -. fe.descent +. fe.baseline /. 2. in
(* baseline, descent, ascent, height (in dashed green) *)
Cairo.set_line_width cr (4. *. px);
Cairo.set_dash cr [| 9. *. px |];
Cairo.set_source_rgba cr 0. 0.6 0. 0.5;
let horizontal_line y =
Cairo.move_to cr (x +. te.x_bearing) y;
Cairo.rel_line_to cr te.width 0. in
horizontal_line y;
horizontal_line (y +. fe.descent);
horizontal_line (y -. fe.ascent);
horizontal_line (y -. fe.baseline);
Cairo.stroke cr;
(* extents: width & height (in dashed blue) *)
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
Cairo.set_line_width cr px;
Cairo.set_dash cr [| 3. *. px |];
Cairo.rectangle cr (x +. te.x_bearing) (y +. te.y_bearing)
~w:te.width ~h:te.height;
Cairo.stroke cr;
(* text *)
Cairo.move_to cr x y;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.show_text cr text;
(* bearing (solid blue line) *)
Cairo.set_dash cr [| |];
Cairo.set_line_width cr (2. *. px);
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
Cairo.move_to cr x y;
Cairo.rel_line_to cr te.x_bearing te.y_bearing;
Cairo.stroke cr;
(* text's advance (blue dot) *)
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
let two_pi = 8. *. atan 1. in
Cairo.arc cr (x +. te.x_advance) (y +. te.y_advance) ~r:(6. *. px)
~a1:0. ~a2:two_pi;
Cairo.fill cr;
(* reference point (x,y) (red dot) *)
Cairo.arc cr x y ~r:(6. *. px) ~a1:0. ~a2:two_pi;
Cairo.set_source_rgba cr 0.75 0. 0. 0.5;
Cairo.fill cr;
(* Write output *)
Cairo.PNG.write surface "textextents.png"
ocaml-cairo/examples/dash.ml 0000644 0001750 0001750 00000001113 13446257732 016236 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let () =
let cr = Cairo.create(Cairo.PDF.create "dash.pdf" ~w:400. ~h:300.) in
let dashes = [| 50.0; (* ink *)
10.0; (* skip *)
10.0; (* ink *)
10.0 (* skip*)
|] in
let ofs = -50.0 in
set_dash cr dashes ~ofs;
set_line_width cr 10.0;
move_to cr 128.0 25.6;
line_to cr 230.4 230.4;
rel_line_to cr (-102.4) 0.0;
curve_to cr 51.2 230.4 51.2 128.0 128.0 128.0;
stroke cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/tips_font.ml 0000644 0001750 0001750 00000001574 13446257732 017337 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
open Cairo
let () =
let alphabet = "AbCdEfGhIjKlMnOpQrStUvWxYz" in
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:780 ~h:30 in
let cr = Cairo.create surface in
(* Examples are in 26.0 x 1.0 coordinate space *)
Cairo.scale cr 30. 30.;
Cairo.set_font_size cr 0.8;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0.0 0.0 0.0;
Cairo.select_font_face cr "Georgia" ~weight:Bold;
let fe = Cairo.font_extents cr in
for i = 0 to String.length alphabet - 1 do
let letter = String.make 1 (alphabet.[i]) in
let te = Cairo.text_extents cr letter in
Cairo.move_to cr (float i +. 0.5 -. te.x_bearing -. te.width /. 2.)
(0.5 -. fe.descent +. fe.baseline /. 2.);
Cairo.show_text cr letter;
done;
(* Write output *)
Cairo.PNG.write surface "tips_font.png"
ocaml-cairo/examples/text_rotate.ml 0000644 0001750 0001750 00000001751 13446257732 017671 0 ustar treinen treinen (* -*- coding:utf-8 -*- *)
open Printf
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "text_rotate.pdf" ~w:400. ~h:400.) in
(* Take the cont from the command line if given: *)
let font = try Sys.argv.(1) with _ -> "Georgia" in
select_font_face cr font;
set_font_size cr 50.0;
let x0 = 200. and y0 = 200. in
translate cr x0 y0;
save cr;
set_source_rgba cr 1. 0. 0. 0.5;
move_to cr (-150.) 0.; line_to cr 300. 0.; stroke cr;
move_to cr 0. (-150.); line_to cr 0. 300.; stroke cr;
restore cr;
let n = 4 in
let da = two_pi /. float n in
move_to cr 0. 0.;
for i = 0 to n - 1 do
save cr;
let angle = float i *. da in
set_source_rgba cr 0. 0. 0. (float(n - i) /. float n);
rotate cr angle;
show_text cr (sprintf "j φ=%g°" (360. *. float i /. float n));
set_source_rgba cr 0. 0. 1. 0.3;
arc cr 0. 0. ~r:2. ~a1:0. ~a2:two_pi;
fill cr;
restore cr;
done;
Surface.finish(get_target cr)
ocaml-cairo/examples/tips_letter.ml 0000644 0001750 0001750 00000001532 13446257732 017662 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
open Cairo
let () =
let alphabet = "AbCdEfGhIjKlMnOpQrStUvWxYz" in
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:780 ~h:30 in
let cr = Cairo.create surface in
(* Examples are in 26.0 x 1.0 coordinate space *)
Cairo.scale cr 30. 30.;
Cairo.set_font_size cr 0.8;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0.0 0.0 0.0;
Cairo.select_font_face cr "Georgia" ~weight:Bold;
for i = 0 to String.length alphabet - 1 do
let letter = String.make 1 (alphabet.[i]) in
let te = Cairo.text_extents cr letter in
Cairo.move_to cr (float i +. 0.5 -. te.x_bearing -. te.width /. 2.)
(0.5 -. te.y_bearing -. te.height /. 2.);
Cairo.show_text cr letter;
done;
(* Write output *)
Cairo.PNG.write surface "tips_letter.png"
ocaml-cairo/examples/diagram.ml 0000644 0001750 0001750 00000017742 13446257732 016742 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
open Cairo
let diagram_draw_source cr =
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr
let diagram_draw_mask cr =
Cairo.set_source_rgb cr 1. 0.9 0.6;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr
let diagram_draw_mask_pattern cr pat =
Cairo.set_source_rgb cr 1. 0.9 0.6;
Cairo.mask cr pat
let diagram_draw_dest cr =
Cairo.set_source_rgb cr 1. 1. 1.;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr
let stroke_draw_mask cr =
Cairo.Group.push cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.rectangle cr 0.20 0.20 ~w:0.6 ~h:0.6;
Cairo.rectangle cr 0.30 0.30 ~w:0.4 ~h:0.4;
Cairo.set_fill_rule cr EVEN_ODD;
Cairo.fill cr;
Cairo.set_fill_rule cr WINDING;
diagram_draw_mask_pattern cr (Cairo.Group.pop cr);
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.set_source_rgb cr 0. 0.6 0.;
let px, py = Cairo.device_to_user_distance cr 1. 1. in
Cairo.set_line_width cr (max px py);
Cairo.stroke cr
let stroke_draw_dest cr =
diagram_draw_dest cr;
Cairo.set_line_width cr 0.1;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.stroke cr
let fill_draw_mask cr =
Cairo.Group.push cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.set_fill_rule cr EVEN_ODD;
Cairo.fill cr;
Cairo.set_fill_rule cr WINDING;
diagram_draw_mask_pattern cr (Cairo.Group.pop cr);
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.set_source_rgb cr 0. 0.6 0.;
let px, py = Cairo.device_to_user_distance cr 1. 1. in
Cairo.set_line_width cr (max px py);
Cairo.stroke cr
let fill_draw_dest cr =
diagram_draw_dest cr;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.fill cr
let showtext_draw_mask cr =
(* yellow mask color *)
Cairo.set_source_rgb cr 1. 0.9 0.6;
(* rectangle with an "a"-shaped hole *)
Cairo.select_font_face cr "Georgia" ~weight:Bold;
Cairo.set_font_size cr 1.2;
let te = Cairo.text_extents cr "a" in
Cairo.Group.push cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.move_to cr (0.5 -. te.width /. 2. -. te.x_bearing)
(0.5 -. te.height /. 2. -. te.y_bearing);
Cairo.Path.text cr "a";
Cairo.set_fill_rule cr EVEN_ODD;
Cairo.fill cr;
Cairo.set_fill_rule cr WINDING;
Cairo.Group.pop_to_source cr;
Cairo.paint cr;
(* show the outline of the glyph with a green line *)
Cairo.move_to cr (0.5 -. te.width /. 2. -. te.x_bearing)
(0.5 -. te.height /. 2. -. te.y_bearing);
Cairo.set_source_rgb cr 0. 0.6 0.;
let ux, uy = Cairo.device_to_user_distance cr 1. 1. in
Cairo.set_line_width cr (max ux uy);
Cairo.Path.text cr "a";
Cairo.stroke cr
let showtext_draw_dest cr =
(* white background *)
Cairo.set_source_rgb cr 1. 1. 1.;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr;
(* black letter "a" *)
Cairo.set_source_rgb cr 0.0 0.0 0.0;
Cairo.select_font_face cr "Georgia" ~weight:Bold;
Cairo.set_font_size cr 1.2;
let te = Cairo.text_extents cr "a" in
Cairo.move_to cr (0.5 -. te.width /. 2. -. te.x_bearing)
(0.5 -. te.height /. 2. -. te.y_bearing);
Cairo.show_text cr "a"
let paint_draw_source cr =
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr
let paint_draw_dest cr =
diagram_draw_dest cr;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.paint cr ~alpha:0.5
let mask_draw_source cr =
let linpat = Cairo.Pattern.create_linear ~x0:0. ~y0:0. ~x1:1. ~y1:1. in
Cairo.Pattern.add_color_stop_rgb linpat 0. 0.3 0.8;
Cairo.Pattern.add_color_stop_rgb linpat 0. 0.8 0.3 ~ofs:1.;
Cairo.set_source cr linpat;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.fill cr
let mask_draw_mask cr =
let radialinv = Cairo.Pattern.create_radial ~x0:0.5 ~y0:0.5 ~r0:0.25
~x1:0.5 ~y1:0.5 ~r1:0.75 in
Cairo.Pattern.add_color_stop_rgba radialinv 0. 0. 0. 0.;
Cairo.Pattern.add_color_stop_rgba radialinv ~ofs:0.5 0. 0. 0. 1.;
Cairo.save cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.clip cr;
diagram_draw_mask_pattern cr radialinv;
Cairo.restore cr
let mask_draw_dest cr =
let linpat = Cairo.Pattern.create_linear ~x0:0. ~y0:0. ~x1:1. ~y1:1. in
Cairo.Pattern.add_color_stop_rgb linpat 0. 0.3 0.8;
Cairo.Pattern.add_color_stop_rgb linpat ~ofs:1. 0. 0.8 0.3;
let radpat = Cairo.Pattern.create_radial ~x0:0.5 ~y0:0.5 ~r0:0.25
~x1:0.5 ~y1:0.5 ~r1:0.75 in
Cairo.Pattern.add_color_stop_rgba radpat 0. 0. 0. 1.;
Cairo.Pattern.add_color_stop_rgba radpat ~ofs:0.5 0. 0. 0. 0.;
diagram_draw_dest cr;
Cairo.save cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.clip cr;
Cairo.set_source cr linpat;
Cairo.mask cr radpat;
Cairo.restore cr
let draw_dest name cr =
if name = "stroke" then stroke_draw_dest cr
else if name = "fill" then fill_draw_dest cr
else if name = "showtext" then showtext_draw_dest cr
else if name = "paint" then paint_draw_dest cr
else if name = "mask" then mask_draw_dest cr
else diagram_draw_dest cr
let draw_mask name cr =
if name = "stroke" then stroke_draw_mask cr
else if name = "fill" then fill_draw_mask cr
else if name = "showtext" then showtext_draw_mask cr
else if name = "paint" then ()
else if name = "mask" then mask_draw_mask cr
else diagram_draw_mask cr
let draw_source name cr =
if name = "paint" then paint_draw_source cr
else if name = "mask" then mask_draw_source cr
else diagram_draw_source cr
let diagram fname alpha0 alpha1 alpha2 =
let width=160. and height=120. in
let svg_filename = fname ^ ".svg"
and png_filename = fname ^ ".png" in
let surf = Cairo.SVG.create svg_filename ~w:width ~h:height in
let cr = Cairo.create surf in
(*
* show layers separately on the right
*)
let layer draw =
Cairo.save cr;
Cairo.Group.push cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.clip cr;
draw fname cr;
Cairo.Group.pop_to_source cr;
Cairo.paint cr;
Cairo.restore cr;
in
Cairo.save cr;
Cairo.scale cr (height /. 3.) (height /. 3.);
(* source *)
Cairo.translate cr (3. *. width /. height -. 1.) 0.;
layer draw_source;
(* mask *)
Cairo.translate cr 0. 1.;
layer draw_mask;
(* destination *)
Cairo.translate cr 0. 1.;
layer draw_dest;
Cairo.restore cr;
(* draw a border around the layers *)
Cairo.save cr;
Cairo.scale cr (height /. 3.) (height /. 3.);
Cairo.translate cr (3. *. width /. height -. 1.) 0.;
let ux, uy = Cairo.device_to_user_distance cr 2. 2. in
Cairo.set_line_width cr (max ux uy);
Cairo.rectangle cr 0. 0. ~w:1. ~h:3.;
Cairo.clip_preserve cr;
Cairo.stroke cr;
Cairo.rectangle cr 0. 1. ~w:1. ~h:1.;
Cairo.stroke cr;
Cairo.restore cr;
(*
* layer diagram on the left
*)
let left_layers ~tx ~ty alpha draw =
Cairo.save cr;
Cairo.scale cr (width -. height /. 3.) height;
Cairo.transform cr { xx=0.6; yx=0.; xy=1./.3.; yy=0.5; x0=tx; y0=ty };
Cairo.Group.push cr;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.clip cr;
draw fname cr;
Cairo.Group.pop_to_source cr;
Cairo.paint cr ~alpha;
Cairo.restore cr;
in
(* destination layer *)
left_layers alpha0 ~tx:0.02 ~ty:0.45 begin fun fname cr ->
draw_dest fname cr;
(* this layer gets a black border *)
Cairo.set_source_rgb cr 0. 0. 0.;
let ux, uy = Cairo.device_to_user_distance cr 2. 2. in
Cairo.set_line_width cr (max ux uy);
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.stroke cr
end;
(* mask layer *)
left_layers alpha1 draw_mask ~tx:0.04 ~ty:0.25;
(* source layer *)
left_layers alpha2 draw_source ~tx:0.06 ~ty:0.05;
(* write output *)
Cairo.PNG.write surf png_filename;
Cairo.Surface.finish surf
let () =
diagram "destination" 1.0 0.15 0.15;
diagram "the-mask" 0.15 1.0 0.15;
diagram "source" 0.15 0.15 1.0;
diagram "stroke" 1.0 0.8 0.4;
diagram "fill" 1.0 0.8 0.4;
diagram "showtext" 1.0 0.8 0.4;
diagram "paint" 1.0 0.8 0.4;
diagram "mask" 1.0 0.8 0.4
ocaml-cairo/examples/setsourcegradient.ml 0000644 0001750 0001750 00000002616 13446257732 021062 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
let radpat = Cairo.Pattern.create_radial ~x0:0.25 ~y0:0.25 ~r0:0.1
~x1:0.5 ~y1:0.5 ~r1:0.5 in
Cairo.Pattern.add_color_stop_rgb radpat 1.0 0.8 0.8;
Cairo.Pattern.add_color_stop_rgb radpat ~ofs:1. 0.9 0.0 0.0;
for i=1 to 9 do
for j=1 to 9 do
Cairo.rectangle cr (float i /. 10. -. 0.04)
(float j /. 10. -. 0.04) ~w:0.08 ~h:0.08;
done
done;
Cairo.set_source cr radpat;
Cairo.fill cr;
let linpat = Cairo.Pattern.create_linear ~x0:0.25 ~y0:0.35
~x1:0.75 ~y1:0.65 in
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.00 1. 1. 1. 0.0;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.25 0. 1. 0. 0.5;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.50 1. 1. 1. 0.0;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.75 0. 0. 1. 0.5;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:1.00 1. 1. 1. 0.0;
Cairo.rectangle cr 0.0 0.0 ~w:1. ~h:1.;
Cairo.set_source cr linpat;
Cairo.fill cr;
(* Write output *)
Cairo.PNG.write surface "setsourcegradient.png"
ocaml-cairo/examples/dune 0000644 0001750 0001750 00000001673 13446257732 015656 0 ustar treinen treinen (executables
(names arcs clip curve_to dash fill_stroke
fill_style gradient set_line_cap set_line_join
text text_align_center text_extents text_rotate
recording pythagoras_tree
graphics_demo
;; Tutorial sources
stroke fill showtext paint mask setsourcergba
setsourcegradient path_close textextents diagram
draw tips_ellipse tips_letter tips_font)
(libraries cairo2 graphics))
(alias
(name examples)
(deps arcs.exe clip.exe curve_to.exe dash.exe fill_stroke.exe
fill_style.exe gradient.exe set_line_cap.exe set_line_join.exe
text.exe text_align_center.exe text_extents.exe text_rotate.exe
recording.exe pythagoras_tree.exe))
(alias
(name tutorial)
(deps stroke.exe fill.exe showtext.exe paint.exe mask.exe setsourcergba.exe
setsourcegradient.exe path_close.exe textextents.exe diagram.exe
draw.exe tips_ellipse.exe tips_letter.exe tips_font.exe))
ocaml-cairo/examples/word_cloud/ 0000755 0001750 0001750 00000000000 13446257732 017132 5 ustar treinen treinen ocaml-cairo/examples/word_cloud/run.ml 0000644 0001750 0001750 00000003441 13446257732 020272 0 ustar treinen treinen (* -*- coding:utf-8 -*- *)
open Printf
open Cairo
module Palette = Cloud.Palette
let l1 = 1.
let l2 = 0.7
let words = [
(1.05, "Mons");
(l1, "Psychologie");
(l1, "Sciences de l'éducation");
(l1, "Sciences Humaines et Sociales");
(l1, "Sciences du langage");
(l1, "Gestion");
(l1, "Warocqué");
(l1, "Sciences");
(l1, "Polytech");
(l1, "Ingénieur civil");
(l1, "FTI-EII");
(l1, "Droit");
(l1, "Médecine");
(l1, "Pharmacie");
(l1, "Archi Mons");
(l1, "Charleroi");
l2, "Logopédie";
l2, "Sciences politiques et sociales";
l2, "Mathématique";
l2, "Informatique";
l2, "Informatique de gestion";
l2, "Chimie";
l2, "Physique";
l2, "Biologie";
l2, "Sciences biomédicales";
l2, "Traduction";
l2, "Interprétation";
l2, "Architecture";
l2, "Électricité";
l2, "Mines et Géologie";
l2, "Mécanique";
l2, "Horaire décalé";
l2, "Formation permanente";
]
let () =
let font = try Sys.argv.(1) with _ -> "Sans" in
try
let canvas = { Cairo.x=50.; y=50.; w=500.; h=300. } in
let cr = Cairo.create (Cairo.PDF.create "cloud.pdf" ~w:600. ~h:400.) in
Random.self_init();
Cairo.select_font_face cr font;
let size0 = 80. in
let size fq word =
let te = text_extents cr word in
size0 /. sqrt te.width /. (1.4 -. fq) in
let color _fq _ = Palette.random Palette.rainbow in
(* Show canvas *)
save cr;
let ux, uy = Cairo.device_to_user_distance cr 1. 1. in
set_line_width cr (max ux uy);
set_dash cr [| 5. |];
rectangle cr canvas.x canvas.y ~w:canvas.w ~h:canvas.h; stroke cr;
restore cr;
Cloud.make cr canvas words ~size ~color ~rotate:0.1;
Cairo.Surface.finish (get_target cr)
with Cairo.Error st as e ->
printf "Fatal error: %s\n" (Cairo.status_to_string st);
raise e
ocaml-cairo/examples/word_cloud/cloud.mli 0000644 0001750 0001750 00000002156 13446257732 020747 0 ustar treinen treinen
open Cairo
type rgba = float * float * float * float
exception Failure
val make : context -> rectangle -> ?rotate:float -> ?padding:float ->
?word_box:(float -> rgba -> rectangle -> string -> unit) ->
size:('a -> string -> float) -> ?min_size:float ->
color:('a -> string -> rgba) ->
('a * string) list -> unit
(** [make cr canvas size color words] make a cloud of the [words] in
the rectangle [canvas] on the surface hold by [cr]. [size] and
[color] must resp. return the text size and color for a given
word.
[word_box sz rgba r word] is executed once for each [word] where
[sz] is the font size, [rgba] is the color of the word, and [r]
is the rectangle reserved for that word. This allows, for
example, to generate an image map for the cloud. *)
module Palette :
sig
type t = (float * float * float * float) array
val random : t -> float * float * float * float
val mauve : t
val metal_blue : t
val blue_green : t
val brown : t
val rainbow : t
val winter : t
val heat : t
val blue_yellow : t
val clay : t
val gray : t
val light_gray : t
end
ocaml-cairo/examples/word_cloud/cloud.ml 0000644 0001750 0001750 00000015010 13446257732 020567 0 ustar treinen treinen (* File: cloud.ml
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
open Cairo
type rgba = float * float * float * float
let neg_half_pi = -2. *. atan 1.
(* Whether two rectangles intersect. *)
let intersect r1 r2 =
r1.x <= r2.x +. r2.w && r1.y <= r2.y +. r2.h
&& r2.x <= r1.x +. r1.w && r2.y <= r1.y +. r1.h
(* Whther [r] intersect the region defined as the union of rectangles
in the list. (This is pretty naive, ordering rectangles should
allow to compite this much faster.) *)
let rec intersect_region r region = match region with
| [] -> false
| r' :: tl -> intersect r r' || intersect_region r tl
let outside r canvas =
r.x < canvas.x || r.y < canvas.y
|| r.x +. r.w > canvas.x +. canvas.w || r.y +. r.h > canvas.y +. canvas.h
(* Return a random number between [-0.5 *. x] and [0.5 *. x]. *)
let rand x = Random.float x -. 0.5 *. x
[@@@warning "-37"]
type position =
| C (* center around both x and y *)
| R (* right of (x,y) *)
| L
| U
| D
| RU
| RD
| LU
| LD
module Text =
struct
let size cr ?(vert=false) text =
let te = text_extents cr text in
if vert then te.height, te.width else te.width, te.height
(* Return the box that the text will occupy if it is put at the
position [pos]. *)
let box cr ?vert ?(padding=0.02) pos x y text =
let width, height = size cr ?vert text in
let x0 = match pos with
| C | U | D -> x -. 0.5 *. width
| R | RU | RD -> x
| L | LU | LD -> x -. width
and y0 = match pos with
| C | R | L -> y -. 0.5 *. height
| U | RU | LU -> y -. height
| D | RD | LD -> y in
let padding' = 1. +. 2. *. padding in
{ Cairo.x = x0 -. padding *. width; y = y0 -. padding *. height;
w = padding' *. width; h = padding' *. height }
;;
(* Display the [text] at position [pos] (vertically if [vert] is true). *)
let show cr ?(vert=false) pos x y text =
let te = text_extents cr text in
let r = box cr ~vert ~padding:0. pos x y text in
if vert then (
translate cr (r.x -. te.y_bearing) (r.y +. r.h +. te.x_bearing);
rotate cr neg_half_pi;
)
else
move_to cr (r.x -. te.x_bearing) (r.y -. te.y_bearing);
show_text cr text;
stroke cr
end
(* ---------------------------------------------------------------------- *)
(* Inspired by ideas of Jim Lund, jiml at uky dot edu,
http://elegans.uky.edu/blog/?p=103 *)
exception Failure
let make cr canvas ?rotate:(rotp=0.) ?padding ?(word_box=fun _ _ _ _ -> ())
~size ?(min_size=11.) ~color words =
let region = ref [] in
(* center of canvas *)
let cx = canvas.x +. 0.5 *. canvas.w
and cy = canvas.y +. 0.5 *. canvas.h in
let rec position target sz fq word =
let vert = Random.float 1. < rotp in
let width, height = Text.size cr ~vert word in
let x = cx +. rand((canvas.w -. width) /. target)
and y = cy +. rand((canvas.h -. height) /. target) in
let rect = Text.box cr ~vert ?padding C x y word in
if intersect_region rect !region || outside rect canvas then (
let target = 0.9995 *. target in
if target < 1. then (
let sz = 0.9 *. sz in
if sz < min_size then raise Failure;
set_font_size cr sz;
position 2. sz fq word
)
else position target sz fq word
)
else (
region := rect :: !region;
set_source_rgba cr 0. 0. 0. 0.2;
(* rectangle cr r.x r.y r.w r.h; stroke cr; *)
let r, g, b, a = color fq word in set_source_rgba cr r g b a;
Text.show cr ~vert C x y word;
word_box sz (r,g,b,a) rect word;
)
in
List.iter begin fun (fq, word) ->
save cr;
let sz = size fq word in
set_font_size cr sz;
position 2. sz fq word;
restore cr
end words
;;
(* ---------------------------------------------------------------------- *)
(* References to check:
http://www.cs.cmu.edu/~sleator/papers/2d-bin-packing.htm
http://www.mat.ucsb.edu/projects/TagRiver/browser/src/algorithms2/PackingAlgorithm3.java
Another implementation using bin packing
http://ninajansen.dk/2009/04/23/introducing-cloud-an-open-source-ruby-wordcloud-generator/
(source git://github.com/ninajansen/cloud.git ); however the result
did not look good enough for me so I did not implement it
.
See also http://www.bewitched.com/research.html for interesting
visualization algorithms.
*)
module Palette =
struct
type t = (float * float * float * float) array
let random p = p.(Random.int (Array.length p))
let color (r, g, b) =
(float r /. 255., float g /. 255., float b /. 255., 1.)
let mauve = Array.map color [|
(190, 73, 232); (207, 119, 238); (223, 165, 244); (162, 62, 197);
(143, 55, 174); (95, 37, 116); (48, 18, 58); (19, 7, 23) |]
let metal_blue = Array.map color [|
(51, 68, 51); (51, 102, 170); (102, 153, 170); (170, 187, 187);
(119, 136, 119) |]
let blue_green = Array.map color [|
(0, 17, 0); (0, 102, 221); (10, 204, 221); (119, 170, 119) |]
let brown = Array.map color [|
(167, 70, 97); (189, 117, 137); (212, 163, 177);
(233, 209, 215); (142, 60, 82); (125, 53, 73);
(84, 35, 49); (42, 18, 24); (17, 7, 10) |]
let rainbow = Array.map color [|
(176, 43, 44); (209, 86, 0); (199, 152, 16); (115, 136, 10);
(107, 186, 112); (63, 76, 107); (53, 106, 160); (208, 31, 60) |]
let winter = Array.map color [|
(0,0,0); (52, 83, 121); (64, 114, 176); (69, 134, 210);
(155, 189, 246); (160, 189, 235) |]
let heat = Array.map color [|
(21, 0, 0); (119, 0, 0); (255, 0, 0); (203, 0, 0); (255, 66, 0) |]
let blue_yellow = Array.map color [|
(34, 68, 102); (102, 119, 136); (204, 170, 102); (136, 153, 170);
(255, 238, 187) |]
let clay = Array.map color [|
(0,0,0); (113, 76, 63); (177, 88, 79); (212, 192, 196);
(248, 214, 229); (188, 133, 136) |]
let gray =
let g x = (x, x, x, 1.) in [| g 0.2; g 0.4; g 0.6; g 0.8 |]
let light_gray =
let g x = (x, x, x, 1.) in [| g 0.5; g 0.6; g 0.7; g 0.8 |]
end
ocaml-cairo/examples/set_line_join.ml 0000644 0001750 0001750 00000001016 13446257732 020142 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let () =
let cr = Cairo.create(Cairo.PDF.create "set_line_join.pdf" ~w:400. ~h:300.) in
set_line_width cr 40.96;
let corner join =
rel_line_to cr 51.2 (-51.2);
rel_line_to cr 51.2 51.2;
set_line_join cr join;
stroke cr in
move_to cr 76.8 84.48;
corner JOIN_MITER; (* default *)
move_to cr 76.8 161.28;
corner JOIN_BEVEL;
move_to cr 76.8 238.08;
corner JOIN_ROUND;
Surface.finish(get_target cr)
ocaml-cairo/examples/clip.ml 0000644 0001750 0001750 00000001213 13446257732 016247 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
let pi = 4. *. atan 1.
let () =
let surface = Cairo.PDF.create "clip.pdf" ~w:300. ~h:300. in
let cr = Cairo.create surface in
Cairo.arc cr 128. 128. ~r:76.8 ~a1:0. ~a2:(2. *. pi);
Cairo.clip cr;
Cairo.Path.clear cr; (* current path is not consumed by Cairo.clip *)
Cairo.rectangle cr 0. 0. ~w:256. ~h:256.;
Cairo.fill cr;
Cairo.set_source_rgb cr 0. 1. 0.;
Cairo.move_to cr 0. 0.;
Cairo.line_to cr 256. 256.;
Cairo.move_to cr 256. 0.;
Cairo.line_to cr 0. 256.;
Cairo.set_line_width cr 10.;
Cairo.stroke cr;
Cairo.Surface.finish surface
ocaml-cairo/examples/text_align_center.ml 0000644 0001750 0001750 00000002075 13446257732 021025 0 ustar treinen treinen (* -*- coding:utf-8 -*- *)
(* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr =
Cairo.create(Cairo.PDF.create "text_align_center.pdf" ~w:400. ~h:300.) in
(* Take the cont from the command line if given: *)
let font = try Sys.argv.(1) with _ -> "Sans" in
let utf8 = "cairo" in
select_font_face cr font;
set_font_size cr 52.;
let x0 = 128. and y0 = 128. in
let e = text_extents cr utf8 in
let x = x0 -. (e.width /. 2. +. e.x_bearing) in
let y = y0 -. (e.height /. 2. +. e.y_bearing) in
move_to cr x y; show_text cr utf8;
(* Funny UTF8 symbols *)
move_to cr 0. (2. *. y0);
show_text cr "€ ∑ ¬ ∫ ≤ ≥ ∞";
(* draw helping lines *)
set_source_rgba cr 1. 0.2 0.2 0.6;
set_line_width cr 6.0;
arc cr x y ~r:10.0 ~a1:0. ~a2:two_pi;
fill cr;
arc cr 0. (2. *. y0) ~r:10.0 ~a1:0. ~a2:two_pi;
fill cr;
move_to cr x0 0.; line_to cr x0 (2. *. y0);
move_to cr 0. y0; line_to cr (2. *. x0) y0;
stroke cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/set_line_cap.ml 0000644 0001750 0001750 00000001225 13446257732 017750 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "set_line_cap.pdf" ~w:400. ~h:300.) in
let line x =
set_source_rgb cr 0. 0. 0.;
set_line_width cr 30.0;
move_to cr x 50.0; line_to cr x 200.0;
stroke cr;
(* draw helping lines *)
set_source_rgb cr 1. 0.2 0.2;
set_line_width cr 2.56;
move_to cr x 50.0; line_to cr x 200.0;
stroke cr in
set_line_cap cr BUTT; (* default *)
line 64.0;
set_line_cap cr ROUND;
line 128.0;
set_line_cap cr SQUARE;
line 192.0;
Surface.finish(get_target cr)
ocaml-cairo/examples/mask.ml 0000644 0001750 0001750 00000001556 13446257732 016265 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
let linpat = Cairo.Pattern.create_linear ~x0:0. ~y0:0. ~x1:1. ~y1:1. in
Cairo.Pattern.add_color_stop_rgb linpat 0. 0.3 0.8;
Cairo.Pattern.add_color_stop_rgb linpat ~ofs:1. 0. 0.8 0.3;
let radpat = Cairo.Pattern.create_radial ~x0:0.5 ~y0:0.5 ~r0:0.25
~x1:0.5 ~y1:0.5 ~r1:0.75 in
Cairo.Pattern.add_color_stop_rgba radpat 0. 0. 0. 1.;
Cairo.Pattern.add_color_stop_rgba radpat ~ofs:0.5 0. 0. 0. 0.;
Cairo.set_source cr linpat;
Cairo.mask cr radpat;
(* Write output *)
Cairo.PNG.write surface "mask.png"
ocaml-cairo/examples/draw.ml 0000644 0001750 0001750 00000016776 13446257732 016301 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let pi_4 = atan 1.
let two_pi = 8. *. pi_4
let draw_path_moveto cr =
Cairo.set_line_width cr 0.1;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.move_to cr 0.25 0.25
let draw_path_lineto cr =
draw_path_moveto cr;
Cairo.line_to cr 0.5 0.375;
Cairo.rel_line_to cr 0.25 (-0.125)
let draw_path_arcto cr =
draw_path_lineto cr;
Cairo.arc cr 0.5 0.5 ~r:(0.25 *. sqrt 2.) ~a1:(-. pi_4) ~a2:pi_4
let draw_path_curveto cr =
draw_path_arcto cr;
Cairo.rel_curve_to cr (-0.25) (-0.125) (-0.25) 0.125 (-0.5) 0.
let draw_path_close cr =
draw_path_curveto cr;
Cairo.Path.close cr
let draw_textextents cr =
let text = "joy" in
Cairo.set_font_size cr 0.5;
(* Drawing code goes here *)
Cairo.set_source_rgb cr 0.0 0.0 0.0;
Cairo.select_font_face cr "Georgia" ~weight:Cairo.Bold;
let ux, uy = Cairo.device_to_user_distance cr 1. 1. in
let px = max ux uy in
let fe = Cairo.font_extents cr in
let te = Cairo.text_extents cr text in
let x = 0.5 -. te.Cairo.x_bearing -. te.Cairo.width /. 2.
and y = 0.5 -. fe.Cairo.descent +. fe.Cairo.baseline /. 2. in
(* baseline, descent, ascent, height *)
Cairo.set_line_width cr (4. *. px);
Cairo.set_dash cr [| 9. *. px |];
Cairo.set_source_rgba cr 0. 0.6 0. 0.5;
let horizontal_line y =
Cairo.move_to cr (x +. te.Cairo.x_bearing) y;
Cairo.rel_line_to cr te.Cairo.width 0. in
horizontal_line y;
horizontal_line (y +. fe.Cairo.descent);
horizontal_line (y -. fe.Cairo.ascent);
horizontal_line (y -. fe.Cairo.baseline);
Cairo.stroke cr;
(* extents: width & height (in dashed blue) *)
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
Cairo.set_line_width cr px;
Cairo.set_dash cr [| 3. *. px |];
Cairo.rectangle cr (x +. te.Cairo.x_bearing)
(y +. te.Cairo.y_bearing) ~w:te.Cairo.width ~h:te.Cairo.height;
Cairo.stroke cr;
(* text *)
Cairo.move_to cr x y;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.show_text cr text;
(* bearing (solid blue line) *)
Cairo.set_dash cr [| |];
Cairo.set_line_width cr (2. *. px);
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
Cairo.move_to cr x y;
Cairo.rel_line_to cr te.Cairo.x_bearing te.Cairo.y_bearing;
Cairo.stroke cr;
(* text's advance (blue dot) *)
Cairo.set_source_rgba cr 0. 0. 0.75 0.5;
Cairo.arc cr (x +. te.Cairo.x_advance) (y +. te.Cairo.y_advance)
~r:(6. *. px) ~a1:0. ~a2:two_pi;
Cairo.fill cr;
(* reference point (x,y) (red dot) *)
Cairo.arc cr x y ~r:(6. *. px) ~a1:0. ~a2:two_pi;
Cairo.set_source_rgba cr 0.75 0. 0. 0.5;
Cairo.fill cr
;;
let draw_setsourcegradient cr =
let radpat = Cairo.Pattern.create_radial ~x0:0.25 ~y0:0.25 ~r0:0.1
~x1:0.5 ~y1:0.5 ~r1:0.5 in
Cairo.Pattern.add_color_stop_rgb radpat 1.0 0.8 0.8;
Cairo.Pattern.add_color_stop_rgb radpat ~ofs:1. 0.9 0.0 0.0;
for i = 1 to 9 do
for j = 1 to 9 do
Cairo.rectangle cr (float i /. 10.0 -. 0.04) (float j /. 10.0 -. 0.04)
~w:0.08 ~h:0.08;
done;
done;
Cairo.set_source cr radpat;
Cairo.fill cr;
let linpat = Cairo.Pattern.create_linear ~x0:0.25 ~y0:0.35
~x1:0.75 ~y1:0.65 in
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.00 1. 1. 1. 0.;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.25 0. 1. 0. 0.5;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.50 1. 1. 1. 0.;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:0.75 0. 0. 1. 0.5;
Cairo.Pattern.add_color_stop_rgba linpat ~ofs:1.00 1. 1. 1. 0.;
Cairo.rectangle cr 0.0 0.0 ~w:1. ~h:1.;
Cairo.set_source cr linpat;
Cairo.fill cr
;;
let get_point = function
| Cairo.MOVE_TO(x,y) -> x,y
| Cairo.LINE_TO(x,y) -> x,y
| Cairo.CURVE_TO(x,y, _,_, _,_) -> x,y
| Cairo.CLOSE_PATH -> failwith "get_point"
let path_diagram cr =
let path = Cairo.Path.to_array(Cairo.Path.copy_flat cr) in
let px, py = Cairo.device_to_user_distance cr 3. 3. in
Cairo.set_line_width cr (max px py);
Cairo.set_source_rgb cr 0. 0.6 0.;
Cairo.stroke cr;
(* Draw markers at the first and the last point of the path, but
only if the path is not closed.
If the last path manipulation was a Cairo.Path.close, then we
can detect this at the end of the path array. The [CLOSE_PATH]
element will be followed by a [MOVE_TO] element (since cairo
1.2.4), so we need to check position [Array.length path - 2].
See the module [Path] for further explanations. *)
let len = Array.length path in
if len <= 1 || path.(len - 2) <> Cairo.CLOSE_PATH then (
(* Get the first point in the path *)
let x, y = get_point path.(0) in
let px, py = Cairo.device_to_user_distance cr 5. 5. in
let px = max px py in
Cairo.arc cr x y ~r:px ~a1:0. ~a2:two_pi;
Cairo.set_source_rgba cr 0.0 0.6 0.0 0.5;
Cairo.fill cr;
let x, y = get_point path.(len - 1) in
Cairo.arc cr x y ~r:px ~a1:0. ~a2:two_pi;
Cairo.set_source_rgba cr 0.0 0.0 0.75 0.5;
Cairo.fill cr;
)
;;
let draw_path_curveto_hints cr =
Cairo.save cr;
let px, py = Cairo.device_to_user_distance cr 3. 3. in
let px = max px py in
Cairo.set_source_rgba cr 0.5 0. 0. 0.5;
Cairo.Path.sub cr;
Cairo.arc cr 0.5 0.625 ~r:px ~a1:0. ~a2:two_pi;
Cairo.fill cr;
Cairo.arc cr 0.5 0.875 ~r:px ~a1:0. ~a2:two_pi;
Cairo.fill cr;
let px, py = Cairo.device_to_user_distance cr 2. 2. in
let px = max px py in
Cairo.set_line_width cr px;
Cairo.set_source_rgba cr 0.5 0. 0. 0.25;
Cairo.move_to cr 0.25 0.75;
Cairo.rel_line_to cr 0.25 0.125;
Cairo.stroke cr;
Cairo.move_to cr 0.75 0.75;
Cairo.rel_line_to cr (-0.25) (-0.125);
Cairo.stroke cr;
Cairo.restore cr
;;
let draw_setsourcergba cr =
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.move_to cr 0. 0.;
Cairo.line_to cr 1. 1.;
Cairo.move_to cr 1. 0.;
Cairo.line_to cr 0. 1.;
Cairo.set_line_width cr 0.2;
Cairo.stroke cr;
Cairo.rectangle cr 0. 0. ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 1. 0. 0. 0.80;
Cairo.fill cr;
Cairo.rectangle cr 0. 0.5 ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 0. 1. 0. 0.60;
Cairo.fill cr;
Cairo.rectangle cr 0.5 0. ~w:0.5 ~h:0.5;
Cairo.set_source_rgba cr 0. 0. 1. 0.40;
Cairo.fill cr
;;
let draw_diagram name cr =
(match name with
| "setsourcergba" -> draw_setsourcergba cr
| "setsourcegradient" -> draw_setsourcegradient cr
| "path-moveto" -> draw_path_moveto cr
| "path-lineto" -> draw_path_lineto cr
| "path-arcto" -> draw_path_arcto cr
| "path-curveto" ->
draw_path_curveto_hints cr;
draw_path_curveto cr
| "path-close" -> draw_path_close cr
| "textextents" -> draw_textextents cr
| _ -> assert false
);
if String.sub name 0 5 = "path-" then path_diagram cr
let diagram name =
let width = 120. and height = 120. in
let svg_filename = name ^ ".svg"
and png_filename = name ^ ".png" in
let surf = Cairo.SVG.create svg_filename ~w:width ~h:height in
let cr = Cairo.create surf in
Cairo.scale cr width height;
Cairo.set_line_width cr 0.01;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.set_source_rgb cr 1. 1. 1.;
Cairo.fill cr;
draw_diagram name cr;
let ux, uy = Cairo.device_to_user_distance cr 2. 2. in
Cairo.set_line_width cr (max ux uy);
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0. 0. ~w:1. ~h:1.;
Cairo.stroke cr;
(* write output *)
Cairo.PNG.write surf png_filename;
Cairo.Surface.finish surf
let () =
diagram "setsourcergba";
diagram "setsourcegradient";
diagram "path-moveto";
diagram "path-lineto";
diagram "path-arcto";
diagram "path-curveto";
diagram "path-close";
diagram "textextents"
ocaml-cairo/examples/path_close.ml 0000644 0001750 0001750 00000001353 13446257732 017446 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_line_width cr 0.05;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.move_to cr 0.25 0.25;
Cairo.line_to cr 0.5 0.375;
Cairo.rel_line_to cr 0.25 (-0.125);
let pi_4 = atan 1. in
Cairo.arc cr 0.5 0.5 ~r:(0.25 *. sqrt 2.) ~a1:(-. pi_4) ~a2:pi_4;
Cairo.rel_curve_to cr (-0.25) (-0.125) (-0.25) 0.125 (-0.5) 0.;
Cairo.Path.close cr;
Cairo.stroke cr;
(* Write output *)
Cairo.PNG.write surface "path_close.png"
ocaml-cairo/examples/gradient.ml 0000644 0001750 0001750 00000001417 13446257732 017123 0 ustar treinen treinen (* Example by Øyvind Kolås taken from http://cairographics.org/samples/ *)
open Cairo
let two_pi = 8. *. atan 1.
let () =
let cr = Cairo.create(Cairo.PDF.create "gradient.pdf" ~w:400. ~h:300.) in
let pat = Pattern.create_linear ~x0:0.0 ~y0:0.0 ~x1:0.0 ~y1:256.0 in
Pattern.add_color_stop_rgba pat ~ofs:1. 0. 0. 0. 1.;
Pattern.add_color_stop_rgba pat ~ofs:0. 1. 1. 1. 1.;
rectangle cr 0. 0. ~w:256. ~h:256.;
set_source cr pat;
fill cr;
let pat = Pattern.create_radial ~x0:115.2 ~y0:102.4 ~r0:25.6
~x1:102.4 ~y1:102.4 ~r1:128.0 in
Pattern.add_color_stop_rgba pat 1. 1. 1. 1.;
Pattern.add_color_stop_rgba pat ~ofs:1. 0. 0. 0. 1.;
set_source cr pat;
arc cr 128.0 128.0 ~r:76.8 ~a1:0. ~a2:two_pi;
fill cr;
Surface.finish(get_target cr)
ocaml-cairo/examples/stroke.ml 0000644 0001750 0001750 00000000772 13446257732 016640 0 ustar treinen treinen (* This file is part of the tutorial
http://cairo.forge.ocamlcore.org/tutorial/
*)
let () =
let surface = Cairo.Image.create Cairo.Image.ARGB32 ~w:120 ~h:120 in
let cr = Cairo.create surface in
(* Examples are in 1.0 x 1.0 coordinate space *)
Cairo.scale cr 120. 120.;
(* Drawing code goes here *)
Cairo.set_line_width cr 0.1;
Cairo.set_source_rgb cr 0. 0. 0.;
Cairo.rectangle cr 0.25 0.25 ~w:0.5 ~h:0.5;
Cairo.stroke cr;
(* Write output *)
Cairo.PNG.write surface "stroke.png"
ocaml-cairo/appveyor.yml 0000644 0001750 0001750 00000001421 13446257732 015541 0 ustar treinen treinen platform:
- x64
environment:
global:
PACKAGE: cairo2
# DEPOPTS: "*"
CYG_ROOT: "C:\\cygwin"
CYG_BASH: "%CYG_ROOT%\\bin\\bash -lc"
FORK_USER: ocaml
PRE_INSTALL_HOOK: opam depext -i lablgtk && opam install lablgtk
init:
- 'echo System architecture: %PLATFORM%'
install:
- appveyor DownloadFile https://raw.githubusercontent.com/%FORK_USER%/ocaml-ci-scripts/master/appveyor-opam.sh
- "%CYG_ROOT%\\setup-x86.exe -qnNdO -R %CYG_ROOT% -s http://cygwin.mirror.constant.com -l C:/cygwin/var/cache/setup -P rsync -P patch -P make -P unzip -P git -P perl -P mingw64-x86_64-gcc-core"
- curl -L -o C:/cygwin/bin/jq https://github.com/stedolan/jq/releases/download/jq-1.5/jq-win32.exe
build_script:
- "%CYG_BASH% '${APPVEYOR_BUILD_FOLDER}/appveyor-opam.sh'"
ocaml-cairo/dune-project 0000644 0001750 0001750 00000000037 13446257732 015475 0 ustar treinen treinen (lang dune 1.1)
(name cairo2)
ocaml-cairo/gtk/ 0000755 0001750 0001750 00000000000 13446257732 013740 5 ustar treinen treinen ocaml-cairo/gtk/cairo_gtk_stubs.c 0000644 0001750 0001750 00000005342 13446257732 017272 0 ustar treinen treinen /* File: cairo_gtk_stubs.c
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation. See the file
LICENCE for more details.
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 file
LICENSE for more details. */
#include
#include
#include
#include
#include
#include
#include
/* OCaml labgtk stubs */
#include
#include
#include
#include
/* OCaml Cairo bindings */
#include "cairo_ocaml.h"
#if ! GTK_CHECK_VERSION(2,8,0)
#error "Gtk+ version >= 2.8 is required"
#else /* not GTK_CHECK_VERSION(2,8,0) */
#define DO1_CONTEXT(name, of_value) \
CAMLexport value caml_##name(value vcr, value v) \
{ \
CAMLparam2(vcr, v); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_value(v)); \
caml_cairo_raise_Error(cairo_status(cr)); \
CAMLreturn(Val_unit); \
}
#define DO3_CONTEXT(name, of_val1, of_val2, of_val3) \
CAMLexport value caml_##name(value vcr, value v1, value v2, value v3) \
{ \
CAMLparam4(vcr, v1, v2, v3); \
cairo_t* cr = CAIRO_VAL(vcr); \
name(cr, of_val1(v1), of_val2(v2), of_val3(v3)); \
caml_cairo_raise_Error(cairo_status(cr)); \
CAMLreturn(Val_unit); \
}
CAMLexport value caml_gdk_cairo_create(value vdrawable)
{
CAMLparam1(vdrawable);
CAMLlocal1(vcontext);
cairo_t *cr = gdk_cairo_create(GdkDrawable_val(vdrawable));
caml_cairo_raise_Error(cairo_status(cr)); /* caml_check_status not exported */
vcontext = alloc_custom(&caml_cairo_ops, sizeof(void*), 1, 50);
CAIRO_VAL(vcontext) = cr;
CAMLreturn(vcontext);
}
DO1_CONTEXT(gdk_cairo_set_source_color, GdkColor_val)
DO1_CONTEXT(gdk_cairo_rectangle, GdkRectangle_val)
DO1_CONTEXT(gdk_cairo_region, GdkRegion_val)
DO3_CONTEXT(gdk_cairo_set_source_pixbuf, GdkPixbuf_val, Double_val, Double_val)
#endif /* GTK_CHECK_VERSION(2,8,0) */
ocaml-cairo/gtk/cairo_gtk.mli 0000644 0001750 0001750 00000003631 13446257732 016410 0 ustar treinen treinen (* File: cairo_gtk.mli
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
(** Integration of Cairo with labgtk2.
It allows to create Cairo contexts which can be used to draw on
GDK drawables. Additional functions allow to convert GDK's
rectangles and regions into Cairo paths and to use pixbufs as
sources for drawing operations. *)
val create : [> `drawable] Gobject.obj -> Cairo.context
(** [create drawable] creates a Cairo context for drawing to
[drawable].
NOTE: due to double-buffering, Cairo contexts created in a GTK+
expose event handler cannot be cached and reused between different
expose events. *)
val set_source_color : Cairo.context -> Gdk.color -> unit
(** [set_source_color cr color] sets the specified [color] as the
source color of cr. *)
val rectangle : Cairo.context -> Gdk.Rectangle.t -> unit
(** [rectangle cr r] adds the rectangle [r] to the current path of [cr]. *)
val region : Cairo.context -> Gdk.region -> unit
(** [region cr r] adds the region [r] to the current path of [cr]. *)
val set_source_pixbuf : Cairo.context ->
GdkPixbuf.pixbuf -> x:float -> y:float -> unit
(** Sets the given pixbuf as the source pattern for the Cairo context.
The pattern has an extend mode of {!Cairo.Pattern.extend} set to
[NONE] and is aligned so that the origin of pixbuf is ([x],[y]). *)
ocaml-cairo/gtk/dune 0000644 0001750 0001750 00000000600 13446257732 014612 0 ustar treinen treinen
(library
(name cairo_gtk)
(public_name cairo2-gtk)
(c_names cairo_gtk_stubs)
(c_flags :standard (:include c_flags.sexp))
(c_library_flags :standard (:include c_library_flags.sexp))
(libraries threads lablgtk2 cairo2)
(synopsis "Rendering Cairo on Gtk canvas"))
(rule
(targets c_flags.sexp c_library_flags.sexp)
(action (run ../config/discover.exe --gtk)))
ocaml-cairo/gtk/cairo_gtk.ml 0000644 0001750 0001750 00000002331 13446257732 016233 0 ustar treinen treinen (* File: cairo_gtk.ml
Copyright (C) 2009
Christophe Troestler
WWW: http://math.umh.ac.be/an/software/
This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License version 3 or
later as published by the Free Software Foundation, with the special
exception on linking described in the file LICENSE.
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 file
LICENSE for more details. *)
(* http://library.gnome.org/devel/gdk/unstable/gdk-Cairo-Interaction.html *)
external create : [> `drawable] Gobject.obj -> Cairo.context
= "caml_gdk_cairo_create"
external set_source_color : Cairo.context -> Gdk.color -> unit
= "caml_gdk_cairo_set_source_color"
external rectangle : Cairo.context -> Gdk.Rectangle.t -> unit
= "caml_gdk_cairo_rectangle"
external region : Cairo.context -> Gdk.region -> unit
= "caml_gdk_cairo_region"
external set_source_pixbuf : Cairo.context -> GdkPixbuf.pixbuf ->
x:float -> y:float -> unit = "caml_gdk_cairo_set_source_pixbuf"
ocaml-cairo/CHANGES.md 0000644 0001750 0001750 00000001760 13446257732 014551 0 ustar treinen treinen 0.6.1 2019-03-20
----------------
- Fix `create_for_data32` handling of dimensions.
- Documentation improvements.
- Fix dependencies for `cairo2-gtk` and `cairo2-pango`.
0.6 2018-09-05
--------------
- New `Ft` module to support FreeType fonts. This is enabled if the
package `conf-freetype` is installed. On the C side, the exported
header file `cairo_ocaml.h` defines the macro `OCAML_CAIRO_HAS_FT`
when the Cairo bindings were compiled with TrueType support.
- New package `Cairo2-pango` providing the module `Cairo_pango`.
- Remove labels that were not bringing a clear benefit. With Dune
default behavior, users will feel compelled to write labels which
was cluttering the code with the previous interface. With Merlin,
it is now possible to have the documentation of a function under the
cursor displayed with a simple keystroke which should alleviate
having slightly less documentation in the types.
- Improve the documentation.
- Use Dune (not the former Jbuilder) to compile.
ocaml-cairo/cairo2-pango.opam 0000644 0001750 0001750 00000001651 13446257732 016315 0 ustar treinen treinen opam-version: "2.0"
maintainer: "Christophe Troestler "
authors: [ "Christophe Troestler "
"Pierre Hauweele " ]
license: "LGPL-3.0 with OCaml linking exception"
homepage: "https://github.com/Chris00/ocaml-cairo"
dev-repo: "git+https://github.com/Chris00/ocaml-cairo.git"
bug-reports: "https://github.com/Chris00/ocaml-cairo/issues"
doc: "https://Chris00.github.io/ocaml-cairo/doc"
tags: ["Cairo" "stroke" "drawing" "tutorial"]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "build" "@doc"] {with-doc}
]
depends: [
"ocaml" {>= "4.02"}
"base-bigarray"
"dune" {build}
"conf-pkg-config" {build}
"conf-cairo"
"cairo2" {= version}
"lablgtk"
]
synopsis: "Interface between Cairo and Pango (for Gtk2)"
description: """
This package provides a way to use Pango (lablgtk, Gtk2) with Cairo.
"""
ocaml-cairo/GPL3.md 0000644 0001750 0001750 00000104446 13446257732 014213 0 ustar treinen treinen GNU GENERAL PUBLIC LICENSE, Version 3, 29 June 2007
===================================================
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
## Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
## TERMS AND CONDITIONS
### 0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
### 1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
### 2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
### 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
### 4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
### 5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
1. The work must carry prominent notices stating that you modified
it, and giving a relevant date.
2. The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
3. You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
4. If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
### 6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
1. Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
2. Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
3. Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
4. Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
5. Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
### 7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
1. Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
2. Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
3. Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
4. Limiting the use for publicity purposes of names of licensors or
authors of the material; or
5. Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
6. Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
### 8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
### 9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
### 10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
### 11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
### 12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
### 13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
### 14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
### 15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
### 16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
### 17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
=============================================
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
.
ocaml-cairo/cairo2.opam 0000644 0001750 0001750 00000002602 13446257732 015210 0 ustar treinen treinen opam-version: "2.0"
maintainer: "Christophe Troestler "
authors: [ "Christophe Troestler "
"Pierre Hauweele " ]
license: "LGPL-3.0 with OCaml linking exception"
homepage: "https://github.com/Chris00/ocaml-cairo"
dev-repo: "git+https://github.com/Chris00/ocaml-cairo.git"
bug-reports: "https://github.com/Chris00/ocaml-cairo/issues"
doc: "https://Chris00.github.io/ocaml-cairo/doc"
tags: ["Cairo" "stroke" "drawing" "tutorial"]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
["dune" "build" "@doc"] {with-doc}
]
depends: [
"ocaml" {>= "4.02"}
"base-bigarray"
"dune" {build}
"conf-cairo"
]
depopts: [
"conf-freetype"
]
conflicts: [
"cairo" {= "0.4.1"}
"cairo" {= "0.4.2"}
]
post-messages: [
"Try to re-run the install command with PKG_CONFIG_PATH pointing a pkg-config path including libffi, e.g. if you use homebrew you can try PKG_CONFIG_PATH=/usr/local/opt/libffi/lib/pkgconfig" {failure & os = "macos"}
]
synopsis: "Binding to Cairo, a 2D Vector Graphics Library"
description: """
This is a binding to Cairo, a 2D graphics library with support for
multiple output devices. Currently supported output targets include
the X Window System, Quartz, Win32, image buffers, PostScript, PDF,
and SVG file output."""
ocaml-cairo/Makefile 0000644 0001750 0001750 00000001203 13446257732 014607 0 ustar treinen treinen # Makefile for developers (users use dune exclusively).
PKGVERSION = $(shell git describe --always)
PACKAGES = $(basename $(wildcard *.opam))
build:
dune build @install @examples @tutorial
test:
dune build @runtest @tests-gtk --force
install uninstall:
dune $@
doc: build
dune build @doc
sed -e 's/%%VERSION%%/$(PKGVERSION)/' --in-place \
_build/default/_doc/_html/cairo2/Cairo/index.html
tutorial-submit: build doc
$(MAKE) -C docs $@
lint:
for p in $(PACKAGES); do opam lint $$p.opam; done
clean:
dune clean
$(RM) $(wildcard *~ *.pdf *.ps *.png *.svg)
.PHONY: build install uninstall doc submit tutorial-submit lint clean