X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/bac74b5934f22cc3d0e971d26fe0275f7f5db7b3..d1b5f6641ac7325cfe857a04445a2f830cc3c797:/charset.plp diff --git a/charset.plp b/charset.plp index 3bf294e..d954e32 100644 --- a/charset.plp +++ b/charset.plp @@ -24,7 +24,6 @@ my $glyphs = Shiar_Sheet::FormatChar->new; my @nibble = (0..9, 'A'..'F'); my $nibsize = 1; -use Encode qw(decode resolve_alias); # generate character table(s) # (~16x faster than decoding in loop; # substr strings is twice as fast as splitting to an array) @@ -67,29 +66,29 @@ my @request = map { $row{table} = ' ' x 1024; $row{set} = 'Unicode planes'; $row{cell} = do 'charset-ucplanes.inc.pl' - or printf "

Table data could not be read: %s.

\n", $@ || $!; + or Alert('Table data could not be read', $@ || $!); @nibble = (map { $_.0, $_.8 } 0 .. 7); $nibsize = 8; } - elsif ($row{set} = resolve_alias($input)) { + elsif ($row{set} = Encode::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", $@ || $!; + or Alert('Table data could not be read', $@ || $!); } 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", $@ || $!; + or Alert('Table data could not be read', $@ || $!); } else { - $row{table} = decode($row{set}, pack 'C*', $row{offset} .. $endpoint); + $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $endpoint); } } else { - say "

Encoding $input unknown

"; + Alert("Encoding $input unknown"); } $row{set} ? \%row : (); } @@ -97,7 +96,7 @@ my @request = map { (); } } map { defined $ALIAS{$_} ? @{ $ALIAS{$_} } : $_ } - $ENV{PATH_INFO} =~ /\w/ ? split(m{[/+\s]}, $ENV{PATH_INFO}) : 'default'; + $Request =~ /\w/ ? split(m{[/+\s]}, $Request) : 'default'; my $NOCHAR = chr 0xFFFD; for my $cp437 (grep {$request[$_]->{set} eq 'cp437'} 0 .. $#request) { @@ -117,9 +116,9 @@ sub range_cell { $len /= $nibsize; $name //= $len <= 2 ? 'res' : 'reserved'; - if (my $part = $offset/$nibsize % 16) { + if (my $part = $offset/$nibsize % @nibble) { # continued row - my $cols = 16 - $part; # remaining + my $cols = @nibble - $part; # remaining $cols = $len if $len < $cols; #TODO: optimise if ($len -= $cols) { # continued on new row @@ -129,15 +128,15 @@ sub range_cell { } $len = $cols; } - elsif (my $rows = $len >> 4) { + elsif (my $rows = int($len / @nibble)) { # multiple full rows - if ($len -= $rows << 4) { + if ($len -= $rows * @nibble) { # partial row remains - $table->{$offset + $nibsize*$rows * 16} //= [$len*$nibsize, "$class joinu", '', $title]; + $table->{$offset + $nibsize*$rows * @nibble} //= [$len*$nibsize, "$class joinu", '', $title]; $class .= ' joind'; } $attr .= sprintf ' rowspan=%d', $rows; - $len = 16; + $len = scalar @nibble; } $attr .= sprintf ' colspan=%d', $len unless $len == 1; @@ -152,17 +151,17 @@ for my $row (@request) { my $title = $row->{set}; $title .= " " for $row->{setnote} // (); printf '%s', $title; - print '' x 17; + print '' x (@nibble + 1); for my $section (qw{thead}) { print "<$section>↱"; print '', $_ for @nibble; print "\n"; } print ''; - for my $msb (0 .. (length($row->{table}) || 256) - 1 >> 4) { - printf '%X', ($msb + ($row->{offset} >> 4)) * $nibsize; + for my $msb (0 .. ((length($row->{table}) || 256) - 1) / @nibble) { + printf '%X', ($msb + int($row->{offset} / @nibble)) * @nibble * $nibsize; for my $lsb (0 .. $#nibble) { - my $val = ( ($msb<<4) + $lsb ) * $nibsize; + my $val = ( ($msb * @nibble) + $lsb ) * $nibsize; if ($row->{cell}) { if (ref $row->{cell} eq 'CODE') { print $row->{cell}->($val); @@ -182,7 +181,7 @@ for my $row (@request) { } print "\n"; } - print "\n"; + say ''; } :>