1 % Copyright (C) 1992, 1993, 1994, 1995, 1999 Aladdin Enterprises. All rights reserved.
3 % This software is provided AS-IS with no warranty, either express or
6 % This software is distributed under license and may not be copied,
7 % modified or distributed except as expressly authorized under the terms
8 % of the license contained in the file LICENSE in this distribution.
10 % For more information about licensing, please refer to
11 % http://www.ghostscript.com/licensing/. For information on
12 % commercial licensing, go to http://www.artifex.com/licensing/ or
13 % contact Artifex Software, Inc., 101 Lucas Valley Road #110,
14 % San Rafael, CA 94903, U.S.A., +1(415)492-9861.
16 % $Id: font2c.ps,v 1.6 2003/07/10 02:56:51 ray Exp $
18 % Write out a PostScript Type 0 or Type 1 font as C code
19 % that can be linked with the interpreter.
20 % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
21 % switch in the command line. The code is reentrant and location-
22 % independent and has no external references, so it can be put into
23 % a sharable library even on VMS.
25 /font2cdict 100 dict dup begin
27 % Define the maximum string length that all compilers will accept.
28 % This must be approximately
29 % min(max line length, max string literal length) / 4 - 5.
33 % Define a temporary file for writing out procedures.
34 /wtempname (_.tmp) def
36 % ------ Protection utilities ------ %
38 % Protection values are represented by a mask:
44 [ (0) (a_execute) null (a_readonly) null null null (a_all)
47 [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
50 % Get the protection of an object.
54 { % Check for executeonly or noaccess objects in protected.
55 dup protected exch known
56 { protected exch get }
63 % Get the protection appropriate for (all the) values in a dictionary.
67 dup type dup /stringtype eq 1 index /arraytype eq or
68 exch /packedarraytype eq or
69 { getpa a_readonly and or }
70 { pop pop a_all exit }
76 % Keep track of executeonly and noaccess objects,
77 % but don't let the protection actually take effect.
79 false .setglobal % so protected can reference local objs
80 /protected % do first so // will work
81 systemdict wcheck { 1500 dict } { 1 dict } ifelse
84 { (Warning: you will not be able to convert protected fonts.\n) print
85 (If you need to convert a protected font, please\n) print
86 (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print
93 { dup //protected exch //a_executeonly put readonly
96 { dup //protected exch //a_noaccess put readonly
102 { userdict /executeonly get exec
105 { userdict /noaccess get exec
111 % ------ Output utilities ------ %
113 % By convention, the output file is named cfile.
115 % Define some utilities for writing the output file.
116 /wtstring 100 string def
117 /wb {cfile exch write} bind def
118 /ws {cfile exch writestring} bind def
119 /wl {ws (\n) ws} bind def
120 /wt {wtstring cvs ws} bind def
122 % Write a C string. Some compilers have unreasonably small limits on
123 % the length of a string literal or the length of a line, so every place
124 % that uses wcs must either know that the string is short,
125 % or be prepared to use wcca instead.
127 { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
131 32 { /wbx load } repeat
132 95 { /wb load } repeat
133 129 { /wbx load } repeat
135 ("\\) { wcst exch { (\\) ws wb } put } forall
137 { (") ws { dup wcst exch get exec } forall (") ws
139 /can_wcs % Test if can use wcs
142 /wncs % name -> C string
145 % Write a C string as an array of character values.
146 % We only need this because of line and literal length limitations.
147 /wca % <string> <prefix> <suffix> wca -
149 { % Stack: suffix n prefix char
151 exch dup 19 ge { () wl pop 0 } if 1 add
152 exch dup 32 ge 1 index 126 le and
153 { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }
159 /wcca % <string> wcca -
163 % Write object protection attributes. Note that dictionaries and arrays are
164 % the only objects that can be writable.
166 { dup xcheck { (a_executable|) ws } if
167 dup type dup /dicttype eq exch /arraytype eq or
169 { getpa a_readonly and }
170 ifelse prot_names exch get ws
173 { getva prot_names exch get ws
176 % ------ Object writing ------ %
178 /wnstring 128 string def
180 % Convert an object to a string to be scanned at a later time.
181 /cvos % <obj> cvos <string>
182 { % We'd like to use == and write directly to a string,
183 % but we can't do the former because of operators,
184 % and we can't do the latter because we can't predict
185 % how long the string would have to be....
186 wtempname (w) file dup 3 -1 roll wproc closefile
187 wtempname status pop pop pop exch pop string
188 wtempname (r) file dup 3 -1 roll readstring pop exch closefile
191 % Write a string/name or null as an element of a string/name/null array.
192 % Convert any other kind of value to a token to be read back in.
195 { pop (\t255,255,) wl
197 { dup type /nametype eq { wnstring cvs } if
198 dup type /stringtype ne { cvos (255,) ws } if
199 dup length 256 idiv wt (,) ws
200 dup length 256 mod wt
205 % Write a packed string/name/null array.
206 /wsna % <name> <(string|name|null)*> wsna -
207 { (\tstatic const unsigned char ) ws exch wt ([] = {) wl
212 % Write a number or an array of numbers, as refs.
214 { type dup /integertype eq exch /realtype eq or
218 { (real_v\() ws wt (\),) ws }
223 % Test whether a procedure or unusual array can be written (printed).
224 /iswx 4 dict dup begin
225 /arraytype { { iswproc } isall } def
226 /nametype { pop true } def
227 /operatortype { pop true } def % assume it has been bound in
228 /packedarraytype /arraytype load def
230 /iswnx 6 dict dup begin
231 /arraytype { { iswproc } isall } def
232 /integertype { pop true } def
233 /nametype { pop true } def
234 /realtype { pop true } def
235 /stringtype { pop true } def
236 /packedarraytype /arraytype load def
238 /iswproc % <obj> iswproc <bool>
239 { dup xcheck { iswx } { iswnx } ifelse
240 1 index type .knownget { exec } { pop false } ifelse
243 % Write a printable procedure (one for which iswproc returns true).
244 /wproca 3 dict dup begin
246 { 1 index ({) writestring
247 { 1 index ( ) writestring 1 index exch wproc } forall
250 /packedarraytype /arraytype load def
251 /operatortype { .writecvs } bind def % assume binding would work
253 /wproc % <file> <proc> wproc -
254 { dup type wproca exch .knownget { exec } { write==only } ifelse
257 % Write a named object. Return true if this was possible.
258 % Legal types are: boolean, integer, name, real, string,
259 % array of (integer, integer+real, name, null+string),
260 % and certain procedures and other arrays (see iswproc above).
261 % All other objects are either handled specially or ignored.
262 /isall % <array> <proc> isall <bool>
264 { 2 index exec not { pop false exit } if }
267 /wott 8 dict dup begin
270 { aload pop 2 index 2 index exec
271 { exch pop exec exit }
278 { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
282 { (\tmake_int\(&) ws exch wt (, ) ws
286 { (\tcode = (*pprocs->name_create)\(i_ctx_p, &) ws exch wt
287 (, ) ws wnstring cvs wcs % OK, names are short
289 (\tif ( code < 0 ) return code;) wl
295 { (\tmake_real\(&) ws exch wt (, (float)) ws
299 { ({\tstatic const unsigned char s_[] = ) ws
300 dup dup can_wcs { wcs } { wcca } ifelse
302 (\tmake_const_string\(&) ws exch wt
303 (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
307 % Write some other kind of object, if known.
309 { dup otherobjs exch known
310 { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
314 % Top-level procedure.
316 { dup type wott exch .knownget { exec } { wother } ifelse
319 % Write an array (called by wo).
320 /wap % <name> <array> wap -
321 { dup xcheck not 1 index wcheck not and 1 index rcheck and
323 { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }
326 /wnuma { % <name> <array> <element_C_type> <<type>_v> wnuma -
327 ({\tstatic const ref_\() ws exch ws (\) a_[] = {) wl exch
328 % Stack: name type_v array
330 (\t) ws 1 index ws (\(0\)) wl
333 (\t) ws 2 index ws (\() ws wt (\),) wl
339 (\tcode = (*pprocs->scalar_array_create)\(i_ctx_p, &) ws exch wt
340 (, (const ref *)a_, ) ws dup length wt
342 (\tif ( code < 0 ) return code;) wl
344 (\tmake_const_array\(&) ws exch wt
345 (, avm_foreign|) ws dup wpa (, ) ws length wt
346 (, (const ref *)a_\);) wl
352 { { { type /integertype eq } isall }
353 { (long) (integer_v) wnuma true }
356 { { { type dup /integertype eq exch /realtype eq or } isall }
357 { (float) (real_v) wnuma true }
360 { { { type dup /nulltype eq exch /stringtype eq or } isall }
361 { ({) ws dup (sa_) exch wsna
362 (\tcode = (*pprocs->string_array_create)\(i_ctx_p, &) ws exch wt
363 (, \(const char *\)sa_, ) ws dup length wt (, ) ws wpa (\);) wl
364 (\tif ( code < 0 ) return code;) wl
369 { { { type /nametype eq } isall }
370 { ({) ws dup (na_) exch wsna
371 (\tcode = (*pprocs->name_array_create)\(i_ctx_p, &) ws 1 index wt
372 (, \(const char *\)na_, ) ws dup length wt (\);) wl
373 (\tif ( code < 0 ) return code;) wl
380 % Stack: name proc string
381 ({\tstatic const unsigned char s_[] = ) ws
382 dup dup can_wcs { wcs } { wcca } ifelse
384 (\tcode = (*pprocs->ref_from_string)\(i_ctx_p, &) ws 2 index wt
385 (, \(const char *\)s_, ) ws length wt (\);) wl
386 (\tif ( code < 0 ) return code;) wl
397 % Write a named dictionary. We assume the ref is already declared.
398 /wd % <name> <dict> <extra> wd -
401 (\tref v_[) ws dup length wt (];) wl
403 { counttomark 2 sub wtstring cvs
404 (v_[) exch concatstrings (]) concatstrings exch wo not
405 { (Skipping ) print ==only (....\n) print }
409 % Stack: array of keys (names)
410 ({) ws dup (str_keys_) exch wsna
411 (\tstatic const cfont_dict_keys keys_ =) wl
412 (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
413 dup wpa (, ) ws dup wva ( };) wl pop
414 (\tcode = \(*pprocs->ref_dict_create\)\(i_ctx_p, &) ws wt
415 (, &keys_, \(const char *\)str_keys_, v_\);) wl
416 (\tif ( code < 0 ) return code;) wl
421 % Write character dictionary keys.
422 % We save a lot of space by abbreviating keys which appear in
423 % StandardEncoding or ISOLatin1Encoding.
424 % Writes code to declare and initialize enc_keys_, str_keys, and keys_.
425 /wcdkeys % <dict> wcdkeys -
426 { % Write keys present in StandardEncoding or ISOLatin1Encoding,
427 % pushing other keys on the o-stack.
428 (static const charindex enc_keys_[] = {) wl
430 { pop decoding 1 index known
431 { decoding exch get ({) ws dup -8 bitshift wt
432 (,) ws 255 and wt (}, ) ws
433 1 add dup 5 mod 0 eq { (\n) ws } if
442 (str_keys_) exch wsna
443 % Write the declaration for keys_.
444 (static const cfont_dict_keys keys_ = {) wl
445 (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
446 (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
447 dup wpa (, ) ws wva () wl
451 % Enumerate character dictionary values in the same order that
452 % the keys appear in enc_keys_ and str_keys_.
453 % <proc> is called with each value in turn.
454 /cdforall % <dict> <proc> cdforall -
456 { decoding 3 index known
457 { 3 -1 roll pop exec }
461 /exec cvx 3 packedarray cvx
464 { decoding 3 index known
466 { 3 -1 roll pop exec }
469 /exec cvx 3 packedarray cvx
471 6 packedarray cvx exec
474 % ------ Writers for special objects ------ %
476 /writespecial 10 dict dup begin
478 /FontInfo { 0 wd } def
480 /Private { 0 wd } def
485 (static const unsigned char values_[] = {) wl
488 (\tcode = \(*pprocs->string_dict_create\)\(i_ctx_p, &) ws wt
489 (, &keys_, (const char *)str_keys_, \(const char *\)values_\);) wl
490 (\tif ( code < 0 ) return code;) wl
497 (static const ref_(float) values_[] = {) wl
498 dup { (\t) ws wnums () wl } cdforall
500 (static const unsigned char lengths_[] = {) wl
501 { (\t) ws dup isnumber
507 (\tcode = \(*pprocs->num_dict_create\)\(i_ctx_p, &) ws wt
508 (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
509 (\tif ( code < 0 ) return code;) wl
513 /Metrics2 /Metrics load def
515 /FDepVector pop % (converted to a list of font names)
519 % ------ The main program ------ %
521 % Construct an inverse dictionary of encodings.
522 [ /StandardEncoding /ISOLatin1Encoding
523 /SymbolEncoding /DingbatsEncoding
526 dup length dict begin
527 { mark exch dup { .findencoding exch def } stopped cleartomark
529 currentdict end /encodingnames exch def
531 % Invert the StandardEncoding and ISOLatin1Encoding vectors.
533 0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
534 0 1 255 { dup StandardEncoding exch get exch def } for
535 currentdict end /decoding exch def
537 /writefont % cfilename procname -> [writes the current font]
538 { (gsf_) exch concatstrings
539 /fontprocname exch def
541 /cfile cfname (w) file def
543 % Remove unwanted keys from the font.
544 currentfont dup length dict begin { def } forall
545 { /FID /MIDVector /CurMID } { currentdict exch undef } forall
546 /Font currentdict end def
548 % Replace the FDepVector with a list of font names.
549 Font /FDepVector .knownget
550 { [ exch { /FontName get } forall ]
551 Font /FDepVector 3 -1 roll put
555 % Find all the special objects we know about.
556 % wo uses this to write out references to otherwise intractable objects.
557 /otherobjs writespecial length dict dup begin
559 { pop Font 1 index .knownget { exch def } { pop } ifelse
564 % Define a dummy FontInfo, in case the font doesn't have one.
567 % Write out the boilerplate.
569 (/****************************************************************) wl
570 ( Portions of this file are subject to the following notice(s):) wl
571 systemdict /copyright get wl
572 FontInfo /Notice .knownget
573 { (----------------------------------------------------------------) wl wl
575 (****************************************************************/) wl
577 (/* ) ws cfname ws ( */) wl
578 (/* This file was created by the ) ws product ws ( font2c utility. */) wl
581 (#include "ccfont.h") wl
584 % Write the procedure prologue.
585 (#ifdef __PROTOTYPES__) wl
586 (ccfont_proc\() ws fontprocname ws (\);) wl
588 fontprocname ws ((i_ctx_t *i_ctx_p, const cfont_procs *pprocs, ref *pfont)) wl
591 fontprocname ws ((i_ctx_p, pprocs, pfont) i_ctx_t *i_ctx_p; const cfont_procs *pprocs; ref *pfont;) wl
596 { exch pop (\tref ) ws wt (;) wl }
599 % Write out the special objects.
601 { exch writespecial 2 index get exec
605 % Write out the main font dictionary.
606 % If possible, substitute the encoding name for the encoding;
607 % PostScript code will fix this up.
608 { /Encoding /PrefEnc }
609 { Font 1 index .knownget
610 { encodingnames exch .knownget { def } { pop } ifelse }
615 (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd
617 % Finish the procedural initialization code.
618 (\t*pfont = Font;) wl
629 % Compute the procedure name from the font name.
630 % Replace all non-alphanumeric characters with '_'.
631 /makefontprocnamemap 256 string
632 0 1 255 { 2 copy 95 put pop } for
633 (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz)
634 { 2 copy dup put pop } forall
636 /makefontprocname % <fontname> makefontprocname <procnamestring>
637 { dup length string cvs
638 dup length 1 sub -1 0
639 { % Stack: string index
640 2 copy 2 copy get //makefontprocnamemap exch get put pop
645 /writefont { font2cdict begin writefont end } def
647 % If the program was invoked from the command line, run it now.
649 { counttomark dup 2 eq exch 3 eq or
650 { counttomark -1 roll cvn
651 (Converting ) print dup =only ( font.\n) print flush
652 % Ensure that we get a clean copy of the font from the
654 2 { % do both local and global
655 currentglobal not setglobal
659 (FontName is ) print currentfont /FontName get ==only (.\n) print flush
661 { % Construct the procedure name from the file name.
662 currentfont /FontName get makefontprocname
666 (Done.\n) print flush
669 (Usage: font2c fontname cfilename.c [shortname]\n) print
670 ( e.g.: font2c Courier cour.c\n) print flush