X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/d9d251ca5b512130cfb4cb9a3e03aa6748f67526..c133e6ad3027e095811931f3e0d21b818865e0e8:/tools/mkttfinfo diff --git a/tools/mkttfinfo b/tools/mkttfinfo index ad8530e..2523b8f 100755 --- a/tools/mkttfinfo +++ b/tools/mkttfinfo @@ -6,24 +6,23 @@ use warnings; use Data::Dump 'pp'; use Font::TTF::Font; use Getopt::Long; +use Cwd 'abs_path'; -our $VERSION = '1.00'; +our $VERSION = '1.01'; -GetOptions(my %opt, +GetOptions(\my %opt, 'verbose|v!', ); my ($ttfuri, $outfile) = @ARGV; -$ttfuri or die "usage error\n"; - -my $fontinc = $ENV{FONTINC} // 'data/font,~/.fonts,/usr/share/fonts/truetype/*'; -if (!-e $ttfuri) { - my $found = (grep {-e} glob "{$fontinc}/$ttfuri")[0] or do { - warn "font not found: $ttfuri\n"; - exit 1; - }; - $ttfuri = $found; -} +$ttfuri or do { + warn "usage error: input font not specified\n"; + exit 64; # EX_USAGE +}; +-e $ttfuri or do { + warn "font not found: $ttfuri\n"; + exit 66; # EX_NOINPUT +}; for ($outfile || ()) { open my $output, '>', $_ or die "Cannot write to $outfile: $!\n"; @@ -31,13 +30,22 @@ for ($outfile || ()) { } { - my $ttf = Font::TTF::Font->open($ttfuri) - or die "Cannot open truetype in $ttfuri: $!"; + my $ttf = eval { + if ($ttfuri =~ /\.ttc\z/) { + require Font::TTF::Ttc; + my $collection = Font::TTF::Ttc->open($ttfuri) or die $!; + return $collection->{directs}->[0]; # first sub-font object + } + return Font::TTF::Font->open($ttfuri); + } or do { + warn "Cannot open font file $ttfuri: ", $@ // $!; + exit 65; # EX_DATAERR + }; - my $ttfname = ($ttfuri =~ m{([^/.]+) (?:[.]ttf)? \z}msx)[0]; + my ($ttfname, @ttfext) = split /\./, ($ttfuri =~ m{([^/]+)\z}ms)[0]; my $ttfmeta = $ttf->{name}->read; my %meta = ( - source => $ttfuri =~ m{(^/usr/.+ | [^/]+) \z}msx, + source => abs_path($ttfuri) =~ m{(^/usr/.+ | [^/]+) \z}msx, name => $ttfmeta->find_name(4) || $ttfname, revision => sprintf('%g', $ttf->{head}->{fontRevision}), version => $ttfmeta->find_name(5) =~ s/\Aversion //ri =~ s/\s+\z//r, @@ -53,12 +61,23 @@ for ($outfile || ()) { $meta{abbr} = lc join '', $meta{name} =~ s/ MS$//r =~ m{ (?!Sans) (?{cmap}->find_ms->{val}; - warn scalar keys %$support, " characters read from $ttfname\n" + warn scalar keys %$support, " characters read from $ttfuri\n" if $opt{verbose}; say pp(sort { $a <=> $b } keys %$support); }