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 $tables = do 'unicode-table.inc.pl' or die $@ || $!;
  29 my (%font, @fontlist);
  30 for my $fontid (qw(d tnr a dv dvs c2k u)) {
  31         my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl";
  32         push @fontlist, $fontid;
  33         $font{$fontid} = {
  34                 -name => $fontmeta->{name},
  35                 map { (chr $_ => 1) } @fontrange
  36         };
  37 }
  38
  39 my @config = qw(
  40         punctuation/common punctuation/marks
  41         latin/sample
  42         symbols/signs1
  43 );
  44 $_ and m{/*+(.+)} and @config = split /[ ]/, $1 for $ENV{PATH_INFO}, $get{q};
  45 @config = qw(ipa/cons ipa/vowels) if 0;
  46
  47 for (@config) {
  48         my ($tablegroup, $tablename) = split m{/}, $_, 2;
  49
  50         print '<table>';
  51         printf '<caption>%s</caption>', "$tablegroup: $tablename";
  52         say '';
  53         my $table = $tables->{$tablegroup}->{$tablename};
  54
  55         for my $chr (@$table) {
  56                 $chr =~ m/^\./ .. 1 or next;
  57                 given ($chr) {
  58                         when (/^[.]/) {
  59                                 print "<tbody style=\"border-bottom:3px double #AAA\">\n";
  60                                 next;
  61                         }
  62                         when ([qw(> - =)]) {
  63                                 next;
  64                         }
  65                 }
  66
  67                 my $ex = s/^-//;
  68                 my $codepoint = ord $chr;
  69                 my $ascii = $codepoint <= 127;
  70
  71                 print "<tr><th>$chr\n";
  72                 my $info = $glyphs->glyph_info($codepoint);
  73                 my ($class, $name, $mnem, $html, $string) = @$info;
  74                 print "<td>$_" for $codepoint, EscapeHTML($name);
  75                 printf '<td class="%s">%s', @$_ for (
  76                         [$ascii ? 'l0' : defined $mnem ? 'l4' : 'l1', $mnem // ''],
  77                         [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''],
  78                         (map { $font{$_}->{$chr} ? [l4 => $font{$_}->{-name}] : [l1 => ''] }
  79                                 @fontlist),
  80                 );
  81         }
  82         say "</table>\n";
  83 }
  84 :></div>
  85
  86 <script type="text/javascript" src="/clipboard.js"></script>
  87