font.plp

   1 <(common.inc.plp)><:
   2
   3 Html({
   4         title => 'character support sheet',
   5         version => 'v1.0',
   6         keywords => [qw'
   7                 unicode glyph char character reference common ipa symbol sign mark table digraph
   8         '],
   9         stylesheet => [qw'light dark mono circus red'],
  10         data => [qw'unicode-table.inc.pl unicode-char.inc.pl'],
  11 });
  12
  13 :>
  14 <h1>Character support</h1>
  15
  16 <p>
  17 Selected characters from Unicode <a href="/unicode">preset</a>
  18 or <a href="/charset">range</a>.
  19 </p>
  20
  21 <div>
  22
  23 <:
  24 use 5.010;
  25 use Shiar_Sheet::FormatChar;
  26 my $glyphs = Shiar_Sheet::FormatChar->new;
  27
  28 my %oslist = (
  29         win95 => [qw( arial ariuni verdana times )],
  30         mac10 => [qw( )],
  31         oss   => [qw( dvsans droid c2k guf )],
  32
  33         android => ['droid'],
  34 );
  35 my @ossel = qw(win95 oss);
  36
  37 my $tables = do 'unicode-table.inc.pl' or die $@ || $!;
  38 my (%font, @fontlist);
  39 for my $os (@ossel) {
  40         my $osfonts = $oslist{$os};
  41         for my $fontid (@{$osfonts}) {
  42                 push @fontlist, $fontid;
  43                 my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl";
  44                 $fontmeta or next;
  45                 $font{$fontid} = {
  46                         -id   => $fontmeta->{id} || $fontid,
  47                         -name => $fontmeta->{name},
  48                         map { (chr $_ => 1) } @fontrange
  49                 };
  50         }
  51 }
  52
  53 my @config = qw(
  54         punctuation/common punctuation/marks
  55         latin/sample
  56         symbols/signs1
  57         math/logic
  58 );
  59 $_ and m{/*+(.+)} and @config = split /[ ]/, $1 for $ENV{PATH_INFO}, $get{q};
  60 @config = qw(ipa/cons ipa/vowels) if 0;
  61
  62 for (@config) {
  63         my ($tablegroup, $tablename) = split m{/}, $_, 2;
  64
  65         print '<table class=mapped>';
  66         printf '<caption>%s</caption>', "$tablegroup: $tablename";
  67         say '';
  68         print '<col>' x 3;
  69         print "<colgroup span=$_>" for 2, map { scalar @{$oslist{$_}} } @ossel;
  70         print '<thead><tr>';
  71         print '<td colspan=2>char';
  72         print '<td>name';
  73         print '<td>di<td>html';
  74         printf('<td colspan=%d title="%s">%s',
  75                 (map {
  76                         scalar @{$_},
  77                         join(', ', map { $_->{-name} } @font{ @{$_} }),
  78                 } $oslist{$_}),
  79                 $_,
  80         ) for @ossel;
  81         say '</thead>';
  82         my $table = $tables->{$tablegroup}->{$tablename};
  83
  84         for my $chr (@$table) {
  85                 $chr =~ m/^\./ .. 1 or next;
  86                 given ($chr) {
  87                         when (/^[.]/) {
  88                                 print "<tbody style=\"border-bottom:3px double #AAA\">\n";
  89                                 next;
  90                         }
  91                         when ([qw(> - =)]) {
  92                                 next;
  93                         }
  94                 }
  95
  96                 my $ex = s/^-//;
  97                 my $codepoint = ord $chr;
  98                 my $ascii = $codepoint <= 127;
  99
 100                 print "<tr><th>$chr\n";
 101                 my $info = $glyphs->glyph_info($codepoint);
 102                 my ($class, $name, $mnem, $html, $string) = @$info;
 103                 print "<td>$_" for sprintf('%X', $codepoint), EscapeHTML($name);
 104                 printf '<td class="%s">%s', @$_ for (
 105                         [$ascii ? 'l0' : defined $mnem ? 'l4' : 'l1', $mnem // ''],
 106                         [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''],
 107                         (map {
 108                                 !$font{$_}->{-id} ? [l0 => "$_?"] :
 109                                 $font{$_}->{$chr} ? [l4 => $font{$_}->{-id}] : [l1 => '']
 110                         } @fontlist),
 111                 );
 112         }
 113         say "</table>\n";
 114 }
 115 :></div>
 116
 117 <script type="text/javascript" src="/clipboard.js"></script>
 118