View of /lisp/test/botsu.l
Parent Directory
| 
Revision Log
Revision:
1.1.1.1 -
(
download)
(
annotate)
(vendor branch)
Thu Dec 28 08:54:19 2000 UTC (23 years, 4 months ago) by
ktanaka
Branch:
ktanaka, MAIN
CVS Tags:
SNAP-20030702, tmp, SNAP-20030624, SNAP-20030630, SNAP-20040518, HEAD
Changes since
1.1: +0 -0 lines
change to CVS wadalab font project
;
(defkazari mincho ((tate hidari tatehane kokoro tsukurihane magaritate tasuki migi) 1 yoko 3)
(lets ((p0 (vref cross 0))
(p1 (vref cross 1))
(p2 (vref cross 2))
(p3 (vref cross 3))
(d0 (diff2 p2 p3))
(d1 (diff2 p1 p3))
(w0 (times minchowidth 1.333 tatekazari))
(w1 (times minchowidth kazariheight))
(p4)(p5)(p6)(p7)(p8)
(const1 (quotient (times w0 0.4) w1)))
(cond ((lessp (plus w0 (metric2 p1 p3))
(times (plus 0.7 (times 1.3 (plus 1.0 const1))) w1))
(setq p5 (plus2 p3 (normlen2 (times -1.0 w0) d1)
(normlen2 (times const1 w1) d0)))
(setq p4 (plus2 p3 (normlen2
(plus (times const1 w1)(times w0 0.4)) d0)))
(setq p6 (plus2 p5 (normlen2 (times (plus 1 const1) w1 1.3) d1)
(normlen2 (times -1 (plus 1 const1) w1) d0)))
(setq p7
(plus2 p3
(normlen2
(difference
(times (plus 0.7 (times 1.3 (plus 1 const1))) w1)
w0) d1))))
(t
(setq p7 p1)
(setq p6 (plus2 p7 (normlen2 (times w1 -0.7) d1)
(normlen2 (times -1.0 w1) d0)))
(setq len1 (difference (plus w0 (metric2 p1 p3))(times 0.7 w1)))
(setq p5 (plus2 p6 (normlen2 (quotient len1 1.3) d0)
(normlen2 (times -1.0 len1) d1)))
(setq p4 (plus2 p5 (normlen2 w0 d1)
(normlen2 (times w0 0.4) d0)))))
; (break)
(setq p8 (plus2 p5 (normlen2 (metric2 p4 p5)(diff2 p6 p5))))
`((angle .,p4)
(bezier .,(inter2 p5 p4 0.333333))
(bezier .,p5)
(angle .,p8)
(angle .,p6)
(angle .,p7))))
;
; 点の定義
;
(defelement mincho ten
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(x (grid (car points) dotsize))
(y (grid (cadr points) dotsize))
(len (metric2 x y)))
(mincho1
x
y
'((80 171 136 255)
((angle 80 171)(bezier 119 214)(bezier 104 256)(angle 136 255))
((angle 80 171)(bezier 155 204)(bezier 173 251)(angle 136 255)))
(cond ((lessp (times 3.0 w) len)
(quotient w 20.0))
(t (quotient len 60.0))))))
;(defelement mincho ten
; (lets ((p0 (car points))
; (p1 (cadr points))
; (len (metric2 p0 p1))
; (w minchowidth)
; (p3 (inter2 p0 p1 0.5))
; (v (normlen2 w (rot90 (diff2 p1 p0))))
; (t (times w 0.1))
; (p5 (plus2 p3 (times2 t v))))
; (bez3 p0 p5 p1 0.0 (times w 0.7)(times w 0.9) w 0.75 2.0)))
;
(comment
(defun line2 (p0 p1 width)
(lets ((diff (diff2 p1 p0))
(l0 (normlen2 width (rot270 diff))))
`(((angle .,(plus2 p0 l0))
(angle .,(plus2 p1 l0)))
((angle .,(diff2 p0 l0))
(angle .,(diff2 p1 l0))))))
;
(defun gridxy (point)
`(,(times meshsize
(fix (plus 0.5 (quotient (car point) meshsize))))
,(times meshsize
(fix (plus 0.5 (quotient (cadr point) meshsize))))))
(defun gridhalfxy (point)
`(,(plus (times 0.5 meshsize)
(times meshsize
(fix (quotient (car point) meshsize))))
,(plus (times 0.5 meshsize)
(times meshsize
(fix (quotient (cadr point) meshsize))))))
(defun grid (point dotsize)
(cond ((oddp dotsize)
(gridhalfxy point))
((gridxy point))))
;
(defun meshwidth (width)
(fix (plus 0.5 (quotient (times 2 width) meshsize))))
(defun inter (a b s)
(plus (times (difference 1.0 s) a)(times s b)))
)
;
; 縦棒の定義
;
(defelement mincho tate
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(x (grid (car points) dotsize))
(y (grid (cadr points) dotsize)))
; (print `(tate ,dotsize) terminal-output)
(cond ((lessp (times 0.08 w) meshsize)
(line2 x y w))
(t
(niku2 x y 0.4 0.4 w (times w 0.92)(times w 0.92) w)))))
;
; 横棒の定義
;
(defelement mincho yoko
(lets ((dotsize (meshwidth (times minchowidth tateyokoratio)))
(ywidth (times 0.5 meshsize dotsize))
(x (grid (car points) dotsize))
(y (grid (cadr points) dotsize)))
(cond ((lessp (times 0.2 ywidth) meshsize)
(line2 x y ywidth))
(t
(niku2 x y 0.3 0.3
ywidth (times ywidth 0.8)
(times ywidth 0.8) ywidth)))))
;
; 右上はらいの定義
;
(defelement mincho migiue
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w1 (times meshsize 0.5 dotsize))
(w2 (times meshsize 0.5))
(x (car points))
(y (cadr points))
(z (caddr points)))
(niku3 x y z 0.3 0.3 w1 (inter w1 w2 0.3)(inter w1 w2 0.7) w2)))
;
; 左はらいの定義
;
;;
;; Nagahashi ni yoru jikkenteki hidari harai.
;;
(defmacro X (p) `(first ,p))
(defmacro Y (p) `(second ,p))
;;(cond
;;((greaterp costheta 0.86)
;;(bez3 p0 p1 p2 w (times w 0.8)(times w 0.4) 0.0 1.0 1.0))
;;(t
(defelement mincho hidari
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w0 (times meshsize 0.5 dotsize))
; (w1 (times meshsize 0.5))
(w1 0)
(p0 (grid (first points) dotsize))
(p1 (grid (second points) dotsize))
(p2 (grid (third points) dotsize))
(costheta (quotient (mul2 (diff2 p1 p0)(diff2 p2 p1))
(metric2 p0 p1)(metric2 p1 p2)))
) ; chotto herasita houga dekiga yoi.
(lets ((v10 (diff2 p0 p1))
(v12 (diff2 p2 p1))
(d10 (norm2 (list (Y v10) (minus (X v10)))))
(d12 (norm2 (list (minus (Y v12)) (X v12))))
(vc (plus2 d10 d12))
(a (length2 v10))(b (length2 v12))
;;(c1disp (//$ b 2.0))
(lenratio (//$ b a))
(c1ratio (min (*$ lenratio lenratio) 0.9)) ; tanaka
; (c1disp (*$ (min (*$ lenratio lenratio) 0.9) a))
(wl (*$ (//$ b (+$ a b)) w0))
(cc (minus (Y (norm2 v10)))) ;cosine
(w2 (+$ (*$ w0 cc) (*$ wl (-$ 1.0 cc))))
(dc (times2 (//$ w2 (mul2 vc d10)) vc))
(cl (plus2 p1 dc))
(cr (diff2 p1 dc)))
`(((angle . ,(plus2 p0 (times2 w0 d10)))
; (bezier . ,(plus2 cl (normlen2 c1disp v10)))
(bezier . ,(inter2 cl (plus2 p0 (times2 w0 d10)) c1ratio))
(bezier . ,cl)
(angle . ,(plus2 p2 (times2 w1 d12))))
((angle . ,(plus2 p0 (normlen2 (minus w0) d10)))
; (bezier . ,(plus2 cr (normlen2 c1disp v10)))
(bezier . ,(inter2 cr (plus2 p0 (normlen2 (minus w0) d10)) c1ratio))
(bezier . ,cr)
(angle . ,(diff2 p2 (times2 w1 d10))))))))
;; end of modification by ken.
;(defprop hidari
; (lambda (points alist)
; (let ((x (car points))
; (y (cadr points))
; (z (caddr points)))
; (cond ((> 40000 (+ (* (-(tofix (car x))(tofix (car y)))(-(tofix (car x))(tofix (car y))))
; (* (-(tofix (cadr x))(tofix (cadr y)))(-(tofix (cadr x))(tofix (cadr y))))))
; (niku3 x y z 0.3 0.3
; minchowidth (times minchowidth 0.8)(times minchowidth 0.4) 0.0))
; (t
; (niku3 x y z 0.6 0.2
; minchowidth (times minchowidth 0.8)(times minchowidth 0.4) 0.0)))))
; mincho)
;
;
(defelement mincho tatehidari
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(a (grid (car points) dotsize))
(b (grid (cadr points) dotsize))
(c (grid (caddr points) dotsize))
(d (grid (cadddr points) dotsize))
(l0 (normlen2 w (rot90 (diff2 a b))))
(w1 (//$ w (float (costheta l0 (diff2 d c)))))
(l1 (plus2 (normlen2 w1 (diff2 d c))
(normlen2 w1 (diff2 b c)))))
`(((angle .,(plus2 a l0))
(angle .,(plus2 b l0))
(bezier .,(plus2 (inter2 b c 0.5) l0))
(bezier .,(plus2 c l1))
(angle .,d))
((angle .,(diff2 a l0))
(angle .,(diff2 b l0))
(bezier .,(diff2 (inter2 b c 0.5) l0))
(bezier .,(diff2 c l1))
(angle .,d)))))
;
; 右はらいの定義
;
(defelement mincho migi
(lets ((dotsize1 (meshwidth (times minchowidth 0.2)))
(w1 (times meshsize 0.5 dotsize1))
(dotsize2 (meshwidth (times minchowidth 1.0)))
(w2 (times meshsize 0.5 dotsize2))
(x (grid (car points) dotsize1))
(y (grid (cadr points) dotsize1))
(z (grid (caddr points) dotsize2)))
(niku3 x y z 0.3 0.3
w1 (inter w1 w2 0.25)(inter w1 w2 0.75) w2)))
;
(defun spline3 (p0 p1 p2 t0 t1 t2)
(lets ((len01 (metric2 p0 p1))
(len12 (metric2 p1 p2))
(t0 (normlen2 len01 t0))
(t1 (normlen2 (times 0.5 (plus len01 len12)) t1))
(t2 (normlen2 len12 t2))
; (right (times2 3.0 (diff2 p2 p0)))
)
; (prind (list "spline3" p0 p1 p2 t0 t1 t2))
`((angle .,p0)
(bezier .,(plus2 p0 (times2 0.3333 t0)))
(bezier .,(plus2 p1 (times2 -0.3333 t1)))
(angle .,p1)
(bezier .,(plus2 p1 (times2 0.3333 t1)))
(bezier .,(plus2 p2 (times2 -0.3333 t2)))
(angle .,p2))
; `((angle .,p0)(angle .,p1)(angle .,p2))
))
;
; こざと偏の一部
;
(defelement mincho kozato
(lets ((p0 (first points))
(p1 (second points))
(p2 (third points))
(p3 (fourth points))
(w (times minchowidth 0.9))
(p12 (inter2 p1 p2 0.5))
(len0 (metric2 p0 p1))
(len1 (metric2 p1 p2))
(len2 (metric2 p2 p3))
(len (plus len0 len1 len2))
(ratio (//$ (times w 0.8) len))
(w0 (times w 0.2))
(l0 (normlen2 w0 (rot90 (diff2 p0 p1))))
(w1 (times w (//$ (plus len0 len0 len1)(plus len len))))
(w1 (plus (times 0.2 w)(times 0.8 w1)))
(l1 (normlen2 w1 (rot90 (diff2 p1 p2))))
(w2 w)
(l2 (normlen2 w2 (rot90 (diff2 p2 p3))))
(p00 (plus2 p0 l0))
(p01 (plus2 p12 l1))
(p02 (plus2 p3 l2))
(t00 (plus2 (normlen2 1.0 (diff2 p1 p0))
(normlen2 ratio l0)))
(t01 (plus2 (normlen2 1.0 (diff2 p2 p1))
(normlen2 ratio l1)))
(t02 (plus2 (normlen2 1.0 (diff2 p3 p2))
(normlen2 ratio l2)))
(line0 (spline3 p00 p01 p02 t00 t01 t02))
(p10 (diff2 p0 l0))
(p11 (diff2 p12 l1))
(p12 (diff2 p3 l2))
(t10 (plus2 (normlen2 1.0 (diff2 p1 p0))
(normlen2 (minus ratio) l0)))
(t11 (plus2 (normlen2 1.0 (diff2 p2 p1))
(normlen2 (minus ratio) l1)))
(t12 (plus2 (normlen2 1.0 (diff2 p3 p2))
(normlen2 (minus ratio) l2)))
(line1 (spline3 p10 p11 p12 t10 t11 t12))
(hane (hanelast p02 p12
(plus2 p02 (normlen2 w (diff2 p2 p3)))
(plus2 p12 (normlen2 w (diff2 p2 p3))))))
(list (nreverse (cons (car (last hane)) (cdr (nreverse line0))))
(append (nreverse (cdr (nreverse line1)))
hane))))
;
(comment
(defelement mincho kozato
(let ((x (car points))
(y (cadr points))
(z (caddr points)))
(niku3 x y z 0.3 0.3 0.0 (times minchowidth 0.7)(times minchowidth 1.0)(times minchowidth 0.9))))
)
; compiled fail
(defun hanelast (p0 p1 p2 p3)
(lets ((len (metric2 p0 p1)))
`(
(angle .,
(plus2 p1
(normlen2 (times len 0.2)
(diff2 p3 p1))))
(bezier .,
(plus2
p0
(plus2
(normlen2 (times len 0.5)(diff2 p1 p0))
(normlen2 (times len -0.0)(diff2 p2 p0)))))
(bezier .,
(plus2 p0
(normlen2 (times len -0.3)(diff2 p2 p0))
(normlen2 (times len 0.3)(diff2 p1 p0))))
(angle .,
(plus2 p0
(normlen2 (times len 0.8)(diff2 p0 p2)))))))
;
; 縦跳ね
;
(defelement mincho tatehane
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(x (grid (car points) dotsize))
(y (grid (cadr points) dotsize))
(z (grid (caddr points) dotsize))
(y (plus2 y (normlen2 w (diff2 x y))))
(z (plus2 z (normlen2 w (diff2 x y))))
(z (cond ((lessp (metric2 y z)(times 3.0 w))
(plus2 y (normlen2 (times 3.0 w)(diff2 z y))))
(t z)))
(len (metric2 y z))
(d0 (diff2 x y))
(l0 (normlen2 w
(list (cadr d0)(minus (car d0)))))
(d1 (diff2 y z))
(l1 (normlen2 (times w -1.0)
(list (minus (cadr d1))(car d1))))
(p0 (plus2 z l1))
(p1 (diff2 z l1))
(p2 (plus2 p0 (normlen2 (times 2.0 w) (diff2 y z))))
(p3 (plus2 p1 (normlen2 (times 2.0 w) (diff2 y z))))
(xx (plus2 y (normlen2 len d0))))
`(((angle . ,(plus2 x l0))
(angle . ,(plus2 xx l0))
(bezier . ,(plus2 xx (plus2 (normlen2 (times -0.5 len)d0)l0)))
(bezier . ,(plus2 z (plus2 (normlen2 (times 0.5 len) d1)l1)))
(angle . ,(plus2 z l1)))
((angle . ,(diff2 x l0))
(angle . ,(diff2 xx l0))
(bezier . ,(plus2 xx (diff2 (normlen2 (times -1.0 len)d0)l0)))
(bezier . ,(plus2 z (diff2 (normlen2 (times 1.0 len) d1) l1)))
.,(hanelast p0 p1 p2 p3)))))
;
; 旁の跳ね
;
(defelement mincho tsukurihane
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p3 (cadddr points))
(p2 (plus2 p2 (normlen2 w (diff2 p1 p2))))
(p3 (plus2 p3 (normlen2 w (diff2 p1 p2))))
(p3 (cond ((lessp (metric2 p2 p3)(times w 3.0))
(plus2 p2 (normlen2 (times w 3.0)(diff2 p3 p2))))
(t p3)))
(p4 (times2 0.5 (plus2 p1 p2)))
(line0 (niku3 p0 p1 p4 0.3 0.3 w w w w))
(line1 (niku3 p4 p2 p3 0.3 0.3 w w w (times w 1.2)))
(rline1 (list (reverse (car line1))(reverse (cadr line1))))
(pp0 (cdr (caar rline1)))
(pp2 (plus2 pp0
(normlen2 (times w 2.0)
(diff2 (cdr (cadar rline1)) pp0))))
(pp1 (cdr (caadr rline1)))
(pp3 (plus2 pp1
(normlen2 (times w 2.0)
(diff2 (cdr (cadadr rline1)) pp1))))
)
(list (append (car line0)(car line1))
(append (cadr line0)(nreverse (cdadr rline1))
(hanelast pp0 pp1 pp2 pp3)))))
;
; さんずい
;
(defelement mincho sanzui
(lets ((p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p3 (cadddr points))
(len0 (metric2 p2 p0))
(len1 (metric2 p2 p1))
(v0 (rot270 (diff2 p1 p0)))
(v1 '(-1.0 0.0))
(v1 (rot270 (diff2 p2 p1)))
(v2 (rot270 (diff2 p3 p1)))
(w minchowidth)
(p4 (plus2 p1 (normlen2 (times len0 0.2) (diff2 p1 p0))
(normlen2 (times w 0.3) v0)))
(p5 (plus2 p2 (normlen2 (times w 2.0) v1)))
(p6 (plus2 p2 (normlen2 (times w -2.0) v1)))
(p70 (plus2 p1 (normlen2 (times len1 0.5) (diff2 p2 p1))))
(p7 (plus2 p70 (normlen2 (times w -1.0) v1)))
(p8 (plus2 p1
(normlen2 w (diff2 p3 p1))
(normlen2 (times w 0.3) v2)))
(p9 (plus2 p1
(normlen2 w (diff2 p3 p1))
(normlen2 (times w -0.3) v2)))
(p10 (plus2 (inter2 p70 p2 0.5) (normlen2 (times w -1.3) v1)))
(p11 (plus2 (inter2 p70 p1 0.5) (normlen2 (times w -0.7) v1))))
`(((angle .,p0)
(bezier .,p4)
(bezier .,p5)
(angle .,p2)
(bezier .,p6)
(bezier .,p10)
(angle .,p7)
(bezier .,p11)
(bezier .,p8)
(angle .,p3))
((angle .,p3)
(bezier .,p9)
(bezier .,p9)
(angle .,p0)))))
(defelement mincho sanzui
(lets ((x (car points))
(y (cadr points)))
(mincho1
x
y
'((87 381 136 112)
((angle 87 381) (bezier 105 381) (bezier 114 364)
(angle 96 329) (bezier 88 313) (bezier 87 295)
(angle 93 272) (angle 136 112))
((angle 87 381) (bezier 29 380) (bezier 101 304)
(angle 23 277) (bezier 43 277) (bezier 57 278)
(angle 66 258) (angle 136 112)))
(quotient minchowidth 20.0))))
;
; こころ
;
(defelement mincho kokoro
(lets
((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(p0 (car points))
(p1 (cadr points))
(p2 (plus2 (caddr points) (normlen2 w (diff2 p0 p1))))
(p1 (plus2 p1 (normlen2 w (diff2 p0 p1))))
(p0 (grid p0 dotsize))
(p1 (grid p1 dotsize))
(p2 (grid p2 dotsize))
(p3 (grid (cadddr points) dotsize))
; (p3 (plus2 p3 (normlen2 w (diff2 p0 p1))))
(p3 (cond ((lessp (metric2 p2 p3) (times w 2.5))
(plus2 p2 (normlen2 (times w 2.5)(diff2 p3 p2))))
(t p3)))
(p4 (times2 0.5 (plus2 p1 p2)))
(len0 (metric2 p1 p4))
(len1 (metric2 p1 p0))
(p5 (cond ((lessp len1 (plus len0 minchowidth))nil)
(t(plus2 p1 (normlen2 len0 (diff2 p0 p1))))))
(p6 (plus2 p2 (times2 0.2 (diff2 p3 p2))))
(p7 (times2 0.5 (plus2 p4 p2)))
(p8 (times2 0.5 (plus2 p6 p7)))
(p9 (plus2 p6 (times2 0.1 (diff2 p3 p6))))
(line0 (cond ((null p5)(list nil nil))(t (line2 p0 p5 w))))
(line1 (niku3 (cond (p5)(t p0)) p1 p4 0.45 0.45 w w w w))
(line2 (niku3 p4 p7 p8 0.45 0.45 w w w w))
(line3 (niku3 p8 p6 p3 0.2 0.6 w w (times w 0.5) 0.0))
(line4 (niku3 p8 p6 p9 0.3 0.3 w w w w))
(line5 (niku2 p9 p3 0.2 0.8 w w (times w 0.1) 0.0))
(len (metric2 p2 p3))
(d0 (diff2 p2 p4))
(d1 (diff2 p2 p3))
(l0 (norm2 (list (minus (cadr d0))(car d0))))
(l1 (norm2 (list (cadr d1)(minus (car d1)))))
)
(list (append (car line0)(car line1)(car line2)(car line4)(car line5))
(append(cadr line0)(cadr line1)(cadr line2)(cadr line3)))))
(comment
(defelement mincho kokoro
(lets ((p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p3 (fourth points))
(w (times minchowidth 0.9))
(p00 (plus2 p0 (normlen2 w (diff2 p1 p2))))
(p01 (diff2 p0 (normlen2 w (diff2 p1 p2))))
(p10 (plus2 p1 (normlen2 w (diff2 p1 p2))))
(p11 (plus2 p1 (normlen2 w (diff2 p2 p1))
(normlen2 (times w 2) (diff2 p0 p1))))
(p20 (plus2 p2 (normlen2 (times w 2.0)(diff2 p2 p1))))
(p21 (plus2 p2 (normlen2 (times w 2.0) (diff2 p3 p2))))
(p40 (plus2 p10 (normlen2 (times w 3.0) (diff2 p00 p10))))
(p41 (plus2 p11 (normlen2 (times w 2.0) (diff2 p01 p11))))
(p50 (plus2 p10 (normlen2 (times w 3.0) (diff2 p2 p10))))
(p51 (plus2 p11 (normlen2 (times w 2.0) (diff2 p21 p11))))
(p60 (plus2 p2 (normlen2 (times w 2.0) (diff2 p1 p2))))
(p61 (plus2 p21 (normlen2 (times w 2.0) (diff2 p11 p21))))
(p7 (plus2 p21 (normlen2 (times w 1.0) (diff2 p21 p11))))
)
`(((angle .,p00)(angle .,p40)(bezier .,p10)
(bezier .,p10)(angle .,p50)(angle .,p60)
(bezier .,(inter2 p60 p20 0.67))
(bezier .,p20)(angle .,p7)
(bezier .,(plus2 p7 (normlen2 w (diff2 p7 p20))))
(bezier .,(plus2 p3 (normlen2 (times w 3.0) (diff2 (inter2 p2 p20 0.5) p3))))
(angle .,p3)
)
((angle .,p01)(angle .,p41)(bezier .,p11)
(bezier .,p11)(angle .,p51)(angle .,p61)
(bezier .,(inter2 p61 p21 0.67))
(bezier .,p21)(angle .,p3)))))
)
;
; たすき
;
(defelement mincho tasuki
(lets
((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p3 (cadddr points))
(p4 (times2 0.5 (plus2 p1 p2)))
; (line1 (niku3 p0 p1 p4 0.3 0.3 w w w w))
; (line2 (niku3 p4 p2 p3 0.45 0.45 w (times w 1.0)(times w 0.5) 0.0))
; (line1 (bez3 p0 p1 p4 w w w w 1.0 1.0))
; (line2 (bez3 p4 p2 p3 w (times w 1.0)(times w 0.5) 0.0 1.0 1.0))
(line1 (curve2 p0 (inter2 p0 p1 0.7)(inter2 p4 p1 0.7) p4 w w w w))
(line2 (curve2 p4 (inter2 p4 p2 0.7)(inter2 p3 p2 0.7) p3
w (times w 1.0)(times w 0.5) 0.0))
(len (metric2 p2 p3))
(d0 (diff2 p2 p4))
(d1 (diff2 p2 p3))
(l0 (norm2 (list (minus (cadr d0))(car d0))))
(l1 (norm2 (list (cadr d1)(minus (car d1)))))
(line3
`((bezier .,(plus2 p2 (times2 w l0)))
(bezier .,(plus2 p3
(plus2 (normlen2 (times len 1.2)d1)(times2 w l1))))
(angle .,(plus2 p3
(plus2 (normlen2 (times len 0.8)d1)(times2 w l1))))
(bezier .,(plus2 p3
(plus2 (normlen2 (times len 0.5)d1)(times2 w l1))))
(bezier .,(plus2 p3(normlen2 (times len 0.9)d1))))))
(list(append (car line1)line3)
(append (cadr line1)(cadr line2)))))
;
; まがりたて
;
(defelement mincho magaritate
(lets
((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(w1 (times w 0.9))
(p0 (car points))
(p1 (cadr points))
(p2 (caddr points)))
(niku3 p0 p1 p2 0.4 0.4 w w1 w1 w)))
;
; かぎ
;
;(defelement mincho kagi
; (lets
; ((p0 (car points))
; (p1 (cadr points))
; (p2 (caddr points))
; (p0 (list (float (car p0))(float (cadr p0))))
; (p1 (list (float (car p1))(float (cadr p1))))
; (p2 (list (float (car p2))(float (cadr p2))))
; (w (times minchowidth 0.9))
; (p1 (plus2 p1 (normlen2 w (diff2 p0 p1))))
; (p2 (plus2 p2 (normlen2 w (diff2 p0 p1))))
; (p3 (times2 0.5 (plus2 p1 p2)))
; (len0 (metric2 p1 p3))
; (len1 (metric2 p0 p1))
; (p4 (cond ((greaterp len0 len1)p0)
; (t (plus2 p1(normlen2 len0 (diff2 p0 p1))))))
; (line0 (cond ((eq p0 p4)'(nil nil))(t(niku2 p0 p4 0.4 0.4 w w w w))))
; (line1 (niku3 p4 p1 p3 0.45 0.45 w w w w))
; (line2 (niku2 p3 p2 0.4 0.4 w w w w)))
; (list (append (car line0)(car line1)(car line2))
; (append (cadr line0)(cadr line1)(cadr line2)))))
;
(defelement mincho kagi
(lets ((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p00 (plus2 p0 (normlen2 w (diff2 p1 p2))))
(p01 (diff2 p0 (normlen2 w (diff2 p1 p2))))
(p10 (plus2 p1 (normlen2 w (diff2 p1 p2))))
(p11 (plus2 p1 (normlen2 w (diff2 p2 p1))
(normlen2 (times w 2) (diff2 p0 p1))))
(p21 (plus2 p2 (normlen2 (times w 2) (diff2 p0 p1))))
(p30 (plus2 p10 (normlen2 (times w 3.0) (diff2 p00 p10))))
(p31 (plus2 p11 (normlen2 (times w 2.0) (diff2 p01 p11))))
(p40 (plus2 p10 (normlen2 (times w 3.0) (diff2 p2 p10))))
(p41 (plus2 p11 (normlen2 (times w 2.0) (diff2 p21 p11)))))
`(((angle .,p00)(angle .,p30)(bezier .,p10)
(bezier .,p10)(angle .,p40)(angle .,p2))
((angle .,p01)(angle .,p31)(bezier .,p11)
(bezier .,p11)(angle .,p41)(angle .,p21)))))
;
;しんにゅう
;
(defelement mincho shin-nyuu
(lets
((dotsize (meshwidth (times minchowidth 0.9)))
(w (times meshsize 0.5 dotsize))
(p0 (car points))
(p1 (cadr points))
(p2 (caddr points))
(p0 (list (float (car p0))(float (cadr p0))))
(p1 (list (float (car p1))(float (cadr p1))))
(p2 (list (float (car p2))(float (cadr p2))))
(len1 (metric2 p0 p1))
(len2 (metric2 p1 p2))
(len (plus len1 len2)))
(niku3 p0 p1 p2 (times 0.5 (quotient len1 len))(times 0.9 (quotient len2 len))
(times w 0.2) (times w 0.4)(times w 1.1)(times w 1.1))))
; ライブラリをexfileする
(cond ((definedp 'kanjilib))
(t (exfile 'lib.l)))
(defelement mincho yoko
(lets ((dotsize (meshwidth (times minchowidth tateyokoratio)))
(w (normwidth dotsize))
(p0 (gridy (car points) dotsize))
(p1 (gridy (cadr points) dotsize)))
(cond ((lessp (times 0.2 w) meshsize)
(line2 p0 p1 w))
(t
(niku2 p0 p1 0.3 0.3 w (times w 0.8)(times w 0.8) w)))))