home/ps/printfont.ps

   1 %
   2 % Formatted font dump. Assumes all fonts include valid FontBBox arrays.
   3 %
   4
   5 /#copies 1 store
   6 /aspectratio 1 def
   7 /landscape false def
   8 /magnification 1 def
   9 /margin 10 def
  10 /orientation 0 def
  11 /rotation 1 def
  12 /xoffset 0 def
  13 /yoffset 0 def
  14
  15 /axescount 0 def
  16 /charwidth false def
  17 /graynotdef 0.85 def
  18 /hireslinewidth 0.2 def
  19 /longnames false def
  20 /maxsize 6.0 def
  21 /minsize 4.5 def
  22 /numbercell true def
  23 /radix 16 def
  24 /labelfont /Helvetica def
  25 /labelspace 36 def
  26 /zerocell 0 def
  27
  28 /roundpage true def
  29 /useclippath true def
  30 /pagebbox [0 0 612 792] def
  31
  32 /inch {72 mul} def
  33 /min {2 copy gt {exch} if pop} def
  34 /max {2 copy lt {exch} if pop} def
  35
  36 /LLx {0 get} bind def
  37 /LLy {1 get} bind def
  38 /URx {2 get} bind def
  39 /URy {3 get} bind def
  40 /BBoxHeight {dup URy exch LLy sub} bind def
  41 /BBoxWidth {dup URx exch LLx sub} bind def
  42
  43 /setup {
  44         /graylevels [1 0 0] def
  45         /scratchstring 512 string def
  46         /Product statusdict begin /product where {pop product}{(Unknown)} ifelse end def
  47         /Resolution 0 72 dtransform dup mul exch dup mul add sqrt cvi def
  48         /Version /version where {pop version}{(???)} ifelse def
  49
  50         landscape {/orientation 90 orientation add def} if
  51
  52         pagedimensions
  53         xcenter ycenter translate
  54         orientation rotation mul rotate
  55         width 2 div neg height 2 div translate
  56         xoffset inch yoffset inch neg translate
  57         margin dup neg translate
  58         0 labelspace .75 mul neg translate
  59         magnification dup aspectratio mul scale
  60         0 0 transform round exch round exch itransform translate
  61
  62         currentdict /linewidth known not {
  63                 /linewidth Resolution 400 le {0}{hireslinewidth} ifelse def
  64         } if
  65 } def
  66
  67 /pagedimensions {
  68         useclippath {
  69                 /pagebbox [clippath pathbbox newpath] def
  70                 roundpage currentdict /roundpagebbox known and {roundpagebbox} if
  71         } if
  72         pagebbox aload pop
  73         4 -1 roll exch 4 1 roll 4 copy
  74         landscape {4 2 roll} if
  75         sub /width exch def
  76         sub /height exch def
  77         add 2 div /xcenter exch def
  78         add 2 div /ycenter exch def
  79 } def
  80
  81 /CharSetup {
  82         /chcode exch def
  83         /chname Encoding chcode get def
  84         /chstring ( ) dup 0 chcode put def
  85         /chknown true def
  86
  87         graylevels 0 1 put      % initial cell fill
  88         graylevels 1 0 put      % cell text
  89         graylevels 2 0 put      % cell border
  90
  91         FontDict /CharStrings known {
  92                 FontDict /CharStrings get chname known not {
  93                         /chknown false def
  94                         graylevels 0 0 put
  95                         graylevels 1 1 put
  96                 } if
  97         } if
  98
  99         chname /.notdef eq {
 100                 /chknown false def
 101                 graylevels 0 graynotdef put
 102                 graylevels 1 graynotdef put
 103         } if
 104
 105         /chwid chknown
 106                 {FontDict 1 scalefont setfont chstring stringwidth pop}
 107                 {0}
 108         ifelse def
 109 } bind def
 110
 111 /CellSetup {
 112         /gridwidth width margin 2 mul sub def
 113         /gridheight height labelspace sub margin 2 mul sub def
 114         /cellwidth gridwidth radix div def
 115         /cellheight gridheight Entries radix div ceiling div def
 116
 117         cellwidth cellheight dtransform truncate exch truncate exch idtransform
 118         /cellheight exch def
 119         /cellwidth exch def
 120
 121         labelfont findfont 1 scalefont setfont
 122         /LabelBBox currentfont /FontBBox get TransformBBox def
 123
 124         LabelBBox 2 0 Encoding {
 125                 scratchstring cvs stringwidth pop
 126                 2 copy lt {exch} if
 127                 pop
 128         } forall put
 129
 130         /CellLabelSize
 131                 cellheight .20 mul cellwidth .90 mul LabelBBox BestFit
 132                 minsize max
 133                 maxsize min
 134         def
 135         zerocell CellOrigin cellheight add neg exch neg exch translate
 136 } bind def
 137
 138 /FontSetup {
 139         FontName findfont 1 scalefont setfont
 140         /BBox currentfont /FontBBox get TransformBBox def
 141         /PointSize cellheight .5 mul cellwidth .8 mul BBox BestFit def
 142         BBox {PointSize mul} forall BBox astore pop
 143
 144         /xorigin cellwidth BBox BBoxWidth sub 2 div BBox LLx sub def
 145         /yorigin cellheight BBox BBoxHeight sub 2 div BBox LLy sub def
 146 } bind def
 147
 148 /BestFit {
 149         /bbox exch def
 150         bbox BBoxWidth div exch
 151         bbox BBoxHeight div min
 152 } bind def
 153
 154 /TransformBBox {        % font bbox to user space
 155         aload pop
 156         currentfont /FontMatrix get dtransform 4 2 roll
 157         currentfont /FontMatrix get dtransform 4 2 roll
 158         4 array astore  % should build user space bbox if all zeros
 159 } bind def
 160
 161 /CellOrigin {
 162         dup
 163         exch radix mod cellwidth mul
 164         exch radix idiv 1 add neg cellheight mul
 165 } bind def
 166
 167 /CellOutline {
 168         newpath
 169         CellOrigin moveto
 170         cellwidth 0 rlineto
 171         0 cellheight rlineto
 172         cellwidth neg 0 rlineto
 173         closepath
 174 } bind def
 175
 176 /LabelCell {
 177         gsave
 178         chcode CellOrigin translate
 179         linewidth .5 mul setlinewidth
 180         labelfont findfont CellLabelSize scalefont setfont
 181
 182         numbercell {
 183                 cellwidth .025 mul cellheight .05 mul moveto
 184                 chcode radix scratchstring cvrs show
 185         } if
 186
 187         charwidth chknown and {
 188                 /wid chwid 0.0005 add scratchstring cvs 0 5 getinterval def
 189                 cellwidth wid stringwidth pop 1.10 mul sub cellheight .05 mul moveto
 190                 wid show
 191         } if
 192
 193         longnames chknown not or {
 194                 cellwidth .025 mul
 195                 cellheight LabelBBox URy CellLabelSize mul sub .05 sub moveto
 196                 Encoding chcode get scratchstring cvs show
 197         } if
 198
 199         axescount 1 ge chknown and {    % gsave/grestore if not last
 200                 newpath
 201                 xorigin yorigin translate
 202
 203                 BBox LLx 0 moveto       % baseline
 204                 BBox URx 0 lineto stroke
 205
 206                 axescount 2 ge {        % vertical through current origin
 207                         0 BBox LLy moveto
 208                         0 BBox URy lineto stroke
 209                 } if
 210
 211                 axescount 3 ge {        % vertical through next origin
 212                         chwid PointSize mul BBox LLy
 213                         dtransform round exch round exch idtransform moveto
 214                         0 BBox BBoxHeight rlineto stroke
 215                         %chwid PointSize mul BBox URy lineto stroke
 216                 } if
 217         } if
 218         grestore
 219 } bind def
 220
 221 /PlaceChar {
 222         FontName findfont PointSize scalefont setfont
 223         chcode CellOrigin moveto
 224         xorigin yorigin rmoveto
 225         ( ) dup 0 chcode put show
 226 } bind def
 227
 228 /LabelPage {
 229         labelfont findfont labelspace .75 mul .75 mul 18 min scalefont setfont
 230         0 labelspace .75 mul .25 mul moveto
 231         FontName scratchstring cvs show
 232
 233         labelfont findfont labelspace .25 mul .75 mul 9 min scalefont setfont
 234         0 gridheight neg moveto
 235         0 labelspace .25 mul .75 mul neg rmoveto
 236         Product show ( Version ) show Version show
 237         ( \() show Resolution scratchstring cvs show (dpi\)) show
 238
 239         gridwidth gridheight neg moveto
 240         0 labelspace .25 mul .75 mul neg rmoveto
 241         (size=, ) stringwidth pop neg 0 rmoveto
 242         PointSize cvi scratchstring cvs stringwidth pop neg 0 rmoveto
 243         (gray=, ) stringwidth pop neg 0 rmoveto
 244         graynotdef scratchstring cvs stringwidth pop neg 0 rmoveto
 245         (linewidth=) stringwidth pop neg 0 rmoveto
 246         linewidth scratchstring cvs stringwidth pop neg 0 rmoveto
 247         (size=) show PointSize cvi scratchstring cvs show (, ) show
 248         (gray=) show graynotdef scratchstring cvs show (, ) show
 249         (linewidth=) show linewidth scratchstring cvs show
 250 } bind def
 251
 252 %
 253 % Formatted dump of the encoded characters in a single font.
 254 %
 255
 256 /PrintFont {
 257         /saveobj save def
 258         /FontName exch def
 259         /FontDict FontName findfont def
 260         /Encoding FontDict /Encoding get def
 261         /Entries Encoding length def
 262
 263         CellSetup
 264         FontSetup
 265         LabelPage
 266         zerocell 1 Entries 1 sub {
 267                 CharSetup
 268                 graylevels 0 get setgray
 269                 chcode CellOutline fill
 270                 graylevels 1 get setgray
 271                 LabelCell
 272                 PlaceChar
 273                 graylevels 2 get setgray
 274                 linewidth setlinewidth
 275                 chcode CellOutline stroke
 276         } for
 277         showpage
 278         saveobj restore
 279 } bind def
 280
 281 %
 282 % Dump of all ROM and disk fonts - in alphabetical order.
 283 %
 284
 285 /AllFonts {
 286         /AllFontNames FontDirectory maxlength array def
 287         AllFontNames 0 0 put
 288
 289         FontDirectory {pop AllFontNames Insert} forall
 290
 291         /filenameforall where {
 292                 pop
 293                 (fonts/*)
 294                 {(fonts/) search pop pop pop AllFontNames Insert}
 295                 200 string
 296                 filenameforall
 297         } if
 298
 299         1 1 AllFontNames 0 get {
 300                 AllFontNames exch get cvn PrintFont
 301         } for
 302 } bind def
 303
 304 /Insert {               % name in a sorted list
 305         /List exch def
 306         /Name exch 128 string cvs def
 307
 308         /Slot 1 def
 309         List 0 get {
 310                 Name List Slot get le {exit} if
 311                 /Slot Slot 1 add def
 312         } repeat
 313
 314         List 0 get -1 Slot {
 315                 dup List exch get
 316                 List 3 1 roll exch 1 add exch put
 317         } for
 318         List Slot Name put
 319         List 0 List 0 get 1 add put
 320 } bind def
 321