summaryrefslogtreecommitdiff
path: root/fonts/utilities/vfinst/1vfinst
blob: 044ed922eb4b52e5a6f957f67afde376aa5ac9d6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
### ====================================================================
###  @Perl-file{
###     author          = "Alan Hoenig",
###     version         = "1.00", 
###     date            = "August 1998", 
###     filename        = "1vfinst",
###     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 first Perl script for the 
###                        vfinst virtual font installation utility.
###                        See accompanying file vfinst.tex for 
###                        additional details.",
###     package         = "vfinst",
###     dependencies    = "1vfinst, vfinst.par, vfinst.lib, 2vfinst, fontinst",
###  }
### ====================================================================

## Introduction and description.  
## =============================

## This script 1vfinst examines all raw font files (afm+pfb), checks that
## each afm file has a matching outline file, creates the sort keys for
## each font (the sort key also encodes the series, weight, and variant
## info of the font), and decides on the Karl Berry font name for
## subsequent renaming. It produces messages in a log file, and one or
## two important files for later processing.  The file fonts.lst contains
## information about the current font and its proposed new Berry name.
## The file typefaces.lst is produced only in TDS systems, and contains
## information linking font families, directory names,a dn supplier
## names.
## 
## The scripts 1vfinst and 2vfinst are unbundled so a user can more
## easily bail out in case things go horribly wrong during the execution
## of the first script.  Also, wizards and wise guys can edit
## (carefully!) fonts.lst if the fontnaming conventions need tweaking.
## (The 2vfinst script reads only these 2 files for font information.)

# SUBROUTINES AND STUFF ...

require("../vfinst.par"); ## system dependent statement!! Beware!
require("..${sep}vfinst.lib");
&getTDSplaces if &isTDS; # construct some TDS parameters
$vfencoding = $vfmapdir unless defined $vfencoding;
$font_place="." unless defined $font_place;
$afm_place="." unless defined $afm_place;

# `CheckInstallation' tries to verify that the installation 
# has been done more-or-less properly.

sub CheckInstallation{# checks that a file list exists 
  local($missing, @missinglist, @presentlist); $missing = $false;
  foreach $i (@_) {
    if (&isfile("..${sep}${i}") == $false) {
      $missing = $true;
      push(@missinglist, $i);
    } else {
      push(@presentlist, $i);
    }
  }
  local($misslist) = join("..",@missinglist);
  local($preslist) = join("\n  ",@presentlist);
  &dwlog("The files ");
  &dwlog("  $preslist");
  &dwlog("are properly located."); 
  die "Can't find \n  $misslist \nfiles...$!\n"
    if $missing; 
}

sub GetEnvironment{# sets up some synonyms...
  $texin = $vfinputs; ## traditional system: input directory;
  $encoding = $vfencoding; # where is file 8r.enc?                      
}

## Sub stripextension takes 2 args---the array containing the file names,
## and the stirng containing the extension.

sub stripextension{
  local(*files,$ext)=@_;
  foreach $elem (@files) {
      $elem =~ s/\.$ext$//;
  }
}

# It's important to be sure that every afm file has a corresponding
# font file, which either has no extension, or is a pfb or a pfa file.
# ('No extension' is treated like a pfa file.)  No args.
# 
# The afm file has a name like `firstname.afm'.  The corresponding font
# file can be `firstname.pfa' (an Ascii font file), `firstname.pfb' (a 
# binary file), or simply `firstname' (equivalent to a pfa file; this 
# convention applies to NeXT systems and others).

## SPECIAL DEBUG OPTION:  When debugging, it's convenient to run
## 1vfinst on large collections of afm files with no matching font
## files in sight.  Normally, this is forbidden, but if the variable
##   $debugging == $true
## then 1vfinst will not check against outline font files.

$debugging = $false;		# default status
## $debugging = $true;

## Usage: &get_afm_names("/psfonts/afm");
sub get_afm_names{
    local($afm_place)=$_[0];
    opendir(THISDIR, $afm_place);
    @allfiles=readdir(THISDIR); 
    @afmfiles = grep(/\.[Aa][Ff][Mm]$/, @allfiles);
    closedir(THISDIR);
} 

## Usage: &get_font_names("/psfonts");
sub get_font_names{
    local($font_place) = $_[0];
    opendir(THISDIR, $font_place);
    @allfiles=readdir(THISDIR);
    @pfafiles = grep(/\.[Pp][Ff][Aa]$/, @allfiles);
    @pfbfiles = grep(/\.[Pp][Ff][Bb]$/, @allfiles);
    @dotless = grep(!/\./, @allfiles); # files with no dots in name
    @dotless  =grep(-T, @dotless); # accept only text files...
    closedir(THISDIR);
    ## (Of course, @dotless still might contain oddball font lookalikes...)
}

## Another UNDOCUMENTED FEATURE:  If variables $font_place and $afm_place
## are defined (perhaps in vfinst.par...), then the fonts/afms will be taken
## from that pair of locations instead of from the current working directory
## ".".  

sub AllAfmsNeedMates{
  local(@allfiles, @pfafiles, @pfbfiles, @dotless);
  local(@missingfonts, @missingafms);
  &get_afm_names($afm_place);
  &get_font_names($font_place);
  @allfonts=@pfafiles;
  push(@allfonts, @pfbfiles);
  push(@allfonts, @dotless);
  @allfontnames = @allfonts; # save fonts with original extensions
  @oriafmfiles = @afmfiles;	# save afm's with original extensions
  &stripextension(*afmfiles, "[Aa][Ff][Mm]");
  &stripextension(*allfonts, "[Pp][Ff][AaBb]"); # regex OK in stripextension
  if ($debugging == $false) { # not debugging...
    @missingfonts = &listcompare(*afmfiles, *allfonts); 
    @missingafms =  &listcompare(*allfonts, *afmfiles); 
    local($fontgaps) = $false;
    if ($#missingfonts > -1) {## warning---missing font files
      $fontgaps = $true;
      &dwlog("There are some missing afm files.");
      &dwlog("They are >> \n ", join("\n ", @missingfonts));
      &dwlog("You will need to find the missing afm's and re-install.");
    }
    if ($#missingafms > -1) {## warning---missing afm files
      $fontgaps = $true;
      &dwlog("There are some missing font files.");
      &dwlog("They are >> \n ", join("\n ", @missingafms));
      &dwlog("You will need to find the missing fonts and re-install.");
    }
    if ($#afmfiles < 0) {# no afms at all!
      $fontgaps = $true;
      &dwlog("That's funny---I find no afm files at all!");
    } 
    if ($#allfonts < 0) {# no fonts at all!
      $fontgaps = $true;
      &dwlog("That's funny---I find no font files at all!");
    }
    &dwlog("Fonts appear to be all in order!") unless $fontgaps;   
    die "Something is wierd, and I can't go on..." if $fontgaps;  
  } else { # debugging
    &dwlog(" *** Debugging now---not checking font files at all...");
  }
}

## When using &ClassifyEachFont (see below), we need to extract certain
## info from the initial part of the afm file.  If the first arg is found
## in the current line from afm, the info is stored in the second arg.
## Eg.: &getafminfo('FamilyName', $Familyname);

sub getafminfo{
  local($searchstr) = $_[0];
  if (/$searchstr/) {
    ($head, $_[1])=split(/ /, $_, 2);
    $_[1] = $correx{"$currafm$searchstr"} 
      if defined $correx{"$currafm$searchstr"};
    &Canonize($_[1]); # removes white space
  }
}

  $talk = <<"Endtalk";
I need a 3-character designation for each font family
you've given me.  If I have heard of the family, I'll 
suggest the abbreviation to you (simply press ENTER to
accept).  If the family is new to me, I'll make a naive
suggestion; again, press ENTER to accept, or enter an 
abbreviation of your own.  

Endtalk

sub validatefamilydata{
  $myfamily = &stdin;
  for (;;) {
    $l = length($myfamily);
    if ( ($l == 3) || ($l == 0) ) {last;}
    print "Stop trying to confuse me---I need EXACTLY \n";
    print "three (3) characters.  Please try again (or just push ENTER). >> ";
    $myfamily = &stdin;
  }
}

## The lines of map.sup have lines like
##   a autologi Autologic
##   b bitstrea Bitstream
## It's a small table, so we load it right away.
## (The `sup' stands for `supplier'.)

sub loadsupplierinfo{
    open (SUPP, "..${sep}map.sup") || "I'm missing file map.sup.";
    while (<SUPP>) {
	next if /^\#/;		# discard comments
	chop;
	local($s, $supdirectory, $suppliername) = split(/\s+/, $_, 3);
	$supp2sabb{$suppliername} = $s;
	$sabb2supdir{$s} = $supdirectory;
    }
    $defaults = "9";
    $defaultsuppliername = "unknown";
}
&loadsupplierinfo;		# just do it!


## The entries in map.n2a look like this:
##   ACaslon ac
##   AGaramond ad
## (This file maps family names (n) to fontname abbrevs (a).)

sub loadfontfamilyinfo{
  open (DICT, "..${sep}map.n2a") || 
      die "Can't seem to open file `map.n2a'. Help, please";
  while (<DICT>) {
      next if /^\#/;		# ignore comments
      ($knownfamily, $abb) = split(/\s+/, $_);
      $family2abb{$knownfamily} = $abb;
  }
  close DICT;
}
&loadfontfamilyinfo;

## Lines in the map.a2d file look like this:
##   ac acaslon
##   ad agaramon
## (This file maps fontname abbreviations (a) to TDS directory
## names (d).)

sub loadfamdirectoryinfo{
    open (DICT, "..${sep}map.a2d") ||
	die "Can't open `map.a2d'.  Mayday...";
    while (<DICT>) {
	next if /^\#/;		# ignore comments
	($ab, $abbdir) = split(/\s+/, $_);
	$abb2dir{$ab} = $abbdir;
    }
}

## If a font family appears to be unknown, it may still be 
## possible to make an educated guess.  A known family may actually
## be embedded in the current family, as `AGaramond' is in 
## the family `AGaramondExp-Regular'.  We'll cycle through all the 
## hash keys to see if this is so.  We've previously prepared a file 
## `famnames' which contains the sorted family names (sorted by
## length of family name, that is), and we'd better read it into
## the array @famnames.

## sub bynamelength{
##     $aa = length($a); $bb = length($b);
##     $n2l{$a} = $aa; $n2l{$b} = $bb;
##     $n2l{$b} <=> $n2l{$a};
## }
## @famnames = sort bynamelength keys %family2abb;
## undef %n2l;

sub loadsortedfamnames{
    open(FAMNAMES, "..${sep}famnames") ||
	die "Where is my list of family names `famnames'?";
    while (<FAMNAMES>) {
	chop;
	push(@famnames, $_);
    }
    close FAMNAMES;
}
&loadsortedfamnames;		# loads the @famnames array

sub guessfontfamily{
    local($found) = false;
    foreach $fname (@famnames) {
	next if length($Familyname) < length($fname);
	$fname_ = $fname; 
	last if $Familyname =~ /$fname_/;
    }
    $found = $true if $Familyname =~ /$fname_/;
    $tentativefamily = "unknown"; # the default
    $tentativefamily = $family2abb{$fname_} if $found == $true;
    $tentativefamily = "$thisabb$tentativefamily";
}

$talked=$false;
sub getfontfamily{
  print $talk if $talked == $false; $talked = $true;
  if (defined($family2abb{$Familyname})) { # known font family
      ($tentativefamily, $tmp) = split(/ /, $family2abb{$Familyname});
      $tentativefamily =~ tr/A-Z/a-z/;
      $tentativefamily = "$thisabb$tentativefamily";
      print "Here's what I can suggest for a family name for \n";
      print ">>  $Familyname.\nPress ENTER to accept, or type your own:\n";
      print "  >>  $tentativefamily\n";
  } else {			# unknown font family
      &guessfontfamily;
      $bruteforceguess=substr($fontname, 0, 2);
      $bruteforceguess=~tr/A-Z/a-z/;
      $bruteforceguess = "$thisabb$bruteforceguess";
      $tentativefamily = $bruteforceguess 
	  if $tentativefamily =~ "unknown";
      print "I've not heard of the font family containing\n";
      print "$fontname in file $currafm.  May I suggest\n";
      print ">>  $tentativefamily\nas a font family name?  ";
      print "(Press ENTER to accept, or give a 3-letter name.) \n";
  }
  &validatefamilydata; # must be exactly 3 chars or a null string
  if ($myfamily eq "") {$myfamily=$tentativefamily;}
  $family{$Familyname}=$myfamily; # eg. $family{'AGaramond'}='pad'
}

## computes tangent from ItalicAngle
## eg. $mytan = &Tan($italicangle);

sub tan{
  local($angle) = @_;
  local($radangle) = $angle * $piover180;
  $mytan = sin($radangle)/cos($radangle);
  if ($mytan < 0) { 
     $mytan = -1*$mytan;
  }
  $mytan;
}

## FindArrayElementContaining finds the element of $_[0] which contains $_[1].
## eg. $currfont = &FindArrayElementContaining(*allfontnames, $currafm);
## We use this array to use the first name of an afm file to read into
## an array containing full names of font files to get the actual font
## name.

sub FindArrayElementContaining{
  local(*source, $strng)=@_;
  foreach $elem (@source) {
    $found = $elem;
    last if $elem =~ /\b$strng\b|\b$strng\./;
  }
  $found;
}

sub getfontcharacteristics{
  @afmtop = ();
  for (;;) {
      $_=<CURRAFM>; chop $_; # get rid of CR-LF
      push (@afmtop, $_) unless /EncodingScheme/; # store the top
      last if /StartCharMetrics/;
      &getafminfo("FontName", $fontname); 
      &getafminfo("FullName", $fullname);
      &getafminfo("FamilyName", $Formalfamilyname); 
      &getafminfo("Weight", $weight); $weight =~ tr/A-Z/a-z/;
      &getafminfo("EncodingScheme", $encoding);
      &getafminfo("ItalicAngle", $italicangle);
      &getafminfo("IsFixedPitch", $monowidth);
  }
  $topofafmfile = join ("", @afmtop);
  foreach $supplier (keys %supp2sabb) {
      $supplierfound = $true;
      $thissupplier = $supplier;
      $thisabb = $supp2sabb{$supplier};
      last if $topofafmfile =~ /$supplier/;
      $supplierfound = $false;
  }
  if ($supplierfound == $false) {
    $thissupplier = "unknown";	# use defaults
    $thisabb = "9";
  }
}

sub getfontangle{
  $angle{$myfamily} = 0 unless defined $angle{$myfamily}; # default
  if ($italicangle != 0) {# non-upright font
    $mytan = &tan($italicangle);
    $angle{$myfamily} = int(1000 * $mytan);
    ## Because of coordinate system differences, the angle is almost
    ## always negative, so the tan will be negative.  We make it positive.
    ## Incidentally, Perl4 forgot to make the tangent negative, so we 
    ## deal with it here.
    $angle{$myfamily} *= -1 if $angle{$myfamily}<0;
  } else {
    $angle{$myfamily} = "000";
  }
}

&loadweightinfo;

sub getfontweight{
    if (defined($weightsortkey{$weight})) {
	$wsk = $weightsortkey{$weight};	# weight sort key
	$wind = $weightindicator{$weight}; # weight indicator
    } else {			# screwy weight somehow
	print "The weight `$weight' for $fontname is a new one for me.\n";
	print "I use defaults for normal-type weights.\n";
	$weight = "normal";
	$wsk = $weightsortkey{$weight}; # use normal as default
	$wind = $weightindicator{$weight}; # ditto; alert user
    }
}

&loadshapeinfo;

sub getfontshape{
    $shapekey = "roman";	# default values follow...
    $shsk = 0;
    $shind = "r";
    foreach $key (keys %shapesortkey) {
	if ($fullname=~/$key/i) {
	    $shsk = $shapesortkey{$key};
	    $shind = $shapeindicator{$key};
	    $shapekey = $key;
	}
    }
}

&loadvariantinfo;

## It's possible that raw fonts can have more than one non-shape
## variant.  Such fonts will rarely be suitable for constructing
## virtual fonts for prose typesetting, so I wil give them the highest
## sort key to get them out of the way.  NB:  All sort key synonyms
## are case insensitive EXCEPT for those containing an uppercase
## character in the @variants array.  This necessitates the special
## treatment in the foreach loop below...

sub getfontvariant{
    $variant = 0;		# default
    undef @foundvariants;
    $varsk = -1;		# default for sork key
    foreach $key (keys %variantsortkey) {
        if ($key =~ /[A-Z]/) {# UC indicates case sensitivity
	  if ($fontname =~ /$key/) {
	      push(@foundvariants, $key);
	      $test = $variantsortkey{$key};
	      $varsk = $test if $test>$varsk; # get largest of sort keys
	  }    
	} else {
	  if ($fontname =~ /$key/i) {
	      push(@foundvariants, $key);
	      $test = $variantsortkey{$key};
	      $varsk = $test if $test>$varsk; # get largest of sort keys
	  }    
        }
    }
    if (! defined(@foundvariants)) {
	push(@foundvariants, "regular");
	$varsk = 0;
    }
}

sub sortcurrvar{		# sort the chars in the $currvar string
    local(@chars) = split(//, $currvar);
    @chars = sort @chars;
    $currvar = join('', @chars);
}

sub CreateNewRawFontNames{
    # First, the font abbreviation and weight....
    $berryname = "$myfamily$wind";
    # Now for the issue of variants, which includes shape...
    if ($shsk > 0) {
	$berryname .= $shind;	# append shape if not `normal'
    }
    $currvar = ""; $currdigit = 8; $currenc = "a"; # initialize variants
    # In the absence of other other variants, variants will be given
    # by "$currvar$currdigit$currenc" = "8a".
    foreach $vkey (@foundvariants) {
	$varenctype = $variantenctype{$vkey};
	$varind = $variantindicator{$vkey};
	$varsk = $variantsortkey{$vkey};
        if ($varenctype eq "S") { # a shape-like variant exists for the font
            $currvar .= $varind if $varsk gt "0";
        }
        if (($varsk==4)||($varsk==5)||($varsk==6)||($varsk eq "A")) {
            $currdigit = 7;
        }
        if ($varenctype eq "E") {
            $currenc = $varind;
        }
    }
    # $currvar is a string of letters.  For fun, let's sort them.
    &sortcurrvar;
    $berryname .= "$currvar$currdigit$currenc";
    &dwlog("Uh oh---`$berryname' is more than 8 chars!  Fix me.")
	if length $berryname > 8;
}

sub findmaxlength{		# find longest length of entries in @foo
    local(*foo) = @_;
    $maxl = -1; local($l, $maxl);
    foreach $elem (@foo) { # let's find max length of filename
	$l = length($elem);
	$maxl = $l if $l > $maxl;
    }
    $maxl;
}

## Sometimes, two or more fonts have the same sortkey.  This may occur
## because the font files are somehow present more than once in the 
## working directory, or because VFinst is not capable of distinuishing 
## between two different fonts.  The user should be notified of this
## potential conflict.  Duplicate fonts should be eliminated.
## Then, 1vfinst should be executed again

undef @duplicates;			# initialize array
sub checkforduplicates{
    foreach $line (@fontlist) {
	local($sortkey, $fontstuff) = split / /, $line, 2;
	$scratch{$sortkey} .= $line;
    }
    local($count);
    foreach $key (keys %scratch) {
	chomp $scratch{$key};
	$count = ($scratch{$key} =~ /\n/g); # $count>0 for duplicate entries
	push(@duplicate, $scratch{$key}) if $count > 0;
    }
    undef @scratch;
    $duplicates_found = $true if @duplicate;
}




  $TDStalk = <<"EndTDStalk";
You have indicated this is a TeX Directory Structure (TDS)
system.  That means you'll need to provide me a supplier
(e.g., monotype, adobe, etc) and a typeface name (agaramon,
baskerv, and so on).  I'll do my best to help you, but
you might need to provide me with names.  Here we go...

EndTDStalk

## One special case: in general, medium and normal are two distinct
## weights (series).  People are sloppy about their terminology, however.
## In case there is no actual normal series, medium shall become normal.

$normalweight = $false;
$mediumweight = $false;
sub recalibratefontlist{
    foreach $elem (@fontlist) {
	if (substr($elem, 3, 1) == $mediumwt) {	# we've found medium!
	    substr($elem, 3, 1) = $normalwt; # change sort key
	    substr($elem, 10, 1) = "r";	# change series indicator
	}
    }
}

sub getfontcorrections{
    open (RC, "..${sep}vfinst.rc");
    &dwlog("\nHere are the font corrections in vfinst.rc:");
    while (<RC>) {
	chop if /\n$/;		# get rid of newline if it is present
	next if /^\#/;		# ignore comments
	&dwlog("  $_");
	s/\s+/ /g;		# eliminate extra spaces
	local($fontname, $characteristic, $correction) = 
	    split(/\s+/, $_, 3);
        $afmfile=$file2font{$fontname};
	$correx{"$afmfile$characteristic"} = $correction;
    }
    close RC;
    &dwlog("");			# skip a line
}

## We need to connect the fonts via the FontName with the names
## of the font files before they have been renamed according to the
## Berry scheme.  The next subroutine creates that mapping---a hash
##     so that $font2file{$fontname}=$filename.

sub map_files_to_fonts{
    foreach $afm_ (@oriafmfiles) {
	open(CURRAFM, "$afm_place$sep$afm_") || die "Where is $afm_?";
	local($afmm, $ext)=split(/\./, $afm_);
	$myfontname="XXXXXX";	# default value indicates not found
        for (;;) {
            $_=<CURRAFM>; 
	    $_ =~ s/[\n\r]//g; # get rid of CR-LF
            last if /StartCharMetrics/;
            if (/FontName/) {
		($tmp, $myfontname)=split(/ /, $_, 2);  
	    }
	}
	$file2font{$myfontname}=$afmm;
    }
}

sub ClassifyEachFont{
  @afmfiles = sort @afmfiles;
  &map_files_to_fonts; 
  &getfontcorrections if -e "..${sep}vfinst.rc"; # non-invasive afm correx
  foreach $currafmname (@oriafmfiles) {
    local($currafm, $aext) = split /\./, $currafmname;             
    open(CURRAFM, "$afm_place$sep$currafmname"); 
    &getfontcharacteristics;
    $normalweight = $true 
	if $weightsortkey{$weight} == $weightsortkey{"normal"};
    $mediumweight = $true
	if $weight =~ /medium/i;
    # We'll try to get as much info as possible from the fontname
    ($Familyname, $fontvar) = split(/-/,$fontname);
    close CURRAFM;  
    $familyname = $Familyname; 
    &getfontfamily unless defined $family{$Familyname};     
    $myfamily = $family{$Familyname};
    &getfontangle;
    &getfontweight;
    &getfontshape;
    &getfontvariant;
    $sortkey="$myfamily$wsk$shsk$varsk";
    # Now that we have all the information about the font, we might as 
    # well create the new Berry name for it...
    &CreateNewRawFontNames;
    $currfont = &FindArrayElementContaining(*allfontnames, $currafm);
    local($fontfirst, $fext) = split /\./, $currfont;
    $maxlength = &findmaxlength(*allfontnames);
    $maxlength = 11 if $maxlength<11;
    $currfont = "Unknown" if $debugging;
    $maxlength = length("unknown ") if $debugging;
    &rpad($berryname, 11);
    $fontandafm = "$fontfirst.\{$fext,$aext\}";
    &rpad($fontandafm, $maxlength+6);
    $fontinformation = 
      "$sortkey $berryname$angle{$myfamily} $fontandafm $fontname\n";
    ## Before saving this information, we first...
    push(@fontlist,$fontinformation);
  }
  undef %family2abb; # release memory resources
  if (($normalweight == $false) && ($mediumweight == $true)) {
      # That is, since there is no normal but there is a medium,
      # medium shall become normal.
      $mediumwt = $weightsortkey{"medium"};
      $normalwt = $weightsortkey{"normal"};
      &recalibratefontlist;
  }
  @fontlist = sort @fontlist;
  &checkforduplicates;
  $file = "File"; &rpad($file, $maxlength);
  $name = "Name"; &rpad($name, $maxlength);
  &dwlog("\nHere are the fonts and their proposed new (Berry) names:\n");
  $titles[0] = 
    "$rem Sort New     Slant  $file       Long Digital Foundry ";
  $titles[1] =  
    "$rem Key  Name           $name       Name ... ";
  $titles[2] = "$rem " . "=" x 72; 
  open (FONTS, ">fonts.lst");
  print FONTS "$rem This is list of font information used by VFinst.\n";
  print FONTS "$rem Created by $vfp on $today at $now.\n$rem\n";
  print FONTS join("\n",@titles), "\n";
  print FONTS @fontlist;
  close FONTS;
  &dwlog(join("\n",@titles));
  &dwlog(join("",@fontlist));
  if (&isTDS) {			# get additional info for TDS...
   # At this point, all fonts have been classified and stored within
   # @fontlist.  We'll waltz through that array, using that array to
   # determine the font families we are using and to seek for 
   # appropraite info in the map files that are part of vfinst.
   print $TDStalk;
   open (TYPE, ">typeface.lst");
   &loadfamdirectoryinfo;
   foreach $entry (@fontlist) {
       undef $famdir;
       ($sortkey, $berryname, $slant, $currfont, $fontname) = 
	   split(/\s+/, $entry);
       $s = substr($berryname, 0, 1); # supplier abbreviation
       $fm = substr($berryname, 1, 2); # 2-char family abbrev
       $fm = substr($berryname, 1, 2); # 2-char family abbrev
       $fam = substr($berryname, 0, 3); # 3-char family abbrev
       if (!defined $famdir{$fam}) { # get info only if necessary...
           $currsupdir{$fam} = $sabb2supdir{$s};# supplier first
           print "I will use supplier directory\n  >>$currsupdir{$fam}";
           print "\nfor $berryname and all other fonts with the same\n";
           print "family name.  Press ENTER to accept, or enter another\n";
           print "alternative....  ";
           $alt = &stdin;
           $currsupdir{$fam} = $alt if $alt ne "";
	   $famdir{$fam} = $abb2dir{$fm} if defined $abb2dir{$fm};
           if (!defined $abb2dir{$fm}) {# no lookup info
	       print "Hmm---I have no information for a directory name for\n";
	       print "the $fm family of fonts.  Please enter a lowercase\n";
	       print "directory name for these fonts.  >>";
	       $famdir{$fam} = &stdin;
	   } else {
	       print "I will use font directory name\n  >>$abb2dir{$fm}\n";
	       print "for $berryname and all other fonts within the same\n";
	       print "family.  Press ENTER to accept, or enter another\n";
	       print "directory name now.  >>";
	       $alt = &stdin;
	       $famdir{$fam} = $alt if $alt ne "";
	   }
	   $tdsinfo{$fam} = "$fam $famdir{$fam} $currsupdir{$fam}";
	   print TYPE "$tdsinfo{$fam}\n";
       }
   }
   close TYPE;
   &dwlog("\nHere are the fontfamilies, typeface names, and suppliers");
   &dwlog("for this installation:\n");
   foreach $key (sort keys %tdsinfo) {
  	     &dwlog("$tdsinfo{$key}");
	 }
   &reassure("fonts.lst");
  }
  open(DUPS, ">duplicat.lst") || # prepare for duplicate info...
      die "Can't open duplicates file";
  print DUPS "This file `duplicat.lst' created by $vfp";
  print DUPS " on $today at $now.\n\n";
  if ($duplicates_found) {
      print DUPS "A list of all fonts that appear the same to VFINST...\n";
      print DUPS "=============================================\n";
      &dwlog("Some fonts may be duplicated or may not appear distinct to ");
      &dwlog("VFinst.  Here's the list:\n");
      &dwlog("=============================================");
      foreach $dup (@duplicate) {
	  print DUPS "$dup\n";
	  print DUPS "=============================================\n";
	  &dwlog("$dup\n", "=============================================");
      }
      &dwlog("Make adjustments, and re-run this script `1vfinst'.");
      &dwlog("(Check `Fixing .afm files' in `vfinst.tex' for assistance.)");
      &reassure("duplicat.lst");
      print DUPS "Duplicates should be removed or fixed; check `vfinst.tex'";
      print DUPS " for assistance.  Then _re-run_ the `1vfinst' script...\n";
  } else {
      print DUPS "No duplicate fonts found.\n";
      &dwlog("No duplicate fonts found.");
  }
  close DUPS;
}

################################################################
#
# MAIN ROUTINE.
#
################################################################

## First, we open a text file that gets written again ONLY in cases
## of normal program termination.  This makes it possible for 2vfinst.prl
## to test for proper termination of this program.

print "This is $vfp.\n\n"; # banner

sub DoIt{
  &OpenLog; ## opens the log file
  &GetEnvironment;
  if (&isTDS) {
    print "\nThis is a TDS (TeX Directory Structure) Production!\n\n";
  }
  &CheckInstallation(@VFINSTmanifest);
  &AllAfmsNeedMates;
  &ClassifyEachFont; # get font family, width, shape, and variant, etc.
  &CloseLog;
}

&DoIt; ## YES!!

## Now summarize instructions for the next phase...
open (NOW, ">start.vfi");
print NOW "(This is the file _start.vfi_ produced by VFinst$ver.)\n\n";
print NOW "Here's the list of fonts with some supporting information:\n\n";
print NOW join("\n",@titles),"\n";
print NOW join("",@fontlist);
if ($duplicates_found) {
    print NOW 
	"\nVFinst thinks that some fonts are duplicated.  Here's that list:\n";
    print NOW 
	"==============================================================\n";
    foreach $dup (@duplicate) {
	print NOW "$dup\n";
	print NOW 
	    "==============================================================\n";
    }
}
    $now =<<"EndNow";

     Please inspect this list, and eliminate any fonts (.pfb + .afm)
that may not be appropriate.  (Check `vfinst.tex` for additional info.)
Eliminate any duplicate fonts, if VFinst found any.  In case you do make
any changes to the fonts that are present, please then re-run the script
`1vfinst`.  
     When you are satisfied with your collection of fonts, then
run the script `2vfinst`.
EndNow
print NOW $now;
print $now;
close NOW;
&display("\n(Font information plus instructions for proceeding \n",
	 "appear in the Ascii file `start.vfi'.");