font: coverage groups

[sheet.git] / tools / mkfontinfo

diff --git a/tools/mkfontinfo b/tools/mkfontinfo
index fe7059fd31a34b9df07531c034f52031df94b10f..0f0857d73f06a27bdec2d5f937d916121021da9e 100755 (executable)
--- a/tools/mkfontinfo
+++ b/tools/mkfontinfo
@@ -23,34 +23,54 @@ for my $fontfile (glob 'ttfsupport/*'.$incsuffix) {
        };
 }
 
-my @chargroups = qw(
-       N Z Math
-       Assigned
-       Latin Greek Cyrillic Georgian Arabic Thai Hangul Han
-);
+       when (qr{^[a-z]+(?:/|\z)}) {
+       }
+
+my %charlist;
+
+my $chartables = do 'unicode-table.inc.pl' or warn $@ || $!;
+if ($chartables) {
+       while (my ($tablegroup, $grouprow) = each %{$chartables}) {
+               while (my ($tablename, $chars) = each %{$grouprow}) {
+                       next if $tablename =~ /^-/;
+                       my $includerows;  # ignore rows before body row
+                       for (@{$chars}) {
+                               $includerows ||= m/^[.]/ or next;
+                               next if /^[.-]/;
+                               next if $_ eq '>' or $_ eq '=';
+                               push @{ $charlist{table}->{"$tablegroup/$tablename"} }, $_;
+                               push @{ $charlist{table}->{$tablegroup} }, $_;
+                       }
+               }
+#              if ($tablegroup eq 'ipa') {
+#                      @chars = grep { !m/[a-zA-Z]/ } @chars;
+#              }
+       }
+}
 
-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;
-       };
+use Unicode::UCD 'charinfo';
+for my $code (0 .. 256**2) {
+       my $charinfo = charinfo($code) or next;
+       next if $charinfo->{category} =~ /^[MC]/;  # ignore Marks and "other" Control chars
+       push @{ $charlist{$_}->{ $charinfo->{$_} } }, chr $code
+               for qw( script category block );
+}
 
-       my %cover = map {
+for (values %charlist) {
+for my $chars (values %{$_}) {
+       my %row = map {
                my $fontcover = $font{$_};
-               ($_ => scalar grep { $fontcover->{$_} } @chars);
+               ($_ => scalar grep { $fontcover->{$_} } @{$chars});
        } keys %font;
-       $cover{-count} = scalar @chars;
-       $cover{-chars} = [ map { ord } sort @chars ];
+       $row{-count} = scalar @{$chars};
+#      $row{-chars} = [ map { ord } sort @{$chars} ];
 
-       say $name.' => '.pp(\%cover).',';
+       $chars = \%row;
 }
-say '}';
+}
+
+say 'use utf8;';
+say '+'.pp(\%charlist);
 
 __END__