X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/08817fabd6fb93f65754166fdcaaa75c928d9651..d9d251ca5b512130cfb4cb9a3e03aa6748f67526:/tools/mkfontinfo diff --git a/tools/mkfontinfo b/tools/mkfontinfo index a9f0d37..12c53a5 100755 --- a/tools/mkfontinfo +++ b/tools/mkfontinfo @@ -5,22 +5,27 @@ use warnings; use utf8; use open OUT => ':utf8', ':std'; -use List::Util 'reduce'; use File::Basename 'basename'; use Data::Dump 'pp'; -our $VERSION = '1.00'; +our $VERSION = '1.01'; -my %font; +my @fontlist; + +my %cover; my $incsuffix = '.inc.pl'; for my $fontfile (glob 'ttfsupport/*'.$incsuffix) { my ($fontid) = basename($fontfile, $incsuffix); my ($fontmeta, @fontrange) = do $fontfile or next; - $font{$fontid} = { - -id => $fontmeta->{id} || $fontid, - -name => $fontmeta->{name}, - map { (chr $_ => 1) } @fontrange - }; + $fontmeta->{file} = $fontid; + my $year = substr $fontmeta->{date}, 0, 4; + $fontmeta->{description} = join(' ', + (map { "version $_" } $fontmeta->{version} || ()), + $fontmeta->{version} && $fontmeta->{version} =~ /\Q$year/ ? () : + (map { "($_)" } $year || ()), + ); + push @fontlist, $fontmeta; + $cover{$fontid} = { map { (chr $_ => 1) } @fontrange }; } my %charlist; @@ -36,6 +41,7 @@ if ($chartables) { next if /^[.-]/; next if $_ eq '>' or $_ eq '='; s/^\\//; # escape + length $_ == 1 or next; # multiple characters lost in query push @{ $charlist{table}->{"$tablegroup/$tablename"} }, $_; push @{ $charlist{table}->{$tablegroup} }, $_; } @@ -46,23 +52,38 @@ if ($chartables) { } } -use Unicode::UCD 'charinfo'; -for my $code (0 .. 256**2) { - my $charinfo = charinfo($code) or next; - next if $charinfo->{category} =~ /^[MC]/; # ignore Marks and "other" Control chars - push @{ $charlist{$_}->{ $charinfo->{$_} } }, chr $code - for qw( script category block ); -} +eval { + require HTML::Entities; + our %char2entity; + HTML::Entities->import('%char2entity'); + while (my ($char, $entity) = each %char2entity) { + $entity =~ /[a-zA-Z]/ or next; # only actual aliases + push @{ $charlist{table}->{html} }, $char; + } + 1; +} or warn "Could not include count for html entities: $@"; + +eval { + use Unicode::UCD 'charinfo'; + for my $code (0 .. 256**2*2) { + my $charinfo = charinfo($code) or next; + next if $charinfo->{category} =~ /^[MC]/; # ignore Marks and "other" Control chars + push @{ $charlist{$_}->{ $charinfo->{$_} } }, chr $code + for qw( script category block ); + } + 1; +} or warn "Could not include unicode groups: $@"; for (values %charlist) { for my $chars (values %{$_}) { - my %row = map { - my $fontcover = $font{$_}; - ($_ => scalar grep { $fontcover->{$_} } @{$chars}); - } keys %font; - $row{-count} = scalar @{$chars}; - - $row{-query} = eval { + my %row; + $row{support} = [ + map { scalar grep { defined } @{ $cover{$_->{file}} }{ @{$chars} } } + @fontlist + ]; + $row{count} = scalar @{$chars}; + + $row{query} = eval { my @query = map { ord } sort @{$chars}; my $i = 0; while ($i < @query) { @@ -85,6 +106,23 @@ for my $chars (values %{$_}) { } } +$charlist{fonts} = \@fontlist; + +my %osfonts = ( + win95 => [qw( arial.win95 arialuni lucidau verdana.win95 times.win95 cour.win95 )], # microsoft + win7 => [qw( arial.win7 verdana.win7 times.win7 cour.win7 )], + win8 => [qw( arial.win8 verdana.win8 times.win8 cour.win8 )], + mac10 => [qw( helvetica.mac10 lucida.mac10 times.mac10 garamond.mac10 palatino.mac10 lucida.mac10 )], # apple + android => [qw( roboto notosans )], # google + oss => [qw( dvsans code2000 unifont opensans )], +); +my %fontnum = map { ($fontlist[$_]->{file} => $_) } 0 .. $#fontlist; +while (my ($os, $fontids) = each %osfonts) { + $charlist{os}->{$os} = [ map { $fontnum{$_} // () } @{$fontids} ]; +} +$charlist{osdefault} = [qw( win95 win8 mac10 oss android )]; + +say "# automatically generated by $0"; say 'use utf8;'; say '+'.pp(\%charlist);