File Coverage

blib/lib/SWF/Builder.pm

Criterion	Covered	Total	%
statement	141	214	65.8
branch	5	14	35.7
condition	5	13	38.4
subroutine	33	53	62.2
pod	1	1	100.0
total	185	295	62.7

package SWF::Builder;

use strict;

use SWF::File;
use SWF::Element;
use SWF::Builder::ExElement;
use SWF::Builder::Character;

use Carp;

our $VERSION = '0.16';
my $SFTAG = SWF::Element::Tag::ShowFrame->new;

sub new {
    my $class = shift;
    my $self = bless {
	_root =>
	  SWF::Builder::Movie::Root->new(@_)
    }, $class;
    $self;
}

sub AUTOLOAD {
    my $self = shift;
    my $sub = $SWF::Builder::AUTOLOAD;

    return if $sub =~/::DESTROY$/;
    $sub =~ s/.+:://;
    croak "Can't locate object method \"$sub\" via package \"".ref($self).'" (perhaps you forgot to load "'.ref($self).'"?)' unless $self->{_root}->can($sub);
    $self->{_root}->$sub(@_);
}

sub DESTROY {
    my $r = shift->{_root};
    $r->_destroy if defined $r;
}

####

package SWF::Builder::Depth;
use Carp;

sub new {
    my ($class, $parent, $lower) = @_;
    my $self = bless {
	_parent => $parent,
	_depth => SWF::Element::Depth->new,
    }, $class;
    $lower ||= $self;
    $self->{_lower} = $lower;
    $self->{_upper} = $lower->{_upper}||$lower;
    $lower->{_upper} = $lower->{_upper}{_lower} = $self;
    return $self;
}

sub set_depth {
    my ($self, $n) = @_;

    $self->{_depth}->configure($n);
    $n+1;
}

sub _destroy {
    my $self = shift;
    while(my $lower = $self->{_lower}) {
	%$self = ();
	$self = $lower;
    }
}


####

package SWF::Builder::_FrameList;

@SWF::Builder::_FrameList::ISA = qw/ SWF::Element::Array::TAGARRAY /;

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

    for my $frame (@$self) {
	for my $tag (@$frame) {
	    $tag->pack($stream);
	}
	$SFTAG->pack($stream);
    }
  SWF::Element::Tag::End->new->pack($stream);
}

####

package SWF::Builder::Movie;

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

sub new {
    my $class = shift;

    my $self = bless {
	_frame_list => SWF::Builder::_FrameList->new,
	_streamsoundf => 0,
    }, $class;
    $self->{_depth_list} = SWF::Builder::Depth->new($self);

    $self;
}

sub new_shape {
    require SWF::Builder::Character::Shape;

    shift->_new_character(SWF::Builder::Character::Shape::Def->new);
}

sub new_static_text {
    require SWF::Builder::Character::Text;

    shift->_new_character(SWF::Builder::Character::Text::Def->new(@_));
}

*new_text = \&new_static_text;

sub new_dynamic_text {
    require SWF::Builder::Character::EditText;
    my $s =shift;
my $q = SWF::Builder::Character::DynamicText->new(@_);
    $s->_new_character($q);
}


sub new_edit_text {
    require SWF::Builder::Character::EditText;

    shift->_new_character(SWF::Builder::Character::EditText::Def->new(@_));
}


sub new_html_text {
    require SWF::Builder::Character::EditText;

    shift->_new_character(SWF::Builder::Character::HTMLText->new(@_));
}

sub new_text_area {
    require SWF::Builder::Character::EditText;

    shift->_new_character(SWF::Builder::Character::TextArea->new(@_));
}

sub new_input_field {
    require SWF::Builder::Character::EditText;

    shift->_new_character(SWF::Builder::Character::InputField->new(@_));
}

sub new_password_field {
    require SWF::Builder::Character::EditText;

    shift->_new_character(SWF::Builder::Character::PasswordField->new(@_));
}

sub new_font {
    require SWF::Builder::Character::Font;

    shift->_new_character(SWF::Builder::Character::Font::Def->new(@_));
}

sub new_movie_clip {
    require SWF::Builder::Character::MovieClip;

    shift->_new_character(SWF::Builder::Character::MovieClip::Def->new);
}

*new_mc = \&new_movie_clip;

sub new_gradient {
    require SWF::Builder::Gradient;

    SWF::Builder::Gradient->new;
}

sub new_jpeg {
    require SWF::Builder::Character::Bitmap;

    my $self = shift;

    unshift @_, 'JPEGFile' if @_==1;
    $self->_new_character(SWF::Builder::Character::Bitmap::JPEG->new(@_));
}

sub new_bitmap {
    require SWF::Builder::Character::Bitmap;

    my $self = shift;

    $self->_new_character(SWF::Builder::Character::Bitmap::Lossless->new(@_));
}

sub new_sound {
    require SWF::Builder::Character::Sound;

    my $self = shift;

    $self->_new_character(SWF::Builder::Character::Sound::Def->new(@_));
}

sub import_asset {
    my $self = shift;

    my $i = $self->_new_character(SWF::Builder::Character::Imported->new(@_));
    $self->_depends($i, 1);  # set 'depend' flag by force because imported assets may be used only by ActionScript.
    $i;
}

#sub shape_tween {
#    require SWF::Builder::Character::MorphShape;
#
#    my $self = shift;
#
#    $self->_new_character(SWF::Builder::Character::MorphShape->shape_tween(@_));
#}

sub _new_character {
    my ($parent, $self) = @_;

    push @{$parent->{_root}{_character_IDs}}, $self->{ID};
    push @{$parent->{_root}{_to_destroy}}, $self;
    $self->{_parent} = $parent;
    $self->{_root}   = $parent->{_root};

    return $self;
}


sub frame_action {
    require SWF::Builder::ActionScript;

    my ($self, $frame) = @_;

    my $tag = SWF::Element::Tag::DoAction->new;
    push @{$self->{_frame_list}[$frame-1]}, $tag;
    my $action = SWF::Builder::ActionScript->new(Version => $self->{_root}{_version});
    $tag->Actions($action->{_actions});
    return $action;
}

sub frame_label {
    my ($self, $frame, $label, $anchor) = @_;

    utf2bin($label);
    push @{$self->{_frame_list}[$frame-1]}, SWF::Element::Tag::FrameLabel->new(Name => $label, NamedAnchorFlag => $anchor);
}


sub set_depth {
    my $self = shift;
    my $n = 1;
    my $depth = $self->{_depth_list}{_upper};
    while ($depth != $self->{_depth_list}) {
	$n = $depth->set_depth($n);
	$depth = $depth->{_upper};
    }
}

sub _destroy {
    my $self = shift;

    $self->{_depth_list}->_destroy;
    %$self = ();
}

####

package SWF::Builder::Movie::Root;
use Carp;

use base qw/ SWF::Builder::Movie SWF::Builder::ExElement::Color::AddColor /;

sub new {
    my $class = shift;
    my %param = @_;
    my $version = $param{Version} || 6;

    my $self = $class->SUPER::new;

    $self->{_file} = SWF::File->new
	( undef,
	  Version => $version,
	  FrameRate => $param{FrameRate},
	  FrameSize => [ map {$_*20} @{$param{FrameSize}}],
	  );
    $self->{_backgroundcolor} = $param{BackgroundColor};
    $self->{_root} = $self;
    $self->{_character_IDs} = [];
    $self->{_ID_seed} = 1;
    $self->{_target_path} = '_root';
    $self->{_to_destroy} = [];
    $self->{_version} = $version;
    $self->{_as_namespace} = {};
    $self->{_init_action} = undef;
    $self->{_auto_namer} = 1;
    $self->_init_is_alpha;
    $self;
}

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

    for my $id (@{$self->{_character_IDs}}) {
	$id->configure(undef);
    }

    $self->set_depth;

    $self->{_frame_list}->pack($stream);

}

our $EMPTY_SPRITE = SWF::Element::Tag::DefineSprite->new(ControlTags=>[SWF::Element::Tag::ShowFrame->new]);

sub save {
    my ($self, $file) = @_;
    my $stream = $self->{_file};

    $self->{_is_alpha}->configure(0);
    SWF::Element::Tag::SetBackgroundColor->new(BackgroundColor => $self->_add_color($self->{_backgroundcolor}))->pack($stream);
    $self->{_ID_seed} = 1;
    if (keys %{$self->{_as_namespace}}) {
	my $action = SWF::Builder::ActionScript->new(Version => $self->{_version});
	$action->compile(_create_namespace_initializer('', '_global', $self->{_as_namespace}));
#	SWF::Element::Tag::DefineSprite->new(SpriteID => $self->{_ID_seed}, ControlTags=>[SWF::Element::Tag::ShowFrame->new])->pack($stream);
	SWF::Element::Tag::DefineSprite->new(SpriteID => $self->{_ID_seed}, ControlTags=>[SWF::Element::Tag::End->new])->pack($stream);
	SWF::Element::Tag::DoInitAction->new(SpriteID => $self->{_ID_seed}++, Actions => $action->{_actions})->pack($stream);
    }
    if ($self->{_init_action}) {
#	SWF::Element::Tag::DefineSprite->new(SpriteID => $self->{_ID_seed}, ControlTags=>[SWF::Element::Tag::ShowFrame->new])->pack($stream);
	SWF::Element::Tag::DefineSprite->new(SpriteID => $self->{_ID_seed}, ControlTags=>[SWF::Element::Tag::End->new])->pack($stream);
	SWF::Element::Tag::DoInitAction->new(SpriteID => $self->{_ID_seed}++, Actions => $self->{_init_action}{_actions})->pack($stream);
    }

    $self->pack($stream);
    $stream->close($file);
}

sub _create_namespace_initializer {
    my ($as, $pname, $namehash) = @_;

    for my $name (keys %$namehash) {
	my $n = "$pname.$name";
	$as .= <
//#
if (eval('$n') == undefined) {
    set('$n', new Object());
}
ASEND
#//
        $as = _create_namespace_initializer($as, $n, $namehash->{$name});
    }
    return $as;
}

sub use_namespace {
    require SWF::Builder::ActionScript;

    my $self = shift;

    while (my $name = shift) {
	my $ns = $self->{_as_namespace};
	my @n = split /\./, $name;
	for my $n (@n) {
	    $ns->{$n} ||= {};
	    $ns = $ns->{$n};
	}
    }
}

sub init_action {
    require SWF::Builder::ActionScript;

    my $self = shift;

    $self->{_init_action} ||= SWF::Builder::ActionScript->new(Version => $self->{_version});
}

sub auto_namer {
    shift->{_auto_namer} = 1;
}

sub no_namer {
    shift->{_auto_namer} = 0;
}


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

    push @{$self->{_frame_list}[$frame-1]}, $char;
}

sub FrameRate {
    my $self = shift;
    $self->{_file}->FrameRate(@_);
}

sub FrameSize {
    my $self = shift;
    $self->{_file}->FrameSize(map {$_*20} @_);
}

sub BackgroundColor {
    my ($self, $color) = @_;
    $self->{_backgroundcolor} = $color if defined $color;
    $self->{_backgroundcolor};
}

sub compress {
    my $self = shift;
    $self->{_file}->compress(@_);
}

sub _destroy {
    my $self = shift;
    undef $self->{_root};
    for (@{$self->{_to_destroy}}) {
	$_->_destroy;
    }
    $self->SUPER::_destroy;
}

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__