X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/3d6f1a6afd0d5bd83e105821553124b37e036668..f2e965b21a4be2aea69d887f619481e04f3ca58a:/Shiar_Sheet/FormatChar.pm diff --git a/Shiar_Sheet/FormatChar.pm b/Shiar_Sheet/FormatChar.pm index 4668c55..f22f42b 100644 --- a/Shiar_Sheet/FormatChar.pm +++ b/Shiar_Sheet/FormatChar.pm @@ -6,11 +6,9 @@ use warnings; use Data::Dump 'pp'; use PLP::Functions 'EscapeHTML'; -our $VERSION = '1.05'; +our $VERSION = '1.06'; -our $diinfo = do 'digraphs.inc.pl'; -our %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} } - sort { length $a <=> length $b } keys %$diinfo; +our $uc = do 'unicode-char.inc.pl'; sub new { my ($class) = @_; @@ -19,29 +17,27 @@ sub new { sub glyph_info { my ($self, $codepoint) = @_; - if (defined (my $mnem = $di{$codepoint})) { - return ($diinfo->{$mnem}, length $mnem == 2 ? $mnem : undef); - } - require Unicode::UCD; - if (my $fullinfo = Unicode::UCD::charinfo($codepoint)) { - return [$codepoint, @$fullinfo{qw/name category script string/}]; - } - return [$codepoint]; + return $uc->{chr $codepoint} || eval { + require Unicode::UCD; + if (my $fullinfo = Unicode::UCD::charinfo($codepoint)) { + return [@$fullinfo{qw/category name - string/}]; + } + } || []; } sub glyph_html { my ($self, $char) = @_; - my ($info, $mnem) = $self->glyph_info(ord $char); - my ($codepoint, $name, $prop, $script, $string) = @$info; + my $codepoint = ord $char; + my $info = $self->glyph_info($codepoint); + my ($class, $name, $mnem, $string) = @$info; my $cell = EscapeHTML($string || $char); my $title = sprintf 'U+%04X%s', $codepoint, $name && " ($name)"; - my @class = ('X', grep {$_} $prop, $script); - $cell = "$cell" if $prop and $prop eq 'Zs'; + $cell = "$cell" if $class =~ /\bZs\b/; $cell = ' ' if $cell eq ''; - return ($cell, EscapeHTML($title), join(' ', @class), $mnem); + return ($cell, EscapeHTML($title), "X $class", $mnem); } sub glyphs_html { @@ -85,9 +81,11 @@ sub cell { ($cell, $title, my $class, $mnem) = $self->glyphs_html($input); if ($self->{style} = 'di') { - if (defined $mnem) { - push @class, $class =~ /\bXz\b/ ? ('l2', 'u-prop') # unofficial - : ('l3', 'u-di'); # standard digraph + if ($class =~ /\bu-di\b/) { + push @class, ('l3', 'u-di'); # standard digraph + } + elsif ($class =~ /\bu-prop\b/) { + push @class, ('l2', 'u-prop'); # unofficial } } else {