X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/9ae15ec3a7007abdd580cd30e4d9e9fbb47628da..290c85c0f46c87ae95eeece911bdd3f57ba51dfd:/tools/mkfontinfo diff --git a/tools/mkfontinfo b/tools/mkfontinfo index 1bf181f..ed328cf 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} }, $_; } @@ -57,23 +63,32 @@ eval { 1; } or warn "Could not include count for html entities: $@"; -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 { + my $agemap = do 'unicode-age.inc.pl' + or warn "Could not include unicode version data: $!"; + + 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 ); + push @{ $charlist{version}->{$_} }, (chr $code) x ($agemap->{$code} <= $_) + for 11, 30, 63; + } + 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) { @@ -96,8 +111,32 @@ for my $chars (values %{$_}) { } } +$charlist{fonts} = \@fontlist; + +my %osfonts = ( + win95 => [qw( arial.win95 arialuni lucidau verdana.win95 times.win95 cour.win95 )], # microsoft + win8 => [map {"$_.win8"} qw( arial verdana times georgia pala cour )], + mac109 => [map {"$_.mac109"} qw( helv lucida times pala )], # apple + android => [qw( roboto droidmono notosans )], # google + oss => [qw( dvsans freesans code2000 unifont )], +); +if (0) { + # copy rows to derive older os versions (same list with different trailing number) + s/8$/7/ for @{ $osfonts{ win7} = [@{ $osfonts{ win8} }] }; + s/9$/7/ for @{ $osfonts{mac107} = [@{ $osfonts{mac109} }] }; +} + +my %fontnum = map { ($fontlist[$_]->{file} => $_) } 0 .. $#fontlist; +while (my ($os, $fontids) = each %osfonts) { + $charlist{os}->{$os} = [ map { $fontnum{$_} // () } @{$fontids} ]; +} +$charlist{osdefault} = [qw( win95 win8 mac109 android oss )]; + +say "# automatically generated by $0"; say 'use utf8;'; -say '+'.pp(\%charlist); +say '+', pp(\%charlist) =~ s{ + ( \[ \s* \d [^]]* ) ,\s* (?= \] ) # arrays of numbers, excluding trailing comma +}{ $1 =~ s/\s+//gr }msxgre; # strip whitespace __END__