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))))) |