pfbtocfdg -- Convert a PostScript Type 1 font to CFDG paths

Here you can discuss and share functionality improvements and helper programs to make Context Free better.

Moderators: MtnViewJohn, chris, mtnviewmark

Post Reply
User avatar
pakin
Posts: 40
Joined: Sat Apr 21, 2007 8:59 pm
Location: United States
Contact:

pfbtocfdg -- Convert a PostScript Type 1 font to CFDG paths

Post by pakin »

A few people expressed interest in the technique I used to produce the text for my Curses image in the Context Free gallery. Attached below is pfbtocfdg, a Perl script I wrote that converts a PostScript Type 1 font to a collection of CFDG paths, one per character. Before using it, note that pfbtocfdg has a number of limitations:
    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.
Feel free to expand upon the code and try to solve some of those limitations.

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;
Enjoy!

User avatar
TorfusPolymorphus
Posts: 27
Joined: Sun Dec 28, 2008 2:16 pm
Contact:

Post by TorfusPolymorphus »

Thanks for the great tool!

The Open Font Library has a collection of fonts with a license that allows modifications and redistributions (under similar constraints as other open source licenses). Many of their fonts can be downloaded in Type 1 format.

Post Reply