digraphs.plp

   1 <:
   2 use utf8;
   3 use strict;
   4 use warnings;
   5 use open IO => ':utf8';
   6
   7 our $VERSION = '1.0';
   8
   9 $header{content_type} = 'text/html; charset=utf-8';
  10
  11 :><!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
  12  "http://www.w3.org/TR/html4/loose.dtd">
  13 <html>
  14
  15 <head>
  16 <title>digraph cheat sheet</title>
  17 <meta http-equiv="content-type" content="utf-8">
  18 <style>
  19 h1 {
  20         text-align: center;
  21         margin: 0 auto 0.2em;
  22 }
  23 table {
  24         border-collapse: collapse;
  25         table-layout: fixed; /* prevent resizing, notably in msie6 */
  26 }
  27 thead th, td {
  28         width: 1.2em; /* msie only looks at the first row */
  29         min-width: 1em; /* prevents gecko from restricting to page width */
  30 }
  31 th, td {
  32         text-align: center;
  33 }
  34 td {
  35         border: 1px solid #888;
  36         background: #DDD;
  37 }
  38 td.any {
  39         background: #FFF;
  40 }
  41 </style>
  42 </head>
  43
  44 <body>
  45 <h1>RFC-1345 Digraphs</h1>
  46 <:
  47 my $di = do 'digraphs.inc.pl';
  48
  49 sub quote {
  50         local $_ = shift;
  51         s/"/&quot;/g;
  52         s/</&lt;/g;
  53         s/>/&gt;/g;
  54         return $_;
  55 }
  56
  57 my @chars = ((map {chr} ord '!' .. ord 'Z'), 'a'..'z');
  58 splice @chars, $_, 1, () for 2, 3-1, 5-2, 31-3;  # remove character exceptions # $ & @
  59 print '<table>';
  60 print '<thead><tr><th>&nbsp;';
  61 print "<th>$_" for @chars, '_';
  62 print '<tbody>';
  63 for my $c1 (@chars) {
  64         print "<tr><th>$c1";
  65         for my $c2 (@chars, '_') {
  66                 my $mnem = $c1 . $c2;
  67                 if (not defined $di->{$mnem}) {
  68                         print '<td>';
  69                         next;
  70                 }
  71                 my $chr = $di->{$mnem};
  72
  73                 my @class = 'any';
  74
  75                 printf '<td class="%s" title="%s">%s',
  76                         join(' ', @class), quote($mnem), quote(chr $chr);
  77         }
  78         print "\n";
  79 }
  80 print "</table>\n";
  81