675 lines · 19.1 KB · Text
RawDownload
%    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,v 1.6 2003/07/10 02:56:51 ray Exp $% 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..currentglobalfalse .setglobal	% so protected can reference local objs/protected		% do first so // will work  systemdict wcheck { 1500 dict } { 1 dict } ifelsedefsystemdict 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 }ifuserdict begin  /executeonly   { dup //protected exch //a_executeonly put readonly   } bind def  /noaccess   { dup //protected exch //a_noaccess put readonly   } bind defendtrue .setglobalsystemdict begin  /executeonly   { userdict /executeonly get exec   } bind odef  /noaccess   { userdict /noaccess get exec   } bind odefend%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 defend 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 defend 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 workend 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

Lines 1–500 of 675.