[wadalabfont-kit] / renderer / mincho.l  

Annotation of /renderer/mincho.l

Parent Directory | Revision Log

Revision: 1.4 - (view) (download)

1 : ktanaka 1.1 ; 単位は400*400の座標系
2 :     ; 縦線の太さ
3 : ktanaka 1.4 (declare (minchowidth tateyokoratio minchoheight tatekazari tome1 kazariheight tomeheight meshsize mw) special)
4 : ktanaka 1.1 ; 縦線に対する横線の太さの比
5 :     (setq tateyokoratio 0.3)
6 :    
7 :     ; 縦線と横線の連結の高さの縦線に対する比
8 :     (setq minchowidth 10.0)
9 :    
10 :     ; 横線の止めの縦線に対する比
11 :     (setq tomeheight 2.2)
12 :    
13 :     ; 縦棒の始点の飾り
14 :     (setq tatekazari 1.5)
15 :    
16 :     ; 縦棒と横棒の交点の飾り
17 :     (setq kazariheight 1.5)
18 :     ;
19 :     (setq minchowidth 22.0 tateyokoratio 0.3 hirawidth 0.35 tatekazari 0.9
20 :     kazariheight 0.7 tomeheight 1.8)
21 :     ; 細明朝
22 :     ;(setq minchowidth 10.0 tateyokoratio 0.3 hirawidth 0.35 tatekazari 1.8
23 :     ; kazariheight 1.8 tomeheight 2.4)
24 :     (setq minchowidth 8.0 tateyokoratio 0.2 hirawidth 0.35 tatekazari 1.8
25 :     kazariheight 1.8 tomeheight 2.4)
26 :     ; 中明朝
27 :     (setq minchowidth 12.0 tateyokoratio 0.4 ; hirawidth 0.35
28 :     hirawidth 0.6
29 :     tatekazari 1.5
30 :     kazariheight 1.4 tomeheight 1.8)
31 :    
32 :     ;
33 :     (setq mw minchowidth)
34 :     ; デフォルトのmeshsizeを十分小さくすると害がない.
35 :     ;(setq meshsize 6.618290)
36 :     (setq meshsize 0.01)
37 :     ;
38 :     ; ライブラリをexfileする
39 :     (cond ((definedp 'kanjilib))
40 :     (t (exfile 'lib.l)))
41 :    
42 :     ;
43 :     (defkazari mincho (yoko 0 yoko 1)
44 :     (lets ((p0 (vref cross 0))
45 :     (p1 (vref cross 1))
46 :     (p2 (vref cross 2))
47 :     (p3 (vref cross 3)))
48 :     `((angle .,(inter2 p0 p2 0.5))
49 :     (angle .,(inter2 p1 p3 -0.5)))))
50 :     ;
51 :     (defkazari mincho ((migi shin-nyuu) 0 (migi shin-nyuu) 1)
52 :     (lets ((p0 (vref cross 0))
53 :     (p1 (vref cross 1))
54 :     (p2 (vref cross 2))
55 :     (p3 (vref cross 3)))
56 :     `((angle .,p2)
57 :     (bezier .,p0)
58 :     (bezier .,p1)
59 :     (angle .,p3))))
60 :     ;
61 :     (defkazari mincho (hidari 2 hidari 3)
62 :     (lets ((p0 (vref cross 0))
63 :     (p1 (vref cross 1))
64 :     (p2 (vref cross 2))
65 :     (p3 (vref cross 3)))
66 :     `((angle .,p2)
67 :     (bezier .,p0)
68 :     (bezier .,p1)
69 :     (angle .,p3))))
70 :     ;
71 :     (defkazari mincho (migiue 0 migiue 1)
72 :     (lets ((p0 (vref cross 1))
73 :     (p1 (vref cross 0))
74 :     (p2 (vref cross 3))
75 :     (p3 (vref cross 2))
76 :     (d0 (norm2 (diff2 p3 p1)))
77 :     (len (metric2 p0 p1))
78 :     (theta (theta d0 '(0.0 1.0)))
79 :     (psi 1.4)
80 :     (cospsi (cos psi))
81 :     (sinpsi (sin psi))
82 :     (p4 (inter2 p1 p3 (times 0.5 cospsi)))
83 :     (p5 (inter2 p0 p2 (times -0.5 cospsi)))
84 :     (w (times mw tatekazari))
85 :     (fai (plus psi 0.6))
86 :     (w1 (times 0.8 (times 0.82 w)))
87 :     (p6 (plus2 p4 (normlen2 w1 d0)))
88 :     (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1))
89 :     (normlen2 (sin fai)(diff2 p1 p0))))
90 :     (p7 (cross2 p4 p6 (diff2 p4 p5) dp6))
91 :     (len0 (metric2 p7 p6))
92 :     (len1 (metric2 p7 p5))
93 :     (len2 (quotient len1 3.0))
94 :     )
95 :     (cond ((lessp len1 len0)
96 :     `(
97 :     (angle .,p6)
98 :     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
99 :     (bezier .,p7)
100 :     (angle .,(plus2 p7 (normlen2 len0 (diff2 p5 p7))))
101 :     (angle .,p5)))
102 :     (t
103 :     `((angle .,p6)
104 :     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
105 :     (bezier .,p7)
106 :     (angle .,p5))))))
107 :     ;
108 :     (defkazari mincho (yoko 2 yoko 3)
109 :     (lets ((p0 (vref cross 0))
110 :     (p1 (vref cross 1))
111 :     (p2 (vref cross 2))
112 :     (p3 (vref cross 3))
113 :     (w tome1)
114 :     (len0 (metric2 p0 p1))
115 :     (w1 (plus w len0))
116 :     (w2 (times w1 1.3))
117 :     (p4 (plus2 p0 (normlen2 (times w2 0.25) (diff2 p0 p2))))
118 :     (p5 (plus2 p4 (normlen2 w2 (diff2 p2 p0))(normlen2 w1 (diff2 p1 p0))))
119 :     (p6 (plus2 p4 (normlen2 (plus w2 (times 0.7 w))(diff2 p2 p0))
120 :     (normlen2 len0 (diff2 p1 p0))))
121 :     (p7 (inter2 p4 p5 0.5))
122 :     (p8 (plus2 p4 (normlen2 (times w2 0.5)(diff2 p2 p0)))))
123 :     `((angle .,p8)
124 :     (bezier .,(inter2 p8 p4 0.66666))
125 :     (bezier .,(inter2 p7 p4 0.66666))
126 :     (angle .,p7)
127 :     (angle .,p5)
128 :     (angle .,p6))))
129 :     ;
130 :     (defkazari mincho ((tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 0
131 :     (tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 1)
132 :     (lets ((p0 (vref cross 0))
133 :     (p1 (vref cross 1))
134 :     (p2 (vref cross 2))
135 :     (p3 (vref cross 3))
136 :     (d0 (norm2 (diff2 p3 p1)))
137 :     (len (metric2 p0 p1))
138 :     (theta (theta d0 '(0.0 1.0)))
139 :     (theta (cond ((plusp theta)0)(theta)))
140 :     (psi (plus 1.32 (times theta -0.85)))
141 :     (cospsi (cos psi))
142 :     (sinpsi (sin psi))
143 :     (p4 (inter2 p1 p3 (times 0.5 cospsi)))
144 :     (p5 (inter2 p0 p2 (times -0.5 cospsi)))
145 :     ; (w (times mw tatekazari))
146 :     (w (times (metric2 p0 p1) tatekazari 0.5))
147 :     (fai (plus psi 0.8))
148 :     (w1 (times 1.2 w))
149 :     (p6 (plus2 p4 (normlen2 w1 d0)))
150 :     (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1))
151 :     (normlen2 (sin fai)(diff2 p1 p0))))
152 :     (p7 (cross2 p4 p6 (diff2 p4 p5) dp6))
153 :     (len0 (metric2 p7 p6))
154 :     (len1 (metric2 p7 p5))
155 :     (len2 (quotient len1 3.0))
156 :     )
157 :     (cond ((lessp len1 len0)
158 :     `((angle .,p5)
159 :     (angle .,(plus2 p7 (normlen2 (min len0 (metric2 p5 p7))
160 :     (diff2 p5 p7))))
161 :     (bezier .,p7)
162 :     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
163 :     (angle .,p6))
164 :     )
165 :     (t
166 :     `((angle .,p5)
167 :     (bezier .,p7)
168 :     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
169 :     (angle .,p6))))))
170 :     ;
171 :     ; (break)
172 :     ; `((angle .,p5)
173 :     ; (bezier .,
174 :     ; (plus2 p4 (normlen2 (times 0.2 len) (diff2 p4 p5))))
175 :     ; (bezier .,
176 :     ; (plus2 p4 (normlen2 (times 0.5 len) (diff2 p4 p5))))
177 :     ; (angle .,
178 :     ; (plus2 p4 (normlen2 (times len 0.4) d0))))))
179 :    
180 :     ;
181 :     (defkazari mincho (migi 2 migi 3)
182 :     (lets ((p0 (vref cross 0))
183 :     (p1 (vref cross 1))
184 :     (p2 (vref cross 2))
185 :     (p3 (vref cross 3))
186 :     (d0 (norm2 (diff2 p3 p1)))
187 :     (len (metric2 p0 p1))
188 :     (sintheta (times -0.4 (car d0))))
189 :     `((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0))))
190 :     (bezier .,
191 :     (plus2 p2
192 :     (times2 (plus 0.4 sintheta)(diff2 p1 p3))
193 :     (times2 0.3 (diff2 p3 p2))))
194 :     (bezier .,
195 :     (plus2 p3
196 :     (times2 (plus 0.6 sintheta)(diff2 p1 p3))
197 :     (times2 0.2 (diff2 p2 p3))))
198 :     (angle .,
199 :     (plus2 p3 (times2 (plus 0.9 sintheta)(diff2 p1 p3)))))))
200 :     ;
201 :     (defkazari mincho (shin-nyuu 2 shin-nyuu 3)
202 :     (lets ((p0 (vref cross 0))
203 :     (p1 (vref cross 1))
204 :     (p2 (vref cross 2))
205 :     (p3 (vref cross 3))
206 :     (len (metric2 p0 p1)))
207 :     `((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0))))
208 :     (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0))))
209 :     (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0))))
210 :     (angle .,(plus2 p1 (times2 0.7 (diff2 p1 p3)))))))
211 :     ;
212 :     (defkazari mincho ((tate magaritate kagi)2 (tate magaritate kagi) 3)
213 :     (lets ((p0 (vref cross 0))
214 :     (p1 (vref cross 1))
215 :     (p2 (vref cross 2))
216 :     (p3 (vref cross 3))
217 :     (p4 (times2 0.5 (plus2 p0 p1)))
218 :     (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1))))
219 :     (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0)))))
220 :     `((angle .,p6)
221 :     (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6))))
222 :     (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4))))
223 :     (angle .,p4)
224 :     (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4))))
225 :     (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5))))
226 :     (angle .,p5))))
227 :     ;
228 :     ;(defkazari mincho (ten 2 ten 3)
229 :     ; (lets ((p0 (vref cross 0))
230 :     ; (p1 (vref cross 1))
231 :     ; (p2 (vref cross 2))
232 :     ; (p3 (vref cross 3))
233 :     ; (p4 (times2 0.5 (plus2 p0 p1)))
234 :     ; (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1))))
235 :     ; (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0)))))
236 :     ; `((angle .,p6)
237 :     ; (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6))))
238 :     ; (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4))))
239 :     ; (angle .,p4)
240 :     ; (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4))))
241 :     ; (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5))))
242 :     ; (angle .,p5))))
243 :     ;
244 :     (defkazari mincho ((tate magaritate) 2 yoko 0)
245 :     (lets ((p0 (vref cross 0))
246 :     (p1 (vref cross 1))
247 :     (p2 (vref cross 2))
248 :     (p3 (vref cross 3))
249 :     (len (metric2 p0 p2))
250 :     (p4 (plus2 p0 (normlen2 len (diff2 p0 p1))))
251 :     (p5 (plus2 p2 (normlen2 len (diff2 p2 p3)))))
252 :     `((angle .,(inter2 p0 p1 0.1))
253 :     (bezier .,p4)
254 :     (bezier .,p5)
255 :     (angle .,p2) )))
256 :     ;
257 :     (defkazari mincho ((tate magaritate) 3 yoko 2)
258 :     (lets ((p0 (vref cross 0))
259 :     (p1 (vref cross 1))
260 :     (p2 (vref cross 2))
261 :     (p3 (vref cross 3))
262 :     (len (metric2 p0 p2))
263 :     (p4 (plus2 p0 (normlen2 len (diff2 p0 p1))))
264 :     (p5 (plus2 p2 (normlen2 len (diff2 p2 p3)))))
265 :     `((angle .,(inter2 p2 p3 0.1))
266 :     (bezier .,p5)
267 :     (bezier .,p4)
268 :     (angle .,p0))))
269 :     ;
270 :     (comment
271 :     (defkazari mincho (kozato 2 kozato 3)
272 :     (lets ((p0 (vref cross 0))
273 :     (p1 (vref cross 1))
274 :     (p2 (vref cross 2))
275 :     (p3 (vref cross 3))
276 :     (p4 (plus2 p0 (diff2 p0 p1)))
277 :     (p5 (plus2 (times2 0.5 (plus2 p0 p1)) (times2 0.1 (diff2 p1 p3))))
278 :     (p6 (plus2 p0 (times2 0.5 (diff2 p2 p0))))
279 :     (p7 (plus2 (times2 0.5 (plus2 p4 p0)) (times2 0.1 (diff2 p3 p1)))))
280 :     `((angle .,p2)
281 :     (bezier .,p6)
282 :     (bezier .,p6)
283 :     (angle .,p4)
284 :     (bezier .,p7)
285 :     (bezier .,p7)
286 :     (angle .,p0)
287 :     (bezier .,p5)
288 :     (bezier .,p1)
289 :     (angle .,p3))))
290 :     )
291 :     ;
292 :     (defkazari mincho ((migi tate hidari tatehidari kokoro magaritate tasuki) 0
293 :     yoko 1)
294 :     (lets ((w (times mw kazariheight))
295 :     (p0 (vref cross 0))
296 :     (p1 (vref cross 1))
297 :     (p2 (vref cross 2))
298 :     (p3 (vref cross 3))
299 :     (len (metric2 p3 p1))
300 :     (len1 (max len (times 2 w))))
301 :     `((angle .,(plus2 p1 (normlen2 w (diff2 p1 p0))))
302 :     (angle .,(plus2 p1 (normlen2 len1 (diff2 p3 p1)))))))
303 :     ;
304 :     (defkazari mincho ((tate hidari tatehidari) 0 hidari 2)
305 :     (lets ((minchoheight (times mw kazariheight)))
306 :     `((angle .,(plus2 (vref cross 1)
307 :     (normlen2
308 :     minchoheight
309 :     (diff2 (vref cross 1)(vref cross 0)))))
310 :     (angle .,(vref cross 2)))))
311 :    
312 :     (defkazari mincho ((tate hidari tatehane kokoro tsukurihane magaritate tasuki migi) 1 yoko 3)
313 :     (lets ((p0 (vref cross 0))
314 :     (p1 (vref cross 1))
315 :     (p2 (vref cross 2))
316 :     (p3 (vref cross 3))
317 :     (d1 (diff2 p1 p3))
318 :     (d0 (rot90 d1))
319 :     ; added by tanaka 1993/3/1
320 :     (p3 (cond ((plusp (mul2 d1 (diff2 p2 p3)))
321 :     p3)
322 :     (t (cross2 p1 p2 (diff2 p3 p1) (rot270 d1)))))
323 :     (p1 (plus2 p3 d1))
324 :     (w0 (times mw 1.333 tatekazari))
325 :     (w1 (times mw kazariheight))
326 :     (const1 (quotient (times w0 0.4) w1))
327 :     (p7 p1)
328 :     (p6 (plus2 p7 (normlen2 (times w1 -0.7) d1)
329 :     (normlen2 (times -1.0 w1) d0)))
330 :     (p8 (cross2 p6 p2
331 :     (plus2 (normlen2 1.0 d0)(normlen2 -1.3 d1))
332 :     (diff2 p3 p2)))
333 :     (p9 (plus2 p3 (normlen2 (times -0.3 w0) d0)))
334 :     (p4)(p5)(w2))
335 :     (cond ((plusp (mul2 (diff2 p3 p2)(diff2 p8 p9)))
336 :     (setq p8 p9)
337 :     (setq w2 (difference w1 (times 0.3 w0)))
338 :     (setq p6 (plus2 p8 (normlen2 (times w2 -1.0) d0)
339 :     (normlen2 (times w2 1.3) d1)))
340 :     (setq p7 (plus2 p6 (normlen2 (times w1 1.0) d0)
341 :     (normlen2 (times 0.7 w1) d1)))))
342 :     (setq p4 (plus2 p8 (normlen2 (times 1.0 w0) (diff2 p2 p3))))
343 :     (setq p5 (cross2 p8 p4 (diff2 p8 p6)
344 :     (rot (diff2 p8 p6)
345 :     (max (degree 50)
346 :     (difference (theta (diff2 p3 p2)(diff2 p8 p6))
347 :     (degree 70))))))
348 :     ; (break)
349 :     (setq p8 (inter2 p5 p6
350 :     (min 0.9 (quotient (metric2 p5 p4)(metric2 p5 p8)))))
351 :     `((angle .,p4)
352 :     (bezier .,(inter2 p4 p5 0.9))
353 :     (bezier .,(inter2 p8 p5 0.9))
354 :     ; (angle .,p5)
355 :     (angle .,p8)
356 :     (angle .,p6)
357 :     (angle .,p7))))
358 :    
359 :    
360 :    
361 :     ;
362 :     ;
363 :     ; 点の定義
364 :     ;
365 :     (defelement mincho ten
366 :     (lets ((dotsize (meshwidth mw))
367 :     (w (times meshsize 0.5 dotsize))
368 :     (p0 (grid (car points) dotsize))
369 :     (p1 (grid (cadr points) dotsize))
370 :     (len (metric2 p0 p1)))
371 :     (mincho1
372 :     p0
373 :     p1
374 :     '((80 171 136 255)
375 :     ((angle 80 171)(bezier 119 214)(bezier 104 256)(angle 136 255))
376 :     ((angle 80 171)(bezier 155 204)(bezier 173 251)(angle 136 255)))
377 :     (cond ((lessp (times 3.0 w) len)
378 :     (quotient w 20.0))
379 :     (t (quotient len 60.0))))))
380 :     ;
381 :     ; 縦棒の定義
382 :     ;
383 :     (defelement mincho tate
384 :     (lets ((dotsize (meshwidth mw))
385 :     (p0 (gridx (car points) dotsize))
386 :     (p1 (gridx (cadr points) dotsize))
387 :     (w (min (normwidth dotsize)(times 0.35 (metric2 p0 p1))))
388 :     )
389 :     ; (print `(tate ,dotsize))
390 :     (cond ((lessp (times 0.08 w) meshsize)
391 :     (line2 p0 p1 w))
392 :     (t
393 :     (niku2 p0 p1 0.4 0.4 w (times w 0.92)(times w 0.92) w)))))
394 :     ;
395 :     ; 横棒の定義
396 :     ;
397 :     (defelement mincho yoko
398 :     (lets ((dotsize (meshwidth (times mw tateyokoratio)))
399 :     (w (normwidth dotsize))
400 :     (p0 (gridy (car points) dotsize))
401 :     (p1 (gridy (cadr points) dotsize)))
402 :     (line2 p0 p1 w)))
403 :     ;
404 :     ; 右上はらいの定義
405 :     ;
406 :     (defelement mincho migiue
407 :     (lets ((dotsize (meshwidth mw))
408 :     (w0 (normwidth dotsize))
409 :     ; (w1 (normwidth 1))
410 :     (w1 0)
411 :     (p0 (gridy (car points) dotsize))
412 :     (p1 (gridy (cadr points) dotsize))
413 :     (p2 (gridy (caddr points) 1)))
414 :     (niku3 p0 p1 p2 0.3 0.3 w0 (inter w0 w1 0.3)(inter w0 w1 0.7) w1)))
415 :     ;
416 :     ; 右はらいの定義
417 :     ;
418 :     (defelement mincho migi
419 :     (lets ((dotsize0 (meshwidth (times mw 0.5)))
420 :     (w0 (normwidth dotsize0))
421 :     (dotsize1 (meshwidth (times mw 1.2)))
422 :     (w1 (normwidth dotsize1))
423 :     (p0 (grid (car points) dotsize0))
424 :     (p1 (cadr points))
425 :     (p2 (grid (caddr points) dotsize1)))
426 :     (niku3 p0 p1 p2 0.3 0.3
427 :     w0 (inter w0 w1 0.25)(inter w0 w1 0.75) w1)))
428 :     ;
429 :     ;しんにょう
430 :     ;
431 :     (defelement mincho shin-nyuu
432 :     (lets
433 :     ((dotsize0 (meshwidth (times mw 0.2)))
434 :     (w0 (normwidth dotsize0))
435 :     (dotsize1 (meshwidth (times mw 1.2)))
436 :     (w1 (normwidth dotsize1))
437 :     (p0 (grid (car points) dotsize0))
438 :     (p1 (cadr points))
439 :     (p2 (grid (caddr points) dotsize1))
440 :     (len0 (metric2 p0 p1))
441 :     (len1 (metric2 p1 p2))
442 :     (len (plus len0 len1)))
443 :     (curve2 p0 (inter2 p0 p1 0.5)(inter2 p2 p1 0.9) p2
444 :     w0 (inter w0 w1 0.2) (inter w0 w1 0.9) w1)))
445 :     ;
446 :     ; まがりたて
447 :     ;
448 :     (defelement mincho magaritate
449 :     (lets ((dotsize (meshwidth mw))
450 :     (w0 (normwidth dotsize))
451 :     (w1 (times w0 0.9))
452 :     (p0 (grid (car points) dotsize))
453 :     (p1 (cadr points))
454 :     (p2 (grid (caddr points) dotsize)))
455 :     (curve2 p0 (inter2 p0 p1 0.7)(inter2 p2 p1 0.7) p2 w0 w1 w1 w0)))
456 :     ;
457 :     ; かぎ
458 :     ;
459 :     (defelement mincho kagi
460 :     (lets ((dotsize0 (meshwidth mw))
461 :     (w0 (normwidth dotsize0))
462 :     (dotsize1 (meshwidth (times 1.0 mw)))
463 :     (w1 (normwidth dotsize1))
464 :     (p0 (gridx (car points) dotsize0))
465 :     (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points)))))
466 :     (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0))
467 :     (p2 (gridy (plus2 (caddr points) l0) dotsize1))
468 :     (len0 (metric2 p0 p1))
469 :     (len1 (metric2 p1 p2))
470 :     (rate0 (min 0.9 (//$ (times w0 4.0) len0)))
471 :     (rate1 (min 0.9 (//$ (times w1 4.0) len1)))
472 :     (p01 (inter2 p1 p0 rate0))
473 :     (p12 (inter2 p1 p2 rate1)))
474 :     (line2 p0 p01 w0
475 :     (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p12 0.1) p12 w0 w0 w1 w1
476 :     (cond ((greaterp (metric2 p12 p2) w0)
477 :     (line2 p12 p2 w1))
478 :     (t `(nil nil)))))))
479 :     ; 縦左はらいの定義
480 :     (defelement mincho tatehidari
481 :     (lets ((dotsize (meshwidth mw))
482 :     (w (normwidth dotsize))
483 :     (p0 (grid (car points) dotsize))
484 :     (p1 (grid (cadr points) dotsize))
485 :     (p2 (grid (caddr points) dotsize))
486 :     (p3 (grid (cadddr points) dotsize))
487 :     (l0 (normlen2 w (rot90 (diff2 p0 p1))))
488 :     (w1 (//$ w (float (costheta l0 (diff2 p3 p2)))))
489 :     (l1 (plus2 (normlen2 w1 (diff2 p3 p2))
490 :     (normlen2 w1 (diff2 p1 p2)))))
491 :     `(((angle .,(plus2 p0 l0))
492 :     (angle .,(plus2 p1 l0))
493 :     (bezier .,(plus2 (inter2 p1 p2 0.5) l0))
494 :     (bezier .,(plus2 p2 l1))
495 :     (angle .,p3))
496 :     ((angle .,(diff2 p0 l0))
497 :     (angle .,(diff2 p1 l0))
498 :     (bezier .,(diff2 (inter2 p1 p2 0.5) l0))
499 :     (bezier .,(diff2 p2 l1))
500 :     (angle .,p3)))))
501 :     ; こころ
502 :     (defelement mincho kokoro
503 :     (lets ((dotsize0 (meshwidth mw))
504 :     (dotsize1 (meshwidth (times 1.0 mw)))
505 :     (w0 (normwidth dotsize0))
506 :     (w1 (normwidth dotsize1))
507 :     (p0 (gridx (car points) dotsize0))
508 :     (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points)))))
509 :     (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0))
510 :     (p2 (gridy (plus2 (caddr points) l0) dotsize1))
511 :     (p3 (fourth points))
512 :     (w0 (min w0 (times 0.35 (metric2 p1 p2))))
513 :     (w1 (min w1 (times 0.35 (metric2 p1 p2))))
514 :     (w0 (min w0 (times 0.35 (metric2 p0 p1))))
515 :     (w1 (min w1 (times 0.35 (metric2 p0 p1))))
516 :     (p3 (plus2 p2
517 :     (normlen2 (min (metric2 p0 p1)
518 :     (max (metric2 p3 p2)(times w1 5.0)))
519 :     (diff2 p3 p2))))
520 :     (p3 (gridx p3 dotsize1))
521 :     (p23 (inter2 p2 p3 0.1))
522 :     (p12 (inter2 p1 p2 0.5))
523 :     (len0 (metric2 p0 p1))
524 :     (len1 (metric2 p1 p12))
525 :     (rate0 (min 0.9 (//$ (times w0 4.0) len0)))
526 :     (rate1 (min 0.9 (//$ (times w1 4.0) len1)))
527 :     (p01 (inter2 p1 p0 rate0))
528 :     (p4 (inter2 p1 p12 rate1))
529 :     (p5 (inter2 p12 p2 0.5))
530 :     (w2 (times w1 0.8))
531 :     (w3 (min (times w1 3.0)(plus w2 (times (metric2 p2 p3) 0.2))))
532 :     )
533 :     ; (prind w0)
534 :     (cond ((lessp len0 (times 6.0 w0))
535 :     ; (prind 'less)
536 :     (curve2 p0 (inter2 p1 p0 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1
537 :     (line2 p4 p12 w1
538 :     (kokorohane p12 p5 p23 p3 w1 w2 w3))))
539 :     (t
540 :     (line2 p0 p01 w0
541 :     (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1
542 :     (line2 p4 p12 w1
543 :     (kokorohane p12 p5 p23 p3 w1 w2 w3))))))))
544 :     ;
545 :     (defun kokorohane (p0 p1 p2 p3 w0 w1 w2)
546 :     (lets ((d0 (diff2 p1 p0))
547 :     (d1 (diff2 p2 p1))
548 :     (a4 (plus2 p2 (normlen2 w2 d1)))
549 :     (l0 (normlen2 w0 (rot270 d0)))
550 :     (l1 (normlen2 w0 (rot270 d1)))
551 :     (h0 (diff2 p2 (normlen2 w1 d1)))
552 :     (h1 (plus2 p2 (normlen2 w1 d1)))
553 :     (a0 (plus2 p0 l0))
554 :     (a3 (plus2 a4 l1))
555 :     (a1 (cross2 a0 a3 d0 d1))
556 :     (b0 (diff2 p0 l0))
557 :     (b1 (cross2 b0 (diff2 a4 l1) d0 d1))
558 :     (b2 (cross2 b1 p3 d1 (diff2 h0 p3)))
559 :     (b3 (diff2 b2 (normlen2 w0 d1)))
560 :     (bez0 (newbez b3 (plus2 b3 l1)
561 :     b0
562 :     (inter2 b0 b1 0.7)
563 :     (inter2 (diff2 a4 l1) b1 0.7)
564 :     (diff2 a4 l1)))
565 :     (b3 (fourth bez0))
566 :     (b2 (cross2 b3 p3 (diff2 (third bez0) b3) (diff2 h0 p3)))
567 :     (a2 (plus2 a3 (normlen2 (times -1.0 w2) d1)))
568 :     (a5 (cross2 (diff2 a4 l1) p3 d1 (diff2 h1 p3)))
569 :     (a7 (diff2 (diff2 a4 l1)
570 :     (normlen2 (min w0 (times 0.6 (metric2 a5 (diff2 a4 l1))))
571 :     d1)))
572 :     (a8 (plus2 h1 (normlen2 (min (times 1.5 w0)(metric2 h1 p3)) (diff2 p3 h1))))
573 :     (a9 (cross2 a8 a4 (diff2 a7 a8) l1))
574 :     (a9 (cond ((lessp (metric2 a4 a7)(metric2 a7 a9))(inter2 a4 a7 0.5))
575 :     (t a7)))
576 :     (a4 (inter2 a3 a4 0.8))
577 :     )
578 :     ; (print `((b3 ,b3) (b2 ,b2)))
579 :     `(((angle .,a0)
580 :     (bezier .,(inter2 a0 a1 0.7))
581 :     (bezier .,(inter2 a2 a1 0.7))
582 :     (angle .,a2)
583 :     (bezier .,(inter2 a2 a3 0.666666))
584 :     (bezier .,(inter2 a4 a3 0.666666))
585 :     (angle .,a4)
586 :     (bezier .,(inter2 a4 a9 0.66666))
587 :     (bezier .,(inter2 a7 a9 0.66666))
588 :     (angle .,a7)
589 :     (bezier .,(inter2 a7 a8 0.66666))
590 :     (bezier .,(inter2 p3 a8 0.66666))
591 :     (angle .,p3))
592 :     ((angle .,b0)
593 :     (bezier .,(second bez0))
594 :     (bezier .,(third bez0))
595 :     (angle .,b3)
596 :     (bezier .,(inter2 b3 b2 0.9))
597 :     (bezier .,(inter2 p3 b2 0.9))
598 :     (angle .,p3)))))
599 :     ; たすき
600 :     (defelement mincho tasuki
601 :     (lets ((dotsize0 (meshwidth mw))
602 :     (w0 (normwidth dotsize0))
603 :     (p0 (gridx (car points) dotsize0))
604 :     (l0 (normlen2 w0 (rot90 (diff2 (caddr points)(cadr points)))))
605 :     (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize0) dotsize0))
606 :     (p2 (gridy (plus2 (caddr points) l0) dotsize0))
607 :     (p3 (fourth points))
608 :     (p3 (cond ((lessp (metric2 p3 p2)(times w0 2.5))
609 :     (plus2 p2 (normlen2 (times w0 2.5)(diff2 p3 p2))))
610 :     (t p3)))
611 :     (p3 (gridx p3 dotsize0))
612 :     (w2 (times w0 0.8))
613 :     (w3 (min (times w0 3.0)(plus w2 (times (metric2 p2 p3) 0.2))))
614 :     (p2 (plus2 p2 (normlen2 w3 (diff2 p1 p2))))
615 :     (p01 (inter2 p0 p1 0.6))
616 :     (p12 (inter2 p2 p1 0.6))
617 :     (p4 (inter2 p01 p12 0.5))
618 :     )
619 :     (kokorohane p0 p1 p2 p3 w0 w2 w3)))
620 :     ; (curve2 p0 (inter2 p0 p01 0.99) (inter2 p4 p01 0.7) p4 w0 w0 w0 w0
621 :     ; (kokorohane p4 p12 p2 p3 w0 w2 w3))))
622 :     ; 縦跳ね
623 :     (defelement mincho tatehane
624 :     (lets ((dotsize (meshwidth mw))
625 :     (w (normwidth dotsize))
626 :     (p0 (gridx (car points) dotsize))
627 :     (p1 (cadr points))
628 :     (p1 (gridx (plus2 p1 (normlen2 w (diff2 p0 p1))) dotsize))
629 :     (p2 (caddr points))
630 :     (p2 (grid (plus2 p2 (normlen2 w (diff2 p0 p1))) dotsize))
631 :     (p2 (plus2 p1 (normlen2 (max (metric2 p2 p1)(times w 1.8))
632 :     (diff2 p2 p1))))
633 :     (len0 (max (times 2.0 w)
634 :     (min (times 0.5 (metric2 p0 p1))
635 :     (times 0.5 (metric2 p1 p2)))))
636 :     (p01 (plus2 p1 (normlen2 len0 (diff2 p0 p1))))
637 :     (w1 (min (times w 1.4)
638 :     (plus w (times (metric2 p1 p2) 0.1))))
639 :     (w2 (min (times 0.8 (metric2 p2 p1))(times w 5.0)))
640 :     )
641 :     ; (break)
642 :     (line2 p0 p01 w
643 :     (hane p01 p1 p2 w w1 w2))))
644 :     (defun hane (p0 p1 p2 w0 w1 w2)
645 :     (lets ((d0 (diff2 p1 p0))
646 :     (d1 (diff2 p2 p1))
647 :     (l0 (normlen2 w0 (rot270 d0)))
648 :     (l1 (normlen2 w0 (rot270 d1)))
649 :     (a0 (plus2 p0 l0))
650 :     (a2 (plus2 p2 (normlen2 w1 l1)))
651 :     (d2 (diff2 a2 (plus2 l1 (diff2 p1 l0))))
652 :     (a1 (cross2 a0 a2 d0 d2))
653 :     (a3 (plus2 a2 (normlen2 w2 d2)))
654 :     (a4 (plus2 a1 (normlen2 (min (times 0.9 (metric2 a3 a1))
655 :     (times 1.5 (metric2 a1 a0)))
656 :     (diff2 a3 a1))))
657 :     (b0 (diff2 p0 l0))
658 :     (b1 (diff2 (diff2 p1 l0) l1))
659 :     (b2 (diff2 p2 (normlen2 w1 l1)))
660 :     (b4 (plus2 b1 (normlen2 (min (metric2 b2 b1)
661 :     (times 1.5 (metric2 b0 b1)))
662 :     (diff2 b2 b1))))
663 :     (t0 (plus2 a2 (normlen2 w0 d2)))
664 :     (t1 (diff2 p2 (normlen2 (times w1 -0.2) l1)))
665 :     (b3 (cross2 a3 b2 (diff2 t1 a3)(diff2 t0 b2)))
666 :     (b3 (cond ((lessp (metric2 a3 b3) 1.0)
667 :     (inter2 b2 a3 0.5))
668 :     (t b3)))
669 :     )
670 :     `(((angle .,a0)
671 :     (bezier .,(inter2 a0 a1 0.66666))
672 :     (bezier .,(inter2 a4 a1 0.66666))
673 :     (angle .,a4)
674 :     ; (angle .,a3)
675 :     )
676 :     ((angle .,b0)
677 :     (bezier .,(inter2 b0 b1 0.66666))
678 :     (bezier .,(inter2 b4 b1 0.66666))
679 :     (angle .,b4)
680 :     (angle .,b2)
681 :     (bezier .,(inter2 b2 b3 0.66666))
682 :     (bezier .,(inter2 a3 b3 0.66666))
683 :     (angle .,a3)))))
684 :     ; 旁の跳ね
685 :     (defelement mincho tsukurihane
686 :     (lets ((dotsize (meshwidth mw))
687 :     (w (normwidth dotsize))
688 :     (p0 (gridx (car points) dotsize))
689 :     (p1 (gridx (cadr points) dotsize))
690 :     (p2 (caddr points))
691 :     (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize))
692 :     (p3 (cadddr points))
693 :     (p3 (cond ((lessp (metric2 p2 p3)(times 2.5 w))
694 :     (plus2 p2 (normlen2 (times 2.5 w) (diff2 p3 p2))))
695 :     (t p3)))
696 :     (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize))
697 :     (l0 (normlen2 w (rot270 (diff2 p1 p0))))
698 :     (l1 (normlen2 w (rot270 (diff2 p1 p0))))
699 :     (l2 (normlen2 w (rot270 (diff2 p1 p0))))
700 :     (a0 (plus2 p0 l0))
701 :     (a1 (cross2 a0 (plus2 p2 l1)(diff2 p1 p0)(diff2 p2 p1)))
702 :     (a2 (cross2 (plus2 p2 l1)(plus2 p3 l2)(diff2 p2 p1)(diff2 p3 p2)))
703 :     (a3 (cross2 a0(plus2 p3 l2)(diff2 p1 p0)(diff2 p3 p2)))
704 :     (len0 (min (times 2.0 w)
705 :     (min (times 0.5 (metric2 p1 p2))
706 :     (times 0.5 (metric2 p2 p3)))))
707 :     (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2))))
708 :     (w1 (min (times w 1.4)
709 :     (plus w (times (metric2 p2 p3) 0.1))))
710 :     (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0))))
711 :     ; (prind `(,p0 ,p1 ,p12 ,p2 ,p3 ,a0 ,a1 ,a2 ,a3))
712 :     (cond ((zerop (sintheta (diff2 p1 p0)(diff2 p2 p0)))
713 :     (line2 p0 p12 w
714 :     (hane p12 p2 p3 w w1 w2)))
715 :     ((greaterp (metric2 a0 a3)(metric2 a0 a1))
716 :     (setq p12
717 :     (diff2 (plus2 a2 (normlen2 (min (times 0.5 (metric2 a1 a2))
718 :     (times 1.5 w))
719 :     (diff2 a1 a2)))
720 :     l1))
721 :     ; (prind p12)
722 :     (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12 w w w w
723 :     (hane p12 p2 p3 w w1 w2)))
724 :     (t
725 :     (setq p12 (cross2 p0 p3 (diff2 p1 p0)(diff2 p2 p3)))
726 :     (hane p0 p12 p3 w w1 w2)))))
727 :     ; こざと偏の一部
728 :     (defelement mincho kozato
729 :     (lets ((dotsize (meshwidth mw))
730 :     (w (normwidth dotsize))
731 :     (p0 (gridx (car points) dotsize))
732 :     (p1 (gridx (cadr points) dotsize))
733 :     (p2 (caddr points))
734 :     (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize))
735 :     (p3 (cadddr points))
736 :     (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize))
737 :     (len0 (max (times 2.0 w)
738 :     (times 0.5 (metric2 p1 p2))))
739 :     (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2))))
740 :     (w1 (min (times w 1.4)
741 :     (plus w (times (metric2 p2 p3) 0.1))))
742 :     (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0))))
743 :     (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12
744 :     (times 0.2 w)
745 :     (times 0.7 w)
746 :     w w
747 :     (hane p12 p2 p3 w w1 w2))))
748 :     ; さんずい
749 :     (defelement mincho sanzui
750 :     (lets ((dotsize (meshwidth mw))
751 :     (w (normwidth dotsize))
752 :     (p0 (car points))
753 :     (p1 (cadr points))
754 :     (v (diff2 p1 p0))
755 :     (vx (car v))
756 :     (vy (cadr v))
757 :     (p0 (plus2 p0 `(,(times -0.8 (difference vx 34.0)) 0)))
758 :     (p2 (plus2 p0 `(,(times 0.03 vy) ,(times 0.3 vy))))
759 :     (p3 (plus2 p2 `(,(times 0.16 vy) ,(times 0.08 vy))))
760 :     (p0 (grid p0 dotsize))
761 :     (p1 (grid p1 1))
762 :     (p3 (grid p3 1))
763 :     (d0 (diff2 p2 p0))
764 :     (d1 (diff2 p1 p2))
765 :     (l0 (rot270 d0))
766 :     (w1 (times w (//$ 1.0 (sintheta d0 d1))))
767 :     ; (w1 w)
768 :     (t0 (plus2 p2 (normlen2 w1 d0)))
769 :     (t1 (diff2 p2 (normlen2 w1 d0)))
770 :     (w2 (times 0.6 w (//$ -1.0 (sintheta d0 (diff2 p3 p2)))))
771 :     ; (w2 w)
772 :     (t2 (plus2 p2 (normlen2 w2 d0)))
773 :     (t3 (diff2 p2 (normlen2 w2 d0)))
774 :     (b4 (cross2 p3 p1 (diff2 t2 p3)(diff2 t0 p1)))
775 :     (b4 (plus2 t2 (normlen2 (min (times 0.9 (metric2 t2 p3))
776 :     (metric2 b4 t2))
777 :     (diff2 p3 t2))))
778 :     (a0 (plus2 p0 (normlen2 (times 1.5 w) l0)))
779 :     (a2 (cross2 a0 p1
780 :     (diff2 (plus2 p2 (normlen2 (times w 0.5) l0)) a0)
781 :     (diff2 t1 p1)))
782 :     (b0 (diff2 p0 (normlen2 (times 1.5 w) l0)))
783 :     (b2 (cross2 b0 p3
784 :     (diff2 (plus2 p2 (normlen2 (times w -0.5) l0)) b0)
785 :     (diff2 t3 p3)))
786 :     (b1 (inter2 b0 b2 0.5))
787 :     (a1 (inter2 a0 a2 0.5))
788 :     (a3 (plus2 a2 (normlen2 (min (times 1.5 (metric2 a1 a2))
789 :     (times 0.9 (metric2 p1 a2)))
790 :     (diff2 p1 a2))))
791 :     (b5 (plus2 b4 (normlen2 (min (times 1.5 (metric2 p3 b4))
792 :     (times 0.9 (metric2 p1 b4)))
793 :     (diff2 p1 b4)))))
794 :     ; (break)
795 :     `(((angle .,p0)
796 :     (bezier .,(inter2 p0 a0 0.66666))
797 :     (bezier .,(inter2 a1 a0 0.66666))
798 :     (angle .,a1)
799 :     (bezier .,(inter2 a1 a2 0.9))
800 :     (bezier .,(inter2 a3 a2 0.9))
801 :     (angle .,a3)
802 :     (angle .,p1))
803 :     ((angle .,p0)
804 :     (bezier .,(inter2 p0 b0 0.66666))
805 :     (bezier .,(inter2 b1 b0 0.66666))
806 :     (angle .,b1)
807 :     (bezier .,(inter2 b1 b2 0.66666))
808 :     (bezier .,(inter2 p3 b2 1.0))
809 :     (angle .,p3)
810 :     (bezier .,(inter2 p3 b4 1.0))
811 :     (bezier .,(inter2 b5 b4 0.66666))
812 :     (angle .,b5)
813 :     (angle .,p1)))))
814 :    
815 :     ; 左はらいの定義
816 :     (defelement mincho hidari
817 :     (lets ((dotsize (meshwidth mw))
818 :     (w (normwidth dotsize))
819 :     (p0 (grid (car points) dotsize))
820 :     (p1 (grid (cadr points) dotsize))
821 :     (p2 (grid (caddr points) 1))
822 :     (w (min w (times 0.35 (metric2 p0 p2))))
823 :     (d0 (diff2 p1 p0))
824 :     (d1 (diff2 p2 p1))
825 :     (l0 (rot270 d0))
826 :     (l1 (rot270 d1))
827 :     (len0 (metric2 p0 p1))
828 :     (rate (//$ len0 (plus (metric2 p1 p2) len0)))
829 :     (theta (theta d0 d1))
830 :     (w1 (inter (times rate w) w
831 :     (min 1.0 (times theta 0.7))))
832 :     (rate0 (max 0.666666
833 :     (plus 1.0 (times 0.5
834 :     (difference 1.0 (quotient 1.0 rate))))))
835 :     (a0 (plus2 p0 (normlen2 w l0)))
836 :     (w2 (times 0.1 mw))
837 :     (a2 (plus2 p2 (normlen2 w2 l0)))
838 :     (a1 (cross2 a0 a2
839 :     (diff2 (plus2 p1 (normlen2 w1 l0)) a0)
840 :     (diff2 (plus2 p1 (normlen2 w1 l1)) a2)))
841 :     (a1 (cond ((or (greaterp (metric2 a0 a1)(metric2 a0 p2))
842 :     (greaterp (metric2 a1 p2)(metric2 a0 p2)))
843 :     (inter2 a0 p2 0.5))
844 :     (t a1)))
845 :     (b0 (diff2 p0 (normlen2 w l0)))
846 :     (b2 (diff2 p2 (normlen2 w2 l0)))
847 :     (b1 (cross2 b0 b2
848 :     (diff2 (diff2 p1 (normlen2 w1 l0)) b0)
849 :     (diff2 (diff2 p1 (normlen2 w1 l1)) b2))))
850 :     ; (break)
851 :     `(((angle .,a0)
852 :     (bezier .,(inter2 a0 a1 rate0))
853 :     (bezier .,(inter2 p2 a1 0.9))
854 :     (angle .,a2))
855 :     ((angle .,b0)
856 :     (bezier .,(inter2 b0 b1 rate0))
857 :     (bezier .,(inter2 p2 b1 0.8))
858 :     (angle .,b2)))))
859 :     ;
860 :     (defun last-joint (prim)
861 :     (lets ((elements (cadr prim))
862 :     (lastpoints))
863 :     (do ((l elements (cdr l)))
864 :     ((atom l))
865 :     (or (and (memq (caar l) '(hidari tatehidari migiue))
866 :     (push (car (last (cadar l))) lastpoints))
867 :     (and (memq (caar l) '(ten migi))
868 :     ; (print (car (cadar l)))
869 :     (push (car (cadar l)) lastpoints))))
870 :     (do ((l elements (cdr l))(newelements)(link))
871 :     ((atom l) `(,(car prim),(nreverse newelements).,(cddr prim)))
872 :     (cond ((setq link (assq 'link (cddar l)))
873 :     (do ((ll (cdr link)(cdr ll))(ret))
874 :     ((atom ll)
875 :     (push `(,(caar l),(cadar l)
876 :     (link .,(nreverse ret)).,(cddar l))
877 :     newelements))
878 :     (or (memq (car ll) lastpoints)(push (car ll) ret))))
879 :     (t
880 :     (push (car l) newelements))))))
881 :     ;
882 :     (defun mincho-prim (prim)
883 :     ; (prind 'hook)
884 :     (lets ((prim (rm-geta prim (times minchowidth 2.0)))
885 :     (prim (last-joint prim))
886 :     (points (car prim))
887 :     (elements (cadr prim))
888 :     (alist (cddr prim))
889 :     (units (units
890 :     `(,points ,elements
891 :     .,(every alist
892 :     #'(lambda (x)
893 :     (not (memq (car x)
894 :     '(xunit yunit))))))))
895 :     (xunit (car units))
896 :     (yunit (cdr units))
897 :     (tome (times minchowidth tomeheight))
898 :     (points-alist)
899 :     (ylen)
900 :     (minylen)
901 :     )
902 : ktanaka 1.4 (do ((l elements (cdr l))(element)(link))
903 : ktanaka 1.1 ((atom l))
904 :     (setq element (car l))
905 :     (do ((ll (cadr element)(cdr ll))(ass))
906 :     ((atom ll))
907 :     (setq ass (assq (car ll) points-alist))
908 :     (cond (ass (rplacd ass (add1 (cdr ass))))
909 :     (t (push `(,(car ll) . 1)points-alist ))))
910 :     (setq link (assq 'link (cddr element)))
911 :     (and link
912 :     (do ((ll (cdr link)(cdr ll))(ass))
913 :     ((atom ll))
914 :     (setq ass (assq (car ll) points-alist))
915 :     (cond (ass (rplacd ass (add1 (cdr ass))))
916 :     (t (push `(,(car ll) . 1)points-alist))))))
917 :     (do ((l elements (cdr l))(element)(p0)(p1)(ylen))
918 :     ((atom l))
919 :     (setq element (car l))
920 :     (cond ((eq (car element) 'yoko)
921 :     (setq p0 (nth (car (cadr element)) points))
922 :     (setq p1 (nth (cadr (cadr element)) points))
923 :     (setq ylen (metric2 p0 p1))
924 :     (cond ((and
925 :     (eq 1 (cdr (assq (cadr (cadr element)) points-alist)))
926 :     (or (null minylen)(lessp ylen minylen)))
927 :     (setq minylen ylen))))))
928 :     (cond ((null minylen)
929 :     (setq tome1 (min tome (times yunit 0.8))))
930 :     (t
931 :     (setq tome1 (min tome (times yunit 0.8)(quotient minylen 4.0)))))
932 :     ; (print `(,tome1 ,tome ,yunit ,minylen))
933 :     (setq mw (min minchowidth (times xunit 0.25)))
934 :     ; (setq mw minchowidth)
935 :     prim))
936 :     ;
937 :     (deftypehook mincho
938 :     (function mincho-prim))
939 :     ;
940 :     (def-type1-hint mincho tate
941 :     (lets ((p0 (car points))
942 :     (p1 (cadr points))
943 :     (x (car p0))
944 :     (w mw))
945 :     (cond ((equal x (car p1))
946 :     `((v ,(difference x w).,(plus x w)))))))
947 :     (comment
948 :     (defelement mincho yoko
949 :     (line2 (car points)(cadr points)(times mw tateyokoratio)))
950 :     )
951 :     ;
952 :     (def-type1-hint mincho yoko
953 :     (lets ((dotsize (meshwidth (times mw tateyokoratio)))
954 :     (w (normwidth dotsize))
955 :     (p0 (gridy (car points) dotsize))
956 :     (y (cadr p0))
957 :     (p1 (gridy (cadr points) dotsize)))
958 :     (cond ((equal y (cadr p1))
959 :     `((h ,(difference y w).,(plus y w)))))))

ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help