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