font: numbered fonts; os groups in include

diff --git a/chars.plp b/chars.plp
index 9197e5ca9a44907d3bc790a9e5c46e98af5964fc..775674ec62e98157571912f885dc5e46132657b6 100644 (file)
--- a/chars.plp
+++ b/chars.plp
@@ -14,27 +14,20 @@ use 5.010;
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 

-my %oslist = (
-       win95   => [qw( arial ariuni verdana times )],  # microsoft
-       mac10   => [qw( lucida garamond )],  # apple
-       android => [qw( roboto noto )],  # google
-       oss     => [qw( dvsans c2k unifont )],
-);
-my @ossel = qw( win95 mac10 oss android );
+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, @fontlist);
-for my $os (@ossel) {
-       my $osfonts = $oslist{$os};
-       for my $fontid (@{$osfonts}) {
-               push @fontlist, $fontid;
+my %font;
+for my $fontid (@fontlist) {

                my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl";
                $fontmeta or next;
                $font{$fontid} = {
                my ($fontmeta, @fontrange) = do "ttfsupport/$fontid.inc.pl";
                $fontmeta or next;
                $font{$fontid} = {

-                       -id   => $fontmeta->{id} || $fontid,
-                       -name => $fontmeta->{name},
+                       (map { (-$_ => $fontmeta->{$_}) } keys %{$fontmeta}),

                        map { (chr $_ => 1) } @fontrange
                };
                        map { (chr $_ => 1) } @fontrange
                };

-       }

 }
 
 # parse input
 }
 
 # parse input


@@ -50,13 +43,12 @@ my $query = eval {
                        ($cat, $name) = ('table', $cat);
                }
 
                        ($cat, $name) = ('table', $cat);
                }
 

-               my $groupinfo = do 'unicode-cover.inc.pl' or die $@ || $!;

                my $row = $groupinfo->{$cat}->{$name}
                        or die "unknown character group $cat/$name\n";
 
                $title = ucfirst EscapeHTML($name).' characters';
                $parent = $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});
+               return EscapeHTML($row->{query});

        }
 } || $get{q};
 
        }
 } || $get{q};
 


@@ -99,19 +91,20 @@ for (map { split /[^\d-]/ } $query) {
 say '<div>';
 print '<table class=mapped>';
 print '<col>' x 3;
 say '<div>';
 print '<table class=mapped>';
 print '<col>' x 3;

-print "<colgroup span=$_>" for 2, map { scalar @{$oslist{$_}} } @ossel;
+print "<colgroup span=$_>"
+       for 2, map { scalar @{ $groupinfo->{os}->{$_} } } @ossel;

 
 print '<thead><tr>';
 print '<td colspan=3>character';
 print '<td colspan=2>input';
 
 print '<thead><tr>';
 print '<td colspan=3>character';
 print '<td colspan=2>input';

-printf '<td colspan=%d>%s fonts', scalar @{ $oslist{$_} }, $_
+printf '<td colspan=%d>%s', scalar @{ $groupinfo->{os}->{$_} }, $_

        for @ossel;
 
 print '<tr>';
 print '<td colspan=2>unicode';
 print '<td>name';
 print '<td><a href="/digraphs" title="digraph">di</a><td>html';
        for @ossel;
 
 print '<tr>';
 print '<td colspan=2>unicode';
 print '<td>name';
 print '<td><a href="/digraphs" title="digraph">di</a><td>html';

-printf '<td title="%s">%s', $font{$_}->{-name}, $font{$_}->{-id} // $_
+printf '<td title="%s">%s', $font{$_}->{-name}, $font{$_}->{-abbr}

        for @fontlist;
 say '</thead>';
 
        for @fontlist;
 say '</thead>';
 


@@ -128,7 +121,7 @@ for my $chr (@chars) {
                        EscapeHTML($mnem) // ''],
                [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''],
                (map {
                        EscapeHTML($mnem) // ''],
                [$ascii ? 'l0' : defined $html ? 'l4' : 'l1', $html // ''],
                (map {

-                       !$font{$_}->{-id} ? [l0 => '?'] :
+                       !defined $font{$_}->{-name} ? [l0 => '?'] :

                        $font{$_}->{$chr} ? [l4 => '✔'] : [l1 => '✘']
                } @fontlist),
        );
                        $font{$_}->{$chr} ? [l4 => '✔'] : [l1 => '✘']
                } @fontlist),
        );

diff --git a/font.plp b/font.plp
index 2d449f08194d51054c6e08a5191ed096e2602518..98fff40ade1bc140b524e0758380cd64f4d58d0d 100644 (file)
--- a/font.plp
+++ b/font.plp
@@ -26,17 +26,11 @@ use 5.010;
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 
 use Shiar_Sheet::FormatChar;
 my $glyphs = Shiar_Sheet::FormatChar->new;
 

-my %oslist = (
-       win     => [qw( arial ariuni lucidau verdana times courier )],  # microsoft
-       mac     => [qw( helvetica lucida times garamond palatino )],  # apple
-       android => [qw( roboto noto )],  # google
-       oss     => [qw( dvsans c2k unifont opensans )],
-);
-my @ossel = qw( win mac oss android );
-my @fontlist = map { @{ $oslist{$_} } } @ossel;
-

 my $cover = do 'unicode-cover.inc.pl' or die $@ || $!;
 
 my $cover = do 'unicode-cover.inc.pl' or die $@ || $!;
 

+my @ossel = @{ $cover->{osdefault} };
+my @fontlist = map { @{ $cover->{os}->{$_} } } @ossel;
+

 my @rows = (
        'block/Latin-1 Supplement',
        'block/Latin Extended-A',
 my @rows = (
        'block/Latin-1 Supplement',
        'block/Latin Extended-A',


@@ -75,15 +69,18 @@ for my $group ($ENV{PATH_INFO} || ()) {
 
 print '<table class=mapped>';
 print '<col><col>';
 
 print '<table class=mapped>';
 print '<col><col>';

-print "<colgroup span=$_>" for map { scalar @{$oslist{$_}} } @ossel;
+print "<colgroup span=$_>"
+       for map { scalar @{ $cover->{os}->{$_} } } @ossel;

 
 print '<thead><tr>';
 print '<th colspan=2>';
 
 print '<thead><tr>';
 print '<th colspan=2>';

-printf '<th colspan=%d>%s fonts', scalar @{ $oslist{$_} }, $_ for @ossel;
+printf '<td colspan=%d>%s fonts', scalar @{ $cover->{os}->{$_} }, $_
+       for @ossel;

 
 print '<tr>';
 print '<th colspan=2>';
 
 print '<tr>';
 print '<th colspan=2>';

-printf '<td>%s', $_ for @fontlist;
+printf '<td title="%s">%s', $_->{name}, $_->{abbr}
+       for @{ $cover->{fonts} }[@fontlist];

 say '</thead>';
 
 for (@rows) {
 say '</thead>';
 
 for (@rows) {


@@ -92,11 +89,10 @@ for (@rows) {
 
        print '<tr>';
        $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)
 
        print '<tr>';
        $name = sprintf '<a href="%s">%s</a>', EncodeURI("/chars/$group/$name"), EscapeHTML($name)

-               if $row->{-count} and $row->{-count} < 1280;
+               if $row->{count} and $row->{count} < 1280;

        print '<th>', $name;
        print '<th>', $name;

-       print '<td class=right>', $row->{-count};
-       for (@fontlist) {
-               my $count = $row->{$_};
+       print '<td class=right>', $row->{count};
+       for my $count (@{ $row->{support} }[@fontlist]) {

                if (not defined $count) {
                        print '<td class="l0">?';
                        next;
                if (not defined $count) {
                        print '<td class="l0">?';
                        next;


@@ -105,12 +101,12 @@ for (@rows) {
                        print '<td class="l1">✘';
                        next;
                }
                        print '<td class="l1">✘';
                        next;
                }

-               if ($count == $row->{-count}) {
+               if ($count == $row->{count}) {

                        print '<td class="l5">✔';
                        next;
                }
 
                        print '<td class="l5">✔';
                        next;
                }
 

-               my $rel = $count / $row->{-count};
+               my $rel = $count / $row->{count};

                my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
                printf '<td class="%s">%d%%', "l$class", $rel*100;
        }
                my $class = $rel < .5 ? 2 : $rel < .9 ? 3 : 4;
                printf '<td class="%s">%d%%', "l$class", $rel*100;
        }

diff --git a/tools/mkfontinfo b/tools/mkfontinfo
index deada09937691bd4e94aa7676e86ddb5b7a1153e..09cc4d24e1839139d5cb43e801143972c8bd0cdb 100755 (executable)
--- a/tools/mkfontinfo
+++ b/tools/mkfontinfo
@@ -5,22 +5,21 @@ use warnings;
 use utf8;
 
 use open OUT => ':utf8', ':std';
 use utf8;
 
 use open OUT => ':utf8', ':std';

-use List::Util 'reduce';

 use File::Basename 'basename';
 use Data::Dump 'pp';
 
 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;
 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;
+       push @fontlist, $fontmeta;
+       $cover{$fontid} = { map { (chr $_ => 1) } @fontrange };

 }
 
 my %charlist;
 }
 
 my %charlist;


@@ -67,13 +66,14 @@ for my $code (0 .. 256**2) {
 
 for (values %charlist) {
 for my $chars (values %{$_}) {
 
 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) {
                my @query = map { ord } sort @{$chars};
                my $i = 0;
                while ($i < @query) {


@@ -96,6 +96,20 @@ for my $chars (values %{$_}) {
 }
 }
 
 }
 }
 

+$charlist{fonts} = \@fontlist;
+
+my %osfonts = (
+       win95   => [qw( arial arialuni lucidau verdana times courier )],  # microsoft
+       mac10   => [qw( helvetica lucida times garamond palatino )],  # apple
+       android => [qw( roboto noto )],  # google
+       oss     => [qw( dvsans c2k 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 mac10 oss android )];
+

 say "# automatically generated by $0";
 say 'use utf8;';
 say '+'.pp(\%charlist);
 say "# automatically generated by $0";
 say 'use utf8;';
 say '+'.pp(\%charlist);

diff --git a/tools/mkttfinfo b/tools/mkttfinfo
index 3dfd8b75330483fd345ca20e5123875fae361766..1d8e69906269d95af82fb6844798c4b126f9d06d 100755 (executable)
--- a/tools/mkttfinfo
+++ b/tools/mkttfinfo
@@ -62,7 +62,8 @@ my %FONTID = (
                        }
                } $ttf->{head}->getdate),
        );
                        }
                } $ttf->{head}->getdate),
        );

-       $meta{id} = $FONTID{ $meta{name} } // lc $ttfname;
+       $meta{abbr} = $FONTID{ $meta{name} } // lc $ttfname;
+

        say "# automatically generated by $0";
        say '+', pp(\%meta), ',';
 
        say "# automatically generated by $0";
        say '+', pp(\%meta), ',';