File Coverage

blib/lib/SWF/Builder/ActionScript.pm

Criterion	Covered	Total	%
statement	32	79	40.5
branch	2	12	16.6
condition	2	8	25.0
subroutine	11	25	44.0
pod	15	17	88.2
total	62	141	43.9

package SWF::Builder::ActionScript;

use strict;

use Carp;
use SWF::Element;
use SWF::Builder;
use SWF::Builder::ExElement;

our $VERSION = "0.041";

sub new {
    my ($class, %param) = @_;
    bless {
	_version => $param{Version}||6,
	_actions => SWF::Element::Array::ACTIONRECORDARRAY->new,
    }, $class;
}

sub _add_tags {
    my $self = shift;
    my $actions = $self->{_actions};

    if ($actions->[-1] and $actions->[-1]->Tag == 0) {
	if (my $label = pop(@$actions)->LocalLabel) {
	    push @$actions, SWF::Element::ACTIONRECORD->new( 'Tag', @{+shift}, LocalLabel => $label );
	}
    }
    push @$actions, map { SWF::Element::ACTIONRECORD->new( 'Tag', @$_)} @_;
    $self;
}

sub _adata {
  SWF::Element::ACTIONDATA->new(@_);
}

sub _get_type {
    my $value = shift;

    if ($value =~ /^\d+$/) {
	return 'Integer';
    } elsif ($value =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
	return 'Double';
    } else {
	return 'String';
    }
}

sub tellTarget {
    my ($self, $target, $code) = @_;

    if (UNIVERSAL::isa($target, 'SWF::Builder::DisplayInstance')) {
	$target = $target->name;
    }
    utf2bin($target);
    $self->_add_tags( [ 'SetTarget', TargetName => $target ] );
    &$code($self);
    $self->_add_tags( [ 'SetTarget', TargetName => '' ] );
}

sub gotoAndPlay {
    &gotoAndStop;
    shift->_add_tags( ['Play'] );
}

sub gotoAndStop {
    my ($self, $frame) = @_;

    if ($frame =~ /^\d+$/) {
	$self->_add_tags( [ 'GotoFrame', Frame => $frame-1 ] );
    } else {
	utf2bin($frame);
	$self->_add_tags( [ 'GotoLabel', Label => $frame ] );
    }
}

sub play {
    shift->_add_tags( ['Play'] );
}

sub stop {
    shift->_add_tags( ['Stop'] );
}

sub setProperty {
    my ($self, $property, $value) = @_;

    utf2bin($value);
    $self->_add_tags
	( [ 'Push',
	    DataList => [ _adata( String => '' ),
			  _adata( Property => $property ),
			  _adata( _get_type($value) => $value ),
			  ],
	    ],
	  [ 'SetProperty' ],
	  );
}

sub calcProperty {
    my ($self, $property, $op, $value) = @_;

    utf2bin($value);
    $self->_add_tags
	( [ 'Push',
	    DataList => [ _adata( String => '' ),
			  _adata( Property => $property ),
			  _adata( String => '' ),
			  _adata( Property => $property ),
			  ],
	    ],
	  [ 'GetProperty' ],
	  [ 'Push',
	    DataList => [ _adata( _get_type($value) => $value ),
			  ],
	    ],
	  [ $op ],
	  [ 'SetProperty' ],
	  );
}


sub moveto {
    my ($self, $x, $y) = @_;

    $self->setProperty('_x', $x);
    $self->setProperty('_y', $y);
}

sub r_moveto {
    my ($self, $x, $y) = @_;

    $self->calcProperty('_x', 'Add2', $x);
    $self->calcProperty('_y', 'Add2', $y);
}

sub rotate {
    my ($self, $r) = @_;

    $self->setProperty('_rotation', $r);
}

sub r_rotate {
    my ($self, $r) = @_;

    $self->calcProperty('_rotation', 'Add2', $r);
}

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

    $yscale ||= $xscale;
    $self->setProperty('_xscale', $xscale);
    $self->setProperty('_yscale', $yscale);
}

sub show {
    shift->setProperty('_visible', 1);
}

sub hide {
    shift->setProperty('_visible', 0);
}



# compiler

sub compile {
    require SWF::Builder::ActionScript::Compiler;

    my $self = shift;
    my $c = SWF::Builder::ActionScript::Compiler->new(@_, Version => $self->{_version});

    $c->compile($self->{_actions});
}

sub load {
    my $self = shift;
    my $file = shift;

    open my $f, '<', $file;
    select((select($f), undef $/)[0]);
    $self->compile(<$f>, @_);
}

1;
__END__