### ====================================================================
###  @Perl-file{
###     author          = "Alan Hoenig",
###     version         = "1.00", 
###     date            = "August 1998", 
###     filename        = "vfinst.lib",
###     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 a library of common routines in 
###                        use by the vfinst package.
###                        See accompanying file vfinst.tex for 
###                        additional details.",
###     package         = "vfinst",
### }
### ====================================================================

## Sloppy fonts: adjust this list CAREFULLY if necessary...
@sloppy_afms=(
  "pad", # Adobe Garamond
  "pmn", # Adobe Minion
  "bch", # Bitsteam Chiani
  "hlh", # Lucida Bright 
  "mbu", # Monotype Bulmer: my idiosyncratic name
  "mbm", # Monotype Bulmer: the proper d esignation!
	      );

## Some misc constants and constructs ...

$ver = "1.00"; # vfinst version number (DOS or Unix!)

$false = 0;  # these are valid for numeric tests only.
$true  = 1;

$root = $sep;	# the root directory for your system

$vfp = "VFinst$ver + Perl$]";

$pi = atan2(1,1) * 4; 
$piover180 = $pi/180;

$currentlyslanted = 1;	# used in 2vfinst
$currentlyupright = 0;

$defaultslant = "167";	# as per Computer Modern fonts...

$eightR = "\"TeXBase1Encoding ReEncodeFont\" <8r.enc";

## We need `manifests'---lists of files that belong with each module---so
## we can verify that the package is properly installed.

@VFINSTmanifest = (
  "1vfinst",
  "2vfinst",
  "vfinst.lib",
  "vfinst.par",
  "vfinst.rc",
  "famnames",
  "map.a2d",
  "map.n2a",
  "map.sup",
  "dotlessj.mtx",
  "uline.mtx",
);

## Now for some common routines.

## Let's get the date and time.

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$curmonth = 
  (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec)[$mon];
$curday = (Sun, Mon, Tues, Wednes, Thurs, Fri, Satur)[$wday];
$mday = "0$mday" if $mday < 10;
$curdate = "$mday $curmonth $year";
$today = $curdate;
$hour = "0".$hour if $hour < 10;
$min  = "0".$min if $min < 10;
$now = $hour.":".$min.":".$sec;

sub scale{# divides two numbers, multiplies by 1000, and int's it.
  local($temp) = 1000 * $_[0]/$_[1] + 0.5;
  int($temp);
}

sub smul{# scaled multiplication
  local($temp) = $_[0]/1000 * $_[1];
  int($temp);
}

sub isTDS{
  defined($vftexmf);
}

sub isfile{
  -e $_[0];
}

sub isfileorlink{
  -e $_[0] || -l $_[0];
}

sub isdir{
  -d $_[0];
}

sub isvariable{
  defined($_[0]);
}

sub stdin{# replaces calls to <STDIN>; checks for only word characters
  local $value = <STDIN>; ## scalar context assumed...
  chomp $value;
  while ($value =~ /\W/) {# non-word char found!
    print "\nWord characters only are allowed---please try again. >>";
    $value = <STDIN>; chomp $value;
  }
  $value;
}

sub copy{
  open(IN, $_[0]) || 
	die "Can't find target $_[0] to copy!\n  ..."; # the source
  open(OUT, ">$_[1]"); # the target
  while (<IN>) {print OUT $_;}
  close IN; close OUT;
}

sub wlog{# write to a log file only
  foreach $elem (@_) {
  	print LOG $elem;
  }
  print LOG "\n";	# print final newline
}
sub display{# print to console only
  foreach $elem (@_) {  
  	print $elem;
  }
  print "\n";	# print final newline
}

sub reassure{
    print 
     "(This information appears in the log file 'vfinst.vlg' and in file(s)";
     foreach $file (@_) {
	print " $file";
     } 
    print ".)\n";
}

sub dwlog{# display on console and write to log file
  &wlog(@_);
  &display(@_);
}

sub OpenLog{
  open (LOG, ">vfinst.vlg");
  &dwlog("This is VFinst$ver + Perl$] on ${curday}day, $today, at $now.\n");
}
sub appendlog{	# called only by script 2vfinst
  open (LOG, ">>vfinst.vlg");
}
sub CloseLog{
  close LOG;
} 

sub getTDSplaces{ # derives some parameters for TDS systems...
  $vfinputs = "$vftexmf${sep}tex${sep}latex${sep}vfinst"; # for .fd files
  $vfmapdir = "$vftexmf${sep}dvips${sep}base";
}

sub printarray{
  local($tmp,*foo)=@_;
  local($tmps);
  $tmps = join(' ',@foo);
  $tmps = "Empty array." unless $#foo >= 0;
  print "$tmp$tmps\n";
}

## Func listcompare takes 2 args: an original (standard) list name,
## and an `other' one, which we will compare to the original.  A 
## final array to hold the members of the other which aren't in the
## original (orphans): @missignfonts=&listcompare(*afmfiles,*allfonts);

sub listcompare{
  local(*original, *other) = @_;
  local($i, $j, $present, $tmp, @orphans); 
  $tmp = "";
  foreach $i (@other) {
    $present = $false;
    foreach $j (@original) {
      next unless $i eq $j;
      $present = $true;
    }
    if ($present == $false) {
      $tmp = "$tmp$i:";
    }
  }
  chop $tmp;
  split(/:/, $tmp);
}

sub verifydirs{
  foreach $directory (@_) {
    &verifydir($directory);
  }
}
sub verifydir{
  if (&isdir($_[0])) {} else {# missing directory
    $errorcount++; # bump up counter
    push(@missdirs, $_[0]);
  }
}
sub verifyfile{
  die "Aargh---I can't find file $_[0]. $!\n"
    unless &isfileorlink($_[0]);
}
sub verifyfiles{
  foreach $file (@_) {
    &verifyfile($file);
  }
  &display("All files in place.");
}

## This subroutine takes 2 args---a string, and a number.  It pads
## the string with spaces on the right.  The padded string has the length
## given by the second argument.  Eg: &rpad($rawfont, 10);

sub rpad{# right pads $_[0] to a length of $_[2]
  local($s,$n)=@_; local($l)=length($s);
  $s .= " " x ($n-$l);
  $_[0]=$s;
}

## like rpad, but pads on the left

sub lpad{# left pads $_[0] to a length of $_[2]
  local($s,$n)=@_; local($l)=length($s);
  $s = " " x ($n-$l) . $s;
  $_[0]=$s;
}

# This canonizes a string by removing all spaces and white space 
# from the string, and transforming all characters to lower case.
# Eg.: &canonize($fontname);

sub canonize{ # make arg lower case, and remove spaces
  $_[0] =~ tr/A-Z/a-z/;
  $_[0] =~ s/\s//g;
}

# This canonizes a string by removing all spaces and white space 
# from the string.  Uppercase letters remain.
# Eg.: &Canonize($fontname);

sub Canonize{ # remove all white space
  $_[0] =~ s/\s//g;
}

sub PrepareToFinish{
  print CLN $cleanuptext;
  open (BAT, ">finish.bat");
  print BAT $finishtext;
}

## Here follow several tables of fontname-specific information.  I hope 
## that these tabular formulations will make it easy to revise this
## information in the event that the fontname conventions change, or 
## categories do.  

## Here is a table of font weights and single char
## weight indicators.  The weights were compiled from 
## the fontname weight.map file and my own analysis of 
## 927 afm files on my system.  Weights on the same line have
## the indicator given at the beginning of the line.
## All weights are canonized by converting to lowercase and 
## removing spaces.  Notice we allow for misspellings!

@weights = (
  "0 a thin hairline",
  "1 j extralight",
  "2 l light",
  "3 r regular roman normal standard",
  "4 k book",
  "5 m medium",
  "6 d demi demibold",
  "7 p poster",
  "8 s semibold",
  "9 b bold bld blditlic boldcondensed bolditalic",
  "A h heavy heavyface",
  "B c black",
  "C u ultra ultrablack",
  "D x extrabold extrablack",
	    );

@nfssweights = (	# matching fontname weights to NFSS weights
  "a ul",
  "j el",		
  "l l",		
  "r m",
  "m md",	# medium series = md (is this OK?)
  "k bk",	# AH book series
  "d db",
  "s sb",
  "p sb",	# what is poster weight?
  "b b",
  "h b",	# how does heavy differ from bold?
  "c bl",	# AH black series
  "x eb",
  "u ub",
);
## (In the above weights, I've tried to make sure that every font
## weight from fontname has some kind of equivalent NFSS series 
## indicator.  In several cases, I've simply guessed.  In other 
## cases (marked by `# AH'), I've made up my own series classes.
## This should all be checked and/or revised.)

sub loadweightinfo{
    foreach $elem (@weights) {
	local($sortkey, $ind, $synonymlist) = split(/ /, $elem, 3);
	$wt{$sortkey} = $ind;	# index weight abbrevs by sort key
	local(@synonyms) = split(/ /, $synonymlist);
	foreach $synonym (@synonyms) {
	    $weightsortkey{$synonym} = $sortkey;
	    $weightindicator{$synonym} = $ind;
	}
    }
    foreach $line (@nfssweights) {
	($w,$tmp) = split(/ /, $line);
        $nfssweight{$w} = $tmp;
    }   
}

@shapes=(
  "0 r roman regular",
  "4 di italicdisplay",
  "1 i italic kursiv ital itlic",
  "2 o oblique obl slanted",
  "3 d capitals display titling caption headline",
  "3 d tallcaps swashcaps lombardiccaps",
	 );

@nfssshapes = (	# Relating fontname shapes to NFSS shapes
  "r n",	#  (This table should probably be expanded.)
  "i it",
  "o sl",
  "c sc",
  "sc sc",
  "si si",	# new shape: small cap italics
  "u ui", 
  "d t",	# new shape: titling or capitals 
  "di ti",	# new shape: italic display
  "n un",	# new shape: underline upright
  "ni ni",	# new shape: underline italic
);

sub loadshapeinfo{
    foreach $elem (@shapes) {
	local($sortkey, $ind, $synonymlist) = split(/ /, $elem, 3);
	$shp[$sortkey] = $ind;	# index shape abbrevs by sort key
	local(@synonyms) = split(/ /, $synonymlist);
	foreach $syn (@synonyms) {
	    $shapesortkey{$syn} = $sortkey;
	    $shapeindicator{$syn} = $ind;
	}
    }
    foreach $line (@nfssshapes) {
	($sh, $tmp) = split(/ /, $line);
	$nfssshape{$sh} = $tmp;
    }
}

## Fontname 2.1 considers variant information and encoding together.
## Here, we need to consider them together for purposes of sorting,
## but we need to segregate them when thinking about naming the raw
## fonts.  We'll organize the raw data in tabular form (as in the 
## weight table above).  An extra field will indicate whether the
## variant is `shape-like' (like italic or oblique) which precedes the
## encoding digit or encoding-like, in which case the variant enters
## into combination with the encoding digit.

## Each uncommented line in this table contains 3 or more 
## fields.  The second categorizes the variant:
##   E = encoding-like variant
##   S = shape-like variant
## The first gives the sorting key, and the third 
## gives the fontname2.1 symbol, and the remaining fields
## yield keywords that might appear in a fontname to identify the type
## of variant.

## NOTE ON BITSTREAM TYPOGRAPHER FONTS: These appear not to be well-
## known.  There are no expert fonts, and small caps fonts contain 
## what you expect---small caps! Ligatures are in so-called ``extension 
## fonts,'' and these font families may also contain alternate 
## or swash fonts.  On my own recognizance, I use ``8q'' as the encoding 
## for the extension fonts.

@variants = (
  "0 S r regular",
  "1 E x expert exp",
  "2 S c smallcap SC smcap",
  "3 E q extension oldstyle", # for BitStream extension fonts
  "4 E a alt alternate alternative ",
  "5 E d osf oldstylefigure", # encoding digit is 7
  "6 E f fraction frac", # encoding digit is 7
  #"7 S d display titling caption headline tallcaps swashcaps lombardiccaps",
  "8 S p ornament thing thang",
  "9 S k greek",
  "A E c dfr", # encoding digit is 7
  "B S s gothic sans",
  "C S w script handwritten swash calligraphy cursive tango",
	     );
sub loadvariantinfo{
    foreach $elem (@variants) {
	$elem =~ s/\s+/ /g;
	local($sortkey, $enc, $ind, $synonymlist) = split(/ /, $elem, 4);
	local(@synonyms) = split(/ /, $synonymlist);
	foreach $syn (@synonyms) {
	    $variantsortkey{$syn} = $sortkey;
	    $variantindicator{$syn} = $ind;
	    $variantenctype{$syn} = $enc;
	}
    }
}