unicode: some mathematical symbols (wip)
[sheet.git] / 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