[m-rev.] [PATCH 06/11] mercury_cairo: Add show_glyphs and glyph_path.

[Peter Wang]

Export the functionality of `cairo_show_glyphs' and `cairo_glyph_path'.

extras/graphics/mercury_cairo/cairo.m:
	Add internal predicates for working with arrays of `cairo_glyph_t'.

extras/graphics/mercury_cairo/cairo.text.m:
	Add `glyph' type that corresponds to `cairo_glyph_t' in the C API.

	Add `show_glyphs' predicate.

extras/graphics/mercury_cairo/cairo.path.m:
	Add `glyph_path' predicate.
---
 extras/graphics/mercury_cairo/cairo.m      | 55 ++++++++++++++++++++++++++++++
 extras/graphics/mercury_cairo/cairo.path.m | 21 +++++++++++-
 extras/graphics/mercury_cairo/cairo.text.m | 27 ++++++++++++++-
 3 files changed, 101 insertions(+), 2 deletions(-)

diff --git a/extras/graphics/mercury_cairo/cairo.m b/extras/graphics/mercury_cairo/cairo.m
index 8ab981e..c5b249a 100644
--- a/extras/graphics/mercury_cairo/cairo.m
+++ b/extras/graphics/mercury_cairo/cairo.m
@@ -586,6 +586,7 @@
 :- implementation.
 
 :- import_module exception.
+:- import_module int.
 :- import_module cairo.text.
 
 :- pragma require_feature_set([conservative_gc, double_prec_float]).
@@ -1339,5 +1340,59 @@ set_dash(Context, Dashes, OffSet, !IO) :-
 ").
 
 %---------------------------------------------------------------------------%
+%
+% Glyph array
+%
+
+:- type glyph_array.
+
+:- pragma foreign_type("C", glyph_array, "cairo_glyph_t *",
+    [can_pass_as_mercury_type]).
+
+:- pred make_glyph_array(list(glyph)::in, glyph_array::uo, int::out,
+    io::di, io::uo) is det.
+
+make_glyph_array(Glyphs, Array, NumGlyphs, !IO) :-
+    list.length(Glyphs, NumGlyphs),
+    alloc_glyph_array(NumGlyphs, Array0),
+    fill_glyph_array(Glyphs, 0, Array0, Array).
+
+:- pred alloc_glyph_array(int::in, glyph_array::uo) is det.
+
+:- pragma foreign_proc("C",
+    alloc_glyph_array(Size::in, Array::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    MR_Word ptr;
+
+    MR_incr_hp_atomic_msg(ptr, MR_bytes_to_words(Size * sizeof(cairo_glyph_t)),
+        MR_ALLOC_ID, ""cairo.glyph_array/0"");
+    Array = (cairo_glyph_t *) ptr;
+").
+
+:- pred fill_glyph_array(list(glyph)::in, int::in,
+    glyph_array::di, glyph_array::uo) is det.
+
+fill_glyph_array([], _Slot, !Array).
+fill_glyph_array([G | Gs], Slot, !Array) :-
+    G = glyph(Index, X, Y),
+    set_glyph_array_slot(Slot, Index, X, Y, !Array),
+    fill_glyph_array(Gs, Slot + 1, !Array).
+
+:- pred set_glyph_array_slot(int::in, int::in, float::in, float::in,
+    glyph_array::di, glyph_array::uo) is det.
+
+:- pragma foreign_proc("C",
+    set_glyph_array_slot(Slot::in, Index::in, X::in, Y::in,
+        Array0::di, Array::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Array = Array0;
+    Array[Slot].index = Index;
+    Array[Slot].x = X;
+    Array[Slot].y = Y;
+").
+
+%---------------------------------------------------------------------------%
 :- end_module cairo.
 %---------------------------------------------------------------------------%
diff --git a/extras/graphics/mercury_cairo/cairo.path.m b/extras/graphics/mercury_cairo/cairo.path.m
index 5d79d4d..4c920a6 100644
--- a/extras/graphics/mercury_cairo/cairo.path.m
+++ b/extras/graphics/mercury_cairo/cairo.path.m
@@ -119,11 +119,16 @@
 :- 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):
+    % 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.glyph_path(Context, Glyphs, !IO)
+    % Adds closed paths for the glyphs to the current path.
+    %
+:- pred glyph_path(context(T)::in, list(glyph)::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.
@@ -290,6 +295,20 @@
    cairo_text_path(Ctxt->mcairo_raw_context, Str);
 ").
 
+glyph_path(Ctxt, Glyphs, !IO) :-
+    make_glyph_array(Glyphs, Array, NumGlyphs, !IO),
+    glyph_array_path(Ctxt, Array, NumGlyphs, !IO).
+
+:- pred glyph_array_path(context(T)::in, glyph_array::in, int::in,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    glyph_array_path(Ctxt::in, Array::in, NumGlyphs::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+    cairo_glyph_path(Ctxt->mcairo_raw_context, Array, NumGlyphs);
+").
+
 rel_curve_to(Ctxt, Dx1, Dy1, Dx2, Dy2, Dx3, Dy3, !IO) :-
     rel_curve_to_2(Ctxt, Dx1, Dy1, Dx2, Dy2, Dx3, Dy3, IsValid, !IO),
     (
diff --git a/extras/graphics/mercury_cairo/cairo.text.m b/extras/graphics/mercury_cairo/cairo.text.m
index 5dd7b16..f6af5e3 100644
--- a/extras/graphics/mercury_cairo/cairo.text.m
+++ b/extras/graphics/mercury_cairo/cairo.text.m
@@ -32,6 +32,13 @@
 
 :- type font_family == string.
 
+:- type glyph
+    --->    glyph(
+                glyph_index :: int,
+                glyph_x     :: float,
+                glyph_y     :: float
+            ).
+
     % The extents of a text string in user-space.
     %
 :- type text_extents
@@ -105,6 +112,10 @@
     %
 :- pred show_text(context(S)::in, string::in, io::di, io::uo) is det.
 
+    % text.show_glyphs(Context, Glyphs, !IO):
+    %
+:- pred show_glyphs(context(S)::in, list(glyph)::in, io::di, io::uo) is det.
+
 :- pred font_extents(context(S)::in, font_extents::out, io::di, io::uo)
     is det.
 
@@ -183,7 +194,21 @@ select_font_face(Context, Family, Slant, Weight, !IO) :-
 "
     cairo_show_text(Ctxt->mcairo_raw_context, Text);
 ").
-    
+
+show_glyphs(Ctxt, Glyphs, !IO) :-
+    make_glyph_array(Glyphs, Array, NumGlyphs, !IO),
+    show_glyphs_array(Ctxt, Array, NumGlyphs, !IO).
+
+:- pred show_glyphs_array(context(T)::in, glyph_array::in, int::in,
+    io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    show_glyphs_array(Ctxt::in, Array::in, NumGlyphs::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, tabled_for_io],
+"
+    cairo_show_glyphs(Ctxt->mcairo_raw_context, Array, NumGlyphs);
+").
+
 :- pragma foreign_proc("C",
     set_font_options(Ctxt::in, FntOpts::in, _IO0::di, _IO::uo),
     [promise_pure, will_not_call_mercury, tabled_for_io],
-- 
2.1.2