X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/108d13f833e9daeff4ea1552e2e1bee1e0ed8c22..de663f0175a0b0172587c1415ea84a804ce5c833:/charset.plp diff --git a/charset.plp b/charset.plp index 4c01b78..42d6a14 100644 --- a/charset.plp +++ b/charset.plp @@ -15,129 +15,145 @@ Html({ data => [qw'charset-unicode.inc.pl charset-utf8.inc.pl'], }); +my @tablist = split /[^\w-]+/, $Request || 'default'; + :>
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 : 8192); - $row{set} = 'Unicode BMP'; - $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' - or printf "Table data could not be read: %s.
\n", $@ || $!; - } - else { - $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint); - } + elsif ($row{set} eq 'utf-8-strict') { + $row{table} = undef; + $row{set} = 'UTF-8'; + $row{cell} = do 'charset-utf8.inc.pl' + or Alert('Table data could not be read', $@ || $!); } else { - say "Encoding $input
unknown
$inputunknown"); + return; } -} map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ } - $Request =~ /\w/ ? split(m{[/+\s]}, $Request) : 'default'; -my $NOCHAR = chr 0xFFFD; - -for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) { - substr($request[$cp437]->{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign - substr($request[$cp437]->{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 - ); + return \%row; } +my @request = map { tabinput($_) } @tablist; + +my $NOCHAR = chr 0xFFFD; sub range_cell { - my ($table, $offset) = @_; + my ($info, $offset) = @_; + my $table = $info->{cell} or return; my $def = $table->{$offset} or return; my ($len, $class, $name, $title) = @{$def}; + my $cols = $info->{cols}; + my $colsize = $table->{colsize} || 1; my $attr = ''; - $len /= $nibsize; + $len /= $colsize; $name //= $len <= 2 ? 'res' : 'reserved'; - if (my $part = $offset/$nibsize % 16) { + if (my $part = $offset/$colsize % $cols) { # continued row - my $cols = 16 - $part; # remaining - $cols = $len if $len < $cols; #TODO: optimise - if ($len -= $cols) { + my $rest = $cols - $part; # remaining + $rest = $len if $len < $rest; #TODO: optimise + if ($len -= $rest) { # continued on new row - $table->{$offset + $nibsize*$cols} //= [$len*$nibsize, "$class joinu", $name, $title]; - $name = ''; + my @next = ($len * $colsize, "$class joinu"); + if ($len > $rest) { + # minority remains + push @next, $name, $title; + $title ||= $name; + $name = ''; + } + else { + # minority on next row + push @next, '"', $title || $name; + } + $table->{$offset + $colsize*$rest} //= \@next; $class .= ' joind'; } - $len = $cols; + $len = $rest; } - elsif (my $rows = $len >> 4) { + elsif (my $rows = int($len / $cols)) { # multiple full rows - if ($len -= $rows << 4) { + if ($len -= $rows * $cols) { # partial row remains - $table->{$offset + $nibsize*$rows * 16} //= [$len*$nibsize, "$class joinu", '', $title]; + $table->{$offset + $colsize*$rows * $cols} //= [$len*$colsize, "$class joinu", '', $title]; $class .= ' joind'; } $attr .= sprintf ' rowspan=%d', $rows; - $len = 16; + $len = $cols; } $attr .= sprintf ' colspan=%d', $len unless $len == 1; @@ -148,31 +164,44 @@ sub range_cell { } for my $row (@request) { + my $cols = $row->{cols}; + my $colsize = $row->{cell} && $row->{cell}->{colsize} || 1; + my $coldigits = ceil(log($colsize * $cols) / log(16)); # uniform length of hexadecimal header + 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 + (length($row->{table}) || 256) * $colsize; + printf '
â±"; - print ' | ', $_ for @nibble; + print "<$section> |
---|---|
", $rowdiv == 1 ? '+' : 'â±'; + printf ' | %0*X', $coldigits, $_ * $colsize for 0 .. $cols - 1; print "\n"; } print ' |
%X', ($msb + ($row->{offset} >> 4)) * $nibsize; - for my $lsb (0 .. $#nibble) { - my $val = ( ($msb<<4) + $lsb ) * $nibsize; + while ($offset < $endpoint - 1) { + print ' | |
'; + { + if (my $rowmod = $offset % $rowdiv) { + # offset in column units + printf '+%X', $rowmod; + } + else { + # divided row offset + printf '%X', ($offset + $row->{offset}) / $rowdiv; + } + } + for (1 .. $cols) { if ($row->{cell}) { - if (ref $row->{cell} eq 'CODE') { - print $row->{cell}->($val); - next; - } - print range_cell($row->{cell}, $val); + print range_cell($row, $offset); next; } - my $glyph = substr $row->{table}, $val, 1; + my $glyph = substr $row->{table}, $offset, 1; if ($glyph eq $NOCHAR) { print ' | '; next; @@ -180,6 +209,9 @@ for my $row (@request) { print "\n".$glyphs->glyph_cell($glyph); } + continue { + $offset += $colsize; + } print "\n"; } say ' |