#!/usr/bin/perl -w

use strict;
$|=1;
package SWFReader;

use IO::File;

sub newFile
{
    my $class= shift;
    my $filename= shift;
    my $fh= IO::File->new();
    $fh->open("< $filename") or die "$filename: $@\n";

    my $header;
    if ($fh->sysread($header, 8) != 8) {
        die "sysread: $@\n";
    }

    my ($signature, $version, $length)= unpack("A3CV", $header);
    print "sig=$signature ver=$version len=$length\n";
    my $body;
    if ($fh->sysread($body, $length-8) != $length-8) {
        die "sysread: $@\n";
    }
    if ($fh->tell() != -s "main.swf") {
        print " file has ", (-s "main.swf") - $fh->tell(), " bytes left\n";
    }
    $fh->close();


    my $self= bless {
        filename=>$filename,
        bytebuf=>$body,
        bytepos=>0,
        buflen=>$length-8,
        bitbuf=>0,
        bitpos=>0,
    }, $class;

    $self->{framesize}= $self->getRect();
    $self->{framerate}= $self->getWord()/256;
    $self->{framecount}= $self->getWord();

    print "fs=",rectAsString($self->{framesize})," rate=$self->{framerate} count=$self->{framecount}\n";

    for (my $i=0 ; $i<$self->{framecount} ; $i++) {
        push(@{$self->{frames}}, $self->getTag());
    }
    return $self;
}

sub rectAsString {
    my $rect= shift;
    return "[$rect->{xmin}..$rect->{xmax}]x[[$rect->{ymin}..$rect->{ymax}]";
}

sub newTag {
    my $class= shift;
    my $tag= shift;
    my $data= shift;

    print "tag $tag->{id} l=$tag->{length}\n";
    return bless {
        bytebuf=>$data,
        bytepos=>0,
        buflen=>length($data),
        bitbuf=>0,
        bitpos=>0,
        %{$tag},
    }, $class;
}

sub name {
    my $self= shift;
    if (exists $self->{filename}) {
        return "file $self->{filename}";
    }
    else {
        return "tag $self->{id}";
    }
}
# get nNeeded bits
sub getBits
{
    my $self= shift;
    my $nNeeded= shift;
    my $result=0;
    while (1) {
        my $bitsLeft= $nNeeded - $self->{bitpos};
        #print "getbits: needed=$nNeeded bitpos=$self->{bitpos} left=$bitsLeft buf=$self->{bitbuf} bytepos=$self->{bytepos}\n";
        if ($bitsLeft>0) {
            $result |= $self->{bitbuf} << $bitsLeft;
            $nNeeded -= $self->{bitpos};
            $self->{bitbuf} = $self->getByte();
            $self->{bitpos}= 8;
        }
        else {
            $result |= $self->{bitbuf} >> -$bitsLeft;
            $self->{bitpos} -= $nNeeded;
            $self->{bitbuf} &= 0xff >> (8 - $self->{bitpos});
            return $result;
        }
    }
}
sub getSBits {
    my $self= shift;
    my $nNeeded= shift;
    my $result= $self->getBits($nNeeded);

    if ($result & (1<<($nNeeded-1))) {
        $result |= -1 << $nNeeded;
    }
    return $result;
}
sub resetBitBuf {
    my $self= shift;
    $self->{bitpos}= 0;
    $self->{bitbuf}= 0;
}
# byte functions
sub getByte {
    my $self= shift;
    $self->resetBitBuf();

    if ($self->{bytepos} == $self->{buflen}) {
        warn "buffer overrun ", $self->name(), " : $self->{bytepos}\n";
    }
    my $byte= ord(substr($self->{bytebuf}, $self->{bytepos}++, 1));
    #print "getbyte [$self->{bytepos}] = $byte\n";

    return $byte;
}
sub getBytes {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getByte());
    }

    return \@data;
}
sub getSByte {
    my $self= shift;
    my $value= $self->getByte();
    if ($value&0x80) {
        $value -= 0x100;
    }
    return $value;
}
sub getSBytes {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getSByte());
    }

    return \@data;
}
# word functions
sub getWord {
    my $self= shift;
    my $lo= $self->getByte();
    my $hi= $self->getByte();
    return $lo | $hi<<8;
}
sub getWords {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getWord());
    }

    return \@data;
}
sub getSWord {
    my $self= shift;
    my $value= $self->getWord();
    if ($value&0x8000) {
        $value -= 0x10000;
    }
    return $value;
}
sub getSWords {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getSWord());
    }

    return \@data;
}
# dword functions
sub getDWord {
    my $self= shift;
    my $lo= $self->getWord();
    my $hi= $self->getWord();
    return $lo | $hi<<16;
}
sub getDWords {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getDWord());
    }

    return \@data;
}
sub getSDWord {
    my $self= shift;
    my $value= $self->getWord();
    if ($value&0x80000000) {
        $value -= 0x1000000000;
    }
    return $value;
}
sub getSDWords {
    my $self= shift;
    my $needed= shift;

    my @data;
    while ($needed--) {
        push (@data, $self->getSDWord());
    }

    return \@data;
}
# fixed point
sub getFixed {
    my $self= shift;
    return $self->getSDword()/0x10000;
}
# complex structs
sub getTag {
    my $self= shift;

    my $tag= {
        tagStart=>$self->{bytepos},
        parent=>$self,
    };

    my $tagidlengthword= $self->getWord();

    $tag->{id}= $tagidlengthword>>6;

    my $length= $tagidlengthword&0x3f;
    if ($length==0x3f) {
        $length= $self->getDWord();
    }
    $tag->{length}= $length;

    my $data= $self->getBytes($length);
    
    return SWFReader->newTag($tag, $data);
}

sub getString
{
    my $self= shift;
    my $string= "";
    while (my $char= $self->getByte()) {
        $string .= $char;
    }
    return $string;
}

# 7800 0566 8000 1144 00
# 01111
#   000.00000000.0000
#   0101.01100110.100  "010 1011 0011 0100" 0x2b34 twips = 553 pixels
#   00000.00000000.00
#   010001.01000100.0  "010 0010 1000 1000" 0x2288 twips = 442 pixels
#   0000000.

sub getRect
{
    my $self= shift;

    $self->resetBitBuf();

    my $rectsize= $self->getBits(5);

    my $xmin= $self->getSBits($rectsize)/20;
    my $xmax= $self->getSBits($rectsize)/20;
    my $ymin= $self->getSBits($rectsize)/20;
    my $ymax= $self->getSBits($rectsize)/20;
    #print "rs=$rectsize x=$xmin..$xmax y=$ymin..$ymax\n";
    return {xmin=>$xmin, xmax=>$xmax, ymin=>$ymin, ymax=>$ymax};
}

sub getMatrix {
    my $self= shift;

    $self->resetBitBuf();
    
    my $hasScale= $self->getBits(1);
    my $scaleX= 1;
    my $scaleY= 1;
    if ($hasScale) {
        my $nBits= $self->getBits(5);
        $scaleX= $self->getSBits($nBits)/0x10000;
        $scaleY= $self->getSBits($nBits)/0x10000;
    }
    my $hasRotate= $self->getBits(1);
    my $rotateSkew0=0;
    my $rotateSkew1=0;
    if ($hasRotate) {
        my $nBits= $self->getBits(5);
        $rotateSkew0= $self->getSBits($nBits)/0x10000;
        $rotateSkew1= $self->getSBits($nBits)/0x10000;
    }
    my $nBits= $self->getBits(5);
    my $translateX= $self->getSBits($nBits)/20;
    my $translateY= $self->getSBits($nBits)/20;

    return {
        scaleX=>$scaleX, scaleY=>$scaleY,
        rotateSkew0=>$rotateSkew0, rotateSkew1=>$rotateSkew1,
        translateX=>$translateX, translateY=>$translateY
    };
    # [ [scaleX, rotateSkew0], [rotateSkew1, scaleY], [translateX, translateY] ]
}

sub getRGB {
    my $self= shift;
    my $red= $self->getByte();
    my $green= $self->getByte();
    my $blue= $self->getByte();

    return {red=>$red, green=>$green, blue=>$blue};
}
sub getRGBA {
    my $self= shift;
    my $red= $self->getByte();
    my $green= $self->getByte();
    my $blue= $self->getByte();
    my $alpha= $self->getByte();

    return {red=>$red, green=>$green, blue=>$blue, alpha=>$alpha};
}

sub getCXForm {
    my $self= shift;

    my $hasAddTerms= $self->getBits(1);
    my $hasMultTerms= $self->getBits(1);
    my $nBits= $self->getBits(4);

    my $redMult= 1; my $greenMult= 1; my $blueMult= 1;
    if ($hasMultTerms)
    {
        $redMult= $self->getSBits($nBits)/256;
        $greenMult= $self->getSBits($nBits)/256;
        $blueMult= $self->getSBits($nBits)/256;
    }

    my $redAdd= 0; my $greenAdd= 0; my $blueAdd= 0;
    if ($hasAddTerms)
    {
        $redAdd= $self->getSBits($nBits);
        $greenAdd= $self->getSBits($nBits);
        $blueAdd= $self->getSBits($nBits);
    }
    return { 
        redAdd=>$redAdd,
        greenAdd=>$greenAdd,
        blueAdd=>$blueAdd,
        redMult=>$redMult,
        greenMult=>$greenMult,
        blueMult=>$blueMult,
    };
}
sub getCXFormAlpha {
    my $self= shift;

    my $hasAddTerms= $self->getBits(1);
    my $hasMultTerms= $self->getBits(1);
    my $nBits= $self->getBits(4);

    my $redMult= 1; my $greenMult= 1; my $blueMult= 1; my $alphaMult= 1;
    if ($hasMultTerms)
    {
        $redMult= $self->getSBits($nBits)/256;
        $greenMult= $self->getSBits($nBits)/256;
        $blueMult= $self->getSBits($nBits)/256;
        $alphaMult= $self->getSBits($nBits)/256;
    }

    my $redAdd= 0; my $greenAdd= 0; my $blueAdd= 0; my $alphaAdd= 0;
    if ($hasAddTerms)
    {
        $redAdd= $self->getSBits($nBits);
        $greenAdd= $self->getSBits($nBits);
        $blueAdd= $self->getSBits($nBits);
        $alphaAdd= $self->getSBits($nBits);
    }
    return { 
        redAdd=>$redAdd,
        greenAdd=>$greenAdd,
        blueAdd=>$blueAdd,
        alphaAdd=>$alphaAdd,
        redMult=>$redMult,
        greenMult=>$greenMult,
        blueMult=>$blueMult,
        alphaMult=>$alphaMult,
    };
}
package SWF;

sub new {
    my $class= shift;
    my $filename= shift;

    return bless {
        reader=> SWFReader->newFile($filename),
    }, $class;
}
    
package main;

my $swf= SWF->new("main.swf");