- It relies on [url=http://www.lcdf.org/type/t1disasm.1.html]t1disasm[/url] from the [url=http://www.lcdf.org/type/index.html#t1utils]LCDF Type 1 Utilities[/url] (t1utils).
- It ignores character subroutines. For some fonts, this is a nonissue. For others, it will produce incorrect glyphs.
- It expects literal arguments for all functions. That is, [i]5 somefunc[/i] is okay, but [i]2 3 add somefunc[/i] is not. I believe that loading a font into [url=http://fontforge.sourceforge.net/]FontForge[/url] and re-saving it may help.
Note that most fonts are copyrighted and that format conversions are a form of derivative work. I'm not a lawyer, but I'd guess that you're probably not legally allowed to distribute a CFDG version of most Type 1 fonts.
That said, here's the code:
Code: Select all
#! /usr/bin/env perl
#######################################################
# Convert a PostScript Type 1 font (.pfb) to a set of #
# paths in the Context Free Design Grammar (.cfdg) #
# #
# By Scott Pakin <scott+cfdg@pakin.org> #
#######################################################
# This script is released under the terms of #
# the GNU General Public License, version 3 #
# (http://www.gnu.org/licenses/gpl-3.0.html). #
#######################################################
use Getopt::Long;
use File::Basename;
use Switch;
use warnings;
use strict;
# Define variables that can be set via the command line.
my $wanthelp = 0; # 1=display help and exit; 0=do nothing
my $prefix; # Prefix string for each symbol name
# Define some other global variables.
my $progname = basename $0; # Name of thie program
my $usagestr = "Usage: $progname [--prefix=<string>] <font.pfb>";
my $t1disasm = "t1disasm"; # Program to disassemble a PFB file
my $xscale = 1.0; # Multiplier for each x coordinate
my $yscale = 1.0; # Multiplier for each y coordinate
my @cfdgcode; # Current CFDG path code
my %allcharnames; # All character names encountered
my $notice; # Font's copyright notice
my $fullname; # Human-readable font name
# Parse the command line.
GetOptions("prefix|p=s" => \$prefix,
"help|h" => \$wanthelp)
|| die "$usagestr\n";
die "$usagestr\n" if $wanthelp;
die "Usage: $progname <font.pfb>\n" if $#ARGV == -1;
my $pfbfile = $ARGV[0];
# Generate an ASCII version of the font and parse it line-by-line
# until we reach the character definitions.
open(PFBTEXT, "$t1disasm $pfbfile|") || die "${progname}: Failed to process $pfbfile using $t1disasm\n";
while (my $oneline = <PFBTEXT>) {
chomp $oneline;
if ($oneline =~ m,^/FontMatrix\s*\[([\d.]+) [\d.]+ [\d.]+ ([\d.]+),) {
# Scale each coordinate by the provided amount.
$xscale = $1 + 0.0;
$yscale = $2 + 0.0;
}
elsif ($oneline =~ m,/FontName\s*/(\S+) def$,) {
# Use the font name in the default name prefix.
$prefix = "$1_" if !defined $prefix;
$prefix =~ s/\W/_/g;
}
elsif ($oneline =~ m,/FullName\s*\((.*)\)\s*readonly def,) {
# Store the human-readable version of the font name.
$fullname = $1;
}
elsif ($oneline =~ m,/Notice\s*\((.*)\)\s*readonly def,) {
# Store the font's copyright notice.
$notice = $1;
}
elsif ($oneline =~ m,/CharStrings,) {
# We've reached the glyph data -- time to switch gears.
last;
}
}
# Output some header comments.
print "/*\n";
printf " * CFDG version of %s\n", ($fullname || basename $pfbfile);
print " * Font notice: $notice\n" if defined $notice;
print " * Redistribution may be restricted; see the font's license agreement\n";
print " * Font was converted to CFDG by pfbtocfdg, written by Scott Pakin <scott+cfdg\@pakin.org>\n";
print " */\n\n";
# Define a subroutine that formats a line of CFDG code and pushes it
# onto the @cfdgcode list.
sub pushcfdg ($@)
{
my $template = $_[0];
$template =~ s/NUM/\%.4f/g;
my @scaledargs = (@_[1..$#_], 0.0);
for (my $i=0; $i<$#scaledargs; $i+=2) {
$scaledargs[$i+0] *= $xscale;
$scaledargs[$i+1] *= $yscale;
}
push @cfdgcode, sprintf $template, @scaledargs;
}
# Process each character.
my $charname; # Name of the current character
my $charwidth; # Width of the current character
while (my $oneline = <PFBTEXT>) {
# Process the beginning and ending of character definitions.
chomp $oneline;
if ($oneline =~ m,/(\S+) \{,) {
# Start of a new character definition
next if $1 eq ".notdef";
if (defined $allcharnames{$1}) {
warn "${progname}: Ignoring repeated definition of character \"$1\"\n";
next;
}
$charname = $1;
$charname =~ s/\W/_/g;
$allcharnames{$charname} = 1;
next;
}
elsif ($oneline =~ m,\},) {
# End of a character definition
if (!defined $charname) {
# Character was canceled.
undef @cfdgcode;
next;
}
pushcfdg "FILL { param evenodd }";
printf "// Character \"%s\", width %.4f\n", $charname, $charwidth*$xscale;
print "path ${prefix}${charname} \{\n";
print " ", join("\n ", @cfdgcode), "\n\}\n\n";
undef @cfdgcode;
undef $charname;
next;
}
# Convert each glyph to CFDG.
next if $oneline !~ /\w/;
my @fields = split " ", $oneline;
switch ($fields[$#fields]) {
case "hsbw" {
# Horizontal sidebearing and width
pushcfdg "MOVETO { x NUM y NUM }", ($fields[0], 0.0);
$charwidth = $fields[1];
}
case "sbw" {
# Sidebearing and width
pushcfdg "MOVETO { x NUM y NUM }", ($fields[0], $fields[1]);
$charwidth = $fields[2];
}
case /^([hvr])(line|move)to$/ {
# Horizontal/vertical/relative line or motion
my $type = substr($fields[$#fields], 0, 1);
my $action = substr($fields[$#fields], 1, 4);
my @newfields = (0.0, 0.0);
$newfields[0] = $fields[0] if $type =~ /[hr]/;
$newfields[1] = $fields[$#fields-1] if $type =~ /[vr]/;
pushcfdg "\U$action\EREL { x NUM y NUM }", @newfields;
}
case /^(hv|vh|rr)curveto$/ {
# Bezier curve
my $type = substr($fields[$#fields], 0, 2);
my @newfields;
switch ($type) {
case "rr" { @newfields = @fields[0..5] }
case "vh" { @newfields = (0.0, @fields[0..3], 0.0) }
case "hv" { @newfields = ($fields[0], 0.0,
$fields[1], $fields[2],
0.0, $fields[3]) }
}
foreach my $i (2 .. 5) {
$newfields[$i] += $newfields[$i-2];
}
pushcfdg "CURVEREL { x1 NUM y1 NUM x2 NUM y2 NUM x NUM y NUM }", @newfields;
}
case [qw(callothersubr callsubr pop setcurrentpoint seac)] {
# Unimplemented command -- may produce an incorrect glyph
warn "${progname}: Ignoring command \"$fields[$#fields]\" in character \"$charname\"\n" if defined $charname;
}
}
}
close PFBTEXT;