File Coverage

blib/lib/SWF/Builder/Character/Shape.pm

Criterion	Covered	Total	%
statement	135	190	71.0
branch	33	68	48.5
condition	11	27	40.7
subroutine	18	20	90.0
pod			n/a
total	197	305	64.5

package SWF::Builder::Character::Shape;

use strict;
use Carp;
use SWF::Element;
use SWF::Builder::Character;
use SWF::Builder::ExElement;
use SWF::Builder::Gradient;
use SWF::Builder::Shape;

our $VERSION="0.05";

@SWF::Builder::Character::Shape::ISA = qw/ SWF::Builder::Character::UsableAsMask /;
@SWF::Builder::Character::Shape::Imported::ISA = qw/ SWF::Builder::Character::Imported SWF::Builder::Character::Shape /;

{
    package SWF::Builder::Character::Shape::Def;

    use SWF::Builder::ExElement;

    @SWF::Builder::Character::Shape::Def::ISA = qw/ SWF::Builder::Shape SWF::Builder::Character::Shape SWF::Builder::ExElement::Color::AddColor /;

    sub new {
	my $self = shift->SUPER::new;
    }

    sub _init {
	my $self = shift;
	$self->_init_character;
	$self->_init_is_alpha;

	$self->{_edges} = SWF::Element::SHAPEWITHSTYLE3->ShapeRecords->new;
	$self->{_current_line_width} = -1;
	$self->{_current_line_color} = '';
	$self->{_current_FillStyle0} = '';
	$self->{_current_FillStyle1} = '';
	$self->{_line_styles} = $self->{_shape_line_styles} = SWF::Element::SHAPEWITHSTYLE3->LineStyles->new;
	$self->{_line_style_hash} = {};
	$self->{_fill_styles} = $self->{_shape_fill_styles} = SWF::Element::SHAPEWITHSTYLE3->FillStyles->new;
	$self->{_fill_style_hash} = {};
	$self->{_links} = [];

	$self;
    }

    sub _add_gradient {
	my ($self, $gradient) = @_;

	$self->{_is_alpha}->configure($self->{_is_alpha}->value | $gradient->{_is_alpha}->value);
	return bless {
	    _is_alpha => $self->{_is_alpha},
	    _gradient => $gradient,
	}, 'SWF::Builder::Shape::Gradient';
    }

    sub linestyle {
	my $self = shift;
	my ($index, $width, $color);

	if ($_[0] eq 'none' or $_[0] eq 0) {
	    $index = 0;
	    $width = -1;
	    $color = '';
	} else {
	    my %param;
	    if ($_[0] eq 'Width' or $_[0] eq 'Color') {
		%param = @_;
	    } else {
		%param = (Width => $_[0], Color => $_[1]);
	    }
	    $width = $param{Width};
	    $width = $self->{_current_line_width} unless defined $width;
	    if (defined $param{Color}) {
		$color = $self->_add_color($param{Color});
	    } else {
		$color = $self->{_current_line_color};
	    }
	    return $self if ($width == $self->{_current_line_width} and $color eq $self->{_current_line_color});

	    if (exists $self->{_line_style_hash}{"$width:$color"}) {
		$index = $self->{_line_style_hash}{"$width:$color"};
	    } else {
		if (@{$self->{_line_styles}} >= 65534) {
		    my $r = $self->_get_stylerecord;
		    $self->{_line_styles} = $r->LineStyles;
		    $self->{_line_style_hash} = {};
		    $self->{_fill_styles} = $r->FillStyles;
		    $self->{_fill_style_hash} = {};
		}
		my $ls = $self->{_line_styles};
		push @$ls, $ls->new_element(Width => $width*20, Color => $color);
		$index = $self->{_line_style_hash}{"$width:$color"} = @$ls;
	    }
	}
	$self->_set_style(LineStyle => $index);
	$self->{_current_line_width} = $width;
	$self->{_current_line_color} = $color;
	$self;
    }

    sub _fillstyle {
	my $self = shift;
	my $setstyle = shift;
	my ($index, $fillkey);

	if ($_[0] eq 'none' or $_[0] eq 0) {
	    $index = 0;
	    $fillkey = '';
	} else {
	    my %param;
	    if ($_[0] eq 'Color' or $_[0] eq 'Gradient' or $_[0] eq 'Bitmap') {
		%param = @_;
	    } else {
		for (ref($_[0])) {
		    /Gradient/ and do {
			%param = (Gradient => $_[0], Type => $_[1], Matrix => $_[2]);
			last;
		    };
		    /Bitmap/ and do {
			%param = (Bitmap => $_[0], Type => $_[1], Matrix => $_[2]);
			last;
		    };
		    %param = (Color => $_[0]);
		}
	    }
	    my @param2;

	    $fillkey = join(',', %param);
	    if (exists $param{Gradient}) {
		unless (UNIVERSAL::isa($param{Matrix}, 'SWF::Builder::ExElement::MATRIX')) {
		    $param{Matrix} = SWF::Builder::ExElement::MATRIX->new->init($param{Matrix});
		}
		push @param2, Gradient       => $self->_add_gradient($param{Gradient}),
		              FillStyleType  =>
				 (lc($param{Type}) eq 'radial' ? 0x12 : 0x10),
			      GradientMatrix => $param{Matrix};

	    } elsif (exists $param{Bitmap}) {
		unless (UNIVERSAL::isa($param{Matrix}, 'SWF::Builder::ExElement::MATRIX')) {
		    my $m = $param{Bitmap}->matrix;
		    $m->init($param{Matrix}) if defined $param{Matrix};
		    $param{Matrix} = $m;
		}
		push @param2, BitmapID      => $param{Bitmap}->{ID},
		              FillStyleType =>
				  (lc($param{Type}) =~ /^clip(ped)?$/ ? 0x41 : 0x40),
			      BitmapMatrix  => $param{Matrix};
		$self->{_is_alpha}->configure($self->{_is_alpha} | $param{Bitmap}{_is_alpha});
		$self->_depends($param{Bitmap});
	    } else {
		push @param2, Color => $self->_add_color($param{Color}),
		              FillStyleType => 0x00;
	    }

	    return $self if $self->{"_current_$setstyle"} eq $fillkey;

	    if (exists $self->{_fill_style_hash}{$fillkey}) {
		$index = $self->{_fill_style_hash}{$fillkey};
	    } else {
		if (@{$self->{_fill_styles}} >= 65534) {
		    my $r = $self->_get_stylerecord;
		    $self->{_line_styles} = $r->LineStyles;
		    $self->{_line_style_hash} = {};
		    $self->{_fill_styles} = $r->FillStyles;
		    $self->{_fill_style_hash} = {};
		}
		my $fs = $self->{_fill_styles};
		push @$fs, $fs->new_element(@param2);
		$index = $self->{_fill_style_hash}{$fillkey} = @$fs;
	    }
	}
	$self->_set_style($setstyle => $index);
	$self->{"_current_$setstyle"} = $fillkey;
	$self;
    }

    sub fillstyle {
	my $self = shift;
	_fillstyle($self, 'FillStyle0', @_);
    }

    *fillstyle0 = \&fillstyle;

    sub fillstyle1 {
	my $self = shift;
	_fillstyle($self, 'FillStyle1', @_);
    }

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

	$self->{_anchors}{$anchor} = [$#{$self->{_edges}}, $self->{_current_X}, $self->{_current_Y}, $#{$self->{_links}}];
	$self->{_last_anchor} = $anchor;
	$self;
    }

    sub _set_bounds {
	my ($self, $x, $y, $f) = @_;
	$self->SUPER::_set_bounds($x, $y);
	return if $f;

	if (defined $self->{_links}[-1]) {
#	    my $cw = $self->{_current_line_width} * 10;
	    my $m = $self->{_links}[-1];
#	    $m->[6]->set_boundary($x-$cw, $y-$cw, $x+$cw, $y+$cw);
	    my (undef, $tlx, $tly) = @{$m->[5]};
	    if ($x*$x+$y*$y < $tlx*$tlx+$tly*$tly) {
		$m->[5] = [$#{$self->{_edges}}, $x, $y];
	    }
	}
    }

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

	if (exists $param{MoveDeltaX} and defined $self->{_links}[-1]) {
	    my $m = $self->{_links}[-1];
	    $m->[1] = $#{$self->{_edges}};
	    $m->[3] = $self->{_current_X};
	    $m->[4] = $self->{_current_Y};
	}

	my $r = $self->SUPER::_set_style(%param);

	if (exists $param{MoveDeltaX}) {
	    my ($x, $y) = ($param{MoveDeltaX}, $param{MoveDeltaY});
	    my @linkinfo =
		($#{$self->{_edges}},        # start edge index
		 undef,                      # last continuous edge index
		 [$#{$self->{_edges}}],      # STYLECHANGERECORD indice
		 undef,                      # last X
		 undef,                      # last Y
		 [$#{$self->{_edges}}, $x, $y],               # top left
#	         SWF::Builder::ExElement::BoundaryRect->new,  # boundary
		 );
	    if (exists $self->{_links}[-1] and $self->{_links}[-1][0] == $linkinfo[0]) {
		$self->{_links}[-1] = \ @linkinfo;
	    } else {
		push @{$self->{_links}}, \ @linkinfo;
	    }
	    if (defined $self->{_last_anchor}) {
		my $last_anchor = $self->{_anchors}{$self->{_last_anchor}};
		if ($last_anchor->[0] == $#{$self->{_edges}} or $last_anchor->[0] == $#{$self->{_edges}}-1) {
		    $last_anchor->[0] = $#{$self->{_edges}};
		    $last_anchor->[1] = $x;
		    $last_anchor->[2] = $y;
		    $last_anchor->[3] = $#{$self->{_links}};
		}
	    }
	    $r->LineStyle($self->{_line_style_hash}{$self->{_current_line_width}.':'.$self->{_current_line_color}}) unless defined $r->LineStyle;
	    $r->FillStyle0($self->{_fill_style_hash}{$self->{_current_FillStyle0}}) unless defined $r->FillStyle0;
	    $r->FillStyle1($self->{_fill_style_hash}{$self->{_current_FillStyle1}}) unless defined $r->FillStyle1;
	} else {
	    push @{$self->{_links}[-1][2]}, $#{$self->{_edges}} if $self->{_links}[-1][2][-1] != $#{$self->{_edges}};
	}
	$r;
    }

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

	my $tag = ($self->{_is_alpha} ? SWF::Element::Tag::DefineShape3->new : SWF::Element::Tag::DefineShape2->new);
	$tag->ShapeID($self->{ID});
	$tag->ShapeBounds($self->{_bounds});
	$tag->Shapes
	    (
	      FillStyles => $self->{_shape_fill_styles},
	      LineStyles => $self->{_shape_line_styles},
	      ShapeRecords =>$self->{_edges},
	     );
	$tag->pack($stream);
    }
}

#####

{
    package SWF::Builder::Shape::Gradient;

    @SWF::Builder::Shape::Gradient::ISA = ('SWF::Element::Array::GRADIENT3');

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

	my $g = $self->{_gradient};
	my $a = $g->{_is_alpha}->value;
	$g->{_is_alpha}->configure($self->{_is_alpha});
	$g->pack($stream);
	$g->{_is_alpha}->configure($a);
    }
}

1;
__END__