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         'category/Sc', # currency
  54         'table/math',
  55         'category/Sm', # mathematical
  56         'table/arrows/single',
  57         'table/lines/single',
  58         'table/block',
  59         'table/lines',
  60         'table/html',
  61 );
  62
  63 if (my $group = $ENV{PATH_INFO}) {
  64         $group =~ s{^/}{};
  65         my $grouprows = $cover->{$group}
  66                 or die "Unknown character category $_\n";
  67         @rows = map { "$group/$_" } sort keys %{$grouprows};
  68 }
  69
  70 # output character list
  71
  72 print '<table class=mapped>';
  73 print '<col><col>';
  74 print "<colgroup span=$_>"
  75         for map { scalar @{ $cover->{os}->{$_} } } @ossel;
  76
  77 print '<thead><tr>';
  78 print '<th colspan=2>';
  79 printf '<td colspan=%d>%s fonts', scalar @{ $cover->{os}->{$_} }, $_
  80         for @ossel;
  81
  82 print '<tr>';
  83 print '<th colspan=2>';
  84 printf '<td title="%s">%s', $_->{name}, $_->{abbr}
  85         for @{ $cover->{fonts} }[@fontlist];
  86 say '</thead>';
  87
  88 for (@rows) {
  89         my ($group, $name) = split m{/}, $_, 2;
  90         my $row = $cover->{$group}->{$name};
  91
  92         print '<tr>';
  93         $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)
  94                 if $row->{count} and $row->{count} < 1280;
  95         print '<th>', $name;
  96         print '<td class=right>', $row->{count};
  97         for my $count (@{ $row->{support} }[@fontlist]) {
  98                 if (not defined $count) {
  99                         print '<td class="l0">?';
 100                         next;
 101                 }
 102                 if (not $count) {
 103                         print '<td class="l1">✘';
 104                         next;
 105                 }
 106                 if ($count == $row->{count}) {
 107                         print '<td class="l5">✔';
 108                         next;
 109                 }
 110
 111                 my $rel = $count / $row->{count};
 112                 my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
 113                 printf '<td class="%s">%d%%', "l$class", $rel*100;
 114         }
 115         say '</tr>';
 116 }
 117
 118 say "</table>\n";
 119
 120 :></div>
 121