Viewing file:  twisted-text.pl (8.18 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
#!/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;
}
|