librarian/font-optimizer/list-features.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 'ext/Font-TTF/lib';
   7 use Font::TTF::Font;
   8
   9 use Getopt::Long;
  10
  11 main();
  12
  13 sub help {
  14     print <<EOF;
  15 Lists GSUB/GPOS features in a font.
  16
  17 Usage:
  18   $0 [options] [inputfile.ttf]
  19
  20 Options:
  21   (None)
  22 EOF
  23     exit 1;
  24 }
  25
  26 sub main {
  27     my $verbose = 0;
  28
  29     my $result = GetOptions(
  30     ) or help();
  31
  32     @ARGV == 1 or help();
  33
  34     my ($input_file) = @ARGV;
  35
  36     my $font = Font::TTF::Font->open($input_file) or die "Error opening $input_file: $!";
  37
  38     my %feats;
  39     my @feats;
  40     for my $table (grep defined, $font->{GPOS}, $font->{GSUB}) {
  41         $table->read;
  42         for my $feature (@{$table->{FEATURES}{FEAT_TAGS}}) {
  43             $feature =~ /^(\w{4})( _\d+)?$/ or die "Unrecognised feature tag syntax '$feature'";
  44             my $tag = $1;
  45             next if $feats{$tag}++;
  46             push @feats, $tag;
  47         }
  48     }
  49     print map "$_\n", @feats;
  50
  51     $font->release;
  52 }