[m-rev.] [PATCH 10/11] mercury_cairo: Add recording surfaces.

[Peter Wang]

Add support for cairo recording surfaces.

extras/graphics/mercury_cairo/cairo.m:
	Add type `rectangle_f', the float analogue of `rectangle'.

extras/graphics/mercury_cairo/cairo.recording.m:
	New module.

extras/graphics/mercury_cairo/README:
	Mention recording surfaces.
---
 extras/graphics/mercury_cairo/README            |  17 +-
 extras/graphics/mercury_cairo/cairo.m           |   9 +
 extras/graphics/mercury_cairo/cairo.recording.m | 222 ++++++++++++++++++++++++
 3 files changed, 240 insertions(+), 8 deletions(-)
 create mode 100644 extras/graphics/mercury_cairo/cairo.recording.m

diff --git a/extras/graphics/mercury_cairo/README b/extras/graphics/mercury_cairo/README
index cc32fa4..ccd08f0 100644
--- a/extras/graphics/mercury_cairo/README
+++ b/extras/graphics/mercury_cairo/README
@@ -92,18 +92,19 @@ For example:
 Backends Submodules
 ===================
 
-The Mercury binding has submodules that provide image, PDF, PostScript, and SVG
-surfaces.  Each surface is represented by a type that is an instance of the
-cairo.surface/1 type class.  For example, the interface to image surfaces is in
-the submodule "cairo.image".
-
-Image surfaces are always supported.  PDF, PostScript, and SVG surfaces are
-optional.  The following predicates may be used to test whether they are are
-supported by an installation:
+The Mercury binding has submodules that provide image, PDF, PostScript, SVG and
+recording surfaces.  Each surface is represented by a type that is an instance
+of the cairo.surface/1 type class.  For example, the interface to image
+surfaces is in the submodule "cairo.image".
+
+Image surfaces are always supported.  PDF, PostScript, SVG and recording
+surfaces are optional.  The following predicates may be used to test whether
+they are are supported by an installation:
     
     cairo.pdf.have_pdf_surface/0
     cairo.ps.have_ps_surface/0
     cairo.svg.have_svg_surface/0
+    cairo.recording.have_recording_surface/0
 
 (The predicate cairo.png.png_is_supported/0 performs the same function for
 determining whether the PNG reading and writing capabilities in the submodule
diff --git a/extras/graphics/mercury_cairo/cairo.m b/extras/graphics/mercury_cairo/cairo.m
index bfc995e..5252e23 100644
--- a/extras/graphics/mercury_cairo/cairo.m
+++ b/extras/graphics/mercury_cairo/cairo.m
@@ -31,6 +31,7 @@
 :- include_module pdf.
 :- include_module png.
 :- include_module ps.
+:- include_module recording.
 :- include_module region.
 :- include_module surface.
 :- include_module svg.
@@ -114,6 +115,14 @@
                 rect_height :: int  % Height
             ).
 
+:- type rectangle_f
+    --->    rectangle_f(
+                rectf_x :: float,
+                rectf_y :: float,
+                rectf_width :: float,
+                rectf_height :: float
+            ).
+
 %---------------------------------------------------------------------------%
 %
 % Error handling
diff --git a/extras/graphics/mercury_cairo/cairo.recording.m b/extras/graphics/mercury_cairo/cairo.recording.m
new file mode 100644
index 0000000..4312008
--- /dev/null
+++ b/extras/graphics/mercury_cairo/cairo.recording.m
@@ -0,0 +1,222 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2015 The Mercury team.
+% 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: Peter Wang
+%
+% This sub-module provides recording surfaces.
+%
+%---------------------------------------------------------------------------%
+
+:- module cairo.recording.
+:- interface.
+
+:- import_module maybe.
+
+%---------------------------------------------------------------------------%
+
+:- type recording_surface.
+
+:- instance surface(recording_surface).
+
+%---------------------------------------------------------------------------%
+
+    % recording.have_recording_surface:
+    % Succeeds if recording surfaces are supported by this implementation.
+    %
+:- pred have_recording_surface is semidet.
+
+    % recording.create_surface(Content, MaybeExtents, Surface, !IO):
+    % Surface is a new recording surface.
+    % Throws a cairo.error/0 exception if the surface cannot be created.
+    %
+:- pred create_surface(content::in, maybe(rectangle_f)::in,
+    recording_surface::out, io::di, io::uo) is det.
+
+    % recording.ink_extents(Surface, X0, Y0, Width, Height):
+    % Measures the extents of the operations stored within the recording
+    % surface.
+    %
+:- pred ink_extents(recording_surface::in, float::out, float::out,
+    float::out, float::out, io::di, io::uo) is det.
+
+    % recording.get_extents(Surface, MaybeExtents):
+    % Get the extents of the recording surface.
+    %
+:- pred get_extents(recording_surface::in, maybe(rectangle_f)::out,
+    io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- pragma foreign_decl("C", "#include \"cairo.mh\"").
+
+:- pragma foreign_type("C", recording_surface, "MCAIRO_surface *",
+	[can_pass_as_mercury_type]).
+
+:- instance surface(recording_surface) where [].
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+   have_recording_surface,
+   [promise_pure, will_not_call_mercury],
+"
+#if defined(CAIRO_HAS_RECORDING_SURFACE)
+    SUCCESS_INDICATOR = MR_TRUE;
+#else
+    SUCCESS_INDICATOR = MR_FALSE;
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+%
+% Recording surface creation
+%
+
+create_surface(Content, MaybeExtents, Surface, !IO) :-
+    (
+        MaybeExtents = yes(rectangle_f(X, Y, W, H)),
+        HaveExtents = yes
+    ;
+        MaybeExtents = no,
+        HaveExtents = no,
+        X = 0.0,
+        Y = 0.0,
+        W = 0.0,
+        H = 0.0
+    ),
+    create_surface_2(Content, HaveExtents, X, Y, W, H, Supported, Status,
+        Surface, !IO),
+    (
+        Supported = yes,
+        ( Status = status_success ->
+            true
+        ;
+            throw(cairo.error("recording.create_surface/4", Status))
+        )
+    ;
+        Supported = no,
+        throw(cairo.unsupported_surface_error("recording"))
+    ).
+
+:- pred create_surface_2(content::in, bool::in, float::in, float::in,
+    float::in, float::in, bool::out, cairo.status::out, recording_surface::out,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    create_surface_2(Content::in, HaveExtents::in, X::in, Y::in,
+        W::in, H::in, Supported::out, Status::out, Surface::out,
+        _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_RECORDING_SURFACE)
+
+    cairo_surface_t		*raw_surface;
+
+    Supported = MR_YES;
+    if (HaveExtents) {
+        cairo_rectangle_t rect = {X, Y, W, H};
+        raw_surface = cairo_recording_surface_create(Content, &rect);
+    } else {
+        raw_surface = cairo_recording_surface_create(Content, NULL);
+    }
+
+    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);
+            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:
+            Surface = NULL;
+            break;
+
+        default:
+            MR_external_fatal_error(\"Mercury cairo\", \"invalid status\");
+    }
+#else
+    Supported = MR_NO;
+    Status = CAIRO_STATUS_SUCCESS;
+    Surface = NULL;
+#endif
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+	ink_extents(Surface::in, X::out, Y::out, W::out, H::out,
+        _IO0::di, _IO::uo),
+	[promise_pure, will_not_call_mercury, tabled_for_io],
+"
+#if defined(CAIRO_HAS_RECORDING_SURFACE)
+    double  x, y, w, h;
+
+    cairo_recording_surface_ink_extents(Surface->mcairo_raw_surface,
+        &x, &y, &w, &h);
+    X = x;
+    Y = y;
+    W = w;
+    H = h;
+#else
+    MR_external_fatal_error(\"Mercury cairo\",
+        \"Recording surfaces not supported by this installation\");
+#endif
+").
+
+%---------------------------------------------------------------------------%
+
+get_extents(Surface, MaybeExtents, !IO) :-
+    get_extents_2(Surface, Ok, X, Y, W, H, !IO),
+    (
+        Ok = yes,
+        MaybeExtents = yes(rectangle_f(X, Y, W, H))
+    ;
+        Ok = no,
+        MaybeExtents = no
+    ).
+
+:- pred get_extents_2(recording_surface::in, bool::out, float::out, float::out,
+    float::out, float::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    get_extents_2(Surface::in, Ok::out, X::out, Y::out, W::out, H::out,
+        _IO0::di, _IO::uo),
+	[promise_pure, will_not_call_mercury, tabled_for_io],
+"
+    cairo_rectangle_t   rect;
+
+    if (cairo_recording_surface_get_extents(Surface->mcairo_raw_surface,
+            &rect))
+    {
+        Ok = MR_YES;
+        X = rect.x;
+        Y = rect.y;
+        W = rect.width;
+        H = rect.height;
+    } else {
+        Ok = MR_NO;
+        X = 0.0;
+        Y = 0.0;
+        W = 0.0;
+        H = 0.0;
+    }
+").
+
+%---------------------------------------------------------------------------%
+:- end_module cairo.recording.
+%---------------------------------------------------------------------------%
-- 
2.1.2