#!/usr/bin/perl

# A script to add type 1 fonts to GhostScript's font map file.
# A lot of the interfacing stuff is copied from epstopdf (the head above, 
# option handeling etc.)
#
# I hope someone will find it usefull
# Peder Axensten <f95-pax@nada.kth.se>

# Program identification
my $program=		"gsbuildfontmap";
my $filedate=		"2002/10/21";
my $fileversion=	"1.3gw";
my $copyright=		"Copyright 2002 by Peder Axensten";
my $title=		"$program $fileversion, $filedate - $copyright";

# Options
$::opt_lc=	undef;
$::opt_debug=	undef;
$::opt_clear=	undef;
$::opt_texprefix=undef;
$::opt_gsprefix=undef;
$::opt_gsversion=undef;
$::opt_outfile=	undef;

# Usage
my @bool = ("false", "true");
my $fontdirstr=		"  ".(join "\n  ", @fontdirs)."\n";
my $usage = <<"END_OF_USAGE";
${title}Syntax:  $program [options]
Does a recursive search for type 1 fonts and adds them to GhostScript's
font map file. The following directories are searched:
$fontdirstr
Options:
  --help:		print usage
  --gsversion=<version>	Which version of gs to write map for
  --gsprefix=<dir>	where gs is installed
			(default: $::opt_gsprefix)
  --texprefix=<dir>	where tex is installed
			(default: $::opt_texprefix)
  --outfile=<file>	write result to <file>
			(default: $::opt_outfile)
  --(no)lc:		add lower case variants of font names (default: $bool[$::opt_lc])
  --(no)clear:		remove all entries by $program (default: $bool[$::opt_clear])
  --(no)debug:		debug informations (default: $bool[$::opt_debug])
END_OF_USAGE

# Process options
use Getopt::Long;
GetOptions (
	"texprefix=s",
	"gsversion=s",
	"gsprefix=s",
	"outfile=s",
	"lc!", 
	"clear!", 
	"debug!", 
) or die $usage;

$::opt_lc = 1 unless defined $::opt_lc;
$::opt_debug = 0 unless defined $::opt_debug;
$::opt_clear = 0 unless defined $::opt_clear;
if (not defined $::opt_texprefix) {
    # We prefer /usr/local/TeX
    $::opt_texprefix = "/usr/local/TeX" if (-d "/usr/local/TeX");
    $::opt_texprefix = "/usr/local/teTeX" if not defined $::opt_texprefix and -d "/usr/local/teTeX";
    die "No TeX found, please use the --texprefix option\n" unless defined $::opt_texprefix;
}
$::opt_gsprefix = "/usr/local" unless defined $::opt_gsprefix;;
die "No gs at $::opt_gsprefix/bin/gs\n" unless -x "$::opt_gsprefix/bin/gs";
$::opt_gsversion = `$::opt_gsprefix/bin/gs --version` unless defined $::opt_gsversion;
chomp( $::opt_gsversion);
$::opt_outfile=	"$::opt_gsprefix/share/ghostscript/$::opt_gsversion/lib/Fontmap.GS" unless defined $::opt_outfile;

my @fontdirs=	(	"$::opt_texprefix/share/texmf/fonts/type1",
			"$::opt_texprefix/share/texmf.local/fonts/type1",
			"$::opt_texprefix/share/texmf.tetex/fonts/type1",
			"$::opt_texprefix/share/texmf.macosx/fonts/type1",
			"$::opt_texprefix/share/texmf.gwtex/fonts/type1",
			"/System Folder/Fonts",
			"/System/Library/Fonts",
			"/Library/Fonts",
			"~/Library/Fonts"
			);

my $startstr=	"% Autogenerated fontmap starts here, don't change this line!";
my $endstr=	"% Autogenerated fontmap ends here, don't change this line!";

# First, copy the non-autogenerated part of the "old" font map
my $tempfile=	"$::opt_outfile"."2";
my $ignore;
open(IN, "$::opt_outfile") or die "Couldn't find $::opt_outfile.\n";
open(OUT, ">$tempfile") or die "Need write permissions for $tempfile.\n";
while(<IN>) {
	$ignore|=	/^$startstr$/;
	print OUT $_ if(!$ignore);
	$ignore&=	!/^$endstr$/;
}
close IN;


my %beenthere;
my $dir;
my $file;
my $font;
my $fontcount=		0;
my $aliascount=		0;
my $nofontcount=	0;
my @dircontents;
if(!$::opt_clear) {
    # Print the start tag and some info
    print OUT "$startstr\n% Generated by $title\n\n";
    foreach $dir (@fontdirs) {
	# We only visit each place once
	if(!exists $beenthere{$dir}) {
	    $beenthere{$dir}=	1;
	    
	    # Get the contents of the present directory
	    if(!opendir DIR, $dir) {
		print "Undefined dir: $dir\n" if $::opt_debug;
		next;
	    }
	    print "Now doing $dir\n" if $::opt_debug;
	    @dircontents=	grep $_= $dir.'/'.$_, grep !/^\./, readdir DIR;
	    closedir DIR;
	    
	    # Push the directories to be processed later
	    push @fontdirs, grep -d, @dircontents;
	    print join "", grep $_="    Dir:  $_\n", grep -d, @dircontents if $::opt_debug;
	    
	    # Process all the .pfb files
	    foreach $file (grep /\.pfb$/, @dircontents) {
		if(open(FONT, $file)) {
		    # Find the font name
		    read FONT, $_, 4000;
		    if(\/FontName [^a-zA-Z0-9]*([-_a-zA-Z0-9]+) def/) {
			# Add this font to the font map file
			$font=	$1;
			$fontcount++;
			print OUT "/".$font."\t($file) ;\n";
			if(($::opt_lc) and ($font eq uc $font) and ($font ne lc $font)) {
			    $aliascount++;
			    print OUT "/".(lc $font)."\t($file) ;\n";
			    print "    '$font' + '".(lc $font)."' in $file\n" if $::opt_debug;
			} else {
			    print "    '$font' in $file\n" if $::opt_debug;
			}
		    } else {
			print "    Unnamed font in $file\n" if $::opt_debug;
		    }
		    close FONT;
		} else {
		    print "    Could not open $file\n" if $::opt_debug;
		}
	    }
	}
    }
    # Print the end tag
    print "Found $fontcount named fonts\n" if ($fontcount);
    print "Added $aliascount lower case variants\n" if ($aliascount);
    print "Found $nofontcount unnamed fonts\n" if ($nofontcount);
    print "Found no fonts\n" if !($fontcount+$nofontcount);
    print OUT "\n";
    print OUT "% Found $fontcount named fonts\n" if ($fontcount);
    print OUT "% Added $aliascount lower case variants\n" if ($aliascount);
    print OUT "% Found $nofontcount unnamed fonts\n" if ($nofontcount);
    print OUT "$endstr\n";
}

close OUT;

# Substitute the old font map with the new
rename $tempfile, $::opt_outfile;

exit 0;