[wadalabfont-kit] / renderer / out2ps.l

Annotation of /renderer/out2ps.l

Revision: 1.5 - (view) (download)

1 :	ktanaka	1.5	;
2 :			; $BAH9g$o$;$N$?$a$@$1$KB8:_$9$k2>A[E*$J(Bxlimit, ylimit
3 :			; $B$H$$$&%(%l%a%s%H$r=\|$/(B
4 :			;
5 :	ktanaka	1.1	(defun rm-limit (prim)
6 :			(do ((l (cadr prim) (cdr l))(ret))
7 :			((atom l)`(,(car prim) ,(nreverse ret).,(cddr prim)))
8 :			(or (memq (caar l) '(xlimit ylimit))
9 :			(push (car l) ret))))
10 :	ktanaka	1.5	;
11 :			; $B%U%!%$%k$N%X%C%@$N=PNO(B
12 :			;
13 :
14 :			(defun outputFileHeader (scale)
15 :	ktanaka	1.1	(format "%!/n%%BoundingBox: 45 45 /c /c/n"
16 :			(plus 55 (fix (times 0.001 scale (- (* line 500) 100))))
17 :			(plus 55 (fix (times 0.001 scale (- (* col 500) 100)))))
18 :	ktanaka	1.5	(princ
19 :			"%!
20 :			/KanjiEncoding
21 :			[
22 :			% \x00
23 :			0 0 0 0 0 0 0 0
24 :			0 0 0 0 0 0 0 0
25 :			0 0 0 0 0 0 0 0
26 :			0 0 0 0 0 0 0 0
27 :			% \x20
28 :			0 1 2 3 4 5 6 7
29 :			8 0 0 0 0 0 0 0
30 :			9 10 11 12 13 14 15 16
31 :			17 18 19 20 21 22 23 24
32 :			% \x40
33 :			25 26 27 28 29 30 31 32
34 :			33 34 35 36 37 38 39 40
35 :			41 42 43 44 45 46 47 48
36 :			49 50 51 52 53 54 55 56
37 :			% \x60
38 :			57 58 59 60 61 62 63 64
39 :			65 66 67 68 69 70 71 72
40 :			73 74 75 76 77 0 0 0
41 :			0 0 0 0 0 0 0 0
42 :			% \x80
43 :			0 0 0 0 0 0 0 0
44 :			0 0 0 0 0 0 0 0
45 :			0 0 0 0 0 0 0 0
46 :			0 0 0 0 0 0 0 0
47 :			% \xA0
48 :			0 1 2 3 4 5 6 7
49 :			8 0 0 0 0 0 0 0
50 :			9 10 11 12 13 14 15 16
51 :			17 18 19 20 21 22 23 24
52 :			% \xC0
53 :			25 26 27 28 29 30 31 32
54 :			33 34 35 36 37 38 39 40
55 :			41 42 43 44 45 46 47 48
56 :			49 50 51 52 53 54 55 56
57 :			% \xE0
58 :			57 58 59 60 61 62 63 64
59 :			65 66 67 68 69 70 71 72
60 :			73 74 75 76 77 0 0 0
61 :			0 0 0 0 0 0 0 0
62 :			] readonly def
63 :			/KanjiSubEncoding {
64 :			%\x00
65 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
66 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
67 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
68 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
69 :			%\x20
70 :			/.notdef /c21 /c22 /c23 /c24 /c25 /c26 /c27
71 :			/c28 /c29 /c2A /c2B /c2C /c2D /c2E /c2F
72 :			/c30 /c31 /c32 /c33 /c34 /c35 /c36 /c37
73 :			/c38 /c39 /c3A /c3B /c3C /c3D /c3E /c3F
74 :			%\x40
75 :			/c40 /c41 /c42 /c43 /c44 /c45 /c46 /c47
76 :			/c48 /c49 /c4A /c4B /c4C /c4D /c4E /c4F
77 :			/c50 /c51 /c52 /c53 /c54 /c55 /c56 /c57
78 :			/c58 /c59 /c5A /c5B /c5C /c5D /c5E /c5F
79 :			%\x60
80 :			/c60 /c61 /c62 /c63 /c64 /c65 /c66 /c67
81 :			/c68 /c69 /c6A /c6B /c6C /c6D /c6E /c6F
82 :			/c70 /c71 /c72 /c73 /c74 /c75 /c76 /c77
83 :			/c78 /c79 /c7A /c7B /c7C /c7D /c7E /.notdef
84 :			%\x80
85 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
86 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
87 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
88 :			/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
89 :			%\xA0
90 :			/.notdef /c21 /c22 /c23 /c24 /c25 /c26 /c27
91 :			/c28 /c29 /c2A /c2B /c2C /c2D /c2E /c2F
92 :			/c30 /c31 /c32 /c33 /c34 /c35 /c36 /c37
93 :			/c38 /c39 /c3A /c3B /c3C /c3D /c3E /c3F
94 :			%\xC0
95 :			/c40 /c41 /c42 /c43 /c44 /c45 /c46 /c47
96 :			/c48 /c49 /c4A /c4B /c4C /c4D /c4E /c4F
97 :			/c50 /c51 /c52 /c53 /c54 /c55 /c56 /c57
98 :			/c58 /c59 /c5A /c5B /c5C /c5D /c5E /c5F
99 :			%\xE0
100 :			/c60 /c61 /c62 /c63 /c64 /c65 /c66 /c67
101 :			/c68 /c69 /c6A /c6B /c6C /c6D /c6E /c6F
102 :			/c70 /c71 /c72 /c73 /c74 /c75 /c76 /c77
103 :			/c78 /c79 /c7A /c7B /c7C /c7D /c7E /.notdef
104 :			} cvlit readonly def
105 :			/T1NF
106 :			{
107 :			/newname exch def
108 :			newname 20 dict def
109 :			newname load begin
110 :			/FontType 1 def
111 :			/FontInfo 8 dict def
112 :			FontInfo begin
113 :			/version (001.001) readonly def
114 :			/FullName (PROLKANJI) readonly def
115 :			/FamilyName (PROLKANJI) readonly def
116 :			/Weight (Medium) readonly def
117 :			/ItalicAngle 0 def
118 :			/isFixedPitch false def
119 :			/UnderlinerPosition 0 def
120 :			/UnderlineThichness 0 def
121 :			end
122 :			%/FontMatrix [.001 0 0 .001 0 0] def
123 :			/FontMatrix [.001 0 0 .001 0 -0.16] def
124 :			/FontBBox [0 0 1000 1000] def
125 :			/Encoding KanjiSubEncoding def
126 :			/CharStrings 256 dict def CharStrings /.notdef <10bf317079ca388fe763> put
127 :			/FontName newname def
128 :			/PaintType 0 def
129 :			/UniqueId 9876 def
130 :			/Private 8 dict def
131 :			Private begin
132 :			/BlueValues [] def
133 :			/password 5839 def
134 :			end
135 :			end
136 :			newname dup dup load definefont
137 :			%[lw-h 0 0 lw-v 0 0] makefont
138 :			def
139 :			} def
140 :			/T0NF
141 :			{
142 :			/newname exch def
143 :			/fdepvector exch def
144 :			newname 20 dict def
145 :			newname load begin
146 :			/FontType 0 def
147 :			/FontMatrix [1 0 0 1 0 0] def
148 :			/FMapType 2 def
149 :			/Encoding KanjiEncoding def
150 :			/FDepVector fdepvector def
151 :			/FontName newname def
152 :			/UniqueId 9876 def
153 :			end
154 :			newname dup dup load definefont
155 :			def
156 :			} def
157 :			/T1D
158 :			{
159 :			2 dict begin
160 :			/ch-code exch def
161 :			/ch-data exch def
162 :			currentfont /CharStrings get ch-code ch-data put
163 :			} def
164 :
165 :			/CompNF
166 :			{
167 :			/newname1 exch def
168 :			newname1 dup length string cvs /str exch def
169 :			str length /len exch def
170 :			/fdepvector 78 array def
171 :			/j 1 def
172 :			16#21 1 16#74 {
173 :			/i exch def
174 :			KanjiEncoding i get 0 gt {
175 :			len 4 add string /newstr exch def
176 :			newstr 0 str putinterval
177 :			newstr len (.r) putinterval
178 :			newstr len 2 add i 16 2 string cvrs putinterval
179 :			newstr cvn /newlit exch def
180 :			newlit T1NF /newfont newlit findfont def
181 :			fdepvector j newfont put
182 :			/j j 1 add def
183 :			} if
184 :			} for
185 :			fdepvector 0 fdepvector 1 get put
186 :			/j 0 def
187 :			fdepvector newname1 T0NF
188 :			} def
189 :
190 :			/CompD
191 :			{
192 :			20 dict begin
193 :			/code exch def
194 :			/charstr exch def
195 :			code 0 get /high exch def
196 :			code 1 get /low exch def
197 :			currentfont /Encoding get high get /index exch def
198 :			currentfont /FDepVector get index get /lowfont exch def
199 :			lowfont /Encoding get low get /tmpkey exch def
200 :			lowfont /CharStrings get tmpkey charstr put
201 :			end
202 :			} def
203 :			/show1 {false charpath 0 setlinewidth stroke} def
204 :			"
205 :			)
206 :			)
207 :			;
208 :			; $B%Z!<%8$4$H$N%X%C%@$N=PNO(B
209 :			;
210 :			(defun outputPageHeader (page file printfile)
211 :			(lets ((date (date-time)))
212 :	ktanaka	1.1	(format "50 50 translate/n0.001 /c mul dup scale/n" scale)
213 :			(format "//Helvetica findfont 70 scalefont setfont/n")
214 :			(and printfile
215 :			(format "0 -70 moveto (/c-/c-/c /c:/c File: /c Page: /c) show/n"
216 :			(substring date 0 2)
217 :			(substring date 2 4)(substring date 4 6)
218 :			(substring date 6 8)(substring date 8 10)
219 :			psfile page))
220 :			(format "//Wadalab-mincho-10 CompNF/n")
221 :	ktanaka	1.5	(format "//Wadalab-mincho-10 findfont 400 scalefont setfont/n")))
222 :			;
223 :			; $B%U%!%$%k$N@8@.(B
224 :			;
225 :			(defun out-to-ps-all (outlines tag psfile
226 :			(nameflag)
227 :			(col 9)(line (fix (times 0.67 col)))
228 :			(printfile t))
229 :			(lets ((standard-output (outopen (stream psfile)))
230 :			(scale (fix (times 160.0 (min (//$ 9.0 (float col))
231 :			(//$ 6.0 (float line))))))
232 :			(ii nil)(jj nil)(page nil)(last nil)
233 :			(skeleton)(hints)(type1)(kstr)
234 :			(next nil)(nextnext nil)(x1 nil)(y1 nil)(x2 nil)(y2 nil))
235 :			(outputFileHeader scale)
236 :			(setq ii 0 jj 0 page 1)
237 :			(outputPageHeader page psfile printfile)
238 :	ktanaka	1.1	(do
239 :			((ol outlines (cdr ol))
240 :			(l nil))
241 :			((atom ol))
242 :			(princ ";" terminal-output)
243 :			; (princ (gccount) terminal-output)
244 :			(print (car ol) terminal-output)
245 :			(setq l
246 :			(let ((err:argument-type #'(lambda (x (y))(throw 'err)))
247 :			(err:number-of-arguments #'(lambda (x (y))(throw 'err)))
248 :			(err:unbound-variable #'(lambda (x (y))(throw 'err)))
249 :			(err:undefined-function #'(lambda (x (y))(throw 'err)))
250 :			(err:zero-division #'(lambda (x (y))(throw 'err))))
251 :			(catch 'err
252 :	ktanaka	1.2	(skeleton2list (setq skeleton (normkanji (rm-limit (applykanji (car ol) tag)))) tag))))
253 :	ktanaka	1.1	(cond
254 :			((atom l)
255 :			(format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n")
256 :			(format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n")
257 :			)
258 :			(t
259 :			(format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n")
260 :			(format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n")
261 :	ktanaka	1.2	(setq hints (type1hints skeleton tag))
262 :	ktanaka	1.1	(setq type1 (out2type1 (makeoutline l) hints))
263 :			(cond ((and (= 2 (string-length (car ol)))
264 :			(logand 128 (sref (car ol) 0)))
265 :			(setq kstr (long-hex-image
266 :			(plus (logand 127 (sref (car ol) 1))
267 :			(times 256 (logand 127 (sref (car ol) 0)))))))
268 :			((and (= 7 (string-length (car ol)))
269 :			(string-equal (substring (car ol) 0 2) "1-"))
270 :			(setq kstr
271 :			(long-hex-image
272 :			(plus (logand 127 (plus 32 (number-value (substring (car ol) 5 7))))
273 :			(times 256 (logand 127 (plus 32 (number-value (substring (car ol) 2 4)))))))))
274 :			(t
275 :			(setq kstr "2121")))
276 :			(princ type1)
277 :			(format " </c> CompD/n" kstr)
278 :			(format "0 70 moveto </c> show/n" kstr)))
279 :			(setq ii (1+ ii))
280 :			(cond ((eq ii col)
281 :			(format "500 /c translate/n" (* -500 (1- col)))
282 :			(setq ii 0)
283 :			(setq jj (1+ jj))
284 :			(cond ((and (eq jj line)(consp (cdr ol)))
285 :			(format "showpage/n")
286 :			(setq page (1+ page))
287 :	ktanaka	1.5	(outputPageHeader page psfile printfile)
288 :	ktanaka	1.1	(setq jj 0))))
289 :			(t (format "0 500 translate/n"))))
290 :			(format "showpage/n")))

ktanaka

Annotation of /renderer/out2ps.l

ViewCVS and CVS Help