use warnings;
use open IO => ':utf8';
-use Unicode::UCD qw(charinfo);
-
our $VERSION = '1.0';
$header{content_type} = 'text/html; charset=utf-8';
td.Zs {background: #ACB} /* space */
td.Zs span {background: #EEE}
-td.Xa {color: #040} /* ascii */
-td.Xl {color: #080} /* latin1 */
+td.Xa {color: #0A0} /* ascii */
+td.Xl {color: #070} /* latin1 */
td.Co {color: #800} /* private */
-td.Xz {color: #F00} /* proposed */
+td.Xz {color: #D00} /* proposed */
tr:hover td {
background: #FF8;
print '<td>';
next;
}
- my $chr = $di->{$mnem};
- my $glyph = chr $chr;
- utf8::upgrade($glyph); # prevent latin1 output
- my $info = charinfo($chr);
-
- my $desc = $mnem;
- $desc .= " ($_)" for $info->{name} || ();
+ my ($codepoint, $name, $prop, $script) = @{ $di->{$mnem} };
- my @class = 'X';
- push @class, $_ for $info->{category} || ();
- push @class, $_ for $info->{script} || ();
+ my $glyph = chr $codepoint;
+ utf8::upgrade($glyph); # prevent latin1 output
+ my $desc = $mnem . ($name && " ($name)");
+ my @class = ('X', grep {$_} $prop, $script);
$glyph = quote($glyph);
- $glyph = "<span>$glyph</span>" if $info->{category} eq 'Zs';
+ $glyph = "<span>$glyph</span>" if $prop eq 'Zs';
printf "\n".'<td class="%s" title="%s">%s',
join(' ', @class), quote($desc), $glyph;
<table><tr>
<td class="X">unicode
- <td class="X Xa">ascii
<td class="X Xl">latin1
+ <td class="X Xa">ascii
<td class="X Co">private
<td class="X Xz">proposed
</table>