File Coverage

blib/lib/SWF/Builder/Character/Font.pm

Criterion	Covered	Total	%
statement	78	99	78.7
branch	13	30	43.3
condition	2	6	33.3
subroutine	14	19	73.6
pod			n/a
total	107	154	69.4

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__