[wadalabfont-kit] / lisp / test / botsu.l  

Annotation of /lisp/test/botsu.l

Parent Directory | Revision Log

Revision: 1.1.1.1 - (view) (download)

1 : ktanaka 1.1 ;
2 :     (defkazari mincho ((tate hidari tatehane kokoro tsukurihane magaritate tasuki migi) 1 yoko 3)
3 :     (lets ((p0 (vref cross 0))
4 :     (p1 (vref cross 1))
5 :     (p2 (vref cross 2))
6 :     (p3 (vref cross 3))
7 :     (d0 (diff2 p2 p3))
8 :     (d1 (diff2 p1 p3))
9 :     (w0 (times minchowidth 1.333 tatekazari))
10 :     (w1 (times minchowidth kazariheight))
11 :     (p4)(p5)(p6)(p7)(p8)
12 :     (const1 (quotient (times w0 0.4) w1)))
13 :     (cond ((lessp (plus w0 (metric2 p1 p3))
14 :     (times (plus 0.7 (times 1.3 (plus 1.0 const1))) w1))
15 :     (setq p5 (plus2 p3 (normlen2 (times -1.0 w0) d1)
16 :     (normlen2 (times const1 w1) d0)))
17 :     (setq p4 (plus2 p3 (normlen2
18 :     (plus (times const1 w1)(times w0 0.4)) d0)))
19 :     (setq p6 (plus2 p5 (normlen2 (times (plus 1 const1) w1 1.3) d1)
20 :     (normlen2 (times -1 (plus 1 const1) w1) d0)))
21 :     (setq p7
22 :     (plus2 p3
23 :     (normlen2
24 :     (difference
25 :     (times (plus 0.7 (times 1.3 (plus 1 const1))) w1)
26 :     w0) d1))))
27 :     (t
28 :     (setq p7 p1)
29 :     (setq p6 (plus2 p7 (normlen2 (times w1 -0.7) d1)
30 :     (normlen2 (times -1.0 w1) d0)))
31 :     (setq len1 (difference (plus w0 (metric2 p1 p3))(times 0.7 w1)))
32 :     (setq p5 (plus2 p6 (normlen2 (quotient len1 1.3) d0)
33 :     (normlen2 (times -1.0 len1) d1)))
34 :     (setq p4 (plus2 p5 (normlen2 w0 d1)
35 :     (normlen2 (times w0 0.4) d0)))))
36 :     ; (break)
37 :     (setq p8 (plus2 p5 (normlen2 (metric2 p4 p5)(diff2 p6 p5))))
38 :     `((angle .,p4)
39 :     (bezier .,(inter2 p5 p4 0.333333))
40 :     (bezier .,p5)
41 :     (angle .,p8)
42 :     (angle .,p6)
43 :     (angle .,p7))))
44 :     ;
45 :     ; 点の定義
46 :     ;
47 :     (defelement mincho ten
48 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
49 :     (w (times meshsize 0.5 dotsize))
50 :     (x (grid (car points) dotsize))
51 :     (y (grid (cadr points) dotsize))
52 :     (len (metric2 x y)))
53 :     (mincho1
54 :     x
55 :     y
56 :     '((80 171 136 255)
57 :     ((angle 80 171)(bezier 119 214)(bezier 104 256)(angle 136 255))
58 :     ((angle 80 171)(bezier 155 204)(bezier 173 251)(angle 136 255)))
59 :     (cond ((lessp (times 3.0 w) len)
60 :     (quotient w 20.0))
61 :     (t (quotient len 60.0))))))
62 :     ;(defelement mincho ten
63 :     ; (lets ((p0 (car points))
64 :     ; (p1 (cadr points))
65 :     ; (len (metric2 p0 p1))
66 :     ; (w minchowidth)
67 :     ; (p3 (inter2 p0 p1 0.5))
68 :     ; (v (normlen2 w (rot90 (diff2 p1 p0))))
69 :     ; (t (times w 0.1))
70 :     ; (p5 (plus2 p3 (times2 t v))))
71 :     ; (bez3 p0 p5 p1 0.0 (times w 0.7)(times w 0.9) w 0.75 2.0)))
72 :    
73 :    
74 :     ;
75 :     (comment
76 :     (defun line2 (p0 p1 width)
77 :     (lets ((diff (diff2 p1 p0))
78 :     (l0 (normlen2 width (rot270 diff))))
79 :     `(((angle .,(plus2 p0 l0))
80 :     (angle .,(plus2 p1 l0)))
81 :     ((angle .,(diff2 p0 l0))
82 :     (angle .,(diff2 p1 l0))))))
83 :     ;
84 :     (defun gridxy (point)
85 :     `(,(times meshsize
86 :     (fix (plus 0.5 (quotient (car point) meshsize))))
87 :     ,(times meshsize
88 :     (fix (plus 0.5 (quotient (cadr point) meshsize))))))
89 :     (defun gridhalfxy (point)
90 :     `(,(plus (times 0.5 meshsize)
91 :     (times meshsize
92 :     (fix (quotient (car point) meshsize))))
93 :     ,(plus (times 0.5 meshsize)
94 :     (times meshsize
95 :     (fix (quotient (cadr point) meshsize))))))
96 :     (defun grid (point dotsize)
97 :     (cond ((oddp dotsize)
98 :     (gridhalfxy point))
99 :     ((gridxy point))))
100 :     ;
101 :     (defun meshwidth (width)
102 :     (fix (plus 0.5 (quotient (times 2 width) meshsize))))
103 :     (defun inter (a b s)
104 :     (plus (times (difference 1.0 s) a)(times s b)))
105 :    
106 :     )
107 :     ;
108 :     ; 縦棒の定義
109 :     ;
110 :     (defelement mincho tate
111 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
112 :     (w (times meshsize 0.5 dotsize))
113 :     (x (grid (car points) dotsize))
114 :     (y (grid (cadr points) dotsize)))
115 :     ; (print `(tate ,dotsize) terminal-output)
116 :     (cond ((lessp (times 0.08 w) meshsize)
117 :     (line2 x y w))
118 :     (t
119 :     (niku2 x y 0.4 0.4 w (times w 0.92)(times w 0.92) w)))))
120 :     ;
121 :     ; 横棒の定義
122 :     ;
123 :     (defelement mincho yoko
124 :     (lets ((dotsize (meshwidth (times minchowidth tateyokoratio)))
125 :     (ywidth (times 0.5 meshsize dotsize))
126 :     (x (grid (car points) dotsize))
127 :     (y (grid (cadr points) dotsize)))
128 :     (cond ((lessp (times 0.2 ywidth) meshsize)
129 :     (line2 x y ywidth))
130 :     (t
131 :     (niku2 x y 0.3 0.3
132 :     ywidth (times ywidth 0.8)
133 :     (times ywidth 0.8) ywidth)))))
134 :     ;
135 :     ; 右上はらいの定義
136 :     ;
137 :     (defelement mincho migiue
138 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
139 :     (w1 (times meshsize 0.5 dotsize))
140 :     (w2 (times meshsize 0.5))
141 :     (x (car points))
142 :     (y (cadr points))
143 :     (z (caddr points)))
144 :     (niku3 x y z 0.3 0.3 w1 (inter w1 w2 0.3)(inter w1 w2 0.7) w2)))
145 :     ;
146 :     ; 左はらいの定義
147 :     ;
148 :    
149 :     ;;
150 :     ;; Nagahashi ni yoru jikkenteki hidari harai.
151 :     ;;
152 :     (defmacro X (p) `(first ,p))
153 :     (defmacro Y (p) `(second ,p))
154 :    
155 :     ;;(cond
156 :     ;;((greaterp costheta 0.86)
157 :     ;;(bez3 p0 p1 p2 w (times w 0.8)(times w 0.4) 0.0 1.0 1.0))
158 :     ;;(t
159 :    
160 :     (defelement mincho hidari
161 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
162 :     (w0 (times meshsize 0.5 dotsize))
163 :     ; (w1 (times meshsize 0.5))
164 :     (w1 0)
165 :     (p0 (grid (first points) dotsize))
166 :     (p1 (grid (second points) dotsize))
167 :     (p2 (grid (third points) dotsize))
168 :     (costheta (quotient (mul2 (diff2 p1 p0)(diff2 p2 p1))
169 :     (metric2 p0 p1)(metric2 p1 p2)))
170 :     ) ; chotto herasita houga dekiga yoi.
171 :     (lets ((v10 (diff2 p0 p1))
172 :     (v12 (diff2 p2 p1))
173 :     (d10 (norm2 (list (Y v10) (minus (X v10)))))
174 :     (d12 (norm2 (list (minus (Y v12)) (X v12))))
175 :     (vc (plus2 d10 d12))
176 :    
177 :     (a (length2 v10))(b (length2 v12))
178 :     ;;(c1disp (//$ b 2.0))
179 :     (lenratio (//$ b a))
180 :     (c1ratio (min (*$ lenratio lenratio) 0.9)) ; tanaka
181 :     ; (c1disp (*$ (min (*$ lenratio lenratio) 0.9) a))
182 :     (wl (*$ (//$ b (+$ a b)) w0))
183 :     (cc (minus (Y (norm2 v10)))) ;cosine
184 :     (w2 (+$ (*$ w0 cc) (*$ wl (-$ 1.0 cc))))
185 :     (dc (times2 (//$ w2 (mul2 vc d10)) vc))
186 :     (cl (plus2 p1 dc))
187 :     (cr (diff2 p1 dc)))
188 :     `(((angle . ,(plus2 p0 (times2 w0 d10)))
189 :     ; (bezier . ,(plus2 cl (normlen2 c1disp v10)))
190 :     (bezier . ,(inter2 cl (plus2 p0 (times2 w0 d10)) c1ratio))
191 :     (bezier . ,cl)
192 :     (angle . ,(plus2 p2 (times2 w1 d12))))
193 :     ((angle . ,(plus2 p0 (normlen2 (minus w0) d10)))
194 :     ; (bezier . ,(plus2 cr (normlen2 c1disp v10)))
195 :     (bezier . ,(inter2 cr (plus2 p0 (normlen2 (minus w0) d10)) c1ratio))
196 :     (bezier . ,cr)
197 :     (angle . ,(diff2 p2 (times2 w1 d10))))))))
198 :     ;; end of modification by ken.
199 :    
200 :     ;(defprop hidari
201 :     ; (lambda (points alist)
202 :     ; (let ((x (car points))
203 :     ; (y (cadr points))
204 :     ; (z (caddr points)))
205 :     ; (cond ((> 40000 (+ (* (-(tofix (car x))(tofix (car y)))(-(tofix (car x))(tofix (car y))))
206 :     ; (* (-(tofix (cadr x))(tofix (cadr y)))(-(tofix (cadr x))(tofix (cadr y))))))
207 :     ; (niku3 x y z 0.3 0.3
208 :     ; minchowidth (times minchowidth 0.8)(times minchowidth 0.4) 0.0))
209 :     ; (t
210 :     ; (niku3 x y z 0.6 0.2
211 :     ; minchowidth (times minchowidth 0.8)(times minchowidth 0.4) 0.0)))))
212 :     ; mincho)
213 :     ;
214 :     ;
215 :    
216 :     (defelement mincho tatehidari
217 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
218 :     (w (times meshsize 0.5 dotsize))
219 :     (a (grid (car points) dotsize))
220 :     (b (grid (cadr points) dotsize))
221 :     (c (grid (caddr points) dotsize))
222 :     (d (grid (cadddr points) dotsize))
223 :     (l0 (normlen2 w (rot90 (diff2 a b))))
224 :     (w1 (//$ w (float (costheta l0 (diff2 d c)))))
225 :     (l1 (plus2 (normlen2 w1 (diff2 d c))
226 :     (normlen2 w1 (diff2 b c)))))
227 :     `(((angle .,(plus2 a l0))
228 :     (angle .,(plus2 b l0))
229 :     (bezier .,(plus2 (inter2 b c 0.5) l0))
230 :     (bezier .,(plus2 c l1))
231 :     (angle .,d))
232 :     ((angle .,(diff2 a l0))
233 :     (angle .,(diff2 b l0))
234 :     (bezier .,(diff2 (inter2 b c 0.5) l0))
235 :     (bezier .,(diff2 c l1))
236 :     (angle .,d)))))
237 :     ;
238 :     ; 右はらいの定義
239 :     ;
240 :     (defelement mincho migi
241 :     (lets ((dotsize1 (meshwidth (times minchowidth 0.2)))
242 :     (w1 (times meshsize 0.5 dotsize1))
243 :     (dotsize2 (meshwidth (times minchowidth 1.0)))
244 :     (w2 (times meshsize 0.5 dotsize2))
245 :     (x (grid (car points) dotsize1))
246 :     (y (grid (cadr points) dotsize1))
247 :     (z (grid (caddr points) dotsize2)))
248 :     (niku3 x y z 0.3 0.3
249 :     w1 (inter w1 w2 0.25)(inter w1 w2 0.75) w2)))
250 :     ;
251 :     (defun spline3 (p0 p1 p2 t0 t1 t2)
252 :     (lets ((len01 (metric2 p0 p1))
253 :     (len12 (metric2 p1 p2))
254 :     (t0 (normlen2 len01 t0))
255 :     (t1 (normlen2 (times 0.5 (plus len01 len12)) t1))
256 :     (t2 (normlen2 len12 t2))
257 :     ; (right (times2 3.0 (diff2 p2 p0)))
258 :     )
259 :     ; (prind (list "spline3" p0 p1 p2 t0 t1 t2))
260 :     `((angle .,p0)
261 :     (bezier .,(plus2 p0 (times2 0.3333 t0)))
262 :     (bezier .,(plus2 p1 (times2 -0.3333 t1)))
263 :     (angle .,p1)
264 :     (bezier .,(plus2 p1 (times2 0.3333 t1)))
265 :     (bezier .,(plus2 p2 (times2 -0.3333 t2)))
266 :     (angle .,p2))
267 :     ; `((angle .,p0)(angle .,p1)(angle .,p2))
268 :     ))
269 :     ;
270 :     ; こざと偏の一部
271 :     ;
272 :     (defelement mincho kozato
273 :     (lets ((p0 (first points))
274 :     (p1 (second points))
275 :     (p2 (third points))
276 :     (p3 (fourth points))
277 :     (w (times minchowidth 0.9))
278 :     (p12 (inter2 p1 p2 0.5))
279 :     (len0 (metric2 p0 p1))
280 :     (len1 (metric2 p1 p2))
281 :     (len2 (metric2 p2 p3))
282 :     (len (plus len0 len1 len2))
283 :     (ratio (//$ (times w 0.8) len))
284 :     (w0 (times w 0.2))
285 :     (l0 (normlen2 w0 (rot90 (diff2 p0 p1))))
286 :     (w1 (times w (//$ (plus len0 len0 len1)(plus len len))))
287 :     (w1 (plus (times 0.2 w)(times 0.8 w1)))
288 :     (l1 (normlen2 w1 (rot90 (diff2 p1 p2))))
289 :     (w2 w)
290 :     (l2 (normlen2 w2 (rot90 (diff2 p2 p3))))
291 :     (p00 (plus2 p0 l0))
292 :     (p01 (plus2 p12 l1))
293 :     (p02 (plus2 p3 l2))
294 :     (t00 (plus2 (normlen2 1.0 (diff2 p1 p0))
295 :     (normlen2 ratio l0)))
296 :     (t01 (plus2 (normlen2 1.0 (diff2 p2 p1))
297 :     (normlen2 ratio l1)))
298 :     (t02 (plus2 (normlen2 1.0 (diff2 p3 p2))
299 :     (normlen2 ratio l2)))
300 :     (line0 (spline3 p00 p01 p02 t00 t01 t02))
301 :     (p10 (diff2 p0 l0))
302 :     (p11 (diff2 p12 l1))
303 :     (p12 (diff2 p3 l2))
304 :     (t10 (plus2 (normlen2 1.0 (diff2 p1 p0))
305 :     (normlen2 (minus ratio) l0)))
306 :     (t11 (plus2 (normlen2 1.0 (diff2 p2 p1))
307 :     (normlen2 (minus ratio) l1)))
308 :     (t12 (plus2 (normlen2 1.0 (diff2 p3 p2))
309 :     (normlen2 (minus ratio) l2)))
310 :     (line1 (spline3 p10 p11 p12 t10 t11 t12))
311 :     (hane (hanelast p02 p12
312 :     (plus2 p02 (normlen2 w (diff2 p2 p3)))
313 :     (plus2 p12 (normlen2 w (diff2 p2 p3))))))
314 :     (list (nreverse (cons (car (last hane)) (cdr (nreverse line0))))
315 :     (append (nreverse (cdr (nreverse line1)))
316 :     hane))))
317 :     ;
318 :     (comment
319 :     (defelement mincho kozato
320 :     (let ((x (car points))
321 :     (y (cadr points))
322 :     (z (caddr points)))
323 :     (niku3 x y z 0.3 0.3 0.0 (times minchowidth 0.7)(times minchowidth 1.0)(times minchowidth 0.9))))
324 :     )
325 :     ; compiled fail
326 :     (defun hanelast (p0 p1 p2 p3)
327 :     (lets ((len (metric2 p0 p1)))
328 :     `(
329 :     (angle .,
330 :     (plus2 p1
331 :     (normlen2 (times len 0.2)
332 :     (diff2 p3 p1))))
333 :     (bezier .,
334 :     (plus2
335 :     p0
336 :     (plus2
337 :     (normlen2 (times len 0.5)(diff2 p1 p0))
338 :     (normlen2 (times len -0.0)(diff2 p2 p0)))))
339 :     (bezier .,
340 :     (plus2 p0
341 :     (normlen2 (times len -0.3)(diff2 p2 p0))
342 :     (normlen2 (times len 0.3)(diff2 p1 p0))))
343 :     (angle .,
344 :     (plus2 p0
345 :     (normlen2 (times len 0.8)(diff2 p0 p2)))))))
346 :     ;
347 :     ; 縦跳ね
348 :     ;
349 :     (defelement mincho tatehane
350 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
351 :     (w (times meshsize 0.5 dotsize))
352 :     (x (grid (car points) dotsize))
353 :     (y (grid (cadr points) dotsize))
354 :     (z (grid (caddr points) dotsize))
355 :     (y (plus2 y (normlen2 w (diff2 x y))))
356 :     (z (plus2 z (normlen2 w (diff2 x y))))
357 :     (z (cond ((lessp (metric2 y z)(times 3.0 w))
358 :     (plus2 y (normlen2 (times 3.0 w)(diff2 z y))))
359 :     (t z)))
360 :     (len (metric2 y z))
361 :     (d0 (diff2 x y))
362 :     (l0 (normlen2 w
363 :     (list (cadr d0)(minus (car d0)))))
364 :     (d1 (diff2 y z))
365 :     (l1 (normlen2 (times w -1.0)
366 :     (list (minus (cadr d1))(car d1))))
367 :     (p0 (plus2 z l1))
368 :     (p1 (diff2 z l1))
369 :     (p2 (plus2 p0 (normlen2 (times 2.0 w) (diff2 y z))))
370 :     (p3 (plus2 p1 (normlen2 (times 2.0 w) (diff2 y z))))
371 :     (xx (plus2 y (normlen2 len d0))))
372 :     `(((angle . ,(plus2 x l0))
373 :     (angle . ,(plus2 xx l0))
374 :     (bezier . ,(plus2 xx (plus2 (normlen2 (times -0.5 len)d0)l0)))
375 :     (bezier . ,(plus2 z (plus2 (normlen2 (times 0.5 len) d1)l1)))
376 :     (angle . ,(plus2 z l1)))
377 :     ((angle . ,(diff2 x l0))
378 :     (angle . ,(diff2 xx l0))
379 :     (bezier . ,(plus2 xx (diff2 (normlen2 (times -1.0 len)d0)l0)))
380 :     (bezier . ,(plus2 z (diff2 (normlen2 (times 1.0 len) d1) l1)))
381 :     .,(hanelast p0 p1 p2 p3)))))
382 :     ;
383 :     ; 旁の跳ね
384 :     ;
385 :     (defelement mincho tsukurihane
386 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
387 :     (w (times meshsize 0.5 dotsize))
388 :     (p0 (car points))
389 :     (p1 (cadr points))
390 :     (p2 (caddr points))
391 :     (p3 (cadddr points))
392 :     (p2 (plus2 p2 (normlen2 w (diff2 p1 p2))))
393 :     (p3 (plus2 p3 (normlen2 w (diff2 p1 p2))))
394 :     (p3 (cond ((lessp (metric2 p2 p3)(times w 3.0))
395 :     (plus2 p2 (normlen2 (times w 3.0)(diff2 p3 p2))))
396 :     (t p3)))
397 :     (p4 (times2 0.5 (plus2 p1 p2)))
398 :     (line0 (niku3 p0 p1 p4 0.3 0.3 w w w w))
399 :     (line1 (niku3 p4 p2 p3 0.3 0.3 w w w (times w 1.2)))
400 :     (rline1 (list (reverse (car line1))(reverse (cadr line1))))
401 :     (pp0 (cdr (caar rline1)))
402 :     (pp2 (plus2 pp0
403 :     (normlen2 (times w 2.0)
404 :     (diff2 (cdr (cadar rline1)) pp0))))
405 :     (pp1 (cdr (caadr rline1)))
406 :     (pp3 (plus2 pp1
407 :     (normlen2 (times w 2.0)
408 :     (diff2 (cdr (cadadr rline1)) pp1))))
409 :     )
410 :     (list (append (car line0)(car line1))
411 :     (append (cadr line0)(nreverse (cdadr rline1))
412 :     (hanelast pp0 pp1 pp2 pp3)))))
413 :     ;
414 :     ; さんずい
415 :     ;
416 :     (defelement mincho sanzui
417 :     (lets ((p0 (car points))
418 :     (p1 (cadr points))
419 :     (p2 (caddr points))
420 :     (p3 (cadddr points))
421 :     (len0 (metric2 p2 p0))
422 :     (len1 (metric2 p2 p1))
423 :     (v0 (rot270 (diff2 p1 p0)))
424 :     (v1 '(-1.0 0.0))
425 :     (v1 (rot270 (diff2 p2 p1)))
426 :     (v2 (rot270 (diff2 p3 p1)))
427 :     (w minchowidth)
428 :     (p4 (plus2 p1 (normlen2 (times len0 0.2) (diff2 p1 p0))
429 :     (normlen2 (times w 0.3) v0)))
430 :     (p5 (plus2 p2 (normlen2 (times w 2.0) v1)))
431 :     (p6 (plus2 p2 (normlen2 (times w -2.0) v1)))
432 :     (p70 (plus2 p1 (normlen2 (times len1 0.5) (diff2 p2 p1))))
433 :     (p7 (plus2 p70 (normlen2 (times w -1.0) v1)))
434 :     (p8 (plus2 p1
435 :     (normlen2 w (diff2 p3 p1))
436 :     (normlen2 (times w 0.3) v2)))
437 :     (p9 (plus2 p1
438 :     (normlen2 w (diff2 p3 p1))
439 :     (normlen2 (times w -0.3) v2)))
440 :     (p10 (plus2 (inter2 p70 p2 0.5) (normlen2 (times w -1.3) v1)))
441 :     (p11 (plus2 (inter2 p70 p1 0.5) (normlen2 (times w -0.7) v1))))
442 :     `(((angle .,p0)
443 :     (bezier .,p4)
444 :     (bezier .,p5)
445 :     (angle .,p2)
446 :     (bezier .,p6)
447 :     (bezier .,p10)
448 :     (angle .,p7)
449 :     (bezier .,p11)
450 :     (bezier .,p8)
451 :     (angle .,p3))
452 :     ((angle .,p3)
453 :     (bezier .,p9)
454 :     (bezier .,p9)
455 :     (angle .,p0)))))
456 :     (defelement mincho sanzui
457 :     (lets ((x (car points))
458 :     (y (cadr points)))
459 :     (mincho1
460 :     x
461 :     y
462 :     '((87 381 136 112)
463 :     ((angle 87 381) (bezier 105 381) (bezier 114 364)
464 :     (angle 96 329) (bezier 88 313) (bezier 87 295)
465 :     (angle 93 272) (angle 136 112))
466 :     ((angle 87 381) (bezier 29 380) (bezier 101 304)
467 :     (angle 23 277) (bezier 43 277) (bezier 57 278)
468 :     (angle 66 258) (angle 136 112)))
469 :     (quotient minchowidth 20.0))))
470 :     ;
471 :     ; こころ
472 :     ;
473 :    
474 :     (defelement mincho kokoro
475 :     (lets
476 :     ((dotsize (meshwidth (times minchowidth 0.9)))
477 :     (w (times meshsize 0.5 dotsize))
478 :     (p0 (car points))
479 :     (p1 (cadr points))
480 :     (p2 (plus2 (caddr points) (normlen2 w (diff2 p0 p1))))
481 :     (p1 (plus2 p1 (normlen2 w (diff2 p0 p1))))
482 :     (p0 (grid p0 dotsize))
483 :     (p1 (grid p1 dotsize))
484 :     (p2 (grid p2 dotsize))
485 :     (p3 (grid (cadddr points) dotsize))
486 :     ; (p3 (plus2 p3 (normlen2 w (diff2 p0 p1))))
487 :     (p3 (cond ((lessp (metric2 p2 p3) (times w 2.5))
488 :     (plus2 p2 (normlen2 (times w 2.5)(diff2 p3 p2))))
489 :     (t p3)))
490 :     (p4 (times2 0.5 (plus2 p1 p2)))
491 :     (len0 (metric2 p1 p4))
492 :     (len1 (metric2 p1 p0))
493 :     (p5 (cond ((lessp len1 (plus len0 minchowidth))nil)
494 :     (t(plus2 p1 (normlen2 len0 (diff2 p0 p1))))))
495 :     (p6 (plus2 p2 (times2 0.2 (diff2 p3 p2))))
496 :     (p7 (times2 0.5 (plus2 p4 p2)))
497 :     (p8 (times2 0.5 (plus2 p6 p7)))
498 :     (p9 (plus2 p6 (times2 0.1 (diff2 p3 p6))))
499 :     (line0 (cond ((null p5)(list nil nil))(t (line2 p0 p5 w))))
500 :     (line1 (niku3 (cond (p5)(t p0)) p1 p4 0.45 0.45 w w w w))
501 :     (line2 (niku3 p4 p7 p8 0.45 0.45 w w w w))
502 :     (line3 (niku3 p8 p6 p3 0.2 0.6 w w (times w 0.5) 0.0))
503 :     (line4 (niku3 p8 p6 p9 0.3 0.3 w w w w))
504 :     (line5 (niku2 p9 p3 0.2 0.8 w w (times w 0.1) 0.0))
505 :     (len (metric2 p2 p3))
506 :     (d0 (diff2 p2 p4))
507 :     (d1 (diff2 p2 p3))
508 :     (l0 (norm2 (list (minus (cadr d0))(car d0))))
509 :     (l1 (norm2 (list (cadr d1)(minus (car d1)))))
510 :     )
511 :     (list (append (car line0)(car line1)(car line2)(car line4)(car line5))
512 :     (append(cadr line0)(cadr line1)(cadr line2)(cadr line3)))))
513 :     (comment
514 :     (defelement mincho kokoro
515 :     (lets ((p0 (car points))
516 :     (p1 (cadr points))
517 :     (p2 (caddr points))
518 :     (p3 (fourth points))
519 :     (w (times minchowidth 0.9))
520 :     (p00 (plus2 p0 (normlen2 w (diff2 p1 p2))))
521 :     (p01 (diff2 p0 (normlen2 w (diff2 p1 p2))))
522 :     (p10 (plus2 p1 (normlen2 w (diff2 p1 p2))))
523 :     (p11 (plus2 p1 (normlen2 w (diff2 p2 p1))
524 :     (normlen2 (times w 2) (diff2 p0 p1))))
525 :     (p20 (plus2 p2 (normlen2 (times w 2.0)(diff2 p2 p1))))
526 :     (p21 (plus2 p2 (normlen2 (times w 2.0) (diff2 p3 p2))))
527 :     (p40 (plus2 p10 (normlen2 (times w 3.0) (diff2 p00 p10))))
528 :     (p41 (plus2 p11 (normlen2 (times w 2.0) (diff2 p01 p11))))
529 :     (p50 (plus2 p10 (normlen2 (times w 3.0) (diff2 p2 p10))))
530 :     (p51 (plus2 p11 (normlen2 (times w 2.0) (diff2 p21 p11))))
531 :     (p60 (plus2 p2 (normlen2 (times w 2.0) (diff2 p1 p2))))
532 :     (p61 (plus2 p21 (normlen2 (times w 2.0) (diff2 p11 p21))))
533 :     (p7 (plus2 p21 (normlen2 (times w 1.0) (diff2 p21 p11))))
534 :     )
535 :     `(((angle .,p00)(angle .,p40)(bezier .,p10)
536 :     (bezier .,p10)(angle .,p50)(angle .,p60)
537 :     (bezier .,(inter2 p60 p20 0.67))
538 :     (bezier .,p20)(angle .,p7)
539 :     (bezier .,(plus2 p7 (normlen2 w (diff2 p7 p20))))
540 :     (bezier .,(plus2 p3 (normlen2 (times w 3.0) (diff2 (inter2 p2 p20 0.5) p3))))
541 :     (angle .,p3)
542 :     )
543 :     ((angle .,p01)(angle .,p41)(bezier .,p11)
544 :     (bezier .,p11)(angle .,p51)(angle .,p61)
545 :     (bezier .,(inter2 p61 p21 0.67))
546 :     (bezier .,p21)(angle .,p3)))))
547 :     )
548 :     ;
549 :     ; たすき
550 :     ;
551 :     (defelement mincho tasuki
552 :     (lets
553 :     ((dotsize (meshwidth (times minchowidth 0.9)))
554 :     (w (times meshsize 0.5 dotsize))
555 :     (p0 (car points))
556 :     (p1 (cadr points))
557 :     (p2 (caddr points))
558 :     (p3 (cadddr points))
559 :     (p4 (times2 0.5 (plus2 p1 p2)))
560 :     ; (line1 (niku3 p0 p1 p4 0.3 0.3 w w w w))
561 :     ; (line2 (niku3 p4 p2 p3 0.45 0.45 w (times w 1.0)(times w 0.5) 0.0))
562 :     ; (line1 (bez3 p0 p1 p4 w w w w 1.0 1.0))
563 :     ; (line2 (bez3 p4 p2 p3 w (times w 1.0)(times w 0.5) 0.0 1.0 1.0))
564 :     (line1 (curve2 p0 (inter2 p0 p1 0.7)(inter2 p4 p1 0.7) p4 w w w w))
565 :     (line2 (curve2 p4 (inter2 p4 p2 0.7)(inter2 p3 p2 0.7) p3
566 :     w (times w 1.0)(times w 0.5) 0.0))
567 :     (len (metric2 p2 p3))
568 :     (d0 (diff2 p2 p4))
569 :     (d1 (diff2 p2 p3))
570 :     (l0 (norm2 (list (minus (cadr d0))(car d0))))
571 :     (l1 (norm2 (list (cadr d1)(minus (car d1)))))
572 :     (line3
573 :     `((bezier .,(plus2 p2 (times2 w l0)))
574 :     (bezier .,(plus2 p3
575 :     (plus2 (normlen2 (times len 1.2)d1)(times2 w l1))))
576 :     (angle .,(plus2 p3
577 :     (plus2 (normlen2 (times len 0.8)d1)(times2 w l1))))
578 :     (bezier .,(plus2 p3
579 :     (plus2 (normlen2 (times len 0.5)d1)(times2 w l1))))
580 :     (bezier .,(plus2 p3(normlen2 (times len 0.9)d1))))))
581 :     (list(append (car line1)line3)
582 :     (append (cadr line1)(cadr line2)))))
583 :     ;
584 :     ; まがりたて
585 :     ;
586 :     (defelement mincho magaritate
587 :     (lets
588 :     ((dotsize (meshwidth (times minchowidth 0.9)))
589 :     (w (times meshsize 0.5 dotsize))
590 :     (w1 (times w 0.9))
591 :     (p0 (car points))
592 :     (p1 (cadr points))
593 :     (p2 (caddr points)))
594 :     (niku3 p0 p1 p2 0.4 0.4 w w1 w1 w)))
595 :     ;
596 :     ; かぎ
597 :     ;
598 :     ;(defelement mincho kagi
599 :     ; (lets
600 :     ; ((p0 (car points))
601 :     ; (p1 (cadr points))
602 :     ; (p2 (caddr points))
603 :     ; (p0 (list (float (car p0))(float (cadr p0))))
604 :     ; (p1 (list (float (car p1))(float (cadr p1))))
605 :     ; (p2 (list (float (car p2))(float (cadr p2))))
606 :     ; (w (times minchowidth 0.9))
607 :     ; (p1 (plus2 p1 (normlen2 w (diff2 p0 p1))))
608 :     ; (p2 (plus2 p2 (normlen2 w (diff2 p0 p1))))
609 :     ; (p3 (times2 0.5 (plus2 p1 p2)))
610 :     ; (len0 (metric2 p1 p3))
611 :     ; (len1 (metric2 p0 p1))
612 :     ; (p4 (cond ((greaterp len0 len1)p0)
613 :     ; (t (plus2 p1(normlen2 len0 (diff2 p0 p1))))))
614 :     ; (line0 (cond ((eq p0 p4)'(nil nil))(t(niku2 p0 p4 0.4 0.4 w w w w))))
615 :     ; (line1 (niku3 p4 p1 p3 0.45 0.45 w w w w))
616 :     ; (line2 (niku2 p3 p2 0.4 0.4 w w w w)))
617 :     ; (list (append (car line0)(car line1)(car line2))
618 :     ; (append (cadr line0)(cadr line1)(cadr line2)))))
619 :     ;
620 :     (defelement mincho kagi
621 :     (lets ((dotsize (meshwidth (times minchowidth 0.9)))
622 :     (w (times meshsize 0.5 dotsize))
623 :     (p0 (car points))
624 :     (p1 (cadr points))
625 :     (p2 (caddr points))
626 :     (p00 (plus2 p0 (normlen2 w (diff2 p1 p2))))
627 :     (p01 (diff2 p0 (normlen2 w (diff2 p1 p2))))
628 :     (p10 (plus2 p1 (normlen2 w (diff2 p1 p2))))
629 :     (p11 (plus2 p1 (normlen2 w (diff2 p2 p1))
630 :     (normlen2 (times w 2) (diff2 p0 p1))))
631 :     (p21 (plus2 p2 (normlen2 (times w 2) (diff2 p0 p1))))
632 :     (p30 (plus2 p10 (normlen2 (times w 3.0) (diff2 p00 p10))))
633 :     (p31 (plus2 p11 (normlen2 (times w 2.0) (diff2 p01 p11))))
634 :     (p40 (plus2 p10 (normlen2 (times w 3.0) (diff2 p2 p10))))
635 :     (p41 (plus2 p11 (normlen2 (times w 2.0) (diff2 p21 p11)))))
636 :     `(((angle .,p00)(angle .,p30)(bezier .,p10)
637 :     (bezier .,p10)(angle .,p40)(angle .,p2))
638 :     ((angle .,p01)(angle .,p31)(bezier .,p11)
639 :     (bezier .,p11)(angle .,p41)(angle .,p21)))))
640 :    
641 :     ;
642 :     ;しんにゅう
643 :     ;
644 :     (defelement mincho shin-nyuu
645 :     (lets
646 :     ((dotsize (meshwidth (times minchowidth 0.9)))
647 :     (w (times meshsize 0.5 dotsize))
648 :     (p0 (car points))
649 :     (p1 (cadr points))
650 :     (p2 (caddr points))
651 :     (p0 (list (float (car p0))(float (cadr p0))))
652 :     (p1 (list (float (car p1))(float (cadr p1))))
653 :     (p2 (list (float (car p2))(float (cadr p2))))
654 :     (len1 (metric2 p0 p1))
655 :     (len2 (metric2 p1 p2))
656 :     (len (plus len1 len2)))
657 :     (niku3 p0 p1 p2 (times 0.5 (quotient len1 len))(times 0.9 (quotient len2 len))
658 :     (times w 0.2) (times w 0.4)(times w 1.1)(times w 1.1))))
659 :     ; ライブラリをexfileする
660 :     (cond ((definedp 'kanjilib))
661 :     (t (exfile 'lib.l)))
662 :     (defelement mincho yoko
663 :     (lets ((dotsize (meshwidth (times minchowidth tateyokoratio)))
664 :     (w (normwidth dotsize))
665 :     (p0 (gridy (car points) dotsize))
666 :     (p1 (gridy (cadr points) dotsize)))
667 :     (cond ((lessp (times 0.2 w) meshsize)
668 :     (line2 p0 p1 w))
669 :     (t
670 :     (niku2 p0 p1 0.3 0.3 w (times w 0.8)(times w 0.8) w)))))

ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help