doc/ttfmetrics.ph

   1 #!/usr/bin/perl
   2
   3 use Font::TTF::Font;
   4 use Font::TTF::Head;
   5 use Font::TTF::Hmtx;
   6 use Font::TTF::Cmap;
   7 use Font::TTF::Maxp;
   8 use Font::TTF::PSNames;
   9 use Font::TTF::Post;
  10
  11 use strict;
  12
  13 sub 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
  63 1;