librarian/font-optimizer/subset.pl

   1 #!/usr/bin/perl
   2
   3 # -CA flag is forbidden in #! line
   4 use Encode qw(decode);
   5     @ARGV = map { decode 'utf-8', $_ } @ARGV;
   6
   7 use strict;
   8 use warnings;
   9
  10 use lib 'ext/Font-TTF/lib';
  11 use Font::Subsetter;
  12
  13 use Getopt::Long;
  14
  15 main();
  16
  17 sub help {
  18     print <<EOF;
  19 Usage:
  20   $0 [options] [inputfile.ttf] [outputfile.ttf]
  21
  22 Options:
  23   --chars=STRING        characters to include in the subset (defaults to "test")
  24   --charsfile=FILE      utf8-encoded file containing characters to include
  25   --verbose, -v         print various details about the font and the subsetting
  26   --include=FEATURES    comma-separated list of feature tags to include
  27                         (all others will be excluded by default)
  28   --exclude=FEATURES    comma-separated list of feature tags to exclude
  29                         (all others will be included by default)
  30   --apply=FEATURES      comma-separated list of feature tags to apply to the
  31                         font directly (folding into the cmap table),
  32                         e.g. "smcp" to replace all letters with small-caps
  33                         versions. (You should use --include/--exclude to remove
  34                         the features, so they don't get applied a second time
  35                         when rendering.)
  36   --licensesubst=STRING substitutes STRING in place of the string \${LICENSESUBST}
  37                         in the font's License Description
  38 EOF
  39     exit 1;
  40 }
  41
  42 sub main {
  43     my $verbose = 0;
  44     my $chars;
  45     my $charsfile;
  46     my $include;
  47     my $exclude;
  48     my $apply;
  49     my $license_desc_subst;
  50
  51     my $result = GetOptions(
  52         'chars=s' => \$chars,
  53         'charsfile=s' => \$charsfile,
  54         'verbose' => \$verbose,
  55         'include=s' => \$include,
  56         'exclude=s' => \$exclude,
  57         'apply=s' => \$apply,
  58         'licensesubst=s' => \$license_desc_subst,
  59     ) or help();
  60
  61     if (defined $chars and defined $charsfile) {
  62         print "ERROR: Only one of '--chars' and --charsfile' can be specified\n\n";
  63         help();
  64     } elsif (defined $chars) {
  65         # just use $chars
  66     } elsif (defined $charsfile) {
  67         open my $f, '<', $charsfile or die "Failed to open $charsfile: $!";
  68         binmode $f, ':utf8';
  69         local $/;
  70         $chars = <$f>;
  71     } else {
  72         $chars = 'test';
  73     }
  74
  75     @ARGV == 2 or help();
  76
  77     my ($input_file, $output_file) = @ARGV;
  78
  79
  80     if ($verbose) {
  81         dump_sizes($input_file);
  82         print "Generating subsetted font...\n\n";
  83     }
  84
  85     my $features;
  86     if ($include) {
  87         $features = { DEFAULT => 0 };
  88         $features->{$_} = 1 for split /,/, $include;
  89     } elsif ($exclude) {
  90         $features = { DEFAULT => 1 };
  91         $features->{$_} = 0 for split /,/, $exclude;
  92     }
  93
  94     my $fold_features;
  95     if ($apply) {
  96         $fold_features = [ split /,/, $apply ];
  97     }
  98
  99     my $subsetter = new Font::Subsetter();
 100     $subsetter->subset($input_file, $chars, {
 101         features => $features,
 102         fold_features => $fold_features,
 103         license_desc_subst => $license_desc_subst,
 104     });
 105     $subsetter->write($output_file);
 106
 107     if ($verbose) {
 108         print "\n";
 109         print "Features:\n  ";
 110         print join ' ', $subsetter->feature_status();
 111         print "\n\n";
 112         print "Included glyphs:\n  ";
 113         print join ' ', $subsetter->glyph_names();
 114         print "\n\n";
 115         dump_sizes($output_file);
 116     }
 117
 118     $subsetter->release();
 119 }
 120
 121 sub dump_sizes {
 122     my ($filename) = @_;
 123     my $font = Font::TTF::Font->open($filename) or die "Failed to open $filename: $!";
 124     print "TTF table sizes:\n";
 125     my $s = 0;
 126     for (sort keys %$font) {
 127         next if /^ /;
 128         my $l = $font->{$_}{' LENGTH'};
 129         $s += $l;
 130         print "  $_: $l\n";
 131     }
 132     print "Total size: $s bytes\n\n";
 133     $font->release();
 134 }