X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/8ed454fdd94aae38d04fcd96cab15ef3b86b9cc5..96bfc3addc80d99f3b329cbb9ed9674c6f6c89b2:/Shiar_Sheet/FormatChar.pm?ds=sidebyside diff --git a/Shiar_Sheet/FormatChar.pm b/Shiar_Sheet/FormatChar.pm index ba38035..707fdc6 100644 --- a/Shiar_Sheet/FormatChar.pm +++ b/Shiar_Sheet/FormatChar.pm @@ -6,7 +6,7 @@ use warnings; use Data::Dump 'pp'; use PLP::Functions 'EscapeHTML'; -our $VERSION = '1.01'; +our $VERSION = '1.04'; our $diinfo = do 'digraphs.inc.pl'; our %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} } @@ -14,7 +14,7 @@ our %di = map { $diinfo->{$_}->[0] => $_ } grep { ref $diinfo->{$_} } sub new { my ($class) = @_; - bless { digraph => 1, unicode => 0 }, $class; + bless { anno => ['di', 0], style => 'di' }, $class; } sub glyph_info { @@ -71,28 +71,69 @@ sub cell { $cell = ''; } elsif ($input eq '=') { - push @class, 'di-invalid'; + push @class, 'u-invalid'; $cell = ''; } else { push @class, 'X'; if ($input =~ s/^-//) { - push @class, 'di-rare'; # discouraged + push @class, 'ex'; # discouraged } ($cell, $title, my $class, $mnem) = $self->glyphs_html($input); - if (defined $mnem) { - push @class, 'di-d'; # digraph - push @class, 'di-prop' if $class =~ /\bXz\b/; # unofficial + if ($self->{style} = 'di') { + if (defined $mnem) { + push @class, $class =~ /\bXz\b/ ? ('l2', 'u-prop') # unofficial + : ('l3', 'u-di'); # standard digraph + } + } + else { + my $codepoint = ord(substr $input, 0, 1); + if ($codepoint <= 0xFF) { + push @class, 'l3', 'u-lat1'; # latin1 + } + elsif ($codepoint <= 0xD7FF) { + push @class, 'l2', 'u-bmp'; # bmp + } } if ($input =~ /[ -~]/) { - push @class, 'di-a'; # ascii + push @class, 'l4', 'u-ascii'; # ascii } else { - push @class, 'di-b'; # basic unicode + push @class, 'l1'; # basic unicode + } + } + + my $anno = ''; + for (@{ $self->{anno} }) { + if ($_ eq 'html') { + require HTML::Entities; + if (my $_ = $HTML::Entities::char2entity{$cell}) { + $anno = sprintf(' %s', EscapeHTML($_)); + last; + } + } + elsif ($_ eq 'xml') { + require HTML::Entities; + $anno = sprintf(' %s', + sprintf "&#%d;", ord($cell) + ); + last; + } + elsif ($_ eq 'di') { + if (defined $mnem and length $mnem) { + $anno = sprintf(' %s', EscapeHTML($mnem)); + last; + } + } + else { + if ($_ eq 'hex' or $cell =~ /^[^a-zA-Z]$/) { + $anno = sprintf(' %04X', 'value', ord $cell); + last; + } } } @@ -101,11 +142,7 @@ sub cell { @class ? sprintf(' class="%s"', join ' ', @class) : '', $html || '', $cell eq '' ? ' ' : $cell, - $self->{digraph} && defined $mnem && length $mnem - ? sprintf(' %s', EscapeHTML($mnem)) - : $self->{unicode} + $cell =~ /^[^a-zA-Z]$/ > 0 - ? sprintf(' %04X', 'value', ord $cell) - : '', + $anno, ); } @@ -130,7 +167,7 @@ sub table { for my $cell (@$digraphs) { if ($cell =~ s/^\.//) { # dot indicates start of a new row - push @rows, ''; + push @rows, ''; if ($cell =~ s/^>//) { # header cell text follows $cell =~ s/_/ /g; # underscores may be used instead of whitespace (for qw//ability) @@ -152,8 +189,8 @@ sub table { } return sprintf qq{\n%s
\n}, - $self->{digraph} || $self->{unicode} >= 0 ? ' dilabel' : '', - join '', map {"$_\n"} @rows; + @{ $self->{anno} } ? ' dilabel' : '', + join '', map {"$_\n"} @rows; } sub print {