[perl-Cairo] Add a new example program

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

commit 436f973d9af68a3d969689765ccbbb1b9c27c655
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sun Aug 7 20:20:42 2011 +0200

    Add a new example program

 examples/twisted-text.pl |  330 ++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 330 insertions(+), 0 deletions(-)
---
diff --git a/examples/twisted-text.pl b/examples/twisted-text.pl
new file mode 100644
index 0000000..6b718e2
--- /dev/null
+++ b/examples/twisted-text.pl
@@ -0,0 +1,330 @@
+#!/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;
+}