[wadalabfont-kit] / lisp / souchou.l  

Annotation of /lisp/souchou.l

Parent Directory | Revision Log

Revision: 1.1.1.1 - (view) (download)

1 : ktanaka 1.1 (subfont souchou mincho)
2 :     ;
3 :     (defun curve2 (p1 p2 dp1 dp2 w1 w2 dw1 dw2 ti)
4 :     (lets ((titi (times ti ti))
5 :     (ddp1 (plus2 (times2 (quotient 6.0 titi)
6 :     (diff2 p2 p1))
7 :     (times2 (quotient -4.0 ti) dp1)
8 :     (times2 (quotient -2.0 ti) dp2)))
9 :     (ddp2 (plus2 (times2 (quotient 6.0 titi)
10 :     (diff2 p1 p2))
11 :     (times2 (quotient 4.0 ti) dp2)
12 :     (times2 (quotient 2.0 ti) dp1)))
13 :     (dp1_ddp1 (mul2 dp1 ddp1))
14 :     (dp2_ddp2 (mul2 dp2 ddp2))
15 :     (lendp1 (length2 dp1))
16 :     (lendp2 (length2 dp2))
17 :     (lendp1_3 (quotient 1.0 (times lendp1 lendp1 lendp1)))
18 :     (lendp2_3 (quotient 1.0 (times lendp2 lendp2 lendp2)))
19 :     (a1 (plus2 p1 (normlen2 w1 (rot270 dp1))))
20 :     (a2 (plus2 p2 (normlen2 w2 (rot270 dp2))))
21 :     (b1 (diff2 p1 (normlen2 w1 (rot270 dp1))))
22 :     (b2 (diff2 p2 (normlen2 w2 (rot270 dp2))))
23 :     )
24 :     ; (break)
25 :     `(((angle .,a1)
26 :     (,test
27 :     .,(plus2 a1
28 :     (times2 (quotient ti 3.0)
29 :     (plus2 dp1
30 :     (times2 (quotient dw1 lendp1) (rot270 dp1))
31 :     (times2 (quotient w1 lendp1) (rot270 ddp1))
32 :     (times2 (times -1.0 w1 dp1_ddp1 lendp1_3)
33 :     (rot270 dp1))))))
34 :     (,test
35 :     .,(plus2 a2
36 :     (times2 (quotient ti -3.0)
37 :     (plus2 dp2
38 :     (times2 (quotient dw2 lendp2)(rot270 dp2))
39 :     (times2 (quotient w2 lendp2) (rot270 ddp2))
40 :     (times2 (times -1.0 w2 dp2_ddp2 lendp2_3)
41 :     (rot270 dp2))))))
42 :     (angle .,a2))
43 :     ((angle .,b1)
44 :     (,test
45 :     .,(plus2 b1
46 :     (times2 (quotient ti 3.0)
47 :     (plus2 dp1
48 :     (times2 (quotient dw1 lendp1) (rot90 dp1))
49 :     (times2 (quotient w1 lendp1) (rot90 ddp1))
50 :     (times2 (times -1.0 w1 dp1_ddp1 lendp1_3)
51 :     (rot90 dp1))
52 :     ))))
53 :     (,test
54 :     .,(plus2 b2
55 :     (times2 (quotient ti -3.0)
56 :     (plus2 dp2
57 :     (times2 (quotient dw2 lendp2) (rot90 dp2))
58 :     (times2 (quotient w2 lendp2) (rot90 ddp2))
59 :     (times2 (times -1.0 w2 dp2_ddp2 lendp2_3)
60 :     (rot90 dp2))))))
61 :     (angle .,b2)))))
62 :     ;
63 :     (defkazari souchou (ten 2 ten 3)
64 :     (lets ((p0 (vref cross 0))
65 :     (p1 (vref cross 1))
66 :     (p2 (vref cross 2))
67 :     (p3 (vref cross 3))
68 :     (p4 (times2 0.5 (plus2 p0 p1)))
69 :     (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1))))
70 :     (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0)))))
71 :     `((angle .,p6)
72 :     (angle .,p4)
73 :     (angle .,p5))))
74 :     ;
75 :     (setq souchouwidth 12.0)
76 :     (defelement souchou ten
77 :     (lets ((p0 (car points))
78 :     (p1 (cadr points))
79 :     (w souchouwidth)
80 :     (l1 (normlen2 w (rot90 (diff2 p1 p0))))
81 :     (p2 (plus2 p1 l1))
82 :     (len (metric2 p0 p2))
83 :     (p02 (plus2 (inter2 p0 p2 0.5)(normlen2 (times len 0.05) l1)))
84 :     (d0 (times2 2 (diff2 p02 p0)))
85 :     (d2 (times2 2 (diff2 p2 p02)))
86 :     (dw (quotient w len)))
87 :     (curve2 p0 p2 d0 d2 0 w w w 1)))
88 :     (defelement souchou hidari
89 :     (lets ((p0 (car points))
90 :     (p1 (cadr points))
91 :     (p2 (caddr points))
92 :     (w souchouwidth)
93 :     (d0 (times2 2 (diff2 p1 p0)))
94 :     (d2 (times2 2.5 (diff2 p2 p1)))
95 :     (len1 (metric2 p0 p1))
96 :     (len2 (metric2 p1 p2))
97 :     (len (plus len1 len2))
98 :     (dw1 (quotient (times -0.5 w len) len))
99 :     (dw2 (times w -2)))
100 :     (curve2 p0 p2 d0 d2 w 0 dw1 dw2 1)))

ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help