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 $cover = do 'unicode-cover.inc.pl' or die $@ || $!;
  30
  31 my @ossel = @{ $cover->{osdefault} };
  32 my @fontlist = map { @{ $cover->{os}->{$_} } } @ossel;
  33
  34 my @rows = (
  35         'block/Latin-1 Supplement',
  36         'block/Latin Extended-A',
  37         'block/Latin Extended Additional',
  38         'block/Latin Extended-B',
  39         'script/Latin',
  40         'script/Greek',
  41         'script/Cyrillic',
  42         'script/Arabic',
  43         'script/Hebrew',
  44         'script/Devanagari',
  45         'script/Thai',
  46         'script/Hangul',
  47         'table/japanese',
  48         'script/Han',
  49         'table/ipa',
  50         'table/punctuation',
  51         'block/Dingbats',
  52         'table/symbols',
  53         'table/math',
  54         'table/arrows/single',
  55         'table/lines/single',
  56         'table/block',
  57         'table/lines',
  58         'table/html',
  59 );
  60
  61 for my $group ($ENV{PATH_INFO} || ()) {
  62         $group =~ s{^/}{};
  63         my $grouprows = $cover->{$group}
  64                 or die "Unknown character category $_\n";
  65         @rows = map { "$group/$_" } sort keys %{$grouprows};
  66 }
  67
  68 # output character list
  69
  70 print '<table class=mapped>';
  71 print '<col><col>';
  72 print "<colgroup span=$_>"
  73         for map { scalar @{ $cover->{os}->{$_} } } @ossel;
  74
  75 print '<thead><tr>';
  76 print '<th colspan=2>';
  77 printf '<td colspan=%d>%s fonts', scalar @{ $cover->{os}->{$_} }, $_
  78         for @ossel;
  79
  80 print '<tr>';
  81 print '<th colspan=2>';
  82 printf '<td title="%s">%s', $_->{name}, $_->{abbr}
  83         for @{ $cover->{fonts} }[@fontlist];
  84 say '</thead>';
  85
  86 for (@rows) {
  87         my ($group, $name) = split m{/}, $_, 2;
  88         my $row = $cover->{$group}->{$name};
  89
  90         print '<tr>';
  91         $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)
  92                 if $row->{count} and $row->{count} < 1280;
  93         print '<th>', $name;
  94         print '<td class=right>', $row->{count};
  95         for my $count (@{ $row->{support} }[@fontlist]) {
  96                 if (not defined $count) {
  97                         print '<td class="l0">?';
  98                         next;
  99                 }
 100                 if (not $count) {
 101                         print '<td class="l1">✘';
 102                         next;
 103                 }
 104                 if ($count == $row->{count}) {
 105                         print '<td class="l5">✔';
 106                         next;
 107                 }
 108
 109                 my $rel = $count / $row->{count};
 110                 my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
 111                 printf '<td class="%s">%d%%', "l$class", $rel*100;
 112         }
 113         say '</tr>';
 114 }
 115
 116 say "</table>\n";
 117
 118 :></div>
 119