summaryrefslogtreecommitdiff
path: root/fonts/utilities/vfinst/vfinst.lib
blob: 10a3a307c0c3002ee2d4cad68109270d68756b7a (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
### ====================================================================
###  @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;
	}
    }
}