This file is indexed.

/usr/share/perl5/Font/AFM.pm is in libfont-afm-perl 1.20-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
# This -*- perl -*-  module is a simple parser for Adobe Font Metrics files.

package Font::AFM;

=head1 NAME

Font::AFM - Interface to Adobe Font Metrics files

=head1 SYNOPSIS

 use Font::AFM;
 $h = new Font::AFM "Helvetica";
 $copyright = $h->Notice;
 $w = $h->Wx->{"aring"};
 $w = $h->stringwidth("Gisle", 10);
 $h->dump;  # for debugging

=head1 DESCRIPTION

This module implements the Font::AFM class. Objects of this class are
initialised from an AFM (Adobe Font Metrics) file and allow you to obtain information
about the font and the metrics of the various glyphs in the font.

All measurements in AFM files are given in terms of units equal to
1/1000 of the scale factor of the font being used. To compute actual
sizes in a document, these amounts should be multiplied by (scale
factor of font)/1000.

The following methods are available:

=over 3

=item $afm = Font::AFM->new($fontname)

Object constructor. Takes the name of the font as argument.
Croaks if the font can not be found.

=item $afm->latin1_wx_table()

Returns a 256-element array, where each element contains the width
of the corresponding character in the iso-8859-1 character set.

=item $afm->stringwidth($string, [$fontsize])

Returns the width of the argument string. The string is
assumed to be encoded in the iso-8859-1 character set.  A second
argument can be used to scale the width according to the font size.

=item $afm->FontName

The name of the font as presented to the PostScript language
C<findfont> operator, for instance "Times-Roman".

=item $afm->FullName

Unique, human-readable name for an individual font, for instance
"Times Roman".

=item $afm->FamilyName

Human-readable name for a group of fonts that are stylistic variants
of a single design. All fonts that are members of such a group should
have exactly the same C<FamilyName>. Example of a family name is
"Times".

=item $afm->Weight

Human-readable name for the weight, or "boldness", attribute of a font.
Examples are C<Roman>, C<Bold>, C<Light>.

=item $afm->ItalicAngle

Angle in degrees counterclockwise from the vertical of the dominant
vertical strokes of the font.

=item $afm->IsFixedPitch

If C<true>, the font is a fixed-pitch
(monospaced) font.

=item $afm->FontBBox

A string of four numbers giving the lower-left x, lower-left y,
upper-right x, and upper-right y of the font bounding box. The font
bounding box is the smallest rectangle enclosing the shape that would
result if all the characters of the font were placed with their
origins coincident, and then painted.

=item $afm->UnderlinePosition

Recommended distance from the baseline for positioning underline
strokes. This number is the y coordinate of the center of the stroke.

=item $afm->UnderlineThickness

Recommended stroke width for underlining.

=item $afm->Version

Version number of the font.

=item $afm->Notice

Trademark or copyright notice, if applicable.

=item $afm->Comment

Comments found in the AFM file.

=item $afm->EncodingScheme

The name of the standard encoding scheme for the font. Most Adobe
fonts use the C<AdobeStandardEncoding>. Special fonts might state
C<FontSpecific>.

=item $afm->CapHeight

Usually the y-value of the top of the capital H.

=item $afm->XHeight

Typically the y-value of the top of the lowercase x.

=item $afm->Ascender

Typically the y-value of the top of the lowercase d.

=item $afm->Descender

Typically the y-value of the bottom of the lowercase p.

=item $afm->Wx

Returns a hash table that maps from glyph names to the width of that glyph.

=item $afm->BBox

Returns a hash table that maps from glyph names to bounding box information.
The bounding box consist of four numbers: llx, lly, urx, ury.

=item $afm->dump

Dumps the content of the Font::AFM object to STDOUT.  Might sometimes
be useful for debugging.

=back


The AFM specification can be found at:

   http://partners.adobe.com/asn/developer/pdfs/tn/5004.AFM_Spec.pdf


=head1 ENVIRONMENT

=over 10

=item METRICS

Contains the path to search for AFM-files.  Format is as for the PATH
environment variable. The default path built into this library is:

 /usr/lib/afm:/usr/local/lib/afm:/usr/openwin/lib/fonts/afm/:.

=back


=head1 BUGS

Kerning data and composite character data are not yet parsed.
Ligature data is not parsed.


=head1 COPYRIGHT

Copyright 1995-1998 Gisle Aas. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

#-------perl resumes here--------------------------------------------

use Carp;
use strict;
use vars qw($VERSION @ISOLatin1Encoding);

$VERSION = "1.20";


# The metrics_path is used to locate metrics files
#
my $metrics_path = $ENV{METRICS} ||
    "/usr/lib/afm:/usr/local/lib/afm:/usr/openwin/lib/fonts/afm/:.";
my @metrics_path = split(/:/, $metrics_path);
foreach (@metrics_path) { s,/$,, }    # reove trailing slashes

@ISOLatin1Encoding = qw(
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space
 exclam quotedbl numbersign dollar percent ampersand quoteright
 parenleft parenright asterisk plus comma minus period slash zero one
 two three four five six seven eight nine colon semicolon less equal
 greater question at A B C D E F G H I J K L M N O P Q R S
 T U V W X Y Z bracketleft backslash bracketright asciicircum
 underscore quoteleft a b c d e f g h i j k l m n o p q r s
 t u v w x y z braceleft bar braceright asciitilde .notdef .notdef
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
 .notdef .notdef .notdef .notdef .notdef .notdef .notdef dotlessi grave
 acute circumflex tilde macron breve dotaccent dieresis .notdef ring
 cedilla .notdef hungarumlaut ogonek caron space exclamdown cent
 sterling currency yen brokenbar section dieresis copyright ordfeminine
 guillemotleft logicalnot hyphen registered macron degree plusminus
 twosuperior threesuperior acute mu paragraph periodcentered cedilla
 onesuperior ordmasculine guillemotright onequarter onehalf threequarters
 questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE
 Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex
 Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis
 multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn
 germandbls agrave aacute acircumflex atilde adieresis aring ae
 ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex
 idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide
 oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis
);


# Creates a new Font::AFM object.  Pass it the name of the font as parameter.
# Synopisis:
#
#    $h = new Font::AFM "Helvetica";
#

sub new
{
   my($class, $fontname) = @_;
   my $file;
   $fontname =~ s/\.afm$//;
   if ($^O eq 'VMS') {
       $file = "sys\$ps_font_metrics:$fontname.afm";
   } else {
       $file = "$fontname.afm";
       unless ($file =~ m,^/,) {
	   # not absolute, search the metrics path for the file
	   foreach (@metrics_path) {
	       if (-f "$_/$file") {
		   $file = "$_/$file";
		   last;
	       }
	   }
       }
   }
   open(AFM, $file) or croak "Can't find the AFM file for $fontname";
   my $self = bless { }, $class;
   local($/, $_) = ("\n", undef);  # ensure correct $INPUT_RECORD_SEPARATOR
   while (<AFM>) {
       next if /^StartKernData/ .. /^EndKernData/;  # kern data not parsed yet
       next if /^StartComposites/ .. /^EndComposites/; # same for composites
       if (/^StartCharMetrics/ .. /^EndCharMetrics/) {
	   # only lines that start with "C" or "CH" are parsed
	   next unless /^CH?\s/;
	   my($name) = /\bN\s+(\.?\w+)\s*;/;
	   my($wx)   = /\bWX\s+(\d+)\s*;/;
	   my($bbox)    = /\bB\s+([^;]+);/;
	   $bbox =~ s/\s+$//;
	   # Should also parse lingature data (format: L successor lignature)
	   $self->{'wx'}{$name} = $wx;
	   $self->{'bbox'}{$name} = $bbox;
	   next;
       }
       last if /^EndFontMetrics/;
       if (/(^\w+)\s+(.*)/) {
	   my($key,$val) = ($1, $2);
	   $key = lc $key;
	   if (defined $self->{$key}) {
	       $self->{$key} = [ $self->{$key} ] unless ref $self->{$key};
	       push(@{$self->{$key}}, $val);
	   } else {
	       $self->{$key} = $val;
	   }
       } else {
	   print STDERR "Can't parse: $_";
       }
   }
   close(AFM);
   unless (exists $self->{wx}->{'.notdef'}) {
       $self->{wx}->{'.notdef'} = 0;
       $self->{bbox}{'.notdef'} = "0 0 0 0";
   }
   $self;
}

# Returns an 256 element array that maps from characters to width
sub latin1_wx_table
{
    my($self) = @_;
    unless ($self->{'_wx_table'}) {
	my @wx;
	for (0..255) {
	    my $name = $ISOLatin1Encoding[$_];
	    if (exists $self->{wx}->{$name}) {
		push(@wx, $self->{wx}->{$name})
	    } else {
		push(@wx, $self->{wx}->{'.notdef'});
	    }
	}
	$self->{'_wx_table'} = \@wx;
    }
    wantarray ? @{ $self->{'_wx_table'} } : $self->{'_wx_table'};
}

sub stringwidth
{
    my($self, $string, $pointsize) = @_;
    return 0.0 unless defined $string;
    return 0.0 unless length $string;

    my @wx = $self->latin1_wx_table;
    my $width = 0.0;
    for (unpack("C*", $string)) {
	$width += $wx[$_];
    }
    if ($pointsize) {
	$width *= $pointsize / 1000;
    }
    $width;
}

sub FontName;
sub FullName;
sub FamilyName;
sub Weight;
sub ItalicAngle;
sub IsFixedPitch;
sub FontBBox;
sub UnderlinePosition;
sub UnderlineThickness;
sub Version;
sub Notice;
sub Comment;
sub EncodingScheme;
sub CapHeight;
sub XHeight;
sub Ascender;
sub Descender;
sub Wx;
sub BBox;

# We implement all the access functions within this simple autoload
# function.

sub AUTOLOAD
{
    no strict 'vars';  # don't want to declare $AUTOLOAD

    #print "AUTOLOAD: $AUTOLOAD\n";
    if ($AUTOLOAD =~ /::DESTROY$/) {
	eval "sub $AUTOLOAD {}";
	goto &$AUTOLOAD;
    } else {
	my $name = $AUTOLOAD;
	$name =~ s/^.*:://;
	croak "Attribute $name not defined for AFM object"
	    unless defined $_[0]->{lc $name};
	return $_[0]->{lc $name};
    }
}


# Dumping might be useful for debugging

sub dump
{
    my($self) = @_;
    my($key, $val);
    foreach $key (sort keys %$self) {
	if (ref $self->{$key}) {
	    if (ref $self->{$key} eq "ARRAY") {
		print "$key = [\n\t", join("\n\t", @{$self->{$key}}), "\n]\n";
	    } elsif (ref $self->{$key} eq "HASH") {
		print "$key = {\n";
		my $key2;
		foreach $key2 (sort keys %{$self->{$key}}) {
		    print "\t$key2 => $self->{$key}{$key2},\n";
		}
		print "}\n";
	    } else {
		print "$key = $self->{$key}\n";
	    }
	} else {
	    print "$key = $self->{$key}\n";
	}
    }
}

1;