summaryrefslogtreecommitdiff
path: root/fonts/utilities/vfinst/2vfinst
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /fonts/utilities/vfinst/2vfinst
Initial commit
Diffstat (limited to 'fonts/utilities/vfinst/2vfinst')
-rw-r--r--fonts/utilities/vfinst/2vfinst963
1 files changed, 963 insertions, 0 deletions
diff --git a/fonts/utilities/vfinst/2vfinst b/fonts/utilities/vfinst/2vfinst
new file mode 100644
index 0000000000..7dca44da7c
--- /dev/null
+++ b/fonts/utilities/vfinst/2vfinst
@@ -0,0 +1,963 @@
+#!/usr/local/bin/perl
+### ====================================================================
+### @Perl-file{
+### author = "Alan Hoenig",
+### version = "1.00",
+### date = "August 1998",
+### filename = "2vfinst",
+### address = "Department of Mathematics,
+### John Jay College,
+### 445 West 59 Street,
+### New York, NY 10019, USA",
+### email = "ajhjj@cunyvm.cuny.edu",
+### codetable = "ISO/ASCII",
+### keywords = "AFM, virtual fonts, fonts, PostScript, TeX",
+### supported = "yes",
+### abstract = "This is the second Perl script for the
+### vfinst virtual font installation utility.
+### See accompanying file vfinst.tex for
+### additional details.",
+### package = "vfinst",
+### dependencies = "vfinst, 1vfinst, fontinst",
+### }
+### ====================================================================
+
+## This script does the grunt work. Using information generated by
+## 1vfinst and given in the parameter file vfinst.par, this script
+## will generate TeX files and other scripts to generate the virtual
+## fonts, to create needed directories, and to move files into the
+## proper places.
+
+#< This file contains definitions for the following subroutines:
+#>
+
+## What this script expects.
+## =========================
+## 1. a fresh copy of psfonts.map in the work directory.
+
+# SUBROUTINES AND STUFF ...
+
+require("../vfinst.par"); # system dependent!! Beware!!
+require("..${sep}vfinst.lib");
+&getTDSplaces if &isTDS; # construct some TDS parameters
+##$vfencoding = $vfmapdir unless defined $vfencoding;
+$cp = $copy; # a synonym
+$rm = $del; # another synonym
+
+##$vfencoding = "" if $vfencoding eq $root; # This eliminates strange
+ # double backslash path names in
+ # case you place the enc file in the root
+
+## We begin by extracting font information from the file fonts.lst,
+## painstakingly prepared by 1vfinst. This file begins with column
+## headings (which we ignore) and is followed by lines of the form
+## mbm300 mbmr8a 000 mbur8a.pfb BulmerMT-Regular
+## whose fields are the sortkey, proposed Berry fontname, slant, existing
+## font outline name, and long (Adobe or Monotype or ...) font name.
+## The matching afm file must have a name formed by stripping the existing
+## extension if there is one and appending `.afm'. Note that slant sometimes
+## varies within members of a family, as in Bulmer, with slightly
+## different slants depending on whether the font is regular, bold,
+## or semi.
+
+## The `parseberryname' routine takes a Berry name like "mbmri8a"
+## as argument.
+
+sub parseberryname{
+ local($scr) = $_[0];
+ $berryfam = substr($scr, 0, 3);
+ $berryencoding = substr($scr, -2, 2);
+ $berryseries = substr($scr, 3, 1);
+ local($l) = length $scr;
+ $berryvars = substr($scr, 4, $l-4-2); # variants
+}
+
+## In case the original extensions are uppercase or something wierd,
+## we need to retrieve this information.
+
+sub get_original_extensions{
+ local($name_plus_extensions) = $_[0];
+ ## $name_plus_extensions looks like `foo.{pfb,afm}'
+ $name_plus_extensions
+ =~ /([-a-zA-Z0-9_]+)\.\{([pfabPFAB]*),([aA][fF][mM])\}/;
+ local($firstname, $pext, $aext) = ($1, $2, $3);
+ $pext = ".$pext" unless $pext eq "";
+ $aext = ".$aext";
+ ($firstname, $pext, $aext);
+
+}
+
+
+## Although all the information in @fontinfo is used somewhere or other,
+## we can facilitate later processing by extracting useful information
+## and storing it separately. In addition to reading fonts.lst, this
+## routine stores a separate list of the font families we have.
+
+## The array @fonts_to_ignore contains a list of font types to ignore----fonts
+## like ornaments, oldstyle figures, etc.
+@fonts_to_ignore=(
+ "p8a", # ornaments
+ "7a", # alternate fonts
+ "7d", # old-style figures
+ );
+sub examine_fonts{
+ $we_ignore_this_font=$false;
+ foreach $font_type (@fonts_to_ignore) {
+ $we_ignore_this_font=$true if $_=~/$font_type\s+/;
+ }
+}
+@fams=();
+sub getfontinfo{
+ open (IN, "fonts.lst") || die "Where is file `fonts.lst'?";
+ while (<IN>) {
+ next if /^$rem/; # ignore comments
+ # in case a user has messed with it...
+ &examine_fonts;
+ push(@fontinfo, $_) unless $we_ignore_this_font;
+ }
+ @fontinfo = sort @fontinfo; # just in case, we sort it again
+ foreach $line (@fontinfo) {
+ local($sk, $bname, $sl, $oln, $fname) = split(/\s+/, $line);
+ push(@berrynames, $bname);
+ $sortkeys{$bname} = $sk;
+ $slants{$bname} = $sl;
+ local($first_name, $pf_ext, $af_ext) = &get_original_extensions($oln);
+ $filename{$bname} = "$first_name$pf_ext";
+ $afmname{$bname} = "$first_name$af_ext";
+ $longfontname{$bname} = $fname;
+ &parseberryname($bname);
+ # keep track of this family...
+ $tmp{$berryfam} = 1;
+ # Now see if smallcaps/osf exists for the family...
+ $expert{$berryfam} = 1 if $berryencoding =~ /x/;
+ $expert{$berryfam} = 1 if $berryvars =~ /c/;
+ $expert{$berryfam} = 1 if $berryvars =~ /x/;
+ # Examine and store slant info, a function of family and series
+ $seriesslant{"$berryfam$berryseries"} = $sl unless $sl eq "000";
+ # We check to see fam/series contains an oblique font. Oblique
+ # exists if the penultimate sortkey character == 2.
+ $obl{"$berryfam$berryseries"} = 1 if substr($sk,-2,1) eq "2";
+ }
+ @fams = sort(keys %tmp); undef %tmp;
+}
+&getfontinfo; # font info loaded!
+
+## Prior to creating the psfonts addendum, let's read the current
+## psfonts.map to determine all the raw fonts currently there. We
+## only want to add an entry to psfonts.new if the font is truly new.
+## If it exists already, we don't want to add it again.
+
+sub GetExistingRawFonts{
+ &copy("$vfmapdir${sep}psfonts.map", "psfonts.map");
+ open (MAP, "psfonts.map") || die "Where is psfonts.map?...$!\n";
+ &copy("psfonts.map", "psfonts.ori"); # keep an original copy...
+ while (<MAP>) {
+ next if $_ eq "\n"; # ignore blank lines
+ next if /^%/; # ignore comment lines (beginning with %)
+ local($rawfont, $other) = split(/\s+/, $_, 2);
+ push(@oldraws, $rawfont); # save name of the raw font
+ }
+ close MAP;
+}
+&GetExistingRawFonts; # do it!
+
+## We'll use this next routine to see whether a raw font
+## already appears in psfonts.map
+
+sub CheckforNewRawFont{
+ $isnewfont = $true; local($myfont) = $_[0];
+ local(@greplist) = grep(/^$myfont/, @oldraws);
+ $isnewfont = $false if defined @greplist;
+}
+
+## This routine checks a raw font to see if it is Adobe Standard
+## encoded. If so, it stores the original name as an ASE font
+## (ASE = Adobe Standard Encoding),
+## revises $rawfont to reflect the TeXBase1Encoding 8r. It also
+## sets a flag to show that the change has been made. Issue
+## routine with the raw font name as arg, eg
+## &checkencoding($rawfont, $asefont); The 2 fonts will be the
+## same unless the original encoding is 8a AND there are
+## no berry variants except for italic.
+
+## The question of variants: variants like expert, small caps, figures,
+## fraction fonts, etc are not suitable for re-encoding according to
+## the TeXBase1 encoding. On the other hand, regular and sans and
+## their italics are suitable
+
+sub makeASEcheck{
+ local($myrawfont, $asefont) = @_;
+ $asefont = $myrawfont;
+ $isviiir = $false; # the default
+ if ((substr($asefont, -2, 2) eq "8a") && ($berryvars eq "i")) {
+ $isviiir = $true; # case 1: italicb
+
+ }
+ if ((substr($asefont, -2, 2) eq "8a") && ($berryvars eq "")) {
+ $isviiir = $true; # case 2: no variants
+ }
+ if ((substr($asefont, -2, 2) eq "8a") && ($berryvars =~ "s")) {
+ $isviiir = $true; # case 3: sans serif
+ }
+ substr($asefont, -2, 2) = "8r" if $isviiir;
+ $_[0] = $myrawfont;
+ $_[1] = $asefont;
+}
+
+sub gettypeinfo{ # only for TDS systems
+ open (IN, "typeface.lst") || die "Where is my list of typefaces?";
+ # Each line in this file looks like:
+ # mbm bulmer monotype
+ while (<IN>) {
+ local($fam); chop;
+ ($fam, $face, $supp) = split(/\s+/, $_);
+ $typeface{$fam} = $face;
+ $supplier{$fam} = $supp;
+ }
+ close IN;
+}
+
+## This rtn takes the @missdirs and suggests a script for creating
+## the missing directories, which are stored in @neededdirs.
+$mkdir="mkdir"; # system dependent call
+open(SCRIPT, ">mkdirs.bat"); # open this anyway, to zap an old file
+print SCRIPT "$rem This script makes any missing directories.\n";
+print SCRIPT "$rem It may be deleted after use.\n";
+sub makemkdirs{
+ foreach $i (0..$#missdirs) {# look at each missing directory
+ $pos=0;
+ $missdirs[$i] = "$missdirs[$i]$sep"; # tack on final slash
+ while (($pos = index($missdirs[$i], $sep, $pos)) >= 0) {# are
+ # any of of its parents missing also?
+ $currdir = substr($missdirs[$i],0,$pos);
+ $trulymissing=$true; # guess that the dir is really absent
+ foreach $j (0..$#neededdirs) {
+ $trulymissing=$false if $currdir eq $neededdirs[$j];
+ # discard it if we've already flagged it as missing
+ }
+ if (&isdir($currdir)) {} else {
+ push(@neededdirs,$currdir) if $trulymissing;
+ }
+ $pos++;
+ }
+ }
+ if ($#neededdirs >=0) {
+ &wlog("\nHere is a suggested script to create the needed directories:\n");
+ foreach $newdir (@neededdirs) {
+ &wlog("$mkdir $newdir");
+ print SCRIPT "$mkdir $newdir\n";
+ }
+ close SCRIPT;
+ }
+}
+
+sub checkdirs{
+ $errorcount=0;
+ if (&isTDS) {# TDS system
+ &verifydirs(
+ $vftexmf,
+ $vfmapdir,
+ $vfinputs,
+ );
+ $prefix = "$vftexmf${sep}fonts$sep";
+ while (($key,$sup) = each %supplier) {# check dirs for pfb, afm, vf, tfm
+ $typ = $typeface{$key};
+ $myafm = "${prefix}afm${sep}$sup${sep}$typ";
+ $mypfb = "${prefix}type1${sep}$sup${sep}$typ";
+ $mytfm = "${prefix}tfm${sep}$sup${sep}$typ";
+ $myvf = "${prefix}vf${sep}$sup${sep}$typ";
+ &verifydirs($myafm,$mypfb,$mytfm,$myvf);
+ }
+ } else {# traditional system
+ &verifydirs(
+ $vfvf,
+ $vftfm,
+ $vfmapdir,
+ $vfpsfonts,
+ $vfafm,
+ $vfinputs,
+ );
+ } # verification concludes
+ if ($errorcount == 0) { # everything OK
+ &display("All directories in place.");
+ } else {# somethings amiss
+ &dwlog("Here is a list of missing directories.\n");
+ &dwlog(join("\n",@missdirs));
+ &makemkdirs;
+ print "\nPlease execute mkdirs.bat when I am finished...\n";
+ }
+}
+
+## This function takes 2 args---fontfamily and file type.
+## The 3rd arg contains the place for the file; it acts like TDSplace
+## in case it is a TDS system, but uses the traditional location otherwise.
+## Example: $fontsource = &findplacefor($fontfamily,"type1");
+
+$tradfiletype{"type1"}=$vfpsfonts; # translates TDS terms
+$tradfiletype{"afm"}=$vfafm; # into lingo used for
+$tradfiletype{"tfm"}=$vftfm; # traditional installations
+$tradfiletype{"vf"}=$vfvf;
+
+sub findplacefor{
+ local($mystring, $mytype)=@_;
+ $tradtype=$tradfiletype{$mytype};
+ local($myfam)=substr($mystring,0,3);
+ if (&isTDS) { # otherwise, the TDS case...
+ $tradtype = "${vftexmf}${sep}fonts${sep}${mytype}${sep}";
+ $tradtype .= "$supplier{$myfam}${sep}$typeface{$myfam}";
+ }
+ $tradtype;
+}
+
+## We need to shear an original font---that is, make an oblique (slanted)
+## font from an upright, and an unslanted italic from a standard
+## italic. The guts of this is done by the &shearfonts routine, which
+## can be used to do either of these operations. (Incidentally, the `t'
+## in the middle of variable names $asetname and $berrytname suggest
+## the word `transformed' (sheared). )
+
+sub shearfonts{
+ # Now lets sort the variants...
+ local(@tmp) = split(//, $berryvars);
+ @tmp = sort @tmp;
+ $berrytvars = join("", @tmp);
+ # Now for the new name...
+ $berrytname = "$berryfam$berryseries$berrytvars$berryencoding";
+ $asetname = $berrytname; # they'll be the same except for 8r's
+ if ($isviiir == $false) { # a non-8r font...
+ &CheckforNewRawFont($berrytname);
+ print MAP "$berrytname $adobename \"$currsl SlantFont\" <$mapfontname\n"
+ if $isnewfont;
+ print TFM "pltotf $berrytname.pl $berrytname.tfm$appendtolog\n";
+ print PUTVFTF "$mv $berrytname.tfm $tfmplace\n";
+ } else { # an 8r font
+ $asetname =~ s/8a/8r/;
+ &CheckforNewRawFont($asetname);
+ if ($isnewfont) {
+ print MAP "$asetname $adobename \"$currsl SlantFont ";
+ print MAP
+ "TeXBase1Encoding ReEncodeFont\" <8r.enc <$mapfontname\n";
+ }
+ print TFM "pltotf $asetname.pl $asetname.tfm$appendtolog\n";
+ print PUTVFTF "$mv $asetname.tfm $tfmplace\n";
+ }
+ # Now for fontinst install instructions. Normally, we get metric
+ # data from the afm file, but we can get it from the mtx file if
+ # that exists---which it will in case of an 8r font.
+ $from = "fromafm";
+ $from = "frommtx" if $isviiir;
+ print INST "\\transformfont{$asetname}{\\slantfont{$dotlesssl}";
+ print INST "{\\${from}{$asename}}}\n";
+}
+
+sub makeuprights{ # make the upright fonts
+ # First, let's get the Berry name for the slanted font
+ # We replace the italic i by a u (unslanted italic) in the variants
+ $berryvars =~ s/i/u/;
+ &shearfonts unless $obl{$famseries};
+}
+
+sub makeslanteds{ # make the slanted fonts
+ # First, let's get the Berry name for the slanted font
+ # We add an o (oblique) to the variants
+ $berryvars .= "o";
+ &shearfonts unless $obl{$famseries};
+}
+
+## [It's now time to create the fontinst installation file. I forego
+## the use of the fontinst \latinfamily command for several reasons:
+## (1) I don't care for T1 fonts that \latinfamily insists on creating;
+## (2) I want to generate italic small caps which \latinfamily omits;
+## (3) I want to use the true italic angle for each family (\latinfamily
+## uses only the 1/6 slant of the Computer Modernfonts, but these
+## slants vary wildly from font family to font family);
+## and (4) I want
+## to be able to include other variants besides expert (eg Bitstream's
+## small caps and extensions fonts).]
+
+## Raw files need close examination. An addendum to psfonts.map
+## needs creation. Scripts to move fonts where they belong, to create
+## property list pl files, and the beginning of the fontinst installation
+## file need to be made.
+
+ $INSTprolog = <<"endinstprolog";
+%\&plain\n
+% This is a fontinst installation file.
+% Created by vfinst$ver at $now on $today.\n
+% THIS FILE MAY BE DELETED at completion of the font installation.\n
+\\input fontinst.sty\n
+endinstprolog
+
+## In TDS systems, it's not necessary to have font path names in psfonts.new.
+## The following subroutine strips them away, assuming that
+## [-+\!\?\@\#\$\%\^\&\:\;=\._A-Za-z0-9]
+## characterizes the allowable characters in a directory name. This is
+## probably more inclusive than most operating systems allow, anyway.
+
+sub strip_path_from_map_entries{
+ unlink "psfonts.tmp" if -e "psfonts.tmp";
+ $good_rename = rename "psfonts.new", "psfonts.tmp";
+ die "Cannot rename map file!" unless $good_rename;
+ open(TMPIN, "psfonts.tmp");
+ open(NEWOUT, ">psfonts.new");
+ while ($_ = <TMPIN>) {
+ #$_ =~ s/<(\s*)([-+\!\?\@\#\$\%\^\&\:\;=\._A-Za-z0-9]*$sep )+/<$1/g; #ori
+ if ($sep eq "\\") { # DOS and DOS-like systems...
+ $_ =~ s/<(\s*)(([-+\!\?\@\#\$\%\^\&\:\;_A-Za-z0-9]*)$sep$sep)+/</g;
+ } else { # UNIX and sensible systems...
+ $_ =~ s/<(\s*)(([-+\!\?\@\#\$\%\^\&\:\;_A-Za-z0-9]*)$sep)+/</g;
+ }
+ print NEWOUT $_;
+ }
+ close TMPIN; close NEWOUT;
+}
+
+ $appendtolog = " >> maketfm.vlg";
+sub processrawfiles{
+ # open files first of all...
+ open (MAP, ">psfonts.new");
+ print MAP "\n"; # cautionary newline
+ open (INST, ">makefont.tex"); # fontinst install file
+ open (TFM, ">maketfm.bat");
+ print TFM "$rem This file makes tfm files. It may be deleted after use.\n";
+ print TFM "$rem Created by $vfp on $today at $now.\n";
+ open (TLOG, ">maketfm.vlg"); # a log file
+ print TLOG
+ "Log file for VFinst maketfm.bat file for $now, $curdate.\n\n";
+ close TLOG;
+ open (REN, ">newnames.bat"); # renames fonts
+ print REN "$rem This file renames files. It may be deleted after use.\n";
+ print REN "$rem Created by $vfp on $today at $now.\n";
+ open (PUTFONT, ">putfonts.bat"); # places fonts, afm's properly
+ print PUTFONT "$rem This file moves files. Delete it after use.\n";
+ print PUTFONT "$rem Created by $vfp on $today at $now.\n";
+ open (PUTVFTF, ">putvftf.bat"); # places tfm's, vf's properly
+ print PUTVFTF "$rem This file moves files. Delete it after use.\n";
+ print PUTVFTF "$rem Created by $vfp on $today at $now.\n";
+ open (CLEANUP, ">cleanup.bat"); # removes stuff from work dir at end
+ print CLEANUP "$rem This file removes files. Delete it after use.\n";
+ print CLEANUP "$rem Created by $vfp on $today at $now.\n";
+ print INST "$INSTprolog";
+ foreach $berryname (@berrynames) {
+ $sortkey = $sortkeys{$berryname};
+ $fontfile = $filename{$berryname};
+ $adobename = $longfontname{$berryname};
+ &parseberryname($berryname);
+ $slant = $defaultslant;
+ $slant = $seriesslant{"$berryfam$berryseries"}
+ if defined($seriesslant{"$berryfam$berryseries"});
+ $dotlesssl = $slant;
+ $dotlesssl =~ s/\.//g; # fontinst doesn't want a decimal point
+ &makeASEcheck($berryname, $asename); # $berryname is the original
+ ($fontfirstname, $ext) = split(/\./, $fontfile);
+ $ext =".$ext" unless $ext eq "";
+ $fontplace = &findplacefor($berryname, "type1");
+ $fontplacefont = "$fontplace$sep$berryname$ext";
+ $afmplace = &findplacefor($berryname, "afm");
+ $tfmplace = &findplacefor($berryname, "tfm");
+ # Now to make addendum to map file, if necessary
+ &CheckforNewRawFont($berryname);
+ if ($isnewfont) { # addendum to psfonts.map
+# need a map name, which must be explicit for traditional systems,
+# but only the font name is needed for TDS systems, as its location
+# will be known in the kpathsea file database.
+ $mapfontname=$fontplacefont; # for traditional systems
+ $mapfontname="$berryname$ext" if &isTDS;
+ if ($isviiir) { # new font AND 8r-encoding
+ &CheckforNewRawFont($asename);
+ print MAP "$asename $adobename $eightR <$mapfontname\n"
+ if $isnewfont; # still new font?
+ } else { # 8x, 7d, etc encodings
+ print MAP "$berryname $adobename <$mapfontname\n";
+ }
+ }
+ # rename files (but only if they havenlt already been renamed)
+ if ($fontfirstname ne $berryname) {
+ print REN "$ren $fontfirstname$ext $berryname$ext\n";
+ print REN "$ren $afmname{$berryname} $berryname.afm\n";
+ }
+ print PUTFONT "$mv $berryname$ext $fontplace\n";
+ print CLEANUP "$rm $berryname$ext\n";
+ print PUTFONT "$mv $berryname.afm $afmplace\n";
+ print CLEANUP "$rm $berryname.afm\n";
+ # make tfm's out of the pl files that fontinst will produce...
+ print TFM "echo \"$berryname\"$appendtolog\n";
+ print TFM "pltotf $berryname.pl $berryname.tfm$appendtolog\n";
+ print PUTVFTF "$mv $berryname.tfm $tfmplace\n";
+ # 8r-encoded fonts mean more vf's in the system. fontinst
+ # needs to create them, an extra tfm needs to be made from
+ # the extra pl file, and of course this must be moved. (Up
+ # above, we've already added the 8r-incantation to the psfonts.map
+ # addendum.
+ if ($isviiir) {
+ print INST "\\transformfont{$asename}";
+ print INST "{\\reencodefont{8r}{\\fromafm{$berryname}}}\n";
+ print TFM "echo \"$asename\"$appendtolog\n";
+ print TFM "pltotf $asename.pl $asename.tfm$appendtolog\n";
+ print PUTVFTF "$mv $asename.tfm $tfmplace\n";
+ }
+ # If oblique versions do NOT exist, we want to create oblique
+ # forms of the upright fonts and unslant forms of the italics.
+ # Slants depend on both the font family and series.
+ $famseries = "$berryfam$berryseries";
+ $slantind = -1; # means stop
+ if (not defined($obl{$famseries})) { # no oblique
+ $sgn = "."; $slantind = 0; # upright
+ if ($berryvars =~ /i/) { # in case an italic
+ $sgn = "-.";
+ $slantind = 1; # italic
+ }
+ $currsl = "$sgn$seriesslant{$famseries}";
+ $dotlesssl = $currsl;
+ $dotlesssl =~ s/\.//g; # fontinst doesn't want a decimal point
+ if ($dotlesssl eq"") {
+ $dotlesssl = "167";
+ $currsl = ".167";
+ }
+ }
+ &makeuprights if $slantind == $currentlyslanted;
+ &makeslanteds if $slantind == $currentlyupright;
+ ## When sorting fonts to make instrucitons in the fontinst install
+ ## file, fonts with the same family, weight, and series (5 chars)
+ ## belong in the same instruction. We'll store the list of fonts
+ ## in 2 associative arrays indexed by these 5 char sequences---one
+ ## array for regular fonts and one for sheared fonts. Sheared fonts
+ ## are either slanted or unslanted italic.
+ $fivechars = $berryfam . substr($sortkey,3,2);
+ $storefont = $asename;
+ $storeshear = $asetname;
+ if ($isviiir) {
+ $storefont = $asename;
+ $storeshear = $asetname;
+ }
+ $fifonts{$fivechars} .= "$storefont,"; # fonts for fontinst file
+ $fishear{$fivechars} .= "$storeshear,"; # sheared fonts for fontinst
+ }
+ close MAP; # closes psfonts.new
+ ## In case this is a TDS system, we can eliminate path names from
+ ## from the entries in psfonts.new.
+ if (&isTDS) {
+ &strip_path_from_map_entries;
+ print REN "$del psfonts.tmp\n";
+ }
+ if (-s "psfonts.new" > 2) { # concatenate non-trivial map files
+ open (ALL, ">psfonts.all");
+ open (SRC, "psfonts.map") || die "The file psfonts.map vanished!";
+ while (<SRC>) {print ALL $_;} # insert original map file
+ close SRC; open (SRC, "psfonts.new");
+ while (<SRC>) {print ALL $_;} # append all additions.
+ close SRC;
+ print REN "$del psfonts.map\n";
+ print REN "$ren psfonts.all psfonts.map\n";
+ }
+ print REN "$del psfonts.new\n";
+}
+
+sub makevfandstorefiles{
+ print TFM "echo \"$vfname\"$appendtolog\n";
+ print TFM "vptovf $vfname.vpl $vfname.vf $vfname.tfm$appendtolog\n";
+ print PUTVFTF "$mv $vfname.vf $vfplace\n"; # store font files...
+ print PUTVFTF "$mv $vfname.tfm $tfmplace\n";
+}
+
+sub printtestlines{
+ print PLN " \\font\\t=$vfname at \\fontsize \n$showfont";
+ $showfont = "";
+ print PLN "\\noindent\\llap\{\\tt $vfname:\\ \}\{\\t \\tryit\}\n";
+ print LTX "\\noindent\\llap\{\\tt $vfenc/$ft/$nfssweight{$weight}/";
+ print LTX "$nfsssh\\ \}\{\\fontfamily\{$ft\}\\fontseries\{";
+ print LTX "$nfssweight{$weight}\}%\n \\fontshape\{";
+ print LTX "$nfsssh\}\\selectfont \\tryit\}\n";
+}
+
+## This sub reverses the list of fonts and adds reference to `ase2exp'
+## if expert fonts
+## are present and if the font family is sloppy. See below for further comments.
+@swash_like_fonts=(
+ "w8a",
+ );
+@expert_like_fonts=(
+ "8x", # expert fonts
+ "c8a", # small caps fonts
+ "co8a", # small caps oblique
+ );
+sub flistfix{ # assumes $flist contains a comma-separated font list.
+ local(@myfonts)=split /,/,$flist;
+ local($is_sloppy)=$false;
+ foreach $member (@sloppy_afms) {
+ $is_sloppy=$true if $fam =~/^$member/;
+ }
+ if ($#myfonts) { # let's reverse the list for more than 1 entry
+ @myfonts=reverse @myfonts;
+ }
+ $flist=join ',', @myfonts; $flist = "$flist,";
+ if ($is_sloppy ) { # Now preface any small caps fonts by `ase2exp'
+ # and any swash fonts by `ase2alt'.
+ foreach $type (@expert_like_fonts) {
+ $flist=~s/$type,/$type,ase2exp,/;
+ }
+ foreach $type (@swash_like_fonts) {
+ $flist=~s/$type,/$type,ase2alt,/;
+ }
+ }
+ ## $myfonts[$#myfonts+1]=$myfonts[$#myfonts];
+ ## $myfonts[$#myfonts-1]="ase2exp";
+}
+
+## This subrtn prints a long, messy \installfont line to the
+## makefont.tex file. It breaks it at a `}{' if the line is
+## longer than $linelength characters. It also adds lines to
+## test files, and it adds an entry to maketfm.bat and to
+## putfonts.bat.
+
+$linelength = 76;
+sub INSTline{
+ local($vffont,$flist,$encfile,$enc,$fam,$series,$shape) = @_;
+# $flist contains a list of fonts, regular, exp, alt, etc. It's necessary
+# to reverse the order. That way, sloppy_afm families, like PAD (Adobe Garamond),
+# can have the expert glyph names renamed by calling `ase2exp'. File ase2exp.mtx
+# gets called only if both the font fam is sloppy and expert fonts are present!
+# Swash fonts have already played with the order of $flist, so we leave it alone
+# if swash. (The implicit assumption is that font families with swash alternates
+# won't be sloppy.)
+ &flistfix; # unless $nfsssh eq "sw";
+ local($myline) =
+ " \\installfont\{$vffont\}\{${flist}dotlessj,latinx\}$linesep";
+ $myline .= "\{$encfile\}\{$enc\}\{$fam\}\{$series\}\{$shape\}\{\}\n";
+ if (($shape eq "un") or ($shape eq "ni")) { # add uline if underlining
+ $myline =~ s/latinx/uline,latinx/;
+ }
+ local($l) = length $myline;
+ $myline =~ s/latinx\}/latinx\}\%\n / if $l > $linelength;
+ $myline =~ s/,latinx// if ($shape eq "t") or ($shape eq "ti"); # for titling fonts
+ # or for displays, which have no lowercase letters,
+ # latinx generates errors becasue it refers to lower-
+ # case glyphs
+ print INST $myline;
+ &printtestlines;
+ &makevfandstorefiles;
+}
+
+sub parsefivechars{
+ $fam = substr($fivechars, 0 ,3);
+ local($i) = substr($fivechars, 3, 1);
+ $weight = $wt{$i};
+ $nfsswt = $nfssweight{$weight};
+ $i = substr($fivechars, 4, 1);
+ $shape = $shp[$i];
+ $nfsssh = $nfssshape{$shape};
+}
+
+@fontinstencfiles = ( # maps encoding shape to an etx file
+ "OT1n OT1",
+ "OT1sc OT1c",
+ "OT1sl OT1",
+ "OT1it OT1i",
+ "OT1si OT1c",
+ "OT1ui OT1",
+ "OT1t OT1",
+ "OT1ti OT1",
+ "OT1n9 OT19vf",
+ "OT1sc9 OT1c9vf",
+ "OT1sl9 OT19vf",
+ "OT1it9 OT1i9vf",
+ "OT1si9 OT1c9vf",
+ "OT1ui9 OT19vf",
+ "OT1t9 OT1",
+ "OT1ti9 OT1",
+ "OT1nx OT1",
+ "OT1scx OT1c",
+ "OT1slx OT1",
+ "OT1itx OT1",
+ "OT1six OT1c",
+ "OT1uix OT1",
+ "OT1tx OT1",
+ "OT1tix OT1",
+ "OT1un OT1",
+ "OT1un9 OT19vf",
+ "OT1unx OT1",
+ "OT1ni OT1",
+ "OT1ni9 OT1i9vf",
+ "OT1nix OT1",
+ "T1n T1",
+ "T1sc T1c",
+ "T1sl T1",
+ "T1it T1",
+ "T1si T1c",
+ "T1ui T1",
+ "T1t T1",
+ "T1ti T1",
+ "T1n9 T19vf",
+ "T1sc9 T1c9vf",
+ "T1sl9 T19vf",
+ "T1it9 T19vf",
+ "T1si9 T1c9vf",
+ "T1ui9 T1",
+ "T1t9 T1",
+ "T1ti9 T1",
+ "T1nx T1",
+ "T1scx T1c",
+ "T1slx T1",
+ "T1itx T1",
+ "T1six T1c",
+ "T1uix T1",
+ "T1tx T1",
+ "T1tix T1",
+ "T1un T1",
+ "T1un9 T19vf",
+ "T1unx T1",
+ "T1ni T1",
+ "T1ni9 T19vf",
+ "T1nix T1",
+ );
+
+$lowercaseencoding = $false;
+$lowercaseencoding = $true if $vfenc =~ /t1/;
+sub loadencodingfilenames{
+ foreach $elem (@fontinstencfiles) {
+ $elem =~ tr/A-Z/a-z/ if $lowercaseencoding == $true;
+ ($encodingtype,$filename) = split(/ /, $elem);
+ $encodingfile{$encodingtype} = $filename;
+ }
+}
+&loadencodingfilenames;
+
+ $plainprolog = <<"endplainprolog";
+\%\&plain
+\\nopagenumbers \\newdimen\\fontsize
+\% Change \\fontsize, \\baselineskip for different type sizes.
+\\fontsize = 12pt \\baselineskip = 14pt \n
+\\def\\tryit\{A fine flight Officiously Ruffles My Puff! 12345 ,.;:
+ \\c{C}e Ph{\\oe}nix Va \\`a M\\\"unchen?\\endgraf\}
+\\font\\1=cmr6 \\newcount\\cno
+\\def\\dd{\\setbox0 = \\hbox{\\t\\char\\cno}\\ifdim\\wd0>0pt
+ \\ifdim\\ht0>0pt \\box0\\lower3pt\\hbox{\\1\\the\\cno}\\fi\\fi
+ \\global\\advance\\cno by1\\relax}
+\\def\\showfont{\\centerline{\\vbox{\\halign{&\\dd\#\#\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+&&&&&&&&&&&&&&&\\cr
+}}}\\medskip}
+ \\centerline{A {\\tt plain} \\TeX{} Test File}
+ \\centerline{Prepared by vfinst$ver at $now, on $curday, $curdate.}
+\\medskip\n
+endplainprolog
+$showfont = " \\showfont\n";
+
+ $latexprolog = <<"endlatexprolog";
+\%\&latex\n
+\\documentclass{article}\n
+\\newcommand\{\\tryit\}\{A fine flight Officiously Ruffles My Puff!
+ 12345 ,.;: \\c{C}e Ph{\\oe}nix Va \\`a M\\\"unchen?\\endgraf\}\n
+\\begin{document}
+\\begin{center}
+ A \\LaTeX{} Test File\\\\
+ Prepared by vfinst$ver at $now, on $curday, $curdate.
+\\end{center}
+The text in the left margin separated by slashes yields the NFSS
+combination of encoding, family, series, and shape that
+generated that test line.\n\\vspace{1pc}\n
+endlatexprolog
+
+sub getvfname{ # determine the fontname2.1 name for virtual font
+ local($fshape) = $_[0];
+ local($vfname) = "$fam$weight"; # start with family & weight...
+ local($thisvar) = $fshape; # initialize to normal;
+ $thisvar= "" if $fshape eq "r";
+ $thisvar = "c" if $fshape eq "sc";
+ $thisvar = "ic" if $fshape eq "si";
+ $thisvar = "iw"if $fshape eq "sw"; # swash
+ $thisvar = "n" if $fshape eq "un";
+ $thisvar = "ni" if $fshape eq "ni";
+ $cork = $true; $cork = $false if $vfenc =~ /ot1/i;
+ $encdigit = "7"; $encdigit = "8" if $cork;
+ $encvar = "t";
+ if (defined($expert{$fam})) {
+ $encdigit = "9"; # start figuring expertised encodings...
+ if ($cork) {
+ $encvar = "e";
+ $encvar = "d" if $type eq "9";
+ } else { # for original tex fonts...
+ $encvar = "t";
+ $encvar = "o" if $type eq "9";
+ }
+ }
+ $vfname .= "$thisvar$encdigit$encvar";
+ local($l) = length $vfname;
+ print "Trouble---virtual font $vfname has too long a name!\n"
+ if $l > 8;
+ $vfname;
+}
+
+## Many popular font families contain an italic swash raw font.
+## Such fonts are distinguished by a fontname which contains the
+## sequence `w8'. This sub creates the swash font by taking the
+## list of raw fonts ($regfonts), putting the swash name at the
+## front, and then generating entries into makefont.tex, putfonts.bat,
+## and maketfm.bat.
+
+$swashrawfont = "w8";
+sub createswashfont{
+ local(@fonts) = split(/,/, $regfonts);
+ ## local($swashfont) = pop @fonts; # capture the name of swash font
+ ## unshift(@fonts, $swashfont);
+ local($swfonts) = join(',', @fonts) . ","; # rejoin everything together
+ $vfname = &getvfname("sw");
+ $nfsssh = "sw"; # new NFSS shape of sw
+ local($swfil)="${vfenc}sw"; # name of swash encoding file
+ &INSTline($vfname,$swfonts,$swfil,$vfenc,$ft,$nfsswt,$nfsssh);
+}
+
+sub finishinstfile{
+ print INST "\n\\installfonts\n";
+ # We'll also prepare the test files...
+ open (PLN, ">testpln.tex");
+ open (LTX, ">testltx.tex");
+ print PLN "$plainprolog";
+ print LTX "$latexprolog";
+ foreach $family (@fams) {
+ @famchoices = (""); # default
+ @famchoices = ("9","x") if defined $expert{$family};
+ foreach $type (@famchoices) {
+ print INST "\\installfamily\{$vfenc\}\{$family$type\}\{\}\n";
+ }
+ }
+ print INST "%%\n";
+ &loadweightinfo;
+ &loadshapeinfo;
+ foreach $fivechars (sort keys %fifonts) {
+ $regfonts = $fifonts{$fivechars};
+ $shears = $fishear{$fivechars};
+ $thesearenotdisplayfonts = $true; # Any display fonts?
+ &parsefivechars;
+ $thesearenotdisplayfonts=$false if $shape =~ /d/; # They ARE displays
+ $tfmplace = &findplacefor($fivechars, "tfm");
+ $vfplace = &findplacefor($fivechars, "vf");
+ @famchoices = (""); # default
+ @famchoices = ("9","x") if defined $expert{$fam};
+ # For each entry there are three types of fonts we
+ # construct---the normal shape (which will be upright or
+ # italic in fact), the matching small caps, and the
+ # shear type (which will be slanted or unslanted italic).
+ foreach $type (@famchoices) {
+ $ft = "$fam$type";
+ # First, handle the main shape (upright or italic)...
+ $vfname = &getvfname($shape); # $shape is "r" or "i"
+ $nfsssh = $nfssshape{$shape};
+ $encodingtype = "$vfenc$nfsssh$type";
+ $fil = $encodingfile{$encodingtype};
+ if ($thesearenotdisplayfonts) {
+ &INSTline($vfname,$regfonts,$fil,$vfenc,$ft,$nfsswt,$nfsssh);
+ &createswashfont if $regfonts =~ /$swashrawfont/;
+ # 2nd, generate sheared variant (oblique or upright it)...
+ $shshape = "o"; $shshape = "u" if $shape eq "i";
+ $nfsssh = $nfssshape{$shshape};
+ $encodingtype = "$vfenc$nfsssh$type";
+ $fil = $encodingfile{$encodingtype};
+ $vfname = &getvfname($shshape);
+ &INSTline($vfname,$shears,$fil,$vfenc,$ft,$nfsswt,$nfsssh)
+ unless $obl{"$fam$weight"};
+ # Third , the matching small caps...
+ $scshape = "sc"; $scshape = "si" if $shape eq "i"; # italic
+ $scshape = "si" if $shape eq "o"; # oblique case
+ $nfsssh = $nfssshape{$scshape};
+ $encodingtype = "$vfenc$scshape$type";
+ $fil = $encodingfile{$encodingtype};
+ $vfname = &getvfname($scshape);
+ &INSTline($vfname,$regfonts,$fil,$vfenc,$ft,$nfsswt,$nfsssh);
+ # Next, underline fonts...
+ $nshape = "n"; $nshape = "ni" if $shape eq "i"; # italic
+ $nshape = "ni" if $shape eq "o"; # oblique
+ $nfsssh = $nfssshape{$nshape};
+ $encodingtype = "$vfenc$nshape$type";
+ $fil = $encodingfile{$encodingtype};
+ # encodingtype mirrors that of main upright or italic font
+ $vfname = &getvfname($nshape);
+ &INSTline($vfname,$regfonts,$fil,$vfenc,$ft,$nfsswt,$nfsssh);
+ } else { # a display font...
+ $nfsssh = "t"; # titling (display)
+ $nfsssh = "ti" if $shape eq "di";
+ &INSTline($vfname,$regfonts,$fil,$vfenc,$ft,$nfsswt,$nfsssh);
+ }
+ }
+ print INST "%%\n";
+ }
+ print INST "\\endinstallfonts\n\n\\bye\n"; # finis
+ print PLN "\n\\bye\n";
+ print LTX "\n\\end\{document\}\n";
+ # We also need to place the updated psfonts.map in proper place
+ # and the fd files where they belong. Sadly, we can't simply `move'
+ # as certain unooperative OS's don't permit this if the file
+ # already exists.
+ print PUTFONT "$copy psfonts.map $vfmapdir${sep}psfonts.map\n";
+ print CLEANUP "$rm psfonts.*\n$rm *.vfi\n$rm makefont.tex\n";
+ print PUTVFTF "$mv *.fd $vfinputs\n";
+ print CLEANUP "$rm *.mtx\n$rm *.pl\n$rm *.vpl\n$rm *.log\n$rm *.aux\n";
+ print CLEANUP "$rm *.vlg\n$rm *.lst\n$rm *.bat\n$rm *.dvi\n$rm *.ps\n";
+ ## Now to change executables to `execute' status for Unix systems...
+ if ($sep eq "/") {
+ chmod 0755, "mkdirs.bat" if -e "mkdirs.bat";
+ local($cnt) =
+ chmod 0755, "maketfm.bat", "putfonts.bat",
+ "putvftf.bat", "cleanup.bat", "newnames.bat";
+ print "Couldn't make .bat files executable---check permissions."
+ if $cnt == 0;
+ }
+}
+
+################################################################
+#
+# MAIN ROUTINE.
+#
+################################################################
+
+ $finishtalk = <<"endfinishtalk";
+
+Program `2vfinst' finished. If you're satisfied with the
+way things went, execute the following commands:
+ mkdirs.bat
+ newnames.bat
+ tex makefont
+ maketfm.bat
+ putfonts.bat
+ putvftf.bat
+ [TDS only: run the system `texhash' or other tool to update
+ TDS search path.]
+ cleanup.bat
+(All but the `tex' step take very little time.)
+(To test your fonts: execute `mkdirs.bat', `newnames.bat', `tex makefont',
+`maketfm.bat', and `putfonts.bat'. Execute the final 2 steps only
+when you're sure you like the fonts and are ready to keep
+them with your other fonts.)
+
+NOTE WELL: This message is stored in the Ascii file `finish.vfi'.
+endfinishtalk
+
+sub DoItAgain{
+ &appendlog;
+ if (&isTDS) { # get typeface, supplier info
+ &gettypeinfo; # in %supplier, %typeface
+ }
+ &checkdirs;
+ &processrawfiles;
+ &finishinstfile;
+ print $finishtalk;
+ open (NXT, ">finish.vfi");
+ print NXT $finishtalk;
+ close NXT;
+}
+
+&DoItAgain; ## Yes!!