home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 5
/
FreshFish_July-August1994.bin
/
bbs
/
gnu
/
gs-2.6.1.4-bin.lha
/
lib
/
ghostscript
/
font2c.ps
< prev
next >
Wrap
Text File
|
1994-07-11
|
14KB
|
501 lines
% Copyright (C) 1992, 1993 Aladdin Enterprises. All rights reserved.
%
% 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, name, 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_const_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
}
}
% Names
{ { type /nametype eq }
{ ({) ws dup (na_) exch wsna
exch (\tcode = (*pprocs->name_array_create)\(&) ws wt
(, na_, ) ws length wt (\);) 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