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