1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
#!/usr/bin/perl
# Extract from ttf: Version 0.00 Font Name Bold
# Extract from ttc: Version 0.00 Batang; Batang Bold(0.01)
# This program is slow
use warnings;
#http://www.perlmonks.org/bare/?node_id=224506
use strict;
use Font::TTF::Font;
use Font::TTF::Ttc;
my $rv=1;
if ( $#ARGV >= 0 ) {
my $f = $ARGV[0];
my $ttc = Font::TTF::Ttc->open($f); # hash ref
if (ref $ttc) {
my $firstsp=''; # Version 0.00 or '; '
my $firstvershort=''; # 0.00 or blank if same as first
my $langs='x';
my $ttf;
foreach $ttf (@{$ttc->{directs}}) {
my $fnar;
if ($fnar = $ttf->{name}) {
my $fr=$fnar->read();
my $verlong=$fr->find_name(5);
$firstsp=$verlong.' ' if (length($firstsp)==0);
my $vershort=$verlong;
if ($verlong =~ m/Version ([0-9\.]+)/ ) {
$vershort=$1;
}
$firstvershort=$vershort if (length($firstvershort)==0);
if ($vershort eq $firstvershort) {
$vershort='';
} else {
$vershort='('.$vershort.')'; # Show (version) on each font if different
}
my @neid=$fr->find_name(4);
if (length($langs) != 0) {
$langs='';
my $langsfirst='';
foreach (keys %{$fnar->{'strings'}[5][3][1]}) {
if ($_ != 0x409) {
$langs .= $langsfirst.$fnar->get_lang($neid[1], $_);
$langsfirst=',';
}
}
$langs=$fnar->get_lang($neid[1],0x409) if (length($langs)==0);
$langs .= ' ';
}
print $langs.$firstsp.$neid[0].$vershort;
$firstsp='; ';
$langs='';
$rv=0;
}
}
print "\n" if ($rv eq 0);
$ttc->DESTROY();
} else {
my $ttf = Font::TTF::Font->open($f);
if (ref $ttf) {
my $fnar;
if ($fnar = $ttf->{name}) {
my $fr=$fnar->read();
#for(my $test=0; $test<200; $test++) { my @testar=$fr->find_name($test); print STDERR $test,",",$testar[3],'-',$testar[0],"\n"; }
#foreach ($fr) { print STDERR $_[3],'-',$_[0],"\n"; }
# http://www.microsoft.com/typography/otspec/name.htm Name IDs
my @neid=$fr->find_name(4);
#foreach (keys %{$fnar->{'strings'}[5][3][1]}) { printf STDERR "lang=%04X %s\n",$_,$fnar->get_lang($neid[1], $_); }
my $langs='';
my $langsfirst='';
foreach (keys %{$fnar->{'strings'}[5][3][1]}) {
if ($_ != 0x409) {
$langs .= $langsfirst.$fnar->get_lang($neid[1], $_);
$langsfirst=',';
}
}
$langs=$fnar->get_lang($neid[1],0x409) if (length($langs)==0);
print $langs.' '.$fr->find_name(5)." ".$neid[0],"\n";
$rv=0;
}
$ttf->release();
}
}
} else {
print "Usage: $0 foo.tt[fc]\n";
print "Result: Version 1.05 Foo Narrow Bold Italic FB ITC\n";
}
exit($rv);
|