#!/usr/local/bin/perl
eval 'exec /usr/local/bin/perl -S $0 "$@"'
	if $running_under_some_shell;

#  Usage:  MakeFont [-c cmd] [-m mode] [-d dpi] [-D]
#		[-p pkdir] [-g gfdir] [-t tfmdir] [-s slop] <name_1> ...
#
#
#  NOTE:  You should modify the defaults below to suit your particular
#  environment.  These include the default dpi, the default font type,
#  the command for running metafont, and the directory names containing
#  the font and font metric files.
#
#
#  <name> is something like "cmr10.360gf" or "cmbx12.432pk".
#  The type must be "pk" or "gf".
#  The appropriate mag step will be worked out from the magnification
#  value in the font name and the dpi number (given below).
#
#  If you leave off the trailing "gf" or "pk", the $def_type will
#  be assumed.
#
#  If you leave out the size, then no magnification will be used
#  (that is, you'll get magstep(0), or magnification = 1000).
#
#  If you get a message like "missing cmr10, scaled 1440" you can
#  use instead "cmr10@1440" for the font name.  The difference is
#  the use of the "@" sign rather than a period.  The font made will
#  be cmr10.432gf (assuming 300 dpi and default_type is "gf").
#
#  Using "cmr10" is the same as "cmr10@1000".  This means that given
#  a message like "missing cmr12" you can use "cmr12" rather than having
#  to say explicitly "cmr12@1000" (the message is unlikely to say
#  "scaled 1000" since the magnification factor is unity).
#
#  If you know you want a font at, say, magstep 1.5, you can use
#  "cmr10*1.5".  The font made will be "cmr10.394gf" (again, assuming
#  300 dpi and default_type is "gf").
#
#  The size need only be within "$slop" of the actual value.  With
#  $slop = 2, cmr10.298gf and cmr10.302gf, if given, will cause
#  cmr10.300gf to be made.  The same holds true for scale factors --
#  using cmr10@1439gf will make cmr10.432gf (again assuming 300 dpi).
#
#  The -D option will suppress the actual execution of any commands.
#  This is handy if you want to see what MakeFont would do, without
#  actually doing it.

# The default values appear below ---------------------------------------------

if (defined($ENV{'MFINPUTS'})) {
    print "MFINPUTS is set; revoking setuid permissions\n";
    $> = $<;
}
($<,$>) = ($>,$<);

$ENV{'PATH'} = "/bin:/usr/bin:/usr/ucb:/usr/local/bin";
$def_mode = "localfont";			# name of default printer
$def_dpi = 300;					# resolution of above
$def_command = "mf";				# default metafont command
$def_tfmdir = "/usr/local/lib/tex/fonts/tfm";	# TeX font metrics directory

$def_slop = 2;				# how close the numbers have to match
$def_type = "pk";			# default font type if none is given

# In the following pair, we want the "$" variables to be expanded later
# (after we have the correct values for things like $dpi!).  Hence the use
# of the single quotes.  Also, you must use the "${name}" notation!!!
# other values for the following might include '....../gf${dpi}', etc.

$def_gfdir = '/usr/local/lib/tex/fonts/${mode}-gf';
$def_pkdir = '/usr/local/lib/tex/fonts/${mode}-pk';

# End of the default values ---------------------------------------------------

($prog = $0) =~ s/.*\///;

require "getopts.pl";
&Getopts("c:m:d:Dg:p:t:s:") ||
    die "Usage: $prog [-c cmd] [-m mode] [-d dpi] [-D]" .
	" [-p pkdir] [-g gfdir] [-t tfmdir] [-s slop] font...\n";

$mf = defined($opt_c) ? $opt_c : $def_command;	# metafont command name
$mode = defined($opt_m) ? $opt_m : $def_mode;	# device type to make font for
$dpi = defined($opt_d) ? $opt_d : $def_dpi;	# device resolution
$pkdir = defined($opt_p) ? $opt_p : $def_pkdir;
$gfdir = defined($opt_g) ? $opt_g : $def_gfdir;
$tfmdir = defined($opt_t) ? $opt_t : $def_tfmdir;
$slop = defined($opt_s) ? $opt_s : $def_slop;

# Now that we have the correct values for $dpi, etc, expand the variables
# in $gfdir and $pkdir.

$gfdir =~ s/\${\w+}/eval $&/eg;
$pkdir =~ s/\${\w+}/eval $&/eg;

print "$prog: Using \"$mf\" to make fonts for \"$mode\" at $dpi dpi\n";

sub execute {
    local (@cmd) = @_;
    print join(" ", @cmd), "\n";
    if (!$opt_D) {
        return system @cmd;
    }
    else {
	return 0;		# indicate success
    }
}

sub abs {
    local($x) = @_;
    return ($x < 0) ? -$x : $x;
}

chdir "/usr/tmp";

$| = 1;

$mode = "\\mode:=$mode;";

foreach $font (@ARGV) {
    if ($font =~ /[.@*]/) {
	($name,$sep,$size,$type) = $font =~ /([^.@*]*)([.@*])([-0-9.]*)(.*)/;
    }
    else {
	$name = $font;
	$sep = "@";
	$size = "";
	$type = "";
    }
    $type = $type ? $type : $def_type;
    if ($type ne "gf" && $type ne "pk") {
	warn "unknown font type for $font -- must be \"gf\" or \"pk\"\n";
	next;
    }
    if ($sep eq "*") {		# convert magstep to magnification factor
	$size = 1000 * exp($size * log(1.2));
    }
    $base = ($sep eq ".") ? $dpi : 1000;
    $size = $size ? $size : $base;

    undef $magstep;
    $mag = 1;
    for (0..24) {
	if (&abs($size - int($base * $mag + 0.5)) <= $slop) {
	    $size = int($dpi * $mag + 0.5);
	    $magstep = $_/2;
	    last;
	}
	elsif (&abs($size - int($base / $mag + 0.5)) <= $slop) {
	    $size = int($dpi / $mag + 0.5);
	    $magstep = - $_/2;
	    last;
	}
	$mag *= sqrt(1.2);
    }
    if (!defined($magstep)) {
	$mag = "mag:=$size/$base;";
        $size = int($size * $dpi / $base + 0.5);
    }
    else {
	$mag = ($magstep != 0) ? "mag:=magstep($magstep);" : "";
    }

    print "$prog: Making \"$name.$size$type\"...\n";
    if (&execute("$mf", "$mode", "batchmode;", "$mag", "input $name") != 0) {
	print "$prog: metafont problems for \"$name.${size}gf\"" .
	    " -- saving \"$name.log\"\n";
    }
    else {
	do execute("rm", "-f", "$name.log");
    }
    if (! -r "$name.${size}gf" && ! $opt_D) {
	print "$prog: metafont failed for \"$name.${size}gf\"\n";
	next;
    }
    if ($type eq "pk") {
	if (&execute("gftopk", "./$name.${size}gf", "$name.${size}pk") != 0) {
	    print "$prog: gftopk failed for \"$name.${size}gf\"\n";
	    next;
	}
	else {
	    do execute("rm", "-f", "$name.${size}gf");
	}
	$destdir=$pkdir;
    }
    else {
	$destdir=$gfdir;
    }

    if (!defined($opt_p) && !defined($opt_g)) {
	($<,$>) = ($>,$<);
    }
    $ret = &execute("cp", "$name.$size$type", "$destdir");
    if (!defined($opt_p) && !defined($opt_g)) {
	($<,$>) = ($>,$<);
    }

    if ($ret != 0) {
	print "$prog: can't copy \"$name.$size$type\" to \"$destdir\"\n";
	print "$prog: leaving it in the current directory\n";
    }
    else {
	do execute("rm", "-f", "$name.$size$type");
    }
    if (-e "$tfmdir/$name.tfm") {
	if (&execute("cmp", "-s", "$name.tfm", "$tfmdir/$name.tfm") != 0) {
	    print "$prog: WARNING: problem with tfm file \"$name.tfm\"\n";
	    print "$prog: please let the TeX maintainer know.\n";
	}
	else {
	    do execute("rm", "-f", "$name.tfm");
	}
    }
    else {
	if (!defined($opt_t)) {
	    ($<,$>) = ($>,$<);
	}
	$ret = &execute("cp", "$name.tfm", "$tfmdir");
	if (!defined($opt_t)) {
	    ($<,$>) = ($>,$<);
	}
	if ($ret != 0) {
	    print "$prog: can't copy \"$name.tfm\" to \"$tfmdir\"\n";
	    print "$prog: leaving it in the current directory\n";
	}
	else {
	    do execute("rm", "-f", "$name.tfm");
	}
    }
}