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', map { EscapeHTML($_) }
  85         join("\n", $_->{name}, $_->{description}),
  86         $_->{abbr},
  87 ) for @{ $cover->{fonts} }[@fontlist];
  88 say '</thead>';
  89
  90 for (@rows) {
  91         my ($group, $name) = split m{/}, $_, 2;
  92         my $row = $cover->{$group}->{$name};
  93
  94         print '<tr>';
  95         $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)
  96                 if $row->{count} and $row->{count} < 1280;
  97         print '<th>', $name;
  98         print '<td class=right>', $row->{count};
  99         for my $count (@{ $row->{support} }[@fontlist]) {
 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