[perl-Cairo/native-paths] Convert Cairo::Paths to native data structures

[Torsten SchÃnfeld <tsch src gnome org>]

commit 532693b489bc68604613ca6591ab4ee0a0970deb
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sat May 23 00:05:45 2009 +0200

    Convert Cairo::Paths to native data structures
    
    Instead of using tied arrays to represent cairo_path_t, always convert them
    completely to and from normal arrays.

 CairoPath.xs |  447 ++++++++++------------------------------------------------
 1 files changed, 73 insertions(+), 374 deletions(-)
---
diff --git a/CairoPath.xs b/CairoPath.xs
index 227a88a..5913abf 100644
--- a/CairoPath.xs
+++ b/CairoPath.xs
@@ -9,79 +9,63 @@
 #include <cairo-perl.h>
 #include <cairo-perl-private.h>
 
-#include "ppport.h"
-
-#define MY_MAGIC_SIG 0xCAFE /* Let's hope this is unique enough */
-
-static MAGIC *
-cairo_perl_mg_find (SV *sv, int type)
-{
-	if (sv) {
-		MAGIC *mg;
-		for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
-			if (mg->mg_type == type && mg->mg_private == MY_MAGIC_SIG)
-				return mg;
-		}
-	}
-	return NULL;
-}
-
-static void *
-cairo_perl_mg_get (SV * sv)
-{
-	MAGIC * mg;
-	if (!cairo_perl_sv_is_ref (sv) ||
-	    !(mg = cairo_perl_mg_find (SvRV (sv), PERL_MAGIC_ext)))
-		return NULL;
-	return mg->mg_ptr;
-}
-
-/* ------------------------------------------------------------------------- */
-
-static SV *
-create_tie (SV * sv, void * object, const char * package)
+SV *
+newSVCairoPath (cairo_path_t * path)
 {
-	SV * tie;
-	HV * stash;
-	MAGIC * mg;
+	AV * av;
+	int i;
+	cairo_path_data_t *data;
 
-	/* Create a tied reference. */
-	tie = newRV_noinc (sv);
-	stash = gv_stashpv (package, TRUE);
-	sv_bless (tie, stash);
-	sv_magic (sv, tie, PERL_MAGIC_tied, Nullch, 0);
+	av = newAV ();
 
-	/* Associate the array with the original path via magic. */
-	sv_magic (sv, 0, PERL_MAGIC_ext, (const char *) object, 0);
+	for (i = 0; i < path->num_data; i += path->data[i].header.length) {
+		HV *hash;
+		AV *points;
+		AV *point;
 
-	mg = mg_find (sv, PERL_MAGIC_ext);
+		data = &path->data[i];
+		hash = newHV ();
+		points = newAV ();
 
-	/* Mark the mg as belonging to us. */
-	mg->mg_private = MY_MAGIC_SIG;
+		switch (data->header.type) {
+		    case CAIRO_PATH_MOVE_TO:
+		    case CAIRO_PATH_LINE_TO:
+			point = newAV ();
+			av_push (point, newSVnv (data[1].point.x));
+			av_push (point, newSVnv (data[1].point.y));
+			av_push (points, newRV_noinc ((SV *) point));
+			break;
+		    case CAIRO_PATH_CURVE_TO:
+			point = newAV ();
+			av_push (point, newSVnv (data[1].point.x));
+			av_push (point, newSVnv (data[1].point.y));
+			av_push (points, newRV_noinc ((SV *) point));
+
+			point = newAV ();
+			av_push (point, newSVnv (data[2].point.x));
+			av_push (point, newSVnv (data[2].point.y));
+			av_push (points, newRV_noinc ((SV *) point));
+
+			point = newAV ();
+			av_push (point, newSVnv (data[3].point.x));
+			av_push (point, newSVnv (data[3].point.y));
+			av_push (points, newRV_noinc ((SV *) point));
+			break;
+		    case CAIRO_PATH_CLOSE_PATH:
+			break;
+		}
 
-#if PERL_REVISION <= 5 && PERL_VERSION <= 6
-	/* perl 5.6.x doesn't actually set mg_ptr when namlen == 0, so do it
-	 * now. */
-	mg->mg_ptr = (char *) object;
-#endif /* 5.6.x */
+		hv_store (hash, "type", 4, cairo_path_data_type_to_sv (data->header.type), 0);
+		hv_store (hash, "points", 6, newRV_noinc ((SV *) points), 0);
 
-	return tie;
-}
+		av_push (av, newRV_noinc ((SV *) hash));
+	}
 
-static SV *
-create_tied_av (void * object, const char * package)
-{
-	return create_tie ((SV *) newAV (), object, package);
-}
+	cairo_path_destroy (path);
 
-static SV *
-create_tied_hv (void * object, const char * package)
-{
-	return create_tie ((SV *) newHV (), object, package);
+	return newRV_noinc ((SV *) av);
 }
 
-/* ------------------------------------------------------------------------- */
-
 #define FETCH_POINT(i)						\
 	if ((svp = av_fetch (points, i, 0)) &&			\
 	    cairo_perl_sv_is_defined (*svp))			\
@@ -93,45 +77,12 @@ create_tied_hv (void * object, const char * package)
 			data[i+1].point.y = SvNV (*svp);	\
 	}
 
-static void
-fill_data_from_array (cairo_path_data_t * data, cairo_path_data_type_t type, AV * points)
-{
-	SV ** svp;
-	AV * point;
-	switch (type) {
-	    case CAIRO_PATH_MOVE_TO:
-		data->header.type = CAIRO_PATH_MOVE_TO;
-		data->header.length = 2;
-		FETCH_POINT (0);
-		break;
-
-	    case CAIRO_PATH_LINE_TO:
-		data->header.type = CAIRO_PATH_LINE_TO;
-		data->header.length = 2;
-		FETCH_POINT (0);
-		break;
-
-	    case CAIRO_PATH_CURVE_TO:
-		data->header.type = CAIRO_PATH_CURVE_TO;
-		data->header.length = 4;
-		FETCH_POINT (0);
-		FETCH_POINT (1);
-		FETCH_POINT (2);
-		break;
-
-	    case CAIRO_PATH_CLOSE_PATH:
-		data->header.type = CAIRO_PATH_CLOSE_PATH;
-		data->header.length = 1;
-		break;
-	}
-}
-
 /* This uses cairo_perl_alloc_temp.  So the return value is only valid until
  * the next FREETMPS occurs.  At the moment, the only cairo function that
  * *takes* a cairo_path_t is cairo_append_path, and it acts on the path
  * immediately and does not store it.  So that's fine. */
-static cairo_path_t *
-path_from_array (SV * sv)
+cairo_path_t *
+SvCairoPath (SV * sv)
 {
 	AV *av;
 	int i, num_data;
@@ -180,7 +131,7 @@ path_from_array (SV * sv)
 	for (i = 0; i <= av_len (av); i++) {
 		SV **svp;
 		HV *hv;
-		AV *points;
+		AV *points, *point;
 
 		svp = av_fetch (av, i, 0);
 		hv = (HV *) SvRV (*svp);
@@ -193,288 +144,36 @@ path_from_array (SV * sv)
 		points = (AV *) SvRV (*svp);
 
 		svp = hv_fetch (hv, "type", 4, 0);
-		fill_data_from_array (data, cairo_path_data_type_from_sv (*svp), points);
-		data += data->header.length;
-	}
-
-	return path;
-}
-
-SV *
-newSVCairoPath (cairo_path_t * path)
-{
-	return create_tied_av (path, "Cairo::Path");
-}
-
-cairo_path_t *
-SvCairoPath (SV * sv)
-{
-	cairo_path_t * path;
-	path = cairo_perl_mg_get (sv);
-	if (!path) {
-		path = path_from_array (sv);
-	}
-	return path;
-}
-
-/* ------------------------------------------------------------------------- */
-
-static SV *
-newSVCairoPathData (cairo_path_data_t * data)
-{
-	return create_tied_hv (data, "Cairo::Path::Data");
-}
 
-static cairo_path_data_t *
-SvCairoPathData (SV * sv)
-{
-	return cairo_perl_mg_get (sv);
-}
-
-/* ------------------------------------------------------------------------- */
-
-static SV *
-newSVCairoPathPoints (cairo_path_data_t * data)
-{
-	return create_tied_av (data, "Cairo::Path::Points");
-}
-
-static cairo_path_data_t *
-SvCairoPathPoints (SV * sv)
-{
-	return cairo_perl_mg_get (sv);
-}
-
-/* ------------------------------------------------------------------------- */
-
-static SV *
-newSVCairoPathPoint (cairo_path_data_t * data)
-{
-	return create_tied_av (data, "Cairo::Path::Point");
-}
-
-static cairo_path_data_t *
-SvCairoPathPoint (SV * sv)
-{
-	return cairo_perl_mg_get (sv);
-}
-
-/* ------------------------------------------------------------------------- */
-
-static IV
-n_points (cairo_path_data_t * data)
-{
-	switch (data->header.type) {
-	    case CAIRO_PATH_MOVE_TO:
-	    case CAIRO_PATH_LINE_TO:
-		return 1;
-	    case CAIRO_PATH_CURVE_TO:
-		return 3;
-	    case CAIRO_PATH_CLOSE_PATH:
-		return 0;
-	}
-	return -1;
-}
-
-/* ------------------------------------------------------------------------- */
-
-MODULE = Cairo::Path	PACKAGE = Cairo::Path
+		switch (cairo_path_data_type_from_sv (*svp)) {
+		    case CAIRO_PATH_MOVE_TO:
+			data->header.type = CAIRO_PATH_MOVE_TO;
+			data->header.length = 2;
+			FETCH_POINT (0);
+			break;
 
-void DESTROY (SV * sv)
-    PREINIT:
-	cairo_path_t *path;
-    CODE:
-	path = SvCairoPath (sv);
-	if (path) {
-#if PERL_REVISION <= 5 && PERL_VERSION <= 6
-		/* Unset mg_ptr to prevent perl 5.6.x from trying to free it again. */
-		MAGIC *mg = cairo_perl_mg_find (SvRV (sv), PERL_MAGIC_ext);
-		mg->mg_ptr = NULL;
-#endif /* 5.6.x */
-		cairo_path_destroy (path);
-	}
+		    case CAIRO_PATH_LINE_TO:
+			data->header.type = CAIRO_PATH_LINE_TO;
+			data->header.length = 2;
+			FETCH_POINT (0);
+			break;
 
-IV FETCHSIZE (cairo_path_t * path)
-    PREINIT:
-	int i;
-    CODE:
-	RETVAL = 0;
-	for (i = 0; i < path->num_data; i += path->data[i].header.length)
-		RETVAL++;
-    OUTPUT:
-	RETVAL
+		    case CAIRO_PATH_CURVE_TO:
+			data->header.type = CAIRO_PATH_CURVE_TO;
+			data->header.length = 4;
+			FETCH_POINT (0);
+			FETCH_POINT (1);
+			FETCH_POINT (2);
+			break;
 
-SV * FETCH (cairo_path_t * path, IV index)
-    PREINIT:
-	int i, counter = 0;
-    CODE:
-	RETVAL = &PL_sv_undef;
-	for (i = 0; i < path->num_data; i += path->data[i].header.length) {
-		if (counter++ == index) {
-			cairo_path_data_t *data = &path->data[i];
-			RETVAL = newSVCairoPathData (data);
+		    case CAIRO_PATH_CLOSE_PATH:
+			data->header.type = CAIRO_PATH_CLOSE_PATH;
+			data->header.length = 1;
 			break;
 		}
-	}
-    OUTPUT:
-	RETVAL
-
-# --------------------------------------------------------------------------- #
-
-MODULE = Cairo::Path	PACKAGE = Cairo::Path::Data
-
-SV * FETCH (SV * sv, const char * key)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathData (sv);
-	if (strEQ (key, "type")) {
-		RETVAL = cairo_path_data_type_to_sv (data->header.type);
-	} else if (strEQ (key, "points")) {
-		RETVAL = newSVCairoPathPoints (data);
-	} else {
-		croak ("Unknown key '%s' for Cairo::Path::Data", key);
-		RETVAL = NULL;
-	}
-    OUTPUT:
-	RETVAL
-
-SV * STORE (SV * sv, const char * key, SV * value)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathData (sv);
-	if (strEQ (key, "points")) {
-		RETVAL = newSVCairoPathPoints (data);
-		fill_data_from_array (data, data->header.type, (AV *) SvRV (value));
-	} else {
-		croak ("Unhandled key '%s' for Cairo::Path::Data; "
-		       "only changing 'points' is supported", key);
-		RETVAL = NULL;
-	}
-    OUTPUT:
-	RETVAL
-
-bool EXISTS (sv, const char * key)
-    CODE:
-	if (strEQ (key, "type")) {
-		RETVAL = TRUE;
-	} else if (strEQ (key, "points")) {
-		RETVAL = TRUE;
-	} else {
-		RETVAL = FALSE;
-	}
-    OUTPUT:
-	RETVAL
-
-const char * FIRSTKEY (sv)
-    CODE:
-	RETVAL = "type";
-    OUTPUT:
-	RETVAL
-
-const char * NEXTKEY (sv, const char * lastkey)
-    CODE:
-	if (strEQ (lastkey, "type")) {
-		RETVAL = "points";
-	} else {
-		RETVAL = NULL;
-	}
-    OUTPUT:
-	RETVAL
-
-# --------------------------------------------------------------------------- #
-
-MODULE = Cairo::Path	PACKAGE = Cairo::Path::Points
-
-IV FETCHSIZE (SV * sv)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathPoints (sv);
-	RETVAL = n_points (data);
-    OUTPUT:
-	RETVAL
-
-SV * FETCH (SV * sv, IV index)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathPoints (sv);
-	if (index >= 0 && index < n_points (data)) {
-		RETVAL = newSVCairoPathPoint (&data[index + 1]);
-	} else {
-		RETVAL = &PL_sv_undef;
-	}
-    OUTPUT:
-	RETVAL
-
-SV * STORE (SV * sv, IV index, SV * value)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathPoints (sv);
-	if (index >= 0 && index < n_points (data)) {
-		cairo_path_data_t * point;
-		AV * av;
-		SV ** svp;
-		point = &data[index + 1];
-		RETVAL = newSVCairoPathPoint (point);
-		av = (AV *) SvRV (value);
-		if ((svp = av_fetch (av, 0, 0)))
-			point->point.x = SvNV (*svp);
-		if ((svp = av_fetch (av, 1, 0)))
-			point->point.y = SvNV (*svp);
-	} else {
-		RETVAL = &PL_sv_undef;
-	}
-    OUTPUT:
-	RETVAL
 
-# --------------------------------------------------------------------------- #
-
-MODULE = Cairo::Path	PACKAGE = Cairo::Path::Point
-
-IV FETCHSIZE (sv)
-    CODE:
-	RETVAL = 2;
-    OUTPUT:
-	RETVAL
-
-SV * FETCH (SV * sv, IV index)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathPoint (sv);
-	switch (index) {
-	    case 0:
-		RETVAL = newSVnv (data->point.x);
-		break;
-	    case 1:
-		RETVAL = newSVnv (data->point.y);
-		break;
-	    default:
-		RETVAL = &PL_sv_undef;
-		break;
+		data += data->header.length;
 	}
-    OUTPUT:
-	RETVAL
 
-SV * STORE (SV * sv, IV index, NV value)
-    PREINIT:
-	cairo_path_data_t * data;
-    CODE:
-	data = SvCairoPathPoint (sv);
-	switch (index) {
-	    case 0:
-		RETVAL = newSVnv (data->point.x = value);
-		break;
-	    case 1:
-		RETVAL = newSVnv (data->point.y = value);
-		break;
-	    default:
-		RETVAL = &PL_sv_undef;
-		break;
-	}
-    OUTPUT:
-	RETVAL
+	return path;
+}