ref: 2707beb7b46cf29fb1ebafad33edf8d48041ed50
dir: /sys/src/cmd/gs/lib/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