[m-rev.] diff: add cairo binding to extras distribution
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon Sep 6 00:30:37 AEST 2010
Add a Mercury binding to the cairo 2D graphics library to the extras
distribution. (For further information see, <http://www.cairographics.org/>.)
The binding is currently fairly complete (enough for the cairo sample and
tutorial programs to be work in Mercury). The main things missing are:
* scaled fonts
* a few operations on patterns (grep for NYI)
* support for X, Quartz, or Win32 surfaces
* font backends other than the builtin toy one
TODO: I'll add README files, Makefiles, update the NEWS file, etc
in a separate change.
extras/graphics/mercury_cairo/*.m:
extras/graphics/mercury_cairo/tutorial/*.m:
extras/graphics/mercury_cairo/samples/*.m:
extras/graphics/mercury_cairo/samples/data/*.png:
Add the Mercury cairo binding.
Julien.
Index: graphics/mercury_cairo/cairo.font_options.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.font_options.m
diff -N graphics/mercury_cairo/cairo.font_options.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.font_options.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,224 @@
+%----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%----------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains predicates for dealing with font_options
+% objects, which are how cairo controls how fonts are rendered.
+%
+%----------------------------------------------------------------------------%
+
+:- module cairo.font_options.
+:- interface.
+
+%----------------------------------------------------------------------------%
+
+ % font_options.create(FontOpts, !IO):
+ %
+:- pred create(font_options::out, io::di, io::uo) is det.
+
+ % font_options.copy(Original, Copy, !IO):
+ %
+:- pred copy(font_options::in, font_options::out, io::di, io::uo) is det.
+
+ % set_antialias(FontOptions, AntiAlias, !IO):
+ %
+:- pred set_antialias(font_options::in, antialias::in, io::di, io::uo) is det.
+
+ % font_options.get_antialias(FontOptions, AntiAlias, !IO):
+ % AntiAlias is the antialiasing mode for FontOptions.
+ %
+:- pred get_antialias(font_options::in, antialias::out, io::di, io::uo) is det.
+
+:- type subpixel_order
+ ---> subpixel_order_default
+ ; subpixel_order_bgr
+ ; subpixel_order_vrgb
+ ; subpixel_order_vbgr.
+
+ % font_options.set_subpixel_order(FontOptions, SubpixelOrder, !IO):
+ %
+:- pred set_subpixel_order(font_options::in, subpixel_order::in,
+ io::di, io::uo) is det.
+
+ % font_options.get_subpixel_order(FontOptions, SubpixelOrder, !IO):
+ % SubpixelOrder is the current subpixel order for FontOptions.
+ %
+:- pred get_subpixel_order(font_options::in, subpixel_order::out,
+ io::di, io::uo) is det.
+
+ % The type of hinting to do on font outlines.
+ %
+:- 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.
+
+ % font_options.set_hint_style(FontOptions, HintStyle, !IO):
+ %
+:- pred set_hint_style(font_options::in, hint_style::in, io::di, io::uo)
+ is det.
+
+ % font_options.get_hint_style(FontOptions, HintStyle, !IO):
+ %
+:- pred get_hint_style(font_options::in, hint_style::out, io::di, io::uo)
+ is det.
+
+:- 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 metric.
+
+ ; hint_metrics_on.
+ % Hint font metrics.
+
+ % font_option.set_hint_metrics(FontOptions, HintMetrics, !IO):
+ %
+:- pred set_hint_metrics(font_options::in, hint_metrics::in, io::di, io::uo)
+ is det.
+
+ % font_options.get_hint_metrics(FontOptions, HintMetrics, !IO):
+ %
+:- pred get_hint_metrics(font_options::in, hint_metrics::out, io::di, io::uo)
+ is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_enum("C", subpixel_order/0, [
+ subpixel_order_default - "CAIRO_SUBPIXEL_ORDER_DEFAULT",
+ subpixel_order_bgr - "CAIRO_SUBPIXEL_ORDER_BGR",
+ subpixel_order_vrgb - "CAIRO_SUBPIXEL_ORDER_VRGB",
+ subpixel_order_vbgr - "CAIRO_SUBPIXEL_ORDER_VBGR"
+]).
+
+:- pragma foreign_enum("C", hint_style/0, [
+ hint_style_default - "CAIRO_HINT_STYLE_DEFAULT",
+ hint_style_none - "CAIRO_HINT_STYLE_NONE",
+ hint_style_slight - "CAIRO_HINT_STYLE_SLIGHT",
+ hint_style_medium - "CAIRO_HINT_STYLE_MEDIUM",
+ hint_style_full - "CAIRO_HINT_STYLE_FULL"
+]).
+
+:- pragma foreign_enum("C", hint_metrics/0, [
+ hint_metrics_default - "CAIRO_HINT_METRICS_DEFAULT",
+ hint_metrics_off - "CAIRO_HINT_METRICS_OFF",
+ hint_metrics_on - "CAIRO_HINT_METRICS_ON"
+]).
+
+%----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ create(FntOpts::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_t *raw_font_options;
+
+ raw_font_options = cairo_font_options_create();
+ FntOpts = MR_GC_NEW(MCAIRO_font_options);
+ FntOpts->mcairo_raw_font_options = raw_font_options;
+ MR_GC_register_finalizer(FntOpts, MCAIRO_finalize_font_options, 0);
+").
+
+:- pragma foreign_proc("C",
+ copy(Orig::in, Copy::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_t *raw_copy;
+
+ raw_copy = cairo_font_options_copy(Orig->mcairo_raw_font_options);
+ Copy = MR_GC_NEW(MCAIRO_font_options);
+ Copy->mcairo_raw_font_options = raw_copy;
+ MR_GC_register_finalizer(Copy, MCAIRO_finalize_font_options, 0);
+").
+
+:- pragma foreign_proc("C",
+ set_antialias(FntOpts::in, AntiAlias::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_set_antialias(FntOpts->mcairo_raw_font_options,
+ AntiAlias);
+").
+
+:- pragma foreign_proc("C",
+ get_antialias(FntOpts::in, AntiAlias::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ AntiAlias =
+ cairo_font_options_get_antialias(FntOpts->mcairo_raw_font_options);
+").
+
+:- pragma foreign_proc("C",
+ set_subpixel_order(FntOpts::in, SPO::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_set_subpixel_order(FntOpts->mcairo_raw_font_options,
+ SPO);
+").
+
+:- pragma foreign_proc("C",
+ get_subpixel_order(FntOpts::in, SPO::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ SPO = cairo_font_options_get_subpixel_order(
+ FntOpts->mcairo_raw_font_options);
+").
+
+:- pragma foreign_proc("C",
+ set_hint_style(FntOpts::in, HintStyle::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_set_hint_style(FntOpts->mcairo_raw_font_options,
+ HintStyle);
+").
+
+:- pragma foreign_proc("C",
+ get_hint_style(FntOpts::in, HintStyle::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ HintStyle = cairo_font_options_get_hint_style(
+ FntOpts->mcairo_raw_font_options);
+").
+
+:- pragma foreign_proc("C",
+ set_hint_metrics(FntOpts::in, HintMetrics::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_set_hint_metrics(FntOpts->mcairo_raw_font_options,
+ HintMetrics);
+").
+
+:- pragma foreign_proc("C",
+ get_hint_metrics(FntOpts::in, HintMetrics::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ HintMetrics = cairo_font_options_get_hint_metrics(
+ FntOpts->mcairo_raw_font_options);
+").
+
+%----------------------------------------------------------------------------%
+:- end_module cairo.font_options.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.image.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.image.m
diff -N graphics/mercury_cairo/cairo.image.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.image.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,162 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module provides image surface, which allow rendering to memory
+% buffers.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.image.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+:- type image_surface.
+
+:- instance surface(image_surface).
+
+%---------------------------------------------------------------------------%
+
+ % image.create_surface(Format, Height, Width, Surface, !IO):
+ % Surface is a new image surface.
+ % Throws a cairo.error/0 exception if the surface cannot be created.
+ %
+:- pred create_surface(format::in, int::in, int::in, image_surface::out,
+ io::di, io::uo) is det.
+
+ % image.get_format(Surface, Format, !IO):
+ % Format is the pixel format for Surface.
+ %
+:- pred get_format(image_surface::in, format::out, io::di, io::uo) is det.
+
+ % image.get_width(Surface, Width, !IO):
+ % Width is the width of Surface (in pixels).
+ %
+:- pred get_width(image_surface::in, int::out, io::di, io::uo) is det.
+
+ % image.get_height(Surface, Height, !IO):
+ % Height is the height of Surface (in pixels).
+ %
+:- pred get_height(image_surface::in, int::out, io::di, io::uo) is det.
+
+ % image.get_stride(Surface, Stride, !IO):
+ % Sride is the stride of Surface (in bytes).
+ %
+:- pred get_stride(image_surface::in, int::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_type("C", image_surface, "MCAIRO_surface *",
+ [can_pass_as_mercury_type]).
+
+:- instance surface(image_surface) where [].
+
+%-----------------------------------------------------------------------------%
+%
+% Image surface creation
+%
+
+:- type maybe_image_surface
+ ---> image_surface_ok(image_surface)
+ ; image_surface_error(cairo.status).
+
+:- pragma foreign_export("C", make_image_surface_ok(in) = out,
+ "MCAIRO_image_surface_ok").
+:- func make_image_surface_ok(image_surface) = maybe_image_surface.
+
+make_image_surface_ok(Surface) = image_surface_ok(Surface).
+
+:- pragma foreign_export("C", make_image_surface_error(in) = out,
+ "MCAIRO_image_surface_error").
+:- func make_image_surface_error(cairo.status) = maybe_image_surface.
+
+make_image_surface_error(Status) = image_surface_error(Status).
+
+create_surface(Format, Height, Width, Surface, !IO) :-
+ create_surface_2(Format, Height, Width, MaybeSurface, !IO),
+ (
+ MaybeSurface = image_surface_ok(Surface)
+ ;
+ MaybeSurface = image_surface_error(ErrorStatus),
+ throw(cairo.error("image.create_surface/6", ErrorStatus))
+ ).
+
+:- pred create_surface_2(format::in, int::in, int::in,
+ maybe_image_surface::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ create_surface_2(Fmt::in, H::in, W::in, MaybeSurface::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ MCAIRO_surface *surface;
+ cairo_surface_t *raw_surface;
+ cairo_status_t status;
+
+ raw_surface = cairo_image_surface_create((cairo_format_t)Fmt,
+ (int)H, (int)W);
+ status = cairo_surface_status(raw_surface);
+
+ switch (status) {
+ case CAIRO_STATUS_SUCCESS:
+ surface = MR_GC_NEW(MCAIRO_surface);
+ surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
+ MaybeSurface = MCAIRO_image_surface_ok(surface);
+ break;
+
+ case CAIRO_STATUS_NULL_POINTER:
+ case CAIRO_STATUS_NO_MEMORY:
+ case CAIRO_STATUS_READ_ERROR:
+ case CAIRO_STATUS_INVALID_CONTENT:
+ case CAIRO_STATUS_INVALID_FORMAT:
+ case CAIRO_STATUS_INVALID_VISUAL:
+ MaybeSurface = MCAIRO_image_surface_error(status);
+ break;
+
+ default:
+ MR_fatal_error(\"invalid status\");
+ }
+").
+
+:- pragma foreign_proc("C",
+ get_format(Surface::in, Fmt::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Fmt = cairo_image_surface_get_format(Surface->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ get_width(Surface::in, Width::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Width = cairo_image_surface_get_width(Surface->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ get_height(Surface::in, Height::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Height = cairo_image_surface_get_height(Surface->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ get_stride(Surface::in, Stride::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Stride = cairo_image_surface_get_stride(Surface->mcairo_raw_surface);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.image.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.m
diff -N graphics/mercury_cairo/cairo.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,1265 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% A Mercury binding to the cairo 2D graphics library.
+%
+% TODO: scaled fonts
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.
+:- interface.
+
+:- import_module bool.
+:- import_module io.
+:- import_module list.
+
+%---------------------------------------------------------------------------%
+
+:- include_module font_options.
+:- include_module image.
+:- include_module matrix.
+:- include_module path.
+:- include_module pattern.
+:- include_module pdf.
+:- include_module png.
+:- include_module ps.
+:- include_module surface.
+:- include_module svg.
+:- include_module text.
+:- include_module transformations.
+
+%---------------------------------------------------------------------------%
+%
+% Basic cairo types
+%
+
+ % Each backend is an instance of this type class.
+ %
+:- typeclass surface(S) where [].
+
+ % Each font backend is an instance of this type class.
+ %
+:- typeclass font_face(F) where [].
+
+ % The cairo drawing context.
+ %
+:- type cairo.context(S). % <= surface(S).
+
+:- type cairo.pattern.
+
+:- type cairo.matrix.
+
+:- type cairo.path.
+
+:- type cairo.font_options.
+
+ % TODO: scaled fonts are NYI.
+ %
+:- type cairo.scaled_font(F). % <= font_face(F).
+
+ % Values of this type descirbe that content that a surface will contain.
+ %
+:- type content
+ ---> content_color
+ % The surface will hold color content only.
+
+ ; content_alpha
+ % The surface will hold alpha content only.
+
+ ; content_color_alpha.
+ % The surface will hold color and alpha content.
+
+ % Values of this type identify the memory format of image data.
+ % (Please see the cairo documentation for a discussion of endianess issues
+ % in relation to pixel data.)
+ %
+:- type format
+ ---> format_argb32
+ % Each pixel is a 32-bit quantity, with alpha in the upper 8 bits,
+ % then red, then green, then blue.
+
+ ; format_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.
+
+ ; format_a8
+ % Each pixel is a 8-bit quantity holding an alpha value.
+
+ ; format_a1.
+ % Each pixel is a 1-bit quantity holding an alpha value.
+
+%---------------------------------------------------------------------------%
+%
+% Error handling
+%
+
+ % The cairo status.
+ %
+:- type cairo.status
+ ---> status_success
+ ; status_no_memory
+ ; status_invalid_restore
+ ; status_invalid_pop_group
+ ; status_no_current_point
+ ; status_invalid_matrix
+ ; status_invalid_status
+ ; status_null_pointer
+ ; status_invalid_string
+ ; status_invalid_path_data
+ ; status_read_error
+ ; status_write_error
+ ; status_surface_finished
+ ; status_surface_type_mismatch
+ ; status_pattern_type_mismatch
+ ; status_invalid_content
+ ; status_invalid_format
+ ; status_invalid_visual
+ ; status_file_not_found
+ ; status_invalid_dash
+ ; status_invalid_dsc_comment
+ ; status_invalid_index
+ ; status_clip_not_representable
+ ; status_temp_file_error
+ ; status_invalid_stride
+ ; status_font_type_mismatch
+ ; status_user_font_immutable
+ ; status_user_font_error
+ ; status_negative_count
+ ; status_invalid_clusters
+ ; status_invalid_slant
+ ; status_invalid_weight.
+
+ % Status information for surfaces.
+ %
+:- inst cairo.surface_status
+ ---> status_success
+ ; status_null_pointer
+ ; status_no_memory
+ ; status_read_error
+ ; status_invalid_content
+ ; status_invalid_format
+ ; status_invalid_visual.
+
+ % Status information for patterns.
+ %
+:- inst cairo.pattern_status
+ ---> status_success
+ ; status_no_memory
+ ; status_pattern_type_mismatch.
+
+ % Exceptions of this type are thrown to indicate a cairo error.
+ %
+:- type cairo.error
+ ---> cairo.error(string, cairo.status).
+
+ % Exceptions of this type are thrown if an attempt is made to create
+ % a surface that is not supported by the implementation.
+ %
+:- type cairo.unsupported_surface_error
+ ---> cairo.unsupported_surface_error(string).
+
+%---------------------------------------------------------------------------%
+%
+% Operations on cairo contexts
+%
+
+ % cairo.create_context(TargetSurface, Context, !IO):
+ % Context is a new cairo context with all graphics state parameters set to
+ % default values and with TargetSurface as a target surface.
+ %
+:- pred create_context(S::in, context(S)::out,
+ io::di, io::uo) is det <= surface(S).
+
+ % cairo.save(Context, !IO):
+ % Make a copy of the current state of Context and save it on an internal
+ % stack of saved states for Context.
+ %
+:- pred save(context(S)::in, io::di, io::uo) is det.
+
+ % cairo.restore(Context, !IO):
+ % Restore Context to the state saved by a preceding call to cairo.save/3
+ % and remove that state from the stack of saved states.
+ %
+:- pred restore(context(S)::in, io::di, io::uo) is det.
+
+ % cairo.get_target(Context, Surface, !IO):
+ % Surface is the target surface for Context as passed to
+ % cairo.create_context/4.
+ %
+:- pred get_target(context(S)::in, S::out,
+ io::di, io::uo) is det <= surface(S).
+
+ % cairo.push_group(Context, !IO):
+ %
+:- pred push_group(context(S)::in, io::di, io::uo) is det.
+
+ % cairo.push_group_with_content(Context, ContentType, !IO):
+ %
+:- pred push_group_with_content(context(S)::in, content::in,
+ io::di, io::uo) is det.
+
+:- pred pop_group(context(S)::in, pattern::out, io::di, io::uo) is det.
+
+:- pred pop_group_to_source(context(S)::in, io::di, io::uo) is det.
+
+:- pred get_group_target(context(S)::in, T::out, io::di, io::uo) is det
+ <= surface(T).
+
+:- pred set_source_rgb(context(S)::in, float::in, float::in, float::in,
+ io::di, io::uo) is det.
+
+:- pred set_source_rgba(context(S)::in, float::in, float::in, float::in,
+ float::in, io::di, io::uo) is det.
+
+ % cairo.set_source(Context, Pattern, !IO):
+ % Set the current source pattern for Context to Pattern.
+ %
+:- pred set_source(context(S)::in, pattern::in, io::di, io::uo) is det.
+
+ % cairo.set_source_surface(Context, Surface, X, Y, !IO):
+ % Create a pattern from Surface and make it the current source pattern
+ % for Context. (X, Y) is the user-space coordinate at which the surface
+ % origin should appear.
+ %
+:- pred set_source_surface(context(S)::in, S::in, float::in, float::in,
+ io::di, io::uo) is det <= surface(S).
+
+ % cairo.get_source(Context, Pattern, !IO):
+ % Pattern is the current source pattern for Context.
+ %
+:- pred get_source(context(S)::in, pattern::out, io::di, io::uo) is det.
+
+:- 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.
+
+ ; antialias_subpixel.
+ % Perform antialiasing by taking advantage of the order of
+ % subpixel elements on devices such as LCD panel.
+
+ % cairo.set_antialias(Context, AntiAlias, !IO):
+ % Set the antialiasing mode of Context to AntiAlias.
+ %
+:- pred set_antialias(context(S)::in, antialias::in, io::di, io::uo) is det.
+
+ % cairo.get_antialias(Context, AntiAlias, !IO):
+ % AntiAlias is the current antialiasing mode for Context.
+ %
+:- pred get_antialias(context(S)::in, antialias::out, io::di, io::uo) is det.
+
+ % cairo.set_dash(Context, Dashes, Offset, !IO):
+ % Dashes is the dash pattern to be used by cairo.stroke/3.
+ % Throws a cairo.error/0 exception if an element of Dashes is negative,
+ % or all of the elements of Dashes are zero.
+ %
+:- pred set_dash(context(S)::in, list(float)::in, float::in,
+ io::di, io::uo) is det.
+
+ % cairo.get_dash_count(Context, Count !IO):
+ % Count is the number of dashes in the current dash pattern for
+ % Context. (Count is 0, if there is no current dash pattern.)
+ %
+:- pred get_dash_count(context(S)::in, int::out, io::di, io::uo) is det.
+
+%:- pred get_dash(...) - NYI.
+
+ % The fill rule is used to select how paths are filled.
+ %
+:- type fill_rule
+ ---> fill_rule_winding
+ ; fill_rule_even_odd.
+
+ % cairo.set_fill_rule(Context, FillRule, !IO):
+ % Set the current fill rule for Context to FillRule.
+ %
+:- pred set_fill_rule(context(S)::in, fill_rule::in, io::di, io::uo) is det.
+
+ % cairo.get_fill_rule(Context, FillRule, !IO):
+ % FillRule is the current file rule for Context.
+ %
+:- pred get_fill_rule(context(S)::in, fill_rule::out, io::di, io::uo) is det.
+
+ % Values of this type specify how to render the endpoints of the path when
+ % stroking.
+ %
+:- type line_cap
+ ---> line_cap_butt
+ % Start(stop) the line exactly at the start(end) point.
+
+ ; line_cap_round
+ % Use a round ending, the center of the circle is the end point.
+
+ ; line_cap_square.
+ % Use squared ending, the center of the square is the end point.
+
+ % cairo.set_line_cap(Context, LineCap, !IO):
+ % Set the line cap style for Context to LineCap.
+ %
+:- pred set_line_cap(context(S)::in, line_cap::in, io::di, io::uo) is det.
+
+ % cairo.get_line_cap(Context, LineCap, !IO):
+ % LineCap is the current line cap style for Context.
+ %
+:- pred get_line_cap(context(S)::in, line_cap::out, io::di, io::uo) is det.
+
+ % Values of this type specify how to render the junction of two lines
+ % when stroking.
+ %
+:- type line_join
+ ---> line_join_miter
+ % Use a sharp (angled) corner.
+
+ ; line_join_round
+ % Use a rounded join, the center of the circle is the joint point.
+
+ ; line_join_bevel.
+ % Use a cut-off join, the join is cut off at half the line width
+ % from the joint point.
+
+ % cairo.set_line_join(Context, LineJoin, !IO):
+ % Set the line join style for Context to LineJoin.
+ %
+:- pred set_line_join(context(S)::in, line_join::in, io::di, io::uo) is det.
+
+ % cairo.get_line_join(Context, LineJoin, !IO):
+ % LineJoin is the current line join style for Context.
+ %
+:- pred get_line_join(context(S)::in, line_join::out, io::di, io::uo) is det.
+
+ % cairo.set_line_width(Context, Width, !IO):
+ % Set the line Width for Context to Width.
+ %
+:- pred set_line_width(context(S)::in, float::in, io::di, io::uo) is det.
+
+ % cairo.get_line_width(Context, Width, !IO):
+ % Width is the current line width for Context.
+ %
+:- pred get_line_width(context(T)::in, float::out, io::di, io::uo) is det.
+
+ % cairo.set_miter_limit(Context, Limit, !IO):
+ % Set the miter limit for Context to Limit.
+ %
+:- pred set_miter_limit(context(T)::in, float::in, io::di, io::uo) is det.
+
+ % cairo.get_miter_limit(Context, Limit, !IO):
+ % Limit is the miter limit for Context.
+ %
+:- pred get_miter_limit(context(T)::in, float::out, io::di, io::uo) is det.
+
+ % Values of this type specify the compositing operator used for drawing
+ % operations (See: <http://cairographics.org/operators/> for details.)
+ %
+:- type operator
+ ---> operator_source
+ ; operator_over
+ ; operator_in
+ ; operator_out
+ ; operator_atop
+ ; operator_dest
+ ; operator_dest_over
+ ; operator_dest_in
+ ; operator_dest_out
+ ; operator_dest_atop
+ ; operator_xor
+ ; operator_add
+ ; operator_saturate.
+
+ % cairo.set_operator(Context, Operator, !IO):
+ % Set the compositing operator for Context to Operator.
+ %
+:- pred set_operator(context(T)::in, operator::in, io::di, io::uo) is det.
+
+ % cairo.get_operator(Context, Operator, !IO):
+ % Operator is the current compositing operator for Context.
+ %
+:- pred get_operator(context(T)::in, operator::out, io::di, io::uo) is det.
+
+ % cairo.set_tolerance(Context, Tolerance, !IO):
+ %
+:- pred set_tolerance(context(T)::in, float::in, io::di, io::uo) is det.
+
+ % cairo.get_tolerance(Context, Tolerance, !IO):
+ %
+:- pred get_tolerance(context(T)::in, float::out, io::di, io::uo) is det.
+
+ % cairo.clip(Context, !IO):
+ % Establishes a new clip region by intersecting the current clip region
+ % with the current path as it would be filled by cairo.fill/3 and according
+ % to the current fill rule.
+ % The current path will be cleared from Context.
+ %
+:- pred clip(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.clip_preserve(Context, !IO):
+ % As above, but do not clear the current path from Context.
+ %
+:- pred clip_preserve(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.clip_extents(Context, Left, Top, Right, Bottom, !IO):
+ % Compute a bounding box in user coordinates covering the area inside the
+ % current clip for Context.
+ %
+:- pred clip_extents(context(T)::in, float::out, float::out,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % cairo.reset_clip(Context, !IO):
+ % Reset the current clip region to its original, unrestricted state.
+ %
+:- pred reset_clip(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.fill(Context, !IO):
+ % Fill the current path according to the current fill rule.
+ % (Each sub-path is implicitly closed before being filled.)
+ % The current path for Context will be cleared.
+ %
+:- pred fill(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.fill_preserve(Context, !IO):
+ % As above, but preserve the current path for Context.
+ %
+:- pred fill_preserve(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.fill_extents(Context, Left, Top, Right, Bottom, !IO):
+ % Compute a bounding box in user coordinates covering the area that would
+ % be affected, (the "inked" area), by a cairo.fill/3 operation given the
+ % current path and fill parameters. If the current path is empty, returns
+ % an empty rectangle ((0,0), (0,0)). Surface dimensions and clipping are
+ % not taken into account.
+ %
+:- pred fill_extents(context(T)::in, float::out, float::out,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % cairo.in_fill(Context, X, Y, Result, !IO):
+ % Result is "yes" if the coordinate (X, Y) is inside the area that
+ % would be affected by a cairo.fill/3 operation given the current
+ % path and filling parameters. Result is "no" otherwise.
+ %
+:- pred in_fill(context(T)::in, float::in, float::in, bool::out,
+ io::di, io::uo) is det.
+
+ % cairo.mask(Context, Pattern, !IO):
+ % Paint the current source using the alpha channel of Pattern as a mask.
+ %
+:- pred mask(context(T)::in, pattern::in, io::di, io::uo) is det.
+
+ % cairo.mask_surface(Context, Surface, X, Y, !IO):
+ % Paint the current source using the alpha channel of Surface as a mask.
+ % (X, Y) is coordinate at which to place the origin of Surface.
+ %
+:- pred mask_surface(context(T)::in, S::in, float::in, float::in,
+ io::di, io::uo) is det <= surface(S).
+
+ % cairo.paint(Context, !IO):
+ % Paint the current source everywhere within the current clip region.
+ %
+:- pred paint(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.paint_with_alpha(Context, Alpha, !IO):
+ % Paint the current source everywhere within the current clip region using
+ % a mask of constant alpha value Alpha.
+ %
+:- pred paint_with_alpha(context(T)::in, float::in, io::di, io::uo) is det.
+
+ % cairo.stroke(Context, !IO):
+ % Stork the current path according to the current line width, line join,
+ % line cap, and dash settings for Context.
+ % The current path will be cleared.
+ %
+:- pred stroke(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.stroke_preserve(Context, !IO):
+ % As above, but preserve the current path for Context.
+ %
+:- pred stroke_preserve(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.stroke_extents(Context, Left, Top, Right, Bottom, !IO):
+ % Compute a bounding box in user coordinates covering the area that would
+ % be affected, (the "inked" area), by a cairo.stroke/3 operation given the
+ % current path and stroke parameters. If the current path is empty, return
+ % an empty rectangle ((0,0), (0,0)).
+ % Surface dimensions and clipping are not taken into account.
+ %
+:- pred stroke_extents(context(T)::in, float::out, float::out,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % cairo.in_stroke(Context, X, Y, Result, !IO):
+ % Result is "yes" if the coordinate (X, Y) is inside the area that would
+ % be affected by a cairo.stroke/3 operation given the current path and
+ % stroking parameters.
+ %
+:- pred in_stroke(context(T)::in, float::in, float::in, bool::out,
+ io::di, io::uo) is det.
+
+ % cairo.copy_page(Context, !IO):
+ % 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/3 if you want to get an empty
+ % page after the emission.
+ %
+:- pred copy_page(context(T)::in, io::di, io::uo) is det.
+
+ % cairo.show_page(Context, !IO):
+ % Emits and clears the current page for backends that support multiple
+ % pages.
+ %
+:- pred show_page(context(T)::in, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+
+ % cairo.status(Context, Status, !IO):
+ % Status is the current status of Context.
+ %
+:- pred status(context(S)::in, status::out, io::di, io::uo) is det.
+
+ % cairo.surface_status(Surface, Status, !IO):
+ % Status is the current status of Surface.
+ %
+:- pred surface_status(S::in, status::out(surface_status),
+ io::di, io::uo) is det <= surface(S).
+
+ % cairo.pattern_status(Pattern, Status, !IO):
+ % Satus is the current status of Pattern.
+ %
+:- pred pattern_status(pattern::in, status::out(pattern_status),
+ io::di, io::uo) is det.
+
+ % cairo.status_to_string(Status) = String:
+ % String is a human-readable description of Status.
+ %
+:- func status_to_string(status) = string.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+:- import_module cairo.text.
+
+:- pragma require_feature_set([conservative_gc, double_prec_float]).
+
+%---------------------------------------------------------------------------%
+
+ % All symbols defined in handwritten code should be prefixed with
+ % "MCAIRO_".
+ %
+:- pragma foreign_decl("C", "
+
+#include <cairo.h>
+
+typedef struct {
+ cairo_t *mcairo_raw_context;
+ MR_Word mcairo_cached_font_face;
+} MCAIRO_context;
+
+typedef struct {
+ cairo_pattern_t *mcairo_raw_pattern;
+} MCAIRO_pattern;
+
+typedef struct {
+ cairo_surface_t *mcairo_raw_surface;
+} MCAIRO_surface;
+
+typedef struct {
+ cairo_path_t *mcairo_raw_path;
+} MCAIRO_path;
+
+typedef struct {
+ cairo_font_face_t *mcairo_raw_font_face;
+} MCAIRO_font_face;
+
+typedef struct {
+ cairo_font_options_t *mcairo_raw_font_options;
+} MCAIRO_font_options;
+
+typedef struct {
+ cairo_scaled_font_t *mcairo_raw_scaled_font;
+} MCAIRO_scaled_font;
+
+extern void
+MCAIRO_finalize_context(void *context, void *client_data);
+
+extern void
+MCAIRO_finalize_pattern(void *pattern, void *client_data);
+
+extern void
+MCAIRO_finalize_surface(void *surface, void *client_data);
+
+extern void
+MCAIRO_finalize_path(void *path, void *client_data);
+
+extern void
+MCAIRO_finalize_font_face(void *font_face, void *client_data);
+
+extern void
+MCAIRO_finalize_font_options(void *font_options, void *client_data);
+
+extern void
+MCAIRO_finalize_scaled_font(void *scaled_font, void *client_data);
+
+").
+
+%---------------------------------------------------------------------------%
+
+ % XXX implement equality for these.
+ %
+:- pragma foreign_type("C", cairo.context(T), "MCAIRO_context *",
+ [can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", cairo.pattern, "MCAIRO_pattern *",
+ [can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", cairo.matrix, "cairo_matrix_t *",
+ [can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", cairo.path, "MCAIRO_path *",
+ [can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", cairo.font_options, "MCAIRO_font_options *",
+ [can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", cairo.scaled_font(F), "MCAIRO_scaled_font *",
+ [can_pass_as_mercury_type]).
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_enum("C", content/0, [
+ content_color - "CAIRO_CONTENT_COLOR",
+ content_alpha - "CAIRO_CONTENT_ALPHA",
+ content_color_alpha - "CAIRO_CONTENT_COLOR_ALPHA"
+]).
+
+:- pragma foreign_enum("C", operator/0, [
+ operator_source - "CAIRO_OPERATOR_SOURCE",
+ operator_over - "CAIRO_OPERATOR_OVER",
+ operator_in - "CAIRO_OPERATOR_IN",
+ operator_out - "CAIRO_OPERATOR_OUT",
+ operator_atop - "CAIRO_OPERATOR_ATOP",
+ operator_dest - "CAIRO_OPERATOR_DEST",
+ operator_dest_over - "CAIRO_OPERATOR_DEST_OVER",
+ operator_dest_in - "CAIRO_OPERATOR_DEST_IN",
+ operator_dest_out - "CAIRO_OPERATOR_DEST_OUT",
+ operator_dest_atop - "CAIRO_OPERATOR_DEST_ATOP",
+ operator_xor - "CAIRO_OPERATOR_XOR",
+ operator_add - "CAIRO_OPERATOR_ADD",
+ operator_saturate - "CAIRO_OPERATOR_SATURATE"
+]).
+
+:- pragma foreign_enum("C", cairo.format/0, [
+ format_argb32 - "CAIRO_FORMAT_ARGB32",
+ format_rgb24 - "CAIRO_FORMAT_RGB24",
+ format_a8 - "CAIRO_FORMAT_A8",
+ format_a1 - "CAIRO_FORMAT_A1"
+]).
+
+:- pragma foreign_enum("C", cairo.status/0, [
+ status_success - "CAIRO_STATUS_SUCCESS",
+ status_no_memory - "CAIRO_STATUS_NO_MEMORY",
+ status_invalid_restore - "CAIRO_STATUS_INVALID_RESTORE",
+ status_invalid_pop_group - "CAIRO_STATUS_INVALID_POP_GROUP",
+ status_no_current_point - "CAIRO_STATUS_NO_CURRENT_POINT",
+ status_invalid_matrix - "CAIRO_STATUS_INVALID_MATRIX",
+ status_invalid_status - "CAIRO_STATUS_INVALID_STATUS",
+ status_null_pointer - "CAIRO_STATUS_NULL_POINTER",
+ status_invalid_string - "CAIRO_STATUS_INVALID_STRING",
+ status_invalid_path_data - "CAIRO_STATUS_INVALID_PATH_DATA",
+ status_read_error - "CAIRO_STATUS_READ_ERROR",
+ status_write_error - "CAIRO_STATUS_WRITE_ERROR",
+ status_surface_finished - "CAIRO_STATUS_SURFACE_FINISHED",
+ status_surface_type_mismatch - "CAIRO_STATUS_SURFACE_TYPE_MISMATCH",
+ status_pattern_type_mismatch - "CAIRO_STATUS_PATTERN_TYPE_MISMATCH",
+ status_invalid_content - "CAIRO_STATUS_INVALID_CONTENT",
+ status_invalid_format - "CAIRO_STATUS_INVALID_FORMAT",
+ status_invalid_visual - "CAIRO_STATUS_INVALID_VISUAL",
+ status_file_not_found - "CAIRO_STATUS_FILE_NOT_FOUND",
+ status_invalid_dash - "CAIRO_STATUS_INVALID_DASH",
+ status_invalid_dsc_comment - "CAIRO_STATUS_INVALID_DSC_COMMENT",
+ status_invalid_index - "CAIRO_STATUS_INVALID_INDEX",
+ status_clip_not_representable - "CAIRO_STATUS_CLIP_NOT_REPRESENTABLE",
+ status_temp_file_error - "CAIRO_STATUS_TEMP_FILE_ERROR",
+ status_invalid_stride - "CAIRO_STATUS_INVALID_STRIDE",
+ status_font_type_mismatch - "CAIRO_STATUS_FONT_TYPE_MISMATCH",
+ status_user_font_immutable - "CAIRO_STATUS_USER_FONT_IMMUTABLE",
+ status_user_font_error - "CAIRO_STATUS_USER_FONT_ERROR",
+ status_negative_count - "CAIRO_STATUS_NEGATIVE_COUNT",
+ status_invalid_clusters - "CAIRO_STATUS_INVALID_CLUSTERS",
+ status_invalid_slant - "CAIRO_STATUS_INVALID_SLANT",
+ status_invalid_weight - "CAIRO_STATUS_INVALID_WEIGHT"
+]).
+:- pragma foreign_code("C", "
+
+void
+MCAIRO_finalize_context(void *context, void *client_data)
+{
+ cairo_destroy(((MCAIRO_context *)context)->mcairo_raw_context);
+}
+
+void
+MCAIRO_finalize_pattern(void *pattern, void *client_data)
+{
+ cairo_pattern_destroy(((MCAIRO_pattern *)pattern)->mcairo_raw_pattern);
+}
+
+void
+MCAIRO_finalize_surface(void *surface, void *client_data)
+{
+ cairo_surface_destroy(((MCAIRO_surface *)surface)->mcairo_raw_surface);
+}
+
+void
+MCAIRO_finalize_path(void *path, void *client_data)
+{
+ cairo_path_destroy(((MCAIRO_path *)path)->mcairo_raw_path);
+}
+
+void
+MCAIRO_finalize_font_face(void *font_face, void *client_data)
+{
+ cairo_font_face_destroy(
+ ((MCAIRO_font_face *)font_face)->mcairo_raw_font_face);
+}
+
+void
+MCAIRO_finalize_font_options(void *font_options, void *client_data)
+{
+ cairo_font_options_destroy(
+ ((MCAIRO_font_options *)font_options)->mcairo_raw_font_options);
+}
+
+void
+MCAIRO_finalize_scaled_font(void *scaled_font, void *client_data)
+{
+ cairo_scaled_font_destroy(
+ ((MCAIRO_scaled_font *)scaled_font)->mcairo_raw_scaled_font);
+}
+
+").
+
+%---------------------------------------------------------------------------%
+
+:- type font_face_container
+ ---> some [F] font_face_container(F) => font_face(F).
+
+%---------------------------------------------------------------------------%
+%
+% Context creation
+%
+
+create_context(Surface, Context, !IO) :-
+ create_context_2(Surface, Context, !IO),
+ % Make sure that the cached font face object is set to
+ % a meaningful value. (See the comments in the implementation
+ % of {get,set}_font_face for details.)
+ cairo.text.toy_font_face_create("",
+ slant_normal, weight_normal, ToyFF, !IO),
+ cairo.text.set_font_face(Context, ToyFF, !IO).
+
+:- pred create_context_2(S::in, context(S)::out,
+ io::di, io::uo) is det <= surface(S).
+
+:- pragma foreign_proc("C",
+ create_context_2(Surface::in, Context::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_t *raw_context;
+
+ raw_context = cairo_create(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+ Context = MR_GC_NEW(MCAIRO_context);
+ Context->mcairo_raw_context = raw_context;
+ /*
+ ** We fill the cached font face in later.
+ */
+ Context->mcairo_cached_font_face = 0;
+ MR_GC_register_finalizer(Context, MCAIRO_finalize_context, 0);
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ save(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_save(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ restore(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_restore(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ get_target(Ctxt::in, Target::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_surface_t *raw_surface;
+ MCAIRO_surface *wrapped_surface;
+
+ raw_surface = cairo_get_target(Ctxt->mcairo_raw_context);
+ /*
+ ** The object returned by cairo_get_target() is owned by cairo,
+ ** since we are keeping a reference to it we need to increment
+ ** its reference count.
+ */
+ raw_surface = cairo_surface_reference(raw_surface);
+ wrapped_surface = MR_GC_NEW(MCAIRO_surface);
+ wrapped_surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(wrapped_surface, MCAIRO_finalize_surface, 0);
+ Target = (MR_Word) wrapped_surface;
+").
+
+:- pragma foreign_proc("C",
+ push_group(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_push_group(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ push_group_with_content(Ctxt::in, Content::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_push_group_with_content(Ctxt->mcairo_raw_context, Content);
+").
+
+:- pragma foreign_proc("C",
+ pop_group(Ctxt::in, Pattern::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_pattern_t *new_pattern;
+
+ new_pattern = cairo_pop_group(Ctxt->mcairo_raw_context);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = new_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ pop_group_to_source(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_pop_group_to_source(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ get_group_target(Ctxt::in, Target::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_surface_t *raw_surface;
+ MCAIRO_surface *wrapped_surface;
+
+ raw_surface = cairo_get_group_target(Ctxt->mcairo_raw_context);
+ wrapped_surface = MR_GC_NEW(MCAIRO_surface);
+ wrapped_surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(wrapped_surface, MCAIRO_finalize_surface, 0);
+ Target = (MR_Word) wrapped_surface;
+").
+
+:- pragma foreign_proc("C",
+ set_source_rgb(Ctxt::in, Red::in, Green::in, Blue::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_source_rgb(Ctxt->mcairo_raw_context, Red, Green, Blue);
+").
+
+:- pragma foreign_proc("C",
+ set_source_rgba(Ctxt::in, Red::in, Green::in, Blue::in, Alpha::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_source_rgba(Ctxt->mcairo_raw_context,
+ Red, Green, Blue, Alpha);
+").
+
+:- pragma foreign_proc("C",
+ set_source(Ctxt::in, Pattern::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_source(Ctxt->mcairo_raw_context, Pattern->mcairo_raw_pattern);
+").
+
+:- pragma foreign_proc("C",
+ set_source_surface(Ctxt::in, SrcSurface::in, X::in, Y::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_source_surface(Ctxt->mcairo_raw_context,
+ ((MCAIRO_surface *)SrcSurface)->mcairo_raw_surface, X, Y);
+").
+
+:- pragma foreign_proc("C",
+ get_source(Ctxt::in, Pattern::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_pattern_t *raw_pattern;
+
+ raw_pattern = cairo_get_source(Ctxt->mcairo_raw_context);
+
+ /*
+ ** The value returned by cairo_get_surface() is owned by
+ ** by cairo. Since we are going to retain a reference to
+ ** it we need to increment the reference count here.
+ */
+ raw_pattern = cairo_pattern_reference(raw_pattern);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ set_fill_rule(Ctxt::in, FillRule::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_fill_rule(Ctxt->mcairo_raw_context, FillRule);
+").
+
+:- pragma foreign_proc("C",
+ get_fill_rule(Ctxt::in, FillRule::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ FillRule = cairo_get_fill_rule(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_line_cap(Ctxt::in, LineCap::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_line_cap(Ctxt->mcairo_raw_context, LineCap);
+").
+
+:- pragma foreign_proc("C",
+ get_line_cap(Ctxt::in, LineCap::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ LineCap = cairo_get_line_cap(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ copy_page(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_copy_page(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ show_page(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_show_page(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_antialias(Ctxt::in, AA::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_antialias(Ctxt->mcairo_raw_context, (cairo_antialias_t)AA);
+").
+
+:- pragma foreign_proc("C",
+ get_antialias(Ctxt::in, AA::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ AA = cairo_get_antialias(Ctxt->mcairo_raw_context);
+").
+
+set_dash(Context, Dashes, OffSet, !IO) :-
+ list.length(Dashes, NumDashes),
+ set_dash_2(Context, Dashes, NumDashes, OffSet, IsValid, !IO),
+ (
+ IsValid = yes
+ ;
+ IsValid = no,
+ throw(cairo.error("set_dash/5", status_invalid_dash))
+ ).
+
+:- pred set_dash_2(context(S)::in, list(float)::in, int::in,
+ float/*offset*/::in, bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ set_dash_2(Ctxt::in, Dashes::in, NumDashes::in, OffSet::in,
+ IsValid::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ double *dashes;
+ double dash;
+ size_t i = 0;
+
+ dashes = MR_GC_malloc(sizeof(double) * NumDashes);
+
+ while (!MR_list_is_empty(Dashes)) {
+ dash = MR_word_to_float(MR_list_head(Dashes));
+ dashes[i] = dash;
+ Dashes = MR_list_tail(Dashes);
+ i++;
+ }
+
+ cairo_set_dash(Ctxt->mcairo_raw_context, dashes, (int)NumDashes, OffSet);
+
+ if (cairo_status(Ctxt->mcairo_raw_context) == CAIRO_STATUS_INVALID_DASH) {
+ IsValid = MR_NO;
+ } else {
+ IsValid = MR_YES;
+ }
+").
+
+:- pragma foreign_proc("C",
+ get_dash_count(Ctxt::in, Count::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Count = cairo_get_dash_count(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_line_join(Ctxt::in, LineJoin::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_line_join(Ctxt->mcairo_raw_context, LineJoin);
+").
+
+:- pragma foreign_proc("C",
+ get_line_join(Ctxt::in, LineJoin::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ LineJoin = cairo_get_line_join(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_line_width(Ctxt::in, Width::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_line_width(Ctxt->mcairo_raw_context, Width);
+").
+
+:- pragma foreign_proc("C",
+ get_line_width(Ctxt::in, Width::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Width = cairo_get_line_width(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_miter_limit(Ctxt::in, Limit::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_miter_limit(Ctxt->mcairo_raw_context, Limit);
+").
+
+:- pragma foreign_proc("C",
+ get_miter_limit(Ctxt::in, Limit::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Limit = cairo_get_miter_limit(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_operator(Ctxt::in, Op::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_operator(Ctxt->mcairo_raw_context, Op);
+").
+
+:- pragma foreign_proc("C",
+ get_operator(Ctxt::in, Op::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Op = cairo_get_operator(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ set_tolerance(Ctxt::in, Tolerance::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_tolerance(Ctxt->mcairo_raw_context, Tolerance);
+").
+
+:- pragma foreign_proc("C",
+ get_tolerance(Ctxt::in, Tolerance::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ Tolerance = cairo_get_tolerance(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ clip(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_clip(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ clip_preserve(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_clip_preserve(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ clip_extents(Ctxt::in, X1::out, Y1::out, X2::out, Y2::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_clip_extents(Ctxt->mcairo_raw_context,
+ &X1, &Y1, &X2, &Y2);
+").
+
+:- pragma foreign_proc("C",
+ reset_clip(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_reset_clip(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ fill(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_fill(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ fill_preserve(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_fill_preserve(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ fill_extents(Ctxt::in, X1::out, Y1::out, X2::out, Y2::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_fill_extents(Ctxt->mcairo_raw_context,
+ &X1, &Y1, &X2, &Y2);
+").
+
+:- pragma foreign_proc("C",
+ in_fill(Ctxt::in, X::in, Y::in, Result::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ if (cairo_in_fill(Ctxt->mcairo_raw_context, X, Y)) {
+ Result = MR_YES;
+ } else {
+ Result = MR_NO;
+ }
+").
+
+:- pragma foreign_proc("C",
+ mask(Ctxt::in, Pattern::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_mask(Ctxt->mcairo_raw_context,
+ Pattern->mcairo_raw_pattern);
+").
+
+:- pragma foreign_proc("C",
+ mask_surface(Ctxt::in, Surface::in, X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_mask_surface(Ctxt->mcairo_raw_context,
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface,
+ X, Y);
+").
+
+:- pragma foreign_proc("C",
+ paint(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_paint(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ paint_with_alpha(Ctxt::in, Alpha::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_paint_with_alpha(Ctxt->mcairo_raw_context, Alpha);
+").
+
+:- pragma foreign_proc("C",
+ stroke(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_stroke(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ stroke_preserve(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_stroke_preserve(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ stroke_extents(Ctxt::in, X1::out, Y1::out, X2::out, Y2::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_stroke_extents(Ctxt->mcairo_raw_context, &X1, &Y1, &X2, &Y2);
+").
+
+:- pragma foreign_proc("C",
+ in_stroke(Ctxt::in, X::in, Y::in, Result::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ if (cairo_in_stroke(Ctxt->mcairo_raw_context, X, Y)) {
+ Result = MR_YES;
+ } else {
+ Result = MR_NO;
+ }
+").
+
+:- pragma foreign_proc("C",
+ status(Ctxt::in, Status::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Status = cairo_status(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ surface_status(Surface::in, Status::out(surface_status),
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Status = cairo_surface_status(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ pattern_status(Pattern::in, Status::out(pattern_status),
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Status = cairo_pattern_status(Pattern->mcairo_raw_pattern);
+").
+
+:- pragma foreign_proc("C",
+ status_to_string(Status::in) = (Str::out),
+ [promise_pure, will_not_call_mercury],
+"
+ const char *desc;
+
+ desc = cairo_status_to_string(Status);
+ MR_make_aligned_string_copy(Str, desc);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.matrix.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.matrix.m
diff -N graphics/mercury_cairo/cairo.matrix.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.matrix.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,245 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au.
+%
+% This modle contains predicates that perform various generic matrix
+% operations on cairo transformation matricies.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.matrix.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+ % matrix.init(XX, YX, XY, YY, X0, Y0, Matrix, !IO):
+ % Matrix is the affine transformation given by:
+ %
+ % <x_new> = XX * <x> + XY * <y> + X0
+ % <y_new> = YX * <x> + YY * <y> +Y0
+ %
+:- pred init(float::in, float::in, float::in, float::in,
+ float::in, float::in, matrix::out, io::di, io::uo) is det.
+
+ % matrix.init_identity(Matrix, !IO):
+ % Matrix is the identity transformation.
+ %
+:- pred init_identity(matrix::out, io::di, io::uo) is det.
+
+ % matrix.init_translate(Tx, Ty, Matrix, !IO):
+ % Matrix is a transformation that translates by Tx and Ty in the X and Y
+ % directions respectively.
+ %
+:- pred init_translate(float::in, float::in, matrix::out, io::di, io::uo)
+ is det.
+
+ % matrix.init_scale(Sx, Sy, Matrix, !IO):
+ % Matrix is a transformation that scales by Sx and Sy in the X and Y
+ % directions respectively.
+ %
+:- pred init_scale(float::in, float::in, matrix::out, io::di, io::uo)
+ is det.
+
+ % matrix.init_rotate(R, Matrix, !IO):
+ % Matrix is a transformation that rotates by R radians.
+ % The direction of rotation is defined such that positive angles rotate
+ % in the direction from the positive X axis toward the positive Y axis.
+ % With the default axis orientation of cairo, positive angles rotate
+ % in a clockwise direction.
+ %
+:- pred init_rotate(float::in, matrix::out, io::di, io::uo) is det.
+
+ % matrix.translate(Matrix, Tx, Ty, !IO):
+ % Apply a translation by Tx, Ty to the transformation in Matrix.
+ %
+:- pred translate(matrix::in, float::in, float::in, io::di, io::uo) is det.
+
+ % matrix.scale(Matrix, Sx, Sy, !IO):
+ % Apply scaling by Sx, Sy to the transformation in Matrix.
+ %
+:- pred scale(matrix::in, float::in, float::in, io::di, io::uo) is det.
+
+ % matrix.rotate(Matrix, R, !IO):
+ % Apply a rotation by R radians to the transformation in Matrix.
+ %
+:- pred rotate(matrix::in, float::in, io::di, io::uo) is det.
+
+ % matrix.invert(Matrix, !IO):
+ % Update Matrix to be the inverse of its original value.
+ % Throws a cairo.error/0 exception if Matrix is not invertible.
+ %
+:- pred invert(matrix::in, io::di, io::uo) is det.
+
+ % matrix.multiply(Result, A, B, !IO):
+ % Update Result to be the product of the affine transformations in A and B.
+ %
+:- pred multiply(matrix::in, matrix::in, matrix::in, io::di, io::uo) is det.
+
+ % matrix.transform_distance(Matrix, Dx0, Dy0, Dx, Dy, !IO):
+ % Transforms the distance vector (Dx0, Dy0) by Matrix.
+ %
+:- pred transform_distance(matrix::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % matrix.transform_point(Matrix, X0, Y0, X, Y, !IO):
+ % (X, Y) is the point (X0, Y0) transformed by Matrix.
+ %
+:- pred transform_point(matrix::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module string.
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ init(Xx::in, Yx::in, Xy::in, Yy::in, X0::in, Y0::in,
+ Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *new_matrix;
+
+ new_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_matrix_init(new_matrix, Xx, Yx, Xy, Yy, X0, Y0);
+ Matrix = new_matrix;
+").
+
+:- pragma foreign_proc("C",
+ init_identity(Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *new_matrix;
+
+ new_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_matrix_init_identity(new_matrix);
+ Matrix = new_matrix;
+").
+
+:- pragma foreign_proc("C",
+ init_translate(Tx::in, Ty::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *new_matrix;
+
+ new_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_matrix_init_translate(new_matrix, Tx, Ty);
+ Matrix = new_matrix;
+").
+
+:- pragma foreign_proc("C",
+ init_scale(Sx::in, Sy::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *new_matrix;
+
+ new_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_matrix_init_scale(new_matrix, Sx, Sy);
+ Matrix = new_matrix;
+").
+
+:- pragma foreign_proc("C",
+ init_rotate(Radians::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *new_matrix;
+
+ new_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_matrix_init_rotate(new_matrix, Radians);
+ Matrix = new_matrix;
+").
+
+:- pragma foreign_proc("C",
+ translate(Matrix::in, Tx::in, Ty::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_translate(Matrix, Tx, Ty);
+").
+
+:- pragma foreign_proc("C",
+ scale(Matrix::in, Sx::in, Sy::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_scale(Matrix, Sx, Sy);
+").
+
+:- pragma foreign_proc("C",
+ rotate(Matrix::in, Radians::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_rotate(Matrix, Radians);
+").
+
+invert(Matrix, !IO) :-
+ invert_2(Matrix, IsValid, !IO),
+ (
+ IsValid = yes
+ ;
+ IsValid = no,
+ throw(cairo.error("invert/3", status_invalid_matrix))
+ ).
+
+:- pred invert_2(matrix::in, bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ invert_2(Matrix::in, IsValid::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ if (cairo_matrix_invert(Matrix) == CAIRO_STATUS_SUCCESS) {
+ IsValid = MR_YES;
+ } else {
+ IsValid = MR_NO;
+ }
+").
+
+:- pragma foreign_proc("C",
+ multiply(Result::in, A::in, B::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_multiply(Result, A, B);
+").
+
+:- pragma foreign_proc("C",
+ transform_distance(Matrix::in, Dx0::in, Dy0::in, Dx::out, Dy::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ double dx;
+ double dy;
+
+ dx = Dx0;
+ dy = Dy0;
+
+ cairo_matrix_transform_distance(Matrix, &dx, &dy);
+ Dx = dx;
+ Dy = dy;
+").
+
+:- pragma foreign_proc("C",
+ transform_point(Matrix::in, X0::in, Y0::in, X::out, Y::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ double x;
+ double y;
+
+ x = X0;
+ y = Y0;
+
+ cairo_matrix_transform_point(Matrix, &x, &y);
+ X = x;
+ Y = y;
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.matrix.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.path.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.path.m
diff -N graphics/mercury_cairo/cairo.path.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.path.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,388 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains predicates for creating and manipulating path
+% data.
+%
+% TODO: implement iteration over path components.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.path.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+ % path.copy_path(Context, Path, !IO):
+ % Path is a copy of the current path.
+ %
+:- pred copy_path(context(T)::in, path::out, io::di, io::uo) is det.
+
+ % path.copy_path_flat(Context, Path, !IO):
+ % Path is a flattened copy of the current path.
+ % (Curves are replaced by piecewise linear approximations.)
+ %
+:- pred copy_path_flat(context(T)::in, path::out, io::di, io::uo) is det.
+
+ % path.append_path(Context, Path, !IO):
+ % Append Path to the current path.
+ %
+:- pred append_path(context(T)::in, path::in, io::di, io::uo) is det.
+
+ % path.has_current_point(Context, Result, !IO):
+ % Result is "yes" if a current point is defined on the current path
+ % and "no" otherwise.
+ %
+:- pred has_current_point(context(T)::in, bool::out, io::di, io::uo) is det.
+
+ % path.get_current_point(Context, X, Y, !IO):
+ % (X, Y) is the current point of the current path.
+ % If the current path has no current point then (X, Y) = (0.0, 0.0).
+ %
+:- pred get_current_point(context(T)::in, float::out, float::out,
+ io::di, io::uo) is det.
+
+ % path.new_path(Context, !IO):
+ % Clears the current point.
+ % After this call there will be no path and no current point.
+ %
+:- pred new_path(context(T)::in, io::di, io::uo) is det.
+
+ % path.new_sub_path(Context, !IO):
+ % Start a new sub-path.
+ % Note that the existing path is not affected.
+ % After this call there will be no current point.
+ %
+:- pred new_sub_path(context(T)::in, io::di, io::uo) is det.
+
+ % path.close_path(Context, !IO):
+ % 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/5), and closes this sub-path.
+ % After this call the current path will be at the joined endpoint of the
+ % sub-path.
+ %
+:- pred close_path(context(T)::in, io::di, io::uo) is det.
+
+ % path.arc(Ctxt, Xc, Yc, R, Angle1, Angle2, !IO):
+ % Add a circular arc of radius R to the current path.
+ % The arc is centred 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.
+ %
+:- pred arc(context(T)::in, float::in, float::in,
+ float::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.arc_negative(Context, Xc, Yc, R, Angle1, Angle2, !IO):
+ % Add a circular arc of radius R to the current path.
+ % The arc is centred at (Xc, Yc), begins at Angle1 and proceeds in the
+ % direction of decreasing angles to end at Angle2.
+ % If Angle2 is less than Angle1 it will be progressively decreased by
+ % 2 * pi until it is greater than Angle1.
+ %
+:- pred arc_negative(context(T)::in, float::in, float::in,
+ float::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.curve_to(Context, X1, Y1, X2, Y2, X3, Y3, !IO):
+ % Adds a cubic Bezier 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).
+ %
+:- pred curve_to(context(T)::in, float::in, float::in,
+ float::in, float::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.line_to(Context, X, Y, !IO):
+ % 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, then this behave like calling
+ % path.move_to(Context, X, Y, !IO).
+ %
+:- pred line_to(context(T)::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.move_to(Context, X, Y, !IO):
+ % Begin a new sub-path. After this call the current point will be (X, Y).
+ %
+:- pred move_to(context(T)::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.rectangle(Context, X, Y, Width, Height, !IO):
+ % Adds a closed sub-path rectangle of the given size to the current path at
+ % position (X, Y) in user-space coordinates.
+ %
+:- pred rectangle(context(T)::in, float::in, float::in, float::in, float::in,
+ io::di, io::uo) is det.
+
+ % path.text_path(Context, Text. !IO):
+ % Adds closed paths for Text to the current path.
+ %
+:- pred text_path(context(T)::in, string::in, io::di, io::uo) is det.
+
+ % path.rel_curve_to(Context, Dx1, Dy1, Dx2, Dy2, Dx3, Dy3, !IO):
+ % Relative-coordinate version of path.curve_to/9.
+ % All offsets are relative to the current point.
+ % Throws a cairo.error/0 exception if there is no current point.
+ %
+:- pred rel_curve_to(context(T)::in, float::in, float::in,
+ float::in, float::in, float::in, float::in, io::di, io::uo) is det.
+
+ % path.rel_line_to(Context, Dx, Dy, !IO):
+ % Relative-coordinate version of path.line_to/5.
+ % All offsets are relative to the current point.
+ % Throws a cairo.error/0 exception if there is no current point.
+ %
+:- pred rel_line_to(context(T)::in, float::in, float::in,
+ io::di, io::uo) is det.
+
+ % path.rel_move_to(Context, Dx, Dy, !IO):
+ % Relative-coordinate version of path.move_to/5.
+ % Throws a cairo.error/0 exception if there is no current point.
+ %
+:- pred rel_move_to(context(T)::in, float::in, float::in,
+ io::di, io::uo) is det.
+
+ % path.path_extents(Context, X1, Y1, X2, Y2, !IO):
+ % 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 ((0,0), (0,0)). Stroke parameters, fill rule, surface
+ % dimensions and clipping are not taken into account.
+ %
+ % (X1, Y1) is the top-left of the box.
+ % (X2, Y2) is the bottom-right of the box.
+ %
+:- pred path_extents(context(T)::in, float::out, float::out,
+ float::out, float::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ copy_path(Ctxt::in, Path::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_path_t *raw_path;
+
+ raw_path = cairo_copy_path(Ctxt->mcairo_raw_context);
+ Path = MR_GC_NEW(MCAIRO_path);
+ Path->mcairo_raw_path = raw_path;
+ MR_GC_register_finalizer(Path, MCAIRO_finalize_path, 0);
+").
+
+:- pragma foreign_proc("C",
+ copy_path_flat(Ctxt::in, Path::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_path_t *raw_path;
+
+ raw_path = cairo_copy_path_flat(Ctxt->mcairo_raw_context);
+ Path = MR_GC_NEW(MCAIRO_path);
+ Path->mcairo_raw_path = raw_path;
+ MR_GC_register_finalizer(Path, MCAIRO_finalize_path, 0);
+").
+
+
+:- pragma foreign_proc("C",
+ append_path(Ctxt::in, Path::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_append_path(Ctxt->mcairo_raw_context,
+ Path->mcairo_raw_path);
+").
+
+:- pragma foreign_proc("C",
+ has_current_point(Ctxt::in, Result::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ if (cairo_has_current_point(Ctxt->mcairo_raw_context)) {
+ Result = MR_YES;
+ } else {
+ Result = MR_NO;
+ }
+").
+
+:- pragma foreign_proc("C",
+ get_current_point(Ctxt::in, X::out, Y::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_get_current_point(Ctxt->mcairo_raw_context, &X, &Y);
+").
+
+:- pragma foreign_proc("C",
+ new_path(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_new_path(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ new_sub_path(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_new_sub_path(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ close_path(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_close_path(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ arc(Ctxt::in, XC::in, YC::in, Radius::in, Angle1::in, Angle2::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_arc(Ctxt->mcairo_raw_context, XC, YC, Radius, Angle1, Angle2);
+").
+
+:- pragma foreign_proc("C",
+ arc_negative(Ctxt::in, XC::in, YC::in, Radius::in, Angle1::in, Angle2::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_arc_negative(Ctxt->mcairo_raw_context, XC, YC, Radius, Angle1, Angle2);
+").
+
+:- pragma foreign_proc("C",
+ curve_to(Ctxt::in, X1::in, Y1::in, X2::in, Y2::in, X3::in, Y3::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_curve_to(Ctxt->mcairo_raw_context, X1, Y1, X2, Y2, X3, Y3);
+").
+
+:- pragma foreign_proc("C",
+ line_to(Ctxt::in, X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_line_to(Ctxt->mcairo_raw_context, X, Y);
+").
+
+:- pragma foreign_proc("C",
+ move_to(Ctxt::in, X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_move_to(Ctxt->mcairo_raw_context, X, Y);
+").
+
+:- pragma foreign_proc("C",
+ rectangle(Ctxt::in, X::in, Y::in, W::in, H::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_rectangle(Ctxt->mcairo_raw_context, X, Y, W, H);
+").
+
+:- pragma foreign_proc("C",
+ text_path(Ctxt::in, Str::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_text_path(Ctxt->mcairo_raw_context, Str);
+").
+
+rel_curve_to(Ctxt, Dx1, Dy1, Dx2, Dy2, Dx3, Dy3, !IO) :-
+ rel_curve_to_2(Ctxt, Dx1, Dy1, Dx2, Dy2, Dx3, Dy3, IsValid, !IO),
+ (
+ IsValid = yes
+ ;
+ IsValid = no,
+ throw(cairo.error("rel_curve_to/7", status_no_current_point))
+ ).
+
+:- pred rel_curve_to_2(context(T)::in, float::in, float::in,
+ float::in, float::in, float::in, float::in, bool::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ rel_curve_to_2(Ctxt::in, Dx1::in, Dy1::in, Dx2::in, Dy2::in,
+ Dx3::in, Dy3::in, IsValid::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_status_t status;
+
+ cairo_rel_curve_to(Ctxt->mcairo_raw_context,
+ Dx1, Dy1, Dx2, Dy2, Dx3, Dy3);
+ status = cairo_status(Ctxt->mcairo_raw_context);
+ if (status == CAIRO_STATUS_NO_CURRENT_POINT) {
+ IsValid = MR_NO;
+ } else {
+ IsValid = MR_YES;
+ }
+").
+
+rel_line_to(Ctxt, Dx, Dy, !IO) :-
+ rel_line_to_2(Ctxt, Dx, Dy, IsValid, !IO),
+ (
+ IsValid = yes
+ ;
+ IsValid = no,
+ throw(cairo.error("rel_line_to/5", status_no_current_point))
+ ).
+
+:- pred rel_line_to_2(context(T)::in, float::in, float::in,
+ bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ rel_line_to_2(Ctxt::in, Dx::in, Dy::in, IsValid::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_status_t status;
+
+ cairo_rel_line_to(Ctxt->mcairo_raw_context, Dx, Dy);
+ status = cairo_status(Ctxt->mcairo_raw_context);
+ if (status == CAIRO_STATUS_NO_CURRENT_POINT) {
+ IsValid = MR_NO;
+ } else {
+ IsValid = MR_YES;
+ }
+").
+
+rel_move_to(Ctxt, Dx, Dy, !IO) :-
+ rel_move_to_2(Ctxt, Dx, Dy, IsValid, !IO),
+ (
+ IsValid = yes
+ ;
+ IsValid = no,
+ throw(cairo.error("rel_move_to/5", status_no_current_point))
+ ).
+
+:- pred rel_move_to_2(context(T)::in, float::in, float::in,
+ bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ rel_move_to_2(Ctxt::in, Dx::in, Dy::in, IsValid::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_status_t status;
+
+ cairo_rel_move_to(Ctxt->mcairo_raw_context, Dx, Dy);
+ status = cairo_status(Ctxt->mcairo_raw_context);
+ if (status == CAIRO_STATUS_NO_CURRENT_POINT) {
+ IsValid = MR_NO;
+ } else {
+ IsValid = MR_YES;
+ }
+").
+
+:- pragma foreign_proc("C",
+ path_extents(Ctxt::in, X1::out, Y1::out, X2::out, Y2::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_path_extents(Ctxt->mcairo_raw_context, &X1, &Y1, &X2, &Y2);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.path.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.pattern.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.pattern.m
diff -N graphics/mercury_cairo/cairo.pattern.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.pattern.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,380 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains predicates and types that deal with patterns.
+%
+% TODO: there are a few unimplemented predicates in this module.
+% (Search for NYI.)
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.pattern.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+ % This type describes 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
+ ---> extend_none
+ % Pixels outside of the source pattern are fully transparent.
+
+ ; extend_repeat
+ % The pattern is tiled by repeating.
+
+ ; extend_reflect
+ % The pattern is tiled by reflecting at the edges.
+
+ ; extend_pad.
+ % Pixels outside of the pattern copy the closest pixel from
+ % the source.
+
+ % The type of filtering that should be applied when reading pixel values
+ % from patterns.
+ %
+:- type filter
+ ---> filter_fast
+ % A high-performance filter, with quality similar to
+ % filter_nearest.
+
+ ; filter_good
+ % A reasonable-performance filter, with quality similar to
+ % filter_bilinear.
+
+ ; filter_best
+ % The highest-quality available. May not b suitable for
+ % interactive use.
+
+ ; filter_nearest
+ % Nearest-neighbour filtering.
+
+ ; filter_bilinear.
+ % Linear interpolation in two dimensions.
+
+ % Values of this type describe the type of a given pattern.
+ %
+:- type pattern_type
+ ---> pattern_type_solid
+ % The pattern is a solid (uniform) color.
+ % It may be opaque or translucent.
+
+ ; pattern_type_surface
+ % The pattern is a based on a surface (an image).
+
+ ; pattern_type_linear
+ % The pattern is a linear gradient.
+
+ ; pattern_type_radial.
+ % The pattern is a radial gradient.
+
+%---------------------------------------------------------------------------%
+
+ % pattern.add_color_stop_rgb(Pattern, Offset, Red, Green, Blue, !IO):
+ % Adds an opaque color stop to a gradient pattern.
+ % Offset specifies the location along the gradient's control vector.
+ % Throws a cairo.error/0 exception if Pattern is not a gradient pattern.
+ %
+:- pred add_color_stop_rgb(pattern::in, float::in, float::in, float::in,
+ float::in, io::di, io::uo) is det.
+
+ % pattern.add_color_stop_rgba(Pattern, Offset, Red, Green, Blue, Alpha,
+ % !IO):
+ %
+ % Adds a translucent color stop to a gradient pattern.
+ % The offset specifies the location along the gradient's control vector.
+ % Throws a cairo.error/0 exception if Pattern is not a gradient pattern.
+ %
+:- pred add_color_stop_rgba(pattern::in, float::in, float::in, float::in,
+ float::in, float::in, io::di, io::uo) is det.
+
+% TODO: NYI.
+% :- pred get_color_stop_count
+% :- pred get_colourt_stop_rgba
+
+ % pattern.create_rgb(Red, Green, Blue, Pattern, !IO):
+ % Pattern is a new pattern corresponding to an opaque color.
+ % The color components, Red, Green, and Blue are in the range [0, 1].
+ % Value outside that range will be clamped.
+ %
+:- pred create_rgb(float::in, float::in, float::in, pattern::out,
+ io::di, io::uo) is det.
+
+ % pattern.create_rgba(Red, Green, Blue, Alpha, Pattern, !IO):
+ % Pattern is a new pattern corresponding to a translucent color.
+ % The color components, Red, Green, Blue, and Alpha are in the
+ % range [0, 1]. Value outside that range will be clamped.
+ %
+:- pred create_rgba(float::in, float::in, float::in, float::in, pattern::out,
+ io::di, io::uo) is det.
+
+% :- pred get_rgba - NYI
+
+ % pattern.create_for_surface(Surface, Pattern, !IO):
+ % Pattern is a new pattern for Surface.
+ %
+:- pred create_for_surface(S::in, pattern::out, io::di, io::uo)
+ is det <= surface(S).
+
+ % pattern.create_linear(X0, Y0, X1, Y1, Pattern, !IO):
+ % Pattern is a new linear gradient pattern along the line defined by
+ % (X0, Y0) and (X1, Y1).
+ %
+:- pred create_linear(float::in, float::in, float::in, float::in, pattern::out,
+ io::di, io::uo) is det.
+
+% :- pred get_linear_points - NYI.
+
+ % pattern.create_radial(Cx0, Cy0, Radius0, Cx1, Cy1, Radius1,
+ % Pattern, !IO):
+ %
+ % Pattern is a new radial gradient pattern between the two circles defined
+ % by (Cx0, Cy0, Radius0) and (Cx1, Cy1, Radius1).
+ %
+:- pred create_radial(float::in, float::in, float::in,
+ float::in, float::in, float::in, pattern::out, io::di, io::uo) is det.
+
+% :- pred get_radial_circles - NYI.
+
+ % pattern.set_extend(Pattern, Extend, !IO):
+ % Set the extend mode for Pattern to Extend.
+ %
+:- pred set_extend(pattern::in, extend::in, io::di, io::uo) is det.
+
+ % pattern.get_extend(Pattern, Extend, !IO):
+ % Extend is the current extend mode for Pattern.
+ %
+:- pred get_extend(pattern::in, extend::out, io::di, io::uo) is det.
+
+ % pattern.set_filter(Pattern, Filter, !IO):
+ % Set Filter to be the filter used when resizing Pattern.
+ %
+:- pred set_filter(pattern::in, filter::in, io::di, io::uo) is det.
+
+ % pattern.get_filter(Pattern, Filter, !IO):
+ % Filter is the current filter for Pattern.
+ %
+:- pred get_filter(pattern::in, filter::out, io::di, io::uo) is det.
+
+ % pattern.set_matrix(Pattern, Matrix, !IO):
+ % Set the transformation matrix for Pattern to Matrix.
+ %
+:- pred set_matrix(pattern::in, matrix::in, io::di, io::uo) is det.
+
+ % pattern.get_matrix(Pattern, Matrix, !IO):
+ % Matrix is the current transformation matrix for Pattern.
+ %
+:- pred get_matrix(pattern::in, matrix::out, io::di, io::uo) is det.
+
+ % pattern.get_type(Pattern, Type, !IO):
+ % Type is pattern type of Pattern.
+ %
+:- pred get_type(pattern::in, pattern_type::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_enum("C", extend/0, [
+ extend_none - "CAIRO_EXTEND_NONE",
+ extend_repeat - "CAIRO_EXTEND_REPEAT",
+ extend_reflect - "CAIRO_EXTEND_REFLECT",
+ extend_pad - "CAIRO_EXTEND_PAD"
+]).
+
+:- pragma foreign_enum("C", filter/0, [
+ filter_fast - "CAIRO_FILTER_FAST",
+ filter_good - "CAIRO_FILTER_GOOD",
+ filter_best - "CAIRO_FILTER_BEST",
+ filter_nearest - "CAIRO_FILTER_NEAREST",
+ filter_bilinear - "CAIRO_FILTER_BILINEAR"
+]).
+
+:- pragma foreign_enum("C", pattern_type/0, [
+ pattern_type_solid - "CAIRO_PATTERN_TYPE_SOLID",
+ pattern_type_surface - "CAIRO_PATTERN_TYPE_SURFACE",
+ pattern_type_linear - "CAIRO_PATTERN_TYPE_LINEAR",
+ pattern_type_radial - "CAIRO_PATTERN_TYPE_RADIAL"
+]).
+
+%---------------------------------------------------------------------------%
+
+add_color_stop_rgb(Pattern, Offset, R, G, B, !IO) :-
+ add_color_stop_rgb_2(Pattern, Offset, R, G, B, !IO),
+ cairo.pattern_status(Pattern, Status, !IO),
+ (
+ Status = status_success
+ ;
+ ( Status = status_no_memory
+ ; Status = status_pattern_type_mismatch
+ ),
+ throw(cairo.error("pattern.add_color_stop_rgb/7", Status))
+ ).
+
+:- pred add_color_stop_rgb_2(pattern::in, float::in, float::in, float::in,
+ float::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ add_color_stop_rgb_2(Pattern::in, Offset::in, R::in, G::in, B::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_add_color_stop_rgb(Pattern->mcairo_raw_pattern,
+ Offset, R, G, B);
+").
+
+add_color_stop_rgba(Pattern, Offset, R, G, B, A, !IO) :-
+ add_color_stop_rgba_2(Pattern, Offset, R, G, B, A, !IO),
+ cairo.pattern_status(Pattern, Status, !IO),
+ (
+ Status = status_success
+ ;
+ ( Status = status_no_memory
+ ; Status = status_pattern_type_mismatch
+ ),
+ throw(cairo.error("pattern.add_color_stop_rgba/8", Status))
+ ).
+
+:- pred add_color_stop_rgba_2(pattern::in, float::in, float::in, float::in,
+ float::in, float::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ add_color_stop_rgba_2(Pattern::in, Offset::in,
+ R::in, G::in, B::in, A::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_add_color_stop_rgba(Pattern->mcairo_raw_pattern,
+ Offset, R, G, B, A);
+").
+
+:- pragma foreign_proc("C",
+ create_rgb(R::in, G::in, B::in, Pattern::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_t *raw_pattern;
+
+ raw_pattern = cairo_pattern_create_rgb(R, G, B);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ create_rgba(R::in, G::in, B::in, A::in, Pattern::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_t *raw_pattern;
+
+ raw_pattern = cairo_pattern_create_rgba(R, G, B, A);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ create_for_surface(Surface::in, Pattern::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_t *raw_pattern;
+ raw_pattern = cairo_pattern_create_for_surface(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ create_linear(X0::in, Y0::in, X1::in, Y1::in, Pattern::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_t *raw_pattern;
+
+ raw_pattern = cairo_pattern_create_linear(X0, Y0, X1, Y1);
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+:- pragma foreign_proc("C",
+ create_radial(Cx0::in, Cy0::in, Radius0::in,
+ Cx1::in, Cy1::in, Radius1::in,
+ Pattern::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_t *raw_pattern;
+
+ raw_pattern = cairo_pattern_create_radial(Cx0, Cy0, Radius0,
+ Cx1, Cy1, Radius1);
+
+ Pattern = MR_GC_NEW(MCAIRO_pattern);
+ Pattern->mcairo_raw_pattern = raw_pattern;
+ MR_GC_register_finalizer(Pattern, MCAIRO_finalize_pattern, 0);
+").
+
+
+:- pragma foreign_proc("C",
+ set_extend(Pattern::in, Extend::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_set_extend(Pattern->mcairo_raw_pattern, Extend);
+").
+
+:- pragma foreign_proc("C",
+ get_extend(Pattern::in, Extend::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Extend = cairo_pattern_get_extend(Pattern->mcairo_raw_pattern);
+").
+
+:- pragma foreign_proc("C",
+ set_filter(Pattern::in, Filter::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_set_filter(Pattern->mcairo_raw_pattern, Filter);
+").
+
+:- pragma foreign_proc("C",
+ get_filter(Pattern::in, Filter::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Filter = cairo_pattern_get_filter(Pattern->mcairo_raw_pattern);
+").
+
+:- pragma foreign_proc("C",
+ set_matrix(Pattern::in, Matrix::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_pattern_set_matrix(Pattern->mcairo_raw_pattern, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ get_matrix(Pattern::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_pattern_get_matrix(Pattern->mcairo_raw_pattern, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ get_type(Pattern::in, PatternType::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ PatternType = cairo_pattern_get_type(Pattern->mcairo_raw_pattern);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.pattern.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.pdf.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.pdf.m
diff -N graphics/mercury_cairo/cairo.pdf.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.pdf.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,174 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains support for rendering PDF documents.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.pdf.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+:- type pdf_surface.
+
+:- instance surface(pdf_surface).
+
+%---------------------------------------------------------------------------%
+
+ % pdf.have_pdf_surface:
+ % Succeeds if PDF surfaces are supported by this implementation.
+ %
+:- pred have_pdf_surface is semidet.
+
+ % pdf.create_surface(FileName, Height, Width, Surface, !IO):
+ % Surface is a PDF surface of the specified Height and Width in points
+ % to be written to FileName.
+ % Throws an unsupported_surface_error/0 exception if PDF surfaces are
+ % not supported by this implementation. Throws a cairo.error/0 exception
+ % if any other error occurs.
+ %
+:- pred create_surface(string::in, float::in, float::in, pdf_surface::out,
+ io::di, io::uo) is det.
+
+ % pdf.set_size(Surface, Height, Width, !IO):
+ % Change the size of a PDF surface for the current (and subsequent) pages.
+ %
+:- pred set_size(pdf_surface::in, float/*height*/::in, float/*width*/::in,
+ io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_decl("C", "
+
+#if defined(CAIRO_HAS_PDF_SURFACE)
+ #include <cairo-pdf.h>
+#endif
+
+").
+
+:- pragma foreign_type("C", pdf_surface, "MCAIRO_surface *",
+ [can_pass_as_mercury_type]).
+
+:- instance surface(pdf_surface) where [].
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ have_pdf_surface,
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(CAIRO_HAS_PDF_SURFACE)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%---------------------------------------------------------------------------%
+%
+% PDF surface creation
+%
+
+:- type maybe_pdf_surface
+ ---> pdf_surface_ok(pdf_surface)
+ ; pdf_surface_error(cairo.status)
+ ; pdf_surface_unsupported.
+
+:- pragma foreign_export("C", make_pdf_surface_ok(in) = out,
+ "MCAIRO_pdf_surface_ok").
+:- func make_pdf_surface_ok(pdf_surface) = maybe_pdf_surface.
+
+make_pdf_surface_ok(Surface) = pdf_surface_ok(Surface).
+
+:- pragma foreign_export("C", make_pdf_surface_error(in) = out,
+ "MCAIRO_pdf_surface_error").
+:- func make_pdf_surface_error(cairo.status) = maybe_pdf_surface.
+
+make_pdf_surface_error(Status) = pdf_surface_error(Status).
+
+:- pragma foreign_export("C", make_pdf_surface_unsupported = out,
+ "MCAIRO_pdf_surface_unsupported").
+:- func make_pdf_surface_unsupported = maybe_pdf_surface.
+
+make_pdf_surface_unsupported = pdf_surface_unsupported.
+
+create_surface(FileName, Height, Width, Surface, !IO) :-
+ create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ (
+ MaybeSurface = pdf_surface_ok(Surface)
+ ;
+ MaybeSurface = pdf_surface_error(ErrorStatus),
+ throw(cairo.error("pdf.create_surface/6", ErrorStatus))
+ ;
+ MaybeSurface = pdf_surface_unsupported,
+ throw(cairo.unsupported_surface_error("PDF"))
+ ).
+
+:- pred create_surface_2(string::in,
+ float::in, float::in, maybe_pdf_surface::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_PDF_SURFACE)
+
+ MCAIRO_surface *surface;
+ cairo_surface_t *raw_surface;
+ cairo_status_t status;
+
+ raw_surface = cairo_pdf_surface_create(FileName, H, W);
+ status = cairo_surface_status(raw_surface);
+
+ switch (status) {
+ case CAIRO_STATUS_SUCCESS:
+ surface = MR_GC_NEW(MCAIRO_surface);
+ surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
+ MaybeSurface = MCAIRO_pdf_surface_ok(surface);
+ break;
+
+ case CAIRO_STATUS_NULL_POINTER:
+ case CAIRO_STATUS_NO_MEMORY:
+ case CAIRO_STATUS_READ_ERROR:
+ case CAIRO_STATUS_INVALID_CONTENT:
+ case CAIRO_STATUS_INVALID_FORMAT:
+ case CAIRO_STATUS_INVALID_VISUAL:
+ MaybeSurface = MCAIRO_pdf_surface_error(status);
+ break;
+
+ default:
+ MR_fatal_error(\"cairo: unknown PDF surface status\");
+ }
+#else
+ MaybeSurface = MCAIRO_pdf_surface_unsupported();
+#endif
+").
+
+:- pragma foreign_proc("C",
+ set_size(Surface::in, Height::in, Width::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_PDF_SURFACE)
+ cairo_pdf_surface_set_size(Surface->mcairo_raw_surface,
+ Height, Width);
+#else
+ MR_fatal_error(\"Cairo PDF surface not available\");
+#endif
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.pdf.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.png.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.png.m
diff -N graphics/mercury_cairo/cairo.png.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.png.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,128 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains support for reading and writing PNG images.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.png.
+:- interface.
+
+:- import_module cairo.image.
+
+%---------------------------------------------------------------------------%
+
+ % Succeeds if the reading and writing PNG files is supported by
+ % this implementation.
+ %
+:- pred png_is_supported is semidet.
+
+ % png.image_surface_create_from_png(FileName, Surface, !IO):
+ % Surface is a new image surface whose contents are the PNG image
+ % from FileName.
+ % Throws a cairo.error/0 exception if an error occurs.
+ %
+:- pred image_surface_create_from_png(string::in, image_surface::out,
+ io::di, io::uo) is det.
+
+ % write_surface_to_png(Surface, FileName, !IO):
+ % Write the contents of Surface to a new file FileName as a PNG image.
+ % Throws a cairo.error/0 exception if an error occurs.
+ %
+:- pred write_surface_to_png(S::in, string::in,
+ io::di, io::uo) is det <= surface(S).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ png_is_supported,
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(CAIRO_HAS_PNG_FUNCTIONS)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%---------------------------------------------------------------------------%
+
+image_surface_create_from_png(FileName, Surface, !IO) :-
+ image_surface_create_from_png_2(FileName, Surface, !IO),
+ cairo.surface_status(Surface, Status, !IO),
+ (
+ Status = status_success
+ ;
+ ( Status = status_null_pointer
+ ; Status = status_no_memory
+ ; Status = status_read_error
+ ; Status = status_invalid_content
+ ; Status = status_invalid_format
+ ; Status = status_invalid_visual
+ ),
+ throw(cairo.error("png.image_surface_create_from_png/4", Status))
+ ).
+
+:- pred image_surface_create_from_png_2(string::in, image_surface::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ image_surface_create_from_png_2(FileName::in, Surface::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_t *raw_image;
+
+ raw_image = cairo_image_surface_create_from_png(FileName);
+ Surface = MR_GC_NEW(MCAIRO_surface);
+ Surface->mcairo_raw_surface = raw_image;
+ MR_GC_register_finalizer(Surface, MCAIRO_finalize_surface, 0);
+").
+
+%---------------------------------------------------------------------------%
+
+:- inst png_write_result
+ ---> status_success
+ ; status_no_memory
+ ; status_surface_type_mismatch
+ ; status_write_error.
+
+write_surface_to_png(Surface, FileName, !IO) :-
+ write_surface_to_png_2(Surface, FileName, Result, !IO),
+ (
+ Result = status_success
+ ;
+ ( Result = status_no_memory
+ ; Result = status_surface_type_mismatch
+ ; Result = status_write_error
+ ),
+ throw(cairo.error("png.write_surface_to_png/4", Result))
+ ).
+
+:- pred write_surface_to_png_2(S::in, string::in,
+ cairo.status::out(png_write_result), io::di, io::uo) is det <= surface(S).
+
+:- pragma foreign_proc("C",
+ write_surface_to_png_2(Surface::in, FileName::in,
+ Result::out(png_write_result), _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Result = cairo_surface_write_to_png(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, FileName);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.png.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.ps.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.ps.m
diff -N graphics/mercury_cairo/cairo.ps.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.ps.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,191 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module contains support for rendering PostScript documents.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.ps.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+:- type ps_surface.
+
+:- instance surface(ps_surface).
+
+%---------------------------------------------------------------------------%
+
+ % This type describes the language level of the PostScript Language
+ % Reference that a generated PostScript file will conform to.
+ %
+:- type ps_level
+ ---> ps_level_2
+ % The language level 2 of the PostScript specification.
+
+ ; ps_level_3.
+ % The language level 3 of the PostScript specification.
+
+%---------------------------------------------------------------------------%
+
+ % Succeeds if PostScript surfaces are supported by this implementation.
+ %
+:- pred have_ps_surface is semidet.
+
+ % ps.create_surface(FileName, Height, Width, Surface, !IO):
+ % Surface is a PostScript surface of the specified Height and Width in
+ % in points to be written to FileName.
+ % Throw an unsupported_surface_error/0 exception if PostScript surfaces
+ % are not supported by this implementation. Throws a cairo.error/0
+ % exception if any other error occurs.
+ %
+:- pred create_surface(string::in, float::in, float::in, ps_surface::out,
+ io::di, io::uo) is det.
+
+ % ps.restrict_to_level(Surface, Level, !IO):
+ % Restrict Surface to the given Level of the PostScript specification.
+ %
+:- pred restrict_to_level(ps_surface::in, ps_level::in,
+ io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_decl("C", "
+
+#if defined(CAIRO_HAS_PS_SURFACE)
+ #include <cairo-ps.h>
+#endif
+
+").
+
+:- pragma foreign_type("C", ps_surface, "MCAIRO_surface *",
+ [can_pass_as_mercury_type]).
+
+:- instance surface(ps_surface) where [].
+
+:- pragma foreign_enum("C", ps_level/0, [
+ ps_level_2 - "CAIRO_PS_LEVEL_2",
+ ps_level_3 - "CAIRO_PS_LEVEL_3"
+]).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ have_ps_surface,
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(CAIRO_HAS_PS_SURFACE)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+%
+% PostScript surface creation
+%
+
+:- type maybe_ps_surface
+ ---> ps_surface_ok(ps_surface)
+ ; ps_surface_error(cairo.status)
+ ; ps_surface_unsupported.
+
+:- pragma foreign_export("C", make_ps_surface_ok(in) = out,
+ "MCAIRO_ps_surface_ok").
+:- func make_ps_surface_ok(ps_surface) = maybe_ps_surface.
+
+make_ps_surface_ok(Surface) = ps_surface_ok(Surface).
+
+:- pragma foreign_export("C", make_ps_surface_error(in) = out,
+ "MCAIRO_ps_surface_error").
+:- func make_ps_surface_error(cairo.status) = maybe_ps_surface.
+
+make_ps_surface_error(Status) = ps_surface_error(Status).
+
+:- pragma foreign_export("C", make_ps_surface_unsupported = out,
+ "MCAIRO_ps_surface_unsupported").
+:- func make_ps_surface_unsupported = maybe_ps_surface.
+
+make_ps_surface_unsupported = ps_surface_unsupported.
+
+create_surface(FileName, Height, Width, Surface, !IO) :-
+ create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ (
+ MaybeSurface = ps_surface_ok(Surface)
+ ;
+ MaybeSurface = ps_surface_error(ErrorStatus),
+ throw(cairo.error("ps.create_surface/6", ErrorStatus))
+ ;
+ MaybeSurface = ps_surface_unsupported,
+ throw(cairo.unsupported_surface_error("PostScript"))
+ ).
+
+:- pred create_surface_2(string::in,
+ float::in, float::in, maybe_ps_surface::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_PS_SURFACE)
+
+ MCAIRO_surface *surface;
+ cairo_surface_t *raw_surface;
+ cairo_status_t status;
+
+ raw_surface = cairo_ps_surface_create(FileName, H, W);
+ status = cairo_surface_status(raw_surface);
+
+ switch (status) {
+ case CAIRO_STATUS_SUCCESS:
+ surface = MR_GC_NEW(MCAIRO_surface);
+ surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
+ MaybeSurface = MCAIRO_ps_surface_ok(surface);
+ break;
+
+ case CAIRO_STATUS_NULL_POINTER:
+ case CAIRO_STATUS_NO_MEMORY:
+ case CAIRO_STATUS_READ_ERROR:
+ case CAIRO_STATUS_INVALID_CONTENT:
+ case CAIRO_STATUS_INVALID_FORMAT:
+ case CAIRO_STATUS_INVALID_VISUAL:
+ MaybeSurface = MCAIRO_ps_surface_error(status);
+ break;
+
+ default:
+ MR_fatal_error(\"cairo: unknown PostScript surface status\");
+ }
+
+#else
+ MaybeSurface = MCAIRO_ps_surface_unsupported();
+#endif
+
+").
+
+:- pragma foreign_proc("C",
+ restrict_to_level(Surface::in, Level::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_PS_SURFACE)
+ cairo_ps_surface_restrict_to_level(Surface->mcairo_raw_surface, Level);
+#else
+ MR_fatal_error(\"Cairo PDF surface not available\");
+#endif
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.ps.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.surface.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.surface.m
diff -N graphics/mercury_cairo/cairo.surface.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.surface.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,198 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module provides various generic operations on cairo surfaces.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.surface.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+% NYI. create_surface_similar
+
+ % surface.finish(Surface, !IO):
+ % Finish Surface and drop all references to external resources.
+ %
+:- pred finish(S::in, io::di, io::uo) is det <= surface(S).
+
+ % surface.flush(Surface, !IO):
+ % Do any pending drawing of Surface and also restore any temporary
+ % modifications cairo has made to the surface's state.
+ %
+:- pred flush(S::in, io::di, io::uo) is det <= surface(S).
+
+ % surface.get_font_options(Surface, FontOptions, !IO):
+ % FontOptions is the default font rendering options for Surface.
+ %
+:- pred get_font_options(S::in, font_options::out, io::di, io::uo)
+ is det <= surface(S).
+
+ % surface.get_content(Surface, ContentType, !IO):
+ % ContentType is the content type of Surface.
+ %
+:- pred get_content(S::in, content::out, io::di, io::uo) is det <= surface(S).
+
+ % surface.mark_dirty(Surface, !IO):
+ % Tell cairo that drawing has been done to Surface using means other than
+ % cairo and that it should re-read any cached areas.
+ %
+:- pred mark_dirty(S::in, io::di, io::uo) is det <= surface(S).
+
+ % surface.mark_dirty_rectangle(Surface, X, Y, Width, Height, !IO):
+ % XXX - rest of documentation.
+:- pred mark_dirty_rectangle(S::in, int::in, int::in, int::in, int::in,
+ io::di, io::uo) is det <= surface(S).
+
+ % surface.set_device_offset(Surface, X, Y, !IO):
+ % Sets an offset, X (Y) in divice units in that X (Y) direction, that is
+ % added to the device coordinates determined by the current transformation
+ % matrix when drawing to Surface.
+ %
+:- pred set_device_offset(S::in, float::in, float::in,
+ io::di, io::uo) is det <= surface(S).
+
+ % surface.get_device_offset(Surface, X, Y, !IO):
+ % Return the device offsets set by the above.
+ %
+:- pred get_device_offset(S::in, float::out, float::out,
+ io::di, io::uo) is det <= surface(S).
+
+ % surface.set_fallback_resolution(Surface, X, Y, !IO):
+ % Set the horizontal and vertical resolution for image fallbacks.
+ %
+:- pred set_fallback_resolution(S::in, float::in, float::in, io::di, io::uo)
+ is det <= surface(S).
+
+ % suface.get_fallback_resultion(Surface, X, Y, !IO):
+ % Get the current fallback resolution for Surface.
+ %
+:- pred get_fallback_resolution(S::in, float::out, float::out, io::di, io::uo)
+ is det <= surface(S).
+
+ % surface.copy_page(Surface, !IO):
+ %
+:- pred copy_page(S::in, io::di, io::uo) is det <= surface(S).
+
+ % surface.show_page(Surface, !IO):
+ %
+:- pred show_page(S::in, io::di, io::uo) is det <= surface(S).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_proc("C",
+ finish(Surface::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_finish(((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ flush(Surface::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_flush(((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ get_font_options(Surface::in, FntOpts::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_t *raw_font_options;
+
+ raw_font_options = cairo_font_options_create();
+ cairo_surface_get_font_options(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface,
+ raw_font_options);
+ FntOpts = MR_GC_NEW(MCAIRO_font_options);
+ FntOpts->mcairo_raw_font_options = raw_font_options;
+ MR_GC_register_finalizer(FntOpts, MCAIRO_finalize_font_options, 0);
+").
+
+:- pragma foreign_proc("C",
+ get_content(Surface::in, Content::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Content = cairo_surface_get_content(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ mark_dirty(Surface::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_mark_dirty(((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+
+:- pragma foreign_proc("C",
+ mark_dirty_rectangle(Surface::in, X::in, Y::in, Width::in, Height::in,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_mark_dirty_rectangle(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, X, Y, Width, Height);
+").
+
+:- pragma foreign_proc("C",
+ set_device_offset(Surface::in, X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_set_device_offset(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, X, Y);
+").
+
+:- pragma foreign_proc("C",
+ get_device_offset(Surface::in, X::out, Y::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_get_device_offset(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, &X, &Y);
+").
+
+:- pragma foreign_proc("C",
+ set_fallback_resolution(Surface::in, X::in, Y::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_set_fallback_resolution(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, X, Y);
+").
+
+:- pragma foreign_proc("C",
+ get_fallback_resolution(Surface::in, X::out, Y::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_get_fallback_resolution(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface, &X, &Y);
+").
+
+:- pragma foreign_proc("C",
+ copy_page(Surface::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_copy_page(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+:- pragma foreign_proc("C",
+ show_page(Surface::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_surface_show_page(
+ ((MCAIRO_surface *)Surface)->mcairo_raw_surface);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.surface.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.svg.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.svg.m
diff -N graphics/mercury_cairo/cairo.svg.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.svg.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,171 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This module provides SVG surfaces, which allow rendering to SVG documents.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.svg.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+:- type svg_surface.
+
+:- instance surface(svg_surface).
+
+ % The version number of the SVG specification that a generated SVG file
+ % will conform to.
+ %
+:- type svg_version
+ ---> svg_version_1_1
+ % Version 1.1 of the SVG specification.
+
+ ; svg_version_1_2.
+ % Version 1.2 of the SVG specification.
+
+%---------------------------------------------------------------------------%
+
+ % Succeeds if SVG surfaces are supported by this implementation.
+ %
+:- pred have_svg_surface is semidet.
+
+ % svg.create_surface(FileName, Width, Height, Surface, !IO):
+ % Surface is an SVG surface of the specified Width and Height in points
+ % to be written to FileName.
+ %
+:- pred create_surface(string::in, int::in, int::in, svg_surface::out,
+ io::di, io::uo) is det.
+
+% restrict_to_version
+% get_versions
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_decl("C", "
+
+#if defined(CAIRO_HAS_SVG_SURFACE)
+ #include <cairo-svg.h>
+#endif
+
+").
+
+:- pragma foreign_type("C", svg_surface, "MCAIRO_surface *",
+ [can_pass_as_mercury_type]).
+
+:- instance surface(svg_surface) where [].
+
+:- pragma foreign_enum("C", svg_version/0, [
+ svg_version_1_1 - "CAIRO_SVG_VERSION_1_1",
+ svg_version_1_2 - "CAIRO_SVG_VERSION_1_2"
+]).
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ have_svg_surface,
+ [promise_pure, will_not_call_mercury],
+"
+#if defined(CAIRO_HAS_SVG_SURFACE)
+ SUCCESS_INDICATOR = MR_TRUE;
+#else
+ SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%---------------------------------------------------------------------------%
+%
+% SVG surface creation
+%
+
+:- type maybe_svg_surface
+ ---> svg_surface_ok(svg_surface)
+ ; svg_surface_error(cairo.status)
+ ; svg_surface_unsupported.
+
+:- pragma foreign_export("C", make_svg_surface_ok(in) = out,
+ "MCAIRO_svg_surface_ok").
+:- func make_svg_surface_ok(svg_surface) = maybe_svg_surface.
+
+make_svg_surface_ok(Surface) = svg_surface_ok(Surface).
+
+:- pragma foreign_export("C", make_svg_surface_error(in) = out,
+ "MCAIRO_svg_surface_error").
+:- func make_svg_surface_error(cairo.status) = maybe_svg_surface.
+
+make_svg_surface_error(Status) = svg_surface_error(Status).
+
+:- pragma foreign_export("C", make_svg_surface_unsupported = out,
+ "MCAIRO_svg_surface_usupported").
+:- func make_svg_surface_unsupported = maybe_svg_surface.
+
+make_svg_surface_unsupported = svg_surface_unsupported.
+
+create_surface(FileName, Height, Width, Surface, !IO) :-
+ create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ (
+ MaybeSurface = svg_surface_ok(Surface)
+ ;
+ MaybeSurface = svg_surface_error(ErrorStatus),
+ throw(cairo.error("svg.create_surface/6", ErrorStatus))
+ ;
+ MaybeSurface = svg_surface_unsupported,
+ throw(cairo.unsupported_surface_error("SVG"))
+ ).
+
+:- pred create_surface_2(string::in, int::in, int::in, maybe_svg_surface::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_SVG_SURFACE)
+
+ MCAIRO_surface *surface;
+ cairo_surface_t *raw_surface;
+ cairo_status_t status;
+
+ raw_surface = cairo_svg_surface_create(FileName, (int)H, (int)W);
+ status = cairo_surface_status(raw_surface);
+
+ switch (status) {
+ case CAIRO_STATUS_SUCCESS:
+ surface = MR_GC_NEW(MCAIRO_surface);
+ surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
+ MaybeSurface = MCAIRO_svg_surface_ok(surface);
+ break;
+
+ case CAIRO_STATUS_NULL_POINTER:
+ case CAIRO_STATUS_NO_MEMORY:
+ case CAIRO_STATUS_READ_ERROR:
+ case CAIRO_STATUS_INVALID_CONTENT:
+ case CAIRO_STATUS_INVALID_FORMAT:
+ case CAIRO_STATUS_INVALID_VISUAL:
+ MaybeSurface = MCAIRO_svg_surface_error(status);
+ break;
+
+ default:
+ MR_fatal_error(\"cairo: unknown SVG surface status\");
+ }
+#else
+ MaybeSurface = MCAIRO_svg_surface_unsupported();
+#endif
+
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.svg.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.text.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.text.m
diff -N graphics/mercury_cairo/cairo.text.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.text.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,318 @@
+%----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%----------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% This sub-module provides support for rendering text.
+%
+%----------------------------------------------------------------------------%
+
+:- module cairo.text.
+:- interface.
+
+%----------------------------------------------------------------------------%
+
+ % Specifies variants of a font face based upon their slant.
+ %
+:- type font_slant
+ ---> slant_normal
+ ; slant_italic
+ ; slant_oblique.
+
+ % Specifies variants of a font face based on their weight.
+ %
+:- type font_weight
+ ---> weight_normal
+ ; weight_bold.
+
+:- type font_family == string.
+
+ % The extents of a text string in user-space.
+ %
+:- type text_extents
+ ---> text_extents(
+ te_x_bearing :: float,
+ te_y_bearing :: float,
+ te_width :: float,
+ te_height :: float,
+ te_x_advance :: float,
+ te_y_advance :: float
+ ).
+
+:- type font_extents
+ ---> font_extents(
+ fe_ascent :: float,
+ fe_descent :: float,
+ fe_height :: float,
+ fe_max_x_advance :: float,
+ fe_max_y_advance :: float
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % text.select_font_face(Context, Family, Slant, Weight, !IO):
+ % Selects a family and style of font from a simplified description as a
+ % Family name, Slant and Weight.
+ %
+:- pred select_font_face(context(T)::in, font_family::in, font_slant::in,
+ font_weight::in, io::di, io::uo) is det.
+
+ % text.set_font_size(Context, Size, !IO):
+ % Sets the current font matrix to a scale by a factor of Size.
+ %
+:- pred set_font_size(context(S)::in, float::in, io::di, io::uo) is det.
+
+ % text.set_font_matrix(Context, Matrix, !IO):
+ % Set the current font matrix for Context to Matrix.
+ %
+:- pred set_font_matrix(context(S)::in, matrix::in, io::di, io::uo) is det.
+
+ % text.get_font_matrix(Context, Matrix, !IO):
+ % Matrix is the current font matrix for Context.
+ %
+:- pred get_font_matrix(context(S)::in, matrix::out, io::di, io::uo) is det.
+
+ % text.set_font_options(Context, FontOptions, !IO):
+ % Set the custom font rendering options for Context to FontOptions.
+ %
+:- pred set_font_options(context(S)::in, font_options::in,
+ io::di, io::uo) is det.
+
+ % text.get_font_options(Context, FontOptions, !IO):
+ % FontOptions are the custom font rendering options for Context.
+ %
+:- pred get_font_options(context(S)::in, font_options::out,
+ io::di, io::uo) is det.
+
+ % text.set_font_face(Context, FontFace, !IO):
+ % Replace the current font face for Context with FontFace.
+ %
+:- pred set_font_face(context(S)::in, F::in, io::di, io::uo) is det
+ <= font_face(F).
+
+ % text.get_font_face(Context, FontFace, !IO):
+ % FontFace is the current font face for Context.
+ %
+:- some [F] pred get_font_face(context(S)::in, F::out, io::di, io::uo) is det
+ => font_face(F).
+
+ % text.show_text(Context, Text, !IO):
+ %
+:- pred show_text(context(S)::in, string::in, io::di, io::uo) is det.
+
+:- pred font_extents(context(S)::in, font_extents::out, io::di, io::uo)
+ is det.
+
+ % text.extents(Context, String, Extents, !IO):
+ % Extents is the text extents of String.
+ %
+:- pred text_extents(context(S)::in, string::in, text_extents::out,
+ io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%
+% The "toy" font face
+%
+
+:- type toy_font_face.
+
+:- instance font_face(toy_font_face).
+
+ % toy_font_face_create(Family::in, Slant::in, FontFace::out, !IO):
+ %
+:- pred toy_font_face_create(string::in, font_slant::in, font_weight::in,
+ toy_font_face::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_enum("C", font_slant/0, [
+ slant_normal - "CAIRO_FONT_SLANT_NORMAL",
+ slant_italic - "CAIRO_FONT_SLANT_ITALIC",
+ slant_oblique - "CAIRO_FONT_SLANT_OBLIQUE"
+]).
+
+:- pragma foreign_enum("C", font_weight/0, [
+ weight_normal - "CAIRO_FONT_WEIGHT_NORMAL",
+ weight_bold - "CAIRO_FONT_WEIGHT_BOLD"
+]).
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ set_font_size(Context::in, Size::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_font_size(Context->mcairo_raw_context, Size);
+").
+
+select_font_face(Context, Family, Slant, Weight, !IO) :-
+ % Calling the cairo_set_font_face() directly won't keep the cached
+ % copy of the font face up-to-date.
+ cairo.text.toy_font_face_create(Family, Slant, Weight, FF, !IO),
+ cairo.text.set_font_face(Context, FF, !IO).
+
+:- pragma foreign_proc("C",
+ set_font_matrix(Ctxt::in, Matrix::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_set_font_matrix(Ctxt->mcairo_raw_context, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ get_font_matrix(Ctxt::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_matrix_t *font_matrix;
+
+ font_matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_get_font_matrix(Ctxt->mcairo_raw_context, font_matrix);
+ Matrix = font_matrix;
+").
+
+:- pragma foreign_proc("C",
+ show_text(Ctxt::in, Text::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_show_text(Ctxt->mcairo_raw_context, Text);
+").
+
+:- pragma foreign_proc("C",
+ set_font_options(Ctxt::in, FntOpts::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_set_font_options(Ctxt->mcairo_raw_context,
+ FntOpts->mcairo_raw_font_options);
+").
+
+:- pragma foreign_proc("C",
+ get_font_options(Ctxt::in, FntOpts::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_options_t *raw_font_options;
+ raw_font_options = cairo_font_options_create();
+ cairo_get_font_options(Ctxt->mcairo_raw_context, raw_font_options);
+ FntOpts = MR_GC_NEW(MCAIRO_font_options);
+ FntOpts->mcairo_raw_font_options = raw_font_options;
+ MR_GC_register_finalizer(FntOpts, MCAIRO_finalize_font_options, 0);
+").
+
+set_font_face(Context, FF, !IO) :-
+ CachedFF = 'new font_face_container'(FF),
+ set_font_face_2(Context, FF, CachedFF, !IO).
+
+:- pred set_font_face_2(context(S)::in, F::in,
+ font_face_container::in, _IO0::di, _IO::uo) is det.
+
+:- pragma foreign_proc("C",
+ set_font_face_2(Ctxt::in, FF::in, CachedFF::in, _IO::di, _IO0::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_set_font_face(Ctxt->mcairo_raw_context,
+ ((MCAIRO_font_face *)FF)->mcairo_raw_font_face);
+ Ctxt->mcairo_cached_font_face = CachedFF;
+").
+
+get_font_face(Context, FF, !IO) :-
+ get_cached_font_face(Context, CachedFF, !IO),
+ % TODO: we should have a sanity check that cairo's current
+ % font face is the same as the one we cached.
+ CachedFF = font_face_container(FF).
+
+:- pred get_cached_font_face(context(S)::in, font_face_container::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ get_cached_font_face(Ctxt::in, CachedFF::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ CachedFF = Ctxt->mcairo_cached_font_face;
+").
+
+font_extents(Context, Extents, !IO) :-
+ font_extents_2(Context, Ascent, Descent, Height, MaxXAdv, MaxYAdv, !IO),
+ Extents = font_extents(
+ Ascent,
+ Descent,
+ Height,
+ MaxXAdv,
+ MaxYAdv).
+
+:- pred font_extents_2(context(S)::in, float::out, float::out, float::out,
+ float::out, float::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ font_extents_2(Ctxt::in, Ascent::out, Descent::out, Height::out,
+ MaxXAdv::out, MaxYAdv::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_font_extents_t extents;
+ cairo_font_extents(Ctxt->mcairo_raw_context, &extents);
+
+ Ascent = extents.ascent;
+ Descent = extents.descent;
+ Height = extents.height;
+ MaxXAdv = extents.max_x_advance;
+ MaxYAdv = extents.max_y_advance;
+").
+
+text_extents(Context, String, Extents, !IO) :-
+ text_extents_2(Context, String, X_Bearing, Y_Bearing, Width, Height,
+ X_Advance, Y_Advance, !IO),
+ Extents = text_extents(
+ X_Bearing,
+ Y_Bearing,
+ Width,
+ Height,
+ X_Advance,
+ Y_Advance).
+
+:- pred text_extents_2(context(T)::in, string::in, float::out, float::out,
+ float::out, float::out, float::out, float::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ text_extents_2(Ctxt::in, Str::in, X_Bearing::out, Y_Bearing::out,
+ Width::out, Height::out, X_Advance::out, Y_Advance::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury],
+"
+ cairo_text_extents_t extents;
+ cairo_text_extents(Ctxt->mcairo_raw_context, Str, &extents);
+
+ X_Bearing = extents.x_bearing;
+ Y_Bearing = extents.y_bearing;
+ Width = extents.width;
+ Height = extents.height;
+ X_Advance = extents.x_advance;
+ Y_Advance = extents.y_advance;
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_type("C", toy_font_face, "MCAIRO_font_face *").
+
+:- instance font_face(toy_font_face) where [].
+
+:- pragma foreign_proc("C",
+ toy_font_face_create(Family::in, Slant::in, Weight::in, FontFace::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_font_face_t *raw_font_face;
+
+ raw_font_face = cairo_toy_font_face_create(Family, Slant, Weight);
+ FontFace = MR_GC_NEW(MCAIRO_font_face);
+ FontFace->mcairo_raw_font_face = raw_font_face;
+ MR_GC_register_finalizer(FontFace, MCAIRO_finalize_font_face, 0);
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.text.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/cairo.transformations.m
===================================================================
RCS file: graphics/mercury_cairo/cairo.transformations.m
diff -N graphics/mercury_cairo/cairo.transformations.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/cairo.transformations.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,214 @@
+%----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%----------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: Julien Fischer <juliensf at csse.unimelb.edu.au>
+%
+% The predicates in this sub-module manipulate a cairo context's current
+% transformation matrix.
+%
+%-----------------------------------------------------------------------------%
+
+:- module cairo.transformations.
+:- interface.
+
+%-----------------------------------------------------------------------------%
+
+ % transformations.translate(Context, Tx, Ty, !IO):
+ % Modifies the current transformation matrix for Context by translating the
+ % user space origin by (Tx, Ty).
+ %
+:- pred translate(context(T)::in, float::in, float::in, io::di, io::uo) is det.
+
+ % transformations.scale(Context, Sx, Sy, !IO):
+ % Modifies the current transformation matrix for Context by scaling the X
+ % and Y user space axes by Sx and Sy respectively.
+ %
+:- pred scale(context(T)::in, float::in, float::in, io::di, io::uo) is det.
+
+ % transformations.rotate(Context, Angle, !IO):
+ % Modifies the current transformation matrix for context by rotating the
+ % user space axes by Angle radians.
+ %
+:- pred rotate(context(T)::in, float::in, io::di, io::uo) is det.
+
+ % transformations.transform(Context, Matrix, !IO):
+ % Modifies the current transformation matrix for Context by applying
+ % Matrix as an additional transformation.
+ % The new transformation of user space takes place after any existing
+ % transformation.
+ %
+:- pred transform(context(T)::in, matrix::in, io::di, io::uo) is det.
+
+ % transformations.set_matrix(Context, Matrix, !IO):
+ % Set the current transformation matrix for Context to Matrix.
+ %
+:- pred set_matrix(context(T)::in, matrix::in, io::di, io::uo) is det.
+
+ % transformations.get_matrix(Context, Matrix, !IO):
+ % Matrix is the current transformation matrix for Context.
+ %
+:- pred get_matrix(context(T)::in, matrix::out, io::di, io::uo) is det.
+
+ % transformations.identity_matrix(Context, !IO):
+ % Reset the current transformation matrix for Context by setting
+ % it equal to the identity matrix.
+ %
+:- pred identity_matrix(context(T)::in, io::di, io::uo) is det.
+
+ % transformations.user_to_device(Context, X_usr, Y_usr,
+ % X_dev, Y_dev, !IO):
+ %
+ % Transform a coordinate from user space to device space.
+ %
+:- pred user_to_device(context(T)::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % transformations.user_to_device_distance(Context, DX_usr, DY_usr,
+ % DX_dev, DY_dev, !IO):
+ %
+ % Transform a distance vector from device space to user space.
+ %
+:- pred user_to_device_distance(context(T)::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % transformations.device_to_user(Context, X_dev, Y_dev,
+ % X_usr, Y_usr, !IO):
+ %
+ % Transform a coordinate from device space to user space.
+ %
+:- pred device_to_user(context(T)::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+ % transformations.device_to_user_distance(Context, DX_dev, DY_dev,
+ % DX_usr, DY_usr, !IO):
+ %
+ % Transform a distance vector from device space to user space.
+ %
+:- pred device_to_user_distance(context(T)::in, float::in, float::in,
+ float::out, float::out, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ translate(Ctxt::in, Tx::in, Ty::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_translate(Ctxt->mcairo_raw_context, Tx, Ty);
+").
+
+:- pragma foreign_proc("C",
+ scale(Ctxt::in, Sx::in, Sy::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_scale(Ctxt->mcairo_raw_context, Sx, Sy);
+").
+
+:- pragma foreign_proc("C",
+ rotate(Ctxt::in, Angle::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_rotate(Ctxt->mcairo_raw_context, Angle);
+").
+
+:- pragma foreign_proc("C",
+ transform(Ctxt::in, Matrix::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_transform(Ctxt->mcairo_raw_context, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ set_matrix(Ctxt::in, Matrix::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_set_matrix(Ctxt->mcairo_raw_context, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ get_matrix(Ctxt::in, Matrix::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ Matrix = MR_GC_NEW(cairo_matrix_t);
+ cairo_get_matrix(Ctxt->mcairo_raw_context, Matrix);
+").
+
+:- pragma foreign_proc("C",
+ identity_matrix(Ctxt::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ cairo_identity_matrix(Ctxt->mcairo_raw_context);
+").
+
+:- pragma foreign_proc("C",
+ user_to_device(Ctxt::in, Ux::in, Uy::in, Dx::out, Dy::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ MR_Float x;
+ MR_Float y;
+
+ x = Ux;
+ y = Uy;
+ cairo_user_to_device(Ctxt->mcairo_raw_context, &x, &y);
+ Dx = x;
+ Dy = y;
+").
+
+:- pragma foreign_proc("C",
+ user_to_device_distance(Ctxt::in, Ux::in, Uy::in, Dx::out, Dy::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ MR_Float x;
+ MR_Float y;
+
+ x = Ux;
+ y = Uy;
+ cairo_user_to_device_distance(Ctxt->mcairo_raw_context, &x, &y);
+ Dx = x;
+ Dy = y;
+").
+
+:- pragma foreign_proc("C",
+ device_to_user(Ctxt::in, Dx::in, Dy::in, Ux::out, Uy::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ MR_Float x;
+ MR_Float y;
+
+ x = Dx;
+ y = Dy;
+ cairo_device_to_user(Ctxt->mcairo_raw_context, &x, &y);
+ Ux = x;
+ Uy = y;
+").
+
+:- pragma foreign_proc("C",
+ device_to_user_distance(Ctxt::in, Dx::in, Dy::in, Ux::out, Uy::out,
+ _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+ MR_Float x;
+ MR_Float y;
+
+ x = Dx;
+ y = Dy;
+ cairo_device_to_user_distance(Ctxt->mcairo_raw_context, &x, &y);
+ Ux = x;
+ Uy = y;
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.transformations.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/mercury_cairo.m
===================================================================
RCS file: graphics/mercury_cairo/mercury_cairo.m
diff -N graphics/mercury_cairo/mercury_cairo.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/mercury_cairo.m 5 Sep 2010 14:18:39 -0000
@@ -0,0 +1,18 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2010 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+
+:- module mercury_cairo.
+:- interface.
+
+%---------------------------------------------------------------------------%
+
+:- import_module cairo.
+
+%---------------------------------------------------------------------------%
+:- end_module mercury_cairo.
+%---------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/arc.m
===================================================================
RCS file: graphics/mercury_cairo/samples/arc.m
diff -N graphics/mercury_cairo/samples/arc.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/arc.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,55 @@
+:- module arc.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ XC = 128.0,
+ YC = 128.0,
+ Radius = 100.0,
+ Angle1 = 45.0 * (pi / 180.0), % Angles are specified
+ Angle2 = 180.0 * (pi / 180.0), % in radians.
+
+ cairo.set_line_width(Context, 10.0, !IO),
+ cairo.path.arc(Context, XC, YC, Radius, Angle1, Angle2, !IO),
+ cairo.stroke(Context, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgba(Context, 1.0, 0.2, 0.2, 0.6, !IO),
+ cairo.set_line_width(Context, 6.0, !IO),
+
+ cairo.path.arc(Context, XC, YC, 10.0, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.path.arc(Context, XC, YC, Radius, Angle1, Angle1, !IO),
+ cairo.path.line_to(Context, XC, YC, !IO),
+
+ cairo.path.arc(Context, XC, YC, Radius, Angle2, Angle2, !IO),
+ cairo.path.line_to(Context, XC, YC, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "arc.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module arc.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/arc_negative.m
===================================================================
RCS file: graphics/mercury_cairo/samples/arc_negative.m
diff -N graphics/mercury_cairo/samples/arc_negative.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/arc_negative.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,55 @@
+:- module arc_negative.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ XC = 128.0,
+ YC = 128.0,
+ Radius = 100.0,
+ Angle1 = 45.0 * (pi / 180.0), % Angles are specified
+ Angle2 = 180.0 * (pi / 180.0), % in radians.
+
+ cairo.set_line_width(Context, 10.0, !IO),
+ cairo.path.arc_negative(Context, XC, YC, Radius, Angle1, Angle2, !IO),
+ cairo.stroke(Context, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgba(Context, 1.0, 0.2, 0.2, 0.6, !IO),
+ cairo.set_line_width(Context, 6.0, !IO),
+
+ cairo.path.arc(Context, XC, YC, 10.0, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.path.arc(Context, XC, YC, Radius, Angle1, Angle1, !IO),
+ cairo.path.line_to(Context, XC, YC, !IO),
+
+ cairo.path.arc(Context, XC, YC, Radius, Angle2, Angle2, !IO),
+ cairo.path.line_to(Context, XC, YC, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "arc_negative.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module arc_negative.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/clip.m
===================================================================
RCS file: graphics/mercury_cairo/samples/clip.m
diff -N graphics/mercury_cairo/samples/clip.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/clip.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,47 @@
+:- module clip.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ path.arc(Context, 128.0, 128.0, 76.8, 0.0, 2.0 * pi, !IO),
+ cairo.clip(Context, !IO),
+
+ new_path(Context, !IO), % Current path is not consumed
+ % by cairo.clip/3.
+
+ path.rectangle(Context, 0.0, 0.0, 256.0, 256.0, !IO),
+ cairo.fill(Context, !IO),
+ cairo.set_source_rgb(Context, 0.0, 1.0, 0.0, !IO),
+ path.move_to(Context, 0.0, 0.0, !IO),
+ path.line_to(Context, 256.0, 256.0, !IO),
+ path.move_to(Context, 256.0, 0.0, !IO),
+ path.line_to(Context, 0.0, 256.0, !IO),
+ cairo.set_line_width(Context, 10.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "clip.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module clip.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/clip_image.m
===================================================================
RCS file: graphics/mercury_cairo/samples/clip_image.m
diff -N graphics/mercury_cairo/samples/clip_image.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/clip_image.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,44 @@
+:- module clip_image.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ path.arc(Context, 128.0, 128.0, 76.8, 0.0, 2.0 * pi, !IO),
+ cairo.clip(Context, !IO),
+ new_path(Context, !IO), % Path not consumed by clip/3.
+
+ image_surface_create_from_png("data/romedalen.png", Image, !IO),
+ image.get_width(Image, W, !IO),
+ image.get_height(Image, H, !IO),
+
+ cairo.transformations.scale(Context, 256.0 / float(W), 256.0 / float(H), !IO),
+ cairo.set_source_surface(Context, Image, 0.0, 0.0, !IO),
+ cairo.paint(Context, !IO),
+
+ write_surface_to_png(Surface, "clip_image.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module clip_image.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/curve_to.m
===================================================================
RCS file: graphics/mercury_cairo/samples/curve_to.m
diff -N graphics/mercury_cairo/samples/curve_to.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/curve_to.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,48 @@
+:- module curve_to.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ X = 25.6, Y = 128.0,
+ X1 = 102.4, Y1 = 230.4,
+ X2 = 153.6, Y2 = 25.6,
+ X3 = 230.4, Y3 = 128.0,
+
+ path.move_to(Context, X, Y, !IO),
+ path.curve_to(Context, X1, Y1, X2, Y2, X3, Y3, !IO),
+
+ cairo.set_line_width(Context, 10.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ cairo.set_source_rgba(Context, 1.0, 0.2, 0.2, 0.6, !IO),
+ cairo.set_line_width(Context, 6.0, !IO),
+ path.move_to(Context, X, Y, !IO),
+ path.line_to(Context, X1, Y1, !IO),
+ path.move_to(Context, X2, Y2, !IO),
+ path.line_to(Context, X3, Y3, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "curve_to.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module curve_to.
+%----------------------------------------------------------------------------%
+
Index: graphics/mercury_cairo/samples/dash.m
===================================================================
RCS file: graphics/mercury_cairo/samples/dash.m
diff -N graphics/mercury_cairo/samples/dash.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/dash.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,45 @@
+:- module dash.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module list.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ Dashes = [50.0, 10.0, 10.0, 10.0],
+ OffSet = -50.0,
+
+ cairo.set_dash(Context, Dashes, OffSet, !IO),
+ cairo.set_line_width(Context, 10.0, !IO),
+
+ cairo.path.move_to(Context, 128.0, 25.6, !IO),
+ cairo.path.line_to(Context, 230.4, 230.4, !IO),
+ cairo.path.rel_line_to(Context, -102.4, 0.0, !IO),
+ cairo.path.curve_to(Context, 51.2, 230.4, 51.2, 128.0, 128.0, 128.0,
+ !IO),
+
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "dash.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module dash.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/fill_and_stroke2.m
===================================================================
RCS file: graphics/mercury_cairo/samples/fill_and_stroke2.m
diff -N graphics/mercury_cairo/samples/fill_and_stroke2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/fill_and_stroke2.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,49 @@
+:- module fill_and_stroke2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ path.move_to(Context, 128.0, 25.6, !IO),
+ path.line_to(Context, 230.4, 230.4, !IO),
+ path.rel_line_to(Context, -102.4, 0.0, !IO),
+ path.curve_to(Context, 51.2, 230.4, 51.2, 128.0, 128.0, 128.0, !IO),
+ path.close_path(Context, !IO),
+
+ path.move_to(Context, 64.0, 25.6, !IO),
+ path.rel_line_to(Context, 51.2, 51.2, !IO),
+ path.rel_line_to(Context, -51.2, 51.2, !IO),
+ path.rel_line_to(Context, -51.2, -51.2, !IO),
+ path.close_path(Context, !IO),
+
+ cairo.set_line_width(Context, 10.0, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 1.0, !IO),
+ cairo.fill_preserve(Context, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "fill_and_stroke2.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module fill_and_stroke2.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/fill_style.m
===================================================================
RCS file: graphics/mercury_cairo/samples/fill_style.m
diff -N graphics/mercury_cairo/samples/fill_style.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/fill_style.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,60 @@
+:- module fill_style.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ cairo.set_line_width(Context, 6.0, !IO),
+
+ path.rectangle(Context, 12.0, 12.0, 232.0, 70.0, !IO),
+ path.new_sub_path(Context, !IO),
+ path.arc(Context, 64.0, 64.0, 40.0, 0.0, 2.0 * pi, !IO),
+ path.new_sub_path(Context, !IO),
+ path.arc_negative(Context, 192.0, 64.0, 40.0, 0.0, -2.0 * pi, !IO),
+
+ cairo.set_fill_rule(Context, fill_rule_even_odd, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.7, 0.0, !IO),
+ cairo.fill_preserve(Context, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ transformations.translate(Context, 0.0, 128.0, !IO),
+ path.rectangle(Context, 12.0, 12.0, 232.0, 70.0, !IO),
+ path.new_sub_path(Context, !IO),
+ path.arc(Context, 64.0, 64.0, 40.0, 0.0, 2.0 * pi, !IO),
+ path.new_sub_path(Context, !IO),
+ path.arc_negative(Context, 192.0, 64.0, 40.0, 0.0, -2.0 * pi,
+ !IO),
+
+ cairo.set_fill_rule(Context, fill_rule_winding, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.9, !IO),
+ cairo.fill_preserve(Context, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "fill_style.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module fill_style.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/gradient.m
===================================================================
RCS file: graphics/mercury_cairo/samples/gradient.m
diff -N graphics/mercury_cairo/samples/gradient.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/gradient.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,47 @@
+:- module gradient.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.pattern.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ pattern.create_linear(0.0, 0.0, 0.0, 256.0, LinPat, !IO),
+ pattern.add_color_stop_rgba(LinPat, 1.0, 0.0, 0.0, 0.0, 1.0, !IO),
+ pattern.add_color_stop_rgba(LinPat, 0.0, 1.0, 1.0, 1.0, 1.0, !IO),
+ path.rectangle(Context, 0.0, 0.0, 256.0, 256.0, !IO),
+ cairo.set_source(Context, LinPat, !IO),
+ cairo.fill(Context, !IO),
+
+ pattern.create_radial(115.2, 102.4, 25.6, 102.4, 102.4, 128.0,
+ RadPat, !IO),
+ pattern.add_color_stop_rgba(RadPat, 0.0, 1.0, 1.0, 1.0, 1.0, !IO),
+ pattern.add_color_stop_rgba(RadPat, 1.0, 0.0, 0.0, 0.0, 1.0, !IO),
+ cairo.set_source(Context, RadPat, !IO),
+ path.arc(Context, 128.0, 128.0, 76.8, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+
+ write_surface_to_png(Surface, "gradient.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module gradient.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/hello.m
===================================================================
RCS file: graphics/mercury_cairo/samples/hello.m
diff -N graphics/mercury_cairo/samples/hello.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/hello.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,38 @@
+%-----------------------------------------------------------------------------%
+
+:- module hello.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 240, 80, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.text.select_font_face(Context, "serif", slant_normal, weight_bold,
+ !IO),
+ cairo.text.set_font_size(Context, 32.0, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 1.0, !IO),
+ cairo.path.move_to(Context, 10.0, 50.0, !IO),
+ cairo.text.show_text(Context, "Hello World", !IO),
+ write_surface_to_png(Surface, "hello.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module hello.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/image.m
===================================================================
RCS file: graphics/mercury_cairo/samples/image.m
diff -N graphics/mercury_cairo/samples/image.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/image.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,43 @@
+:- module image.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ image_surface_create_from_png("data/romedalen.png", Image, !IO),
+ image.get_width(Image, W, !IO),
+ image.get_height(Image, H, !IO),
+
+ cairo.transformations.translate(Context, 128.0, 128.0, !IO),
+ cairo.transformations.rotate(Context, 45.0 * pi / 180.0, !IO),
+ cairo.transformations.scale(Context, 256.0 / float(W), 256.0 / float(H), !IO),
+ cairo.transformations.translate(Context, -0.5 * float(W), -0.5 * float(H), !IO),
+
+ cairo.set_source_surface(Context, Image, 0.0, 0.0, !IO),
+ cairo.paint(Context, !IO),
+
+ write_surface_to_png(Surface, "image.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module image.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/imagepattern.m
===================================================================
RCS file: graphics/mercury_cairo/samples/imagepattern.m
diff -N graphics/mercury_cairo/samples/imagepattern.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/imagepattern.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,54 @@
+:- module imagepattern.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.matrix.
+:- import_module cairo.path.
+:- import_module cairo.pattern.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ image_surface_create_from_png("data/romedalen.png", Image, !IO),
+ image.get_width(Image, W, !IO),
+ image.get_height(Image, H, !IO),
+
+ pattern.create_for_surface(Image, Pattern, !IO),
+ pattern.set_extend(Pattern, extend_repeat, !IO),
+
+ transformations.translate(Context, 128.0, 128.0, !IO),
+ transformations.rotate(Context, pi / 4.0, !IO),
+ transformations.scale(Context, 1.0 / sqrt(2.0), 1.0 / sqrt(2.0), !IO),
+ transformations.translate(Context, -128.0, -128.0, !IO),
+
+ matrix.init_scale(float(W) / 256.0 * 5.0, float(H) / 256.0 * 5.0, Matrix, !IO),
+ pattern.set_matrix(Pattern, Matrix, !IO),
+
+ cairo.set_source(Context, Pattern, !IO),
+
+ path.rectangle(Context, 0.0, 0.0, 256.0, 256.0, !IO),
+ cairo.fill(Context, !IO),
+
+ write_surface_to_png(Surface, "imagepattern.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module imagepattern.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/multi_segment_caps.m
===================================================================
RCS file: graphics/mercury_cairo/samples/multi_segment_caps.m
diff -N graphics/mercury_cairo/samples/multi_segment_caps.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/multi_segment_caps.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,43 @@
+:- module multi_segment_caps.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.path.
+:- import_module cairo.image.
+:- import_module cairo.png.
+
+:- import_module float.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ path.move_to(Context, 50.0, 75.0, !IO),
+ path.line_to(Context, 200.0, 75.0, !IO),
+
+ path.move_to(Context, 50.0, 125.0, !IO),
+ path.line_to(Context, 200.0, 125.0, !IO),
+
+ path.move_to(Context, 50.0, 175.0, !IO),
+ path.line_to(Context, 200.0, 175.0, !IO),
+
+ cairo.set_line_width(Context, 30.0, !IO),
+ cairo.set_line_cap(Context, line_cap_round, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "multi_segment_caps.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module multi_segment_caps.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/set_line_cap.m
===================================================================
RCS file: graphics/mercury_cairo/samples/set_line_cap.m
diff -N graphics/mercury_cairo/samples/set_line_cap.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/set_line_cap.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,56 @@
+:- module set_line_cap.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ cairo.set_line_width(Context, 30.0, !IO),
+ cairo.set_line_cap(Context, line_cap_butt, !IO), % Default.
+ path.move_to(Context, 64.0, 50.0, !IO),
+ path.line_to(Context, 64.0, 200.0, !IO),
+ cairo.stroke(Context, !IO),
+ cairo.set_line_cap(Context, line_cap_round, !IO),
+ path.move_to(Context, 128.0, 50.0, !IO),
+ path.line_to(Context, 128.0, 200.0, !IO),
+ cairo.stroke(Context, !IO),
+ cairo.set_line_cap(Context, line_cap_square, !IO),
+ path.move_to(Context, 192.0, 50.0, !IO),
+ path.line_to(Context, 192.0, 200.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgb(Context, 1.0, 0.2, 0.2, !IO),
+ cairo.set_line_width(Context, 2.56, !IO),
+ path.move_to(Context, 64.0, 50.0, !IO),
+ path.line_to(Context, 64.0, 200.0, !IO),
+ path.move_to(Context, 128.0, 50.0, !IO),
+ path.line_to(Context, 128.0, 200.0, !IO),
+ path.move_to(Context, 192.0, 50.0, !IO),
+ path.line_to(Context, 192.0, 200.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "set_line_cap.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module set_line_cap.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/set_line_join.m
===================================================================
RCS file: graphics/mercury_cairo/samples/set_line_join.m
diff -N graphics/mercury_cairo/samples/set_line_join.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/set_line_join.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,49 @@
+:- module set_line_join.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.path.
+:- import_module cairo.image.
+:- import_module cairo.png.
+
+:- import_module float.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ cairo.set_line_width(Context, 40.96, !IO),
+ path.move_to(Context, 76.8, 84.43, !IO),
+ path.rel_line_to(Context, 51.2, -51.2, !IO),
+ path.rel_line_to(Context, 51.2, 51.2, !IO),
+ cairo.set_line_join(Context, line_join_miter, !IO), % Default.
+ cairo.stroke(Context, !IO),
+
+ path.move_to(Context, 76.8, 161.28, !IO),
+ path.rel_line_to(Context, 51.2, -51.2, !IO),
+ path.rel_line_to(Context, 51.2, 51.2, !IO),
+ cairo.set_line_join(Context, line_join_bevel, !IO),
+ cairo.stroke(Context, !IO),
+
+ path.move_to(Context, 76.8, 238.08, !IO),
+ path.rel_line_to(Context, 51.2, -51.2, !IO),
+ path.rel_line_to(Context, 51.2, 51.2, !IO),
+ cairo.set_line_join(Context, line_join_round, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "set_line_join.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module set_line_join.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/text.m
===================================================================
RCS file: graphics/mercury_cairo/samples/text.m
diff -N graphics/mercury_cairo/samples/text.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/text.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,54 @@
+:- module text.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ text.select_font_face(Context, "Sans", slant_normal,
+ weight_bold, !IO),
+ text.set_font_size(Context, 90.0, !IO),
+
+ path.move_to(Context, 10.0, 135.0, !IO),
+ text.show_text(Context, "Hello", !IO),
+
+ path.move_to(Context, 70.0, 165.0, !IO),
+ path.text_path(Context, "void", !IO),
+ cairo.set_source_rgb(Context, 0.5, 0.5, 1.0, !IO),
+ cairo.fill_preserve(Context, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.set_line_width(Context, 2.56, !IO),
+ cairo.stroke(Context, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgba(Context, 1.0, 0.2, 0.2, 0.6, !IO),
+ path.arc(Context, 10.0, 135.0, 5.12, 0.0, 2.0 * pi, !IO),
+ path.close_path(Context, !IO),
+ path.arc(Context, 70.0, 165.0, 5.12, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+
+ write_surface_to_png(Surface, "text.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module text.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/text_align_center.m
===================================================================
RCS file: graphics/mercury_cairo/samples/text_align_center.m
diff -N graphics/mercury_cairo/samples/text_align_center.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/text_align_center.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,54 @@
+:- module text_align_center.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ Utf8 = "cairo",
+ text.select_font_face(Context, "Sans", slant_normal,
+ weight_normal, !IO),
+ text.set_font_size(Context, 52.0, !IO),
+ text.text_extents(Context, Utf8, Extents, !IO),
+ X = 128.0 - (Extents ^ te_width / 2.0 + Extents ^ te_x_bearing),
+ Y = 128.0 - (Extents ^ te_height / 2.0 + Extents ^ te_y_bearing),
+
+ path.move_to(Context, X, Y, !IO),
+ text.show_text(Context, Utf8, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgba(Context, 1.0, 0.2, 0.2, 0.6, !IO),
+ cairo.set_line_width(Context, 6.0, !IO),
+ path.arc(Context, X, Y, 10.0, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+ path.move_to(Context, 128.0, 0.0, !IO),
+ path.rel_line_to(Context, 0.0, 256.0, !IO),
+ path.move_to(Context, 0.0, 128.0, !IO),
+ path.rel_line_to(Context, 256.0, 0.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "text_align_center.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module text_align_center.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/text_extents.m
===================================================================
RCS file: graphics/mercury_cairo/samples/text_extents.m
diff -N graphics/mercury_cairo/samples/text_extents.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/samples/text_extents.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,58 @@
+:- module text_extents.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+
+:- import_module float.
+:- import_module math.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 256, 256, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+
+ Utf8 = "cairo",
+
+ text.select_font_face(Context, "Sans", slant_normal,
+ weight_normal, !IO),
+
+ text.set_font_size(Context, 100.0, !IO),
+ text.text_extents(Context, Utf8, Extents, !IO),
+
+ X = 25.0,
+ Y = 150.0,
+
+ path.move_to(Context, X, Y, !IO),
+ text.show_text(Context, Utf8, !IO),
+
+ % Draw helping lines.
+ cairo.set_source_rgba(Context, 1.0, 0.0, 0.2, 0.6, !IO),
+ cairo.set_line_width(Context, 6.0, !IO),
+ path.arc(Context, X, Y, 10.0, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+ path.move_to(Context, X, Y, !IO),
+ path.rel_line_to(Context, 0.0, -Extents ^ te_height, !IO),
+ path.rel_line_to(Context, Extents ^ te_width, 0.0, !IO),
+ path.rel_line_to(Context, Extents ^ te_x_bearing,
+ -Extents ^ te_y_bearing, !IO),
+ cairo.stroke(Context, !IO),
+
+ write_surface_to_png(Surface, "text_extents.png", !IO).
+
+%----------------------------------------------------------------------------%
+:- end_module text_extents.
+%----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/samples/data/romedalen.png
===================================================================
RCS file: graphics/mercury_cairo/samples/data/romedalen.png
diff -N graphics/mercury_cairo/samples/data/romedalen.png
Binary files /dev/null and romedalen.png differ
Index: graphics/mercury_cairo/tutorial/fill.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/fill.m
diff -N graphics/mercury_cairo/tutorial/fill.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/fill.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,38 @@
+%-----------------------------------------------------------------------------%
+
+:- module fill.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.path.rectangle(Context, 0.25, 0.25, 0.5, 0.5, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "fill.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module fill.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/mask.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/mask.m
diff -N graphics/mercury_cairo/tutorial/mask.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/mask.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,46 @@
+%-----------------------------------------------------------------------------%
+
+:- module mask.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.pattern.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.pattern.create_linear(0.0, 0.0, 1.0, 1.0, LinPat, !IO),
+ cairo.pattern.add_color_stop_rgb(LinPat, 0.0, 0.0, 0.3, 0.8, !IO),
+ cairo.pattern.add_color_stop_rgb(LinPat, 1.0, 0.0, 0.8, 0.3, !IO),
+
+ cairo.pattern.create_radial(0.5, 0.5, 0.25, 0.5, 0.5, 0.75, RadPat, !IO),
+ cairo.pattern.add_color_stop_rgba(RadPat, 0.0, 0.0, 0.0, 0.0, 1.0, !IO),
+ cairo.pattern.add_color_stop_rgba(RadPat, 0.5, 0.0, 0.0, 0.0, 0.0, !IO),
+
+ cairo.set_source(Context, LinPat, !IO),
+ cairo.mask(Context, RadPat, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "mask.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module mask.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/paint.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/paint.m
diff -N graphics/mercury_cairo/tutorial/paint.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/paint.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,37 @@
+%-----------------------------------------------------------------------------%
+
+:- module paint.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.paint_with_alpha(Context, 0.5, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "paint.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module paint.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/path_close.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/path_close.m
diff -N graphics/mercury_cairo/tutorial/path_close.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/path_close.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,49 @@
+%-----------------------------------------------------------------------------%
+
+:- module path_close.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_line_width(Context, 0.1, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+
+ cairo.path.move_to(Context, 0.25, 0.25, !IO),
+ cairo.path.line_to(Context, 0.5, 0.375, !IO),
+ cairo.path.rel_line_to(Context, 0.25, -0.125, !IO),
+ cairo.path.arc(Context, 0.5, 0.5, 0.25 * sqrt(2.0), -0.25 * pi, 0.25 * pi, !IO),
+ cairo.path.rel_curve_to(Context, -0.25, -0.125, -0.25, 0.125, -0.5, 0.0, !IO),
+ cairo.path.close_path(Context, !IO),
+
+ cairo.stroke(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "path_close.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module path_close.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/setsourcegradient.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/setsourcegradient.m
diff -N graphics/mercury_cairo/tutorial/setsourcegradient.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/setsourcegradient.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,71 @@
+%-----------------------------------------------------------------------------%
+
+:- module setsourcegradient.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.pattern.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module int.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.pattern.create_radial(0.25, 0.25, 0.1, 0.5, 0.5, 0.5, RadPat, !IO),
+ cairo.pattern.add_color_stop_rgb(RadPat, 0.0, 1.0, 0.8, 0.8, !IO),
+ cairo.pattern.add_color_stop_rgb(RadPat, 1.0, 0.9, 0.0, 0.0, !IO),
+
+ int.fold_up(draw_rectangle(Context), 1, 9, !IO),
+
+ cairo.set_source(Context, RadPat, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.pattern.create_linear(0.25, 0.35, 0.75, 0.65, LinPat, !IO),
+ cairo.pattern.add_color_stop_rgba(LinPat, 0.00, 1.0, 1.0, 1.0, 0.0, !IO),
+ cairo.pattern.add_color_stop_rgba(LinPat, 0.25, 0.0, 1.0, 0.0, 0.5, !IO),
+ cairo.pattern.add_color_stop_rgba(LinPat, 0.50, 1.0, 1.0, 1.0, 0.0, !IO),
+ cairo.pattern.add_color_stop_rgba(LinPat, 0.75, 0.0, 0.0, 1.0, 0.5, !IO),
+ cairo.pattern.add_color_stop_rgba(LinPat, 1.00, 1.0, 1.0, 1.0, 0.0, !IO),
+
+ cairo.path.rectangle(Context, 0.0, 0.0, 1.0, 1.0, !IO),
+ cairo.set_source(Context, LinPat, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "setsourcegradient.png", !IO).
+
+:- pred draw_rectangle(context(S)::in, int::in, io::di, io::uo)
+ is det <= surface(S).
+
+draw_rectangle(Context, I, !IO) :-
+ int.fold_up(draw_rectangle_2(Context, I), 1, 9, !IO).
+
+:- pred draw_rectangle_2(context(S)::in, int::in, int::in, io::di, io::uo)
+ is det <= surface(S).
+
+draw_rectangle_2(Context, I, J, !IO) :-
+ cairo.path.rectangle(Context, float(I) / 10.0 - 0.04,
+ float(J) / 10.0 - 0.04, 0.08, 0.08, !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module setsourcegradient.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/setsourcergba.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/setsourcergba.m
diff -N graphics/mercury_cairo/tutorial/setsourcergba.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/setsourcergba.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,54 @@
+%-----------------------------------------------------------------------------%
+
+:- module setsourcergba.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.path.move_to(Context, 0.0, 0.0, !IO),
+ cairo.path.line_to(Context, 1.0, 1.0, !IO),
+ cairo.path.move_to(Context, 1.0, 0.0, !IO),
+ cairo.path.line_to(Context, 0.0, 1.0, !IO),
+ cairo.set_line_width(Context, 0.2, !IO),
+ cairo.stroke(Context, !IO),
+
+ cairo.path.rectangle(Context, 0.0, 0.0, 0.5, 0.5, !IO),
+ cairo.set_source_rgba(Context, 1.0, 0.0, 0.0, 0.8, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.path.rectangle(Context, 0.0, 0.5, 0.5, 0.5, !IO),
+ cairo.set_source_rgba(Context, 0.0, 1.0, 0.0, 0.6, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.path.rectangle(Context, 0.5, 0.0, 0.5, 0.5, !IO),
+ cairo.set_source_rgba(Context, 0.0, 0.0, 1.0, 0.4, !IO),
+ cairo.fill(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "setsourcergba.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module setsourcergba.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/showtext.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/showtext.m
diff -N graphics/mercury_cairo/tutorial/showtext.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/showtext.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,46 @@
+%-----------------------------------------------------------------------------%
+
+:- module showtext.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+:- import_module cairo.transformations.
+
+:- import_module float.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.text.select_font_face(Context, "Georgia", slant_normal,
+ weight_bold, !IO),
+ cairo.text.set_font_size(Context, 1.2, !IO),
+ cairo.text.text_extents(Context, "a", TE, !IO),
+ cairo.path.move_to(Context, 0.5 - TE ^ te_width / 2.0 - TE ^ te_x_bearing,
+ 0.5 - TE ^ te_height / 2.0 - TE ^ te_y_bearing, !IO),
+ cairo.text.show_text(Context, "a", !IO),
+
+ cairo.png.write_surface_to_png(Surface, "showtext.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module showtext.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/stroke.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/stroke.m
diff -N graphics/mercury_cairo/tutorial/stroke.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/stroke.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,39 @@
+%-----------------------------------------------------------------------------%
+
+:- module stroke.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_line_width(Context, 0.1, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.path.rectangle(Context, 0.25, 0.25, 0.5, 0.5, !IO),
+ cairo.stroke(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "stroke.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module stroke.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/textextents.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/textextents.m
diff -N graphics/mercury_cairo/tutorial/textextents.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/textextents.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,102 @@
+%-----------------------------------------------------------------------------%
+
+:- module textextents.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module list.
+:- import_module math.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ Text = "joy",
+
+ cairo.image.create_surface(format_argb32, 240, 240, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 240.0, 240.0, !IO),
+ cairo.text.set_font_size(Context, 0.5, !IO),
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.text.select_font_face(Context, "Georgia", slant_normal,
+ weight_bold, !IO),
+
+ cairo.transformations.device_to_user_distance(Context, 1.0, 1.0,
+ Ux, Uy, !IO),
+ Px = ( if Ux > Uy then Ux else Uy ),
+
+ cairo.text.font_extents(Context, FE, !IO),
+ cairo.text.text_extents(Context, Text, TE, !IO),
+ X = 0.5 - TE ^ te_x_bearing - TE ^ te_width / 2.0,
+ Y = 0.5 - FE ^ fe_descent + FE ^ fe_height / 2.0,
+
+ /* baseline, descent, ascent, height */
+ cairo.set_line_width(Context, 4.0 * Px, !IO),
+ cairo.set_dash(Context, [9.0 * Px], 0.0, !IO),
+ cairo.set_source_rgba(Context, 0.0, 0.6, 0.0, 0.5, !IO),
+ cairo.path.move_to(Context, X + TE ^ te_x_bearing, Y, !IO),
+ cairo.path.rel_line_to(Context, TE ^ te_width, 0.0, !IO),
+ cairo.path.move_to(Context, X + TE ^ te_x_bearing, Y + FE ^ fe_descent, !IO),
+ cairo.path.rel_line_to(Context, TE ^ te_width, 0.0, !IO),
+ cairo.path.move_to(Context, X + TE ^ te_x_bearing, Y - FE ^ fe_ascent, !IO),
+ cairo.path.rel_line_to(Context, TE ^ te_width, 0.0, !IO),
+ cairo.path.move_to(Context, X + TE ^ te_x_bearing, Y - FE ^ fe_height, !IO),
+ cairo.path.rel_line_to(Context, TE ^ te_width, 0.0, !IO),
+ cairo.stroke(Context, !IO),
+
+ /* extents: width & height */
+ cairo.set_source_rgba(Context, 0.0, 0.0, 0.75, 0.5, !IO),
+ cairo.set_line_width(Context, Px, !IO),
+ cairo.set_dash(Context, [3.0 * Px], 0.0, !IO),
+ cairo.path.rectangle(Context, X + TE ^ te_x_bearing,
+ Y + TE ^ te_y_bearing, TE ^ te_width, TE ^ te_height, !IO),
+ cairo.stroke(Context, !IO),
+
+ /* text */
+ cairo.path.move_to(Context, X, Y, !IO),
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.text.show_text(Context, Text, !IO),
+
+ /* bearing */
+ cairo.set_dash(Context, [], 0.0, !IO),
+ cairo.set_line_width(Context, 2.0 * Px, !IO),
+ cairo.set_source_rgba(Context, 0.0, 0.0, 0.75, 0.5, !IO),
+ cairo.path.move_to(Context, X, Y, !IO),
+ cairo.path.rel_line_to(Context, TE ^ te_x_bearing, TE ^ te_y_bearing, !IO),
+ cairo.stroke(Context, !IO),
+
+ /* text's advance */
+ cairo.set_source_rgba(Context, 0.0, 0.0, 0.75, 0.5, !IO),
+ cairo.path.arc(Context, X + TE ^ te_x_advance, Y + TE ^ te_y_advance,
+ float(5) * Px, 0.0, 2.0 * pi, !IO),
+ cairo.fill(Context, !IO),
+
+ /* reference point */
+ cairo.path.arc(Context, X, Y, float(5) * Px, 0.0, 2.0 * pi, !IO),
+ cairo.set_source_rgba(Context, 0.75, 0.0, 0.0, 0.5, !IO),
+ cairo.fill(Context, !IO),
+
+ /* Write output and clean up */
+ cairo.png.write_surface_to_png(Surface, "textextents.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module textextents.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/tips_ellipse.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/tips_ellipse.m
diff -N graphics/mercury_cairo/tutorial/tips_ellipse.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/tips_ellipse.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,49 @@
+%-----------------------------------------------------------------------------%
+
+:- module tips_ellipse.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.transformations.
+
+:- import_module float.
+:- import_module math.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 120, 120, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 120.0, 120.0, !IO),
+
+ cairo.set_line_width(Context, 0.1, !IO),
+
+ cairo.save(Context, !IO),
+ cairo.transformations.scale(Context, 0.5, 1.0, !IO),
+ cairo.path.arc(Context, 0.5, 0.5, 0.40, 0.0, 2.0 * pi, !IO),
+ cairo.stroke(Context, !IO),
+
+ cairo.transformations.translate(Context, 1.0, 0.0, !IO),
+ cairo.path.arc(Context, 0.5, 0.5, 0.40, 0.0, 2.0 * pi, !IO),
+ cairo.restore(Context, !IO),
+ cairo.stroke(Context, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "tips_ellipse.png", !IO).
+
+%-----------------------------------------------------------------------------%
+:- end_module tips_ellipse.
+%-----------------------------------------------------------------------------%
Index: graphics/mercury_cairo/tutorial/tips_letter.m
===================================================================
RCS file: graphics/mercury_cairo/tutorial/tips_letter.m
diff -N graphics/mercury_cairo/tutorial/tips_letter.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ graphics/mercury_cairo/tutorial/tips_letter.m 5 Sep 2010 12:15:53 -0000
@@ -0,0 +1,62 @@
+%-----------------------------------------------------------------------------%
+
+:- module tips_letter.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module cairo.
+:- import_module cairo.image.
+:- import_module cairo.path.
+:- import_module cairo.png.
+:- import_module cairo.text.
+:- import_module cairo.transformations.
+
+:- import_module char.
+:- import_module int.
+:- import_module float.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ cairo.image.create_surface(format_argb32, 780, 30, Surface, !IO),
+ cairo.create_context(Surface, Context, !IO),
+ cairo.transformations.scale(Context, 30.0, 30.0, !IO),
+ cairo.text.set_font_size(Context, 0.8, !IO),
+
+ Alphabet = "AbCdEfGhIjKlMnOpQrStUvWxYz",
+
+ cairo.set_source_rgb(Context, 0.0, 0.0, 0.0, !IO),
+ cairo.text.select_font_face(Context, "Georgia", slant_normal,
+ weight_bold, !IO),
+
+ string.foldl2(draw_letter(Context), Alphabet, 0, _, !IO),
+
+ cairo.png.write_surface_to_png(Surface, "tips_letter.png", !IO).
+
+
+:- pred draw_letter(context(S)::in, char::in, int::in, int::out,
+ io::di, io::uo) is det <= surface(S).
+
+draw_letter(Context, LetterChar, !I, !IO) :-
+ Letter = string.from_char(LetterChar),
+ cairo.text.text_extents(Context, Letter, TE, !IO),
+ cairo.path.move_to(Context,
+ float(!.I) + 0.5 - TE ^ te_x_bearing - TE ^ te_width / 2.0,
+ 0.5 - TE ^ te_y_bearing - TE ^ te_height / 2.0, !IO),
+ cairo.text.show_text(Context, Letter, !IO),
+ !:I = !.I + 1.
+
+%-----------------------------------------------------------------------------%
+:- end_module tips_letter.
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list