font.plp

   1 <(common.inc.plp)><:
   2
   3 Html({
   4         title => 'character support sheet',
   5         version => 'v1.1',
   6         keywords => [qw(
   7                 unicode font glyph char character support overview cover coverage
   8                 script block symbol sign mark reference table
   9         )],
  10         stylesheet => [qw( light dark mono circus red )],
  11         data => [qw( unicode-cover.inc.pl )],
  12 });
  13
  14 :>
  15 <h1>Font coverage</h1>
  16
  17 <p>
  18 Character support of Unicode
  19 <a href="/charset">blocks</a> and <a href="/unicode">presets</a>.
  20 </p>
  21
  22 <div>
  23
  24 <:
  25 use 5.010;
  26 use Shiar_Sheet::FormatChar;
  27 my $glyphs = Shiar_Sheet::FormatChar->new;
  28
  29 my %oslist = (
  30         win     => [qw( arial ariuni lucidau verdana times courier )],  # microsoft
  31         mac     => [qw( helvetica lucida times garamond palatino )],  # apple
  32         android => [qw( roboto noto )],  # google
  33         oss     => [qw( dvsans c2k unifont opensans )],
  34 );
  35 my @ossel = qw( win mac oss android );
  36 my @fontlist = map { @{ $oslist{$_} } } @ossel;
  37
  38 my $cover = do 'unicode-cover.inc.pl' or die $@ || $!;
  39
  40 my @rows = (
  41         'block/Latin-1 Supplement',
  42         'block/Latin Extended-A',
  43         'block/Latin Extended Additional',
  44         'block/Latin Extended-B',
  45         'script/Latin',
  46         'script/Greek',
  47         'script/Cyrillic',
  48         'script/Arabic',
  49         'script/Hebrew',
  50         'script/Devanagari',
  51         'script/Thai',
  52         'script/Hangul',
  53         'table/japanese',
  54         'script/Han',
  55         'table/ipa',
  56         'table/punctuation',
  57         'block/Dingbats',
  58         'table/symbols',
  59         'table/math',
  60         'table/arrows/single',
  61         'table/lines/single',
  62         'table/block',
  63         'table/lines',
  64         'table/html',
  65 );
  66
  67 for my $group ($ENV{PATH_INFO} || ()) {
  68         $group =~ s{^/}{};
  69         my $grouprows = $cover->{$group}
  70                 or die "Unknown character category $_\n";
  71         @rows = map { "$group/$_" } sort keys %{$grouprows};
  72 }
  73
  74 # output character list
  75
  76 print '<table class=mapped>';
  77 print '<col><col>';
  78 print "<colgroup span=$_>" for map { scalar @{$oslist{$_}} } @ossel;
  79
  80 print '<thead><tr>';
  81 print '<th colspan=2>';
  82 printf '<th colspan=%d>%s fonts', scalar @{ $oslist{$_} }, $_ for @ossel;
  83
  84 print '<tr>';
  85 print '<th colspan=2>';
  86 printf '<td>%s', $_ for @fontlist;
  87 say '</thead>';
  88
  89 for (@rows) {
  90         my ($group, $name) = split m{/}, $_, 2;
  91         my $row = $cover->{$group}->{$name};
  92
  93         print '<tr>';
  94         $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)
  95                 if $row->{-count} and $row->{-count} < 1280;
  96         print '<th>', $name;
  97         print '<td class=right>', $row->{-count};
  98         for (@fontlist) {
  99                 my $count = $row->{$_};
 100                 if (not defined $count) {
 101                         print '<td class="l0">?';
 102                         next;
 103                 }
 104                 if (not $count) {
 105                         print '<td class="l1">✘';
 106                         next;
 107                 }
 108                 if ($count == $row->{-count}) {
 109                         print '<td class="l5">✔';
 110                         next;
 111                 }
 112
 113                 my $rel = $count / $row->{-count};
 114                 my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
 115                 printf '<td class="%s">%d%%', "l$class", $rel*100;
 116         }
 117         say '</tr>';
 118 }
 119
 120 say "</table>\n";
 121
 122 :></div>
 123