X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/f22a9debc2c3c50828c31ff028057734a4aadea6..211543b923759291c93630472bae959c6e8fb652:/charset.plp?ds=sidebyside diff --git a/charset.plp b/charset.plp index e2b2e27..b0d3b83 100644 --- a/charset.plp +++ b/charset.plp @@ -2,7 +2,7 @@ Html({ title => 'charset cheat sheet', - version => 'v1.0', + version => '1.0', description => [ "Reference sheet with all glyphs in common character encoding tables,", "and an overview of Unicode ranges and UTF-8 bytes.", @@ -12,15 +12,17 @@ Html({ reference common overview table '], stylesheet => [qw'light'], + data => [qw'charset-unicode.inc.pl charset-utf8.inc.pl'], }); :>
Table data could not be read: %s.
\n", $@ || $!; + @nibble = (map { $_.0, $_.8 } 0 .. 7); + $nibsize = 8; } elsif ($row{set} = resolve_alias($input)) { if ($row{set} eq 'Internal') { - $row{table} = ' ' x ($endpoint < 255 ? 640 : 4096); + $row{table} = ' ' x ($endpoint < 255 ? 640 : 8192); $row{set} = 'Unicode BMP'; - $row{cell} = do 'charset-unicode.inc.pl'; + $row{cell} = do 'charset-unicode.inc.pl' + or printf "Table data could not be read: %s.
\n", $@ || $!; } elsif ($row{set} eq 'utf-8-strict') { $row{table} = undef; $row{set} = 'UTF-8'; - $row{cell} = do 'charset-utf8.inc.pl'; + $row{cell} = do 'charset-utf8.inc.pl' + or printf "Table data could not be read: %s.
\n", $@ || $!; } else { $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint); @@ -97,10 +108,50 @@ for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) { ); } -my @nibble = (0..9, 'A'..'F'); +sub range_cell { + my ($table, $offset) = @_; + my $def = $table->{$offset} or return; + my ($len, $class, $name, $title) = @{$def}; + + my $attr = ''; + $len /= $nibsize; + $name //= $len <= 2 ? 'res' : 'reserved'; + + if (my $part = $offset/$nibsize % 16) { + # continued row + my $cols = 16 - $part; # remaining + $cols = $len if $len < $cols; #TODO: optimise + if ($len -= $cols) { + # continued on new row + $table->{$offset + $nibsize*$cols} = [$len*$nibsize, "$class joinu", $name, $title]; + $name = ''; + $class .= ' joind'; + } + $len = $cols; + } + elsif (my $rows = $len >> 4) { + # multiple full rows + if ($len -= $rows << 4) { + # partial row remains + $table->{$offset + $nibsize*$rows * 16} = [$len*$nibsize, "$class joinu", '', $title]; + $class .= ' joind'; + } + $attr .= sprintf ' rowspan=%d', $rows; + $len = 16; + } + + $attr .= sprintf ' colspan=%d', $len unless $len == 1; + $attr .= $1 if $class and $class =~ s/( \w+="[^"]*")//; + $attr .= sprintf ' class="%s"', $class if $class; + $attr .= sprintf ' title="%s"', EscapeHTML($title) if $title; + return "â±"; @@ -109,38 +160,25 @@ for my $row (@request) { } print ' | ||
---|---|---|
%X', $msb + ($row->{offset} >> 4); + printf ' | ||
%X', ($msb + ($row->{offset} >> 4)) * $nibsize; for my $lsb (0 .. $#nibble) { + my $val = ( ($msb<<4) + $lsb ) * $nibsize; if ($row->{cell}) { - print $row->{cell}->(($msb<<4) + $lsb); + if (ref $row->{cell} eq 'CODE') { + print $row->{cell}->($val); + next; + } + print range_cell($row->{cell}, $val); next; } - my $glyph = substr $row->{table}, ($msb<<4) + $lsb, 1; + my $glyph = substr $row->{table}, $val, 1; if ($glyph eq $NOCHAR) { print ' | '; next; } - my $info = [ord $glyph]; - if (defined (my $mnem = $di{ord $glyph})) { - $info = $diinfo->{$mnem}; - } - else { - require Unicode::UCD; - my $fullinfo = Unicode::UCD::charinfo(ord $glyph); - $info = [@$fullinfo{qw/code name category script string/}] if $fullinfo; - } - my ($codepoint, $name, $prop, $script, $string) = @$info; - - $glyph = EscapeHTML($string || $glyph); - my $desc = sprintf 'U+%04X%s', $codepoint, $name && " ($name)"; - my @class = ('X', grep {$_} $prop, $script); - - $glyph = "$glyph" if $prop eq 'Zs'; - - printf "\n".' | %s', - join(' ', @class), EscapeHTML($desc), $glyph; + print "\n".$glyphs->glyph_cell($glyph); } print "\n"; } @@ -183,7 +221,7 @@ for my $row (@request) { |
unicode 5.0 + | unicode 7.0 | proposed | deprecated | unassigned |