summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlgs/lib/font2c.ps
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlgs/lib/font2c.ps')
-rw-r--r--[-rwxr-xr-x]Master/tlpkg/tlgs/lib/font2c.ps1350
1 files changed, 675 insertions, 675 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2c.ps b/Master/tlpkg/tlgs/lib/font2c.ps
index c5234d72b02..0dcdaab3a9f 100755..100644
--- a/Master/tlpkg/tlgs/lib/font2c.ps
+++ b/Master/tlpkg/tlgs/lib/font2c.ps
@@ -1,675 +1,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
+% 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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-07 20:35:01 +0000