## Flash::SWF.pm ##
use strict;
package Flash::SWF;

my %fields = (

   filename     => undef,
   version      => 3,
   file_length  => undef,
   frame_size   => {},
   frame_rate   => undef,
   frame_count  => 0,

   tags         => [],

   _bitPos      => 0,
   _bifBuf      => 0,

   debug        => 1,
);

#################################################################
# TAG DEFINITIONS
#################################################################

my %tagdef = (

    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,	# Event sound tags.
    StartSound			=> 15,
    DefineButtonSound	=> 17,
    SoundStreamHead		=> 18,
    SoundStreamBlock	=> 19,
    DefineBitsLossless	=> 20,	# A bitmap using lossless zlib compression.
    DefineBitsJPEG2		=> 21,	# A bitmap using an internal JPEG compression table.
    DefineShape2		=> 22,
    DefineButtonCxform	=> 23,
    Protect				=> 24,	# This file should not be importable for editing.

    # These are the new tags for Flash 3.

    PlaceObject2		=> 26,	# The new style place w/ alpha color transform and name.
    RemoveObject2		=> 28,	# A more compact remove object that omits the character tag (just depth).
    DefineShape3		=> 32,	# A shape V3 includes alpha values.
    DefineText2			=> 33,	# A text V2 includes alpha values.
    DefineButton2		=> 34,	# A button V2 includes color transform, alpha and multiple actions
    DefineBitsJPEG3		=> 35,	# A JPEG bitmap with alpha info.
    DefineBitsLossless2 => 36,	# A lossless bitmap with alpha info.
    DefineSprite		=> 39,	# Define a sequence of tags that describe the behavior of a sprite.
    NameCharacter		=> 40,	# Name a character definition, character id and a string,
                                #    (used for buttons, bitmaps, sprites and sounds).
    FrameLabel			=> 43,	# A string label for the current frame.
    SoundStreamHead2	=> 45,	# For lossless streaming sound, should not have needed this...
    DefineMorphShape	=> 46,	# A morph shape definition
    DefineFont2			=> 48,	# 


);

my %tagdict = reverse %tagdef;


########################################################################


sub new {
	my $class = shift;
	my $self  = { %fields };
	
	bless $self, $class;		
	
	if ($self->{filename} = shift) { $self->readfile() }
	
	return $self;
}

## reading routines

sub readfile {
	my $self = shift;

	open    SWF, $self->{filename} or die "couldn't open SWF file";
	binmode SWF;
	
	$self->read_header() or die "unable to read header";

	my ($code, $data) = $self->read_tag();
	while ($code){
		($code, $data) = $self->read_tag();
		push @{$self->{tags}}, { code => $code, data => $data };
	}

	close SWF;
}

sub read_header {
	my $self = shift;
	my $data;

	## start with 3-byte identifier
	$data = $self->_Get(3);
	$data =~ /FWS/ or die "not a valid SWF (it said $data)";
	print "header = $data\n" if $self->{debug};

	## then the version
	$data = $self->_Get(1, "C");
	$self->{version} = $data;
	print "version = ", $self->{version}, "\n" if $self->{debug};

	## then the file length
	$data = $self->_Get(4,"L");
	$self->{file_length} = $data;
	print "file length = ", $self->{file_length}, "\n" if $self->{debug};

	## frame size is tricky... it's in twips (1 twip = 20th of point)
	my %r = $self->read_rect();
	%{$self->{frame_size}} = (
	     w => ($r{xmax} - $r{xmin}) / 20,
	     h => ($r{ymax} - $r{ymin}) / 20,
    );
	print "frame w: ", $self->{frame_size}{w}, "\n" if $self->{debug};
	print "frame h: ", $self->{frame_size}{h}, "\n" if $self->{debug};

	## now the frame rate
	$data = $self->_Get(2,"S");
	$self->{frame_rate} = $data;
	print "frame rate = ", $self->{frame_rate}, "\n" if $self->{debug};

	## and finally, the frame count
	$data = $self->_Get(2,"S");
	$self->{frame_count} = $data;
	print "frame count = ", $self->{frame_count}, "\n" if $self->{debug};

	return 1;
}


sub _InitBits {
	my $self = shift;
	$self->{_bitPos} = 0;
	$self->{_bitBuf} = 0;
}

sub _Get {
	my ($self, $bytes, $packaging ) = @_;
	my $data;
   
	sysread SWF, $data, $bytes;
	if ($packaging) { $data = unpack $packaging, $data }
	return $data;					  
}

sub _GetBits {
	my $self = shift;
	my $n = shift; # number of bits to get
    my $v = 0; # the return value

	for (;;) {

		# we want to know if we should use the whole byte.
		my $s =  $n - $self->{_bitPos};

		##print "n = $n ; v = $v;  s = $s; pos = ", $self->{_bitPos};
		##print ";  buf = ", unpack( "B8", $self->{_bitBuf}), "\n";

		if ( $s > 0 ) {

			# all these bits are ours
			$v |= $self->{_bitBuf} << $s;
			$n -= $self->{_bitPos};

			# get the next buffer
			$self->{_bitBuf} = $self->_Get(1,"C");
			$self->{_bitPos} = 8;

		} else {

			# this is our last byte, take only the bits we need
			$v |= $self->{_bitBuf} >> ( -$s );
			$self->{_bitPos} -=	$n;

			# mask off the consumed bits
			$self->{_bitBuf} &= 0xff >> (8 - $self->{_bitPos});
			return $v;
		}
	}
}


sub _GetSBits { #same as _GetBits, but signed
	my $self = shift;
	my $n = shift; # number of bits to get


    my $v = $self->_GetBits($n);

	### don't ask me what this next bit is doing..
	### the C version had "1L" on the left side of both << 's..

    # Is the number negative?
    if ($v & (1 << ($n - 1)))
    {
        # Yes. Extend the sign.
        $v |= -1 << $n;
    }

    return $v;
}

sub read_rect {
	my $self = shift;
	my %r = ();

	$self->_InitBits();
	my $nbits = $self->_GetBits(5);
	print "nbits is $nbits\n" if $self->{debug};

	$r{xmin} = $self->_GetSBits($nbits);
	$r{xmax} = $self->_GetSBits($nbits);
	$r{ymin} = $self->_GetSBits($nbits);
	$r{ymax} = $self->_GetSBits($nbits);
	
	return %r;
}

sub read_tag {

	## this could actually trigger events at some point..
	my $self = shift;

## i have no clue why this didn't work:
#
#	$self->_InitBits();
#	my $code = $self->_GetBits(10);
#	my $length = $self->_GetBits(6);
##
	my $code = $self->_Get(2,"S");
	my $length = $code & 0x3f;
	$code = $code >> 6;

	if ($length == 63) {
		$length = $self->_Get(4,"L");
	}
	
	print "r: tag $code\tlen $length\t$tagdict{$code}\n" if $self->{debug};
	
	my $data = $self->_Get($length,"A*");
	
	return $code, $data; 
}


## encoding routines

sub write_header {
	my $self = shift;
	print "writing header..\n" if $self->{debug};
}

sub writefile {
	my $self = shift;
	$_ = shift and $self->{filename} = $_;
	my ($tag, $code, $length, $data);

	open    SWF, ">" . $self->{filename} or die "couldn't open SWF file";
	binmode SWF;
	
	$self->write_header();

	foreach $tag (@{$self->{tags}}) {
		$code = $tag->{code};
		$length = length ($tag->{data});
		print "w: tag $code\tlen $length\t$tagdict{$code}\n"
			if $self->{debug};
		
	}
}

1;