%PDF- %PDF-
Direktori : /usr/share/doc/libcairo-perl/examples/ |
Current File : //usr/share/doc/libcairo-perl/examples/twisted-text.pl |
#!/usr/bin/perl use strict; use warnings; use Glib qw(TRUE FALSE); use Pango; # This is a port of pango's cairotwisted example written by Behdad Esfahbod. sub two_points_distance { my ($a, $b) = @_; my $dx = $b->[0] - $a->[0]; my $dy = $b->[1] - $a->[1]; return sqrt($dx * $dx + $dy * $dy); } sub parametrize_path { my ($path) = @_; my $current_point; my @parametrization = (); foreach (0 .. $#{$path}) { my $data = $path->[$_]; $parametrization[$_] = 0.0; if ($data->{type} eq "move-to") { $current_point = $data->{points}[0]; } elsif ($data->{type} eq "line-to") { $parametrization[$_] = two_points_distance ($current_point, $data->{points}[0]); $current_point = $data->{points}[0]; } elsif ($data->{type} eq "curve-to") { $parametrization[$_] = two_points_distance ($current_point, $data->{points}->[0]); $parametrization[$_] += two_points_distance ($data->{points}[0], $data->{points}[1]); $parametrization[$_] += two_points_distance ($data->{points}[1], $data->{points}[2]); $current_point = $data->{points}[2]; } } return \@parametrization; } sub _fancy_cairo_stroke { my ($cr, $preserve) = @_; my $line_width = $cr->get_line_width; my $path = $cr->copy_path; $cr->new_path; $cr->save; $cr->set_line_width($line_width / 3); $cr->set_dash(0, 10, 10); foreach my $data (@{$path}) { my @points = @{$data->{points}}; if ($data->{type} eq "move-to" || $data->{type} eq "line-to") { $cr->move_to ($points[0][0], $points[0][1]); } elsif ($data->{type} eq "curve-to") { $cr->line_to ($points[0][0], $points[0][1]); $cr->move_to ($points[1][0], $points[1][1]); $cr->line_to ($points[2][0], $points[2][1]); } } $cr->stroke; $cr->restore; $cr->save; $cr->set_line_width ($line_width * 4); $cr->set_line_cap ("round"); foreach my $data (@{$path}) { my @points = @{$data->{points}}; if ($data->{type} eq "move-to") { $cr->move_to ($points[0][0], $points[0][1]); } elsif ($data->{type} eq "line-to") { $cr->rel_line_to (0, 0); $cr->move_to ($points[0][0], $points[0][1]); } elsif ($data->{type} eq "curve-to") { $cr->rel_line_to (0, 0); $cr->move_to ($points[0][0], $points[0][1]); $cr->rel_line_to (0, 0); $cr->move_to ($points[1][0], $points[1][1]); $cr->rel_line_to (0, 0); $cr->move_to ($points[2][0], $points[2][1]); } elsif ($data->{type} eq "close-path") { $cr->rel_line_to (0, 0); } } $cr->rel_line_to (0, 0); $cr->stroke; $cr->restore; foreach my $data (@{$path}) { my @points = @{$data->{points}}; if ($data->{type} eq "move-to") { $cr->move_to ($points[0][0], $points[0][1]); } elsif ($data->{type} eq "line-to") { $cr->line_to ($points[0][0], $points[0][1]); } elsif ($data->{type} eq "curve-to") { $cr->curve_to ($points[0][0], $points[0][1], $points[1][0], $points[1][1], $points[2][0], $points[2][1]); } elsif ($data->{type} eq "close-path") { $cr->close_path; } } $cr->stroke; if ($preserve) { $cr->append_path ($path); } } sub fancy_cairo_stroke { my ($cr) = @_; _fancy_cairo_stroke ($cr, FALSE); } sub fancy_cairo_stroke_preserve { my ($cr) = @_; _fancy_cairo_stroke ($cr, TRUE); } sub transform_path { my ($path, $f, $closure) = @_; foreach my $data (@{$path}) { if ($data->{type} eq "curve-to") { $f->($closure, $data->{points}[2]); $f->($closure, $data->{points}[1]); $f->($closure, $data->{points}[0]); } elsif ($data->{type} eq "move-to" || $data->{type} eq "line-to") { $f->($closure, $data->{points}[0]); } } } sub point_on_path { my ($param, $point) = @_; my $oldy = $point->[1]; my $d = $point->[0]; my $path = $param->{path}; my $parametrization = $param->{parametrization}; my ($ratio, $dx, $dy); my $data; my $current_point = undef; my $length = $#{$path}; my $i; for ($i = 0; $i < $length && $d > $parametrization->[$i]; $i++) { $d -= $parametrization->[$i]; $data = $path->[$i]; if ($data->{type} eq "move-to" || $data->{type} eq "line-to") { $current_point = $data->{points}[0]; } elsif ($data->{type} eq "curve-to") { $current_point = $data->{points}[2]; } } $data = $path->[$i]; if ($data->{type} eq "line-to") { my $ratio = $d / $parametrization->[$i]; $point->[0] = $current_point->[0] * (1 - $ratio) + $data->{points}[0][0] * $ratio; $point->[1] = $current_point->[1] * (1 - $ratio) + $data->{points}[0][1] * $ratio; $dx = -($current_point->[0] - $data->{points}[0][0]); $dy = -($current_point->[1] - $data->{points}[0][1]); $d = $oldy; $ratio = $d / $parametrization->[$i]; $point->[0] += -$dy * $ratio; $point->[1] += $dx * $ratio; } elsif ($data->{type} eq "curve-to") { $ratio = $d / $parametrization->[$i]; $point->[0] = $current_point->[0] * (1 - $ratio) * (1 - $ratio) * (1 - $ratio) + 3 * $data->{points}[0][0] * (1 - $ratio) * (1 - $ratio) * $ratio + 3 * $data->{points}[1][0] * (1 - $ratio) * $ratio * $ratio + 3 * $data->{points}[2][0] * $ratio * $ratio * $ratio; $point->[1] = $current_point->[1] * (1 - $ratio) * (1 - $ratio) * (1 - $ratio) + 3 * $data->{points}[0][1] * (1 - $ratio) * (1 - $ratio) * $ratio + 3 * $data->{points}[1][1] * (1 - $ratio) * $ratio * $ratio + 3 * $data->{points}[2][1] * $ratio * $ratio * $ratio; $dx =-3 * $current_point->[0] * (1 - $ratio) * (1 - $ratio) + 3 * $data->{points}[0][0] * (1 - 4 * $ratio + 3 * $ratio * $ratio) + 3 * $data->{points}[1][0] * ( 2 * $ratio - 3 * $ratio * $ratio) + 3 * $data->{points}[2][0] * $ratio * $ratio; $dy =-3 * $current_point->[1] * (1 - $ratio) * (1 - $ratio) + 3 * $data->{points}[0][1] * (1 - 4 * $ratio + 3 * $ratio * $ratio) + 3 * $data->{points}[1][1] * ( 2 * $ratio - 3 * $ratio * $ratio) + 3 * $data->{points}[2][1] * $ratio * $ratio; $d = $oldy; $ratio = $d / sqrt ($dx * $dx + $dy * $dy); $point->[0] += -$dy * $ratio; $point->[1] += $dx * $ratio; } } sub map_path_onto { my ($cr, $path) = @_; my $param = { path => $path, parametrization => parametrize_path ($path), }; my $current_path = $cr->copy_path; transform_path ($current_path, \&point_on_path, $param); $cr->new_path; $cr->append_path ($current_path); } sub draw_path { my ($cr) = @_; $cr->move_to (50, 700); $cr->line_to (300, 750); $cr->curve_to (550, 800, 900, 700, 900, 400); $cr->curve_to (900, 0, 600, 300, 100, 100); } sub draw_text { my ($cr) = @_; my $font_options = Cairo::FontOptions->create; $font_options->set_hint_style ("none"); $font_options->set_hint_metrics ("off"); $cr->set_font_options ($font_options); my $layout = Pango::Cairo::create_layout ($cr); my $desc = Pango::FontDescription->from_string ("Serif 72"); $layout->set_font_description ($desc); $layout->set_text ("It was a dream... Oh Just a dream..."); my $line = $layout->get_line (0); Pango::Cairo::layout_line_path ($cr, $line); } sub draw { my ($cr) = @_; # Decrease tolerance a bit, since it's going to be magnified $cr->set_tolerance (0.05); $cr->set_source_rgb (1.0, 0.0, 0.0); draw_path ($cr); fancy_cairo_stroke_preserve ($cr); my $path = $cr->copy_path_flat; $cr->new_path; draw_text ($cr); map_path_onto ($cr, $path); $cr->set_source_rgba (0.3, 0.3, 1.0, 0.3); $cr->fill_preserve; $cr->set_source_rgb (0.1, 0.1, 0.1); $cr->stroke; } { if ($#ARGV != 0) { warn "Usage: cairo-twisted-text.pl OUTPUT_FILENAME\n"; exit 1; } my $filename = $ARGV[0]; my $surface = Cairo::ImageSurface->create ("argb32", 500, 500); my $cr = Cairo::Context->create ($surface); $cr->translate (0, 50); $cr->scale (0.5, 0.5); $cr->set_source_rgb (1.0, 1.0, 1.0); $cr->paint; draw ($cr); if ("success" ne $surface->write_to_png ($filename)) { warn "Could not save png to '$filename'\n"; exit 1; } exit 0; }