[cairo-commit] cairo-perl/examples/png README, 1.1, 1.2 bevels.pl, NONE, 1.1 caps_joins.pl, 1.2, 1.3 hering.pl, 1.2, 1.3 spline-pipeline.pl, NONE, 1.1 text-rotate.pl, NONE, 1.1 text.pl, NONE, 1.1

Torsten Schoenfeld commit at pdx.freedesktop.org
Sat Jun 3 07:21:11 PDT 2006 

Committed by: tsch

Update of /cvs/cairo/cairo-perl/examples/png
In directory kemper:/tmp/cvs-serv11079/examples/png

Modified Files:
	README caps_joins.pl hering.pl 
Added Files:
	bevels.pl spline-pipeline.pl text-rotate.pl text.pl 
Log Message:
	* Cairo.pm: Document Cairo::get_group_target, Cairo::new_sub_path,
	Cairo::Pattern::get_type, Cairo::set_scaled_font, Cairo::version,
	and Cairo::version_string.

	* t/Cairo.t, Cairo.xs: Allow Cairo::version[_string] to be called
	as a function and as a class method.

	* CairoPattern.xs, CairoSurface.xs, t/CairoSurface.t, Makefile.PL,
	examples/simple.pl, examples/png/caps_joins.pl,
	examples/png/hering.pl: Whitespace fixes.

	* t/CairoSurface.t, CairoSurface.xs: Wrap
	cairo_surface_get_content.

	* MakeHelper.pm: Don't add a linebreak to croaks so perl prints
	line information.

	* Makefile.PL: Require cairo 1.1.7.

	* examples/png/README, examples/png/bevels.pl,
	examples/png/spline-pipeline.pl, examples/png/text-rotate.pl,
	examples/png/text.pl: New example ports.


Index: README
===================================================================
RCS file: /cvs/cairo/cairo-perl/examples/png/README,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- README	28 Nov 2004 05:30:30 -0000	1.1
+++ README	3 Jun 2006 14:21:10 -0000	1.2
@@ -1,6 +1,7 @@
-These files are ports of the cairo-demo/png examples as of 11/27/04. This stuff
-isn't done in perlish ways so you've been warned. You'll need png backend
+These files are ports of the cairo-demo/png examples as of 2006-05-28. This
+stuff isn't done in perlish ways so you've been warned. You'll need png backend
 support.
 
 TODO:
-	text, text-rotate: need freetype stuff worked out...
+	snapping
+	star_and_ring

--- NEW FILE: bevels.pl ---
#!/usr/bin/perl

# This simple demo demonstrates how cairo may be used to draw
# old-fashioned widgets with bevels that depend on lines exactly
# 1-pixel wide.
#
# This demo is really only intended to demonstrate how someone might
# emulate antique graphics, and this style is really not recommended
# for future code. Some notes:
#
# 1) We're not going for pixel-perfect emulation of crusty graphics
#    here. Notice that the checkmark is rendered nicely by cairo
#    without jaggies.
#
# 2) The use of opaque highlight/lowlight colors here is particularly
#    passe. A much more interesting approach would blend translucent
#    colors over an arbitrary background.
#
# 3) This widget style is optimized for device-pixels. As such, it
#    won't scale up very well, (except for integer scale
#    factors). I'd be more interested to see future widget schemes
#    that look good at all scales.
#
# One way to get better-looking graphics at all scales might be to
# introduce some device-pixel snapping into cairo for
# horizontal/vertical path components. Then, a lot of the 0.5
# adjustments could disappear from code like this, and then this code
# could become more scalable.

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 100,
	HEIGHT => 70,
	M_PI => 4 * atan2(1, 1),
};

my $BG_COLOR =  [ 0xd4, 0xd0, 0xc8 ];
my $HI_COLOR_1 = [ 0xff, 0xff, 0xff ];
my $HI_COLOR_2 = [ 0xd4, 0xd0, 0xc8 ];
my $LO_COLOR_1 = [ 0x80, 0x80, 0x80 ];
my $LO_COLOR_2 = [ 0x40, 0x40, 0x40 ];
my $BLACK  = [ 0, 0, 0 ];

sub set_hex_color
{
	my ($cr, $color) = @_;
	$cr->set_source_rgb (
		$color->[0] / 255.0,
		$color->[1] / 255.0,
		$color->[2] / 255.0);
}

sub bevel_box
{
	my ($cr, $x, $y, $width, $height) = @_;

	$cr->save;

	$cr->set_line_width (1.0);
	$cr->set_line_cap ('square');

	# Fill and highlight
	set_hex_color ($cr, $HI_COLOR_1);
	$cr->rectangle ($x, $y, $width, $height);
	$cr->fill;

	# 2nd hightlight
	set_hex_color ($cr, $HI_COLOR_2);
	$cr->move_to ($x + 1.5, $y + $height - 1.5);
	$cr->rel_line_to ($width - 3, 0);
	$cr->rel_line_to (0, - ($height - 3));
	$cr->stroke;

	# 1st lowlight
	set_hex_color ($cr, $LO_COLOR_1);
	$cr->move_to ($x + 0.5, $y + $height - 1.5);
	$cr->rel_line_to (0, - ($height - 2));
	$cr->rel_line_to ($width - 2, 0);
	$cr->stroke;

	# 2nd lowlight
	set_hex_color ($cr, $LO_COLOR_2);
	$cr->move_to ($x + 1.5, $y + $height - 2.5);
	$cr->rel_line_to (0, - ($height - 4));
	$cr->rel_line_to ($width - 4, 0);
	$cr->stroke;

	$cr->restore;
}

sub bevel_circle
{
	my ($cr, $x, $y, $width) = @_;

	my $radius = ($width - 1)/2.0 - 0.5;

	$cr->save;

	$cr->set_line_width (1);

	# Fill and highlight
	set_hex_color ($cr, $HI_COLOR_1);
	$cr->arc ($x+$radius+1.5, $y+$radius+1.5, $radius, 0, 2*M_PI);
	$cr->fill;

	# 2nd highlight
	set_hex_color ($cr, $HI_COLOR_2);
	$cr->arc ($x+$radius+0.5, $y+$radius+0.5, $radius, 0, 2*M_PI);
	$cr->stroke;

	# 1st lowlight
	set_hex_color ($cr, $LO_COLOR_1);
	$cr->arc ($x+$radius+0.5, $y+$radius+0.5, $radius, 3*M_PI/4, 7*M_PI/4);
	$cr->stroke;

	# 2nd lowlight
	set_hex_color ($cr, $LO_COLOR_2);
	$cr->arc ($x+$radius+1.5, $y+$radius+1.5, $radius, 3*M_PI/4, 7*M_PI/4);
	$cr->stroke;

	$cr->restore;
}

# Slightly smaller than specified to match interior size of bevel_box
sub flat_box
{
	my ($cr, $x, $y, $width, $height) = @_;

	$cr->save;

	# Fill background
	set_hex_color ($cr, $HI_COLOR_1);
	$cr->rectangle ($x+1, $y+1, $width-2, $height-2);
	$cr->fill;

	# Stroke outline
	$cr->set_line_width (1.0);
	set_hex_color ($cr, $BLACK);
	$cr->rectangle ($x+1.5, $y+1.5, $width-3, $height-3);
	$cr->stroke;

	$cr->restore;
}

sub flat_circle
{
	my ($cr, $x, $y, $width) = @_;
	my $radius = ($width - 1) / 2.0;

	$cr->save;

	# Fill background
	set_hex_color ($cr, $HI_COLOR_1);
	$cr->arc ($x+$radius+0.5, $y+$radius+0.5, $radius-1, 0, 2*M_PI);
	$cr->fill;

	# Stroke outline
	$cr->set_line_width (1.0);
	set_hex_color ($cr, $BLACK);
	$cr->arc ($x+$radius+0.5, $y+$radius+0.5, $radius-1, 0, 2*M_PI);
	$cr->stroke;

	$cr->restore;
}

sub groovy_box
{
	my ($cr, $x, $y, $width, $height) = @_;

	$cr->save;

	# Highlight
	set_hex_color ($cr, $HI_COLOR_1);
	$cr->set_line_width (2);
	$cr->rectangle ($x+1, $y+1, $width-2, $height-2);
	$cr->stroke;

	# Lowlight
	set_hex_color ($cr, $LO_COLOR_1);
	$cr->set_line_width (1);
	$cr->rectangle ($x+0.5, $y+0.5, $width-2, $height-2);
	$cr->stroke;

	$cr->restore;
}

use constant
{
	CHECK_BOX_SIZE => 13,
};

sub check_box
{
	my ($cr, $x, $y, $checked) = @_;

	$cr->save;

	bevel_box ($cr, $x, $y, CHECK_BOX_SIZE, CHECK_BOX_SIZE);

	if ($checked) {
		set_hex_color ($cr, $BLACK);
		$cr->move_to ($x+3, $y+5);
		$cr->rel_line_to (2.5, 2);
		$cr->rel_line_to (4.5, -4);
		$cr->rel_line_to (0, 3);
		$cr->rel_line_to (-4.5, 4);
		$cr->rel_line_to (-2.5, -2);
		$cr->close_path;
		$cr->fill;
	}

	$cr->restore;
}

use constant
{
	RADIO_SIZE => CHECK_BOX_SIZE,
};

sub radio_button
{
	my ($cr, $x, $y, $checked) = @_;

	$cr->save;

	bevel_circle ($cr, $x, $y, RADIO_SIZE);

	if ($checked) {
		set_hex_color ($cr, $BLACK);
		$cr->arc (
		   $x + (RADIO_SIZE-1) / 2.0 + 0.5,
		   $y + (RADIO_SIZE-1) / 2.0 + 0.5,
		   (RADIO_SIZE-1) / 2.0 - 3.5,
		   0, 2 * M_PI);
		$cr->fill;
	}

	$cr->restore;
}

sub draw_bevels
{
	my ($cr, $width, $height) = @_;
	my $check_room = ($width - 20) / 3;
	my $check_pad = ($check_room - CHECK_BOX_SIZE) / 2;

	groovy_box ($cr, 5, 5, $width - 10, $height - 10);

	check_box ($cr, 10+$check_pad, 10+$check_pad, 0);
	check_box ($cr, $check_room+10+$check_pad, 10+$check_pad, 1);
	flat_box ($cr, 2 * $check_room+10+$check_pad, 10+$check_pad,
	          CHECK_BOX_SIZE, CHECK_BOX_SIZE);

	radio_button ($cr, 10+$check_pad, $check_room+10+$check_pad, 0);
	radio_button ($cr, $check_room+10+$check_pad, $check_room+10+$check_pad, 1);
	flat_circle ($cr, 2 * $check_room+10+$check_pad, $check_room+10+$check_pad, CHECK_BOX_SIZE);
}

{
	my $surface = Cairo::ImageSurface->create ('argb32', WIDTH, HEIGHT);
	my $cr = Cairo::Context->create ($surface);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	set_hex_color ($cr, $BG_COLOR);
	$cr->fill;

	draw_bevels ($cr, WIDTH, HEIGHT);

	$surface->write_to_png ('bevels.png');
}

Index: caps_joins.pl
===================================================================
RCS file: /cvs/cairo/cairo-perl/examples/png/caps_joins.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- caps_joins.pl	12 Jul 2005 20:29:49 -0000	1.2
+++ caps_joins.pl	3 Jun 2006 14:21:10 -0000	1.3
@@ -4,7 +4,6 @@
 use warnings;
 use Cairo;
 
-
 use constant
 {
 	WIDTH => 600,
@@ -79,6 +78,3 @@
 	$cr->set_line_cap ('round');
 	stroke_v_twice ($cr, $width, $height);
 }
-
-
-

Index: hering.pl
===================================================================
RCS file: /cvs/cairo/cairo-perl/examples/png/hering.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- hering.pl	12 Jul 2005 20:29:49 -0000	1.2
+++ hering.pl	3 Jun 2006 14:21:10 -0000	1.3
@@ -4,7 +4,6 @@
 use warnings;
 use Cairo;
 
-
 use constant
 {
 	WIDTH => 300,

--- NEW FILE: spline-pipeline.pl ---
#!/usr/bin/perl

use strict;
use warnings;
use Cairo;

use constant
{
	LINE_WIDTH => 13,
};

sub spline_path
{
	my ($cr) = @_;

	$cr->save;
	{
		$cr->translate (-106.0988385, -235.84433);
		$cr->move_to (49.517857, 235.84433);
		$cr->curve_to (86.544809, 175.18401,
		               130.19603, 301.40165,
		               162.67982, 240.42946);
	}
	$cr->restore;
}

sub source_path
{
	my ($cr) = @_;
	spline_path ($cr);
	$cr->set_line_width (1);
	$cr->stroke;
}

sub stroke
{
	my ($cr) = @_;
	spline_path ($cr);
	$cr->set_line_width (LINE_WIDTH);
	$cr->stroke;
}

sub scale_both_set_line_width_stroke
{
	my ($cr) = @_;
	$cr->scale (0.5, 0.5);
	spline_path ($cr);
	$cr->set_line_width (LINE_WIDTH);
	$cr->stroke;
}

sub scale_both_set_line_width_double_stroke
{
	my ($cr) = @_;
	$cr->scale (0.5, 0.5);
	spline_path ($cr);
	$cr->set_line_width (2 * LINE_WIDTH);
	$cr->stroke;
}

sub save_scale_path_restore_set_line_width_stroke
{
	my ($cr) = @_;
	$cr->save;
	{
		$cr->scale (0.5, 1.0);
		spline_path ($cr);
	}
	$cr->restore;

	$cr->set_line_width (LINE_WIDTH);
	$cr->stroke;
}

# XXX: Ouch. It looks like there's an API bug in the implemented semantics for
# cairo_set_line_width. I believe the following function
# (set_line_width_scale_path_stroke_BUGGY) should result in a figure identical
# to the version above it (save_scale_path_restore_set_line_width_stroke), but
# it's currently giving the same result as the one beloe
# (scale_path_set_line_width_stroke).
sub set_line_width_scale_path_stroke_BUGGY
{
	my ($cr) = @_;
	$cr->set_line_width (LINE_WIDTH);
	$cr->scale (0.5, 1.0);
	spline_path ($cr);
	$cr->stroke;
}

sub scale_path_set_line_width_stroke
{
	my ($cr) = @_;
	$cr->scale (0.5, 1.0);
	$cr->set_line_width (LINE_WIDTH);
	spline_path ($cr);
	$cr->stroke;
}

{
	my @pipelines = (
		\&source_path,
		\&stroke,
		\&scale_both_set_line_width_stroke,
		\&scale_both_set_line_width_double_stroke,
		\&save_scale_path_restore_set_line_width_stroke,
		\&scale_path_set_line_width_stroke,
	);
	my $width = 140;
	my $height = 68.833 * scalar @pipelines;

	my $surface = Cairo::ImageSurface->create ('argb32', $width, $height);
	my $cr = Cairo::Context->create ($surface);

	foreach (0 .. $#pipelines) {
		$cr->save;
		{
			$cr->translate ($width/2, ($_+0.5)*($height/scalar @pipelines));
			$pipelines[$_]->($cr);
		}
		$cr->restore;
		if ($cr->status ne 'success') {
			warn "Cairo is unhappy after pipeline #$_: " . $cr->status . "\n";
			exit 1;
		}
	}

	$surface->write_to_png ('spline-pipeline.png');
}


--- NEW FILE: text-rotate.pl ---
#!/usr/bin/perl

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 450,
	HEIGHT => 900,
	NUM_STRINGS => 3,
	M_PI => 4 * atan2(1, 1),
};

{
	my $surface = Cairo::ImageSurface->create ('argb32', WIDTH, HEIGHT);
	my $cr = Cairo::Context->create ($surface);

	$cr->set_source_rgb (0.0, 0.0, 0.0);

	$cr->translate (40, 40);

	$cr->select_font_face ('mono', 'normal', 'normal');
	$cr->set_font_size (12);
	$cr->show_text ('+CTM rotation');

	$cr->save;
	$cr->select_font_face ('serif', 'normal', 'normal');
	$cr->set_font_size (40);
	for (my $i = 0; $i < NUM_STRINGS; $i++) {
		my $angle = $i * 0.5 * M_PI / (NUM_STRINGS - 1);
		$cr->save;
		$cr->rotate ($angle);
		$cr->move_to (100, 0);
		$cr->show_text ("Text");
		$cr->restore;
	}
	$cr->restore;

	$cr->translate (0, HEIGHT / 3);

	$cr->move_to (0, 0);
	$cr->show_text ('+CTM rotation');
	$cr->rel_move_to (0, 12);
	$cr->show_text ('-font rotation');

	$cr->save;
	$cr->select_font_face ('serif', 'normal', 'normal');
	$cr->set_font_size (40);
	for (my $i = 0; $i < NUM_STRINGS; $i++) {
		my $angle = $i * 0.5 * M_PI / (NUM_STRINGS - 1);
		$cr->save;
		$cr->rotate ($angle);
		my $matrix = Cairo::Matrix->init_identity;
		$matrix->scale (40, 40);
		$matrix->rotate (-$angle);
		$cr->set_font_matrix ($matrix);
		$cr->move_to (100, 0);
		$cr->show_text ('Text');
		$cr->restore;
	}
	$cr->restore;

	$cr->translate (0, HEIGHT / 3);

	$cr->move_to (0, 0);
	$cr->show_text ('+CTM rotation');
	$cr->rel_move_to (0, 12);
	$cr->show_text ('-CTM rotation');

	$cr->save;
	$cr->select_font_face ('serif', 'normal', 'normal');
	$cr->set_font_size (40);
	for (my $i = 0; $i < NUM_STRINGS; $i++) {
		my $angle = $i * 0.5 * M_PI / (NUM_STRINGS - 1);
		$cr->save;
		$cr->rotate ($angle);
		$cr->move_to (100, 0);
		$cr->rotate (-$angle);
		$cr->show_text ('Text');
		$cr->restore;
	}
	$cr->restore;

	$surface->write_to_png ('text-rotate.png');
}

--- NEW FILE: text.pl ---
#!/usr/bin/perl

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 450,
	HEIGHT => 600,
	TEXT => 'hello, world',
	NUM_GLYPHS => 10,
	M_PI => 4 * atan2(1, 1),
};

sub box_text
{
	my ($cr, $utf8, $x, $y) = @_;

	$cr->save;

	my $extents = $cr->text_extents (TEXT);
	my $line_width = $cr->get_line_width;
	$cr->rectangle ($x + $extents->{x_bearing} - $line_width,
	                $y + $extents->{y_bearing} - $line_width,
	                $extents->{width} + 2 * $line_width,
	                $extents->{height} + 2 *$line_width);
	$cr->stroke;

	$cr->move_to ($x, $y);
	$cr->show_text ($utf8);
	$cr->move_to ($x, $y);
	$cr->text_path ($utf8);
	$cr->set_source_rgb (1, 0, 0);
	$cr->set_line_width (1.0);
	$cr->stroke;

	$cr->restore;
}

sub box_glyphs
{
	my ($cr, $x, $y, @glyphs) = @_;

	$cr->save;

	my $extents = $cr->glyph_extents (@glyphs);
	my $line_width = $cr->get_line_width;
	$cr->rectangle ($x + $extents->{x_bearing} - $line_width,
	                $y + $extents->{y_bearing} - $line_width,
	                $extents->{width} + 2 * $line_width,
	                $extents->{height} + 2 * $line_width);
	$cr->stroke;

	foreach my $glyph (@glyphs) {
		$glyph->{x} += $x;
		$glyph->{y} += $y;
	}
	$cr->show_glyphs (@glyphs);
	$cr->glyph_path (@glyphs);
	$cr->set_source_rgb (1, 0, 0);
	$cr->set_line_width (1.0);
	$cr->stroke;
	foreach my $glyph (@glyphs) {
		$glyph->{x} -= $x;
		$glyph->{y} -= $y;
	}

	$cr->restore;
}

{
	my $surface = Cairo::ImageSurface->create ('argb32', WIDTH, HEIGHT);
	my $cr = Cairo::Context->create ($surface);

	$cr->set_source_rgb (0, 0, 0);
	$cr->set_line_width (2.0);

	$cr->save;
	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_source_rgba (0, 0, 0, 0);
	$cr->set_operator ('source');
	$cr->fill;
	$cr->restore;

	$cr->select_font_face ('sans', 'normal', 'normal');
	$cr->set_font_size (40);
	if (1) {
		my $matrix = Cairo::Matrix->init_scale (40, -40);
		$cr->set_font_matrix ($matrix);

		$cr->scale (1, -1);
		$cr->translate (0, - HEIGHT);
	}

	my $font_extents = $cr->font_extents;
	my $height = $font_extents->{height};

	my @glyphs = ();
	my $dx = 0;
	my $dy = 0;
	foreach (0 .. NUM_GLYPHS - 1) {
		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;
	}

	box_text ($cr, TEXT, 10, $height);

	$cr->translate (0, $height);
	$cr->save;
	{
		$cr->translate (10, $height);
		$cr->rotate (10 * M_PI / 180);
		box_text ($cr, TEXT, 0, 0);
	}
	$cr->restore;

	$cr->translate (0, 2 * $height);
	$cr->save;
	{
		my $matrix = Cairo::Matrix->init_identity;
		$matrix->scale (40, -40);
		$matrix->rotate (-10 * M_PI / 180);
		$cr->set_font_matrix ($matrix);
		box_text ($cr, TEXT, 10, $height);
	}
	$cr->restore;

	$cr->translate (0, 2 * $height);
	box_glyphs ($cr, 10, $height, @glyphs);

	$cr->translate (10, 2 * $height);
	$cr->save;
	{
		$cr->rotate (10 * M_PI / 180);
		box_glyphs ($cr, 0, 0, @glyphs);
	}
	$cr->restore;

	$cr->translate (0, $height);
	foreach (0 .. NUM_GLYPHS - 1) {
		$glyphs[$_]->{y} += $_ * 5;
	}
	box_glyphs ($cr, 10, $height, @glyphs);

	$surface->write_to_png ('text.png');
}

More information about the cairo-commit mailing list