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--Master/tlpkg/tlgs/lib/font2c.ps675
1 files changed, 675 insertions, 0 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2c.ps b/Master/tlpkg/tlgs/lib/font2c.ps
new file mode 100644
index 00000000000..c5234d72b02
--- /dev/null
+++ b/Master/tlpkg/tlgs/lib/font2c.ps
@@ -0,0 +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