# PDFJ::TTF - TrueType font support
# 2002-4 Sey <nakajima@netstock.co.jp>

package PDFJ::TTF;
use PDFJ::Unicode;
use Carp;
use strict;
use vars qw(@ISA);
@ISA = qw(PDFJ::TTfile);

sub new {
	my($class, $fontfile, $offset) = @_;
	$offset ||= 0;
	my $self = bless {fontfile => $fontfile, offset => $offset}, $class;
	$self->read_tabledirs;
	$self;
}

#-------------------------------------------------
# information for PDF
#-------------------------------------------------
sub pdf_info_common {
	my($self) = @_;
	my %info;
	$info{EmbedFlag} = $self->{table}{'OS/2'}{fsType};
	$info{BaseFont} = $self->find_name(1,0,6);
	$info{Ascent} = $self->toglyphunit(
		$self->{table}{'OS/2'}{sTypoAscender} ||
		$self->{table}{hhea}{ascent});
	$info{CapHeight} = $self->toglyphunit($self->{table}{'OS/2'}{sCapHeight}) ||
		$info{Ascent}; # OK?
	$info{Descent} = $self->toglyphunit(
		$self->{table}{'OS/2'}{sTypoDescender} ||
		$self->{table}{hhea}{descent});
	$info{Flags} = 
		($self->{table}{post}{isFixedPitch} ? 1 : 0) |
		($self->{table}{post}{italicAngle} ? 1 << 6 : 0);
	$info{FontBBox} = [$self->toglyphunit(
		@{$self->{table}{head}}{qw(xMin yMin xMax yMax)})];
	$info{FontName} = $info{BaseFont};
	$info{ItalicAngle} = $self->{table}{post}{italicAngle};
	\%info;
}

sub pdf_info_cid {
	my($self, $encoding) = @_;
	my $info = $self->pdf_info_common;
	$info->{Encoding} = $encoding;
	$info->{Flags} |= (1 << 2); # Symbolic
if(0) {
	my $upm = $self->{table}{head}{unitsPerEm};
	my @width = @{$self->{table}{hmtx}{hMetrics}{advanceWidth}};
	my $glphs = $self->{table}{maxp}{numGlyphs};
	while( $glphs > @width ) {
		push @width, $width[$#width];
	}
}
	$info;
}

sub pdf_info_ascii {
	my($self, $encoding) = @_;
	my $info = $self->pdf_info_common;
	$encoding ||= 'mac';
	if( $encoding =~ /^win/i ) {
		$encoding = 'WinAnsiEncoding';
	} elsif( $encoding =~ /^mac/i ) {
		$encoding = 'MacRomanEncoding';
	} else {
		croak "unknown encoding '$encoding'";
	}
	$info->{Encoding} = $encoding;
	$info->{Flags} |= (1 << 5); # Non Symbolic
	$info->{FirstChar} = 0;
	$info->{LastChar} = 255;
	my @gidxs;
	if( $encoding eq 'MacRomanEncoding' ) {
		my $cmap = $self->find_cmap(1,0,0);
		croak "missing cmap for MacRomanEncoding" unless $cmap;
		my $gidx = $cmap->{glyphIndexArray};
		@gidxs = map {$gidx->[$_]} (0..255);
	} else { # WinAnsiEncoding
		@gidxs = $self->unicode2gidx(map {_EncWin2Uni($_)} (0..255));
	}
	my @width = @{$self->{table}{hmtx}{hMetrics}{advanceWidth}};
	my $glphs = $self->{table}{maxp}{numGlyphs};
	while( $glphs > @width ) {
		push @width, $width[$#width];
	}
	$info->{Widths} = [$self->toglyphunit(map {$width[$_]} @gidxs)];
	$info;
}

sub toglyphunit {
	my($self, @values) = @_;
	my $upm = $self->{table}{head}{unitsPerEm} || 0;
	grep {$_ = int(($_ || 0) * 1000 / $upm + 0.5)} @values;
	wantarray ? @values : $values[0];
}

#-------------------------------------------------
# make subset for PDF
#-------------------------------------------------
sub subset {
	my($self, $encoding, @unicodes) = @_; 
		# @unicodes must be uniqed
	my $result;
	my @gidxs = (0, $self->unicode2gidx(@unicodes)); 
		# 0 for missing glyph required
	if( $encoding =~ /-V$/ ) {
		my $vgidsubst = $self->vgidsubst;
		grep {$_ = $vgidsubst->{$_} if $vgidsubst->{$_}} @gidxs
			if $vgidsubst;
	}
	my %gidxs;
	@gidxs{@gidxs} = 1 x @gidxs;
	$self->{subset_gidxs} = \%gidxs;
	#my @tags = @{$self->{tags}};
	my @tags = grep {exists $self->{tabledir}{$_}}
		('head','hhea','loca','maxp','cvt ','prep','glyf','hmtx','fpgm');
	my %tabledata;
	for my $tag(sort @tags) {
		my $mname = "subset_$tag";
		$mname =~ s#/#_#g;
		$mname =~ s# #_#g;
		my $func = $self->can($mname);
		my $data = $func ? $self->$func() : $self->whole_table($tag);
		my $length = length($data);
		$data .= "\x00" x ((4 - $length % 4) % 4);
		$tabledata{$tag} = {
			data => $data,
			length => $length,
			checksum => PDFJ::TTutil::_checksum($data),
		};
	}
	# subtable
	my $tables = @tags;
	my($range, $sel);
	for( my $tmp = 1, my $j = 0; $tmp <= $tables; $tmp *= 2, $j++ ) {
		$range = $tmp;
		$sel = $j;
	}
	$range *= 16;
	$result = pack "Nnnnn", 
		$self->{subtable}{scaler_type}, 
		$tables,
		$range,
		$sel,
		($tables * 16 - $range);
	# tabledir
	for my $tag(sort @tags) {
		$tabledata{$tag}{diroff} = length($result) + 8;
		$result .= pack "A4NNN",
			$tag,
			$tabledata{$tag}{checksum},
			0, # set offset later
			$tabledata{$tag}{length};
	}
	# tables
	for my $tag(@tags) {
		$tabledata{$tag}{offset} = length $result;
		substr($result, $tabledata{$tag}{diroff}, 4) = 
			pack "N", $tabledata{$tag}{offset};
		$result .= $tabledata{$tag}{data};
	}
	# checkSumAdjustment
	my $csa = 0xb1b0afba - PDFJ::TTutil::_checksum($result);
	$csa += 4294967296 if $csa < 0;
	substr($result, $tabledata{head}{offset} + 8, 4) = pack "N", $csa;
	# make CIDToGIDMap
	my @cids = (0, map {PDFJ::Unicode::unicodetocid($_, $encoding)} @unicodes);
		# CID 0 -> GID 0 OK?
	my @c2g;
	#@c2g[@cids] = @gidxs;
	for( my $j = 0; $j < @cids; $j++ ) {
		next if $cids[$j] eq '-';
		$c2g[$cids[$j]] = $gidxs[$j];
	}
	my $cidtogidmap = pack "n*", map {$_ || 0} @c2g;
if(0) {
	# make CIDSet
	my $cidset;
	for my $cid(@cids) {
		vec($cidset, int($cid / 8) + 7 - ($cid % 8), 1) = 1;
	}
	($result, $cidtogidmap, $cidset);
}
	($result, $cidtogidmap);
}

# get vertical mode gid substitution table
sub vgidsubst {
	my($self) = @_;
	return unless exists $self->{tabledir}{mort};
	my %result;
	$self->read_mort;
	my $mort = $self->{table}{mort};
	for my $chain(@{$mort->{chain}}) {
		for my $subtable(@{$chain->{subtable}}) {
			if( $subtable->{coverage} == 0x8004 ) { # vetical and non-contextual
				my $lutable = $subtable->{lookuptable};
				if( $lutable->{format} == 6 ) {
					for my $entry(@{$lutable->{entries}}) {
						$result{$entry->{glyph}} = $entry->{value};
					}
				} elsif( $lutable->{format} == 8 ) {
					my $first = $lutable->{firstGlyph};
					my $count = $lutable->{glyphCount};
					for( my $j = 0; $j < $count; $j++ ) {
						$result{$first + $j} = $lutable->{valueArray}[$j];
					}
				}
			}
		}
	}
	\%result;
}

sub subset_head {
	my($self) = @_;
	my $result = $self->whole_table('head');
	substr($result, 8, 4) = pack "N", 0; # checkSumAdjustment = 0
	$result;
}

sub subset_glyf {
	my($self) = @_;
	my $result = "";
	my $islong = $self->{table}{head}{indexToLocFormat};
	my $size = $islong ? 4 : 2;
	my $mag = $islong ? 1 : 2;
	my $template = $islong ? "NN" : "nn";
	my $loca_offset = $self->{tabledir}{loca}{offset};
	my(@off, @len, %len);
	for my $gidx(sort {$a <=> $b} keys %{$self->{subset_gidxs}}) {
		my($off, $next) = unpack $template, 
			$self->_seek_read($loca_offset + $size * $gidx, $size * 2);
		push @off, $off * $mag;
		my $len = ($next - $off) * $mag;
		push @len, $len;
		$len{$gidx} = $len;
	}
	$self->{subset_glyf_lengths} = \%len;
	my $glyf_offset = $self->{tabledir}{glyf}{offset} || 0;
	for( my $j = 0; $j < @off; $j++ ) {
		$result .= $self->_seek_read($glyf_offset + $off[$j], $len[$j]);
	}
	$result;
}

sub subset_loca {
	my($self) = @_;
	my $result;
	my $lengths = $self->{subset_glyf_lengths} 
		or croak "missing subset_glyf_lengths";
	my $glphs = $self->{table}{maxp}{numGlyphs};
	my $islong = $self->{table}{head}{indexToLocFormat};
	my $template = $islong ? "N" : "n";
	my $loca_offset = $self->{tabledir}{loca}{offset};
	my $last = 0;
	for( my $j = 0; $j < $glphs; $j++ ) {
		$result .= pack $template, $last;
		$last += $lengths->{$j} if $lengths->{$j};
	}
	$result .= pack $template, $last;
	$result;
}

sub Xsubset_loca {
	my($self) = @_;
	my $result;
	my $lengths = $self->{subset_glyf_lengths} 
		or croak "missing subset_glyf_lengths";
	my $islong = $self->{table}{head}{indexToLocFormat};
	my $mag = $islong ? 1 : 2;
	my $template = $islong ? "N" : "n";
	my $off = 0;
	for my $len(@$lengths) {
		$result .= pack $template, ($off / $mag);
		$off += $len;
	}
	$result .= pack $template, ($off / $mag);
	$result;
}

sub Xsubset_hmtx {
	my($self) = @_;
	my $result;
	my @width = @{$self->{table}{hmtx}{hMetrics}{advanceWidth}};
	my $glphs = $self->{table}{maxp}{numGlyphs};
	while( $glphs > @width ) {
		push @width, $width[$#width];
	}
	my @lsb = @{$self->{table}{hmtx}{hMetrics}{leftSideBearing}};
	push @lsb, @{$self->{table}{hmtx}{leftSideBearing}} 
		if $self->{table}{hmtx}{leftSideBearing};
	PDFJ::TTutil::_short2unsigned(\@lsb);
	#for my $gidx(@{$self->{subset_gidxs}}) {
	for my $gidx(sort {$a <=> $b} keys %{$self->{subset_gidxs}}) {
		$result .= pack "nn", $width[$gidx], $lsb[$gidx];
	}
	$result;
}

sub whole_table {
	my($self, $tag) = @_;
	return unless exists $self->{tabledir}{$tag};
	$self->seek_table($tag);
	$self->_read($self->table_length($tag));
}

#------------------------------------------------
# read TTF file tables
#------------------------------------------------

sub read_tabledirs {
	my($self) = @_;
	$self->seek($self->{offset});
	$self->_read_hash($self->{subtable}, qw(
		scaler_type:N
		numTables:n
		searchRange:n
		entrySelector:n
		rangeShift:n
		));
	my $type = $self->{subtable}{scaler_type};
	croak "unknown type: $type(0x".sprintf("%x",$type).")"
		unless $type == 0x10000 || $type == 0x74727565 || # 1.0 or 'true';
			$type == 0x4f54544f; # 'OTTO' for OpenType font
	my $tables = $self->{subtable}{numTables};
	my $rby16;
	for( my $r = 1; $r <= $tables; $r *= 2 ) {
		$rby16 = $r;
	}
	croak "illegal searchRange" 
		unless $rby16 * 16 == $self->{subtable}{searchRange};
	my @tags;
	while( $tables-- ) {
		my $tag = $self->_read(4);
		$self->_read_hash($self->{tabledir}{$tag}, qw(
			checksum:N 
			offset:N 
			length:N
			));
		push @tags, $tag;
	}
	$self->{tags} = \@tags;
}

sub reload {
	my($self, $flag) = @_;
	$self->{reload} = $flag if defined $flag;
	$self->{reload};
}

sub table_length {
	my($self, $tag) = @_;
	$self->{tabledir}{$tag}{length};
}

sub checksum_table {
	my($self, $tag) = @_;
	my $length = $self->table_length($tag);
	$self->seek_table($tag);
	my $sum = 0;
	for( my $pos = 0; $pos < $length; $pos += 4 ) {
		$sum += unpack "N", $self->_read(4);
	}
	$sum &= 0xffffffff;
	$sum;
}

sub read_table {
	my($self, @tags) = @_;
	if( $tags[0] eq ':all' ) {
		@tags = keys %{$self->{tabledir}};
	}
	for my $tag(@tags) {
		my $mname = "read_$tag";
		$mname =~ s/\s+$//;
		$mname =~ s#/#_#g;
		my $func = $self->can($mname);
		$self->$func() if $func;
	}
}

sub read_head {
	my($self) = @_;
	my $tag = 'head';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:N
		fontRevision:N
		checkSumAdjustment:N
		magicNumber:N
		flags:n
		unitsPerEm:n
		createdH:N
		createdL:N
		modifiedH:N
		modifiedL:N
		xMin:m
		yMin:m
		xMax:m
		yMax:m
		macStyle:n
		lowestRecPPEM:n
		fontDirectionHint:m
		indexToLocFormat:m
		glyphDataFormat:m
		));
}

sub read_hhea {
	my($self) = @_;
	my $tag = 'hhea';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:N
		ascent:m
		descent:m
		lineGap:m
		advanceWidthMax:n
		minLeftSideBearing:m
		minRightSideBearing:m
		xMaxExtent:m
		caretSlopeRise:m
		caretSlopeRun:m
		caretOffset:m
		reserved:n
		reserved:n
		reserved:n
		reserved:n
		metricDataFormat:n
		numOfLongHorMetrics:n
		));
}

sub read_name {
	my($self) = @_;
	my $tag = 'name';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		format:n
		count:n
		stringOffset:n
		));
	my $count = $self->{table}{$tag}{count};
	while( $count-- ) {
		my %rec;
		$self->_read_hash(\%rec, qw(
			platformID:n
			platformSpecificID:n
			languageID:n
			nameID:n
			length:n
			offset:n
			));
		push @{$self->{table}{$tag}{nameRecord}}, \%rec;
	}
	for my $rec(@{$self->{table}{$tag}{nameRecord}}) {
		$self->seek($self->{tabledir}{$tag}{offset} + 
			$self->{table}{$tag}{stringOffset} + 
			$rec->{offset});
		$rec->{name} = $self->_read($rec->{length});
	}
}

sub find_name {
	my($self, $pid, $psid, $nameid) = @_;
	for my $rec(@{$self->{table}{name}{nameRecord}}) {
		if( $rec->{platformID} == $pid && 
			$rec->{platformSpecificID} == $psid &&
			$rec->{nameID} == $nameid ) {
			return $rec->{name};
		}
	}
	return;
}

sub read_post {
	my($self) = @_;
	my $tag = 'post';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		format:N
		italicAngle:N
		underlinePosition:m
		underlineThickness:m
		isFixedPitch:N
		minMemType42:N
		maxMemType42:N
		minMemType1:N
		maxMemType1:N
		));
}

sub read_maxp {
	my($self) = @_;
	my $tag = 'maxp';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:N
		numGlyphs:n
		maxPoints:n
		maxContours:n
		maxComponentPoints:n
		maxComponentContours:n
		maxZones:n
		maxTwilightPoints:n
		maxStorage:n
		maxFunctionDefs:n
		maxInstructionDefs:n
		maxStackElements:n
		maxSizeOfInstructions:n
		maxComponentElements:n
		maxComponentDepth:n
		));
}

sub read_loca {
	my($self) = @_;
	my $tag = 'loca';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->read_head unless exists $self->{table}{head};
	$self->read_maxp unless exists $self->{table}{maxp};
	$self->seek_table($tag);
	my $glphs = $self->{table}{maxp}{numGlyphs};
	my $offsets = $glphs + 1;
	my $template = $self->{table}{head}{indexToLocFormat} ? 'N' : 'n';
	$self->_read_hash($self->{table}{$tag}, "offset:$template:$offsets");
}

sub read_hmtx {
	my($self) = @_;
	my $tag = 'hmtx';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->read_hhea unless exists $self->{table}{hhea};
	$self->read_maxp unless exists $self->{table}{maxp};
	croak "'numOfLongHorMetrics' in 'hhea' table required" 
		unless exists $self->{table}{hhea}{numOfLongHorMetrics};
	croak "'numGlyphs' in 'maxp' table required" 
		unless exists $self->{table}{maxp}{numGlyphs};
	my $mtxs = $self->{table}{hhea}{numOfLongHorMetrics};
	my $glphs = $self->{table}{maxp}{numGlyphs};
	my $lsbs = $glphs - $mtxs;
	$self->seek_table($tag);
	my %data;
	while( $mtxs-- ) {
		my($width, $lsb) = unpack "nn", $self->_read(4);
		$lsb = PDFJ::TTutil::_short2signed($lsb);
		push @{$data{hMetrics}{advanceWidth}}, $width;
		push @{$data{hMetrics}{leftSideBearing}}, $lsb;
	}
	$self->_read_hash(\%data, "leftSideBearing:m:$lsbs") if $lsbs;
	$self->{table}{$tag} = \%data;
}

sub read_cmap {
	my($self) = @_;
	my $tag = 'cmap';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:n
		numberSubtables:n
		));
	my $count = $self->{table}{$tag}{numberSubtables};
	while( $count-- ) {
		my %st;
		$self->_read_hash(\%st, qw(
			platformID:n
			platformSpecificID:n
			offset:N
			));
		push @{$self->{table}{$tag}{subtable}}, \%st;
	}
	for my $st(@{$self->{table}{$tag}{subtable}}) {
		$self->seek($self->{tabledir}{$tag}{offset} + $st->{offset});
		$self->_read_hash($st, qw(
			format:n
			length:n
			language:n
			));
		if( $st->{format} == 0 ) {
			$self->_read_hash($st, "glyphIndexArray:C:256");
		} elsif( $st->{format} == 4 ) {
			$self->_read_hash($st, qw(
				segCountX2:n
				searchRange:n
				entrySelector:n
				rangeShift:n
				));
			my $segcount = $st->{segCountX2} / 2;
			$self->_read_hash($st, 
				"endCode:n:$segcount",
				"reservedPad:n",
				"startCode:n:$segcount",
				"idDelta:n:$segcount",
				);
			$st->{idRangeOffset_at} = $self->tell;
			$self->_read_hash($st, 
				"idRangeOffset:n:$segcount",
				);
		}
	}
}

# get only Non-contextual Glyph Substitution Subtable
sub read_mort {
	my($self) = @_;
	my $tag = 'mort';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:N
		nChains:N
		));
	my $count = $self->{table}{$tag}{nChains};
	my $chainoffset = $self->{tabledir}{$tag}{offset} + 8;
	while( $count-- ) {
		if( $chainoffset % 4 ) {
			$chainoffset = (int($chainoffset / 4) + 1) * 4;
		}
		$self->seek($chainoffset);
		my %chain;
		$self->_read_hash(\%chain, qw(
			defaultFlags:N
			chainLength:N
			nFeatureEntries:n
			nSubtables:n
			));
		for( my $j = 0; $j < $chain{nFeatureEntries}; $j++ ) {
			$self->_read_hash($chain{featuretable}[$j], qw(
				featureType:n
				featureSetting:n
				enableFlags:N
				disableFlags:N
				));
		}
		for( my $j = 0; $j < $chain{nSubtables}; $j++ ) {
			$self->_read_hash($chain{subtable}[$j], qw(
				length:n
				coverage:n
				subFeatureFlags:N
				));
			my $type = $chain{subtable}[$j]{coverage} & 7;
			if( $type == 4 ) { # Non-contextual glyph substitution
				$chain{subtable}[$j]{lookuptable} = 
					$self->_read_LookupTable('n');
			}
		}
		push @{$self->{table}{$tag}{chain}}, \%chain;
		$chainoffset += $chain{chainLength} + 8;
	}
}

sub _read_LookupTable {
	my($self, $valuetype, $lu) = @_;
	$lu ||= {};
	$self->_read_hash($lu, qw(format:n));
	if( $lu->{format} == 0 ) { # simple array format
	
	} elsif( $lu->{format} == 2 ) { # segment single format
		$self->_read_BinSrchHeader($lu);
		for( my $j = 0; $j < $lu->{nUnits}; $j++ ) {
			push @{$lu->{segments}}, 
				$self->_read_hash({}, 
				"lastGlyph:n", "firstGlyph:n", "value:$valuetype");
		}
	} elsif( $lu->{format} == 4 ) { # segment array format
		$self->_read_BinSrchHeader($lu);
		my $vlen = $self->_typelen($valuetype);
		my $vcount = int(($lu->{unitSize} - 4) / $vlen);
		for( my $j = 0; $j < $lu->{nUnits}; $j++ ) {
			push @{$lu->{segments}}, 
				$self->_read_hash({}, 
				"lastGlyph:n", "firstGlyph:n", "value:$valuetype:$vcount");
		}
	} elsif( $lu->{format} == 6 ) { # single table format
		$self->_read_BinSrchHeader($lu);
		for( my $j = 0; $j < $lu->{nUnits}; $j++ ) {
			push @{$lu->{entries}}, 
				$self->_read_hash({}, "glyph:n", "value:$valuetype");
		}
	} elsif( $lu->{format} == 8 ) { # trimmed array format
		$self->_read_hash($lu, qw(
			firstGlyph:n
			glyphCount:n
			));
		my $count = $lu->{glyphCount};
		$self->_read_hash($lu, "valueArray:$valuetype:$count");
	}
	$lu;
}

sub _read_BinSrchHeader {
	my($self, $bsh) = @_;
	$bsh ||= {};
	$self->_read_hash($bsh, qw(
		unitSize:n
		nUnits:n
		searchRange:n
		entrySelector:n
		rangeShift:n
		));
	$bsh;
}

sub find_cmap {
	my($self, $pid, $psid, $format) = @_;
	for my $st(@{$self->{table}{cmap}{subtable}}) {
		if( $st->{platformID} == $pid &&
			$st->{platformSpecificID} == $psid &&
			$st->{format} == $format ) {
			return $st;
		}
	}
	return;
}

sub unicode2gidx {
	my($self, @codes) = @_;
	unless( $self->{cmap314_count} ) {
		my $cmap = $self->find_cmap(3,1,4);
		croak "missing cmap for Unicode" unless $cmap;
		$self->{cmap314_count} = $cmap->{segCountX2} / 2;
		$self->{cmap314_start} = $cmap->{startCode};
		$self->{cmap314_end} = $cmap->{endCode};
		$self->{cmap314_offset} = $cmap->{idRangeOffset};
		$self->{cmap314_delta} = $cmap->{idDelta};
		$self->{cmap314_offset_at} = $cmap->{idRangeOffset_at};
	}
	my($count, $start, $end, $offset, $delta, $offset_at) = @$self{qw(
		cmap314_count
		cmap314_start
		cmap314_end
		cmap314_offset
		cmap314_delta
		cmap314_offset_at
		)};
	my @result;
	for my $code(@codes) {
		my $seg = -1;
		for( my $j = 0; $j < $count; $j++ ) {
			next if $end->[$j] < $code;
			$seg = $j if $code >= $start->[$j];
			last;
		}
		if( $seg == -1 ) {
			push @result, 0;
			next;
		}
		if( $offset->[$seg] ) {
			$self->seek($offset_at + $seg * 2 + $offset->[$seg] + 
				($code - $start->[$seg]) * 2);
			my($idx) = unpack "n", $self->_read(2);
			$idx = ($idx + $delta->[$seg]) % 65536 if $idx == 0;
			push @result, $idx;
		} else {
			push @result, ($code + $delta->[$seg]) % 65536;
		}
	}
	wantarray ? @result : $result[0];
}

sub read_OS_2 {
	my($self) = @_;
	my $tag = 'OS/2';
	return if exists $self->{table}{$tag} && !$self->reload;
	$self->seek_table($tag);
	$self->_read_hash($self->{table}{$tag}, qw(
		version:n
		xAvgCharWidth:m
		usWeightClass:n
		usWidthClass:n
		fsType:m
		ySubscriptXSize:m
		ySubscriptYSize:m
		ySubscriptXOffset:m
		ySubscriptYOffset:m
		ySuperscriptXSize:m
		ySuperscriptYSize:m
		ySuperscriptXOffset:m
		ySuperscriptYOffset:m
		yStrikeoutSize:m
		yStrikeoutPosition:m
		sFamilyClass:m
		panose:C:10
		ulCharRange:N:4
		hVendID:C:4
		fsSelection:n
		fsFirstCharIndex:n
		fsLastCharIndex:n
		sTypoAscender:m
		sTypoDescender:m
		sTypoLineGap:m
		usWinAscent:n
		usWinDescent:n
		ulCodePageRange:N:2
		sxHeight:m
		sCapHeight:m
		usDefaultChar:n
		usBreakChar:n
		usMaxContext:n
		), $self->{tabledir}{$tag}{length});
}

sub seek_table {
	my($self, $tag) = @_;
	croak "missing '$tag' table" unless $self->{tabledir}{$tag};
	$self->seek($self->{tabledir}{$tag}{offset});
}

sub dump {
	my($self, $handle, $verbose) = @_;
	$handle ||= \*STDOUT;
	print $handle $self->{fontfile},"\n";
	if( $verbose ) {
		for my $key(keys %{$self->{subtable}}) {
			print $handle "subtable:$key => $self->{subtable}{$key}\n";
		}
		for my $tag(@{$self->{tags}}) {
			my $dir = $self->{tabledir}{$tag};
			print $handle "tabledir($tag):@$dir{qw(checksum offset length)}\n";
		}
	}
	for my $tag(keys %{$self->{table}}) {
		my $fname = "dump_$tag";
		$fname =~ s/\s+$//;
		if( $self->can($fname) ) {
			$self->$fname($handle);
		} else {
			print $handle "\ntable($tag)";
			PDFJ::TTutil::_dump($handle, "", $self->{table}{$tag});
		}
	}
	print $handle "\n";
}

my @EncWin2Uni;
sub _EncWin2Uni {
	my($code) = @_;
	unless( @EncWin2Uni ) {
		while(<DATA>) {
			chomp;
			next if /^#/;
			my(undef, undef, undef, $win, undef, $uni) = split /,/;
			$win += 0;
			$uni = hex($uni);
			$EncWin2Uni[$win] = $uni if $win;
		}
	}
	$EncWin2Uni[$code];
}

#------------------------------------------------
package PDFJ::TTC;
use Carp;
use strict;
use vars qw(@ISA);
@ISA = qw(PDFJ::TTfile);

sub new {
	my($class, $fontfile) = @_;
	my $self = bless {fontfile => $fontfile}, $class;
	$self->read_header;
	$self;
}

sub read_header {
	my($self) = @_;
	$self->seek(0);
	my $tag = $self->_read(4);
	croak "NOT TTC file: $self->{fontfile}" unless $tag eq 'ttcf';
	my $version = unpack "N", $self->_read(4);
	my $fonts = unpack "N", $self->_read(4);
	$self->{fonts} = $fonts;
	$self->_read_hash($self, "diroff:N:$fonts");
}

sub fonts { $_[0]->{fonts} }

sub select {
	my($self, $num) = @_;
	croak "TTC font number out of range" if $num < 0 || $num >= $self->{fonts};
	unless( $self->{font}[$num] ) {
		$self->{font}[$num] = 
			PDFJ::TTF->new($self->{fontfile}, $self->{diroff}[$num]);
	}
	$self->{font}[$num];
}

#------------------------------------------------
package PDFJ::TTfile;
use FileHandle;
use Carp;

sub DESTROY {
	my($self) = @_;
	$self->close;
}

sub open {
	my($self) = @_;
	unless( $self->{handle} ) {
		my $fontfile = $self->{fontfile};
		$self->{handle} = new FileHandle $fontfile
			or croak "cannot open $fontfile";
		binmode $self->{handle};
	}
	$self->{handle};
}

sub close {
	my($self) = @_;
	if( $self->{handle} ) {
		close $self->{handle};
		$self->{handle} = undef;
	}
}

sub seek {
	my($self, $offset) = @_;
	my $handle = $self->open;
	seek $handle, $offset, 0;
}

sub tell {
	my($self) = @_;
	my $handle = $self->open;
	tell $handle;
}

sub _read {
	my($self, $length) = @_;
	return "" unless $length;
	my $handle = $self->open;
	my $buf = "";
	read $handle, $buf, $length or croak "read error";
	$buf;
}

sub _seek_read {
	my($self, $offset, $length) = @_;
	$self->seek($offset);
	$self->_read($length);
}


sub _typelen {
	my($self, $type) = @_;
	{C => 1, n => 2, m => 2, N => 4, M => 4}->{$type};
}

sub _read_hash {
	$_[1] = {} unless defined $_[1];
	my($self, $hashref, @specs) = @_;
	my($maxlen);
	if( $specs[$#specs] =~ /^\d+$/ ) {
		$maxlen = pop @specs;
	}
	my $handle = $self->open;
	my($length, @keys, %count, @shortsignedkeys, @longsignedkeys, $template, 
		$buf);
	for my $spec(@specs) {
		my($key, $type, $count) = split /:/, $spec;
		$count ||= "";
		my $typelen = $self->_typelen($type);
		push @keys, $key;
		$count{$key} = $count;
		if( $type eq 'C' ) {
			$template .= "C$count";
		} elsif( $type eq 'n' || $type eq 'm' ) {
			$template .= "n$count";
		} elsif( $type eq 'N' || $type eq 'M' ) {
			$template .= "N$count";
		} else {
			croak "unknown type '$type'";
		}
		$length += $count ? $typelen * $count : $typelen;
		push @shortsignedkeys, $key if $type eq 'm';
		push @longsignedkeys, $key if $type eq 'M';
		last if $maxlen && $length >= $maxlen;
	}
	read $handle, $buf, $length or croak "read error";
	my @data = unpack $template, $buf;
	my $j = 0;
	for my $key(@keys) {
		if( $count{$key} ) {
			$hashref->{$key} = [@data[$j .. $j + $count{$key} - 1]];
			$j += $count{$key};
		} else {
			$hashref->{$key} = $data[$j++];
		}
	}
	for my $key(@shortsignedkeys) {
		$hashref->{$key} = PDFJ::TTutil::_short2signed($hashref->{$key});
	}
	for my $key(@longsignedkeys) {
		$hashref->{$key} = PDFJ::TTutil::_long2signed($hashref->{$key});
	}
	$hashref;
}

sub _read_array {
	my($self, $type, $count) = @_;
	my $handle = $self->open;
	my($length, $buf);
	if( $type eq 'C' ) {
		$length = 1;
	} elsif( $type eq 'n' ) {
		$length = 2;
	} elsif( $type eq 'N' ) {
		$length = 4;
	} else {
		croak "unknown type '$type'";
	}
	$length *= $count;
	read $handle, $buf, $length or croak "read error";
	unpack "$type$count", $buf;
}

#------------------------------------------------
package PDFJ::TTutil;

sub _dump {
	my($handle, $indent, $data) = @_;
	if( ref($data) eq 'HASH' ) {
		for my $key(keys %$data) {
			print $handle "\n$indent  $key => ";
			_dump($handle, "$indent  ", $data->{$key});
		}
	} elsif( ref($data) eq 'ARRAY' ) {
		if( ref($data->[0]) ) {
			for( my $j = 0; $j < @$data; $j++ ) {
				print $handle "\n$indent  [$j] ";
				_dump($handle, "$indent  ", $data->[$j]);
			}
		} else {
			print $handle "[", join(',', @$data), "]";
		}
	} else {
		print $handle $data;
	}
}

sub _checksum {
	my($data) = @_;
	my $result = 0;
	for my $value(unpack "N*", $data) {
		$result += $value;
	}
	$result &= 0xffffffff;
	$result;
}

sub _short2signed {
	my($value) = @_;
	if( ref($value) eq 'ARRAY' ) {
		grep {$_ = unpack("s", pack("S", $_))} @$value;
		$value;
	} else {
		unpack("s", pack("S", $value));
	}
}

sub _short2unsigned {
	my($value) = @_;
	if( ref($value) eq 'ARRAY' ) {
		grep {$_ = unpack("S", pack("s", $_))} @$value;
		$value;
	} else {
		unpack("S", pack("s", $value));
	}
}

sub _long2signed {
	my($value) = @_;
	if( ref($value) eq 'ARRAY' ) {
		grep {$_ = unpack("l", pack("L", $_))} @$value;
		$value;
	} else {
		unpack("l", pack("L", $value));
	}
}

#------------------------------------------------
package PDFJ::TTF;  # for __DATA__

1;

__DATA__
# PDF predefined encoding table and Unicode 
# from 'PDF Reference Manual 1.3' and 'Adobe Glyph List 1.2'
# Unicode is hex, others are decimal
# name,Standard,MacRoman,WinAnsi,PDFDoc,Unicode
A,65,65,65,65,0041
AE,225,174,198,198,00C6
Aacute,*,231,193,193,00C1
Acircumflex,*,229,194,194,00C2
Adieresis,*,128,196,196,00C4
Agrave,*,203,192,192,00C0
Aring,*,129,197,197,00C5
Atilde,*,204,195,195,00C3
B,66,66,66,66,0042
C,67,67,67,67,0043
Ccedilla,*,130,199,199,00C7
D,68,68,68,68,0044
E,69,69,69,69,0045
Eacute,*,131,201,201,00C9
Ecircumflex,*,230,202,202,00CA
Edieresis,*,232,203,203,00CB
Egrave,*,233,200,200,00C8
Eth,*,*,208,208,00D0
Euro,*,*,128,160,20AC
F,70,70,70,70,0046
G,71,71,71,71,0047
H,72,72,72,72,0048
I,73,73,73,73,0049
Iacute,*,234,205,205,00CD
Icircumflex,*,235,206,206,00CE
Idieresis,*,236,207,207,00CF
Igrave,*,237,204,204,00CC
J,74,74,74,74,004A
K,75,75,75,75,004B
L,76,76,76,76,004C
Lslash,232,*,*,149,0141
M,77,77,77,77,004D
N,78,78,78,78,004E
Ntilde,*,132,209,209,00D1
O,79,79,79,79,004F
OE,234,206,140,150,0152
Oacute,*,238,211,211,00D3
Ocircumflex,*,239,212,212,00D4
Odieresis,*,133,214,214,00D6
Ograve,*,241,210,210,00D2
Oslash,233,175,216,216,00D8
Otilde,*,205,213,213,00D5
P,80,80,80,80,0050
Q,81,81,81,81,0051
R,82,82,82,82,0052
S,83,83,83,83,0053
Scaron,*,*,138,151,0160
T,84,84,84,84,0054
Thorn,*,*,222,222,00DE
U,85,85,85,85,0055
Uacute,*,242,218,218,00DA
Ucircumflex,*,243,219,219,00DB
Udieresis,*,134,220,220,00DC
Ugrave,*,244,217,217,00D9
V,86,86,86,86,0056
W,87,87,87,87,0057
X,88,88,88,88,0058
Y,89,89,89,89,0059
Yacute,*,*,221,221,00DD
Ydieresis,*,217,159,152,0178
Z,90,90,90,90,005A
Zcaron,*,*,142,153,017D
a,97,97,97,97,0061
aacute,*,135,225,225,00E1
acircumflex,*,137,226,226,00E2
acute,194,171,180,180,00B4
adieresis,*,138,228,228,00E4
ae,241,190,230,230,00E6
agrave,*,136,224,224,00E0
ampersand,38,38,38,38,0026
aring,*,140,229,229,00E5
asciicircum,94,94,94,94,005E
asciitilde,126,126,126,126,007E
asterisk,42,42,42,42,002A
at,64,64,64,64,0040
atilde,*,139,227,227,00E3
b,98,98,98,98,0062
backslash,92,92,92,92,005C
bar,124,124,124,124,007C
braceleft,123,123,123,123,007B
braceright,125,125,125,125,007D
bracketleft,91,91,91,91,005B
bracketright,93,93,93,93,005D
breve,198,249,*,24,02D8
brokenbar,*,*,166,166,00A6
bullet,183,165,149,128,2022
c,99,99,99,99,0063
caron,207,255,*,25,02C7
ccedilla,*,141,231,231,00E7
cedilla,203,252,184,184,00B8
cent,162,162,162,162,00A2
circumflex,195,246,136,26,02C6
colon,58,58,58,58,003A
comma,44,44,44,44,002C
copyright,*,169,169,169,00A9
currency,168,219,164,164,00A4
d,100,100,100,100,0064
dagger,178,160,134,129,2020
daggerdbl,179,224,135,130,2021
degree,*,161,176,176,00B0
dieresis,200,172,168,168,00A8
divide,*,214,247,247,00F7
dollar,36,36,36,36,0024
dotaccent,199,250,*,27,02D9
dotlessi,245,245,*,154,0131
e,101,101,101,101,0065
eacute,*,142,233,233,00E9
ecircumflex,*,144,234,234,00EA
edieresis,*,145,235,235,00EB
egrave,*,143,232,232,00E8
eight,56,56,56,56,0038
ellipsis,188,201,133,131,2026
emdash,208,209,151,132,2014
endash,177,208,150,133,2013
equal,61,61,61,61,003D
eth,*,*,240,240,00F0
exclam,33,33,33,33,0021
exclamdown,161,193,161,161,00A1
f,102,102,102,102,0066
fi,174,222,*,147,FB01
five,53,53,53,53,0035
fl,175,223,*,148,FB02
florin,166,196,131,134,0192
four,52,52,52,52,0034
fraction,164,218,*,135,2215
g,103,103,103,103,0067
germandbls,251,167,223,223,00DF
grave,193,96,96,96,0060
greater,62,62,62,62,003E
guillemotleft,171,199,171,171,00AB
guillemotright,187,200,187,187,00BB
guilsinglleft,172,220,139,136,2039
guilsinglright,173,221,155,137,203A
h,104,104,104,104,0068
hungarumlaut,205,253,*,28,02DD
hyphen,45,45,45,45,00AD
i,105,105,105,105,0069
iacute,*,146,237,237,00ED
icircumflex,*,148,238,238,00EE
idieresis,*,149,239,239,00EF
igrave,*,147,236,236,00EC
j,106,106,106,106,006A
k,107,107,107,107,006B
l,108,108,108,108,006C
less,60,60,60,60,003C
logicalnot,*,194,172,172,00AC
lslash,248,*,*,155,0142
m,109,109,109,109,006D
macron,197,248,175,175,02C9
minus,*,*,*,138,2212
mu,*,181,181,181,03BC
multiply,*,*,215,215,00D7
n,110,110,110,110,006E
nine,57,57,57,57,0039
ntilde,*,150,241,241,00F1
numbersign,35,35,35,35,0023
o,111,111,111,111,006F
oacute,*,151,243,243,00F3
ocircumflex,*,153,244,244,00F4
odieresis,*,154,246,246,00F6
oe,250,207,156,156,0153
ogonek,206,254,*,29,02DB
ograve,*,152,242,242,00F2
one,49,49,49,49,0031
onehalf,*,*,189,189,00BD
onequarter,*,*,188,188,00BC
onesuperior,*,*,185,185,00B9
ordfeminine,227,187,170,170,00AA
ordmasculine,235,188,186,186,00BA
oslash,249,191,248,248,00F8
otilde,*,155,245,245,00F5
p,112,112,112,112,0070
paragraph,182,166,182,182,00B6
parenleft,40,40,40,40,0028
parenright,41,41,41,41,0029
percent,37,37,37,37,0025
period,46,46,46,46,002E
periodcentered,180,225,183,183,2219
perthousand,189,228,137,139,2030
plus,43,43,43,43,002B
plusminus,*,177,177,177,00B1
q,113,113,113,113,0071
question,63,63,63,63,003F
questiondown,191,192,191,191,00BF
quotedbl,34,34,34,34,0022
quotedblbase,185,227,132,140,201E
quotedblleft,170,210,147,141,201C
quotedblright,186,211,148,142,201D
quoteleft,96,212,145,143,2018
quoteright,39,213,146,144,2019
quotesinglbase,184,226,130,145,201A
quotesingle,169,39,39,39,0027
r,114,114,114,114,0072
registered,*,168,174,174,00AE
ring,202,251,176,30,02DA
s,115,115,115,115,0073
scaron,*,*,154,157,0161
section,167,164,167,167,00A7
semicolon,59,59,59,59,003B
seven,55,55,55,55,0037
six,54,54,54,54,0036
slash,47,47,47,47,002F
space,32,32,32,32,0020
space,32,202,160,32,00A0
sterling,163,163,163,163,00A3
t,116,116,116,116,0074
thorn,*,*,254,254,00FE
three,51,51,51,51,0033
threequarters,*,*,190,190,00BE
threesuperior,*,*,179,179,00B3
tilde,196,247,152,31,02DC
trademark,*,170,153,146,2122
two,50,50,50,50,0032
twosuperior,*,*,178,178,00B2
u,117,117,117,117,0075
uacute,*,156,250,250,00FA
ucircumflex,*,158,251,251,00FB
udieresis,*,159,252,252,00FC
ugrave,*,157,249,249,00F9
underscore,95,95,95,95,005F
v,118,118,118,118,0076
w,119,119,119,119,0077
x,120,120,120,120,0078
y,121,121,121,121,0079
yacute,*,*,253,253,00FD
ydieresis,*,216,255,255,00FF
yen,165,180,165,165,00A5
z,122,122,122,122,007A
zcaron,*,*,158,158,017E
zero,48,48,48,48,0030
