X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/2876b76b7b654f43dd1668c4a963a049450ed66c..5f257afb85ce61ae765dffad95ce755acb760234:/Shiar_Sheet/FormatChar.pm diff --git a/Shiar_Sheet/FormatChar.pm b/Shiar_Sheet/FormatChar.pm index ee0c310..0a8a50a 100644 --- a/Shiar_Sheet/FormatChar.pm +++ b/Shiar_Sheet/FormatChar.pm @@ -8,7 +8,7 @@ use utf8; use Data::Dump 'pp'; use PLP::Functions 'EscapeHTML'; -our $VERSION = '1.06'; +our $VERSION = '1.08'; our $uc = do 'unicode-char.inc.pl'; @@ -31,15 +31,15 @@ sub glyph_html { my ($self, $char) = @_; my $codepoint = ord $char; my $info = $self->glyph_info($codepoint); - my ($class, $name, $mnem, $html, $string) = @$info; + my ($class, $name, $mnem, $entity, $string) = @$info; my $cell = EscapeHTML($string || $char); - my $title = sprintf 'U+%04X%s', $codepoint, $name && " ($name)"; + my $title = sprintf 'U+%04X%s', $codepoint, !!$name && " ($name)"; - $cell = "$cell" if $class =~ /\bZs\b/; + $cell = "$cell" if $class and $class =~ /\bZs\b/; $cell = ' ' if $cell eq ''; - return ($cell, EscapeHTML($title), "X $class", $mnem, $html); + return ($cell, EscapeHTML($title), !!$class && "X $class", $mnem, $entity); } sub glyphs_html { @@ -109,7 +109,7 @@ sub cell { } if ($self->{style} eq 'di') { - if ($mnem =~ /…/) { + if ($mnem and $mnem =~ /…/) { # incomplete representation, usually partial } elsif ($class =~ /\bu-di\b/) { @@ -181,42 +181,31 @@ sub cell { } } - return sprintf('%s%s', - defined $title ? qq{ title="$title"} : '', - @class ? sprintf(' class="%s"', join ' ', @class) : '', - $html || '', + return sprintf('<%s>%s%s', + join(' ', 'td', + defined $title ? qq{title="$title"} : (), + @class ? sprintf('class="%s"', join ' ', @class) : (), + $html || (), + ), $cell eq '' ? ' ' : $cell, $anno, ); } -sub table { - my ($self, $digraphs) = @_; - - my @rows; - - my @colheads; - while ($digraphs->[0] !~ /^\./) { - my $cell = shift @$digraphs or last; - push @colheads, sprintf( - '<%s%s>%s', - $cell =~ s/^-// ? 'td' : 'th', - $cell =~ s/:(.*)// ? qq{ title="$1"} : '', - $cell eq '_' ? ' ' : $cell - ); - } - push @rows, sprintf '%s', join '', @colheads if @colheads; +sub row { + my ($self, $cells) = @_; + my @html; my $colspan = 1; - for my $cell (@$digraphs) { + for my $cell (@{$cells}) { if ($cell =~ s/^\.//) { # dot indicates start of a new row - push @rows, ''; + push @html, ''; if ($cell =~ s/^>//) { # header cell text follows $cell =~ s/_/ /g; # underscores may be used instead of whitespace (for qw//ability) my $class = $cell =~ s/^-// && ' class="ex"'; - $rows[-1] .= "".($cell || ' '); + $html[-1] .= "".($cell || ' '); } next; } @@ -225,17 +214,51 @@ sub table { $colspan++; next; } + elsif ($cell eq '>-') { + $html[-1] .= ''; + next; + } + elsif ($cell =~ m/^'.$cell; + next; + } - $rows[-1] .= $self->cell($cell, - $colspan > 1 && qq{ colspan="$colspan"}, + $html[-1] .= $self->cell($cell, + $colspan > 1 && qq{colspan="$colspan"}, ); $colspan = 1; } - return sprintf qq{\n%s
\n}, - @{ $self->{anno} } ? ' dilabel' : '', - join '', map {"$_\n"} @rows; + return @html; +} + +sub tabletag { + my ($self) = @_; + my $class = 'glyphs'; + $class .= ' dilabel' if @{ $self->{anno} }; + return sprintf '', $class; +} + +sub table { + my ($self, $digraphs) = @_; + + my @rows; + + my @colheads; + while ($digraphs->[0] !~ /^\./) { + my $cell = shift @$digraphs or last; + push @colheads, sprintf( + '<%s%s>%s', + $cell =~ s/^-// ? 'td' : 'th', + $cell =~ s/:(.*)// ? qq{ title="$1"} : '', + $cell eq '_' ? ' ' : $cell + ); + } + push @rows, sprintf '%s', join '', @colheads if @colheads; + push @rows, $self->row($digraphs); + + return join '', map {"$_\n"} $self->tabletag, @rows, '
'; } sub print {