X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/0c9d5cd332b3a9124f75926de5094c90b353e238..HEAD:/charset.plp diff --git a/charset.plp b/charset.plp index 7f19bc1..bbab1d6 100644 --- a/charset.plp +++ b/charset.plp @@ -5,7 +5,8 @@ my @tablist = split m{/+}, $Request || 'default'; Html({ title => 'charset cheat sheet', - version => '1.0', + version => '1.3', + canonical => "/charset/$Request" . ($mode && '?compare'), description => [ "Reference sheet with all glyphs in common character encoding tables,", "and an overview of Unicode ranges and UTF-8 bytes.", @@ -14,9 +15,9 @@ Html({ charset codepage unicode ascii utf8 latin glyph character encoding reference common overview table '], - stylesheet => [qw'light'], + (stylesheet => [qw'light']) x !$mode, data => [qw( - charset-encoding.inc.pl + charset.inc.pl charset-encoding.inc.pl charset-unicode.inc.pl charset-ucplanes.inc.pl charset-utf8.inc.pl )], }); @@ -28,26 +29,25 @@ use List::Util qw( first pairmap pairfirst pairs );

<: +if ($tablist[0] eq 'unicode') { + say "Detailed allocation of Unicode blocks."; + print "See ", showlink("charsets", '/charset'), " to compare specific encodings"; +} +else { + if ($tablist[0] eq 'default') { - say "Overview of Unicode allocation and common latin code pages."; + say "Overview of Unicode ", showlink("allocation", '/charset/unicode'); + say "and common latin code pages."; say "Compare alternate charsets:"; } else { say "Charset comparison:"; } -sub optionlink { - my ($title, $href, $selected) = @_; - return sprintf( - $selected ? '%s' : '%s', - EscapeHTML($title), $href - ); -} - print join " •\n", ( map { join " ·\n", pairmap { - optionlink($b || ucfirst $a, '/charset'.($a && "/$a?compare"), $a eq $Request); + showlink($b || ucfirst $a, '/charset'.($a && "/$a?compare"), $a eq $Request); } @{$_} } [ @@ -56,6 +56,7 @@ print join " •\n", ( dos => 'DOS', mac => 'Apple', ebcdic => 'EBCDIC', + legacy => 'legacy', $tablist[0] eq 'default' ? () : ('' => 'common'), ], [ @@ -68,6 +69,8 @@ print join " •\n", ( hebrew => 0, ], ); + +} :>.

@@ -77,8 +80,7 @@ use Shiar_Sheet::FormatChar; my $glyphs = Shiar_Sheet::FormatChar->new; my @request; -my $charsets = do 'charset-encoding.inc.pl' - or Alert('Encoding metadata could not be read', $@ || $!); +my $charsets = Data('charset'); sub tabinput { # generate character table(s) @@ -96,6 +98,7 @@ sub tabinput { state $visible = {'' => 1}; # all present tables my %row = (offset => 0, cols => 16); + $row{$_} = $charset->{$_} for qw( note table ); # copy metadata if (not defined $params) { my @parents = @{ $charset->{inherit} || [] }; @@ -130,7 +133,7 @@ sub tabinput { # extend earlier range my $skip = int(($row{endpoint} || $row{startpoint}) / $row{cols}); for ($skip + 1 .. (hex($+{start}) / $row{cols}) - 1) { - $row{skip}->{ $_ * $row{cols} - $row{startpoint} }++; + $row{skip}->{ $_ * $row{cols} }++; } } else { @@ -147,12 +150,14 @@ sub tabinput { eval { $charset->{setup}->(\%row) } or Alert("Incomplete setup of $input", $@); } + $row{endpoint} ||= 0xFF; - if ($row{set}) {} - elsif ($row{set} = Encode::resolve_alias($input)) { + if (defined $row{table} or defined $row{cell}) { + $row{set} //= $input; + } + elsif ($row{set} = Encode::resolve_alias($charset->{set} // $input)) { $row{offset} = delete $row{startpoint}; - $row{endpoint} ||= 0xFF; - if ($row{set} eq 'MacHebrew' or $row{set} eq 'MacThai') { + if ($charset->{varchar}) { # array of possibly multiple characters per code point $row{table} = [ map { Encode::decode($row{set}, pack 'C*', $_) } $row{offset} .. $row{endpoint} @@ -165,9 +170,8 @@ sub tabinput { } $row{endpoint} -= $row{offset}; - - $visible->{ascii} = # assume common base - $visible->{ $row{set} } = 1; + $visible->{ascii}++; # assume common base + $row{set} = $input if $charset->{set}; # base override } else { Alert("Encoding $input unknown"); @@ -178,6 +182,12 @@ sub tabinput { while (my ($offset, $sub) = each %{$replace}) { $offset -= $row{offset}; + if (ref $row{table} eq 'ARRAY') { + $row{table}->[$offset] = $sub + if $offset >= 0 and $offset <= $row{endpoint}; + next; + } + my $length = length $sub; if ($offset < 0) { @@ -200,6 +210,7 @@ sub tabinput { } push @request, \%row; + $visible->{ $row{set} } = 1 if $row{table}; } tabinput($_) for @tablist; @@ -281,8 +292,8 @@ for my $row (@request) { printf '
', !$row->{cell} && ' charmap'; my $title = $row->{set}; - $title .= " " - for $row->{parent} || (); + $title .= " " for $row->{parent} || (); + $title .= " " for $row->{note} || (); printf '', $title; print '' x ($cols + 1); for my $section (qw{thead}) { @@ -293,13 +304,13 @@ for my $row (@request) { print ''; while ($offset <= $row->{endpoint} * $colsize) { - if ($row->{skip}->{$offset}) { + if ($row->{skip}->{$offset + $row->{offset}}) { $offset += $cols * $colsize; next; } print '
%s
'; - if (defined $row->{skip}->{$offset}) { + if (defined $row->{skip}->{$offset + $row->{offset}}) { print '⋮'; } else { @@ -323,7 +334,7 @@ for my $row (@request) { my $cp = $offset + $row->{offset}; my $glyph = ref $row->{table} eq 'ARRAY' ? $row->{table}->[$offset] : substr $row->{table}, $offset, 1; - my ($cell, $name, $class) = $glyph eq $NOCHAR ? () : + my ($cell, $name, $class) = !defined $glyph || $glyph eq $NOCHAR ? () : $glyphs->glyph_html($glyph); if ($mode) { @@ -332,15 +343,15 @@ for my $row (@request) { $cp == ord $glyph ? 'l4' : $row->{parent} && $glyph eq Encode::decode($row->{parent}, pack 'C', $cp) ? 'l3' : - !$class ? undef : + !defined $cell ? undef : $visible->{$glyph} ? 'l2' : 'l1' ); $visible->{$glyph}++; } - say sprintf $class ? '%s' : '', - $name, $class, $cell; + printf '%s', $class, $cell) : '>'; } continue { $offset += $colsize; @@ -391,7 +402,7 @@ for my $row (@request) {
-
unicode 7.0 + unicode 10.0 proposed deprecated unassigned