X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/abfe2b33cdf66bbed85b33b3c8b8103201c544f9..1436e579bd7ccf52d5e53d2db969eb74093df149:/charset.plp
diff --git a/charset.plp b/charset.plp
index 9d7375d..51c391c 100644
--- a/charset.plp
+++ b/charset.plp
@@ -15,7 +15,7 @@ Html({
data => [qw'charset-unicode.inc.pl charset-utf8.inc.pl'],
});
-my @tablist = split /[^\w-]+/, $Request || 'default';
+my @tablist = split m{/+}, $Request || 'default';
:>
Character encoding
@@ -31,7 +31,7 @@ sub tabinput {
my $input = shift or return;
state $ALIAS = {
- default => [qw( unicode+0-192 utf-8 iso-8859-1 iso-8859-15 cp1252 cp437 cp850 )],
+ default => [qw( unicode+0-639 utf-8 iso-8859-1 iso-8859-15 cp1252 cp437 cp850 )],
us => [qw( cp437 cp863 AdobeStandardEncoding gsm0338 )],
ebcdic => [qw( cp37 cp500 cp875 cp1026 cp1047 posix-bc )],
iso => [map {"iso-8859-$_"} 1 .. 11, 13 .. 16],
@@ -39,19 +39,23 @@ sub tabinput {
cp737 cp869 cp866 cp855 cp862 cp864 )],
aix => [qw( cp1006 )],
win => [qw( cp1252 cp1250 cp1254 cp1257 cp1258 cp1253 cp1251 cp1255 cp1256 cp874 )],
+ mac => [qw( MacRoman MacRomanian MacRumanian MacCroatian MacCentralEurRoman MacTurkish MacIcelandic MacSami
+ MacGreek MacCyrillic MacHebrew MacArabic MacFarsi MacThai )],
+ # languages
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 )],
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 )], # MacUkrainian is broken
- arabic => [qw( iso-8859-6 cp1006 cp864 cp1256 MacArabic )], # MacFarsi same as MacArabic?
+ arabic => [qw( iso-8859-6 cp1256 MacArabic cp864 cp1006 MacFarsi )],
greek => [qw( iso-8859-7 cp1253 MacGreek cp737 cp869 )],
hebrew => [qw( iso-8859-8 cp1255 MacHebrew cp862 )],
thai => [qw( iso-8859-11 cp874 MacThai )],
vietnamese => [qw( viscii cp1258 MacVietnamese )],
symbol => [qw( symbol dingbats MacDingbats AdobeZdingbat AdobeSymbol )],
+
# iso-code shorthand
1 => 'westeur',
2 => 'centeur',
@@ -83,13 +87,13 @@ sub tabinput {
'gsm0338' => ['ascii' => '0-127'],
'iso-8859-2' => ['iso-8859-1' => '160'],
- 'iso-8859-3' => ['iso-8859-1' => '160'],
+ 'iso-8859-3' => ['iso-8859-1' => '160'], #TODO: also apply to iso-8859-9
'iso-8859-4' => ['iso-8859-2' => '160'],
'iso-8859-5' => ['iso-8859-1' => '160'],
- 'iso-8859-6' => ['iso-8859-1' => '160'],
+ 'iso-8859-6' => ['cp1256' => '128', 'iso-8859-1' => '160'],
'iso-8859-7' => ['iso-8859-1' => '160'],
'iso-8859-8' => ['iso-8859-1' => '160'],
- 'iso-8859-9' => ['iso-8859-1' => '208'],
+ 'iso-8859-9' => ['iso-8859-1' => '208-223+240'],
'iso-8859-10' => ['iso-8859-4' => '160'],
'iso-8859-11' => ['iso-8859-1' => '160'],
'iso-8859-13' => ['iso-8859-4' => '160'],
@@ -99,14 +103,15 @@ sub tabinput {
'hp-roman8' => ['iso-8859-1' => '160'],
'cp1252' => ['iso-8859-1' => '128-159'],
- 'cp1250' => ['iso-8859-2' => '128-191'],
- 'cp1254' => ['iso-8859-9' => '128-159'],
- 'cp874' => ['iso-8859-11' => '128-159'], # windows-874 actually cp1162
- 'cp1257' => ['iso-8859-13' => '128'],
+ 'cp1250' => ['iso-8859-2' => '128-191', 'cp1252' => '128'],
+ 'cp1254' => ['iso-8859-9' => '128-159', 'cp1252' => '128-159+208'],
+ 'cp874' => ['iso-8859-11' => '128-159', 'cp1252' => '128'], # windows-874 actually cp1162
+ 'cp1257' => ['iso-8859-13' => '128-159+255', 'cp1252' => '128'],
'cp1251' => ['cp1252' => '128'],
'cp1253' => ['cp1252' => '128'],
'cp1255' => ['iso-8859-8' => '128-223', 'cp1252' => '128'],
'cp1256' => ['cp1252' => '128'],
+ 'cp1258' => ['cp1252' => '128-159+192'],
'cp850' => ['cp437' => '144'],
'cp860' => ['cp437' => '128-175'],
@@ -114,49 +119,70 @@ sub tabinput {
'cp863' => ['cp437' => '128-175'],
'cp865' => ['cp437' => '144-175'],
'cp852' => ['cp850' => '128', 'cp437' => '128'],
- 'cp857' => ['cp850' => '128-239', 'cp437' => '128'],
+ 'cp857' => ['cp850' => '128-175+208-239', 'cp437' => '128'],
'cp775' => ['cp850' => '128'], # partial cp437
- 'cp866' => ['cp437' => '128'],
+ 'cp866' => ['cp437' => '128-175+224'],
'cp855' => ['cp437' => '128'],
- 'cp1006' => ['cp437' => '128'],
- 'cp737' => ['cp437' => '128'],
+ 'cp1006' => ['iso-8859-6' => '160', 'cp437' => '128'],
+ 'cp737' => ['cp437' => '128-175+224'],
'cp869' => ['cp437' => '128'],
- 'cp862' => ['cp437' => '128'],
- 'cp864' => ['cp437' => '128'],
+ 'cp862' => ['cp437' => '128-159'],
+ 'cp864' => ['MacArabic' => '128', 'iso-8859-6' => '128', 'cp437' => '128'], #TODO: compare form variants
'koi8-u' => ['koi8-r' => 128],
'koi8-f' => ['koi8-u' => 128],
- 'MacRomanian' => ['MacRoman' => '160'],
+ 'MacRomanian' => ['MacRoman' => '160-191+208-223'],
+ 'MacRumanian' => ['MacRomanian' => '160-191+208-223', 'MacRoman' => '160-191+208-223'],
'MacCroatian' => ['MacRoman' => '160'],
'MacCentralEurRoman' => ['MacRoman' => '128'],
+ 'MacIcelandic'=> ['MacRoman' => '160-175+208-239'], #TODO: gaps at C/E
'MacTurkish' => ['MacRoman' => '208-223'], # F5 is unassigned
+ 'MacSami' => ['MacIcelandic' => '144', 'MacRoman' => '144'],
+ 'MacGreek' => ['MacRoman' => '128'],
'MacCyrillic' => ['MacRoman' => '128'],
- 'MacHebrew' => ['MacRoman' => '128'],
+ 'MacHebrew' => ['iso-8859-8' => '128', 'MacRoman' => '128-143+160'], # partial ascii
+ 'MacArabic' => ['iso-8859-6' => '128', 'cp864' => '128', 'MacRoman' => '128'], #TODO: multiple parents
+ 'MacFarsi' => ['MacArabic' => '176-191', 'MacRoman' => '128'],
};
my @parents = @{ $INHERIT->{$input} || [] };
- if (my ($parent, $part) = pairfirst { exists $visible->{$a} } @parents) {
+ if (my ($parent, $part) = pairfirst { defined $visible->{$a} } @parents) {
$row{parent} = $parent;
$params = $part;
- $_ eq $part or $params = 128 for $visible->{$parent} // ();
+ $params = 128 unless $visible->{$parent}
+ or ($input eq 'MacCroatian' and defined $visible->{MacRomanian});
}
- elsif (exists $visible->{ascii}) {
+ elsif (defined $visible->{ascii}) {
$row{parent} = $parents[0];
$params = $parents[1] || 128;
- exists $visible->{$_} or $visible->{$_} = $params for $row{parent};
$params = 128 if $params >= 128; # ascii offset at most
}
elsif (@parents) {
$row{parent} = $parents[0];
}
- exists $visible->{$_} or $visible->{$_} = $params // 0 for $row{parent};
+ $visible->{$_} //= 0 for $row{parent};
}
- if (defined $params and $params =~ m/^ (\d+) (-\d+)? /x) {
- $row{offset} = $1;
- $endpoint = -$2 if $2;
+ if (defined $params) {
+ $params =~ m{
+ \A (? \d+)
+ (?: (?: [-] (? \d+) )? (?: [+] (? \d+) ) )?
+ (?: [-] (? \d+) )? \z
+ }x or Alert([
+ "Unknown range parameters for $input",
+ "$params
is not in format start(-stop)(+restart(-end))",
+ ]);
+
+ $row{offset} = $+{offset};
+ $endpoint = $+{endpoint} if $+{endpoint};
+ if (my $restart = $+{restart}) {
+ my $skip = int(($+{stop} || $row{offset}) / $row{cols});
+ for ($skip + 1 .. ($restart / $row{cols}) - 1) {
+ $row{skip}->{ $_ * $row{cols} - $row{offset} }++;
+ }
+ }
}
if ($input =~ /^U([0-9a-f]+)(?:-([0-9a-f]+))?/) {
@@ -164,31 +190,31 @@ sub tabinput {
my $end = $2 ? hex($2) << 4 : $start + 240;
$row{table} = join '', map { chr } $start .. $end+15;
utf8::upgrade($row{table}); # prevent latin1 output
- $row{len} = length $row{table};
+ $row{endpoint} = $end + 14 - $start;
$row{set} = sprintf 'Unicode block U+%02Xxx', $start >> 8;
}
elsif ($input eq 'U') {
- $row{len} = 1024;
$row{set} = 'Unicode planes';
$row{cell} = do 'charset-ucplanes.inc.pl'
or Alert('Table data could not be read', $@ || $!);
$row{cols} *= 2;
+ $row{endpoint} = 1023 * $row{cell}->{colsize};
}
elsif ($row{set} = Encode::resolve_alias($input)) {
if ($row{set} eq 'Internal') {
- $row{len} = $endpoint < 255 ? 640 : 8192;
$row{set} = 'Unicode BMP';
$row{cell} = do 'charset-unicode.inc.pl'
or Alert('Table data could not be read', $@ || $!);
+ $row{endpoint} = ($endpoint || 8191) * $row{cell}->{colsize};
}
elsif ($row{set} eq 'utf-8-strict') {
- $row{len} = 256;
$row{set} = 'UTF-8';
$row{cell} = do 'charset-utf8.inc.pl'
or Alert('Table data could not be read', $@ || $!);
+ $row{endpoint} = 255;
}
else {
- if ($row{set} eq 'MacHebrew') {
+ if ($row{set} eq 'MacHebrew' or $row{set} eq 'MacThai') {
# array of possibly multiple characters per code point
$row{table} = [
map { Encode::decode($row{set}, pack 'C*', $_) } $row{offset} .. $endpoint
@@ -199,7 +225,7 @@ sub tabinput {
# substr strings is twice as fast as splitting to an array
$row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $endpoint);
}
- $row{len} = $endpoint - $row{offset};
+ $row{endpoint} = $endpoint - $row{offset};
if ($row{set} eq 'cp437' and !$row{offset}) {
substr($row{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign
@@ -212,7 +238,7 @@ sub tabinput {
}
$visible->{ascii} = # assume common base
- $visible->{ $row{set} } = undef;
+ $visible->{ $row{set} } = 1;
}
}
else {
@@ -284,7 +310,6 @@ for my $row (@request) {
my $rowdiv = 16 ** $coldigits; # row divide for column digits
$rowdiv = 1 if $rowdiv != $cols * $colsize; # divide only if all columns are matched
my $offset = 0;
- my $endpoint = $offset + $row->{len} * $colsize;
printf '', !$row->{cell} && ' charmap';
my $title = $row->{set};
@@ -298,7 +323,12 @@ for my $row (@request) {
print "\n";
}
print '';
- while ($offset < $endpoint - 1) {
+ while ($offset < $row->{endpoint}) {
+ if ($row->{skip}->{$offset}) {
+ $offset += $cols * $colsize;
+ next;
+ }
+
print '';
{
if (my $rowmod = $offset % $rowdiv) {
@@ -323,6 +353,20 @@ for my $row (@request) {
next;
}
+ if (exists $get{compare}) {
+ state $visible = {};
+ my $cp = $offset + $row->{offset};
+ printf ' | %2$s',
+ $cp == ord $glyph ? 'l4' :
+ $row->{parent} && $glyph eq
+ Encode::decode($row->{parent}, pack 'C', $cp) ? 'l3' :
+ $visible->{$glyph} ? 'l2' :
+ 'l1',
+ $glyphs->glyph_html($glyph);
+ $visible->{$glyph}++;
+ next;
+ }
+
print "\n".$glyphs->glyph_cell($glyph);
}
continue {
@@ -337,7 +381,13 @@ for my $row (@request) {
-
+ <: if (exists $get{compare}) { :>
+ unicode
+ | inherited
+ | existing
+ | original
+ | unassigned
+<: } else { :>
| control
| whitespace
| diacritic
@@ -374,6 +424,6 @@ for my $row (@request) {
deprecated
| unassigned
| invalid
- |
+<: } :> |
|
---|