Annotation of /renderer/gothic.lAnnotation of /renderer/gothic.l
Parent Directory
| 
Revision Log
Revision: 1.4 - (view) (download)
| 1 : | ktanaka | 1.1 | ;(cond ((definedp 'kanjilib)) |
| 2 : | ; (t (exfile 'lib.l))) | ||
| 3 : | ktanaka | 1.4 | (declare (local_gothicwidth) special) |
| 4 : | ktanaka | 1.1 | (defun gothic2 (p1 p2 w) |
| 5 : | (lets ((p12 (diff2 p2 p1)) | ||
| 6 : | (l1 (normlen2 w (rot270 p12)))) | ||
| 7 : | `(((angle .,(plus2 p1 l1)) | ||
| 8 : | (angle .,(plus2 p2 l1))) | ||
| 9 : | ((angle .,(diff2 p1 l1)) | ||
| 10 : | (angle .,(diff2 p2 l1)))))) | ||
| 11 : | ; | ||
| 12 : | (defun gothic3 (p1 p2 p3 w (ratio 0.6666666666)) | ||
| 13 : | (lets ((p12 (diff2 p2 p1)) | ||
| 14 : | (l1 (normlen2 w (rot270 p12))) | ||
| 15 : | (p23 (diff2 p3 p2)) | ||
| 16 : | (l3 (normlen2 w (rot270 p23))) | ||
| 17 : | (dp1 (times2 (times 3 ratio) p12)) | ||
| 18 : | (dp2 (times2 (times 3 ratio) p23)) | ||
| 19 : | (ddp1 (plus2 | ||
| 20 : | (times2 6.0 (diff2 p3 p1)) | ||
| 21 : | (times2 -4.0 dp1) | ||
| 22 : | (times2 -2.0 dp2))) | ||
| 23 : | (ddp2 (plus2 | ||
| 24 : | (times2 6.0 (diff2 p1 p3)) | ||
| 25 : | (times2 4.0 dp2) | ||
| 26 : | (times2 2.0 dp1))) | ||
| 27 : | (dp1_ddp1 (mul2 dp1 ddp1)) | ||
| 28 : | (dp2_ddp2 (mul2 dp2 ddp2)) | ||
| 29 : | (lendp1 (length2 dp1)) | ||
| 30 : | (lendp2 (length2 dp2)) | ||
| 31 : | (lendp1_3 (expt lendp1 3)) | ||
| 32 : | (lendp2_3 (expt lendp2 3)) | ||
| 33 : | (a1 (plus2 p1 l1)) | ||
| 34 : | (a2 (plus2 p3 l3)) | ||
| 35 : | (b1 (diff2 p1 l1)) | ||
| 36 : | (b2 (diff2 p3 l3)) | ||
| 37 : | (da1 (plus2 | ||
| 38 : | dp1 | ||
| 39 : | (times2 (quotient w lendp1) (rot270 ddp1)) | ||
| 40 : | (times2 (quotient (times w dp1_ddp1) lendp1_3) (rot90 dp1)))) | ||
| 41 : | (da2 (plus2 | ||
| 42 : | dp2 | ||
| 43 : | (times2 (quotient w lendp2) (rot270 ddp2)) | ||
| 44 : | (times2 (quotient (times w dp2_ddp2) lendp2_3) (rot90 dp2)))) | ||
| 45 : | (db1 (plus2 | ||
| 46 : | dp1 | ||
| 47 : | (times2 (quotient w lendp1) (rot90 ddp1)) | ||
| 48 : | (times2 (quotient (times w dp1_ddp1) lendp1_3) (rot270 dp1)))) | ||
| 49 : | (db2 (plus2 | ||
| 50 : | dp2 | ||
| 51 : | (times2 (quotient w lendp2) (rot90 ddp2)) | ||
| 52 : | (times2 (quotient (times w dp2_ddp2) lendp2_3) (rot270 dp2)))) | ||
| 53 : | ) | ||
| 54 : | ; (break) | ||
| 55 : | `(((angle .,a1) | ||
| 56 : | (bezier .,(plus2 a1 (times2 0.33333333 da1))) | ||
| 57 : | (bezier .,(plus2 a2 (times2 -0.33333333 da2))) | ||
| 58 : | (angle .,a2)) | ||
| 59 : | ((angle .,b1) | ||
| 60 : | (bezier .,(plus2 b1 (times2 0.33333333 db1))) | ||
| 61 : | (bezier .,(plus2 b2 (times2 -0.33333333 db2))) | ||
| 62 : | (angle .,b2))))) | ||
| 63 : | |||
| 64 : | (defun gothiccurve (p1 p2 p3 w (ratio 0.6666666666)) | ||
| 65 : | (lets ((p12 (diff2 p2 p1)) | ||
| 66 : | (l1 (normlen2 w (rot270 p12))) | ||
| 67 : | (p23 (diff2 p3 p2)) | ||
| 68 : | (l3 (normlen2 w (rot270 p23))) | ||
| 69 : | (w1 (quotient (times -1.0 w (length2 l1)(length2 p23)) | ||
| 70 : | (mul2 l1 p23))) | ||
| 71 : | (a1 (plus2 p1 l1)) | ||
| 72 : | (a2 (plus2 p2 (normlen2 w1 (diff2 p2 p1))(normlen2 w1 (diff2 p2 p3)))) | ||
| 73 : | (a3 (plus2 p3 l3)) | ||
| 74 : | (b1 (diff2 p1 l1)) | ||
| 75 : | (b2 (plus2 p2 (normlen2 w1 (diff2 p1 p2))(normlen2 w1 (diff2 p3 p2)))) | ||
| 76 : | (b3 (diff2 p3 l3))) | ||
| 77 : | ; (break) | ||
| 78 : | ktanaka | 1.4 | ; (setq test 'bezier) |
| 79 : | ktanaka | 1.1 | `(((angle .,a1) |
| 80 : | ktanaka | 1.4 | (bezier .,(inter2 a1 a2 ratio)) |
| 81 : | (bezier .,(inter2 a3 a2 ratio)) | ||
| 82 : | ktanaka | 1.1 | (angle .,a3)) |
| 83 : | ((angle .,b1) | ||
| 84 : | ktanaka | 1.4 | (bezier .,(inter2 b1 b2 ratio)) |
| 85 : | (bezier .,(inter2 b3 b2 ratio)) | ||
| 86 : | ktanaka | 1.1 | (angle .,b3))))) |
| 87 : | |||
| 88 : | |||
| 89 : | (setq gothicwidth 13.0) | ||
| 90 : | ; | ||
| 91 : | (defkazari gothic ((tate hidari tatehidari tatehane kokoro tasuki magaritate) 0 | ||
| 92 : | (tate hidari tatehidari tatehane kokoro tasuki magaritate) 1) | ||
| 93 : | (lets ((p0 (vref cross 0)) | ||
| 94 : | (p1 (vref cross 1)) | ||
| 95 : | (p2 (vref cross 2)) | ||
| 96 : | (p3 (vref cross 3)) | ||
| 97 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 98 : | (len (metric2 p0 p1)) | ||
| 99 : | (sintheta (times 0.5 (car d0)))) | ||
| 100 : | `((angle .,p0) | ||
| 101 : | (bezier ., | ||
| 102 : | (plus2 p1 (normlen2 (plus (times len 0.2)(times len sintheta)) (diff2 p3 p1)) | ||
| 103 : | (normlen2 (times len 0.5) (diff2 p1 p0)))) | ||
| 104 : | (bezier ., | ||
| 105 : | (plus2 p1 (normlen2 (plus (times len 0.6)(times 1.5 len sintheta)) (diff2 p3 p1)) | ||
| 106 : | (normlen2 (times len 0.5) (diff2 p1 p0)))) | ||
| 107 : | (angle ., | ||
| 108 : | (plus2 p1 (normlen2 (plus (times len 0.8)(times len sintheta)) (diff2 p3 p1))))))) | ||
| 109 : | ; | ||
| 110 : | (defkazari gothic (migiue 0 migiue 1) | ||
| 111 : | (lets ((p1 (vref cross 0)) | ||
| 112 : | (p0 (vref cross 1)) | ||
| 113 : | (p3 (vref cross 2)) | ||
| 114 : | (p2 (vref cross 3)) | ||
| 115 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 116 : | (len (metric2 p0 p1)) | ||
| 117 : | ; (sintheta (times 0.5 (car d0))) | ||
| 118 : | (sintheta 0) | ||
| 119 : | ) | ||
| 120 : | `( | ||
| 121 : | (angle ., | ||
| 122 : | (plus2 p1 (normlen2 (plus (times len 0.8)(times len sintheta)) (diff2 p3 p1)))) | ||
| 123 : | (bezier ., | ||
| 124 : | (plus2 p1 (normlen2 (plus (times len 0.6)(times 1.5 len sintheta)) (diff2 p3 p1)) | ||
| 125 : | (normlen2 (times len 0.5) (diff2 p1 p0)))) | ||
| 126 : | (bezier ., | ||
| 127 : | (plus2 p1 (normlen2 (plus (times len 0.2)(times len sintheta)) (diff2 p3 p1)) | ||
| 128 : | (normlen2 (times len 0.5) (diff2 p1 p0)))) | ||
| 129 : | (angle .,p0)))) | ||
| 130 : | ; | ||
| 131 : | (defkazari gothic ((sanzui kokoro migiue tasuki) 2 (sanzui kokoro migiue tasuki) 3) | ||
| 132 : | (lets ((p1 (vref cross 0)) | ||
| 133 : | (p0 (vref cross 1)) | ||
| 134 : | (p3 (vref cross 2)) | ||
| 135 : | (p2 (vref cross 3)) | ||
| 136 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 137 : | (sintheta (min 0.25 (times 0.5 (cadr d0)))) | ||
| 138 : | (l0 (normlen2 (times sintheta (metric2 p0 p1)) d0)) | ||
| 139 : | ) | ||
| 140 : | `((angle .,(plus2 p1 l0)) | ||
| 141 : | (angle .,(diff2 p0 l0))))) | ||
| 142 : | (defkazari gothic (ten 2 ten 3) | ||
| 143 : | (lets ((p1 (vref cross 0)) | ||
| 144 : | (p0 (vref cross 1)) | ||
| 145 : | (p3 (vref cross 2)) | ||
| 146 : | (p2 (vref cross 3)) | ||
| 147 : | (l0 (times2 -0.1 (diff2 p3 p1)))) | ||
| 148 : | `((angle .,(plus2 p1 l0)) | ||
| 149 : | (angle .,(diff2 p0 l0))))) | ||
| 150 : | ; | ||
| 151 : | (defkazari gothic | ||
| 152 : | ; ((hidari tatehidari migi tatehane tsukurihane shin-nyuu kozato) 2 | ||
| 153 : | ; (hidari tatehidari migi tatehane tsukurihane shin-nyuu kozato) 3) | ||
| 154 : | ((hidari tatehidari migi shin-nyuu) 2 | ||
| 155 : | (hidari tatehidari migi shin-nyuu) 3) | ||
| 156 : | (lets ((p1 (vref cross 0)) | ||
| 157 : | (p0 (vref cross 1)) | ||
| 158 : | (p3 (vref cross 2)) | ||
| 159 : | (p2 (vref cross 3)) | ||
| 160 : | (d0 (norm2 (diff2 p3 p1))) | ||
| 161 : | (costheta (times 0.2 (car d0))) | ||
| 162 : | (l0 (normlen2 (times costheta (metric2 p0 p1)) d0)) | ||
| 163 : | ) | ||
| 164 : | `((angle .,(diff2 p1 l0)) | ||
| 165 : | (angle .,(plus2 p0 l0))))) | ||
| 166 : | ; | ||
| 167 : | (defkazari gothic ((magaritate tsukurihane hidari) 1 yoko 3) | ||
| 168 : | (lets ((p0 (vref cross 0)) | ||
| 169 : | (p1 (vref cross 1)) | ||
| 170 : | (p2 (vref cross 2)) | ||
| 171 : | (p3 (vref cross 3))) | ||
| 172 : | `((angle .,(inter2 p2 p3 0.3)) | ||
| 173 : | (angle .,(inter2 p1 p3 0.3))))) | ||
| 174 : | (defkazari gothic (hidari 2 ten 0) | ||
| 175 : | (lets ((p0 (vref cross 0)) | ||
| 176 : | (p1 (vref cross 1)) | ||
| 177 : | (p2 (vref cross 2)) | ||
| 178 : | (p3 (vref cross 3)) | ||
| 179 : | (newp0 (plus2 p3 (normlen2 (times 3.0 local_gothicwidth)(diff2 p0 p3)))) | ||
| 180 : | ) | ||
| 181 : | `((angle .,newp0)))) | ||
| 182 : | ;; | ||
| 183 : | ;; エレメントの定義 | ||
| 184 : | ;; | ||
| 185 : | ; | ||
| 186 : | ; 点の定義 | ||
| 187 : | ; | ||
| 188 : | (defelement gothic ten | ||
| 189 : | (lets ((x (car points)) | ||
| 190 : | (y (cadr points)) | ||
| 191 : | (x (inter2 y x 0.9)) | ||
| 192 : | (w local_gothicwidth) | ||
| 193 : | (diff (diff2 y x)) | ||
| 194 : | (m (plus2 (times2 0.5 (plus2 x y)) | ||
| 195 : | (times2 0.1 (list (cadr diff)(minus (car diff))))))) | ||
| 196 : | (gothic3 x m y w))) | ||
| 197 : | |||
| 198 : | ; (niku3 x m y 0.3 0.3 w w w (times 1.1 w)))) | ||
| 199 : | ; | ||
| 200 : | ; 縦棒の定義 | ||
| 201 : | ; | ||
| 202 : | (defelement gothic tate | ||
| 203 : | (let ((x (car points)) | ||
| 204 : | (y (cadr points)) | ||
| 205 : | (w local_gothicwidth)) | ||
| 206 : | (gothic2 x y w)))) | ||
| 207 : | |||
| 208 : | ; | ||
| 209 : | ; 横棒の定義 | ||
| 210 : | ; | ||
| 211 : | (defelement gothic yoko | ||
| 212 : | (let ((x (car points)) | ||
| 213 : | (y (cadr points)) | ||
| 214 : | (w local_gothicwidth)) | ||
| 215 : | (gothic2 (inter2 x y 0.000001) (inter2 y x 0.00001) w))) | ||
| 216 : | ; | ||
| 217 : | ; 右上はらいの定義 | ||
| 218 : | ; | ||
| 219 : | (defelement gothic migiue | ||
| 220 : | (let ((x (car points)) | ||
| 221 : | (y (cadr points)) | ||
| 222 : | (z (caddr points)) | ||
| 223 : | (w local_gothicwidth) | ||
| 224 : | ) | ||
| 225 : | ; (niku3 x y z 0.3 0.3 w w w w) | ||
| 226 : | (gothic3 x y z w) | ||
| 227 : | )) | ||
| 228 : | |||
| 229 : | ; | ||
| 230 : | ; 左はらいの定義 | ||
| 231 : | ; | ||
| 232 : | (defelement gothic hidari | ||
| 233 : | (lets ((p0 (car points)) | ||
| 234 : | (p1 (cadr points)) | ||
| 235 : | (p2 (caddr points)) | ||
| 236 : | (w local_gothicwidth) | ||
| 237 : | ) | ||
| 238 : | (gothic3 p0 p1 p2 w))) | ||
| 239 : | ; | ||
| 240 : | ; 縦左はらいの定義 | ||
| 241 : | ; | ||
| 242 : | (defelement gothic tatehidari | ||
| 243 : | (lets ((p0 (car points)) | ||
| 244 : | (p1 (cadr points)) | ||
| 245 : | (p2 (caddr points)) | ||
| 246 : | (p3 (cadddr points)) | ||
| 247 : | (w local_gothicwidth) | ||
| 248 : | (l0 (gothic2 p0 p1 w)) | ||
| 249 : | (l1 (gothic3 p1 p2 p3 w))) | ||
| 250 : | `(,(nconc (car l0) (cdar l1)) | ||
| 251 : | ,(nconc (cadr l0) (cdadr l1))))) | ||
| 252 : | ; | ||
| 253 : | ; 右はらいの定義 | ||
| 254 : | ; | ||
| 255 : | (defelement gothic migi | ||
| 256 : | (let ((x (car points)) | ||
| 257 : | (y (cadr points)) | ||
| 258 : | (z (caddr points)) | ||
| 259 : | (w local_gothicwidth)) | ||
| 260 : | ; (niku3 x y z 0.3 0.3 w w w w) | ||
| 261 : | (gothic3 x y z w) | ||
| 262 : | )) | ||
| 263 : | ; | ||
| 264 : | ; こざと偏の一部 | ||
| 265 : | ; | ||
| 266 : | (defelement gothic kozato | ||
| 267 : | (lets ((p0 (car points)) | ||
| 268 : | (p1 (cadr points)) | ||
| 269 : | (p2 (caddr points)) | ||
| 270 : | (p3 (fourth points)) | ||
| 271 : | (p12 (inter2 p1 p2 0.5)) | ||
| 272 : | (w local_gothicwidth)) | ||
| 273 : | (curve2 p0 (inter2 p0 p1 0.6)(inter2 p12 p1 0.6) p12 | ||
| 274 : | w w w w | ||
| 275 : | (hane p12 p2 p3 | ||
| 276 : | w w w)))) | ||
| 277 : | ; | ||
| 278 : | ; 縦跳ね | ||
| 279 : | ; | ||
| 280 : | (defelement gothic tatehane | ||
| 281 : | (lets ((p0 (car points)) | ||
| 282 : | (p1 (cadr points)) | ||
| 283 : | (p2 (caddr points)) | ||
| 284 : | (w local_gothicwidth) | ||
| 285 : | (p1 (plus2 p1 (normlen2 w (diff2 p0 p1)))) | ||
| 286 : | (p2 (plus2 p2 (normlen2 w (diff2 p0 p1)))) | ||
| 287 : | (len0 (metric2 p0 p1)) | ||
| 288 : | (len1 (metric2 p1 p2)) | ||
| 289 : | (p01 (inter2 p1 p0 (quotient len1 len0))) | ||
| 290 : | (p2 (plus2 p1 (normlen2 (max (times 2.0 w)(metric2 p2 p1)) | ||
| 291 : | (diff2 p2 p1))))) | ||
| 292 : | (line2 p0 p01 w (hane p01 p1 p2 w w w)))) | ||
| 293 : | ; (out1 (gothic2 p0 p01 w)) | ||
| 294 : | ; (out2 (gothiccurve p01 p1 p2 w))) | ||
| 295 : | ; `(,(nconc (car out1)(cdar out2)) | ||
| 296 : | ; ,(nconc (cadr out1)(cdadr out2))))) | ||
| 297 : | ; | ||
| 298 : | ; 旁の跳ね | ||
| 299 : | ; | ||
| 300 : | (defelement gothic tsukurihane | ||
| 301 : | (lets ((p0 (car points)) | ||
| 302 : | (p1 (cadr points)) | ||
| 303 : | (p2 (caddr points)) | ||
| 304 : | (p3 (cadddr points)) | ||
| 305 : | (w local_gothicwidth) | ||
| 306 : | (p2 (plus2 p2 (normlen2 w (diff2 p1 p2)))) | ||
| 307 : | (p3 (plus2 p3 (normlen2 w (diff2 p1 p2)))) | ||
| 308 : | (p3 (cond ((lessp (metric2 p2 p3) (times w 2)) | ||
| 309 : | (plus2 p2 (normlen2 (times w 2)(diff2 p3 p2)))) | ||
| 310 : | (t p3))) | ||
| 311 : | (p4 (inter2 p1 p2 0.5)) | ||
| 312 : | ; (out1 (gothic3 p0 p1 p4 w)) | ||
| 313 : | ; (out2 (gothic3 p4 p2 p3 w)) | ||
| 314 : | ) | ||
| 315 : | ; (break) | ||
| 316 : | (curve2 p0 (inter2 p0 p1 0.6)(inter2 p4 p1 0.6) p4 | ||
| 317 : | w w w w | ||
| 318 : | (hane p4 p2 p3 | ||
| 319 : | w w w)))) | ||
| 320 : | ; )) | ||
| 321 : | ; ) | ||
| 322 : | ; `(,(nconc (car out1)(cdar out2)) | ||
| 323 : | ; ,(nconc (cadr out1)(cdadr out2))))) | ||
| 324 : | ; | ||
| 325 : | ; さんずい | ||
| 326 : | ; | ||
| 327 : | (defelement gothic sanzui | ||
| 328 : | (lets ((p0 (car points)) | ||
| 329 : | (p1 (cadr points)) | ||
| 330 : | (dx (difference (car p0)(car p1))) | ||
| 331 : | (p0 (plus2 p0 `(,dx 0))) | ||
| 332 : | (p1 (inter2 p0 p1 0.7)) | ||
| 333 : | (p0 (inter2 p1 p0 0.9)) | ||
| 334 : | (v0 (times2 0.05 (rot270 (diff2 p1 p0)))) | ||
| 335 : | (p2 (plus2 (inter2 p0 p1 0.5) v0)) | ||
| 336 : | (w local_gothicwidth)) | ||
| 337 : | (gothic3 p0 p2 p1 w))) | ||
| 338 : | |||
| 339 : | ; | ||
| 340 : | ; こころ | ||
| 341 : | ; | ||
| 342 : | (defelement gothic kokoro | ||
| 343 : | (lets ((p0 (car points)) | ||
| 344 : | (p1 (cadr points)) | ||
| 345 : | (p2 (caddr points)) | ||
| 346 : | (p3 (cadddr points)) | ||
| 347 : | (w local_gothicwidth) | ||
| 348 : | (p2 (plus2 p2 (normlen2 (times w 1.2)(diff2 p1 p2)))) | ||
| 349 : | (p1 (plus2 p1 (normlen2 w (diff2 p0 p1)))) | ||
| 350 : | (p2 (plus2 p2 (normlen2 w (diff2 p3 p2)))) | ||
| 351 : | (w2 (times w 2)) | ||
| 352 : | (p10 (plus2 p1 (normlen2 w2 (diff2 p0 p1)))) | ||
| 353 : | (p12 (cond ((lessp (metric2 p1 p2) (times w2 2.0)) | ||
| 354 : | (inter2 p1 p2 0.5)) | ||
| 355 : | (t (plus2 p1 (normlen2 w2 (diff2 p2 p1)))))) | ||
| 356 : | (p21 (cond ((lessp (metric2 p1 p2) (times w2 2.0)) | ||
| 357 : | nil) | ||
| 358 : | (t (plus2 p2 (normlen2 w2 (diff2 p1 p2)))))) | ||
| 359 : | (p23 (plus2 p2 (normlen2 (min w2 (times 0.8 (metric2 p3 p2)))(diff2 p3 p2)))) | ||
| 360 : | (out1 (gothic2 p0 p10 w)) | ||
| 361 : | (out2 (gothiccurve p10 p1 p12 w)) | ||
| 362 : | (out3 (cond (p21 (gothic2 p12 p21 w)) | ||
| 363 : | (t '((nil) (nil))))) | ||
| 364 : | (out4 (cond (p21 (gothiccurve p21 p2 p23 w)) | ||
| 365 : | (t (gothiccurve p12 p2 p23 w)))) | ||
| 366 : | (out5 (gothic2 p23 p3 w))) | ||
| 367 : | `(,(nconc (car out1)(cdar out2)(cdar out3)(cdar out4)(cdar out5)) | ||
| 368 : | ,(nconc (cadr out1)(cdadr out2)(cdadr out3)(cdadr out4)(cdadr out5))))) | ||
| 369 : | ; | ||
| 370 : | ; たすき | ||
| 371 : | ; | ||
| 372 : | (defelement gothic tasuki | ||
| 373 : | (lets ((p0 (car points)) | ||
| 374 : | (p1 (cadr points)) | ||
| 375 : | (p2 (caddr points)) | ||
| 376 : | (p3 (cadddr points)) | ||
| 377 : | (w local_gothicwidth) | ||
| 378 : | (p21 (plus2 p2 (normlen2 | ||
| 379 : | (min (times 0.5 (metric2 p1 p2))(times 4 w)) | ||
| 380 : | (diff2 p1 p2)))) | ||
| 381 : | (p23 (plus2 p2 (normlen2 | ||
| 382 : | (min (times 0.5 (metric2 p2 p3))(times 4 w)) | ||
| 383 : | (diff2 p3 p2))))) | ||
| 384 : | (curve2 p0 (inter2 p0 p1 0.7)(inter2 p21 p1 0.7) p21 | ||
| 385 : | w w w w | ||
| 386 : | (curve2 p21 (inter2 p21 p2 0.7)(inter2 p23 p2 0.7) p23 | ||
| 387 : | w w w w | ||
| 388 : | (gothic2 p23 p3 w))))) | ||
| 389 : | ; `(,(nconc (car out1)(cdar out2)(cdar out3)) | ||
| 390 : | ; ,(nconc (cadr out1)(cdadr out2)(cdadr out3))))) | ||
| 391 : | ; | ||
| 392 : | ; まがりたて | ||
| 393 : | ; | ||
| 394 : | (defelement gothic magaritate | ||
| 395 : | (let ((p0 (car points)) | ||
| 396 : | (p1 (cadr points)) | ||
| 397 : | (p2 (caddr points)) | ||
| 398 : | (w local_gothicwidth)) | ||
| 399 : | (cond ((lessp (metric2 p1 p2)(times 4.0 w)) | ||
| 400 : | (gothic2 p0 p2 w)) | ||
| 401 : | (t | ||
| 402 : | (gothic3 p0 p1 p2 w))))) | ||
| 403 : | ; | ||
| 404 : | ; かぎ | ||
| 405 : | ; | ||
| 406 : | (defelement gothic kagi | ||
| 407 : | (lets ((p0 (car points)) | ||
| 408 : | (p1 (cadr points)) | ||
| 409 : | (p2 (caddr points)) | ||
| 410 : | (w local_gothicwidth) | ||
| 411 : | (p1 (plus2 p1 (normlen2 w (diff2 p0 p1)))) | ||
| 412 : | (p2 (plus2 p2 (normlen2 w (diff2 p0 p1)))) | ||
| 413 : | (w2 (times w 3)) | ||
| 414 : | (p10 (cond ((lessp w2 (metric2 p0 p1)) | ||
| 415 : | (plus2 p1 (normlen2 w2 (diff2 p0 p1)))) | ||
| 416 : | (t p0))) | ||
| 417 : | (p12 (plus2 p1 (normlen2 w2 (diff2 p2 p1)))) | ||
| 418 : | (out1 (cond ((not (eq p0 p10)) (gothic2 p0 p10 w))(t '(nil nil)))) | ||
| 419 : | (out2 (gothiccurve p10 p1 p12 w circle-ratio)) | ||
| 420 : | (out3 (gothic2 p12 p2 w))) | ||
| 421 : | `(,(nconc (car out1)(cdar out2)(cdar out3)) | ||
| 422 : | ,(nconc (cadr out1)(cdadr out2)(cdadr out3))))) | ||
| 423 : | ; | ||
| 424 : | ; しんにゅう | ||
| 425 : | ; | ||
| 426 : | (defelement gothic shin-nyuu | ||
| 427 : | (lets ((p0 (car points)) | ||
| 428 : | (p1 (cadr points)) | ||
| 429 : | (p2 (caddr points)) | ||
| 430 : | (w local_gothicwidth)) | ||
| 431 : | (curve2 p0 (inter2 p0 p1 0.7)(inter2 p2 p1 0.7) p2 w w w w))) | ||
| 432 : | ; (gothic3 p0 p1 p2 w))) | ||
| 433 : | ; | ||
| 434 : | (deftypehook gothic | ||
| 435 : | (function gothic-prim)) | ||
| 436 : | (declare (yokopoints) special) | ||
| 437 : | (defun rm-geta (prim getalen) | ||
| 438 : | (lets ((points (car prim)) | ||
| 439 : | (elements (cadr prim)) | ||
| 440 : | (newelements) | ||
| 441 : | (linkpoints) | ||
| 442 : | (yokopoints)) | ||
| 443 : | (do ((l elements (cdr l))(p)(link)) | ||
| 444 : | ((atom l)) | ||
| 445 : | (and (setq link (assq 'link (cddar l))) | ||
| 446 : | (setq linkpoints (append (cdr link) linkpoints))) | ||
| 447 : | (and (eq (caar l) 'yoko) | ||
| 448 : | (setq p (cadar l)) | ||
| 449 : | (setq yokopoints `(,(car p) ,(cadr p) .,yokopoints))) | ||
| 450 : | (or (memq (caar l) '(tate magaritate)) | ||
| 451 : | (setq linkpoints (append (cadar l) linkpoints)))) | ||
| 452 : | (do ((l elements (cdr l))(epoints)(p1)(lastp)(rp1)(link)(yokolink)) | ||
| 453 : | ((atom l) | ||
| 454 : | `(,points ,(nreverse newelements) .,(cddr prim))) | ||
| 455 : | (cond ((memq (caar l) '(tate magaritate)) | ||
| 456 : | (setq epoints (copy (cadar l))) | ||
| 457 : | (setq lastp (last epoints)) | ||
| 458 : | (setq rp1 (nth (setq p1 (car lastp)) points)) | ||
| 459 : | (setq link (assq 'link (cddar l))) | ||
| 460 : | (and link | ||
| 461 : | (setq yokolink | ||
| 462 : | (do ((ll (cdr link)(cdr ll))(ret)) | ||
| 463 : | ((atom ll)(nreverse ret)) | ||
| 464 : | (and (memq (car ll) yokopoints) | ||
| 465 : | (push (car ll) ret))))) | ||
| 466 : | (cond ((or (null link)(null yokolink)(memq p1 linkpoints)) | ||
| 467 : | (push (car l) newelements)) | ||
| 468 : | (t | ||
| 469 : | (do ((ll yokolink (cdr ll))(minlink)(minlen)(p)(len)) | ||
| 470 : | ((atom ll) | ||
| 471 : | (cond ((lessp minlen getalen) | ||
| 472 : | (rplaca lastp minlink) | ||
| 473 : | ; (break) | ||
| 474 : | (push `(,(caar l) ,epoints | ||
| 475 : | (link .,(remq minlink (cdr link))) | ||
| 476 : | .,(cddar l)) newelements)) | ||
| 477 : | (t | ||
| 478 : | (push (car l) newelements)))) | ||
| 479 : | (setq p (nth (car ll) points)) | ||
| 480 : | (setq len (metric2 rp1 p)) | ||
| 481 : | (and (or (null minlink)(lessp len minlen)) | ||
| 482 : | (setq minlink (car ll) minlen len)))))) | ||
| 483 : | (t (push (car l) newelements)))))) | ||
| 484 : | |||
| 485 : | (defun gothic-prim (prim) | ||
| 486 : | (lets ((prim (rm-geta prim 30.0)) | ||
| 487 : | (points (car prim)) | ||
| 488 : | (elements (cadr prim)) | ||
| 489 : | (alist (cddr prim)) | ||
| 490 : | (origunits (units prim)) | ||
| 491 : | (units (units | ||
| 492 : | `(,points ,elements | ||
| 493 : | .,(every alist | ||
| 494 : | #'(lambda (x) | ||
| 495 : | (not (memq (car x) | ||
| 496 : | '(xunit yunit)))))))) | ||
| 497 : | (width (min gothicwidth | ||
| 498 : | (times 0.16 (min (car origunits)(cdr origunits)(car units)(cdr units)))))) | ||
| 499 : | ; (break) | ||
| 500 : | (setq local_gothicwidth width) | ||
| 501 : | `(,points ,elements .,alist))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |