diff options
author | Chris Severance | 2017-07-13 03:10:42 -0400 |
---|---|---|
committer | Chris Severance | 2017-07-13 03:10:42 -0400 |
commit | 70810e0ce24d4509a6721138c9069b8bbf3f4f89 (patch) | |
tree | 3793f03db3b57119e5e0ba72a5e3239de575611f /FONTVER.pl | |
parent | 2faaa3d133c7aa534138159abb4de9ea0ce48e9c (diff) | |
download | aur-ttf-ms-win8.tar.gz |
Update to new adaptable PKGBUILD
Diffstat (limited to 'FONTVER.pl')
-rwxr-xr-x | FONTVER.pl | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/FONTVER.pl b/FONTVER.pl new file mode 100755 index 000000000000..36a91d14225e --- /dev/null +++ b/FONTVER.pl @@ -0,0 +1,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); |