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( )],  # apple
  32         android => [qw( droidsans )],  # google
  33         oss     => [qw( dvsans c2k unifont )],
  34 );
  35 my @ossel = qw( win95 oss android );
  36 my @fontlist = map { @{ $oslist{$_} } } @ossel;
  37
  38 my $cover = do 'unicode-cover.inc.pl' or die $@ || $!;
  39
  40 # output character list
  41
  42 print '<table class=mapped>';
  43 print '<col><col>';
  44 print "<colgroup span=$_>" for map { scalar @{$oslist{$_}} } @ossel;
  45
  46 print '<thead><tr>';
  47 print '<th colspan=2>';
  48 printf '<th colspan=%d>%s fonts', scalar @{ $oslist{$_} }, $_ for @ossel;
  49
  50 print '<tr>';
  51 print '<th colspan=2>';
  52 printf '<td>%s', $_ for @fontlist;
  53 say '</thead>';
  54
  55 for my $name (sort keys %{$cover}) {
  56         my $row = $cover->{$name};
  57         print '<tr>';
  58         $name = qq{<a href="/chars/$name">$name</a>}
  59                 if $row->{-count} and $row->{-count} < 1280;
  60         print '<th>', $name;
  61         print '<td class=right>', $row->{-count};
  62         for (@fontlist) {
  63                 my $count = $row->{$_};
  64                 if (not defined $count) {
  65                         print '<td class="l0">?';
  66                         next;
  67                 }
  68                 if (not $count) {
  69                         print '<td class="l1">0';
  70                         next;
  71                 }
  72
  73                 my $rel = $count / $row->{-count};
  74                 my $class = $rel < .5 ? 2 : $rel < .75 ? 3 : $rel < 1 ? 4 : 5;
  75                 printf '<td class="%s">%d%%', "l$class", $rel*100;
  76         }
  77         say '</tr>';
  78 }
  79
  80 say "</table>\n";
  81
  82 :></div>
  83