package SWF::Builder::Character::Font;
use strict;
use utf8;
our $VERSION="0.091";
our %indirect;
@indirect{ ('_sans', '_serif', '_typewriter', "_\x{30b4}\x{30b7}\x{30c3}\x{30af}", "_\x{660e}\x{671d}", "_\x{7b49}\x{5e45}") }
= ('_sans', '_serif', '_typewriter', "_\x{30b4}\x{30b7}\x{30c3}\x{30af}", "_\x{660e}\x{671d}", "_\x{7b49}\x{5e45}");
@SWF::Builder::Character::Font::ISA = qw/ SWF::Builder::Character /;
####
package SWF::Builder::Character::Font::Imported;
@SWF::Builder::Character::Font::Imported::ISA = qw/ SWF::Builder::Character::Imported SWF::Builder::Character::Font /;
sub embed {1} # ??
sub add_glyph{}
####
package SWF::Builder::Character::Font::Def;
use Carp;
use SWF::Element;
use SWF::Builder;
use SWF::Builder::ExElement;
@SWF::Builder::Character::Font::Def::ISA = qw/ SWF::Builder::Character::Font /;
sub new {
my ($class, $fontfile, $fontname) = @_;
my $tag;
my $self = bless {
_embed => 1,
_average_width => 512,
_read_only => 0,
_code_hash => {},
_glyph_hash => {},
_tag => ($tag = SWF::Element::Tag::DefineFont2->new),
}, $class;
$self->_init_character;
$tag->FontID($self->{ID});
if (exists $indirect{$fontfile}) {
utf2bin($fontfile);
$tag->FontName($fontfile);
$self->embed(0);
return $self;
}
eval {$self->_init_font($fontfile, $fontname)};
if ($@) {
if ($@ =~ /Can\'t locate object method/) {
eval { require SWF::Builder::Character::Font::FreeType }
or eval { require SWF::Builder::Character::Font::TTF }
or croak "Failed loading font module. It is necessary to install Font-FreeType or Font-TTF to use outline fonts";
$self->_init_font($fontfile, $fontname);
} else {
die;
}
}
$self;
}
sub embed {
my ($self, $embed) = @_;
if (defined $embed) {
$self->{_embed} = $embed;
}
return $self->{_embed};
}
sub is_readonly {
shift->{_read_only};
}
sub get_average_width {
shift->{_average_width};
}
sub glyph_shape {
my ($self, $char) = @_;
if (exists $self->{_glyph_hash}{$char} and defined $self->{_glyph_hash}{$char}[1]) {
return $self->{_glyph_hash}{$char}[1];
} else {
my $gshape = SWF::Builder::Character::Font::Glyph->new;
$self->{_glyph_hash}{$char}[1] = $gshape;
return $gshape;
}
}
sub add_glyph {
my ($self, $string, $e_char) = @_;
my @chars;
return unless $self->{_embed};
my $hash = $self->{_glyph_hash};
if (defined $e_char) {
@chars = map {chr} (ord($string) .. ord($e_char));
} else {
@chars = split //, $string;
}
for my $c (@chars) {
next if $hash->{$c};
my $gshape = $self->glyph_shape($c);
my $adv = $self->_draw_glyph($c, $gshape);
$hash->{$c} = [$adv, $gshape];
}
}
sub LanguageCode {
my ($self, $code) = @_;
unless (defined $code) {
my $l = $self->{_tag}->LanguageCode->value;
return ('none', 'Latin', 'Japanese', 'Korean', 'Simplified Chinese', 'Traditional Chinese')[$l];
} elsif ($code!~/\d+/) {
($code) = 'none:0 Latin:1 Japanese:2 Korean:3 Simplified Chinese:4 Traditional Chinese:5'=~/\b$code.*?:(\d)/i;
}
$self->{_tag}->LanguageCode($code);
}
sub AUTOLOAD {
my $self = shift;
our $AUTOLOAD;
my ($sub) = $AUTOLOAD=~/::([^:]+)$/;
return if $sub eq 'DESTROY';
my $tag = $self->{_tag};
if ($tag->can($sub)) {
$tag->$sub(@_);
} elsif ($tag->can(my $fsub="FontFlags$sub")) {
$tag->$fsub(@_);
} else {
croak "Can\'t locate object method \"$sub\" via package \"".ref($self).'"';
}
}
my $emprect = SWF::Element::RECT->new(Xmin => 0, Ymin => 0, Xmax => 0, Ymax => 0);
sub _pack {
my ($self, $stream) = @_;
my $tag = $self->{_tag};
my $hash = $self->{_glyph_hash};
my ($code_t, $adv_t, $glyph_t, $bounds_t, $kern_t) =
($tag->CodeTable, $tag->FontAdvanceTable, $tag->GlyphShapeTable, $tag->FontBoundsTable, $tag->FontKerningTable);
for my $c (sort keys %{$self->{_glyph_hash}}) {
push @$code_t, ord($c);
push @$adv_t, (defined($hash->{$c}[0]) ? $hash->{$c}[0]*20 : $hash->{$c}[1]{_bounds}->Xmax);
push @$glyph_t, SWF::Element::SHAPE->new(ShapeRecords => $hash->{$c}[1]{_edges});
push @$bounds_t, $emprect;
}
@{$self->{_code_hash}}{@$code_t} = (0..$#$code_t);
$self->{_tag}->pack($stream);
}
####
package SWF::Builder::Character::Font::Glyph;
use SWF::Builder::Shape;
@SWF::Builder::Character::Font::Glyph::ISA = ('SWF::Builder::Shape');
sub new {
my $class = shift;
my $self = $class->SUPER::new;
$self->fillstyle(1)->linestyle(0);
}
1;
__END__
=head1 NAME
SWF::Builder::Character::Font - SWF font object
=head1 SYNOPSIS
my $font = $mc->new_font('c:/windows/font/arial.ttf');
$font->add_glyph('0123456789');
=head1 DESCRIPTION
This module creates SWF fonts from TrueType fonts.
=over 4
=item $font = $mc->new_font( $fontfile [, $fontname] )
returns a new font.
$fontfile is a outline font file name or an indirect font name.
The font file name should be specified a full path name.
Supported indirect font names are '_sans', '_serif', '_typewriter',
"_\x{30b4}\x{30b7}\x{30c3}\x{30af}" ('gosikku' in Japanese katakana),
"_\x{660e}\x{671d}" ('mincho' in Japanese kanji),
and "_\x{7b49}\x{5e45}" ('tofuku' in Japanese kanji).
When you use outline fonts, either Font::TTF or Font::FreeType is necessary.
Font::TTF supports TrueType fonts (*.ttf/*.ttc). Font::FreeType supports TrueType,
OpenType, and PostScript fonts (*.ttf/*.ttc/*.otf/*.pfb).
Optional $fontname is a font name referred by HTMLs in dynamic texts.
The font name is taken from the TrueType file if not defined.
=item $font->embed( [$embed] )
sets/gets a flag to embed the font or not.
=item $font->is_readonly
gets a permission flag to use the font only 'preview & print'.
If the flag is set, the font cannot be used for text field.
This works properly only when Font::TTF are used and 'OS/2' table are defined in the font.
=item $font->get_average_width
gets the average character width.
This works properly only when Font::TTF are used and 'OS/2' table are defined in the font.
=item $font->add_glyph( $char_string [, $e_char] )
adds glyph data of the characters of the string to the font.
Usually, L<SWF::Builder::character::Text> adds required glyph
data automatically.
It is necessary to do add_glyph if the font is used for a dynamic text
or a text field which will be changed at playing time.
if $e_char is present, add_glyph adds glyphs of characters from
first character of $char_string to first character of $e_char.
For example, $font->add_glyph('a', 'z') adds glyphs of all lower case alphabet.
=item $font->LanguageCode( $code )
sets the spoken language of texts to which the font is applied.
$code can take 'none', 'Latin', 'Japanese', 'Korean', 'Simplified Chinese', and
'Traditional Chinese'. It can also take a number, 0, 1, 2, 3, 4, and 5,
or an initial, 'n', 'L', 'J', 'K', 'S'(or 'C'), and 'T', respectively.
=back
=head1 COPYRIGHT
Copyright 2003 Yasuhiro Sasama (ySas), <ysas@nmt.ne.jp>
This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.
=cut