added sample: gifscale.pl - scale an animated gif
[imager.git] / samples / gifscale.pl
1 #!perl -w
2 use strict;
3 use Imager;
4 use POSIX qw(ceil);
5
6 $Imager::formats{gif} || $Imager::formats{ungif}
7   or die "Your build of Imager doesn't support gif\n";
8
9 $Imager::formats{gif}
10   or warn "Your build of Imager output's uncompressed GIFs, install libgif instead of libungif (the patents have expired)";
11
12 my $factor = shift;
13 my $in_name = shift;
14 my $out_name = shift
15   or die "Usage: $0 scalefactor input.gif output.gif\n";
16
17 $factor > 0
18   or die "scalefactor must be positive\n";
19
20 my @in = Imager->read_multi(file => $in_name)
21   or die "Cannot read image file: ", Imager->errstr, "\n";
22
23 # the sizes need to be based on the screen size of the image, but
24 # that's only present in GIF, make sure the image was read as gif
25
26 $in[0]->tags(name => 'i_format') eq 'gif'
27   or die "File $in_name is not a GIF image\n";
28
29 my $src_screen_width = $in[0]->tags(name => 'gif_screen_width');
30 my $src_screen_height = $in[0]->tags(name => 'gif_screen_height');
31
32 my $out_screen_width = ceil($src_screen_width * $factor);
33 my $out_screen_height = ceil($src_screen_height * $factor);
34
35 my @out;
36 for my $in (@in) {
37   my $scaled = $in->scale(scalefactor => $factor, qtype=>'mixing');
38   
39   # roughly preserve the relative position
40   $scaled->settag(name => 'gif_left', 
41                   value => $factor * $in->tags(name => 'gif_left'));
42   $scaled->settag(name => 'gif_top', 
43                   value => $factor * $in->tags(name => 'gif_left'));
44
45   $scaled->settag(name => 'gif_screen_width', value => $out_screen_width);
46   $scaled->settag(name => 'gif_screen_height', value => $out_screen_height);
47
48   # set some other tags from the source
49   for my $tag (qw/gif_delay gif_user_input gif_loop gif_disposal/) {
50     $scaled->settag(name => $tag, value => $in->tags(name => $tag));
51   }
52   if ($in->tags(name => 'gif_local_map')) {
53     $scaled->settag(name => 'gif_local_map', value => 1);
54   }
55
56   push @out, $scaled;
57 }
58
59 Imager->write_multi({ file => $out_name }, @out)
60   or die "Cannot save $out_name: ", Imager->errstr, "\n";
61
62 =head1 NAME
63
64 gifscale.pl - demonstrates adjusting tags when scaling a GIF image
65
66 =head1 SYNOPSIS
67
68 perl gifscale.pl scalefactor input.gif output.gif
69
70 =head1 DESCRIPTION
71
72 Scales an input multi-image GIF file.  Unlike a simple scale each file
73 solution this:
74
75 =over
76
77 =item *
78
79 preserves GIF animation attributes
80
81 =item *
82
83 adjusts the sub-images positions on the background accounting for the
84 scale factor.
85
86 =back
87
88 =head1 AUTHOR
89
90 Tony Cook <tony@imager.perl.org>
91
92 =cut