Revision: 1.3 - (view) (download)
1 : | ktanaka | 1.1 | ; 単位は400*400の座標系 |
2 : | ; 縦線の太さ | ||
3 : | (declare (minchowidth tateyokoratio minchoheight kazariheight tomeheight meshsize mw) special) | ||
4 : | ; 縦線に対する横線の太さの比 | ||
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 : | (do ((l elements (cdr l))(element)) | ||
903 : | ((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 |