Revision Log
Revision: 1.6 - (view) (download)
| 1 : | ktanaka | 1.1 | ; 単位は400*400の座標系 |
| 2 : | ktanaka | 1.4 | (declare (minchowidth tateyokoratio minchoheight tatekazari tome1 kazariheight tomeheight meshsize mw) special) |
| 3 : | ktanaka | 1.5 | ; mwはmincho-primの中で設定される |
| 4 : | ; (setq mw minchowidth) | ||
| 5 : | ktanaka | 1.1 | ; |
| 6 : | ; ライブラリをexfileする | ||
| 7 : | (cond ((definedp 'kanjilib)) | ||
| 8 : | (t (exfile 'lib.l))) | ||
| 9 : | |||
| 10 : | ; | ||
| 11 : | (defkazari mincho (yoko 0 yoko 1) | ||
| 12 : | (lets ((p0 (vref cross 0)) | ||
| 13 : | (p1 (vref cross 1)) | ||
| 14 : | (p2 (vref cross 2)) | ||
| 15 : | (p3 (vref cross 3))) | ||
| 16 : | `((angle .,(inter2 p0 p2 0.5)) | ||
| 17 : | (angle .,(inter2 p1 p3 -0.5))))) | ||
| 18 : | ; | ||
| 19 : | (defkazari mincho ((migi shin-nyuu) 0 (migi shin-nyuu) 1) | ||
| 20 : | (lets ((p0 (vref cross 0)) | ||
| 21 : | (p1 (vref cross 1)) | ||
| 22 : | (p2 (vref cross 2)) | ||
| 23 : | (p3 (vref cross 3))) | ||
| 24 : | `((angle .,p2) | ||
| 25 : | (bezier .,p0) | ||
| 26 : | (bezier .,p1) | ||
| 27 : | (angle .,p3)))) | ||
| 28 : | ; | ||
| 29 : | (defkazari mincho (hidari 2 hidari 3) | ||
| 30 : | (lets ((p0 (vref cross 0)) | ||
| 31 : | (p1 (vref cross 1)) | ||
| 32 : | (p2 (vref cross 2)) | ||
| 33 : | (p3 (vref cross 3))) | ||
| 34 : | `((angle .,p2) | ||
| 35 : | (bezier .,p0) | ||
| 36 : | (bezier .,p1) | ||
| 37 : | (angle .,p3)))) | ||
| 38 : | ; | ||
| 39 : | (defkazari mincho (migiue 0 migiue 1) | ||
| 40 : | (lets ((p0 (vref cross 1)) | ||
| 41 : | (p1 (vref cross 0)) | ||
| 42 : | (p2 (vref cross 3)) | ||
| 43 : | (p3 (vref cross 2)) | ||
| 44 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 45 : | (len (metric2 p0 p1)) | ||
| 46 : | (theta (theta d0 '(0.0 1.0))) | ||
| 47 : | (psi 1.4) | ||
| 48 : | (cospsi (cos psi)) | ||
| 49 : | (sinpsi (sin psi)) | ||
| 50 : | (p4 (inter2 p1 p3 (times 0.5 cospsi))) | ||
| 51 : | (p5 (inter2 p0 p2 (times -0.5 cospsi))) | ||
| 52 : | (w (times mw tatekazari)) | ||
| 53 : | (fai (plus psi 0.6)) | ||
| 54 : | (w1 (times 0.8 (times 0.82 w))) | ||
| 55 : | (p6 (plus2 p4 (normlen2 w1 d0))) | ||
| 56 : | (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1)) | ||
| 57 : | (normlen2 (sin fai)(diff2 p1 p0)))) | ||
| 58 : | (p7 (cross2 p4 p6 (diff2 p4 p5) dp6)) | ||
| 59 : | (len0 (metric2 p7 p6)) | ||
| 60 : | (len1 (metric2 p7 p5)) | ||
| 61 : | (len2 (quotient len1 3.0)) | ||
| 62 : | ) | ||
| 63 : | (cond ((lessp len1 len0) | ||
| 64 : | `( | ||
| 65 : | (angle .,p6) | ||
| 66 : | (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7)))) | ||
| 67 : | (bezier .,p7) | ||
| 68 : | (angle .,(plus2 p7 (normlen2 len0 (diff2 p5 p7)))) | ||
| 69 : | (angle .,p5))) | ||
| 70 : | (t | ||
| 71 : | `((angle .,p6) | ||
| 72 : | (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7)))) | ||
| 73 : | (bezier .,p7) | ||
| 74 : | (angle .,p5)))))) | ||
| 75 : | ; | ||
| 76 : | (defkazari mincho (yoko 2 yoko 3) | ||
| 77 : | (lets ((p0 (vref cross 0)) | ||
| 78 : | (p1 (vref cross 1)) | ||
| 79 : | (p2 (vref cross 2)) | ||
| 80 : | (p3 (vref cross 3)) | ||
| 81 : | (w tome1) | ||
| 82 : | (len0 (metric2 p0 p1)) | ||
| 83 : | (w1 (plus w len0)) | ||
| 84 : | (w2 (times w1 1.3)) | ||
| 85 : | (p4 (plus2 p0 (normlen2 (times w2 0.25) (diff2 p0 p2)))) | ||
| 86 : | (p5 (plus2 p4 (normlen2 w2 (diff2 p2 p0))(normlen2 w1 (diff2 p1 p0)))) | ||
| 87 : | (p6 (plus2 p4 (normlen2 (plus w2 (times 0.7 w))(diff2 p2 p0)) | ||
| 88 : | (normlen2 len0 (diff2 p1 p0)))) | ||
| 89 : | (p7 (inter2 p4 p5 0.5)) | ||
| 90 : | (p8 (plus2 p4 (normlen2 (times w2 0.5)(diff2 p2 p0))))) | ||
| 91 : | `((angle .,p8) | ||
| 92 : | (bezier .,(inter2 p8 p4 0.66666)) | ||
| 93 : | (bezier .,(inter2 p7 p4 0.66666)) | ||
| 94 : | (angle .,p7) | ||
| 95 : | (angle .,p5) | ||
| 96 : | (angle .,p6)))) | ||
| 97 : | ; | ||
| 98 : | (defkazari mincho ((tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 0 | ||
| 99 : | (tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 1) | ||
| 100 : | (lets ((p0 (vref cross 0)) | ||
| 101 : | (p1 (vref cross 1)) | ||
| 102 : | (p2 (vref cross 2)) | ||
| 103 : | (p3 (vref cross 3)) | ||
| 104 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 105 : | (len (metric2 p0 p1)) | ||
| 106 : | (theta (theta d0 '(0.0 1.0))) | ||
| 107 : | (theta (cond ((plusp theta)0)(theta))) | ||
| 108 : | (psi (plus 1.32 (times theta -0.85))) | ||
| 109 : | (cospsi (cos psi)) | ||
| 110 : | (sinpsi (sin psi)) | ||
| 111 : | (p4 (inter2 p1 p3 (times 0.5 cospsi))) | ||
| 112 : | (p5 (inter2 p0 p2 (times -0.5 cospsi))) | ||
| 113 : | ; (w (times mw tatekazari)) | ||
| 114 : | (w (times (metric2 p0 p1) tatekazari 0.5)) | ||
| 115 : | (fai (plus psi 0.8)) | ||
| 116 : | (w1 (times 1.2 w)) | ||
| 117 : | (p6 (plus2 p4 (normlen2 w1 d0))) | ||
| 118 : | (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1)) | ||
| 119 : | (normlen2 (sin fai)(diff2 p1 p0)))) | ||
| 120 : | (p7 (cross2 p4 p6 (diff2 p4 p5) dp6)) | ||
| 121 : | (len0 (metric2 p7 p6)) | ||
| 122 : | (len1 (metric2 p7 p5)) | ||
| 123 : | (len2 (quotient len1 3.0)) | ||
| 124 : | ) | ||
| 125 : | (cond ((lessp len1 len0) | ||
| 126 : | `((angle .,p5) | ||
| 127 : | (angle .,(plus2 p7 (normlen2 (min len0 (metric2 p5 p7)) | ||
| 128 : | (diff2 p5 p7)))) | ||
| 129 : | (bezier .,p7) | ||
| 130 : | (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7)))) | ||
| 131 : | (angle .,p6)) | ||
| 132 : | ) | ||
| 133 : | (t | ||
| 134 : | `((angle .,p5) | ||
| 135 : | (bezier .,p7) | ||
| 136 : | (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7)))) | ||
| 137 : | (angle .,p6)))))) | ||
| 138 : | ; | ||
| 139 : | ; (break) | ||
| 140 : | ; `((angle .,p5) | ||
| 141 : | ; (bezier ., | ||
| 142 : | ; (plus2 p4 (normlen2 (times 0.2 len) (diff2 p4 p5)))) | ||
| 143 : | ; (bezier ., | ||
| 144 : | ; (plus2 p4 (normlen2 (times 0.5 len) (diff2 p4 p5)))) | ||
| 145 : | ; (angle ., | ||
| 146 : | ; (plus2 p4 (normlen2 (times len 0.4) d0)))))) | ||
| 147 : | |||
| 148 : | ; | ||
| 149 : | (defkazari mincho (migi 2 migi 3) | ||
| 150 : | (lets ((p0 (vref cross 0)) | ||
| 151 : | (p1 (vref cross 1)) | ||
| 152 : | (p2 (vref cross 2)) | ||
| 153 : | (p3 (vref cross 3)) | ||
| 154 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 155 : | (len (metric2 p0 p1)) | ||
| 156 : | (sintheta (times -0.4 (car d0)))) | ||
| 157 : | `((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0)))) | ||
| 158 : | (bezier ., | ||
| 159 : | (plus2 p2 | ||
| 160 : | (times2 (plus 0.4 sintheta)(diff2 p1 p3)) | ||
| 161 : | (times2 0.3 (diff2 p3 p2)))) | ||
| 162 : | (bezier ., | ||
| 163 : | (plus2 p3 | ||
| 164 : | (times2 (plus 0.6 sintheta)(diff2 p1 p3)) | ||
| 165 : | (times2 0.2 (diff2 p2 p3)))) | ||
| 166 : | (angle ., | ||
| 167 : | (plus2 p3 (times2 (plus 0.9 sintheta)(diff2 p1 p3))))))) | ||
| 168 : | ; | ||
| 169 : | (defkazari mincho (shin-nyuu 2 shin-nyuu 3) | ||
| 170 : | (lets ((p0 (vref cross 0)) | ||
| 171 : | (p1 (vref cross 1)) | ||
| 172 : | (p2 (vref cross 2)) | ||
| 173 : | (p3 (vref cross 3)) | ||
| 174 : | (len (metric2 p0 p1))) | ||
| 175 : | `((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0)))) | ||
| 176 : | (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0)))) | ||
| 177 : | (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0)))) | ||
| 178 : | (angle .,(plus2 p1 (times2 0.7 (diff2 p1 p3))))))) | ||
| 179 : | ; | ||
| 180 : | (defkazari mincho ((tate magaritate kagi)2 (tate magaritate kagi) 3) | ||
| 181 : | (lets ((p0 (vref cross 0)) | ||
| 182 : | (p1 (vref cross 1)) | ||
| 183 : | (p2 (vref cross 2)) | ||
| 184 : | (p3 (vref cross 3)) | ||
| 185 : | (p4 (times2 0.5 (plus2 p0 p1))) | ||
| 186 : | (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1)))) | ||
| 187 : | (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0))))) | ||
| 188 : | `((angle .,p6) | ||
| 189 : | (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6)))) | ||
| 190 : | (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4)))) | ||
| 191 : | (angle .,p4) | ||
| 192 : | (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4)))) | ||
| 193 : | (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5)))) | ||
| 194 : | (angle .,p5)))) | ||
| 195 : | ; | ||
| 196 : | ;(defkazari mincho (ten 2 ten 3) | ||
| 197 : | ; (lets ((p0 (vref cross 0)) | ||
| 198 : | ; (p1 (vref cross 1)) | ||
| 199 : | ; (p2 (vref cross 2)) | ||
| 200 : | ; (p3 (vref cross 3)) | ||
| 201 : | ; (p4 (times2 0.5 (plus2 p0 p1))) | ||
| 202 : | ; (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1)))) | ||
| 203 : | ; (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0))))) | ||
| 204 : | ; `((angle .,p6) | ||
| 205 : | ; (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6)))) | ||
| 206 : | ; (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4)))) | ||
| 207 : | ; (angle .,p4) | ||
| 208 : | ; (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4)))) | ||
| 209 : | ; (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5)))) | ||
| 210 : | ; (angle .,p5)))) | ||
| 211 : | ; | ||
| 212 : | (defkazari mincho ((tate magaritate) 2 yoko 0) | ||
| 213 : | (lets ((p0 (vref cross 0)) | ||
| 214 : | (p1 (vref cross 1)) | ||
| 215 : | (p2 (vref cross 2)) | ||
| 216 : | (p3 (vref cross 3)) | ||
| 217 : | (len (metric2 p0 p2)) | ||
| 218 : | (p4 (plus2 p0 (normlen2 len (diff2 p0 p1)))) | ||
| 219 : | (p5 (plus2 p2 (normlen2 len (diff2 p2 p3))))) | ||
| 220 : | `((angle .,(inter2 p0 p1 0.1)) | ||
| 221 : | (bezier .,p4) | ||
| 222 : | (bezier .,p5) | ||
| 223 : | (angle .,p2) ))) | ||
| 224 : | ; | ||
| 225 : | (defkazari mincho ((tate magaritate) 3 yoko 2) | ||
| 226 : | (lets ((p0 (vref cross 0)) | ||
| 227 : | (p1 (vref cross 1)) | ||
| 228 : | (p2 (vref cross 2)) | ||
| 229 : | (p3 (vref cross 3)) | ||
| 230 : | (len (metric2 p0 p2)) | ||
| 231 : | (p4 (plus2 p0 (normlen2 len (diff2 p0 p1)))) | ||
| 232 : | (p5 (plus2 p2 (normlen2 len (diff2 p2 p3))))) | ||
| 233 : | `((angle .,(inter2 p2 p3 0.1)) | ||
| 234 : | (bezier .,p5) | ||
| 235 : | (bezier .,p4) | ||
| 236 : | (angle .,p0)))) | ||
| 237 : | ; | ||
| 238 : | (comment | ||
| 239 : | (defkazari mincho (kozato 2 kozato 3) | ||
| 240 : | (lets ((p0 (vref cross 0)) | ||
| 241 : | (p1 (vref cross 1)) | ||
| 242 : | (p2 (vref cross 2)) | ||
| 243 : | (p3 (vref cross 3)) | ||
| 244 : | (p4 (plus2 p0 (diff2 p0 p1))) | ||
| 245 : | (p5 (plus2 (times2 0.5 (plus2 p0 p1)) (times2 0.1 (diff2 p1 p3)))) | ||
| 246 : | (p6 (plus2 p0 (times2 0.5 (diff2 p2 p0)))) | ||
| 247 : | (p7 (plus2 (times2 0.5 (plus2 p4 p0)) (times2 0.1 (diff2 p3 p1))))) | ||
| 248 : | `((angle .,p2) | ||
| 249 : | (bezier .,p6) | ||
| 250 : | (bezier .,p6) | ||
| 251 : | (angle .,p4) | ||
| 252 : | (bezier .,p7) | ||
| 253 : | (bezier .,p7) | ||
| 254 : | (angle .,p0) | ||
| 255 : | (bezier .,p5) | ||
| 256 : | (bezier .,p1) | ||
| 257 : | (angle .,p3)))) | ||
| 258 : | ) | ||
| 259 : | ; | ||
| 260 : | (defkazari mincho ((migi tate hidari tatehidari kokoro magaritate tasuki) 0 | ||
| 261 : | yoko 1) | ||
| 262 : | (lets ((w (times mw kazariheight)) | ||
| 263 : | (p0 (vref cross 0)) | ||
| 264 : | (p1 (vref cross 1)) | ||
| 265 : | (p2 (vref cross 2)) | ||
| 266 : | (p3 (vref cross 3)) | ||
| 267 : | (len (metric2 p3 p1)) | ||
| 268 : | (len1 (max len (times 2 w)))) | ||
| 269 : | `((angle .,(plus2 p1 (normlen2 w (diff2 p1 p0)))) | ||
| 270 : | (angle .,(plus2 p1 (normlen2 len1 (diff2 p3 p1))))))) | ||
| 271 : | ; | ||
| 272 : | (defkazari mincho ((tate hidari tatehidari) 0 hidari 2) | ||
| 273 : | (lets ((minchoheight (times mw kazariheight))) | ||
| 274 : | `((angle .,(plus2 (vref cross 1) | ||
| 275 : | (normlen2 | ||
| 276 : | minchoheight | ||
| 277 : | (diff2 (vref cross 1)(vref cross 0))))) | ||
| 278 : | (angle .,(vref cross 2))))) | ||
| 279 : | |||
| 280 : | (defkazari mincho ((tate hidari tatehane kokoro tsukurihane magaritate tasuki migi) 1 yoko 3) | ||
| 281 : | (lets ((p0 (vref cross 0)) | ||
| 282 : | (p1 (vref cross 1)) | ||
| 283 : | (p2 (vref cross 2)) | ||
| 284 : | (p3 (vref cross 3)) | ||
| 285 : | (d1 (diff2 p1 p3)) | ||
| 286 : | (d0 (rot90 d1)) | ||
| 287 : | ; added by tanaka 1993/3/1 | ||
| 288 : | (p3 (cond ((plusp (mul2 d1 (diff2 p2 p3))) | ||
| 289 : | p3) | ||
| 290 : | (t (cross2 p1 p2 (diff2 p3 p1) (rot270 d1))))) | ||
| 291 : | (p1 (plus2 p3 d1)) | ||
| 292 : | (w0 (times mw 1.333 tatekazari)) | ||
| 293 : | (w1 (times mw kazariheight)) | ||
| 294 : | (const1 (quotient (times w0 0.4) w1)) | ||
| 295 : | (p7 p1) | ||
| 296 : | (p6 (plus2 p7 (normlen2 (times w1 -0.7) d1) | ||
| 297 : | (normlen2 (times -1.0 w1) d0))) | ||
| 298 : | (p8 (cross2 p6 p2 | ||
| 299 : | (plus2 (normlen2 1.0 d0)(normlen2 -1.3 d1)) | ||
| 300 : | (diff2 p3 p2))) | ||
| 301 : | (p9 (plus2 p3 (normlen2 (times -0.3 w0) d0))) | ||
| 302 : | (p4)(p5)(w2)) | ||
| 303 : | (cond ((plusp (mul2 (diff2 p3 p2)(diff2 p8 p9))) | ||
| 304 : | (setq p8 p9) | ||
| 305 : | (setq w2 (difference w1 (times 0.3 w0))) | ||
| 306 : | (setq p6 (plus2 p8 (normlen2 (times w2 -1.0) d0) | ||
| 307 : | (normlen2 (times w2 1.3) d1))) | ||
| 308 : | (setq p7 (plus2 p6 (normlen2 (times w1 1.0) d0) | ||
| 309 : | (normlen2 (times 0.7 w1) d1))))) | ||
| 310 : | (setq p4 (plus2 p8 (normlen2 (times 1.0 w0) (diff2 p2 p3)))) | ||
| 311 : | (setq p5 (cross2 p8 p4 (diff2 p8 p6) | ||
| 312 : | (rot (diff2 p8 p6) | ||
| 313 : | (max (degree 50) | ||
| 314 : | (difference (theta (diff2 p3 p2)(diff2 p8 p6)) | ||
| 315 : | (degree 70)))))) | ||
| 316 : | ; (break) | ||
| 317 : | (setq p8 (inter2 p5 p6 | ||
| 318 : | (min 0.9 (quotient (metric2 p5 p4)(metric2 p5 p8))))) | ||
| 319 : | `((angle .,p4) | ||
| 320 : | (bezier .,(inter2 p4 p5 0.9)) | ||
| 321 : | (bezier .,(inter2 p8 p5 0.9)) | ||
| 322 : | ; (angle .,p5) | ||
| 323 : | (angle .,p8) | ||
| 324 : | (angle .,p6) | ||
| 325 : | (angle .,p7)))) | ||
| 326 : | |||
| 327 : | |||
| 328 : | |||
| 329 : | ; | ||
| 330 : | ; | ||
| 331 : | ; 点の定義 | ||
| 332 : | ; | ||
| 333 : | (defelement mincho ten | ||
| 334 : | (lets ((dotsize (meshwidth mw)) | ||
| 335 : | (w (times meshsize 0.5 dotsize)) | ||
| 336 : | (p0 (grid (car points) dotsize)) | ||
| 337 : | (p1 (grid (cadr points) dotsize)) | ||
| 338 : | (len (metric2 p0 p1))) | ||
| 339 : | (mincho1 | ||
| 340 : | p0 | ||
| 341 : | p1 | ||
| 342 : | '((80 171 136 255) | ||
| 343 : | ((angle 80 171)(bezier 119 214)(bezier 104 256)(angle 136 255)) | ||
| 344 : | ((angle 80 171)(bezier 155 204)(bezier 173 251)(angle 136 255))) | ||
| 345 : | (cond ((lessp (times 3.0 w) len) | ||
| 346 : | (quotient w 20.0)) | ||
| 347 : | (t (quotient len 60.0)))))) | ||
| 348 : | ; | ||
| 349 : | ; 縦棒の定義 | ||
| 350 : | ; | ||
| 351 : | (defelement mincho tate | ||
| 352 : | (lets ((dotsize (meshwidth mw)) | ||
| 353 : | (p0 (gridx (car points) dotsize)) | ||
| 354 : | (p1 (gridx (cadr points) dotsize)) | ||
| 355 : | (w (min (normwidth dotsize)(times 0.35 (metric2 p0 p1)))) | ||
| 356 : | ) | ||
| 357 : | ; (print `(tate ,dotsize)) | ||
| 358 : | (cond ((lessp (times 0.08 w) meshsize) | ||
| 359 : | (line2 p0 p1 w)) | ||
| 360 : | (t | ||
| 361 : | (niku2 p0 p1 0.4 0.4 w (times w 0.92)(times w 0.92) w))))) | ||
| 362 : | ; | ||
| 363 : | ; 横棒の定義 | ||
| 364 : | ; | ||
| 365 : | (defelement mincho yoko | ||
| 366 : | (lets ((dotsize (meshwidth (times mw tateyokoratio))) | ||
| 367 : | (w (normwidth dotsize)) | ||
| 368 : | (p0 (gridy (car points) dotsize)) | ||
| 369 : | (p1 (gridy (cadr points) dotsize))) | ||
| 370 : | (line2 p0 p1 w))) | ||
| 371 : | ; | ||
| 372 : | ; 右上はらいの定義 | ||
| 373 : | ; | ||
| 374 : | (defelement mincho migiue | ||
| 375 : | (lets ((dotsize (meshwidth mw)) | ||
| 376 : | (w0 (normwidth dotsize)) | ||
| 377 : | ; (w1 (normwidth 1)) | ||
| 378 : | (w1 0) | ||
| 379 : | (p0 (gridy (car points) dotsize)) | ||
| 380 : | (p1 (gridy (cadr points) dotsize)) | ||
| 381 : | (p2 (gridy (caddr points) 1))) | ||
| 382 : | (niku3 p0 p1 p2 0.3 0.3 w0 (inter w0 w1 0.3)(inter w0 w1 0.7) w1))) | ||
| 383 : | ; | ||
| 384 : | ; 右はらいの定義 | ||
| 385 : | ; | ||
| 386 : | (defelement mincho migi | ||
| 387 : | (lets ((dotsize0 (meshwidth (times mw 0.5))) | ||
| 388 : | (w0 (normwidth dotsize0)) | ||
| 389 : | (dotsize1 (meshwidth (times mw 1.2))) | ||
| 390 : | (w1 (normwidth dotsize1)) | ||
| 391 : | (p0 (grid (car points) dotsize0)) | ||
| 392 : | (p1 (cadr points)) | ||
| 393 : | (p2 (grid (caddr points) dotsize1))) | ||
| 394 : | (niku3 p0 p1 p2 0.3 0.3 | ||
| 395 : | w0 (inter w0 w1 0.25)(inter w0 w1 0.75) w1))) | ||
| 396 : | ; | ||
| 397 : | ;しんにょう | ||
| 398 : | ; | ||
| 399 : | (defelement mincho shin-nyuu | ||
| 400 : | (lets | ||
| 401 : | ((dotsize0 (meshwidth (times mw 0.2))) | ||
| 402 : | (w0 (normwidth dotsize0)) | ||
| 403 : | (dotsize1 (meshwidth (times mw 1.2))) | ||
| 404 : | (w1 (normwidth dotsize1)) | ||
| 405 : | (p0 (grid (car points) dotsize0)) | ||
| 406 : | (p1 (cadr points)) | ||
| 407 : | (p2 (grid (caddr points) dotsize1)) | ||
| 408 : | (len0 (metric2 p0 p1)) | ||
| 409 : | (len1 (metric2 p1 p2)) | ||
| 410 : | (len (plus len0 len1))) | ||
| 411 : | (curve2 p0 (inter2 p0 p1 0.5)(inter2 p2 p1 0.9) p2 | ||
| 412 : | w0 (inter w0 w1 0.2) (inter w0 w1 0.9) w1))) | ||
| 413 : | ; | ||
| 414 : | ; まがりたて | ||
| 415 : | ; | ||
| 416 : | (defelement mincho magaritate | ||
| 417 : | (lets ((dotsize (meshwidth mw)) | ||
| 418 : | (w0 (normwidth dotsize)) | ||
| 419 : | (w1 (times w0 0.9)) | ||
| 420 : | (p0 (grid (car points) dotsize)) | ||
| 421 : | (p1 (cadr points)) | ||
| 422 : | (p2 (grid (caddr points) dotsize))) | ||
| 423 : | (curve2 p0 (inter2 p0 p1 0.7)(inter2 p2 p1 0.7) p2 w0 w1 w1 w0))) | ||
| 424 : | ; | ||
| 425 : | ; かぎ | ||
| 426 : | ; | ||
| 427 : | (defelement mincho kagi | ||
| 428 : | (lets ((dotsize0 (meshwidth mw)) | ||
| 429 : | (w0 (normwidth dotsize0)) | ||
| 430 : | (dotsize1 (meshwidth (times 1.0 mw))) | ||
| 431 : | (w1 (normwidth dotsize1)) | ||
| 432 : | (p0 (gridx (car points) dotsize0)) | ||
| 433 : | (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points))))) | ||
| 434 : | (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0)) | ||
| 435 : | (p2 (gridy (plus2 (caddr points) l0) dotsize1)) | ||
| 436 : | (len0 (metric2 p0 p1)) | ||
| 437 : | (len1 (metric2 p1 p2)) | ||
| 438 : | (rate0 (min 0.9 (//$ (times w0 4.0) len0))) | ||
| 439 : | (rate1 (min 0.9 (//$ (times w1 4.0) len1))) | ||
| 440 : | (p01 (inter2 p1 p0 rate0)) | ||
| 441 : | (p12 (inter2 p1 p2 rate1))) | ||
| 442 : | (line2 p0 p01 w0 | ||
| 443 : | (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p12 0.1) p12 w0 w0 w1 w1 | ||
| 444 : | (cond ((greaterp (metric2 p12 p2) w0) | ||
| 445 : | (line2 p12 p2 w1)) | ||
| 446 : | (t `(nil nil))))))) | ||
| 447 : | ; 縦左はらいの定義 | ||
| 448 : | (defelement mincho tatehidari | ||
| 449 : | (lets ((dotsize (meshwidth mw)) | ||
| 450 : | (w (normwidth dotsize)) | ||
| 451 : | (p0 (grid (car points) dotsize)) | ||
| 452 : | (p1 (grid (cadr points) dotsize)) | ||
| 453 : | (p2 (grid (caddr points) dotsize)) | ||
| 454 : | (p3 (grid (cadddr points) dotsize)) | ||
| 455 : | (l0 (normlen2 w (rot90 (diff2 p0 p1)))) | ||
| 456 : | (w1 (//$ w (float (costheta l0 (diff2 p3 p2))))) | ||
| 457 : | (l1 (plus2 (normlen2 w1 (diff2 p3 p2)) | ||
| 458 : | (normlen2 w1 (diff2 p1 p2))))) | ||
| 459 : | `(((angle .,(plus2 p0 l0)) | ||
| 460 : | (angle .,(plus2 p1 l0)) | ||
| 461 : | (bezier .,(plus2 (inter2 p1 p2 0.5) l0)) | ||
| 462 : | (bezier .,(plus2 p2 l1)) | ||
| 463 : | (angle .,p3)) | ||
| 464 : | ((angle .,(diff2 p0 l0)) | ||
| 465 : | (angle .,(diff2 p1 l0)) | ||
| 466 : | (bezier .,(diff2 (inter2 p1 p2 0.5) l0)) | ||
| 467 : | (bezier .,(diff2 p2 l1)) | ||
| 468 : | (angle .,p3))))) | ||
| 469 : | ; こころ | ||
| 470 : | (defelement mincho kokoro | ||
| 471 : | (lets ((dotsize0 (meshwidth mw)) | ||
| 472 : | (dotsize1 (meshwidth (times 1.0 mw))) | ||
| 473 : | (w0 (normwidth dotsize0)) | ||
| 474 : | (w1 (normwidth dotsize1)) | ||
| 475 : | (p0 (gridx (car points) dotsize0)) | ||
| 476 : | (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points))))) | ||
| 477 : | (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0)) | ||
| 478 : | (p2 (gridy (plus2 (caddr points) l0) dotsize1)) | ||
| 479 : | (p3 (fourth points)) | ||
| 480 : | (w0 (min w0 (times 0.35 (metric2 p1 p2)))) | ||
| 481 : | (w1 (min w1 (times 0.35 (metric2 p1 p2)))) | ||
| 482 : | (w0 (min w0 (times 0.35 (metric2 p0 p1)))) | ||
| 483 : | (w1 (min w1 (times 0.35 (metric2 p0 p1)))) | ||
| 484 : | (p3 (plus2 p2 | ||
| 485 : | (normlen2 (min (metric2 p0 p1) | ||
| 486 : | (max (metric2 p3 p2)(times w1 5.0))) | ||
| 487 : | (diff2 p3 p2)))) | ||
| 488 : | (p3 (gridx p3 dotsize1)) | ||
| 489 : | (p23 (inter2 p2 p3 0.1)) | ||
| 490 : | (p12 (inter2 p1 p2 0.5)) | ||
| 491 : | (len0 (metric2 p0 p1)) | ||
| 492 : | (len1 (metric2 p1 p12)) | ||
| 493 : | (rate0 (min 0.9 (//$ (times w0 4.0) len0))) | ||
| 494 : | (rate1 (min 0.9 (//$ (times w1 4.0) len1))) | ||
| 495 : | (p01 (inter2 p1 p0 rate0)) | ||
| 496 : | (p4 (inter2 p1 p12 rate1)) | ||
| 497 : | (p5 (inter2 p12 p2 0.5)) | ||
| 498 : | (w2 (times w1 0.8)) | ||
| 499 : | (w3 (min (times w1 3.0)(plus w2 (times (metric2 p2 p3) 0.2)))) | ||
| 500 : | ) | ||
| 501 : | ; (prind w0) | ||
| 502 : | (cond ((lessp len0 (times 6.0 w0)) | ||
| 503 : | ; (prind 'less) | ||
| 504 : | (curve2 p0 (inter2 p1 p0 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1 | ||
| 505 : | (line2 p4 p12 w1 | ||
| 506 : | (kokorohane p12 p5 p23 p3 w1 w2 w3)))) | ||
| 507 : | (t | ||
| 508 : | (line2 p0 p01 w0 | ||
| 509 : | (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1 | ||
| 510 : | (line2 p4 p12 w1 | ||
| 511 : | (kokorohane p12 p5 p23 p3 w1 w2 w3)))))))) | ||
| 512 : | ; | ||
| 513 : | (defun kokorohane (p0 p1 p2 p3 w0 w1 w2) | ||
| 514 : | (lets ((d0 (diff2 p1 p0)) | ||
| 515 : | (d1 (diff2 p2 p1)) | ||
| 516 : | (a4 (plus2 p2 (normlen2 w2 d1))) | ||
| 517 : | (l0 (normlen2 w0 (rot270 d0))) | ||
| 518 : | (l1 (normlen2 w0 (rot270 d1))) | ||
| 519 : | (h0 (diff2 p2 (normlen2 w1 d1))) | ||
| 520 : | (h1 (plus2 p2 (normlen2 w1 d1))) | ||
| 521 : | (a0 (plus2 p0 l0)) | ||
| 522 : | (a3 (plus2 a4 l1)) | ||
| 523 : | (a1 (cross2 a0 a3 d0 d1)) | ||
| 524 : | (b0 (diff2 p0 l0)) | ||
| 525 : | (b1 (cross2 b0 (diff2 a4 l1) d0 d1)) | ||
| 526 : | (b2 (cross2 b1 p3 d1 (diff2 h0 p3))) | ||
| 527 : | (b3 (diff2 b2 (normlen2 w0 d1))) | ||
| 528 : | (bez0 (newbez b3 (plus2 b3 l1) | ||
| 529 : | b0 | ||
| 530 : | ktanaka | 1.6 | (inter2 b0 b1 0.8) |
| 531 : | (inter2 (diff2 a4 l1) b1 0.8) | ||
| 532 : | ktanaka | 1.1 | (diff2 a4 l1))) |
| 533 : | (b3 (fourth bez0)) | ||
| 534 : | (b2 (cross2 b3 p3 (diff2 (third bez0) b3) (diff2 h0 p3))) | ||
| 535 : | (a2 (plus2 a3 (normlen2 (times -1.0 w2) d1))) | ||
| 536 : | (a5 (cross2 (diff2 a4 l1) p3 d1 (diff2 h1 p3))) | ||
| 537 : | (a7 (diff2 (diff2 a4 l1) | ||
| 538 : | (normlen2 (min w0 (times 0.6 (metric2 a5 (diff2 a4 l1)))) | ||
| 539 : | d1))) | ||
| 540 : | (a8 (plus2 h1 (normlen2 (min (times 1.5 w0)(metric2 h1 p3)) (diff2 p3 h1)))) | ||
| 541 : | (a9 (cross2 a8 a4 (diff2 a7 a8) l1)) | ||
| 542 : | (a9 (cond ((lessp (metric2 a4 a7)(metric2 a7 a9))(inter2 a4 a7 0.5)) | ||
| 543 : | (t a7))) | ||
| 544 : | (a4 (inter2 a3 a4 0.8)) | ||
| 545 : | ) | ||
| 546 : | ; (print `((b3 ,b3) (b2 ,b2))) | ||
| 547 : | `(((angle .,a0) | ||
| 548 : | (bezier .,(inter2 a0 a1 0.7)) | ||
| 549 : | (bezier .,(inter2 a2 a1 0.7)) | ||
| 550 : | (angle .,a2) | ||
| 551 : | (bezier .,(inter2 a2 a3 0.666666)) | ||
| 552 : | (bezier .,(inter2 a4 a3 0.666666)) | ||
| 553 : | (angle .,a4) | ||
| 554 : | (bezier .,(inter2 a4 a9 0.66666)) | ||
| 555 : | (bezier .,(inter2 a7 a9 0.66666)) | ||
| 556 : | (angle .,a7) | ||
| 557 : | (bezier .,(inter2 a7 a8 0.66666)) | ||
| 558 : | (bezier .,(inter2 p3 a8 0.66666)) | ||
| 559 : | (angle .,p3)) | ||
| 560 : | ((angle .,b0) | ||
| 561 : | (bezier .,(second bez0)) | ||
| 562 : | (bezier .,(third bez0)) | ||
| 563 : | (angle .,b3) | ||
| 564 : | (bezier .,(inter2 b3 b2 0.9)) | ||
| 565 : | (bezier .,(inter2 p3 b2 0.9)) | ||
| 566 : | (angle .,p3))))) | ||
| 567 : | ; たすき | ||
| 568 : | (defelement mincho tasuki | ||
| 569 : | (lets ((dotsize0 (meshwidth mw)) | ||
| 570 : | (w0 (normwidth dotsize0)) | ||
| 571 : | (p0 (gridx (car points) dotsize0)) | ||
| 572 : | (l0 (normlen2 w0 (rot90 (diff2 (caddr points)(cadr points))))) | ||
| 573 : | (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize0) dotsize0)) | ||
| 574 : | (p2 (gridy (plus2 (caddr points) l0) dotsize0)) | ||
| 575 : | (p3 (fourth points)) | ||
| 576 : | (p3 (cond ((lessp (metric2 p3 p2)(times w0 2.5)) | ||
| 577 : | (plus2 p2 (normlen2 (times w0 2.5)(diff2 p3 p2)))) | ||
| 578 : | (t p3))) | ||
| 579 : | (p3 (gridx p3 dotsize0)) | ||
| 580 : | (w2 (times w0 0.8)) | ||
| 581 : | (w3 (min (times w0 3.0)(plus w2 (times (metric2 p2 p3) 0.2)))) | ||
| 582 : | (p2 (plus2 p2 (normlen2 w3 (diff2 p1 p2)))) | ||
| 583 : | (p01 (inter2 p0 p1 0.6)) | ||
| 584 : | (p12 (inter2 p2 p1 0.6)) | ||
| 585 : | (p4 (inter2 p01 p12 0.5)) | ||
| 586 : | ) | ||
| 587 : | (kokorohane p0 p1 p2 p3 w0 w2 w3))) | ||
| 588 : | ; (curve2 p0 (inter2 p0 p01 0.99) (inter2 p4 p01 0.7) p4 w0 w0 w0 w0 | ||
| 589 : | ; (kokorohane p4 p12 p2 p3 w0 w2 w3)))) | ||
| 590 : | ; 縦跳ね | ||
| 591 : | (defelement mincho tatehane | ||
| 592 : | (lets ((dotsize (meshwidth mw)) | ||
| 593 : | (w (normwidth dotsize)) | ||
| 594 : | (p0 (gridx (car points) dotsize)) | ||
| 595 : | (p1 (cadr points)) | ||
| 596 : | (p1 (gridx (plus2 p1 (normlen2 w (diff2 p0 p1))) dotsize)) | ||
| 597 : | (p2 (caddr points)) | ||
| 598 : | (p2 (grid (plus2 p2 (normlen2 w (diff2 p0 p1))) dotsize)) | ||
| 599 : | (p2 (plus2 p1 (normlen2 (max (metric2 p2 p1)(times w 1.8)) | ||
| 600 : | (diff2 p2 p1)))) | ||
| 601 : | (len0 (max (times 2.0 w) | ||
| 602 : | (min (times 0.5 (metric2 p0 p1)) | ||
| 603 : | (times 0.5 (metric2 p1 p2))))) | ||
| 604 : | (p01 (plus2 p1 (normlen2 len0 (diff2 p0 p1)))) | ||
| 605 : | (w1 (min (times w 1.4) | ||
| 606 : | (plus w (times (metric2 p1 p2) 0.1)))) | ||
| 607 : | (w2 (min (times 0.8 (metric2 p2 p1))(times w 5.0))) | ||
| 608 : | ) | ||
| 609 : | ; (break) | ||
| 610 : | (line2 p0 p01 w | ||
| 611 : | (hane p01 p1 p2 w w1 w2)))) | ||
| 612 : | (defun hane (p0 p1 p2 w0 w1 w2) | ||
| 613 : | (lets ((d0 (diff2 p1 p0)) | ||
| 614 : | (d1 (diff2 p2 p1)) | ||
| 615 : | (l0 (normlen2 w0 (rot270 d0))) | ||
| 616 : | (l1 (normlen2 w0 (rot270 d1))) | ||
| 617 : | (a0 (plus2 p0 l0)) | ||
| 618 : | (a2 (plus2 p2 (normlen2 w1 l1))) | ||
| 619 : | (d2 (diff2 a2 (plus2 l1 (diff2 p1 l0)))) | ||
| 620 : | (a1 (cross2 a0 a2 d0 d2)) | ||
| 621 : | (a3 (plus2 a2 (normlen2 w2 d2))) | ||
| 622 : | (a4 (plus2 a1 (normlen2 (min (times 0.9 (metric2 a3 a1)) | ||
| 623 : | (times 1.5 (metric2 a1 a0))) | ||
| 624 : | (diff2 a3 a1)))) | ||
| 625 : | (b0 (diff2 p0 l0)) | ||
| 626 : | (b1 (diff2 (diff2 p1 l0) l1)) | ||
| 627 : | (b2 (diff2 p2 (normlen2 w1 l1))) | ||
| 628 : | (b4 (plus2 b1 (normlen2 (min (metric2 b2 b1) | ||
| 629 : | (times 1.5 (metric2 b0 b1))) | ||
| 630 : | (diff2 b2 b1)))) | ||
| 631 : | (t0 (plus2 a2 (normlen2 w0 d2))) | ||
| 632 : | (t1 (diff2 p2 (normlen2 (times w1 -0.2) l1))) | ||
| 633 : | (b3 (cross2 a3 b2 (diff2 t1 a3)(diff2 t0 b2))) | ||
| 634 : | (b3 (cond ((lessp (metric2 a3 b3) 1.0) | ||
| 635 : | (inter2 b2 a3 0.5)) | ||
| 636 : | (t b3))) | ||
| 637 : | ) | ||
| 638 : | `(((angle .,a0) | ||
| 639 : | (bezier .,(inter2 a0 a1 0.66666)) | ||
| 640 : | (bezier .,(inter2 a4 a1 0.66666)) | ||
| 641 : | (angle .,a4) | ||
| 642 : | ; (angle .,a3) | ||
| 643 : | ) | ||
| 644 : | ((angle .,b0) | ||
| 645 : | (bezier .,(inter2 b0 b1 0.66666)) | ||
| 646 : | (bezier .,(inter2 b4 b1 0.66666)) | ||
| 647 : | (angle .,b4) | ||
| 648 : | (angle .,b2) | ||
| 649 : | (bezier .,(inter2 b2 b3 0.66666)) | ||
| 650 : | (bezier .,(inter2 a3 b3 0.66666)) | ||
| 651 : | (angle .,a3))))) | ||
| 652 : | ; 旁の跳ね | ||
| 653 : | (defelement mincho tsukurihane | ||
| 654 : | (lets ((dotsize (meshwidth mw)) | ||
| 655 : | (w (normwidth dotsize)) | ||
| 656 : | (p0 (gridx (car points) dotsize)) | ||
| 657 : | (p1 (gridx (cadr points) dotsize)) | ||
| 658 : | (p2 (caddr points)) | ||
| 659 : | (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize)) | ||
| 660 : | (p3 (cadddr points)) | ||
| 661 : | (p3 (cond ((lessp (metric2 p2 p3)(times 2.5 w)) | ||
| 662 : | (plus2 p2 (normlen2 (times 2.5 w) (diff2 p3 p2)))) | ||
| 663 : | (t p3))) | ||
| 664 : | (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize)) | ||
| 665 : | (l0 (normlen2 w (rot270 (diff2 p1 p0)))) | ||
| 666 : | (l1 (normlen2 w (rot270 (diff2 p1 p0)))) | ||
| 667 : | (l2 (normlen2 w (rot270 (diff2 p1 p0)))) | ||
| 668 : | (a0 (plus2 p0 l0)) | ||
| 669 : | (a1 (cross2 a0 (plus2 p2 l1)(diff2 p1 p0)(diff2 p2 p1))) | ||
| 670 : | (a2 (cross2 (plus2 p2 l1)(plus2 p3 l2)(diff2 p2 p1)(diff2 p3 p2))) | ||
| 671 : | (a3 (cross2 a0(plus2 p3 l2)(diff2 p1 p0)(diff2 p3 p2))) | ||
| 672 : | (len0 (min (times 2.0 w) | ||
| 673 : | (min (times 0.5 (metric2 p1 p2)) | ||
| 674 : | (times 0.5 (metric2 p2 p3))))) | ||
| 675 : | (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2)))) | ||
| 676 : | (w1 (min (times w 1.4) | ||
| 677 : | (plus w (times (metric2 p2 p3) 0.1)))) | ||
| 678 : | (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0)))) | ||
| 679 : | ; (prind `(,p0 ,p1 ,p12 ,p2 ,p3 ,a0 ,a1 ,a2 ,a3)) | ||
| 680 : | (cond ((zerop (sintheta (diff2 p1 p0)(diff2 p2 p0))) | ||
| 681 : | (line2 p0 p12 w | ||
| 682 : | (hane p12 p2 p3 w w1 w2))) | ||
| 683 : | ((greaterp (metric2 a0 a3)(metric2 a0 a1)) | ||
| 684 : | (setq p12 | ||
| 685 : | (diff2 (plus2 a2 (normlen2 (min (times 0.5 (metric2 a1 a2)) | ||
| 686 : | (times 1.5 w)) | ||
| 687 : | (diff2 a1 a2))) | ||
| 688 : | l1)) | ||
| 689 : | ; (prind p12) | ||
| 690 : | (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12 w w w w | ||
| 691 : | (hane p12 p2 p3 w w1 w2))) | ||
| 692 : | (t | ||
| 693 : | (setq p12 (cross2 p0 p3 (diff2 p1 p0)(diff2 p2 p3))) | ||
| 694 : | (hane p0 p12 p3 w w1 w2))))) | ||
| 695 : | ; こざと偏の一部 | ||
| 696 : | (defelement mincho kozato | ||
| 697 : | (lets ((dotsize (meshwidth mw)) | ||
| 698 : | (w (normwidth dotsize)) | ||
| 699 : | (p0 (gridx (car points) dotsize)) | ||
| 700 : | (p1 (gridx (cadr points) dotsize)) | ||
| 701 : | (p2 (caddr points)) | ||
| 702 : | (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize)) | ||
| 703 : | (p3 (cadddr points)) | ||
| 704 : | (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize)) | ||
| 705 : | (len0 (max (times 2.0 w) | ||
| 706 : | (times 0.5 (metric2 p1 p2)))) | ||
| 707 : | (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2)))) | ||
| 708 : | (w1 (min (times w 1.4) | ||
| 709 : | (plus w (times (metric2 p2 p3) 0.1)))) | ||
| 710 : | (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0)))) | ||
| 711 : | (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12 | ||
| 712 : | (times 0.2 w) | ||
| 713 : | (times 0.7 w) | ||
| 714 : | w w | ||
| 715 : | (hane p12 p2 p3 w w1 w2)))) | ||
| 716 : | ; さんずい | ||
| 717 : | (defelement mincho sanzui | ||
| 718 : | (lets ((dotsize (meshwidth mw)) | ||
| 719 : | (w (normwidth dotsize)) | ||
| 720 : | (p0 (car points)) | ||
| 721 : | (p1 (cadr points)) | ||
| 722 : | (v (diff2 p1 p0)) | ||
| 723 : | (vx (car v)) | ||
| 724 : | (vy (cadr v)) | ||
| 725 : | (p0 (plus2 p0 `(,(times -0.8 (difference vx 34.0)) 0))) | ||
| 726 : | (p2 (plus2 p0 `(,(times 0.03 vy) ,(times 0.3 vy)))) | ||
| 727 : | (p3 (plus2 p2 `(,(times 0.16 vy) ,(times 0.08 vy)))) | ||
| 728 : | (p0 (grid p0 dotsize)) | ||
| 729 : | (p1 (grid p1 1)) | ||
| 730 : | (p3 (grid p3 1)) | ||
| 731 : | (d0 (diff2 p2 p0)) | ||
| 732 : | (d1 (diff2 p1 p2)) | ||
| 733 : | (l0 (rot270 d0)) | ||
| 734 : | (w1 (times w (//$ 1.0 (sintheta d0 d1)))) | ||
| 735 : | ; (w1 w) | ||
| 736 : | (t0 (plus2 p2 (normlen2 w1 d0))) | ||
| 737 : | (t1 (diff2 p2 (normlen2 w1 d0))) | ||
| 738 : | (w2 (times 0.6 w (//$ -1.0 (sintheta d0 (diff2 p3 p2))))) | ||
| 739 : | ; (w2 w) | ||
| 740 : | (t2 (plus2 p2 (normlen2 w2 d0))) | ||
| 741 : | (t3 (diff2 p2 (normlen2 w2 d0))) | ||
| 742 : | (b4 (cross2 p3 p1 (diff2 t2 p3)(diff2 t0 p1))) | ||
| 743 : | (b4 (plus2 t2 (normlen2 (min (times 0.9 (metric2 t2 p3)) | ||
| 744 : | (metric2 b4 t2)) | ||
| 745 : | (diff2 p3 t2)))) | ||
| 746 : | (a0 (plus2 p0 (normlen2 (times 1.5 w) l0))) | ||
| 747 : | (a2 (cross2 a0 p1 | ||
| 748 : | (diff2 (plus2 p2 (normlen2 (times w 0.5) l0)) a0) | ||
| 749 : | (diff2 t1 p1))) | ||
| 750 : | (b0 (diff2 p0 (normlen2 (times 1.5 w) l0))) | ||
| 751 : | (b2 (cross2 b0 p3 | ||
| 752 : | (diff2 (plus2 p2 (normlen2 (times w -0.5) l0)) b0) | ||
| 753 : | (diff2 t3 p3))) | ||
| 754 : | (b1 (inter2 b0 b2 0.5)) | ||
| 755 : | (a1 (inter2 a0 a2 0.5)) | ||
| 756 : | (a3 (plus2 a2 (normlen2 (min (times 1.5 (metric2 a1 a2)) | ||
| 757 : | (times 0.9 (metric2 p1 a2))) | ||
| 758 : | (diff2 p1 a2)))) | ||
| 759 : | (b5 (plus2 b4 (normlen2 (min (times 1.5 (metric2 p3 b4)) | ||
| 760 : | (times 0.9 (metric2 p1 b4))) | ||
| 761 : | (diff2 p1 b4))))) | ||
| 762 : | ; (break) | ||
| 763 : | `(((angle .,p0) | ||
| 764 : | (bezier .,(inter2 p0 a0 0.66666)) | ||
| 765 : | (bezier .,(inter2 a1 a0 0.66666)) | ||
| 766 : | (angle .,a1) | ||
| 767 : | (bezier .,(inter2 a1 a2 0.9)) | ||
| 768 : | (bezier .,(inter2 a3 a2 0.9)) | ||
| 769 : | (angle .,a3) | ||
| 770 : | (angle .,p1)) | ||
| 771 : | ((angle .,p0) | ||
| 772 : | (bezier .,(inter2 p0 b0 0.66666)) | ||
| 773 : | (bezier .,(inter2 b1 b0 0.66666)) | ||
| 774 : | (angle .,b1) | ||
| 775 : | (bezier .,(inter2 b1 b2 0.66666)) | ||
| 776 : | (bezier .,(inter2 p3 b2 1.0)) | ||
| 777 : | (angle .,p3) | ||
| 778 : | (bezier .,(inter2 p3 b4 1.0)) | ||
| 779 : | (bezier .,(inter2 b5 b4 0.66666)) | ||
| 780 : | (angle .,b5) | ||
| 781 : | (angle .,p1))))) | ||
| 782 : | |||
| 783 : | ; 左はらいの定義 | ||
| 784 : | (defelement mincho hidari | ||
| 785 : | (lets ((dotsize (meshwidth mw)) | ||
| 786 : | (w (normwidth dotsize)) | ||
| 787 : | (p0 (grid (car points) dotsize)) | ||
| 788 : | (p1 (grid (cadr points) dotsize)) | ||
| 789 : | (p2 (grid (caddr points) 1)) | ||
| 790 : | (w (min w (times 0.35 (metric2 p0 p2)))) | ||
| 791 : | (d0 (diff2 p1 p0)) | ||
| 792 : | (d1 (diff2 p2 p1)) | ||
| 793 : | (l0 (rot270 d0)) | ||
| 794 : | (l1 (rot270 d1)) | ||
| 795 : | (len0 (metric2 p0 p1)) | ||
| 796 : | (rate (//$ len0 (plus (metric2 p1 p2) len0))) | ||
| 797 : | (theta (theta d0 d1)) | ||
| 798 : | (w1 (inter (times rate w) w | ||
| 799 : | (min 1.0 (times theta 0.7)))) | ||
| 800 : | (rate0 (max 0.666666 | ||
| 801 : | (plus 1.0 (times 0.5 | ||
| 802 : | (difference 1.0 (quotient 1.0 rate)))))) | ||
| 803 : | (a0 (plus2 p0 (normlen2 w l0))) | ||
| 804 : | (w2 (times 0.1 mw)) | ||
| 805 : | (a2 (plus2 p2 (normlen2 w2 l0))) | ||
| 806 : | (a1 (cross2 a0 a2 | ||
| 807 : | (diff2 (plus2 p1 (normlen2 w1 l0)) a0) | ||
| 808 : | (diff2 (plus2 p1 (normlen2 w1 l1)) a2))) | ||
| 809 : | (a1 (cond ((or (greaterp (metric2 a0 a1)(metric2 a0 p2)) | ||
| 810 : | (greaterp (metric2 a1 p2)(metric2 a0 p2))) | ||
| 811 : | (inter2 a0 p2 0.5)) | ||
| 812 : | (t a1))) | ||
| 813 : | (b0 (diff2 p0 (normlen2 w l0))) | ||
| 814 : | (b2 (diff2 p2 (normlen2 w2 l0))) | ||
| 815 : | (b1 (cross2 b0 b2 | ||
| 816 : | (diff2 (diff2 p1 (normlen2 w1 l0)) b0) | ||
| 817 : | (diff2 (diff2 p1 (normlen2 w1 l1)) b2)))) | ||
| 818 : | ; (break) | ||
| 819 : | `(((angle .,a0) | ||
| 820 : | (bezier .,(inter2 a0 a1 rate0)) | ||
| 821 : | ktanaka | 1.6 | (bezier .,(inter2 p2 a1 0.95)) |
| 822 : | ktanaka | 1.1 | (angle .,a2)) |
| 823 : | ((angle .,b0) | ||
| 824 : | (bezier .,(inter2 b0 b1 rate0)) | ||
| 825 : | ktanaka | 1.6 | (bezier .,(inter2 p2 b1 0.95)) |
| 826 : | ktanaka | 1.1 | (angle .,b2))))) |
| 827 : | ; | ||
| 828 : | (defun last-joint (prim) | ||
| 829 : | (lets ((elements (cadr prim)) | ||
| 830 : | (lastpoints)) | ||
| 831 : | (do ((l elements (cdr l))) | ||
| 832 : | ((atom l)) | ||
| 833 : | (or (and (memq (caar l) '(hidari tatehidari migiue)) | ||
| 834 : | (push (car (last (cadar l))) lastpoints)) | ||
| 835 : | (and (memq (caar l) '(ten migi)) | ||
| 836 : | ; (print (car (cadar l))) | ||
| 837 : | (push (car (cadar l)) lastpoints)))) | ||
| 838 : | (do ((l elements (cdr l))(newelements)(link)) | ||
| 839 : | ((atom l) `(,(car prim),(nreverse newelements).,(cddr prim))) | ||
| 840 : | (cond ((setq link (assq 'link (cddar l))) | ||
| 841 : | (do ((ll (cdr link)(cdr ll))(ret)) | ||
| 842 : | ((atom ll) | ||
| 843 : | (push `(,(caar l),(cadar l) | ||
| 844 : | (link .,(nreverse ret)).,(cddar l)) | ||
| 845 : | newelements)) | ||
| 846 : | (or (memq (car ll) lastpoints)(push (car ll) ret)))) | ||
| 847 : | (t | ||
| 848 : | (push (car l) newelements)))))) | ||
| 849 : | ; | ||
| 850 : | (defun mincho-prim (prim) | ||
| 851 : | ; (prind 'hook) | ||
| 852 : | (lets ((prim (rm-geta prim (times minchowidth 2.0))) | ||
| 853 : | (prim (last-joint prim)) | ||
| 854 : | (points (car prim)) | ||
| 855 : | (elements (cadr prim)) | ||
| 856 : | (alist (cddr prim)) | ||
| 857 : | (units (units | ||
| 858 : | `(,points ,elements | ||
| 859 : | .,(every alist | ||
| 860 : | #'(lambda (x) | ||
| 861 : | (not (memq (car x) | ||
| 862 : | '(xunit yunit)))))))) | ||
| 863 : | (xunit (car units)) | ||
| 864 : | (yunit (cdr units)) | ||
| 865 : | (tome (times minchowidth tomeheight)) | ||
| 866 : | (points-alist) | ||
| 867 : | (ylen) | ||
| 868 : | (minylen) | ||
| 869 : | ) | ||
| 870 : | ktanaka | 1.4 | (do ((l elements (cdr l))(element)(link)) |
| 871 : | ktanaka | 1.1 | ((atom l)) |
| 872 : | (setq element (car l)) | ||
| 873 : | (do ((ll (cadr element)(cdr ll))(ass)) | ||
| 874 : | ((atom ll)) | ||
| 875 : | (setq ass (assq (car ll) points-alist)) | ||
| 876 : | (cond (ass (rplacd ass (add1 (cdr ass)))) | ||
| 877 : | (t (push `(,(car ll) . 1)points-alist )))) | ||
| 878 : | (setq link (assq 'link (cddr element))) | ||
| 879 : | (and link | ||
| 880 : | (do ((ll (cdr link)(cdr ll))(ass)) | ||
| 881 : | ((atom ll)) | ||
| 882 : | (setq ass (assq (car ll) points-alist)) | ||
| 883 : | (cond (ass (rplacd ass (add1 (cdr ass)))) | ||
| 884 : | (t (push `(,(car ll) . 1)points-alist)))))) | ||
| 885 : | (do ((l elements (cdr l))(element)(p0)(p1)(ylen)) | ||
| 886 : | ((atom l)) | ||
| 887 : | (setq element (car l)) | ||
| 888 : | (cond ((eq (car element) 'yoko) | ||
| 889 : | (setq p0 (nth (car (cadr element)) points)) | ||
| 890 : | (setq p1 (nth (cadr (cadr element)) points)) | ||
| 891 : | (setq ylen (metric2 p0 p1)) | ||
| 892 : | (cond ((and | ||
| 893 : | (eq 1 (cdr (assq (cadr (cadr element)) points-alist))) | ||
| 894 : | (or (null minylen)(lessp ylen minylen))) | ||
| 895 : | (setq minylen ylen)))))) | ||
| 896 : | (cond ((null minylen) | ||
| 897 : | (setq tome1 (min tome (times yunit 0.8)))) | ||
| 898 : | (t | ||
| 899 : | (setq tome1 (min tome (times yunit 0.8)(quotient minylen 4.0))))) | ||
| 900 : | ; (print `(,tome1 ,tome ,yunit ,minylen)) | ||
| 901 : | (setq mw (min minchowidth (times xunit 0.25))) | ||
| 902 : | ; (setq mw minchowidth) | ||
| 903 : | prim)) | ||
| 904 : | ; | ||
| 905 : | (deftypehook mincho | ||
| 906 : | (function mincho-prim)) | ||
| 907 : | ; | ||
| 908 : | (def-type1-hint mincho tate | ||
| 909 : | (lets ((p0 (car points)) | ||
| 910 : | (p1 (cadr points)) | ||
| 911 : | (x (car p0)) | ||
| 912 : | (w mw)) | ||
| 913 : | (cond ((equal x (car p1)) | ||
| 914 : | `((v ,(difference x w).,(plus x w))))))) | ||
| 915 : | (comment | ||
| 916 : | (defelement mincho yoko | ||
| 917 : | (line2 (car points)(cadr points)(times mw tateyokoratio))) | ||
| 918 : | ) | ||
| 919 : | ; | ||
| 920 : | (def-type1-hint mincho yoko | ||
| 921 : | (lets ((dotsize (meshwidth (times mw tateyokoratio))) | ||
| 922 : | (w (normwidth dotsize)) | ||
| 923 : | (p0 (gridy (car points) dotsize)) | ||
| 924 : | (y (cadr p0)) | ||
| 925 : | (p1 (gridy (cadr points) dotsize))) | ||
| 926 : | (cond ((equal y (cadr p1)) | ||
| 927 : | `((h ,(difference y w).,(plus y w))))))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |