\p{AHex}+) )? \z }x) {
+ if (defined $row{endpoint}) {
+ # 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} }++;
+ }
}
- elsif ($value <= 0xBF) {
- print 'Multi-byte continuation'
- if $value == 0x80;
+ else {
+ $row{startpoint} = hex $+{start};
}
- elsif ($value <= 0xC1) {
- print ' | (Overl.)'
- if $value == 0xC0;
+ $row{endpoint} = hex($+{end} || 0);
+ }
+ else {
+ Alert("Unknown option $param for charset $input");
+ }
+ }
+
+ if ($charset->{setup}) {
+ eval { $charset->{setup}->(\%row) }
+ or Alert("Incomplete setup of $input", $@);
+ }
+
+ if ($row{set}) {}
+ elsif ($row{set} = Encode::resolve_alias($input)) {
+ $row{offset} = delete $row{startpoint};
+ $row{endpoint} ||= 0xFF;
+ 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} .. $row{endpoint}
+ ];
+ }
+ else {
+ # ~16x faster than decoding in loop;
+ # substr strings is twice as fast as splitting to an array
+ $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $row{endpoint});
+ }
+
+ if ($row{set} eq 'cp437') {
+ if ($row{offset} <= 0xED and $row{endpoint} >= 0xED) {
+ # replace phi glyph
+ substr($row{table}, 0xED - $row{offset}, 1) = 'Ï';
+ }
+ if ($row{offset} < 0x20) {
+ # replace control characters by visible variants
+ my $sub = substr 'ââºâ»â¥â¦â£â â¢ââââââªâ«â¼âºâââ¼Â¶Â§â¬â¨âââââââ²â¼', $row{offset};
+ substr($row{table}, 0, length $sub) = $sub;
}
- elsif ($value <= 0xDF) {
- print ' | 2-byte sequence start'
- if $value == 0xC2;
- print ' | '
- if $value == 0xD0;
+ }
+ elsif ($row{set} eq 'symbol') {
+ if ($row{offset} <= 0x60 and $row{endpoint} >= 0x60) {
+ # replace radical extender by closest unicode equivalent
+ substr($row{table}, 0x60 - $row{offset}, 1) = 'â';
}
- elsif ($value <= 0xEF) {
- print ' | 3-byte sequence start'
- if $value == 0xE0;
+ if ($row{offset} <= 0xBD and $row{endpoint} >= 0xFF) {
+ substr($row{table}, 0xBD - $row{offset}, 2) = 'ââ¯'; # arrow extenders
+ substr($row{table}, 0xD2 - $row{offset}, 3) = '®©â¢'; # serif variants
+ substr($row{table}, 0xE0 - $row{offset}, 1) = 'â'; # replace lookalike, should match AdobeSymbol
+ substr($row{table}, 0xE2 - $row{offset}, 3) = '®©â¢'; # sans-serif variants
+ substr($row{table}, 0xE6 - $row{offset}, 10) = 'ââââ¡â¢â£â§â¨â©âª';
+ substr($row{table}, 0xF0 - $row{offset}, 1) = 'â¬';
+ substr($row{table}, 0xF4 - $row{offset}, 11) = 'â®â¡âââ â¤â¥â¦â«â¬â';
}
- elsif ($value <= 0xF4) {
- print ' | 4-byte sequence'
- if $value == 0xF0;
+ }
+
+ $row{endpoint} -= $row{offset};
+
+ $visible->{ascii} = # assume common base
+ $visible->{ $row{set} } = 1;
+ }
+ else {
+ Alert("Encoding $input unknown");
+ return;
+ }
+ push @request, \%row;
+}
+tabinput($_) for @tablist;
+
+my $NOCHAR = chr 0xFFFD;
+
+sub range_cell {
+ 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 /= $colsize;
+ $name //= $len <= 2 ? 'res' : 'reserved';
+
+ if (my $part = ($offset/$colsize - $info->{startpoint}) % $cols) {
+ # continued row
+ my $rest = $cols - $part; # remaining
+ $rest = $len if $len < $rest; #TODO: optimise
+ if ($len -= $rest) {
+ # continued on new row
+ my @next = ($len * $colsize, "$class joinu");
+ my $separate = $cols - $len > $rest; # columns not on next row
+ if ($len > $rest) {
+ # minority remains
+ push @next, $name, $title;
+ $title ||= $name;
+ $name = $separate && 'â¦';
}
- elsif ($value <= 0xF7) {
- print ' | (Overflow)'
- if $value == 0xF5;
+ else {
+ # minority on next row
+ push @next, $separate && '"', $title || $name;
}
- elsif ($value <= 0xFB) {
- print ' | 5-byte'
- if $value == 0xF8;
+ $table->{$offset + $colsize*$rest} //= \@next;
+ $class .= ' joind';
+ }
+ $len = $rest;
+ }
+ elsif (my $rows = int($len / $cols)) {
+ # multiple full rows
+ my $rowsize = $colsize * $cols;
+ if ($len -= $rows * $cols) {
+ # partial row remains
+ $table->{$offset + $rowsize * $rows} //= [$len*$colsize, "$class joinu", '', $title];
+ $class .= ' joind';
+ }
+
+ unless ($info->{realsize}) {
+ # coalesce multiple rows
+ while ($rows > 3) {
+ $info->{skip}->{$offset += $rowsize}++;
+ $rows--;
}
- elsif ($value <= 0xFD) {
- print ' | 6-byte'
- if $value == 0xFC;
+ if ($rows > 2) {
+ $info->{skip}->{$offset += $rowsize} = 0;
}
- elsif ($value <= 0xFF) {
- print ' | Invalid'
- if $value == 0xFE;
+ }
+
+ $attr .= sprintf ' rowspan=%d', $rows;
+ $len = $cols;
+ }
+
+ $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 " | $name\n";
+}
+
+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 = $row->{startpoint} * $colsize || 0;
+
+ printf '', !$row->{cell} && ' charmap';
+ my $title = $row->{set};
+ $title .= " "
+ for $row->{parent} || ();
+ printf '%s', $title;
+ print '' x ($cols + 1);
+ for my $section (qw{thead}) {
+ print "<$section>", $rowdiv == 1 ? '+' : 'â±';
+ printf ' | %0*X', $coldigits, $_ * $colsize for 0 .. $cols - 1;
+ print "\n";
+ }
+
+ print ' | ';
+ while ($offset <= $row->{endpoint} * $colsize) {
+ if ($row->{skip}->{$offset}) {
+ $offset += $cols * $colsize;
+ next;
+ }
+
+ print '';
+ if (defined $row->{skip}->{$offset}) {
+ print 'â®';
+ }
+ else {
+ if (my $rowmod = $offset % $rowdiv) {
+ # offset in column units
+ printf '+%X', $rowmod;
}
else {
- print "\n".' | ?';
+ # divided row offset
+ printf '%X', ($offset + $row->{offset}) / $rowdiv;
}
}
- print "\n";
+ say '';
+
+ for (1 .. $cols) {
+ if ($row->{cell}) {
+ print range_cell($row, $offset);
+ next;
+ }
+
+ 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 ? () :
+ $glyphs->glyph_html($glyph);
+
+ if ($mode) {
+ state $visible = {};
+ $class = (
+ $cp == ord $glyph ? 'l4' :
+ $row->{parent} && $glyph eq
+ Encode::decode($row->{parent}, pack 'C', $cp) ? 'l3' :
+ !$class ? undef :
+ $visible->{$glyph} ? 'l2' :
+ 'l1'
+ );
+ $visible->{$glyph}++;
+ }
+
+ say sprintf $class ? ' | %s' : ' | ',
+ $name, $class, $cell;
+ }
+ continue {
+ $offset += $colsize;
+ }
}
- print " |
---|
\n";
+ say ' |