digraphs.plp

   1 <:
   2 use utf8;
   3 use strict;
   4 use warnings;
   5 use open IO => ':utf8';
   6
   7 use Unicode::UCD qw(charinfo);
   8
   9 our $VERSION = '1.0';
  10
  11 $header{content_type} = 'text/html; charset=utf-8';
  12
  13 :><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  14  "http://www.w3.org/TR/html4/loose.dtd">
  15 <html>
  16
  17 <head>
  18 <title>digraph cheat sheet</title>
  19 <meta http-equiv="content-type" content="utf-8">
  20 <style>
  21 h1 {
  22         text-align: center;
  23         margin: 0 auto 0.2em;
  24 }
  25 table {
  26         border-collapse: collapse;
  27         table-layout: fixed; /* prevent resizing, notably in msie6 */
  28 }
  29 #legend {
  30         margin-top: 1em;
  31 }
  32 #legend table {
  33         width: 100%;
  34         table-layout: auto;
  35 #}
  36 #legend td {
  37         padding: 0 0.2em;
  38 }
  39 thead th, td {
  40         width: 1.2em; /* msie only looks at the first row */
  41         min-width: 1em; /* prevents gecko from restricting to page width */
  42 }
  43 th, td {
  44         text-align: center;
  45 }
  46 td {
  47         border: 1px solid #888;
  48         background: #DDD;
  49 }
  50 td.X {
  51         background: #FFF;
  52 }
  53
  54 td.Lm, td.Mc, td.Me, td.Zl, td.Zp, td.Cs {background:red} /* unknown */
  55
  56 /* letters */
  57 td.Greek    {background: #FFE0CF}
  58 td.Cyrillic {background: #FFDDA8}
  59 td.Latin    {background: #FFB}
  60 td.Hebrew   {background: #FFD}
  61 td.Arabic   {background: #EFE}
  62 td.Hiragana {background: #DFC}
  63 td.Katakana {background: #DFA}
  64 td.Bopomofo {background: #BFC}
  65
  66 td.Nd, td.Nl,
  67 td.No {background: #FBB} /* number */
  68 td.Sc {background: #FCD} /* currency */
  69 td.Sm {background: #ECE} /* math */
  70 td.So {background: #DDCCFF} /* symbol */
  71 td.Cf, td.Pd,
  72 td.Po {background: #CDF} /* punctuation */
  73 td.Ps, td.Pe, td.Pi,
  74 td.Pf {background: #BEF} /* quote */
  75 td.Lm,
  76 td.Sk {background: #CEE} /* spacing modifier */
  77 td.Mn {background: #ACC} /* modifier */
  78 td.Cc {background: #BBB; color: #666} /* control */
  79 td.Zs {background: #ACB} /* space */
  80 td.Zs span {background: #EEE}
  81
  82 td.Xa {color: #040} /* ascii */
  83 td.Xl {color: #080} /* latin1 */
  84 td.Co {color: #800} /* private */
  85 td.Xz {color: #F00} /* proposed */
  86
  87 tr:hover td {
  88         background: #FF8;
  89 }
  90 </style>
  91 </head>
  92
  93 <body>
  94 <h1>RFC-1345 Digraphs</h1>
  95
  96 <:
  97 my $di = do 'digraphs.inc.pl';
  98
  99 sub quote {
 100         local $_ = shift;
 101         s/"/&quot;/g;
 102         s/</&lt;/g;
 103         s/>/&gt;/g;
 104         return $_;
 105 }
 106
 107 my @chars = ((map {chr} ord '!' .. ord 'Z'), 'a'..'z');
 108 splice @chars, $_, 1, () for 2, 3-1, 5-2, 31-3;  # remove character exceptions # $ & @
 109 my @chars2 = (@chars, '_');  # trailing character (extended set)
 110
 111 print '<table>';
 112 for my $section (qw{thead tfoot}) {
 113         print "<$section><tr><th>&nbsp;";
 114         print "<th>$_" for @chars2;
 115 }
 116 print '<tbody>';
 117 for my $c1 (@chars) {
 118         print "<tr><th>$c1";
 119         for my $c2 (@chars2) {
 120                 my $mnem = $c1 . $c2;
 121                 if (not defined $di->{$mnem}) {
 122                         print '<td>';
 123                         next;
 124                 }
 125                 my $chr = $di->{$mnem};
 126                 my $glyph = chr $chr;
 127                 utf8::upgrade($glyph);  # prevent latin1 output
 128                 my $info = charinfo($chr);
 129
 130                 my $desc = $mnem;
 131                 $desc .= " ($_)" for $info->{name} || ();
 132
 133                 my @class = 'X';
 134                 push @class, $_ for $info->{category} || ();
 135                 push @class, $_ for $info->{script} || ();
 136
 137                 $glyph = quote($glyph);
 138                 $glyph = "<span>$glyph</span>" if $info->{category} eq 'Zs';
 139
 140                 printf "\n".'<td class="%s" title="%s">%s',
 141                         join(' ', @class), quote($desc), $glyph;
 142         }
 143         print "\n<th>$c1\n";
 144 }
 145 print "</table>\n";
 146 :>
 147 <div id="legend">
 148         <table><tr>
 149         <td class="X Cc">control
 150         <td class="X Zs"><span>spacing</span>
 151         <td class="X Mn">modifier
 152         <td class="X Sk">spacing modifier
 153         <td class="X Pf">quote
 154         <td class="X Po">punctuation
 155         <td class="X So">symbol
 156         <td class="X Sm">math
 157         <td class="X Sc">currency
 158         <td class="X No">numeric
 159         <td class="X Greek">greek
 160         <td class="X Cyrillic">cyrillic
 161         <td class="X Latin">latin
 162         <td class="X Hebrew">hebrew
 163         <td class="X Arabic">arabic
 164         <td class="X Hiragana">japanese
 165         <td class="X Bopomofo">chinese
 166         </table>
 167
 168         <table><tr>
 169         <td class="X">unicode
 170         <td class="X Xa">ascii
 171         <td class="X Xl">latin1
 172         <td class="X Co">private
 173         <td class="X Xz">proposed
 174         </table>
 175 </div>
 176
 177 </html>