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