#!/usr/bin/perl # Written by Skip Collins 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 () { $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); }