package      Flash::Parser::SWF;


use          Exporter;
use          File::Binary;
use          Flash::Object;
use          Flash::Constants;
use          Compress::Zlib;
use          vars qw($VERSION);       
@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw();

$VERSION   = "0.01";

   
   
   # --- global variables
   my $bin;
   my @i_offset_table;
   my @code_table;
   my @glyph_counts;
   my @u_offset_table;
   my @routines;
   
   my ($fill_bits, $line_bits); # global vars for shape_records
   
   
   my @src_adpcm;
   my $bitbuf_adpcm;      # this should always contain at least 24 bits of data
   my $bitpos_adpcm;
   my $samples_adpcm;     # number of samples decompressed so far
   
   # Sound stream global vars
   my $stream_compression;
   my $sample_rate;
   my $stream_sample_size;
   my $stream_stereomono;
   my $stream_samples;
   
   my $newpos;
   my $length;
   
   # we load the routines array with references to the various 
   # parsing routines this means that all we need to do to parse 
   # a tag with code x is call the routine referenced at 
   # $routines[x] which should mean that it is very fast   
   $routines[0]  =  \&end;
   $routines[1]  =  \&show_frame;
   $routines[2]  =  \&define_shape;
   $routines[3]  =  \&free_character;
   $routines[4]  =  \&place_object;
   $routines[5]  =  \&remove_object;
   $routines[6]  =  \&define_bits;
   $routines[7]  =  \&define_button;
   $routines[8]  =  \&JPEG_tables;
   $routines[9]  =  \&set_background_colour;
   $routines[10] =  \&define_font;
   $routines[11] =  \&define_text;
   $routines[12] =  \&do_action;
   $routines[13] =  \&define_fontinfo;
   $routines[14] =  \&define_sound;         # Event sound tags.
   $routines[15] =  \&start_sound;
   $routines[17] =  \&define_buttonsound;   
   $routines[18] =  \&sound_streamhead;
   $routines[19] =  \&sound_streamblock;
   $routines[20] =  \&define_bitslossless;  # A bitmap using lossless zlib compression.
   $routines[21] =  \&define_bitsJPEG2;     # A bitmap using an internal JPEG compression table.
   $routines[22] =  \&define_shape2;
   $routines[23] =  \&define_buttoncxform;
   $routines[24] =  \&protect;              # This file should not be importable for editing.

   # These are the new tags for Flash 3,    
   $routines[26] =  \&place_object2;        # The new style place w/ alpha color transform and name.
   $routines[28] =  \&remove_object2;       # A more compact remove object that omits the character tag (just depth).
   $routines[32] =  \&define_shape3;        # A shape V3 includes alpha values.
   $routines[33] =  \&define_text2;         # A text V2 includes alpha values.
   $routines[34] =  \&define_button2;       # A button V2 includes color transform, alpha and multiple actions
   $routines[35] =  \&define_bitsJPEG3;     # A JPEG bitmap with alpha info.
   $routines[36] =  \&define_bitslossless2; # A lossless bitmap with alpha info.
   $routines[37] =  \&define_edittext;      # An editable Text Field
   $routines[38] =  \&define_mousetarget;   
   $routines[39] =  \&define_sprite;        # Define a sequence of tags that describe the behavior of a sprite.
   $routines[40] =  \&name_character;       # Name a character definition, character id and a string,
                                            #    (used for buttons, bitmaps, sprites and sounds).
   $routines[43] =  \&frame_label;          # A string label for the current frame.
   $routines[45] =  \&sound_streamhead2;    # For lossless streaming sound, should not have needed this...
   $routines[46] =  \&define_morphshape;    # A morph shape definition
   $routines[48] =  \&define_font2;         


 
   



sub parse
{
      # parsing  is split into two parts
      # one sets everything up like the binary file stream 
      # the other loops through all the tags. This is so
      # we can have Sprites as embedded movies/Flash::Objects.
  
      my ($filename, $flash) =  @_;
      
      
     #select STDERR; 
     $| =1;
      
      
      # if we've been passed a flash object then use it otherwise create a new one
      $flash = new Flash::Object unless (defined $flash);
      
      #return $flash;
      
      # now check to see if we've got a file to work on          
      unless (defined $filename)
      {
         push @{$flash->{error}}, "You didn't pass a filename\n";       
         return $flash;       
      }

      unless ($bin = new File::Binary($filename))
      {
         push @{$flash->{error}}, "File '$filename' not read!\n";       
         return $flash;       
      }
      
      
      # now check to see if we've got a valid SWF file
      unless ($bin->getBytes(3) eq 'FWS')  
      {
        push @{$flash->{error}},  "'$filename' is not valid SWF file\n";        
        return $flash;
      }

   
      # finally we set the headers 
      get_headers($flash);
      
      
      # and the we can start to parse the tags
      parse_tags($flash);
      
      
      # and then we can return with our fully loaded Flash::Object :)
      return $flash;
      
  
}


sub get_headers 
{
  my $flash = shift;
  
  my $ver    = unpack("C",$bin->getBytes(1));
  my $len    = unpack("L",$bin->getBytes(4));
   
  my $rect   = get_rect();
  my $framer = unpack("S",$bin->getBytes(2)) >> 8;
  my $framec = unpack("S",$bin->getBytes(2));  
  
  $flash->set_headers($ver,$len,$rect->xmin,$rect->xmax,$rect->ymin,$rect->ymax,$framec,$framer, $bin->where()); 
  
}




sub parse_tags 
{

  my $flash =  shift;
  my $framecount  = 0; 
 
  my ($code, $tag);
  do
  {
        #print STDERR "new tag\n";
        $code      = unpack("S",$bin->getBytes(2)); # get what tag we are parsing
        $length    = $code & 0x3f;                  # and what length it is
        $code      = $code >> 6;
        $length    = unpack("L",$bin->getBytes(4)) if ($length == 63);
        
                
        $newpos = $bin->where;
        
        
        
        #print "\t".$code."), length= $length, newpos = $newpos\n";
        
        $framecount++ if ($code==1);
         print STDERR $tagdict->{$code},"\n" if ($framecount==91);
        #if ($code==1) {
        #print STDERR "----------- ( ". $framecount++ ." ) ----------------\n";
        #  #sleep 3;
        #}
	     
	      my $tag = undef; 	      
        # let the parsing begin !        
        if (defined $routines[$code]) { $tag = &{$routines[$code]}         }
        else                          { $tag = &default_tag($code,$length) }
        
        #print "Ok : $code\n" if (defined $tag);
        $flash->add_tag($tag) if (defined $tag);
        
        # just to be paranoid we seek to the correct new position anyway
        $bin->seekTo($newpos + $length) unless ($code==0 || !$newpos);
        
        #sleep(10);


        
   }
   until ($code==0);
  
}




sub default_tag 
{
   
    my $tag       = new Flash::Tags::Default;
    
    my ($code, $length) = @_;
    
    $tag->data    ($bin->getBytes($length));
    $tag->type    ($code);
    $tag->length  ($length);
    
    return $tag;
}


sub end
{
     my $tag          = new Flash::Tags::End;
     return $tag;
}

sub define_mousetarget
{
     my $tag          = new Flash::Tags::DefineMouseTarget;
     return $tag;
}

sub show_frame 
{

    my $tag         = new Flash::Tags::ShowFrame;
    $tag->offset   ($bin->where);
    return $tag;

}


sub start_sound 
{   

    my $tag = new Flash::Tags::StartSound;

    
    
    $tag->tagid      ( $bin->getWord );
  
    
    
    
    $tag->soundstate  (get_soundstate());
    
    
    
    return $tag;
}

sub get_soundstate
{
    

    my $state = new Flash::Types::SoundState;
    
    $state->soundcode  (unpack "C", $bin->getBytes(1));
    
    $state->inpoint    ($bin->getDWord) if ($state->soundcode & sound_hasinpoint );   
    $state->outpoint   ($bin->getDWord) if ($state->soundcode & sound_hasoutpoint);   
    $state->loops      ($bin->getDWord) if ($state->soundcode & sound_hasloops   );
   
    if ($state->soundcode & sound_hasenvelope)
    {
        my $points      = unpack "C", $bin->getBytes(1);
        
        
        for (my $i =0 ; $i < $points; $i++)
        { 
           my $envelope = new Flash::Types::SoundEnvelope;
           $envelope->mark44      ($bin->getDWord);
           $envelope->left        ($bin->getWord);
           $envelope->right       ($bin->getWord);
           $state->envelopes->[$i] = $envelope; 
        }
      
    }

    return $state;
}


sub set_background_colour 
{
    
    my $tag         = new Flash::Tags::SetBackgroundColour;
    $tag->colour  (get_colour(0));
    return $tag;
}


sub free_character 
{

    my $tag = new Flash::Tags::FreeCharacter;    
    $tag->tagid ($bin->getWord);    
    return $tag;
}


sub place_object
{
   
   my $tag = new Flash::Tags::PlaceObject;

   $tag->tagid ( unpack("C",$bin->getBytes(2)) );
   $tag->depth ( unpack("C",$bin->getBytes(2)) );
   
   
   $tag->matrix (get_matrix());   
   $tag->cxform (get_cxform(0)) if ($bin->where < $newpos + $length);
   return $tag;

}





sub remove_object 
{    
    
    my $tag = new Flash::Tags::RemoveObject;
    
    $tag->depth ($bin->getWord);
    $tag->tagid ($bin->getWord);
    return $tag;
    
}

sub remove_object2 
{

    my $tag = new Flash::Tags::RemoveObject2;
    
    $tag->depth(unpack("S",$bin->getBytes($length)));
    return $tag;
}


sub frame_label 
{
  
    my $tag = new Flash::Tags::FrameLabel
   
    $tag->label(get_string());
    
    return $tag;
}


sub place_object2 
{

    my $tag = new Flash::Tags::PlaceObject2;
      
    $tag->flags(unpack("C",$bin->getBytes(1))); my $flags = $tag->flags;
    $tag->depth($bin->getWord);
    

   
       

    $tag->move       ( 1                            ) if ($flags & place_move);    
    $tag->tag        ( $bin->getWord                ) if ($flags & place_character);
    $tag->matrix     ( get_matrix()                 ) if ($flags & place_matrix);
    $tag->cxform     ( get_cxform()                 ) if ($flags & place_colour_transform);
    $tag->ratio      ( unpack "C",$bin->getBytes(2) ) if ($flags & place_ratio);
    $tag->clip_depth ( unpack "C",$bin->getBytes(2) ) if ($flags & place_define_clip);
    $tag->name       ( get_string()                 ) if ($flags & place_name);
    
    return $tag;
}


sub get_cxform
{
    my $cx = new Flash::Types::CXform;
    
    $cx->with_alpha ((defined $_[0])?$_[0]:0);

    
    
   
    # !!! The spec has these bits reversed !!!
    my $need_add = ($bin->getBits(1)!=0);
    my $need_mul = ($bin->getBits(1)!=0);
    # !!! The spec has these bits reversed !!!

    

    my $n = $bin->getBits(4);

    $cx->aa  ( 256 ); 
    $cx->ab  ( 0   );
   
    if ($need_mul)
    {
        $cx->ra ( unpack "S", $bin->getSBits($n) );
        $cx->ga ( unpack "S", $bin->getSBits($n) );
        $cx->ba ( unpack "S", $bin->getSBits($n) );
        
        $cx->aa ( unpack "S",$bin->getSBits($n)  ) if ($cx->with_alpha);
        
    } else {
        $cx->ra ( 256 );
        $cx->ga ( 256 );
        $cx->ba ( 256 );
    }

    if ($need_add)
    {
        $cx->rb ( unpack "S", $bin->getSBits($n) );
        $cx->gb ( unpack "S", $bin->getSBits($n) );
        $cx->bb ( unpack "S", $bin->getSBits($n) );
        
        $cx->ab ( unpack "S", $bin->getSBits($n) ) if ($cx->with_alpha);
                          
    } else {
        $cx->rb ( 8 );
        $cx->gb ( 8 );
        $cx->bb ( 8 );
    }

    return $cx;
}

sub get_string 
{
  
  
  my $label = "";
  
  while (my $char = unpack("C",$bin->getBytes(1))){$label .= chr($char)}
  
  return $label;
  
}


sub get_matrix 
{

    my $matrix = new Flash::Types::Matrix;
    
    my $n;

    

    if ($bin->getBits(1))
    {
        $n = $bin->getBits(5);
        $matrix->a  ( $bin->getSBits($n) );
        $matrix->d  ( $bin->getSBits($n) );        
            
    }
    else
    {
        $matrix->a  ( 0x00010000 );
        $matrix->d  ( 0x00010000 );
    }

    
    # Rotate/skew terms
    if ($bin->getBits(1))
    {
        $n = $bin->getBits(5);
        $matrix->b  ( $bin->getSBits($n) );
        $matrix->c  ( $bin->getSBits($n) );
        
    }
    else
    {
        $matrix->b (0);
        $matrix->c (0);
    }

    # Translate terms
    $n = $bin->getBits(5);
    $matrix->tx  ( $bin->getSBits($n) );
    $matrix->ty  ( $bin->getSBits($n) );
    
              
    return $matrix;
}


sub sound_streamhead 
{    
 
    my $tag = new Flash::Tags::SoundStreamHead;
       
    get_sound_stream_head($tag);
    
    return $tag;
}

sub sound_streamhead2
{
    my $tag = new Flash::Tags::SoundStreamHead2;
    get_sound_stream_head($tag);
    
    return $tag;
    
}

sub get_sound_stream_head
{
    my ($tag, $tab) = @_;
    # The stream settings  these are all 
    # global vars too 'cos they get 
    # referenced by other  bits of Sound code    
    $tag->mix_format    (unpack "C", $bin->getBytes(1));
    
    $stream_compression = $tag->compression ( $bin->getBits(4)              );
    $stream_sample_rate = $tag->sample_rate ( $bin->getBits(2)              );
    $stream_sample_size = $tag->sample_size ( $bin->getBits(1)              );
    $stream_stereomono  = $tag->stereomono  ( $bin->getBits(1)              );
    $stream_samples     = $tag->samples     ( unpack "C", $bin->getBytes(2) );
    
    return $tag;
}


sub define_bits
{
  
  my $tag = new Flash::Tags::DefineBits;
  
  $tag->tagid ( $bin->getWord );
  
  
  $tag->guts  ( get_image_guts($bin, $length-2) );
  
  return $tag;
}



sub define_bits_lossless 
{
  
   my $tag = new Flash::Tags::DefineBitsLossless;
   
   get_bitslossless($tag);
    
   return $tag;
}


sub get_bitslossless
{
   my ($tag, $tab) = @_;
   
   # cunningly done so that will work for both BitsLossless1 and 2
   # ha ha ha, I am 733t, ph34r my 5k177z !
  
   $tag->with_alpha  ( (defined $_[0])?$_[0]:0 );
      
   # set up values if we're doing for doing DefineBitsLossless2   
   $tag->rgb_size       ( ($tag->with_alpha)?4:3  );
   
   my $initial_pos = $bin->where;
   
   # get my tag ID 
   $tag->tagid  ( $bin->getWord );

    
   # get some other relevant info
   $tag->format ( unpack("C",$bin->getBytes(1)) );
   $tag->width  ( $bin->getWord );
   $tag->height ( $bin->getWord );
   $tag->table_size ( 0 );

   # work out the new colourtable size if this is a format '3' PNG (8 bit image data)
   $tag->table_size ( unpack("C",$bin->getBytes(1)) ) if ($tag->format == 3);
   $tag->table_size ($tag->table_size + 1);

   
   # initialise an inflation scheme    
   my $z = inflateInit() or die "Cannot create a inflation stream\n" ;
    
   my $size  = ($tag->table_size * $tag->rgb_size) + ($tag->width*$tag->height);
   my $input = $bin->getBytes($size);
    
    my $output = $z->inflate($input);
    
    unless (defined $output) {
      print STDERR "\tBitslossless ".$tag->tagid." does not contain valid ZLIB compressed data\n";
      return;
    }
    
    @{$tag->decompressed} =  unpack "C$size", $output ;
   
       
     
}


sub define_bitsJPEG2
{

   my $tag = new Flash::Tags::DefineBitsJPEG2;
   $tag->tagid     ( $bin->getWord );
   $tag->encoding  ( get_image_guts() );
   $tag->image     ( get_image_guts() );
  
   return $tag;
   
}


sub define_bitsJPEG3 
{
   my $tag = new Flash::Tags::DefineBitsJPEG2;
   $tag->tagid     ( $bin->getWord   );
   $tag->encoding  ( get_image_guts() );
   $tag->image     ( get_image_guts() );  
   $tag->alpha     ( $bin->getBytes($newpos - $bin->where) );
   
   return $tag;
}


sub JPEG_tables
{
     my $tag = new Flash::Tags::JPEGtables;
     #$tag->guts ( get_image_guts() );
     
     return $tag;
}





sub get_image_guts 
{
  
  
  my $ig = new Flash::Types::ImageGuts;
  
  #while ($bin->where < $newpos + $length)
  #{
  #      $ig->data->[$p] = unpack "C", $bin->getBytes(1);
  #}
  ##my $p = 0;
  #$ig->data->[$p] = unpack "C", $bin->getBytes(1);
  #unless (sprintf("%02x",$ig->data->[0]) eq '0xFF')
  #{
  #  print STDERR 'This is not a JPEG Image Stream';
  #  return; 
  #}
  
  
  #do
  #{
  #  $ig->data->[++$p] = unpack "C", $bin->getBytes(1);
  #   
  #}until (sprintf("%02x",$ig->data->[$p]) eq '0xD8');
  
  return $ig;
  
  
}


sub get_rect
{
   $bin->initBits();
   
   my $rect      = new Flash::Types::Rect;   
   
   my $n         = $bin->getBits(5) ;
   
   $rect->xmin   ( $bin->getSBits($n) );
   $rect->xmax   ( $bin->getSBits($n) );
   $rect->ymin   ( $bin->getSBits($n) );
   $rect->ymax   ( $bin->getSBits($n) );
   
   return $rect;
    
}


sub get_shapestyle 
{
    my $style = new Flash::Types::ShapeStyle;
    
    $style->with_alpha ( (defined $_[0])?$_[0]:0 );

    # Get the number of fills.
    $fills = unpack "C", $bin->getBytes(1);
    $fills = $bin->getWord if ($fills == 255);
  

    
   


    #Get each of the fill style.
    for (my $i = 0; $i < $fills; $i++)
    {
       my $fill = new Flash::Types::FillStyle;
       
       $fill->style ( unpack("C",$bin->getBytes(1)) );
       
       last unless (defined $fill->style());
       
       if ($fill->style & fill_gradient) 
       {
           
            $fill->type ( 'gradient' );
            
            # Get the gradient matrix.
            
            $fill->matrix ( get_matrix() );

            # Get the number of colors.
            my $colours = unpack "C", $bin->getBytes(1);
            
            
            # Get each of the colors.
            for ($j = 0; $j < $colours; $j++)
            {
                $fill->colours->[$j] = get_colour($style->with_alpha);                
            }
            
            
       } elsif ($fill->style & fill_bits) {
           
            $fill->type     ( 'bitmap' );
            $fill->bitmapid ( $bin->getWord );
            
            $fill->matrix   ( get_matrix() );                                    
            
        
       } else {

            $fill->type ( 'solid' );
         
            # A solid color
            $fill->colours->[0] = get_colour($style->with_alpha);                        
           

      }
      $style->fills->[$i] = $fill;
       
    }


    # Get the number of lines.
    my $lines = unpack("C",$bin->getBytes(1));

    # Do we have a larger number?
    $lines = $bin->getWord() if ($lines == 255);
    
    
    
    # Get each of the line styles.
    for (my $i = 1; $i <= $lines; $i++)
    {
        my $line      = new Flash::Types::LineStyle;
        $line->width  ( $bin->getWord() );
        $line->colour ( get_colour($style->with_alpha) );
        $style->lines->[$i] = $line;    
    }
    

    return $style
    
}

sub get_colour 
{
  my $colour = new Flash::Types::Colour;
  
  $colour->with_alpha ( (defined $_[0])?$_[0]:0 );
 
  $colour->r ( unpack"C", $bin->getBytes(1) );
  $colour->g ( unpack"C", $bin->getBytes(1) );
  $colour->b ( unpack"C", $bin->getBytes(1) );
  $colour->a ( 0xff );

  $colour->a ( unpack"C", $bin->getBytes(1) ) if ($colour->with_alpha);
        

  return $colour;
 
}
  

  
sub get_shape_definition
{
  
  my $tag = shift;
  
  $tag->with_alpha  ( (defined $_[0])?$_[0]:0 );
  $tag->shapeid     ( $bin->getWord() );
  $tag->bounds      ( get_rect );
  
  $tag->style (get_shapestyle($tag->with_alpha)    );  
  array_copy($tag->records, get_shape_records($tag->with_alpha) );
  
  
  
  
  
}



sub define_shape2 
{
  
    my $tag = new Flash::Tags::DefineShape2;
    
    get_shape_definition($tag);
    
    return $tag;
}


sub define_shape3 
{

    my $tag = new Flash::Tags::DefineShape3;
    
    get_shape_definition($tag,1);
 
    return $tag;
}




sub define_bitslossless2
{
   my $tag = new Flash::Tags::DefineBitsLossless2;
   
   get_bitslossless($tag,1);
   
   return $tag;
}

sub define_button 
{
    
    my $tag = new Flash::Tags::Button;
    $tag->tagid ( $bin->getWord );

    my $end = unpack("C",$bin->getBytes(1));
    
    my @buttonrecords;
    
    while ($end !=0 ) 
    {
        push @buttonrecords, button_record($end, 0);
        $end = unpack("C",$bin->getBytes(1))
    }
    
    
    @{$tag->buttonrecords} = @buttonrecords;

    array_copy($tag->actions, get_actions() );
    
    return $tag;
}


sub button_record 
{
    my ($byte,$colour_matrix) = @_;
    
    my $record = new Flash::Types::ButtonRecord;
    
    my $pad = $byte >> 4;
    $record->state_hittest ( ($byte & 0x8) );
    $record->state_down    ( ($byte & 0x4) );
    $record->state_over    ( ($byte & 0x2) );
    $record->state_up      ( ($byte & 0x1) );

    $record->character     ( $bin->getWord );
    $record->layer         ( $bin->getWord );

    $record->matrix        ( get_matrix () );
    
    
    # bit confused about this one the spec mutters something 
    # about nCharactersInButton and getting as many CXforms
    # as that but it always seems to be one :/
    $record->cxform ( get_cxform ) if ($colour_matrix);
    
    return $record;
}



sub get_shape_records
{
  

  
  my $with_alpha = (defined $_[0])?$_[0]:0;

  $bin->initBits();     # Bug!  this was not in the original example
                        # Required to reset bit counters and read byte aligned.

  # Get the bits per style index for the start shape     
  $fill_bits = $bin->getBits(4);  # in some of the example code these 
  $line_bits = $bin->getBits(4);  # are global vars so they are here :/
    
  my $x_last = 0;                 # these plus with_alpha will be
  my $y_last = 0;                 # directly referenced get_shape_record


  my @records;  
  
  while (my $record = get_shape_record(\$x, \$y, $fill_bits, $line_bits))
  {
    #print STDERR "ShapeRecord\n";
    push @records, $record; 
  }
  
  return @records;
}


sub get_shape_record
{
    my ($x,$y, $fill_bits, $line_bits) = @_;
    my $record = new Flash::Types::ShapeRecord;

    $record->fillbits ($fill_bits);
    $record->linebits ($line_bits);


 
    # Determine if this is an edge.
    $record->isedge ( $bin->getBits(1) );
     
    #print "IsEdge : ".$record->isedge,"\n";
 
    unless ($record->isedge())
    {
        # Handle a state change
        $record->flags ( $bin->getBits(5) );

        # Are we at the end?
        return undef if ($record->flags == 0);
        
        #Process a move to.
        if ($record->flags & flags_moveto)
        {
            $record->type ( 'moveto' );
            
            my $bits = $bin->getBits(5);
            $record->x (  $bin->getSBits($bits) );
            $record->y (  $bin->getSBits($bits) );
            
            $$x_last = $record->x;
            $$y_last = $record->y;
        }

        # Get new fill info.
        if ($record->flags & flags_fill0)
        {
            $record->type       ( 'Fill0' );
            $record->fillstyle0 ( $bin->getBits($fill_bits) );
            
        }
        
        if ($record->flags & flags_fill1)
        {
            $record->type       ( 'Fill1' );
            $record->fillstyle1 ( $bin->getBits($fill_bits) );
            
        }
        
        # Get new line info
        if ($record->flags & flags_line)
        {
             $record->type      ( 'Line' );
             $record->linestyle ( $bin->getBits($line_bits) );
            
        }
        
        # Check to get a new set of styles for a new shape layer.
        if ($record->flags & flags_newstyles)
        {
                        
            # Parse the style.
            $record->type  ( 'style' );
            $record->style ( get_shapestyle($with_alpha) );

            # Reset globalvars
            $fill_bits = $bin->getBits(4);
            $line_bits = $bin->getBits(4);

            $record->fillbits ( $fill_bits );
            $record->linebits ( $line_bits );
            
            
        }
        
        return undef if ($record->flags & flags_end)
        
        
     }else {
      
      
        if ($bin->getBits(1))
        {
            # Handle a line
            my $bits = $bin->getBits(4) +2;   # number of bits is biased by 2
            
            
            #Save the deltas
            if ($bin->getBits(1))
            {
                # Handle a general line.
                $record->type ( 'line' );
                $record->x    ( $bin->getSBits($bits) );
                $record->y    ( $bin->getSBits($bits) );
                
                $$x_last += $record->x;
                $$y_last += $record->y;

            }
            else
            {
                #Handle a vert or horiz line.
                if ($bin->getBits(1))
                {
                    # Vertical line
                    $record->type ( 'vline' );
                    $record->y    ( $bin->getSBits($bits) );
                    
                    $$y_last += $record->y;
                }    
                else
                {
                    # Horizontal line
                    $record->type ( 'hline' );
                    $record->x    ( $bin->getSBits($bits) );
                    
                    $$x_last += $record->x;
                    
                }
            }
        }
        else
        {
            # Handle a curve
            my $bits = $bin->getBits(4) + 2;   # nBits is biased by 2
            
            
            $record->type ( 'curve' );            
           
            # Get the control
            $record->cx ( $bin->getSBits($bits) );
            $record->cy ( $bin->getSBits($bits) );
            
            $$x_last += $record->cx;
            $$y_last += $record->cy;
          

            # Get the anchor
            $record->ax ( $bin->getSBits($bits) );
            $record->ay ( $bin->getSBits($bits) );
            
            $$x_last += $record->ax;
            $$y_last += $record->ay;
        }

        
    }

    return $record;
}


sub define_shape 
{
  
    my $tag = new Flash::Tags::DefineShape;
        
    get_shape_definition($tag,0);
    
    #print STDERR "Shape Records = ".scalar(@{$tag->records})."\n";
    
    return $tag;
    
}


sub get_shape 
{
    $tag->with_alpha ( (defined $_[0])?$_[0]:0 );
    
    $tag->tagid ( $bin->getWord );
    
   

    #Get the bounding rectangle
    $tag->rect ( get_rect() );
    
    
    # .. and the shape style    
    $tag->style ( get_shapestyle($tag->with_alpha) ) ;
         
    
    array_copy($tag->shape_records, get_shape_records($tag->with_alpha) ); 
  
}


sub define_font 
{
    
    my $tag = new Flash::Tags::DefineFont;
    
    $tag->fontid (  $bin->getWord );
    
    

    my $start = $bin->where;

    $tag->offset ( $bin->getWord );
    
    my @offset_table;
    
    my $glyphcount = $tag->offset/2;
    $glyph_counts[$tag->fontid] = $glyphcount;
    

    
    $offset_table[0] = $tag->offset;

    for(my $n=1; $n<$glyphcount; $n++)
    {
        $offset_table[$n] = $bin->getWord;
    }

    for(my $n=0; $n<$glyphcount; $n++)
    {
        $bin->seekTo($offset_table[$n] + $start);

        $tag->glyphs->[$n] = \@{get_shape_records(0)};
    }

    return $tag;
}

sub define_fontinfo
{
    my $tag = new Flash::Tags::DefineFontInfo;
    
    
   $tag->fontid ( $bin->getWord );
    
    

    my $namelen = unpack("C",$bin->getBytes(1));    
    $tag->name    ( $bin->getBytes($namelen) );
    

    
    $tag->flags   ( unpack "C", $bin->getBytes(1) );

    my $glyph_count = $glyph_counts[$tag->fontid];

    
    
    for(my $n=0; $n < $glyph_count; $n++)
    {
        $tag->code_table->[$n] = ($tag->flags & fontflags_widecodes)? $bin->getWord :unpack "C",$bin->getBytes(1) ;
        
        
    }
    
    
    return $tag;
}


sub define_text 
{
    
    my $tag = new Flash::Tags::DefineText;
    
    $tag->tagid  ( $bin->getWord  );
    $tag->rect   ( get_rect()     );
    $tag->matrix ( get_matrix()   );
    
    # for some reason we need to get an extra byte. I don't know why.
    $bin->getBytes(1);
    
    $tag->glyph_bits   (unpack "C", $bin->getBytes(1));
    $tag->advance_bits (unpack "C", $bin->getBytes(1));
    
    $tag->text_records ( get_text_record($glyph_bits, $advance_bits) );
    
    return $tag;
}



sub get_text_record
{
    my ($glyph_bits, $advance_bits) = @_;
    
    my $record = new Flash::Types::TextRecord;
   
    
    $record->flags ( unpack "C" , $bin->getBytes(1) );
    return undef if ($record->flags == 0);
    
    
    if ($record->flags & is_text_control)
    {
        $record->fontid   ( $bin->getWord() ) if ($record->flags & text_hasfont);        
        $record->colour   ( get_colour      ) if ($record->flags & text_hascolour);
        $record->x_offset ( $bin->getWord() ) if ($record->flags & text_hasxoffset);
        $record->y_offset ( $bin->getWord() ) if ($record->flags & text_hasyoffset);
        $record->height   ( $bin->getWord() ) if ($record->flags & text_hasfont);
    }
    else
    {
        my $glyph_count = $record->flags;
        

        $bin->initBits();     # reset bit counter

        
        for (my $g = 0; $g < $glyph_count; $g++)
        {
            my %gr;
            $gr{index}   = $bin->getBits($glyph_bits);
            $gr{advance} = $bin->getBits($advance_bits);
            $record->glyphs->[$g] = \%gr;
            
        }
        
    }

    return $record;
}


sub define_text2 
{
    $tag = Flash::Tags::DefineText2
    
    $tag->tagid  ( $bin->getWord );
    $tag->rect   ( get_rect()    );
    $tag->matrix ( get_matrix()  );
    
    # for some reason we need to get an extra byte. I don't know why.
    $bin->getBytes(1);
    
    my $glyph_bits   = unpack "C", $bin->getBytes(1);
    my $advance_bits = unpack "C", $bin->getBytes(1);
    
    $tag->text_records ( get_text_record($glyph_bits, $advance_bits) );
    
    return $tag;
}

sub name_character
{
    
    my $tag = new Flash::Tags::NameCharacter;
    
    $tag->tagid ( $bin->getWord    );
    $tag->label ( get_string()     );
 
    return $tag;
}



sub protect
{
  
    my $tag = new Flash::Tags::Protect;
}


sub define_edittext
{
  
   my $tag = new Flash::Tags::DefineEditText;
   
    
    
    $tag->tagid           ( $bin->getWord() );
    $tag->rect            ( get_rect()      );
    
    

    $tag->flags           ( $bin->getWord() );

    

    if ($tag->flags & edittext_hasfont)
    {
        $tag->fontid      ( $bin->getWord() );
        $tag->height      ( $bin->getWord   );                 
    }

    $tag->colour          ( get_colour(1)   ) if ($tag->flags & edittext_hastextcolour);
    

    $tag->maxlength       ( $bin->getWord() ) if ($tag->flags & edittext_hasmaxlength);
    
    if ($tag->flags & edittext_haslayout)
    {
        $tag->align       ( $bin->getBytes(1) );
        $tag->leftmargin  ( $bin->getWord()   );
        $tag->rightmargin ( $bin->getWord()   );
        $tag->indent      ( $bin->getWord()   );
        $tag->leading     ( $bin->getWord()   );
    }

    $tag->variable        ( get_string()    );
    

    $tag->initialtext     ( get_string()    ) if ($tag->flags & edittext_hastext);
    

     
    return $tag;
   
}


sub define_font2 
{
  
    my $tag = new Flash::Tags::DefineFont2;
    
    
    $tag->tagid ( $bin->getWord() );
    $tag->flags ( $bin->getWord() );

    # Skip the font name
    my $namelen = $bin->getBytes(1);
    
    my $fontname = "";
    
    while (--$namelen) {
     $fontname .=  unpack "C", $bin->getBytes(1);
    }
    
    $tag->fontname ( $fontname );
    
    
    #Get the number of glyphs.
    my $nglyphs = $bin->getWord();
    

    my $pos = $bin->where;

    


    if ($nglyphs > 0)
    {
        
        # Get the FontOffsetTable        
        my $offset_table = [];        
        for (my $n=0; $n<$tag->nglyphs; $n++)
        {
            $offset_table[$n] = ($tag->flags & fontflags_wideoffsets)? $bin->getDWord() : $bin->getWord();
            
        }
        
        # Get the CodeOffset               
        my $code_offset = ($tag->flags & fontflags_wideoffsets)? $bin->getDWord() : $bin->getWord();
        

        
        # Get the Glyphs        
        for(my $n=0; $n<$nglyphs; $n++)
        {
            
            
            
            $bin->seekto($pos + $offset_table[$n]);

            $bin->initBits(); # reset bit counter


            $tag->glyphs->[$n] = \@{get_shape_records(0)};
        }

        @offset_table = undef;


        printf STDERR "Bad CodeOffset in DefineFont2 : tagid : ".$tag->tagid.", file offset : ".sprintf("0x%04x",$bin->where)."\n" if ($bin->where != $pos + $code_offset);
        
        # Get the CodeTable                   
        $bin->seekto($pos + $code_offset);

           
        for (my $i=0; $i<$nglyphs; $i++)
        {            
            $tag->code_table->[$i] = ($tag->flags & fontflags_wideoffsets)? $bin->getWord : unpack "C", $bin->getBytes(1);
        }
 
    }
    

    if ($tag->flags & fontflags_haslayout)
    {
        
        # Get "layout" fields        
        $tag->ascent  ( $bin->getWord() );
        $tag->descent ( $bin->getWord() );
        $tag->leading ( $bin->getWord() );

        

        # Skip Advance table
        $bin->seekto($bin->where + ($nglyphs * 2));

        
        # Get BoundsTable        
        for (my $i=0; $i<$nglyphs; $i++)
        {            
            $tag->bounds->[$i] = get_rect();            
        }

        
        # Get Kerning Pair
        my $kerning_count = $bin->getWord();
        for ($i=0; $i<$kerning_count; $i++)
        {
            my $kp = new Flash::Types::KerningPair;
            
            if ($tag->flags & fontflags_wideoffsets)
            {
                $kp->code1 ( $bin->getWord() ); 
                $kp->code2 ( $bin->getWord() );
            }
            else
            {
                $kp->code1 ( $bin->getBytes(1) );
                $kp->code1 ( $bin->getBytes(1) );
            }
            $kp->adjust    ( $bin->getWord() );
            
            $tag->kerning_pairs->[$i] = $kp;
            
        }

        
    }
    
    return $tag;
}


sub define_sound   #!!!!!!!!!!!!!!!!!
{
  
    my $tag = new Flash::Tags::DefineSound;
    
    
    $tag->tagid       ( $bin->getWord() );

    
        
    $tag->compression ( $bin->getBits(4) );  # uncompressed, ADPCM or MP3
    $tag->samplerate  ( $bin->getBits(2) );
    $tag->samplesize  ( $bin->getBits(1) );
    $tag->stereomono  ( $bin->getBits(1) );
    $tag->samplecount ( $bin->getDWord() );


    my @compression  = qw(uncompressed ADPCM MP3);
    my @samplerate   = qw(5.5 11 22 44);
    my $samplesize   = ($tag->samplesize) ? 16 : 8;
    my $stereomono   = ($tag->stereomono) ? "stereo" : "mono";

    
    
        if    ($tag->compression == 0)
        {
            # do nothing, uncompressed samples
        }
        elsif ($tag->compression == 1)
        {
            my $samples_adpcm = 0;
            my $srcAdpcm      = get_string();
            #adpcm_decompress($tag->samplecount, $tag->stereomono, $tag->samplesize);
            
        }
        elsif ($tag->compression == 2)
        {
            $tag->mp3delay   ( $bin->getWord() );
            #$tag->mp3headers ( DecodeMp3Headers($tag->samplecount) );
            
        }


    return $tag;
}


sub do_action
{
  my $tag = new Flash::Tags::DoAction;
  array_copy($tag->actions, get_actions() ); 
  
  return $tag;
}

sub get_actions
{
  
   
    
   
    my @actions;
    
    for (;;) 
    {
      
        my $action = new Flash::Types::Action;
    
        # Handle the action        
        $action->code (unpack "C", $bin->getBytes(1));
        

        
        
        # Action code of zero indicates end of actions        
        if ($action->code() == 0 || ! defined($action->code())) {
            push @actions, $action;
            return @actions ;
        }
        


        $action->length ( 0 );
        $action->length ( $bin->getWord() ) if ($action->code & $actiondef->{"HasLength"});
        
 
        my $pos = $bin->where + $action->length;

        my $switch = "DEFAULT";
        $switch = $actiondict->{$action->code} if (defined $actiondict->{$action->code});
        
        

        SWITCH: for ($_ = $switch) {

            /GotoFrame/  && do
            {
              $action->frame($bin->getWord());
              last SWITCH;
            };


            /GetURL/        && do 
            {
                $action->url    ( get_string() );
                $action->target ( get_string() );                
                last SWITCH;
            };

            /WaitForFrame/        && do 
            {
                $action->frame      ( $bin->getWord() );
                $action->skip_count ( unpack "C", $bin->getBytes(1) );
                last SWITCH;
            };

            /SetTarget/        && do 
            {
                # swfparse used to crash here!
                $action->target ( get_string() );
                last SWITCH;
            };

            /GotoLabel/        && do  
            {
                # swfparse used to crash here!
                $action->label ( get_string() );
                last SWITCH;
            };

            /WaitForFrameExpression/        && do 
            {
                $action->skip_count ( $bin->getBytes(1) );                
                last SWITCH;
            };
                
            /PushData/        && do
            {
                $action->datatype (unpack "C", $bin->getBytes(1));

                # property ids are pushed as floats for some reason
                # in some example code this was a union. Eugggh. Hard to port to Perl.
                if ($action->datatype == 1 ) {
                    $action->propertyid ( $bin->getDWord() );                    
                } elsif ($action->datatype == 0 ) {
                    $action->label ( get_string() );
                } else {
                    printf STDERR "pushData invalid dataType: %02x\n", $action->datatype ;
                }


                last SWITCH;
            };

            /BranchAlways/        && do 
            {
                $action->offset ( $bin->getWord() );               
                last SWITCH;
            };

            /GetURL2/        && do 
            {
                my $flag = unpack "C", $bin->getBytes(1);

                
                $action->sendvars ( 'target') if ($flag == 1);
                $action->sendvars ( 'POST'  ) if ($flag == 2);
                  
                
                last SWITCH;
            };

            /BranchIfTrue/        && do 
            {
                $action->offset ( $bin->getWord() );
                last SWITCH;
            };

         

            /GotoExpression/        && do  
            {
                $action->stopflag  (unpack "C", $bin->getBytes(1));
                #$action->flag ( 'Stop' ) if ( $stopflag == 0 );
                #$action->flag ( 'Play' ) if ( $stopflag == 1 );
                
                last SWITCH;
            };
            
            # DEFAULT
            # There are lots of other Actions but none of them
            # have any attributes so we don't need to do anything

      
        
        

        }
  
        push @actions, $action;
                
        # 'paranoia, paranoia everybody's coming to get you' dum de do
        # prevents bad action reads.
        $bin->seekTo($pos);
    }
 
   
}


sub define_buttonsound
{
  
    my $tag = new Flash::Tags::DefineButtonSound;
    
    $tag->tagid ( $bin->getWord() );

        
    # step through for button states
    for (my $i = 0; $i < 3; $i++)
    {
        
        
 
        $tag->states->[$i] = get_buttonstate();
        
        
    }
    
    return $tag;
}

sub get_buttonstate
{
    
    my $state = new Flash::Types::ButtonState;
    
    $state->state     ($_[0]);
    $state->soundtag  ($bin->getWord);
    
    $state->soundstate(get_soundstate) if ($state->soundtag);
    
    return $state;
         
  
}

sub sound_streamblock 
{
  
    my $tag = new Flash::Tags::DefineButtonSound;
   

    $tag->compression ( $stream_compression );
    
        if ($tag->compression == 0)
        {
            # do nothing
        }
        if ($tag->compression == 1)
        {
            $samples_adpcm = 0;
            @src_adpcm  = get_adpcm;
            $tag->adpcm ( adpcm_decompress );
         
        }
        if ($tag->compression == 2)
        {
            $tag->samplesperframe  ( $bin->getWord() );
            $tag->delay            ( $bin->getWord() );

            
            $tag->mp3headers ( decode_mp3_headers($tag->samplesperframe) );
        }
        
   
    return $tag;
    
}


sub define_buttoncxform
{
  
   my $tag = new Flash::Tags::DefineButtonCXform;
   
   
   $tag->tagid ($bin->getWord());
    

    while ($bin->where < $newpos)
    {
        push @{$tag->cxforms}, get_cxform();

    }
  
   return $tag;
}

sub define_button2
{
    
    
    my $tag = new Flash::Tags::DefineButton2;

    $tag->tagid       ( $bin->getWord() );
    my $track = unpack "C", $bin->getBytes(1);
    $tag->trackasmenu (  );

    # Get offset to first "Button2ActionCondition"
    # This offset is not in the spec!
    my $offset = $bin->getWord();
    my $nexaction = $bin->where + $offset - 2;

    
    # Parse Button Records
    
    my $end = unpack("C",$bin->getBytes(1));
    
    my @buttonrecords;
    
    while ($end !=0 ) 
    {
        push @buttonrecords, button_record($end, 0);
        $end = unpack("C",$bin->getBytes(1))
    }
    
    
    #@{$tag->buttonrecords} = @buttonrecords;

    
    # Parse Button2ActionConditions        
    #$bin->seekTo($nextaction);  # more paranoia

    
    
    while (1)
    {
        my $ac = new Flash::Types::ActionCondition;               
        
        
        my $nextaction   = $bin->where + $bin->getWord() - 2;

        $ac->condition  ( $bin->getWord() );

        

        # parse ACTIONRECORDs until ActionEndFlag
        array_copy($ac->actions, get_actions() );

        # Action Offset of zero means there's no more
        last if ($bin->where > $nextaction);
        
        push @{$tag->actionconditions}, $ac;
                
        $bin->seekTo($nextaction);
        
    }

    return $tag;

}



sub define_sprite
{
  my $tag = new Flash::Tags::DefineSprite;
  $tag->tagid      ( $bin->getWord() );
  $tag->framecount ( $bin->getWord() );
  $tag->movie      ( new Flash::Object);
 
  #my $oldframecount = $framecount;
  #$framecount = 0;
  
  parse_tags       ($tag->movie);
  
  # parse_tags($tag);
  
  #$framecount  = $oldframecount;
  
  return $tag;
}


sub define_morphshape #!!!!!!
{
  
    my $tag = new Flash::Tags::DefineMorphShape;
    
    $tag->tagid ( $tag->getWord() );
    $tag->r1    ( get_rect        ); 
    $tag->r2    ( get_rect        );
    


    # Calculate the position of the end shape edges
    my $offset      = $bin->getDWord();
    my $endshapepos = $bin->where; #!!!!!!!!!

    # Always get RGBA not RGB for DefineMorphShape
    $tag->shapestyles( get_shapestyle(1) );
    

    

    
    # Parse the start shape
    array_copy($tag->startrecords, get_shaperecords(1) );
    
   
    # Get the bits per style index for the end shape
    # THIS IS POINTLESS -- THERE ARE NO STYLES ?!
    

    $bin->initBits();
    $fillbits = $bin->getBits(4);     # not sure if we should save these to n_FillBits & nLineBits
    $linebits = $bin->getBits(4);     # there are no styles so none of this make sense.

    
    # Parse the end shape
    $taTypes/Action.pm
/virtual/twoshortplanks.com/www/html/Flash/stuff/Flash/Types/ActionCondition.pm
/virtual/twoshortplanks.com/www/html/Flash/stuff/Flash/Types/ButtonRecord.pm
/virtual/twoshortplanks.com/www