summarylogtreecommitdiffstats
path: root/FONTVER.pl
diff options
context:
space:
mode:
authorChris Severance2015-08-20 19:35:22 -0400
committerChris Severance2015-08-20 19:35:22 -0400
commit8ae52f0caa71554a741abad002970272aae0c7e0 (patch)
treefa1d6a14c2da19e31f914505eba15ccc4d8d4f58 /FONTVER.pl
parentb5e7c8de984d7f3b2ad0ca13ad4dfd48f8422f5b (diff)
downloadaur-8ae52f0caa71554a741abad002970272aae0c7e0.tar.gz
All new PKGBUILD
Diffstat (limited to 'FONTVER.pl')
-rwxr-xr-xFONTVER.pl90
1 files changed, 90 insertions, 0 deletions
diff --git a/FONTVER.pl b/FONTVER.pl
new file mode 100755
index 00000000000..36a91d14225
--- /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);