font-optimizer/subset.pl

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