X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/378d119f5791fea807f36749ce9ecb5a5c60952e..141f0dc206b7f54b29627b91484782643bd08ec6:/Shiar_Sheet/FormatChar.pm diff --git a/Shiar_Sheet/FormatChar.pm b/Shiar_Sheet/FormatChar.pm index a501b94..a806258 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.00'; +our $VERSION = '1.03'; 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 {}, $class; + bless { digraph => 1, unicode => 0 }, $class; } sub glyph_info { @@ -38,7 +38,7 @@ sub glyph_html { my $title = sprintf 'U+%04X%s', $codepoint, $name && " ($name)"; my @class = ('X', grep {$_} $prop, $script); - $cell = "$cell" if $prop eq 'Zs'; + $cell = "$cell" if $prop and $prop eq 'Zs'; $cell = ' ' if $cell eq ''; return ($cell, EscapeHTML($title), join(' ', @class), $mnem); @@ -83,9 +83,20 @@ sub cell { ($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->{digraph}) { + if (defined $mnem) { + push @class, 'di-d'; # digraph + push @class, 'di-prop' if $class =~ /\bXz\b/; # unofficial + } + } + else { + my $codepoint = ord(substr $input, 0, 1); + if ($codepoint <= 0xFF) { + push @class, 'di-d'; # latin1 + } + elsif ($codepoint <= 0xD7FF) { + push @class, 'di-prop'; # bmp + } } if ($input =~ /[ -~]/) { @@ -100,12 +111,13 @@ sub cell { defined $title ? qq{ title="$title"} : '', @class ? sprintf(' class="%s"', join ' ', @class) : '', $html || '', - $cell eq '' ? ' ' : $cell, - defined $mnem && length $mnem + $cell eq '' ? (' ', '') : ($cell, + $self->{digraph} && defined $mnem && length $mnem ? sprintf(' %s', EscapeHTML($mnem)) - : $cell =~ /^[^a-zA-Z]$/ + : $self->{unicode} + $cell =~ /^[^a-zA-Z]$/ > 0 ? sprintf(' %04X', 'value', ord $cell) - : '', + : '' + ), ); } @@ -130,7 +142,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) @@ -151,8 +163,20 @@ sub table { $colspan = 1; } - return sprintf qq{\n%s
\n}, - join '', map {"$_\n"} @rows; + return sprintf qq{\n%s
\n}, + $self->{digraph} || $self->{unicode} >= 0 ? ' dilabel' : '', + join '', map {"$_\n"} @rows; +} + +sub print { + my $self = shift; + while (@_) { + printf '

%s

'."\n\n", shift; + while (ref $_[0] and $_ = shift) { + print $self->table($_); + } + print '
'; + } } 1;