tprintfont.ps - plan9port - [fork] Plan 9 from user space
(HTM) git clone git://src.adamsgaard.dk/plan9port
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
(DIR) LICENSE
---
tprintfont.ps (7585B)
---
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