diff options
Diffstat (limited to 'Master/tlpkg/tlgs/lib/font2c.ps')
-rw-r--r-- | Master/tlpkg/tlgs/lib/font2c.ps | 674 |
1 files changed, 0 insertions, 674 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2c.ps b/Master/tlpkg/tlgs/lib/font2c.ps deleted file mode 100644 index dffc24745e0..00000000000 --- a/Master/tlpkg/tlgs/lib/font2c.ps +++ /dev/null @@ -1,674 +0,0 @@ -% Copyright (C) 2001-2012 Artifex Software, Inc. -% 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. -% -% Refer to licensing information at http://www.artifex.com or contact -% Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134, San Rafael, -% CA 94903, U.S.A., +1(415)492-9861, for further information. -% - -% 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 |