Category : DeskTop Publishing in the 1990's
Archive   : GS252INI.ZIP
Filename : FONT2C.PS

% Copyright (C) 1992 Aladdin Enterprises. All rights reserved.
% Distributed by Free Software Foundation, Inc.
%
% This file is part of Ghostscript.
%
% Ghostscript is distributed in the hope that it will be useful, but
% WITHOUT ANY WARRANTY. No author or distributor accepts responsibility
% to anyone for the consequences of using it or for whether it serves any
% particular purpose or works at all, unless he says so in writing. Refer
% to the Ghostscript General Public License for full details.
%
% Everyone is granted permission to copy, modify and redistribute
% Ghostscript, but only under the conditions described in the Ghostscript
% General Public License. A copy of this license is supposed to have been
% given to you along with Ghostscript so you can know your rights and
% responsibilities. It should be in a file named COPYING. Among other
% things, the copyright notice and this notice must be preserved on all
% copies.

% font2c.ps
% Write out a Type 1 font as C code that can be linked with Ghostscript.
% This even works on protected fonts, if you use the -dWRITESYSTEMDICT
% switch in the command line. The code is reentrant and has no
% external references, so it can be shared.

% Define the maximum string length that will get by the compiler.
% This must be approximately
% min(max line length, max string literal length) / 4 - 5.

/max_wcs 50 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 exch /arraytype 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.
/protected % do first so // will work
systemdict wcheck { 1500 dict } { 1 dict } ifelse
def
systemdict wcheck
{ systemdict begin
/executeonly
{ dup //protected exch a_executeonly put readonly
} bind odef
/noaccess
{ dup //protected exch a_noaccess put readonly
} bind odef
end
}
{ (Warning: you will not be able to convert protected fonts.\n) print
(If you need to convert a protected font,\n) print
(please restart Ghostscript with the -dWRITESYSTEMDICT switch.\n) print
flush
}
ifelse

% ------ 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 ->
{ 0 4 -2 roll exch
{ exch ws
exch dup 19 ge { () wl pop 0 } if 1 add
exch wt (,)
} forall
pop pop ws
} bind def
/wcca
{ ({\n) (}) wca
} bind def

% Write object protection attributes. Note that dictionaries are
% the only objects that can be writable.
/wpa
{ dup xcheck { (a_executable+) ws } if
dup type /dicttype eq { 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

% Write a string/name or null as an element of a string/name/null array. */
/wsn
{ dup null eq
{ pop (\t255,255,) wl
}
{ dup type /nametype eq { wnstring cvs } 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)* ->
{ (\tstatic const char ) ws exch wt ([] = {) wl
{ wsn } forall
(\t0\n};) wl
} 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, null+string).
% Dictionaries are handled specially. Other types are ignored.
/isall % array proc -> bool
{ true 3 -1 roll
{ 2 index exec not { pop false exit } if }
forall exch pop
} bind def
/wott 7 dict dup begin
/arraytype
{ woatt
{ aload pop 2 index 2 index isall
{ exch pop exec exit }
{ pop pop }
ifelse
}
forall
} bind def
/booleantype
{ { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
wt (\);) wl true
} bind def
/dicttype
{ dup alldicts exch known
{ alldicts exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
{ pop pop false }
ifelse
} bind def
/integertype
{ (\tmake_int\(&) ws exch wt (, ) ws
wt (\);) wl true
} bind def
/nametype
{ (\tcode = (*pprocs->name_create)\(&) ws exch wt
(, ) ws wnstring cvs wcs % OK, names are short
(\);) wl
(\tif ( code < 0 ) return code;) wl
true
} bind 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_string\(&) ws exch wt
(, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
(}) wl true
} bind def
end def
/wo % name obj -> OK
{ dup type wott exch known
{ dup type wott exch get exec }
{ pop pop false }
ifelse
} bind def

% Write an array (called by wo).
/wnuma % name array C_type type_v ->
{ ({\tstatic const ref_\() ws exch ws
(\) a_[] = {) wl exch
dup length 0 eq
{ (\t0) wl
}
{ dup
{ (\t) ws 2 index ws (\() ws wt (\),) wl
} forall
}
ifelse
(\t};) wl exch pop
(\tmake_array\(&) ws exch wt
(, ) ws dup wpa (, ) ws length wt
(, (ref *)a_\);) wl (}) wl
} bind def
/woatt [
% Integers
{ { type /integertype eq }
{ (long) (integer_v) wnuma true }
}
% Integers + reals
{ { type dup /integertype eq exch /realtype eq or }
{ (float) (real_v) wnuma true }
}
% Strings + nulls
{ { type dup /nulltype eq exch /stringtype eq or }
{ ({) ws dup (sa_) exch wsna
exch (\tcode = (*pprocs->string_array_create)\(&) ws wt
(, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
(\tif ( code < 0 ) return code;) wl
(}) wl true
}
}
% Default
{ { pop true }
{ pop pop false }
}
] def

% Write a named dictionary. We assume the ref is already declared.
/wd % name dict
{ ({) ws
(\tref v_[) ws dup length wt (];) wl
dup [ exch
{ counttomark 2 sub wtstring cvs
(v_[) exch concatstrings (]) concatstrings exch wo not
{ pop }
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 (, 1, ) ws
dup wpa (, ) ws dup wva ( };) wl
(\tcode = \(*pprocs->ref_dict_create\)\(&) ws 1 index wt
(, &keys_, str_keys_, &v_[0]\);) wl
(\tif (code < 0) return code;) wl
pop pop
(}) wl
(}) wl
} bind def

% Write a character dictionary.
% We save a lot of space by abbreviating keys which appear in
% StandardEncoding or ISOLatin1Encoding.
/wcd % namestring createtype dict valuetype writevalueproc ->
{ % Keys present in StandardEncoding or ISOLatin1Encoding
2 index
(static const charindex enc_keys_[] = {) wl
[ 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
% Other keys
(str_keys_) exch wsna
% Values, with those corresponding to stdkeys first.
(static const ) ws 1 index ws
( values_[] = {) wl
2 index
{ decoding 2 index known
{ exch pop 1 index exec }
{ pop pop }
ifelse
}
forall
2 index
{ decoding 2 index known
{ pop pop }
{ exch pop 1 index exec }
ifelse
}
forall
(\t0\n};) wl
% Actual creation code
(static const cfont_dict_keys keys_ = {) wl
(\tenc_keys_, countof\(enc_keys_\) - 1,) wl
(\t) ws 2 index length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
pop pop
dup wpa (, ) ws wva () wl
(};) wl
(\tcode = \(*pprocs->) ws ws (_dict_create\)\(&) ws ws
(, &keys_, str_keys_, &values_[0]\);) wl
(\tif ( code < 0 ) return code;) wl
} bind def

% ------ The main program ------ %

% Construct an inverse dictionary of encodings.
3 dict begin
StandardEncoding (StandardEncoding) def
ISOLatin1Encoding (ISOLatin1Encoding) def
SymbolEncoding (SymbolEncoding) def
currentdict end /encodingnames exch def

% Invert the StandardEncoding and ISOLatin1Encoding vector.
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

/makefontprocname % fontname -> procname
{ wtstring cvs
dup length 1 sub -1 0
{ dup wtstring exch get 45 eq { wtstring exch 95 put } { pop } ifelse
}
for
} def

/writefont % cfilename procname -> [writes the current font]
{ (gsf_) exch concatstrings
/fontprocname exch def
/cfname exch def
/cfile cfname (w) file def
/Font currentfont def
Font /CharStrings get length dict
/charmap exch def

% Define all the dictionaries we know about.
% wo uses this when writing out dictionaries.
/alldicts 10 dict def
alldicts begin
Font /Font def
{ /FontInfo /CharStrings /Private }
{ dup Font exch get exch def }
forall
encodingnames Font /Encoding get known not
{ % Make a fake entry for Encoding, for later
Font /Encoding get /Encoding def
}
if
Font /Metrics known { Font /Metrics get /Metrics def } if
end

% Write out the boilerplate.
Font begin
(/* Copyright (C) 1992 Aladdin Enterprises. All rights reserved.) wl
( Distributed by Free Software Foundation, Inc.) wl
() wl
(This file is part of Ghostscript.) wl
() wl
(Ghostscript is distributed in the hope that it will be useful, but) wl
(WITHOUT ANY WARRANTY. No author or distributor accepts responsibility) wl
(to anyone for the consequences of using it or for whether it serves any) wl
(particular purpose or works at all, unless he says so in writing.) wl
(Refer to the Ghostscript General Public License for full details.) wl
() wl
(Everyone is granted permission to copy, modify and redistribute) wl
(Ghostscript, but only under the conditions described in the Ghostscript) wl
(General Public License. A copy of this license is supposed to have been) wl
(given to you along with Ghostscript so you can know your rights and) wl
(responsibilities. It should be in a file named COPYING. Among other) wl
(things, the copyright notice and this notice must be preserved on all) wl
(copies. */) wl
() wl
(/* ) ws cfname ws ( */) wl
(/* This file was created by the Ghostscript font2c utility. */) wl
() wl
FontInfo /Notice known
{ (/* Portions of this file are subject to the following notice: */) wl
(/****************************************************************) wl
FontInfo /Notice get wl
( ****************************************************************/) wl
() wl
} if
(#include "std.h") wl
(#include "iref.h") wl
(#include "store.h") wl
(#include "ccfont.h") wl
() wl

% Write the procedure prologue.
(#ifdef __PROTOTYPES__) wl
(int huge) wl
fontprocname ws ((const cfont_procs *pprocs, ref *pfont)) wl
(#else) wl
(int huge) wl
fontprocname ws ((pprocs, pfont) const cfont_procs *pprocs; ref *pfont;) wl
(#endif) wl
({\tint code;) wl
alldicts
{ exch pop (\tref ) ws wt (;) wl }
forall

% Write out the FontInfo.
(FontInfo) FontInfo wd

% Write out the CharStrings.
({) wl
(CharStrings) (string) CharStrings (char) { wsn } wcd
(}) wl

% Write out the Metrics.
Font /Metrics known
{ ({) wl
(Metrics) (num) Metrics (float) { (\t) ws wtstring cvs ws (,) wl } wcd
(}) wl
}
if

% Write out the Private dictionary.
(Private) Private wd

% Write out the Encoding vector, if it isn't standard.
encodingnames Encoding known not
{ ({) wl
(str_elts_) Encoding wsna
(\tcode = \(*pprocs->name_array_create\)\(&Encoding, str_elts_, ) ws
Encoding length wt (\);) wl
(\tif (code < 0) return code;) wl
(}) wl
}
if

% Write out the main font dictionary.
% If possible, substitute the encoding name for the encoding;
% PostScript code will fix this up.
Font dup length dict copy
encodingnames Encoding known
{ dup /Encoding encodingnames Encoding get put
}
{ % Force it to be treated like a known dictionary
dup /Encoding 1 dict put
}
ifelse
(Font) exch wd

% Finish the procedural initialization code.
(\t*pfont = Font;) wl
(\treturn 0;) wl
(}) wl
end

cfile closefile

} bind 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
dup FontDirectory exch known { dup FontDirectory exch undef } if

findfont setfont
counttomark 1 eq
{ % Construct the procedure name from the file name.
currentfont /FontName get makefontprocname
}
if
writefont
}
{ cleartomark
(Usage: font2c fontname cfilename.c [shortname]\n) print
( e.g.: font2c Courier cour.c\n) print flush
mark
}
ifelse
}
if pop