#!/usr/bin/perl
eval "exec /usr/bin/perl -S $0 $*"
	if $running_under_some_shell;
#Copyright 1990/07/18 Chris Lewis 2.1

#	Set to path of sfp2pk if you have it, otherwise NULL.
$sfp2pk	= '';
#	Threshold for acceptable point sizes (default 10%).
$thresh = 1.1;
#	Place to build new fonts
$newfonts = "/tmp/newfonts";
#	You might also want to adjust the "do gen"'s at the end.

#	Don't touch from here on.
$basedir = `pwd`;
chop($basedir);
@pointlist = (6, 7, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 28, 36);
$verbose = 0;
$dirlist = '';
#	If non-null, each font matching this pattern not needed to
#	build a particular size will be DELETED.
$discardpat = "";

$oldname = '';

sub discard {
    local($file) = $_[0];
    if ($discard && $file =~ $discardpat) {
	unlink($file);
	printf DISCARD ("deleted %s\n", $file);
    }
}

sub gen {
    local($outf, $engname, $escape, $outtype) = ($_[0], $_[1], $_[2], $_[3]);
    if ($sfontonly && $outf ne 'S') {
	return;
    }
    @namelist = @_;
    shift(namelist);
    shift(namelist);
    shift(namelist);
    shift(namelist);
    unlink("$outf.build");
    foreach $pointsize (@pointlist) {
	$found[$pointsize] = 0;
	$missing = '';
	$cmdline = "$basedir/pk2sfp -m \\\n";
	$usedfonts = '';
	$looklist = '';
	for ($i = 0; $i <= $#namelist; $i++) {
	    ($rnamelist, $map) = split(/\//, $namelist[$i]);
	    $best = '';
	    $bestratio = 1000;
	    $tmplist = '';

	    @alternates = split(/,/, $rnamelist);
	    foreach $rname (@alternates) {
		$ratio = $ratios{$rname, $pointsize};
		if (!$ratio) {
		    $looked = "$rname(notfound)";
		} else {
		    ($np, $size) = split(/ /, $table{$rname, $pointsize});
		    #$looked = sprintf("$rname$np.$size(%.2f)", $ratio);
		    $looked = sprintf("%s(%.2f)", $path{$rname, $pointsize},
			$ratio);
		    if ($ratio && $ratio <= $bestratio) {
			$best = $rname;
			$bestratio = $ratio;
			$bestentry = $looked;
		    }
		}
		$looklist .= "$looked\n";
		$tmplist .= "$looked ";
	    }
	    if ($best && $bestratio <= $thresh) {
		$usedfonts .= "$bestentry\n";
		$tdir = $path{$best, $pointsize};
		if (!$map) {
		    $map = $best;
		    if (! -r "$md/$map.$outtype") {
			$map = $alternates[0];
		    }
		}
		if (! -r "$md/$map.$outtype") {
		    $missing .= sprintf("Map file $map (for entry %s)\n",
			$namelist[$i]);
		}
		$cmdline .= "\t$md/$map.$outtype $tdir\\\n";
	    } else {
		$missing .= "($tmplist) ";
	    }
	}
	if ($missing) {
	    chop($missing);
	    printf STDERR ("Missing $missing, won't generate $outf at $pointsize\n");
	    printf STDERR ("Acceptable ones: $usedfonts\n");
	} else {
	    $cmdline .= "\t\t> t";
	    $found[$pointsize] = 1;
	    chop($usedfonts);
	    printf STDERR ("Generating $outf at $pointsize using $usedfonts\n");
	    if (system($cmdline)) {
		printf STDERR ("failed ($!) $cmdline\n");
		exit(1);
	    }
	    if (system("$basedir/pk2sfp t > $newfonts/$outf.$pointsize.sfp")) {
		printf STDERR ("pk2sfp sort to build $outf.$pointsize.sfp failed\n");
		exit(1);
	    }
	    unlink('t');
	    if ($sfp2pk) {
		if (system("$sfp2pk < $newfonts/$outf.$pointsize.sfp " .
		    "> $newfonts/$outf.$pointsize.pk")) {
		    printf STDERR ("sfp2pk < $outf.$pointsize.sfp failed\n");
		    exit(1);
		}
		unlink("$newfonts/$outf.$pointsize.sfp");
	    }
	    close(GEN);
	}
    }
    open(TABLE, ">>lj.fonts.new");
# The second field can be truncated, but none of the others.
#HI Helvetica-Italic \033(8U\033(s1p1s-3b04T nnnnpnnnnnnnnnn
#HB Helvetica-Bold   \033(8U\033(s1p0s03b04T nnnnnnnnnnnnnnn
    printf TABLE ("%-2s %-16.16s %-23s ", $outf, $engname, $escape);
    foreach $pointsize (@pointlist) {
	if ($found[$pointsize]) {
	    if ($sfp2pk) {
		printf TABLE 'p';
	    } else {
		printf TABLE 's';
	    }
	} else {
	    printf TABLE 'n';
	}
    }
    printf TABLE "\n";
    close(TABLE);
}
sub findcomplete {
    foreach $name (sort keys(listofnames)) {
	$complete{$name} = 0;
	foreach $p (@pointlist) {
	    if ($ratios{$name, $p} <= $thresh) {
		$complete{$name}++;
		next;
	    }
	}
    }
    foreach $name (sort keys(listofnames)) {
	printf STDERR ("I have %d reasonable sizes of %s\n", $complete{$name},
	    $name);
    }
}


sub dumplist {
    foreach $name (sort keys(listofnames)) {
	foreach $p (@pointlist) {
	    ($rp, $rs) = split(/ /, $table{$name, $p});
	    printf STDERR ("%-8s %4d %4d %4d %4.4g%% %s\n",
		$name, $p, $rp, $rs, (1 - $ratios{$name,$p}) * 100,
		$path{$name, $p});
	}
    }
}

while($arg = shift(@ARGV)) {
    if ($arg eq '-v') {
	$verbose = 1;
    } elsif ($arg =~ /-S/) {
	$sfontonly = 1;
    } elsif ($arg =~ /^-D(.*)/) {
	$basedir = $1;
    } elsif ($arg =~ /^-s(.*)/) {
	$sfp2pk = $1;
    } elsif ($arg =~ /^-f(.*)/) {
	$newfonts = $1;
    } elsif ($arg !~ /^-/) {
	if (-d $arg) {
	    $dirlist = "$dirlist $arg";
	} else {
	    printf STDERR ("No directory %s, skipping\n", $arg);
	}
    } else {
	printf STDERR ("calcfonts: bad option %s\n", $arg);
	exit(1);
    }
}

if ($sfp2pk && ! -x $sfp2pk) {
    printf STDERR
	("sfp2pk ($sfp2pk) not found - will generate SFP's not PK's\n");
    $sfp2pk = '';
}

if (!$dirlist) {
    printf STDERR ("No directories to search - aborting\n");
    exit(0);
}

$md = "$basedir/maps";
$dirlist = "$basedir/fonts $dirlist";

unlink("$basedir/lj.fonts.new");
unlink("discard");
open(DISCARD, ">discard");

$cmdline =
    "find $dirlist -type f '(' -name '*pk' -o -name '*.sfp' ')' -print";
printf STDERR ("Commandline: $cmdline\n");
open(INLIST, "$cmdline|") || die "Cannot start $cmdline\n";

while(<INLIST>) {
    chop;
    #/([a-z]+)([0-9]+)\s*:\s*(.*)/;
    $path = $_;
    if (/^\S+\/([a-z]+)([0-9]+)\.([0-9]+)pk/) {
	$name = $1;
	$points = $2;
	$size = $3;
    } elsif (/^\S+\/[a-z]+([0-9]+)\/([a-z]+)([0-9]+)\.pk/) {
	$size = $1;
	$name = $2;
	$points = $3;
    } elsif (/^\S+\/([a-z]+)([0-9]+)\.pk/) {
	$size = 300;
	$name = $1;
	$points = $2;
    } elsif (/^\S+\/([a-z]+)([0-9]+)\.sfp/) {
	$size = 300;
	$name = $1;
	$points = $2;
    } else {
	printf STDERR ("Skipping %s\n", $path);
	do discard($path);
	next;
    }
    $listofnames{$name} = 1;
    $actpoints = $points * $size / 300;
#printf("path: $path, name: $name, points: $points");
#printf(" size: $size, actpoints: $actpoints\n");
    $foundany = 0;
    foreach $needpoint (@pointlist) {
	$ratio = $actpoints / $needpoint;
	if ($ratio < 1) {
	    $ratio = 1 / $ratio;
	}
#printf("ratio: (to get %d) %.2f\n", $needpoint, $ratio);
	if ($ratios{$name, $needpoint} eq '') {
	    $ratios{$name, $needpoint} = 100;
	}

	if ($ratio <= $ratios{$name, $needpoint}) {
	    $ratios{$name, $needpoint} = $ratio;
	    $table{$name, $needpoint} = "$points $size";
	    $refcnt{$path}++;
	    if ($path{$name, $needpoint}) {
		$opath = $path{$name, $needpoint};
		$refcnt{$opath}--;
		if ($refcnt{$opath} == 0) {
		    printf DISCARD "%s\n", $opath;
		    do discard($opath);
		}
	    }
	    $path{$name, $needpoint} = $path;
	    $foundany++;
	}
    }
    if (!$foundany) {
	do discard($path);
	printf DISCARD "%s\n", $path;
    }
}

if ($verbose) {
    do findcomplete();
    do dumplist();
}

#	Example of do gen call:
# do gen(
#	'R',		Cat Troff name
#	'Times-Roman',	English name (useful only in debugging)
#	'\033(8U\033(s1p0s00b05T', Escape to emit if not present or builtin
#	'ROMAN8',	map suffix to use.
#	'cmr,jmr',	a font entry
#	'cmsy,jmsy',	a font entry
#	'cmti,jmti',	a font entry
#	'cmtrf,jmtrf');	a font entry
#
# There can be any number of font entries, and it is of the following
# generalized form:
#
#	<font>,<font>,<font>..../<map prefix>
#
#	Where: the list of fonts is a comma-separated list of
#	PK/SFP font name prefixes of fonts that would be acceptable
#	for merging with the other font entries to build the CAT font.
#	A font with that prefix closest to each desired point size will
#	be the one selected.  In case of ties, the later one wins in the
#	list.  The map prefix (along with the suffix) is used to select
#	which merge control file to use.  See pk2sfp and utils/maps.
#	If omitted, the map prefix will default to the font prefix that
#	it used if present.  If not present, it will default to the first
#	font prefix.
#	See LASERFONTS if you want more information on what the heck this
#	junk is doing.

do gen('R', 'Times-Roman', '\033(8U\033(s1p0s00b05T', 'ROMAN8',
    'cmr,jmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('I', 'Times-Italic', '\033(8U\033(s1p1s-3b05T', 'ROMAN8',
    'cmsl,jmsl/cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('B', 'Times-Bold', '\033(8U\033(s1p0s03b05T', 'ROMAN8',
    'cmbx,jmbx/cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

#	Shipped with psroff (as PK's):
do gen('S', 'Symbol', '\033(8M\033(s1p0s00b05T', 'MATH8',
    'cmr,jmr', 'cmsy,jmsy', 'cmmi,jmmi', 'cmtrf,jmtrf');

do gen('C', 'Courier', '\033(8U\033(s0p0s00b03T', 'ROMAN8',
    'cmtt,cmvtt,jmtt/cmtt', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('CI', 'Courier-Italic', '\033(8U\033(s1p1s-3b03T', 'ROMAN8',
    'cmit,cmsltt,jmit,jmsltt/cmtt', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('H', 'Helvetica', '\033(8U\033(s1p0s00b04T', 'ROMAN8',
    'cmss,lcmss,jmss/cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('HI', 'Helvetica-Italic', '\033(8U\033(s1p1s-3b04T', 'ROMAN8',
    'cmssi,lcmssi,jmssi/cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('HB', 'Helvetica-Bold', '\033(8U\033(s1p0s03b04T', 'ROMAN8',
    'cmssb,lcmssb,jmssbx/cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('E', 'English', '\033(8U\033(s1p0s00b05T', 'ROMAN8',
    'eufm/alnum', 'cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

do gen('EB', 'English-Bold', '\033(8U\033(s1p0s00b05T', 'ROMAN8',
    'eufb/alnum', 'cmr', 'cmsy,jmsy', 'cmti,jmti', 'cmtrf,jmtrf');

#"CI", "Courier-Italic", "\033(8U\033(s0p1s-3b03T", "ROMAN8",
#"CB", "Courier-Bold", "\033(8U\033(s0p0s03b03T", "ROMAN8",
#"L", "LinePrinter", "\033(8U\033(s0p0s00b00T", "ROMAN8",
#"LI", "LinePrinter-Ital", "\033(8U\033(s0p1s-3b00T", "ROMAN8",
#"LB", "LinePrinter-Bold", "\033(8U\033(s0p0s03b00T", "ROMAN8",
