X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/4d0dfd97b2708e809741ad853bff0bd000fcbb33..2a99bcdadec88d7483903e2c8420ad3e78fcb805:/font.plp diff --git a/font.plp b/font.plp index e0a9663..d4d7deb 100644 --- a/font.plp +++ b/font.plp @@ -1,9 +1,10 @@ <(common.inc.plp)><: -use 5.014; + +my $font = $Request; Html({ - title => 'character support sheet', - version => 'v1.1', + title => 'font coverage '.($font ? "for $font" : 'sheet'), + version => '1.2', keywords => [qw( unicode font glyph char character support overview cover coverage script block symbol sign mark reference table @@ -12,15 +13,50 @@ Html({ data => [qw( unicode-cover.inc.pl )], }); -if (my $font = $ENV{PATH_INFO} =~ s{^/}{}r) { +if ($font) { my ($fontmeta, @cover) = do "ttfsupport/$font.inc.pl"; $fontmeta or die "Unknown font $font\n"; - my $offset = $get{q} || 0; + my $map = eval { + $get{map} or return; + + my $groupinfo = do 'unicode-cover.inc.pl' or die $@ || $!; + + my ($cat, $name) = split m{/}, $get{map}, 2 or die "invalid map\n"; + if (!$name) { + ($cat, $name) = ('table', $cat); + } + + my $row = $groupinfo->{$cat}->{$name} + or die "unknown character group $cat/$name\n"; + my $query = $row->{query}; + + my @map; + for (map { split /[^\d-]/ } $query) { + my @range = split /-/, $_, 2; + m/^[0-9]+$/ or die "Invalid code point $_ in query $query\n" for @range; + push @map, $_ for $range[0] .. ($range[1] // $range[0]); + } + return \@map; + }; + die $@ if $@; + + require Unicode::UCD; + + my $pagerows = 0x200; + my $pagecols = 32; + my $offset = eval { + local $_ = $get{q} || 0; + return $_ if /\A\d+\z/; # numeric + return hex $1 if /\A (?: 0?x | u\W* ) ([0-9a-f]+) \z/ix; # hexadecimal + return $_->[0]->[0] for Unicode::UCD::charblock(ucfirst) || (); # block + die "Unknown offset query '$_'\n"; + }; + die $@ if $@; say "

Font coverage

"; say "

$_

" for EscapeHTML($fontmeta->{name}); - printf("

Version %s released %s contains %d glyphs.

\n", + printf("

Version %s released %s contains %d glyphs.", !!$_->[2] && qq( title="revision $_->[2]"), $_->[1], $_->[0], scalar @cover, @@ -30,9 +66,22 @@ if (my $font = $ENV{PATH_INFO} =~ s{^/}{}r) { EscapeHTML($fontmeta->{version}), $fontmeta->{revision}, ]; - printf "

%s

\n", join('
', map { $_ ? EscapeHTML($_) : () } - $fontmeta->{copyright}, $fontmeta->{license}, - ); + for ($fontmeta->{os}) { + say '
'; + print ucfirst join(' ', + "distributed", + (map { "by $_" } $fontmeta->{oscorp} || "various sources"), + (map { "with $_" } $_ || ()), + ('and published as freeware "Core Web font"') x ($_ eq 'Windows 2000'), + (map { "under a $_ license" } + map { $fontmeta->{license} ? qq($_) : $_ } + $_ && $_ ne 'Android' ? 'proprietary' : 'free', + ), + ); + print '.'; + } + say '

'; + say "

$_

" for EscapeHTML($fontmeta->{copyright}) || (); require Shiar_Sheet::FormatChar; my $glyphs = Shiar_Sheet::FormatChar->new; @@ -42,21 +91,77 @@ if (my $font = $ENV{PATH_INFO} =~ s{^/}{}r) { say <<"EOT"; EOT say ''; - for my $cp ($offset .. $offset+0x1FF) { + + my $offsetlink = '?' . join('&', + (map { $_ . '=' . EncodeURI($get{$_}) } grep { defined $get{$_} } qw{ map }), + 'q', + ); + say "" for join(' ', grep {$_} + $offset > $pagerows && sprintf('◄', $offsetlink, 0), + $offset > 0 && sprintf( + '', + $offsetlink, $offset - $pagerows, + ), + sprintf('U+%04X', $map ? $map->[$offset] : $offset), + Unicode::UCD::charblock($map ? $map->[$offset] : $offset), + $offset + $pagerows < ($map ? @{$map} : 0x11_0000) && sprintf( + '', + $offsetlink, $offset + $pagerows, + ), + ); + + for my $cp ($offset .. $offset+$pagerows-1) { + $cp = $map->[$cp] or next if $map; + + state $colpos; + my $block = Unicode::UCD::charblock($cp); + if ($block ne (state $sameblock = $block) and $block ne 'No_Block') { + print ''; + printf '
$_
%s', $pagecols+1, $block + unless $block eq 'No_Block'; + say ''; + $sameblock = $block; + $colpos = 0; + } + + if ($map) { + # compare previous code point and indicate gaps + state $lastcp = 0; + if ($cp != ++$lastcp) { + if (!$colpos or $colpos++ % $pagecols > $pagecols - 3) { + # nearly last column, start new row + $colpos = 0; + } + else { + # mark repositioning in existing row + printf '%X', $cp; + } + $lastcp = $cp; + } + } + + say sprintf '
%X', $cp if $colpos++ % $pagecols == 0; + my $info = $glyphs->glyph_info($cp); - my ($class, $name, $mnem, $html, $string) = @{$info}; + my ($class, $name, $mnem, $entity, $string) = @{$info}; my $np = $class =~ /\bC\S\b/; # noprint if control or invalid - say sprintf '
%X', $cp if $cp % 32 == 0; + # display literal character, with placeholder circle if non-spacing/enclosing + my $html = ($class =~ /\bM[ne]\b/ && chr 9676) . EscapeHTML(chr $cp); say sprintf '%s', !$class ? ('l0', $cp, '', '') : $cover{$cp} ? $np ? 'l2' : 'l5' : $np ? 'Xi' : 'l1', $cp, !!$name && ": $name", - ($cover{$cp} || !$np) && EscapeHTML(chr $cp); + ($cover{$cp} || !$np) && $html; } say '
'; @@ -81,6 +186,8 @@ my @ossel = @{ $cover->{osdefault} }; my @fontlist = map { @{ $cover->{os}->{$_} } } @ossel; my @rows = ( + 'version/11', + 'version/63', 'block/Latin-1 Supplement', 'block/Latin Extended-A', 'block/Latin Extended Additional', @@ -117,15 +224,18 @@ if (my $group = $get{q}) { # output character list -print ''; +print '
'; print ''; print "" for map { scalar @{ $cover->{os}->{$_} } } @ossel; print ''; print ''; print ''; + $name = sprintf 'Unicode v%.1f', $name / 10 if $group eq 'version'; $name = sprintf '%s', EncodeURI("/chars/$group/$name"), EscapeHTML($name) if $row->{count} and $row->{count} < 1280; print ''; }
'; -printf '%s fonts', scalar @{ $cover->{os}->{$_} }, $_ - for @ossel; +for my $os (@ossel) { + my $osfonts = $cover->{os}->{$os}; + my $osfont = $cover->{fonts}->[ $osfonts->[0] ]; # first font + printf '%s', scalar @{$osfonts}, $osfont->{os} || '' +} print '
'; @@ -141,6 +251,7 @@ for (@rows) { my $row = $cover->{$group}->{$name}; print '
', $name; @@ -161,7 +272,7 @@ for (@rows) { my $rel = $count / $row->{count}; my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4; - printf '%d%%', "l$class", $rel*100; + printf '%d', "l$class", $rel*10; } say '