Improvements from other font packages

1 files changed, 75 insertions, 14 deletions

diff --git a/FONTVER.pl b/FONTVER.pl
index bec9b4b760f1..36a91d14225e 100755
--- a/FONTVER.pl
+++ b/FONTVER.pl
@@ -1,29 +1,90 @@
 #!/usr/bin/perl
 
-# Extract: Version 0.00 Font Name Bold
+# 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 CGI qw(:all);
+use Font::TTF::Ttc;
 
-#print header();
 my $rv=1;
-if ( $#ARGV >= 0 ) { 
+if ( $#ARGV >= 0 ) {
   my $f = $ARGV[0];
-  my $fontname = Font::TTF::Font->open($f);
-  if (ref $fontname) {
-    my $fnar;
-    if ($fnar = $fontname->{name}) {
-      my $fr=$fnar->read;
+  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
-      print $fr->find_name(5)." ".$fr->find_name(4);
-      $rv=0;
+        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();
     }
-    $fontname->release();
   }
 } else {
-  print "Usage: $0 foo.ttf\n";
-  print "Result: Version 1.05 Foo Narrow Bold Italic\n";
+  print "Usage: $0 foo.tt[fc]\n";
+  print "Result: Version 1.05 Foo Narrow Bold Italic FB ITC\n";
 }
 exit($rv);