diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /fonts/utilities/vfinst/2vfinst |
Initial commit
Diffstat (limited to 'fonts/utilities/vfinst/2vfinst')
-rw-r--r-- | fonts/utilities/vfinst/2vfinst | 963 |
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{ + ©("$vfmapdir${sep}psfonts.map", "psfonts.map"); + open (MAP, "psfonts.map") || die "Where is psfonts.map?...$!\n"; + ©("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!! |