diff options
Diffstat (limited to 'Master/tlpkg/tlgs/lib/font2c.ps')
| -rw-r--r-- | Master/tlpkg/tlgs/lib/font2c.ps | 675 |
1 files changed, 0 insertions, 675 deletions
diff --git a/Master/tlpkg/tlgs/lib/font2c.ps b/Master/tlpkg/tlgs/lib/font2c.ps deleted file mode 100644 index c5234d72b02..00000000000 --- a/Master/tlpkg/tlgs/lib/font2c.ps +++ /dev/null @@ -1,675 +0,0 @@ -% 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
|