view release on metacpan or  search on metacpan

samples/img2swf.plx  view on Meta::CPAN

#!/usr/bin/perl

use strict;

use SWF::File;
use SWF::Element;
use Image::Magick;
use Compress::Zlib;
use Getopt::Std;

my %opt;
getopts('ft', \%opt);

my ($imagefile, $swffile) = @ARGV;

unless (defined $imagefile) {
    print STDERR <<USAGE;
img2swf.plx - convert an image to a swf.
  perl img2swf.plx [-f] [-t] imagefile [swffile]
   -f: Force to convert to full color bitmap.
   -t: Keep transparency.
USAGE

    exit(1);
}

($swffile = $imagefile) =~s/\.[^.]+$/.swf/ unless defined $swffile;

my $image = Image::Magick->new;
$image->Read($imagefile);

my $height = $image->Get('height');
my $width = $image->Get('width');
die "Can't open $imagefile." if ($height == 0 and $width == 0);

my ($lossless, $tp);
if ($opt{t} and $image->Get('matte')) {
    $lossless = SWF::Element::Tag::DefineBitsLossless2->new;
    $tp=1;
} else {
    $lossless = SWF::Element::Tag::DefineBitsLossless->new;
    $tp=0;
}
$lossless->configure
    ( CharacterID => 1,
      BitmapWidth => $width,
      BitmapHeight => $height,
    );

if ((my $colors = $image->Get('colors'))>=256 or $opt{f}) {

    $lossless->BitmapFormat(5); # fullcolor

    my $d = deflateInit() or die "Can't open zlib stream."; 

    for(my $y = 0; $y<$height; $y++) {
	for(my $x = 0; $x<$width; $x++) {
	    my @rgba = split /,/, $image->Get("pixel[$x,$y]");
	    if (!$tp) {
		pop @rgba;
		unshift @rgba, 0;
	    } else {
		$rgba[3] = 255-$rgba[3];
		@rgba=@rgba[3,0..2];
	    }

	    my ($output, $status) = $d->deflate(pack('CCCC',@rgba)); # 4 bytes per pixel.
	    die "Compress error." unless $status == Z_OK;
	    $lossless->ZlibBitmapData->add($output);
	}
    }

    my ($output, $status) = $d->flush();
    die "Compress error." unless $status == Z_OK;
    $lossless->ZlibBitmapData->add($output);

} else {

    $lossless->BitmapFormat(3); # bitmap with colormap
    $lossless->BitmapColorTableSize($colors-1);

    my (%colors, $pixels);
    my $index = 0;
    my $pad = "\x00" x (4 - $width % 4);
    my $d = deflateInit() or die "Can't open zlib stream."; 

    for(my $y = 0; $y<$height; $y++) {
	for(my $x = 0; $x<$width; $x++) {
	    my $rgba;