jpgs to swf - cann't find threads
cMay
swf, perhaps it is a 3rd party plugin or shareware or such?
Thanks
Christopher May
Navneet Behal
If you have Fireworks 4.0 you can use this command for free
http://www.massimocorner.com/fw/commands/patrick/batch_export_swf.zip
This is how the author Patrick Mineault describes it:
"Batch convert image files to the swf (Flash) file format. Useful if you want
to create image galleries in Flash that use loadMovie(). Note: don't run
as a batch process, just start it from the Command menu "
Good Luck
Navneet
---------------------------------------------------------
"cMay" <ch...@visceralproductions.com> wrote in message
news:3B505B51...@visceralproductions.com...
urami_
> "Batch convert image files to the swf (Flash) file format. Useful if you want
> to create image galleries in Flash that use loadMovie(). Note: don't run
> as a batch process, just start it from the Command menu "
or for On Line use "jpeg2swf" , an early alpha
version here: http://wahlers.de/jpeg2swf_ocx.zip - read the text
file that is included.
egan
called jpg2swf.pl
Oops, I can't find the URL, but the authors email is:
adam
---@---
sixzeds.com
(remove the ---'s)
aw, hell, here it is, he said hes a nice guys who'll let you redistrib it...
#!/usr/bin/perl -w
# jpg->swf converter (batch mode)
# Adam, 2000 (ad...@sixzeds.com)
# Based in part on Img::Size.
# thanks to all at www.openswf.org for the addenda to the swf format docs
# release 1 - creates 100x100 swfs from any size jpg.
# release 1.01 - fixed limitation - now outputs to any size. Currently set up to
output swf of same dimensions as input image
# see produce_swf routine to change this behaviour
## Requirements: Currently requires djpeg/cjpeg to support other file formats.
## AUTHOR
## Adam Lounds, ad...@sixzeds.com
## COPYRIGHT
## This is free software in the colloquial nice-guy sense of the word.
## Copyright (c) 2000, Adam Lounds. You may redistribute and/or modify it
## under the same terms as Perl itself. (Artistic License)
## USAGE
## on the command line: jpgswf_batch.cgi filename [filename2 ...]
## note: you can set the output file to be a certain size in the produce_swf
routine
## TODO:
## Tidy up code or do a module.
## use a proper binary module. Math::BaseCalc looks promising, as does the
File::Binary module from
## the perl::flash pages at http://www.twoshortplanks.com/simon/flash/index.html
## Currently, all binary conversion is done with vec and pack/unpack. It's not
nice.
## use Imagemagic module for photoshop conversion rather than the current hacky
method
## Do lossless version for gif/png images (convert gif/bmp to png first?)
## Support photoshop jpeg images natively? (not likely)
## Apologies:
## this really is hacky, and has been converted multiple times to behave in
## different ways, which always seems to make code messier. There's also a lot
## of redundant debug comments. I've tried to modularise as much as possible
## (for example the abstraction of the RECT, vline and hline routines) to
## pave the way for something a little tidier. But hey.
require Symbol;
use strict;
use CGI;
use vars qw($dbh $last_pos $debug $savepath $filesaved);
use FileHandle;
my $debug = 0;
my $last_pos = 0;
my $filesaved = 0; # when any file goes all the way, this will be set to one.
foreach my $file_to_do (@ARGV) {
next unless ($file_to_do =~ /(\.jpg|\.JPG)$/); #only convert jpegs
my $outfile = $file_to_do;
$outfile =~ s/jpg$/swf/i; # file.jpg -> file.swf
&do_one($file_to_do, $outfile);
}
sub do_one {
# routine called from HTML form, hopefully with image attached...
# saves file to fixed place (implement your own unique-filename algorithm)
my ($infile, $outfile) = @_;
my $fh = new FileHandle;
open $fh, $infile || die "can't open $infile: $!";
my $length = -s $fh; # size of input jpg
$debug && &log("jpgswf/upload: reading filehandle image- size is $length");
if ($length <1) {
# empty image - don't save
$debug && &log("jpgswf/upload: zero length file for image");
return;
}
# ok - file should be available. Read it in...
binmode($fh); # allow script to run on win32 platform
my $jpg = &my_read($fh, $length);
# now have data in $jpg.
# check JPG for validity/photoshop
my ($type, $x, $y) = ();
($type, $x, $y) = &jpegvalidate(\$jpg);
if ($type eq "ok") {
# file is normal JPEG file
my $swfref = &produce_swf($x, $y, \$jpg);
&write_swf($swfref, $outfile);
} elsif ($type eq "PShop") {
# photoshop format
# run through djpeg/cjpeg
my ($x, $y, $newjpgref) = &convertPS(\$jpg);
my $swfref = &produce_swf($x, $y, $newjpgref);
&write_swf($swfref, $outfile);
} elsif ($type eq "nonjfif") {
&doerror('not a jpeg file');
} elsif (($type eq "gif") || ($type eq "bmp")) {
# gif/bmp format
# run through cjpeg
my ($x, $y, $newjpgref) = &convertGIF(\$jpg);
my $swfref = &produce_swf($x, $y, $newjpgref);
&write_swf($swfref, $outfile);
} elsif ($type eq 'swf') {
# swf format - just write to disk
$filesaved = 1;
&write_swf(\$jpg, $outfile);
}
if ($filesaved) {
&html_ok();
} else {
&doerror("file upload failed");
}
}
sub jpegvalidate {
# called with ($rc, $x, $y) = &jpegvalidate(\$jpg);
my $jpgref = shift;
my $rc = ''; # return code - ok, PShop, nonjfif or error
my ($x, $y) = (0,0); # x,y size
$last_pos = 0; # reset global seek position for all filehandles
# check for FFD8 as 1st 2 bytes
my $soi = &buf_read($jpgref, 2); # read 1st 2 bytes
if ($soi ne "\xFF\xD8") {
# not a JFIF file - work out what it is and return
my $nexttwo = &buf_read($jpgref,2);
my $signature = $soi . $nexttwo;
if ($signature =~ /^FWS/) {
$debug && &log("DETECT - SWF file being uploaded");
return ('swf', 0,0);
} elsif ($signature =~ /^GIF/) {
$debug && &log("DETECT - GIF file being uploaded");
return ('gif', 0,0);
} elsif ($signature =~ /^BM/) {
$debug && &log("DETECT - BMP file being uploaded");
return ('bmp', 0,0);
}
return ('nonjfif', 0,0);
}
while (1) {
# parse each block in the JFIF file
my $header = &buf_read($jpgref, 4);
my ($ff, $type, $len) = unpack("CCn", $header);
#### Sanity checks - if any of these conditions is met then there is a problem
(or we are done!)
if ($ff != 0xFF) {
$debug && &log("jpgswf/upload - ERROR - $ff $type $len - next block
missing!");
return ('error', 0,0);
} elsif ($len <2) {
$debug && &log("jpgswf/upload: $ff $type $len - short block (len < 2)");
return ('error',0,0);
} elsif (($type == 0xEC) || ($type == 0xED) || ($type == 0xEE)) {
# photoshop extensions - Aaagh!
return ('PShop', 0,0);
} elsif (($type == 0xDA) || ($type == 0xD9)) {
# image data - make sure we have already met the x and y dimension data
if (($x == 0) && ($y == 0)) {
$debug && &log("jpgswf:upload - weird JFIF upload: $ff $type $len - SOS/EOI
found (ie got to image data before finding out size)");
return ('error',0,0);
} else {
# reached image data, have x and y coords and no errors so far.
# extra check for jpegs with more than one image block
if ($$jpgref =~ /\xFF\xDA.*\xFF\xDA/s) { # /s to ignore \n and treat
everything as one string
# v.poor check but *will* catch them.
return ('PShop', 0,0);
}
last;
}
}
# process "normal" blocks...
if (($type >= 0xc0) && ($type <= 0xc3)) {
# block containing size data
($x, $y) = get_size($type, $len, &buf_read($jpgref, $len - 2));
} else {
# unknown/unrequired block. Just read it in so we can parse the next block
my $throwaway = &buf_read($jpgref, $len-2);
}
}
# only way out of above loop is via last or a return.
# if last, we get to here - ie file is fine.
return ('ok', $x, $y);
}
sub convertPS {
# routine to convert Photoshop format files ready for conversion to swf
# called with ($x, $y, $newjpgref) = &convertPS(\$jpg);
# NOTE: re-creating the file as a jfif will result in a loss of quality.
# however, it's either that or no upload at all. Your call...
my $jpgref = shift;
my $newjpg = ();
$debug && &log("converting Photoshop image...");
# there is probably a better way to do this which would just shove the data
# through a pipe and read from the other end. Until I find it, we save to disk...
open (CONVERT, "|djpeg -bmp |cjpeg >/home/dev/data/tmp/$$.tmp");
print CONVERT $$jpgref;
close CONVERT;
# should now have valid jpeg file in /home/moveon/data/tmp/$$.tmp
open (NEWJPG, "/home/dev/data/tmp/$$.tmp");
while (<NEWJPG>) {
$newjpg .= $_;
}
close NEWJPG;
system ("rm /home/dev/data/tmp/$$.tmp"); # delete temporary file from disk
my ($type, $x, $y) = &jpegvalidate(\$newjpg);
if ($type ne "ok") {
# conversion has failed!!!
$debug && &log("photoshop conversion has failed :-( type is now $type");
&doerror("Photoshop format not supported");
exit(0);
}
# all OK
return ($x, $y, \$newjpg);
}
sub convertGIF {
# conversion routine for GIF->JPG ready for conversion to swf
# called with ($x, $y, $newjpgref) = &convertPS(\$jpg);
my $jpgref = shift;
my $newjpg = ();
# there is probably a better way to do this which would just shove the data
# through a pipe and read from the other end. Until I find it, we save to disk...
open (CONVERT, "|cjpeg >/home/dev/data/tmp/$$.tmp");
print CONVERT $$jpgref;
close CONVERT;
# should now have valid jpeg file in /home/moveon/data/tmp/$$.tmp
open (NEWJPG, "/home/dev/data/tmp/$$.tmp");
while (<NEWJPG>) {
$newjpg .= $_;
}
close NEWJPG;
# DEBUG - uncomment before going live..
#system ("rm /home/dev/data/tmp/$$.tmp"); # delete temporary file from disk
my ($type, $x, $y) = &jpegvalidate(\$newjpg);
if ($type ne "ok") {
# conversion has failed!!!
&log("foreign format conversion has failed :-( type is now $type");
&doerror("Non JPEG images not supported");
exit(0);
}
# all OK
return ($x, $y, \$newjpg);
}
sub produce_swf {
# call with &produce_swf($x, $y, \$jpg)
# returns $swf as a string of bytes ready for output
my ($xsize, $ysize, $jpgref) = @_;
# 100x100 hardcoding
#my $xtwips = 2000; # movie/shape size hardcoded to 100x100
#my $ytwips = 2000;
my $xtwips = $xsize * 20; # movie/shape size based on jpeg size
my $ytwips = $ysize * 20;
my $bytesize = length ($$jpgref); # not needed - worked out within jpg_img
routine
$debug && &log("jpgswf/produce_swf: got size of jpg as $xsize x $ysize ($bytesize
bytes)"); # $bytesize only used in this debug message!
my $version = 4;
my $swf = &fws_header($version); # start with FWS header
$swf .= ' '; # placeholder for file size (4 bytes)
$swf .= &rect(0,$xtwips,0,$ytwips); # bounding box for movie
$swf .= &frame_rate(12); # set frame rate at 12fps
$swf .= &num_frames(1); # set number of frames as 1
$swf .= &bg_col(255,255,255); # set background colour as white
if ($debug) {
&log("jpgswf/produce_swf: header complete - hexdump is:");
&log(&hexdump($swf));
}
$swf .= &jpg_img($jpgref); # include jpg image
$swf .= &defineshape($xsize, $ysize, $xtwips, $ytwips); # define shape with
scaling
$swf .= &footer; # place object, show frame etc
# OK - swf is now complete! Need to go back and fix file size though...
my $filesize = length $swf;
$debug && &log("jpgswf/produce_swf: swf complete. size is $filesize");
my $sizevec = '';
vec($sizevec, 0,32) = $filesize;
my ($byte1, $byte2, $byte3, $byte4) = unpack("CCCC", $sizevec);
my $sizebit = chr($byte4) . chr($byte3) . chr($byte2) . chr($byte1);
substr($swf, 4, 4) = $sizebit; # insert in correct place
return \$swf;
}
sub write_swf {
# routine to actually write to disk
# usage: &write_swf($dataref, $outfile);
my ($dataref, $outfile) = @_;
my $filename = $outfile;
open (OUT, ">$filename") || die "can't open $filename for output - $!";
$debug && &log("saving image to file $filename");
binmode OUT; # fix win32!
my $length = length $$dataref;
syswrite OUT, $$dataref, $length;
close OUT;
$filesaved = 1; # global var to say something has been saved
}
# FWS header (initial 4 bytes)
sub fws_header {
# call with $bitstring = &fws_header($version) - $version is typically 4 for
flash 4
my $version = shift;
my $out = 'FWS';
$out .= chr($version);
return $out;
}
# number of frames in movie encoding
sub num_frames {
# call with $bitstring - &num_frames($num) where $num is number of frames.
# typically 1 for jpg->swf conversion
# returns string for number of frames entry
# typically 0x01 0x00 if one frame
my $numframes = shift;
my $out = chr($numframes) . chr(0); # only copes with <255 frames like this...
return $out;
}
# Background colour change encoding
sub bg_col {
# call with $bitstring = &bg_col($r, $g, $b) with r,g,b in range 0-255
# returns bitstring for bg colour change record
# typically 0x43 0x02 0xff 0xff 0xff for white (255,255,255).
my ($r, $g, $b) = @_;
my $out = '';
$out .= chr(0x43) . chr(0x02); # flash "change background colour" tag
# sanity check colour values are from 0 to 255
foreach ($r, $g, $b) {
if (($_ <0) || ($_ > 255)) {
$debug && &log("convert/bg_col: bg_col - colour out of range! input rgb value
was $r $g $b");
return &bg_col(255,255,255); # gracefully exit as if white
} else {
$out .= chr($_);
}
}
return $out;
}
### FRAME RATE encoding
sub frame_rate {
# call with $swf .= &frame_rate(18) for 18 fps
# returns string for FRAMERATE entry
my $fps = shift;
my $out = '';
$out .= chr(0); # only copes with integer frame rates
$out .= chr($fps);
return $out;
}
### RECT encoding
sub rect {
# call with $swf .= &rect($minx, $maxx, $miny, $maxy) where $minx etc are
measured in twips
# (pixels * 20)
# returns: string of bytes for RECT entry
my ($xmin, $xmax, $ymin, $ymax) = @_;
# work out number of bits needed for encoding
my $bitsneeded = &bitsneeded(@_);
$bitsneeded++; # allow for sign bit
# first 5 bits are number of bits to use for other values
my $numvec = '';
vec($numvec, 0, 8) = $bitsneeded;
my $binarystring = unpack('B*', $numvec);
my $bitstring = substr($binarystring, -5);
foreach (@_) {
# TODO check and sort out negative numbers...
#&log("encoding $_ using $bitsneeded bits");
my $dummyvec = '';
vec($dummyvec, 0, 32) = $_;
my $binarystring = unpack('B*', $dummyvec);
$binarystring = substr($binarystring, (0-$bitsneeded));
#$debug && &log("jpgswf/rect: $_ is $binarystring in $bitsneeded bits");
$bitstring .= $binarystring;
}
my $numpads = (length $bitstring) % 8;
$numpads = 8 - $numpads; # need to add rather
# than subtract to get
# to nearest multiple
$numpads = ($numpads == 8) ? 0 : $numpads;
# make sure we don't pad a whole byte.
$bitstring .= "0" x $numpads;
$debug && &log("jpgswf/rect: bitstring padded to " . length($bitstring) . "
chars");
my $out = pack('B*', $bitstring);
return $out;
}
# Definebits JEPG2 record
sub jpg_img {
# routine to include a jpg image in a swf file
# call with $swf .= &jpg_img($jpgref); (does *not* return bitstring!)
# returns string of bytes for jpg record
my $jpgref = shift; # reference to jpg file
# get record length in right order (ie hex value of 01020304 saved as 04030201)
my $bytesize = length ($$jpgref);
my $sizevec = '';
vec($sizevec, 0,32) = $bytesize+6; # 6 extra bytes used in definebits record
my ($byte1, $byte2, $byte3, $byte4) = unpack("CCCC", $sizevec);
my $dummyvec = '';
vec($dummyvec, 0,16) = 0x7f05; # 7f 05 -> define bits JPEG2
vec($dummyvec, 2,8 ) = $byte4;
vec($dummyvec, 3,8 ) = $byte3;
vec($dummyvec, 4,8 ) = $byte2;
vec($dummyvec, 5,8 ) = $byte1;
# set id of bitmap as 1
vec($dummyvec, 6,8 ) = 1;
vec($dummyvec, 7,8 ) = 0;
vec($dummyvec, 4,16) = 0xffd9; # extra JFIF header for some reason...
vec($dummyvec, 5,16) = 0xffd8; # extra JFIF header for some reason...
# header complete - convert from bitstring to string
my $output = $dummyvec;
$output .= $$jpgref;
#$debug && &log(&hexdump($output)); # shows definebits JPEG2 entry (warning -
this is long!!)
return $output;
}
# DEFINE SHAPE routine
sub defineshape {
# hardcoded to draw a rectangle with out jpg image in it
# call with $swf .= &defineshape($x, $y, $xtwips, $ytwips)
# where $x and $y are dimensions of jpg
# xtwips, ytwips are desired size of shape to put jpg in (scaled to fit)
# returns string of bytes for define shape record.
my ($x, $y , $xtwips, $ytwips) = @_;
$debug && &log("defineshape: $x, $y, $xtwips, $ytwips");
## tag stuff
my $dummyvec = '';
vec($dummyvec, 0, 16) = 0xbf00; # long shape record
vec($dummyvec, 1, 16) = 0; # holder word for length (1)
vec($dummyvec, 2, 16) = 0; # holder word for length (2)
vec($dummyvec, 3, 16) = 0x0200; # id = 2
my $out = $dummyvec;
## bounding box for shape
$out .= &rect(0, $xtwips, 0, $ytwips); # shape bounding box
## Fill style array
## include redundant fill style 65535 to reproduce flash behaviour
$out .= chr(2); # 2 fill styles (reproduce flash editor bug)
my @empty_fillstyle = ( 0x41, 0xff, 0xff, 0xd9,
0x40, 0x00, 0x05, 0x00,
0x00, 0x00 ); # redundant fill style data
foreach (@empty_fillstyle) {
$out .= chr($_);
}
# include our image data as a fill style
$out .= chr(0x41); # clipped bitmap fill style
$out .= chr(1) . chr(0); # 0x0100 -> fill id = 1
########## matrix for scaling.
# how many bits for scaling?
my $xscale = $xtwips/$x;
$xscale *= 65536; # shift 16 bits to the left
$xscale /= 10; # ignore units column (Flash does it...)
$xscale = int $xscale; # trim fractional part
$xscale *= 10; # get units column back
# same for y
my $yscale = int(($ytwips/$y) * 65536 / 10 ) * 10;
my $bitsneeded = &bitsneeded($xscale, $yscale);
$bitsneeded++; # allow for sign bit
$debug && &log("jpgswf/defineshape: checking bitsneeded for scale values $xscale
and $yscale - $bitsneeded");
# work out bitstring for bitsneeded
$dummyvec = '';
vec($dummyvec, 0, 8) = $bitsneeded;
my $bitstring_bitsneeded = unpack('B*', $dummyvec);
$bitstring_bitsneeded = substr($bitstring_bitsneeded, -5);
# work out bitstring for x scale
$dummyvec = '';
vec($dummyvec, 0, 32) = $xscale; # put value in vector
my $bitstring_xscale = unpack('B*', $dummyvec); # get as bitstring
$bitstring_xscale = substr($bitstring_xscale, (0-$bitsneeded)); # trim to right
size
# work out bitstring for y scale
$dummyvec = '';
vec($dummyvec, 0, 32) = $yscale; # put value in vector
my $bitstring_yscale = unpack('B*', $dummyvec); # get as bitstring
$bitstring_yscale = substr($bitstring_yscale, (0-$bitsneeded)); # trim to right
size
# concatenate bitstrings to make a MATRIX bitstring
my $bitstring_matrix = "1" . $bitstring_bitsneeded . $bitstring_xscale .
$bitstring_yscale . "00000";
# 1 = has scale
# 0 = no rotate
# 0 = no transform (ie origin is 0,0)
# extra five 0's determined by trialling jpegs from 6px to 1536px in 2x
increments
# bit padding now works fine for all of these (ie using 18 to 26 bits in the
# scale fields)
# pad out to byte boundary
$bitstring_matrix = &_pad($bitstring_matrix, 8);
# convert from bitstring to data string
my $matrix = pack('B*', $bitstring_matrix);
$out .= $matrix;
if ($debug) {
&log("matrix: scale to $xscale x $yscale");
#&log(&hexdump($matrix));
}
# linestyle array
$out .= chr(0); # empty LINESTYLE ARRAY
# shape record array
# extra stuff for start of shape (not sure about these two bytes yet - I think
they set the fillstyle...)
my @extrabits = ( 0x20, 0x12 );
foreach (@extrabits) {
$out .= chr($_);
}
# draw box $xtwips by $ytwips
my $hline1 = &hline($xtwips); # bits for line entry
my $vline1 = &vline($ytwips);
my $hline2 = &hline(0 - $xtwips);
my $vline2 = &vline(0 - $ytwips);
# end shape
my $shape_end = "000000"; # six zero bits -> end shape record
# generate bytestring for shape record
my $shape_bitstring = &_pad($hline1 . $vline1 . $hline2 . $vline2 . $shape_end,
8); # ensure shape fits into byte boundary
my $shape_record = pack('B*', $shape_bitstring);
$out .= $shape_record;
# ok - shape record complete. Need to go back and set record length...
my $recordlength = length($out) - 6; # 6 to allow for record header
my $sizevec = '';
vec($sizevec, 0,32) = $recordlength;
my ($byte1, $byte2, $byte3, $byte4) = unpack("CCCC", $sizevec);
my $sizebit = chr($byte4) . chr($byte3) . chr($byte2) . chr($byte1);
substr($out, 2, 4) = $sizebit; # insert in correct place
return $out;
}
# FOOTER - tidy up at the end, show the frame etc
sub footer {
# call with $swf .= &footer; (no input params)
# output - string containing footer data
my $out = '';
my @footerdata = ( 0x86, 0x06, 0x06, # place char (6 long)
0x01, 0x00, # place at depth 1
0x02, 0x00, # place char 2
0x00, # empty matrix
0x40, 0x00, # show frame, length 0
0x00, 0x00 ); # end of swf, length 0
foreach (@footerdata) {
$out .= chr($_);
}
return $out;
}
sub bitsneeded {
# routine to determine how many bits are needed to
# encode some values
my @values = @_;
my $bitsneeded = 0;
foreach (@values) {
$_ = ($_ < 0) ? 0-$_ : $_; # no negatives
my $dummyvec = '';
vec($dummyvec, 0, 32) = $_;
my $binaryvalue = unpack('B*', $dummyvec);
$binaryvalue =~ s/^0+//; # trim leading zeros
my $length = length $binaryvalue;
if ($length > $bitsneeded) {
$bitsneeded = $length;
}
$debug && &log("jpgswf/bitsneeded: $_ is $binaryvalue ($length long)");
}
return $bitsneeded;
}
sub hexdump {
# routine to dump hex to stdout for debug purposes.
my $data = shift;
my $bytecount = length $data;
my @hexvals = unpack("C$bytecount", $data);
my $count = 0;
my $out = '';
foreach (@hexvals) {
$count++;
$out .= sprintf "%02x ", $_;
if ($count == 16) {
$count = 0;
$out .= "\n";
}
}
return $out;
}
sub doerror {
# routine called if there was a problem
my $error = shift;
print <<EOF;
<head><title>upload failed</title></head>
<!-- error - $error -->
<body bgcolor="#000000">
Your upload has failed. Please click the back button and try again.<p>
Please note that we only support uploads as JPEG files.
</body>
</html>
EOF
exit;
}
sub my_read {
my ($source, $len) = @_;
my $buf = '';
my $n = read($source, $buf, $len);
die "read failed - $!" unless defined $n;
die "short read ($n/$len)" unless ($n ==$len);
return $buf;
}
sub buf_read {
my $buf = shift;
my ($length, $offset) = @_;
$last_pos = 0 unless (defined($last_pos));
if (defined($offset) && ($offset != $last_pos)) {
$last_pos = $offset;
return '' if ($last_pos > length($$buf));
}
my $data = substr($$buf, $last_pos, $length);
$last_pos += length($data);
return $data;
}
sub get_size {
# determine size from a FFc0 JFIF block
my ($type, $len, $data) = @_;
# data should be:
# x (dummy byte)
# n (2 bytes for y size)
# n (2 bytes for x size)
my ($y, $x) = unpack("xnn", $data);
$debug && &log(sprintf "jpgswf/get_size: parsing size block of type %02x ... size
is $x x $y", $type);
return ($x, $y);
}
sub html_ok {
return;
# routine to print "all ok message"
$debug && &log("generating all_ok html page");
print <<EOF;
<head><title>JPG to SWF conversion complete</title></head>
<body bgcolor="#FFFFFF">
Your upload has completed successfully.
The converted image is <A HREF="/images/converted.swf">here</A>
</body>
</html>
EOF
}
sub log {
# routine to handle error log - we can't view the global one and don't want
# to pollute it, but we still need to do debugging...
my ($message) = shift;
my ($min, $hour, $day, $mon) = (localtime) [1..4];
$mon++; # fix jan=0 thing
$hour = sprintf("%02d", $hour);
$min = sprintf("%02d", $min);
my $timestring = "$hour:$min $day/$mon";
$message =~ s/\n//g; # now remove all lfs from message
my $script = $0;
$message = "$timestring $script: $message"; # stick timestring and messages
together. $0 is name of running program
print STDERR "$message \n";
}
sub _pad {
# internal routine to pad a bitstring to nearest n bits with trailing zeros.
$pad_to is normally 8
my ($bitstring, $pad_to) = @_;
my $numpads = (length $bitstring) % $pad_to;
$numpads = $pad_to - $numpads; # need to add rather
# than subtract to get
# to nearest multiple
$numpads = ($numpads == $pad_to) ? 0 : $numpads;
# make sure we don't pad a whole byte.
$bitstring .= "0" x $numpads;
return $bitstring;
}
sub hline {
# routine to add a horizontal line to a shape record
my $xdelta = shift;
# work out bits for NBits = UB[4] + 2
my $bitsneeded = &bitsneeded(abs($xdelta)) + 1; # eg 12 bits needed (allow extra
bit for sign bit)
$bitsneeded -= 2; # allow for the +2 part
my $numvec = ''; # holder for vector
vec($numvec, 0, 8) = $bitsneeded; # put data into vector
my $binarystring = unpack('B*', $numvec); # convert to binary bitstring
my $bitstring = substr($binarystring, -4); # only use 4 bits to fit in UB[4]
# STRAIGHTEDGERECORD
my $outstring = '';
$outstring .= "1"; # shape record
$outstring .= "1"; # straight edge
$outstring .= $bitstring; # number of bits per value (NBits = UB[4] +2)
$outstring .= "0"; # Vert/Horiz line
$outstring .= "0"; # Horiz line
# cope with negative numbers...
my $DeltaX_bitstring = '';
if ($xdelta < 0) {
# negative value... calculate two's complement to get negative version
# for non-binary aware people, two's complement is calculated as follows:
# 1. take binary value (eg 0111 1101 0000 == 2000)
# 2. subtract one (now 0111 1100 1111 == 1999)
# 3. invert (now 1000 0011 0000 == -2000)
my $positive_value = abs($xdelta);
$positive_value -= 1; # subtract one
my $vec = '';
vec($numvec, 0, 32) = $positive_value;
my $binarystring = unpack('B*', $numvec);
$DeltaX_bitstring = substr($binarystring, (0 - ($bitsneeded + 2))); # truncate
to required length
$DeltaX_bitstring =~ tr/10/01/; # flip all bits
} else {
# positive value - much easier!
my $vec = '';
vec($numvec, 0, 32) = $xdelta;
my $binarystring = unpack('B*', $numvec);
$DeltaX_bitstring = substr($binarystring, (0 - ($bitsneeded + 2)));
}
$outstring .= $DeltaX_bitstring;
return $outstring;
}
sub vline {
# routine to add a vertical line to a shape record (very similar to hline...)
my $ydelta = shift;
# work out bits for NBits = UB[4] + 2
my $bitsneeded = &bitsneeded(abs($ydelta)) + 1; # eg 12 bits needed (allow extra
bit for sign bit)
$bitsneeded -= 2; # allow for the +2 part
my $numvec = ''; # holder for vector
vec($numvec, 0, 8) = $bitsneeded; # put data into vector
my $binarystring = unpack('B*', $numvec); # convert to binary bitstring
my $bitstring = substr($binarystring, -4); # only use 4 bits to fit in UB[4]
#STRAIGHTEDGERECORD
my $outstring = '';
$outstring .= "1"; # shape record
$outstring .= "1"; # straight edge
$outstring .= $bitstring; # number of bits per value (NBits = UB[4] +2)
$outstring .= "0"; # Vert/Horiz line
$outstring .= "1"; # vert line
# cope with negative numbers...
my $DeltaY_bitstring = '';
if ($ydelta < 0) {
# negative value... calculate two's complement to get negative version
# for non-binary aware people, two's complement is calculated as follows:
# 1. take binary value (eg 0111 1101 0000 == 2000)
# 2. subtract one (now 0111 1100 1111 == 1999)
# 3. invert (now 1000 0011 0000 == -2000)
my $positive_value = abs($ydelta);
$positive_value -= 1; # subtract one
my $vec = '';
vec($numvec, 0, 32) = $positive_value;
my $binarystring = unpack('B*', $numvec); # convert to bitstring
$DeltaY_bitstring = substr($binarystring, (0 - ($bitsneeded + 2))); # truncate
to required length
$DeltaY_bitstring =~ tr/10/01/; # flip all bits
} else {
# positive value - much easier!
my $vec = '';
vec($numvec, 0, 32) = $ydelta;
my $binarystring = unpack('B*', $numvec);
$DeltaY_bitstring = substr($binarystring, (0 - ($bitsneeded + 2)));
}
$outstring .= $DeltaY_bitstring;
return $outstring;
}