sys/lib/ghostscript/printafm.ps

   1 %!
   2 % written by James Clark <jjc@jclark.uucp>
   3 % print an afm file on the standard output
   4 % usage is `fontname printafm' eg `/Times-Roman printafm'
   5
   6 % From the `dvitops' distribution, which included this notice:
   7 % dvitops is not copyrighted; you can do with it exactly as you please.
   8 % I would, however, ask that if you make improvements or modifications,
   9 % you ask me before distributing them to others.
  10
  11 % Altered by d.love@dl.ac.uk to produce input for Rokicki's afm2tfm,
  12 % which groks the format of the Adobe AFMs.
  13
  14 % $Id: printafm.ps,v 1.4 2002/02/21 21:49:28 giles Exp $
  15 % Modified by L. Peter Deutsch 9/14/93:
  16 %   uses Ghostscript's =only procedure to replace 'buf cvs print'.
  17 % Modified by L. Peter Deutsch 9/6/95:
  18 %   uses Ghostscript's shellarguments facility to accept the font name
  19 %     on the command line.
  20
  21 /onechar 1 string def
  22
  23 % c toupper - c
  24 /toupper {
  25         dup dup 8#141 ge exch 8#172 le and {
  26                 8#40 sub
  27         } if
  28 } bind def
  29
  30 % printcharmetrics -
  31
  32 /printcharmetrics {
  33         (StartCharMetrics ) print
  34         currentfont /CharStrings get dup length exch /.notdef known { 1 sub } if =
  35         currentfont 1000 scalefont setfont 0 0 moveto
  36         /e currentfont /Encoding get def
  37         0 1 255 {
  38                 dup e exch get
  39                 dup /.notdef ne {
  40                         exch dup printmetric
  41                 } {
  42                         pop pop
  43                 } ifelse
  44         } for
  45         % s contains an entry for each name in the original encoding vector
  46         /s 256 dict def
  47         e {
  48                 s exch true put
  49         } forall
  50         % v is the new encoding vector
  51         /v 256 array def
  52         0 1 255 {
  53                 v exch /.notdef put
  54         } for
  55         % fill up v with names in CharStrings
  56         /i 0 def
  57         currentfont /CharStrings get {
  58                 pop
  59                 i 255 le {
  60                         v i 3 -1 roll put
  61                         /i i 1 add def
  62                 } {
  63                         pop
  64                 } ifelse
  65         } forall
  66         % define a new font with v as its encoding vector
  67         currentfont maxlength dict /f exch def
  68         currentfont {
  69                 exch dup dup /FID ne exch /Encoding ne and {
  70                         exch f 3 1 roll put
  71                 } {
  72                         pop pop
  73                 } ifelse
  74         } forall
  75         f /Encoding v put
  76         f /FontName /temp put
  77         % make this new font the current font
  78         /temp f definefont setfont
  79         % print a entry for each character not in old vector
  80         /e currentfont /Encoding get def
  81         0 1 255 {
  82                 dup e exch get
  83                 dup dup /.notdef ne exch s exch known not and {
  84                         exch -1 printmetric
  85                 } {
  86                         pop pop
  87                 } ifelse
  88         } for
  89         (EndCharMetrics) =
  90 } bind def
  91
  92 % name actual_code normal_code printmetric -
  93
  94 /printmetric {
  95         /saved save def
  96         (C ) print =only
  97         ( ; WX ) print
  98         onechar 0 3 -1 roll put
  99         onechar stringwidth pop round cvi =only
 100         ( ; N ) print =only
 101         ( ; B ) print
 102         onechar false charpath flattenpath mark pathbbox counttomark {
 103                 counttomark -1 roll
 104                 round cvi =only
 105                 ( ) print
 106         } repeat pop
 107         (;) =
 108         saved restore
 109 } bind def
 110
 111 % fontname printafm -
 112
 113 /printafm {
 114         findfont gsave setfont
 115         (StartFontMetrics 2.0) =
 116         (FontName ) print currentfont /FontName get =
 117
 118                 % Print the FontInfo
 119
 120         currentfont /FontInfo get {
 121                 exch
 122                 =string cvs dup dup 0 get 0 exch toupper put print
 123                 ( ) print =
 124         } forall
 125
 126                 % Print the FontBBox
 127
 128         (FontBBox) print
 129         currentfont /FontBBox get {
 130                 ( ) print round cvi =only
 131         } forall
 132         (\n) print
 133
 134         printcharmetrics
 135         (EndFontMetrics) =
 136         grestore
 137 } bind def
 138
 139 % Check for command line arguments.
 140 [ shellarguments
 141  { ] dup length 1 eq
 142     { 0 get printafm }
 143     { (Usage: printafm fontname\n) print flush }
 144    ifelse
 145  }
 146  { pop }
 147 ifelse