#! /usr/bin/perl -w

# mktexmf -- make a new MF 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: mktexmf,v 1.21 1999/05/30 18:57:41 olaf Exp
# 
# 
# Perl version:
# $Id: mktexmf,v 1.7 1999/07/18 23:40:48 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;
use TeX::Kpsewhich;
use Cwd;

$progname=basename($0);
$version=strip_quotes(<<'EOV');
:	Perl version: $Id: mktexmf,v 1.7 1999/07/18 23:40:48 jdg Exp $
:	based on /bin/sh version _Id: mktexmf,v 1.21 1999/05/30 18:57:41 olaf Exp _
EOV
$version =~ s/_/\$/g;
$usage=strip_quotes(<<EOU);
:	Usage: $progname FONT.
:	
:	Makes the Metafont source file for FONT, if possible. For example,
:	`ecr12' or `cmr11'.
EOU
# ' <- for the benefit of emacs users

# We now perform the necessary initialisations.  There are no special
# options for mktexmf.
mktex_opt();

# 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=basename($ARGV[0],'.mf');
($rootname,$pointsize) = $name=~/^(.*?)(\d*)$/;
# Don't go further if no pointsize
$pointsize or die "$progname: no pointsize in fontname!\n";

$sauterroot=$kpse_plain->find("b-$rootname.mf");
$rootfile='';  # Initialise it to satisfy -w
if ($sauterroot) {
	$rootfile=$sauterroot;
	$rootname="b-$rootname";
	$nametype = '';
} else {
	# Czech/Slovak fonts get special treatment:
	if ($rootname =~ /^(cs|i?lcsss|ics(csc|tt))/) {
		$rootfile = $kpse_plain->find("cscode.mf");
		$nametype = 'cs';
	}
	# LH fonts get special treatment:
	elsif ($rootname =~ m/^( # This is a horrendous regexp
			wn[bcdfirstuv]|
			rx[bcdfiorstuvx][bcfhilmostx]|
			l[abchl][bcdfiorstuvx]
		)/x) {
		$rootfile = $kpse_plain->find(substr($rootname,0,2) . 'codes.mf');
		$nametype = 'lh';
	}
	else {
		$rootfile = $kpse_plain->find("$rootname.mf");
		$nametype = '';
	}
}

exit 1 unless $rootfile and -f "$rootfile";

$mt_mfname=(mktex_names($name))[2];

$destdir=dirname($mt_mfname);
# The mktex_dir call will die if it fails
-d $destdir or mktex_dir($destdir);
chdir $destdir or die "$progname: can't chdir to $destdir: $!\n";

# Now, what's the pointsize?
%realsize=(11=>10.95, 14=>14.4, 17=>17.28, 20=>20.74, 25=>24.88,
	30=>29.86, 36=>35.83);
if (! ($realsize = $realsize{$pointsize})) {
	# The new convention is to have three or four letters for the
	# font name and four digits for the pointsize. The number is
	# pointsize * 100. We effectively divide by 100 by ignoring the
	# last two digits.
	if ($pointsize =~ /^\d{4,5}$/) { $realsize = $pointsize/100; }
	else { $realsize = $pointsize; }
}

$mfname="$name.mf";
if (-r "$mfname") {
   print "$progname: $destdir/$mfname already exists.\n";
	print SAVEOUT "$destdir/$mfname\n";
	mktex_upd($destdir,$mfname);
	exit 0;
}

push @cleanfiles, "mf$$.tmp";
open MFTMP, ">mf$$.tmp"
	or die "$progname: can't create temp file $destdir/mf$$.tmp: $!\n";

if ($name =~ /^(ec|tc)/) {
	print MFTMP strip_quotes(<<END);
:		if unknown exbase: input exbase fi;
:		gensize:=$realsize;
:		generate $rootname;
END
}
elsif ($name =~ /^dc/) {
	print MFTMP strip_quotes(<<END);
:		if unknown dxbase: input dxbase fi;
:		gensize:=$realsize;
:		generate $rootname;
END
}
elsif ($nametype eq 'cs') {
	print MFTMP strip_quotes(<<END);
:		input cscode;
:		use_driver;
END
}
elsif ($nametype eq 'lh') {
	print MFTMP strip_quotes(<<END);
:		input fikparm;
END
}
elsif ($name =~ m/^g[lorst][ijmtwx][cinou]/) {
	# A small superset of the names of the cbgreek fonts.
	print MFTMP strip_quotes(<<END);
:		gensize:=$realsize;
:		input $rootname;
END
}
else {
	print MFTMP strip_quotes(<<END);
:		design_size := $realsize;
:		input $rootname;
END
}

close MFTMP
	or die "$progname: problem writing to $destdir/mf$$.tmp: $!\n";

chmod +(stat cwd())[2] & 0644, "mf$$.tmp"
	or die "Couldn't chmod mf$$.tmp: $!\n";
unlink $mfname;
if (! move("mf$$.tmp","$mfname")) {
	unlink $mfname;
	die "Couldn't move mf$$.tmp to $mfname: $!\n";
}

print SAVEOUT "$destdir/$mfname\n";
print "$progname: $destdir/$mfname: successfully generated.\n";
mktex_upd($destdir, $mfname);

exit 0;
