1package SWF::Element;
2
3require 5.006;
4
5use strict;
6use vars qw($VERSION @ISA);
7
8use Carp;
9use SWF::BinStream;
10
11$VERSION = '0.42';
12
13sub new {
14    my $class = shift;
15    my $self = [];
16
17    $class=ref($class)||$class;
18
19    bless $self, $class;
20    $self->_init;
21    $self->configure(@_) if @_;
22    $self;
23}
24
25sub clone {
26    my $source = shift;
27    croak "Can't clone a class" unless ref($source);
28    my $f = 0;
29    my @attr = map {($f=($f==0)||not ref($_)) ? $_ : $_->clone} $source->configure;
30    $source->new(@attr);
31}
32
33sub new_element {
34    my $self = shift;
35    my $name = shift;
36    my $element;
37
38    eval {$element = $self->element_type($name)->new(@_)};
39    croak $@ if $@;
40    $element;
41}
42
43sub element_type {
44    no strict 'refs';
45    return ${(ref($_[0])||$_[0]).'::_Element_Types'}{$_[1]};
46}
47
48sub element_names {
49    no strict 'refs';
50    return @{(ref($_[0])||$_[0]).'::_Element_Names'};
51}
52
53sub configure {
54    my ($self, @param)=@_;
55    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY');
56
57    if (@param==0) {
58	my @names=$self->element_names;
59	my @result=();
60	my $key;
61	for $key (@names) {
62	    push @result, $key, $self->$key();
63	}
64	return @result;
65    } elsif (@param==1) {
66	my $key = $param[0];
67	return $self->$key();
68    } else {
69	my ($key, $value);
70	while (($key, $value) = splice(@param, 0, 2)) {
71	    $self->$key($value);
72	}
73	return $self;
74    }
75}
76
77sub defined {
78    my $self = shift;
79    my @names=$self->element_names;
80    my $d;
81
82    for my $key (@names) {
83	if ($self->element_type($key) !~ /^\$(.*)$/) {
84	    $d = $self->$key->defined;
85	    last if $d;
86	} else {
87	    $d = defined $self->$key;
88	    last if $d;
89	}
90    }
91    return $d;
92}
93
94sub dumper {
95    my ($self, $outputsub, $indent)=@_;
96    my @names=$self->element_names;
97
98    $indent ||= 0;
99    $outputsub||=\&_default_output;
100
101    &$outputsub(ref($self)."->new(\n", 0);
102    for my $key (@names) {
103	no warnings 'uninitialized';
104	if ($self->element_type($key) =~/^\$/) {
105	    my $p = $self->$key;
106	    $p = "\"$p\"" unless $p=~/^[-\d.]+$/;
107	    &$outputsub("$key => $p,\n", $indent+1) if defined($self->$key);
108	} elsif ($self->$key->defined) {
109	    &$outputsub("$key => ", $indent+1);
110	    $self->$key->dumper($outputsub, $indent+1);
111	    &$outputsub(",\n", 0);
112	}
113    }
114    &$outputsub(")", $indent);
115}
116
117sub _default_output {print ' ' x ($_[1] * 4), $_[0]};
118
119# _init, pack and unpack need to be overridden in the subclass.
120
121sub _init {   # set attributes, parameters, etc.
122}
123
124sub pack {
125  Carp::confess "Unexpected pack";
126}
127
128sub unpack {
129  Carp::confess "Unexpected unpack";
130}
131
132sub _create_pack {
133    my $classname = shift;
134    my $u = shift||'';
135    my $packsub = <<SUB_START;
136sub \{
137    my \$self = shift;
138    my \$stream = shift;
139SUB_START
140    my $unpacksub = $packsub;
141
142    no strict 'refs';
143
144    $classname = "SWF::Element::$classname";
145    for my $key ($classname->element_names) {
146	if ($classname->element_type($key) !~ /^\$(.*)$/) {
147	    $packsub .= "\$self->$key->pack(\$stream, \@_);";
148	    $unpacksub .= "\$self->$key->unpack(\$stream, \@_);";
149	} else {
150	    $packsub .= "\$stream->set_$1(\$self->$key);";
151	    $unpacksub .= "\$self->$key(\$stream->get_$1);";
152	}
153    }
154    $packsub .='}';
155    $unpacksub .='}';
156    *{"${classname}::${u}pack"} = eval($packsub) unless defined &{"${classname}::${u}pack"};
157    *{"${classname}::${u}unpack"} = eval($unpacksub) unless defined &{"${classname}::${u}unpack"};
158}
159
160# Utility sub to create subclass.
161
162sub _create_class {
163    no strict 'refs';
164
165    my $classname = shift;
166    my $isa = shift;
167    my $base = ((@_ % 2) ? pop : 0);
168
169    $classname = "SWF::Element::$classname";
170
171    my $element_names = \@{"${classname}::_Element_Names"};
172    my $element_types = \%{"${classname}::_Element_Types"};
173
174#    $isa = [$isa] unless ref($isa) eq 'ARRAY';
175    @{"${classname}::ISA"}=map {$_ ? "SWF::Element::$_" : "SWF::Element"} @$isa;
176    while (@_) {
177	my $k = shift;
178	my $v = shift;
179	my $base1 = $base;
180	push @$element_names, $k;
181
182	if ($v !~ /^\$/) {
183	    my $type = $element_types->{$k} = "SWF::Element::$v";
184	    *{"${classname}::$k"} = sub {
185		my $self = shift;
186		if (@_) {
187		    my $p = $_[0];
188		    if (UNIVERSAL::isa($p, $type) or not defined $p) {
189			$self->[$base1] = $p;
190		    } else {
191			$self->[$base1] = $type->new unless defined $self->[$base1];
192			$self->[$base1]->configure(@_);
193		    }
194		} else {
195		    $self->[$base1] = $type->new unless defined $self->[$base1];
196		}
197		$self->[$base1];
198	    };
199	} else {
200	    $element_types->{$k} = $v;
201	    *{"${classname}::$k"} = sub {
202		my ($self, $data) = @_;
203		$self->[$base1] = $data if @_>=2;
204		$self->[$base1];
205	    };
206	}
207
208	$base++;
209
210    }
211}
212
213sub _create_flag_accessor {
214    no strict 'refs';
215    my ($name, $flagfield, $bit, $len) = @_;
216    my $pkg = (caller)[0];
217
218    $len ||=1;
219    my $field = (((1<<$len) - 1)<<$bit);
220
221    *{"${pkg}::$name"} = sub {
222	my ($self, $set) = @_;
223	my $flags = $self->$flagfield || 0;
224
225	if (defined $set) {
226	    $flags &= ~$field;
227	    $flags |= ($set<<$bit);
228	    $self->$flagfield($flags);
229	}
230	return (($flags & $field) >> $bit);
231    }
232}
233
234# Create subclasses.
235
236_create_class('ID', ['Scalar']);
237_create_class('Depth', ['Scalar']);
238_create_class('BinData', ['Scalar']);
239_create_class('RGB', [''],
240	      Red   => '$UI8',
241	      Green => '$UI8',
242	      Blue  => '$UI8');
243_create_pack('RGB');
244_create_class('RGBA', ['', 'RGB'],
245	      Red   => '$UI8',
246	      Green => '$UI8',
247	      Blue  => '$UI8',
248	      Alpha => '$UI8');
249_create_pack('RGBA');
250_create_class('RECT', [''],
251	      Xmin => '$', Ymin => '$',
252	      Xmax => '$', Ymax => '$');
253_create_class('MATRIX', [''],
254	      ScaleX      => '$', ScaleY      => '$',
255	      RotateSkew0 => '$', RotateSkew1 => '$',
256	      TranslateX  => '$', TranslateY  => '$');
257_create_class('CXFORM', [''],
258	      Flags         => '$',
259	      RedMultTerm   => '$',
260	      GreenMultTerm => '$',
261	      BlueMultTerm  => '$',
262	      RedAddTerm    => '$',
263	      GreenAddTerm  => '$',
264	      BlueAddTerm   => '$');
265_create_class('CXFORMWITHALPHA', ['CXFORM'],
266	      Flags         => '$',
267	      RedMultTerm   => '$',
268	      GreenMultTerm => '$',
269	      BlueMultTerm  => '$',
270	      AlphaMultTerm => '$',
271	      RedAddTerm    => '$',
272	      GreenAddTerm  => '$',
273	      BlueAddTerm   => '$',
274	      AlphaAddTerm  => '$');
275_create_class('STRING', ['Scalar']);
276_create_class('PSTRING', ['STRING']);
277_create_class('FILLSTYLE1', [''],
278	      FillStyleType  => '$UI8',
279	      Color          => 'RGB',
280	      GradientMatrix => 'MATRIX',
281	      Gradient       => 'Array::GRADIENT1',
282	      BitmapID       => 'ID',
283	      BitmapMatrix   => 'MATRIX');
284_create_class('FILLSTYLE3', ['FILLSTYLE1'],
285	      FillStyleType  => '$UI8',
286	      Color          => 'RGBA',
287	      GradientMatrix => 'MATRIX',
288	      Gradient       => 'Array::GRADIENT3',
289	      BitmapID       => 'ID',
290	      BitmapMatrix   => 'MATRIX');
291_create_class('GRADRECORD1', [''],
292	      Ratio => '$UI8',
293	      Color => 'RGB');
294_create_pack('GRADRECORD1');
295_create_class('GRADRECORD3', ['GRADRECORD1'],
296	      Ratio => '$UI8',
297	      Color => 'RGBA');
298_create_class('LINESTYLE1', [''],
299	      Width => '$UI16',
300	      Color => 'RGB');
301_create_pack('LINESTYLE1');
302_create_class('LINESTYLE3', ['LINESTYLE1'],
303	      Width => '$UI16',
304	      Color => 'RGBA');
305_create_class('SHAPE', [''],
306	      ShapeRecords => 'Array::SHAPERECORDARRAY1');
307_create_class('SHAPEWITHSTYLE1', ['SHAPE'],
308	      FillStyles   => 'Array::FILLSTYLEARRAY1',
309	      LineStyles   => 'Array::LINESTYLEARRAY1',
310	      ShapeRecords => 'Array::SHAPERECORDARRAY1');
311_create_class('SHAPEWITHSTYLE2', ['SHAPEWITHSTYLE1'],
312	      FillStyles   => 'Array::FILLSTYLEARRAY2',
313	      LineStyles   => 'Array::LINESTYLEARRAY2',
314	      ShapeRecords => 'Array::SHAPERECORDARRAY2');
315_create_class('SHAPEWITHSTYLE3', ['SHAPEWITHSTYLE2'],
316	      FillStyles   => 'Array::FILLSTYLEARRAY3',
317	      LineStyles   => 'Array::LINESTYLEARRAY3',
318	      ShapeRecords => 'Array::SHAPERECORDARRAY3');
319_create_class('SHAPERECORD1', ['']);
320_create_class('SHAPERECORD2', ['SHAPERECORD1']);
321_create_class('SHAPERECORD3', ['SHAPERECORD2']);
322_create_class('SHAPERECORD1::STYLECHANGERECORD', ['SHAPERECORD1'],
323	      MoveDeltaX => '$',
324	      MoveDeltaY => '$',
325	      FillStyle0 => '$',
326	      FillStyle1 => '$',
327	      LineStyle  => '$' );
328_create_class('SHAPERECORD2::STYLECHANGERECORD', ['SHAPERECORD1::STYLECHANGERECORD', 'SHAPERECORD2'],
329	      MoveDeltaX => '$',
330	      MoveDeltaY => '$',
331	      FillStyle0 => '$',
332	      FillStyle1 => '$',
333	      LineStyle  => '$',
334	      FillStyles => 'Array::FILLSTYLEARRAY2',
335	      LineStyles => 'Array::LINESTYLEARRAY2');
336_create_class('SHAPERECORD3::STYLECHANGERECORD', ['SHAPERECORD2::STYLECHANGERECORD', 'SHAPERECORD3'],
337	      MoveDeltaX => '$',
338	      MoveDeltaY => '$',
339	      FillStyle0 => '$',
340	      FillStyle1 => '$',
341	      LineStyle  => '$',
342	      FillStyles => 'Array::FILLSTYLEARRAY3',
343	      LineStyles => 'Array::LINESTYLEARRAY3');
344_create_class('SHAPERECORDn::STRAIGHTEDGERECORD', ['SHAPERECORD1', 'SHAPERECORD2', 'SHAPERECORD3'],
345	      DeltaX => '$', DeltaY => '$');
346_create_class('SHAPERECORDn::CURVEDEDGERECORD',  ['SHAPERECORD1', 'SHAPERECORD2', 'SHAPERECORD3'],
347	      ControlDeltaX => '$', ControlDeltaY => '$',
348	      AnchorDeltaX  => '$', AnchorDeltaY  => '$');
349_create_class('Tag', ['']);
350_create_class('Tag::Identified', ['Tag']);
351_create_class('MORPHFILLSTYLE', [''],
352	      FillStyleType       => '$UI8',
353	      StartColor          => 'RGBA',
354	      EndColor            => 'RGBA',
355	      StartGradientMatrix => 'MATRIX',
356	      EndGradientMatrix   => 'MATRIX',
357	      Gradient            => 'Array::MORPHGRADIENT',
358	      BitmapID            => 'ID',
359	      StartBitmapMatrix   => 'MATRIX',
360	      EndBitmapMatrix     => 'MATRIX');
361_create_class('MORPHGRADRECORD', [''],
362	      StartRatio => '$UI8', StartColor => 'RGBA',
363	      EndRatio   => '$UI8', EndColor   => 'RGBA');
364_create_pack('MORPHGRADRECORD');
365_create_class('MORPHLINESTYLE', [''],
366	      StartWidth => '$UI16', EndWidth => '$UI16',
367	      StartColor => 'RGBA',  EndColor => 'RGBA');
368_create_pack('MORPHLINESTYLE');
369_create_class('BUTTONRECORD1', [''],
370	      ButtonStates => '$UI8',
371	      CharacterID  => 'ID',
372	      PlaceDepth   => 'Depth',
373	      PlaceMatrix  => 'MATRIX');
374_create_class('BUTTONRECORD2', ['BUTTONRECORD1'],
375	      ButtonStates   => '$UI8',
376	      CharacterID    => 'ID',
377	      PlaceDepth     => 'Depth',
378	      PlaceMatrix    => 'MATRIX',
379	      ColorTransform => 'CXFORMWITHALPHA');
380_create_class('BUTTONCONDACTION', [''],
381	      Condition => '$UI16', Actions => 'Array::ACTIONRECORDARRAY');
382_create_pack('BUTTONCONDACTION');
383_create_class('TEXTRECORD1', [''],
384	      FontID     => 'ID',
385	      TextColor  => 'RGB',
386	      XOffset    => '$SI16',
387	      YOffset    => '$SI16',
388	      TextHeight => '$UI16',
389	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
390_create_class('TEXTRECORD2', ['TEXTRECORD1'],
391	      FontID     => 'ID',
392	      TextColor  => 'RGBA',
393	      XOffset    => '$SI16',
394	      YOffset    => '$SI16',
395	      TextHeight => '$UI16',
396	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
397_create_class('TEXTRECORD::TYPE0', ['','TEXTRECORD1','TEXTRECORD2'],
398	      GlyphEntries => 'Array::GLYPHENTRYARRAY');
399_create_pack('TEXTRECORD::TYPE0');
400_create_class('GLYPHENTRY', [''],
401	      GlyphIndex => '$', GlyphAdvance => '$');
402_create_class('TEXTRECORD1::TYPE1', ['TEXTRECORD1'],
403	      FontID     => 'ID',
404	      TextColor  => 'RGB',
405	      XOffset    => '$SI16',
406	      YOffset    => '$SI16',
407	      TextHeight => '$UI16');
408_create_class('TEXTRECORD2::TYPE1', ['TEXTRECORD1::TYPE1', 'TEXTRECORD2'],
409	      FontID     => 'ID',
410	      TextColor  => 'RGBA',
411	      XOffset    => '$SI16',
412	      YOffset    => '$SI16',
413	      TextHeight => '$UI16');
414_create_class('SOUNDINFO', [''],
415	      SyncFlags       => '$',
416	      InPoint         => '$UI32',
417	      OutPoint        => '$UI32',
418	      LoopCount       => '$UI16',
419	      EnvelopeRecords => 'Array::SOUNDENVELOPEARRAY');
420_create_class('SOUNDENVELOPE', [''],
421	      Pos44 => '$UI32', LeftLevel => '$UI16', RightLevel => '$UI16');
422_create_pack('SOUNDENVELOPE');
423_create_class('ACTIONTagNumber', ['Scalar']);
424_create_class('ACTIONRECORD', [''],
425	      Tag        => 'ACTIONTagNumber',
426	      LocalLabel => '$');
427_create_class('ACTIONDATA', ['Scalar']);
428_create_class('ACTIONDATA::String', ['ACTIONDATA']);
429_create_class('ACTIONDATA::Property', ['ACTIONDATA']);
430_create_class('ACTIONDATA::NULL', ['ACTIONDATA']);
431_create_class('ACTIONDATA::UNDEF', ['ACTIONDATA']);
432_create_class('ACTIONDATA::Register', ['ACTIONDATA']);
433_create_class('ACTIONDATA::Boolean', ['ACTIONDATA']);
434_create_class('ACTIONDATA::Double', ['ACTIONDATA']);
435_create_class('ACTIONDATA::Integer', ['ACTIONDATA']);
436_create_class('ACTIONDATA::Lookup', ['ACTIONDATA']);
437_create_class('CLIPACTIONRECORD', [''],
438	      EventFlags   => '$',
439	      KeyCode      => '$UI8',
440	      Actions      => 'Array::ACTIONRECORDARRAY');
441_create_class('ASSET', [''],
442	      ID     => 'ID',
443	      Name   => 'STRING');
444_create_pack('ASSET');
445_create_class('REGISTERPARAM', [''],
446	      Register  => '$UI8',
447	      ParamName => 'STRING');
448_create_pack('REGISTERPARAM');
449
450##########
451
452package SWF::Element::Scalar;
453
454use overload
455    '""' => \&value,
456    '0+' => \&value,
457    '++' => sub {${$_[0]}++},
458    '--' => sub {${$_[0]}--},
459    '='  => \&clone,
460    fallback =>1,
461    ;
462@SWF::Element::Scalar::ISA = ('SWF::Element');
463
464sub new {
465    my $class = shift;
466    my ($self, $data);
467
468    $self = \$data;
469    bless $self, ref($class)||$class;
470    $self->_init;
471    $self->configure(@_) if @_;
472    $self;
473}
474
475sub clone {
476    my $self = shift;
477    Carp::croak "Can't clone a class" unless ref($self);
478    my $new = $self->new($self->value);
479}
480
481sub configure {
482    my ($self, $newval)=@_;
483#    Carp::croak "Can't set $newval in ".ref($self) unless $newval=~/^[\d.]*$/;
484    unless (ref($newval)) {
485	$$self = $newval;
486    } elsif (eval{$newval->isa('SWF::Element::Scalar')}) {
487	$$self = $newval->value;
488    }
489    $self;
490}
491sub value {
492    ${$_[0]};
493}
494
495sub defined {
496    defined ${$_[0]};
497}
498
499# 'pack' and 'unpack' should be overridden in the subclass or
500# the owner class is responsible for packing/unpacking THIS.
501
502sub pack {
503    Carp::croak "'pack' should be overridden in ".ref($_[0]);
504}
505
506sub unpack {
507    Carp::croak "'unpack' should be overridden in ".ref($_[0]);
508}
509
510sub dumper {
511    my ($self, $outputsub)=@_;
512
513    $outputsub||=\&SWF::Element::_default_output;
514
515    &$outputsub($self->value, 0);
516}
517
518sub _init {}
519
520
521##########
522
523package SWF::Element::ID;
524
525sub pack {
526    my ($self, $stream) = @_;
527
528    $stream->set_UI16($self->value);
529}
530
531sub unpack {
532    my ($self, $stream) = @_;
533
534    $self->configure($stream->get_UI16);
535}
536
537##########
538
539package SWF::Element::Depth;
540
541sub pack {
542    my ($self, $stream) = @_;
543
544    $stream->set_UI16($self->value);
545}
546
547sub unpack {
548    my ($self, $stream) = @_;
549
550    $self->configure($stream->get_UI16);
551}
552
553##########
554
555package SWF::Element::Array;
556
557sub new {
558    my $class = shift;
559    my $self = [];
560
561    bless $self, ref($class)||$class;
562    $self->_init;
563    $self->configure(@_) if @_;
564
565    $self;
566}
567
568sub configure {
569    my ($self, @param)=@_;
570    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY' and ref($param[0][0]));
571    for my $p (@param) {
572	my $element = $self->new_element;
573	if (UNIVERSAL::isa($p, ref($element)) or not defined $p) {
574	    $element = $p;
575	} elsif (ref($p) eq 'ARRAY') {
576	    $element->configure($p);
577	} else {
578#	  Carp::croak "Element type mismatch: ".ref($p)." in ".ref($self);
579	  Carp::confess "Element type mismatch: ".ref($p)." in ".ref($self);
580	}
581	push @$self, $element;
582    }
583    $self;
584}
585
586sub clone {
587    my $self = $_[0];
588    die "Can't clone a class" unless ref($self);
589    my $new = $self->new;
590    for my $i (@$self) {
591	push @$new, $i->clone;
592    }
593    $new;
594}
595
596sub pack {
597    my $self = shift;
598
599    for my $element (@$self) {
600	$element->pack(@_);
601    }
602    $self->last(@_);
603}
604
605sub unpack {
606    my $self = shift;
607    {
608	my $element = $self->new_element;
609	$element->unpack(@_);
610	last if $self->is_last($element);
611	push @$self, $element;
612	redo;
613    }
614}
615
616sub defined {
617    return @{shift()} > 0;
618}
619
620sub dumper {
621    my ($self, $outputsub, $indent) = @_;
622
623    $indent ||= 0;
624    $outputsub||=\&SWF::Element::_default_output;
625
626    &$outputsub(ref($self)."->new([\n", 0);
627    my $n = 0;
628    for my $i (@$self) {
629	&$outputsub('', $indent+1);
630	$i->dumper($outputsub, $indent+1);
631	&$outputsub(",\t\t\t# $n\n", 0);
632	$n++;
633    }
634    &$outputsub("])", $indent);
635}
636
637sub _init {
638    my $self = shift;
639
640    for my $element (@$self) {
641	last unless ref($element) eq '' or  ref($element) eq 'ARRAY';
642	my $new = $self->new_element;
643	last unless ref($new);
644	$new->configure($element);
645	$element = $new;
646    }
647}
648
649sub new_element {}
650sub is_last {0}
651sub last {};
652
653sub _create_array_class {
654    no strict 'refs';
655    my ($classname, $isa, $newelement, $last, $is_last)=@_;
656
657    $classname = "Array::$classname";
658    SWF::Element::_create_class($classname, $isa);
659
660    $classname = "SWF::Element::$classname";
661    if ($newelement) {
662	$newelement = "SWF::Element::$newelement";
663	*{"${classname}::new_element"} = sub {shift; $newelement->new(@_)};
664    }
665    *{"${classname}::last"} = $last if $last;
666    *{"${classname}::is_last"} = $is_last if $is_last;
667}
668
669_create_array_class('FILLSTYLEARRAY1', ['Array1'], 'FILLSTYLE1');
670_create_array_class('FILLSTYLEARRAY2', ['Array2', 'Array::FILLSTYLEARRAY1'], 'FILLSTYLE1');
671_create_array_class('FILLSTYLEARRAY3', ['Array::FILLSTYLEARRAY2'],'FILLSTYLE3');
672_create_array_class('GRADIENT1',       ['Array1'], 'GRADRECORD1');
673_create_array_class('GRADIENT3',       ['Array::GRADIENT1'], 'GRADRECORD3');
674_create_array_class('LINESTYLEARRAY1', ['Array1'], 'LINESTYLE1');
675_create_array_class('LINESTYLEARRAY2', ['Array2', 'Array::LINESTYLEARRAY1'], 'LINESTYLE1');
676_create_array_class('LINESTYLEARRAY3', ['Array::LINESTYLEARRAY2'], 'LINESTYLE3');
677_create_array_class('SHAPERECORDARRAY1',  ['Array'],  'SHAPERECORD1',
678		    sub {$_[1]->set_bits(0,6)},
679                    sub {$_[1]->isa('SWF::Element::SHAPERECORDn::ENDSHAPERECORD')});
680
681_create_array_class('SHAPERECORDARRAY2', ['Array::SHAPERECORDARRAY1'], 'SHAPERECORD2');
682_create_array_class('SHAPERECORDARRAY3', ['Array::SHAPERECORDARRAY2'], 'SHAPERECORD3');
683_create_array_class('MORPHFILLSTYLEARRAY', ['Array2'],    'MORPHFILLSTYLE');
684_create_array_class('MORPHLINESTYLEARRAY', ['Array2'],    'MORPHLINESTYLE');
685_create_array_class('MORPHGRADIENT',       ['Array1'],    'MORPHGRADRECORD');
686_create_array_class('BUTTONRECORDARRAY1',  ['Array'],     'BUTTONRECORD1',
687                     sub {$_[1]->set_UI8(0)},
688                     sub {$_[1]->ButtonStates == 0});
689
690_create_array_class('BUTTONRECORDARRAY2', ['Array::BUTTONRECORDARRAY1'], 'BUTTONRECORD2');
691_create_array_class('BUTTONCONDACTIONARRAY', ['Array'], 'BUTTONCONDACTION');
692_create_array_class('GLYPHSHAPEARRAY1',          ['Array'], 'SHAPE');
693_create_array_class('GLYPHSHAPEARRAY2',          ['Array'], 'SHAPE');
694_create_array_class('CODETABLE',            ['Array::Scalar']);
695_create_array_class('FONTADVANCETABLE',     ['Array::Scalar']);
696_create_array_class('FONTBOUNDSTABLE',      ['Array'], 'RECT', sub {});
697_create_array_class('TEXTRECORDARRAY1',     ['Array'], 'TEXTRECORD1',
698                    sub {$_[1]->set_UI8(0)},
699                    sub {$_[1]->isa('SWF::Element::TEXTRECORD::End')});
700
701_create_array_class('TEXTRECORDARRAY2',   ['Array::TEXTRECORDARRAY1'], 'TEXTRECORD2');
702_create_array_class('GLYPHENTRYARRAY',    ['Array1'], 'GLYPHENTRY');
703_create_array_class('SOUNDENVELOPEARRAY', ['Array1'], 'SOUNDENVELOPE');
704_create_array_class('ACTIONRECORDARRAY',  ['Array'],  'ACTIONRECORD',
705                    sub {$_[1]->set_UI8(0)},
706                    sub {$_[1]->Tag == 0});
707_create_array_class('ACTIONDATAARRAY', ['Array'],  'ACTIONDATA',
708                    sub {});
709_create_array_class('STRINGARRAY',     ['Array3'], 'STRING');
710_create_array_class('CLIPACTIONRECORDARRAY', ['Array'],  'CLIPACTIONRECORD',
711                    sub {$_[1]->set_UI32(0)},
712                    sub {$_[1]->EventFlags == 0});
713_create_array_class('ASSETARRAY',      ['Array3'], 'ASSET');
714_create_array_class('TAGARRAY',        ['Array'],  'Tag',
715                    sub {},
716                    sub {$_[1]->tag_name eq 'End' && ((push @{$_[0]}, $_[1]),1)});
717_create_array_class('REGISTERPARAMARRAY', ['Array'], 'REGISTERPARAM',
718                    sub {});
719
720##########
721
722package SWF::Element::Array::Scalar;
723
724@SWF::Element::Array::Scalar::ISA=qw(SWF::Element::Array);
725
726sub configure {
727    my $self = shift;
728
729    if (ref($_[0]) eq 'ARRAY') {
730	push @$self, @{$_[0]};
731    } else {
732	push @$self, @_;
733    }
734    $self;
735}
736
737sub clone {
738    my $self = $_[0];
739    die "Can't clone a class" unless ref($self);
740    $self->new(@$self);
741}
742
743sub dumper {
744    my ($self, $outputsub, $indent) = @_;
745    my @data;
746
747    &$outputsub(ref($self)."->new([\n", 0);
748    for (my $i = 0; $i < @$self; $i+=8) {
749	my @data = @$self[$i..($i+7 > $#$self ? $#$self : $i+7)];
750	&$outputsub(sprintf("%5d,"x@data."\n", @data), 0);
751    }
752    &$outputsub("])", $indent);
753}
754
755##########
756
757package SWF::Element::Array1;
758use vars qw(@ISA);
759
760@ISA=qw(SWF::Element::Array);
761
762sub pack {
763    my $self = shift;
764    my $count = @$self;
765
766    $_[0]->set_UI8($count);
767    $self->_pack(@_);
768}
769
770sub _pack {
771    my $self = shift;
772
773    for my $element (@$self) {
774	$element->pack(@_);
775    }
776}
777
778
779sub unpack {
780    my $self = shift;
781
782    $self->_unpack($_[0]->get_UI8, @_);
783}
784
785sub _unpack {
786    my $self = shift;
787    my $count = shift;
788
789    while (--$count>=0) {
790	my $element = $self->new_element;
791	$element->unpack(@_);
792	push @$self, $element;
793    }
794}
795
796##########
797
798package SWF::Element::Array2;
799use vars qw(@ISA);
800
801@ISA=qw(SWF::Element::Array1);
802
803sub pack {
804    my $self=shift;
805    my $stream=$_[0];
806    my $count=@$self;
807
808    if ($count>254) {
809	$stream->set_UI8(0xFF);
810	$stream->set_UI16($count);
811    } else {
812	$stream->set_UI8($count);
813    }
814    $self->_pack(@_);
815}
816
817sub unpack {
818    my $self=shift;
819    my $stream=$_[0];
820    my $count=$stream->get_UI8;
821
822    $count=$stream->get_UI16 if $count==0xFF;
823
824    $self->_unpack($count, @_);
825}
826
827##########
828
829package SWF::Element::Array3;
830use vars qw(@ISA);
831
832@ISA=qw(SWF::Element::Array1);
833
834sub unpack {
835    my $self = shift;
836
837    $self->_unpack($_[0]->get_UI16, @_);
838}
839
840sub pack {
841    my $self = shift;
842
843    $_[0]->set_UI16(scalar @$self);
844    $self->_pack(@_);
845}
846
847##########
848
849package SWF::Element::Array::STRINGARRAY;
850
851sub configure {
852    my ($self, @param)=@_;
853    @param = @{$param[0]} if (ref($param[0]) eq 'ARRAY');
854    for my $p (@param) {
855	my $element = $self->new_element;
856	if (UNIVERSAL::isa($p, ref($element)) or not defined $p) {
857	    $element = $p;
858	} elsif (ref($p) eq '') {
859	    $element->configure($p);
860	} else {
861	  Carp::croak "Element type mismatch: ".ref($p)." in ".ref($self);
862	}
863	push @$self, $element;
864    }
865    $self;
866}
867
868##########
869
870package SWF::Element::RECT;
871
872sub pack {
873    my ($self, $stream)=@_;
874    $stream->flush_bits;
875    $stream->set_sbits_list(5, $self->Xmin, $self->Xmax, $self->Ymin, $self->Ymax);
876}
877
878sub unpack {
879    my ($self, $stream)=@_;
880    $stream->flush_bits;
881    my $nbits=$stream->get_bits(5);
882
883    for my $i(qw/Xmin Xmax Ymin Ymax/) {
884	$self->$i($stream->get_sbits($nbits));
885    }
886}
887
888##########
889
890package SWF::Element::MATRIX;
891
892sub _init {
893    my $self = shift;
894    $self->ScaleX(1);
895    $self->ScaleY(1);
896    $self->RotateSkew0(0);
897    $self->RotateSkew1(0);
898}
899
900sub pack {
901    my ($self, $stream)=@_;
902
903    $stream->flush_bits;
904    if ($self->ScaleX != 1 or $self->ScaleY != 1) {
905	$stream->set_bits(1,1);
906	$stream->set_sbits_list(5, $self->ScaleX * 65536, $self->ScaleY * 65536);
907    } else {
908	$stream->set_bits(0,1);
909    }
910    if ($self->RotateSkew0 != 0 or $self->RotateSkew1 != 0) {
911	$stream->set_bits(1,1);
912	$stream->set_sbits_list(5, $self->RotateSkew0 * 65536, $self->RotateSkew1 * 65536);
913    } else {
914	$stream->set_bits(0,1);
915    }
916	$stream->set_sbits_list(5, $self->TranslateX, $self->TranslateY);
917}
918
919sub unpack {
920    my ($self, $stream)=@_;
921    my ($hasscale, $hasrotate);
922
923    $stream->flush_bits;
924    if ($hasscale = $stream->get_bits(1)) {
925	my $nbits=$stream->get_bits(5);
926#	$nbits = 32 if $nbits == 0; # ???
927	$self->ScaleX($stream->get_sbits($nbits) / 65536);
928	$self->ScaleY($stream->get_sbits($nbits) / 65536);
929    } else {
930	$self->ScaleX(1);
931	$self->ScaleY(1);
932    }
933    if ($hasrotate = $stream->get_bits(1)) {
934	my $nbits=$stream->get_bits(5);
935#	$nbits = 32 if $nbits == 0; # ???
936	$self->RotateSkew0($stream->get_sbits($nbits) / 65536);
937	$self->RotateSkew1($stream->get_sbits($nbits) / 65536);
938    } else {
939	$self->RotateSkew0(0);
940	$self->RotateSkew1(0);
941    }
942    my $nbits=$stream->get_bits(5);
943#    my $scalex = $self->ScaleX;
944#    $nbits = 32 if $nbits == 0 and ($scalex == 0 or $scalex >= 16383.99998474 or $scalex <= -16383.99998474); # ???
945    $self->TranslateX($stream->get_sbits($nbits));
946    $self->TranslateY($stream->get_sbits($nbits));
947}
948
949sub defined {
950    my $self = shift;
951
952    return (defined($self->TranslateX) or defined($self->TranslateY) or
953	    $self->ScaleX      != 1    or $self->ScaleY      != 1 or
954	    $self->RotateSkew0 != 0    or $self->RotateSkew1 != 0);
955}
956
957sub scale {
958    my ($self, $xscale, $yscale)=@_;
959    $yscale=$xscale unless defined $yscale;
960
961    $self->ScaleX($self->ScaleX * $xscale);
962    $self->RotateSkew0($self->RotateSkew0 * $xscale);
963    $self->ScaleY($self->ScaleY * $yscale);
964    $self->RotateSkew1($self->RotateSkew1 * $yscale);
965    $self;
966}
967
968sub moveto {
969    my ($self, $x, $y)=@_;
970    $self->TranslateX($x);
971    $self->TranslateY($y);
972    $self;
973}
974
975sub rotate {
976    my ($self, $degree)=@_;
977    $degree = $degree*3.14159265358979/180;
978    my $sin = sin($degree);
979    my $cos = cos($degree);
980    my $a = $self->ScaleX;
981    my $b = $self->RotateSkew0;
982    my $c = $self->RotateSkew1;
983    my $d = $self->ScaleY;
984    $self->ScaleX($a*$cos-$b*$sin);
985    $self->RotateSkew0($a*$sin+$b*$cos);
986    $self->RotateSkew1($c*$cos-$d*$sin);
987    $self->ScaleY($c*$sin+$d*$cos);
988
989    $self;
990}
991
992##########
993
994package SWF::Element::CXFORM;
995
996sub pack {
997    my ($self, $stream)=@_;
998    my @param = map $self->$_, $self->element_names;
999    shift @param;
1000    my $half  = @param>>1;
1001    my @mult   = @param[0..$half-1];
1002    my @add  = @param[$half..$#param];
1003
1004    $stream->flush_bits;
1005    if (grep defined $_, @add) {
1006	$stream->set_bits(1,1);
1007    } else {
1008	$stream->set_bits(0,1);
1009	@add = ();
1010    }
1011    if (grep defined $_, @mult) {
1012	$stream->set_bits(1,1);
1013    } else {
1014	$stream->set_bits(0,1);
1015	@mult = ();
1016    }
1017    $stream->set_sbits_list(4, @mult, @add) if @add or @mult;
1018}
1019
1020sub unpack {
1021    my ($self, $stream)=@_;
1022
1023    $stream->flush_bits;
1024    my $hasAdd  = $stream->get_bits(1);
1025    my $hasMult = $stream->get_bits(1);
1026
1027    $self->Flags($hasAdd | ($hasMult<<1));
1028
1029    my $nbits = $stream->get_bits(4);
1030    my @names = $self->element_names;
1031    shift @names;
1032    my $half = @names>>1;
1033
1034    if ($hasMult) {
1035	for my $i (@names[0..$half-1]) {
1036	    $self->$i($stream->get_sbits($nbits));
1037	}
1038    }
1039    if ($hasAdd) {
1040	for my $i (@names[$half..$#names]) {
1041	    $self->$i($stream->get_sbits($nbits));
1042	}
1043    }
1044}
1045
1046SWF::Element::_create_flag_accessor('HasAddTerms', 'Flags', 0);
1047SWF::Element::_create_flag_accessor('HasMultTerms', 'Flags', 1);
1048
1049##########
1050
1051package SWF::Element::BinData;
1052
1053use Data::TemporaryBag;
1054
1055sub _init {
1056    my $self = shift;
1057
1058    $$self = Data::TemporaryBag->new;
1059}
1060
1061sub configure {
1062    my ($self, $newval) = @_;
1063
1064    if (ref($newval)) {
1065	if ($newval->isa('Data::TemporaryBag')) {
1066	    $$self = $newval->clone;
1067	} elsif ($newval->isa('SWF::Element::BinData')) {
1068	    $self = $newval->clone;
1069	} else {
1070	  Carp::croak "Can't set ".ref($newval)." in ".ref($self);
1071	}
1072    } else {
1073	$$self = Data::TemporaryBag->new($newval) if defined $newval;
1074    }
1075    $self;
1076}
1077
1078sub clone {
1079    my $self = shift;
1080
1081    $self->new($$self);
1082}
1083
1084for my $sub (qw/substr value defined/) {
1085    no strict 'refs';
1086    *{"SWF::Element::BinData::$sub"} = sub {
1087	my $self=shift;
1088	$$self->$sub(@_);
1089    };
1090}
1091
1092sub add {
1093    my $self = shift;
1094
1095    $$self->add(@_);
1096    $self;
1097}
1098
1099sub Length {
1100    $ {$_[0]}->length;
1101}
1102
1103sub pack {
1104    my ($self, $stream)=@_;
1105    my $size = $self->Length;
1106    my $pos = 0;
1107
1108    while ($size > $pos) {
1109	$stream->set_string($self->substr($pos, 1024));
1110	$pos += 1024;
1111    }
1112}
1113
1114sub unpack {
1115    my ($self, $stream, $len)=@_;
1116
1117    while ($len > 0) {
1118	my $size = ($len > 1024) ? 1024 : $len;
1119	$self->add($stream->get_string($size));
1120	$len -= $size;
1121    }
1122}
1123
1124sub save {
1125    my ($self, $file) = @_;
1126    no strict 'refs';  # so that a symbol ref as $file works
1127    local(*F);
1128    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
1129	# Assume $file is a filename
1130	open(F, "> $file") or die "Can't open $file: $!";
1131	$file = *F;
1132    }
1133    binmode($file);
1134    my $stream = SWF::BinStream::Write->new;
1135    $stream->autoflush(1000, sub {print $file $_[1]});
1136    $self->pack($stream);
1137    print $file $stream->flush_stream;
1138    close $file;
1139}
1140
1141sub load {
1142    my($self, $file) = @_;
1143    no strict 'refs';  # so that a symbol ref as $file works
1144    local(*F);
1145    unless (ref($file) or $file =~ /^\*[\w:]+$/) {
1146	# Assume $file is a filename
1147	open(F, $file) or die "Can't open $file: $!";
1148	$file = *F;
1149    }
1150    binmode($file);
1151    my $size = (stat $file)[7];
1152    my $stream = SWF::BinStream::Read->new('', sub {my $data; read $file, $data, 1000; $_[0]->add_stream($data)});
1153    $self->unpack($stream, $size);
1154    close $file;
1155}
1156
1157{
1158    my $label = 'A';
1159
1160    sub dumper {
1161	my ($self, $outputsub, $indent) = @_;
1162
1163	$indent ||= 0;
1164	$outputsub||=\&SWF::Element::_default_output;
1165
1166	&$outputsub(ref($self)."->new\n", 0);
1167
1168	my $size = $self->Length;
1169	my $pos = 0;
1170
1171	while ($size > $pos) {
1172	    my $data = CORE::pack('u', $self->substr($pos, 1024));
1173	    &$outputsub("->add(unpack('u', <<'$label'))\n$data$label\n", $indent+1);
1174	    $pos += 1024;
1175	    $label++;
1176	}
1177    }
1178}
1179
1180##########
1181
1182package SWF::Element::STRING;
1183
1184sub pack {
1185    my ($self, $stream)=@_;
1186    $stream->set_string($self->value."\0");
1187}
1188
1189sub unpack {
1190    my ($self, $stream)=@_;
1191    my $str='';
1192    my $char;
1193    $str.=$char while (($char = $stream->get_string(1)) ne "\0");
1194    $self->configure($str);
1195}
1196
1197sub dumper {
1198    my ($self, $outputsub)=@_;
1199    my $data = $self->value;
1200
1201    $data =~ s/([\\\$\@\"])/\\$1/gs;
1202    $data =~ s/([\x00-\x1F\x80-\xFF])/sprintf('\\x%.2X', ord($1))/ges;
1203    $outputsub||=\&SWF::Element::_default_output;
1204
1205    &$outputsub("\"$data\"", 0);
1206}
1207
1208##########
1209
1210package SWF::Element::PSTRING;
1211
1212sub pack {
1213    my ($self, $stream)=@_;
1214    my $str = $self->value;
1215
1216    $stream->set_UI8(length($str));
1217    $stream->set_string($str);
1218}
1219
1220sub unpack {
1221    my ($self, $stream)=@_;
1222    my $len = $stream->get_UI8;
1223
1224    $self->configure($stream->get_string($len));
1225}
1226
1227##########
1228
1229package SWF::Element::FILLSTYLE1;
1230
1231sub pack {
1232    my ($self, $stream)=@_;
1233    my $style=$self->FillStyleType;
1234    $stream->set_UI8($style);
1235    if ($style==0x00) {
1236	$self->Color->pack($stream);
1237    } elsif ($style==0x10 or $style==0x12) {
1238	$self->GradientMatrix->pack($stream);
1239	$self->Gradient->pack($stream);
1240    } elsif ($style>=0x40 or $style<=0x43) {
1241	$self->BitmapID->pack($stream);
1242	$self->BitmapMatrix->pack($stream);
1243    }
1244}
1245
1246sub unpack {
1247    my ($self, $stream)=@_;
1248    my $style = $self->FillStyleType($stream->get_UI8);
1249    if ($style==0x00) {
1250	$self->Color->unpack($stream);
1251    } elsif ($style==0x10 or $style==0x12) {
1252	$self->GradientMatrix->unpack($stream);
1253	$self->Gradient->unpack($stream);
1254    } elsif ($style>=0x40 or $style<=0x43) {
1255	$self->BitmapID->unpack($stream);
1256	$self->BitmapMatrix->unpack($stream);
1257    }
1258}
1259
1260##########
1261
1262package SWF::Element::SHAPE;
1263
1264sub pack {
1265    my ($self, $stream, $nfillbits, $nlinebits)=@_;
1266#    my ($fillidx, $lineidx)=(-1,-1);
1267
1268    $stream->flush_bits;
1269
1270=begin possible_unnecessary
1271
1272    for my $shaperec (@{$self->ShapeRecords}) {
1273	next unless $shaperec->isa('SWF::Element::SHAPERECORD1::STYLECHANGERECORD');
1274	my $style;
1275	$style   = $shaperec->FillStyle0;
1276	$fillidx = $style if (defined $style and $fillidx < $style);
1277	$style   = $shaperec->FillStyle1;
1278	$fillidx = $style if (defined $style and $fillidx < $style);
1279	$style   = $shaperec->LineStyle;
1280	$lineidx = $style if (defined $style and $lineidx < $style);
1281    }
1282    if ($fillidx>=0) {
1283	$nfillbits=1;
1284	$nfillbits++ while ($fillidx>=(1<<$nfillbits));
1285    } else {
1286	$nfillbits=0;
1287    }
1288    if ($lineidx>=0) {
1289	$nlinebits=1;
1290	$nlinebits++ while ($lineidx>=(1<<$nlinebits));
1291    } else {
1292	$nlinebits=0;
1293    }
1294
1295=end possible_unnecessary
1296
1297=cut
1298
1299    $stream->set_bits($nfillbits, 4);
1300    $stream->set_bits($nlinebits, 4);
1301
1302    $self->ShapeRecords->pack($stream, \$nfillbits, \$nlinebits);
1303}
1304
1305sub unpack {
1306    my ($self, $stream)=@_;
1307    my ($nfillbits, $nlinebits);
1308
1309    $stream->flush_bits;
1310    $nfillbits=$stream->get_bits(4);
1311    $nlinebits=$stream->get_bits(4);
1312
1313    $self->ShapeRecords->unpack($stream, \$nfillbits, \$nlinebits);
1314}
1315
1316##########
1317
1318package SWF::Element::SHAPEWITHSTYLE1;
1319
1320sub pack {
1321    my ($self, $stream)=@_;
1322    my ($fillidx, $lineidx)=($#{$self->FillStyles}+1, $#{$self->LineStyles}+1);
1323    my ($nfillbits, $nlinebits)=(0,0);
1324
1325    $self->FillStyles->pack($stream);
1326    $self->LineStyles->pack($stream);
1327
1328    if ($fillidx>0) {
1329	$nfillbits=1;
1330	$nfillbits++ while ($fillidx>=(1<<$nfillbits));
1331    } else {
1332	$nfillbits=0;
1333    }
1334    if ($lineidx>0) {
1335	$nlinebits=1;
1336	$nlinebits++ while ($lineidx>=(1<<$nlinebits));
1337    } else {
1338	$nlinebits=0;
1339    }
1340
1341    $stream->flush_bits;
1342    $stream->set_bits($nfillbits, 4);
1343    $stream->set_bits($nlinebits, 4);
1344
1345    $self->ShapeRecords->pack($stream, \$nfillbits, \$nlinebits);
1346}
1347
1348sub unpack {
1349    my ($self, $stream)=@_;
1350
1351    $self->FillStyles->unpack($stream);
1352    $self->LineStyles->unpack($stream);
1353    $self->SUPER::unpack($stream);
1354}
1355
1356##########
1357
1358package SWF::Element::SHAPERECORD1;
1359
1360sub unpack {
1361    my ($self, $stream, $nfillbits, $nlinebits)=@_;
1362
1363    if ($stream->get_bits(1)) { # Edge
1364
1365	if ($stream->get_bits(1)) {
1366	    bless $self, 'SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD';
1367	} else {
1368	    bless $self, 'SWF::Element::SHAPERECORDn::CURVEDEDGERECORD';
1369	}
1370	$self->_init;
1371	$self->unpack($stream);
1372
1373    } else { # New Shape or End of Shape
1374
1375	my $flags = $stream->get_bits(5);
1376	if ($flags==0) {
1377	    bless $self, 'SWF::Element::SHAPERECORDn::ENDSHAPERECORD';
1378	} else {
1379	    bless $self, ref($self).'::STYLECHANGERECORD';
1380	    $self->_init;
1381	    $self->unpack($stream, $nfillbits, $nlinebits, $flags);
1382	}
1383    }
1384}
1385
1386sub pack {
1387    Carp::croak "Not enough data to pack ".ref($_[0]);
1388}
1389
1390sub AUTOLOAD { # auto re-bless with proper sub class by specified accessor.
1391    my ($self, @param)=@_;
1392    my ($name, $class);
1393
1394    return if $SWF::Element::SHAPERECORD1::AUTOLOAD =~/::DESTROY$/;
1395
1396    Carp::croak "No such method: $SWF::Element::SHAPERECORD1::AUTOLOAD" unless $SWF::Element::SHAPERECORD1::AUTOLOAD=~/::([A-Z]\w*)$/;
1397    $name = $1;
1398    $class = ref($self);
1399
1400    for my $subclass ("${class}::STYLECHANGERECORD", 'SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD', 'SWF::Element::SHAPERECORDn::CURVEDEDGERECORD') {
1401	$class=$subclass, last if $subclass->element_type($name);
1402    }
1403    Carp::croak "Element '$name' is NOT in $class " if $class eq ref($self);
1404
1405    bless $self, $class;
1406    $self->$name(@param);
1407}
1408
1409##########
1410
1411package SWF::Element::SHAPERECORD1::STYLECHANGERECORD;
1412
1413sub pack {
1414    my ($self, $stream, $nfillbits, $nlinebits)=@_;
1415    my ($flags)=0;
1416
1417    my $j=0;
1418    for my $i (qw/MoveDeltaX FillStyle0 FillStyle1 LineStyle/) {
1419	$flags |=(1<<$j) if defined $self->$i;
1420	$j++;
1421    }
1422    $stream->set_bits($flags, 6);
1423    $stream->set_sbits_list(5, $self->MoveDeltaX, $self->MoveDeltaY) if ($flags & 1);
1424    $stream->set_bits($self->FillStyle0, $$nfillbits) if ($flags & 2);
1425    $stream->set_bits($self->FillStyle1, $$nfillbits) if ($flags & 4);
1426    $stream->set_bits($self->LineStyle , $$nlinebits) if ($flags & 8);
1427}
1428
1429sub unpack {
1430    my ($self, $stream, $nfillbits, $nlinebits, $flags)=@_;
1431
1432    if ($flags & 1) { # MoveTo
1433	my ($nbits)=$stream->get_bits(5);
1434	$self->MoveDeltaX($stream->get_sbits($nbits));
1435	$self->MoveDeltaY($stream->get_sbits($nbits));
1436    }
1437    if ($flags & 2) { # FillStyle0
1438	$self->FillStyle0($stream->get_bits($$nfillbits));
1439    }
1440    if ($flags & 4) { # FillStyle1
1441	$self->FillStyle1($stream->get_bits($$nfillbits));
1442    }
1443    if ($flags & 8) { # LineStyle
1444	$self->LineStyle($stream->get_bits($$nlinebits));
1445    }
1446}
1447
1448##########
1449
1450package SWF::Element::SHAPERECORD2::STYLECHANGERECORD;
1451
1452sub pack {
1453    my ($self, $stream, $nfillbits, $nlinebits)=@_;
1454    my ($flags)=0;
1455
1456    my $j=0;
1457    for my $i (qw/MoveDeltaX FillStyle0 FillStyle1 LineStyle/) {
1458	$flags |=(1<<$j) if defined $self->$i;
1459	$j++;
1460    }
1461    $flags |= 16 if @{$self->FillStyles}>0 or @{$self->LineStyles}>0;
1462    $stream->set_bits($flags, 6);
1463    $stream->set_sbits_list(5, $self->MoveDeltaX, $self->MoveDeltaY) if ($flags & 1);
1464    $stream->set_bits($self->FillStyle0, $$nfillbits) if ($flags & 2);
1465    $stream->set_bits($self->FillStyle1, $$nfillbits) if ($flags & 4);
1466    $stream->set_bits($self->LineStyle , $$nlinebits) if ($flags & 8);
1467    if ($flags & 16) { # NewStyles (SHAPERECORD2,3)
1468	my ($fillidx, $lineidx)=($#{$self->FillStyles}+1, $#{$self->LineStyles}+1);
1469	$self->FillStyles->pack($stream);
1470	$self->LineStyles->pack($stream);
1471	if ($fillidx>0) {
1472	    $$nfillbits=1;
1473	    $$nfillbits++ while ($fillidx>=(1<<$$nfillbits));
1474	} else {
1475	    $$nfillbits=0;
1476	}
1477	if ($lineidx>0) {
1478	    $$nlinebits=1;
1479	    $$nlinebits++ while ($lineidx>=(1<<$$nlinebits));
1480	} else {
1481	    $$nlinebits=0;
1482	}
1483	$stream->set_bits($$nfillbits, 4);
1484	$stream->set_bits($$nlinebits, 4);
1485    }
1486}
1487
1488sub unpack {
1489    my ($self, $stream, $nfillbits, $nlinebits, $flags)=@_;
1490
1491    if ($flags & 1) { # MoveTo
1492	my ($nbits)=$stream->get_bits(5);
1493	$self->MoveDeltaX($stream->get_sbits($nbits));
1494	$self->MoveDeltaY($stream->get_sbits($nbits));
1495    }
1496    if ($flags & 2) { # FillStyle0
1497	$self->FillStyle0($stream->get_bits($$nfillbits));
1498    }
1499    if ($flags & 4) { # FillStyle1
1500	$self->FillStyle1($stream->get_bits($$nfillbits));
1501    }
1502    if ($flags & 8) { # LineStyle
1503	$self->LineStyle($stream->get_bits($$nlinebits));
1504    }
1505    if ($flags & 16) { # NewStyles (SHAPERECORD2,3)
1506	$self->FillStyles->unpack($stream);
1507	$self->LineStyles->unpack($stream);
1508	$$nfillbits=$stream->get_bits(4);
1509	$$nlinebits=$stream->get_bits(4);
1510    }
1511}
1512
1513##########
1514
1515package SWF::Element::SHAPERECORDn::STRAIGHTEDGERECORD;
1516
1517sub unpack {
1518    my ($self, $stream)=@_;
1519    my $nbits = $stream->get_bits(4)+2;
1520    if ($stream->get_bits(1)) {
1521	$self->DeltaX($stream->get_sbits($nbits));
1522	$self->DeltaY($stream->get_sbits($nbits));
1523    } else {
1524	if ($stream->get_bits(1)) {
1525	    $self->DeltaX(0);
1526	    $self->DeltaY($stream->get_sbits($nbits));
1527	} else {
1528	    $self->DeltaX($stream->get_sbits($nbits));
1529	    $self->DeltaY(0);
1530	}
1531    }
1532}
1533
1534sub pack {
1535    my ($self, $stream)=@_;
1536    my ($dx, $dy, $nbits);
1537
1538    $stream->set_bits(3,2); # Type=1, Edge=1
1539
1540    $dx=$self->DeltaX;
1541    $dy=$self->DeltaY;
1542    $nbits=SWF::BinStream::Write::get_maxbits_of_sbits_list($dx, $dy);
1543    $nbits=2 if ($nbits<2);
1544    $stream->set_bits($nbits-2,4);
1545    if ($dx==0) {
1546	$stream->set_bits(1,2); # GeneralLine=0, Vert=1
1547	$stream->set_sbits($dy, $nbits);
1548    } elsif ($dy==0) {
1549	$stream->set_bits(0,2); # GeneralLine=0, Vert=0
1550	$stream->set_sbits($dx, $nbits);
1551    } else {
1552	$stream->set_bits(1,1); # GeneralLine=1
1553	$stream->set_sbits($dx, $nbits);
1554	$stream->set_sbits($dy, $nbits);
1555    }
1556}
1557
1558##########
1559
1560package SWF::Element::SHAPERECORDn::CURVEDEDGERECORD;
1561
1562sub unpack {
1563    my ($self, $stream)=@_;
1564    my ($nbits)=$stream->get_bits(4)+2;
1565
1566    $self->ControlDeltaX($stream->get_sbits($nbits));
1567    $self->ControlDeltaY($stream->get_sbits($nbits));
1568    $self->AnchorDeltaX($stream->get_sbits($nbits));
1569    $self->AnchorDeltaY($stream->get_sbits($nbits));
1570}
1571
1572sub pack {
1573    my ($self, $stream)=@_;
1574
1575    my @d=( $self->ControlDeltaX,
1576            $self->ControlDeltaY,
1577            $self->AnchorDeltaX ,
1578            $self->AnchorDeltaY  );
1579    my $nbits = SWF::BinStream::Write::get_maxbits_of_sbits_list(@d);
1580    $nbits=2 if ($nbits<2);
1581    $stream->set_bits(2,2); # Type=1, Edge=0
1582    $stream->set_bits($nbits-2,4);
1583    for my $i (@d) {
1584	$stream->set_sbits($i, $nbits);
1585    }
1586}
1587
1588##########
1589
1590package SWF::Element::Tag;
1591
1592my @tagname;
1593
1594sub new {
1595    my ($class, %headerdata)=@_;
1596    my $self;
1597    my $length = $headerdata{Length};
1598    my $tag = $headerdata{Tag};
1599
1600    $self = [];
1601    delete @headerdata{'Length','Tag'};
1602
1603    if (defined $tag) {
1604	$class = $class->_tag_class($tag);
1605	bless $self, $class;
1606    } else {
1607	$class = ref($class)||$class;
1608	bless $self, $class;
1609    }
1610    $self->_init($length, $tag);
1611    $self->configure(%headerdata) if %headerdata;
1612    $self;
1613}
1614
1615sub _init {
1616    my ($self, $length)=@_;
1617
1618    $self->Length($length);
1619}
1620
1621sub Length {
1622    my ($self, $len) = @_;
1623    $self->[0] = $len if defined $len;
1624    $self->[0];
1625}
1626
1627sub is_tagtype {
1628    my ($self, $type) = @_;
1629
1630    return $self->isa("SWF::Element::Tag::${type}");
1631}
1632
1633sub unpack {   # unpack tag header, re-bless, and unpack individual data for the tag.
1634    my ($self, $stream)=@_;
1635    my ($header, $tag, $length);
1636
1637    $header = $stream->get_UI16;
1638    $tag = $header>>6;
1639    $length = ($header & 0x3f);
1640    $length = $stream->get_UI32 if ($length == 0x3f);
1641    my $class = $self->_tag_class($tag);
1642    bless $self, $class;
1643    $self->_init($length, $tag);
1644    $self->unpack($stream);
1645}
1646
1647
1648sub pack {
1649    Carp::croak "Can't pack the unidentified tag.";
1650}
1651
1652sub _unpack {
1653  Carp::confess "Unexpected _unpack";
1654}
1655
1656sub _pack {
1657  Carp::confess "Unexpected _pack";
1658}
1659
1660
1661sub _tag_class {
1662    return 'SWF::Element::Tag::'.($tagname[$_[1]]||'Unknown');
1663}
1664
1665sub _create_tag {
1666    no strict 'refs';
1667
1668    my $tagname = shift;
1669    my $tagno = shift;
1670    my $isa = shift;
1671    $_ = "Tag::$_" for @$isa;
1672    SWF::Element::_create_class("Tag::$tagname", $isa, @_, 1);
1673
1674    my $tag_package = "SWF::Element::Tag::${tagname}";
1675    my $offset = 0;
1676    while (@_) {
1677	my $k = shift;
1678	my $v = shift;
1679	my $o = 0;
1680	if ($v eq 'ID' or $v eq 'Depth') {
1681	    $v = 'lookahead_UI16';
1682	    $o = 2;
1683	} elsif ($v =~ /^\$./) {
1684	    $v =~ s/^./lookahead_/;
1685	    ($o) = $v=~/(\d+)$/;
1686	    $o >>=3;
1687	} else {
1688	    last;
1689	}
1690	unless (defined &{"${tag_package}::lookahead_$k"}) {
1691	    my $offset1 = $offset;
1692	    *{"${tag_package}::lookahead_$k"} = sub {
1693		my ($self, $stream) = @_;
1694		$self->$k($stream->$v($offset1));
1695	    }
1696	}
1697
1698        $offset += $o;
1699    }
1700
1701    $tagname[$tagno] = $tagname;
1702    *{"${tag_package}::tag_number"} = sub {$tagno};
1703    *{"${tag_package}::tag_name"} = sub {$tagname};
1704    @{"${tag_package}::Packed::ISA"} = ( 'SWF::Element::Tag::Packed', $tag_package );
1705}
1706
1707sub _create_pack {
1708    my $tagname = shift;
1709  SWF::Element::_create_pack("Tag::$tagname",'_');
1710}
1711
1712##  Tag types  ##
1713
1714@SWF::Element::Tag::Definition::ISA = ('SWF::Element::Tag::Identified');
1715  @SWF::Element::Tag::Shape::ISA    = ('SWF::Element::Tag::Definition');
1716  @SWF::Element::Tag::Bitmap::ISA   = ('SWF::Element::Tag::Definition');
1717    @SWF::Element::Tag::LossLessBitmap::ISA = ('SWF::Element::Tag::Bitmap');
1718    @SWF::Element::Tag::JPEG::ISA   = ('SWF::Element::Tag::Bitmap');
1719  @SWF::Element::Tag::Font::ISA     = ('SWF::Element::Tag::Definition');
1720  @SWF::Element::Tag::Text::ISA     = ('SWF::Element::Tag::Definition');
1721  @SWF::Element::Tag::Sound::ISA    = ('SWF::Element::Tag::Definition');
1722  @SWF::Element::Tag::Button::ISA   = ('SWF::Element::Tag::Definition');
1723  @SWF::Element::Tag::Sprite::ISA   = ('SWF::Element::Tag::Definition');
1724  @SWF::Element::Tag::Video::ISA    = ('SWF::Element::Tag::Definition');
1725@SWF::Element::Tag::DisplayList::ISA = ('SWF::Element::Tag::Identified');
1726@SWF::Element::Tag::Control::ISA    = ('SWF::Element::Tag::Identified');
1727
1728@SWF::Element::Tag::ValidInSprite::ISA = ('SWF::Element::Tag');
1729@SWF::Element::Tag::ActionContainer::ISA  = ('SWF::Element::Tag');
1730@SWF::Element::Tag::AlwaysLongHeader::ISA  = ('SWF::Element::Tag');
1731
1732##  Shapes  ##
1733
1734_create_tag('DefineShape', 2, ['Shape'],
1735
1736	    ShapeID     => 'ID',
1737	    ShapeBounds => 'RECT',
1738	    Shapes      => 'SHAPEWITHSTYLE1');
1739_create_pack('DefineShape');
1740
1741_create_tag('DefineShape2', 22, ['DefineShape'],
1742
1743	    ShapeID     => 'ID',
1744	    ShapeBounds => 'RECT',
1745	    Shapes      => 'SHAPEWITHSTYLE2');
1746_create_pack('DefineShape2');
1747
1748_create_tag('DefineShape3', 32, ['DefineShape'],
1749
1750	    ShapeID     => 'ID',
1751	    ShapeBounds => 'RECT',
1752	    Shapes      => 'SHAPEWITHSTYLE3');
1753_create_pack('DefineShape3');
1754
1755_create_tag('DefineMorphShape', 46, ['Shape'],
1756
1757	    CharacterID     => 'ID',
1758	    StartBounds     => 'RECT',
1759	    EndBounds       => 'RECT',
1760	    MorphFillStyles => 'Array::MORPHFILLSTYLEARRAY',
1761	    MorphLineStyles => 'Array::MORPHLINESTYLEARRAY',
1762	    StartEdges      => 'SHAPE',
1763	    EndEdges        => 'SHAPE');
1764
1765##  Bitmaps  ##
1766
1767_create_tag('DefineBits', 6, ['JPEG'],
1768
1769	    CharacterID => 'ID',
1770	    JPEGData    => 'BinData');
1771
1772_create_tag('JPEGTables', 8, ['JPEG'],
1773
1774	    JPEGData => 'BinData');
1775
1776_create_tag('DefineBitsJPEG2', 21, ['DefineBits'],
1777
1778	    CharacterID => 'ID',
1779	    JPEGData    => 'BinData');
1780
1781_create_tag('DefineBitsJPEG3', 35, ['DefineBitsJPEG2'],
1782
1783	    CharacterID     => 'ID',
1784	    JPEGData        => 'BinData',
1785	    BitmapAlphaData => 'BinData');
1786
1787_create_tag('DefineBitsLossless', 20, ['LossLessBitmap', 'AlwaysLongHeader'],
1788
1789	    CharacterID          => 'ID',
1790	    BitmapFormat         => '$UI8',
1791	    BitmapWidth          => '$UI16',
1792	    BitmapHeight         => '$UI16',
1793	    BitmapColorTableSize => '$UI8',
1794	    ZlibBitmapData       => 'BinData',
1795	    );
1796
1797_create_tag('DefineBitsLossless2', 36, ['DefineBitsLossless'],
1798
1799	    CharacterID          => 'ID',
1800	    BitmapFormat         => '$UI8',
1801	    BitmapWidth          => '$UI16',
1802	    BitmapHeight         => '$UI16',
1803	    BitmapColorTableSize => '$UI8',
1804	    ZlibBitmapData       => 'BinData',
1805	    );
1806
1807##  Buttons  ##
1808
1809_create_tag('DefineButton', 7, ['Button', 'ActionContainer'],
1810
1811	    ButtonID    => 'ID',
1812	    Characters  => 'Array::BUTTONRECORDARRAY1',
1813	    Actions     => 'Array::ACTIONRECORDARRAY');
1814_create_pack('DefineButton');
1815
1816_create_tag('DefineButton2', 34, ['Button', 'ActionContainer'],
1817
1818	    ButtonID   => 'ID',
1819	    Flags      => '$UI8',
1820	    Characters => 'Array::BUTTONRECORDARRAY2',
1821	    Actions    => 'Array::BUTTONCONDACTIONARRAY');
1822
1823_create_tag('DefineButtonCxform', 23, ['Button'],
1824
1825	    ButtonID             => 'ID',
1826	    ButtonColorTransform => 'CXFORM');
1827_create_pack('DefineButtonCxform');
1828
1829_create_tag('DefineButtonSound', 17, ['Button'],
1830
1831	    ButtonID => 'ID',
1832	    ButtonSoundChar0 => 'ID', ButtonSoundInfo0 => 'SOUNDINFO',
1833	    ButtonSoundChar1 => 'ID', ButtonSoundInfo1 => 'SOUNDINFO',
1834	    ButtonSoundChar2 => 'ID', ButtonSoundInfo2 => 'SOUNDINFO',
1835	    ButtonSoundChar3 => 'ID', ButtonSoundInfo3 => 'SOUNDINFO');
1836
1837##  Fonts & Texts  ##
1838
1839_create_tag('DefineFont', 10, ['Font'],
1840
1841	    FontID => 'ID', GlyphShapeTable => 'Array::GLYPHSHAPEARRAY1');
1842_create_pack('DefineFont');
1843
1844_create_tag('DefineFontInfo', 13, ['Font'],
1845
1846	    FontID        => 'ID',
1847	    FontName      => 'PSTRING',
1848	    FontFlags     => '$UI8',
1849	    CodeTable     => 'Array::CODETABLE');
1850
1851_create_tag('DefineFontInfo2', 62, ['DefineFontInfo'],
1852
1853	    FontID        => 'ID',
1854	    FontName      => 'PSTRING',
1855	    FontFlags     => '$UI8',
1856	    LanguageCode  => '$UI8',
1857	    CodeTable     => 'Array::CODETABLE');
1858
1859_create_tag('DefineFont2', 48, ['Font'],
1860
1861	    FontID           => 'ID',
1862	    FontFlags        => '$UI8',
1863	    LanguageCode     => '$UI8',
1864	    FontName         => 'PSTRING',
1865	    GlyphShapeTable  => 'Array::GLYPHSHAPEARRAY2',
1866	    CodeTable        => 'Array::CODETABLE',
1867	    FontAscent       => '$SI16',
1868	    FontDescent      => '$SI16',
1869	    FontLeading      => '$SI16',
1870	    FontAdvanceTable => 'Array::FONTADVANCETABLE',
1871	    FontBoundsTable  => 'Array::FONTBOUNDSTABLE',
1872	    FontKerningTable => 'FONTKERNINGTABLE');
1873
1874_create_tag('DefineText', 11, ['Text'],
1875
1876	    CharacterID => 'ID',
1877	    TextBounds  => 'RECT',
1878	    TextMatrix  => 'MATRIX',
1879	    TextRecords => 'Array::TEXTRECORDARRAY1');
1880_create_pack('DefineText');
1881
1882_create_tag('DefineText2', 33, ['DefineText'],
1883
1884	    CharacterID => 'ID',
1885	    TextBounds  => 'RECT',
1886	    TextMatrix  => 'MATRIX',
1887	    TextRecords => 'Array::TEXTRECORDARRAY2');
1888_create_pack('DefineText2');
1889
1890_create_tag('DefineEditText', 37, ['Text'],
1891
1892	    CharacterID  => 'ID',
1893	    Bounds       => 'RECT',
1894	    Flags        => '$UI16',
1895	    FontID       => 'ID',
1896	    FontHeight   => '$UI16',
1897	    TextColor    => 'RGBA',
1898	    MaxLength    => '$UI16',
1899	    Align        => '$UI8',
1900	    LeftMargin   => '$UI16',
1901	    RightMargin  => '$UI16',
1902	    Indent       => '$UI16',
1903	    Leading      => '$UI16',
1904	    VariableName => 'STRING',
1905	    InitialText  => 'STRING');
1906
1907##  Sounds  ##
1908
1909_create_tag('DefineSound', 14, ['Sound'],
1910
1911	    SoundID          => 'ID',
1912	    Flags            => '$UI8',
1913	    SoundSampleCount => '$UI32',
1914	    SoundData        => 'BinData');
1915
1916_create_tag('StartSound', 15, ['Identified', 'ValidInSprite'],
1917
1918	    SoundID   => 'ID',
1919	    SoundInfo => 'SOUNDINFO');
1920_create_pack('StartSound');
1921
1922_create_tag('SoundStreamBlock', 19, ['Identified', 'ValidInSprite'],
1923
1924	    StreamSoundData => 'BinData');
1925
1926_create_tag('SoundStreamHead', 18, ['Identified', 'ValidInSprite'],
1927
1928	    Flags                  => '$UI16',
1929	    StreamSoundSampleCount => '$UI16',
1930	    LatencySeek            => '$SI16');
1931
1932_create_tag('SoundStreamHead2', 45, ['SoundStreamHead'],
1933
1934	    Flags                  => '$UI16',
1935	    StreamSoundSampleCount => '$UI16',
1936	    LatencySeek            => '$SI16');
1937
1938##  Sprites  ##
1939
1940_create_tag('DefineSprite', 39, ['Sprite'],
1941
1942	    SpriteID    => 'ID',
1943	    FrameCount  => '$UI16',
1944	    ControlTags => 'Array::TAGARRAY',
1945	    TagStream   => 'TAGSTREAM');
1946
1947##  Display list  ##
1948
1949_create_tag('PlaceObject', 4, ['DisplayList', 'ValidInSprite'],
1950
1951	    CharacterID    => 'ID',
1952	    Depth          => 'Depth',
1953	    Matrix         => 'MATRIX',
1954	    ColorTransform => 'CXFORM');
1955
1956_create_tag('PlaceObject2', 26, ['DisplayList', 'ActionContainer', 'ValidInSprite'],
1957
1958	    Flags          => '$UI8',
1959	    Depth          => 'Depth',
1960	    CharacterID    => 'ID',
1961	    Matrix         => 'MATRIX',
1962	    ColorTransform => 'CXFORMWITHALPHA',
1963	    Ratio          => '$UI16',
1964	    Name           => 'STRING',
1965	    ClipDepth      => 'Depth',
1966	    ClipActions    => 'Array::CLIPACTIONRECORDARRAY');
1967
1968_create_tag('RemoveObject', 5, ['DisplayList', 'ValidInSprite'],
1969
1970	    CharacterID => 'ID', Depth => 'Depth' );
1971_create_pack('RemoveObject');
1972
1973_create_tag('RemoveObject2', 28, ['DisplayList', 'ValidInSprite'],
1974
1975	    Depth => 'Depth' );
1976_create_pack('RemoveObject2');
1977
1978_create_tag('ShowFrame', 1, ['DisplayList', 'ValidInSprite']);
1979_create_pack('ShowFrame');
1980
1981##  Control  ##
1982
1983_create_tag('SetBackgroundColor', 9, ['Control'],
1984
1985	    BackgroundColor => 'RGB' );
1986_create_pack('SetBackgroundColor');
1987
1988_create_tag('FrameLabel', 43, ['Control', 'ValidInSprite'],
1989
1990	    Name => 'STRING',
1991	    NamedAnchorFlag => '$UI8' );
1992
1993_create_tag('Protect', 24, ['Control'],
1994
1995	    Reserved => '$UI16',
1996	    Password => 'STRING' );
1997
1998_create_tag('EnableDebugger', 58, ['Control'],
1999
2000	    Reserved => '$UI16',
2001	    Password => 'STRING' );
2002_create_pack('EnableDebugger');
2003
2004_create_tag('EnableDebugger2', 64, ['Control'],
2005
2006	    Reserved => '$UI16',
2007	    Password => 'STRING' );
2008_create_pack('EnableDebugger2');
2009
2010_create_tag('ScriptLimits', 65, ['Control'],
2011
2012	    MaxRecurtionDepth    => '$UI16',
2013	    ScriptTimeoutSeconds => '$UI16' );
2014_create_pack('ScriptLimits');
2015
2016_create_tag('SetTabIndex', 66, ['Control'],
2017
2018	    Depth    => 'Depth',
2019	    TabIndex => '$UI16' );
2020_create_pack('SetTabIndex');
2021
2022
2023_create_tag('End', 0, ['Control', 'ValidInSprite']);
2024_create_pack('End');
2025
2026_create_tag('ExportAssets', 56, ['Control'],
2027
2028	    Assets => 'Array::ASSETARRAY');
2029_create_pack('ExportAssets');
2030
2031_create_tag('ImportAssets', 57, ['Control', 'Definition'],
2032
2033	    URL    => 'STRING',
2034	    Assets => 'Array::ASSETARRAY');
2035_create_pack('ImportAssets');
2036
2037##  Actions  ##
2038
2039_create_tag('DoAction', 12, ['Identified', 'ActionContainer', 'ValidInSprite'],
2040
2041	    Actions => 'Array::ACTIONRECORDARRAY');
2042_create_pack('DoAction');
2043
2044_create_tag('DoInitAction', 59, ['Definition', 'ActionContainer'],
2045
2046	    SpriteID => 'ID',
2047	    Actions  => 'Array::ACTIONRECORDARRAY');
2048_create_pack('DoInitAction');
2049
2050##  Video  ##
2051
2052_create_tag('DefineVideoStream', 60, ['Video'],
2053
2054            CharacterID => 'ID',
2055            NumFrames   => '$UI16',
2056            Width       => '$UI16',
2057            Height      => '$UI16',
2058            VideoFlags  => '$UI8',
2059            CodecID     => '$UI8');
2060_create_pack('DefineVideoStream');
2061
2062_create_tag('VideoFrame', 61, ['Video'],
2063
2064            StreamID  => 'ID',
2065            FrameNum  => '$UI16',
2066            VideoData => 'BinData');
2067_create_pack('VideoFrame');
2068
2069##  others?  ##
2070
2071_create_tag('FreeCharacter', 3, ['Control'],
2072
2073	    CharacterID => 'ID');
2074_create_pack('FreeCharacter');
2075
2076_create_tag('NameCharacter', 40, ['Control'],
2077
2078	    ID => 'ID',
2079	    Name        => 'STRING');
2080_create_pack('NameCharacter');
2081
2082
2083
2084### Identified Tag base ###
2085
2086package SWF::Element::Tag::Identified;
2087
2088sub unpack {
2089    my $self = shift;
2090    my $stream = shift;
2091
2092    my $start = $stream->tell;
2093    my $length = $self->Length || 0;
2094    $self->_unpack($stream, @_) if $length>0;
2095    $stream->flush_bits;
2096    my $read = $stream->tell - $start;
2097    if ($read < $length) {
2098	$stream->get_string($length-$read);  # Skip the rest of tag data.
2099    } elsif ($read > $length) {
2100	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??";
2101    }
2102}
2103
2104sub pack {
2105    my ($self, $stream)=@_;
2106    my $substream = $stream->sub_stream;
2107
2108    $self->_pack($substream);
2109    my $header = $self->tag_number<<6;
2110    my $len = $substream->tell;
2111    if ($len >= 0x3f or $self->is_tagtype('AlwaysLongHeader')) {
2112	$header |= 0x3f;
2113	$stream->set_UI16($header);
2114	$stream->set_UI32($len);
2115    } else {
2116	$stream->set_UI16($header|$len);
2117    }
2118    $substream->flush_stream;
2119}
2120
2121
2122####  Packed tag  ####
2123##########
2124
2125package SWF::Element::Tag::Packed;
2126
2127#@SWF::Element::Tag::Packed::ISA = ('SWF::Element::Tag::Identified');
2128
2129SWF::Element::_create_class
2130    ( 'Tag::Packed', ['Tag::Identified'],
2131      Tag  => '$',
2132      Data => 'BinData',
2133     1 );
2134
2135sub _init {
2136    my $self = shift;
2137    my $tag = $_[1];
2138
2139    $self->SUPER::_init(@_);
2140    $self->Tag($tag);
2141}
2142
2143sub _tag_class {
2144    return $tagname[$_[1]] ? 'SWF::Element::Tag::'.$tagname[$_[1]].'::Packed' : 'SWF::Element::Tag::Unknown';
2145}
2146
2147sub _unpack {
2148    my ($self, $stream)=@_;
2149
2150    $self->Data->unpack($stream, $self->Length);
2151}
2152
2153sub _pack {
2154    my ($self, $stream)=@_;
2155
2156    $self->Data->pack($stream);
2157}
2158
2159####  Unknown  ####
2160##########
2161
2162package SWF::Element::Tag::Unknown;
2163
2164@SWF::Element::Tag::Unknown::ISA = ('SWF::Element::Tag::Packed');
2165
2166SWF::Element::_create_class
2167    ( 'Tag::Unknown', ['Tag::Packed'],
2168      Tag  => '$',
2169      Data => 'BinData',
2170     1 );
2171
2172sub _init {
2173    my $self = shift;
2174    my $tag = $_[1];
2175
2176    $self->SUPER::_init(@_);
2177    Carp::carp "Tag No. $tag is unknown";
2178}
2179
2180sub tag_name {'Unknown'}
2181sub tag_number {shift->Tag}
2182
2183####  Shapes  ####
2184########
2185
2186package SWF::Element::Tag::DefineMorphShape;
2187
2188sub _unpack {
2189    my ($self, $stream)=@_;
2190
2191    $self->CharacterID->unpack($stream);
2192    $self->StartBounds->unpack($stream);
2193    $self->EndBounds  ->unpack($stream);
2194    $stream->get_UI32; # Skip Offset
2195    $self->MorphFillStyles->unpack($stream);
2196    $self->MorphLineStyles->unpack($stream);
2197    $stream->flush_bits;
2198    $self->StartEdges->unpack($stream);
2199    $stream->flush_bits;
2200    $self->EndEdges->unpack($stream);
2201}
2202
2203sub _pack {
2204    my ($self, $stream)=@_;
2205
2206    $self->CharacterID->pack($stream);
2207    $self->StartBounds->pack($stream);
2208    $self->EndBounds  ->pack($stream);
2209    {
2210	my $tempstream=$stream->sub_stream;
2211	my ($nfillbits, $nlinebits) = (0, 0);
2212	my ($fillidx, $lineidx) = ($#{$self->MorphFillStyles}+1, $#{$self->MorphLineStyles}+1);
2213	if ($fillidx>0) {
2214	    $nfillbits=1;
2215	    $nfillbits++ while ($fillidx>=(1<<$nfillbits));
2216	}
2217	if ($lineidx>0) {
2218	    $nlinebits=1;
2219	    $nlinebits++ while ($lineidx>=(1<<$nlinebits));
2220	}
2221	$self->MorphFillStyles->pack($tempstream);
2222	$self->MorphLineStyles->pack($tempstream);
2223	$tempstream->flush_bits;
2224	$self->StartEdges->pack($tempstream, $nfillbits, $nlinebits);
2225	$tempstream->flush_bits;
2226	$stream->set_UI32($tempstream->tell);
2227	$tempstream->flush_stream;
2228    }
2229    $self->EndEdges->pack($stream, 0, 0);
2230    $stream->flush_bits;
2231}
2232
2233##########
2234
2235package SWF::Element::MORPHFILLSTYLE;
2236
2237sub pack {
2238    my ($self, $stream)=@_;
2239    my $style=$self->FillStyleType;
2240    $stream->set_UI8($style);
2241    if ($style==0x00) {
2242	$self->StartColor->pack($stream);
2243	$self->EndColor->pack($stream);
2244    } elsif ($style==0x10 or $style==0x12) {
2245	$self->StartGradientMatrix->pack($stream);
2246	$self->EndGradientMatrix->pack($stream);
2247	$self->Gradient->pack($stream);
2248    } elsif ($style>=0x40 or $style<=0x43) {
2249	$self->BitmapID->pack($stream);
2250	$self->StartBitmapMatrix->pack($stream);
2251	$self->EndBitmapMatrix->pack($stream);
2252    }
2253}
2254
2255sub unpack {
2256    my ($self, $stream)=@_;
2257    my $style = $self->FillStyleType($stream->get_UI8);
2258    if ($style==0x00) {
2259	$self->StartColor->unpack($stream);
2260	$self->EndColor->unpack($stream);
2261    } elsif ($style==0x10 or $style==0x12) {
2262	$self->StartGradientMatrix->unpack($stream);
2263	$self->EndGradientMatrix->unpack($stream);
2264	$self->Gradient->unpack($stream);
2265    } elsif ($style<=0x40 or $style<=0x43) {
2266	$self->BitmapID->unpack($stream);
2267	$self->StartBitmapMatrix->unpack($stream);
2268	$self->EndBitmapMatrix->unpack($stream);
2269    }
2270}
2271
2272
2273####  Bitmaps  ####
2274##########
2275
2276package SWF::Element::Tag::DefineBits;
2277
2278sub _unpack {
2279    my ($self, $stream)=@_;
2280
2281    $self->CharacterID->unpack($stream);
2282    $self->JPEGData->unpack($stream, $self->Length - 2);
2283}
2284
2285sub _pack {
2286    my ($self, $stream)=@_;
2287
2288    $self->CharacterID->pack($stream);
2289    $self->JPEGData->pack($stream);
2290}
2291
2292##########
2293
2294package SWF::Element::Tag::DefineBitsJPEG2;
2295
2296sub _unpack {
2297    my ($self, $stream)=@_;
2298
2299    $self->CharacterID->unpack($stream);
2300#    $self->_unpack_JPEG($stream, $self->Length - 2);
2301    $self->JPEGData->unpack($stream, $self->Length - 2);
2302}
2303
2304=pod
2305
2306sub _unpack_JPEG {
2307    my ($self, $stream, $len) = @_;
2308    my ($data1, $data2);
2309
2310    while (!$data2 and $len > 0) {
2311	my $size = ($len > 1000) ? 1000 : $len;
2312	$data1 = $stream->get_string($size);
2313	$len -= $size;
2314	if ($data1 =~/\xff$/ and $len>0) {
2315	    $data1 .= $stream->get_string(1);
2316	    $len--;
2317	}
2318	($data1, $data2) = split /\xff\xd9/, $data1;
2319	$self->BitmapJPEGEncoding->add($data1);
2320    }
2321    $self->BitmapJPEGEncoding->add("\xff\xd9");
2322
2323    $self->BitmapJPEGImage($data2);
2324    while ($len > 0) {
2325	my $size = ($len > 1000) ? 1000 : $len;
2326	$data1 = $stream->get_string($size);
2327	$len -= $size;
2328	$self->BitmapJPEGImage->add($data1);
2329    }
2330}
2331
2332=cut
2333
2334##########
2335
2336package SWF::Element::Tag::DefineBitsJPEG3;
2337
2338sub _unpack {
2339    my ($self, $stream)=@_;
2340
2341    $self->CharacterID->unpack($stream);
2342    my $offset = $stream->get_UI32;
2343#    $self->_unpack_JPEG($stream, $offset);
2344    $self->JPEGData->unpack($stream, $offset);
2345    $self->BitmapAlphaData->unpack($stream, $self->Length - $offset - 6);
2346}
2347
2348sub _pack {
2349    my ($self, $stream)=@_;
2350
2351    $self->CharacterID->pack($stream);
2352    $stream->set_UI32($self->JPEGData->Length);
2353    $self->JPEGData->pack($stream);
2354    $self->BitmapAlphaData->pack($stream);
2355}
2356
2357##########
2358
2359package SWF::Element::Tag::DefineBitsLossless;
2360
2361sub _unpack {
2362    my ($self, $stream)=@_;
2363    my $length=$self->Length - 7;
2364
2365#    delete @{$self}{qw/ColorTable BitmapImage/};
2366
2367    $self->CharacterID->unpack($stream);
2368    $self->BitmapFormat($stream->get_UI8);
2369    $self->BitmapWidth($stream->get_UI16);
2370    $self->BitmapHeight($stream->get_UI16);
2371    if ($self->BitmapFormat == 3) {
2372	$self->BitmapColorTableSize($stream->get_UI8);
2373	$length--;
2374    }
2375    $self->ZlibBitmapData->unpack($stream, $length);
2376#    $self->decompress;
2377}
2378
2379sub _pack {
2380    my ($self, $stream)=@_;
2381
2382#    $self->compress if defined $self->{'ColorTable'} and defined $self->{'BitmapImage'};
2383    $self->CharacterID->pack($stream);
2384    $stream->set_UI8($self->BitmapFormat);
2385    $stream->set_UI16($self->BitmapWidth);
2386    $stream->set_UI16($self->BitmapHeight);
2387    $stream->set_UI8($self->BitmapColorTableSize) if $self->BitmapFormat == 3;
2388    $self->ZlibBitmapData->pack($stream);
2389}
2390
2391sub decompress {
2392}
2393
2394sub compress {
2395}
2396
2397##########
2398
2399package SWF::Element::Tag::JPEGTables;
2400
2401sub _unpack {
2402    my ($self, $stream)=@_;
2403
2404    $self->JPEGData->unpack($stream, $self->Length);
2405}
2406
2407sub _pack {
2408    my ($self, $stream)=@_;
2409
2410    $self->JPEGData->pack($stream);
2411}
2412
2413####  Buttons  ####
2414
2415##########
2416
2417package SWF::Element::BUTTONRECORD1;
2418
2419sub unpack {
2420    my ($self, $stream)=@_;
2421
2422    $self->ButtonStates($stream->get_UI8);
2423    return if $self->ButtonStates == 0;
2424    $self->CharacterID->unpack($stream);
2425    $self->PlaceDepth->unpack($stream);
2426    $self->PlaceMatrix->unpack($stream);
2427}
2428
2429sub pack {
2430    my ($self, $stream)=@_;
2431
2432    $stream->set_UI8($self->ButtonStates);
2433    return if $self->ButtonStates == 0;
2434    $self->CharacterID->pack($stream);
2435    $self->PlaceDepth->pack($stream);
2436    $self->PlaceMatrix->pack($stream);
2437}
2438
2439{
2440    my $bit = 0;
2441    for my $f (qw/ButtonStateUp ButtonStateOver ButtonStateDown ButtonStateHitTest/) {
2442      SWF::Element::_create_flag_accessor($f, 'ButtonStates', $bit++);
2443    }
2444}
2445
2446package SWF::Element::BUTTONRECORD2;
2447
2448sub unpack {
2449    my ($self, $stream)=@_;
2450
2451    $self->SUPER::unpack($stream);
2452    return if $self->ButtonStates == 0;
2453    $self->ColorTransform->unpack($stream);
2454}
2455
2456sub pack {
2457    my ($self, $stream)=@_;
2458
2459    $self->SUPER::pack($stream);
2460    return if $self->ButtonStates == 0;
2461    $self->ColorTransform->pack($stream);
2462}
2463
2464
2465##########
2466
2467package SWF::Element::Tag::DefineButton2;
2468
2469sub _unpack {
2470    my ($self, $stream)=@_;
2471
2472    $self->ButtonID->unpack($stream);
2473    $self->Flags($stream->get_UI8);
2474    my $offset=$stream->get_UI16;
2475    $self->Characters->unpack($stream);
2476    $self->Actions->unpack($stream) if $offset;
2477}
2478
2479sub _pack {
2480    my ($self, $stream)=@_;
2481    my $actions = $self->Actions;
2482
2483    $self->ButtonID->pack($stream);
2484    $stream->set_UI8($self->Flags);
2485    my $substream = $stream->sub_stream;
2486    $self->Characters->pack($substream);
2487    $stream->set_UI16((@$actions>0) && ($substream->tell + 2));
2488    $substream->flush_stream;
2489    $actions->pack($stream) if (@$actions>0);
2490}
2491
2492 SWF::Element::_create_flag_accessor('TrackAsMenu', 'Flags', 0);
2493
2494##########
2495
2496package SWF::Element::Array::BUTTONCONDACTIONARRAY;
2497
2498sub pack {
2499    my ($self, $stream)=@_;
2500
2501    my $last=pop @$self;
2502    for my $element (@$self) {
2503	my $tempstream=$stream->sub_stream;
2504	$element->pack($tempstream);
2505	$stream->set_UI16($tempstream->tell + 2);
2506	$tempstream->flush_stream;
2507    }
2508    $stream->set_UI16(0);
2509    $last->pack($stream);
2510    push @$self, $last;
2511}
2512
2513sub unpack {
2514    my ($self, $stream)=@_;
2515    my ($element, $offset);
2516
2517    do {
2518	$offset=$stream->get_UI16;
2519	$element=$self->new_element;
2520	$element->unpack($stream);
2521	push @$self, $element;
2522    } until $offset==0;
2523}
2524
2525##########
2526
2527package SWF::Element::BUTTONCONDACTION;
2528
2529{
2530    my $bit = 0;
2531
2532    for my $f (qw/IdleToOverUp OverUpToIdle OverUpToOverDown OverDownToOverUp OverDownToOutDown OutDownToOverDown OutDownToIdle IdleToOverDown OverDownToIdle/) {
2533      SWF::Element::_create_flag_accessor("Cond$f", 'Condition', $bit++);
2534    }
2535  SWF::Element::_create_flag_accessor("CondKeyPress", 'Condition', 9, 7);
2536
2537}
2538
2539##########
2540
2541package SWF::Element::Tag::DefineButtonSound;
2542
2543sub _unpack {
2544    my ($self, $stream)=@_;
2545
2546    $self->ButtonID->unpack($stream);
2547    for my $i (0..3) {
2548	my $bsc = "ButtonSoundChar$i";
2549	my $bsi = "ButtonSoundInfo$i";
2550
2551	$self->$bsc->unpack($stream);
2552	if ($self->$bsc) {
2553	    $self->$bsi->unpack($stream);
2554	}
2555    }
2556}
2557
2558sub _pack {
2559    my ($self, $stream)=@_;
2560
2561    $self->ButtonID->pack($stream);
2562    for my $i (0..3) {
2563	my $bsc = "ButtonSoundChar$i";
2564	my $bsi = "ButtonSoundInfo$i";
2565
2566	$self->$bsc->pack($stream);
2567	$self->$bsi->pack($stream) if $self->$bsc;
2568    }
2569}
2570
2571####  Texts and Fonts  ####
2572##########
2573
2574package SWF::Element::Array::GLYPHSHAPEARRAY1;
2575
2576sub pack {
2577    my ($self, $stream)=@_;
2578    my $offset = @$self*2+2;
2579
2580    $stream->set_UI16($offset);
2581
2582    my $tempstream = $stream->sub_stream;
2583
2584    for my $element (@$self) {
2585	$element->pack($tempstream, 1, 0);
2586	$stream->set_UI16($offset + $tempstream->tell);
2587    }
2588    $tempstream->flush_stream;
2589}
2590
2591sub unpack {
2592    my ($self, $stream)=@_;
2593    my $offset=$stream->get_UI16;
2594
2595    $stream->get_string($offset-2); # skip offset table.
2596    for (my $i=0; $i < $offset/2; $i++) {
2597	my $element = $self->new_element;
2598	$element->unpack($stream);
2599	push @$self, $element;
2600    }
2601}
2602
2603##########
2604
2605package SWF::Element::Array::GLYPHSHAPEARRAY2;
2606
2607sub pack {     # return wide offset flag (true => 32bit, false => 16bit)
2608    my ($self, $stream)=@_;
2609    my (@offset, $wideoffset);
2610    my $glyphcount=@$self;
2611
2612    $offset[0]=0;
2613    my $tempstream=$stream->sub_stream;
2614
2615    for my $element (@$self) {
2616	$element->pack($tempstream, 1, 0);
2617	push @offset, $tempstream->tell;  # keep glyph shape's offset.
2618    }
2619
2620# Each offset should be added the offset table size.
2621# If the last offset is more than 65535, offsets are packed in 32bits each.
2622
2623    if (($glyphcount+1)*2+$offset[-1] >= (1<<16)) {
2624	$wideoffset=1;
2625	for my $element (@offset) {
2626	    $stream->set_UI32(($glyphcount+1)*4+$element);
2627	}
2628    } else {
2629	$wideoffset=0;
2630	for my $element (@offset) {
2631	    $stream->set_UI16(($glyphcount+1)*2+$element);
2632	}
2633    }
2634    $tempstream->flush_stream;
2635    return $wideoffset;
2636}
2637
2638sub unpack {
2639    my ($self, $stream, $wideoffset)=@_;
2640    my @offset;
2641    my $getoffset = ($wideoffset ? sub {$stream->get_UI32} : sub {$stream->get_UI16});
2642    my $origin = $stream->tell;
2643
2644    $offset[0] = &$getoffset;
2645    my $count = $offset[0]>>($wideoffset ? 2:1);
2646
2647    for (my $i = 1; $i < $count; $i++) {
2648	push @offset, &$getoffset;
2649    }
2650    my $pos = $stream->tell - $origin;
2651    my $offset = shift @offset;
2652    Carp::croak ref($self).": Font offset table seems to be collapsed." if $pos>$offset;
2653    $stream->get_string($pos-$offset) if $pos<$offset;
2654    for (my $i = 1; $i < $count; $i++) {
2655	my $element = $self->new_element;
2656	$element->unpack($stream);
2657	push @$self, $element;
2658	my $pos = $stream->tell - $origin;
2659	my $offset = shift @offset;
2660	Carp::croak ref($self).": Font shape table seems to be collapsed." if $pos>$offset;
2661	$stream->get_string($pos-$offset) if $pos<$offset;
2662    }
2663}
2664
2665
2666##########
2667
2668package SWF::Element::Tag::DefineFont2;
2669
2670sub _unpack {
2671    my ($self, $stream)=@_;
2672
2673    $self->FontID->unpack($stream);
2674    my $flag = $self->FontFlags($stream->get_UI8);
2675    $self->LanguageCode($stream->get_UI8);
2676    $self->FontName->unpack($stream);
2677    my $glyphcount = $stream->get_UI16;
2678    if ($glyphcount > 0) {
2679	$self->GlyphShapeTable->unpack($stream, ($flag & 8));
2680	$self->CodeTable->unpack($stream, $glyphcount, ($flag & 4));
2681    }
2682    if ($flag & 128) {
2683	$self->FontAscent($stream->get_SI16);
2684	$self->FontDescent($stream->get_SI16);
2685	$self->FontLeading($stream->get_SI16);
2686	$self->FontAdvanceTable->unpack($stream, $glyphcount);
2687	$self->FontBoundsTable ->unpack($stream, $glyphcount);
2688	$self->FontKerningTable->unpack($stream, ($flag & 4));
2689    }
2690}
2691
2692sub _pack {
2693    my ($self, $stream)=@_;
2694    my $glyphcount = @{$self->CodeTable};
2695
2696    $self->FontID->pack($stream);
2697    my $tempstream = $stream->sub_stream;
2698    my $flag = (($self->FontFlags || 0) & 0b01010111);
2699
2700    $self->FontName->pack($tempstream);
2701    $tempstream->set_UI16($glyphcount);
2702    if ($glyphcount > 0){
2703	$self->GlyphShapeTable->pack($tempstream) and ($flag |= 8);
2704	$self->CodeTable->pack($tempstream, $self->FontFlagsWideCodes) and ($flag |= 4);
2705    }
2706    if (defined $self->FontAscent) {
2707	$flag |= 128;
2708	$tempstream->set_SI16($self->FontAscent);
2709	$tempstream->set_SI16($self->FontDescent);
2710	$tempstream->set_SI16($self->FontLeading);
2711	$self->FontAdvanceTable->pack($tempstream);
2712	$self->FontBoundsTable->pack($tempstream);
2713	$self->FontKerningTable->pack($tempstream, ($flag & 4));
2714    }
2715    $stream->set_UI8($flag);
2716    $stream->set_UI8($self->LanguageCode);
2717    $tempstream->flush_stream;
2718}
2719
2720{
2721    my $bit = 0;
2722    for my $f (qw/ Bold Italic WideCodes WideOffsets ANSI SmallText ShiftJIS HasLayout /) {
2723      SWF::Element::_create_flag_accessor("FontFlags$f", 'FontFlags', $bit++);
2724    }
2725}
2726
2727##########
2728
2729package SWF::Element::Array::CODETABLE;
2730
2731sub pack {
2732    my ($self, $stream, $widecode)=@_;
2733
2734    for my $element (@$self) {
2735	if ($element > 255) {
2736	    $widecode = 1;
2737	    last;
2738	}
2739    }
2740    if ($widecode) {
2741	for my $element (@$self) {
2742	    $stream->set_UI16($element);
2743	}
2744    } else {
2745	for my $element (@$self) {
2746	    $stream->set_UI8($element);
2747	}
2748    }
2749    $widecode;
2750}
2751
2752sub unpack {
2753    my ($self, $stream, $glyphcount, $widecode)=@_;
2754    my ($templete);
2755    if ($widecode) {
2756	$glyphcount*=2;
2757	$templete='v*';
2758    } else {
2759	$templete='C*';
2760    }
2761
2762    @$self=unpack($templete,$stream->get_string($glyphcount));
2763}
2764
2765##########
2766
2767package SWF::Element::Array::FONTADVANCETABLE;
2768
2769sub pack {
2770    my ($self, $stream)=@_;
2771
2772    for my $element (@$self) {
2773	$stream->set_SI16($element);
2774    }
2775}
2776
2777sub unpack {
2778    my ($self, $stream, $glyphcount)=@_;
2779
2780    while (--$glyphcount >=0) {
2781	push @$self, $stream->get_SI16;
2782    }
2783}
2784
2785##########
2786
2787package SWF::Element::Array::FONTBOUNDSTABLE;
2788
2789sub unpack {
2790    my ($self, $stream, $glyphcount)=@_;
2791
2792    while (--$glyphcount >=0) {
2793	my $element = $self->new_element;
2794	$element->unpack($stream);
2795	push @$self, $element;
2796    }
2797}
2798
2799##########
2800
2801package SWF::Element::FONTKERNINGTABLE;
2802
2803@SWF::Element::FONTKERNINGTABLE::ISA = ('SWF::Element');
2804
2805sub new {
2806    my $class = shift;
2807    my $self = {};
2808
2809    $class=ref($class)||$class;
2810
2811    bless $self, $class;
2812    $self->configure(@_) if @_;
2813    $self;
2814}
2815
2816sub unpack {
2817    my ($self, $stream, $widecode)=@_;
2818    my $count=$stream->get_UI16;
2819    my $getcode=($widecode ? sub {$stream->get_UI16} : sub {$stream->get_UI8});
2820    %$self=();
2821    while (--$count>=0) {
2822	my $code1=&$getcode;
2823	my $code2=&$getcode;
2824	$self->{"$code1-$code2"}=$stream->get_SI16;
2825    }
2826}
2827
2828sub pack {
2829    my ($self, $stream, $widecode)=@_;
2830    my $setcode=($widecode ? sub {$stream->set_UI16(shift)} : sub {$stream->set_UI8(shift)});
2831    my ($k, $v);
2832
2833    $stream->set_UI16(scalar(keys(%$self)));
2834    while (($k, $v)=each(%$self)) {
2835	my ($code1, $code2)=split(/-/,$k);
2836	&$setcode($code1);
2837	&$setcode($code2);
2838	$stream->set_SI16($v);
2839    }
2840}
2841
2842sub configure {
2843    my ($self, @param)=@_;
2844
2845    if (@param==0) {
2846	return map {$_, $self->{$_}} grep {defined $self->{$_}} keys(%$self);
2847    } elsif (@param==1) {
2848	my $k=$param[0];
2849	return undef unless exists $self->{$k};
2850	return $self->{$k};
2851    } else {
2852	my %param=@param;
2853	my ($key, $value);
2854	while (($key, $value) = each %param) {
2855	    next if $key!~/^\d+-\d+$/;
2856	    $self->{$key}=$value;
2857	}
2858    }
2859}
2860
2861sub dumper {
2862    my ($self, $outputsub, $indent)=@_;
2863    my ($k, $v);
2864
2865    $indent ||= 0;
2866    $outputsub||=\&SWF::Element::_default_output;
2867
2868    &$outputsub(ref($self)."->new(\n", 0);
2869    while (($k, $v) = each %$self) {
2870	&$outputsub("'$k' => $v,\n", $indent + 1);
2871    }
2872    &$outputsub(")", $indent);
2873}
2874
2875sub defined {
2876    keys %{shift()} > 0;
2877}
2878
2879##########
2880
2881package SWF::Element::Tag::DefineFontInfo;
2882
2883sub _unpack {
2884    my ($self, $stream)=@_;
2885
2886    my $start = $stream->tell;
2887    $self->FontID   ->unpack($stream);
2888    $self->FontName ->unpack($stream);
2889    my $widecode   = $self->FontFlags($stream->get_UI8) & 1;
2890    my $glyphcount = $self->Length - ($stream->tell - $start);
2891    $glyphcount >>= 1 if $widecode;
2892    $self->CodeTable->unpack($stream, $glyphcount, $widecode);
2893}
2894
2895sub _pack {
2896    my ($self, $stream)=@_;
2897
2898    $self->FontID   ->pack($stream);
2899    $self->FontName ->pack($stream);
2900    my $substream = $stream->sub_stream;
2901    my $flag = $self->FontFlags & 0b11110;
2902    $self->CodeTable->pack($substream) and ($flag |= 1);
2903
2904    $stream->set_UI8($flag);
2905    $substream->flush_stream;
2906}
2907
2908{
2909    my $bit = 0;
2910    for my $f (qw/ WideCodes Bold Italic ANSI ShiftJIS SmallText/) {
2911      SWF::Element::_create_flag_accessor("FontFlags$f", 'FontFlags', $bit++);
2912    }
2913}
2914
2915##########
2916
2917package SWF::Element::Tag::DefineFontInfo2;
2918
2919sub _unpack {
2920    my ($self, $stream)=@_;
2921
2922    my $start = $stream->tell;
2923    $self->FontID   ->unpack($stream);
2924    $self->FontName ->unpack($stream);
2925    my $widecode = $self->FontFlags($stream->get_UI8) & 1;
2926    $self->LanguageCode($stream->get_UI8);
2927    my $glyphcount = $self->Length - ($stream->tell - $start);
2928    $glyphcount >>= 1 if $widecode;
2929    $self->CodeTable->unpack($stream, $glyphcount, $widecode);
2930}
2931
2932sub _pack {
2933    my ($self, $stream)=@_;
2934
2935    $self->FontID   ->pack($stream);
2936    $self->FontName ->pack($stream);
2937    my $substream = $stream->sub_stream;
2938    my $flag = ($self->FontFlags & 0b11100111 | 1);
2939    $self->CodeTable->pack($substream, 1);
2940
2941    $stream->set_UI8($flag);
2942    $stream->set_UI8($self->LanguageCode);
2943    $substream->flush_stream;
2944}
2945
2946
2947##########
2948
2949package SWF::Element::Array::TEXTRECORDARRAY1;
2950
2951sub pack {
2952    my ($self, $stream)=@_;
2953    my ($nglyphmax, $nglyphbits, $nadvancemax, $nadvancebits, $g, $a) = (0) x 6;
2954
2955    for my $element (@$self) {
2956	for my $entry (@{$element->GlyphEntries}) {
2957	    $g=$entry->GlyphIndex;
2958	    $a=$entry->GlyphAdvance;
2959	    $a=~$a if $a<0;
2960	    $nglyphmax=$g if $g>$nglyphmax;
2961	    $nadvancemax=$a if $a>$nadvancemax;
2962	}
2963    }
2964    $nglyphbits++ while ($nglyphmax>=(1<<$nglyphbits));
2965    $nadvancebits++ while ($nadvancemax>=(1<<$nadvancebits));
2966    $nadvancebits++; # for sign bit.
2967
2968    $stream->set_UI8($nglyphbits);
2969    $stream->set_UI8($nadvancebits);
2970
2971    for my $element (@$self) {
2972	$element->pack($stream, $nglyphbits, $nadvancebits);
2973    }
2974    $self->last($stream);
2975}
2976
2977sub unpack {
2978    my ($self, $stream)=@_;
2979    my ($nglyphbits, $nadvancebits);
2980    my ($flags);
2981
2982    $nglyphbits=$stream->get_UI8;
2983    $nadvancebits=$stream->get_UI8;
2984    {
2985	my $element = $self->new_element;
2986	$element->unpack($stream, $nglyphbits, $nadvancebits);
2987	last if $self->is_last($element);
2988	push @$self, $element;
2989	redo;
2990    }
2991}
2992
2993##########
2994
2995package SWF::Element::TEXTRECORD1;
2996
2997sub unpack {
2998    my $self = shift;
2999    my $stream = shift;
3000
3001    my $flags = $stream->get_UI8;
3002    if ($flags == 0) {
3003	return bless $self, 'SWF::Element::TEXTRECORD::End';
3004    }
3005    $self->FontID   ->unpack($stream)    if ($flags & 8);
3006    $self->TextColor->unpack($stream)    if ($flags & 4);
3007    $self->XOffset($stream->get_SI16)    if ($flags & 1);
3008    $self->YOffset($stream->get_SI16)    if ($flags & 2);
3009    $self->TextHeight($stream->get_UI16) if ($flags & 8);
3010    $self->GlyphEntries->unpack($stream, @_);
3011}
3012
3013sub pack {
3014    my $self = shift;
3015    my $stream = shift;
3016    my ($flags)=0x80;
3017
3018    $flags|=8 if $self->FontID->defined or defined $self->TextHeight;
3019    $flags|=4 if $self->TextColor->defined;
3020    $flags|=1 if defined $self->XOffset;
3021    $flags|=2 if defined $self->YOffset;
3022    $stream->set_UI8($flags);
3023
3024    $self->FontID->pack($stream)  if ($flags & 8);
3025    $self->TextColor->pack($stream) if ($flags & 4);
3026    $stream->set_SI16($self->XOffset) if ($flags & 1);
3027    $stream->set_SI16($self->YOffset) if ($flags & 2);
3028    $stream->set_UI16($self->TextHeight) if ($flags & 8);
3029    $self->GlyphEntries->pack($stream, @_);
3030}
3031
3032##########
3033
3034package SWF::Element::GLYPHENTRY;
3035
3036sub unpack {
3037    my ($self, $stream, $nglyphbits, $nadvancebits)=@_;
3038
3039    $self->GlyphIndex($stream->get_bits($nglyphbits));
3040    $self->GlyphAdvance($stream->get_sbits($nadvancebits));
3041}
3042
3043sub pack {
3044    my ($self, $stream, $nglyphbits, $nadvancebits)=@_;
3045
3046    $stream->set_bits($self->GlyphIndex, $nglyphbits);
3047    $stream->set_sbits($self->GlyphAdvance, $nadvancebits);
3048}
3049
3050##########
3051
3052package SWF::Element::TEXTRECORD1::TYPE1;
3053
3054=pod obsolete
3055
3056sub unpack {
3057    my ($self, $stream, $flags)=@_;
3058
3059    $self->FontID   ->unpack($stream)    if ($flags & 8);
3060    $self->TextColor->unpack($stream)    if ($flags & 4);
3061    $self->XOffset($stream->get_SI16)    if ($flags & 1);
3062    $self->YOffset($stream->get_SI16)    if ($flags & 2);
3063    $self->TextHeight($stream->get_UI16) if ($flags & 8);
3064}
3065
3066=cut
3067
3068sub pack {
3069    my ($self, $stream)=@_;
3070    my ($flags)=0x80;
3071
3072    $flags|=8 if $self->FontID->defined or defined $self->TextHeight;
3073    $flags|=4 if $self->TextColor->defined;
3074    $flags|=1 if defined $self->XOffset;
3075    $flags|=2 if defined $self->YOffset;
3076    $stream->set_UI8($flags);
3077
3078    $self->FontID->pack($stream)  if ($flags & 8);
3079    $self->TextColor->pack($stream) if ($flags & 4);
3080    $stream->set_SI16($self->XOffset) if ($flags & 1);
3081    $stream->set_SI16($self->YOffset) if ($flags & 2);
3082    $stream->set_UI16($self->TextHeight) if ($flags & 8);
3083}
3084
3085
3086##########
3087
3088package SWF::Element::Tag::DefineEditText;
3089
3090sub _unpack {
3091    my ($self, $stream)=@_;
3092
3093    $self->CharacterID->unpack($stream);
3094    $self->Bounds->unpack($stream);
3095    my $flag = $self->Flags($stream->get_UI16);
3096
3097    if ($flag & 1) {
3098	$self->FontID->unpack($stream);
3099	$self->FontHeight($stream->get_UI16);
3100    }
3101    $self->TextColor->unpack($stream) if $flag & 4;
3102    $self->MaxLength($stream->get_UI16) if $flag & 2;
3103
3104    if ($flag & (1<<13)) {
3105	$self->Align($stream->get_UI8);
3106	for my $element (qw/LeftMargin RightMargin Indent Leading/) {
3107	    $self->$element($stream->get_UI16);
3108	}
3109    }
3110    $self->VariableName->unpack($stream);
3111    $self->InitialText->unpack($stream) if $flag & 128;
3112}
3113
3114sub _pack {
3115    my ($self, $stream)=@_;
3116
3117    my $flag = $self->Flags & 0b101101101111000;
3118    $flag |= ($self->FontID->defined or defined $self->FontHeight) |
3119	     defined ($self->MaxLength)  << 1 |
3120             ($self->TextColor->defined) << 2 |
3121	     ($self->InitialText->defined) << 7 |
3122	     (defined $self->Align
3123              or defined $self->LeftMargin
3124              or defined $self->RightMargin
3125              or defined $self->Indent
3126              or defined $self->Leading) << 13;
3127
3128    $self->CharacterID->pack($stream);
3129    $self->Bounds->pack($stream);
3130    $stream->set_UI16($flag);
3131
3132    if ($flag & 1) {
3133	$self->FontID->pack($stream);
3134	$stream->set_UI16($self->FontHeight);
3135    }
3136    $self->TextColor->pack($stream) if $flag & 4;
3137    $stream->set_UI16($self->MaxLength) if $flag & 2;
3138    if ($flag & (1<<13)) {
3139	$stream->set_UI8($self->Align);
3140	for my $element (qw/LeftMargin RightMargin Indent Leading/) {
3141	    $stream->set_UI16($self->$element);
3142	}
3143    }
3144    $self->VariableName->pack($stream);
3145    $self->InitialText->pack($stream) if $flag & 128;
3146}
3147
3148{
3149    my $bit = 0;
3150    for my $f (qw / HasFont HasMaxLength HasTextColor ReadOnly Password Multiline WordWrap HasText UseOutlines HTML Reserved Border NoSelect HasLayout AutoSize / ) {
3151      SWF::Element::_create_flag_accessor($f, 'Flags', $bit++);
3152    }
3153}
3154
3155####  Sounds  ####
3156##########
3157
3158package SWF::Element::SOUNDINFO;
3159
3160sub unpack {
3161    my ($self, $stream)=@_;
3162    my $flags=$stream->get_UI8;
3163
3164    $self->SyncFlags($flags);
3165
3166    $self->InPoint($stream->get_UI32) if ($flags & 1);
3167    $self->OutPoint($stream->get_UI32) if ($flags & 2);
3168    $self->LoopCount($stream->get_UI16) if ($flags & 4);
3169    $self->EnvelopeRecords->unpack($stream) if ($flags & 8);
3170}
3171
3172sub pack {
3173    my ($self, $stream)=@_;
3174    my $flags=$self->SyncFlags |
3175	      $self->EnvelopeRecords->defined << 3 |
3176	      defined($self->LoopCount) << 2 |
3177	      defined($self->OutPoint)  << 1 |
3178	      defined($self->InPoint);
3179    $stream->set_UI8($flags);
3180
3181    $stream->set_UI32($self->InPoint) if ($flags & 1);
3182    $stream->set_UI32($self->OutPoint) if ($flags & 2);
3183    $stream->set_UI16($self->LoopCount) if ($flags & 4);
3184    $self->EnvelopeRecords->pack($stream) if ($flags & 8);
3185}
3186
3187{
3188    my $bit = 0;
3189    for my $f (qw/ HasInPoint HasOutPoint HasLoops HasEnvelope SyncNoMultiple SyncStop /) {
3190      SWF::Element::_create_flag_accessor($f, 'SyncFlags', $bit++);
3191    }
3192}
3193
3194##########
3195
3196package SWF::Element::Tag::DefineSound;
3197
3198sub _unpack {
3199    my ($self, $stream)=@_;
3200
3201    $self->SoundID->unpack($stream);
3202    $self->Flags($stream->get_UI8);
3203    $self->SoundSampleCount($stream->get_UI32);
3204    $self->SoundData->unpack($stream, $self->Length - 7);
3205}
3206
3207sub _pack {
3208    my ($self, $stream)=@_;
3209
3210    $self->SoundID->pack($stream);
3211    $stream->set_UI8($self->Flags);
3212    $stream->set_UI32($self->SoundSampleCount);
3213    $self->SoundData->pack($stream);
3214}
3215
3216 SWF::Element::_create_flag_accessor("SoundFormat", 'Flags', 4, 4);
3217 SWF::Element::_create_flag_accessor("SoundRate", 'Flags', 2, 2);
3218 SWF::Element::_create_flag_accessor("SoundSize", 'Flags', 1, 1);
3219 SWF::Element::_create_flag_accessor("SoundType", 'Flags', 0, 1);
3220
3221##########
3222
3223package SWF::Element::Tag::SoundStreamBlock;
3224
3225sub _unpack {
3226    my ($self, $stream)=@_;
3227
3228    $self->StreamSoundData->unpack($stream, $self->Length);
3229}
3230
3231sub _pack {
3232    my ($self, $stream)=@_;
3233
3234    $self->StreamSoundData->pack($stream);
3235}
3236
3237##########
3238
3239package SWF::Element::Tag::SoundStreamHead;
3240
3241sub _unpack {
3242    my ($self, $stream)=@_;
3243
3244    $self->Flags($stream->get_UI16);
3245    $self->StreamSoundSampleCount($stream->get_UI16);
3246    $self->LatencySeek($stream->get_SI16) if $self->Length == 6;
3247}
3248
3249sub _pack {
3250    my ($self, $stream)=@_;
3251
3252    $stream->set_UI16($self->Flags);
3253    $stream->set_UI16($self->StreamSoundSampleCount);
3254    $stream->set_SI16($self->LatencySeek) if $self->StreamSoundCompression == 2 and defined($self->LatencySeek);
3255}
3256
3257
3258SWF::Element::_create_flag_accessor('StreamSoundCompression', 'Flags',12, 4);
3259SWF::Element::_create_flag_accessor('StreamSoundRate', 'Flags', 10, 2);
3260SWF::Element::_create_flag_accessor('StreamSoundSize', 'Flags', 9, 1);
3261SWF::Element::_create_flag_accessor('StreamSoundType', 'Flags', 8, 1);
3262SWF::Element::_create_flag_accessor('PlaybackSoundRate', 'Flags', 2, 2);
3263SWF::Element::_create_flag_accessor('PlaybackSoundSize', 'Flags', 1, 1);
3264SWF::Element::_create_flag_accessor('PlaybackSoundType', 'Flags', 0, 1);
3265
3266####  Sprites  ####
3267##########
3268
3269package SWF::Element::TAGSTREAM;
3270
3271use SWF::Parser;
3272
3273sub new {
3274    my $self;
3275    bless \$self, shift;
3276}
3277
3278sub configure {
3279    my ($self, $data, $version) = @_;
3280
3281    $$self = SWF::BinStream::Read->new($data, undef, $version);
3282    $self;
3283}
3284
3285sub dumper {
3286    my ($self, $outputsub)=@_;
3287
3288    $outputsub||=\&SWF::Element::_default_output;
3289
3290    &$outputsub('undef', 0);
3291}
3292
3293sub defined {
3294    defined ${+shift};
3295}
3296
3297sub parse {
3298    my ($self, $p, $callback) = @_;
3299
3300    if (ref($p) eq 'CODE' and !defined $callback) {
3301	$callback = $p;
3302    } elsif (lc($p) ne 'callback' or ref($callback) ne 'CODE') {
3303      Carp::croak "Callback subroutine is needed to parse tags of sprite";
3304    }
3305    my $parser = SWF::Parser->new('tag-callback' => $callback, stream => $$self, header => 'no');
3306    $parser->parse;
3307}
3308
3309##########
3310
3311package SWF::Element::Tag::DefineSprite;
3312
3313sub _unpack {
3314    my ($self, $stream)=@_;
3315
3316    $self->SpriteID->unpack($stream);
3317    $self->FrameCount($stream->get_UI16);
3318    $self->ControlTags->unpack($stream);
3319}
3320
3321sub shallow_unpack {
3322    my ($self, $stream) = @_;
3323
3324    $self->SpriteID->unpack($stream);
3325    $self->FrameCount($stream->get_UI16);
3326    $self->TagStream($stream->get_string($self->Length - 4), $stream->Version);
3327}
3328
3329sub _pack {
3330    my ($self, $stream)=@_;
3331
3332    $self->SpriteID->pack($stream);
3333    my $tempstream = $stream->sub_stream;
3334    for my $tag (@{$self->ControlTags}) {
3335	unless ($tag->is_tagtype('ValidInSprite')) {
3336	  Carp::carp $tag->tag_name." is invalid tag in DefineSprite " ;
3337	    next;
3338	}
3339	$tag->pack($tempstream);
3340    }
3341    $stream->set_UI16($tempstream->{_framecount});
3342    $tempstream->flush_stream;
3343}
3344
3345####  Display List  ####
3346##########
3347
3348package SWF::Element::Tag::PlaceObject;
3349
3350sub _unpack {
3351    my ($self, $stream)=@_;
3352
3353    my $start = $stream->tell;
3354
3355    $self->CharacterID->unpack($stream);
3356    $self->Depth->unpack($stream);
3357    $self->Matrix->unpack($stream);
3358    if ($stream->tell < $start + $self->Length) {
3359	$self->ColorTransform->unpack($stream);
3360    }
3361}
3362
3363sub _pack {
3364    my ($self, $stream)=@_;
3365
3366    $self->CharacterID->pack($stream);
3367    $self->Depth->pack($stream);
3368    $self->Matrix->pack($stream);
3369    $self->ColorTransform->pack($stream) if $self->ColorTransform->defined;
3370}
3371
3372##########
3373
3374package SWF::Element::Tag::PlaceObject2;
3375
3376sub _unpack {
3377    my ($self, $stream)=@_;
3378
3379    my $flag = $self->Flags($stream->get_UI8);
3380    $self->Depth         ->unpack($stream);
3381    $self->CharacterID   ->unpack($stream) if $flag & 2;
3382    $self->Matrix        ->unpack($stream) if $flag & 4;
3383    $self->ColorTransform->unpack($stream) if $flag & 8;
3384    $self->Ratio($stream->get_UI16)        if $flag & 16;
3385    $self->Name          ->unpack($stream) if $flag & 32;
3386    $self->ClipDepth     ->unpack($stream) if $flag & 64;
3387    if ($flag & 128) {
3388	$stream->get_UI16; # skip reserved.
3389	if ($stream->Version >= 6) {  # skip clipaction flag
3390	    $stream->get_UI32;
3391#	    $stream->get_UI16;
3392	} else {
3393	    $stream->get_UI16;
3394	}
3395	$self->ClipActions->unpack($stream);
3396    }
3397}
3398
3399sub _pack {
3400    my ($self, $stream)=@_;
3401    my $flag = ($self->PlaceFlagMove |
3402	       ((my $cid = $self->CharacterID)->defined) << 1 |
3403	       ((my $matrix = $self->Matrix)  ->defined) << 2 |
3404	       ((my $ctfm = $self->ColorTransform)->defined) << 3 |
3405	       (defined (my $ratio = $self->Ratio) << 4) |
3406	       ((my $name = $self->Name)->defined) << 5 |
3407	       ((my $cdepth = $self->ClipDepth)->defined) << 6 |
3408	       ((my $caction = $self->ClipActions)->defined) << 7) ;
3409    $stream->set_UI8($flag);
3410    $self->Depth->pack($stream);
3411    $cid   ->pack($stream)     if $flag & 2;
3412    $matrix->pack($stream)     if $flag & 4;
3413    $ctfm  ->pack($stream)     if $flag & 8;
3414    $stream->set_UI16($ratio)  if $flag & 16;
3415    $name  ->pack($stream)     if $flag & 32;
3416    $cdepth->pack($stream)     if $flag & 64;
3417    if ($flag & 128) {
3418	$stream->set_UI16(0);  # Reserved.
3419	my $f = 0;
3420	for my $e (@{$caction}) {
3421	    $f |= $e->EventFlags;
3422	}
3423	if ($stream->Version >= 6) {
3424	    $stream->set_UI32($f);
3425	} else {
3426	    $stream->set_UI16($f);
3427	}
3428	$caction->pack($stream);
3429    }
3430}
3431
3432sub lookahead_CharacterID {
3433    my ($self, $stream) = @_;
3434    $self->lookahead_Flags($stream);
3435    $self->CharacterID($stream->lookahead_UI16(2)) if $self->PlaceFlagHasCharacter;
3436};
3437
3438{
3439    my $bit = 0;
3440    for my $f (qw/ Move HasCharacter HasMatrix HasColorTransform HasRatio HasName HasClipDepth HasClipActions /) {
3441      SWF::Element::_create_flag_accessor("PlaceFlag$f", 'Flags', $bit++);
3442    }
3443}
3444
3445##########
3446
3447package SWF::Element::Tag::ShowFrame;
3448
3449sub pack {
3450    my ($self, $stream) = @_;
3451
3452    $self->SUPER::pack($stream);
3453    $stream->{_framecount}++;
3454}
3455
3456package SWF::Element::Tag::ShowFrame::Packed;
3457
3458sub pack {
3459    my ($self, $stream) = @_;
3460
3461    $self->SUPER::pack($stream);
3462    $stream->{_framecount}++;
3463}
3464
3465####  Controls  ####
3466##########
3467
3468package SWF::Element::Tag::Protect;
3469
3470sub _unpack {
3471    my ($self, $stream) = @_;
3472
3473    $self->Reserved($stream->get_UI16);
3474    $self->Password->unpack($stream);
3475}
3476
3477sub _pack {
3478    my ($self, $stream) = @_;
3479
3480    $self->Password->pack($stream) if $self->Password->defined;
3481}
3482
3483##########
3484
3485package SWF::Element::Tag::FrameLabel;
3486
3487sub _unpack {
3488    my ($self, $stream) = @_;
3489
3490    $self->Name->unpack($stream);
3491    if ($self->Length > length($self->Name->value)+1) {
3492	$self->NamedAnchorFlag($stream->get_UI8);
3493    }
3494}
3495
3496sub _pack {
3497    my ($self, $stream) = @_;
3498
3499    $self->Name->pack($stream);
3500    $stream->set_UI8($self->NamedAnchorFlag) if $self->NamedAnchorFlag;
3501}
3502
3503####  Actions  ####
3504##########
3505
3506package SWF::Element::ACTIONRECORD;
3507
3508
3509our %actiontagtonum=(
3510    ActionEnd                      => 0x00,
3511    ActionNextFrame                => 0x04,
3512    ActionPrevFrame                => 0x05,
3513    ActionPlay                     => 0x06,
3514    ActionStop                     => 0x07,
3515    ActionToggleQuality            => 0x08,
3516    ActionStopSounds               => 0x09,
3517    ActionAdd                      => 0x0A,
3518    ActionSubtract                 => 0x0B,
3519    ActionMultiply                 => 0x0C,
3520    ActionDivide                   => 0x0D,
3521    ActionEquals                   => 0x0E,
3522    ActionLess                     => 0x0F,
3523    ActionAnd                      => 0x10,
3524    ActionOr                       => 0x11,
3525    ActionNot                      => 0x12,
3526    ActionStringEquals             => 0x13,
3527    ActionStringLength             => 0x14,
3528    ActionStringExtract            => 0x15,
3529    ActionPop                      => 0x17,
3530    ActionToInteger                => 0x18,
3531    ActionGetVariable              => 0x1C,
3532    ActionSetVariable              => 0x1D,
3533    ActionSetTarget2               => 0x20,
3534    ActionStringAdd                => 0x21,
3535    ActionGetProperty              => 0x22,
3536    ActionSetProperty              => 0x23,
3537    ActionCloneSprite              => 0x24,
3538    ActionRemoveSprite             => 0x25,
3539    ActionTrace                    => 0x26,
3540    ActionStartDrag                => 0x27,
3541    ActionEndDrag                  => 0x28,
3542    ActionStringLess               => 0x29,
3543    ActionThrow                    => 0x2a,
3544    ActionCastOp                   => 0x2b,
3545    ActionImplementsOp             => 0x2c,
3546    ActionFSCommand2               => 0x2d,
3547    ActionRandomNumber             => 0x30,
3548    ActionMBStringLength           => 0x31,
3549    ActionCharToAscii              => 0x32,
3550    ActionAsciiToChar              => 0x33,
3551    ActionGetTime                  => 0x34,
3552    ActionMBStringExtract          => 0x35,
3553    ActionMBCharToAscii            => 0x36,
3554    ActionMBAsciiToChar            => 0x37,
3555    ActionDelete                   => 0x3a,
3556    ActionDelete2                  => 0x3b,
3557    ActionDefineLocal              => 0x3c,
3558    ActionCallFunction             => 0x3d,
3559    ActionReturn                   => 0x3e,
3560    ActionModulo                   => 0x3f,
3561    ActionNewObject                => 0x40,
3562    ActionDefineLocal2             => 0x41,
3563    ActionInitArray                => 0x42,
3564    ActionInitObject               => 0x43,
3565    ActionTypeOf                   => 0x44,
3566    ActionTargetPath               => 0x45,
3567    ActionEnumerate                => 0x46,
3568    ActionAdd2                     => 0x47,
3569    ActionLess2                    => 0x48,
3570    ActionEquals2                  => 0x49,
3571    ActionToNumber                 => 0x4a,
3572    ActionToString                 => 0x4b,
3573    ActionPushDuplicate            => 0x4C,
3574    ActionStackSwap                => 0x4d,
3575    ActionGetMember                => 0x4e,
3576    ActionSetMember                => 0x4f,
3577    ActionIncrement                => 0x50,
3578    ActionDecrement                => 0x51,
3579    ActionCallMethod               => 0x52,
3580    ActionNewMethod                => 0x53,
3581    ActionInstanceOf               => 0x54,
3582    ActionEnumerate2               => 0x55,
3583    ActionBitAnd                   => 0x60,
3584    ActionBitOr                    => 0x61,
3585    ActionBitXor                   => 0x62,
3586    ActionBitLShift                => 0x63,
3587    ActionBitRShift                => 0x64,
3588    ActionBitURShift               => 0x65,
3589    ActionStrictEquals             => 0x66,
3590    ActionGreater                  => 0x67,
3591    ActionStringGreater            => 0x68,
3592    ActionExtends                  => 0x69,
3593#    ActionCall                     => 0x9e,
3594);
3595
3596our %actionnumtotag= reverse %actiontagtonum;
3597
3598sub new {
3599    my ($class, @headerdata)=@_;
3600    my %headerdata = ref($headerdata[0]) eq 'ARRAY' ? @{$headerdata[0]} : @headerdata;
3601    my $self = [];
3602    my $tag = $headerdata{Tag};
3603
3604    if (defined($tag) and $tag !~/^\d+$/) {
3605	$tag = "Action$tag" unless $tag =~ /^Action/;
3606	my $tag1 = $actiontagtonum{$tag};
3607	Carp::croak "ACTIONRECORD '$tag' is not defined." unless defined $tag1;
3608	$tag = $tag1;
3609    }
3610    delete $headerdata{Tag};
3611    $class=ref($class)||$class;
3612    bless $self, $class;
3613    if (defined $tag) {
3614	$self->Tag($tag);
3615	bless $self, _action_class($tag);
3616    }
3617    $self->_init;
3618    $self->configure(%headerdata) if %headerdata;
3619    $self;
3620}
3621
3622sub _init {}
3623
3624sub configure {
3625    my ($self, @param)=@_;
3626    @param = @{$param[0]} if ref($param[0]) eq 'ARRAY';
3627    my %param=@param;
3628
3629    if (defined $param{Tag}) {
3630	my $tag = $param{Tag};
3631	if ($tag !~/^\d+$/) {
3632	    $tag = "Action$tag" if $tag !~ /^Action/;
3633	    my $tag1 = $actiontagtonum{$tag};
3634	    Carp::croak "ACTIONRECORD '$tag1' is not defined." unless defined $tag1;
3635	    $tag = $tag1;
3636	}
3637	delete $param{Tag};
3638	$self->Tag($tag);
3639	bless $self, _action_class($tag);
3640	$self->_init;
3641    }
3642    $self->SUPER::configure(%param);
3643}
3644
3645sub _action_class {
3646    my $num = shift;
3647    my $name = $actionnumtotag{$num};
3648    if (!$name and $num >= 0x80) {
3649	$name = 'ActionUnknown';
3650    }
3651    if ($num >=0x80) {
3652	return "SWF::Element::ACTIONRECORD::$name";
3653    } else {
3654	return "SWF::Element::ACTIONRECORD";
3655    }
3656}
3657
3658sub unpack {
3659    my $self = shift;
3660    my $stream = shift;
3661
3662    $self->Tag->unpack($stream);
3663    if ($self->Tag >= 0x80) {
3664	bless $self, _action_class($self->Tag);
3665	$self->_init;
3666	my $len = $stream->get_UI16;
3667	my $start = $stream->tell;
3668	$self->_unpack($stream, $len);
3669#	my $read = $stream->tell - $start;
3670#	if ($read < $len) {
3671#	    $stream->get_string($len-$read);  # Skip the rest of tag data.
3672#	} elsif ($read > $len) {
3673#	    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??";
3674#	}  # Some SWFs have an invalid action tag length (?)
3675    }
3676}
3677
3678sub pack {
3679    my ($self, $stream) = @_;
3680
3681    $self->Tag->pack($stream);
3682    if ($self->Tag >= 0x80) {
3683	my $substream = $stream->sub_stream;
3684	$self->_pack($substream);
3685	$stream->set_UI16($substream->tell);
3686	$substream->flush_stream;
3687    }
3688}
3689
3690sub _unpack {
3691    my $self = shift;
3692  Carp::confess "Unexpected _unpack for ".ref($self)." ".$self->Tag;
3693}
3694
3695sub _pack {
3696  Carp::confess "Unexpected _pack";
3697}
3698
3699sub tag_name {
3700    return $actionnumtotag{shift->Tag};
3701}
3702
3703sub _create_action_tag {
3704    no strict 'refs';
3705
3706    my $tagname = shift;
3707    my $tagno = shift;
3708    my $tagisa = shift;
3709    $tagisa = defined($tagisa) ? "ACTIONRECORD::_$tagisa" :  'ACTIONRECORD';
3710    $tagname = "Action$tagname";
3711    SWF::Element::_create_class("ACTIONRECORD::$tagname", [$tagisa], Tag => 'ACTIONTagNumber', LocalLabel => "\$", @_);
3712
3713    $actionnumtotag{$tagno} = $tagname;
3714    $actiontagtonum{$tagname} = $tagno;
3715
3716    my $packsub = <<SUB_START;
3717sub \{
3718    my \$self = shift;
3719    my \$stream = shift;
3720SUB_START
3721    my $unpacksub = $packsub;
3722
3723    my $classname = "SWF::Element::ACTIONRECORD::$tagname";
3724    my @names = $classname->element_names;
3725    shift @names;
3726    shift @names;
3727    for my $key (@names) {
3728	if ($classname->element_type($key) !~ /^\$(.*)$/) {
3729	    $packsub .= "\$self->$key->pack(\$stream, \@_);";
3730	    $unpacksub .= "\$self->$key->unpack(\$stream, \@_);";
3731	} else {
3732	    $packsub .= "\$stream->set_$1(\$self->$key);";
3733	    $unpacksub .= "\$self->$key(\$stream->get_$1);";
3734	}
3735    }
3736    $unpacksub .='}';
3737    *{"${classname}::_unpack"} = eval($unpacksub);
3738
3739    if ($tagisa eq 'ACTIONRECORD') {
3740	$packsub .='}';
3741	*{"${classname}::_pack"} = eval($packsub);
3742    }
3743}
3744
3745sub _set_label {}
3746
3747@SWF::Element::ACTIONRECORD::_HasSkipCount::ISA=('SWF::Element::ACTIONRECORD');
3748@SWF::Element::ACTIONRECORD::_HasOffset::ISA=('SWF::Element::ACTIONRECORD');
3749@SWF::Element::ACTIONRECORD::_HasCodeSize::ISA=('SWF::Element::ACTIONRECORD::_HasOffset');
3750
3751_create_action_tag('Unknown',  'Unknown', undef, Data       => 'BinData');
3752_create_action_tag('GotoFrame',     0x81, undef, Frame      => '$UI16');
3753_create_action_tag('GetURL',        0x83, undef,
3754		   UrlString    => 'STRING',
3755		   TargetString => 'STRING' );
3756_create_action_tag('WaitForFrame',  0x8A, 'HasSkipCount',
3757		   Frame     => '$UI16',
3758		   SkipCount => '$UI8' );
3759_create_action_tag('SetTarget',     0x8B, undef, TargetName  => 'STRING' );
3760_create_action_tag('GotoLabel',     0x8C, undef, Label       => 'STRING' );
3761_create_action_tag('WaitForFrame2', 0x8D, 'HasSkipCount',
3762                   SkipCount   => '$UI8' );
3763_create_action_tag('Push',          0x96, undef, DataList    => 'Array::ACTIONDATAARRAY' );
3764_create_action_tag('Jump',          0x99, 'HasOffset',
3765                   BranchOffset=> '$SI16');
3766_create_action_tag('GetURL2',       0x9a, undef, Method      => '$UI8');
3767_create_action_tag('If',            0x9d, 'HasOffset',
3768                   BranchOffset=> '$SI16');
3769_create_action_tag('Call',          0x9e, undef);
3770_create_action_tag('GotoFrame2',    0x9F, undef, PlayFlag    => '$UI8');
3771_create_action_tag('ConstantPool',  0x88, undef,
3772		   ConstantPool => 'Array::STRINGARRAY');
3773_create_action_tag('DefineFunction',   0x9b, 'HasCodeSize',
3774		   FunctionName => 'STRING',
3775		   Params       => 'Array::STRINGARRAY',
3776                   CodeSize     => '$UI16');
3777_create_action_tag('StoreRegister', 0x87, undef, Register   => '$UI8');
3778_create_action_tag('With',          0x94, 'HasCodeSize',
3779                   CodeSize => '$UI16');
3780
3781_create_action_tag('DefineFunction2', 0x8e, 'HasCodeSize',
3782		   FunctionName  => 'STRING',
3783                   RegisterCount => '$UI8',
3784                   Flags         => '$UI16',
3785                   Parameters    => 'Array::REGISTERPARAMARRAY',
3786                   CodeSize      => '$UI16');
3787
3788_create_action_tag('Try', 0x8f, undef,
3789                   TrySize       => '$UI16',
3790                   CatchSize     => '$UI16',
3791                   FinallySize   => '$UI16',
3792                   CatchName     => 'STRING',
3793                   CatchRegister => '$UI8');
3794
3795_create_action_tag('StrictMode', 0x89, undef, StrictMode => '$UI8');
3796
3797##########
3798
3799package SWF::Element::ACTIONTagNumber;
3800
3801sub dumper {
3802    my ($self, $outputsub)=@_;
3803
3804    $outputsub||=\&SWF::Element::_default_output;
3805    my $tag = $SWF::Element::ACTIONRECORD::actionnumtotag{$self->value};
3806    &$outputsub($tag ? "'$tag'" : $self->value, 0);
3807}
3808
3809sub pack {
3810    my ($self, $stream) = @_;
3811
3812    $stream->set_UI8($self->value);
3813}
3814
3815sub unpack {
3816    my ($self, $stream) = @_;
3817
3818    $self->configure($stream->get_UI8);
3819}
3820
3821##########
3822
3823package SWF::Element::Array::ACTIONDATAARRAY;
3824
3825sub unpack {
3826    my ($self, $stream, $len) = @_;
3827    my $start = $stream->tell;
3828
3829    while ($stream->tell - $start < $len) {
3830	my $element = $self->new_element;
3831	$element->unpack($stream);
3832	push @$self, $element;
3833    }
3834}
3835
3836##########
3837
3838package SWF::Element::ACTIONDATA;
3839
3840sub configure {
3841    my ($self, $type, $data) = @_;
3842
3843    if (defined $data) {
3844	if ($type eq 'Type') {
3845	    $type = $data;
3846	    undef $data;
3847	}
3848	my $class = "SWF::Element::ACTIONDATA::$type";
3849	Carp::croak "No Data type '$type' in ACTIONDATA " unless $class->can('new');
3850	bless $self, $class;
3851    } else {
3852	$data = $type;
3853    }
3854
3855    $$self = $data if defined $data;
3856    $self;
3857}
3858
3859sub dumper {
3860    my ($self, $outputsub, $indent)=@_;
3861
3862    $outputsub||=\&SWF::Element::_default_output;
3863
3864    my $val = $self->value;
3865
3866    $val = "\"$val\"" if $val !~ /^-?[.\d]/;
3867
3868    &$outputsub(ref($self)."->new($val)", 0);
3869}
3870
3871my @actiondata_types
3872     = qw/String Property NULL UNDEF Register Boolean Double Integer Lookup Lookup/;
3873
3874sub pack {
3875    my ($self, $stream) = @_;
3876
3877    Carp::carp "No specified type in ACTIONDATA, so pack as String. ";
3878    $self->configure(Type => 'String');
3879    $self->pack($stream);
3880}
3881
3882sub unpack {
3883    my ($self, $stream) = @_;
3884    my $type = $stream->get_UI8;
3885
3886    Carp::croak "Undefined type '$type' in ACTIONDATA "
3887	if $type > $#actiondata_types;
3888
3889    bless $self, "SWF::Element::ACTIONDATA::$actiondata_types[$type]";
3890    $self->_unpack($stream, $type);
3891}
3892
3893sub _unpack {};
3894
3895#########
3896
3897package SWF::Element::ACTIONDATA::String;
3898
3899sub pack {
3900    my ($self, $stream) = @_;
3901
3902    $stream->set_UI8(0);
3903    $stream->set_string($self->value."\0");
3904}
3905
3906sub _unpack {
3907  SWF::Element::STRING::unpack(@_);
3908}
3909
3910sub dumper {
3911    my ($self, $outputsub, $indent)=@_;
3912
3913    $outputsub||=\&SWF::Element::_default_output;
3914
3915    my $val = $self->value;
3916
3917    $val =~ s/([\\\$\@\"])/\\$1/gs;
3918    $val =~ s/([\x00-\x1F\x80-\xFF])/sprintf('\\x%.2X', ord($1))/ges;
3919    $val = "\"$val\"";
3920
3921    &$outputsub(ref($self)."->new($val)", 0);
3922}
3923
3924#########
3925{
3926    package SWF::Element::ACTIONDATA::Property;
3927
3928    my %prop_num =
3929	( _x            =>          0,
3930	  _y            => 1065353216,
3931          _xscale       => 1073741824,
3932	  _yscale       => 1077936128,
3933	  _currentframe => 1082130432,
3934	  _totalframes  => 1084227584,
3935	  _alpha        => 1086324736,
3936	  _visible      => 1088421888,
3937	  _width        => 1090519040,
3938	  _height       => 1091567616,
3939	  _rotation     => 1092616192,
3940	  _target       => 1093664768,
3941	  _framesloaded => 1094713344,
3942	  _name         => 1095761920,
3943	  _droptarget   => 1096810496,
3944	  _url          => 1097859072,
3945	  _highquality  => 1098907648,
3946	  _focusrect    => 1099431936,
3947	  _soundbuftime => 1099956224,
3948	  _quality      => 1100480512,
3949	  _xmouse       => 1101004800,
3950	  _ymouse       => 1101529088,
3951	  );
3952    my %num_prop = reverse %prop_num;
3953
3954    sub pack {
3955	my ($self, $stream) = @_;
3956	my $data = $self->value;
3957
3958	$stream->set_UI8(1);
3959	$data = (exists $prop_num{$data}) ? $prop_num{$data} : unpack('L', CORE::pack('f', $data));
3960	$stream->set_UI32($data);
3961
3962    }
3963
3964    sub _unpack {
3965	my ($self, $stream) = @_;
3966	my $data = $stream->get_UI32;
3967	$data = (exists $num_prop{$data}) ? $num_prop{$data} : unpack('f', CORE::pack('L', $data));
3968	$self->configure($data);
3969    }
3970}
3971
3972#########
3973
3974package SWF::Element::ACTIONDATA::NULL;
3975
3976sub pack {
3977    $_[1]->set_UI8(2);
3978}
3979
3980#########
3981
3982package SWF::Element::ACTIONDATA::UNDEF;
3983
3984sub pack {
3985    $_[1]->set_UI8(3);
3986}
3987
3988#########
3989
3990package SWF::Element::ACTIONDATA::Register;
3991
3992sub pack {
3993    my ($self, $stream) = @_;
3994
3995    $stream->set_UI8(4);
3996    $stream->set_UI8($self->value);
3997}
3998
3999sub _unpack {
4000    my ($self, $stream) = @_;
4001
4002    $self->configure($stream->get_UI8);
4003}
4004
4005#########
4006
4007package SWF::Element::ACTIONDATA::Boolean;
4008
4009sub pack {
4010    my ($self, $stream) = @_;
4011
4012    $stream->set_UI8(5);
4013    $stream->set_UI8($self->value);
4014}
4015
4016sub _unpack {
4017    my ($self, $stream) = @_;
4018
4019    $self->configure($stream->get_UI8);
4020}
4021
4022#########
4023
4024package SWF::Element::ACTIONDATA::Lookup;
4025
4026sub pack {
4027    my ($self, $stream) = @_;
4028
4029    if ((my $v = $self->value) >= 256) {
4030	$stream->set_UI8(9);
4031	$stream->set_UI16($v);
4032    } else {
4033	$stream->set_UI8(8);
4034	$stream->set_UI8($v);
4035    }
4036}
4037
4038sub _unpack {
4039    my ($self, $stream, $type) = @_;
4040
4041    $self->configure($type == 8 ? $stream->get_UI8 : $stream->get_UI16);
4042}
4043
4044#########
4045
4046package SWF::Element::ACTIONDATA::Integer;
4047
4048sub pack {
4049    my ($self, $stream) = @_;
4050
4051    $stream->set_UI8(7);
4052    $stream->set_SI32($self->value); # really signed?
4053}
4054
4055sub _unpack {
4056    my ($self, $stream) = @_;
4057
4058    $self->configure($stream->get_SI32); # really signed?
4059}
4060
4061#########
4062{
4063    package SWF::Element::ACTIONDATA::Double; # IEEE754 double support needed.
4064
4065    my $BE = (CORE::pack('s',1) eq CORE::pack('n',1));
4066    my $INF  = "\x00\x00\x00\x00\x00\x00\xf0\x7f";
4067    my $NINF = "\x00\x00\x00\x00\x00\x00\xf0\xff";
4068    my $MANTISSA = ~$NINF;
4069
4070    sub pack {
4071	my ($self, $stream) = @_;
4072
4073	$stream->set_UI8(6);
4074	my $value = $self->value;
4075	my $data;
4076	if ($value eq 'NaN') {
4077	    $data = "\x00\x00\x00\x00\x00\x00\xf8\x7f";
4078	} elsif ($value eq 'Infinity') {
4079	    $data = $INF;
4080	} elsif ($value eq '-Infinity') {
4081	    $data = $NINF;
4082	} else {
4083	    $data = CORE::pack('d', $value);
4084	    $data = reverse $data if $BE;
4085	}
4086	$stream->set_string(substr($data, -4));
4087	$stream->set_string(substr($data,0,4));
4088    }
4089
4090    sub _unpack {
4091	my ($self, $stream) = @_;
4092	my $data = $stream->get_string(4);
4093	$data = $stream->get_string(4). $data;
4094
4095	my $value;
4096
4097	if (($data & $INF) eq $INF and ($data & $MANTISSA) ne "\x00" x 8) {
4098	    $value = 'NaN';
4099	} elsif ($data eq $INF) {
4100	    $value = 'Infinity';
4101	} elsif ($data eq $NINF) {
4102	    $value = '-Infinity';
4103	} else {
4104	    $data = reverse $data if $BE;
4105	    $value = unpack('d',$data);
4106	}
4107	$self->configure($value);
4108    }
4109
4110}
4111
4112##########
4113
4114package SWF::Element::CLIPACTIONRECORD;
4115
4116sub unpack {
4117    my ($self, $stream) = @_;
4118
4119    my $flag = 0;
4120    $stream->_lock_version;
4121    if ($stream->Version >= 6) {
4122	$flag = $self->EventFlags ($stream->get_UI32);
4123    } else {
4124	$flag = $self->EventFlags ($stream->get_UI16);
4125    }
4126    return if $flag == 0;
4127    my $size = $stream->get_UI32;
4128    my $start = $stream->tell;
4129    $self->KeyCode($stream->get_UI8)if $self->ClipEventKeyPress;
4130    $self->Actions->unpack($stream);
4131    my $remain = $stream->tell - $start - $size;
4132    $stream->get_string($remain) if $remain > 0;
4133}
4134
4135sub pack {
4136    my ($self, $stream) = @_;
4137
4138    $stream->_lock_version;
4139    if ($stream->Version >= 6) {
4140	$stream->set_UI32($self->EventFlags);
4141   } else {
4142	$stream->set_UI16($self->EventFlags & 0xffff);
4143    }
4144
4145    my $tempstream = $stream->sub_stream;
4146    $tempstream->set_UI8($self->KeyCode) if $self->ClipEventKeyPress;
4147    $self->Actions->pack($tempstream);
4148    $stream->set_UI32($tempstream->tell);
4149    $tempstream->flush_stream;
4150}
4151
4152{
4153    my $bit = 0;
4154    for my $f
4155	( qw/ Load           EnterFrame  Unload     MouseMove
4156	      MouseDown      MouseUp     KeyDown    KeyUp
4157	      Data           Initialize  Press      Release
4158	      ReleaseOutside RollOver    RollOut    DragOver
4159	      DragOut        KeyPress    Construct
4160	  / ) {
4161      SWF::Element::_create_flag_accessor("ClipEvent$f", 'EventFlags', $bit++);
4162    }
4163}
4164
4165##########
4166
4167package SWF::Element::Array::ACTIONRECORDARRAY;
4168
4169sub pack {
4170    my $self = shift;
4171    my $stream = $_[0];
4172
4173    # Add ActionEnd if there is not.
4174
4175    push @$self, SWF::Element::ACTIONRECORD->new(Tag=>'ActionEnd') if $self->[-1]->Tag != 0;
4176
4177    my $actionstream = SWF::BinStream::Write->new($stream->Version);
4178    my %labels;
4179    my $count = 0;
4180
4181    # Keep label positions.
4182
4183    for my $element (@$self) {
4184	$labels{$element->LocalLabel} = [$count, $actionstream->tell] if ($element->LocalLabel);
4185	$count++;
4186	$element->pack($actionstream, @_);
4187    }
4188
4189    my %marks = $actionstream->mark;
4190    my @replace;
4191
4192    for my $label (keys %marks) {
4193	(my $label1 = $label)=~s/\#.*$//;   # inner local label
4194      Carp::croak "Can't find LocalLabel '$label1' " unless defined $labels{$label1};
4195
4196	while(my ($tell, $obj) = splice(@{$marks{$label}}, 0, 2)) {
4197	    my ($data, $length) = $obj->_resolve_label($tell, $labels{$label1}, $self);
4198
4199	    if ($length >= 2 and $tell % 1024 == 1023) {
4200		my @data = split //, $data;
4201		push @{$replace[$tell>>10]}, [1023, 1, $data[0]];
4202		push @{$replace[($tell>>10)+1]}, [0, 1, $data[1]];
4203	    } else {
4204		push @{$replace[$tell>>10]}, [$tell % 1024, $length, $data];
4205	    }
4206	}
4207    }
4208
4209    while($actionstream->Length > 0) {
4210	my $buf = $actionstream->flush_stream(1024);
4211	my $replace1 = shift @replace;
4212	while (my $replace2 = shift @$replace1) {
4213	    my ($pos, $len, $r) = @$replace2;
4214	    substr($buf, $pos, $len) = $r;
4215	}
4216	$stream->set_string($buf);
4217    }
4218}
4219
4220{
4221    my $label;
4222
4223    sub unpack {
4224	my ($self, $stream, $len) = @_;
4225	my @byteoffset;
4226	my $start = $stream->tell;
4227
4228	while(!defined $len or $stream->tell - $start < $len) {
4229	    push @byteoffset, $stream->tell-$start;
4230	    my $element = $self->new_element;
4231	    $element->unpack($stream);
4232	    push @$self, $element;
4233	    last if !defined $len and $element->Tag == 0;
4234	}
4235	$label = 'A';
4236	for (my $i = 0; $i < @byteoffset; $i++) {
4237	    $self->[$i]->_set_label($i, $self, \@byteoffset);
4238	}
4239    }
4240
4241    sub _get_label {
4242	$label++;
4243    }
4244}
4245
4246##########
4247
4248package SWF::Element::ACTIONRECORD::_HasSkipCount;
4249
4250sub _set_label {
4251    my ($self, $pos, $actionstream) = @_;
4252    my $skip = $self->SkipCount;
4253    my $dst = $actionstream->[$pos + $skip+1];
4254
4255    my $l = $dst->LocalLabel;
4256    unless ($l) {
4257	$l = $actionstream->_get_label;
4258	$dst->LocalLabel($l);
4259    }
4260    $self->SkipCount("$l#$skip");
4261}
4262
4263##########
4264
4265package SWF::Element::ACTIONRECORD::ActionWaitForFrame;
4266
4267sub _pack {
4268    my ($self, $stream) = @_;
4269
4270    $stream->set_UI16($self->Frame);
4271    my $skip = $self->SkipCount;
4272
4273    if ($skip =~ /^[^\d]/) {
4274	$stream->mark($skip, bless [$self], 'SWF::Element::_Label::SkipCount');
4275	$stream->set_UI8(0);
4276    } else {
4277	$stream->set_UI8($skip);
4278    }
4279}
4280
4281##########
4282
4283package SWF::Element::ACTIONRECORD::ActionWaitForFrame2;
4284
4285sub _pack {
4286    my ($self, $stream) = @_;
4287    my $skip = $self->SkipCount;
4288
4289    if ($skip =~ /^[^\d]/) {
4290	$stream->mark($skip, bless [$self], 'SWF::Element::_Label::SkipCount');
4291	$stream->set_UI8(0);
4292    } else {
4293	$stream->set_UI8($skip);
4294    }
4295}
4296
4297##########
4298
4299package SWF::Element::ACTIONRECORD::_HasOffset;
4300
4301sub _set_label {
4302    my ($self, $pos, $actionstream, $byteoffset) = @_;
4303    my $offset = $self->_Offset;
4304    my $j = $pos+1;
4305    my $set = $byteoffset->[$j];
4306    my $dst = $set;
4307    if ($offset < 0) {
4308	while ($j>=0 and ($dst-$set) > $offset) {
4309	    $j--;
4310	    $dst = $byteoffset->[$j];
4311	}
4312    } else {
4313	while ($j<@$byteoffset and ($dst-$set) < $offset) {
4314	    $j++;
4315	    $dst = $byteoffset->[$j];
4316	}
4317    }
4318    if ($dst-$set == $offset) {
4319	my $l = $actionstream->[$j]->LocalLabel;
4320	unless ($l) {
4321	    $l = $actionstream->_get_label;
4322	    $actionstream->[$j]->LocalLabel($l);
4323	}
4324	$self->_Offset("$l#$offset");
4325    }
4326}
4327
4328##########
4329
4330package SWF::Element::ACTIONRECORD::ActionJump;
4331
4332sub _pack {
4333    my ($self, $stream) = @_;
4334    my $offset = $self->BranchOffset;
4335
4336    if ($offset =~ /^[^\d\-]/) {
4337	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::Offset');
4338	$stream->set_SI16(0);
4339    } else {
4340	$stream->set_SI16($offset);
4341    }
4342}
4343
4344*SWF::Element::ACTIONRECORD::ActionJump::_Offset = \&BranchOffset;
4345*SWF::Element::ACTIONRECORD::ActionIf::_Offset = \&BranchOffset;
4346*SWF::Element::ACTIONRECORD::ActionIf::_pack = \&_pack;
4347
4348##########
4349
4350package SWF::Element::ACTIONRECORD::ActionGetURL2;
4351
4352SWF::Element::_create_flag_accessor('SendVarsMethod', 'Method', 0, 2);
4353SWF::Element::_create_flag_accessor('LoadTargetFlag', 'Method', 6);
4354SWF::Element::_create_flag_accessor('LoadVariablesFlag', 'Method', 7);
4355
4356##########
4357
4358package SWF::Element::ACTIONRECORD::ActionDefineFunction;
4359
4360sub _pack {
4361    my ($self, $stream) = @_;
4362
4363    $self->FunctionName->pack($stream);
4364    $self->Params->pack($stream);
4365
4366    my $offset = $self->CodeSize;
4367
4368    if ($offset =~ /^\D/) {
4369	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
4370	$stream->set_UI16(0);
4371    } else {
4372	$stream->set_UI16($offset);
4373    }
4374}
4375
4376*SWF::Element::ACTIONRECORD::ActionDefineFunction::_Offset = \&CodeSize;
4377
4378##########
4379
4380package SWF::Element::ACTIONRECORD::ActionWith;
4381
4382sub _pack {
4383    my ($self, $stream) = @_;
4384
4385    my $offset = $self->CodeSize;
4386
4387    if ($offset =~ /^\D/) {
4388	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
4389	$stream->set_UI16(0);
4390    } else {
4391	$stream->set_UI16($offset);
4392    }
4393}
4394
4395*SWF::Element::ACTIONRECORD::ActionWith::_Offset = \&CodeSize;
4396
4397##########
4398
4399package SWF::Element::ACTIONRECORD::ActionDefineFunction2;
4400
4401sub _pack {
4402    my ($self, $stream) = @_;
4403
4404    $self->FunctionName->pack($stream);
4405    $stream->set_UI16(scalar @{$self->Parameters});
4406    $stream->set_UI8($self->RegisterCount);
4407    $stream->set_UI16($self->Flags);
4408    $self->Parameters->pack($stream);
4409
4410    my $offset = $self->CodeSize;
4411
4412    if ($offset =~ /^\D/) {
4413	$stream->mark($offset, bless [$self], 'SWF::Element::_Label::CodeSize');
4414	$stream->set_UI16(0);
4415    } else {
4416	$stream->set_UI16($offset);
4417    }
4418}
4419
4420{
4421    no warnings 'redefine';
4422
4423    *SWF::Element::ACTIONRECORD::ActionDefineFunction2::_unpack = sub {
4424	my ($self, $stream) = @_;
4425
4426	$self->FunctionName->unpack($stream);
4427	my $numparams = $stream->get_UI16;
4428	$self->RegisterCount($stream->get_UI8);
4429	$self->Flags($stream->get_UI16);
4430	my $params = $self->Parameters;
4431	for (my $c = 0 ; $c < $numparams; $c++) {
4432	    my $p = $params->new_element;
4433	    $p->unpack($stream);
4434	    push @$params, $p;
4435	}
4436	$self->CodeSize($stream->get_UI16);
4437    }
4438}
4439
4440*SWF::Element::ACTIONRECORD::ActionDefineFunction2::_Offset = \&CodeSize;
4441
4442{
4443    my $bit = 0;
4444    for my $f (qw/ This Arguments Super /) {
4445      SWF::Element::_create_flag_accessor("Preload${f}Flag", 'Flags', $bit++);
4446      SWF::Element::_create_flag_accessor("Suppress${f}Flag", 'Flags', $bit++);
4447    }
4448    for my $f (qw/ Root Parent Global /) {
4449      SWF::Element::_create_flag_accessor("Preload${f}Flag", 'Flags', $bit++);
4450    }
4451}
4452
4453##########
4454
4455package SWF::Element::ACTIONRECORD::ActionTry;
4456
4457{
4458    no warnings 'redefine';
4459
4460    *SWF::Element::ACTIONRECORD::ActionTry::_pack = sub {
4461	my ($self, $stream) = @_;
4462
4463	my $flags = 0;
4464	my ($trylabel) = ($self->TrySize =~ /^(.*#)/);
4465	my ($catchlabel) = ($self->CatchSize =~ /^(.*#)/);
4466	my ($finallylabel) = ($self->FinallySize =~ /^(.*#)/);
4467
4468	$flags |= 4 if defined $self->CatchRegister;
4469	$flags |= 2 if ($finallylabel and $finallylabel ne $catchlabel or !$finallylabel and $self->FinallySize != 0);
4470	$flags |= 1 if ($catchlabel and $catchlabel ne $trylabel or !$catchlabel and $self->CatchSize != 0);
4471
4472	$stream->set_UI8($flags);
4473
4474	my $byteoffset;
4475	my $current_byteoffset = $stream->tell;
4476	for my $n (qw/TrySize CatchSize FinallySize/) {
4477	    my $offset = $self->$n;
4478	    if ($offset =~ /^\D/) {
4479		my $label = bless [$self, \$byteoffset], "SWF::Element::_Label::$n";
4480		$stream->mark($offset, $label);
4481		$stream->set_UI16(0);
4482	    } else {
4483		$stream->set_UI16($offset);
4484	    }
4485	}
4486
4487	if ($flags & 4) {
4488	    $stream->set_UI8($self->CatchRegister);
4489	} else {
4490	    $self->CatchName->pack($stream);
4491	}
4492	$byteoffset = $stream->tell - $current_byteoffset;
4493    };
4494
4495    *SWF::Element::ACTIONRECORD::ActionTry::_unpack = sub {
4496	my ($self, $stream,$len) = @_;
4497
4498	my $flags = $stream->get_UI8;
4499	$self->TrySize($stream->get_UI16);
4500	my $catchsize = $stream->get_UI16;
4501	$self->CatchSize($catchsize) if $flags & 1;
4502	my $finallysize = $stream->get_UI16;
4503	$self->FinallySize($finallysize) if $flags & 2;
4504	if ($flags & 4) {
4505	    $self->CatchRegister($stream->get_UI8);
4506	} else {
4507	    $self->CatchName->unpack($stream);
4508	}
4509    };
4510}
4511
4512sub _set_label {
4513    my ($self, $pos, $actionstream, $byteoffset) = @_;
4514    my $j = $pos+1;
4515
4516    for my $x_size (qw/ TrySize CatchSize FinallySize /) {
4517	my $offset = $self->$x_size;
4518
4519	next if !defined $offset or $offset <= 0;
4520
4521	my $set = $byteoffset->[$j];
4522	my $dst = $set;
4523
4524	while ($j<@$byteoffset and ($dst-$set) < $offset) {
4525	    $j++;
4526	    $dst = $byteoffset->[$j];
4527	}
4528
4529	if ($dst-$set == $offset) {
4530	    my $l = $actionstream->[$j]->LocalLabel;
4531	    unless ($l) {
4532		$l = $actionstream->_get_label;
4533		$actionstream->[$j]->LocalLabel($l);
4534	    }
4535	    $self->$x_size("$l#$offset");
4536	}
4537    }
4538
4539}
4540
4541##########
4542
4543package SWF::Element::_Label::SkipCount;
4544
4545sub _resolve_label {
4546    my ($self, $pos, $dst, $actions) = @_;
4547    my $count = 1;
4548
4549    for my $element (@$actions) {
4550	last if $element eq $self->[0];
4551	$count++;
4552    }
4553    Carp::croak "SkipCount of ".ref($self->[0])." cannot refer backward " if $dst->[0] < $count;
4554    return (CORE::pack('C', $dst->[0] - $count), 1);
4555}
4556
4557##########
4558
4559package SWF::Element::_Label::Offset;
4560
4561sub _resolve_label {
4562    my ($self, $pos, $dst) = @_;
4563    return (CORE::pack('v', $dst->[1] - $pos - 2), 2);
4564}
4565
4566##########
4567
4568package SWF::Element::_Label::CodeSize;
4569
4570sub _resolve_label {
4571    my ($self, $pos, $dst) = @_;
4572    my $offset = $dst->[1] - $pos - 2;
4573  Carp::croak "Can't set negative code size for ".ref($self->[0]) if $offset < 0;
4574    return (CORE::pack('v', $offset), 2);
4575}
4576
4577##########
4578
4579package SWF::Element::_Label::TrySize;
4580
4581sub _resolve_label {
4582    my ($self, $pos, $dst) = @_;
4583    my $offset = $dst->[1] - $pos - ${$self->[1]};
4584    (my $trylabel = $self->[0]->TrySize) =~ s/#.*$//;
4585
4586  Carp::croak "Can't set negative code size for TrySize" if $offset < 0;
4587    $self->[0]->TrySize("$trylabel#$offset");
4588    return (CORE::pack('v', $offset), 2);
4589}
4590
4591##########
4592
4593package SWF::Element::_Label::CatchSize;
4594
4595sub _resolve_label {
4596    my ($self, $pos, $dst) = @_;
4597    (my $trysize = $self->[0]->TrySize) =~ s/^.*#//;
4598    (my $catchlabel = $self->[0]->CatchSize) =~ s/#.*$//;
4599    my $offset = $dst->[1] - $pos - ${$self->[1]} - $trysize + 2;
4600  Carp::croak "Can't set negative code size for CatchSize" if $offset < 0;
4601    $self->[0]->CatchSize("$catchlabel#$offset");
4602    return (CORE::pack('v', $offset), 2);
4603}
4604
4605##########
4606
4607package SWF::Element::_Label::FinallySize;
4608
4609sub _resolve_label {
4610    my ($self, $pos, $dst) = @_;
4611    (my $trysize = $self->[0]->TrySize) =~ s/^.*#//;
4612    (my $catchsize = $self->[0]->CatchSize) =~ s/^.*#//;
4613    (my $finallylabel = $self->[0]->FinallySize) =~ s/#.*$//;
4614    my $offset = $dst->[1] - $pos - ${$self->[1]} - $trysize - $catchsize + 4;
4615  Carp::croak "Can't set negative code size for FinallySize" if $offset < 0;
4616    $self->[0]->FinallySize("$finallylabel#$offset");
4617    return (CORE::pack('v', $offset), 2);
4618}
4619
4620
4621
4622####  Video  ####
4623##########
4624
4625package SWF::Element::Tag::DefineVideoStream;
4626
4627SWF::Element::_create_flag_accessor('VideoFlagsSmoothing', 'VideoFlags', 0);
4628SWF::Element::_create_flag_accessor('VideoFlagsDeblocking', 'VideoFlags', 1, 2);
4629
4630##########
4631
4632package SWF::Element::Tag::VideoFrame;
4633
4634sub _unpack {
4635    my ($self, $stream) = @_;
4636
4637    $self->StreamID->unpack($stream);
4638    $self->FrameNum($stream->get_UI16);
4639    $self->VideoData->unpack($stream, $self->Length - 4);
4640}
4641
4642##########
4643
46441;
4645__END__
4646
4647# Below is the stub of documentation for your module. You better edit it!
4648
4649=head1 NAME
4650
4651SWF::Element - Classes of SWF tags and elements.
4652See I<Element.pod> for further information.
4653
4654=head1 COPYRIGHT
4655
4656Copyright 2000 Yasuhiro Sasama (ySas), <ysas@nmt.ne.jp>
4657
4658This library is free software; you can redistribute it
4659and/or modify it under the same terms as Perl itself.
4660
4661=cut
4662
4663
4664