# Flash::SWF::Parser

package      Flash::SWF::Parser;

use          Exporter;
use          File::Binary;
use          Flash::Object;
use          Compress::Zlib;
@ISA       = qw(Exporter);
@EXPORT    = qw(parse);
@EXPORT_OK = qw();

    $splaceMove          = 0x01; # this place moves an exisiting object
    $splaceCharacter     = 0x02; # there is a character tag (if no tag, must be a move)
    $splaceMatrix        = 0x04; # there is a matrix (matrix)
    $splaceColorTransform= 0x08; # there is a color transform (cxform with alpha)
    $splaceRatio         = 0x10; # there is a blend ratio (word)
    $splaceName          = 0x20; # there is an object name (string)
    $splaceDefineClip    = 0x40; # this shape should open or close a clipping bracket (character != 0 to open, character == 0 to close)

    $soundHasInPoint     = 0x01;
    $soundHasOutPoint    = 0x02;
    $soundHasLoops       = 0x04;
    $soundHasEnvelope    = 0x08;
    
    $fillGradient        = 0x10;
    $fillLinearGradient  = 0x10;
    $fillRadialGradient  = 0x12;
    $fillMaxGradientColors =  8;
    # Texture/bitmap fills
    $fillBits            = 0x40; # if this bit is set, must be a bitmap pattern
    # one bit left for expansion
    
    # These flag codes are used for state changes - and as return values from ShapeParser::GetEdge()
    $eflagsMoveTo       = 0x01;
    $eflagsFill0        = 0x02;
    $eflagsFill1        = 0x04;
    $eflagsLine         = 0x08;
    $eflagsNewStyles    = 0x10;

    $eflagsEnd          = 0x80;  # a state change with no change marks the end
   
    # font flags
    $fontUnicode   = 0x20;
    $fontShiftJIS  = 0x10;
    $fontANSI      = 0x08;
    $fontItalic    = 0x04;
    $fontBold      = 0x02;
    $fontWideCodes = 0x01;
   
   
    # Edit text field flags
    $sfontFlagsBold          = 0x01;
    $sfontFlagsItalic        = 0x02;
    $sfontFlagsWideCodes     = 0x04;
    $sfontFlagsWideOffsets   = 0x08;
    $sfontFlagsANSI          = 0x10;
    $sfontFlagsUnicode       = 0x20;
    $sfontFlagsShiftJIS      = 0x40;
    $sfontFlagsHasLayout     = 0x80;

    # Edit Text Flags
    $seditTextFlagsHasFont       = 0x0001;
    $seditTextFlagsHasMaxLength  = 0x0002;
    $seditTextFlagsHasTextColor  = 0x0004;
    $seditTextFlagsReadOnly      = 0x0008;
    $seditTextFlagsPassword      = 0x0010;
    $seditTextFlagsMultiline     = 0x0020;
    $seditTextFlagsWordWrap      = 0x0040;
    $seditTextFlagsHasText       = 0x0080;
    $seditTextFlagsUseOutlines   = 0x0100;
    $seditTextFlagsBorder        = 0x0800;
    $seditTextFlagsNoSelect      = 0x1000;
    $seditTextFlagsHasLayout     = 0x2000;



    # TextFlags
    $isTextControl = 0x80;

    $textHasFont   = 0x08;
    $textHasColor  = 0x04;
    $textHasYOffset= 0x02;
    $textHasXOffset= 0x01;
   
    my @piOffsetTable;
    my @piCodeTable;
    my @iGlyphCounts;
    my  @puOffsetTable;
   


sub parse 
{
	 
	 my ($self, $flash, $filename) = @_;
  	

    $| = 1;
    select STDERR; $| =1; select STDOUT;
    
    #print "DOING $filename\n\n";
    print STDERR "opening $filename\n";
	 unless ($bin = new File::Binary($filename))
   {
       print STDERR "File '$filename' not read!\n";       
       
   }

   unless ($bin->getBytes(3) eq 'FWS')  
   {
      print STDERR  "'$filename' is not valid SWF file\n";
      exit 1;
      return undef;
   }

   

   my $ver    = unpack("C",$bin->getBytes(1));
   my $len    = unpack("L",$bin->getBytes(4));
   
   my %rect = %{getRect($bin)};
   print STDERR "Here\n";
   
   #my $n      = $bin->getBits(5);
   #my $xmin   = $bin->getSBits($n);
   #my $xmax   = $bin->getSBits($n);
   #my $ymin   = $bin->getSBits($n);
   #my $ymax   = $bin->getSBits($n);
   my $framer = unpack("S",$bin->getBytes(2)) >> 8;
   my $framec = unpack("S",$bin->getBytes(2));


   # $xmin,$xmax,$ymin,$ymax
   print STDERR "Got headers\n";
   $flash->set_headers($ver,$len,$rect{'xmin'},$rect{'xmax'},$rect{'ymin'},$rect{'ymax'},$framec,$framer, $bin->where());
 
   ## i have no clue why this didn't work:
   #
   #       $self->_initBits();
   #       my $code = $self->_GetBits(10);
   #       my $length = $self->_GetBits(6);
   ##
   
    my $code;

    print STDERR "starting to parse\n";
    do
    {
        $code = unpack("S",$bin->getBytes(2));
        my $length = $code & 0x3f;
        $code = $code >> 6;

        if ($length == 63) {
                $length = unpack("L",$bin->getBytes(4));
        }
        
	        
        my $newpos = $bin->where;
        parseDefaultTag($code,$length,$bin,$flash) unless eval ("parse".$flash->to_tag($code)."(\$code,\$length,\$bin,\$flash)");
        #print $flash->to_tag($code)," ";
        $bin->seekTo($newpos + $length) unless ($code==0 || !$newpos);
        #print $bin->where,"\n";


        
    }
    until ($code==0);


	return $flash;
		
		      
}


sub parseDefaultTag 
{

    my ($code,$length,$bin,$flash) = @_;    

    my $data = $bin->getBytes($length);

    $flash->add_tag(type=>$code);
    
    return 1;

}



sub parseShowFrame 
{

    my ($code,$length,$bin,$flash) = @_;    

    my $data = $bin->getBytes($length);

    $flash->add_tag(type=>$code,offset=>$bin->where());

    return 1;
}


sub parseStartSound 
{

    my ($code,$length,$bin,$flash) = @_;    

    my %tag;
    $tag{'type'}      = $code;
    $tag{'tagid'}     = unpack("C",$bin->getBytes(2));
    $tag{'soundcode'} = unpack("C",$bin->getBytes(1)); my $soundcode = $tag{'soundcode'};
    my $bits = 24;
    
    $tag{'inpoint'}  = 1 if ($soundcode & $soundHasInPoint );   
    $tag{'outpoint'} = 1 if ($soundcode & $soundHasOutPoint );   
    if ($soundcode & $soundHasLoops )
    {
         $tag{'loops'} = unpack("C",$bin->getBytes(4)); 
    #    #| (unpack("C",$bin->getBytes(1)) << 8) | (unpack("C",$bin->getBytes(1)) << 16) | (unpack("C",$bin->getBytes(1)) << 24);
         my $data = getBits(32);
    #    print "\thas loops\n";
    #     $bits = 56;
    }
    
    #$bin->getBits(($length*8)-$bits);
    $flash->add_tag(%tag);

    return 1;
}

sub parseSetBackgroundColor 
{
        
    my ($code,$length,$bin,$flash) = @_;    
               
    $flash->add_tag(type=>$code, RGB_HEX=>unpack("H6",$bin->getBytes($length)));
        
    return 1;
}


sub parseFreeCharacter 
{

    my ($code,$length,$bin,$flash) = @_;    
    
    my $tagid = $bin->getWord;
    
    $flash->add_tag(type=>$code, tagid=>$tagid);
    
    return 1;
}


sub parsePlaceObject 
{

   my ($code,$length,$bin,$flash) = @_;            
	

   my $tagid = unpack("C",$bin->getBytes(2));
   my $depth = unpack("C",$bin->getBytes(2));
   
   my $diff = ($length*8)  - 32; 
   my %matrix = %{getMatrix($bin)};   

   
   
   #print "  $diff";
   $diff -= $matrix{'bits'};
   #print "  $diff\n";
   my %cx;
   if ($diff>0)
   { #print "GETTING CXFORM\n";
     %cx = %{getCXForm($bin,0)};
   }
   $bin->getBits($diff);

   $flash->add_tag(type=>$code,tag=>$tagid,depth=>$depth,matrix=>\%matrix, cx=>\%cx);
    
   return 1;
}





sub parseRemoveObject 
{

    my ($code,$length,$bin,$flash) = @_;    
    
    $depth = $bin->getWord;
    $flash->add_tag(type=>$code,tagid=>$bin->getWord(),depth=>$depth);

    
}

sub parseRemoveObject2 
{

    my ($code,$length,$bin,$flash) = @_;    
    
    $flash->add_tag(type=>$code,depth=>unpack("S",$bin->getBytes($length)));

}


sub parseFrameLabel 
{
  
    my ($code,$length,$bin,$flash) = @_;    
   
    my $label = getString($bin);
    
    
    
   
    $flash->add_tag(type=>$code,label=>$label);
}


sub parsePlaceObject2 
{

    my ($code,$length,$bin,$flash) = @_;   
    
    
    my (%matrix, %cx, %tag);    
    $tag{'flags'} = unpack("C",$bin->getBytes(1)); my $flags = $tag{'flags'};
    $tag{'depth'} = $bin->getWord;
    

    my $bits  = 24;
    
    
    $tag{'type'} = $code;

    if ($flags & $splaceMove)
    {
        $tag{'move'} =  1;
    }
    
    if ($flags & $splaceCharacter)
    {
        $tag{'tag'} =  $bin->getWord;
        $bits += 16;
    }
   
    if ($flags & $splaceMatrix)
    {
    #    print ">>GETTING MATRIX\n";  
         %matrix = %{getMatrix($bin)};
        $bits += $matrix{'bits'};
        $tag{'matrix'} = \%matrix;
    }
    
    if ($flags & $splaceColorTransform) 
    {
         #print "Getting CXForm\n";
         %cx = %{getCXForm($bin,1)};
         #$bits += $cx{'bits'};
         $tag{'cx'} = \%cx;
        
    }        

    #  Get the ratio if specified.
    if ($flags & $splaceRatio)
    {
        $tag{'ratio'} = $bin->getBytes(2);
        $bits += 16;
        #INDENT;
        #print "ratio $ratio\n";
    }        

    # get the clipdepth if specified.
    if ($flags & $splaceDefineClip) 
    {
        $tag{'clip_depth'} = $bin->getBytes(2);
        $bits += 16;
        #INDENT;
        #printf("clipDepth %i\n", clipDepth);
    }

    # get the instance name
    #if ($flags & $splaceName) 
    #{
    #    while($bin->getBytes(1)){};
    #    #INDENT;
        #printf("instance name %s\n", pszName);
    #}

    #print "L=$length : Bits:$bits\n";
    #$bin->getBits(($length*8)  - $bits);
    $flash->add_tag(%tag);

    return 1;
}


sub getCXForm
{
    my ($bin, $has_alpha) = @_;

    #print ">>>GEtting CXForm<<<";
    my %cx;
   
    # !!! The spec has these bits reversed !!!
    my $fNeedAdd = ($bin->getBits(1)!=0);
    my $fNeedMul = ($bin->getBits(1)!=0);
    # !!! The spec has these bits reversed !!!

    #printf("fNeedMul:%d fNeedAdd:%d\n", $fNeedMul, $fNeedAdd);

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

    $cx{'aa'} = 256; 
    $cx{'ab'} = 0;
   
    if ($fNeedMul)
    {
        $cx{'ra'} = unpack("S",$bin->getSBits($n));
        $cx{'ga'} = unpack("S",$bin->getSBits($n));
        $cx{'ba'} = unpack("S",$bin->getSBits($n));
        #$cx{'bits'}+= 3*$n;
        if ($has_alpha)
        {           
           $cx{'aa'} = unpack("S",$bin->getSBits($n));
           #$cx{'bits'}+= $n;
        }
        
    } else {
        $cx{'ra'} = 256;
        $cx{'ga'} = 256;
        $cx{'ba'} = 256;
    }

    if ($fNeedAdd)
    {
        $cx{'rb'} = unpack("S",$bin->getSBits($n));
        $cx{'gb'} = unpack("S",$bin->getSBits($n));
        $cx{'bb'} = unpack("S",$bin->getSBits($n));
        #$cx{'bits'}+= 3*$n;
        if ($has_alpha)
        {  #$cx{'bits'}+= $n;
           $cx{'ab'} = unpack("S",$bin->getSBits($n));
        }
    } else {
        $cx{'rb'} = 8;
        $cx{'gb'} = 8;
        $cx{'bb'} = 8;
    }

    return \%cx;
}

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


sub getMatrix 
{

    my $bin = shift;

    my (%matrix,$n);

    $matrix{'bits'} = 1;

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

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

    # Translate terms
    $n = $bin->getBits(5);
    $matrix{'tx'}  = $bin->getSBits($n);
    $matrix{'ty'}  = $bin->getSBits($n);
    $matrix{'bits'} += 5 + $n + $n;

           
    $matrix{'a'} /=65536;
    $matrix{'b'} /=65536;
    $matrix{'c'} /=65536;
    $matrix{'d'} /=65536;
    $matrix{'tx'} /=20;
    $matrix{'ty'} /=20;

        #print "Mbits = ",$matrix{'bits'},"\n";
        #print "\ta = ",$matrix{'a'},"\n";
        #print "\td = ",$matrix{'d'},"\n";
        #print "\tb = ",$matrix{'b'},"\n";   
        #print "\tc = ",$matrix{'c'},"\n";   
        #print "\ttx = ",$matrix{'tx'},"\n";   
        #print "\tty = ",$matrix{'ty'},"\n";   
    return \%matrix;
}


sub parseSoundStreamHead
{    
    my ($code,$length,$bin,$flash) = @_;
    parseSoundStreamHead2(45,$length,$bin,$flash);
    #$bin->getBytes($length);
    #$flash->add_tag(type=>$code);
    return 1;
}

sub parseSoundStreamHead2
{

    my ($code,$length,$bin,$flash) = @_;
    
    #print "Sound Length ".($length*8)."\n";
    # The stream settings
    my $iStreamCompression = $bin->getBits(4);
    my $iStreamSampleRate  = $bin->getBits(2);
    my $iStreamSampleSize  = $bin->getBits(1);
    my $iStreamStereoMono  = $bin->getBits(1);
    my $nStreamSamples     = $bin->getBytes(2);

    
    my @ppszCompression    = ("uncompressed", "ADPCM", "MP3");
    my @ppszSampleRate     = ("5.5", "11", "22", "44");
    my $pszSampleSize      = (($iStreamSampleSize == 0) ? "8" : "16");
    my $pszStereoMono      = (($iStreamStereoMono == 0) ? "mono" : "stereo");

    $flash->add_tag(type=>$code,freq=>$ppszCompression[$iStreamCompression], sample_rate=>$ppszSampleRate[$iStreamSampleRate],Size=>$pszSampleSize ,Mono=>$pszStereoMono,Average_Samples_Per_Frame=>$nStreamSamples);
    #printf("%stagSoundStreamHead%s: %s %skHz %s-bit %s AverageSamplesPerFrame:%d\n",
    #    str, fIsHead2 ? "2" : "", ppszCompression[m_iStreamCompression], ppszSampleRate[m_iStreamSampleRate],
    #    pszSampleSize, pszStereoMono, m_nStreamSamples);

    $bin->getBits(($length*8)-24);
    #$flash->add_tag(type=>$code);

    return 1;
}


sub parseDefineBits
{
  my ($code,$length,$bin,$flash) = @_;
  
  my $tagid = $bin->getWord;
  
  
  my $guts = getImageGuts($bin, $length-2);
  $flash->add_tag(type=>$code,tagid=>$tagid, guts=>$guts);
  
  
  
  return 1;
}



sub parseDefineBitsLossless
{
   # get passed 
   # - my tag code
   # - the length of this tag
   # - a binary file object 
   # - and a Flash::Object
   # on the command line
   my ($code,$length,$bin,$flash, $with_alpha) = @_;
   
   select STDERR; $| = 1; select STDOUT;
   
   
   # set up values if we're doing for doing DefineBitsLossless2
   $with_alpha = 0 unless (defined $with_alpha);
   my $rgb_size = 3;
   $rgb_size = 4 if ($with_alpha);
   
   my $initial_pos = $bin->where;
   
   # get my tag ID 
   my $tagid = $bin->getWord;

   # for debugging purposes 
   print STDERR "DefineBitsLossless\n";
    
    # get some other relevant info
    my $format = unpack("C",$bin->getBytes(1));
    my $width  = $bin->getWord;
    my $height = $bin->getWord;
    my $table_size = 0;

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

   
    # initialise an inflation scheme    
    my $z = inflateInit() or die "Cannot create a inflation stream\n" ;
    
    my $size = ($table_size * $rgb_size) + ($width*$height);
    my $input = $bin->getBytes($size);
    
    my $output = $z->inflate($input);
    
    unless ($output) {
      print STDERR "\tAaaaaaaaaaaargh\n";
      goto BUGOUT;
    }
    
    my @decompressed = unpack "C$size", $output;
    
    
    # generate a string of the colour data (from 0 to (table_size*3) in the decompressed array) 
    my $colourtable = "\n\t";
    for (my $i=0; $i<($table_size*$rgb_size); $i+=$rgb_size)
    {    
         $colourtable .= " ";
         for (my $j=0; $j<$rgb_size; $j++){
          $colourtable .= sprintf("%02x", $decompressed[$i+$j]);
         }
         $colourtable .= " ";
         
         
         if (($i % (8*$rgb_size)) == (7*$rgb_size)){
             $colourtable .= sprintf("\n\t");}
    }
    $colourtable .= "\n";
    
    #print $colourtable;

    # get all the picture data (from  (table_size*rgb_size)+1 to the end of the array  
    my $picture = sprintf("\n\t");
    my $i = 0;
    for ($y=0; $y<$height; $y++){
        for ($x=0; $x<$width; $x++, $i++){
            my $loc = ($table_size*$rgb_size)+$i;
            my $thing = $decompressed[$loc];            
            $picture .= sprintf("%02x", $thing);
        }
        $picture .= sprintf("\n\t");
    }
    $picture .= sprintf("\n");

    # don't print picture ... it's huge
    # and don't add it to the tag either
    #print $picture,"\n";

    BUGOUT:
    # add a new tag to our Flash::Object   
    $flash->add_tag(type=>$code, tagid=>$tagid, tableSize=>$table_size, format=>$format, width=>$width, height=>$height. colourtable=>$colourtable);
    
    
    
    # finished parsing this tag
    return 1;
    
}


sub parseDefineBitsJPEG2
{
   my ($code,$length,$bin,$flash) = @_;
   my $tagid = $bin->getWord;
   $flash->add_tag(type=>$code,tagid=>$tagid, guts=>getImageGuts($bin, $length-2));
  
   return 1;
}


sub parseDefineBitsJPEG3
{
   my ($code,$length,$bin,$flash) = @_;
   my $tagid = $bin->getWord;
   $flash->add_tag(type=>$code,tagid=>$tagid, guts=>getImageGuts($bin, $length-2));
  
   return 1;
}

sub parseJPEGTables
{
     my ($code,$length,$bin,$flash) = @_;
     my $guts = getImageGuts($bin, $length);
     $flash->add_tag(type=>$code, guts=>$guts);
     
     #print "arse\n" unless (defined $guts);
}



sub getImagesluts
{
  
    print "OOOH yeah\n";
    my ($bin,$length) = @_;
    
    return $bin->getBytes($length);
  
  
}


sub getImageGuts
{
  
  my ($bin,$length) = @_;
  
  my $end = $bin->where + $length;
  
  
  
  
  
  
  my $lfCount = 0;                
    
  my $guts = "\n\t----- dumping image details -----\n";
  
  
  
  while ($bin->where < $end)
  {
        if (($lfCount % 16) == 0){$guts .= "\n\t"}
        $lfCount += 1;
        $guts .= sprintf("%02x ", unpack("C",$bin->getBytes(1)));
        #$guts .= $bin->getBytes(1);
  }
  
  return $guts;
  
  
}


sub getRect
{
   my $bin = shift;
 
   my %rect;
   $bin->initBits();
   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 getShapeStyle
{
    my ($bin,$with_alpha) = @_;
    
    #my $i = 0;

    # Get the number of fills.
    my $nFills = unpack "C", $bin->getBytes(1);
    #print "\tnfills = $nFills\n";

    # Do we have a larger number?
    if ($nFills == 255)
    {
        # Get the larger number.
        $nFills = $bin->getWord;
    }

    my %style;
    

    
    $style{'nfills'} = $nFills;


    #Get each of the fill style.
    for (my $i = 1; $i <= $nFills; $i++)
    {
        my $fillStyle = unpack("C",$bin->getBytes(1));

       my %Gill;
       if ($fillStyle & $fillGradient) 
       {
           #print STDERR "DEBUG>>Gradient fill\n";
            $fill{'type'} = 'gradient';
            
            # Get the gradient matrix.
            
            my %matrix = %{getMatrix($bin)};

            # Get the number of colors.
            my $nColors = unpack "C", $bin->getBytes(1);
            
            $fill{'matrix'} = \%matrix;
            $fill{'ncolors'} = $nColors;
            
            #print "Gradient Colours = $nColors\n";
            #print "Gradient Matrix ...\n";
            #printf("\t[%5.3f   %5.3f]\n",  $matrix{'a'},  $matrix{'b'});
            #printf("\t[%5.3f   %5.3f]\n",  $matrix{'c'},  $matrix{'d'});
            #printf("\t[%5.3f   %5.3f]\n",  $matrix{'tx'}, $matrix{'ty'});
            #printf("%s\tGradient Fill with %u colors\n", str, nColors);



            # Get each of the colors.
            for ($j = 0; $j < $nColors; $j++)
            {
                my %colour;
                my $pos              = unpack "C", $bin->getBytes(1);
                my $rgba             = getColour($bin,$with_alpha);
                $colour{'pos'} =  $pos;
                $colour{'RGBA'} = sprintf("%06x",$rgba);
                $fill{"colour_$j"} = \%colour;
                
            }
            
            
       } elsif ($fillStyle & $fillBits) {
           
            $fill{'type'} = 'bitmap';
            my $uBitmapID = $bin->getWord;
            $fill{'uBitmapID'} = $uBitmapID;
            my %matrix = %{getMatrix($bin)};
            $fill{'matrix'} = \%matrix;
            
            
            
        
       } else {

            $fill{'type'} = 'solid';
         
            # A solid color
            my $rgba = getColour($bin,$with_alpha);
            $fill{"color"} = sprintf("%06x", $rgba);
            
           

       }
       $style{'fill_'.$i} = \%Gill;
    }


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

    # Do we have a larger number?
    if ($nLines == 255)
    {
        # Get the larger number.
        $nLines = $bin->getWord;
    }


    $style{'no_linestyles'} = $nLines;
    #printf("\tNumber of line styles \t%u\n", $nLines);

    # Get each of the line styles.
    for (my $i = 1; $i <= $nLines; $i++)
    {
        
        my $width = $bin->getWord;
        my $color = getColour($bin,$with_alpha);
    
        $style{"linestyle".$i} = sprintf("\tLine style %-5u width %G color RGB_HEX %06x\n", $i, $width/20, $color);
        #print $style{'linestyle'.$i}."\n";
    }
    

    return \%style;
    
}

sub getColour 
{
 
 my ($bin,$with_alpha) = @_;
 
 my $r = unpack"C", $bin->getBytes(1);
 my $g = unpack"C", $bin->getBytes(1);
 my $b = unpack"C", $bin->getBytes(1);
 my $a = 0xff;

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

 return ($a << 24) | ($r << 16) | ($g << 8) | $b;
 
}
  

  

sub parseDefineShape2
{
  
    my ($code,$length,$bin,$flash, $with_alpha) = @_;    
    parseDefineShape($code,$length,$bin,$flash, 0);
    
    return 1;
}


sub parseDefineShape3
{
    my ($code,$length,$bin,$flash, $with_alpha) = @_;    
    parseDefineShape($code,$length,$bin,$flash, 1);
    
    return 1;
}




sub parseDefineBitsLossless2
{
   my ($code,$length,$bin,$flash) = @_;
   parseDefineBitsLossless($code,$length,$bin,$flash,1);
   
   return 1;
}

sub parseDefineButton
{
    my ($code,$length,$bin,$flash) = @_;
 
    my $tagid = $bin->getWord;

    my $iButtonEnd = unpack("C",$bin->getBytes(1));
    
    my @buttonrecords;
    
    do{
        push @buttonrecords, parseButtonRecord($bin,$iButtonEnd, 0);
        $iButtonEnd = unpack("C",$bin->getBytes(1))
    }
    while ($iButtonEnd !=0 );

    #parse ACTIONRECORDs until ActionEndFlag
    #ParseDoAction(str, false);
    $flash->add_tag(type=>$code, tagid=>$tagid);
    
    return 1;
}


sub parseButtonRecord
{
    my ($bin,$iByte,$colour_matrix) = @_;
    my $iPad = $iByte >> 4;
    my $iButtonStateHitTest = ($iByte & 0x8);
    my $iButtonStateDown    = ($iByte & 0x4);
    my $iButtonStateOver    = ($iByte & 0x2);
    my $iButtonStateUp      = ($iByte & 0x1);

    my $iButtonCharacter = $bin->getWord;
    my $iButtonLayer     = $bin->getWord;

    
    printf STDERR ("\n\tParse Button Record: char:%d layer:%d ", $iButtonCharacter, $iButtonLayer);

    if ($iButtonStateHitTest != 0) { print STDERR "HIT "  }
    if ($iButtonStateDown != 0)    { print STDERR "DOWN " }
    if ($iButtonStateOver != 0)    { print STDERR "OVER " }
    if ($iButtonStateUp != 0)      { print STDERR "UP "   }
    print STDERR "\n";

    my %matrix = %{getMatrix($bin)};
    #PrintMatrix(matrix, str);

    if ($colour_matrix)
    {
        # nCharactersInButton always seems to be one
        my $nCharactersInButton = 1;

        for (my $i=0; $i<$nCharactersInButton; $i++)
        {
            my %cxform = %{getCxform($bin)};   # ??could be false here??
        }
    }
    
    return 1;
}





sub parseShapeRecord
{
  
    my ($bin, $xLast, $yLast, $nFillBits, $nLineBits) = @_;
    
    # Determine if this is an edge.
    my $isEdge = $bin->getBits(1);

    if (!$isEdge)
    {
        # Handle a state change
        my $flags = $bin->getBits(5);

        # Are we at the end?
        return (1,$xLast,$yLast) if ($flags == 0);
        
        #Process a move to.
        if ($flags & $eflagsMoveTo)
        {
            my $nBits = $bin->getBits(5);
            my $x =  $bin->getSBits($nBits);
            my $y =  $bin->getSBits($nBits);
            
            $xLast = $x;
            $yLast = $y;
            #printf("\n\txLast=%G\tyLast=%G\n",$x,$y);
            printf("\n\tmoveto: (%g,%g)\n", $xLast/20, $yLast/20);
        }
        # Get new fill info.
        if ($flags & $eflagsFill0)
        {
            my $i = $bin->getBits($nFillBits);
            printf("\tFillStyle0: %d (%d bits)\n", $i, $nFillBits);
        }
        if ($flags & $eflagsFill1)
        {
            my $i = $bin->getBits($nFillBits);
            printf("\tFillStyle1: %d (%d bits)\n", $i, $nFillBits);
        }
        # Get new line info
        if ($flags & $eflagsLine)
        {
            my $i = $bin->getBits($nLineBits);
            printf("\tLineStyle: %d\n", $i);
        }
        # Check to get a new set of styles for a new shape layer.
        if ($flags & $eflagsNewStyles)
        {
            printf("\tFound more Style info\n");
            
            # Parse the style.
            parseShapeStyle($with_alpha);

            # Reset.
            $nFillBits = $bin->getBits(4);
            $nLineBits = $bin->getBits(4);

            printf("\tnFillBits:%d  nLineBits:%d\n", $nFillBits, $nLineBits);
            return (0,$xLast,$yLast);
        }
        if ($flags & $eflagsEnd)
        {
            printf("\tEnd of shape.\n\n");
        }
  
        return ($flags & $eflagsEnd)? (1,$xLast,$yLast) : (0,$xLast,$yLast);
     }else {
        if ($bin->getBits(1))
        {
            # Handle a line
            my $nBits = $bin->getBits(4);   # nBits is biased by 2
            $nBits +=2;
            
            #Save the deltas
            if ($bin->getBits(1))
            {
                # Handle a general line.
                my $x = $bin->getSBits($nBits);
                my $y = $bin->getSBits($nBits);
                $xLast += $x;
                $yLast += $y;
                #printf("\n\txLast=%G\tyLast=%G\n",$xLast,$yLast);
                printf("\tlineto: (%g,%g).\n", ($xLast)/20, $yLast/20);
            }
            else
            {
                #Handle a vert or horiz line.
                if ($bin->getBits(1))
                {
                    # Vertical line
                    my $y = $bin->getSBits($nBits);
                    $yLast += $y;
                    #printf("\n\txLast=%G\tyLast=%G\n",$xLast,$yLast);
                    printf("\tvlineto: (%g,%g).\n", $xLast/20, $yLast/20);
                }
                else
                {
                    # Horizontal line
                    my $x = $bin->getSBits($nBits);
                    $xLast += $x;
                    #printf("\n\txLast=%G\tyLast=%G\n",$xLast,$yLast);
                    printf("\thlineto: (%g,%g).\n", $xLast/20, $yLast/20);
                }
            }
        }
        else
        {
            # Handle a curve
            my $nBits = $bin->getBits(4);   # nBits is biased by 2
            $nBits +=2;
            

            # Get the control
            my $cx = $bin->getSBits($nBits);
            my $cy = $bin->getSBits($nBits);
            $xLast += $cx;
            $yLast += $cy;
            #printf("\n\txLast=%G\tyLast=%G\n",$xLast,$yLast);
            printf("\tcurveto: (%g,%g)", ($xLast)/20, $yLast/20);

            # Get the anchor
            my $ax = $bin->getSBits($nBits);
            my $ay = $bin->getSBits($nBits);
            $xLast += $ax;
            $yLast += $ay;
            #printf("\n\txLast=%g\tyLast=%g\n",$xLast,$yLast);
            printf("(%G,%G)\n", $xLast/20, $yLast/20);
        }

        return (0,$xLast,$yLast);
    }
 
    
}


sub parseDefineShape
{
  
    my ($code,$length,$bin,$flash, $with_alpha) = @_;
    
    $with_alpha = 0 unless (defined $with_alpha);
    
    my $tagid = $bin->getWord;
    
   

    #Get the bounding rectangle
    my %rect = %{getRect($bin)};
    
    
    
    my %style = %{getShapeStyle($bin,$with_alpha)};

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

    my $nFillBits = $bin->getBits(4);
    my $nLineBits  = $bin->getBits(4);

    #printf("%sm_nFillBits:%d  m_nLineBits:%d\n", str, m_nFillBits, m_nLineBits);
     


    my $xLast = 0;
    my $yLast = 0;

    my $atEnd = 0;
    
    
    while (!$atEnd)
    {
        ($atEnd,$xLast,$yLast) = parseShapeRecord($bin, $xLast, $yLast,  $nFillBits, $nLineBits);
    }
    
    
     
    $flash->add_tag(type=>$code, tagid=>$tagid, style=>\%style, nFillBits=>$nFillBits, nLineBits=>$nLineBits);# rect=>\%rect);
    
    return 1;
    
}


sub parseDefineFont
{
    my ($code,$length,$bin,$flash) = @_;
  
    
    my $iFontID =  $bin->getWord;
    
    

    my $iStart = $bin->where;

    my $iOffset = $bin->getWord;
    #//printf("%s\tiOffset: 0x%04x\n", str, iOffset);

    my $iGlyphCount = $iOffset/2;
    $iGlyphCounts[$iFontID] = $iGlyphCount;
    #printf("%s\tnumber of glyphs: %d\n", str, iGlyphCount);

    
    $piOffsetTable[0] = $iOffset;

    for(my $n=1; $n<$iGlyphCount; $n++){
        $piOffsetTable[$n] = $bin->getWord;}
=pod
    for(my $n=0; $n<$iGlyphCount; $n++)
    {
        $bin->seekTo($piOffsetTable[$n] + $iStart);

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

        my $nFillBits = $bin->getBits(4);
        my $nLineBits = $bin->getBits(4);

        #printf("%s\tm_nFillBits:%d m_nLineBits:%d\n", str, m_nFillBits, m_nLineBits);

        my $xLast = 0;
        my $yLast = 0;

        my $fAtEnd = 0;

        print "---DEFINE FONT----------\n";
        while (!$fAtEnd)
        {
            ($fAtEnd,$xLast,$yLast) = parseShapeRecord($bin, $xLast, $yLast, $nFillBits, $nLineBits);
        }
    }
=cut
    $flash->add_tag(type=>$code, fontid=>$iFontID,  iGlyphCount=>$iGlyphCount,  iOffset=>$iOffset);
    
    return 1;
}

sub parseDefineFontInfo
{
    my ($code,$length,$bin,$flash) = @_;
    
    my $iFontID = $bin->getWord;
    
    #printf("%stagDefineFontInfo \tFont ID %-5u\n", str, iFontID);

    my $iNameLen = unpack("C",$bin->getBytes(1));    
    my $pszName  = $bin->getBytes($iNameLen);
    

    #printf("%s\tFontName: '%s'\n",str, pszName);

    #delete pszName;

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

    my $iGlyphCount = $iGlyphCounts[$iFontID];

   
    print "FONT STUFF\n";
    #printf("%s\t", str);
    for(my $n=0; $n < $iGlyphCount; $n++)
    {
        if ($flags & $fontWideCodes){
            $piCodeTable[$n] = $bin->getWord;
        }else{
            $piCodeTable[$n] = unpack "C",$bin->getBytes(1);
        }
        printf("[%d,'%c'] ", $piCodeTable[$n], $piCodeTable[$n]);
    }
    print "\n/FONT STUFF\n";
    #printf("\n\n");

    #delete piCodeTable;
    $flash->add_tag(type=>$code, fontid=>$iFontID,  iNameLen=>$iNameLen,  iGlyphCount=>$iGlyphCount, pszName=>$pszName);
    
    return 1;
}


sub parseDefineText
{
    my ($code,$length,$bin,$flash) = @_;
    
    my $tagid = $bin->getWord;
    

    my %rect = %{getRect($bin)};
    
    my %matrix = %{getMatrix($bin)};
    
    # for some reason we need to get an extra byte. I don't know why.
    $bin->getBytes(1);
    my $nGlyphBits   = unpack "C", $bin->getBytes(1);
    my $nAdvanceBits = unpack "C", $bin->getBytes(1);

    #printf("%s\tnGlyphBits:%d nAdvanceBits:%d\n", str, nGlyphBits, nAdvanceBits);

    print "\n\n---Text Record---\n";
    my $fContinue = 1;

    do{
        $fContinue = parseTextRecord($bin, $nGlyphBits, $nAdvanceBits);
    }while ($fContinue);
   print "\n\nend ---Text Record---\n";

   $flash->add_tag(type=>$code, tagid=>$tagid, rect=>\%rect, matrix=>\%matrix, nGlyphBits=>$nGlyphBits, nAdvanceBits=>$nAdvanceBits);
}



sub parseTextRecord
{
    my ($bin, $nGlyphBits, $nAdvanceBits) = @_;
    
    my $flags = unpack "C" , $bin->getBytes(1);
    return 0 if ($flags == 0);
    
    
    #printf("\n\tflags: 0x%02x\n",  $flags);

    if ($flags & $isTextControl)
    {
        if ($flags & $textHasFont)
        {
            my $fontId = $bin->getWord();
            printf("\tfontId: %d\n", $fontId);
        }
        if ($flags & $textHasColor)
        {
            my $r = unpack "C" ,$bin->getBytes(1);
            my $g = unpack "C" ,$bin->getBytes(1);
            my $b = unpack "C" ,$bin->getBytes(1);
            printf("\tfontColour: (%d,%d,%d)\n", $r, $g, $b);
        }
        if ($flags & $textHasXOffset)
        {
            my $iXOffset = $bin->getWord();
            printf("\tX-offset: %d\n", $iXOffset);
        }
        if ($flags & $textHasYOffset)
        {
            my $iYOffset = $bin->getWord();
            printf("\tY-offset: %d\n", $iYOffset);
        }
        if ($flags & $textHasFont)
        {
            my $iFontHeight = $bin->getWord();
            printf("\tFont Height: %d\n", $iFontHeight);
        }
    }
    else
    {
        my $iGlyphCount = $flags;
        printf("\tnumber of glyphs: %d\n",  $iGlyphCount);

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

        print "\t";
        for (my $g = 0; $g < $iGlyphCount; $g++)
        {
            my $iIndex   = $bin->getBits($nGlyphBits);
            my $iAdvance = $bin->getBits($nAdvanceBits);
            printf("[%d,%d] ", $iIndex, $iAdvance);
        }
        printf("\n");
    }

    return 1;
}


sub parseDefineText2
{
   my ($code,$length,$bin,$flash) = @_;
   
   my $tagid = $bin->getWord;

   $flash->add_tag(type=>$code, tagid=>$tagid);
   
   return 1;
}

sub parseNameCharacter
{
    my ($code,$length,$bin,$flash) = @_;
   
    my $tagid = $bin->getWord;
    my $label = getString($bin);
 
    $flash->add_tag(type=>$code, tagid=>$tagid, label=>$label);

    return 1;
}



sub parseProtect
{
  
    my ($code,$length,$bin,$flash) = @_;    
    $flash->add_tag(type=>$code);
    return 1;
}


sub parseDefineEditText
{
  
    my ($code,$length,$bin,$flash) = @_;    
   
    
    my %tag;
    my $tagid = $bin->getWord();
    my %rect = getRect($bin);
    
    $tag{'code'}  = $code;
    $tag{'tagid'} = $tagid;
    $tag{'rect'}  = \%rect;


    my $flags = $bin->getWord();

    

    if ($flags & $seditTextFlagsHasFont)
    {
        $tag{'uFontID'}     = $bin->getWord();
        $tag{'uFontHeight'} = $bin->getWordGetWord();                 
    }

    if ($flags & $seditTextFlagsHasTextColor)
    {
        $tag{'colour'} = sprintf("%06x",getColour($bin,1));
    }

    if ($flags & $seditTextFlagsHasMaxLength)
    {
        $tag{'iMaxLength'} = $bin->getWord();        
    }

    if ($flags & $seditTextFlagsHasLayout)
    {
        $tag{'iAlign'} = $bin->getByte();
        $tag{'uLeftMargin'} = $bin->getWord();
        $tag{'uRightMargin'} = $bin->etWord();
        $tag{'uIndent'} = $bin->etWord();
        $tag{'uLeading'} = $bin->etWord();
    }

    $tag{'pszVariable'} = getString($bin);
    

    if ($flags & $seditTextFlagsHasText )
    {
        $tag{'pszInitialText'} = getString($bin);        
    }

     $flash->add_tag(%tag);
     
     return 1;
}


sub parseDefineFont2
{
  
    my ($code,$length,$bin,$flash) = @_;   
    
    my %tag;
    
    $tag{'tagid'} = $bin->getWord();

    my $flags = $bin->getWord();

    # Skip the font name
    my $iNameLen = $bin->getByte();
    my @szFontName;
    for (my $i=0; $i<$iNameLen; $i++){
        $szFontName[$i] = $bin->getByte();}
    
    
    #Get the number of glyphs.
    $nGlyphs = $bin->getWord();
    $tag{'$nGlyphs'} = $nGlyphs;

    my $iDataPos = $bin->where;

    #printf("%stagDefineFont2 \ttagid %-5u flags:%04x nGlyphs:%d\n", str, tagid, flags, nGlyphs);

=pod
    if ($nGlyphs > 0)
    {
        
        # Get the FontOffsetTable
        

        
        for (my $n=0; $n<$nGlyphs; $n++)
            if ($flags & $sfontFlagsWideOffsets) }
                $puOffsetTable[$n] = $bin->getDWord();
            } else {
                $puOffsetTable[$n] = $bin->getWord();
            }

        
        # Get the CodeOffset
        

        my $iCodeOffset = 0;
        if ($flags & $sfontFlagsWideOffsets){
            $iCodeOffset = $bin->getDWord();
        }else{
            $iCodeOffset = $bin->getWord();
        }

        
        # Get the Glyphs
        

        for(my $n=0; $n<$nGlyphs; $n++)
        {
            
            
            #printf("\n\t%s>>> Glyph:%d", str, n);
            $bin->seekto($iDataPos + $puOffsetTable[$n]);

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

            my $m_nFillBits = unpack "C", $bin->getBits(4);
            my $m_nLineBits = unpack "C", $bin->getBits(4);

            my $xLast = 0;
            my $yLast = 0;

            my $fAtEnd = 0;

             while (!$fAtEnd)
             {
                ($fAtEnd,$xLast,$yLast) = parseShapeRecord($bin, $xLast, $yLast, $nFillBits, $nLineBits);
             }
        }

          @puOffsetTable = undef;


        if ($bin->where != $iDataPos + $iCodeOffset)
        {
            printf STDERR "Bad CodeOffset\n";
            return;
        }

        
        # Get the CodeTable
        
            
        $bin->seekto($iDataPos + $iCodeOffset);


        for (my $i=0; $i<$nGlyphs; $i++)
        {
            if ($flags & $sfontFlagsWideOffsets)
                printf("%02x:[%04x] ", i, GetWord());
            else
                printf("%02x:[%c] ", i, GetByte());

            if ((i & 7) == 7)
                printf("\n%s", str);
        }
        printf("\n");
    }
    

    if ($flags & $sfontFlagsHasLayout)
    {
        
        # Get "layout" fields
        

        S16 iAscent = GetWord();
        S16 iDescent = GetWord();
        S16 iLeading = GetWord();

        printf("\n%sHasLayout: iAscent:%d iDescent:%d iLeading:%d\n", str, iAscent, iDescent, iLeading);

        // Skip Advance table
        SkipBytes(nGlyphs * 2);


        // Get BoundsTable
        int i;
        for (i=0; i<nGlyphs; i++)
        {
            SRECT rBounds;
            GetRect(&rBounds);
            //printf("rBounds: (%d,%d)(%d,%d)\n", rBounds.xmin, rBounds.ymin, rBounds.xmax, rBounds.ymax);
        }

        //
        // Get Kerning Pairs
        //

        S16 iKerningCount = GetWord();
        printf("\n%sKerning Pair Count:%d\n", str, iKerningCount);
        for (i=0; i<iKerningCount; i++)
        {
            U16 iCode1, iCode2;
            if (flags & sfontFlagsWideOffsets)
            {
                iCode1 = GetWord();
                iCode2 = GetWord();
            }
            else
            {
                iCode1 = GetByte();
                iCode2 = GetByte();
            }
            S16 iAdjust = GetWord();

            printf("%sKerningPair:%-4d %c <--> %c : %d\n", str, i, iCode1, iCode2, iAdjust);
        }

        printf("m_tagEnd:%08x m_filePos:%08x\n", m_tagEnd, m_filePos);
    }
=cut    


    $flash->add_tag(%tag);

    return 1;
}

sub parseDefineSound
{
  
    my ($code,$length,$bin,$flash) = @_;   
    
    print STDERR "DefineSound\n";
    my %tag;
    $tag{'type'}  = $code;
    $tag{'tagid'} = $bin->getWord();

    
        
    my $iCompression = $bin->getBits(4);      # uncompressed, ADPCM or MP3
    my $iSampleRate  = $bin->getBits(2);
    my $iSampleSize  = $bin->getBits(1);
    my $iStereoMono  = $bin->getBits(1);
    my $iSampleCount = $bin->getDWord();


    my @ppszCompression  = qw(uncompressed ADPCM MP3);
    my @ppszSampleRate   = qw(5.5 11 22 44);
    my $pszSampleSize    = ($iSampleSize) ? 16 : 8;
    my $pszStereoMono    = ($iStereoMono) ? "stereo" : "mono";

    #printf("%s %skHz %s-bit %s NumberOfSamples:%d (%08x)\n",
    
    $tag{'Compression'} =  $ppszCompression[$iCompression];
    $tag{'SampleRate'}  =  $ppszSampleRate[$iSampleRate];
    $tag{'SampleSize'}  =  $pszSampleSize;
    $tag{'StereoMono'}  =  $pszStereoMono;
    $tag{'SampleCount'} =  $iSampleCount;  
        
    
=pod
    switch (iCompression)
    {
        case 0:
        {
            printf("%s  uncompressed samples\n", str);
            break;
        }
        case 1:
        {
            m_nSamplesAdpcm = 0;
            m_srcAdpcm = &m_fileBuf[m_filePos];
            AdpcmDecompress(iSampleCount, iStereoMono, iSampleSize);
            break;
        }
        case 2:
        {
            int iDelay = GetWord();
            printf("%s  MP3: delay:%d\n", str, iDelay);
            DecodeMp3Headers(str, iSampleCount);
            break;
        }
    }
=cut
    $flash->add_tag(%tag);
    return 1;
    
}
1;