charset: intro and navigation of common presets

[sheet.git] / charset.plp

diff --git a/charset.plp b/charset.plp
index 6119859478217b3a87f5a467c0619e975de8392c..f26b7bdce3a7d495bb61d69c5d6e205735fcb573 100644 (file)
--- a/charset.plp
+++ b/charset.plp
@@ -17,8 +17,53 @@ Html({
 
 my @tablist = split m{/+}, $Request || 'default';
 
+use List::Util qw( first pairmap pairfirst pairs );
+
 :>
-<h1>Character encoding</h1>
+<h1>Character encodings</h1>
+
+<p>
+<:
+if ($tablist[0] eq 'default') {
+       say "Overview of Unicode allocation and common latin code pages.";
+       say "Compare alternate charsets:";
+}
+else {
+       say "Charset comparison:";
+}
+
+sub optionlink {
+       my ($title, $href, $selected) = @_;
+       return sprintf(
+               $selected ? '<strong>%s</strong>' : '<a href="%2$s">%s</a>',
+               EscapeHTML($title), $href
+       );
+}
+
+print join " •\n", (
+       map {
+               join " ·\n", pairmap {
+                       optionlink($b || ucfirst $a, "/charset/$a?compare", $a eq $Request);
+               } @{$_}
+       }
+       [
+               iso      => 'ISO',
+               dos      => 'DOS',
+               mac      => 'Apple',
+               ebcdic   => 'EBCDIC',
+       ],
+       [
+               westeur  => 'West',
+               centeur  => 'Central',
+               norteur  => 'North European',
+               turkish  => 0,
+               greek    => 0,
+               cyrillic => 0,
+               hebrew   => 0,
+       ],
+);
+:>.
+</p>
 
 <:
 use POSIX qw( ceil );
@@ -46,6 +91,7 @@ sub tabinput {
                westeur    => [qw( iso-8859-1 iso-8859-15 cp1252 iso-8859-14 cp850 hp-roman8 nextstep MacRoman )],
                centeur    => [qw( iso-8859-2 iso-8859-16 cp1250 cp852 MacRomanian MacCroatian MacCentralEurRoman )], # MacRumanian only for DB
                turkish    => [qw( iso-8859-9 iso-8859-3 cp1254 cp857 MacTurkish )],
+               norteur    => [qw( baltic nordic )],
                baltic     => [qw( iso-8859-4 iso-8859-13 cp1257 cp775 )],
                nordic     => [qw( iso-8859-10 cp865 cp861 MacIcelandic MacSami )],
                cyrillic   => [qw( koi8-r koi8-u koi8-f iso-8859-5 cp1251 MacCyrillic cp866 cp855
@@ -82,10 +128,8 @@ sub tabinput {
        my $params = $input =~ s/[+](.*)\z// ? $1 : undef;
 
        if (not defined $params) {
-               use List::Util qw( first pairfirst pairs );
-
                state $INHERIT = {
-                       'cp437'       => ['cp850' => 0], # ascii range overridden later
+                       'cp437'       => ['cp850' => 0, 'ascii' => '0-31+128'], # ascii range overridden later
                        'gsm0338'     => ['ascii' => '0-127'],
 
                        'iso-8859-2'  => ['iso-8859-1' => '160'],
@@ -166,16 +210,21 @@ sub tabinput {
                }
                elsif (defined $visible->{ascii}) {
                        $row{parent} = $parents[0];
-                       $params = $parents[1] || 128;
+                       $params = $parents[1] // 128;
                        $params = 128 if $params >= 128;  # ascii offset at most
                }
                elsif (@parents) {
                        $row{parent} = $parents[0];
+                       $params = $parents[1] if $parents[1] == 0;  # apply ascii end
                }
-               $visible->{$_} //= 0 for $row{parent};
+               $visible->{$_} //= 0 for $row{parent} || ();
+       }
+       else {
+               # manual option to double table width
+               $row{cols} *= 2 if $params =~ s/[+]\z//;
        }
 
-       if (defined $params) {
+       if (length $params) {
                $params =~ m{
                        \A (?<offset> \d+)
                        (?: (?: [-] (?<stop> \d+) )? (?: [+] (?<restart> \d+) ) )?
@@ -298,11 +347,22 @@ sub range_cell {
        }
        elsif (my $rows = int($len / $cols)) {
                # multiple full rows
+               my $rowsize = $colsize * $cols;
                if ($len -= $rows * $cols) {
                        # partial row remains
-                       $table->{$offset + $colsize*$rows * $cols} //= [$len*$colsize, "$class joinu", '', $title];
+                       $table->{$offset + $rowsize * $rows} //= [$len*$colsize, "$class joinu", '', $title];
                        $class .= ' joind';
                }
+
+               # coalesce multiple rows
+               while ($rows > 3) {
+                       $info->{skip}->{$offset += $rowsize}++;
+                       $rows--;
+               }
+               if ($rows > 2) {
+                       $info->{skip}->{$offset += $rowsize} = 0;
+               }
+
                $attr .= sprintf ' rowspan=%d', $rows;
                $len = $cols;
        }
@@ -341,7 +401,10 @@ for my $row (@request) {
                }
 
                print '<tr><th>';
-               {
+               if (defined $row->{skip}->{$offset}) {
+                       print '⋮';
+               }
+               else {
                        if (my $rowmod = $offset % $rowdiv) {
                                # offset in column units
                                printf '<small>+%X</small>', $rowmod;