[cairo-commit] cairo-perl Cairo.xs, 1.1, 1.2 CairoMatrix.xs, 1.1, 1.2 CairoPattern.xs, 1.1, 1.2 CairoSurface.xs, 1.1, 1.2 ChangeLog, NONE, 1.1 MANIFEST, 1.1, 1.2 MANIFEST.SKIP, 1.1, 1.2 Makefile.PL, 1.1, 1.2 cairo-perl.h, 1.1, 1.2

Ross McFarland commit at pdx.freedesktop.org
Mon Nov 8 18:59:46 PST 2004


Committed by: rwmcfa1

Update of /cvs/cairo/cairo-perl
In directory gabe:/tmp/cvs-serv31938

Modified Files:
	Cairo.xs CairoMatrix.xs CairoPattern.xs CairoSurface.xs 
	MANIFEST MANIFEST.SKIP Makefile.PL cairo-perl.h 
Added Files:
	ChangeLog 
Log Message:
	* Cairo.xs, CairoMatrix.xs, CairoPattern.xs, CairoSurface.xs: all of 
	the create functions have been cleaned up/fixed. debug prints removed.
	create's alised to new's where appropriate.

	* MANIFEST, MANIFEST.SKIP: ChangeLog added. build and CVS skipped

	* Makefile.PL, cairo-perl.h, Cairo.xs: new (write_)boot code added,
	in progress. use build dir for most of autogen'd stuff. fixed bug in
	enums creation (= -> ==)

Index: Cairo.xs
===================================================================
RCS file: /cvs/cairo/cairo-perl/Cairo.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Cairo.xs	5 Nov 2004 01:34:04 -0000	1.1
+++ Cairo.xs	9 Nov 2004 02:59:43 -0000	1.2
@@ -9,18 +9,29 @@
 
 #include <cairo-perl.h>
 
+void
+_cairo_perl_call_XS (pTHX_ void (*subaddr) (pTHX_ CV *), CV * cv, SV ** mark)
+{
+	dSP;
+	PUSHMARK (mark);
+	(*subaddr) (aTHX_ cv);
+	PUTBACK;	/* forget return values */
+}
+
 MODULE = Cairo	PACKAGE = Cairo	PREFIX = cairo_
 
 BOOT:
-	# boot the second XS file
-	boot_Cairo__Surface (aTHX_ cv);
+	{
+#include "cairo-perl-boot.xsh"
+	}
 
 cairo_t * cairo_create (class);
-    CODE:
-	RETVAL = cairo_create ();
-	DBG ("creating cr: %p\n", RETVAL);
-    OUTPUT:
-	RETVAL
+    ALIAS:
+	Cairo::new = 1
+    C_ARGS:
+	/* void */
+    CLEANUP:
+	CAIRO_PERL_UNUSED (ix);
 
 ## shouldn't have to deal with references from perl
 ##void cairo_reference (cairo_t * cr);
@@ -29,7 +40,6 @@
 ##void cairo_destroy (cairo_t * cr);
 void cairo_DESTROY (cairo_t * cr);
     CODE:
-	DBG ("destroying cr: %p\n", cr);
 	cairo_destroy (cr);
 
 void cairo_save (cairo_t * cr);
@@ -41,11 +51,9 @@
     CODE:
 	RETVAL = cairo_create ();
 	cairo_copy (RETVAL, src);
-	DBG ("creating copy of %p: %p\n", src, RETVAL);
     OUTPUT:
 	RETVAL
 
-
 void cairo_set_target_surface (cairo_t * cr, cairo_surface_t * surface);
 
 void cairo_set_target_image (cairo_t * cr, char * data, cairo_format_t format, int width, int height, int stride);
@@ -115,7 +123,7 @@
 
 ## XXX: double *
 ##void cairo_set_dash (cairo_t * cr, double * dashes, int ndash, double offset);
-void cairo_set_dash (cairo_t * cr, double offset, double dash1, ...)
+void cairo_set_dash (cairo_t * cr, double offset, dash1, ...)
     PREINIT:
 	DOUBLES_DECLARE
     CODE:
@@ -292,7 +300,10 @@
 
 const char * cairo_status_string (cairo_t * cr);
 
-cairo_surface_t * cairo_surface_create_for_image (char * data, cairo_format_t format, int width, int height, int stride);
+## XXX: this one is kinda odd, image data is the first param
+cairo_surface_t * cairo_surface_create_for_image (class, char * data, cairo_format_t format, int width, int height, int stride);
+    C_ARGS:
+	data, format, width, height, stride
 
 cairo_surface_t * cairo_surface_create_similar (cairo_surface_t * other, cairo_format_t format, int width, int height);
 
@@ -310,32 +321,44 @@
 
 cairo_filter_t cairo_surface_get_filter (cairo_surface_t * surface);
 
-cairo_surface_t * cairo_image_surface_create (cairo_format_t format, int width, int height);
+cairo_surface_t * cairo_image_surface_create (class, cairo_format_t format, int width, int height);
+    C_ARGS:
+	format, width, height
 
-cairo_surface_t * cairo_image_surface_create_for_data (char * data, cairo_format_t format, int width, int height, int stride);
+cairo_surface_t * cairo_image_surface_create_for_data (class, char * data, cairo_format_t format, int width, int height, int stride);
+    C_ARGS:
+	data, format, width, height, stride
 
 #ifdef CAIRO_HAS_PS_SURFACE
 
-cairo_surface_t * cairo_ps_surface_create (FILE * file, double width_inches, double height_inches, double x_pixels_per_inch, double y_pixels_per_inch);
+cairo_surface_t * cairo_ps_surface_create (class, FILE * file, double width_inches, double height_inches, double x_pixels_per_inch, double y_pixels_per_inch);
+   C_ARGS:
+	file, width_inches, height_inches, x_pixels_per_inch, y_pixels_per_inch
 
 #endif /* CAIRO_HAS_PS_SURFACE */
 
 #ifdef CAIRO_HAS_PNG_SURFACE
 
-cairo_surface_t * cairo_png_surface_create (FILE * file, cairo_format_t format, int width, int height);
+cairo_surface_t * cairo_png_surface_create (class, FILE * file, cairo_format_t format, int width, int height);
+    C_ARGS:
+	file, format, width, height
 
 #endif /* CAIRO_HAS_PNG_SURFACE */
 
 #ifdef CAIRO_HAS_XLIB_SURFACE
 
 ## XXX: Display, Drawable ...
-cairo_surface_t * cairo_xlib_surface_create (Display * dpy, Drawable drawable, Visual * visual, cairo_format_t format, Colormap colormap);
+cairo_surface_t * cairo_xlib_surface_create (class, Display * dpy, Drawable drawable, Visual * visual, cairo_format_t format, Colormap colormap);
+    C_ARGS:
+	dpy, drawable, visual, format, colormap
 
 #endif /* CAIRO_HAS_XLIB_SURFACE */
 
 #ifdef CAIRO_HAS_GLITZ_SURFACE
 
 ## XXX: glitz_surface_t
-cairo_surface_t * cairo_glitz_surface_create (glitz_surface_t * surface);
+cairo_surface_t * cairo_glitz_surface_create (class, glitz_surface_t * surface);
+    C_ARGS:
+	surface
 
 #endif /* CAIRO_HAS_GLITZ_SURFACE */

Index: CairoMatrix.xs
===================================================================
RCS file: /cvs/cairo/cairo-perl/CairoMatrix.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- CairoMatrix.xs	5 Nov 2004 01:34:04 -0000	1.1
+++ CairoMatrix.xs	9 Nov 2004 02:59:43 -0000	1.2
@@ -11,16 +11,17 @@
 MODULE = Cairo::Matrix	PACKAGE = Cairo::Matrix PREFIX = cairo_matrix_
 
 cairo_matrix_t * cairo_matrix_create (class);
-    CODE:
-	RETVAL = cairo_matrix_create ();
-	DBG ("creating matrix: %p\n", RETVAL);
-    OUTPUT:
-	RETVAL
+    ALIAS:
+	Cairo::Matrix::new = 1
+    C_ARGS:
+	/* void */
+    CLEANUP:
+	CAIRO_PERL_UNUSED (ix);
 
+## destroy should happen auto-magically
 ##void cairo_matrix_destroy (cairo_matrix_t * matrix);
 void cairo_matrix_DESTROY (cairo_matrix_t * matrix);
     CODE:
-	DBG ("destroying matrix: %p\n", matrix);
 	cairo_matrix_destroy (matrix);
 
 ## XXX: cairo_status_t cairo_matrix_copy (cairo_matrix_t * matrix, const cairo_matrix_t * other);

Index: CairoPattern.xs
===================================================================
RCS file: /cvs/cairo/cairo-perl/CairoPattern.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- CairoPattern.xs	5 Nov 2004 01:34:04 -0000	1.1
+++ CairoPattern.xs	9 Nov 2004 02:59:43 -0000	1.2
@@ -11,14 +11,26 @@
 MODULE = Cairo::Pattern	PACKAGE = Cairo::Pattern PREFIX = cairo_pattern_
 
 cairo_pattern_t * cairo_pattern_create_for_surface (cairo_surface_t * surface);
+    ALIAS:
+	Cairo::Pattern::new = 1
+    CLEANUP:
+	CAIRO_PERL_UNUSED (ix);
 
-cairo_pattern_t * cairo_pattern_create_linear (double x0, double y0, double x1, double y1);
+cairo_pattern_t * cairo_pattern_create_linear (class, double x0, double y0, double x1, double y1);
+    C_ARGS:
+	x0, y0, x1, y1
 
-cairo_pattern_t * cairo_pattern_create_radial (double cx0, double cy0, double radius0, double cx1, double cy1, double radius1);
+cairo_pattern_t * cairo_pattern_create_radial (class, double cx0, double cy0, double radius0, double cx1, double cy1, double radius1);
+    C_ARGS:
+	cx0, cy0, radius0, cx1, cy1, radius1
 
-void cairo_pattern_reference (cairo_pattern_t * pattern);
+## shouldn't have to deal with references from perl
+##void cairo_pattern_reference (cairo_pattern_t * pattern);
 
-void cairo_pattern_destroy (cairo_pattern_t * pattern);
+## destroy should happen auto-magically
+void cairo_pattern_DESTROY (cairo_pattern_t * pattern);
+    CODE:
+	cairo_pattern_destroy (pattern);
   
 cairo_status_t cairo_pattern_add_color_stop (cairo_pattern_t * pattern, double offset, double red, double green, double blue, double alpha);
   

Index: CairoSurface.xs
===================================================================
RCS file: /cvs/cairo/cairo-perl/CairoSurface.xs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- CairoSurface.xs	5 Nov 2004 01:34:04 -0000	1.1
+++ CairoSurface.xs	9 Nov 2004 02:59:43 -0000	1.2
@@ -10,19 +10,18 @@
 
 MODULE = Cairo::Surface	PACKAGE = Cairo::ImageSurface	PREFIX = cairo_image_surface_
 
-## XXX: add format
 cairo_surface_t * cairo_image_surface_create (class, cairo_format_t format, int width, int height)
-    CODE:
-	RETVAL = cairo_image_surface_create (format, width, height);
-	DBG ("creating surface %p\n", RETVAL);
-    OUTPUT:
-	RETVAL
+    ALIAS:
+	Cairo::Surface::new = 1
+    C_ARGS:
+	format, width, height
+    CLEANUP:
+	CAIRO_PERL_UNUSED (ix);
 
 MODULE = Cairo::Surface	PACKAGE = Cairo::Surface PREFIX = cairo_surface_
 
-## manipulate state objects
-
+## destroy should happen auto-magically
+## void cairo_surface_destroy (cairo_surface_t * surface);
 void cairo_surface_DESTROY (cairo_surface_t * surface);
     CODE:
-	DBG ("destroying surface: %p\n", surface);
 	cairo_surface_destroy (surface);

--- NEW FILE: ChangeLog ---
2004/11/08 20:44 (-0500) rwmcfa1

	* Cairo.xs, CairoMatrix.xs, CairoPattern.xs, CairoSurface.xs: all of 
	the create functions have been cleaned up/fixed. debug prints removed.
	create's alised to new's where appropriate.

	* MANIFEST, MANIFEST.SKIP: ChangeLog added. build and CVS skipped

	* Makefile.PL, cairo-perl.h, Cairo.xs: new (write_)boot code added,
	in progress. use build dir for most of autogen'd stuff

Index: MANIFEST
===================================================================
RCS file: /cvs/cairo/cairo-perl/MANIFEST,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- MANIFEST	5 Nov 2004 01:34:04 -0000	1.1
+++ MANIFEST	9 Nov 2004 02:59:43 -0000	1.2
@@ -6,6 +6,7 @@
 CairoMatrix.xs
 CairoPattern.xs
 CairoSurface.xs
+ChangeLog
 LICENSE
 Makefile.PL
 MANIFEST

Index: MANIFEST.SKIP
===================================================================
RCS file: /cvs/cairo/cairo-perl/MANIFEST.SKIP,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- MANIFEST.SKIP	5 Nov 2004 01:34:04 -0000	1.1
+++ MANIFEST.SKIP	9 Nov 2004 02:59:43 -0000	1.2
@@ -1,10 +1,9 @@
 .*\.bak
 blib
 .*\.bs
+build
 .*\.c
-CairoEnums\.xs
-cairo-perl-auto\.typemap
-cairo-perl-enums\.h
+CVS
 Makefile$
 Makefile\.old
 .*\.o

Index: Makefile.PL
===================================================================
RCS file: /cvs/cairo/cairo-perl/Makefile.PL,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Makefile.PL	5 Nov 2004 01:34:04 -0000	1.1
+++ Makefile.PL	9 Nov 2004 02:59:43 -0000	1.2
@@ -5,12 +5,20 @@
 #
 # $Header$
 #
+# TODO:
+#	- file spec
+#	- pull a lot of this out into a helper pm or something
+#
 
 use strict;
 use warnings;
 use Data::Dumper;
 use ExtUtils::PkgConfig;
 use ExtUtils::MakeMaker;
+use IO::File;
+
+our $autogen_dir = 'build';
+mkdir $autogen_dir unless (-d $autogen_dir);
 
 my %cairo_cfg = ExtUtils::PkgConfig->find ('cairo');
 #print Dumper (\%cairo_cfg);
@@ -108,8 +116,13 @@
 	/],
 );
 
-my %xs = map { /^(.*)\.xs$/; $_ => "$1.c"; } <*.xs>, do_enums ();
-#print Dumper (\%xs);
+my @xs_files = <*.xs>;
+my %xs = map { /^(.*)\.xs$/; $_ => "$1.c"; } @xs_files, do_enums ();
+
+write_boot (
+	xs_files => \@xs_files,
+	ignore => '(^Cairo$|Enums)',
+);
 
 my @typemaps = do_typemaps ();
 push @typemaps, 'cairo-perl.typemap';
@@ -117,7 +130,7 @@
 WriteMakefile (
 	NAME => 'Cairo',
 	VERSION_FROM => 'Cairo.pm',
-	INC => '-I. '.$cairo_cfg{cflags},
+	INC => '-I. -I./'.$autogen_dir.' '.$cairo_cfg{cflags},
 	LIBS => $cairo_cfg{libs},
 	XS => \%xs,
 	OBJECT => q/$(O_FILES)/,
@@ -131,14 +144,61 @@
 sub postamble
 {
 	"realclean ::
-	-\$(RM_RF)  CairoEnums.xs cairo-perl-enums.h cairo-perl-auto.typemap";
+	-\$(RM_RF) $autogen_dir CairoEnums.xs";
 }
 
 package main;
 
+# copied/borrowed from Gtk2-Perl's CodeGen
+sub write_boot
+{
+	my %opts = (
+		ignore => '^[^:]+$',	# ignore package with no colons in it
+		filename => $autogen_dir.'/cairo-perl-boot.xsh',
+		'glob' => 'xs/*.xs',
+		@_,
+	);
+	my $ignore = $opts{ignore};
+
+	my $file = IO::File->new (">$opts{filename}")
+		or die "Cannot write $opts{filename}: $!"; 
+
+	print $file "\n\n/* This file is automatically generated, any changes made here will be lost! */\n\n";
+
+	my %boot=();
+
+	my @xs_files = 'ARRAY' eq ref $opts{xs_files}
+	             ? @{ $opts{xs_files} }
+	             : glob $opts{'glob'};
+
+	foreach my $xsfile (@xs_files) {
+		my $in = IO::File->new ($xsfile)
+				or die "can't open $xsfile: $!\n";
+
+		while (<$in>) {
+			next unless m/^MODULE\s*=\s*(\S+)/;
+			#warn "found $1 in $&\n";
+
+			my $package = $1;
+			
+			next if $package =~ m/$ignore/;
+
+			$package =~ s/:/_/g;
+			my $sym = "boot_$package";
+			print $file "CAIRO_PERL_CALL_BOOT ($sym);\n"
+				unless $boot{$sym};
+			$boot{$sym}++;
+		}
+
+		close $in;
+	}
+
+	close $file;
+}
+
 sub do_typemaps
 {
-	my $cairo_perl = 'cairo-perl-auto.typemap';
+	my $cairo_perl = $autogen_dir.'/cairo-perl-auto.typemap';
 	open TYPEMAP, '>'.$cairo_perl
 		or die "unable to open ($cairo_perl) for output";
 
@@ -271,7 +331,7 @@
 
 		foreach $full (@enums)
 		{
-			$str .= "	else if (val = $full)
+			$str .= "	else if (val == $full)
 		return newSVpv (\"$full\", 0);
 ";
 		}
@@ -279,7 +339,7 @@
 		$str;
 	}
 
-	open HDR, ">cairo-perl-enums.h";
+	open HDR, ">$autogen_dir/cairo-perl-enums.h";
 	print HDR "/*
  *
  */

Index: cairo-perl.h
===================================================================
RCS file: /cvs/cairo/cairo-perl/cairo-perl.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cairo-perl.h	5 Nov 2004 01:34:04 -0000	1.1
+++ cairo-perl.h	9 Nov 2004 02:59:44 -0000	1.2
@@ -17,8 +17,29 @@
 #include <stdio.h>
 #include <cairo.h>
 
+#define CAIRO_PERL_UNUSED(var) if (0) { (var) = (var); }
+
+/* XXX: copied/borrowed from gtk2-perl */
+void _cairo_perl_call_XS (pTHX_ void (*subaddr) (pTHX_ CV *), CV * cv, SV ** mark);
+/* XXX: copied/borrowed from gtk2-perl
+ *
+ * call the boot code of a module by symbol rather than by name.
+ *
+ * in a perl extension which uses several xs files but only one pm, you
+ * need to bootstrap the other xs files in order to get their functions
+ * exported to perl.  if the file has MODULE = Foo::Bar, the boot symbol
+ * would be boot_Foo__Bar.
+ */
+
+#define CAIRO_PERL_CALL_BOOT(name)				\
+	{							\
+		extern XS(name);				\
+		_cairo_perl_call_XS (aTHX_ name, cv, mark);	\
+	}
+
 #include <cairo-perl-enums.h>
 
+
 #ifdef CAIRO_DEBUG
 # define DBG(format, args...)	fprintf (stderr, format , ## args)
 #else




More information about the cairo-commit mailing list