X-Git-Url: https://git.mdrn.pl/librarian.git/blobdiff_plain/e316fc14bef26f958937aec0e6854b61f71a3b34..09dded3d8606e8e4406fffcf477ceb4a1c97fee2:/librarian/font-optimizer/list-features.pl

diff --git a/librarian/font-optimizer/list-features.pl b/librarian/font-optimizer/list-features.pl
new file mode 100755
index 0000000..3264a48
--- /dev/null
+++ b/librarian/font-optimizer/list-features.pl
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 'ext/Font-TTF/lib';
+use Font::TTF::Font;
+
+use Getopt::Long;
+
+main();
+
+sub help {
+    print <<EOF;
+Lists GSUB/GPOS features in a font.
+
+Usage:
+  $0 [options] [inputfile.ttf]
+
+Options:
+  (None)
+EOF
+    exit 1;
+}
+
+sub main {
+    my $verbose = 0;
+
+    my $result = GetOptions(
+    ) or help();
+
+    @ARGV == 1 or help();
+
+    my ($input_file) = @ARGV;
+
+    my $font = Font::TTF::Font->open($input_file) or die "Error opening $input_file: $!";
+
+    my %feats;
+    my @feats;
+    for my $table (grep defined, $font->{GPOS}, $font->{GSUB}) {
+        $table->read;
+        for my $feature (@{$table->{FEATURES}{FEAT_TAGS}}) {
+            $feature =~ /^(\w{4})( _\d+)?$/ or die "Unrecognised feature tag syntax '$feature'";
+            my $tag = $1;
+            next if $feats{$tag}++;
+            push @feats, $tag;
+        }
+    }
+    print map "$_\n", @feats;
+
+    $font->release;
+}