GNOME.org
 

[perl-Cairo] Wrap cairo_show_text_glyphs

commit b24e68f1685c6a84d573d461bdd55e51df8019c8
Author: Torsten Schönfeld <kaffeetisch gmx de>
Date:   Sun May 16 21:19:21 2010 +0200

    Wrap cairo_show_text_glyphs
    
    This also involves wrapping cairo_text_cluster_t and a few new cairo_status_t
    values.

 Cairo.xs               |  122 ++++++++++++++++++++++++++++++++++++++++++------
 Makefile.PL            |   61 ++++++++++++++---------
 cairo-perl.h           |    7 +++
 cairo-perl.typemap     |    7 +++
 examples/glyph-text.pl |   50 ++++++++++++++++++++
 t/Cairo.t              |   12 ++++-
 6 files changed, 220 insertions(+), 39 deletions(-)
---
diff --git a/Cairo.xs b/Cairo.xs
index 430bad4..e20ec08 100644
--- a/Cairo.xs
+++ b/Cairo.xs
@@ -32,6 +32,20 @@ call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV * cv, SV ** mark)
 
 /* ------------------------------------------------------------------------- */
 
+/* Copied from Glib/Glib.xs. */
+void *
+cairo_perl_alloc_temp (int nbytes)
+{
+	dTHR;
+	SV * s;
+
+	if (nbytes <= 0) return NULL;
+
+	s = sv_2mortal (NEWSV (0, nbytes));
+	memset (SvPVX (s), 0, nbytes);
+	return SvPVX (s);
+}
+
 /* Copied from Glib/GType.xs. */
 void
 cairo_perl_set_isa (const char *child_package,
@@ -154,20 +168,6 @@ newSVCairoTextExtents (cairo_text_extents_t *extents)
 
 /* ------------------------------------------------------------------------- */
 
-/* taken from Glib/Glib.xs */
-void *
-cairo_perl_alloc_temp (int nbytes)
-{
-	dTHR;
-	SV * s;
-
-	if (nbytes <= 0) return NULL;
-
-	s = sv_2mortal (NEWSV (0, nbytes));
-	memset (SvPVX (s), 0, nbytes);
-	return SvPVX (s);
-}
-
 SV *
 newSVCairoGlyph (cairo_glyph_t *glyph)
 {
@@ -246,6 +246,52 @@ newSVCairoRectangle (cairo_rectangle_t *rectangle)
 
 /* ------------------------------------------------------------------------- */
 
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 8, 0)
+
+SV *
+newSVCairoTextCluster (cairo_text_cluster_t *cluster)
+{
+	HV *hv;
+
+	if (!cluster)
+		return &PL_sv_undef;
+
+	hv = newHV ();
+
+	hv_store (hv, "num_bytes", 9, newSViv (cluster->num_bytes), 0);
+	hv_store (hv, "num_glyphs", 10, newSVnv (cluster->num_glyphs), 0);
+
+	return newRV_noinc ((SV *) hv);
+}
+
+cairo_text_cluster_t *
+SvCairoTextCluster (SV *sv)
+{
+	HV *hv;
+	SV **value;
+	cairo_text_cluster_t *cluster;
+
+	if (!cairo_perl_sv_is_hash_ref (sv))
+		croak ("cairo_text_cluster_t must be a hash reference");
+
+	hv = (HV *) SvRV (sv);
+	cluster = cairo_perl_alloc_temp (sizeof (cairo_text_cluster_t));
+
+	value = hv_fetch (hv, "num_bytes", 9, 0);
+	if (value && SvOK (*value))
+		cluster->num_bytes = SvIV (*value);
+
+	value = hv_fetch (hv, "num_glyphs", 10, 0);
+	if (value && SvOK (*value))
+		cluster->num_glyphs = SvIV (*value);
+
+	return cluster;
+}
+
+#endif
+
+/* ------------------------------------------------------------------------- */
+
 MODULE = Cairo	PACKAGE = Cairo	PREFIX = cairo_
 
 BOOT:
@@ -525,6 +571,54 @@ void cairo_show_glyphs (cairo_t * cr, ...)
 	cairo_show_glyphs (cr, glyphs, num_glyphs);
 	Safefree (glyphs);
 
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 8, 0)
+
+##void cairo_show_text_glyphs (cairo_t *cr, const char *utf8, int utf8_len, const cairo_glyph_t *glyphs, int num_glyphs, const cairo_text_cluster_t *clusters, int num_clusters, cairo_text_cluster_flags_t cluster_flags);
+void
+cairo_show_text_glyphs (cairo_t *cr, SV *utf8_sv, SV *glyphs_sv, SV *clusters_sv, cairo_text_cluster_flags_t cluster_flags)
+    PREINIT:
+	const char *utf8 = NULL;
+	STRLEN utf8_len = 0;
+	cairo_glyph_t * glyphs = NULL;
+	cairo_text_cluster_t * clusters = NULL;
+	int i, num_glyphs, num_clusters;
+	AV *glyphs_av, *clusters_av;
+    CODE:
+	if (!cairo_perl_sv_is_array_ref (glyphs_sv))
+		croak ("glyphs must be an array ref");
+	if (!cairo_perl_sv_is_array_ref (clusters_sv))
+		croak ("text clusters must be an array ref");
+
+	utf8 = SvPV (utf8_sv, utf8_len);
+
+	glyphs_av = (AV *) SvRV (glyphs_sv);
+	num_glyphs = av_len (glyphs_av) + 1;
+	glyphs = cairo_glyph_allocate (num_glyphs);
+	for (i = 0; i < num_glyphs; i++) {
+		SV **value = av_fetch (glyphs_av, i, 0);
+		if (value)
+			glyphs[i] = *SvCairoGlyph (*value);
+	}
+
+	clusters_av = (AV *) SvRV (clusters_sv);
+	num_clusters = av_len (clusters_av) + 1;
+	clusters = cairo_text_cluster_allocate (num_clusters);
+	for (i = 0; i < num_clusters; i++) {
+		SV **value = av_fetch (clusters_av, i, 0);
+		if (value)
+			clusters[i] = *SvCairoTextCluster (*value);
+	}
+
+	cairo_show_text_glyphs (cr,
+	                        utf8, (int) utf8_len,
+	                        glyphs, num_glyphs,
+	                        clusters, num_clusters, cluster_flags);
+
+	cairo_text_cluster_free (clusters);
+	cairo_glyph_free (glyphs);
+
+#endif
+
 cairo_font_face_t * cairo_get_font_face (cairo_t *cr);
 
 ##void cairo_font_extents (cairo_t *cr, cairo_font_extents_t *extents);
diff --git a/Makefile.PL b/Makefile.PL
index 335e751..7c520c6 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -219,23 +219,27 @@ my %flags = ();
 
 # --------------------------------------------------------------------------- #
 
+sub add_new_enum_values {
+	my (%new) = @_;
+	foreach my $enum (keys %new) {
+		foreach my $value (@{$new{$enum}}) {
+			push @{$enums{$enum}}, $value;
+		}
+	}
+}
+
 my $have_cairo_1_2 = ExtUtils::PkgConfig->atleast_version("cairo", "1.2.0");
 my $have_cairo_1_4 = ExtUtils::PkgConfig->atleast_version("cairo", "1.4.0");
-my $have_cairo_1_6 = ExtUtils::PkgConfig->atleast_version("cairo", "1.5.0"); # FIXME: 1.6
+my $have_cairo_1_6 = ExtUtils::PkgConfig->atleast_version("cairo", "1.6.0");
+my $have_cairo_1_8 = ExtUtils::PkgConfig->atleast_version("cairo", "1.8.0");
 
 if ($have_cairo_1_2) {
-	my %new = (
+	add_new_enum_values(
 		cairo_extend_t => [qw/CAIRO_EXTEND_PAD/],
 		cairo_format_t => [qw/CAIRO_FORMAT_RGB16_565/],
 		cairo_status_t => [qw/CAIRO_STATUS_INVALID_DSC_COMMENT/],
 	);
 
-	foreach my $enum (keys %new) {
-		foreach my $value (@{$new{$enum}}) {
-			push @{$enums{$enum}}, $value;
-		}
-	}
-
 	$enums{cairo_font_type_t} = [qw/
 		CAIRO_FONT_TYPE_
 		CAIRO_FONT_TYPE_TOY
@@ -283,37 +287,46 @@ if ($have_cairo_1_2) {
 }
 
 if ($have_cairo_1_4) {
-	my %new = (
+	add_new_enum_values(
 		cairo_status_t => [qw/CAIRO_STATUS_INVALID_INDEX
 		                      CAIRO_STATUS_CLIP_NOT_REPRESENTABLE/],
 	);
-
-	foreach my $enum (keys %new) {
-		foreach my $value (@{$new{$enum}}) {
-			push @{$enums{$enum}}, $value;
-		}
-	}
 }
 
 if ($have_cairo_1_6) {
+	add_new_enum_values(
+		cairo_font_type_t => [qw/CAIRO_FONT_TYPE_QUARTZ/],
+		cairo_status_t => [qw/CAIRO_STATUS_TEMP_FILE_ERROR
+				      CAIRO_STATUS_INVALID_STRIDE/],
+
+	);
+
 	$enums{cairo_ps_level_t} = [qw/
 		CAIRO_PS_LEVEL_
 		CAIRO_PS_LEVEL_2
 		CAIRO_PS_LEVEL_3
 	/];
+} else {
+	$enums{cairo_ps_level_t} = [];
+}
 
-	my %new = (
-		cairo_font_type_t => [qw/CAIRO_FONT_TYPE_QUARTZ/],
+if ($have_cairo_1_8) {
+	add_new_enum_values(
+	      cairo_status_t => [qw/CAIRO_STATUS_FONT_TYPE_MISMATCH
+				    CAIRO_STATUS_USER_FONT_IMMUTABLE
+				    CAIRO_STATUS_USER_FONT_ERROR
+				    CAIRO_STATUS_NEGATIVE_COUNT
+				    CAIRO_STATUS_INVALID_CLUSTERS
+				    CAIRO_STATUS_INVALID_SLANT
+				    CAIRO_STATUS_INVALID_WEIGHT/],
 	);
 
-	foreach my $enum (keys %new) {
-		foreach my $value (@{$new{$enum}}) {
-			push @{$enums{$enum}}, $value;
-		}
-	}
-
+	$flags{cairo_text_cluster_flags_t} = [qw/
+		CAIRO_TEXT_CLUSTER_FLAG_
+		CAIRO_TEXT_CLUSTER_FLAG_BACKWARD
+	/];
 } else {
-	$enums{cairo_ps_level_t} = [];
+	$flags{cairo_text_cluster_flags_t} = [];
 }
 
 # --------------------------------------------------------------------------- #
diff --git a/cairo-perl.h b/cairo-perl.h
index 99512de..c672e69 100644
--- a/cairo-perl.h
+++ b/cairo-perl.h
@@ -57,6 +57,13 @@ SV * newSVCairoTextExtents (cairo_text_extents_t *extents);
 SV * newSVCairoGlyph (cairo_glyph_t *glyph);
 cairo_glyph_t * SvCairoGlyph (SV *sv);
 
+#if CAIRO_VERSION >= CAIRO_VERSION_ENCODE(1, 8, 0)
+
+SV * newSVCairoTextCluster (cairo_text_cluster_t *cluster);
+cairo_text_cluster_t * SvCairoTextCluster (SV *sv);
+
+#endif
+
 SV * newSVCairoPath (cairo_path_t *path);
 cairo_path_t * SvCairoPath (SV *sv);
 
diff --git a/cairo-perl.typemap b/cairo-perl.typemap
index ed782c7..62bb02c 100644
--- a/cairo-perl.typemap
+++ b/cairo-perl.typemap
@@ -17,6 +17,7 @@ cairo_bool_t		T_UV
 cairo_font_extents_t *	T_CAIRO_FONT_EXTENTS
 cairo_text_extents_t *	T_CAIRO_TEXT_EXTENTS
 cairo_glyph_t *		T_CAIRO_GLYPH
+cairo_text_cluster_t *	T_CAIRO_TEXT_CLUSTER
 cairo_path_t *		T_CAIRO_PATH
 
 FT_Face			T_FT_FACE
@@ -27,6 +28,9 @@ INPUT
 T_CAIRO_GLYPH
 	$var = SvCairoGlyph ($arg);
 
+T_CAIRO_TEXT_CLUSTER
+	$var = SvCairoTextCluster ($arg);
+
 T_CAIRO_PATH
 	$var = SvCairoPath ($arg);
 
@@ -41,5 +45,8 @@ T_CAIRO_TEXT_EXTENTS
 T_CAIRO_GLYPH
 	$arg = newSVCairoGlyph ($var);
 
+T_CAIRO_TEXT_CLUSTER
+	$arg = newSVCairoTextCluster ($var);
+
 T_CAIRO_PATH
 	$arg = newSVCairoPath ($var);
diff --git a/examples/glyph-text.pl b/examples/glyph-text.pl
new file mode 100644
index 0000000..2c3a5a4
--- /dev/null
+++ b/examples/glyph-text.pl
@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use utf8;
+use Cairo;
+
+use constant
+{
+	WIDTH => 250,
+	HEIGHT => 200,
+	NUM_GLYPHS => 10,
+	TEXT => 'abcdefghij',
+};
+
+my $surface = Cairo::PdfSurface->create ('glyph-text.pdf', WIDTH, HEIGHT);
+my $cr = Cairo::Context->create ($surface);
+
+$cr->select_font_face ('sans', 'normal', 'normal');
+$cr->set_font_size (40);
+
+my @glyphs = ();
+my $dx = 0;
+my $dy = 0;
+foreach (0 .. NUM_GLYPHS - 1) {
+	# This selects the first few glyphs defined in the font,
+	# usually C<< !"#$%&'()* >>.
+	my $glyph = { index => $_ + 4, x => $dx, y => $dy };
+	my $extents = $cr->glyph_extents ($glyph);
+	$dx += $extents->{x_advance};
+	$dy += $extents->{y_advance};
+	push @glyphs, $glyph;
+}
+
+# One-to-one mapping between glyphs and bytes in a string.  This relies on the
+# utf8 represenation of the letters in TEXT being one byte long.
+my @clusters = map { {num_bytes => 1, num_glyphs => 1} } (1 .. NUM_GLYPHS);
+
+my $height = $cr->font_extents->{height};
+
+# Display the glyphs normally
+$cr->translate (0, $height);
+$cr->show_glyphs (@glyphs);
+
+# Display the glyphs such that when you select and copy them, you actually get
+# reverse of TEXT, i.e. 'jihgfedcba'.
+$cr->translate (0, $height);
+$cr->show_text_glyphs (TEXT, \ glyphs, \ clusters, 'backward');
+
+$cr->show_page;
diff --git a/t/Cairo.t b/t/Cairo.t
index e1b2eb1..9183a95 100644
--- a/t/Cairo.t
+++ b/t/Cairo.t
@@ -10,7 +10,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 73;
+use Test::More tests => 74;
 
 unless (eval 'use Test::Number::Delta; 1;') {
 	my $reason = 'Test::Number::Delta not available';
@@ -210,6 +210,16 @@ my @glyphs = ({ index => 1, x => 2, y => 3 },
 $cr->show_text ('Urgs?');
 $cr->show_glyphs (@glyphs);
 
+SKIP: {
+	skip 'new stuff', 1
+		unless Cairo::VERSION >= Cairo::VERSION_ENCODE (1, 8, 0);
+
+	my @clusters = map { {num_bytes => 1, num_glyphs => 1} } (1 .. 3);
+	my $text = 'abc';
+	$cr->show_text_glyphs ($text, \ glyphs, \ clusters, ['backward']);
+	is ($cr->status, 'success');
+}
+
 my $face = $cr->get_font_face;
 isa_ok ($face, 'Cairo::FontFace');
 $cr->set_font_face ($face);
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]