File Coverage

blib/lib/SWF/Element.pm

Criterion	Covered	Total	%
statement	566	2333	24.2
branch	116	634	18.3
condition	27	205	13.1
subroutine	94	316	29.7
pod	8	10	80.0
total	811	3498	23.1

package SWF::Element;

require 5.006;

use strict;
use vars qw($VERSION @ISA);

use Carp;
use SWF::BinStream;

$VERSION = '0.42';

sub new {
    my $class = shift;
    my $self = [];

    $class=ref($class)||$class;

    bless $self, $class;
    $self->_init;
    $self->configure(@_) if @_;
    $self;
}

sub clone {
    my $source = shift;
    croak "Can't clone a class" unless ref($source);
    my $f = 0;
    my @attr = map {($f=($f==0)||not ref($_)) ? $_ : $_->clone} $source->configure;
    $source->new(@attr);
}

sub new_element {
    my $self = shift;
    my $name = shift;
    my $element;

    eval {$element = $self->element_type($name)->new(@_)};
    croak $@ if $@;
    $element;
}

sub element_type {
    no strict 'refs';
    return ${(ref($_[0])||$_[0]).'::_Element_Types'}{$_[1]};
}

sub element_names {
    no strict 'refs';
    return @{(ref($_[0])||$_[0]).'::_Element_Names'};
}

sub configure {
    my ($self, @param)=@_;
    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY');

    if (@param==0) {
	my @names=$self->element_names;
	my @result=();
	my $key;
	for $key (@names) {
	    push @result, $key, $self->$key();
	}
	return @result;
    } elsif (@param==1) {
	my $key = $param[0];
	return $self->$key();
    } else {
	my ($key, $value);
	while (($key, $value) = splice(@param, 0, 2)) {
	    $self->$key($value);
	}
	return $self;
    }
}

sub defined {
    my $self = shift;
    my @names=$self->element_names;
    my $d;

    for my $key (@names) {
	if ($self->element_type($key) !~ /^\$(.*)$/) {
	    $d = $self->$key->defined;
	    last if $d;
	} else {
	    $d = defined $self->$key;
	    last if $d;
	}
    }
    return $d;
}

sub dumper {
    my ($self, $outputsub, $indent)=@_;
    my @names=$self->element_names;

    $indent ||= 0;
    $outputsub||=\&_default_output;

    &$outputsub(ref($self)."->new(\n", 0);
    for my $key (@names) {
	no warnings 'uninitialized';
	if ($self->element_type($key) =~/^\$/) {
	    my $p = $self->$key;
	    $p = "\"$p\"" unless $p=~/^[-\d.]+$/;
	    &$outputsub("$key => $p,\n", $indent+1) if defined($self->$key);
	} elsif ($self->$key->defined) {
	    &$outputsub("$key => ", $indent+1);
	    $self->$key->dumper($outputsub, $indent+1);
	    &$outputsub(",\n", 0);
	}
    }
    &$outputsub(")", $indent);
}

sub _default_output {print ' ' x ($_[1] * 4), $_[0]};

# _init, pack and unpack need to be overridden in the subclass.

sub _init {   # set attributes, parameters, etc.
}

sub pack {
  Carp::confess "Unexpected pack";
}

sub unpack {
  Carp::confess "Unexpected unpack";
}

sub _create_pack {
    my $classname = shift;
    my $u = shift||'';
    my $packsub = <
sub \{
    my \$self = shift;
    my \$stream = shift;
SUB_START
    my $unpacksub = $packsub;

    no strict 'refs';

    $classname = "SWF::Element::$classname";
    for my $key ($classname->element_names) {
	if ($classname->element_type($key) !~ /^\$(.*)$/) {
	    $packsub .= "\$self->$key->pack(\$stream, \@_);";
	    $unpacksub .= "\$self->$key->unpack(\$stream, \@_);";
	} else {
	    $packsub .= "\$stream->set_$1(\$self->$key);";
	    $unpacksub .= "\$self->$key(\$stream->get_$1);";
	}
    }
    $packsub .='}';
    $unpacksub .='}';
    *{"${classname}::${u}pack"} = eval($packsub) unless defined &{"${classname}::${u}pack"};
    *{"${classname}::${u}unpack"} = eval($unpacksub) unless defined &{"${classname}::${u}unpack"};
}

# Utility sub to create subclass.

sub _create_class {
    no strict 'refs';

    my $classname = shift;
    my $isa = shift;
    my $base = ((@_ % 2) ? pop : 0);

    $classname = "SWF::Element::$classname";

    my $element_names = \@{"${classname}::_Element_Names"};
    my $element_types = \%{"${classname}::_Element_Types"};

#    $isa = [$isa] unless ref($isa) eq 'ARRAY';
    @{"${classname}::ISA"}=map {$_ ? "SWF::Element::$_" : "SWF::Element"} @$isa;
    while (@_) {
	my $k = shift;
	my $v = shift;
	my $base1 = $base;
	push @$element_names, $k;

	if ($v !~ /^\$/) {
	    my $type = $element_types->{$k} = "SWF::Element::$v";
	    *{"${classname}::$k"} = sub {
		my $self = shift;
		if (@_) {
		    my $p = $_[0];
		    if (UNIVERSAL::isa($p, $type) or not defined $p) {
			$self->[$base1] = $p;
		    } else {
			$self->[$base1] = $type->new unless defined $self->[$base1];
			$self->[$base1]->configure(@_);
		    }
		} else {
		    $self->[$base1] = $type->new unless defined $self->[$base1];
		}
		$self->[$base1];
	    };
	} else {
	    $element_types->{$k} = $v;
	    *{"${classname}::$k"} = sub {
		my ($self, $data) = @_;
		$self->[$base1] = $data if @_>=2;
		$self->[$base1];
	    };
	}

	$base++;

    }
}

sub _create_flag_accessor {
    no strict 'refs';
    my ($name, $flagfield, $bit, $len) = @_;
    my $pkg = (caller)[0];

    $len ||=1;
    my $field = (((1<<$len) - 1)<<$bit);

    *{"${pkg}::$name"} = sub {
	my ($self, $set) = @_;
	my $flags = $self->$flagfield || 0;

	if (defined $set) {
	    $flags &= ~$field;
	    $flags |= ($set<<$bit);
	    $self->$flagfield($flags);
	}
	return (($flags & $field) >> $bit);
    }
}

# Create subclasses.

_create_class('ID', ['Scalar']);
_create_class('Depth', ['Scalar']);
_create_class('BinData', ['Scalar']);
_create_class('RGB', [''],
	      Red   => '$UI8',
	      Green => '$UI8',
	      Blue  => '$UI8');
_create_pack('RGB');
_create_class('RGBA', ['', 'RGB'],
	      Red   => '$UI8',
	      Green => '$UI8',
	      Blue  => '$UI8',
	      Alpha => '$UI8');
_create_pack('RGBA');
_create_class('RECT', [''],
	      Xmin => '$', Ymin => '$',
	      Xmax => '$', Ymax => '$');
_create_class('MATRIX', [''],
	      ScaleX      => '$', ScaleY      => '$',
	      RotateSkew0 => '$', RotateSkew1 => '$',
	      TranslateX  => '$', TranslateY  => '$');
_create_class('CXFORM', [''],
	      Flags         => '$',
	      RedMultTerm   => '$',
	      GreenMultTerm => '$',
	      BlueMultTerm  => '$',
	      RedAddTerm    => '$',
	      GreenAddTerm  => '$',
	      BlueAddTerm   => '$');
_create_class('CXFORMWITHALPHA', ['CXFORM'],
	      Flags         => '$',
	      RedMultTerm   => '$',
	      GreenMultTerm => '$',
	      BlueMultTerm  => '$',
	      AlphaMultTerm => '$',
	      RedAddTerm    => '$',
	      GreenAddTerm  => '$',
	      BlueAddTerm   => '$',
	      AlphaAddTerm  => '$');
_create_class('STRING', ['Scalar']);
_create_class('PSTRING', ['STRING']);
_create_class('FILLSTYLE1', [''],
	      FillStyleType  => '$UI8',
	      Color          => 'RGB',
	      GradientMatrix => 'MATRIX',
	      Gradient       => 'Array::GRADIENT1',
	      BitmapID       => 'ID',
	      BitmapMatrix   => 'MATRIX');
_create_class('FILLSTYLE3', ['FILLSTYLE1'],
	      FillStyleType  => '$UI8',
	      Color          => 'RGBA',
	      GradientMatrix => 'MATRIX',
	      Gradient       => 'Array::GRADIENT3',
	      BitmapID       => 'ID',
	      BitmapMatrix   => 'MATRIX');
_create_class('GRADRECORD1', [''],
	      Ratio => '$UI8',
	      Color => 'RGB');
_create_pack('GRADRECORD1');
_create_class('GRADRECORD3', ['GRADRECORD1'],
	      Ratio => '$UI8',
	      Color => 'RGBA');
_create_class('LINESTYLE1', [''],
	      Width => '$UI16',
	      Color => 'RGB');
_create_pack('LINESTYLE1');
_create_class('LINESTYLE3', ['LINESTYLE1'],
	      Width => '$UI16',
	      Color => 'RGBA');
_create_class('SHAPE', [''],
	      ShapeRecords => 'Array::SHAPERECORDARRAY1');
_create_class('SHAPEWITHSTYLE1', ['SHAPE'],
	      FillStyles   => 'Array::FILLSTYLEARRAY1',
	      LineStyles   => 'Array::LINESTYLEARRAY1',
	      ShapeRecords => 'Array::SHAPERECORDARRAY1');
_create_class('SHAPEWITHSTYLE2', ['SHAPEWITHSTYLE1'],
	      FillStyles   => 'Array::FILLSTYLEARRAY2',
	      LineStyles   => 'Array::LINESTYLEARRAY2',
	      ShapeRecords => 'Array::SHAPERECORDARRAY2');
_create_class('SHAPEWITHSTYLE3', ['SHAPEWITHSTYLE2'],
	      FillStyles   => 'Array::FILLSTYLEARRAY3',
	      LineStyles   => 'Array::LINESTYLEARRAY3',
	      ShapeRecords => 'Array::SHAPERECORDARRAY3');
_create_class('SHAPERECORD1', ['']);
_create_class('SHAPERECORD2', ['SHAPERECORD1']);
_create_class('SHAPERECORD3', ['SHAPERECORD2']);
_create_class('SHAPERECORD1::STYLECHANGERECORD', ['SHAPERECORD1'],
	      MoveDeltaX => '$',
	      MoveDeltaY => '$',
	      FillStyle0 => '$',
	      FillStyle1 => '$',
	      LineStyle  => '$' );
_create_class('SHAPERECORD2::STYLECHANGERECORD', ['SHAPERECORD1::STYLECHANGERECORD', 'SHAPERECORD2'],
	      MoveDeltaX => '$',
	      MoveDeltaY => '$',
	      FillStyle0 => '$',
	      FillStyle1 => '$',
	      LineStyle  => '$',
	      FillStyles => 'Array::FILLSTYLEARRAY2',
	      LineStyles => 'Array::LINESTYLEARRAY2');
_create_class('SHAPERECORD3::STYLECHANGERECORD', ['SHAPERECORD2::STYLECHANGERECORD', 'SHAPERECORD3'],
	      MoveDeltaX => '$',
	      MoveDeltaY => '$',
	      FillStyle0 => '$',
	      FillStyle1 => '$',
	      LineStyle  => '$',
	      FillStyles => 'Array::FILLSTYLEARRAY3',
	      LineStyles => 'Array::LINESTYLEARRAY3');
_create_class('SHAPERECORDn::STRAIGHTEDGERECORD', ['SHAPERECORD1', 'SHAPERECORD2', 'SHAPERECORD3'],
	      DeltaX => '$', DeltaY => '$');
_create_class('SHAPERECORDn::CURVEDEDGERECORD',  ['SHAPERECORD1', 'SHAPERECORD2', 'SHAPERECORD3'],
	      ControlDeltaX => '$', ControlDeltaY => '$',
	      AnchorDeltaX  => '$', AnchorDeltaY  => '$');
_create_class('Tag', ['']);
_create_class('Tag::Identified', ['Tag']);
_create_class('MORPHFILLSTYLE', [''],
	      FillStyleType       => '$UI8',
	      StartColor          => 'RGBA',
	      EndColor            => 'RGBA',
	      StartGradientMatrix => 'MATRIX',
	      EndGradientMatrix   => 'MATRIX',
	      Gradient            => 'Array::MORPHGRADIENT',
	      BitmapID            => 'ID',
	      StartBitmapMatrix   => 'MATRIX',
	      EndBitmapMatrix     => 'MATRIX');
_create_class('MORPHGRADRECORD', [''],
	      StartRatio => '$UI8', StartColor => 'RGBA',
	      EndRatio   => '$UI8', EndColor   => 'RGBA');
_create_pack('MORPHGRADRECORD');
_create_class('MORPHLINESTYLE', [''],
	      StartWidth => '$UI16', EndWidth => '$UI16',
	      StartColor => 'RGBA',  EndColor => 'RGBA');
_create_pack('MORPHLINESTYLE');
_create_class('BUTTONRECORD1', [''],
	      ButtonStates => '$UI8',
	      CharacterID  => 'ID',
	      PlaceDepth   => 'Depth',
	      PlaceMatrix  => 'MATRIX');
_create_class('BUTTONRECORD2', ['BUTTONRECORD1'],
	      ButtonStates   => '$UI8',
	      CharacterID    => 'ID',
	      PlaceDepth     => 'Depth',
	      PlaceMatrix    => 'MATRIX',
	      ColorTransform => 'CXFORMWITHALPHA');
_create_class('BUTTONCONDACTION', [''],
	      Condition => '$UI16', Actions => 'Array::ACTIONRECORDARRAY');
_create_pack('BUTTONCONDACTION');
_create_class('TEXTRECORD1', [''],
	      FontID     => 'ID',
	      TextColor  => 'RGB',
	      XOffset    => '$SI16',
	      YOffset    => '$SI16',
	      TextHeight => '$UI16',
	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
_create_class('TEXTRECORD2', ['TEXTRECORD1'],
	      FontID     => 'ID',
	      TextColor  => 'RGBA',
	      XOffset    => '$SI16',
	      YOffset    => '$SI16',
	      TextHeight => '$UI16',
	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
_create_class('TEXTRECORD::TYPE0', ['','TEXTRECORD1','TEXTRECORD2'],
	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
_create_pack('TEXTRECORD::TYPE0');
_create_class('GLYPHENTRY', [''],
	      GlyphIndex => '$', GlyphAdvance => '$');
_create_class('TEXTRECORD1::TYPE1', ['TEXTRECORD1'],
	      FontID     => 'ID',
	      TextColor  => 'RGB',
	      XOffset    => '$SI16',
	      YOffset    => '$SI16',
	      TextHeight => '$UI16');
_create_class('TEXTRECORD2::TYPE1', ['TEXTRECORD1::TYPE1', 'TEXTRECORD2'],
	      FontID     => 'ID',
	      TextColor  => 'RGBA',
	      XOffset    => '$SI16',
	      YOffset    => '$SI16',
	      TextHeight => '$UI16');
_create_class('SOUNDINFO', [''],
	      SyncFlags       => '$',
	      InPoint         => '$UI32',
	      OutPoint        => '$UI32',
	      LoopCount       => '$UI16',
	      EnvelopeRecords => 'Array::SOUNDENVELOPEARRAY');
_create_class('SOUNDENVELOPE', [''],
	      Pos44 => '$UI32', LeftLevel => '$UI16', RightLevel => '$UI16');
_create_pack('SOUNDENVELOPE');
_create_class('ACTIONTagNumber', ['Scalar']);
_create_class('ACTIONRECORD', [''],
	      Tag        => 'ACTIONTagNumber',
	      LocalLabel => '$');
_create_class('ACTIONDATA', ['Scalar']);
_create_class('ACTIONDATA::String', ['ACTIONDATA']);
_create_class('ACTIONDATA::Property', ['ACTIONDATA']);
_create_class('ACTIONDATA::NULL', ['ACTIONDATA']);
_create_class('ACTIONDATA::UNDEF', ['ACTIONDATA']);
_create_class('ACTIONDATA::Register', ['ACTIONDATA']);
_create_class('ACTIONDATA::Boolean', ['ACTIONDATA']);
_create_class('ACTIONDATA::Double', ['ACTIONDATA']);
_create_class('ACTIONDATA::Integer', ['ACTIONDATA']);
_create_class('ACTIONDATA::Lookup', ['ACTIONDATA']);
_create_class('CLIPACTIONRECORD', [''],
	      EventFlags   => '$',
	      KeyCode      => '$UI8',
	      Actions      => 'Array::ACTIONRECORDARRAY');
_create_class('ASSET', [''],
	      ID     => 'ID',
	      Name   => 'STRING');
_create_pack('ASSET');
_create_class('REGISTERPARAM', [''],
	      Register  => '$UI8',
	      ParamName => 'STRING');
_create_pack('REGISTERPARAM');

##########

package SWF::Element::Scalar;

use overload
    '""' => \&value,
    '0+' => \&value,
    '++' => sub {${$_[0]}++},
    '--' => sub {${$_[0]}--},
    '='  => \&clone,
    fallback =>1,
    ;
@SWF::Element::Scalar::ISA = ('SWF::Element');

sub new {
    my $class = shift;
    my ($self, $data);

    $self = \$data;
    bless $self, ref($class)||$class;
    $self->_init;
    $self->configure(@_) if @_;
    $self;
}

sub clone {
    my $self = shift;
    Carp::croak "Can't clone a class" unless ref($self);
    my $new = $self->new($self->value);
}

sub configure {
    my ($self, $newval)=@_;
#    Carp::croak "Can't set $newval in ".ref($self) unless $newval=~/^[\d.]*$/;
    unless (ref($newval)) {
	$$self = $newval;
    } elsif (eval{$newval->isa('SWF::Element::Scalar')}) {
	$$self = $newval->value;
    }
    $self;
}
sub value {
    ${$_[0]};
}

sub defined {
    defined ${$_[0]};
}

# 'pack' and 'unpack' should be overridden in the subclass or
# the owner class is responsible for packing/unpacking THIS.

sub pack {
    Carp::croak "'pack' should be overridden in ".ref($_[0]);
}

sub unpack {
    Carp::croak "'unpack' should be overridden in ".ref($_[0]);
}

sub dumper {
    my ($self, $outputsub)=@_;

    $outputsub||=\&SWF::Element::_default_output;

    &$outputsub($self->value, 0);
}

sub _init {}


##########

package SWF::Element::ID;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI16($self->value);
}

sub unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_UI16);
}

##########

package SWF::Element::Depth;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI16($self->value);
}

sub unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_UI16);
}

##########

package SWF::Element::Array;

sub new {
    my $class = shift;
    my $self = [];

    bless $self, ref($class)||$class;
    $self->_init;
    $self->configure(@_) if @_;

    $self;
}

sub configure {
    my ($self, @param)=@_;
    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY' and ref($param[0][0]));
    for my $p (@param) {
	my $element = $self->new_element;
	if (UNIVERSAL::isa($p, ref($element)) or not defined $p) {
	    $element = $p;
	} elsif (ref($p) eq 'ARRAY') {
	    $element->configure($p);
	} else {
#	  Carp::croak "Element type mismatch: ".ref($p)." in ".ref($self);
	  Carp::confess "Element type mismatch: ".ref($p)." in ".ref($self);
	}
	push @$self, $element;
    }
    $self;
}

sub clone {
    my $self = $_[0];
    die "Can't clone a class" unless ref($self);
    my $new = $self->new;
    for my $i (@$self) {
	push @$new, $i->clone;
    }
    $new;
}

sub pack {
    my $self = shift;

    for my $element (@$self) {
	$element->pack(@_);
    }
    $self->last(@_);
}

sub unpack {
    my $self = shift;
    {
	my $element = $self->new_element;
	$element->unpack(@_);
	last if $self->is_last($element);
	push @$self, $element;
	redo;
    }
}

sub defined {
    return @{shift()} > 0;
}

sub dumper {
    my ($self, $outputsub, $indent) = @_;

    $indent ||= 0;
    $outputsub||=\&SWF::Element::_default_output;

    &$outputsub(ref($self)."->new([\n", 0);
    my $n = 0;
    for my $i (@$self) {
	&$outputsub('', $indent+1);
	$i->dumper($outputsub, $indent+1);
	&$outputsub(",\t\t\t# $n\n", 0);
	$n++;
    }
    &$outputsub("])", $indent);
}

sub _init {
    my $self = shift;

    for my $element (@$self) {
	last unless ref($element) eq '' or  ref($element) eq 'ARRAY';
	my $new = $self->new_element;
	last unless ref($new);
	$new->configure($element);
	$element = $new;
    }
}

sub new_element {}
sub is_last {0}
sub last {};

sub _create_array_class {
    no strict 'refs';
    my ($classname, $isa, $newelement, $last, $is_last)=@_;

    $classname = "Array::$classname";
    SWF::Element::_create_class($classname, $isa);

    $classname = "SWF::Element::$classname";
    if ($newelement) {
	$newelement = "SWF::Element::$newelement";
	*{"${classname}::new_element"} = sub {shift; $newelement->new(@_)};
    }
    *{"${classname}::last"} = $last if $last;
    *{"${classname}::is_last"} = $is_last if $is_last;
}

_create_array_class('FILLSTYLEARRAY1', ['Array1'], 'FILLSTYLE1');
_create_array_class('FILLSTYLEARRAY2', ['Array2', 'Array::FILLSTYLEARRAY1'], 'FILLSTYLE1');
_create_array_class('FILLSTYLEARRAY3', ['Array::FILLSTYLEARRAY2'],'FILLSTYLE3');
_create_array_class('GRADIENT1',       ['Array1'], 'GRADRECORD1');
_create_array_class('GRADIENT3',       ['Array::GRADIENT1'], 'GRADRECORD3');
_create_array_class('LINESTYLEARRAY1', ['Array1'], 'LINESTYLE1');
_create_array_class('LINESTYLEARRAY2', ['Array2', 'Array::LINESTYLEARRAY1'], 'LINESTYLE1');
_create_array_class('LINESTYLEARRAY3', ['Array::LINESTYLEARRAY2'], 'LINESTYLE3');
_create_array_class('SHAPERECORDARRAY1',  ['Array'],  'SHAPERECORD1',
		    sub {$_[1]->set_bits(0,6)},
                    sub {$_[1]->isa('SWF::Element::SHAPERECORDn::ENDSHAPERECORD')});

_create_array_class('SHAPERECORDARRAY2', ['Array::SHAPERECORDARRAY1'], 'SHAPERECORD2');
_create_array_class('SHAPERECORDARRAY3', ['Array::SHAPERECORDARRAY2'], 'SHAPERECORD3');
_create_array_class('MORPHFILLSTYLEARRAY', ['Array2'],    'MORPHFILLSTYLE');
_create_array_class('MORPHLINESTYLEARRAY', ['Array2'],    'MORPHLINESTYLE');
_create_array_class('MORPHGRADIENT',       ['Array1'],    'MORPHGRADRECORD');
_create_array_class('BUTTONRECORDARRAY1',  ['Array'],     'BUTTONRECORD1',
                     sub {$_[1]->set_UI8(0)},
                     sub {$_[1]->ButtonStates == 0});

_create_array_class('BUTTONRECORDARRAY2', ['Array::BUTTONRECORDARRAY1'], 'BUTTONRECORD2');
_create_array_class('BUTTONCONDACTIONARRAY', ['Array'], 'BUTTONCONDACTION');
_create_array_class('GLYPHSHAPEARRAY1',          ['Array'], 'SHAPE');
_create_array_class('GLYPHSHAPEARRAY2',          ['Array'], 'SHAPE');
_create_array_class('CODETABLE',            ['Array::Scalar']);
_create_array_class('FONTADVANCETABLE',     ['Array::Scalar']);
_create_array_class('FONTBOUNDSTABLE',      ['Array'], 'RECT', sub {});
_create_array_class('TEXTRECORDARRAY1',     ['Array'], 'TEXTRECORD1',
                    sub {$_[1]->set_UI8(0)},
                    sub {$_[1]->isa('SWF::Element::TEXTRECORD::End')});

_create_array_class('TEXTRECORDARRAY2',   ['Array::TEXTRECORDARRAY1'], 'TEXTRECORD2');
_create_array_class('GLYPHENTRYARRAY',    ['Array1'], 'GLYPHENTRY');
_create_array_class('SOUNDENVELOPEARRAY', ['Array1'], 'SOUNDENVELOPE');
_create_array_class('ACTIONRECORDARRAY',  ['Array'],  'ACTIONRECORD',
                    sub {$_[1]->set_UI8(0)},
                    sub {$_[1]->Tag == 0});
_create_array_class('ACTIONDATAARRAY', ['Array'],  'ACTIONDATA',
                    sub {});
_create_array_class('STRINGARRAY',     ['Array3'], 'STRING');
_create_array_class('CLIPACTIONRECORDARRAY', ['Array'],  'CLIPACTIONRECORD',
                    sub {$_[1]->set_UI32(0)},
                    sub {$_[1]->EventFlags == 0});
_create_array_class('ASSETARRAY',      ['Array3'], 'ASSET');
_create_array_class('TAGARRAY',        ['Array'],  'Tag',
                    sub {},
                    sub {$_[1]->tag_name eq 'End' && ((push @{$_[0]}, $_[1]),1)});
_create_array_class('REGISTERPARAMARRAY', ['Array'], 'REGISTERPARAM',
                    sub {});

##########

package SWF::Element::Array::Scalar;

@SWF::Element::Array::Scalar::ISA=qw(SWF::Element::Array);

sub configure {
    my $self = shift;

    if (ref($_[0]) eq 'ARRAY') {
	push @$self, @{$_[0]};
    } else {
	push @$self, @_;
    }
    $self;
}

sub clone {
    my $self = $_[0];
    die "Can't clone a class" unless ref($self);
    $self->new(@$self);
}

sub dumper {
    my ($self, $outputsub, $indent) = @_;
    my @data;

    &$outputsub(ref($self)."->new([\n", 0);
    for (my $i = 0; $i < @$self; $i+=8) {
	my @data = @$self[$i..($i+7 > $#$self ? $#$self : $i+7)];
	&$outputsub(sprintf("%5d,"x@data."\n", @data), 0);
    }
    &$outputsub("])", $indent);
}

##########

package SWF::Element::Array1;
use vars qw(@ISA);

@ISA=qw(SWF::Element::Array);

sub pack {
    my $self = shift;
    my $count = @$self;

    $_[0]->set_UI8($count);
    $self->_pack(@_);
}

sub _pack {
    my $self = shift;

    for my $element (@$self) {
	$element->pack(@_);
    }
}


sub unpack {
    my $self = shift;

    $self->_unpack($_[0]->get_UI8, @_);
}

sub _unpack {
    my $self = shift;
    my $count = shift;

    while (--$count>=0) {
	my $element = $self->new_element;
	$element->unpack(@_);
	push @$self, $element;
    }
}

##########

package SWF::Element::Array2;
use vars qw(@ISA);

@ISA=qw(SWF::Element::Array1);

sub pack {
    my $self=shift;
    my $stream=$_[0];
    my $count=@$self;

    if ($count>254) {
	$stream->set_UI8(0xFF);
	$stream->set_UI16($count);
    } else {
	$stream->set_UI8($count);
    }
    $self->_pack(@_);
}

sub unpack {
    my $self=shift;
    my $stream=$_[0];
    my $count=$stream->get_UI8;

    $count=$stream->get_UI16 if $count==0xFF;

    $self->_unpack($count, @_);
}

##########

package SWF::Element::Array3;
use vars qw(@ISA);

@ISA=qw(SWF::Element::Array1);

sub unpack {
    my $self = shift;

    $self->_unpack($_[0]->get_UI16, @_);
}

sub pack {
    my $self = shift;

    $_[0]->set_UI16(scalar @$self);
    $self->_pack(@_);
}

##########

package SWF::Element::Array::STRINGARRAY;

sub configure {
    my ($self, @param)=@_;
    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY');
    for my $p (@param) {
	my $element = $self->new_element;
	if (UNIVERSAL::isa($p, ref($element)) or not defined $p) {
	    $element = $p;
	} elsif (ref($p) eq '') {
	    $element->configure($p);
	} else {
	  Carp::croak "Element type mismatch: ".ref($p)." in ".ref($self);
	}
	push @$self, $element;
    }
    $self;
}

##########

package SWF::Element::RECT;

sub pack {
    my ($self, $stream)=@_;
    $stream->flush_bits;
    $stream->set_sbits_list(5, $self->Xmin, $self->Xmax, $self->Ymin, $self->Ymax);
}

sub unpack {
    my ($self, $stream)=@_;
    $stream->flush_bits;
    my $nbits=$stream->get_bits(5);

    for my $i(qw/Xmin Xmax Ymin Ymax/) {
	$self->$i($stream->get_sbits($nbits));
    }
}

##########

package SWF::Element::MATRIX;

sub _init {
    my $self = shift;
    $self->ScaleX(1);
    $self->ScaleY(1);
    $self->RotateSkew0(0);
    $self->RotateSkew1(0);
}

sub pack {
    my ($self, $stream)=@_;

    $stream->flush_bits;
    if ($self->ScaleX != 1 or $self->ScaleY != 1) {
	$stream->set_bits(1,1);
	$stream->set_sbits_list(5, $self->ScaleX * 65536, $self->ScaleY * 65536);
    } else {
	$stream->set_bits(0,1);
    }
    if ($self->RotateSkew0 != 0 or $self->RotateSkew1 != 0) {
	$stream->set_bits(1,1);
	$stream->set_sbits_list(5, $self->RotateSkew0 * 65536, $self->RotateSkew1 * 65536);
    } else {
	$stream->set_bits(0,1);
    }
	$stream->set_sbits_list(5, $self->TranslateX, $self->TranslateY);
}

sub unpack {
    my ($self, $stream)=@_;
    my ($hasscale, $hasrotate);

    $stream->flush_bits;
    if ($hasscale = $stream->get_bits(1)) {
	my $nbits=$stream->get_bits(5);
#	$nbits = 32 if $nbits == 0; # ???
	$self->ScaleX($stream->get_sbits($nbits) / 65536);
	$self->ScaleY($stream->get_sbits($nbits) / 65536);
    } else {
	$self->ScaleX(1);
	$self->ScaleY(1);
    }
    if ($hasrotate = $stream->get_bits(1)) {
	my $nbits=$stream->get_bits(5);
#	$nbits = 32 if $nbits == 0; # ???
	$self->RotateSkew0($stream->get_sbits($nbits) / 65536);
	$self->RotateSkew1($stream->get_sbits($nbits) / 65536);
    } else {
	$self->RotateSkew0(0);
	$self->RotateSkew1(0);
    }
    my $nbits=$stream->get_bits(5);
#    my $scalex = $self->ScaleX;
#    $nbits = 32 if $nbits == 0 and ($scalex == 0 or $scalex >= 16383.99998474 or $scalex <= -16383.99998474); # ???
    $self->TranslateX($stream->get_sbits($nbits));
    $self->TranslateY($stream->get_sbits($nbits));
}

sub defined {
    my $self = shift;

    return (defined($self->TranslateX) or defined($self->TranslateY) or
	    $self->ScaleX      != 1    or $self->ScaleY      != 1 or
	    $self->RotateSkew0 != 0    or $self->RotateSkew1 != 0);
}

sub scale {
    my ($self, $xscale, $yscale)=@_;
    $yscale=$xscale unless defined $yscale;

    $self->ScaleX($self->ScaleX * $xscale);
    $self->RotateSkew0($self->RotateSkew0 * $xscale);
    $self->ScaleY($self->ScaleY * $yscale);
    $self->RotateSkew1($self->RotateSkew1 * $yscale);
    $self;
}

sub moveto {
    my ($self, $x, $y)=@_;
    $self->TranslateX($x);
    $self->TranslateY($y);
    $self;
}

sub rotate {
    my ($self, $degree)=@_;
    $degree = $degree*3.14159265358979/180;
    my $sin = sin($degree);
    my $cos = cos($degree);
    my $a = $self->ScaleX;
    my $b = $self->RotateSkew0;
    my $c = $self->RotateSkew1;
    my $d = $self->ScaleY;
    $self->ScaleX($a*$cos-$b*$sin);
    $self->RotateSkew0($a*$sin+$b*$cos);
    $self->RotateSkew1($c*$cos-$d*$sin);
    $self->ScaleY($c*$sin+$d*$cos);

    $self;
}

##########

package SWF::Element::CXFORM;

sub pack {
    my ($self, $stream)=@_;
    my @param = map $self->$_, $self->element_names;
    shift @param;
    my $half  = @param>>1;
    my @mult   = @param[0..$half-1];
    my @add  = @param[$half..$#param];

    $stream->flush_bits;
    if (grep defined $_, @add) {
	$stream->set_bits(1,1);
    } else {
	$stream->set_bits(0,1);
	@add = ();
    }
    if (grep defined $_, @mult) {
	$stream->set_bits(1,1);
    } else {
	$stream->set_bits(0,1);
	@mult = ();
    }
    $stream->set_sbits_list(4, @mult, @add) if @add or @mult;
}

sub unpack {
    my ($self, $stream)=@_;

    $stream->flush_bits;
    my $hasAdd  = $stream->get_bits(1);
    my $hasMult = $stream->get_bits(1);

    $self->Flags($hasAdd | ($hasMult<<1));

    my $nbits = $stream->get_bits(4);
    my @names = $self->element_names;
    shift @names;
    my $half = @names>>1;

    if ($hasMult) {
	for my $i (@names[0..$half-1]) {
	    $self->$i($stream->get_sbits($nbits));
	}
    }
    if ($hasAdd) {
	for my $i (@names[$half..$#names]) {
	    $self->$i($stream->get_sbits($nbits));
	}
    }
}

SWF::Element::_create_flag_accessor('HasAddTerms', 'Flags', 0);
SWF::Element::_create_flag_accessor('HasMultTerms', 'Flags', 1);

##########

package SWF::Element::BinData;

use Data::TemporaryBag;

sub _init {
    my $self = shift;

    $$self = Data::TemporaryBag->new;
}

sub configure {
    my ($self, $newval) = @_;

    if (ref($newval)) {
	if ($newval->isa('Data::TemporaryBag')) {
	    $$self = $newval->clone;
	} elsif ($newval->isa('SWF::Element::BinData')) {
	    $self = $newval->clone;
	} else {
	  Carp::croak "Can't set ".ref($newval)." in ".ref($self);
	}
    } else {
	$$self = Data::TemporaryBag->new($newval) if defined $newval;
    }
    $self;
}

sub clone {
    my $self = shift;

    $self->new($$self);
}

for my $sub (qw/substr value defined/) {
    no strict 'refs';
    *{"SWF::Element::BinData::$sub"} = sub {
	my $self=shift;
	$$self->$sub(@_);
    };
}

sub add {
    my $self = shift;

    $$self->add(@_);
    $self;
}

sub Length {
    $ {$_[0]}->length;
}

sub pack {
    my ($self, $stream)=@_;
    my $size = $self->Length;
    my $pos = 0;

    while ($size > $pos) {
	$stream->set_string($self->substr($pos, 1024));
	$pos += 1024;
    }
}

sub unpack {
    my ($self, $stream, $len)=@_;

    while ($len > 0) {
	my $size = ($len > 1024) ? 1024 : $len;
	$self->add($stream->get_string($size));
	$len -= $size;
    }
}

sub save {
    my ($self, $file) = @_;
    no strict 'refs';  # so that a symbol ref as $file works
    local(*F);
    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	open(F, "> $file") or die "Can't open $file: $!";
	$file = *F;
    }
    binmode($file);
    my $stream = SWF::BinStream::Write->new;
    $stream->autoflush(1000, sub {print $file $_[1]});
    $self->pack($stream);
    print $file $stream->flush_stream;
    close $file;
}

sub load {
    my($self, $file) = @_;
    no strict 'refs';  # so that a symbol ref as $file works
    local(*F);
    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
	# Assume $file is a filename
	open(F, $file) or die "Can't open $file: $!";
	$file = *F;
    }
    binmode($file);
    my $size = (stat $file)[7];
    my $stream = SWF::BinStream::Read->new('', sub {my $data; read $file, $data, 1000; $_[0]->add_stream($data)});
    $self->unpack($stream, $size);
    close $file;
}

{
    my $label = 'A';

    sub dumper {
	my ($self, $outputsub, $indent) = @_;

	$indent ||= 0;
	$outputsub||=\&SWF::Element::_default_output;

	&$outputsub(ref($self)."->new\n", 0);

	my $size = $self->Length;
	my $pos = 0;

	while ($size > $pos) {
	    my $data = CORE::pack('u', $self->substr($pos, 1024));
	    &$outputsub("->add(unpack('u', <<'$label'))\n$data$label\n", $indent+1);
	    $pos += 1024;
	    $label++;
	}
    }
}

##########

package SWF::Element::STRING;

sub pack {
    my ($self, $stream)=@_;
    $stream->set_string($self->value."\0");
}

sub unpack {
    my ($self, $stream)=@_;
    my $str='';
    my $char;
    $str.=$char while (($char = $stream->get_string(1)) ne "\0");
    $self->configure($str);
}

sub dumper {
    my ($self, $outputsub)=@_;
    my $data = $self->value;

    $data =~ s/([\\\$\@\"])/\\$1/gs;
    $data =~ s/([\x00-\x1F\x80-\xFF])/sprintf('\\x%.2X', ord($1))/ges;
    $outputsub||=\&SWF::Element::_default_output;

    &$outputsub("\"$data\"", 0);
}

##########

package SWF::Element::PSTRING;

sub pack {
    my ($self, $stream)=@_;
    my $str = $self->value;

    $stream->set_UI8(length($str));
    $stream->set_string($str);
}

sub unpack {
    my ($self, $stream)=@_;
    my $len = $stream->get_UI8;

    $self->configure($stream->get_string($len));
}

##########

package SWF::Element::FILLSTYLE1;

sub pack {
    my ($self, $stream)=@_;
    my $style=$self->FillStyleType;
    $stream->set_UI8($style);
    if ($style==0x00) {
	$self->Color->pack($stream);
    } elsif ($style==0x10 or $style==0x12) {
	$self->GradientMatrix->pack($stream);
	$self->Gradient->pack($stream);
    } elsif ($style>=0x40 or $style<=0x43) {
	$self->BitmapID->pack($stream);
	$self->BitmapMatrix->pack($stream);
    }
}

sub unpack {
    my ($self, $stream)=@_;
    my $style = $self->FillStyleType($stream->get_UI8);
    if ($style==0x00) {
	$self->Color->unpack($stream);
    } elsif ($style==0x10 or $style==0x12) {
	$self->GradientMatrix->unpack($stream);
	$self->Gradient->unpack($stream);
    } elsif ($style>=0x40 or $style<=0x43) {
	$self->BitmapID->unpack($stream);
	$self->BitmapMatrix->unpack($stream);
    }
}

##########

package SWF::Element::SHAPE;

sub pack {
    my ($self, $stream, $nfillbits, $nlinebits)=@_;
#    my ($fillidx, $lineidx)=(-1,-1);

    $stream->flush_bits;

=begin possible_unnecessary

    for my $shaperec (@{$self->ShapeRecords}) {
	next unless $shaperec->isa('SWF::Element::SHAPERECORD1::STYLECHANGERECORD');
	my $style;
	$style   = $shaperec->FillStyle0;
	$fillidx = $style if (defined $style and $fillidx < $style);
	$style   = $shaperec->FillStyle1;
	$fillidx = $style if (defined $style and $fillidx < $style);
	$style   = $shaperec->LineStyle;
	$lineidx = $style if (defined $style and $lineidx < $style);
    }
    if ($fillidx>=0) {
	$nfillbits=1;
	$nfillbits++ while ($fillidx>=(1<<$nfillbits));
    } else {
	$nfillbits=0;
    }
    if ($lineidx>=0) {
	$nlinebits=1;
	$nlinebits++ while ($lineidx>=(1<<$nlinebits));
    } else {
	$nlinebits=0;
    }

=end possible_unnecessary

=cut

    $stream->set_bits($nfillbits, 4);
    $stream->set_bits($nlinebits, 4);

    $self->ShapeRecords->pack($stream, \$nfillbits, \$nlinebits);
}

sub unpack {
    my ($self, $stream)=@_;
    my ($nfillbits, $nlinebits);

    $stream->flush_bits;
    $nfillbits=$stream->get_bits(4);
    $nlinebits=$stream->get_bits(4);

    $self->ShapeRecords->unpack($stream, \$nfillbits, \$nlinebits);
}

##########

package SWF::Element::SHAPEWITHSTYLE1;

sub pack {
    my ($self, $stream)=@_;
    my ($fillidx, $lineidx)=($#{$self->FillStyles}+1, $#{$self->LineStyles}+1);
    my ($nfillbits, $nlinebits)=(0,0);

    $self->FillStyles->pack($stream);
    $self->LineStyles->pack($stream);

    if ($fillidx>0) {
	$nfillbits=1;
	$nfillbits++ while ($fillidx>=(1<<$nfillbits));
    } else {
	$nfillbits=0;
    }
    if ($lineidx>0) {
	$nlinebits=1;
	$nlinebits++ while ($lineidx>=(1<<$nlinebits));
    } else {
	$nlinebits=0;
    }

    $stream->flush_bits;
    $stream->set_bits($nfillbits, 4);
    $stream->set_bits($nlinebits, 4);

    $self->ShapeRecords->pack($stream, \$nfillbits, \$nlinebits);
}

sub unpack {
    my ($self, $stream)=@_;

    $self->FillStyles->unpack($stream);
    $self->LineStyles->unpack($stream);
    $self->SUPER::unpack($stream);
}

##########

package SWF::Element::SHAPERECORD1;

sub unpack {
    my ($self, $stream, $nfillbits, $nlinebits)=@_;

    if ($stream->get_bits(1)) { # Edge

	if ($stream->get_bits(1)) {
	    bless $self, 'SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD';
	} else {
	    bless $self, 'SWF::Element::SHAPERECORDn::CURVEDEDGERECORD';
	}
	$self->_init;
	$self->unpack($stream);

    } else { # New Shape or End of Shape

	my $flags = $stream->get_bits(5);
	if ($flags==0) {
	    bless $self, 'SWF::Element::SHAPERECORDn::ENDSHAPERECORD';
	} else {
	    bless $self, ref($self).'::STYLECHANGERECORD';
	    $self->_init;
	    $self->unpack($stream, $nfillbits, $nlinebits, $flags);
	}
    }
}

sub pack {
    Carp::croak "Not enough data to pack ".ref($_[0]);
}

sub AUTOLOAD { # auto re-bless with proper sub class by specified accessor.
    my ($self, @param)=@_;
    my ($name, $class);

    return if $SWF::Element::SHAPERECORD1::AUTOLOAD =~/::DESTROY$/;

    Carp::croak "No such method: $SWF::Element::SHAPERECORD1::AUTOLOAD" unless $SWF::Element::SHAPERECORD1::AUTOLOAD=~/::([A-Z]\w*)$/;
    $name = $1;
    $class = ref($self);

    for my $subclass ("${class}::STYLECHANGERECORD", 'SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD', 'SWF::Element::SHAPERECORDn::CURVEDEDGERECORD') {
	$class=$subclass, last if $subclass->element_type($name);
    }
    Carp::croak "Element '$name' is NOT in $class " if $class eq ref($self);

    bless $self, $class;
    $self->$name(@param);
}

##########

package SWF::Element::SHAPERECORD1::STYLECHANGERECORD;

sub pack {
    my ($self, $stream, $nfillbits, $nlinebits)=@_;
    my ($flags)=0;

    my $j=0;
    for my $i (qw/MoveDeltaX FillStyle0 FillStyle1 LineStyle/) {
	$flags |=(1<<$j) if defined $self->$i;
	$j++;
    }
    $stream->set_bits($flags, 6);
    $stream->set_sbits_list(5, $self->MoveDeltaX, $self->MoveDeltaY) if ($flags & 1);
    $stream->set_bits($self->FillStyle0, $$nfillbits) if ($flags & 2);
    $stream->set_bits($self->FillStyle1, $$nfillbits) if ($flags & 4);
    $stream->set_bits($self->LineStyle , $$nlinebits) if ($flags & 8);
}

sub unpack {
    my ($self, $stream, $nfillbits, $nlinebits, $flags)=@_;

    if ($flags & 1) { # MoveTo
	my ($nbits)=$stream->get_bits(5);
	$self->MoveDeltaX($stream->get_sbits($nbits));
	$self->MoveDeltaY($stream->get_sbits($nbits));
    }
    if ($flags & 2) { # FillStyle0
	$self->FillStyle0($stream->get_bits($$nfillbits));
    }
    if ($flags & 4) { # FillStyle1
	$self->FillStyle1($stream->get_bits($$nfillbits));
    }
    if ($flags & 8) { # LineStyle
	$self->LineStyle($stream->get_bits($$nlinebits));
    }
}

##########

package SWF::Element::SHAPERECORD2::STYLECHANGERECORD;

sub pack {
    my ($self, $stream, $nfillbits, $nlinebits)=@_;
    my ($flags)=0;

    my $j=0;
    for my $i (qw/MoveDeltaX FillStyle0 FillStyle1 LineStyle/) {
	$flags |=(1<<$j) if defined $self->$i;
	$j++;
    }
    $flags |= 16 if @{$self->FillStyles}>0 or @{$self->LineStyles}>0;
    $stream->set_bits($flags, 6);
    $stream->set_sbits_list(5, $self->MoveDeltaX, $self->MoveDeltaY) if ($flags & 1);
    $stream->set_bits($self->FillStyle0, $$nfillbits) if ($flags & 2);
    $stream->set_bits($self->FillStyle1, $$nfillbits) if ($flags & 4);
    $stream->set_bits($self->LineStyle , $$nlinebits) if ($flags & 8);
    if ($flags & 16) { # NewStyles (SHAPERECORD2,3)
	my ($fillidx, $lineidx)=($#{$self->FillStyles}+1, $#{$self->LineStyles}+1);
	$self->FillStyles->pack($stream);
	$self->LineStyles->pack($stream);
	if ($fillidx>0) {
	    $$nfillbits=1;
	    $$nfillbits++ while ($fillidx>=(1<<$$nfillbits));
	} else {
	    $$nfillbits=0;
	}
	if ($lineidx>0) {
	    $$nlinebits=1;
	    $$nlinebits++ while ($lineidx>=(1<<$$nlinebits));
	} else {
	    $$nlinebits=0;
	}
	$stream->set_bits($$nfillbits, 4);
	$stream->set_bits($$nlinebits, 4);
    }
}

sub unpack {
    my ($self, $stream, $nfillbits, $nlinebits, $flags)=@_;

    if ($flags & 1) { # MoveTo
	my ($nbits)=$stream->get_bits(5);
	$self->MoveDeltaX($stream->get_sbits($nbits));
	$self->MoveDeltaY($stream->get_sbits($nbits));
    }
    if ($flags & 2) { # FillStyle0
	$self->FillStyle0($stream->get_bits($$nfillbits));
    }
    if ($flags & 4) { # FillStyle1
	$self->FillStyle1($stream->get_bits($$nfillbits));
    }
    if ($flags & 8) { # LineStyle
	$self->LineStyle($stream->get_bits($$nlinebits));
    }
    if ($flags & 16) { # NewStyles (SHAPERECORD2,3)
	$self->FillStyles->unpack($stream);
	$self->LineStyles->unpack($stream);
	$$nfillbits=$stream->get_bits(4);
	$$nlinebits=$stream->get_bits(4);
    }
}

##########

package SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD;

sub unpack {
    my ($self, $stream)=@_;
    my $nbits = $stream->get_bits(4)+2;
    if ($stream->get_bits(1)) {
	$self->DeltaX($stream->get_sbits($nbits));
	$self->DeltaY($stream->get_sbits($nbits));
    } else {
	if ($stream->get_bits(1)) {
	    $self->DeltaX(0);
	    $self->DeltaY($stream->get_sbits($nbits));
	} else {
	    $self->DeltaX($stream->get_sbits($nbits));
	    $self->DeltaY(0);
	}
    }
}

sub pack {
    my ($self, $stream)=@_;
    my ($dx, $dy, $nbits);

    $stream->set_bits(3,2); # Type=1, Edge=1

    $dx=$self->DeltaX;
    $dy=$self->DeltaY;
    $nbits=SWF::BinStream::Write::get_maxbits_of_sbits_list($dx, $dy);
    $nbits=2 if ($nbits<2);
    $stream->set_bits($nbits-2,4);
    if ($dx==0) {
	$stream->set_bits(1,2); # GeneralLine=0, Vert=1
	$stream->set_sbits($dy, $nbits);
    } elsif ($dy==0) {
	$stream->set_bits(0,2); # GeneralLine=0, Vert=0
	$stream->set_sbits($dx, $nbits);
    } else {
	$stream->set_bits(1,1); # GeneralLine=1
	$stream->set_sbits($dx, $nbits);
	$stream->set_sbits($dy, $nbits);
    }
}

##########

package SWF::Element::SHAPERECORDn::CURVEDEDGERECORD;

sub unpack {
    my ($self, $stream)=@_;
    my ($nbits)=$stream->get_bits(4)+2;

    $self->ControlDeltaX($stream->get_sbits($nbits));
    $self->ControlDeltaY($stream->get_sbits($nbits));
    $self->AnchorDeltaX($stream->get_sbits($nbits));
    $self->AnchorDeltaY($stream->get_sbits($nbits));
}

sub pack {
    my ($self, $stream)=@_;

    my @d=( $self->ControlDeltaX,
            $self->ControlDeltaY,
            $self->AnchorDeltaX ,
            $self->AnchorDeltaY  );
    my $nbits = SWF::BinStream::Write::get_maxbits_of_sbits_list(@d);
    $nbits=2 if ($nbits<2);
    $stream->set_bits(2,2); # Type=1, Edge=0
    $stream->set_bits($nbits-2,4);
    for my $i (@d) {
	$stream->set_sbits($i, $nbits);
    }
}

##########

package SWF::Element::Tag;

my @tagname;

sub new {
    my ($class, %headerdata)=@_;
    my $self;
    my $length = $headerdata{Length};
    my $tag = $headerdata{Tag};

    $self = [];
    delete @headerdata{'Length','Tag'};

    if (defined $tag) {
	$class = $class->_tag_class($tag);
	bless $self, $class;
    } else {
	$class = ref($class)||$class;
	bless $self, $class;
    }
    $self->_init($length, $tag);
    $self->configure(%headerdata) if %headerdata;
    $self;
}

sub _init {
    my ($self, $length)=@_;

    $self->Length($length);
}

sub Length {
    my ($self, $len) = @_;
    $self->[0] = $len if defined $len;
    $self->[0];
}

sub is_tagtype {
    my ($self, $type) = @_;

    return $self->isa("SWF::Element::Tag::${type}");
}

sub unpack {   # unpack tag header, re-bless, and unpack individual data for the tag.
    my ($self, $stream)=@_;
    my ($header, $tag, $length);

    $header = $stream->get_UI16;
    $tag = $header>>6;
    $length = ($header & 0x3f);
    $length = $stream->get_UI32 if ($length == 0x3f);
    my $class = $self->_tag_class($tag);
    bless $self, $class;
    $self->_init($length, $tag);
    $self->unpack($stream);
}


sub pack {
    Carp::croak "Can't pack the unidentified tag.";
}

sub _unpack {
  Carp::confess "Unexpected _unpack";
}

sub _pack {
  Carp::confess "Unexpected _pack";
}


sub _tag_class {
    return 'SWF::Element::Tag::'.($tagname[$_[1]]||'Unknown');
}

sub _create_tag {
    no strict 'refs';

    my $tagname = shift;
    my $tagno = shift;
    my $isa = shift;
    $_ = "Tag::$_" for @$isa;
    SWF::Element::_create_class("Tag::$tagname", $isa, @_, 1);

    my $tag_package = "SWF::Element::Tag::${tagname}";
    my $offset = 0;
    while (@_) {
	my $k = shift;
	my $v = shift;
	my $o = 0;
	if ($v eq 'ID' or $v eq 'Depth') {
	    $v = 'lookahead_UI16';
	    $o = 2;
	} elsif ($v =~ /^\$./) {
	    $v =~ s/^./lookahead_/;
	    ($o) = $v=~/(\d+)$/;
	    $o >>=3;
	} else {
	    last;
	}
	unless (defined &{"${tag_package}::lookahead_$k"}) {
	    my $offset1 = $offset;
	    *{"${tag_package}::lookahead_$k"} = sub {
		my ($self, $stream) = @_;
		$self->$k($stream->$v($offset1));
	    }
	}

        $offset += $o;
    }

    $tagname[$tagno] = $tagname;
    *{"${tag_package}::tag_number"} = sub {$tagno};
    *{"${tag_package}::tag_name"} = sub {$tagname};
    @{"${tag_package}::Packed::ISA"} = ( 'SWF::Element::Tag::Packed', $tag_package );
}

sub _create_pack {
    my $tagname = shift;
  SWF::Element::_create_pack("Tag::$tagname",'_');
}

##  Tag types  ##

@SWF::Element::Tag::Definition::ISA = ('SWF::Element::Tag::Identified');
  @SWF::Element::Tag::Shape::ISA    = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Bitmap::ISA   = ('SWF::Element::Tag::Definition');
    @SWF::Element::Tag::LossLessBitmap::ISA = ('SWF::Element::Tag::Bitmap');
    @SWF::Element::Tag::JPEG::ISA   = ('SWF::Element::Tag::Bitmap');
  @SWF::Element::Tag::Font::ISA     = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Text::ISA     = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Sound::ISA    = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Button::ISA   = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Sprite::ISA   = ('SWF::Element::Tag::Definition');
  @SWF::Element::Tag::Video::ISA    = ('SWF::Element::Tag::Definition');
@SWF::Element::Tag::DisplayList::ISA = ('SWF::Element::Tag::Identified');
@SWF::Element::Tag::Control::ISA    = ('SWF::Element::Tag::Identified');

@SWF::Element::Tag::ValidInSprite::ISA = ('SWF::Element::Tag');
@SWF::Element::Tag::ActionContainer::ISA  = ('SWF::Element::Tag');
@SWF::Element::Tag::AlwaysLongHeader::ISA  = ('SWF::Element::Tag');

##  Shapes  ##

_create_tag('DefineShape', 2, ['Shape'],

	    ShapeID     => 'ID',
	    ShapeBounds => 'RECT',
	    Shapes      => 'SHAPEWITHSTYLE1');
_create_pack('DefineShape');

_create_tag('DefineShape2', 22, ['DefineShape'],

	    ShapeID     => 'ID',
	    ShapeBounds => 'RECT',
	    Shapes      => 'SHAPEWITHSTYLE2');
_create_pack('DefineShape2');

_create_tag('DefineShape3', 32, ['DefineShape'],

	    ShapeID     => 'ID',
	    ShapeBounds => 'RECT',
	    Shapes      => 'SHAPEWITHSTYLE3');
_create_pack('DefineShape3');

_create_tag('DefineMorphShape', 46, ['Shape'],

	    CharacterID     => 'ID',
	    StartBounds     => 'RECT',
	    EndBounds       => 'RECT',
	    MorphFillStyles => 'Array::MORPHFILLSTYLEARRAY',
	    MorphLineStyles => 'Array::MORPHLINESTYLEARRAY',
	    StartEdges      => 'SHAPE',
	    EndEdges        => 'SHAPE');

##  Bitmaps  ##

_create_tag('DefineBits', 6, ['JPEG'],

	    CharacterID => 'ID',
	    JPEGData    => 'BinData');

_create_tag('JPEGTables', 8, ['JPEG'],

	    JPEGData => 'BinData');

_create_tag('DefineBitsJPEG2', 21, ['DefineBits'],

	    CharacterID => 'ID',
	    JPEGData    => 'BinData');

_create_tag('DefineBitsJPEG3', 35, ['DefineBitsJPEG2'],

	    CharacterID     => 'ID',
	    JPEGData        => 'BinData',
	    BitmapAlphaData => 'BinData');

_create_tag('DefineBitsLossless', 20, ['LossLessBitmap', 'AlwaysLongHeader'],

	    CharacterID          => 'ID',
	    BitmapFormat         => '$UI8',
	    BitmapWidth          => '$UI16',
	    BitmapHeight         => '$UI16',
	    BitmapColorTableSize => '$UI8',
	    ZlibBitmapData       => 'BinData',
	    );

_create_tag('DefineBitsLossless2', 36, ['DefineBitsLossless'],

	    CharacterID          => 'ID',
	    BitmapFormat         => '$UI8',
	    BitmapWidth          => '$UI16',
	    BitmapHeight         => '$UI16',
	    BitmapColorTableSize => '$UI8',
	    ZlibBitmapData       => 'BinData',
	    );

##  Buttons  ##

_create_tag('DefineButton', 7, ['Button', 'ActionContainer'],

	    ButtonID    => 'ID',
	    Characters  => 'Array::BUTTONRECORDARRAY1',
	    Actions     => 'Array::ACTIONRECORDARRAY');
_create_pack('DefineButton');

_create_tag('DefineButton2', 34, ['Button', 'ActionContainer'],

	    ButtonID   => 'ID',
	    Flags      => '$UI8',
	    Characters => 'Array::BUTTONRECORDARRAY2',
	    Actions    => 'Array::BUTTONCONDACTIONARRAY');

_create_tag('DefineButtonCxform', 23, ['Button'],

	    ButtonID             => 'ID',
	    ButtonColorTransform => 'CXFORM');
_create_pack('DefineButtonCxform');

_create_tag('DefineButtonSound', 17, ['Button'],

	    ButtonID => 'ID',
	    ButtonSoundChar0 => 'ID', ButtonSoundInfo0 => 'SOUNDINFO',
	    ButtonSoundChar1 => 'ID', ButtonSoundInfo1 => 'SOUNDINFO',
	    ButtonSoundChar2 => 'ID', ButtonSoundInfo2 => 'SOUNDINFO',
	    ButtonSoundChar3 => 'ID', ButtonSoundInfo3 => 'SOUNDINFO');

##  Fonts & Texts  ##

_create_tag('DefineFont', 10, ['Font'],

	    FontID => 'ID', GlyphShapeTable => 'Array::GLYPHSHAPEARRAY1');
_create_pack('DefineFont');

_create_tag('DefineFontInfo', 13, ['Font'],

	    FontID        => 'ID',
	    FontName      => 'PSTRING',
	    FontFlags     => '$UI8',
	    CodeTable     => 'Array::CODETABLE');

_create_tag('DefineFontInfo2', 62, ['DefineFontInfo'],

	    FontID        => 'ID',
	    FontName      => 'PSTRING',
	    FontFlags     => '$UI8',
	    LanguageCode  => '$UI8',
	    CodeTable     => 'Array::CODETABLE');

_create_tag('DefineFont2', 48, ['Font'],

	    FontID           => 'ID',
	    FontFlags        => '$UI8',
	    LanguageCode     => '$UI8',
	    FontName         => 'PSTRING',
	    GlyphShapeTable  => 'Array::GLYPHSHAPEARRAY2',
	    CodeTable        => 'Array::CODETABLE',
	    FontAscent       => '$SI16',
	    FontDescent      => '$SI16',
	    FontLeading      => '$SI16',
	    FontAdvanceTable => 'Array::FONTADVANCETABLE',
	    FontBoundsTable  => 'Array::FONTBOUNDSTABLE',
	    FontKerningTable => 'FONTKERNINGTABLE');

_create_tag('DefineText', 11, ['Text'],

	    CharacterID => 'ID',
	    TextBounds  => 'RECT',
	    TextMatrix  => 'MATRIX',
	    TextRecords => 'Array::TEXTRECORDARRAY1');
_create_pack('DefineText');

_create_tag('DefineText2', 33, ['DefineText'],

	    CharacterID => 'ID',
	    TextBounds  => 'RECT',
	    TextMatrix  => 'MATRIX',
	    TextRecords => 'Array::TEXTRECORDARRAY2');
_create_pack('DefineText2');

_create_tag('DefineEditText', 37, ['Text'],

	    CharacterID  => 'ID',
	    Bounds       => 'RECT',
	    Flags        => '$UI16',
	    FontID       => 'ID',
	    FontHeight   => '$UI16',
	    TextColor    => 'RGBA',
	    MaxLength    => '$UI16',
	    Align        => '$UI8',
	    LeftMargin   => '$UI16',
	    RightMargin  => '$UI16',
	    Indent       => '$UI16',
	    Leading      => '$UI16',
	    VariableName => 'STRING',
	    InitialText  => 'STRING');

##  Sounds  ##

_create_tag('DefineSound', 14, ['Sound'],

	    SoundID          => 'ID',
	    Flags            => '$UI8',
	    SoundSampleCount => '$UI32',
	    SoundData        => 'BinData');

_create_tag('StartSound', 15, ['Identified', 'ValidInSprite'],

	    SoundID   => 'ID',
	    SoundInfo => 'SOUNDINFO');
_create_pack('StartSound');

_create_tag('SoundStreamBlock', 19, ['Identified', 'ValidInSprite'],

	    StreamSoundData => 'BinData');

_create_tag('SoundStreamHead', 18, ['Identified', 'ValidInSprite'],

	    Flags                  => '$UI16',
	    StreamSoundSampleCount => '$UI16',
	    LatencySeek            => '$SI16');

_create_tag('SoundStreamHead2', 45, ['SoundStreamHead'],

	    Flags                  => '$UI16',
	    StreamSoundSampleCount => '$UI16',
	    LatencySeek            => '$SI16');

##  Sprites  ##

_create_tag('DefineSprite', 39, ['Sprite'],

	    SpriteID    => 'ID',
	    FrameCount  => '$UI16',
	    ControlTags => 'Array::TAGARRAY',
	    TagStream   => 'TAGSTREAM');

##  Display list  ##

_create_tag('PlaceObject', 4, ['DisplayList', 'ValidInSprite'],

	    CharacterID    => 'ID',
	    Depth          => 'Depth',
	    Matrix         => 'MATRIX',
	    ColorTransform => 'CXFORM');

_create_tag('PlaceObject2', 26, ['DisplayList', 'ActionContainer', 'ValidInSprite'],

	    Flags          => '$UI8',
	    Depth          => 'Depth',
	    CharacterID    => 'ID',
	    Matrix         => 'MATRIX',
	    ColorTransform => 'CXFORMWITHALPHA',
	    Ratio          => '$UI16',
	    Name           => 'STRING',
	    ClipDepth      => 'Depth',
	    ClipActions    => 'Array::CLIPACTIONRECORDARRAY');

_create_tag('RemoveObject', 5, ['DisplayList', 'ValidInSprite'],

	    CharacterID => 'ID', Depth => 'Depth' );
_create_pack('RemoveObject');

_create_tag('RemoveObject2', 28, ['DisplayList', 'ValidInSprite'],

	    Depth => 'Depth' );
_create_pack('RemoveObject2');

_create_tag('ShowFrame', 1, ['DisplayList', 'ValidInSprite']);
_create_pack('ShowFrame');

##  Control  ##

_create_tag('SetBackgroundColor', 9, ['Control'],

	    BackgroundColor => 'RGB' );
_create_pack('SetBackgroundColor');

_create_tag('FrameLabel', 43, ['Control', 'ValidInSprite'],

	    Name => 'STRING',
	    NamedAnchorFlag => '$UI8' );

_create_tag('Protect', 24, ['Control'],

	    Reserved => '$UI16',
	    Password => 'STRING' );

_create_tag('EnableDebugger', 58, ['Control'],

	    Reserved => '$UI16',
	    Password => 'STRING' );
_create_pack('EnableDebugger');

_create_tag('EnableDebugger2', 64, ['Control'],

	    Reserved => '$UI16',
	    Password => 'STRING' );
_create_pack('EnableDebugger2');

_create_tag('ScriptLimits', 65, ['Control'],

	    MaxRecurtionDepth    => '$UI16',
	    ScriptTimeoutSeconds => '$UI16' );
_create_pack('ScriptLimits');

_create_tag('SetTabIndex', 66, ['Control'],

	    Depth    => 'Depth',
	    TabIndex => '$UI16' );
_create_pack('SetTabIndex');


_create_tag('End', 0, ['Control', 'ValidInSprite']);
_create_pack('End');

_create_tag('ExportAssets', 56, ['Control'],

	    Assets => 'Array::ASSETARRAY');
_create_pack('ExportAssets');

_create_tag('ImportAssets', 57, ['Control', 'Definition'],

	    URL    => 'STRING',
	    Assets => 'Array::ASSETARRAY');
_create_pack('ImportAssets');

##  Actions  ##

_create_tag('DoAction', 12, ['Identified', 'ActionContainer', 'ValidInSprite'],

	    Actions => 'Array::ACTIONRECORDARRAY');
_create_pack('DoAction');

_create_tag('DoInitAction', 59, ['Definition', 'ActionContainer'],

	    SpriteID => 'ID',
	    Actions  => 'Array::ACTIONRECORDARRAY');
_create_pack('DoInitAction');

##  Video  ##

_create_tag('DefineVideoStream', 60, ['Video'],

            CharacterID => 'ID',
            NumFrames   => '$UI16',
            Width       => '$UI16',
            Height      => '$UI16',
            VideoFlags  => '$UI8',
            CodecID     => '$UI8');
_create_pack('DefineVideoStream');

_create_tag('VideoFrame', 61, ['Video'],

            StreamID  => 'ID',
            FrameNum  => '$UI16',
            VideoData => 'BinData');
_create_pack('VideoFrame');

##  others?  ##

_create_tag('FreeCharacter', 3, ['Control'],

	    CharacterID => 'ID');
_create_pack('FreeCharacter');

_create_tag('NameCharacter', 40, ['Control'],

	    ID => 'ID',
	    Name        => 'STRING');
_create_pack('NameCharacter');



### Identified Tag base ###

package SWF::Element::Tag::Identified;

sub unpack {
    my $self = shift;
    my $stream = shift;

    my $start = $stream->tell;
    my $length = $self->Length || 0;
    $self->_unpack($stream, @_) if $length>0;
    $stream->flush_bits;
    my $read = $stream->tell - $start;
    if ($read < $length) {
	$stream->get_string($length-$read);  # Skip the rest of tag data.
    } elsif ($read > $length) {
	Carp::croak ref($self)." unpacked $read bytes in excess of the described tag length, $length bytes.  The SWF may be collapsed or the module bug??";
    }
}

sub pack {
    my ($self, $stream)=@_;
    my $substream = $stream->sub_stream;

    $self->_pack($substream);
    my $header = $self->tag_number<<6;
    my $len = $substream->tell;
    if ($len >= 0x3f or $self->is_tagtype('AlwaysLongHeader')) {
	$header |= 0x3f;
	$stream->set_UI16($header);
	$stream->set_UI32($len);
    } else {
	$stream->set_UI16($header|$len);
    }
    $substream->flush_stream;
}


####  Packed tag  ####
##########

package SWF::Element::Tag::Packed;

#@SWF::Element::Tag::Packed::ISA = ('SWF::Element::Tag::Identified');

SWF::Element::_create_class
    ( 'Tag::Packed', ['Tag::Identified'],
      Tag  => '$',
      Data => 'BinData',
     1 );

sub _init {
    my $self = shift;
    my $tag = $_[1];

    $self->SUPER::_init(@_);
    $self->Tag($tag);
}

sub _tag_class {
    return $tagname[$_[1]] ? 'SWF::Element::Tag::'.$tagname[$_[1]].'::Packed' : 'SWF::Element::Tag::Unknown';
}

sub _unpack {
    my ($self, $stream)=@_;

    $self->Data->unpack($stream, $self->Length);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->Data->pack($stream);
}

####  Unknown  ####
##########

package SWF::Element::Tag::Unknown;

@SWF::Element::Tag::Unknown::ISA = ('SWF::Element::Tag::Packed');

SWF::Element::_create_class
    ( 'Tag::Unknown', ['Tag::Packed'],
      Tag  => '$',
      Data => 'BinData',
     1 );

sub _init {
    my $self = shift;
    my $tag = $_[1];

    $self->SUPER::_init(@_);
    Carp::carp "Tag No. $tag is unknown";
}

sub tag_name {'Unknown'}
sub tag_number {shift->Tag}

####  Shapes  ####
########

package SWF::Element::Tag::DefineMorphShape;

sub _unpack {
    my ($self, $stream)=@_;

    $self->CharacterID->unpack($stream);
    $self->StartBounds->unpack($stream);
    $self->EndBounds  ->unpack($stream);
    $stream->get_UI32; # Skip Offset
    $self->MorphFillStyles->unpack($stream);
    $self->MorphLineStyles->unpack($stream);
    $stream->flush_bits;
    $self->StartEdges->unpack($stream);
    $stream->flush_bits;
    $self->EndEdges->unpack($stream);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->CharacterID->pack($stream);
    $self->StartBounds->pack($stream);
    $self->EndBounds  ->pack($stream);
    {
	my $tempstream=$stream->sub_stream;
	my ($nfillbits, $nlinebits) = (0, 0);
	my ($fillidx, $lineidx) = ($#{$self->MorphFillStyles}+1, $#{$self->MorphLineStyles}+1);
	if ($fillidx>0) {
	    $nfillbits=1;
	    $nfillbits++ while ($fillidx>=(1<<$nfillbits));
	}
	if ($lineidx>0) {
	    $nlinebits=1;
	    $nlinebits++ while ($lineidx>=(1<<$nlinebits));
	}
	$self->MorphFillStyles->pack($tempstream);
	$self->MorphLineStyles->pack($tempstream);
	$tempstream->flush_bits;
	$self->StartEdges->pack($tempstream, $nfillbits, $nlinebits);
	$tempstream->flush_bits;
	$stream->set_UI32($tempstream->tell);
	$tempstream->flush_stream;
    }
    $self->EndEdges->pack($stream, 0, 0);
    $stream->flush_bits;
}

##########

package SWF::Element::MORPHFILLSTYLE;

sub pack {
    my ($self, $stream)=@_;
    my $style=$self->FillStyleType;
    $stream->set_UI8($style);
    if ($style==0x00) {
	$self->StartColor->pack($stream);
	$self->EndColor->pack($stream);
    } elsif ($style==0x10 or $style==0x12) {
	$self->StartGradientMatrix->pack($stream);
	$self->EndGradientMatrix->pack($stream);
	$self->Gradient->pack($stream);
    } elsif ($style>=0x40 or $style<=0x43) {
	$self->BitmapID->pack($stream);
	$self->StartBitmapMatrix->pack($stream);
	$self->EndBitmapMatrix->pack($stream);
    }
}

sub unpack {
    my ($self, $stream)=@_;
    my $style = $self->FillStyleType($stream->get_UI8);
    if ($style==0x00) {
	$self->StartColor->unpack($stream);
	$self->EndColor->unpack($stream);
    } elsif ($style==0x10 or $style==0x12) {
	$self->StartGradientMatrix->unpack($stream);
	$self->EndGradientMatrix->unpack($stream);
	$self->Gradient->unpack($stream);
    } elsif ($style<=0x40 or $style<=0x43) {
	$self->BitmapID->unpack($stream);
	$self->StartBitmapMatrix->unpack($stream);
	$self->EndBitmapMatrix->unpack($stream);
    }
}


####  Bitmaps  ####
##########

package SWF::Element::Tag::DefineBits;

sub _unpack {
    my ($self, $stream)=@_;

    $self->CharacterID->unpack($stream);
    $self->JPEGData->unpack($stream, $self->Length - 2);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->CharacterID->pack($stream);
    $self->JPEGData->pack($stream);
}

##########

package SWF::Element::Tag::DefineBitsJPEG2;

sub _unpack {
    my ($self, $stream)=@_;

    $self->CharacterID->unpack($stream);
#    $self->_unpack_JPEG($stream, $self->Length - 2);
    $self->JPEGData->unpack($stream, $self->Length - 2);
}

=pod

sub _unpack_JPEG {
    my ($self, $stream, $len) = @_;
    my ($data1, $data2);

    while (!$data2 and $len > 0) {
	my $size = ($len > 1000) ? 1000 : $len;
	$data1 = $stream->get_string($size);
	$len -= $size;
	if ($data1 =~/\xff$/ and $len>0) {
	    $data1 .= $stream->get_string(1);
	    $len--;
	}
	($data1, $data2) = split /\xff\xd9/, $data1;
	$self->BitmapJPEGEncoding->add($data1);
    }
    $self->BitmapJPEGEncoding->add("\xff\xd9");

    $self->BitmapJPEGImage($data2);
    while ($len > 0) {
	my $size = ($len > 1000) ? 1000 : $len;
	$data1 = $stream->get_string($size);
	$len -= $size;
	$self->BitmapJPEGImage->add($data1);
    }
}

=cut

##########

package SWF::Element::Tag::DefineBitsJPEG3;

sub _unpack {
    my ($self, $stream)=@_;

    $self->CharacterID->unpack($stream);
    my $offset = $stream->get_UI32;
#    $self->_unpack_JPEG($stream, $offset);
    $self->JPEGData->unpack($stream, $offset);
    $self->BitmapAlphaData->unpack($stream, $self->Length - $offset - 6);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->CharacterID->pack($stream);
    $stream->set_UI32($self->JPEGData->Length);
    $self->JPEGData->pack($stream);
    $self->BitmapAlphaData->pack($stream);
}

##########

package SWF::Element::Tag::DefineBitsLossless;

sub _unpack {
    my ($self, $stream)=@_;
    my $length=$self->Length - 7;

#    delete @{$self}{qw/ColorTable BitmapImage/};

    $self->CharacterID->unpack($stream);
    $self->BitmapFormat($stream->get_UI8);
    $self->BitmapWidth($stream->get_UI16);
    $self->BitmapHeight($stream->get_UI16);
    if ($self->BitmapFormat == 3) {
	$self->BitmapColorTableSize($stream->get_UI8);
	$length--;
    }
    $self->ZlibBitmapData->unpack($stream, $length);
#    $self->decompress;
}

sub _pack {
    my ($self, $stream)=@_;

#    $self->compress if defined $self->{'ColorTable'} and defined $self->{'BitmapImage'};
    $self->CharacterID->pack($stream);
    $stream->set_UI8($self->BitmapFormat);
    $stream->set_UI16($self->BitmapWidth);
    $stream->set_UI16($self->BitmapHeight);
    $stream->set_UI8($self->BitmapColorTableSize) if $self->BitmapFormat == 3;
    $self->ZlibBitmapData->pack($stream);
}

sub decompress {
}

sub compress {
}

##########

package SWF::Element::Tag::JPEGTables;

sub _unpack {
    my ($self, $stream)=@_;

    $self->JPEGData->unpack($stream, $self->Length);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->JPEGData->pack($stream);
}

####  Buttons  ####

##########

package SWF::Element::BUTTONRECORD1;

sub unpack {
    my ($self, $stream)=@_;

    $self->ButtonStates($stream->get_UI8);
    return if $self->ButtonStates == 0;
    $self->CharacterID->unpack($stream);
    $self->PlaceDepth->unpack($stream);
    $self->PlaceMatrix->unpack($stream);
}

sub pack {
    my ($self, $stream)=@_;

    $stream->set_UI8($self->ButtonStates);
    return if $self->ButtonStates == 0;
    $self->CharacterID->pack($stream);
    $self->PlaceDepth->pack($stream);
    $self->PlaceMatrix->pack($stream);
}

{
    my $bit = 0;
    for my $f (qw/ButtonStateUp ButtonStateOver ButtonStateDown ButtonStateHitTest/) {
      SWF::Element::_create_flag_accessor($f, 'ButtonStates', $bit++);
    }
}

package SWF::Element::BUTTONRECORD2;

sub unpack {
    my ($self, $stream)=@_;

    $self->SUPER::unpack($stream);
    return if $self->ButtonStates == 0;
    $self->ColorTransform->unpack($stream);
}

sub pack {
    my ($self, $stream)=@_;

    $self->SUPER::pack($stream);
    return if $self->ButtonStates == 0;
    $self->ColorTransform->pack($stream);
}


##########

package SWF::Element::Tag::DefineButton2;

sub _unpack {
    my ($self, $stream)=@_;

    $self->ButtonID->unpack($stream);
    $self->Flags($stream->get_UI8);
    my $offset=$stream->get_UI16;
    $self->Characters->unpack($stream);
    $self->Actions->unpack($stream) if $offset;
}

sub _pack {
    my ($self, $stream)=@_;
    my $actions = $self->Actions;

    $self->ButtonID->pack($stream);
    $stream->set_UI8($self->Flags);
    my $substream = $stream->sub_stream;
    $self->Characters->pack($substream);
    $stream->set_UI16((@$actions>0) && ($substream->tell + 2));
    $substream->flush_stream;
    $actions->pack($stream) if (@$actions>0);
}

 SWF::Element::_create_flag_accessor('TrackAsMenu', 'Flags', 0);

##########

package SWF::Element::Array::BUTTONCONDACTIONARRAY;

sub pack {
    my ($self, $stream)=@_;

    my $last=pop @$self;
    for my $element (@$self) {
	my $tempstream=$stream->sub_stream;
	$element->pack($tempstream);
	$stream->set_UI16($tempstream->tell + 2);
	$tempstream->flush_stream;
    }
    $stream->set_UI16(0);
    $last->pack($stream);
    push @$self, $last;
}

sub unpack {
    my ($self, $stream)=@_;
    my ($element, $offset);

    do {
	$offset=$stream->get_UI16;
	$element=$self->new_element;
	$element->unpack($stream);
	push @$self, $element;
    } until $offset==0;
}

##########

package SWF::Element::BUTTONCONDACTION;

{
    my $bit = 0;

    for my $f (qw/IdleToOverUp OverUpToIdle OverUpToOverDown OverDownToOverUp OverDownToOutDown OutDownToOverDown OutDownToIdle IdleToOverDown OverDownToIdle/) {
      SWF::Element::_create_flag_accessor("Cond$f", 'Condition', $bit++);
    }
  SWF::Element::_create_flag_accessor("CondKeyPress", 'Condition', 9, 7);

}

##########

package SWF::Element::Tag::DefineButtonSound;

sub _unpack {
    my ($self, $stream)=@_;

    $self->ButtonID->unpack($stream);
    for my $i (0..3) {
	my $bsc = "ButtonSoundChar$i";
	my $bsi = "ButtonSoundInfo$i";

	$self->$bsc->unpack($stream);
	if ($self->$bsc) {
	    $self->$bsi->unpack($stream);
	}
    }
}

sub _pack {
    my ($self, $stream)=@_;

    $self->ButtonID->pack($stream);
    for my $i (0..3) {
	my $bsc = "ButtonSoundChar$i";
	my $bsi = "ButtonSoundInfo$i";

	$self->$bsc->pack($stream);
	$self->$bsi->pack($stream) if $self->$bsc;
    }
}

####  Texts and Fonts  ####
##########

package SWF::Element::Array::GLYPHSHAPEARRAY1;

sub pack {
    my ($self, $stream)=@_;
    my $offset = @$self*2+2;

    $stream->set_UI16($offset);

    my $tempstream = $stream->sub_stream;

    for my $element (@$self) {
	$element->pack($tempstream, 1, 0);
	$stream->set_UI16($offset + $tempstream->tell);
    }
    $tempstream->flush_stream;
}

sub unpack {
    my ($self, $stream)=@_;
    my $offset=$stream->get_UI16;

    $stream->get_string($offset-2); # skip offset table.
    for (my $i=0; $i < $offset/2; $i++) {
	my $element = $self->new_element;
	$element->unpack($stream);
	push @$self, $element;
    }
}

##########

package SWF::Element::Array::GLYPHSHAPEARRAY2;

sub pack {     # return wide offset flag (true => 32bit, false => 16bit)
    my ($self, $stream)=@_;
    my (@offset, $wideoffset);
    my $glyphcount=@$self;

    $offset[0]=0;
    my $tempstream=$stream->sub_stream;

    for my $element (@$self) {
	$element->pack($tempstream, 1, 0);
	push @offset, $tempstream->tell;  # keep glyph shape's offset.
    }

# Each offset should be added the offset table size.
# If the last offset is more than 65535, offsets are packed in 32bits each.

    if (($glyphcount+1)*2+$offset[-1] >= (1<<16)) {
	$wideoffset=1;
	for my $element (@offset) {
	    $stream->set_UI32(($glyphcount+1)*4+$element);
	}
    } else {
	$wideoffset=0;
	for my $element (@offset) {
	    $stream->set_UI16(($glyphcount+1)*2+$element);
	}
    }
    $tempstream->flush_stream;
    return $wideoffset;
}

sub unpack {
    my ($self, $stream, $wideoffset)=@_;
    my @offset;
    my $getoffset = ($wideoffset ? sub {$stream->get_UI32} : sub {$stream->get_UI16});
    my $origin = $stream->tell;

    $offset[0] = &$getoffset;
    my $count = $offset[0]>>($wideoffset ? 2:1);

    for (my $i = 1; $i < $count; $i++) {
	push @offset, &$getoffset;
    }
    my $pos = $stream->tell - $origin;
    my $offset = shift @offset;
    Carp::croak ref($self).": Font offset table seems to be collapsed." if $pos>$offset;
    $stream->get_string($pos-$offset) if $pos<$offset;
    for (my $i = 1; $i < $count; $i++) {
	my $element = $self->new_element;
	$element->unpack($stream);
	push @$self, $element;
	my $pos = $stream->tell - $origin;
	my $offset = shift @offset;
	Carp::croak ref($self).": Font shape table seems to be collapsed." if $pos>$offset;
	$stream->get_string($pos-$offset) if $pos<$offset;
    }
}


##########

package SWF::Element::Tag::DefineFont2;

sub _unpack {
    my ($self, $stream)=@_;

    $self->FontID->unpack($stream);
    my $flag = $self->FontFlags($stream->get_UI8);
    $self->LanguageCode($stream->get_UI8);
    $self->FontName->unpack($stream);
    my $glyphcount = $stream->get_UI16;
    if ($glyphcount > 0) {
	$self->GlyphShapeTable->unpack($stream, ($flag & 8));
	$self->CodeTable->unpack($stream, $glyphcount, ($flag & 4));
    }
    if ($flag & 128) {
	$self->FontAscent($stream->get_SI16);
	$self->FontDescent($stream->get_SI16);
	$self->FontLeading($stream->get_SI16);
	$self->FontAdvanceTable->unpack($stream, $glyphcount);
	$self->FontBoundsTable ->unpack($stream, $glyphcount);
	$self->FontKerningTable->unpack($stream, ($flag & 4));
    }
}

sub _pack {
    my ($self, $stream)=@_;
    my $glyphcount = @{$self->CodeTable};

    $self->FontID->pack($stream);
    my $tempstream = $stream->sub_stream;
    my $flag = (($self->FontFlags || 0) & 0b01010111);

    $self->FontName->pack($tempstream);
    $tempstream->set_UI16($glyphcount);
    if ($glyphcount > 0){
	$self->GlyphShapeTable->pack($tempstream) and ($flag |= 8);
	$self->CodeTable->pack($tempstream, $self->FontFlagsWideCodes) and ($flag |= 4);
    }
    if (defined $self->FontAscent) {
	$flag |= 128;
	$tempstream->set_SI16($self->FontAscent);
	$tempstream->set_SI16($self->FontDescent);
	$tempstream->set_SI16($self->FontLeading);
	$self->FontAdvanceTable->pack($tempstream);
	$self->FontBoundsTable->pack($tempstream);
	$self->FontKerningTable->pack($tempstream, ($flag & 4));
    }
    $stream->set_UI8($flag);
    $stream->set_UI8($self->LanguageCode);
    $tempstream->flush_stream;
}

{
    my $bit = 0;
    for my $f (qw/ Bold Italic WideCodes WideOffsets ANSI SmallText ShiftJIS HasLayout /) {
      SWF::Element::_create_flag_accessor("FontFlags$f", 'FontFlags', $bit++);
    }
}

##########

package SWF::Element::Array::CODETABLE;

sub pack {
    my ($self, $stream, $widecode)=@_;

    for my $element (@$self) {
	if ($element > 255) {
	    $widecode = 1;
	    last;
	}
    }
    if ($widecode) {
	for my $element (@$self) {
	    $stream->set_UI16($element);
	}
    } else {
	for my $element (@$self) {
	    $stream->set_UI8($element);
	}
    }
    $widecode;
}

sub unpack {
    my ($self, $stream, $glyphcount, $widecode)=@_;
    my ($templete);
    if ($widecode) {
	$glyphcount*=2;
	$templete='v*';
    } else {
	$templete='C*';
    }

    @$self=unpack($templete,$stream->get_string($glyphcount));
}

##########

package SWF::Element::Array::FONTADVANCETABLE;

sub pack {
    my ($self, $stream)=@_;

    for my $element (@$self) {
	$stream->set_SI16($element);
    }
}

sub unpack {
    my ($self, $stream, $glyphcount)=@_;

    while (--$glyphcount >=0) {
	push @$self, $stream->get_SI16;
    }
}

##########

package SWF::Element::Array::FONTBOUNDSTABLE;

sub unpack {
    my ($self, $stream, $glyphcount)=@_;

    while (--$glyphcount >=0) {
	my $element = $self->new_element;
	$element->unpack($stream);
	push @$self, $element;
    }
}

##########

package SWF::Element::FONTKERNINGTABLE;

@SWF::Element::FONTKERNINGTABLE::ISA = ('SWF::Element');

sub new {
    my $class = shift;
    my $self = {};

    $class=ref($class)||$class;

    bless $self, $class;
    $self->configure(@_) if @_;
    $self;
}

sub unpack {
    my ($self, $stream, $widecode)=@_;
    my $count=$stream->get_UI16;
    my $getcode=($widecode ? sub {$stream->get_UI16} : sub {$stream->get_UI8});
    %$self=();
    while (--$count>=0) {
	my $code1=&$getcode;
	my $code2=&$getcode;
	$self->{"$code1-$code2"}=$stream->get_SI16;
    }
}

sub pack {
    my ($self, $stream, $widecode)=@_;
    my $setcode=($widecode ? sub {$stream->set_UI16(shift)} : sub {$stream->set_UI8(shift)});
    my ($k, $v);

    $stream->set_UI16(scalar(keys(%$self)));
    while (($k, $v)=each(%$self)) {
	my ($code1, $code2)=split(/-/,$k);
	&$setcode($code1);
	&$setcode($code2);
	$stream->set_SI16($v);
    }
}

sub configure {
    my ($self, @param)=@_;

    if (@param==0) {
	return map {$_, $self->{$_}} grep {defined $self->{$_}} keys(%$self);
    } elsif (@param==1) {
	my $k=$param[0];
	return undef unless exists $self->{$k};
	return $self->{$k};
    } else {
	my %param=@param;
	my ($key, $value);
	while (($key, $value) = each %param) {
	    next if $key!~/^\d+-\d+$/;
	    $self->{$key}=$value;
	}
    }
}

sub dumper {
    my ($self, $outputsub, $indent)=@_;
    my ($k, $v);

    $indent ||= 0;
    $outputsub||=\&SWF::Element::_default_output;

    &$outputsub(ref($self)."->new(\n", 0);
    while (($k, $v) = each %$self) {
	&$outputsub("'$k' => $v,\n", $indent + 1);
    }
    &$outputsub(")", $indent);
}

sub defined {
    keys %{shift()} > 0;
}

##########

package SWF::Element::Tag::DefineFontInfo;

sub _unpack {
    my ($self, $stream)=@_;

    my $start = $stream->tell;
    $self->FontID   ->unpack($stream);
    $self->FontName ->unpack($stream);
    my $widecode   = $self->FontFlags($stream->get_UI8) & 1;
    my $glyphcount = $self->Length - ($stream->tell - $start);
    $glyphcount >>= 1 if $widecode;
    $self->CodeTable->unpack($stream, $glyphcount, $widecode);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->FontID   ->pack($stream);
    $self->FontName ->pack($stream);
    my $substream = $stream->sub_stream;
    my $flag = $self->FontFlags & 0b11110;
    $self->CodeTable->pack($substream) and ($flag |= 1);

    $stream->set_UI8($flag);
    $substream->flush_stream;
}

{
    my $bit = 0;
    for my $f (qw/ WideCodes Bold Italic ANSI ShiftJIS SmallText/) {
      SWF::Element::_create_flag_accessor("FontFlags$f", 'FontFlags', $bit++);
    }
}

##########

package SWF::Element::Tag::DefineFontInfo2;

sub _unpack {
    my ($self, $stream)=@_;

    my $start = $stream->tell;
    $self->FontID   ->unpack($stream);
    $self->FontName ->unpack($stream);
    my $widecode = $self->FontFlags($stream->get_UI8) & 1;
    $self->LanguageCode($stream->get_UI8);
    my $glyphcount = $self->Length - ($stream->tell - $start);
    $glyphcount >>= 1 if $widecode;
    $self->CodeTable->unpack($stream, $glyphcount, $widecode);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->FontID   ->pack($stream);
    $self->FontName ->pack($stream);
    my $substream = $stream->sub_stream;
    my $flag = ($self->FontFlags & 0b11100111 | 1);
    $self->CodeTable->pack($substream, 1);

    $stream->set_UI8($flag);
    $stream->set_UI8($self->LanguageCode);
    $substream->flush_stream;
}


##########

package SWF::Element::Array::TEXTRECORDARRAY1;

sub pack {
    my ($self, $stream)=@_;
    my ($nglyphmax, $nglyphbits, $nadvancemax, $nadvancebits, $g, $a) = (0) x 6;

    for my $element (@$self) {
	for my $entry (@{$element->GlyphEntries}) {
	    $g=$entry->GlyphIndex;
	    $a=$entry->GlyphAdvance;
	    $a=~$a if $a<0;
	    $nglyphmax=$g if $g>$nglyphmax;
	    $nadvancemax=$a if $a>$nadvancemax;
	}
    }
    $nglyphbits++ while ($nglyphmax>=(1<<$nglyphbits));
    $nadvancebits++ while ($nadvancemax>=(1<<$nadvancebits));
    $nadvancebits++; # for sign bit.

    $stream->set_UI8($nglyphbits);
    $stream->set_UI8($nadvancebits);

    for my $element (@$self) {
	$element->pack($stream, $nglyphbits, $nadvancebits);
    }
    $self->last($stream);
}

sub unpack {
    my ($self, $stream)=@_;
    my ($nglyphbits, $nadvancebits);
    my ($flags);

    $nglyphbits=$stream->get_UI8;
    $nadvancebits=$stream->get_UI8;
    {
	my $element = $self->new_element;
	$element->unpack($stream, $nglyphbits, $nadvancebits);
	last if $self->is_last($element);
	push @$self, $element;
	redo;
    }
}

##########

package SWF::Element::TEXTRECORD1;

sub unpack {
    my $self = shift;
    my $stream = shift;

    my $flags = $stream->get_UI8;
    if ($flags == 0) {
	return bless $self, 'SWF::Element::TEXTRECORD::End';
    }
    $self->FontID   ->unpack($stream)    if ($flags & 8);
    $self->TextColor->unpack($stream)    if ($flags & 4);
    $self->XOffset($stream->get_SI16)    if ($flags & 1);
    $self->YOffset($stream->get_SI16)    if ($flags & 2);
    $self->TextHeight($stream->get_UI16) if ($flags & 8);
    $self->GlyphEntries->unpack($stream, @_);
}

sub pack {
    my $self = shift;
    my $stream = shift;
    my ($flags)=0x80;

    $flags|=8 if $self->FontID->defined or defined $self->TextHeight;
    $flags|=4 if $self->TextColor->defined;
    $flags|=1 if defined $self->XOffset;
    $flags|=2 if defined $self->YOffset;
    $stream->set_UI8($flags);

    $self->FontID->pack($stream)  if ($flags & 8);
    $self->TextColor->pack($stream) if ($flags & 4);
    $stream->set_SI16($self->XOffset) if ($flags & 1);
    $stream->set_SI16($self->YOffset) if ($flags & 2);
    $stream->set_UI16($self->TextHeight) if ($flags & 8);
    $self->GlyphEntries->pack($stream, @_);
}

##########

package SWF::Element::GLYPHENTRY;

sub unpack {
    my ($self, $stream, $nglyphbits, $nadvancebits)=@_;

    $self->GlyphIndex($stream->get_bits($nglyphbits));
    $self->GlyphAdvance($stream->get_sbits($nadvancebits));
}

sub pack {
    my ($self, $stream, $nglyphbits, $nadvancebits)=@_;

    $stream->set_bits($self->GlyphIndex, $nglyphbits);
    $stream->set_sbits($self->GlyphAdvance, $nadvancebits);
}

##########

package SWF::Element::TEXTRECORD1::TYPE1;

=pod obsolete

sub unpack {
    my ($self, $stream, $flags)=@_;

    $self->FontID   ->unpack($stream)    if ($flags & 8);
    $self->TextColor->unpack($stream)    if ($flags & 4);
    $self->XOffset($stream->get_SI16)    if ($flags & 1);
    $self->YOffset($stream->get_SI16)    if ($flags & 2);
    $self->TextHeight($stream->get_UI16) if ($flags & 8);
}

=cut

sub pack {
    my ($self, $stream)=@_;
    my ($flags)=0x80;

    $flags|=8 if $self->FontID->defined or defined $self->TextHeight;
    $flags|=4 if $self->TextColor->defined;
    $flags|=1 if defined $self->XOffset;
    $flags|=2 if defined $self->YOffset;
    $stream->set_UI8($flags);

    $self->FontID->pack($stream)  if ($flags & 8);
    $self->TextColor->pack($stream) if ($flags & 4);
    $stream->set_SI16($self->XOffset) if ($flags & 1);
    $stream->set_SI16($self->YOffset) if ($flags & 2);
    $stream->set_UI16($self->TextHeight) if ($flags & 8);
}


##########

package SWF::Element::Tag::DefineEditText;

sub _unpack {
    my ($self, $stream)=@_;

    $self->CharacterID->unpack($stream);
    $self->Bounds->unpack($stream);
    my $flag = $self->Flags($stream->get_UI16);

    if ($flag & 1) {
	$self->FontID->unpack($stream);
	$self->FontHeight($stream->get_UI16);
    }
    $self->TextColor->unpack($stream) if $flag & 4;
    $self->MaxLength($stream->get_UI16) if $flag & 2;

    if ($flag & (1<<13)) {
	$self->Align($stream->get_UI8);
	for my $element (qw/LeftMargin RightMargin Indent Leading/) {
	    $self->$element($stream->get_UI16);
	}
    }
    $self->VariableName->unpack($stream);
    $self->InitialText->unpack($stream) if $flag & 128;
}

sub _pack {
    my ($self, $stream)=@_;

    my $flag = $self->Flags & 0b101101101111000;
    $flag |= ($self->FontID->defined or defined $self->FontHeight) |
	     defined ($self->MaxLength)  << 1 |
             ($self->TextColor->defined) << 2 |
	     ($self->InitialText->defined) << 7 |
	     (defined $self->Align
              or defined $self->LeftMargin
              or defined $self->RightMargin
              or defined $self->Indent
              or defined $self->Leading) << 13;

    $self->CharacterID->pack($stream);
    $self->Bounds->pack($stream);
    $stream->set_UI16($flag);

    if ($flag & 1) {
	$self->FontID->pack($stream);
	$stream->set_UI16($self->FontHeight);
    }
    $self->TextColor->pack($stream) if $flag & 4;
    $stream->set_UI16($self->MaxLength) if $flag & 2;
    if ($flag & (1<<13)) {
	$stream->set_UI8($self->Align);
	for my $element (qw/LeftMargin RightMargin Indent Leading/) {
	    $stream->set_UI16($self->$element);
	}
    }
    $self->VariableName->pack($stream);
    $self->InitialText->pack($stream) if $flag & 128;
}

{
    my $bit = 0;
    for my $f (qw / HasFont HasMaxLength HasTextColor ReadOnly Password Multiline WordWrap HasText UseOutlines HTML Reserved Border NoSelect HasLayout AutoSize / ) {
      SWF::Element::_create_flag_accessor($f, 'Flags', $bit++);
    }
}

####  Sounds  ####
##########

package SWF::Element::SOUNDINFO;

sub unpack {
    my ($self, $stream)=@_;
    my $flags=$stream->get_UI8;

    $self->SyncFlags($flags);

    $self->InPoint($stream->get_UI32) if ($flags & 1);
    $self->OutPoint($stream->get_UI32) if ($flags & 2);
    $self->LoopCount($stream->get_UI16) if ($flags & 4);
    $self->EnvelopeRecords->unpack($stream) if ($flags & 8);
}

sub pack {
    my ($self, $stream)=@_;
    my $flags=$self->SyncFlags |
	      $self->EnvelopeRecords->defined << 3 |
	      defined($self->LoopCount) << 2 |
	      defined($self->OutPoint)  << 1 |
	      defined($self->InPoint);
    $stream->set_UI8($flags);

    $stream->set_UI32($self->InPoint) if ($flags & 1);
    $stream->set_UI32($self->OutPoint) if ($flags & 2);
    $stream->set_UI16($self->LoopCount) if ($flags & 4);
    $self->EnvelopeRecords->pack($stream) if ($flags & 8);
}

{
    my $bit = 0;
    for my $f (qw/ HasInPoint HasOutPoint HasLoops HasEnvelope SyncNoMultiple SyncStop /) {
      SWF::Element::_create_flag_accessor($f, 'SyncFlags', $bit++);
    }
}

##########

package SWF::Element::Tag::DefineSound;

sub _unpack {
    my ($self, $stream)=@_;

    $self->SoundID->unpack($stream);
    $self->Flags($stream->get_UI8);
    $self->SoundSampleCount($stream->get_UI32);
    $self->SoundData->unpack($stream, $self->Length - 7);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->SoundID->pack($stream);
    $stream->set_UI8($self->Flags);
    $stream->set_UI32($self->SoundSampleCount);
    $self->SoundData->pack($stream);
}

 SWF::Element::_create_flag_accessor("SoundFormat", 'Flags', 4, 4);
 SWF::Element::_create_flag_accessor("SoundRate", 'Flags', 2, 2);
 SWF::Element::_create_flag_accessor("SoundSize", 'Flags', 1, 1);
 SWF::Element::_create_flag_accessor("SoundType", 'Flags', 0, 1);

##########

package SWF::Element::Tag::SoundStreamBlock;

sub _unpack {
    my ($self, $stream)=@_;

    $self->StreamSoundData->unpack($stream, $self->Length);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->StreamSoundData->pack($stream);
}

##########

package SWF::Element::Tag::SoundStreamHead;

sub _unpack {
    my ($self, $stream)=@_;

    $self->Flags($stream->get_UI16);
    $self->StreamSoundSampleCount($stream->get_UI16);
    $self->LatencySeek($stream->get_SI16) if $self->Length == 6;
}

sub _pack {
    my ($self, $stream)=@_;

    $stream->set_UI16($self->Flags);
    $stream->set_UI16($self->StreamSoundSampleCount);
    $stream->set_SI16($self->LatencySeek) if $self->StreamSoundCompression == 2 and defined($self->LatencySeek);
}


SWF::Element::_create_flag_accessor('StreamSoundCompression', 'Flags',12, 4);
SWF::Element::_create_flag_accessor('StreamSoundRate', 'Flags', 10, 2);
SWF::Element::_create_flag_accessor('StreamSoundSize', 'Flags', 9, 1);
SWF::Element::_create_flag_accessor('StreamSoundType', 'Flags', 8, 1);
SWF::Element::_create_flag_accessor('PlaybackSoundRate', 'Flags', 2, 2);
SWF::Element::_create_flag_accessor('PlaybackSoundSize', 'Flags', 1, 1);
SWF::Element::_create_flag_accessor('PlaybackSoundType', 'Flags', 0, 1);

####  Sprites  ####
##########

package SWF::Element::TAGSTREAM;

use SWF::Parser;

sub new {
    my $self;
    bless \$self, shift;
}

sub configure {
    my ($self, $data, $version) = @_;

    $$self = SWF::BinStream::Read->new($data, undef, $version);
    $self;
}

sub dumper {
    my ($self, $outputsub)=@_;

    $outputsub||=\&SWF::Element::_default_output;

    &$outputsub('undef', 0);
}

sub defined {
    defined ${+shift};
}

sub parse {
    my ($self, $p, $callback) = @_;

    if (ref($p) eq 'CODE' and !defined $callback) {
	$callback = $p;
    } elsif (lc($p) ne 'callback' or ref($callback) ne 'CODE') {
      Carp::croak "Callback subroutine is needed to parse tags of sprite";
    }
    my $parser = SWF::Parser->new('tag-callback' => $callback, stream => $$self, header => 'no');
    $parser->parse;
}

##########

package SWF::Element::Tag::DefineSprite;

sub _unpack {
    my ($self, $stream)=@_;

    $self->SpriteID->unpack($stream);
    $self->FrameCount($stream->get_UI16);
    $self->ControlTags->unpack($stream);
}

sub shallow_unpack {
    my ($self, $stream) = @_;

    $self->SpriteID->unpack($stream);
    $self->FrameCount($stream->get_UI16);
    $self->TagStream($stream->get_string($self->Length - 4), $stream->Version);
}

sub _pack {
    my ($self, $stream)=@_;

    $self->SpriteID->pack($stream);
    my $tempstream = $stream->sub_stream;
    for my $tag (@{$self->ControlTags}) {
	unless ($tag->is_tagtype('ValidInSprite')) {
	  Carp::carp $tag->tag_name." is invalid tag in DefineSprite " ;
	    next;
	}
	$tag->pack($tempstream);
    }
    $stream->set_UI16($tempstream->{_framecount});
    $tempstream->flush_stream;
}

####  Display List  ####
##########

package SWF::Element::Tag::PlaceObject;

sub _unpack {
    my ($self, $stream)=@_;

    my $start = $stream->tell;

    $self->CharacterID->unpack($stream);
    $self->Depth->unpack($stream);
    $self->Matrix->unpack($stream);
    if ($stream->tell < $start + $self->Length) {
	$self->ColorTransform->unpack($stream);
    }
}

sub _pack {
    my ($self, $stream)=@_;

    $self->CharacterID->pack($stream);
    $self->Depth->pack($stream);
    $self->Matrix->pack($stream);
    $self->ColorTransform->pack($stream) if $self->ColorTransform->defined;
}

##########

package SWF::Element::Tag::PlaceObject2;

sub _unpack {
    my ($self, $stream)=@_;

    my $flag = $self->Flags($stream->get_UI8);
    $self->Depth         ->unpack($stream);
    $self->CharacterID   ->unpack($stream) if $flag & 2;
    $self->Matrix        ->unpack($stream) if $flag & 4;
    $self->ColorTransform->unpack($stream) if $flag & 8;
    $self->Ratio($stream->get_UI16)        if $flag & 16;
    $self->Name          ->unpack($stream) if $flag & 32;
    $self->ClipDepth     ->unpack($stream) if $flag & 64;
    if ($flag & 128) {
	$stream->get_UI16; # skip reserved.
	if ($stream->Version >= 6) {  # skip clipaction flag
	    $stream->get_UI32;
#	    $stream->get_UI16;
	} else {
	    $stream->get_UI16;
	}
	$self->ClipActions->unpack($stream);
    }
}

sub _pack {
    my ($self, $stream)=@_;
    my $flag = ($self->PlaceFlagMove |
	       ((my $cid = $self->CharacterID)->defined) << 1 |
	       ((my $matrix = $self->Matrix)  ->defined) << 2 |
	       ((my $ctfm = $self->ColorTransform)->defined) << 3 |
	       (defined (my $ratio = $self->Ratio) << 4) |
	       ((my $name = $self->Name)->defined) << 5 |
	       ((my $cdepth = $self->ClipDepth)->defined) << 6 |
	       ((my $caction = $self->ClipActions)->defined) << 7) ;
    $stream->set_UI8($flag);
    $self->Depth->pack($stream);
    $cid   ->pack($stream)     if $flag & 2;
    $matrix->pack($stream)     if $flag & 4;
    $ctfm  ->pack($stream)     if $flag & 8;
    $stream->set_UI16($ratio)  if $flag & 16;
    $name  ->pack($stream)     if $flag & 32;
    $cdepth->pack($stream)     if $flag & 64;
    if ($flag & 128) {
	$stream->set_UI16(0);  # Reserved.
	my $f = 0;
	for my $e (@{$caction}) {
	    $f |= $e->EventFlags;
	}
	if ($stream->Version >= 6) {
	    $stream->set_UI32($f);
	} else {
	    $stream->set_UI16($f);
	}
	$caction->pack($stream);
    }
}

sub lookahead_CharacterID {
    my ($self, $stream) = @_;
    $self->lookahead_Flags($stream);
    $self->CharacterID($stream->lookahead_UI16(2)) if $self->PlaceFlagHasCharacter;
};

{
    my $bit = 0;
    for my $f (qw/ Move HasCharacter HasMatrix HasColorTransform HasRatio HasName HasClipDepth HasClipActions /) {
      SWF::Element::_create_flag_accessor("PlaceFlag$f", 'Flags', $bit++);
    }
}

##########

package SWF::Element::Tag::ShowFrame;

sub pack {
    my ($self, $stream) = @_;

    $self->SUPER::pack($stream);
    $stream->{_framecount}++;
}

package SWF::Element::Tag::ShowFrame::Packed;

sub pack {
    my ($self, $stream) = @_;

    $self->SUPER::pack($stream);
    $stream->{_framecount}++;
}

####  Controls  ####
##########

package SWF::Element::Tag::Protect;

sub _unpack {
    my ($self, $stream) = @_;

    $self->Reserved($stream->get_UI16);
    $self->Password->unpack($stream);
}

sub _pack {
    my ($self, $stream) = @_;

    $self->Password->pack($stream) if $self->Password->defined;
}

##########

package SWF::Element::Tag::FrameLabel;

sub _unpack {
    my ($self, $stream) = @_;

    $self->Name->unpack($stream);
    if ($self->Length > length($self->Name->value)+1) {
	$self->NamedAnchorFlag($stream->get_UI8);
    }
}

sub _pack {
    my ($self, $stream) = @_;

    $self->Name->pack($stream);
    $stream->set_UI8($self->NamedAnchorFlag) if $self->NamedAnchorFlag;
}

####  Actions  ####
##########

package SWF::Element::ACTIONRECORD;


our %actiontagtonum=(
    ActionEnd                      => 0x00,
    ActionNextFrame                => 0x04,
    ActionPrevFrame                => 0x05,
    ActionPlay                     => 0x06,
    ActionStop                     => 0x07,
    ActionToggleQuality            => 0x08,
    ActionStopSounds               => 0x09,
    ActionAdd                      => 0x0A,
    ActionSubtract                 => 0x0B,
    ActionMultiply                 => 0x0C,
    ActionDivide                   => 0x0D,
    ActionEquals                   => 0x0E,
    ActionLess                     => 0x0F,
    ActionAnd                      => 0x10,
    ActionOr                       => 0x11,
    ActionNot                      => 0x12,
    ActionStringEquals             => 0x13,
    ActionStringLength             => 0x14,
    ActionStringExtract            => 0x15,
    ActionPop                      => 0x17,
    ActionToInteger                => 0x18,
    ActionGetVariable              => 0x1C,
    ActionSetVariable              => 0x1D,
    ActionSetTarget2               => 0x20,
    ActionStringAdd                => 0x21,
    ActionGetProperty              => 0x22,
    ActionSetProperty              => 0x23,
    ActionCloneSprite              => 0x24,
    ActionRemoveSprite             => 0x25,
    ActionTrace                    => 0x26,
    ActionStartDrag                => 0x27,
    ActionEndDrag                  => 0x28,
    ActionStringLess               => 0x29,
    ActionThrow                    => 0x2a,
    ActionCastOp                   => 0x2b,
    ActionImplementsOp             => 0x2c,
    ActionFSCommand2               => 0x2d,
    ActionRandomNumber             => 0x30,
    ActionMBStringLength           => 0x31,
    ActionCharToAscii              => 0x32,
    ActionAsciiToChar              => 0x33,
    ActionGetTime                  => 0x34,
    ActionMBStringExtract          => 0x35,
    ActionMBCharToAscii            => 0x36,
    ActionMBAsciiToChar            => 0x37,
    ActionDelete                   => 0x3a,
    ActionDelete2                  => 0x3b,
    ActionDefineLocal              => 0x3c,
    ActionCallFunction             => 0x3d,
    ActionReturn                   => 0x3e,
    ActionModulo                   => 0x3f,
    ActionNewObject                => 0x40,
    ActionDefineLocal2             => 0x41,
    ActionInitArray                => 0x42,
    ActionInitObject               => 0x43,
    ActionTypeOf                   => 0x44,
    ActionTargetPath               => 0x45,
    ActionEnumerate                => 0x46,
    ActionAdd2                     => 0x47,
    ActionLess2                    => 0x48,
    ActionEquals2                  => 0x49,
    ActionToNumber                 => 0x4a,
    ActionToString                 => 0x4b,
    ActionPushDuplicate            => 0x4C,
    ActionStackSwap                => 0x4d,
    ActionGetMember                => 0x4e,
    ActionSetMember                => 0x4f,
    ActionIncrement                => 0x50,
    ActionDecrement                => 0x51,
    ActionCallMethod               => 0x52,
    ActionNewMethod                => 0x53,
    ActionInstanceOf               => 0x54,
    ActionEnumerate2               => 0x55,
    ActionBitAnd                   => 0x60,
    ActionBitOr                    => 0x61,
    ActionBitXor                   => 0x62,
    ActionBitLShift                => 0x63,
    ActionBitRShift                => 0x64,
    ActionBitURShift               => 0x65,
    ActionStrictEquals             => 0x66,
    ActionGreater                  => 0x67,
    ActionStringGreater            => 0x68,
    ActionExtends                  => 0x69,
#    ActionCall                     => 0x9e,
);

our %actionnumtotag= reverse %actiontagtonum;

sub new {
    my ($class, @headerdata)=@_;
    my %headerdata = ref($headerdata[0]) eq 'ARRAY' ? @{$headerdata[0]} : @headerdata;
    my $self = [];
    my $tag = $headerdata{Tag};

    if (defined($tag) and $tag !~/^\d+$/) {
	$tag = "Action$tag" unless $tag =~ /^Action/;
	my $tag1 = $actiontagtonum{$tag};
	Carp::croak "ACTIONRECORD '$tag' is not defined." unless defined $tag1;
	$tag = $tag1;
    }
    delete $headerdata{Tag};
    $class=ref($class)||$class;
    bless $self, $class;
    if (defined $tag) {
	$self->Tag($tag);
	bless $self, _action_class($tag);
    }
    $self->_init;
    $self->configure(%headerdata) if %headerdata;
    $self;
}

sub _init {}

sub configure {
    my ($self, @param)=@_;
    @param = @{$param[0]} if ref($param[0]) eq 'ARRAY';
    my %param=@param;

    if (defined $param{Tag}) {
	my $tag = $param{Tag};
	if ($tag !~/^\d+$/) {
	    $tag = "Action$tag" if $tag !~ /^Action/;
	    my $tag1 = $actiontagtonum{$tag};
	    Carp::croak "ACTIONRECORD '$tag1' is not defined." unless defined $tag1;
	    $tag = $tag1;
	}
	delete $param{Tag};
	$self->Tag($tag);
	bless $self, _action_class($tag);
	$self->_init;
    }
    $self->SUPER::configure(%param);
}

sub _action_class {
    my $num = shift;
    my $name = $actionnumtotag{$num};
    if (!$name and $num >= 0x80) {
	$name = 'ActionUnknown';
    }
    if ($num >=0x80) {
	return "SWF::Element::ACTIONRECORD::$name";
    } else {
	return "SWF::Element::ACTIONRECORD";
    }
}

sub unpack {
    my $self = shift;
    my $stream = shift;

    $self->Tag->unpack($stream);
    if ($self->Tag >= 0x80) {
	bless $self, _action_class($self->Tag);
	$self->_init;
	my $len = $stream->get_UI16;
	my $start = $stream->tell;
	$self->_unpack($stream, $len);
#	my $read = $stream->tell - $start;
#	if ($read < $len) {
#	    $stream->get_string($len-$read);  # Skip the rest of tag data.
#	} elsif ($read > $len) {
#	    Carp::carp ref($self)." unpacked $read bytes in excess of the described ACTIONRECORD length, $len bytes.  The SWF may be collapsed or the module bug??";
#	}  # Some SWFs have an invalid action tag length (?)
    }
}

sub pack {
    my ($self, $stream) = @_;

    $self->Tag->pack($stream);
    if ($self->Tag >= 0x80) {
	my $substream = $stream->sub_stream;
	$self->_pack($substream);
	$stream->set_UI16($substream->tell);
	$substream->flush_stream;
    }
}

sub _unpack {
    my $self = shift;
  Carp::confess "Unexpected _unpack for ".ref($self)." ".$self->Tag;
}

sub _pack {
  Carp::confess "Unexpected _pack";
}

sub tag_name {
    return $actionnumtotag{shift->Tag};
}

sub _create_action_tag {
    no strict 'refs';

    my $tagname = shift;
    my $tagno = shift;
    my $tagisa = shift;
    $tagisa = defined($tagisa) ? "ACTIONRECORD::_$tagisa" :  'ACTIONRECORD';
    $tagname = "Action$tagname";
    SWF::Element::_create_class("ACTIONRECORD::$tagname", [$tagisa], Tag => 'ACTIONTagNumber', LocalLabel => "\$", @_);

    $actionnumtotag{$tagno} = $tagname;
    $actiontagtonum{$tagname} = $tagno;

    my $packsub = <
sub \{
    my \$self = shift;
    my \$stream = shift;
SUB_START
    my $unpacksub = $packsub;

    my $classname = "SWF::Element::ACTIONRECORD::$tagname";
    my @names = $classname->element_names;
    shift @names;
    shift @names;
    for my $key (@names) {
	if ($classname->element_type($key) !~ /^\$(.*)$/) {
	    $packsub .= "\$self->$key->pack(\$stream, \@_);";
	    $unpacksub .= "\$self->$key->unpack(\$stream, \@_);";
	} else {
	    $packsub .= "\$stream->set_$1(\$self->$key);";
	    $unpacksub .= "\$self->$key(\$stream->get_$1);";
	}
    }
    $unpacksub .='}';
    *{"${classname}::_unpack"} = eval($unpacksub);

    if ($tagisa eq 'ACTIONRECORD') {
	$packsub .='}';
	*{"${classname}::_pack"} = eval($packsub);
    }
}

sub _set_label {}

@SWF::Element::ACTIONRECORD::_HasSkipCount::ISA=('SWF::Element::ACTIONRECORD');
@SWF::Element::ACTIONRECORD::_HasOffset::ISA=('SWF::Element::ACTIONRECORD');
@SWF::Element::ACTIONRECORD::_HasCodeSize::ISA=('SWF::Element::ACTIONRECORD::_HasOffset');

_create_action_tag('Unknown',  'Unknown', undef, Data       => 'BinData');
_create_action_tag('GotoFrame',     0x81, undef, Frame      => '$UI16');
_create_action_tag('GetURL',        0x83, undef,
		   UrlString    => 'STRING',
		   TargetString => 'STRING' );
_create_action_tag('WaitForFrame',  0x8A, 'HasSkipCount',
		   Frame     => '$UI16',
		   SkipCount => '$UI8' );
_create_action_tag('SetTarget',     0x8B, undef, TargetName  => 'STRING' );
_create_action_tag('GotoLabel',     0x8C, undef, Label       => 'STRING' );
_create_action_tag('WaitForFrame2', 0x8D, 'HasSkipCount',
                   SkipCount   => '$UI8' );
_create_action_tag('Push',          0x96, undef, DataList    => 'Array::ACTIONDATAARRAY' );
_create_action_tag('Jump',          0x99, 'HasOffset',
                   BranchOffset=> '$SI16');
_create_action_tag('GetURL2',       0x9a, undef, Method      => '$UI8');
_create_action_tag('If',            0x9d, 'HasOffset',
                   BranchOffset=> '$SI16');
_create_action_tag('Call',          0x9e, undef);
_create_action_tag('GotoFrame2',    0x9F, undef, PlayFlag    => '$UI8');
_create_action_tag('ConstantPool',  0x88, undef,
		   ConstantPool => 'Array::STRINGARRAY');
_create_action_tag('DefineFunction',   0x9b, 'HasCodeSize',
		   FunctionName => 'STRING',
		   Params       => 'Array::STRINGARRAY',
                   CodeSize     => '$UI16');
_create_action_tag('StoreRegister', 0x87, undef, Register   => '$UI8');
_create_action_tag('With',          0x94, 'HasCodeSize',
                   CodeSize => '$UI16');

_create_action_tag('DefineFunction2', 0x8e, 'HasCodeSize',
		   FunctionName  => 'STRING',
                   RegisterCount => '$UI8',
                   Flags         => '$UI16',
                   Parameters    => 'Array::REGISTERPARAMARRAY',
                   CodeSize      => '$UI16');

_create_action_tag('Try', 0x8f, undef,
                   TrySize       => '$UI16',
                   CatchSize     => '$UI16',
                   FinallySize   => '$UI16',
                   CatchName     => 'STRING',
                   CatchRegister => '$UI8');

_create_action_tag('StrictMode', 0x89, undef, StrictMode => '$UI8');

##########

package SWF::Element::ACTIONTagNumber;

sub dumper {
    my ($self, $outputsub)=@_;

    $outputsub||=\&SWF::Element::_default_output;
    my $tag = $SWF::Element::ACTIONRECORD::actionnumtotag{$self->value};
    &$outputsub($tag ? "'$tag'" : $self->value, 0);
}

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI8($self->value);
}

sub unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_UI8);
}

##########

package SWF::Element::Array::ACTIONDATAARRAY;

sub unpack {
    my ($self, $stream, $len) = @_;
    my $start = $stream->tell;

    while ($stream->tell - $start < $len) {
	my $element = $self->new_element;
	$element->unpack($stream);
	push @$self, $element;
    }
}

##########

package SWF::Element::ACTIONDATA;

sub configure {
    my ($self, $type, $data) = @_;

    if (defined $data) {
	if ($type eq 'Type') {
	    $type = $data;
	    undef $data;
	}
	my $class = "SWF::Element::ACTIONDATA::$type";
	Carp::croak "No Data type '$type' in ACTIONDATA " unless $class->can('new');
	bless $self, $class;
    } else {
	$data = $type;
    }

    $$self = $data if defined $data;
    $self;
}

sub dumper {
    my ($self, $outputsub, $indent)=@_;

    $outputsub||=\&SWF::Element::_default_output;

    my $val = $self->value;

    $val = "\"$val\"" if $val !~ /^-?[.\d]/;

    &$outputsub(ref($self)."->new($val)", 0);
}

my @actiondata_types
     = qw/String Property NULL UNDEF Register Boolean Double Integer Lookup Lookup/;

sub pack {
    my ($self, $stream) = @_;

    Carp::carp "No specified type in ACTIONDATA, so pack as String. ";
    $self->configure(Type => 'String');
    $self->pack($stream);
}

sub unpack {
    my ($self, $stream) = @_;
    my $type = $stream->get_UI8;

    Carp::croak "Undefined type '$type' in ACTIONDATA "
	if $type > $#actiondata_types;

    bless $self, "SWF::Element::ACTIONDATA::$actiondata_types[$type]";
    $self->_unpack($stream, $type);
}

sub _unpack {};

#########

package SWF::Element::ACTIONDATA::String;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI8(0);
    $stream->set_string($self->value."\0");
}

sub _unpack {
  SWF::Element::STRING::unpack(@_);
}

sub dumper {
    my ($self, $outputsub, $indent)=@_;

    $outputsub||=\&SWF::Element::_default_output;

    my $val = $self->value;

    $val =~ s/([\\\$\@\"])/\\$1/gs;
    $val =~ s/([\x00-\x1F\x80-\xFF])/sprintf('\\x%.2X', ord($1))/ges;
    $val = "\"$val\"";

    &$outputsub(ref($self)."->new($val)", 0);
}

#########
{
    package SWF::Element::ACTIONDATA::Property;

    my %prop_num =
	( _x            =>          0,
	  _y            => 1065353216,
          _xscale       => 1073741824,
	  _yscale       => 1077936128,
	  _currentframe => 1082130432,
	  _totalframes  => 1084227584,
	  _alpha        => 1086324736,
	  _visible      => 1088421888,
	  _width        => 1090519040,
	  _height       => 1091567616,
	  _rotation     => 1092616192,
	  _target       => 1093664768,
	  _framesloaded => 1094713344,
	  _name         => 1095761920,
	  _droptarget   => 1096810496,
	  _url          => 1097859072,
	  _highquality  => 1098907648,
	  _focusrect    => 1099431936,
	  _soundbuftime => 1099956224,
	  _quality      => 1100480512,
	  _xmouse       => 1101004800,
	  _ymouse       => 1101529088,
	  );
    my %num_prop = reverse %prop_num;

    sub pack {
	my ($self, $stream) = @_;
	my $data = $self->value;

	$stream->set_UI8(1);
	$data = (exists $prop_num{$data}) ? $prop_num{$data} : unpack('L', CORE::pack('f', $data));
	$stream->set_UI32($data);

    }

    sub _unpack {
	my ($self, $stream) = @_;
	my $data = $stream->get_UI32;
	$data = (exists $num_prop{$data}) ? $num_prop{$data} : unpack('f', CORE::pack('L', $data));
	$self->configure($data);
    }
}

#########

package SWF::Element::ACTIONDATA::NULL;

sub pack {
    $_[1]->set_UI8(2);
}

#########

package SWF::Element::ACTIONDATA::UNDEF;

sub pack {
    $_[1]->set_UI8(3);
}

#########

package SWF::Element::ACTIONDATA::Register;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI8(4);
    $stream->set_UI8($self->value);
}

sub _unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_UI8);
}

#########

package SWF::Element::ACTIONDATA::Boolean;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI8(5);
    $stream->set_UI8($self->value);
}

sub _unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_UI8);
}

#########

package SWF::Element::ACTIONDATA::Lookup;

sub pack {
    my ($self, $stream) = @_;

    if ((my $v = $self->value) >= 256) {
	$stream->set_UI8(9);
	$stream->set_UI16($v);
    } else {
	$stream->set_UI8(8);
	$stream->set_UI8($v);
    }
}

sub _unpack {
    my ($self, $stream, $type) = @_;

    $self->configure($type == 8 ? $stream->get_UI8 : $stream->get_UI16);
}

#########

package SWF::Element::ACTIONDATA::Integer;

sub pack {
    my ($self, $stream) = @_;

    $stream->set_UI8(7);
    $stream->set_SI32($self->value); # really signed?
}

sub _unpack {
    my ($self, $stream) = @_;

    $self->configure($stream->get_SI32); # really signed?
}

#########
{
    package SWF::Element::ACTIONDATA::Double; # IEEE754 double support needed.

    my $BE = (CORE::pack('s',1) eq CORE::pack('n',1));
    my $INF  = "\x00\x00\x00\x00\x00\x00\xf0\x7f";
    my $NINF = "\x00\x00\x00\x00\x00\x00\xf0\xff";
    my $MANTISSA = ~$NINF;

    sub pack {
	my ($self, $stream) = @_;

	$stream->set_UI8(6);
	my $value = $self->value;
	my $data;
	if ($value eq 'NaN') {
	    $data = "\x00\x00\x00\x00\x00\x00\xf8\x7f";
	} elsif ($value eq 'Infinity') {
	    $data = $INF;
	} elsif ($value eq '-Infinity') {
	    $data = $NINF;
	} else {
	    $data = CORE::pack('d', $value);
	    $data = reverse $data if $BE;
	}
	$stream->set_string(substr($data, -4));
	$stream->set_string(substr($data,0,4));
    }

    sub _unpack {
	my ($self, $stream) = @_;
	my $data = $stream->get_string(4);
	$data = $stream->get_string(4). $data;

	my $value;

	if (($data & $INF) eq $INF and ($data & $MANTISSA) ne "\x00" x 8) {
	    $value = 'NaN';
	} elsif ($data eq $INF) {
	    $value = 'Infinity';
	} elsif ($data eq $NINF) {
	    $value = '-Infinity';
	} else {
	    $data = reverse $data if $BE;
	    $value = unpack('d',$data);
	}
	$self->configure($value);
    }

}

##########

package SWF::Element::CLIPACTIONRECORD;

sub unpack {
    my ($self, $stream) = @_;

    my $flag = 0;
    $stream->_lock_version;
    if ($stream->Version >= 6) {
	$flag = $self->EventFlags ($stream->get_UI32);
    } else {
	$flag = $self->EventFlags ($stream->get_UI16);
    }
    return if $flag == 0;
    my $size = $stream->get_UI32;
    my $start = $stream->tell;
    $self->KeyCode($stream->get_UI8)if $self->ClipEventKeyPress;
    $self->Actions->unpack($stream);
    my $remain = $stream->tell - $start - $size;
    $stream->get_string($remain) if $remain > 0;
}

sub pack {
    my ($self, $stream) = @_;

    $stream->_lock_version;
    if ($stream->Version >= 6) {
	$stream->set_UI32($self->EventFlags);
   } else {
	$stream->set_UI16($self->EventFlags & 0xffff);
    }

    my $tempstream = $stream->sub_stream;
    $tempstream->set_UI8($self->KeyCode) if $self->ClipEventKeyPress;
    $self->Actions->pack($tempstream);
    $stream->set_UI32($tempstream->tell);
    $tempstream->flush_stream;
}

{
    my $bit = 0;
    for my $f
	( qw/ Load           EnterFrame  Unload     MouseMove
	      MouseDown      MouseUp     KeyDown    KeyUp
	      Data           Initialize  Press      Release
	      ReleaseOutside RollOver    RollOut    DragOver
	      DragOut        KeyPress    Construct
	  / ) {
      SWF::Element::_create_flag_accessor("ClipEvent$f", 'EventFlags', $bit++);
    }
}

##########

package SWF::Element::Array::ACTIONRECORDARRAY;

sub pack {
    my $self = shift;
    my $stream = $_[0];

    # Add ActionEnd if there is not.

    push @$self, SWF::Element::ACTIONRECORD->new(Tag=>'ActionEnd') if $self->[-1]->Tag != 0;

    my $actionstream = SWF::BinStream::Write->new($stream->Version);
    my %labels;
    my $count = 0;

    # Keep label positions.

    for my $element (@$self) {
	$labels{$element->LocalLabel} = [$count, $actionstream->tell] if ($element->LocalLabel);
	$count++;
	$element->pack($actionstream, @_);
    }

    my %marks = $actionstream->mark;
    my @replace;

    for my $label (keys %marks) {
	(my $label1 = $label)=~s/\#.*$//;   # inner local label
      Carp::croak "Can't find LocalLabel '$label1' " unless defined $labels{$label1};

	while(my ($tell, $obj) = splice(@{$marks{$label}}, 0, 2)) {
	    my ($data, $length) = $obj->_resolve_label($tell, $labels{$label1}, $self);

	    if ($length >= 2 and $tell % 1024 == 1023) {
		my @data = split //, $data;
		push @{$replace[$tell>>10]}, [1023, 1, $data[0]];
		push @{$replace[($tell>>10)+1]}, [0, 1, $data[1]];
	    } else {
		push @{$replace[$tell>>10]}, [$tell % 1024, $length, $data];
	    }
	}
    }

    while($actionstream->Length > 0) {
	my $buf = $actionstream->flush_stream(1024);
	my $replace1 = shift @replace;
	while (my $replace2 = shift @$replace1) {
	    my ($pos, $len, $r) = @$replace2;
	    substr($buf, $pos, $len) = $r;
	}
	$stream->set_string($buf);
    }
}

{
    my $label;

    sub unpack {
	my ($self, $stream, $len) = @_;
	my @byteoffset;
	my $start = $stream->tell;

	while(!defined $len or $stream->tell - $start < $len) {
	    push @byteoffset, $stream->tell-$start;
	    my $element = $self->new_element;
	    $element->unpack($stream);
	    push @$self, $element;
	    last if !defined $len and $element->Tag == 0;
	}
	$label = 'A';
	for (my $i = 0; $i < @byteoffset; $i++) {
	    $self->[$i]->_set_label($i, $self, \@byteoffset);
	}
    }

    sub _get_label {
	$label++;
    }
}

##########

package SWF::Element::ACTIONRECORD::_HasSkipCount;

sub _set_label {
    my ($self, $pos, $actionstream) = @_;
    my $skip = $self->SkipCount;
    my $dst = $actionstream->[$pos + $skip+1];

    my $l = $dst->LocalLabel;
    unless ($l) {
	$l = $actionstream->_get_label;
	$dst->LocalLabel($l);
    }
    $self->SkipCount("$l#$skip");
}

##########

package SWF::Element::ACTIONRECORD::ActionWaitForFrame;

sub _pack {
    my ($self, $stream) = @_;

    $stream->set_UI16($self->Frame);
    my $skip = $self->SkipCount;

    if ($skip =~ /^[^\d]/) {
	$stream->mark($skip, bless [$self], 'SWF::Element::_Label::SkipCount');
	$stream->set_UI8(0);
    } else {
	$stream->set_UI8($skip);
    }
}

##########

package SWF::Element::ACTIONRECORD::ActionWaitForFrame2;

sub _pack {
    my ($self, $stream) = @_;
    my $skip = $self->SkipCount;

    if ($skip =~ /^[^\d]/) {
	$stream->mark($skip, bless [$self], 'SWF::Element::_Label::SkipCount');
	$stream->set_UI8(0);
    } else {
	$stream->set_UI8($skip);
    }
}

##########

package SWF::Element::ACTIONRECORD::_HasOffset;

sub _set_label {
    my ($self, $pos, $actionstream, $byteoffset) = @_;
    my $offset = $self->_Offset;
    my $j = $pos+1;
    my $set = $byteoffset->[$j];
    my $dst = $set;
    if ($offset < 0) {
	while ($j>=0 and ($dst-$set) > $offset) {
	    $j--;
	    $dst = $byteoffset->[$j];
	}
    } else {
	while ($j<@$byteoffset and ($dst-$set) < $offset) {
	    $j++;
	    $dst = $byteoffset->[$j];
	}
    }
    if ($dst-$set == $offset) {
	my $l = $actionstream->[$j]->LocalLabel;
	unless ($l) {
	    $l = $actionstream->_get_label;
	    $actionstream->[$j]->LocalLabel($l);
	}
	$self->_Offset("$l#$offset");
    }
}

##########

package SWF::Element::ACTIONRECORD::ActionJump;

sub _pack {
    my ($self, $stream) = @_;
    my $offset = $self->BranchOffset;

    if ($offset =~ /^[^\d\-]/) {
	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::Offset');
	$stream->set_SI16(0);
    } else {
	$stream->set_SI16($offset);
    }
}

*SWF::Element::ACTIONRECORD::ActionJump::_Offset = \&BranchOffset;
*SWF::Element::ACTIONRECORD::ActionIf::_Offset = \&BranchOffset;
*SWF::Element::ACTIONRECORD::ActionIf::_pack = \&_pack;

##########

package SWF::Element::ACTIONRECORD::ActionGetURL2;

SWF::Element::_create_flag_accessor('SendVarsMethod', 'Method', 0, 2);
SWF::Element::_create_flag_accessor('LoadTargetFlag', 'Method', 6);
SWF::Element::_create_flag_accessor('LoadVariablesFlag', 'Method', 7);

##########

package SWF::Element::ACTIONRECORD::ActionDefineFunction;

sub _pack {
    my ($self, $stream) = @_;

    $self->FunctionName->pack($stream);
    $self->Params->pack($stream);

    my $offset = $self->CodeSize;

    if ($offset =~ /^\D/) {
	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
	$stream->set_UI16(0);
    } else {
	$stream->set_UI16($offset);
    }
}

*SWF::Element::ACTIONRECORD::ActionDefineFunction::_Offset = \&CodeSize;

##########

package SWF::Element::ACTIONRECORD::ActionWith;

sub _pack {
    my ($self, $stream) = @_;

    my $offset = $self->CodeSize;

    if ($offset =~ /^\D/) {
	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
	$stream->set_UI16(0);
    } else {
	$stream->set_UI16($offset);
    }
}

*SWF::Element::ACTIONRECORD::ActionWith::_Offset = \&CodeSize;

##########

package SWF::Element::ACTIONRECORD::ActionDefineFunction2;

sub _pack {
    my ($self, $stream) = @_;

    $self->FunctionName->pack($stream);
    $stream->set_UI16(scalar @{$self->Parameters});
    $stream->set_UI8($self->RegisterCount);
    $stream->set_UI16($self->Flags);
    $self->Parameters->pack($stream);

    my $offset = $self->CodeSize;

    if ($offset =~ /^\D/) {
	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
	$stream->set_UI16(0);
    } else {
	$stream->set_UI16($offset);
    }
}

{
    no warnings 'redefine';

    *SWF::Element::ACTIONRECORD::ActionDefineFunction2::_unpack = sub {
	my ($self, $stream) = @_;

	$self->FunctionName->unpack($stream);
	my $numparams = $stream->get_UI16;
	$self->RegisterCount($stream->get_UI8);
	$self->Flags($stream->get_UI16);
	my $params = $self->Parameters;
	for (my $c = 0 ; $c < $numparams; $c++) {
	    my $p = $params->new_element;
	    $p->unpack($stream);
	    push @$params, $p;
	}
	$self->CodeSize($stream->get_UI16);
    }
}

*SWF::Element::ACTIONRECORD::ActionDefineFunction2::_Offset = \&CodeSize;

{
    my $bit = 0;
    for my $f (qw/ This Arguments Super /) {
      SWF::Element::_create_flag_accessor("Preload${f}Flag", 'Flags', $bit++);
      SWF::Element::_create_flag_accessor("Suppress${f}Flag", 'Flags', $bit++);
    }
    for my $f (qw/ Root Parent Global /) {
      SWF::Element::_create_flag_accessor("Preload${f}Flag", 'Flags', $bit++);
    }
}

##########

package SWF::Element::ACTIONRECORD::ActionTry;

{
    no warnings 'redefine';

    *SWF::Element::ACTIONRECORD::ActionTry::_pack = sub {
	my ($self, $stream) = @_;

	my $flags = 0;
	my ($trylabel) = ($self->TrySize =~ /^(.*#)/);
	my ($catchlabel) = ($self->CatchSize =~ /^(.*#)/);
	my ($finallylabel) = ($self->FinallySize =~ /^(.*#)/);

	$flags |= 4 if defined $self->CatchRegister;
	$flags |= 2 if ($finallylabel and $finallylabel ne $catchlabel or !$finallylabel and $self->FinallySize != 0);
	$flags |= 1 if ($catchlabel and $catchlabel ne $trylabel or !$catchlabel and $self->CatchSize != 0);

	$stream->set_UI8($flags);

	my $byteoffset;
	my $current_byteoffset = $stream->tell;
	for my $n (qw/TrySize CatchSize FinallySize/) {
	    my $offset = $self->$n;
	    if ($offset =~ /^\D/) {
		my $label = bless [$self, \$byteoffset], "SWF::Element::_Label::$n";
		$stream->mark($offset, $label);
		$stream->set_UI16(0);
	    } else {
		$stream->set_UI16($offset);
	    }
	}

	if ($flags & 4) {
	    $stream->set_UI8($self->CatchRegister);
	} else {
	    $self->CatchName->pack($stream);
	}
	$byteoffset = $stream->tell - $current_byteoffset;
    };

    *SWF::Element::ACTIONRECORD::ActionTry::_unpack = sub {
	my ($self, $stream,$len) = @_;

	my $flags = $stream->get_UI8;
	$self->TrySize($stream->get_UI16);
	my $catchsize = $stream->get_UI16;
	$self->CatchSize($catchsize) if $flags & 1;
	my $finallysize = $stream->get_UI16;
	$self->FinallySize($finallysize) if $flags & 2;
	if ($flags & 4) {
	    $self->CatchRegister($stream->get_UI8);
	} else {
	    $self->CatchName->unpack($stream);
	}
    };
}

sub _set_label {
    my ($self, $pos, $actionstream, $byteoffset) = @_;
    my $j = $pos+1;

    for my $x_size (qw/ TrySize CatchSize FinallySize /) {
	my $offset = $self->$x_size;

	next if !defined $offset or $offset <= 0;

	my $set = $byteoffset->[$j];
	my $dst = $set;

	while ($j<@$byteoffset and ($dst-$set) < $offset) {
	    $j++;
	    $dst = $byteoffset->[$j];
	}

	if ($dst-$set == $offset) {
	    my $l = $actionstream->[$j]->LocalLabel;
	    unless ($l) {
		$l = $actionstream->_get_label;
		$actionstream->[$j]->LocalLabel($l);
	    }
	    $self->$x_size("$l#$offset");
	}
    }

}

##########

package SWF::Element::_Label::SkipCount;

sub _resolve_label {
    my ($self, $pos, $dst, $actions) = @_;
    my $count = 1;

    for my $element (@$actions) {
	last if $element eq $self->[0];
	$count++;
    }
    Carp::croak "SkipCount of ".ref($self->[0])." cannot refer backward " if $dst->[0] < $count;
    return (CORE::pack('C', $dst->[0] - $count), 1);
}

##########

package SWF::Element::_Label::Offset;

sub _resolve_label {
    my ($self, $pos, $dst) = @_;
    return (CORE::pack('v', $dst->[1] - $pos - 2), 2);
}

##########

package SWF::Element::_Label::CodeSize;

sub _resolve_label {
    my ($self, $pos, $dst) = @_;
    my $offset = $dst->[1] - $pos - 2;
  Carp::croak "Can't set negative code size for ".ref($self->[0]) if $offset < 0;
    return (CORE::pack('v', $offset), 2);
}

##########

package SWF::Element::_Label::TrySize;

sub _resolve_label {
    my ($self, $pos, $dst) = @_;
    my $offset = $dst->[1] - $pos - ${$self->[1]};
    (my $trylabel = $self->[0]->TrySize) =~ s/#.*$//;

  Carp::croak "Can't set negative code size for TrySize" if $offset < 0;
    $self->[0]->TrySize("$trylabel#$offset");
    return (CORE::pack('v', $offset), 2);
}

##########

package SWF::Element::_Label::CatchSize;

sub _resolve_label {
    my ($self, $pos, $dst) = @_;
    (my $trysize = $self->[0]->TrySize) =~ s/^.*#//;
    (my $catchlabel = $self->[0]->CatchSize) =~ s/#.*$//;
    my $offset = $dst->[1] - $pos - ${$self->[1]} - $trysize + 2;
  Carp::croak "Can't set negative code size for CatchSize" if $offset < 0;
    $self->[0]->CatchSize("$catchlabel#$offset");
    return (CORE::pack('v', $offset), 2);
}

##########

package SWF::Element::_Label::FinallySize;

sub _resolve_label {
    my ($self, $pos, $dst) = @_;
    (my $trysize = $self->[0]->TrySize) =~ s/^.*#//;
    (my $catchsize = $self->[0]->CatchSize) =~ s/^.*#//;
    (my $finallylabel = $self->[0]->FinallySize) =~ s/#.*$//;
    my $offset = $dst->[1] - $pos - ${$self->[1]} - $trysize - $catchsize + 4;
  Carp::croak "Can't set negative code size for FinallySize" if $offset < 0;
    $self->[0]->FinallySize("$finallylabel#$offset");
    return (CORE::pack('v', $offset), 2);
}



####  Video  ####
##########

package SWF::Element::Tag::DefineVideoStream;

SWF::Element::_create_flag_accessor('VideoFlagsSmoothing', 'VideoFlags', 0);
SWF::Element::_create_flag_accessor('VideoFlagsDeblocking', 'VideoFlags', 1, 2);

##########

package SWF::Element::Tag::VideoFrame;

sub _unpack {
    my ($self, $stream) = @_;

    $self->StreamID->unpack($stream);
    $self->FrameNum($stream->get_UI16);
    $self->VideoData->unpack($stream, $self->Length - 4);
}

##########

1;
__END__