diff options
author | Karl Berry <karl@freefriends.org> | 2005-12-28 00:07:27 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2005-12-28 00:07:27 +0000 |
commit | 30dd9f517c9c093ff3319061647a4555264f7914 (patch) | |
tree | 0d7a349bf99be5a42cc9c5a80a30f3b7136c4ccd /Master/xemtex/gslib/font2c.ps | |
parent | 08ab8dce83f53b0f915cb66a37bbc8478b22c307 (diff) |
trunk
git-svn-id: svn://tug.org/texlive/trunk@9 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/xemtex/gslib/font2c.ps')
-rw-r--r-- | Master/xemtex/gslib/font2c.ps | 676 |
1 files changed, 676 insertions, 0 deletions
diff --git a/Master/xemtex/gslib/font2c.ps b/Master/xemtex/gslib/font2c.ps new file mode 100644 index 00000000000..fecd5713e29 --- /dev/null +++ b/Master/xemtex/gslib/font2c.ps @@ -0,0 +1,676 @@ +% Copyright (C) 1992, 1993, 1994, 1995, 1999 Aladdin Enterprises. All rights reserved. +% +% This program is free software; you can redistribute it and/or modify it +% under the terms of the GNU General Public License as published by the +% Free Software Foundation; either version 2 of the License, or (at your +% option) any later version. +% +% This program is distributed in the hope that it will be useful, but +% WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General +% Public License for more details. +% +% You should have received a copy of the GNU General Public License along +% with this program; if not, write to the Free Software Foundation, Inc., +% 59 Temple Place, Suite 330, Boston, MA, 02111-1307. + +% $Id: font2c.ps,v 1.3.2.1.2.1 2003/04/12 14:02:38 giles 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 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 (, ) ws + wt (\);) wl true + } bind def + /stringtype + { ({\tstatic const 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 + (, 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 + (, 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 char s_[] = ) ws + dup dup can_wcs { wcs } { wcca } ifelse + (;) wl + (\tcode = (*pprocs->ref_from_string)\(i_ctx_p, &) ws 2 index wt + (, 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_, 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 char values_[] = {) wl + { wsn } cdforall + (\t0\n};) wl + (\tcode = \(*pprocs->string_dict_create\)\(i_ctx_p, &) ws wt + (, &keys_, str_keys_, 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 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 |