digraphs.plp

   1 <(common.inc.plp)><:
   2
   3 my $mode = $Request || 'vim';
   4 my $include = 'digraphs' . ($mode ne 'vim' && "-$mode");
   5 my $cmp = exists $get{cmp} ? ($get{cmp} // 1) : !!$Request;
   6
   7 my $di = eval { Data($include) } || {};
   8 warn "error in $include: ", @{$@} if ref $@;
   9
  10 Html({
  11         title => "$mode digraph cheat sheet",
  12         version => '1.4',
  13         description => $di->{description} // [
  14                 "Complete table of digraph characters from",
  15                 ($di->{title} // $mode) . ".",
  16         ],
  17         keywords => [@{ $di->{keywords} // [] }, qw'
  18                 digraph mnemonic compose composition pair
  19                 character char glyph table unicode vim
  20         '],
  21         stylesheet => [qw'light'],
  22         data => ["data/$include.json"],
  23 });
  24
  25 %{$di} or Abort(
  26         "Requested digraphs <q>$mode</q> not available",
  27         '404 request not found',
  28 );
  29
  30 say "<h1>$di->{title} Digraphs</h1>";
  31 say "<p>$_</p>" for $di->{intro} // ();
  32
  33 if (exists $get{v}) {
  34         # show characters for inverted mnemonics (vim alternatives)
  35         $di->{key}->{ substr($_, 1, 1) . substr($_, 0, 1) } ||= [
  36                 $di->{key}->{$_}->[0], '', 'l0 ex', '', $di->{key}->{$_}->[4]
  37         ] for grep { ref $di->{key}->{$_} } keys %{ $di->{key} };
  38 }
  39
  40 my @chars = (
  41         [qw{! " % ' ( ) * + , - . /}],
  42         ['0'..'9'], [qw{: ; < = > ?}],
  43         ['A'..'M'], ['N'..'Z'],
  44         ['a'..'m'], ['n'..'z'],
  45 );
  46 my @chars2 = (['_'], @chars);  # trailing character (extended set)
  47 my @columns = !exists $get{split} ? \@chars2 :
  48         ([@chars2[0, 1, 3, 4, 6]], [@chars2[2, 5, 7]]);
  49
  50 if ($mode eq 'xorg') {
  51         #TODO determine character usage from declared keys
  52         $chars2[0] = [qw( # ^ _ ` ~ )];
  53         @chars = @chars2;
  54 }
  55
  56 for my $colchars (@columns) {
  57 print '<table class="glyphs dimap"><col>';
  58 print qq'<colgroup span="$_">' for map {scalar @$_} @{$colchars};
  59 say '</colgroup><col>';
  60 for my $section (qw{thead tfoot}) {
  61         print "<$section><tr><th>↳";
  62         print '<th>', EscapeHTML($_) for map {@$_} @{$colchars};
  63         say '<th>&nbsp;';
  64 }
  65 for my $c1group (@chars) {
  66         print '<tbody>';
  67         for my $c1 (@$c1group) {
  68                 print '<tr><th>', EscapeHTML($c1);
  69                 for my $c2 (map {@$_} @$colchars) {
  70                         my $mnem = $c1 . $c2;
  71                         if (not defined $di->{key}->{$mnem}) {
  72                                 print '<td>';
  73                                 next;
  74                         }
  75                         if (ref $di->{key}->{$mnem} ne 'ARRAY') {
  76                                 printf '<td class="X Xr" title="%s">', EscapeHTML($mnem);
  77                                 next;
  78                         }
  79                         my ($codepoint, $name, $support, $script, $string) =
  80                                 @{ $di->{key}->{$mnem} };
  81
  82                         my $glyph = $string || !!$codepoint && chr $codepoint;
  83                         utf8::upgrade($glyph);  # prevent latin1 output
  84                         my $desc = $mnem . ($name && " ($name)");
  85                         my @class = ('X', grep {$_} $script);
  86                         push @class, $cmp ? $support :
  87                                 $di->{flagclass}->{$support} // "u-$support" if $support;
  88
  89                         $glyph = EscapeHTML($glyph);
  90                         $glyph = "<span>$glyph</span>" if $script =~ /\bZs\b/;
  91
  92                         printf "\n".'<td class="%s" title="%s">%s',
  93                                 join(' ', @class), EscapeHTML($desc), $glyph;
  94                 }
  95                 say "\n<th>", EscapeHTML($c1);
  96         }
  97 }
  98 say '</table>';
  99 print '<hr>' if exists $get{split};
 100 }
 101
 102 :>
 103 <div class="legend"><: unless ($cmp) { :>
 104         <table class="glyphs"><tr>
 105         <td class="X Cc">control
 106         <td class="X Zs"><span>space</span>
 107         <td class="X Mn">combining
 108         <td class="X Sk">spacing&nbsp;modifier
 109         <td class="X Pf">quote
 110         <td class="X Po">punctuation
 111         <td class="X So">symbol
 112         <td class="X Sm">math
 113         <td class="X Sc">currency
 114         <td class="X No">numeric
 115         <td class="X Greek">greek
 116         <td class="X Cyrillic">cyrillic
 117         <td class="X Latin">latin
 118         <td class="X Hebrew">hebrew
 119         <td class="X Arabic">arabic
 120         <td class="X Hangul">korean
 121         <td class="X Hiragana">japanese
 122         <td class="X Bopomofo">chinese
 123         </table>
 124 <: } :>
 125         <table class="glyphs"><tr><:
 126         printf qq(\n\t<td class="X %s">%s), $cmp ? $_ : $di->{flagclass}{$_} // "u-$_", $di->{flag}->{$_}
 127                 for sort keys %{ $di->{flag} };
 128 :>
 129         </table>
 130 </div>
 131