#! /usr/bin/perl -w

# mktexpk -- make a new PK file, because one wasn't found.
# 
# This Perl version is based on the original /bin/sh version:
# 
#   te@informatik.uni-hannover.de, kb@mail.tug.org, and infovore@xs4all.nl.
#   Public domain.
#   RCS Id: mktexpk,v 1.25 1999/05/29 20:38:21 olaf Exp
# 
# 
# Perl version:
# $Id: mktexpk,v 1.8 1999/07/20 23:07:17 jdg Exp $
# Copyright 1999, Julian Gilbey <jdg@debian.org>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use File::Basename;
use File::Copy;
use TeX::Mktex qw(:DEFAULT mknam_nomfdrivers $MT_FEATURES $TEMPDIR
		$DPI $BDPI $MODE $MAG $ps_to_pk);
use TeX::Kpsewhich;
use Cwd;

$progname=basename($0);
$version=strip_quotes(<<'EOV');
:	Perl version: $Id: mktexpk,v 1.8 1999/07/20 23:07:17 jdg Exp $
:	based on /bin/sh version _Id: mktexpk,v 1.25 1999/05/29 20:38:21 olaf Exp _
EOV
$version =~ s/_/\$/g;
$usage=strip_quotes(<<EOU);
:	Usage: $progname [OPTIONS] NAME [REDIRECT]
:	  Create a PK font.
:	
:	--dpi DPI           use resolution DPI.
:	--bdpi BDPI         use base resolution BDPI.
:	--mag MAG           use magnificiation MAG.
:	--mfmode MODE       use MODE as the METAFONT mode.
:	--destdir DESTDIR   write fonts in DESTDIR.
:	
:	Try to create a PK file for NAME at resolution DPI, with an assumed
:	device base resolution of BDPI, and a Metafont `mag' of MAG. Use MODE
:	for the METAFONT mode.  Use DESTDIR for the root of where to install
:	into, either the absolute directory name to use (if it starts with a
:	/) or relative to the default DESTDIR (if not). REDIRECT, if supplied,
:	is a string of the form '>&n', where n is the number of the file
:	descriptor which is to receive, instead of stdout, the name of the
:	newly created pk file.
EOU
#` <- for emacs users

# We now perform the necessary initialisations.
$mt_max_args=2;
mktex_opt('destdir=s', \$DEST, 'dpi=i', \$opt_dpi, 'bdpi=i', \$opt_bdpi,
	'mfmode=s', \$opt_mode, 'mag=s', \$opt_mag);

$DPI = $opt_dpi || $DPI;
$BDPI = $opt_bdpi || $BDPI;
$opt_mode ne '/' and $MODE = $opt_mode || $MODE;
$MAG = $opt_mag || $MAG;
$MAG =~ m|^[-+/\d]+$| or die "$progname: invalid mag: $MAG";

if (defined $ARGV[1]) {
	if ($ARGV[1] =~ /^>&(\d+)$/) {
		if ($1 != 1) {
			open STDOUT, ">&=$1"
				or die "$progname: can't use fd $1 for stdout: $!\n";
		}
	}
	else {
		warn "$progname: argument '$ARGV[1]' ignored - badly formatted.\n" .
			"(Try $progname --help for more information.)\n";
	}
}


# Where do potential mf driver files go?
":$MT_FEATURES:" =~ /:nomfdrivers:/ && mknam_nomfdrivers();

# All output except for the font location should go to stderr
open SAVEOUT, ">&STDOUT" or die "$progname: can't dup stdout: $!\n";
open STDOUT, ">&STDERR" or die "$progname: can't dup stderr onto stdout: $!\n";

$NAME=(fileparse($ARGV[0], '\.\d*pk'))[0];

# ps_to_pk is set in mktex.opt
if ($ps_to_pk eq 'gsftopk') {
	if (system("gsftopk -t $NAME </dev/null") >> 8 == 0) {
		$cmd="gsftopk $NAME $DPI";
	}
}
elsif ($ps_to_pk eq 'ps2pk') {
	# grep for the font in $PSMAPFILE.  These are base font names, such as
	# rpplr (the original) or pplr0 (an interim step) or pplr8r (current).
	@ARGV = $kpse_plain->find({'format' => 'dvips config'},
		'ps2pk.map', 'psfonts.map');
	while (<>) {
		/^$NAME($|[ \t])/o && last;
	}
	if ($_) {
		tr /<"[//d;  # " <- for sake of emacs users!
		@fields=split;
		shift @fields; shift @fields; shift @fields;
		while ($_ = shift @fields) {
			/\.enc$/ and $encoding = "-e $_", next;
			/\.pf[ab]$/ and $psname = $_, next;
			/SlantFont$/ and $slant = "-S $lastopt", next;
			/ExtendFont$/ and $extend = "-E $lastopt", next;
		}
		continue {
			$lastopt = $_;
		}
	}

	# Guessing the name of the type1 font file as fallback:
	($ANAME=$NAME) =~ s/8r$/8a/;
	OUTER: foreach $base ($NAME, $ANAME) {
		foreach $suffix (qw(pfa pfb)) {
			$kpse_plain->find("$base.$suffix") and
				$psname="$base.$suffix", last OUTER;
		}
	}

	if (! $psname) {
		warn "$progname: cannot find $NAME.pfa or $NAME.pfb. Trying gsftopk.\n";
		$cmd = "gsftopk $NAME $DPI";
	}
	else {
		$cmd = "ps2pk -v -X$DPI -R$BDPI " .
			"$slant $extend $encoding $psname $NAME.${DPI}pk";
	}
}

if (! $cmd) {
	if (system("(ttf2pk -t -q $NAME) >/dev/null 2>&1") >> 8 == 0) {
		$cmd = "ttf2pk -q $NAME $DPI";
	}
	elsif (system("(hbf2gf -t -q $NAME) >/dev/null 2>&1") >> 8 == 0) {
		$cmd = "hbf2gf -q $NAME $DPI";
	}
}

if ($cmd) {
	$MODE = 'modeless';
}
else {
	# Check that $BDPI and $MODE are consistent; if not, ignore the mode and
	# hope we can correctly guess it from bdpi.  (People like to specify the
	# resolution on the command line, not the mode so much.)
	if (length $MODE) {
		open MF, "mf '\\mode:=$MODE; mode_setup; " .
			"message\"BDPI=\"&decimal round pixels_per_inch; end.' </dev/null |"
				or die "$progname: Cannot run METAFONT BDPI test: $!\n";
		while (<MF>) {
			/BDPI=(\d+)/ and $mf_bdpi=$1, last;
		}
		close MF or die "$progname: Problem running METAFONT BDPI test: $!\n";
		if ($mf_bdpi != $BDPI) {
			warn "$progname: Mismatched mode $MODE and resolution $BDPI; " .
				"ignoring mode.\n";
			$MODE='';
		}
	}
	
	# If an explicit mode is not supplied, try to guess. You can get a
	# list of extant modes from ftp://ftp.tug.org/tex/modes.mf.
	if (! length $MODE or $MODE eq 'default') {
		%default_modes=(
			  85 => 'sun',
			 100 => 'nextscrn',
			 180 => 'toshiba',
			 300 => 'cx',
			 400 => 'nexthi',
			 600 => 'ljfour',
			1270 => 'linoone',
		);
		if (exists $default_modes{$BDPI}) {
			$MODE=$default_modes{$BDPI};
		}
		else {
			die "$progname: Can't guess mode for $BDPI dpi devices.\n" .
				"$progname: Use a config file, or update me.\n";
		}
	}
	
	# Run Metafont. Always use plain Metafont, since reading cmbase.mf
	# does not noticeably slow things down.
	$cmd = "mf '\\mode:=$MODE; mag:=$MAG; nonstopmode; input $NAME'";
}

$PKDEST = (mktex_names($NAME, $DPI, $MODE, $DEST))[0];

($PKNAME, $PKDESTDIR) = fileparse($PKDEST);
$GFNAME="$NAME.${DPI}gf";

if (-r $PKDEST) {
	print "$progname: $PKDEST already exists.\n";
	print SAVEOUT "$PKDEST\n";
	mktex_upd($PKDESTDIR, $PKNAME);
	exit 0;
}

# Try to create the destdir first. Do not create fonts, if this fails.
mktex_dir($PKDESTDIR);
die "$progname: mktex_dir $PKDESTDIR failed!\n" if ! -d $PKDESTDIR;

print "$progname: Running $cmd\n";
if (system("$cmd </dev/null") >> 8 != 0) {
	die "$progname: `$cmd' failed\n" unless -f "$NAME.log";
	# Don't abort if only "Strange path" or "bad pos" errors occurr.
	open LOG, "<$NAME.log"
		or die "$progname: Can't open $NAME.log file: $!\n";
	$strange=$badpos=0;
	while (<LOG>) {
		if (/^! Strange path/) {
			$strange++;
		}
		elsif (/^! bad pos./) {
			$badpos++;
		}
		elsif (/^! /) {
			-s "$NAME.log" && move("$NAME.log", $KPSE_DOT);
			die "$progname: `$cmd' failed.  (Log in $KPSE_DOT)\n";
		}
	}
	close LOG
		or die "$progname: problem reading $NAME.log: $!\n";
	$strange || $badpos and
		warn "$progname: warning: `$cmd' caused" .
			($strange ?
				(" $strange strange path error" . ($strange>1 ? "s" : "")) : "") .
			($strange && $badpos ? " and" : "") .
			($badpos ?
				(" $badpos bad pos error" . ($badpos>1 ? "s" : "")) : "") .
			".\n";
}

if (-r $GFNAME) {
	system("gftopk ./$GFNAME $PKNAME </dev/null") >> 8 == 0
		or die "$progname: gftopk ./$GFNAME $PKNAME failed: $!\n";
}

if (! -f $PKNAME and -f "$NAME.${DPI}pk") {
	move ("$NAME.${DPI}pk", $PKNAME)
		or die "$progname: couldn't move $NAME.${DPI}pk to $PKNAME: $!\n";
}

-s $PKNAME or die "$progname: `$cmd' failed to make $PKNAME.\n";

# Install the PK file carefully, since others may be working simultaneously.
push @cleanfiles, "$PKDESTDIR/pk$$.tmp";
unless (move($PKNAME, "$PKDESTDIR/pk$$.tmp")) {
	my $err="$!";
	unlink "$PKDESTDIR/pk$$.tmp";
	die "$progname: move of pk file to destination directory failed: $err\n";
}

unless (chdir $PKDESTDIR) {
	my $err="$!";
	unlink "$PKDESTDIR/pk$$.tmp";
	die "$progname: chdir $PKDESTDIR failed: $err\n";
}

unless (chmod +(stat cwd())[2] & 0644, "pk$$.tmp") {
	my $err="$!";
	unlink "pk$$.tmp";
	die "$progname: chmod pk$$.tmp failed: $err\n";
}

if (! -r $PKNAME) {
	unless(move("pk$$.tmp", $PKNAME)) {
		my $err="$!";
		unlink "pk$$.tmp", $PKNAME;
		die "$progname: move pk$$.tmp $PKNAME failed: $err\n";
	}
	-r $PKNAME
		or die "$progname: couldn't install $PKNAME and don't know why not!\n";
}

# OK, success with the TFM.
mktex_upd($PKDESTDIR, $PKNAME);
print SAVEOUT "$PKDEST\n";
print "$progname: $PKDEST: successfully generated.\n";

exit 0;
