added sample: gifscale.pl - scale an animated gif

diff --git a/Changes b/Changes
index 275a3ae2ec49c1494caaf0f3dff87a8b302431b9..044a137b6cdc2b053a25e4d798d507b2516ec098 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
 Imager release history.  Older releases can be found in Changes.old
 
+Imager 0.61 - unreleased
+===========
+
+ - added samples/gifscale.pl, which adjusts the screen size/position tags
+   when scaling an animated gif
+   http://rt.cpan.org/Ticket/Display.html?id=27591
+
 Imager 0.60 - 30 August 2007
 ===========
 

diff --git a/MANIFEST b/MANIFEST
index 2c3d16e73e85a4731d1d8318853540fb7b7426b5..b1e78c7659dc159e67e5476202dabf2abccb31af 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -201,6 +201,7 @@ samples/align-string.pl Demonstrate align_string method.
 samples/anaglyph.pl
 samples/border.pl       Demonstrate adding a border
 samples/flasher.pl     Animate an source image fading to a color and back
+samples/gifscale.pl    Scale an animated GIF, preserving animation info
 samples/inline_capture2image.pl         convert captured BGR data to an image
 samples/inline_replace_color.pl  replace colors using Inline::C
 samples/interleave.pl

diff --git a/TODO b/TODO
index e855c9e75e64912ab57138aa1e644813811df208..e0dde90dca1e44c00a4d93e883a0531bd4464a34 100644 (file)
--- a/TODO
+++ b/TODO
@@ -6,13 +6,20 @@ Release Plans (subject to change)
 brown-bag bugs may add intermediate releases.  The dates are goals,
 not commitments.
 
+For 0.62: (tentative)
+
+thick lines
+
+have alpha channel work treated as coverage for primitives (more
+general combine parameter)
+
 For 0.61:
 
 TIFF improvements (to be detailed) (#20329)
 
 regmach.c fixes/tests (#29296)
 
-sample: scaling an animated gif (#27591)
+sample: scaling an animated gif (#27591) (done)
 
 transform2() docs (#29267)
 

diff --git a/samples/README b/samples/README
index 039fb172689e957483ed31d7ec990b19d63aa0e5..a6ce36dc4c9a26029d3788d93448fe8b1805d8d2 100644 (file)
--- a/samples/README
+++ b/samples/README
@@ -104,3 +104,9 @@ flasher.pl
 
   Demonstrates setting an alpha channel with convert(), rubthrough(), 
   and writing animated GIFs.
+
+gifscale.pl
+
+  Scales an animated GIF image, preserving GIF animation information
+  and adjusting the image screen positions to account for the scale
+  factor.

diff --git a/samples/gifscale.pl b/samples/gifscale.pl
new file mode 100644 (file)
index 0000000..a7b3a4a
--- /dev/null
+++ b/samples/gifscale.pl
@@ -0,0 +1,92 @@
+#!perl -w
+use strict;
+use Imager;
+use POSIX qw(ceil);
+
+$Imager::formats{gif} || $Imager::formats{ungif}
+  or die "Your build of Imager doesn't support gif\n";
+
+$Imager::formats{gif}
+  or warn "Your build of Imager output's uncompressed GIFs, install libgif instead of libungif (the patents have expired)";
+
+my $factor = shift;
+my $in_name = shift;
+my $out_name = shift
+  or die "Usage: $0 scalefactor input.gif output.gif\n";
+
+$factor > 0
+  or die "scalefactor must be positive\n";
+
+my @in = Imager->read_multi(file => $in_name)
+  or die "Cannot read image file: ", Imager->errstr, "\n";
+
+# the sizes need to be based on the screen size of the image, but
+# that's only present in GIF, make sure the image was read as gif
+
+$in[0]->tags(name => 'i_format') eq 'gif'
+  or die "File $in_name is not a GIF image\n";
+
+my $src_screen_width = $in[0]->tags(name => 'gif_screen_width');
+my $src_screen_height = $in[0]->tags(name => 'gif_screen_height');
+
+my $out_screen_width = ceil($src_screen_width * $factor);
+my $out_screen_height = ceil($src_screen_height * $factor);
+
+my @out;
+for my $in (@in) {
+  my $scaled = $in->scale(scalefactor => $factor, qtype=>'mixing');
+  
+  # roughly preserve the relative position
+  $scaled->settag(name => 'gif_left', 
+                 value => $factor * $in->tags(name => 'gif_left'));
+  $scaled->settag(name => 'gif_top', 
+                 value => $factor * $in->tags(name => 'gif_left'));
+
+  $scaled->settag(name => 'gif_screen_width', value => $out_screen_width);
+  $scaled->settag(name => 'gif_screen_height', value => $out_screen_height);
+
+  # set some other tags from the source
+  for my $tag (qw/gif_delay gif_user_input gif_loop gif_disposal/) {
+    $scaled->settag(name => $tag, value => $in->tags(name => $tag));
+  }
+  if ($in->tags(name => 'gif_local_map')) {
+    $scaled->settag(name => 'gif_local_map', value => 1);
+  }
+
+  push @out, $scaled;
+}
+
+Imager->write_multi({ file => $out_name }, @out)
+  or die "Cannot save $out_name: ", Imager->errstr, "\n";
+
+=head1 NAME
+
+gifscale.pl - demonstrates adjusting tags when scaling a GIF image
+
+=head1 SYNOPSIS
+
+perl gifscale.pl scalefactor input.gif output.gif
+
+=head1 DESCRIPTION
+
+Scales an input multi-image GIF file.  Unlike a simple scale each file
+solution this:
+
+=over
+
+=item *
+
+preserves GIF animation attributes
+
+=item *
+
+adjusts the sub-images positions on the background accounting for the
+scale factor.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=cut