charset.plp

   1 <(common.inc.plp)><:
   2
   3 Html({
   4         title => 'charset cheat sheet',
   5         version => 'v1.0',
   6         description => [
   7                 "Reference sheet with all glyphs in common character encoding tables,",
   8                 "and an overview of Unicode ranges and UTF-8 bytes.",
   9         ],
  10         keywords => [qw'
  11                 charset codepage unicode ascii utf8 latin glyph character encoding
  12                 reference common overview table
  13         '],
  14         stylesheet => [qw'light'],
  15 });
  16
  17 :>
  18 <h1>Character encoding</h1>
  19
  20 <:
  21 use Shiar_Sheet::FormatChar;
  22 my $glyphs = Shiar_Sheet::FormatChar->new;
  23
  24 use Encode qw(decode resolve_alias);
  25 # generate character table(s)
  26 # (~16x faster than decoding in loop;
  27 #  substr strings is twice as fast as splitting to an array)
  28 my %ALIAS = (
  29 #       default => [qw(unicode utf-8 iso-8859-1 cp437 -cp1252- --iso-8859-15- -koi8-f)],
  30         default => [qw(unicode- utf-8 iso-8859-1 -cp1252- --iso-8859-15- cp437 -cp850)],
  31         0 => [qw(cp437 cp863)],
  32         1 => [qw(iso-8859-1 cp1252 MacRoman cp850)],
  33         2 => [qw(iso-8859-2 cp1250 cp852 MacCentralEurRoman MacCroatian MacRumanian)],
  34         5 => [qw(koi8-f iso-8859-5 cp1251 MacCyrillic cp855 cp866)],
  35         7 => [qw(iso-8859-7 cp1253 MacGreek cp737 cp869)],
  36         8 => [qw(iso-8859-8 cp1255 MacHebrew cp862)],
  37 );
  38 my @request = map {
  39         if (my $input = $_) {
  40                 my %row = (offset => 0);
  41                 my $endpoint = 255;
  42                 if ($input =~ s/^--//) {
  43                         $row{offset} = $endpoint > 160 ? 160 : 48;
  44                 }
  45                 elsif ($input =~ s/^-//) {
  46                         $row{offset} = $endpoint > 128 ? 128 : 32;
  47                 }
  48                 if ($input =~ s/-$//) {
  49                         $endpoint = $row{offset} ? $row{offset} < 160 ? 159 : 191 : 127;
  50                 }
  51
  52                 if ($input =~ /^U([0-9a-f]+)(?:-([0-9a-f]+))?/) {
  53                         my $start = hex($1) << ($2 ? 4 : 8);
  54                         my $end = $2 ? hex($2) << 4 : $start + 240;
  55                         $row{table} = join '', map { chr } $start .. $end+15;
  56                         utf8::upgrade($row{table});  # prevent latin1 output
  57                         $row{set} = sprintf 'Unicode block U+%02Xxx', $start >> 8;
  58                 }
  59                 elsif ($input eq 'U') {
  60                         $row{table} = ' ' x 512;
  61                         $row{set} = 'Unicode planes';
  62                         $row{cell} = do 'charset-ucplanes.inc.pl';
  63                 }
  64                 elsif ($row{set} = resolve_alias($input)) {
  65                         if ($row{set} eq 'Internal') {
  66                                 $row{table} = ' ' x ($endpoint < 255 ? 640 : 4096);
  67                                 $row{set} = 'Unicode BMP';
  68                                 $row{cell} = do 'charset-unicode.inc.pl';
  69                         }
  70                         elsif ($row{set} eq 'utf-8-strict') {
  71                                 $row{table} = undef;
  72                                 $row{set} = 'UTF-8';
  73                                 $row{cell} = do 'charset-utf8.inc.pl';
  74                         }
  75                         else {
  76                                 $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
  77                         }
  78                 }
  79                 else {
  80                         print "<p>Encoding $input unknown</p>\n";
  81                 }
  82                 \%row;
  83         }
  84         else {
  85                 ();
  86         }
  87 } map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ }
  88         $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default';
  89 my $NOCHAR = chr 0xFFFD;
  90
  91 for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) {
  92         substr($request[$cp437]->{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign
  93         substr($request[$cp437]->{table}, 0, 32) = pack 'U*', map {hex} qw(
  94                 2007 263A 263B 2665 2666 2663 2660 2022 25D8 25CB 25D9 2642 2640 266A 266B 263C
  95                 25BA 25C4 2195 203C 00B6 00A7 25AC 21A8 2191 2193 2192 2190 221F 2194 25B2 25BC
  96         );
  97 }
  98
  99 my @nibble = (0..9, 'A'..'F');
 100 for my $row (@request) {
 101         printf '<div class="section"><table class="glyphs%s">', !$row->{cell} && ' charmap';
 102         printf '<caption>%s</caption>', $row->{set};
 103         print '<col>' x 17;
 104         for my $section (qw{thead}) {
 105                 print "<$section><tr><th>↱";
 106                 print '<th>', $_ for @nibble;
 107                 print "\n";
 108         }
 109         print '<tbody>';
 110         for my $msb (0 .. (length($row->{table}) || 256) - 1 >> 4) {
 111                 printf '<tr><th>%X', $msb + ($row->{offset} >> 4);
 112                 for my $lsb (0 .. $#nibble) {
 113                         if ($row->{cell}) {
 114                                 print $row->{cell}->(($msb<<4) + $lsb);
 115                                 next;
 116                         }
 117
 118                         my $glyph = substr $row->{table}, ($msb<<4) + $lsb, 1;
 119                         if ($glyph eq $NOCHAR) {
 120                                 print '<td>';
 121                                 next;
 122                         }
 123
 124                         print "\n".$glyphs->glyph_cell($glyph);
 125                 }
 126                 print "\n";
 127         }
 128         print "</table></div>\n";
 129 }
 130
 131 :>
 132 <hr>
 133
 134 <div class="legend">
 135         <table class="glyphs"><tr>
 136         <td class="X Cc">control
 137         <td class="X Zs"><span>whitespace</span>
 138         <td class="X Mn">diacritic<table class="glyphs"><tr>
 139                 <td class="X Sk">letter
 140                 </table>
 141         <td class="X Po">punctuation<table class="glyphs"><tr>
 142                 <td class="X Pf">quote
 143                 </table>
 144         <td class="X So">symbol<table class="glyphs"><tr>
 145                 <td class="X Sm">math
 146                 <td class="X Sc">currency
 147                 </table>
 148         <td class="X No">numeric
 149         <td class="X Greek">greek<table class="glyphs"><tr>
 150                 <td class="X Latin">latin
 151                 <td class="X Cyrillic">cyrillic
 152                 </table>
 153         <td class="X Aramaic">aramaic<table class="glyphs"><tr>
 154                 <td class="X Brahmic">brahmic
 155                 <td class="X Arabic">arabic
 156                 </table>
 157         <td class="X Syllabic">syllabic<table class="glyphs"><tr>
 158                 <td class="X African">african
 159                 <td class="X Hiragana">japanese
 160                 <td class="X Han">cjk
 161                 <td class="X Bopomofo">chinese
 162                 </table>
 163         <td class="X Alpha">alphabetic
 164         </table>
 165
 166         <table class="glyphs"><tr>
 167         <td class="X">unicode 5.0
 168         <td class="X Xr">proposed
 169         <td class="X Xd">deprecated
 170         <td class="">unassigned
 171         <td class="X Xi">invalid
 172         </table>
 173 </div>
 174