1package SWF::Builder::Character::Text;
2
3use strict;
4use utf8;
5
6our $VERSION="0.04";
7
8@SWF::Builder::Character::Text::ISA = qw/ SWF::Builder::Character::UsableAsMask /;
9@SWF::Builder::Character::Text::Imported::ISA = qw/ SWF::Builder::Character::Imported SWF::Builder::Character::Text /;
10@SWF::Builder::Character::StaticText::Imported::ISA = qw/ SWF::Builder::Character::Text::Imported /;
11
12####
13
14package SWF::Builder::Character::Text::Def;
15
16use Carp;
17use SWF::Element;
18use SWF::Builder::Character;
19use SWF::Builder::Character::Font;
20use SWF::Builder::ExElement;
21
22@SWF::Builder::Character::Text::Def::ISA = qw/ SWF::Builder::Character::Text SWF::Builder::ExElement::Color::AddColor/;
23
24sub new {
25    my ($class, $font, $text) = @_;
26    my $tag;
27    my $self = bless {
28	_bounds       => SWF::Builder::ExElement::BoundaryRect->new,
29	_textrecords  => SWF::Element::Array::TEXTRECORDARRAY2->new,
30	_kerning      => 1,
31	_current_font => '',
32	_current_size => 12,
33	_max_ascent   => 0,
34	_max_descent  => 0,
35	_p_max_descent=> 0,
36	_current_X    => 0,
37	_current_Y    => 0,
38	_leading      => 0,
39	_nl           => undef,
40	_nl_X         => 0,
41	_nlbounds     => SWF::Builder::ExElement::BoundaryRect->new,
42    }, $class;
43    $self->_init_character;
44    $self->_init_is_alpha;
45    $self->{_nl} = $self->_get_last_record;
46    $self->font($font) if defined $font;
47    $self->text($text) if defined $text;
48    $self;
49}
50
51sub _get_last_record {
52    my $self = shift;
53    my $records = $self->{_textrecords};
54    my $r;
55
56    if (!@$records or $records->[-1]->GlyphEntries->defined) {
57	$r = SWF::Element::TEXTRECORD2->new;
58	push @$records, $r;
59	return $r;
60    } else {
61	return $records->[-1];
62    }
63}
64
65sub font {
66    my ($self, $font) = @_;
67    return if $font eq $self->{_current_font};
68    croak "Invalid font" unless UNIVERSAL::isa($font, 'SWF::Builder::Character::Font');
69    croak "The font applied to the static text needs to embed glyph data" unless $font->embed;
70    my $r = $self->_get_last_record;
71    my $size = $self->{_current_size};
72    $r->TextHeight($size*20);
73    $r->FontID($font->{ID});
74    $self->{_current_font} = $font;
75    $self->_depends($font);
76    my $as  = $font->{_tag}->FontAscent  * $size / 1024;
77    my $des = $font->{_tag}->FontDescent * $size / 1024;
78    $self->{_max_ascent}  = $as  if $self->{_max_ascent}  < $as;
79    $self->{_max_descent} = $des if $self->{_max_descent} < $des;
80    $self;
81}
82
83sub size {
84    my ($self, $size) = @_;
85    my $r = $self->_get_last_record;
86    $r->TextHeight($size*20);
87    $r->FontID($self->{_current_font}->{ID});
88    $self->{_current_size} = $size;
89    my $as  = $self->{_current_font}{_tag}->FontAscent  * $size / 1024;
90    my $des = $self->{_current_font}{_tag}->FontDescent * $size / 1024;
91    $self->{_max_ascent}  = $as  if $self->{_max_ascent}  < $as;
92    $self->{_max_descent} = $des if $self->{_max_descent} < $des;
93    $self;
94}
95
96sub kerning {
97    my ($self, $kern) = @_;
98
99    if (defined $kern) {
100	$self->{_kerning} = $kern;
101	$self;
102    } else {
103	$self->{_kerning};
104    }
105}
106
107sub leading {
108    my ($self, $leading) = @_;
109    if (defined $leading) {
110	$self->{_leading} = $leading;
111	$self;
112    } else {
113	$self->{_leading};
114    }
115}
116
117sub color {
118    my ($self, $color) = @_;
119    my $r = $self->_get_last_record;
120    $color = $self->_add_color($color);
121    $r->TextColor($color);
122    $self;
123}
124
125sub _bbox_adjust {
126    my $self = $_[0];  # Don't use 'shift'
127    my $nl = $self->{_nl};
128    my $nlbbox = $self->{_nlbounds};
129    return unless defined $nlbbox->[0];
130
131    my $s = $self->{_current_Y} + $self->{_max_ascent} + $self->{_p_max_descent};
132
133    $self->{_bounds}->set_boundary($nlbbox->[0], $nlbbox->[1]+$s*20, $nlbbox->[2], $nlbbox->[3]+$s*20);
134    $self->{_nlbounds} = SWF::Builder::ExElement::BoundaryRect->new;
135}
136
137sub _line_adjust {
138    my $self = $_[0];  # Don't use 'shift'
139    &_bbox_adjust;
140    $self->{_current_Y} += $self->{_max_ascent} + $self->{_p_max_descent};
141    $self->{_nl}->YOffset($self->{_current_Y}*20);
142    my $size = $self->{_current_size};
143    my $ft = $self->{_current_font}{_tag};
144    $self->{_max_ascent}  = $ft->FontAscent  * $size / 1024;
145    $self->{_max_descent} = $ft->FontDescent * $size / 1024;
146    $self->{_nl} = undef;
147}
148
149sub position {
150    &_line_adjust;
151    goto &_position;
152}
153
154sub _position {
155    my ($self, $x, $y) = @_;
156    my $r = $self->_get_last_record;
157    $r->XOffset($x*20);
158    $r->YOffset($y*20);
159    $self->{_bounds}->set_boundary($x*20, $y*20, $x*20, $y*20);
160    $self->{_current_X} = $self->{_nl_X} = $x;
161    $self->{_current_Y} = $y;
162    $self->{_nl} = $r;
163    $self->{_p_max_descent} = 0;
164    $self;
165}
166
167sub text {
168    my ($self, $text) = @_;
169    my @text = split /([\x00-\x1f]+)/, $text;
170    my $font = $self->{_current_font};
171    my $scale = $self->{_current_size} / 51.2;
172    my $glyph_hash = $font->{_glyph_hash};
173
174    while (my($text, $ctrl) = splice(@text, 0, 2)) {
175	my $bbox = $self->{_nlbounds};
176	$font->add_glyph($text);
177	my @chars = split //, $text;
178	if (@chars) {
179	    my $gent = $self->{_textrecords}[-1]->GlyphEntries;
180	    my $c1 = shift @chars;
181	    push @chars, undef;
182	    my $x = $self->{_current_X};
183	    for my $c (@chars) {
184		my $ord_c1 = ord($c1);
185		my $kern = ($self->{_kerning} and defined $c) ? $font->kern($ord_c1, ord($c)) : 0;
186#		my $kern = 0;
187		my $adv = ($glyph_hash->{$c1}[0] + $kern) * $scale;
188		my $b = $glyph_hash->{$c1}[1]{_bounds};
189		if (defined $b->[0]) {
190		    $bbox->set_boundary($x*20+$b->[0]*$scale, $b->[1]*$scale, $x*20+$b->[2]*$scale, $b->[3]*$scale);
191		} else {
192		    $bbox->set_boundary($x*20, 0, $x*20, 0);
193		}
194		push @$gent, SWF::Builder::Text::GLYPHENTRY->new($ord_c1, $adv, $font);
195		$x += $adv;
196		$c1 = $c;
197	    }
198	    $self->{_current_X} = $x;
199	}
200
201	if ($ctrl and (my $n = $ctrl=~tr/\n/\n/)) {
202	    my $md = $self->{_max_descent};
203	    my $height = $self->{_max_ascent} + $md;
204	    $self->_line_adjust;
205#	    $self->_position($self->{_nl_X}, $self->{_current_Y} + $height * ($n-1) + ($font->{_tag}->FontLeading * $scale / 20 + $self->{_leading})*$n);
206	    $self->_position($self->{_nl_X}, $self->{_current_Y} + $height * ($n-1) + $self->{_leading} * $n);
207	    $self->{_p_max_descent} = $md;
208	}
209    }
210    $self;
211}
212
213sub get_bbox {
214    my $self = shift;
215    $self->_bbox_adjust;
216    return map{$_/20} @{$self->{_bounds}};
217}
218
219sub _pack {
220    my ($self, $stream) = @_;
221
222    $self->_line_adjust if $self->{_nl};
223
224    my $x = $self->{_current_X} = 0;
225    my $y = $self->{_current_Y} = 0;
226
227    my $tag;
228    if ($self->{_is_alpha}) {
229	$tag = SWF::Element::Tag::DefineText2->new;
230    } else {
231	$tag = SWF::Element::Tag::DefineText->new;
232    }
233    $tag->configure( CharacterID => $self->{ID},
234		     TextBounds  => $self->{_bounds},
235		     TextRecords => $self->{_textrecords},
236		     );
237    $tag->pack($stream);
238
239}
240
241
242####
243
244{
245    package SWF::Builder::Text::GLYPHENTRY;
246    @SWF::Builder::Text::GLYPHENTRY::ISA = ('SWF::Element::GLYPHENTRY');
247
248    sub new {
249	my ($class, $code, $adv, $font) = @_;
250	bless [$code, $adv*20, $font->{_code_hash}], $class;
251    }
252
253    sub GlyphIndex {
254	my $self = shift;
255
256	return $self->[2]{$self->[0]};
257    }
258
259    sub GlyphAdvance {
260	return shift->[1];
261    }
262}
263
2641;
265__END__
266
267
268=head1 NAME
269
270SWF::Builder::Character::Text - SWF static text object
271
272=head1 SYNOPSIS
273
274  my $text = $mc->new_static_text( $font )
275    ->size(10)
276    ->color('000000')
277    ->text('This is a text.');
278
279  my $text_i = $text->place;
280
281=head1 DESCRIPTION
282
283This module creates static texts, which cannot be changed at playing time.
284
285=over 4
286
287=item $text = $mc->new_static_text( [$font, $text] )
288
289returns a new static text.
290$font is an SWF::Builder::Font object.
291
292=item $text->font( $font )
293
294applies the font to the following text.
295$font is an SWF::Builder::Font object.
296
297=item $text->size( $size )
298
299sets a font size to $size in pixel.
300
301=item $text->color( $color )
302
303sets color of the following text.
304The color can take a six or eight-figure
305hexadecimal string, an array reference of R, G, B, and optional alpha value,
306an array reference of named parameters such as [Red => 255],
307and SWF::Element::RGB/RGBA object.
308
309=item $text->text( $string )
310
311writes the $string.  The glyph data of the applied font is embedded if needed.
312The string can also include a newline code, "\n".
313
314=item $text->position( $x, $y )
315
316sets the position of the following text.
317($x, $y) are coordinates in pixel relative to the I<origin> of the text object.
318
319=item $text->leading( $leading )
320
321sets the vertical distance between the lines in pixel.
322
323=item $text->kerning( [$kerning] )
324
325sets/gets a flag to adjust spacing between kern pair.
326
327=item $text->get_bbox
328
329returns the bounding box of the text, a list of coordinates
330( top-left X, top-left Y, bottom-right X, bottom-right Y ).
331
332=item $text_i = $text->place( ... )
333
334returns the display instance of the text. See L<SWF::Builder>.
335
336=back
337
338=head1 COPYRIGHT
339
340Copyright 2003 Yasuhiro Sasama (ySas), <ysas@nmt.ne.jp>
341
342This library is free software; you can redistribute it
343and/or modify it under the same terms as Perl itself.
344
345=cut
346