View of /primdata/prim-test.lView of /primdata/prim-test.l
Parent Directory
| 
Revision Log
change to CVS wadalab font project
(setq mu '(((91 49)
(138 62)
(138 75)
(135 248)
(113 272)
(67 275)
(56 235)
(113 178)
(138 234)
(135 327)
(333 316)
(327 282)
(321 230)
(25 122)
(81 140)
(210 123)
(229 123)
(280 80)
(314 103)
(337 140)
(342 149))
((hira-long
(0 1 2 3 4 5 6 7 8 9 10 11 12)
(hirawidth 3 23 17 18 16 18 12 8 18 23 23 8 3))
(hira-long (13 14 15 16) (hirawidth 5 19 25 14))
(hira-long (17 18 19 20) (hirawidth 5 13 18 12)))))
(macro diff (x) `(difference .,x))
(defelement mincho hira-long
(lets ((npoints (length points))
(array (vector (* npoints npoints) 0.0))
(ti
(vector (1- npoints)
(do ((l points (cdr l))
(ret))
((atom (cdr l))(nreverse ret))
(push (exp (times 0.6666
(log (metric2 (car l)(cadr l))))) ret))))
(titi (vector (1- npoints)))
(pi
(vector npoints
(do ((l points (cdr l))
(ret))
((atom l)(nreverse ret))
(push (car l) ret))))
(bix (vector (1- (* npoints 2))))(biy (vector (1- (* npoints 2))))
(dpi (vector (1- (* npoints 2))))
(ddpi (vector (1- (* npoints 2))))
(dpir (vector (1- (* npoints 2))))
(ddpir (vector (1- (* npoints 2))))
(dpix (vector (1- (* npoints 2))))(dpiy (vector (1- (* npoints 2))))
(bi (vector (1- (* npoints 2))))
(hwlist (assq 'hirawidth alist))
(wi (cond (hwlist
(vector npoints
(do ((l (cdr hwlist)(cdr l))
(ret))
((atom l)(nreverse ret))
(push (times (car l) hirawidth) ret))))
(t
(vector npoints *default-hirawidth*))))
(bwi (vector (1- (* npoints 2))))
(dwi (vector (1- (* npoints 2))))
(dxi1 (vector (1- (* npoints 2))))
(dxi2 (vector (1- (* npoints 2))))
(dlen (vector (1- (* npoints 2))))
(dlen2 (vector (1- (* npoints 2))))
(s0)(s00)(s01)(s1)(s10)(s11)
)
(do ((i 0 (1+ i)))((>= i (1- npoints)))
(vset titi i (times (vref ti i)(vref ti i))))
(vset array 0 (quotient 2.0 (vref ti 0)))
(vset array 1 (quotient 1.0 (vref ti 0)))
(vset bi 0 (times2 (quotient 3.0 (vref titi 0))
(diff2 (vref pi 1)(vref pi 0))))
(vset bwi 0 (times (quotient 3.0 (vref titi 0))
(difference (vref wi 1)(vref wi 0))))
(do ((i 0 (1+ i))
(j npoints (+ j npoints)))
((>= i (- npoints 2)))
(vset array (+ j i) (quotient 1.0 (vref ti i)))
(vset array (+ j i 1)(plus (quotient 2.0 (vref ti i))
(quotient 2.0 (vref ti (1+ i)))))
(vset array (+ j i 2) (quotient 1.0 (vref ti (1+ i))))
(vset bi (1+ i )
(plus2
(times2 (quotient -3.0 (vref titi i))(vref pi i))
(times2 (difference (quotient 3.0 (vref titi i))
(quotient 3.0 (vref titi (1+ i))))(vref pi (1+ i)))
(times2 (quotient 3.0 (vref titi (1+ i)))(vref pi (+ i 2)))))
(vset bwi (1+ i)
(plus (times (quotient -3.0 (vref titi i))(vref wi i))
(times (difference (quotient 3.0 (vref titi i))
(quotient 3.0 (vref titi (1+ i))))
(vref wi (1+ i)))
(times (quotient 3.0 (vref titi (1+ i)))
(vref wi (+ i 2))))))
(vset array (- (* npoints npoints) 2)
(quotient 1.0 (vref ti (- npoints 2))))
(vset array (1- (* npoints npoints))
(quotient 2.0 (vref ti (- npoints 2))))
(vset bi (1- npoints)
(times2 (quotient 3.0 (vref titi (- npoints 2)))
(diff2 (vref pi (1- npoints))(vref pi (- npoints 2)))))
(vset bwi (1- npoints)
(times (quotient 3.0 (vref titi (- npoints 2)))
(difference (vref wi (1- npoints))(vref wi (- npoints 2)))))
(do ((i 0 (1+ i)))((>= i npoints))
(vset bix i (car (vref bi i)))
(vset biy i (cadr (vref bi i)))
(vset dpix i 0.0)
(vset dpiy i 0.0)
(vset dwi i 0.0)
)
(gs npoints array dpix bix)
(gs npoints array dpiy biy)
(gs npoints array dwi bwi)
(do ((i 0 (1+ i)))((>= i npoints))
(vset dpi i `(,(vref dpix i) ,(vref dpiy i))))
(do ((i 0 (1+ i)))((>= i npoints))
(vset dwi i (times 0.2 (vref dwi i))))
; (print dwi)
; (vset ddpi 0 '(0.0 0.0))
(do ((i 0 (1+ i)))
((>= i (1- npoints)))
(setq len (metric2 (vref pi i)(vref pi (1+ i))))
(setq n (fix (quotient (plus len 10) 20)))
(setq p1 (vref pi i) dp1 (vref dpi i) w1 (vref wi i) dw1 (vref dwi i))
(setq p2 (vref pi (1+ i)) dp2 (vref dpi (1+ i))
w2 (vref wi (1+ i)) dw2 (vref dwi (1+ i)))
(setq t1 (vref ti i))
(setq t2 (times t1 t1) t3 (times t1 t1 t1))
(do ((j 0 (1+ j)))
((> j n))
(setq tt (times j (quotient (vref ti i) n)))
(setq tt1 tt)
(setq tt2 (times tt tt) tt3 (times tt tt tt))
(setq p
(plus2
(times2 (quotient (times 2 tt3) t3)
(diff2 p1 p2))
(times2 (quotient tt3 t2)
(plus2 dp1 dp2))
(times2 (quotient (times 3 tt2) t2)
(diff2 p2 p1))
(times2 (times -1.0 (quotient tt2 t1))
(plus2 dp1 dp1 dp2))
(times2 tt1 dp1)
p1))
(setq dp
(plus2
(times2 (quotient (times 6 tt2) t3)
(diff2 p1 p2))
(times2 (quotient (times 3 tt2) t2)
(plus2 dp1 dp2))
(times2 (quotient (times 6 tt1) t2)
(diff2 p2 p1))
(times2 (times -2.0 (quotient tt1 t1))
(plus2 dp1 dp1 dp2))
dp1))
(setq w
(plus
(times (quotient (times 2 tt3) t3)
(diff w1 w2))
(times (quotient tt3 t2)
(plus dw1 dw2))
(times (quotient (times 3 tt2) t2)
(diff w2 w1))
(times (times -1.0 (quotient tt2 t1))
(plus dw1 dw1 dw2))
(times tt1 dw1)
w1))
(setq dw
(plus
(times (quotient (times 6 tt2) t3)
(diff w1 w2))
(times (quotient (times 3 tt2) t2)
(plus dw1 dw2))
(times (quotient (times 6 tt1) t2)
(diff w1 w2))
(times (times -2.0 (quotient tt1 t1))
(plus dw1 dw1 dw2))
dw1))
(format "/c /c /c /c daen/n" (fix (car p))(- 400 (fix (cadr p)))
(fix (times 360 (quotient (theta dp '(1.0 0.0)) 6.2832))) (fix w))))
(setq p (vref pi (1- npoints)) dp (vref dpi (1- npoints))
w (vref wi (1- npoints)))
(format "/c /c /c /c daen/n" (fix (car p))(- 400 (fix (cadr p)))
(fix (times 360 (quotient (theta dp '(1.0 0.0)) 6.2832))) (fix w))
(vset ddpi (1- npoints) '(0.0 0.0))
(do ((i 0 (1+ i)))
((>= i (1- npoints)))
(vset ddpi i
(plus2
(times2
(quotient 6.0 (vref titi i))
(diff2 (vref pi (1+ i))(vref pi i)))
(times2
(quotient -4.0 (vref ti i))
(vref dpi i))
(times2
(quotient -2.0 (vref ti i))
(vref dpi (1+ i)))
)))
(do ((i 0 (1+ i))(tmp))((>= i npoints))
(vset dlen i (setq tmp (quotient 1.0 (length2 (vref dpi i)))))
(vset dlen2 i (times tmp tmp)))
(do ((i 0 (1+ i))(x)(y))((>= i npoints))
(setq x (times (vref dlen i)(car (vref dpi i)))
y (times (vref dlen i)(cadr (vref dpi i))))
(vset dpir i
(vector 6 `(,x ,y ,y ,(minus x) 0 0)))
(setq x (times (vref dlen i)(car (vref ddpi i)))
y (times (vref dlen i)(cadr (vref ddpi i))))
(vset ddpir i
(vector 6 `(,x ,y ,y ,(minus x) 0 0))))
; (break)
(do ((i 0 (1+ i)))((>= i npoints))
(vset dxi1 i
(plus2 (vref dpi i)
(affine `(0 ,(minus (vref dwi i)))(vref dpir i))
(affine `(0 ,(minus (vref wi i)))(vref ddpir i))
(times2 (times -1.0 (mul2 (vref dpi i)(vref ddpi i))
(vref dlen2 i))
(affine `(0 ,(minus (vref wi i)))(vref dpir i)))
))
(vset dxi2 i
(plus2 (vref dpi i)
(affine `(0 ,(vref dwi i))
(vref dpir i))
(affine `(0 ,(vref wi i))(vref ddpir i))
(times2 (times -1.0 (mul2 (vref dpi i)(vref ddpi i))
(vref dlen2 i))
(affine `(0 ,(vref wi i))
(vref dpir i)))
)
))
; (break)
(setq d0 (normlen2 (times -0.8 (vref wi 0))(vref dpi 0)))
(setq l0 (length2 d0))
(setq l0 (times l0 l0))
(setq s0 (plus2 (vref pi 0) d0))
(cond
((plusp (vref wi 0))
(setq p00 (plus2 (vref pi 0)
(affine `(0 ,(minus (vref wi 0)))(vref dpir 0))))
(setq p01 (plus2 (vref pi 0)(affine `(0 ,(vref wi 0))(vref dpir 0))))
(setq s00 (plus2 p00 (times2 (quotient l0
(mul2 (vref dxi1 0) d0))
(vref dxi1 0))))
(setq s01 (plus2 p01 (times2 (quotient l0
(mul2 (vref dxi2 0)d0))
(vref dxi2 0))))))
(setq d1 (normlen2 (times 0.8 (vref wi (1- npoints)))
(vref dpi (1- npoints))))
(setq l1 (length2 d1))
(setq l1 (times l1 l1))
(setq s1 (plus2 (vref pi (1- npoints)) d1))
(cond
((plusp (vref wi (1- npoints)))
(setq p10 (plus2 (vref pi (1- npoints))
(affine `(0 ,(minus (vref wi (1- npoints))))
(vref dpir (1- npoints)))))
(setq p11 (plus2 (vref pi (1- npoints))
(affine `(0 ,(vref wi (1- npoints)))
(vref dpir (1- npoints)))))
(setq s10 (plus2 p10 (times2 (quotient l1
(mul2 (vref dxi1 (1- npoints))
d1))
(vref dxi1 (1- npoints)))))
(setq s11 (plus2 p11 (times2 (quotient l1
(mul2 (vref dxi2 (1- npoints))
d1))
(vref dxi2 (1- npoints)))))))
(setq test 'bezier)
(do ((i 0 (1+ i))
(ret1 (and (plusp (vref wi 0))
`((,test .,(inter2 p00 s00 circle-ratio))
(,test .,(inter2 s0 s00 circle-ratio))
(angle .,s0))))
(ret2 (and (plusp (vref wi 0))
`((,test .,(inter2 p01 s01 circle-ratio))
(,test .,(inter2 s0 s01 circle-ratio))
(angle .,s0))))
(p0)(p1))
((>= i (1- npoints))
(cond ((plusp (vref wi (1- npoints)))
(push `(angle .,p10) ret1)
(push `(,test .,(inter2 p10 s10 circle-ratio)) ret1)
(push `(,test .,(inter2 s1 s10 circle-ratio)) ret1)))
(push `(angle .,s1) ret1)
(cond ((plusp (vref wi (1- npoints)))
(push `(angle .,p11) ret2)
(push `(,test .,(inter2 p11 s11 circle-ratio)) ret2)
(push `(,test .,(inter2 s1 s11 circle-ratio)) ret2)))
(push `(angle .,s1) ret2)
`(,(reverse ret1) ,(reverse ret2)))
(setq p1 (plus2 (vref pi i)(affine `(0 ,(vref wi i))(vref dpir i))))
(setq p2 (plus2 (vref pi (1+ i))
(affine `(0 ,(vref wi (1+ i)))(vref dpir (1+ i)))))
(push `(angle .,p1) ret2)
(push `(,test .,(plus2 p1
(times2 (quotient (vref ti i) 3.0)
(vref dxi2 i)))) ret2)
(push `(,test .,(diff2 p2
(times2 (quotient (vref ti i) 3.0)
(vref dxi2 (1+ i))))) ret2)
(setq p1 (plus2 (vref pi i)(affine `(0 ,(minus (vref wi i)))
(vref dpir i))))
(setq p2 (plus2 (vref pi (1+ i))
(affine `(0 ,(minus (vref wi (1+ i))))
(vref dpir (1+ i)))))
(push `(angle .,p1) ret1)
(push `(,test .,(plus2 p1
(times2 (quotient (vref ti i) 3.0)
(vref dxi1 i)))) ret1)
(push `(,test .,(diff2 p2
(times2 (quotient (vref ti i) 3.0)
(vref dxi1 (1+ i))))) ret1))))
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |