view release on metacpan or  search on metacpan

lib/SWF/Builder/Character/Font/TTF.pm  view on Meta::CPAN

package SWF::Builder::Character::Font::TTF;  # stub

our $VERSION="0.07";

####

package SWF::Builder::Character::Font::Def;  # addition

use strict;
use utf8;

use SWF::Builder::ExElement;
use SWF::Builder::Shape;
use Font::TTF::Font;
use Font::TTF::Ttc;
use Carp;

sub _init_font {
    my ($self, $fontfile, $fontname) = @_;

    my $type = 0;
    my $tag = $self->{_tag};
    $self->{_ttf_tables} = (my $ttft = bless {}, 'SWF::Builder::Font::TTFTables');

    my $font = Font::TTF::Font->open($fontfile) ||  
	       Font::TTF::Ttc->open($fontfile) 
		   or croak "Can't open font file '$fontfile'";
    my ($p_font, $head, $name, $os2, $hhea, $cmap, $loca, $hmtx, $kern);
    $ttft->{_font} = $p_font = $font;
    
    if (ref($font)=~/:Ttc$/) {   # TrueType collection
	my @names;
	$p_font = $font->{directs}[0];   # Primary font needs to access some table. 
	for my $f (@{$font->{directs}}) { # For each collected font...
	    my $names;
	    $f->{name}->read;
	    for my $pid (@{$f->{name}{strings}[1]}) { # gathers all font names ( latin, unicode...)
		
		for my $eid (@$pid) {
		    while (my ($lid, $s) = each(%$eid)) {
			$names .= "$s\n";
		    }
		}
	    }
	    if (index($names, "$fontname\n") >=0) { # if match $fontname to the gathered,
		$font = $f;                         # accept the font.
		last;
	    }
	}
    }

  EMBED:
    {
	$name = $font->{name}||$p_font->{name} # font name
	or croak 'Invalid font';
	if ($os2 = $font->{'OS/2'}||$p_font->{'OS/2'}) {  # get OS/2 table to check the lisence.
	    $os2->read;
	    my $fstype = $os2->{fsType} && 0;
	    
	    if ($fstype & 0x302) {
		warn "Embedding outlines of the font '$fontfile' is not permitted.\n";
		$self->{_embed} = 0;
		last EMBED;
	    } elsif ($fstype & 4) {
		warn "The font '$fontfile' can use only for 'Preview & Print'.\n";
		$self->{_read_only} = 1;
	    }
	} else {
	    warn "The font '$fontfile' doesn't have any lisence information. See the lisence of the font.\n";
	}
	$head = $font->{head}||$p_font->{head} # header
	or croak "Can't find TTF header of the font $fontname";
	$hhea = $font->{hhea}||$p_font->{hhea} # horizontal header
	or croak "Can't find hhea table of the font $fontname";
	$cmap = $font->{cmap}||$p_font->{cmap} # chr-glyph mapping
	or croak "Can't find cmap table of the font $fontname";
	$loca = $font->{loca}||$p_font->{loca} # glyph location index
	or croak "Can't find glyph index table of the font $fontname";
	$hmtx = $font->{hmtx}||$p_font->{hmtx} # horizontal metrics
	or croak "Can't find hmtx table of the font $fontname";
	$kern = $font->{kern}||$p_font->{kern} # kerning table (optional)
	and $kern->read;
	$head->read;
	$name->read;
	$hhea->read;
	$cmap->read;
	$hmtx->read;
	$loca->read;
	my $scale = 1024 / $head->{unitsPerEm};   # 1024(Twips/Em) / S(units/Em) = Scale(twips/unit)
	$tag->FontAscent($hhea->{Ascender} * $scale);
	$tag->FontDescent(-$hhea->{Descender} * $scale);
	$tag->FontLeading($hhea->{LineGap} * $scale);  # ?
	$self->{_scale}  = $scale/20; # pixels/unit
	$self->{_average_width} = defined($os2) ? $os2->{xAvgCharWidth}*$scale : 512;
	$ttft->{_cmap}   = ($cmap->find_ms or croak "Can't find unicode cmap table in the font $fontname")->{val}; # Unicode cmap
	$ttft->{_advance}= $hmtx->{advance};
	$ttft->{_loca} = $loca; 
	eval {
	    for my $kt (@{$kern->{tables}}) {
		if ($kt->{coverage} & 1) {
		    $self->{_ttf_tables}{_kern} = $kt->{kern}; # horizontal kerning
		    last;
		}
	    }
	};
    }
    unless ($fontname) {
	($fontname) = ($name->find_name(1)=~/(.+)/);  # Cleaning up is needed. But why?
	($fontname) = ($fontfile =~ /.*\/([^\\\/.]+)/) unless $fontname;
    }
    utf2bin($fontname);
    $tag->FontName($fontname);
    $type = $head->{macStyle};
    $tag->FontFlagsBold(1) if ($type & 1);
    $tag->FontFlagsItalic(1) if ($type & 2);

    $self;
}

sub get_fontnames {
    my ($self, $ttc) = @_;

    my $font = Font::TTF::Ttc->open($ttc)