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