1#!/usr/bin/perl
2
3use Font::TTF::Font;
4use Font::TTF::Head;
5use Font::TTF::Hmtx;
6use Font::TTF::Cmap;
7use Font::TTF::Maxp;
8use Font::TTF::PSNames;
9use Font::TTF::Post;
10
11use strict;
12
13sub parse_ttf_file($) {
14    my($filename) = @_;
15
16    my $fontdata = {
17	widths => {},
18	kern => {}
19    };
20
21    my $f = Font::TTF::Font->open($filename);
22
23    return undef if (!defined($f));
24
25    $fontdata->{file} = $filename;
26    $fontdata->{type} = defined($f->{' CFF'}) ? 'otf' : 'ttf';
27
28    $f->{head}->read();
29    $fontdata->{scale} = $f->{head}{unitsPerEm};
30
31    $f->{maxp}->read();
32    my $glyphs = $f->{maxp}{numGlyphs};
33
34    $f->{cmap}->read();
35    $f->{hmtx}->read();
36    $f->{name}->read();
37    $fontdata->{name} = $f->{name}->find_name(6); # PostScript name
38    $f->{post}->read();
39    my $psglyphs = 0;
40    my $psmap = $f->{post}->{VAL};
41    $psmap = [] if (!defined($psmap));
42    #printf "Glyphs with PostScript names: %d\n", scalar(@$psmap);
43
44    # Can be done as an array of arrays in case of multiple unicodes to
45    # one glyph...
46    my @unimap = $f->{cmap}->reverse();
47
48    for (my $i = 0; $i < $glyphs; $i++) {
49	my $width = $f->{hmtx}->{advance}[$i];
50	my $psname = $psmap->[$i];
51	if (!defined($psname)) {
52	    $psname = Font::TTF::PSNames::lookup($unimap[$i]);
53	}
54	next if (!defined($psname) || ($psname eq '.notdef'));
55	$fontdata->{widths}{$psname} = $f->{hmtx}->{advance}[$i];
56    }
57
58    $f->release;
59
60    return $fontdata;
61}
62
631;
64