package SWF; require 5.005; use strict; use vars qw($AUTOLOAD $VERSION); $VERSION = .1; my $debug = 0; $^W = 1; #turn on warnings for debugging # # class data definitions # my %tag2num = ( Header => -1, # to make my life easier End => 0, ShowFrame => 1, DefineShape => 2, FreeCharacter => 3, PlaceObject => 4, RemoveObject => 5, DefineBits => 6, DefineButton => 7, JPEGTables => 8, SetBackgroundColor => 9, DefineFont => 10, DefineText => 11, DoAction => 12, DefineFontInfo => 13, DefineSound => 14, StartSound => 15, DefineButtonSound => 17, SoundStreamHead => 18, SoundStreamBlock => 19, DefineBitsLossless => 20, DefineBitsJPEG2 => 21, DefineShape2 => 22, DefineButtonCxform => 23, Protect => 24, PathsArePostScript => 25, PlaceObject2 => 26, RemoveObject2 => 28, SyncFrame => 29, FreeAll => 31, DefineShape3 => 32, DefineText2 => 33, DefineButton2 => 34, DefineBitsJPEG3 => 35, DefineBitsLossless2 => 36, DefineEditText => 37, DefineMovie => 38, DefineSprite => 39, NameCharacter => 40, SerialNumber => 41, DefineTextFormat => 42, FrameLabel => 43, SoundStreamHead2 => 45, DefineMorphShape => 46, FrameTag => 47, DefineFont2 => 48, GenCommand => 49, DefineCommandObj => 50, CharacterSet => 51, FontRef => 52, DefineBitsPtr => 1023, # special tag used only in the editor? #tag 59: #two bytes of unknown content, followed by actionscript bytecode #(usually 0x88 constant pool) # #tag 62 - new font info: #font_id - UI16 #name_length - UI8 #name - name_length bytes #unknown - UI16 #character codes for referenced fonts - UI16[nglyphs] - could be #unicode UnknownActionScript => 59, NewFontInfo => 62, ); my %num2tag = reverse %tag2num; my %actionConditions = ( OverDownToIdle => 1, IdleToOverDown => 2, OutDownToIdle => 3, OutDownToOverDown => 4, OverDownToOutDown => 5, OverDownToOverUp => 6, OverUpToOverDown => 7, OverUpToIdle => 8, IdleToOverUp => 9, ); my %keyCodes = ( ID_KEY_LEFT => 0x01, ID_KEY_RIGHT => 0x02, ID_KEY_HOME => 0x03, ID_KEY_END => 0x04, ID_KEY_INSERT => 0x05, ID_KEY_DELETE => 0x06, ID_KEY_CLEAR => 0x07, ID_KEY_BACKSPACE => 0x08, ID_KEY_ENTER => 0x0D, ID_KEY_UP => 0x0E, ID_KEY_DOWN => 0x0F, ID_KEY_PAGE_UP => 0x10, ID_KEY_PAGE_DOWN => 0x11, ID_KEY_TAB => 0x12, ); my %actionCodes = ( sactionHasLength => 0x80, sactionNone => 0x00, sactionGotoFrame => 0x81, sactionGetURL => 0x83, sactionNextFrame => 0x04, sactionPrevFrame => 0x05, sactionPlay => 0x06, sactionStop => 0x07, sactionToggleQuality => 0x08, sactionStopSounds => 0x09, sactionWaitForFrame => 0x8A, sactionSetTarget => 0x8B, sactionGotoLabel => 0x8C, sactionAdd => 0x0A, sactionSubtract => 0x0B, sactionMultiply => 0x0C, sactionDivide => 0x0D, sactionEquals => 0x0E, sactionLess => 0x0F, sactionAnd => 0x10, sactionOr => 0x11, sactionNot => 0x12, sactionStringEquals => 0x13, sactionStringLength => 0x14, sactionStringAdd => 0x21, sactionStringExtract => 0x15, sactionPush => 0x96, sactionPop => 0x17, sactionToInteger => 0x18, sactionJump => 0x99, sactionIf => 0x9D, sactionCall => 0x9E, sactionGetVariable => 0x1C, sactionSetVariable => 0x1D, sactionGetURL2 => 0x9A, sactionGotoFrame2 => 0x9F, sactionSetTarget2 => 0x20, sactionGetProperty => 0x22, sactionSetProperty => 0x23, sactionCloneSprite => 0x24, sactionRemoveSprite => 0x25, sactionTrace => 0x26, sactionStartDrag => 0x27, sactionEndDrag => 0x28, sactionStringLess => 0x29, sactionWaitForFrame2 => 0x8D, sactionRandomNumber => 0x30, sactionMBStringLength => 0x31, sactionCharToAscii => 0x32, sactionAsciiToChar => 0x33, sactionGetTime => 0x34, sactionMBStringExtract => 0x35, sactionMBCharToAscii => 0x36, sactionMBAsciiToChar => 0x37, sactionQuickTime => 0xAA, ); my %fields = ( version => undef, fileLength => undef, frameSize => undef, frameRate => undef, frameCount => undef, protected => undef, content => undef, _tagList => [], _labels => {}, ); # # Begin public methods # sub new { # Usage: my $swf = SWF->new; my $class = shift; my $self = { _permitted => \%fields, %fields }; bless $self, ref($class) || $class; return $self; } sub addLabel { # Usage: $swf->addLabel($label, $frameNum) # # Adds a FrameLabel which gives the specified name to the frame # Labels must be unique - behavior for non-unique labels is undefined # If no frame number is given, the label is removed. my $self = shift; my $label = shift || return; my $frame = shift; if (defined $frame) { $self->{'_labels'}{$label} = $frame; } else { delete $self->{'_labels'}{$label}; } } sub appendTag { # Usage: $swf->appendTag($tagref) # # Pushes a tag object onto the list of tags in the SWF my $self = shift; my $tagref = shift || return; return unless (ref $tagref eq "SWF::Tag"); my $tagListRef = $self->_tagList; push @$tagListRef, $tagref; } sub tagName { # Usage: my $tagname = SWF::tagName($tagnum) # # given a tag number, will return the name of that tag my $tagnum = shift; return $num2tag{$tagnum}; } sub tagNum { # Usage: my $tagnum = SWF::tagNum($tagname) # # given a tag name, will return the number of that tag my $tagname = shift; return $tag2num{$tagname}; } sub validTags { # Returns a list of valid tag names return sort keys %tag2num; } sub dump { # Usage: $swf->dump # # prints data dump of SWF object my $self = shift; use Data::Dumper; print Dumper($self); } sub _tagList { # Usage: my @taglist = $swf->_tagList; # $swf->_tagList(\@taglist); my $self = shift; my $arref = shift; if (defined $arref) { return undef unless (ref $arref eq "ARRAY"); # make a copy to prevent tagList from being modified from outside my @tmparr = @$arref; $self->{'_tagList'} = \@tmparr; } return $self->{'_tagList'}; } sub _bits2int { # Usage: $int = _bits2int($bitstr) my $bitstr = shift || return; # pad left bits out # $bitstr = "0"x(8-(length($bitstr)%8)) . $bitstr; # my god, what a crappy, suck-ass way to do things. fix it. # pad out to 8, 16, or 32 bound, then pack B*, unpack C, S, or L my $int = 0; my $p = 1; my $l = length($bitstr)-1; for (my $i=$l;$i>=0;$i--) { $int += $p if substr($bitstr,$i,1); $p*=2; } # return ord(pack "B*",$bitstr); # no good - stops at 8 bits. return $int; } sub YY_bits2sint { my $bitstr = shift || return; my $n = length($bitstr); my $int = SWF::_bits2int($bitstr); print "DEBUG1 BITS2SINT: $bitstr = $int\n" if $debug; if ($int & (1 << ($n - 1))) { $int |= -1 << $n; } print "DEBUG2 BITS2SINT: $bitstr = $int\n" if $debug; return $int; } sub _bits2sint { # Usage: $sint = _bits2sint($bitstr) my $bitstr = shift || return; # print "DEBUG BITS2SINT: $bitstr = " if $debug; my $signed = substr($bitstr,0,1); # my god, what a crappy, suck-ass way to do things. fix it. # # geez, it sucks worse than I thought - this is some weird # complementing scheme where the leftomst bit is the sign # (fine - 1=negative) but after the first 1, coming from the # right, every bit is flipped. investigate. # # hmm..looks sort of standardish, but across byte boundaries. # looks like we're still going to have to unroll it by hand. my $sint = 0; if ($signed) { $bitstr = substr($bitstr,1); my $flipit = 0; my $p = 1; my $l = length($bitstr)-1; for (my $i=$l;$i>=0;$i--) { if ($flipit) { $sint += $p unless substr($bitstr,$i,1); } else { if (substr($bitstr,$i,1)) { $sint += $p; $flipit = 1; } } $p*=2; } $sint *= -1; } else { $sint = SWF::_bits2int($bitstr); } return $sint; } sub minBits { # Usage: $nBits = SWF::_minBits($foo, $bar, $baz) # # Returns the minimum number of bits required to represent the vars my @vars = @_; } sub writeBits { # Usage: $content = SWF::writeBits($bits, $nBits) } sub AUTOLOAD { my $self = shift; my $name = $AUTOLOAD; $name =~ s/.*://; return undef unless (exists $self->{_permitted}->{$name}); if (@_) { my $value = shift; return $self->{$name} = $value; } else { return $self->{$name}; } } =head1 NAME SWF - Defines and implements a .swf (Small Web Format, or Flash) file =head1 SYNOPSIS use SWF; $swf = SWF->new(); =head1 DESCRIPTION (...insert description of what SWF is here...) This module implements the core data structure and functionality of an SWF object. It is intended to be used as a base class for other modules - SWF::Parser, SWF::Generator, etc. =head1 AUTHOR Copyright 2000, Marc Majcher. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Address bug reports and comments to: swf-module@majcher.com. This module is based on the OpenSWF specification and SDK released by Macromedia at http://www.macromedia.com/software/flash/open/licensing/ =cut # # Let's try to define some data type objects here... # use Class::Struct; package SWF::Readable; SWF::struct 'SWF::Readable' => { content => '$', atByte => '$', bitBuffer => '$', }; sub init { # Usage: my $readable = SWF::Readable->new->init # # this is mostly to get rid of warning, but that can't be bad. my $self = shift; $self->{'SWF::Readable::content'} = ""; $self->{'SWF::Readable::atByte'} = 0; $self->{'SWF::Readable::bitBuffer'} = ""; return $self; } sub rlength { # Usage: my $length = $readable->rlength # # Returns the length of the content in the Readable object my $self = shift; return length($self->{'SWF::Readable::content'}); } sub readString { # Usage: my $string = $readable->readString # # Reads a string from the content and returns it. Strings # always end with a null (0x00) character my $self = shift; my $string = ""; my $char; while ($char = $self->readBytes(1)) { $string .= $char; last if (ord($char) == 0); } return $string; } sub readBytes { # Usage: my $bytes = $readable->readBytes($number) # # will read $number bytes from {'content'} and return them, # updating the byte counter {'atByte'} # # there's got to be a better way to do this than substring. my $self = shift; my $howMany = shift || return; my $bytes = substr($self->{'SWF::Readable::content'}, $self->{'SWF::Readable::atByte'}, $howMany); $self->seek($self->{'SWF::Readable::atByte'} + $howMany) || return; return $bytes; } sub readBits { # Usage: my $bits = $readable->readBits($number) # # will read the number of bits from {'content'} and return them # # these should all be bit operations, not string operations, # but I have a headache, and can't think about it right now. my $self = shift; my $number = shift || return; my $bits; if ($self->bitBuffer eq "") { if (($number % 8) == 0) { #read whole bytes $bits = pack("B*",$self->readBytes($number/8)); } } if ($number > length($self->bitBuffer)) { # need to fill up bitBuffer my $bytes2read = int(($number-length($self->bitBuffer))/8)+1; my $tmpbits = $self->readBytes($bytes2read); $self->bitBuffer( $self->bitBuffer . unpack("B*",$tmpbits) ); } # read bits from the cache $bits = substr($self->bitBuffer,0,$number); $self->bitBuffer( substr($self->bitBuffer, $number )); return $bits; } sub flushBits { # Usage: $readable->flushBits # # blows away the bitBuffer, so bytes are read from byte boundaries my $self = shift; $self->bitBuffer(""); } sub seek { # Usage: $readable->seek($address) # # will set the {'atByte'} counter to the address given. if no # arguments are given, will seek to the beginning. will return # the address on success, undef if address is out of range my $self = shift; my $address = shift || 0; if ($address) { return unless ($address <= length($self->content)); $self->atByte($address); } else { $self->atByte(0); } 1; } sub tell { # Usage: my $pos = $readable->tell # # Returns the current byte that the atByte counter points to my $self = shift; return $self->atByte; } # # From here on out, it should be all data structures. Each data # structure if defined using Class::Struct, and should have (at least) # three methods, in addition to the 'new' method automatically created. # The methods are: 'read', which takes a Readable object ('content') # and reads the data type from it, 'write', which writes the object to # a data stream, and 'debug', which prints out useful information about # the object. # package SWF::Tag; SWF::struct 'SWF::Tag' => { tagID => '$', length => '$', frame => '$', content => '$', }; sub read { # Usage: $tag->read($swf) # # Takes a Readable object as an argument, and reads a Tag structure # from it, setting the proper instance vars in the Tag object my $self = shift; my $swf = shift || return; # read tag id and length # there must be a better/faster way to do this. my $recordHeader = unpack("B*", $swf->readBytes(2)); my $tagID = SWF::_bits2int(substr($recordHeader, 8, 8) . substr($recordHeader, 0, 2)); my $length = SWF::_bits2int(substr($recordHeader, 2, 6)); # get long tag length if ($length == 63) { $length = unpack("L", $swf->readBytes(4)); } $self->tagID($tagID); $self->length($length); # read in the tag content and store it my $content = SWF::Readable->new->init; $content->content($swf->readBytes($length)); $self->content($content); return $self; } package SWF::RGB; SWF::struct 'SWF::RGB' => { Red => '$', Green => '$', Blue => '$', }; sub read { print " -- reading RGB\n" if $debug; # Usage: $RGB->read($content) # # Takes a Readable object as an argument, and reads an RGB structure # from it, setting the proper instance vars in the RGB object my $self = shift; my $content = shift || return; my $Red = ord($content->readBytes(1)); my $Green = ord($content->readBytes(1)); my $Blue = ord($content->readBytes(1)); $self->Red($Red); $self->Green($Green); $self->Blue($Blue); return $self; } sub write { my $self = shift; my $content = pack "C", $self->Red; $content .= pack "C", $self->Green; $content .= pack "C", $self->Blue; return $content; } sub debug { my $RGB = shift; print " R: " . $RGB->Red . " G: " . $RGB->Green . " B: " . $RGB->Blue . "\n"; } package SWF::RGBA; SWF::struct 'SWF::RGBA' => { Red => '$', Green => '$', Blue => '$', Alpha => '$', }; sub read { print " -- reading RGBA\n" if $debug; # Usage: $RGBA->read($content) # # Takes a Readable object as an argument, and reads an RGBA structure # from it, setting the proper instance vars in the RGBA object my $self = shift; my $content = shift || return; my $Red = ord($content->readBytes(1)); my $Green = ord($content->readBytes(1)); my $Blue = ord($content->readBytes(1)); my $Alpha = ord($content->readBytes(1)); $self->Red($Red); $self->Green($Green); $self->Blue($Blue); $self->Alpha($Alpha); return $self; } sub write { my $self = shift; my $content = pack "C", $self->Red; $content .= pack "C", $self->Green; $content .= pack "C", $self->Blue; $content .= pack "C", $self->Alpha; return $content; } sub debug { my $RGBA = shift; print " R: " . $RGBA->Red . " G: " . $RGBA->Green . " B: " . $RGBA->Blue . " A " . $RGBA->Alpha . "\n"; } package SWF::Rect; SWF::struct 'SWF::Rect' => { Nbits => '$', Xmin => '$', Xmax => '$', Ymin => '$', Ymax => '$', }; sub read { print " -- reading Rect\n" if $debug; # Usage: $rect->read($content) # # Takes a Readable object as an argument, and reads a Rect structure # from it, setting the proper instance vars in the Rect object my $self = shift; my $content = shift || return; my $Nbits = SWF::_bits2int($content->readBits(5)); my $Xmin = SWF::_bits2sint($content->readBits($Nbits)); my $Xmax = SWF::_bits2sint($content->readBits($Nbits)); my $Ymin = SWF::_bits2sint($content->readBits($Nbits)); my $Ymax = SWF::_bits2sint($content->readBits($Nbits)); $content->flushBits; $self->Nbits($Nbits); $self->Xmin($Xmin); $self->Xmax($Xmax); $self->Ymin($Ymin); $self->Ymax($Ymax); return $self; } sub write { my $self = shift; my $content; # my $nbits = SWF::_minBits(); ### for debugging only: my $bitString = "01100000000000000011111010000000000000000011111010000000"; return pack "B*",$bitString; } sub debug { my $rect = shift; print "(", $rect->Xmin, ", ", $rect->Xmax, ", ", $rect->Ymin, ", ", $rect->Ymax, ")\n"; } package SWF::Matrix; SWF::struct 'SWF::Matrix' => { HasScale => '$', NScaleBits => '$', ScaleX => '$', ScaleY => '$', HasRotate => '$', RotateBits => '$', RotateSkew0 => '$', RotateSkew1 => '$', NTranslateBits => '$', TranslateX => '$', TranslateY => '$', }; sub read { print " -- reading Matrix\n" if $debug; # Usage: $matrix->read($content) # # Takes a readable and reads a Matrix my $self = shift; my $content = shift || return; if (my $hasScale = $content->readBits(1)) { my $nScaleBits = SWF::_bits2int($content->readBits(5)); my $scaleX = SWF::_bits2int($content->readBits($nScaleBits)); my $scaleY = SWF::_bits2int($content->readBits($nScaleBits)); $self->ScaleX($scaleX); $self->ScaleY($scaleY); } if (my $hasRotate = $content->readBits(1)) { print "reading rotate bits\n"; my $nRotateBits = SWF::_bits2int($content->readBits(5)); my $rotateSkew0 = SWF::_bits2int($content->readBits($nRotateBits)); my $rotateSkew1 = SWF::_bits2int($content->readBits($nRotateBits)); $self->RotateSkew0($rotateSkew0); $self->RotateSkew1($rotateSkew1); } my $nTranslateBits = SWF::_bits2int($content->readBits(5)); my $translateX = SWF::_bits2int($content->readBits($nTranslateBits)); my $translateY = SWF::_bits2int($content->readBits($nTranslateBits)); $self->TranslateX($translateX); $self->TranslateY($translateY); $content->flushBits; return $self; } sub debug { my $matrix = shift; print " Matrix: " . ($matrix->ScaleX || "0") . " " . ($matrix->RotateSkew0 || "0") . "\n" . " " . ($matrix->RotateSkew1 || "0"). " " . ($matrix->ScaleY || "0"). "\n" . " " . ($matrix->TranslateX || "0"). " " . ($matrix->TranslateY || "0"). "\n" ; } package SWF::CXform; SWF::struct 'SWF::CXform' => { HasAddTerms => '$', HasMultTerms => '$', Nbits => '$', RedMultTerm => '$', GreenMultTerm => '$', BlueMultTerm => '$', RedAddTerm => '$', GreenAddTerm => '$', BlueAddTerm => '$', }; sub read { print " -- reading CXform\n" if $debug; # Usage: $cxform->read($content) # # Takes a readable and reads a CXform my $self = shift; my $content = shift || return; my $hasAdd = $content->readBits(1); my $hasMult = $content->readBits(1); my $nbits = SWF::_bits2int($content->readBits(4)); if ($hasAdd) { my $rmt = SWF::_bits2int($content->readBits($nbits)); my $gmt = SWF::_bits2int($content->readBits($nbits)); my $bmt = SWF::_bits2int($content->readBits($nbits)); $self->RedMultTerm($rmt); $self->GreenMultTerm($gmt); $self->BlueMultTerm($bmt); } if ($hasMult) { my $rat = SWF::_bits2int($content->readBits($nbits)); my $gat = SWF::_bits2int($content->readBits($nbits)); my $bat = SWF::_bits2int($content->readBits($nbits)); $self->RedAddTerm($rat); $self->GreenAddTerm($gat); $self->BlueAddTerm($bat); } $content->flushBits; return $self; } sub debug { my $self = shift; print " CXform: "; if (defined $self->RedMultTerm) { print "(mult) R " . $self->RedMultTerm . " G " . $self->GreenMultTerm . " B " . $self->BlueMultTerm; } if (defined $self->RedAddTerm) { print " (add) R " . $self->RedAddTerm . " G " . $self->GreenAddTerm . " B " . $self->BlueAddTerm; } print "\n"; } package SWF::CXformWithAlpha; SWF::struct 'SWF::CXformWithAlpha' => { HasAddTerms => '$', HasMultTerms => '$', Nbits => '$', RedMultTerm => '$', GreenMultTerm => '$', BlueMultTerm => '$', AlphaMultTerm => '$', RedAddTerm => '$', GreenAddTerm => '$', BlueAddTerm => '$', AlphaAddTerm => '$', }; sub read { print " -- reading CXformW/A\n" if $debug; # Usage: $cxformwa->read($content) # # Takes a readable and reads a CXformwa my $self = shift; my $content = shift || return; my $hasAdd = $content->readBits(1); my $hasMult = $content->readBits(1); my $nbits = SWF::_bits2int($content->readBits(4)); if ($hasAdd) { my $rmt = SWF::_bits2int($content->readBits($nbits)); my $gmt = SWF::_bits2int($content->readBits($nbits)); my $bmt = SWF::_bits2int($content->readBits($nbits)); my $amt = SWF::_bits2int($content->readBits($nbits)); $self->RedMultTerm($rmt); $self->GreenMultTerm($gmt); $self->BlueMultTerm($bmt); $self->AlphaMultTerm($amt); } if ($hasMult) { my $rat = SWF::_bits2int($content->readBits($nbits)); my $gat = SWF::_bits2int($content->readBits($nbits)); my $bat = SWF::_bits2int($content->readBits($nbits)); my $aat = SWF::_bits2int($content->readBits($nbits)); $self->RedAddTerm($rat); $self->GreenAddTerm($gat); $self->BlueAddTerm($bat); $self->AlphaAddTerm($aat); } $content->flushBits; return $self; } sub debug { my $self = shift; print " CXform: "; if (defined $self->RedMultTerm) { print "(mult) R " . $self->RedMultTerm . " G " . $self->GreenMultTerm . " B " . $self->BlueMultTerm . " A " . $self->AlphaMultTerm; } if (defined $self->RedAddTerm) { print " (add) R " . $self->RedAddTerm . " G " . $self->GreenAddTerm . " B " . $self->BlueAddTerm . " A " . $self->AlphaAddTerm; } print "\n"; } package SWF::ShapeWithStyle; SWF::struct 'SWF::ShapeWithStyle' => { FillStyles => '$', LineStyles => '$', NumFillBits => '$', NumLineBits => '$', ShapeRecords => '@', ShapeRecordCount => '$', ShapeType => '$', }; sub read { print " -- reading ShapeWithStyle\n" if $debug; my $self = shift; my $content = shift || return; # read in array of fill styles my $fillArray = SWF::FillStyleArray->new; $fillArray->ShapeType($self->ShapeType); $fillArray->read($content); $self->FillStyles($fillArray); # read in array of line styles my $lineArray = SWF::LineStyleArray->new; $lineArray->ShapeType($self->ShapeType); $lineArray->read($content); $self->LineStyles($lineArray); my $fillbits = SWF::_bits2int($content->readBits(4)); my $linebits = SWF::_bits2int($content->readBits(4)); # print "Fillbits: $fillbits - Linebits: $linebits\n" if $debug; $self->NumFillBits($fillbits); $self->NumLineBits($linebits); # read in array of shape records my $reading = 1; while ($reading) { my $shape = SWF::ShapeRecord->new; $shape->NumFillBits($fillbits); $shape->NumLineBits($linebits); $shape->ShapeType($self->ShapeType); $shape->read($content); if ($shape->Type eq "EndShapeRecord") { $reading = 0; } else { $self->ShapeRecords($reading-1, $shape); $reading++; } } $content->flushBits; return $self; } sub debug { } package SWF::Shape; SWF::struct 'SWF::Shape' => { NumFillBits => '$', NumLinebits => '$', ShapeRecords => '@', ShapeType => '$', }; sub read { print " -- reading Shape\n" if $debug; my $self = shift; my $content = shift || return; my $fillbits = SWF::_bits2int($content->readBits(4)); my $linebits = SWF::_bits2int($content->readBits(4)); $self->NumFillBits($fillbits); $self->NumLineBits($linebits); my $reading = 1; while ($reading) { my $shape = SWF::ShapeRecord->new; $shape->NumFillBits($fillbits); $shape->NumLineBits($linebits); $shape->ShapeType($self->ShapeType); $shape->read($content); if ($shape->Type eq "EndShapeRecord") { $reading = 0; } else { $self->ShapeRecords($reading-1, $shape); $reading++; } } $content->flushBits; return $self; } sub debug { } package SWF::FillStyleArray; SWF::struct 'SWF::FillStyleArray' => { FillStyleCount => '$', FillStyles => '@', ShapeType => '$', }; sub read { print " -- reading FillStyleArray\n" if $debug; my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); if ($count == 0xFF) { $count = unpack("S", $content->readBytes(2)); } $self->FillStyleCount($count); for my $i (0..$count-1) { my $style = SWF::FillStyle->new; $style->ShapeType($self->ShapeType); $style->read($content); $self->FillStyles($i, $style); } return $self; } sub debug { my $self = shift; my $count = $self->FillStyleCount; print " FSA: " . $count . " fillstyles:\n"; for my $i (0..$count-1) { my $style = $self->FillStyles($i); $style->debug; } } package SWF::FillStyle; SWF::struct 'SWF::FillStyle' => { FillStyleType => '$', Color => '$', GradientMatrix => '$', Gradient => '$', BitmapId => '$', BitmapMatrix => '$', ShapeType => '$', }; sub read { print " -- reading FillStyle\n" if $debug; my $self = shift; my $content = shift || return; my $type = ord($content->readBytes(1)); if ($type == 0x00) { # solid fill my $color; if ($self->ShapeType == 3) { $color = SWF::RGBA->new->read($content); } else { $color = SWF::RGB->new->read($content); } $self->Color($color); } elsif (($type == 0x10) || ($type == 0x12)) { # gradient fill my $matrix = SWF::Matrix->new->read($content); my $gradient = SWF::Gradient->new; $gradient->ShapeType($self->ShapeType); $gradient->read($content); $self->GradientMatrix($matrix); $self->Gradient($gradient); } elsif (($type == 0x40) || ($type == 0x41)) { # bitmap fill my $bitmapid = unpack("S", $content->readBytes(2)); my $matrix = SWF::Matrix->new->read($content); $self->BitmapId($bitmapid); $self->BitmapMatrix($matrix); } else { # oh, let's just die. die "Bad fill type in Fillstyle: $type"; } $self->FillStyleType($type); return $self; } sub debug { my $self = shift; print " FillStyle: "; my $type = $self->FillStyletype; if ($type == 0x00) { print "(Color) "; my $color = $self->Color; $color->debug; } elsif ($type == 0x10) { print "(Linear Gradient Fill) "; my $matrix = $self->GradientMatrix; $matrix->debug; my $gradient = $self->Gradient; $gradient->debug; } elsif ($type == 0x12) { print "(Radial Gradient Fill) "; my $matrix = $self->GradientMatrix; $matrix->debug; my $gradient = $self->Gradient; $gradient->debug; } elsif ($type == 0x40) { print "(Tiled Bitmap Fill) "; my $bitmapid = $self->Bitmapid; print "bitmap $bitmapid - "; my $matrix = $self->BitmapMatrix; $matrix->debug; } elsif ($type == 0x41) { print "(Clipped Bitmap Fill) "; my $bitmapid = $self->Bitmapid; print "bitmap $bitmapid - "; my $matrix = $self->BitmapMatrix; $matrix->debug; } } package SWF::Gradient; SWF::struct 'SWF::Gradient' => { NumGradients => '$', GradientRecords => '@', ShapeType => '$', }; sub read { print " -- reading Gradient\n" if $debug; my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); $self->NumGradients($count); for my $i (0..$count-1) { my $gradient = SWF::GradRecord->new; $gradient->ShapeType($self->ShapeType); $gradient->read($content); $self->GradientRecords($i, $gradient); } return $self; } sub debug { my $self = shift; my $count = $self->NumGradients; for my $i (0..$count-1) { my $gradient = $self->GradientRecords($i); $gradient->debug; } } package SWF::GradRecord; SWF::struct 'SWF::GradRecord' => { Ratio => '$', Color => '$', ShapeType => '$', }; sub read { print " -- reading GradRecord\n" if $debug; my $self = shift; my $content = shift || return; my $ratio = ord($content->readBytes(1)); my $color; if ($self->ShapeType == 3) { $color = SWF::RGBA->new->read($content); } else { $color = SWF::RGB->new->read($content); } $self->Ratio($ratio); $self->Color($color); return $self; } sub debug { my $self = shift; my $ratio = $self->Ratio; print " GradRecord: ratio = $ratio : "; my $color = $self->Color; $color->debug; } package SWF::LineStyleArray; SWF::struct 'SWF::LineStyleArray' => { LineStyleCount => '$', LineStyles => '@', ShapeType => '$', }; sub read { print " -- reading LineStyleArray\n" if $debug; my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); if ($count == 0xFF) { $count = unpack("S", $content->readBytes(2)); } $self->LineStyleCount($count); # print "LSA count: $count\n"; for my $i (0..$count-1) { my $style = SWF::LineStyle->new; $style->ShapeType($self->ShapeType); $style->read($content); $self->LineStyles($i, $style); } return $self; } sub debug { my $self = shift; my $count = $self->LineStyleCount; print " LSA: " . $count . " linestyles:\n" if $debug; for my $i (0..$count-1) { my $style = $self->LineStyles($i); $style->debug; } } package SWF::LineStyle; SWF::struct 'SWF::LineStyle' => { Width => '$', Color => '$', ShapeType => '$', }; sub read { print " -- reading LineStyle\n" if $debug; my $self = shift; my $content = shift || return; my $width = unpack("S", $content->readBytes(2)); $self->Width($width); my $color; if ($self->ShapeType == 3) { $color = SWF::RGBA->new->read($content); } else { $color = SWF::RGB->new->read($content); } $self->Color($color); return $self; } sub debug { my $self = shift; print " LineStyle: width " . $self->width . "\n "; my $color = $self->Color; $color->debug; } package SWF::ShapeRecord; SWF::struct 'SWF::ShapeRecord' => { Type => '$', NumFillBits => '$', NumLineBits => '$', ShapeType => '$', MoveBits => '$', MoveDeltaX => '$', MoveDeltaY => '$', FillStyle0 => '$', FillStyle1 => '$', LineStyle => '$', FillStyles => '@', LineStyles => '@', NumBits => '$', GeneralLineFlag => '$', VertLineFlag => '$', DeltaX => '$', DeltaY => '$', ControlDeltaX => '$', ControlDeltaY => '$', AnchorDeltaX => '$', AnchorDeltaY => '$', }; sub read { print " -- reading ShapeRecord\n" if $debug; my $self = shift; my $content = shift || return; my $typeFlag = $content->readBits(1); if ($typeFlag) { # edged record my $straightFlag = $content->readBits(1); if ($straightFlag) { # StraightEdgeRecord $self->Type("StraightEdgeRecord"); print " StraightEdgeRecord\n" if $debug; my $numBits = SWF::_bits2int($content->readBits(4)) + 2; $self->NumBits($numBits); # print "NumBits: $numBits\n" if $debug; my $lineFlag = $content->readBits(1); $self->GeneralLineFlag($lineFlag); my ($deltaX, $deltaY); if ($lineFlag) { # General Line $deltaX = SWF::_bits2sint($content->readBits($numBits)); $deltaY = SWF::_bits2sint($content->readBits($numBits)); print " DeltaY $deltaY DeltaX $deltaX\n" if $debug; } else { # Vert/Horiz Line my $vLineFlag = $content->readBits(1); $self->VertLineFlag($vLineFlag); if ($vLineFlag) { # Vertical Line $deltaY = SWF::_bits2sint($content->readBits($numBits)); print " Vertical - Delta Y $deltaY\n" if $debug; } else { # Horizontal Line $deltaX = SWF::_bits2sint($content->readBits($numBits)); print " Horizontal - Delta X $deltaX\n" if $debug; } } $self->DeltaX($deltaX); $self->DeltaY($deltaY); } else { # CurvedEdgeRecord $self->Type("CurvedEdgeRecord"); print " CurvedEdgeRecord\n" if $debug; my $numBits = SWF::_bits2int($content->readBits(4)) + 2; $self->NumBits($numBits); my $cDeltaX = SWF::_bits2sint($content->readBits($numBits)); my $cDeltaY = SWF::_bits2sint($content->readBits($numBits)); my $aDeltaX = SWF::_bits2sint($content->readBits($numBits)); my $aDeltaY = SWF::_bits2sint($content->readBits($numBits)); $self->ControlDeltaX($cDeltaX); $self->ControlDeltaY($cDeltaY); $self->AnchorDeltaX($aDeltaX); $self->AnchorDeltaY($aDeltaY); } } else { # non-edge record my $flags = $content->readBits(5); if (SWF::_bits2int($flags) == 0) { # EndShapeRecord $self->Type("EndShapeRecord"); print " EndShapeRecord\n" if $debug; } else { # StyleChangeRecord $self->Type("StyleChangeRecord"); print " StyleChangeRecord\n" if $debug; my $nFillBits = $self->NumFillBits; my $nLineBits = $self->NumLineBits; # print "SCR: fillbits $nFillBits - linebits $nLineBits\n" if $debug; my ($stateNewStyles, $stateLineStyle, $stateFillStyle1, $stateFillStyle0, $stateMoveTo) = unpack("AAAAA", $flags); if ($stateMoveTo) { my $mBits = SWF::_bits2int($content->readBits(5)); my $moveDeltaX = SWF::_bits2sint($content->readBits($mBits)); my $moveDeltaY = SWF::_bits2sint($content->readBits($mBits)); $self->MoveBits($mBits); $self->MoveDeltaX($moveDeltaX); $self->MoveDeltaY($moveDeltaY); print " Movebits: $mBits MDX: $moveDeltaX MDY: $moveDeltaY\n" if $debug; } if ($stateFillStyle0) { my $fillStyle0 = SWF::_bits2int($content->readBits($nFillBits)); $self->FillStyle0($fillStyle0); # print "FS0: $fillStyle0\n" if $debug; } if ($stateFillStyle1) { my $fillStyle1 = SWF::_bits2int($content->readBits($nFillBits)); $self->FillStyle1($fillStyle1); # print "FS1: $fillStyle1\n" if $debug; } if ($stateLineStyle) { my $lineStyle = SWF::_bits2int($content->readBits($nLineBits)); $self->LineStyle($lineStyle); } if ($stateNewStyles) { my $fillStyles = SWF::FillStyleArray->new; $fillStyles->ShapeType($self->ShapeType); $fillStyles->read($content); $self->FillStyles($fillStyles); my $lineStyles = SWF::LineStyleArray->new; $lineStyles->ShapeType($self->ShapeType); $lineStyles->read($content); $self->LineStyles($lineStyles); $nFillBits = SWF::_bits2int($content->readBits(4)); $nLineBits = SWF::_bits2int($content->readBits(4)); $self->NumFillBits($nFillBits); $self->NumLineBits($nLineBits); } } } # $content->flushBits; return $self; } sub debug { } package SWF::ActionRecord; SWF::struct 'SWF::ActionRecord' => { ActionCode => '$', Length => '$', Frame => '$', UrlString => '$', TargetString => '$', SkipCount => '$', TargetName => '$', Label => '$', Type => '$', String => '$', Float => '$', BranchOffset => '$', Method => '$', Play => '$', }; sub read { my $self = shift; my $content = shift || return; my $code = ord($content->readBytes(1)); $self->ActionCode($code); # this is obviously a job for a lookup hash - make it so if ($code >= 0x80) { #long tag my $length = unpack("S", $content->readBytes(2)); $self->Length($length); } elsif ($code == 0x81) { # GotoFrame my $frame = unpack("S", $content->readBytes(2)); $self->Frame($frame); } elsif ($code == 0x83) { # GetURL my $urlstring = $content->readString; $self->UrlString($urlstring); my $targetstring = $content->readString; $self->TargetString($targetstring); } elsif ($code == 0x8A) { # WaitForFrame my $frame = unpack("S", $content->readBytes(2)); $self->Frame($frame); my $skipcount = ord($content->readBytes(1)); $self->SkipCount($skipcount); } elsif ($code == 0x8B) { # SetTarget my $targetname = $content->readString; $self->TargetName($targetname); } elsif ($code == 0x8C) { # GoToLabel my $label = $content->readString; $self->Lable($label); } elsif ($code == 0x96) { # Push my $type = ord($content->readBytes(1)); $self->Type($type); if ($type) { #float # read a float - 32 bit single precision little endian # not sure if this works - must test & fix my $float = unpack("f", $content->readBytes(4)); $self->Fload($float); } else { #string my $string = $content->readString; $self->String($string); } } elsif (($code == 0x99) || ($code == 0x9D)) { # Jump/If my $offset = unpack("S", $content->readBytes(2)); $self->BranchOffset($offset); } elsif ($code == 0x9A) { # getURL2 my $method = ord($content->readBytes(1)); $self->Method($method); } elsif ($code == 0x9F) { # GotoFrame2 my $play = readBytes(1); $self->Play($play); } elsif ($code == 0x8D) { my $skipcount = ord($content->readBytes(1)); $self->SkipCount($skipcount); } return $self; } sub debug { my $self = shift; } package SWF::MorphFillStyles; SWF::struct 'SWF::MorphFillStyles' => { FillStyleCount => '$', FillStyles => '@', }; sub read { print " -- reading MorphFillStyles\n" if $debug; my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); if ($count == 0xFF) { $count = unpack("S", $content->readBytes(2)); } $self->FillStyleCount($count); for my $i (0..$count-1) { my $style = SWF::MorphFillStyle->new->read($content); $self->FillStyles($i, $style); } return $self; } sub debug { my $self = shift; } package SWF::MorphFillStyle; SWF::struct 'SWF::MorphFillStyle' => { FillStyleType => '$', StartColor => '$', EndColor => '$', StartGradientMatrix => '$', EndGradientMatrix => '$', Gradient => '$', BitmapId => '$', StartBitmapMatrix => '$', EndBitmapMatrix => '$', }; sub read { my $self = shift; my $content = shift || return; my $type = ord($content->readBytes(1)); if ($type == 0x00) { # solid fill my $startcolor = SWF::RGBA->new->read($content); my $endcolor = SWF::RGBA->new->read($content); $self->StartColor($startcolor); $self->EndColor($endcolor); } elsif (($type == 0x10) || ($type == 0x12)) { # gradient fill my $startmatrix = SWF::Matrix->new->read($content); my $endmatrix = SWF::Matrix->new->read($content); my $gradient = SWF::MorphGradient->new->read($content); $self->StartGradientMatrix($startmatrix); $self->EndGradientMatrix($endmatrix); $self->Gradient($gradient); } elsif (($type == 0x40) || ($type == 0x41)) { # bitmap fill my $bitmapid = unpack("S", $content->readBytes(2)); my $startmatrix = SWF::Matrix->new->read($content); my $endmatrix = SWF::Matrix->new->read($content); $self->BitmapId($bitmapid); $self->StartBitmapMatrix($startmatrix); $self->EndBitmapMatrix($endmatrix); } else { # oh, let's just die. die "Bad fill type in Fillstyle: $type"; } $self->FillStyleType($type); return $self; } sub debug { my $self = shift; } package SWF::MorphGradient; SWF::struct 'SWF::MorphGradient' => { NumGradients => '$', GradientRecords => '$', }; sub read { my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); $self->NumGradients($count); for my $i (0..$count-1) { my $gradient = SWF::MorphGradRecord->new->read($content); $self->GradientRecords($i, $gradient); } return $self; } sub debug { my $self = shift; } package SWF::MorphGradRecord; SWF::struct 'SWF::MorphGradRecord' => { StartRatio => '$', StartColor => '$', EndRatio => '$', EndColor => '$', }; sub read { my $self = shift; my $content = shift || return; my $sRatio = ord($content->readBytes(1)); my $sColor = SWF::RGBA->new->read($content); my $eRatio = ord($content->readBytes(1)); my $eColor = SWF::RGBA->new->read($content); $self->StartRatio($sRatio); $self->StartColor->($sColor); $self->EndRatio($eRatio); $self->EndColor->($eColor); return $self; } sub debug { my $self = shift; } package SWF::MorphLineStyles; SWF::struct 'SWF::MorphLineStyles' => { LineStyleCount => '$', LineStyles => '@', }; sub read { print " -- reading MorphLineStyles\n" if $debug; my $self = shift; my $content = shift || return; my $count = ord($content->readBytes(1)); if ($count == 0xFF) { $count = unpack("S", $content->readBytes(2)); } $self->LineStyleCount($count); for my $i (0..$count-1) { my $style = SWF::MorphLineStyle->new->read($content); $self->LineStyles($i, $style); } return $self; } sub debug { my $self = shift; } package SWF::MorphLineStyle; SWF::struct 'SWF::MorphLineStyle' => { StartWidth => '$', EndWidth => '$', StartColor => '$', EndColor => '$', }; sub read { print " -- reading MorphLineStyle\n" if $debug; my $self = shift; my $content = shift || return; my $sWidth = unpack("S", $content->readBytes(2)); $self->StartWidth($sWidth); my $eWidth = unpack("S", $content->readBytes(2)); $self->EndWidth($eWidth); my $sColor = SWF::RGBA->new->read($content); $self->StartColor($sColor); my $eColor = SWF::RGBA->new->read($content); $self->EndColor($eColor); return $self; } sub debug { my $self = shift; } package SWF::ZlibBitmapData; SWF::struct 'SWF::ZlibBitmapData' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::ZlibBitmapData2; SWF::struct 'SWF::ZlibBitmapData2' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::TextRecord; SWF::struct 'SWF::TextRecord' => { TextRecordType => '$', TextReserved => '$', TextHasFont => '$', TextHasColor => '$', TextHasYOffset => '$', TextHasXOffset => '$', TextFontID => '$', TextColor => '$', TextXOffset => '$', TextYOffset => '$', TextHeight => '$', TextGlyphCount => '$', TextGlyphEntries => '$', TextType => '$', GlyphBits => '$', AdvanceBits => '$', }; sub read { my $self = shift; my $content = shift || return; my $recordType = $content->readBits(1); $self->TextRecordType($recordType); if ($recordType) { # Text Style Change Record my $reserved = $content->readBits(3); $self->TextReserved($reserved); my $hasfont = $content->readBits(1); $self->TextHasFont($hasfont); my $hascolor = $content->readBits(1); $self->TextHasColor($hascolor); my $hasYoff = $content->readBits(1); $self->TextHasYOffset($hasYoff); my $hasXoff = $content->readBits(1); $self->TextHasXOffset($hasXoff); if ($hasfont) { my $fontid = unpack("S", $content->readBytes(2)); $self->TextFontID($fontid); } if ($hascolor) { my $color; if ($self->TextType == 2) { $color = SWF::RGBA->new->read($self->content); } else { $color = SWF::RGB->new->read($self->content); } $self->TextColor($color); } if ($hasXoff) { my $xoff = unpack("s", $content->readBytes(2)); $self->TextXOffset($xoff); } if ($hasYoff) { my $yoff = unpack("s", $content->readBytes(2)); $self->TextYOffset($yoff); } if ($hasfont) { my $height = unpack("S", $content->readBytes(2)); $self->TextHeight($height); } } else { # Glyph Record my $glyphCount = SWF::_bits2int($content->readBits(7)); $self->TextGlyphCount($glyphCount); my @glyphs = (); my $i = 0; while ($i < $glyphCount) { my $entry = SWF::GlyphEntry->new; $entry->GlyphBits($self->GlyphBits); $entry->AdvanceBits($self->AdvanceBits); $entry->read($content); $self->TextGlyphEntries($i, $entry); $i++; } } return $self; } sub debug { my $self = shift; } package SWF::GlyphEntry; SWF::struct 'SWF::GlyphEntry' => { TextGlyphIndex => '$', TextGlyphAdvance => '$', GlyphBits => '$', AdvanceBits => '$', }; sub read { my $self = shift; my $content = shift || return; my $glyphindex = SWF::_bits2int($content->readBits($self->GlyphBits)); my $glyphadv = SWF::_bits2sint($content->readBits($self->AdvanceBits)); $self->TextGlyphIndex($glyphindex); $self->TextGlyphAdvance($glyphadv); return $self; } sub debug { my $self = shift; } package SWF::KerningRecord; SWF::struct 'SWF::KerningRecord' => { FontKerningCode1 => '$', FontKerningCode2 => '$', FontKerningAdjustment => '$', FontFlagsWideCodes => '$', }; sub read { my $self = shift; my $content = shift || return; my ($code1, $code2); if ($self->FontFlagsWideCodes == 1) { $code1 = unpack("S", $content->readBytes(2)); $code2 = unpack("S", $content->readBytes(2)); } else { $code1 = ord($content->readBytes(1)); $code2 = ord($content->readBytes(1)); } my $adj = unpack("S", $content->readBytes(2)); $self->FontKerningCode1($code1); $self->FontKerningCode2($code2); $self->FontKerningAdjustment($adj); return $self; } sub debug { my $self = shift; } package SWF::SoundInfo; SWF::struct 'SWF::SoundInfo' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::SoundEnvelope; SWF::struct 'SWF::SoundEnvelope' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::ADPCMSoundData; SWF::struct 'SWF::ADPCMSoundData' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::ADPCMPacket16Stereo; SWF::struct 'SWF::ADPCMPacket16Stereo' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::ADPCMCodeData; SWF::struct 'SWF::ADPCMCodeData' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::MP3SoundData; SWF::struct 'SWF::MP3SoundData' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::MP3Frame; SWF::struct 'SWF::MP3Frame' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::MP3StreamSoundData; SWF::struct 'SWF::MP3StreamSoundData' => { }; sub read { my $self = shift; my $content = shift || return; return $self; } sub debug { my $self = shift; } package SWF::ButtonRecord; SWF::struct 'SWF::ButtonRecord' => { ButtonReserved => '$', ButtonStateHitTest => '$', ButtonStateDown => '$', ButtonStateOver => '$', ButtonStateUp => '$', ButtonCharacter => '$', ButtonLayer => '$', ButtonMatrix => '$', ColorTransform => '$', }; sub read { my $self = shift; my $content = shift || return; print " --reading ButtonRecord\n" if $debug; my $reserved = $content->readBits(4); my $sHitTest = $content->readBits(1); my $sDown = $content->readBits(1); my $sOver = $content->readBits(1); my $sUp = $content->readBits(1); my $character = unpack("S", $content->readBytes(2)); my $layer = unpack("S", $content->readBytes(2)); my $matrix = SWF::Matrix->new->read($content); my $xform = SWF::CXform->new->read($content); $self->ButtonStateHitTest($sHitTest); $self->ButtonStateDown($sDown); $self->ButtonStateOver($sOver); $self->ButtonStateUp($sUp); $self->ButtonCharacter($character); $self->ButtonLayer($layer); $self->ButtonMatrix($matrix); $self->ColorTransform($xform); return $self; } sub debug { my $self = shift; } 1;