â³";
- print ' | ', $_ for @nibble;
- print " | \n";
+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 % $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");
+ 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 = $rest;
+ }
+ elsif (my $rows = int($len / $cols)) {
+ # multiple full rows
+ if ($len -= $rows * $cols) {
+ # partial row remains
+ $table->{$offset + $colsize*$rows * $cols} //= [$len*$colsize, "$class joinu", '', $title];
+ $class .= ' joind';
+ }
+ $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";
+}
+
+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 '', !$row->{cell} && ' charmap';
+ my $title = $row->{set};
+ $title .= " " for $row->{setnote} // ();
+ 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 ' | ';
- for my $msb (0 .. $#nibble) {
- print '', $nibble[$msb];
- for my $lsb (0 .. $#nibble) {
- my $glyph = substr $table, ($msb<<4) + $lsb, 1;
+ 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}) {
+ print range_cell($row, $offset);
+ next;
+ }
+
+ my $glyph = substr $row->{table}, $offset, 1;
if ($glyph eq $NOCHAR) {
print ' | ';
next;
}
- my $info = [ord $glyph];
- if (defined (my $mnem = $di{ord $glyph})) {
- $info = $diinfo->{$mnem};
- }
- my ($codepoint, $name, $prop, $script, $string) = @$info;
-
- $glyph = quote($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), quote($desc), $glyph;
+ print "\n".$glyphs->glyph_cell($glyph);
+ }
+ continue {
+ $offset += $colsize;
}
- print "\n | ", $nibble[$msb], "\n";
+ print "\n";
}
- print " |
---|
\n";
+ say ' |
---|