#!/usr/local/bin/perl
# Filename - cvtbdf.pl
# Author - Geoff Baysinger (gbaysing@HiWAAY.net)
# Purpose - Allows "simple" installation of additional BDF fonts for GD.pm
# Usage - "cvtbdf.pl" (no arguments, see instructions)
# License - Freely given to be distributed with the GD.pm libraries
# (you may modify this script to your heart's content,
# but it may only be distributed by the author or via the GD.pm
# package.)
#
# Summary -
# Uses "bdftogd", (provided with GD.pm) to convert BDF fonts to GD format.
# It should makes the edits necessary to the GD.pm source files so that.
# the "bdftogd" process is automated and all the user needs do is recompile
# the GD.pm package (only "GD.so" is changed during compilation).
#
# Instructions -
# 1) go to your GD.pm source installation directory
# note: if you have already installed GD.pm, run a "make clean"
# 2) create a subdirectory called "fonts" (mkdir fonts)
# 3) copy the BDF font files you wish to convert to the "fonts" directory
# note: The BDF font must be a type that "bdftogd" can convert, hence
# it must be a standard monospaced character font, not a BDF
# cursor file. Some monospaced fonts may still not work. Test
# with "bdftogd" before running this script if you are unsure.
# 4) copy "bdftogd" and "cvtbdf.pl" to the "fonts" directory
# 5) run "cvtbdf.pl"
# 6) go to your GD.pm source installation directory and install the new
# version via a "make" and "make install"
#
# Notes -
# A) Keep the "fonts" subdirectory and all fonts you wish to use in the
# future. Each time you want to add a font you will need the old ones
# in the directory, or they will disappear during the next recompile.
# B) Add new fonts in the future is as easy as copying the .bdf file to
# the "fonts" directory and running steps #5 and #6 again.
#
# Thanks -
# To Lincoln Stein for the use of CGI.pm and GD.pm and to all other
# contributors of those packages.
# make sure we have the conversion program
if (! -x "bdftogd") { die "OOPS!\n Can't execute 'bdftogd', is it even there?\n error: $!\n\n"; }
&badnames;
&saveorig("GD.pm","GD.xs","libgd/Makefile.PL");
©orig("GD.pm","GD.xs","libgd/Makefile.PL");
for $i (@files) {
open(OLDXS,"../GD.xs") || die "OOPS!\n Can't open '../GD.xs' for reading\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
open(NEWXS,"> ../GD.xs.fonts") || die "OOPS!\n Can't open '../GD.xs.fonts' for writing\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
open(OLDPM,"../GD.pm") || die "OOPS!\n Can't open '../GD.pm' for reading\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
open(NEWPM,"> ../GD.pm.fonts") || die "OOPS!\n Can't open '../GD.pm.fonts' for writing\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
open(OLDMAKE,"../libgd/Makefile.PL") || die "OOPS!\n Can't open '../libgd/Makefile.PL' for reading\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
open(NEWMAKE,"> ../libgd/Makefile.PL.fonts") || die "OOPS!\n Can't open '../libgd/Makefile.PL.fonts' for writing\n Make sure you're in a 'fonts' subdirectory\n error: $!\n\n";
# some state-keeping variables
my $extern;
my $package;
my $export;
my $preload;
my $h;
my $c;
# figure out our "name"
my $name = "BDF" . $i;
$name =~ /(.*)\.bdf/;
$name = $1;
print "=> name = $name\n";
# do the actual font conversion:
open(FONT,"$i");
# usage: bdftogd fontname filename, eg. bdftogd FontLarge gdfontl }
my $fontname = "Font" . $name;
my $filename = "font" . $name;
my $gdname = "gdfont" . $name;
open(CONVERT,"| bdftogd $fontname $filename");
while (<FONT>) { print CONVERT; }
close CONVERT;
# move the font files to "../libgd"
open(OLD,"${gdname}.h");
open(NEW,"> ../libgd/${gdname}.h");
while (<OLD>) { print NEW; }
close OLD;
close NEW;
unlink("${gdname}.h");
open(OLD,"${gdname}.c");
open(NEW,"> ../libgd/${gdname}.c");
while (<OLD>) { print NEW; }
close OLD;
close NEW;
unlink("${gdname}.c");
## Begin editing files
# GD.xs:
while (<OLDXS>) {
$data = $_;
if (! $extern && $data =~ /^extern[\s]{1,}gdFontPtr/) {
$data = "extern gdFontPtr gdFont" . $name . ";\n" . $data;
$extern = 1;
} elsif (! $package && $data =~ /^MODULE[\s]*=[\s]*GD[\s]{1,}PACKAGE[\s]*=[\s]*GD::Font[\s]{1,}PREFIX=gd/) {
$data .= "\nGD::Font\ngd" . $name . "(packname=\"GD::Font\")\n char * packname\n PROTOTYPE: \$\n CODE:\n {\n RETVAL = gdFont" . $name . ";\n }\n OUTPUT:\n RETVAL\n";
$package = 1;
}
print NEWXS $data;
}
# GD.pm:
while (<OLDPM>) {
$data = $_;
if (! $export && $data =~ /\@EXPORT = qw\(/) {
$data .= " gd" . $name . "Font\n";
$export = "done";
} elsif (! $preload && $data =~ /^# Preloaded methods go here./) {
$data .= "sub GD::gd" . $name . "Font {\n return &GD::Font::" . $name . ";\n}\n";
$preload = "done";
}
print NEWPM $data;
}
# libgd/Makefile.PL:
while (<OLDMAKE>) {
$data = $_;
# 'H' => [qw(gd.h gdfontl.h gdfonts.h io.h gdfontg.h gdfontmb.h gdfontt.h mtables.h)],
if (! $h && $data =~ /^([\s]*'H'[\s]*\=\>[\s]*\[qw\(gd\.h[\s])(.*)/) {
$data = $1 . "${gdname}.h " . $2 . "\n";
$h = "done";
} elsif (! $c && $data =~ /^([\s]*'C'[\s]*\=\>[\s]*\[qw\(gdfontg\.c[\s])(.*)/) {
# 'C' => [qw(gdfontg.c gdfontmb.c gdfontt.c gdfontl.c gdfonts.c libgd.c)],
$data = $1 . "${gdname}.c " . $2 . "\n";
$c = "done";
}
print NEWMAKE $data;
}
# close the files
close OLDXS;
close NEWXS;
close OLDPM;
close NEWPM;
close OLDMAKE;
close NEWMAKE;
# copy the files to the proper extension
open(NEWXS,"../GD.xs.fonts");
open(OLDXS,"> ../GD.xs");
open(NEWPM,"../GD.pm.fonts");
open(OLDPM,"> ../GD.pm");
open(NEWMAKE,"../libgd/Makefile.PL.fonts");
open(OLDMAKE,"> ../libgd/Makefile.PL");
while (<NEWXS>) { print OLDXS; }
while (<NEWPM>) { print OLDPM; }
while (<NEWMAKE>) { print OLDMAKE; }
close NEWXS;
close OLDXS;
close NEWPM;
close OLDPM;
close NEWMAKE;
close OLDMAKE;
# unlink the temp files
unlink "../GD.pm.fonts";
unlink "../GD.xs.fonts";
unlink "../libgd/Makefile.PL.fonts";
}
sub saveorig {
local (@files) = @_;
for $file (@files) {
if (! -f "../${file}.orig") {
open(OLD,"../$file") || die $!;
open(ORIG,"> ../${file}.orig") || die $!;
while (<OLD>) { print ORIG; }
close OLD;
close ORIG;
}
}
}
sub copyorig {
local(@files) = @_;
for $file (@files) {
open(ORIG,"../${file}.orig") || die $!;
open(NEW,"> ../$file") || die $!;
while (<ORIG>) { print NEW; }
close ORIG;
close NEW;
}
}
sub badnames {
@badnames = (<*.BDF>,<*.Bdf>,<*.BDf>,<*.bDf>,<*.bDF>,<*.BdF>);
for $i (@badnames) {
my $goodname = $i;
$goodname =~ tr/A-Z/a-z/;
open(BAD,"$i");
open(GOOD,"> $goodname");
while (<BAD>) { print GOOD; }
close BAD;
close GOOD;
unlink $i;
}
@files = <*.bdf>;
}