#! /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.11 2001/11/28 13:08:00 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 $KPSE_DOT
		  $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.11 2001/11/28 13:08:00 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
# `

# 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',
			360 => 'epstylus',
			400 => 'nexthi',
			600 => 'ljfour',
			720 => 'epscszz',
			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;
