#!/usr/bin/perl
# Written by Martin Hosken of SIL's NRSI
# http://scripts.sil.org
# 
# (C) copyright 2008 Martin Hosken - SIL International 
# released under the Perl Artistic License.
#
# you need the Font::TTF perl module available on http://search.cpan.org/dist/Font-TTF/
# or libfont-ttf-perl in Debian/Ubuntu
# 
# tweaks by Nicolas Spalinger
#
# TODO:
# - show full Unicode name
# - parse copyright/license/designer metadata of fonts given as parameters
# to find out if it's an open font or not (open as in http://scripts.sil.org/OFL_fonts or http://unifont.org/fontguide)
# and to get upstream or someone else to extend the font to support proper rendering of the target content.

use Font::TTF::Font;
use IO::File;

unless ($ARGV[1])
{
    die<<'EOT';
    txtfontcoverage <infile> font1.ttf font2.ttf font2.otf...
Examines a text in <infile> and takes as parameters TrueType/OpenType fonts
intended to cover all the characters in that text. If any characters are not
covered, list them at the end with their Unicode code points. Earlier fonts
take precedence over later ones.
EOT
}

my ($src) = shift @ARGV;
foreach $fn (@ARGV)
{
    my $f = Font::TTF::Font->open($fn) || die "Can't open font file $fn (only .ttf/.otf supported)" ;
    my $c = $f->{'cmap'}->read->find_ms;
    foreach $u (sort keys %{$c->{'val'}})
    { $map{$u} = $fn unless (defined $map{$u}); }
    $f->release;
}

my $fin = IO::File->new("< $src") || die "Can't open $src";
while (<$fin>)
{
    chomp;
    my (@list) = unpack('U*', $_);
    foreach $l (@list)
    {
        if (defined $map{$l})
        { $flist{$map{$l}}++; }
        else
        { $unk{$l}++; }
    }
}

print "txtfontcoverage (using Font::TTF)\n";
print "==================================\n\n";
print "Text coverage analysed with the following fonts:\n";
print join("\n", sort keys %flist);
print "\n\nCharacters, if any, (shown as Unicode code points) not covered by any fonts above:\n";
print join(" ", map { sprintf("U+%04X", $_) } sort {$a <=> $b} keys %unk);
print "\n";