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