From: Mischa POSLAWSKY <perl@shiar.org>
Date: Tue, 4 Jan 2011 20:25:35 +0000 (+0100)
Subject: font: script to generate coverage data from ttf files
X-Git-Tag: v1.5~60
X-Git-Url: http://git.shiar.nl/sheet.git/commitdiff_plain/9defa38b80fd2091d37bb832ef1b02ddee242d51

font: script to generate coverage data from ttf files
---

diff --git a/tools/convert-ttf.pl b/tools/convert-ttf.pl
new file mode 100755
index 0000000..3a7cc0e
--- /dev/null
+++ b/tools/convert-ttf.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+
+use Data::Dump 'pp';
+use Font::TTF::Font;
+
+my ($ttfname, $outfile) = @ARGV;
+
+for ($outfile || ()) {
+	!-e $_ or die "Output file $outfile already exists\n";
+	open my $output, '>', $_ or die "Cannot write to $outfile: $!\n";
+	select $output;
+}
+
+{
+	my $ttf = Font::TTF::Font->open($ttfname)
+		or die "Cannot open truetype in $ttfname: $!";
+
+	my %meta = (
+		filename => $ttfname,
+		name     => $ttf->{name}->read->find_name(4) || $ttfname,
+		version  => $ttf->{head}->{fontRevision},
+		date     => (map {
+			$_ && eval {
+				require Time::Piece;
+				Time::Piece->new($_)->datetime;
+			}
+		} $ttf->{head}->getdate),
+	);
+	say pp(\%meta), ',';
+
+	my $support = $ttf->{cmap}->find_ms->{val};
+	warn scalar keys %$support, " characters read from $ttfname\n";
+	say pp(sort { $a <=> $b } keys %$support);
+}
+
+__END__
+
+=head1 NAME
+
+convert-ttf.pl - Writes unicode characters present in TrueType font
+
+=head1 SYNOPSIS
+
+    convert-ttf <font.ttf> [<output.inc.pl>]
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+Licensed under the GNU Affero General Public License version 3.
+