[wadalabfont-kit] / renderer / out2ps.l  

Annotation of /renderer/out2ps.l

Parent Directory | Revision Log

Revision: 1.7 - (view) (download)

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

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help