<(common.inc.plp)><: 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-cover.inc.pl ttfsupport unicode-char.inc.pl )], }); use 5.010; use Shiar_Sheet::FormatChar; my $glyphs = Shiar_Sheet::FormatChar->new; my $groupinfo = do 'unicode-cover.inc.pl' or die $@ || $!; my @ossel = @{ $groupinfo->{osdefault} }; my @fontlist = map { $_->{file} } @{ $groupinfo->{fonts} }[ map { @{ $groupinfo->{os}->{$_} } } @ossel ]; my %font; for my $fontid (@fontlist) { my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl"; $fontmeta or next; $font{$fontid} = { (map { (-$_ => $fontmeta->{$_}) } keys %{$fontmeta}), map { (chr $_ => 1) } @fontrange }; } # parse input my ($title, $parent) = ('Character overview'); my $query = eval { for ($ENV{PATH_INFO} || ()) { s{^/}{}; return $_ if m{^[0-9 +-]+$}; my ($cat, $name) = split m{/}, $_, 2 or die "invalid query\n"; if (!$name) { ($cat, $name) = ('table', $cat); } my $row = $groupinfo->{$cat}->{$name} or die "unknown character group $cat/$name\n"; $title = ucfirst EscapeHTML($name).' characters'; $parent = $cat; return EscapeHTML($row->{query}); } } || $get{q}; say "

$title

"; if (!$query) { say "

Unicode group not specified: $@

"; exit; }; for ($parent || 'Unicode range') { my %CATDESC = ( block => 'Unicode block', script => 'Unicode script', category => 'Unicode category', table => 'Unicode preset group', ); say sprintf('

List %s in selected %s.

', 'characters and font support', $CATDESC{$parent} || $parent, ); } my @chars; for (map { split /[^\d-]/ } $query) { my @range = split /-/, $_, 2; m/^[0-9]+$/ or die "Invalid code point $_ in query $query\n" for @range; push @chars, chr $_ for $range[0] .. ($range[1] // $range[0]); } @chars or die "No match for query $query\n"; @chars <= 1500 or die sprintf( 'Too many matches (%d) for query %s'."\n", scalar @chars, $query, ); # output character list say '

'; print ''; print '' x 3; print "" for 2, map { scalar @{ $groupinfo->{os}->{$_} } } @ossel; print ''; print ''; print ''; for my $chr (@chars) { my $codepoint = ord $chr; my $ascii = $codepoint <= 127; print "

character'; print '			input'; printf '		%s', scalar @{ $groupinfo->{os}->{$_} }, $_ for @ossel; print '
unicode'; print '		name'; print '	di	html'; printf('	%s', map { EscapeHTML($_) } join("\n", $font{$_}->{-name}, $font{$_}->{-description}), $font{$_}->{-abbr}, ) for @fontlist; say '
$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 ? $class =~ /\bu-di\b/ ? 'l4' : 'l3' : 'l1', EscapeHTML($mnem) // ''], [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''], (map { !defined $font{$_}->{-name} ? [l0 => '?'] : $font{$_}->{$chr} ? [l4 => '✔'] : [l1 => '✘'] } @fontlist), ); } say "

\n"; say "

\n";