ref: 6540a9a21ae4f62f512f3e95063561d87e80701c
dir: /sys/lib/postscript/prologues/printfont.ps/
%
% Formatted font dump. Assumes all fonts include valid FontBBox arrays.
%
/#copies 1 store
/aspectratio 1 def
/landscape false def
/magnification 1 def
/margin 10 def
/orientation 0 def
/rotation 1 def
/xoffset 0 def
/yoffset 0 def
/axescount 0 def
/charwidth false def
/graynotdef 0.85 def
/hireslinewidth 0.2 def
/longnames false def
/maxsize 6.0 def
/minsize 4.5 def
/numbercell true def
/radix 16 def
/labelfont /Helvetica def
/labelspace 36 def
/zerocell 0 def
/roundpage true def
/useclippath true def
/pagebbox [0 0 612 792] def
/inch {72 mul} def
/min {2 copy gt {exch} if pop} def
/max {2 copy lt {exch} if pop} def
/LLx {0 get} bind def
/LLy {1 get} bind def
/URx {2 get} bind def
/URy {3 get} bind def
/BBoxHeight {dup URy exch LLy sub} bind def
/BBoxWidth {dup URx exch LLx sub} bind def
/setup {
/graylevels [1 0 0] def
/scratchstring 512 string def
/Product statusdict begin /product where {pop product}{(Unknown)} ifelse end def
/Resolution 0 72 dtransform dup mul exch dup mul add sqrt cvi def
/Version /version where {pop version}{(???)} ifelse def
landscape {/orientation 90 orientation add def} if
pagedimensions
xcenter ycenter translate
orientation rotation mul rotate
width 2 div neg height 2 div translate
xoffset inch yoffset inch neg translate
margin dup neg translate
0 labelspace .75 mul neg translate
magnification dup aspectratio mul scale
0 0 transform round exch round exch itransform translate
currentdict /linewidth known not {
/linewidth Resolution 400 le {0}{hireslinewidth} ifelse def
} if
} def
/pagedimensions {
useclippath {
/pagebbox [clippath pathbbox newpath] def
roundpage currentdict /roundpagebbox known and {roundpagebbox} if
} if
pagebbox aload pop
4 -1 roll exch 4 1 roll 4 copy
landscape {4 2 roll} if
sub /width exch def
sub /height exch def
add 2 div /xcenter exch def
add 2 div /ycenter exch def
} def
/CharSetup {
/chcode exch def
/chname Encoding chcode get def
/chstring ( ) dup 0 chcode put def
/chknown true def
graylevels 0 1 put % initial cell fill
graylevels 1 0 put % cell text
graylevels 2 0 put % cell border
FontDict /CharStrings known {
FontDict /CharStrings get chname known not {
/chknown false def
graylevels 0 0 put
graylevels 1 1 put
} if
} if
chname /.notdef eq {
/chknown false def
graylevels 0 graynotdef put
graylevels 1 graynotdef put
} if
/chwid chknown
{FontDict 1 scalefont setfont chstring stringwidth pop}
{0}
ifelse def
} bind def
/CellSetup {
/gridwidth width margin 2 mul sub def
/gridheight height labelspace sub margin 2 mul sub def
/cellwidth gridwidth radix div def
/cellheight gridheight Entries radix div ceiling div def
cellwidth cellheight dtransform truncate exch truncate exch idtransform
/cellheight exch def
/cellwidth exch def
labelfont findfont 1 scalefont setfont
/LabelBBox currentfont /FontBBox get TransformBBox def
LabelBBox 2 0 Encoding {
scratchstring cvs stringwidth pop
2 copy lt {exch} if
pop
} forall put
/CellLabelSize
cellheight .20 mul cellwidth .90 mul LabelBBox BestFit
minsize max
maxsize min
def
zerocell CellOrigin cellheight add neg exch neg exch translate
} bind def
/FontSetup {
FontName findfont 1 scalefont setfont
/BBox currentfont /FontBBox get TransformBBox def
/PointSize cellheight .5 mul cellwidth .8 mul BBox BestFit def
BBox {PointSize mul} forall BBox astore pop
/xorigin cellwidth BBox BBoxWidth sub 2 div BBox LLx sub def
/yorigin cellheight BBox BBoxHeight sub 2 div BBox LLy sub def
} bind def
/BestFit {
/bbox exch def
bbox BBoxWidth div exch
bbox BBoxHeight div min
} bind def
/TransformBBox { % font bbox to user space
aload pop
currentfont /FontMatrix get dtransform 4 2 roll
currentfont /FontMatrix get dtransform 4 2 roll
4 array astore % should build user space bbox if all zeros
} bind def
/CellOrigin {
dup
exch radix mod cellwidth mul
exch radix idiv 1 add neg cellheight mul
} bind def
/CellOutline {
newpath
CellOrigin moveto
cellwidth 0 rlineto
0 cellheight rlineto
cellwidth neg 0 rlineto
closepath
} bind def
/LabelCell {
gsave
chcode CellOrigin translate
linewidth .5 mul setlinewidth
labelfont findfont CellLabelSize scalefont setfont
numbercell {
cellwidth .025 mul cellheight .05 mul moveto
chcode radix scratchstring cvrs show
} if
charwidth chknown and {
/wid chwid 0.0005 add scratchstring cvs 0 5 getinterval def
cellwidth wid stringwidth pop 1.10 mul sub cellheight .05 mul moveto
wid show
} if
longnames chknown not or {
cellwidth .025 mul
cellheight LabelBBox URy CellLabelSize mul sub .05 sub moveto
Encoding chcode get scratchstring cvs show
} if
axescount 1 ge chknown and { % gsave/grestore if not last
newpath
xorigin yorigin translate
BBox LLx 0 moveto % baseline
BBox URx 0 lineto stroke
axescount 2 ge { % vertical through current origin
0 BBox LLy moveto
0 BBox URy lineto stroke
} if
axescount 3 ge { % vertical through next origin
chwid PointSize mul BBox LLy
dtransform round exch round exch idtransform moveto
0 BBox BBoxHeight rlineto stroke
%chwid PointSize mul BBox URy lineto stroke
} if
} if
grestore
} bind def
/PlaceChar {
FontName findfont PointSize scalefont setfont
chcode CellOrigin moveto
xorigin yorigin rmoveto
( ) dup 0 chcode put show
} bind def
/LabelPage {
labelfont findfont labelspace .75 mul .75 mul 18 min scalefont setfont
0 labelspace .75 mul .25 mul moveto
FontName scratchstring cvs show
labelfont findfont labelspace .25 mul .75 mul 9 min scalefont setfont
0 gridheight neg moveto
0 labelspace .25 mul .75 mul neg rmoveto
Product show ( Version ) show Version show
( \() show Resolution scratchstring cvs show (dpi\)) show
gridwidth gridheight neg moveto
0 labelspace .25 mul .75 mul neg rmoveto
(size=, ) stringwidth pop neg 0 rmoveto
PointSize cvi scratchstring cvs stringwidth pop neg 0 rmoveto
(gray=, ) stringwidth pop neg 0 rmoveto
graynotdef scratchstring cvs stringwidth pop neg 0 rmoveto
(linewidth=) stringwidth pop neg 0 rmoveto
linewidth scratchstring cvs stringwidth pop neg 0 rmoveto
(size=) show PointSize cvi scratchstring cvs show (, ) show
(gray=) show graynotdef scratchstring cvs show (, ) show
(linewidth=) show linewidth scratchstring cvs show
} bind def
%
% Formatted dump of the encoded characters in a single font.
%
/PrintFont {
/saveobj save def
/FontName exch def
/FontDict FontName findfont def
/Encoding FontDict /Encoding get def
/Entries Encoding length def
CellSetup
FontSetup
LabelPage
zerocell 1 Entries 1 sub {
CharSetup
graylevels 0 get setgray
chcode CellOutline fill
graylevels 1 get setgray
LabelCell
PlaceChar
graylevels 2 get setgray
linewidth setlinewidth
chcode CellOutline stroke
} for
showpage
saveobj restore
} bind def
%
% Dump of all ROM and disk fonts - in alphabetical order.
%
/AllFonts {
/AllFontNames FontDirectory maxlength array def
AllFontNames 0 0 put
FontDirectory {pop AllFontNames Insert} forall
/filenameforall where {
pop
(fonts/*)
{(fonts/) search pop pop pop AllFontNames Insert}
200 string
filenameforall
} if
1 1 AllFontNames 0 get {
AllFontNames exch get cvn PrintFont
} for
} bind def
/Insert { % name in a sorted list
/List exch def
/Name exch 128 string cvs def
/Slot 1 def
List 0 get {
Name List Slot get le {exit} if
/Slot Slot 1 add def
} repeat
List 0 get -1 Slot {
dup List exch get
List 3 1 roll exch 1 add exch put
} for
List Slot Name put
List 0 List 0 get 1 add put
} bind def