X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/4e71d82512759ed7da92d213ac66d006dae456a1..aeb47e7600bf4e34a37f3ebfe0e6edc534d92147:/font.plp diff --git a/font.plp b/font.plp index 1e1732b..e64e204 100644 --- a/font.plp +++ b/font.plp @@ -1,117 +1,236 @@ <(common.inc.plp)><: +use 5.014; Html({ title => 'character support sheet', - version => 'v1.0', - keywords => [qw' - unicode glyph char character reference common ipa symbol sign mark table digraph - '], - stylesheet => [qw'light dark mono circus red'], - data => [qw'unicode-table.inc.pl unicode-char.inc.pl'], + version => 'v1.2', + keywords => [qw( + unicode font glyph char character support overview cover coverage + script block symbol sign mark reference table + )], + stylesheet => [qw( light dark mono circus red )], + data => [qw( unicode-cover.inc.pl )], }); +if (my $font = $ENV{PATH_INFO} =~ s{^/}{}r) { + my ($fontmeta, @cover) = do "ttfsupport/$font.inc.pl"; + $fontmeta or die "Unknown font $font\n"; + + 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.", + !!$_->[2] && qq( title="revision $_->[2]"), + $_->[1], $_->[0], + scalar @cover, + ) for [ + grep { $_ } + ($fontmeta->{date} || '?') =~ s/T.*//r, + EscapeHTML($fontmeta->{version}), + $fontmeta->{revision}, + ]; + 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; + + my %cover = map { ($_ => 1) } @cover; # lookup map + + say <<"EOT"; + + +EOT + say ''; + + say "" for join(' ', grep {$_} + $offset > $pagerows && sprintf('◄', 0), + $offset > 0 && sprintf( + '', + $offset - $pagerows, + ), + sprintf('U+%04X', $offset), + Unicode::UCD::charblock($offset), + $offset + $pagerows < 0x11_0000 && sprintf( + '', + $offset + $pagerows, + ), + ); + + for my $cp ($offset .. $offset+$pagerows-1) { + 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; + } + + say sprintf '
%X', $cp if $colpos++ % $pagecols == 0; + + my $info = $glyphs->glyph_info($cp); + my ($class, $name, $mnem, $html, $string) = @{$info}; + my $np = $class =~ /\bC\S\b/; # noprint if control or invalid + # 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) && $html; + } + say '
'; + + exit; +} + :> -

Character support

+

Font coverage

-Selected characters from Unicode preset -or range. +Character support of Unicode +blocks and presets.

<: -use 5.010; -use Shiar_Sheet::FormatChar; -my $glyphs = Shiar_Sheet::FormatChar->new; -my %oslist = ( - win95 => [qw/arial ariuni verdana times/], - mac10 => [qw//], - oss => ['dv ss', qw/droid c2k guf/], - - android => ['droid'], +my $cover = do 'unicode-cover.inc.pl' or die $@ || $!; + +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', + 'block/Latin Extended-B', + 'script/Latin', + 'script/Greek', + 'script/Cyrillic', + 'script/Arabic', + 'script/Hebrew', + 'script/Devanagari', + 'script/Thai', + 'script/Hangul', + 'table/japanese', + 'script/Han', + 'table/ipa', + 'table/punctuation', + 'block/Dingbats', + 'table/symbols', + 'category/Sc', # currency + 'table/math', + 'category/Sm', # mathematical + 'table/arrows/single', + 'table/lines/single', + 'table/block', + 'table/lines', + 'table/html', ); -my @ossel = qw(win95 oss); -my $tables = do 'unicode-table.inc.pl' or die $@ || $!; -my (%font, @fontlist); +if (my $group = $get{q}) { + my $grouprows = $cover->{$group} + or die "Unknown character category $_\n"; + @rows = map { "$group/$_" } sort keys %{$grouprows}; +} + +# output character list + +print ''; +print ''; +print "" + for map { scalar @{ $cover->{os}->{$_} } } @ossel; + +print ''; +print ''; } -:> - +say "
'; for my $os (@ossel) { - my $osfonts = $oslist{$os}; - for my $fontid (@{$osfonts}) { - push @fontlist, $fontid; - my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl"; - $fontmeta or next; - $font{$fontid} = { - -id => $fontmeta->{id} || $fontid, - -name => $fontmeta->{name}, - map { (chr $_ => 1) } @fontrange - }; - } + my $osfonts = $cover->{os}->{$os}; + my $osfont = $cover->{fonts}->[ $osfonts->[0] ]; # first font + printf '%s', scalar @{$osfonts}, $osfont->{os} || '' } -my @config = qw( - punctuation/common punctuation/marks - latin/sample - symbols/signs1 -); -$_ and m{/*+(.+)} and @config = split /[ ]/, $1 for $ENV{PATH_INFO}, $get{q}; -@config = qw(ipa/cons ipa/vowels) if 0; - -for (@config) { - my ($tablegroup, $tablename) = split m{/}, $_, 2; - - print ''; - printf '', "$tablegroup: $tablename"; - say ''; - print '' x 3; - print "" for 2, map { scalar @{$oslist{$_}} } @ossel; - print ''; - print ''; - my $table = $tables->{$tablegroup}->{$tablename}; - - for my $chr (@$table) { - $chr =~ m/^\./ .. 1 or next; - given ($chr) { - when (/^[.]/) { - print "\n"; - next; - } - when ([qw(> - =)]) { - next; - } +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 '
%s
char'; - print 'name'; - print 'dihtml'; - printf('%s', - (map { - scalar @{$_}, - join(', ', map { $_->{-name} } @font{ @{$_} }), - } $oslist{$_}), - $_, - ) for @ossel; - say '
'; +printf('%s', map { EscapeHTML($_) } + join("\n", $_->{name}, $_->{description}), + "/font/$_->{file}", + $_->{abbr}, +) for @{ $cover->{fonts} }[@fontlist]; +say ''; + +for (@rows) { + my ($group, $name) = split m{/}, $_, 2; + my $row = $cover->{$group}->{$name}; + + print '
', $name; + print '', $row->{count}; + for my $count (@{ $row->{support} }[@fontlist]) { + if (not defined $count) { + print '?'; + next; + } + if (not $count) { + print '✘'; + next; + } + if ($count == $row->{count}) { + print '✔'; + next; } - my $ex = s/^-//; - my $codepoint = ord $chr; - my $ascii = $codepoint <= 127; - - print "
$chr\n"; - my $info = $glyphs->glyph_info($codepoint); - my ($class, $name, $mnem, $html, $string) = @$info; - print "$_" for sprintf('%X', $codepoint), EscapeHTML($name); - printf '%s', @$_ for ( - [$ascii ? 'l0' : defined $mnem ? 'l4' : 'l1', $mnem // ''], - [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''], - (map { - !$font{$_}->{-id} ? [l0 => "$_?"] : - $font{$_}->{$chr} ? [l4 => $font{$_}->{-id}] : [l1 => ''] - } @fontlist), - ); + my $rel = $count / $row->{count}; + my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4; + printf '%d%%', "l$class", $rel*100; } - say "
\n"; + say '
\n"; + +:>