From: churchh@emx.cc.utexas.edu (Henry Churchyard)
Newsgroups: comp.lang.postscript,comp.fonts
Subject: Postscript program to dump .AFM info?
Keywords: .AFM
Date: 28 Aug 92 19:46:28 GMT
Followup-To: comp.lang.postscript
Organization: The University of Texas at Austin; Austin, Texas


   I had the idea of patching the SHOWFONT.PS program in the PSROFF
3.0 distribution so that it would dump a table of font metrics in .AFM
compatible format (this could be useful in cases where a Type 1 font
is distributed without an .AFM file, just a pixmap and/or metrics file
for some program and/or platform that is not personally useful for
you).

   I noticed that the results, for a font that I already had an .AFM
file for, showed a lot of minor discrepancies from the .AFM.  Am I
correct in surmising that some, at least, of these minor inaccuracies
come from getting the _charpath_s of 18pt. characters on a 300 dpi
device?  (I noticed that when I went up to 20pts., some of the
discrepancies lessened).

   So does anybody have a general purpose program for getting
rock-solid .AFM values from a Postscript font (at least for those
characters which are mapped in the current encoding vector)?

Thanks!

         --Henry Churchyard     churchh@emx.cc.utexas.edu


 -(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-

%! PS-Adobe 1.0
%%Title: showfont -- displays the font metrics in a pretty one page table
% patched 8/92 to dump bounding-box and width info, scaled as in .AFM file
% Change "^D" at end to real \004, change "Palatino-Roman" to font desired.
% Accuracy of .AFM results on 300dpi device may not be greater than 13.3,
% due to equation:  1/300 inch = 13.3 x (18pts/1000pts)(1 inch/72pts) ???
%%Creator: Ken Marchant & Chris Lewis
%%CreationDate: March 1989
%%Pages: atend
%%
/SAVEOBJ save def

%(START showfont display Palatino-Roman\n) print
%flush
/FONTname (Palatino-Roman) def

%%  Setup functions used and etc...

/rowmove {
    /I exch def
    I 16 mod 30 mul 72 add
    680 I 16 idiv 30 mul sub
    moveto
} def

/llyarr 259 array def
/widthps 259 array def
/uryarr 259 array def
/llxarr 259 array def
/urxarr 259 array def
/rbeararr 259 array def
/tmp 1 string def
.5 setlinewidth

/Helvetica findfont 9 scalefont setfont

%% Draw the grid around the cells
%% and add the hex labels to the outside of the box

0 1 16
{
    /i exch def
    /j i 30 mul def
    %% vertical lines
    j 62 add dup 220 moveto
    700 lineto
    stroke

    %% horizontal lines
    j 220 add dup 62 exch moveto
    542 exch lineto
    stroke

    i 16 ge { clear exit } if

    %% hex across the top
    j 77 add dup 705 moveto
    i 16 (   ) cvrs show

    %% hex along the sides
    50 670 j sub 12 add moveto
    i 16 (   ) cvrs show
}
for

%       scale width in points at 18pts to width in 1/72'nds at 1000 point.
/myscaleps {
    1000 mul 18 div round cvi
} def

/irmove {
    CY add exch
    CX add exch moveto
} def

%% Print out the headings in the font to be displayed and Times-Roman

/Times-Roman findfont 18 scalefont setfont
295 FONTname stringwidth pop .5 mul sub 750 moveto FONTname show

FONTname findfont 18 scalefont setfont
295 FONTname stringwidth pop .5 mul sub 730 moveto FONTname show

%% loop thru all the charcters and display in 18 point
%% insert the character widths/bbox into the arrays
%
%       Cell format:
% octal    decimal    hex
% uryarr   CHARACTER 
% llyarr             
% llxarr   widthps    urxarr
%
%
0 1 258
{
    newpath
    /i exch def
    i rowmove
    i 255 gt {
        i 256 eq { /tmp (ff) def } if
        i 257 eq { /tmp (ffi) def } if
        i 258 eq { /tmp (ffl) def } if
    } {
        /tmp 1 string def
                 tmp 0 i put
    } ifelse
    tmp show

    widthps i tmp stringwidth pop myscaleps put

    %   Set current point again.
    i rowmove
    currentpoint /cury exch def /curx exch def

    % retrieve bounding box info.
    tmp false charpath flattenpath pathbbox
    /ury exch def
    /urx exch def
    /lly exch def
    /llx exch def

    % calc llxarr from bbox lower-x (=left bearing)

    llxarr i llx curx sub myscaleps put
                  
    % calc uryarr from bbox upper-y

    uryarr i ury cury sub myscaleps put

    % calc llyarr from bbox lower-y

    llyarr i lly cury sub myscaleps put

    % calc urxarr from bbox upper-x

    urxarr i urx curx sub myscaleps put

    % calc right-bearing as width minus upper-x

    rbeararr i widthps i get urxarr i get sub put

}
for

%%display the values in the arrays

/Helvetica-Narrow findfont 5 scalefont setfont

0 1 258
{
    /i exch def

    i rowmove

    currentpoint /CY exch def /CX exch def

    -9 0 irmove
    llyarr i get (       ) cvs show

    -9 8 irmove
    uryarr i get (       ) cvs show

    1 -8 irmove
    widthps i get (       ) cvs show

%   12 8 irmove
%    rbeararr i get (       ) cvs show

    -9 -8 irmove
    llxarr i get (       ) cvs show

    12 -8 irmove
    urxarr i get (       ) cvs show

    -9 15 irmove
    i 8 (   ) cvrs show

    1 15 irmove
    i 10 (   ) cvrs show

    12 15 irmove
    i 16 (   ) cvrs show
}
for

FONTname findfont 18 scalefont setfont
72 144 moveto (This is a test of this font.) show
72 124 moveto (ABCDEFGHIJKLMNOPQRSTUVWXYZ) show
72 104 moveto (abcdefghijklmnopqrstuvwxyz) show
72 84 moveto (0123456789!@#$\%^&*\(\)_+=) show
72 64 moveto ({}[]\\|;:'",.<>?/&~`) show

showpage
%(END showfont display Palatino-Roman\n) print
%flush
SAVEOBJ restore
%%Pages: 1
^D

 -(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-/\-(<>)-\/-<()>-

-- ____  ___   _  / _ _  ___   _  / _ _      _  ___    _   ____   Henry
     .|     |   |    \|     |  .|    \|       |    |    |     |   Churchyard--
      |     |       __\     |   |   __\            |  __|  |  |      churchh@
      .     .  __    .      .                      .   .    . .      emx.cc.
      .     .        .      .                          .     .       utexas.edu