charset.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>charset cheat sheet</title>
  17 <meta http-equiv="content-type" content="utf-8">
  18 <link rel="stylesheet" type="text/css" media="all" href="/base.css">
  19 </head>
  20
  21 <body>
  22 <h1>Character encoding</h1>
  23
  24 <:
  25 my $diinfo = do 'digraphs.inc.pl';
  26 my %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} }
  27         keys %$diinfo;
  28
  29 use Encode qw(decode resolve_alias);
  30 # generate character table(s)
  31 # (~16x faster than decoding in loop;
  32 #  substr strings is twice as fast as splitting to an array)
  33 my %ALIAS = (
  34 #       default => [qw(unicode utf-8 iso-8859-1 cp437 -cp1252- --iso-8859-15- -koi8-f)],
  35         default => [qw(unicode utf-8 iso-8859-1 -cp1252- --iso-8859-15- cp437 -cp850)],
  36         0 => [qw(cp437 cp863)],
  37         1 => [qw(iso-8859-1 cp1252 MacRoman cp850)],
  38         2 => [qw(iso-8859-2 cp1250 cp852 MacCentralEurRoman MacCroatian MacRumanian)],
  39         5 => [qw(koi8-f iso-8859-5 cp1251 MacCyrillic cp855 cp866)],
  40         7 => [qw(iso-8859-7 cp1253 MacGreek cp737 cp869)],
  41         8 => [qw(iso-8859-8 cp1255 MacHebrew cp862)],
  42 );
  43 my @request = map {
  44         if (my $input = $_) {
  45                 my %row = (offset => 0);
  46                 my $endpoint = 255;
  47                 if ($input =~ s/^--//) {
  48                         $row{offset} = $endpoint > 160 ? 160 : 48;
  49                 }
  50                 elsif ($input =~ s/^-//) {
  51                         $row{offset} = $endpoint > 128 ? 128 : 32;
  52                 }
  53                 if ($input =~ s/-$//) {
  54                         $endpoint = $row{offset} ? $row{offset} < 160 ? 159 : 191 : 127;
  55                 }
  56                 if ($row{set} = resolve_alias($input)) {
  57                         if ($row{set} eq 'Internal') {
  58                                 $row{table} = ' 'x512;
  59                                 $row{set} = 'Unicode BMP';
  60                         }
  61                         elsif ($row{set} eq 'utf-8-strict') {
  62                                 $row{table} = undef;
  63                                 $row{set} = 'UTF-8';
  64                         }
  65                         else {
  66                                 $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
  67                         }
  68                 }
  69                 else {
  70                         print "<p>Encoding $input unknown</p>\n";
  71                 }
  72                 \%row;
  73         }
  74         else {
  75                 ();
  76         }
  77 } map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ }
  78         $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default';
  79 my $NOCHAR = chr 0xFFFD;
  80
  81 for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) {
  82         substr($request[$cp437]->{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign
  83         substr($request[$cp437]->{table}, 0, 32) = pack 'U*', map {hex} qw(
  84                 2007 263A 263B 2665 2666 2663 2660 2022 25D8 25CB 25D9 2642 2640 266A 266B 263C
  85                 25BA 25C4 2195 203C 00B6 00A7 25AC 21A8 2191 2193 2192 2190 221F 2194 25B2 25BC
  86         );
  87 }
  88
  89 sub quote {
  90         local $_ = shift;
  91         s/"/&quot;/g;
  92         s/</&lt;/g;
  93         s/>/&gt;/g;
  94         return $_;
  95 }
  96
  97 sub printcell_unicode {
  98         my ($value) = @_;
  99         if ($value > 0x1FF) {
 100                 print "\n".'<td class="X">?';
 101         }
 102         elsif ($value == 0) {
 103                 print '<td colspan="2" class="X Cc">control';
 104         }
 105         elsif ($value == 2) {
 106                 print '<td colspan="6" class="X Ll Latin">latin';
 107         }
 108         elsif ($value == 8) {
 109                 print '<td colspan="2" class="X Cc">control';
 110         }
 111         elsif ($value == 10) {
 112                 print '<td colspan="6" class="X Ll Latin">latin supplement';
 113         }
 114         elsif ($value == 0x10) {
 115                 print '<td colspan="8" class="X Ll Latin">latin ext-A';
 116         }
 117         elsif ($value == 0x18) {
 118                 print '<td colspan="8" class="X Ll Latin">latin ext-B';
 119         }
 120         elsif ($value == 0x20) {
 121                 print '<td colspan="5" class="X Ll Latin">latin ext-B';
 122         }
 123         elsif ($value == 0x25) {
 124                 print '<td colspan="6" class="X Ll Latin">IPA';
 125         }
 126         elsif ($value == 0x2B) {
 127                 print '<td colspan="5" class="X Sk">spacing modifier';
 128         }
 129         elsif ($value == 0x30) {
 130                 print '<td colspan="8" class="X Mn">diacritics';
 131         }
 132         elsif ($value == 0x38) {
 133                 print '<td colspan="8" class="X Ll Greek">greek';
 134         }
 135         elsif ($value == 0x40) {
 136                 print '<td colspan="16" class="X Ll Cyrillic">cyrillic';
 137         }
 138         elsif ($value == 0x50) {
 139                 print '<td colspan="3" class="X Ll Cyrillic">cyrillic+';
 140         }
 141         elsif ($value == 0x53) {
 142                 print '<td colspan="5" class="X Ll Armenian">armenian';
 143         }
 144         elsif ($value == 0x58) {
 145                 print '<td colspan="8" class="X Ll Hebrew">hebrew';
 146         }
 147         elsif ($value == 0x60) {
 148                 print '<td colspan="16" class="X Ll Arabic">arabic';
 149         }
 150         elsif ($value == 0x70) {
 151                 print '<td colspan="5" class="X Ll Aramaic">syriac';
 152         }
 153         elsif ($value == 0x75) {
 154                 print '<td colspan="3" class="X Ll Arabic">arabic+';
 155         }
 156         elsif ($value == 0x78) {
 157                 print '<td colspan="4" class="X Ll African">thaana';
 158         }
 159         elsif ($value == 0x7C) {
 160                 print '<td colspan="4" class="X Ll African">nko';
 161         }
 162         elsif ($value == 0x80) {
 163                 print '<td colspan="4" class="X di-rare">samaritan';
 164         }
 165         elsif ($value == 0x84) {
 166                 print '<td colspan="2" class="X di-rare Ll Aramaic">manda';
 167         }
 168         elsif ($value == 0x86) {
 169                 print '<td colspan="12" class="di-invalid">reserved';
 170         }
 171         elsif ($value == 0x90) {
 172                 print '<td colspan="8" class="X Ll Brahmic">devanagari';
 173         }
 174         elsif ($value == 0x98) {
 175                 print '<td colspan="8" class="X Ll Brahmic">bengali';
 176         }
 177         elsif ($value == 0xA0) {
 178                 print '<td colspan="8" class="X Ll Brahmic">gurmukhi';
 179         }
 180         elsif ($value == 0xA8) {
 181                 print '<td colspan="8" class="X Ll Brahmic">gujarati';
 182         }
 183         elsif ($value == 0xB0) {
 184                 print '<td colspan="8" class="X Ll Brahmic">oriya';
 185         }
 186         elsif ($value == 0xB8) {
 187                 print '<td colspan="8" class="X Ll Brahmic">tamil';
 188         }
 189         elsif ($value == 0xC0) {
 190                 print '<td colspan="8" class="X Ll Brahmic">telugu';
 191         }
 192         elsif ($value == 0xC8) {
 193                 print '<td colspan="8" class="X Ll Brahmic">kannada';
 194         }
 195         elsif ($value == 0xD0) {
 196                 print '<td colspan="8" class="X Ll Brahmic">malayalam';
 197         }
 198         elsif ($value == 0xD8) {
 199                 print '<td colspan="8" class="X Ll Brahmic">sinhala';
 200         }
 201         elsif ($value == 0xE0) {
 202                 print '<td colspan="8" class="X Ll Brahmic Khmer">thai';
 203         }
 204         elsif ($value == 0xE8) {
 205                 print '<td colspan="8" class="X Ll Brahmic Khmer">lao';
 206         }
 207         elsif ($value == 0xF0) {
 208                 print '<td colspan="16" class="X Ll Brahmic">tibetan';
 209         }
 210         elsif ($value == 0x100) {
 211                 print '<td colspan="10" class="X Ll Brahmic">myanmar';
 212         }
 213         elsif ($value == 0x10A) {
 214                 print '<td colspan="6" class="X Ll Aramaic">georgian';
 215         }
 216         elsif ($value == 0x110) {
 217                 print '<td colspan="16" class="X Ll Hangul">hangeul jamo';
 218         }
 219         elsif ($value == 0x120) {
 220                 print '<td colspan="16" class="X Ll African">ethiopic';
 221         }
 222         elsif ($value == 0x130) {
 223                 print '<td colspan="8" class="X Ll African">ethiopic';
 224         }
 225         elsif ($value == 0x138) {
 226                 print '<td colspan="2" class="X Ll African">eth+';
 227         }
 228         elsif ($value == 0x13A) {
 229                 print '<td colspan="6" class="X Ll X">cherokee';
 230         }
 231         elsif ($value == 0x140) {
 232                 print '<td colspan="16" rowspan="2" class="X Ll Syllabic">unified canadian aboriginal syllabics';
 233         }
 234         elsif ($value == 0x160) {
 235                 print '<td colspan="8" class="X Ll Syllabic">unified canadian syllabics';
 236         }
 237         elsif ($value == 0x168) {
 238                 print '<td colspan="2" class="X Ll X">ogham';
 239         }
 240         elsif ($value == 0x16A) {
 241                 print '<td colspan="6" class="X Ll X">runic';
 242         }
 243         elsif ($value == 0x170) {
 244                 print '<td colspan="2" class="X Ll Brahmic">tagalog';
 245         }
 246         elsif ($value == 0x172) {
 247                 print '<td colspan="2" class="X Ll Brahmic">hanun';
 248         }
 249         elsif ($value == 0x174) {
 250                 print '<td colspan="2" class="X Ll Brahmic">buhid';
 251         }
 252         elsif ($value == 0x176) {
 253                 print '<td colspan="2" class="X Ll Brahmic" title="tagbanwa">tagb';
 254         }
 255         elsif ($value == 0x178) {
 256                 print '<td colspan="8" class="X Ll Brahmic Khmer">khmer';
 257         }
 258         elsif ($value == 0x180) {
 259                 print '<td colspan="11" class="X Ll Aramaic">mongolian';
 260         }
 261         elsif ($value == 0x18B) {
 262                 print '<td colspan="5" class="X Ll Syllabic di-rare">canadian+';
 263         }
 264         elsif ($value == 0x190) {
 265                 print '<td colspan="5" class="X Ll Brahmic">limbu';
 266         }
 267         elsif ($value == 0x195) {
 268                 print '<td colspan="4" class="X Ll Brahmic">tai le';
 269         }
 270         elsif ($value == 0x198) {
 271                 print '<td colspan="6" class="X Ll Brahmic">new tai lue';
 272         }
 273         elsif ($value == 0x19E) {
 274                 print '<td colspan="2" class="X Ll Brahmic Khmer" title="khmer symbols">km';
 275         }
 276         elsif ($value == 0x1A0) {
 277                 print '<td colspan="2" class="X Ll Brahmic">lontara';
 278         }
 279         elsif ($value == 0x1A2) {
 280                 print '<td colspan="9" class="X Ll Brahmic di-rare">tai tham';
 281         }
 282         elsif ($value == 0x1AB) {
 283                 print '<td colspan="5" class="di-invalid">reserved';
 284         }
 285         elsif ($value == 0x1B0) {
 286                 print '<td colspan="8" class="X Ll ">balinese';
 287         }
 288         elsif ($value == 0x1B8) {
 289                 print '<td colspan="4" class="X Ll ">sundanese';
 290         }
 291         elsif ($value == 0x1BC) {
 292                 print '<td colspan="4" class="X Ll di-rare">batak';
 293         }
 294         elsif ($value == 0x1C0) {
 295                 print '<td colspan="5" class="X Ll ">lepcha';
 296         }
 297         elsif ($value == 0x1C5) {
 298                 print '<td colspan="3" class="X Ll ">ol chiki';
 299         }
 300         elsif ($value == 0x1C8) {
 301                 print '<td colspan="5" class="di-invalid">reserved';
 302         }
 303         elsif ($value == 0x1CD) {
 304                 print '<td colspan="3" class="X Ll di-rare">vedic';
 305         }
 306         elsif ($value == 0x1D0) {
 307                 print '<td colspan="8" class="X Ll Latin">phonetic';
 308         }
 309         elsif ($value == 0x1D8) {
 310                 print '<td colspan="4" class="X Ll Latin">phonetic+';
 311         }
 312         elsif ($value == 0x1DC) {
 313                 print '<td colspan="4" class="X Mn">combining';
 314         }
 315         elsif ($value == 0x1E0) {
 316                 print '<td colspan="16" class="X Ll Latin">latin extended additional';
 317         }
 318         elsif ($value == 0x1F0) {
 319                 print '<td colspan="16" class="X Ll Greek">greek+';
 320         }
 321 }
 322
 323 sub printcell_utf8 {
 324         my ($value) = @_;
 325         if ($value <= 0x7F) {
 326                 print '<td rowspan="8" colspan="16" class="X di-a"',
 327                           ' title="U+0000 – U+007F">Single byte ASCII'
 328                         if $value == 0;
 329         }
 330         elsif ($value <= 0xBF) {
 331                 print '<td rowspan="4" colspan="16" class="X di-d"',
 332                           '>Multi-byte continuation'
 333                         if $value == 0x80;
 334         }
 335         elsif ($value <= 0xC1) {
 336                 print '<td colspan="2" class="X di-b" style="border-right:none; border-bottom:none"',
 337                           ' title="U+0000 – U+007F">(Overl.)'
 338                         if $value == 0xC0;
 339         }
 340         elsif ($value <= 0xDF) {
 341                 print '<td rowspan="2" colspan="14" class="X di-prop" style="border-left:none"',
 342                           ' title="U+0080 – U+03FF">2-byte sequence start'
 343                         if $value == 0xC2;
 344                 print '<td rowspan="1" colspan="16" class="X di-prop" style="border-top:none"',
 345                           ' title="U+0400 – U+07FF">'
 346                         if $value == 0xD0;
 347         }
 348         elsif ($value <= 0xEF) {
 349                 print '<td colspan="16" class="X di-prop"',
 350                           ' title="U+0800 – U+FFFF">3-byte sequence start'
 351                         if $value == 0xE0;
 352         }
 353         elsif ($value <= 0xF4) {
 354                 print '<td colspan="5" class="X di-prop" style="border-right:none"',
 355                           ' title="U+1·0000 – U+10·FFFF">4-byte sequence'
 356                         if $value == 0xF0;
 357         }
 358         elsif ($value <= 0xF7) {
 359                 print '<td colspan="3" class="X di-b" style="border-left:none"',
 360                           ' title="U+11·0000 – U+1FF·FFFF">(Overflow)'
 361                         if $value == 0xF5;
 362         }
 363         elsif ($value <= 0xFB) {
 364                 print '<td colspan="4" class="X di-b"',
 365                           ' title="U+200·0000 – U+3FFF·FFFF">5-byte'
 366                         if $value == 0xF8;
 367         }
 368         elsif ($value <= 0xFD) {
 369                 print '<td colspan="2" class="X di-b"',
 370                           ' title="U+4000·0000 – 7FFFF·FFFF">6-byte'
 371                         if $value == 0xFC;
 372         }
 373         elsif ($value <= 0xFF) {
 374                 print '<td colspan="2" class="di-invalid">Invalid'
 375                         if $value == 0xFE;
 376         }
 377         else {
 378                 print "\n".'<td class="X">?';
 379         }
 380 }
 381
 382 print "<ul>\n";
 383
 384 my @nibble = (0..9, 'A'..'F');
 385 for my $row (@request) {
 386         print '<li><table class="glyphs">';
 387         printf '<caption>%s</caption>', $row->{set};
 388         print '<col>';
 389         for my $section (qw{thead}) {
 390                 print "<$section><tr><th>↱";
 391                 print '<th>', $_ for @nibble;
 392                 print "\n";
 393         }
 394         print '<tbody>';
 395         for my $msb (0 .. (length($row->{table}) || 256) - 1 >> 4) {
 396                 printf '<tr><th>%X', $msb + ($row->{offset} >> 4);
 397                 for my $lsb (0 .. $#nibble) {
 398                         if ($row->{set} eq 'UTF-8') {
 399                                 printcell_utf8(($msb<<4) + $lsb);
 400                                 next;
 401                         }
 402                         elsif ($row->{set} eq 'Unicode BMP') {
 403                                 printcell_unicode(($msb<<4) + $lsb);
 404                                 next;
 405                         }
 406
 407                         my $glyph = substr $row->{table}, ($msb<<4) + $lsb, 1;
 408                         if ($glyph eq $NOCHAR) {
 409                                 print '<td>';
 410                                 next;
 411                         }
 412                         my $info = [ord $glyph];
 413                         if (defined (my $mnem = $di{ord $glyph})) {
 414                                 $info = $diinfo->{$mnem};
 415                         }
 416                         my ($codepoint, $name, $prop, $script, $string) = @$info;
 417
 418                         $glyph = quote($string || $glyph);
 419                         my $desc = sprintf 'U+%04X%s', $codepoint, $name && " ($name)";
 420                         my @class = ('X', grep {$_} $prop, $script);
 421
 422                         $glyph = "<span>$glyph</span>" if $prop eq 'Zs';
 423
 424                         printf "\n".'<td class="%s" title="%s">%s',
 425                                 join(' ', @class), quote($desc), $glyph;
 426                 }
 427                 print "\n";
 428         }
 429         print "</table>\n";
 430 }
 431
 432 print "</ul>\n";
 433
 434 :>
 435 <hr>
 436
 437 <p class="footer">
 438         <a href="http://sheet.shiar.nl/" rel="home">sheet.shiar.nl</a>/charset
 439         <a href="git://git.shiar.nl/sheet" rel="vcs-git" title="Git repository"><:= "v$VERSION" :></a>
 440         created by <a href="http://shiar.nl/" rel="author">Shiar</a> •
 441         <a title="Licensed under the GNU Affero General Public License, version 3" rel="copyright"
 442            href="http://www.fsf.org/licensing/licenses/agpl-3.0.html">AGPLv3</a> •
 443         last update <:
 444                 use Time::Format qw(time_format);
 445                 print time_format('yyyy-mm-dd', (stat $ENV{SCRIPT_FILENAME})[9]);
 446         :>
 447 </p>
 448
 449 </html>