Commit | Line | Data |
---|---|---|
4b08bc21 WJ |
1 | % Copyright (C) 1991 Aladdin Enterprises. All rights reserved. |
2 | % Distributed by Free Software Foundation, Inc. | |
3 | % | |
4 | % This file is part of Ghostscript. | |
5 | % | |
6 | % Ghostscript is distributed in the hope that it will be useful, but | |
7 | % WITHOUT ANY WARRANTY. No author or distributor accepts responsibility | |
8 | % to anyone for the consequences of using it or for whether it serves any | |
9 | % particular purpose or works at all, unless he says so in writing. Refer | |
10 | % to the Ghostscript General Public License for full details. | |
11 | % | |
12 | % Everyone is granted permission to copy, modify and redistribute | |
13 | % Ghostscript, but only under the conditions described in the Ghostscript | |
14 | % General Public License. A copy of this license is supposed to have been | |
15 | % given to you along with Ghostscript so you can know your rights and | |
16 | % responsibilities. It should be in a file named COPYING. Among other | |
17 | % things, the copyright notice and this notice must be preserved on all | |
18 | % copies. | |
19 | ||
20 | % wrfont.ps | |
21 | % Write out a Type 1 font in readable, reloadable form. | |
22 | % Note that this does NOT work on protected fonts, such as Adobe fonts | |
23 | % (unless you have loaded unprot.ps first, in which case you may be | |
24 | % violating the Adobe license). | |
25 | ||
26 | % ------ Options ------ % | |
27 | ||
28 | % Define whether to write out the CharStrings in binary or in hex. | |
29 | % Binary takes less space on the file, but isn't guaranteed portable. | |
30 | /binary false def | |
31 | ||
32 | % Define whether to use binary token encodings for the CharStrings. | |
33 | % Binary tokens are smaller and load faster, but are a Level 2 feature. | |
34 | /binary_tokens false def | |
35 | ||
36 | % ------ Output utilities ------ % | |
37 | ||
38 | % By convention, the output file is named psfile. | |
39 | ||
40 | % Define some utilities for writing the output file. | |
41 | /wtstring 100 string def | |
42 | /wb {psfile exch write} bind def | |
43 | /wnb {/wb load repeat} bind def | |
44 | /ws {psfile exch writestring} bind def | |
45 | /wl {ws (\n) ws} bind def | |
46 | /wt {wtstring cvs ws ( ) ws} bind def | |
47 | /wd % Write a dictionary. | |
48 | { dup length wt (dict dup begin) wl { we } forall | |
49 | (end) ws | |
50 | } bind def | |
51 | /wld % Write a large dictionary more efficiently. | |
52 | % Ignore the readonly attributes. | |
53 | { dup length wt (dict dup begin) wl | |
54 | 0 exch | |
55 | { exch wo wo | |
56 | 1 add dup 200 eq | |
57 | { wo ({def} repeat) wl 0 } | |
58 | if | |
59 | } | |
60 | forall | |
61 | dup 0 ne | |
62 | { wo ({def} repeat) wl } | |
63 | { pop } | |
64 | ifelse | |
65 | (end) ws | |
66 | } bind def | |
67 | /we % Write a dictionary entry. | |
68 | { exch wo wo /def cvx wo (\n) ws | |
69 | } bind def | |
70 | ||
71 | % Construct the inversion of the system name table. | |
72 | /SystemNames where | |
73 | { pop /snit 256 dict def | |
74 | 0 1 255 | |
75 | { dup SystemNames exch get | |
76 | dup null ne { exch snit 3 1 roll put } { pop pop } ifelse | |
77 | } | |
78 | for | |
79 | } | |
80 | { /snit 1 dict def | |
81 | } | |
82 | ifelse | |
83 | ||
84 | % Write an object, using binary tokens if requested and possible. | |
85 | /woa % write in ascii | |
86 | { psfile exch write==only | |
87 | } bind def | |
88 | % Lookup table for ASCII output. | |
89 | /intbytes % int nbytes -> byte* | |
90 | { exch { dup 255 and exch -8 bitshift } repeat pop | |
91 | } bind def | |
92 | /wotta 8 dict dup begin | |
93 | { /booleantype /integertype /nulltype /realtype } | |
94 | { { ( ) ws woa } def } | |
95 | forall | |
96 | /nametype | |
97 | { dup xcheck { ( ) ws } if woa | |
98 | } bind def | |
99 | { /arraytype /packedarraytype /stringtype } | |
100 | { { dup woa wop } def } | |
101 | forall | |
102 | end def | |
103 | % Lookup table for binary output. | |
104 | /wottb 8 dict dup begin | |
105 | wotta currentdict copy pop | |
106 | /integertype | |
107 | { dup dup 127 le exch -128 ge and | |
108 | { 136 wb 255 and wb | |
109 | } | |
110 | { ( ) ws woa | |
111 | } | |
112 | ifelse | |
113 | } bind def | |
114 | /nametype | |
115 | { dup snit exch known | |
116 | { dup xcheck { 146 } { 145 } ifelse wb | |
117 | snit exch get wb | |
118 | } | |
119 | { wotta /nametype get exec | |
120 | } | |
121 | ifelse | |
122 | } bind def | |
123 | /stringtype | |
124 | { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb | |
125 | ws wop | |
126 | } bind def | |
127 | end def | |
128 | /wop % Write object protection | |
129 | { wcheck not { /readonly cvx wo } if | |
130 | } bind def | |
131 | /wo % Write an object. | |
132 | { dup type binary_tokens { wottb } { wotta } ifelse | |
133 | exch get exec | |
134 | } bind def | |
135 | ||
136 | % Write a hex string for Subrs or CharStrings. | |
137 | /wx % string -> | |
138 | { binary | |
139 | { ws | |
140 | } | |
141 | { % Some systems choke on very long lines, so | |
142 | % we break up the hexstring into chunks of 50 characters. | |
143 | { dup length 25 le {exit} if | |
144 | dup 0 25 getinterval psfile exch writehexstring (\n) ws | |
145 | dup length 25 sub 25 exch getinterval | |
146 | } loop | |
147 | psfile exch writehexstring | |
148 | } ifelse | |
149 | } bind def | |
150 | ||
151 | % ------ The main program ------ % | |
152 | ||
153 | % Define the dictionary of actions for special entries in the dictionaries. | |
154 | % We lump the font and the Private dictionary together, because | |
155 | % the set of keys doesn't overlap. | |
156 | [/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs] | |
157 | dup length dict begin | |
158 | { null cvx def } forall | |
159 | currentdict end /specialkeys exch def | |
160 | ||
161 | % Define the procedures for the Private dictionary. | |
162 | % These must be defined without being bound. | |
163 | 4 dict begin | |
164 | /-! {string currentfile exch readhexstring pop} def | |
165 | /-| {string currentfile exch readstring pop} def | |
166 | /|- {readonly def} def | |
167 | /| {readonly put} def | |
168 | currentdict end /privateprocs exch def | |
169 | ||
170 | % Construct an inverse dictionary of encodings. | |
171 | 3 dict begin | |
172 | StandardEncoding /StandardEncoding def | |
173 | ISOLatin1Encoding /ISOLatin1Encoding def | |
174 | SymbolEncoding /SymbolEncoding def | |
175 | currentdict end /encodingnames exch def | |
176 | ||
177 | /writefont % psfile -> [writes the current font] | |
178 | { /psfile exch def | |
179 | /Font currentfont def | |
180 | /readproc binary { (-| ) } { (-! ) } ifelse def | |
181 | ||
182 | % Turn on binary tokens if relevant. | |
183 | binary_tokens { (currentobjectformat 1 setobjectformat) wl } if | |
184 | ||
185 | % If the file has a UniqueID, write out a check against loading it twice. | |
186 | Font /UniqueID known | |
187 | { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl | |
188 | ( {) ws wo ( findfont dup /UniqueID known) wl | |
189 | ( { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl | |
190 | ( { pop false } ifelse) wl | |
191 | ( { pop save /restore load } if) wl | |
192 | ( } if) wl | |
193 | } | |
194 | if | |
195 | ||
196 | % Write out the creation of the font dictionary and FontInfo. | |
197 | Font length 1 add wt (dict begin) wl % +1 for FontFile | |
198 | Font begin | |
199 | (/FontInfo ) ws FontInfo wd ( readonly def) wl | |
200 | ||
201 | % Write out the other fixed entries in the font dictionary. | |
202 | Font | |
203 | { 1 index specialkeys exch known | |
204 | { pop pop } { we } ifelse | |
205 | } forall | |
206 | /Encoding | |
207 | encodingnames Encoding known | |
208 | { encodingnames Encoding get cvx } | |
209 | { Encoding } | |
210 | ifelse we | |
211 | ||
212 | % Write out the Metrics, if any. | |
213 | Font /Metrics known | |
214 | { (/Metrics ) ws Metrics wld ( readonly def) wl | |
215 | } | |
216 | if | |
217 | ||
218 | % Close the font dictionary. | |
219 | (currentdict end) wl | |
220 | ||
221 | % The rest of the file could be in eexec form, but we don't see any point | |
222 | % in doing this, because we aren't attempting to conceal it from anyone. | |
223 | ||
224 | % Create and initialize the Private dictionary. | |
225 | Private dup length privateprocs length add dict copy begin | |
226 | privateprocs { readonly def } forall | |
227 | (dup /Private ) ws currentdict length 1 add wt (dict dup begin) wl | |
228 | currentdict | |
229 | { 1 index specialkeys exch known | |
230 | { pop pop } { we } ifelse | |
231 | } forall | |
232 | ||
233 | % Write the Subrs entries, if any. | |
234 | currentdict /Subrs known | |
235 | { (/Subrs ) ws Subrs length wt (array) wl | |
236 | 0 1 Subrs length 1 sub | |
237 | { dup Subrs exch get dup null ne | |
238 | { /dup cvx wo exch wo dup length wo ( ) ws readproc ws wx ( |) wl } | |
239 | { pop pop } | |
240 | ifelse | |
241 | } for | |
242 | (readonly def) wl | |
243 | } | |
244 | if | |
245 | ||
246 | % Write the CharStrings entries. | |
247 | (2 index /CharStrings ) ws | |
248 | CharStrings length wt (dict dup begin) wl | |
249 | CharStrings | |
250 | { exch wo | |
251 | binary_tokens | |
252 | { % Suppress recognizing the readonly status of the string. | |
253 | dup length string copy wo | |
254 | } | |
255 | { dup length wo ( ) ws readproc ws wx | |
256 | } | |
257 | ifelse ( |-) wl | |
258 | } forall | |
259 | ||
260 | % Wrap up the private part of the font. | |
261 | (end) wl % CharStrings | |
262 | (end) wl % Private | |
263 | end % Private | |
264 | (readonly put) wl % CharStrings in font | |
265 | (readonly put) wl % Private in font | |
266 | end % Font | |
267 | ||
268 | % Terminate the output. | |
269 | (dup /FontName get exch definefont pop) wl | |
270 | Font /UniqueID known { (exec) wl } if | |
271 | binary_tokens { (setobjectformat) wl } if | |
272 | ||
273 | } bind def |