1package SWF::Builder::ExElement; 2 3use strict; 4use Carp; 5use SWF::Element; 6 7require Exporter; 8 9our $VERSION="0.05"; 10@SWF::Builder::ExElement::ISA = ('Exporter'); 11 12our @EXPORT = ('utf2bin', 'bin2utf', '_round'); 13*utf2bin = ($]>=5.008) ? \&utf8::encode : sub{}; 14*bin2utf = ($]>=5.008) ? \&utf8::decode : sub{}; 15 16sub _round { 17 my $a=shift; 18 19 $a||=0; 20 return int($a+0.5*($a<=>0)); 21} 22 23package SWF::Builder::ExElement::Color; 24 25 SWF::Element::_create_class('_Color', ['RGB','RGBA'], 26 Red => '$UI8', 27 Green => '$UI8', 28 Blue => '$UI8', 29 Alpha => '$UI8', 30 is_alpha => 'Scalar'); 31 32@SWF::Builder::ExElement::Color::ISA = ('SWF::Element::_Color'); 33eval{SWF::Element::RGB->new->pack}; 34eval{SWF::Element::RGBA->new->pack}; 35 36use overload 37 '""' => sub { 38 my $self = shift; 39 sprintf('%2.2X%2.2X%2.2X%2.2X', $self->Red, $self->Green, $self->Blue, $self->Alpha); 40 }, 41 fallback =>1; 42 43sub element_names { 44 SWF::Element::_Color->element_names; 45} 46 47sub element_type { 48 SWF::Element::_Color->element_type($_[1]); 49} 50 51sub pack { 52 my ($self, $stream) = @_; 53 54 if ($self->is_alpha) { 55 $self->SWF::Element::RGBA::pack($stream); 56 } else { 57 $self->SWF::Element::RGB::pack($stream); 58 } 59} 60 61##### 62 63package SWF::Builder::ExElement::Color::AddColor; 64 65sub _add_color { 66 my $self = shift; 67 my @param = @_; 68 my %param; 69 my @color = qw/Red Green Blue Alpha/; 70 71 { 72 if (@param == 1) { 73 if ($param[0] =~ /^\#?([0-9a-f][0-9a-f]){3,4}$/i) { 74 @param{qw/Red Green Blue Alpha/} = map {oct('0x'.$_)} ($param[0]=~/\#?(..)/g); 75 } elsif (ref($param[0]) eq 'ARRAY') { 76 @param = @{$param[0]}; 77 redo; 78 } elsif (UNIVERSAL::isa($param[0],'SWF::Element::RGB')) { 79 %param = $param[0]->configure; 80 delete $param{_is_alpha}; 81 } 82 } elsif ($param[0] =~ /^\d+$/) { 83 @param{qw/Red Green Blue Alpha/} = @param; 84 } else { 85 my %param1 = @param; 86 @param{qw/Red Green Blue Alpha/} = @param1{qw/Red Green Blue Alpha/}; 87 } 88 } 89 90 unless (defined $param{Alpha}) { 91 $param{Alpha} = 255; 92 } elsif ($param{Alpha} < 255) { 93 $self->{_is_alpha}->configure(1); 94 } 95 return SWF::Builder::ExElement::Color->new(%param, is_alpha => $self->{_is_alpha}); 96} 97 98sub _init_is_alpha { 99 my ($self, $f) = @_; 100 $f ||= 0; 101 $self->{_is_alpha} = SWF::Element::Scalar->new($f); 102} 103 104#### 105 106package SWF::Builder::ExElement::BoundaryRect; 107@SWF::Builder::ExElement::BoundaryRect::ISA = ('SWF::Element::RECT'); 108 109sub new { 110 my $class =shift; 111 bless [@_], $class; 112} 113 114sub Xmin { 115 my ($self, $v) = @_; 116 if (defined $v) { 117 $self->[0] = $v; 118 } 119 $self->[0]; 120} 121 122sub Ymin { 123 my ($self, $v) = @_; 124 if (defined $v) { 125 $self->[1] = $v; 126 } 127 $self->[1]; 128} 129 130sub Xmax { 131 my ($self, $v) = @_; 132 if (defined $v) { 133 $self->[2] = $v; 134 } 135 $self->[2]; 136} 137 138sub Ymax { 139 my ($self, $v) = @_; 140 if (defined $v) { 141 $self->[3] = $v; 142 } 143 $self->[3]; 144} 145 146sub pack { 147 my ($self, $stream) = @_; 148 my %rect; 149 @rect{qw/ Xmin Ymin Xmax Ymax /} = @$self; 150 SWF::Element::RECT->new 151 ( Xmin => $self->[0], 152 Ymin => $self->[1], 153 Xmax => $self->[2], 154 Ymax => $self->[3], 155 )->pack($stream); 156} 157 158sub set_boundary { 159 my ($self, $x1, $y1, $x2, $y2)=@_; 160 161 ($x1, $x2) = ($x2, $x1) if $x1 > $x2; 162 ($y1, $y2) = ($y2, $y1) if $y1 > $y2; 163 164 unless (defined($self->Xmin)) { 165 $self->[0] = $x1; 166 $self->[2] = $x2; 167 $self->[1] = $y1; 168 $self->[3] = $y2; 169 } else { 170 if ($self->[0]>$x1) { 171 $self->[0] = $x1; 172 } 173 if ($self->[2]<$x2) { 174 $self->[2] = $x2; 175 } 176 if ($self->[1]>$y1) { 177 $self->[1] = $y1; 178 } 179 if ($self->[3]<$y2) { 180 $self->[3] = $y2; 181 } 182 } 183} 184 185##### 186 187package SWF::Builder::ExElement::MATRIX; 188 189@SWF::Builder::ExElement::MATRIX::ISA = ('SWF::Element::MATRIX'); 190 191sub moveto { 192 my ($self, $x, $y) = @_; 193 $self->SUPER::moveto($x*20, $y*20); 194} 195 196*translate = \&moveto; 197 198sub _moveto_twips { 199 shift->SUPER::moveto(@_); 200} 201 202sub init { 203 my ($m, $p) = @_; 204 205 Carp::croak "Invalid matrix option" unless ref($p) eq 'ARRAY'; 206 while( my ($com, $param) = splice(@$p, 0, 2) ) { 207 Carp::croak "Invalid matrix option '$com'" unless $m->can($com); 208 $m->$com(ref($param) eq 'ARRAY' ? @$param : ($param)); 209 } 210 $m; 211} 212 213 2141; 215 216