[cairo-commit] cairo-perl/examples/png README, NONE, 1.1 caps_joins.pl, NONE, 1.1 hering.pl, NONE, 1.1 outline.pl, NONE, 1.1 spiral.pl, NONE, 1.1 splines_tolerance.pl, NONE, 1.1 stars.pl, NONE, 1.1

Ross McFarland commit at pdx.freedesktop.org
Sat Nov 27 21:30:32 PST 2004


Committed by: rwmcfa1

Update of /cvs/cairo/cairo-perl/examples/png
In directory gabe:/tmp/cvs-serv26179/examples/png

Added Files:
	README caps_joins.pl hering.pl outline.pl spiral.pl 
	splines_tolerance.pl stars.pl 
Log Message:
initial import, ports of cairo-demo/png examples

--- NEW FILE: README ---
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
support.

TODO:
	text, text-rotate: need freetype stuff worked out...

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

use strict;
use warnings;
use Cairo;


use constant
{
	WIDTH => 600,
	HEIGHT => 600,
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_caps_joins ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

sub stroke_v_twice
{
	my ($cr, $width, $height) = @_;

	$cr->move_to (0, 0);
	$cr->rel_line_to ($width / 2, $height / 2);
	$cr->rel_line_to ($width / 2, - $height / 2);

	$cr->save;
	$cr->stroke;
	$cr->restore;

	$cr->save;
	{
		$cr->set_line_width (2.0);
		$cr->set_line_cap ('BUTT');
		$cr->set_rgb_color (1, 1, 1);
		$cr->stroke;
	}
	$cr->restore;

	$cr->new_path;
}

sub draw_caps_joins
{
	my ($cr, $width, $height) = @_;

	my $line_width = $height / 12 & (~1);

	$cr->set_line_width ($line_width);
	$cr->set_rgb_color (0, 0, 0);

	$cr->translate ($line_width, $line_width);
	$width -= 2 * $line_width;

	$cr->set_line_join ('BEVEL');
	$cr->set_line_cap ('BUTT');
	stroke_v_twice ($cr, $width, $height);

	$cr->translate (0, $height / 4 - $line_width);
	$cr->set_line_join ('MITER');
	$cr->set_line_cap ('SQUARE');
	stroke_v_twice ($cr, $width, $height);

	$cr->translate (0, $height / 4 - $line_width);
	$cr->set_line_join ('ROUND');
	$cr->set_line_cap ('ROUND');
	stroke_v_twice ($cr, $width, $height);
}




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

use strict;
use warnings;
use Cairo;


use constant
{
	WIDTH => 300,
	HEIGHT => 600,
	LINES => 32,
	M_PI_2 => 3.14159265 / 2.0,
};

use constant
{
	MAX_THETA => (.80 * M_PI_2),
};

use constant
{
	THETA_INC => (2.0 * MAX_THETA / (LINES-1)),
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_hering ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

sub draw_hering
{
	my ($cr, $width, $height) = @_;

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

	$cr->save;
	{
		$cr->translate ($width / 2, $height / 2);
		$cr->rotate (MAX_THETA);
	
		for (my $i=0; $i < LINES; $i++)
		{
		$cr->move_to (-2 * $width, 0);
		$cr->line_to (2 * $width, 0);
		$cr->stroke;
		
		$cr->rotate (- THETA_INC);
		}
	}
	$cr->restore;

	$cr->set_line_width (6);
	$cr->set_rgb_color (1, 0, 0);

	$cr->move_to ($width / 4, 0);
	$cr->rel_line_to (0, $height);
	$cr->stroke;

	$cr->move_to (3 * $width / 4, 0);
	$cr->rel_line_to (0, $height);
	$cr->stroke;
}

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

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 750,
	HEIGHT => 500,
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_outlines ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

sub create_gradient
{
	my ($cr, $width, $height) = @_;

	my $gradient;
	my $matrix;
	my $gradient_pattern;

	$cr->save;

	$gradient = $cr->current_target_surface->create_similar
			('ARGB32', 3, 2);
	$cr->set_target_surface ($gradient);

	$cr->set_rgb_color (0, 0, 0);
	$cr->rectangle (0, 0, 1, 2);
	$cr->fill;

	$cr->set_rgb_color (1, 1, 1);
	$cr->rectangle (1, 0, 1, 2);
	$cr->fill;

	$cr->set_rgb_color (0, 0, 0);
	$cr->rectangle (2, 0, 1, 2);
	$cr->fill;

	$cr->restore;

	$matrix = Cairo::Matrix->create;
	$matrix->scale (2.0 / $width, 1.0 / $height);
	
	$gradient_pattern = Cairo::Pattern::->create_for_surface ($gradient);
	$gradient_pattern->set_matrix ($matrix);
	$gradient_pattern->set_filter ('BILINEAR');

	return $gradient_pattern;
}

sub draw_outlines
{
	my ($cr, $surface_width, $surface_height) = @_;

	my $gradient;
	my ($width, $height, $pad);

	$width = $surface_width / 4.0;
	$pad = ($surface_width - (3 * $width)) / 2.0;
	$height = $surface_height;

	$gradient = create_gradient ($cr, $width, $height);

	$cr->set_pattern ($gradient);
	draw_flat ($cr, $width, $height);

	$cr->translate ($width + $pad, 0);
	$cr->set_pattern ($gradient);
	draw_tent ($cr, $width, $height);

	$cr->translate ($width + $pad, 0);
	$cr->set_pattern ($gradient);
	draw_cylinder ($cr, $width, $height);

	$cr->restore;
}

sub draw_flat
{
	my ($cr, $width, $height) = @_;
	
	my $hwidth = $width / 2.0;

	$cr->rectangle (0, $hwidth, $width, $height - $hwidth);

	$cr->fill;
}

sub draw_tent
{
	my ($cr, $width, $height) = @_;

	my $hwidth = $width / 2.0;

	$cr->move_to     (       0,  $hwidth);
	$cr->rel_line_to ( $hwidth, -$hwidth);
	$cr->rel_line_to ( $hwidth,  $hwidth);
	$cr->rel_line_to (       0,  $height - $hwidth);
	$cr->rel_line_to (-$hwidth, -$hwidth);
	$cr->rel_line_to (-$hwidth,  $hwidth);
	$cr->close_path;

	$cr->fill;
}

sub draw_cylinder
{
	my ($cr, $width, $height) = @_;

	my $hwidth = $width / 2.0;

	$cr->move_to (0, $hwidth);
	$cr->rel_curve_to (0, -$hwidth, $width, -$hwidth, $width, 0);
	$cr->rel_line_to (0, $height - $hwidth);
	$cr->rel_curve_to (0, -$hwidth, -$width, -$hwidth, -$width, 0);
	$cr->close_path;

	$cr->fill;
}

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

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 600,
	HEIGHT => 600,
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_spiral ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

sub draw_spiral
{
	my ($cr, $width, $height) = @_;
	
	my $wd = .02 * $width;
	my $hd = .02 * $height;

	$width -= 2;
	$height -= 2;

	$cr->move_to ($width + 1, 1 - $hd);
	for (my $i=0; $i < 9; $i++)
	{
		$cr->rel_line_to (0, $height - $hd * (2 * $i - 1));
		$cr->rel_line_to (- ($width - $wd * (2 * $i)), 0);
		$cr->rel_line_to (0, - ($height - $hd * (2 * $i)));
		$cr->rel_line_to ($width - $wd * (2 * $i + 1), 0);
	}

	$cr->set_rgb_color (0, 0, 1);
	$cr->stroke;
}

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

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 600,
	HEIGHT => 300,
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_splines ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

sub draw_spline
{
	my ($cr, $height) = @_;

	$cr->move_to (0, .1 * $height);
	$height = .8 * $height;
	$cr->rel_curve_to (-$height / 2, $height / 2, $height / 2, $height / 2,
			   0, $height);
	$cr->stroke;
}

sub draw_splines
{
	my ($cr, $width, $height) = @_;

	my @tolerance = (.1, .5, 1, 5, 10);
	my $line_width = .08 * $width;
	my $gap = $width / 6;

	$cr->set_rgb_color (0, 0, 0);
	$cr->set_line_width ($line_width);

	$cr->translate ($gap, 0);
	for (my $i = 0; $i < 5; $i++)
	{
		$cr->set_tolerance ($tolerance[$i]);
		draw_spline ($cr, $height);
		$cr->translate ($gap, 0);
	}
}

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

use strict;
use warnings;
use Cairo;

use constant
{
	WIDTH => 600,
	HEIGHT => 275,
	M_PI => 3.14159265,
};

{
	my $cr;

	$cr = Cairo->create;

	$0 =~ /(.*)\.pl/;
	my $out = "$1.png";

	open OUT, ">$out" or die "unable to open ($out) for output";

	$cr->set_target_png (*OUT, 'ARGB32', WIDTH, HEIGHT);

	$cr->rectangle (0, 0, WIDTH, HEIGHT);
	$cr->set_rgb_color (1, 1, 1);
	$cr->fill;

	draw_stars ($cr, WIDTH, HEIGHT);

	$cr->show_page;
	close OUT;
}

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

	my $theta = 4 * M_PI / 5.0;

	$cr->move_to (0, 0);
	for (my $i = 0; $i < 4; $i++)
	{
		$cr->rel_line_to (1.0, 0);
		$cr->rotate ($theta);
	}
	$cr->close_path;
}

sub draw_stars
{
	my ($cr, $width, $height) = @_;

	$cr->set_rgb_color (0, 0, 0);

	$cr->save;
	{
		$cr->translate (5, $height / 2.6);
		$cr->scale ($height, $height);
		star_path ($cr);
		$cr->set_fill_rule ('WINDING');
		$cr->fill;
	}
	$cr->restore;

	$cr->save;
	{
		$cr->translate ($width - $height - 5, $height / 2.6);
		$cr->scale ($height, $height);
		star_path ($cr);
		$cr->set_fill_rule ('EVEN_ODD');
		$cr->fill;
	}
	$cr->restore;
}




More information about the cairo-commit mailing list