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