#!/usr/bin/perl

# Written by Skip Collins <bernard.collins@jhuapl.edu>

use File::Basename;
@plsuffixlist = "\.pl";
@vplsuffixlist = "\.vpl";

if ( ($#ARGV<0)||($#ARGV>2) || ($ARGV[0] =~ "-help")) {
    print "Usage: remap PLFILE[.pl] [AIPLFILE[.pl] [VPLFILE[.vpl]]]\n";
    print "  Translate PLFILE to AIPLFILE and companion VPLFILE.\n";
    print "  Default AIPLFILE is aiPLFILE.pl.\n";
    print "  Default VPLFILE is PLFILE.vpl.\n";
    print "\n";
    print "--help  display this help and exit\n";
} else {
    ($plbasename, $plpath, $plsuffix) = fileparse($ARGV[0], @plsuffixlist);
    if ($plsuffix eq "") {
	$plsuffix = "\.pl";
    }
    $plfile = $plpath.$plbasename.$plsuffix;
    if ($#ARGV >= 1) {
	($aiplbasename, $aiplpath, $aiplsuffix) = fileparse($ARGV[1], @plsuffixlist);
	if ($aiplsuffix eq "") {
	    $aiplsuffix = "\.pl";
	}
	$aiplfile = ">".$aiplpath.$aiplbasename.$aiplsuffix;
	$mapname = $aiplbasename;
	if ($#ARGV == 2) {
	    ($vplbasename, $vplpath, $vplsuffix) = fileparse($ARGV[2], @vplsuffixlist);
	    if ($vplsuffix eq "") {
		$vplsuffix = "\.vpl";
	    }
	    $vplfile = ">".$vplpath.$vplbasename.$vplsuffix;
	} else {
	    $vplfile = ">".$plpath.$plbasename."\.vpl";
	}
    } else {
	$aiplfile = ">".$plpath."ai".$plbasename."\.pl";
	$vplfile = ">".$plpath.$plbasename."\.vpl";
	$mapname = "ai".$plbasename;
    }
    open(INPUT, $plfile) || die "Can't open $plfile.";
    open(OUTPUT_PL, $aiplfile) || die "Can't open $aiplfile.";
    open(OUTPUT_VPL, $vplfile) || die "Can't open $vplfile.";
    $sevenbitflag = "FALSE";
    while (<INPUT>) {
	$string = $_;
	if ($string =~ /\(CHECKSUM/) {
# Ooops. FONTCHECKSUM should refer to the mapped font, not this font.
# Maybe it's best to leave it empty.
#	    $mapchecksum = $string;
#	    $mapchecksum =~ s/\s*\(CHECKSUM\s*O\s*//;
#	    $mapchecksum =~ s/\)\s*//;
	} else {
	    print OUTPUT_VPL "$string";
	    $plstring = $string;
	    if (!($string =~ /\(FACE|\(HEADER|\(SKIP|\(TOP O 0\)|\(MID O 0\)|\(BOT O 0\)/)) {
		$plstring =~ s/\sO\s[0-7]+/shift_octal_numbers($&)/ge;
		if ($string =~ /\(DESIGNSIZE/) {
		    $mapdsize = $string;
		    $mapdsize =~ s/\s*\(DESIGNSIZE\s*R\s*//;
		    $mapdsize =~ s/\)\s*//;
		    print OUTPUT_VPL "(MAPFONT O 0\n";
		    print OUTPUT_VPL "   (FONTNAME  $mapname)\n";
#		    print OUTPUT_VPL "   (FONTCHECKSUM O $mapchecksum)\n";
		    print OUTPUT_VPL "   (FONTAT R 1.0)\n";
		    print OUTPUT_VPL "   (FONTDSIZE R $mapdsize)\n";
		    print OUTPUT_VPL "   )\n";
		} elsif ($string =~ /\(CHARACTER/) {
		    $mapchar = $string;
		    $mapchar =~ s/\s*\(CHARACTER\s*O\s*//;
		    $mapchar =~ s/\s*$//;
		    $mapchar = " O $mapchar";
		    $newmapchar = shift_octal_numbers($mapchar);
# Originally, I wanted only to remap problematic characters. But, in
# order to minimize the number of duplicate references to external fonts
# and therefore reduce the likelihood of uncovering subtle bugs in ps/pdf
# output, I will instead map all characters in the virtual font.
#		    if ($newmapchar ne $mapchar) {
		    print OUTPUT_VPL "   (MAP\n";
		    print OUTPUT_VPL "      (SETCHAR$newmapchar)\n";
		    print OUTPUT_VPL "      )\n";
#		    }
		} elsif ($string =~ /\(SEVENBITSAFEFLAG/) {
		    $sevenbitflag = "TRUE";
		}
	    }
	    print OUTPUT_PL "$plstring";
	}
    }
# SEVENBITSAFEFLAG does not seem to take. So, for some fonts, the round-trip
# tfm->pl->vpl->tfm->pl results in slightly different start and finish .tfm/.pl 
# files. This does not seem to matter in the end.
    print OUTPUT_VPL "(SEVENBITSAFEFLAG $sevenbitflag)\n";
    close(INPUT);
    close(OUTPUT_PL);
    close(OUTPUT_VPL);
}

sub shift_octal_numbers {
    local($string) = $_[0];
    $onumber = substr($string, 3, 20);
    $dnumber = oct($onumber);
    if (($dnumber <= 0x20) && ($dnumber >= 0)) {
	if ($dnumber < 0x0A) {
	    $dnumber += 0xA1;
	}
	else {
	    $dnumber += 0xA3;
	}
    }
    elsif ($dnumber == 0x7F) {
	$dnumber = 0xC4;
    }
    return " O ".sprintf("%o", $dnumber);   
}
