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