outstanding change
[librarian.git] / 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 }