font: mkfontinfo script to create unicode-cover.inc.pl

diff --git a/Makefile b/Makefile
index 8666e8235d21cfed2cdb35cc5db273faa4667f19..4782932052327eaf610c7b451d4eca844b9c8a42 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: unicode-char.inc.pl ttfsupport
+all: unicode-char.inc.pl unicode-cover.inc.pl
 
 data/rfc1345.txt:
        wget http://www.ietf.org/rfc/rfc1345.txt -O $@
@@ -13,8 +13,12 @@ ttfsupport:
        mkdir ttfsupport
        tools/convert-allfonts
 
+unicode-cover.inc.pl: ttfsupport tools/mkfontinfo
+       tools/mkfontinfo >$@
+
 clean:
        -rm digraphs.inc.pl
        -rm unicode-char.inc.pl
        -rm -rf ttfsupport/
+       -rm unicode-cover.inc.pl
 

diff --git a/tools/mkfontinfo b/tools/mkfontinfo
new file mode 100755 (executable)
index 0000000..fe7059f
--- /dev/null
+++ b/tools/mkfontinfo
@@ -0,0 +1,76 @@
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use open OUT => ':utf8', ':std';
+use List::Util 'reduce';
+use File::Basename 'basename';
+use Data::Dump 'pp';
+
+our $VERSION = '1.00';
+
+my %font;
+my $incsuffix = '.inc.pl';
+for my $fontfile (glob 'ttfsupport/*'.$incsuffix) {
+       my ($fontid) = basename($fontfile, $incsuffix);
+       my ($fontmeta, @fontrange) = do $fontfile or next;
+       $font{$fontid} = {
+               -id   => $fontmeta->{id} || $fontid,
+               -name => $fontmeta->{name},
+               map { (chr $_ => 1) } @fontrange
+       };
+}
+
+my @chargroups = qw(
+       N Z Math
+       Assigned
+       Latin Greek Cyrillic Georgian Arabic Thai Hangul Han
+);
+
+say 'use utf8;';
+say '+{';
+for my $name (@chargroups) {
+       my $match = qr/\A\p{$name}\z/;
+       my @chars = eval {
+               grep { m/$match/ } map { chr $_ }
+               0..0xD7FF, 0xE000..0xFDCF, 0xFDF0..0xFFFD,
+       } or do {
+               warn $@;
+               next;
+       };
+
+       my %cover = map {
+               my $fontcover = $font{$_};
+               ($_ => scalar grep { $fontcover->{$_} } @chars);
+       } keys %font;
+       $cover{-count} = scalar @chars;
+       $cover{-chars} = [ map { ord } sort @chars ];
+
+       say $name.' => '.pp(\%cover).',';
+}
+say '}';
+
+__END__
+
+=head1 NAME
+
+mkfontinfo - Prepare font coverage of various character groups
+
+=head1 SYNOPSIS
+
+    mkfontinfo > unicode-cover.inc.pl
+
+Test by finding the number of cyrillic characters in DejaVu Sans:
+
+    perl -E'$f = do "unicode-cover.inc.pl"; say $f->{Cyrillic}->{dvsans}'
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+Licensed under the GNU Affero General Public License version 3.
+