home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 12 Font / 12-Font.zip / PFMAFM.ZIP / GETAFM.PS next >
Text File  |  1991-09-12  |  2KB  |  87 lines
  1. % Get font widths from LaserWriter
  2. % Copyright (c) 1986 by Pipeline Associates, Inc.
  3.  
  4. /nstr 4 string def
  5. /wstr 8 string def
  6. /char 1 string def
  7. /tempstr 100 string def
  8.  
  9. /np{newpath 0 0 moveto}def
  10. /getbbox{false charpath flattenpath pathbbox}def
  11. /FF{name findfont}def
  12.  
  13. /prtwidth { 
  14.     char 0 3 -1 roll put 
  15.     char stringwidth 
  16.     pop round cvi wstr cvs
  17. } def
  18.  
  19. /PrintCharMetrics { 
  20.     /charnum exch def
  21.     /charname FF /Encoding get charnum get def
  22.     charname /.notdef ne
  23.     {
  24.         (C )print charnum nstr cvs print ( ; WX ) print
  25.         charnum prtwidth print ( ; N ) print
  26.         charname tempstr cvs print ( ; B ) print
  27.         np char getbbox 4
  28.         {4 -1 roll dup round cvi wstr cvs print ( ) print} repeat
  29.         pop pop pop pop
  30.         (;)=
  31.     } if
  32. } def
  33.  
  34. /prfont {
  35.     /name exch def
  36.  
  37.     (StartFontMetrics 1.0)=
  38.     (Comment Copyright (c) 1986 Pipeline Associates, Inc.  All Rights reserved)= flush
  39.     (Comment Produced by getafm.ps)= flush
  40.     (FontName )print flush
  41.     FF /FontName get = flush
  42.     % (FullName )print flush
  43.     % FF /FontInfo get /FullName get = flush
  44.     % (FamilyName )print flush
  45.     % FF /FontInfo get /FamilyName get = flush
  46.     % (Weight )print flush
  47.     % FF /FontInfo get /Weight get = flush
  48.     % (ItalicAngle )print flush
  49.     % FF /FontInfo get /ItalicAngle get = flush
  50.     % (IsFixedPitch )print flush
  51.     % FF /FontInfo get /isFixedPitch get = flush
  52.     (UnderlinePosition )print flush
  53.     FF /FontInfo get /UnderlinePosition get = flush
  54.     (UnderlineThickness )print flush
  55.     FF /FontInfo get /UnderlineThickness get = flush
  56.     % (Version )print flush
  57.     % FF /FontInfo get /version get = flush
  58.     % (Notice )print flush
  59.     % FF /FontInfo get /Notice get = flush
  60.  
  61.     (FontBBox )print flush
  62.     FF /FontBBox get {wstr cvs print ( ) print} forall ()= flush
  63.  
  64.     FF 1000 scalefont setfont
  65.     (CapHeight )print
  66.     np (H) getbbox round cvi = pop pop pop
  67.     (XHeight )print
  68.     np (x) getbbox round cvi = pop pop pop
  69.     (Ascender )print
  70.     np (d) getbbox round cvi = pop pop pop
  71.     (Descender )print
  72.     np (p) getbbox round pop pop round cvi = pop
  73.     (StartCharMetrics)= flush
  74.  
  75.     0 1 255 {
  76.         PrintCharMetrics flush
  77.     } for
  78.     
  79.     (EndCharMetrics)= flush
  80.     (EndFontMetrics)= flush
  81. } def
  82.  
  83. % Change the following line to have the correct fontname.  This is
  84. % case sensitive.
  85.  
  86. /Times-Roman prfont
  87.