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         win95   => [qw( arial ariuni verdana times courier )],  # microsoft
  31         mac10   => [qw( lucida garamond )],  # apple
  32         android => [qw( droidsans )],  # google
  33         oss     => [qw( dvsans c2k unifont )],
  34 );
  35 my @ossel = qw( win95 mac10 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 );
  65
  66 for my $group ($ENV{PATH_INFO} || ()) {
  67         $group =~ s{^/}{};
  68         my $grouprows = $cover->{$group}
  69                 or die "Unknown character category $_\n";
  70         @rows = map { "$group/$_" } sort keys %{$grouprows};
  71 }
  72
  73 # output character list
  74
  75 print '<table class=mapped>';
  76 print '<col><col>';
  77 print "<colgroup span=$_>" for map { scalar @{$oslist{$_}} } @ossel;
  78
  79 print '<thead><tr>';
  80 print '<th colspan=2>';
  81 printf '<th colspan=%d>%s fonts', scalar @{ $oslist{$_} }, $_ for @ossel;
  82
  83 print '<tr>';
  84 print '<th colspan=2>';
  85 printf '<td>%s', $_ for @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 (@fontlist) {
  98                 my $count = $row->{$_};
  99                 if (not defined $count) {
 100                         print '<td class="l0">?';
 101                         next;
 102                 }
 103                 if (not $count) {
 104                         print '<td class="l1">✘';
 105                         next;
 106                 }
 107                 if ($count == $row->{-count}) {
 108                         print '<td class="l5">✔';
 109                         next;
 110                 }
 111
 112                 my $rel = $count / $row->{-count};
 113                 my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
 114                 printf '<td class="%s">%d%%', "l$class", $rel*100;
 115         }
 116         say '</tr>';
 117 }
 118
 119 say "</table>\n";
 120
 121 :></div>
 122