font: coverage groups

[sheet.git] / chars.plp

diff --git a/chars.plp b/chars.plp
index b081ac2749567468c920a663f81b52ffafed1372..c36615db37acc4abe6a11a6035816bf19336f4e7 100644 (file)
--- a/chars.plp
+++ b/chars.plp
@@ -7,7 +7,7 @@ Html({
                unicode glyph char character reference common ipa symbol sign mark table digraph
        '],
        stylesheet => [qw'light dark mono circus red'],
-       data => [qw'unicode-table.inc.pl unicode-char.inc.pl'],
+       data => [qw( unicode-cover.inc.pl ttfsupport unicode-char.inc.pl )],
 });
 
 :>
@@ -33,7 +33,6 @@ my %oslist = (
 );
 my @ossel = qw( win95 oss android );
 
-my $tables = do 'unicode-table.inc.pl' or die $@ || $!;
 my (%font, @fontlist);
 for my $os (@ossel) {
        my $osfonts = $oslist{$os};
@@ -54,47 +53,29 @@ for my $os (@ossel) {
 my @chars;
 my @querydesc;
 
-my $query = $ENV{PATH_INFO} || $get{q} || 'ipa';
-for ($query) {
-       s{^/}{};
-       when (qr{^[a-z]+(?:/|\z)}) {
-               for (split / /) {
-                       push @querydesc, "preset group $_";
-                       my ($tablegroup, $tablename) = split m{/}, $_, 2;
-                       my @tables = $tablename ? $tables->{$tablegroup}->{$tablename}
-                                  : sort values %{ $tables->{$tablegroup} };
-                       for (@tables) {
-                               my $includerows;  # ignore rows before body row
-                               for (@{$_}) {
-                                       $includerows ||= m/^[.]/ or next;
-                                       next if /^[.-]/;
-                                       next if $_ eq '>' or $_ eq '=';
-                                       push @chars, $_;
-                               }
+if (my $query = $ENV{PATH_INFO} || $get{q} || 'ipa') {
+       my $groupinfo = do 'unicode-cover.inc.pl' or die $@ || $!;
+       for (split /[\s+]/, $query) {
+               s{^/}{};
+               when (qr{^[\d,;\s+-]+$}) {
+                       push @querydesc, "character codepoints $_";
+                       for (map { split /[^\d-]/ } $_) {
+                               my ($charnum, $range) = split /-/, $_;
+                               push @chars, chr $_ for $charnum .. ($range // $charnum);
                        }
                }
-               when ('ipa') {
-                       @chars = grep { !m/[a-zA-Z]/ } @chars;
+               when ($_) {
+                       my $row = $groupinfo->{$_} or do {
+                               warn "group $_ not found";
+                               next;
+                       };
+                       push @querydesc, $row->{-name} // $_;
+                       push @chars, map { chr } @{ $row->{-chars} };
                }
-       }
-       when (qr{[\d,;\s+-]+}) {
-               push @querydesc, "character codepoints $_";
-               for (map { split /[^\d-]/ } $_) {
-                       my ($charnum, $range) = split /-/, $_;
-                       push @chars, chr $_ for $charnum .. ($range // $charnum);
+               default {
+                       die "unknown parameter: $_\n";
                }
        }
-       when (qr{[A-Z]}) {
-               push @querydesc, "unicode match $_";
-               eval {
-                       my $match = qr/\A\p{$_}\z/;
-                       push @chars, grep { m/$match/ } map { chr $_ }
-                               0..0xD7FF, 0xE000..0xFDCF, 0xFDF0..0xFFFD;
-               } or die "invalid unicode match: $_\n";
-       }
-       default {
-               die "unknown parameter: $_\n";
-       }
 }
 
 @chars <= 1500 or die sprintf(