1#!/usr/bin/perl
2
3use strict;
4
5use SWF::File;
6use SWF::Element;
7use Image::Magick;
8use Compress::Zlib;
9use Getopt::Std;
10
11my %opt;
12getopts('ft', \%opt);
13
14my ($imagefile, $swffile) = @ARGV;
15
16unless (defined $imagefile) {
17    print STDERR <<USAGE;
18img2swf.plx - convert an image to a swf.
19  perl img2swf.plx [-f] [-t] imagefile [swffile]
20   -f: Force to convert to full color bitmap.
21   -t: Keep transparency.
22USAGE
23
24    exit(1);
25}
26
27($swffile = $imagefile) =~s/\.[^.]+$/.swf/ unless defined $swffile;
28
29my $image = Image::Magick->new;
30$image->Read($imagefile);
31
32my $height = $image->Get('height');
33my $width = $image->Get('width');
34die "Can't open $imagefile." if ($height == 0 and $width == 0);
35
36my ($lossless, $tp);
37if ($opt{t} and $image->Get('matte')) {
38    $lossless = SWF::Element::Tag::DefineBitsLossless2->new;
39    $tp=1;
40} else {
41    $lossless = SWF::Element::Tag::DefineBitsLossless->new;
42    $tp=0;
43}
44$lossless->configure
45    ( CharacterID => 1,
46      BitmapWidth => $width,
47      BitmapHeight => $height,
48    );
49
50if ((my $colors = $image->Get('colors'))>=256 or $opt{f}) {
51
52    $lossless->BitmapFormat(5); # fullcolor
53
54    my $d = deflateInit() or die "Can't open zlib stream.";
55
56    for(my $y = 0; $y<$height; $y++) {
57	for(my $x = 0; $x<$width; $x++) {
58	    my @rgba = split /,/, $image->Get("pixel[$x,$y]");
59	    if (!$tp) {
60		pop @rgba;
61		unshift @rgba, 0;
62	    } else {
63		$rgba[3] = 255-$rgba[3];
64		@rgba=@rgba[3,0..2];
65	    }
66
67	    my ($output, $status) = $d->deflate(pack('CCCC',@rgba)); # 4 bytes per pixel.
68	    die "Compress error." unless $status == Z_OK;
69	    $lossless->ZlibBitmapData->add($output);
70	}
71    }
72
73    my ($output, $status) = $d->flush();
74    die "Compress error." unless $status == Z_OK;
75    $lossless->ZlibBitmapData->add($output);
76
77} else {
78
79    $lossless->BitmapFormat(3); # bitmap with colormap
80    $lossless->BitmapColorTableSize($colors-1);
81
82    my (%colors, $pixels);
83    my $index = 0;
84    my $pad = "\x00" x (4 - $width % 4);
85    my $d = deflateInit() or die "Can't open zlib stream.";
86
87    for(my $y = 0; $y<$height; $y++) {
88	for(my $x = 0; $x<$width; $x++) {
89	    my $rgba;
90	    unless (exists $colors{$rgba = $image->Get("pixel[$x,$y]")}) {
91		$colors{$rgba} = pack('C',$index++);
92	    }
93	    $pixels .= $colors{$rgba};
94	}
95	$pixels .= $pad;
96    }
97    %colors = reverse %colors;
98    $tp = $tp ? 'CCCC':'CCC';
99    for my $k (sort keys %colors) {
100	my @rgba = split /,/, $colors{$k};
101	$rgba[3] = 255-$rgba[3];
102	my ($output, $status) = $d->deflate(pack($tp, @rgba));
103	die "Compress error." unless $status == Z_OK;
104	$lossless->ZlibBitmapData->add($output);
105    }
106    my ($output, $status) = $d->deflate($pixels);
107    die "Compress error." unless $status == Z_OK;
108    $lossless->ZlibBitmapData->add($output);
109    ($output, $status) = $d->flush();
110    die "Compress error." unless $status == Z_OK;
111    $lossless->ZlibBitmapData->add($output);
112}
113
114# create SWF.
115
116my $swf = SWF::File->new($swffile);
117$swf->FrameRate(15);
118$swf->FrameSize(0,0,$width*20,$height*20);   # It can't set the same size???
119
120SWF::Element::Tag::SetBackgroundColor->new(
121     BackgroundColor => [
122      Red => 128,
123      Green => 255,
124      Blue => 255,
125     ],
126)->pack($swf);
127
128# lossless tag is packed here.
129
130$lossless->pack($swf);
131
132# define the same size rectangle filled with the bitmap.
133
134SWF::Element::Tag::DefineShape2->new(
135     ShapeID => 2,
136     ShapeBounds => [
137      Xmin => 0,
138      Ymin => 0,
139      Xmax => $width,
140      Ymax => $height
141     ],
142     Shapes => [
143      FillStyles => [
144       FillStyleType => 0x40,
145       BitmapID => 1,
146      ],
147      ShapeRecords => [
148       [MoveDeltaX => 0, MoveDeltaY => 0, FillStyle0 => 1],
149       [DeltaX => $width],
150       [DeltaY => $height],
151       [DeltaX => -$width],
152       [DeltaY => -$height]
153      ],
154     ],
155)->pack($swf);
156
157SWF::Element::Tag::PlaceObject2->new(
158     CharacterID => 2,
159     Depth => 1,
160     Matrix => [
161      TranslateX => 0,
162      TranslateY => 0,
163      ScaleX => 20,
164      ScaleY => 20,
165     ],
166)->pack($swf);
167
168my $sf = SWF::Element::Tag::ShowFrame->new;
169$sf->pack($swf);
170
171SWF::Element::Tag::DoAction->new(
172     Actions => [[Tag => 'ActionStop']],
173)->pack($swf);
174
175$sf->pack($swf);
176
177SWF::Element::Tag::End->new->pack($swf);
178
179$swf->close;
180