File: font2c.ps

package info (click to toggle)
ghostscript 8.71~dfsg2-9+squeeze1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 79,896 kB
  • ctags: 80,654
  • sloc: ansic: 501,432; sh: 25,689; python: 4,853; cpp: 3,633; perl: 3,597; tcl: 1,480; makefile: 1,187; lisp: 407; asm: 284; xml: 263; awk: 66; csh: 17; yacc: 15
file content (675 lines) | stat: -rw-r--r-- 19,591 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
%    Copyright (C) 1992, 1993, 1994, 1995, 1999 Aladdin Enterprises.  All rights reserved.
% 
% This software is provided AS-IS with no warranty, either express or
% implied.
% 
% This software is distributed under license and may not be copied,
% modified or distributed except as expressly authorized under the terms
% of the license contained in the file LICENSE in this distribution.
% 
% For more information about licensing, please refer to
% http://www.ghostscript.com/licensing/. For information on
% commercial licensing, go to http://www.artifex.com/licensing/ or
% contact Artifex Software, Inc., 101 Lucas Valley Road #110,
% San Rafael, CA  94903, U.S.A., +1(415)492-9861.

% $Id: font2c.ps 6300 2005-12-28 19:56:24Z giles $
% font2c.ps
% Write out a PostScript Type 0 or Type 1 font as C code
% that can be linked with the interpreter.
% This even works on protected fonts, if you use the -dWRITESYSTEMDICT
% switch in the command line.  The code is reentrant and location-
% independent and has no external references, so it can be put into
% a sharable library even on VMS.

/font2cdict 100 dict dup begin

% Define the maximum string length that all compilers will accept.
% This must be approximately
%	min(max line length, max string literal length) / 4 - 5.

/max_wcs 50 def

% Define a temporary file for writing out procedures.
/wtempname (_.tmp) def

% ------ Protection utilities ------ %

% Protection values are represented by a mask:
/a_noaccess 0 def
/a_executeonly 1 def
/a_readonly 3 def
/a_all 7 def
/prot_names
 [ (0) (a_execute) null (a_readonly) null null null (a_all)
 ] def
/prot_opers
 [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
 ] def

% Get the protection of an object.
   /getpa
    { dup wcheck
       { pop a_all }
       {	% Check for executeonly or noaccess objects in protected.
         dup protected exch known
	  { protected exch get }
	  { pop a_readonly }
	 ifelse
       }
      ifelse
    } bind def

% Get the protection appropriate for (all the) values in a dictionary.
   /getva
    { a_noaccess exch
       { exch pop
         dup type dup /stringtype eq 1 index /arraytype eq or
	 exch /packedarraytype eq or
	  { getpa a_readonly and or }
	  { pop pop a_all exit }
	 ifelse
       }
      forall
    } bind def

% Keep track of executeonly and noaccess objects,
% but don't let the protection actually take effect.
.currentglobal
false .setglobal	% so protected can reference local objs
/protected		% do first so // will work
  systemdict wcheck { 1500 dict } { 1 dict } ifelse
def
systemdict wcheck not
 { (Warning: you will not be able to convert protected fonts.\n) print
   (If you need to convert a protected font, please\n) print
   (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print
   flush
   (%end) .skipeof
 }
if
userdict begin
  /executeonly
   { dup //protected exch //a_executeonly put readonly
   } bind def
  /noaccess
   { dup //protected exch //a_noaccess put readonly
   } bind def
end
true .setglobal
systemdict begin
  /executeonly
   { userdict /executeonly get exec
   } bind odef
  /noaccess
   { userdict /noaccess get exec
   } bind odef
end
%end
.setglobal

% ------ Output utilities ------ %

% By convention, the output file is named cfile.

% Define some utilities for writing the output file.
   /wtstring 100 string def
   /wb {cfile exch write} bind def
   /ws {cfile exch writestring} bind def
   /wl {ws (\n) ws} bind def
   /wt {wtstring cvs ws} bind def

% Write a C string.  Some compilers have unreasonably small limits on
% the length of a string literal or the length of a line, so every place
% that uses wcs must either know that the string is short,
% or be prepared to use wcca instead.
   /wbx
    { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
    } bind def
   /wcst
    [
      32 { /wbx load } repeat
      95 { /wb load } repeat
      129 { /wbx load } repeat
    ] def
   ("\\) { wcst exch { (\\) ws wb } put } forall
   /wcs
    { (") ws { dup wcst exch get exec } forall (") ws
    } bind def
   /can_wcs	% Test if can use wcs
    { length max_wcs le
    } bind def
   /wncs	% name -> C string
    { wtstring cvs wcs
    } bind def
% Write a C string as an array of character values.
% We only need this because of line and literal length limitations.
   /wca		% <string> <prefix> <suffix> wca -
    { 0 4 -2 roll exch
       {	% Stack: suffix n prefix char
	 exch ws
	 exch dup 19 ge { () wl pop 0 } if 1 add
	 exch dup 32 ge 1 index 126 le and
	  { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }
	  { wt }
	 ifelse (,)
       } forall
      pop pop ws
    } bind def
   /wcca	% <string> wcca -
    { ({\n) (}) wca
    } bind def

% Write object protection attributes.  Note that dictionaries and arrays are
% the only objects that can be writable.
   /wpa
    { dup xcheck { (a_executable|) ws } if
      dup type dup /dicttype eq exch /arraytype eq or
       { getpa }
       { getpa a_readonly and }
      ifelse prot_names exch get ws
    } bind def
   /wva
    { getva prot_names exch get ws
    } bind def

% ------ Object writing ------ %

   /wnstring 128 string def

% Convert an object to a string to be scanned at a later time.
   /cvos		% <obj> cvos <string>
    {		% We'd like to use == and write directly to a string,
		% but we can't do the former because of operators,
		% and we can't do the latter because we can't predict
		% how long the string would have to be....
	 wtempname (w) file dup 3 -1 roll wproc closefile
	 wtempname status pop pop pop exch pop string
	 wtempname (r) file dup 3 -1 roll readstring pop exch closefile
    } bind def

% Write a string/name or null as an element of a string/name/null array.
% Convert any other kind of value to a token to be read back in.
   /wsn
    { dup null eq
       { pop (\t255,255,) wl
       }
       { dup type /nametype eq { wnstring cvs } if
	 dup type /stringtype ne { cvos (255,) ws } if
	 dup length 256 idiv wt (,) ws
	 dup length 256 mod wt
	 (,) (,\n) wca
       }
      ifelse
    } bind def
% Write a packed string/name/null array.
   /wsna	% <name> <(string|name|null)*> wsna -
    { (\tstatic const unsigned char ) ws exch wt ([] = {) wl
      { wsn } forall
      (\t0\n};) wl
    } bind def

% Write a number or an array of numbers, as refs.
/isnumber
 { type dup /integertype eq exch /realtype eq or
 } bind def
/wnums
 { dup isnumber
    { (real_v\() ws wt (\),) ws }
    { { wnums } forall }
   ifelse
 } bind def

% Test whether a procedure or unusual array can be written (printed).
/iswx 4 dict dup begin
  /arraytype { { iswproc } isall } def
  /nametype { pop true } def
  /operatortype { pop true } def	% assume it has been bound in
  /packedarraytype /arraytype load def
end def
/iswnx 6 dict dup begin
  /arraytype { { iswproc } isall } def
  /integertype { pop true } def
  /nametype { pop true } def
  /realtype { pop true } def
  /stringtype { pop true } def
  /packedarraytype /arraytype load def
end def
/iswproc	% <obj> iswproc <bool>
 { dup xcheck { iswx } { iswnx } ifelse
   1 index type .knownget { exec } { pop false } ifelse
 } bind def

% Write a printable procedure (one for which iswproc returns true).
/wproca 3 dict dup begin
  /arraytype
   { 1 index ({) writestring
      { 1 index ( ) writestring 1 index exch wproc } forall
     (}) writestring
   } bind def
  /packedarraytype /arraytype load def
  /operatortype { .writecvs } bind def	% assume binding would work
end def
/wproc		% <file> <proc> wproc -
 { dup type wproca exch .knownget { exec } { write==only } ifelse
 } bind def

% Write a named object.  Return true if this was possible.
% Legal types are: boolean, integer, name, real, string,
% array of (integer, integer+real, name, null+string),
% and certain procedures and other arrays (see iswproc above).
% All other objects are either handled specially or ignored.
   /isall	% <array> <proc> isall <bool>
    { true 3 -1 roll
       { 2 index exec not { pop false exit } if }
      forall exch pop
    } bind def
   /wott 8 dict dup begin
      /arraytype
       { woatt
          { aload pop 2 index 2 index exec
	     { exch pop exec exit }
	     { pop pop }
	    ifelse
	  }
	 forall
       } bind def
      /booleantype
       { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
         wt (\);) wl true
       } bind def
      /integertype
       { (\tmake_int\(&) ws exch wt (, ) ws
         wt (\);) wl true
       } bind def
      /nametype
       { (\tcode = (*pprocs->name_create)\(i_ctx_p, &) ws exch wt
         (, ) ws wnstring cvs wcs	% OK, names are short
	 (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 true
       } bind def
      /packedarraytype
	/arraytype load def
      /realtype
       { (\tmake_real\(&) ws exch wt (, (float)) ws
         wt (\);) wl true
       } bind def
      /stringtype
       { ({\tstatic const unsigned char s_[] = ) ws
         dup dup can_wcs { wcs } { wcca } ifelse
	 (;) wl
	 (\tmake_const_string\(&) ws exch wt
	 (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
	 (}) wl true
       } bind def
   end def
% Write some other kind of object, if known.
   /wother
    { dup otherobjs exch known
       { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
       { pop pop false }
      ifelse
    } bind def
% Top-level procedure.
   /wo		% name obj -> OK
    { dup type wott exch .knownget { exec } { wother } ifelse
    } bind def

% Write an array (called by wo).
   /wap		% <name> <array> wap -
    { dup xcheck not 1 index wcheck not and 1 index rcheck and
       { pop pop }
       { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }
      ifelse
    } bind def
   /wnuma {	% <name> <array> <element_C_type> <<type>_v> wnuma -
      ({\tstatic const ref_\() ws exch ws (\) a_[] = {) wl exch
		% Stack: name type_v array
      dup length 0 eq {
	(\t) ws 1 index ws (\(0\)) wl
      } {
	dup {
	  (\t) ws 2 index ws (\() ws wt (\),) wl
	} forall
      } ifelse exch pop
		% Stack: name array
      (\t};) wl
      dup wcheck {
	(\tcode = (*pprocs->scalar_array_create)\(i_ctx_p, &) ws exch wt
	(, (const ref *)a_, ) ws dup length wt
	(, ) ws wpa (\);) wl
	(\tif ( code < 0 ) return code;) wl
      } {
	(\tmake_const_array\(&) ws exch wt
	(, avm_foreign|) ws dup wpa (, ) ws length wt
	(, (const ref *)a_\);) wl
      } ifelse
      (}) wl
    } bind def
   /woatt [
	% Integers
     { { { type /integertype eq } isall }
       { (long) (integer_v) wnuma true }
     }
	% Integers + reals
     { { { type dup /integertype eq exch /realtype eq or } isall }
       { (float) (real_v) wnuma true }
     }
	% Strings + nulls
     { { { type dup /nulltype eq exch /stringtype eq or } isall }
       { ({) ws dup (sa_) exch wsna
	 (\tcode = (*pprocs->string_array_create)\(i_ctx_p, &) ws exch wt
	 (, \(const char *\)sa_, ) ws dup length wt (, ) ws wpa (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 (}) wl true
       }
     }
	% Names
     { { { type /nametype eq } isall }
       { ({) ws dup (na_) exch wsna
	 (\tcode = (*pprocs->name_array_create)\(i_ctx_p, &) ws 1 index wt
	 (, \(const char *\)na_, ) ws dup length wt (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 wap (}) wl true
       }
     }
	% Procedure
     { { iswproc }
       { dup cvos
		% Stack: name proc string
	 ({\tstatic const unsigned char s_[] = ) ws
         dup dup can_wcs { wcs } { wcca } ifelse
	 (;) wl
	 (\tcode = (*pprocs->ref_from_string)\(i_ctx_p, &) ws 2 index wt
	 (, \(const char *\)s_, ) ws length wt (\);) wl
	 (\tif ( code < 0 ) return code;) wl
	 wap (}) wl true
	 wtempname deletefile
       }
     }
	% Default
     { { pop true }
       { wother }
     }
   ] def

% Write a named dictionary.  We assume the ref is already declared.
   /wd		% <name> <dict> <extra> wd -
    { 3 1 roll
      ({) ws
      (\tref v_[) ws dup length wt (];) wl
      dup [ exch
       { counttomark 2 sub wtstring cvs
         (v_[) exch concatstrings (]) concatstrings exch wo not
          { (Skipping ) print ==only (....\n) print }
	 if
       } forall
      ]
		% Stack: array of keys (names)
      ({) ws dup (str_keys_) exch wsna
      (\tstatic const cfont_dict_keys keys_ =) wl
      (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
      dup wpa (, ) ws dup wva ( };) wl pop
      (\tcode = \(*pprocs->ref_dict_create\)\(i_ctx_p, &) ws wt
      (, &keys_, \(const char *\)str_keys_, v_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
      (}) wl
    } bind def

% Write character dictionary keys.
% We save a lot of space by abbreviating keys which appear in
% StandardEncoding or ISOLatin1Encoding.
% Writes code to declare and initialize enc_keys_, str_keys, and keys_.
/wcdkeys	% <dict> wcdkeys -
 {	% Write keys present in StandardEncoding or ISOLatin1Encoding,
	% pushing other keys on the o-stack.
   (static const charindex enc_keys_[] = {) wl
   dup [ exch 0 exch
    { pop decoding 1 index known
       { decoding exch get ({) ws dup -8 bitshift wt
	 (,) ws 255 and wt (}, ) ws
	 1 add dup 5 mod 0 eq { (\n) ws } if
       }
       { exch }
      ifelse
    }
   forall pop
   ]
   ({0,0}\n};) wl
	% Write other keys.
   (str_keys_) exch wsna
	% Write the declaration for keys_.
   (static const cfont_dict_keys keys_ = {) wl
   (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
   (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
   dup wpa (, ) ws wva () wl
   (};) wl
 } bind def

% Enumerate character dictionary values in the same order that
% the keys appear in enc_keys_ and str_keys_.
% <proc> is called with each value in turn.
/cdforall	% <dict> <proc> cdforall -
 { 2 copy
    { decoding 3 index known
       { 3 -1 roll pop exec }
       { pop pop pop }
      ifelse
    }
   /exec cvx 3 packedarray cvx
   /forall cvx
   5 -2 roll
    { decoding 3 index known
       { pop pop pop }
       { 3 -1 roll pop exec }
      ifelse
    }
   /exec cvx 3 packedarray cvx
   /forall cvx
   6 packedarray cvx exec
 } bind def

% ------ Writers for special objects ------ %

/writespecial 10 dict dup begin

   /FontInfo { 0 wd } def

   /Private { 0 wd } def

   /CharStrings
    { ({) wl
      dup wcdkeys
      (static const unsigned char values_[] = {) wl
       { wsn } cdforall
      (\t0\n};) wl
      (\tcode = \(*pprocs->string_dict_create\)\(i_ctx_p, &) ws wt
      (, &keys_, (const char *)str_keys_, \(const char *\)values_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
    } bind def

   /Metrics
    { ({) wl
      dup wcdkeys
      (static const ref_(float) values_[] = {) wl
      dup { (\t) ws wnums () wl } cdforall
      (\t0\n};) wl
      (static const unsigned char lengths_[] = {) wl
       { (\t) ws dup isnumber
	  { pop 0 }
	  { length 1 add }
	 ifelse wt (,) wl
       } cdforall
      (\t0\n};) wl
      (\tcode = \(*pprocs->num_dict_create\)\(i_ctx_p, &) ws wt
      (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
      (\tif ( code < 0 ) return code;) wl
      (}) wl
    } bind def

   /Metrics2 /Metrics load def

   /FDepVector pop	% (converted to a list of font names)

end def

% ------ The main program ------ %

% Construct an inverse dictionary of encodings.
[ /StandardEncoding /ISOLatin1Encoding
  /SymbolEncoding /DingbatsEncoding
  /KanjiSubEncoding
]
dup length dict begin
 { mark exch dup { .findencoding exch def } stopped cleartomark
 } forall
currentdict end /encodingnames exch def

% Invert the StandardEncoding and ISOLatin1Encoding vectors.
512 dict begin
  0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
  0 1 255 { dup StandardEncoding exch get exch def } for
currentdict end /decoding exch def

/writefont		% cfilename procname -> [writes the current font]
 { (gsf_) exch concatstrings
     /fontprocname exch def
   /cfname exch def
   /cfile cfname (w) file def

% Remove unwanted keys from the font.
   currentfont dup length dict begin { def } forall
    { /FID /MIDVector /CurMID } { currentdict exch undef } forall
   /Font currentdict end def

% Replace the FDepVector with a list of font names.
   Font /FDepVector .knownget
    { [ exch { /FontName get } forall ]
      Font /FDepVector 3 -1 roll put
    }
   if

% Find all the special objects we know about.
% wo uses this to write out references to otherwise intractable objects.
   /otherobjs writespecial length dict dup begin
     writespecial
      { pop Font 1 index .knownget { exch def } { pop } ifelse
      }
     forall
   end def

% Define a dummy FontInfo, in case the font doesn't have one.
   /FontInfo 0 dict def

% Write out the boilerplate.
   Font begin
   (/****************************************************************) wl
   (   Portions of this file are subject to the following notice(s):) wl
   systemdict /copyright get wl
   FontInfo /Notice .knownget
    { (----------------------------------------------------------------) wl wl
    } if
   (****************************************************************/) wl
   () wl
   (/* ) ws cfname ws ( */) wl
   (/* This file was created by the ) ws product ws ( font2c utility. */) wl
   () wl
   (#undef DEBUG) wl
   (#include "ccfont.h") wl
   () wl

% Write the procedure prologue.
   (#ifdef __PROTOTYPES__) wl
   (ccfont_proc\() ws fontprocname ws (\);) wl
   (int) wl
   fontprocname ws ((i_ctx_t *i_ctx_p, const cfont_procs *pprocs, ref *pfont)) wl
   (#else) wl
   (int) wl
   fontprocname ws ((i_ctx_p, pprocs, pfont) i_ctx_t *i_ctx_p; const cfont_procs *pprocs; ref *pfont;) wl
   (#endif) wl
   ({\tint code;) wl
   (\tref Font;) wl
   otherobjs
    { exch pop (\tref ) ws wt (;) wl }
   forall

% Write out the special objects.
   otherobjs
    { exch writespecial 2 index get exec
    }
   forall

% Write out the main font dictionary.
% If possible, substitute the encoding name for the encoding;
% PostScript code will fix this up.
    { /Encoding /PrefEnc }
    { Font 1 index .knownget
       { encodingnames exch .knownget { def } { pop } ifelse }
       { pop }
      ifelse
    }
   forall
   (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd

% Finish the procedural initialization code.
   (\t*pfont = Font;) wl
   (\treturn 0;) wl
   (}) wl
   end				% Font

   cfile closefile

 } bind def

end def			% font2cdict

% Compute the procedure name from the font name.
% Replace all non-alphanumeric characters with '_'.
/makefontprocnamemap 256 string
   0 1 255 { 2 copy 95 put pop } for
   (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz)
    { 2 copy dup put pop } forall
readonly def
/makefontprocname	% <fontname> makefontprocname <procnamestring>
 { dup length string cvs
   dup length 1 sub -1 0
    {		% Stack: string index
      2 copy 2 copy get //makefontprocnamemap exch get put pop
    }
   for 
 } def

/writefont { font2cdict begin writefont end } def

% If the program was invoked from the command line, run it now.
[ shellarguments
 { counttomark dup 2 eq exch 3 eq or
    { counttomark -1 roll cvn
      (Converting ) print dup =only ( font.\n) print flush
		% Ensure that we get a clean copy of the font from the
		% file system.
      2 {	% do both local and global
	currentglobal not setglobal
	dup undefinefont
      } repeat
      findfont setfont
      (FontName is ) print currentfont /FontName get ==only (.\n) print flush
      counttomark 1 eq
       {	% Construct the procedure name from the file name.
         currentfont /FontName get makefontprocname
       }
      if
      writefont
      (Done.\n) print flush
    }
    { cleartomark
      (Usage: font2c fontname cfilename.c [shortname]\n) print
      ( e.g.: font2c Courier cour.c\n) print flush
      mark
    }
   ifelse
 }
if pop