X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/a180fb63ca5b34948194aad96395f3ba8ec5b22d..2a99bcdadec88d7483903e2c8420ad3e78fcb805:/charset.plp diff --git a/charset.plp b/charset.plp index b6b61b9..d25f23c 100644 --- a/charset.plp +++ b/charset.plp @@ -12,7 +12,7 @@ Html({ reference common overview table '], stylesheet => [qw'light'], - data => [qw'charset-unicode.inc.pl charset-utf8.inc.pl'], + data => [qw'charset-unicode.inc.pl charset-ucplanes.inc.pl charset-utf8.inc.pl'], }); my @tablist = split m{/+}, $Request || 'default'; @@ -48,6 +48,7 @@ print join " •\n", ( } [ iso => 'ISO', + win => 'Windows', dos => 'DOS', mac => 'Apple', ebcdic => 'EBCDIC', @@ -78,7 +79,7 @@ sub tabinput { state $ALIAS = { default => [qw( u+0-639 utf-8+realsize iso-8859-1 iso-8859-15 cp1252 cp437 cp850 )], - unicode => [qw( uu+cols=32 u+0-4095 u+4096-6319 u+6320-8191 )], + unicode => [qw( uu+cols=32+realsize u+0-4095 u+4096-6319 u+6320-8191 )], us => [qw( cp437 cp863 gsm0338 AdobeStandardEncoding )], ebcdic => [qw( cp37 cp500 cp1047 posix-bc cp1026 cp875 )], iso => [map {"iso-8859-$_"} 1 .. 11, 13 .. 16], @@ -104,7 +105,7 @@ sub tabinput { hebrew => [qw( iso-8859-8 cp1255 MacHebrew cp862 U59-5F )], thai => [qw( iso-8859-11 cp874 MacThai )], vietnamese => [qw( viscii cp1258 MacVietnamese )], - symbol => [qw( symbol dingbats MacDingbats AdobeZdingbat AdobeSymbol )], + symbols => [qw( symbol dingbats MacDingbats )], # iso-code shorthand 1 => 'westeur', @@ -124,7 +125,7 @@ sub tabinput { return; } - state $visible = {}; # all present tables + state $visible = {'' => 1}; # all present tables my %row = (offset => 0, cols => 16); my $params = $input =~ s/[+](.*)\z// ? $1 : undef; @@ -132,6 +133,11 @@ sub tabinput { state $INHERIT = { 'cp437' => ['cp850' => 0, 'ascii' => '0-31+128'], # ascii range overridden later 'gsm0338' => ['ascii' => '0-127'], + 'dingbats' => ['' => '32-127+160'], + 'MacDingbats' => ['dingbats' => '128-159'], + 'AdobeZdingbat'=> ['MacDingbats' => '128-159'], # should be identical but maps to private use + 'symbol' => ['' => '32-127+160'], + 'AdobeSymbol' => ['symbol' => '32-127+160', '' => '32-127+160'], # minor differences, irrelevant except for different '€' 'iso-8859-2' => ['iso-8859-1' => '160'], 'iso-8859-3' => ['iso-8859-1' => '160'], #TODO: also apply to iso-8859-9 @@ -297,19 +303,29 @@ sub tabinput { $row{endpoint} -= $row{offset}; if ($row{set} eq 'cp437') { - for my $phipos (237 - $row{offset}) { - next if $phipos < 0 or $phipos > $row{endpoint}; + if ($row{offset} <= 0xED and $row{endpoint} >= 0xED - $row{offset}) { # replace phi glyph - substr($row{table}, $phipos, 1) = pack 'U*', 0x3D5; + substr($row{table}, 0xED - $row{offset}, 1) = 'ϕ'; } - if ($row{offset} == 0) { + if ($row{offset} < 0x20) { # replace control characters by visible variants - substr($row{table}, 0, 32) = pack 'U*', map {hex} qw( - 2007 263A 263B 2665 2666 2663 2660 2022 - 25D8 25CB 25D9 2642 2640 266A 266B 263C - 25BA 25C4 2195 203C 00B6 00A7 25AC 21A8 - 2191 2193 2192 2190 221F 2194 25B2 25BC - ); + my $sub = substr ' ☺☻♥♦♣♠•◘○◙♂♀♪♫☼►◄↕‼¶§▬↨↑↓→←∟↔▲▼', $row{offset}; + substr($row{table}, 0, length $sub) = $sub; + } + } + elsif ($row{set} eq 'symbol') { + if ($row{offset} <= 0x60 and $row{endpoint} >= 0x60 - $row{offset}) { + # replace radical extender by closest unicode equivalent + substr($row{table}, 0x60 - $row{offset}, 1) = '│'; + } + if ($row{offset} <= 0xBD and $row{endpoint} >= 0xFF - $row{offset}) { + substr($row{table}, 0xBD - $row{offset}, 2) = '⏐⎯'; # arrow extenders + substr($row{table}, 0xD2 - $row{offset}, 3) = '®©™'; # serif variants + substr($row{table}, 0xE0 - $row{offset}, 1) = '◊'; # replace lookalike, should match AdobeSymbol + substr($row{table}, 0xE2 - $row{offset}, 3) = '®©™'; # sans-serif variants + substr($row{table}, 0xE6 - $row{offset}, 10) = '⎛⎜⎝⎡⎢⎣⎧⎨⎩⎪'; + substr($row{table}, 0xF0 - $row{offset}, 1) = '€'; + substr($row{table}, 0xF4 - $row{offset}, 11) = '⎮⌡⎞⎟⎠⎤⎥⎦⎫⎬⎭'; } } @@ -345,15 +361,16 @@ sub range_cell { if ($len -= $rest) { # continued on new row my @next = ($len * $colsize, "$class joinu"); + my $separate = $cols - $len > $rest; # columns not on next row if ($len > $rest) { # minority remains push @next, $name, $title; $title ||= $name; - $name = ''; + $name = $separate && '…'; } else { # minority on next row - push @next, '"', $title || $name; + push @next, $separate && '"', $title || $name; } $table->{$offset + $colsize*$rest} //= \@next; $class .= ' joind'; @@ -402,7 +419,7 @@ for my $row (@request) { printf '
', !$row->{cell} && ' charmap'; my $title = $row->{set}; $title .= " " - for grep { $_ ne 'iso-8859-1' } $row->{parent} // (); + for $row->{parent} || (); printf '', $title; print '' x ($cols + 1); for my $section (qw{thead}) { @@ -439,28 +456,27 @@ for my $row (@request) { next; } + my $cp = $offset + $row->{offset}; my $glyph = ref $row->{table} eq 'ARRAY' ? $row->{table}->[$offset] : substr $row->{table}, $offset, 1; - if ($glyph eq $NOCHAR) { - print '
%s
'; - next; - } + my ($cell, $name, $class) = $glyph eq $NOCHAR ? () : + $glyphs->glyph_html($glyph); if (exists $get{compare}) { state $visible = {}; - my $cp = $offset + $row->{offset}; - printf '%2$s', + $class = ( $cp == ord $glyph ? 'l4' : $row->{parent} && $glyph eq Encode::decode($row->{parent}, pack 'C', $cp) ? 'l3' : + !$class ? undef : $visible->{$glyph} ? 'l2' : - 'l1', - $glyphs->glyph_html($glyph); + 'l1' + ); $visible->{$glyph}++; - next; } - say $glyphs->glyph_cell($glyph); + say sprintf $class ? '%s' : '', + $name, $class, $cell; } continue { $offset += $colsize;