1# This -*- perl -*- module is a simple parser for Adobe Font Metrics files. 2 3package Font::AFM; 4 5=head1 NAME 6 7Font::AFM - Interface to Adobe Font Metrics files 8 9=head1 SYNOPSIS 10 11 use Font::AFM; 12 $h = new Font::AFM "Helvetica"; 13 $copyright = $h->Notice; 14 $w = $h->Wx->{"aring"}; 15 $w = $h->stringwidth("Gisle", 10); 16 $h->dump; # for debugging 17 18=head1 DESCRIPTION 19 20This module implements the Font::AFM class. Objects of this class are 21initialised from an AFM (Adobe Font Metrics) file and allow you to obtain information 22about the font and the metrics of the various glyphs in the font. 23 24All measurements in AFM files are given in terms of units equal to 251/1000 of the scale factor of the font being used. To compute actual 26sizes in a document, these amounts should be multiplied by (scale 27factor of font)/1000. 28 29The following methods are available: 30 31=over 3 32 33=item $afm = Font::AFM->new($fontname) 34 35Object constructor. Takes the name of the font as argument. 36Croaks if the font can not be found. 37 38=item $afm->latin1_wx_table() 39 40Returns a 256-element array, where each element contains the width 41of the corresponding character in the iso-8859-1 character set. 42 43=item $afm->stringwidth($string, [$fontsize]) 44 45Returns the width of the argument string. The string is 46assumed to be encoded in the iso-8859-1 character set. A second 47argument can be used to scale the width according to the font size. 48 49=item $afm->FontName 50 51The name of the font as presented to the PostScript language 52C<findfont> operator, for instance "Times-Roman". 53 54=item $afm->FullName 55 56Unique, human-readable name for an individual font, for instance 57"Times Roman". 58 59=item $afm->FamilyName 60 61Human-readable name for a group of fonts that are stylistic variants 62of a single design. All fonts that are members of such a group should 63have exactly the same C<FamilyName>. Example of a family name is 64"Times". 65 66=item $afm->Weight 67 68Human-readable name for the weight, or "boldness", attribute of a font. 69Examples are C<Roman>, C<Bold>, C<Light>. 70 71=item $afm->ItalicAngle 72 73Angle in degrees counterclockwise from the vertical of the dominant 74vertical strokes of the font. 75 76=item $afm->IsFixedPitch 77 78If C<true>, the font is a fixed-pitch 79(monospaced) font. 80 81=item $afm->FontBBox 82 83A string of four numbers giving the lower-left x, lower-left y, 84upper-right x, and upper-right y of the font bounding box. The font 85bounding box is the smallest rectangle enclosing the shape that would 86result if all the characters of the font were placed with their 87origins coincident, and then painted. 88 89=item $afm->UnderlinePosition 90 91Recommended distance from the baseline for positioning underline 92strokes. This number is the y coordinate of the center of the stroke. 93 94=item $afm->UnderlineThickness 95 96Recommended stroke width for underlining. 97 98=item $afm->Version 99 100Version number of the font. 101 102=item $afm->Notice 103 104Trademark or copyright notice, if applicable. 105 106=item $afm->Comment 107 108Comments found in the AFM file. 109 110=item $afm->EncodingScheme 111 112The name of the standard encoding scheme for the font. Most Adobe 113fonts use the C<AdobeStandardEncoding>. Special fonts might state 114C<FontSpecific>. 115 116=item $afm->CapHeight 117 118Usually the y-value of the top of the capital H. 119 120=item $afm->XHeight 121 122Typically the y-value of the top of the lowercase x. 123 124=item $afm->Ascender 125 126Typically the y-value of the top of the lowercase d. 127 128=item $afm->Descender 129 130Typically the y-value of the bottom of the lowercase p. 131 132=item $afm->Wx 133 134Returns a hash table that maps from glyph names to the width of that glyph. 135 136=item $afm->BBox 137 138Returns a hash table that maps from glyph names to bounding box information. 139The bounding box consist of four numbers: llx, lly, urx, ury. 140 141=item $afm->dump 142 143Dumps the content of the Font::AFM object to STDOUT. Might sometimes 144be useful for debugging. 145 146=back 147 148 149The AFM specification can be found at: 150 151 http://partners.adobe.com/asn/developer/pdfs/tn/5004.AFM_Spec.pdf 152 153 154=head1 ENVIRONMENT 155 156=over 10 157 158=item METRICS 159 160Contains the path to search for AFM-files. Format is as for the PATH 161environment variable. The default path built into this library is: 162 163 /usr/lib/afm:/usr/local/lib/afm:/usr/openwin/lib/fonts/afm/:. 164 165=back 166 167 168=head1 BUGS 169 170Kerning data and composite character data are not yet parsed. 171Ligature data is not parsed. 172 173 174=head1 COPYRIGHT 175 176Copyright 1995-1998 Gisle Aas. All rights reserved. 177 178This program is free software; you can redistribute it and/or modify 179it under the same terms as Perl itself. 180 181=cut 182 183#-------perl resumes here-------------------------------------------- 184 185use Carp; 186use strict; 187use vars qw($VERSION @ISOLatin1Encoding); 188 189$VERSION = "1.20"; 190 191 192# The metrics_path is used to locate metrics files 193# 194my $metrics_path = $ENV{METRICS} || 195 "/usr/lib/afm:/usr/local/lib/afm:/usr/openwin/lib/fonts/afm/:."; 196my @metrics_path = split(/:/, $metrics_path); 197foreach (@metrics_path) { s,/$,, } # reove trailing slashes 198 199@ISOLatin1Encoding = qw( 200 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef 201 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef 202 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef 203 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef space 204 exclam quotedbl numbersign dollar percent ampersand quoteright 205 parenleft parenright asterisk plus comma minus period slash zero one 206 two three four five six seven eight nine colon semicolon less equal 207 greater question at A B C D E F G H I J K L M N O P Q R S 208 T U V W X Y Z bracketleft backslash bracketright asciicircum 209 underscore quoteleft a b c d e f g h i j k l m n o p q r s 210 t u v w x y z braceleft bar braceright asciitilde .notdef .notdef 211 .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef 212 .notdef .notdef .notdef .notdef .notdef .notdef .notdef dotlessi grave 213 acute circumflex tilde macron breve dotaccent dieresis .notdef ring 214 cedilla .notdef hungarumlaut ogonek caron space exclamdown cent 215 sterling currency yen brokenbar section dieresis copyright ordfeminine 216 guillemotleft logicalnot hyphen registered macron degree plusminus 217 twosuperior threesuperior acute mu paragraph periodcentered cedilla 218 onesuperior ordmasculine guillemotright onequarter onehalf threequarters 219 questiondown Agrave Aacute Acircumflex Atilde Adieresis Aring AE 220 Ccedilla Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex 221 Idieresis Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis 222 multiply Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn 223 germandbls agrave aacute acircumflex atilde adieresis aring ae 224 ccedilla egrave eacute ecircumflex edieresis igrave iacute icircumflex 225 idieresis eth ntilde ograve oacute ocircumflex otilde odieresis divide 226 oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis 227); 228 229 230# Creates a new Font::AFM object. Pass it the name of the font as parameter. 231# Synopisis: 232# 233# $h = new Font::AFM "Helvetica"; 234# 235 236sub new 237{ 238 my($class, $fontname) = @_; 239 my $file; 240 $fontname =~ s/\.afm$//; 241 if ($^O eq 'VMS') { 242 $file = "sys\$ps_font_metrics:$fontname.afm"; 243 } else { 244 $file = "$fontname.afm"; 245 unless ($file =~ m,^/,) { 246 # not absolute, search the metrics path for the file 247 foreach (@metrics_path) { 248 if (-f "$_/$file") { 249 $file = "$_/$file"; 250 last; 251 } 252 } 253 } 254 } 255 open(AFM, $file) or croak "Can't find the AFM file for $fontname"; 256 my $self = bless { }, $class; 257 local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR 258 while (<AFM>) { 259 next if /^StartKernData/ .. /^EndKernData/; # kern data not parsed yet 260 next if /^StartComposites/ .. /^EndComposites/; # same for composites 261 if (/^StartCharMetrics/ .. /^EndCharMetrics/) { 262 # only lines that start with "C" or "CH" are parsed 263 next unless /^CH?\s/; 264 my($name) = /\bN\s+(\.?\w+)\s*;/; 265 my($wx) = /\bWX\s+(\d+)\s*;/; 266 my($bbox) = /\bB\s+([^;]+);/; 267 $bbox =~ s/\s+$//; 268 # Should also parse lingature data (format: L successor lignature) 269 $self->{'wx'}{$name} = $wx; 270 $self->{'bbox'}{$name} = $bbox; 271 next; 272 } 273 last if /^EndFontMetrics/; 274 if (/(^\w+)\s+(.*)/) { 275 my($key,$val) = ($1, $2); 276 $key = lc $key; 277 if (defined $self->{$key}) { 278 $self->{$key} = [ $self->{$key} ] unless ref $self->{$key}; 279 push(@{$self->{$key}}, $val); 280 } else { 281 $self->{$key} = $val; 282 } 283 } else { 284 print STDERR "Can't parse: $_"; 285 } 286 } 287 close(AFM); 288 unless (exists $self->{wx}->{'.notdef'}) { 289 $self->{wx}->{'.notdef'} = 0; 290 $self->{bbox}{'.notdef'} = "0 0 0 0"; 291 } 292 $self; 293} 294 295# Returns an 256 element array that maps from characters to width 296sub latin1_wx_table 297{ 298 my($self) = @_; 299 unless ($self->{'_wx_table'}) { 300 my @wx; 301 for (0..255) { 302 my $name = $ISOLatin1Encoding[$_]; 303 if (exists $self->{wx}->{$name}) { 304 push(@wx, $self->{wx}->{$name}) 305 } else { 306 push(@wx, $self->{wx}->{'.notdef'}); 307 } 308 } 309 $self->{'_wx_table'} = \@wx; 310 } 311 wantarray ? @{ $self->{'_wx_table'} } : $self->{'_wx_table'}; 312} 313 314sub stringwidth 315{ 316 my($self, $string, $pointsize) = @_; 317 return 0.0 unless defined $string; 318 return 0.0 unless length $string; 319 320 my @wx = $self->latin1_wx_table; 321 my $width = 0.0; 322 for (unpack("C*", $string)) { 323 $width += $wx[$_]; 324 } 325 if ($pointsize) { 326 $width *= $pointsize / 1000; 327 } 328 $width; 329} 330 331sub FontName; 332sub FullName; 333sub FamilyName; 334sub Weight; 335sub ItalicAngle; 336sub IsFixedPitch; 337sub FontBBox; 338sub UnderlinePosition; 339sub UnderlineThickness; 340sub Version; 341sub Notice; 342sub Comment; 343sub EncodingScheme; 344sub CapHeight; 345sub XHeight; 346sub Ascender; 347sub Descender; 348sub Wx; 349sub BBox; 350 351# We implement all the access functions within this simple autoload 352# function. 353 354sub AUTOLOAD 355{ 356 no strict 'vars'; # don't want to declare $AUTOLOAD 357 358 #print "AUTOLOAD: $AUTOLOAD\n"; 359 if ($AUTOLOAD =~ /::DESTROY$/) { 360 eval "sub $AUTOLOAD {}"; 361 goto &$AUTOLOAD; 362 } else { 363 my $name = $AUTOLOAD; 364 $name =~ s/^.*:://; 365 croak "Attribute $name not defined for AFM object" 366 unless defined $_[0]->{lc $name}; 367 return $_[0]->{lc $name}; 368 } 369} 370 371 372# Dumping might be useful for debugging 373 374sub dump 375{ 376 my($self) = @_; 377 my($key, $val); 378 foreach $key (sort keys %$self) { 379 if (ref $self->{$key}) { 380 if (ref $self->{$key} eq "ARRAY") { 381 print "$key = [\n\t", join("\n\t", @{$self->{$key}}), "\n]\n"; 382 } elsif (ref $self->{$key} eq "HASH") { 383 print "$key = {\n"; 384 my $key2; 385 foreach $key2 (sort keys %{$self->{$key}}) { 386 print "\t$key2 => $self->{$key}{$key2},\n"; 387 } 388 print "}\n"; 389 } else { 390 print "$key = $self->{$key}\n"; 391 } 392 } else { 393 print "$key = $self->{$key}\n"; 394 } 395 } 396} 397 3981; 399