#!/usr/bin/perl

# a coverage script

# depends on Unicode::UCD and Font::TTF

# by Martin Hosken

# small tweaks by Nicolas Spalinger

use Font::TTF::Font;

use Unicode::UCD qw(charblocks charblock charscripts charscript);

use Getopt::Std;

getopts('s');

my $blocks, $stats;

if ($opt_s)

{

    $blocks = charscripts;

}

else

{

    $blocks = charblocks;

}

foreach (keys %{$blocks})

{

    foreach $r (@{$blocks->{$_}})

    { $stats->{$_}[0] += ($r->[1] - $r->[0]) + 1; }

}

$f = Font::TTF::Font->open($ARGV[0]) || die "Can't open font $ARGV[0]";

$cmap = $f->{'cmap'}->read->find_ms->{'val'};

foreach $c (keys %{$cmap})

{

    $r = $opt_s ? charscript($c) : charblock($c);

    $stats->{$r}[1]++;

}

foreach (sort keys %{$stats})

{

    next unless ($_ && $stats->{$_}[1]);

    printf "%s: %d/%d (%.2f%%)\n", $_, $stats->{$_}[1], $stats->{$_}[0], $stats->{$_}[1] / $stats->{$_}[0] * 100.;

}