ref: 8c20c6ec1933054386dd712158d2452da15d6ec7
dir: /sys/lib/ghostscript/font2c.ps/
% 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. .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