Annotation of /renderer/unit.lAnnotation of /renderer/unit.l
Parent Directory
| 
Revision Log
Revision: 1.4 - (view) (download)
| 1 : | ktanaka | 1.1 | ; |
| 2 : | ktanaka | 1.4 | (declare (ylimitval) special) |
| 3 : | ktanaka | 1.1 | (setq ylimitval 0.15) |
| 4 : | (defun add-ylimit (prim) | ||
| 5 : | (cond ((assq 'ylimit (cddr prim)) | ||
| 6 : | prim) | ||
| 7 : | (t | ||
| 8 : | (lets ((nprim (add-unit prim)) | ||
| 9 : | (yunit (yunit nprim)) | ||
| 10 : | (region (realregion nprim)) | ||
| 11 : | (height (difference (fourth region)(second region)))) | ||
| 12 : | (cond | ||
| 13 : | ((zerop height) | ||
| 14 : | `(,(car prim) ,(cadr prim) | ||
| 15 : | (ylimit ,(difference (second region) yunit) | ||
| 16 : | ,(plus (second region) yunit)) | ||
| 17 : | .,(cddr nprim))) | ||
| 18 : | (t | ||
| 19 : | (do ((i 0 (1+ i)) | ||
| 20 : | (prim1 '(((0 0)(400 0))((ylimit (0 1))))) | ||
| 21 : | (conv (vector 6 '(0 0 0 0 0 1))) | ||
| 22 : | (ylimit) | ||
| 23 : | (section1) | ||
| 24 : | (ylimit1 (second region)) | ||
| 25 : | (ylimit2 (fourth region))) | ||
| 26 : | ((>= i 3) | ||
| 27 : | `(,(car prim) | ||
| 28 : | ,(cadr prim) | ||
| 29 : | (ylimit ,ylimit1 ,ylimit2).,(cddr nprim))) | ||
| 30 : | (setq ylimit (times ylimitval (difference ylimit2 ylimit1))) | ||
| 31 : | (setq section1 (general-section nprim prim1 conv | ||
| 32 : | `((ylimit 0 . ,ylimit)))) | ||
| 33 : | (setq ylimit1 (rm-eq (caar section1))) | ||
| 34 : | (setq ylimit2 (rm-eq (cdar (reverse section1))))))))))) | ||
| 35 : | ; | ||
| 36 : | (defun add-xlimit (prim) | ||
| 37 : | (cond ((assq 'xlimit (cddr prim)) | ||
| 38 : | prim) | ||
| 39 : | (t | ||
| 40 : | (lets ((nprim (add-unit prim)) | ||
| 41 : | (prim1 '(((0 0)(0 400))((xlimit (0 1))))) | ||
| 42 : | (conv (vector 6 '(0 0 0 0 1 0))) | ||
| 43 : | (xlimit (times 0.8 (xunit nprim))) | ||
| 44 : | (section1 (general-section nprim prim1 conv | ||
| 45 : | `((xlimit 0 . ,xlimit)))) | ||
| 46 : | (xlimit1 (rm-eq (caar section1))) | ||
| 47 : | (xlimit2 (rm-eq (cdar (reverse section1)))) | ||
| 48 : | (center (prim-center prim)) | ||
| 49 : | (centerwidth (and center (max (difference center xlimit1) | ||
| 50 : | (difference xlimit2 center))))) | ||
| 51 : | ; (break) | ||
| 52 : | (cond (center `(,(car prim),(cadr prim) | ||
| 53 : | (xlimit ,(difference center centerwidth) | ||
| 54 : | ,(plus center centerwidth)) | ||
| 55 : | .,(cddr prim))) | ||
| 56 : | (t `(,(car prim),(cadr prim) | ||
| 57 : | (xlimit ,xlimit1 ,xlimit2).,(cddr prim)))))))) | ||
| 58 : | |||
| 59 : | ; | ||
| 60 : | (defun xscale (fonttype list) | ||
| 61 : | (lets ((scale (car list)) | ||
| 62 : | (prim (cadr list)) | ||
| 63 : | (nprim (add-unit (applykanji prim fonttype))) | ||
| 64 : | (xunit (xunit nprim)) | ||
| 65 : | (affine (region-affine | ||
| 66 : | (virtual-region '(nil nil (center . 200)) '(0 0 400 200)) | ||
| 67 : | nprim '((xlimitratio . 1.0)) '(0 0 400 200))) | ||
| 68 : | (xlimit1 (//$ (float (minus (vref affine 4))) | ||
| 69 : | (float (vref affine 0)))) | ||
| 70 : | (xlimit2 (//$ (difference 400.0 (vref affine 4)) | ||
| 71 : | (float (vref affine 0)))) | ||
| 72 : | (width (difference xlimit2 xlimit1)) | ||
| 73 : | (width1 (quotient width scale)) | ||
| 74 : | (delta (times 0.5 (difference width1 width))) | ||
| 75 : | ; (soko (break)) | ||
| 76 : | ) | ||
| 77 : | `(,(car nprim) | ||
| 78 : | ,(cadr nprim) | ||
| 79 : | (xunit .,(//$ (float xunit) (float scale))) | ||
| 80 : | (xlimit ,(difference xlimit1 delta) ,(plus xlimit2 delta)) | ||
| 81 : | .,(cddr nprim)))) | ||
| 82 : | ; | ||
| 83 : | (defun yscale (fonttype list) | ||
| 84 : | (lets ((scale (car list)) | ||
| 85 : | (prim (cadr list)) | ||
| 86 : | (nprim (add-unit (applykanji prim fonttype))) | ||
| 87 : | (yunit (yunit nprim)) | ||
| 88 : | (prim1 '(((0 0)(400 0))((ylimit (0 1))))) | ||
| 89 : | (conv (vector 6 '(0 0 0 0 0 1))) | ||
| 90 : | (ylimit 50) | ||
| 91 : | (section1 (general-section nprim prim1 conv | ||
| 92 : | `((ylimit 0 . ,ylimit)))) | ||
| 93 : | (ylimit1 (rm-eq (caar section1))) | ||
| 94 : | (ylimit2 (rm-eq (cdar (reverse section1)))) | ||
| 95 : | (height (difference ylimit2 ylimit1)) | ||
| 96 : | (height1 (quotient height scale)) | ||
| 97 : | (delta (times 0.5 (difference height1 height)))) | ||
| 98 : | `(,(car nprim) | ||
| 99 : | ,(cadr nprim) | ||
| 100 : | (yunit .,(//$ (float yunit) (float scale))) | ||
| 101 : | (ylimit ,(difference ylimit1 delta) ,(plus ylimit2 delta)) | ||
| 102 : | .,(cddr nprim)))) | ||
| 103 : | ; | ||
| 104 : | (defun prim-xlen (prim region) | ||
| 105 : | (lets ((points (car prim)) | ||
| 106 : | (lines (cadr prim)) | ||
| 107 : | (alist (cddr prim)) | ||
| 108 : | (minx (car region)) | ||
| 109 : | (maxx (caddr region)) | ||
| 110 : | (width (difference maxx minx)) | ||
| 111 : | (xlen (assoc 'xlen alist))) | ||
| 112 : | (cond | ||
| 113 : | (xlen (cdr xlen)) | ||
| 114 : | ((zerop width)0.0) | ||
| 115 : | (t | ||
| 116 : | (do ((l lines (cdr l)) | ||
| 117 : | (xlen 0.0)) | ||
| 118 : | ((atom l) | ||
| 119 : | (cond ((lessp 2.0 (quotient xlen width))(quotient xlen width)) | ||
| 120 : | (t 2.0))) | ||
| 121 : | (do ((ll (cadar l) (cdr ll))) | ||
| 122 : | ((atom (cdr ll))) | ||
| 123 : | (setq | ||
| 124 : | xlen | ||
| 125 : | (plus xlen (abs (difference (car (nth (car ll) points)) | ||
| 126 : | (car (nth (cadr ll) points)))))))))))) | ||
| 127 : | ; | ||
| 128 : | (defun prim-ylen (prim region) | ||
| 129 : | (lets ((points (car prim)) | ||
| 130 : | (lines (cadr prim)) | ||
| 131 : | (alist (cddr prim)) | ||
| 132 : | (miny (cadr region)) | ||
| 133 : | (maxy (cadddr region)) | ||
| 134 : | (height (difference maxy miny)) | ||
| 135 : | (ylen (assoc 'ylen alist))) | ||
| 136 : | (cond | ||
| 137 : | (ylen (cdr ylen)) | ||
| 138 : | ((zerop height)0.0) | ||
| 139 : | (t | ||
| 140 : | (do ((l lines (cdr l)) | ||
| 141 : | (ylen 0.0)) | ||
| 142 : | ((atom l) | ||
| 143 : | (cond ((lessp 2.0 (quotient ylen height)) | ||
| 144 : | (quotient ylen height)) | ||
| 145 : | (t 2.0))) | ||
| 146 : | (do ((ll (cadar l) (cdr ll))) | ||
| 147 : | ((atom (cdr ll))) | ||
| 148 : | (setq | ||
| 149 : | ylen | ||
| 150 : | (plus ylen (abs (difference(cadr (nth (car ll) points)) | ||
| 151 : | (cadr (nth (cadr ll) points)))))))))))) | ||
| 152 : | (defun realregion (prim) | ||
| 153 : | (cond ((assqcdr 'realregion (cddr prim))) | ||
| 154 : | (t | ||
| 155 : | (lets ((points (car prim)) | ||
| 156 : | (minx (caar points)) | ||
| 157 : | (maxx minx) | ||
| 158 : | (miny (cadar points)) | ||
| 159 : | (maxy miny)) | ||
| 160 : | (do ((l (cdr points) (cdr l)) | ||
| 161 : | (x nil)(y nil)) | ||
| 162 : | ((atom l)(list minx miny maxx maxy)) | ||
| 163 : | (setq x (caar l) y (cadar l)) | ||
| 164 : | (cond ((greaterp minx x)(setq minx x)) | ||
| 165 : | ((lessp maxx x)(setq maxx x))) | ||
| 166 : | (cond ((greaterp miny y)(setq miny y)) | ||
| 167 : | ((lessp maxy y)(setq maxy y)))))))) | ||
| 168 : | (defun affinelist (point trans) | ||
| 169 : | (let ((x (float (car point))) | ||
| 170 : | (y (float (cadr point)))) | ||
| 171 : | `( | ||
| 172 : | ,(plus (vref trans 4)(times x (vref trans 0))(times y (vref trans 2))) | ||
| 173 : | ,(plus (vref trans 5)(times x (vref trans 1))(times y (vref trans 3))) | ||
| 174 : | .,(cddr point)))) | ||
| 175 : | |||
| 176 : | |||
| 177 : | |||
| 178 : | (defun affinepart (l trans) | ||
| 179 : | (let ((points (car l)) | ||
| 180 : | (lines (cadr l)) | ||
| 181 : | (alist (cddr l)) | ||
| 182 : | (newpoints nil)) | ||
| 183 : | (do ((ll points (cdr ll))) | ||
| 184 : | ((atom ll)`(,(nreverse newpoints) ,lines .,(affinealist alist trans))) | ||
| 185 : | (push (affinelist (car ll) trans) newpoints)))) | ||
| 186 : | (declare (transalist) special) | ||
| 187 : | (setq transalist '(tare nyou kamae kamae1 kamae2)) | ||
| 188 : | (defun affinealist (l trans) | ||
| 189 : | (do ((ll l (cdr ll)) | ||
| 190 : | (p0 nil) | ||
| 191 : | (p1 nil) | ||
| 192 : | (ret nil)) | ||
| 193 : | ((atom ll)(nreverse ret)) | ||
| 194 : | (cond ((memq (caar ll) transalist) | ||
| 195 : | (setq p0 (list (cadar ll)(caddar ll)) p1 (cdddar ll)) | ||
| 196 : | (push (cons (caar ll) | ||
| 197 : | (append (affinelist p0 trans) | ||
| 198 : | (affinelist p1 trans))) ret)) | ||
| 199 : | ((equal (car ll) '(center))(push '(center) ret)) | ||
| 200 : | ((eq (caar ll) 'center) | ||
| 201 : | (push `(center .,(plus (times (vref trans 0) (cdar ll)) | ||
| 202 : | (vref trans 4))) ret)) | ||
| 203 : | ((eq (caar ll) 'xunit) | ||
| 204 : | (push `(xunit .,(times (vref trans 0) (cdar ll))) ret)) | ||
| 205 : | ((eq (caar ll) 'yunit) | ||
| 206 : | (push `(yunit .,(times (vref trans 3) (cdar ll))) ret)) | ||
| 207 : | ))) | ||
| 208 : | ; (t (push (car ll) ret))))) | ||
| 209 : | |||
| 210 : | (defun appendpart (prim0 prim1 (newalist)) | ||
| 211 : | (lets ((points0 (car prim0)) | ||
| 212 : | (lines0 (cadr prim0)) | ||
| 213 : | ; (primalist0 (cddr prim0)) | ||
| 214 : | (base (length points0)) | ||
| 215 : | (points1 (car prim1)) | ||
| 216 : | (lines1 (cadr prim1)) | ||
| 217 : | (alist nil)(links nil)(newlinks nil) | ||
| 218 : | ; (primalist1 (cddr prim1)) | ||
| 219 : | ) | ||
| 220 : | ; (prind (list primalist0 primalist1)) | ||
| 221 : | (do ((l lines1 (cdr l)) | ||
| 222 : | (newlines nil)) | ||
| 223 : | ((atom l) | ||
| 224 : | `(,(append points0 points1) | ||
| 225 : | ,(append lines0 (nreverse newlines)) | ||
| 226 : | ; .,(append newalist primalist0 primalist1) | ||
| 227 : | .,newalist | ||
| 228 : | )) | ||
| 229 : | (setq alist (cddar l)) | ||
| 230 : | (setq links (assq 'link alist)) | ||
| 231 : | (setq newlinks nil) | ||
| 232 : | (cond (links | ||
| 233 : | (do ((ll (cdr links) (cdr ll)) | ||
| 234 : | (newlinks nil)) | ||
| 235 : | ((atom ll)(setq links `(link .,(nreverse newlinks)))) | ||
| 236 : | (push (+ base (car ll)) newlinks)) | ||
| 237 : | (push links alist))) | ||
| 238 : | (do ((ll (cadar l) (cdr ll)) | ||
| 239 : | (newline nil)) | ||
| 240 : | ((atom ll)(push (cons (caar l)(cons (nreverse newline) alist)) newlines)) | ||
| 241 : | (push (+ base (car ll)) newline))))) | ||
| 242 : | (comment | ||
| 243 : | (defun movexy (x y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 244 : | (let ((ret (vector 6 trans))) | ||
| 245 : | (vset ret 4 (plus (vref ret 4)(float x))) | ||
| 246 : | (vset ret 5 (plus (vref ret 5)(float y))) | ||
| 247 : | ret)) | ||
| 248 : | |||
| 249 : | (defun movex (x (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 250 : | (let ((ret (vector 6 trans))) | ||
| 251 : | (vset ret 4 (plus (vref ret 4)(float x))) | ||
| 252 : | ret)) | ||
| 253 : | |||
| 254 : | (defun movey (y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 255 : | (let ((ret (vector 6 trans))) | ||
| 256 : | (vset ret 5 (plus (vref ret 5)(float y))) | ||
| 257 : | ret)) | ||
| 258 : | |||
| 259 : | (defun scalex (x (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 260 : | (let ((ret (vector 6 trans))) | ||
| 261 : | (vset ret 0 (times (vref ret 0)(float x))) | ||
| 262 : | (vset ret 2 (times (vref ret 2)(float x))) | ||
| 263 : | (vset ret 4 (times (vref ret 4)(float x))) | ||
| 264 : | ret)) | ||
| 265 : | |||
| 266 : | (defun scalexy (x y(trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 267 : | (let ((ret (vector 6 trans))) | ||
| 268 : | (vset ret 0 (times (vref ret 0)(float x))) | ||
| 269 : | (vset ret 1 (times (vref ret 1)(float y))) | ||
| 270 : | (vset ret 2 (times (vref ret 2)(float x))) | ||
| 271 : | (vset ret 3 (times (vref ret 3)(float y))) | ||
| 272 : | (vset ret 4 (times (vref ret 4)(float x))) | ||
| 273 : | (vset ret 5 (times (vref ret 5)(float y))) | ||
| 274 : | ret)) | ||
| 275 : | |||
| 276 : | (defun scaley (y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0)))) | ||
| 277 : | (let ((ret (vector 6 trans))) | ||
| 278 : | (vset ret 1 (times (vref ret 1)(float y))) | ||
| 279 : | (vset ret 3 (times (vref ret 3)(float y))) | ||
| 280 : | (vset ret 5 (times (vref ret 5)(float y))) | ||
| 281 : | ret)) | ||
| 282 : | ) | ||
| 283 : | ; | ||
| 284 : | (defun add-unit (prim (ratio '(1 . 1))) | ||
| 285 : | (lets ((points (car prim)) | ||
| 286 : | (elements (cadr prim)) | ||
| 287 : | (alist (cddr prim)) | ||
| 288 : | (xunit (assq 'xunit alist)) | ||
| 289 : | (yunit (assq 'yunit alist)) | ||
| 290 : | (units (or (and xunit yunit)(units prim))) | ||
| 291 : | (newalist | ||
| 292 : | (cond (xunit `((xunit .,(times (car ratio)(cdr xunit))).,alist)) | ||
| 293 : | ((zerop (region-width (realregion prim))) alist) | ||
| 294 : | (t `((xunit .,(times (car ratio)(car units))).,alist)))) | ||
| 295 : | (newalist | ||
| 296 : | (cond (yunit `((yunit .,(times (cdr ratio)(cdr yunit))).,newalist)) | ||
| 297 : | ((zerop (region-height (realregion prim))) newalist) | ||
| 298 : | (t `((yunit .,(times (cdr ratio)(cdr units))).,newalist))))) | ||
| 299 : | `(,points ,elements .,newalist))) | ||
| 300 : | ; | ||
| 301 : | (defun yunit (prim (defunit 100.0)) | ||
| 302 : | (let ((yunit (assq 'yunit (cddr prim)))) | ||
| 303 : | (cond (yunit (cdr yunit)) | ||
| 304 : | (t | ||
| 305 : | (lets ((region (realregion prim)) | ||
| 306 : | (height (region-height region)) | ||
| 307 : | (tateheight (tateheight prim))) | ||
| 308 : | (cond ((zerop height) defunit) | ||
| 309 : | (t (//$ (float height)(float tateheight))))))))) | ||
| 310 : | ; | ||
| 311 : | ; プリミティブ固有の高さを決定する | ||
| 312 : | ; | ||
| 313 : | (defun tateheight (prim) | ||
| 314 : | (lets ((rregion (realregion prim)) | ||
| 315 : | (xlen (prim-xlen prim rregion)) | ||
| 316 : | (height (difference (fourth rregion)(second rregion))) | ||
| 317 : | (yokosort (yokosort prim)) | ||
| 318 : | (yokokankaku (yokokankaku prim)) | ||
| 319 : | (tateheight (assq 'tateheight (cddr prim)))) | ||
| 320 : | (cond (yokosort (quotient height yokosort)) | ||
| 321 : | (tateheight (cdr tateheight)) | ||
| 322 : | ((and yokokankaku | ||
| 323 : | (greaterp (quotient height yokokankaku 1.4) | ||
| 324 : | (difference xlen 1.0))) | ||
| 325 : | (quotient height yokokankaku 1.4)) | ||
| 326 : | ((lessp xlen 2.0)1.0) | ||
| 327 : | (t (difference xlen 1.0))))) | ||
| 328 : | ; | ||
| 329 : | (defun xunit (prim (defunit 100.0)) | ||
| 330 : | (let ((xunit (assq 'xunit (cddr prim)))) | ||
| 331 : | (cond (xunit (cdr xunit)) | ||
| 332 : | (t | ||
| 333 : | (lets ((region (realregion prim)) | ||
| 334 : | (width (region-width region)) | ||
| 335 : | (yokowidth (yokowidth prim))) | ||
| 336 : | (cond ((zerop width) defunit) | ||
| 337 : | (t (//$ (float width)(float yokowidth))))))))) | ||
| 338 : | ; | ||
| 339 : | (defun yokowidth (prim) | ||
| 340 : | (lets ((rregion (realregion prim)) | ||
| 341 : | (ylen (prim-ylen prim rregion)) | ||
| 342 : | (width (difference (third rregion)(first rregion))) | ||
| 343 : | (tatekankaku (tatekankaku prim)) | ||
| 344 : | (yokowidth (assq 'yokowidth (cddr prim)))) | ||
| 345 : | (cond (yokowidth (cdr yokowidth)) | ||
| 346 : | ((and tatekankaku | ||
| 347 : | (greaterp (quotient width tatekankaku 1.4) | ||
| 348 : | (difference ylen 1.0))) | ||
| 349 : | (quotient width tatekankaku 1.4)) | ||
| 350 : | ((lessp ylen 2.0)1.0) | ||
| 351 : | (t (difference ylen 1.0))))) | ||
| 352 : | (defun tatekankaku (prim) | ||
| 353 : | (lets ((points (car prim)) | ||
| 354 : | (lines (cadr prim)) | ||
| 355 : | (tates nil)) | ||
| 356 : | (do ((l lines (cdr l))) | ||
| 357 : | ((atom l)) | ||
| 358 : | (cond ((memq (caar l)'(tate tatehane tatehidari kokoro tsukurihane tasuki)) | ||
| 359 : | (push (car l) tates)))) | ||
| 360 : | (cond (tates | ||
| 361 : | (do ((l tates (cdr l)) | ||
| 362 : | (minkankaku nil) | ||
| 363 : | (p0 nil)(p1 nil)) | ||
| 364 : | ((atom (cdr l))minkankaku) | ||
| 365 : | (setq p0 (nth (car (cadar l)) points) | ||
| 366 : | p1 (nth (cadr (cadar l)) points)) | ||
| 367 : | (do ((ll (cdr l) (cdr ll)) | ||
| 368 : | (p2 nil)(p3 nil)(kankaku nil)) | ||
| 369 : | ((atom ll)) | ||
| 370 : | (setq p2 (nth (car (cadar ll)) points) | ||
| 371 : | p3 (nth (cadr (cadar ll)) points)) | ||
| 372 : | (cond ((not (or (lessp (cadr p0)(cadr p1)(cadr p2)) | ||
| 373 : | (lessp (cadr p3)(cadr p0)(cadr p1)))) | ||
| 374 : | ; (prind (list p0 p1 p2 p3)) | ||
| 375 : | (setq kankaku (abs (difference (car p0)(car p2)))) | ||
| 376 : | (cond ((or (null minkankaku) | ||
| 377 : | (greaterp minkankaku kankaku)) | ||
| 378 : | (setq minkankaku kankaku))))))))))) | ||
| 379 : | (defun yokokankaku (prim) | ||
| 380 : | (lets ((points (car prim)) | ||
| 381 : | (lines (cadr prim)) | ||
| 382 : | (yokos nil)) | ||
| 383 : | (do ((l lines (cdr l))) | ||
| 384 : | ((atom l)) | ||
| 385 : | (cond ((eq 'yoko (caar l)) | ||
| 386 : | (push (car l) yokos)))) | ||
| 387 : | (cond (yokos | ||
| 388 : | (do ((l yokos (cdr l)) | ||
| 389 : | (minkankaku nil) | ||
| 390 : | (p0 nil)(p1 nil)) | ||
| 391 : | ((atom (cdr l))minkankaku) | ||
| 392 : | (setq p0 (nth (car (cadar l)) points) | ||
| 393 : | p1 (nth (cadr (cadar l)) points)) | ||
| 394 : | (do ((ll (cdr l) (cdr ll)) | ||
| 395 : | (p2 nil)(p3 nil)(kankaku nil)) | ||
| 396 : | ((atom ll)) | ||
| 397 : | (setq p2 (nth (car (cadar ll)) points) | ||
| 398 : | p3 (nth (cadr (cadar ll)) points)) | ||
| 399 : | (cond ((not (or (lessp (car p0)(car p1)(car p2)) | ||
| 400 : | (lessp (car p3)(car p0)(car p1)))) | ||
| 401 : | ; (prind (list p0 p1 p2 p3)) | ||
| 402 : | (setq kankaku (abs (difference (cadr p0)(cadr p2)))) | ||
| 403 : | (cond ((or (null minkankaku) | ||
| 404 : | (greaterp minkankaku kankaku)) | ||
| 405 : | (setq minkankaku kankaku))))))))))) | ||
| 406 : | ; | ||
| 407 : | (defun inlink (e1 e2 points) | ||
| 408 : | (lets ((points1 (cadr e1)) | ||
| 409 : | (links2 (assq 'link (cddr e2))) | ||
| 410 : | (links2 (and links2 (cdr links2)))) | ||
| 411 : | (do ((l points1 (cdr l))) | ||
| 412 : | ((atom l)) | ||
| 413 : | (and (memq (car l) links2)(exit t))))) | ||
| 414 : | ; | ||
| 415 : | (defun element-cross (e1 e2 points) | ||
| 416 : | (cond | ||
| 417 : | ((inlink e1 e2 points)) | ||
| 418 : | ((inlink e2 e1 points)) | ||
| 419 : | (t | ||
| 420 : | (do ((l (cadr e1) (cdr l))(flag)) | ||
| 421 : | ((atom (cdr l))) | ||
| 422 : | (do ((ll (cadr e2) (cdr ll))) | ||
| 423 : | ((atom (cdr ll))) | ||
| 424 : | ; (print (list (nth (car l) points)(nth (cadr l) points) | ||
| 425 : | ; (nth (car ll) points)(nth (cadr ll) points))) | ||
| 426 : | ; (print (line-cross (nth (car l) points)(nth (cadr l) points) | ||
| 427 : | ; (nth (car ll) points)(nth (cadr ll) points))) | ||
| 428 : | (and (line-cross (nth (car l) points)(nth (cadr l) points) | ||
| 429 : | (nth (car ll) points)(nth (cadr ll) points)) | ||
| 430 : | (setq flag t) | ||
| 431 : | (exit t); koreja dasshutsu shinai | ||
| 432 : | )) | ||
| 433 : | (and flag (exit flag)))))) | ||
| 434 : | ; | ||
| 435 : | (defun purecross (e1 e2 points) | ||
| 436 : | (not (or (inlink e1 e2 points) | ||
| 437 : | (inlink e2 e1 points)))) | ||
| 438 : | ; | ||
| 439 : | (defun crossunit (e1 e2 points) | ||
| 440 : | (do ((l defcrossunit (cdr l)) | ||
| 441 : | (type1 (car e1)) | ||
| 442 : | (type2 (car e2))) | ||
| 443 : | ((atom l)) | ||
| 444 : | ; (print (list type1 type2)) | ||
| 445 : | (cond ((and (eq_member type1 (caar l)) | ||
| 446 : | (eq_member type2 (cadar l))) | ||
| 447 : | (exit (funcall (cddar l) e1 points e2 points))) | ||
| 448 : | ((and (eq_member type1 (cadar l)) | ||
| 449 : | (eq_member type2 (caar l))) | ||
| 450 : | (exit (funcall (cddar l) e2 points e1 points)))))) | ||
| 451 : | ; | ||
| 452 : | (defun nocrossunit (e1 e2 points) | ||
| 453 : | (do ((l defnocrossunit (cdr l)) | ||
| 454 : | (type1 (car e1)) | ||
| 455 : | (type2 (car e2))) | ||
| 456 : | ((atom l)) | ||
| 457 : | ; (print (list type1 type2)) | ||
| 458 : | (cond ((and (eq_member type1 (caar l)) | ||
| 459 : | (eq_member type2 (cadar l))) | ||
| 460 : | (exit (funcall (cddar l) e1 points e2 points))) | ||
| 461 : | ((and (eq_member type1 (cadar l)) | ||
| 462 : | (eq_member type2 (caar l))) | ||
| 463 : | (exit (funcall (cddar l) e2 points e1 points)))))) | ||
| 464 : | ; | ||
| 465 : | (defun elementunit (element points) | ||
| 466 : | (do ((l defelementunit (cdr l)) | ||
| 467 : | (type (car element))) | ||
| 468 : | ((atom l)) | ||
| 469 : | (cond ((eq_member type (caar l)) | ||
| 470 : | (exit (funcall (cdar l) element points)))))) | ||
| 471 : | ; | ||
| 472 : | (defun findunit (prim) | ||
| 473 : | (lets ((points (car prim)) | ||
| 474 : | (elements (cadr prim)) | ||
| 475 : | (alist (cddr prim)) | ||
| 476 : | (unit) | ||
| 477 : | (crossunit) | ||
| 478 : | (nocrossunit) | ||
| 479 : | (elementunit)) | ||
| 480 : | (do ((l elements (cdr l))) | ||
| 481 : | ((atom (cdr l)) | ||
| 482 : | (list crossunit nocrossunit elementunit)) | ||
| 483 : | (do ((ll (cdr l) (cdr ll))) | ||
| 484 : | ((atom ll)) | ||
| 485 : | (cond ((element-cross (car l) (car ll) points) | ||
| 486 : | ; (print (list "cross" (car l)(car ll))) | ||
| 487 : | (and (setq unit (crossunit (car l) (car ll) points)) | ||
| 488 : | (push unit crossunit))) | ||
| 489 : | (t | ||
| 490 : | ; (print (list "nocross" (car l)(car ll))) | ||
| 491 : | (and (setq unit (nocrossunit (car l) (car ll) points)) | ||
| 492 : | (push unit nocrossunit) | ||
| 493 : | )))) | ||
| 494 : | (and (setq unit (elementunit (car l) points)) | ||
| 495 : | (push unit elementunit))))) | ||
| 496 : | ; | ||
| 497 : | (defun include-el (el list) | ||
| 498 : | (do ((l list (cdr l)) | ||
| 499 : | (ret nil)) | ||
| 500 : | ((atom l)ret) | ||
| 501 : | (cond ((eq el (cadar l)) | ||
| 502 : | (push `(,(caddar l) .,(caar l)) ret)) | ||
| 503 : | ((eq el (caddar l)) | ||
| 504 : | (push `(,(cadar l) .,(caar l)) ret))))) | ||
| 505 : | ; | ||
| 506 : | (defun nodup (x list) | ||
| 507 : | (lets ((val (car x)) | ||
| 508 : | (list1 (include-el (cadr x) list)) | ||
| 509 : | (list2 (include-el (caddr x) list))) | ||
| 510 : | (do ((l list1 (cdr l))(assq)) | ||
| 511 : | ((atom l)t) | ||
| 512 : | (setq assq (assq (caar l) list2)) | ||
| 513 : | (and assq | ||
| 514 : | (greaterp val (cdar l)) | ||
| 515 : | (greaterp val (cdr assq)) | ||
| 516 : | (exit))))) | ||
| 517 : | ; | ||
| 518 : | (defun average (list) | ||
| 519 : | (do ((n 0 (1+ n)) | ||
| 520 : | (l list (cdr l)) | ||
| 521 : | (sum 0)) | ||
| 522 : | ((atom l)(cond ((plusp n)(//$ (float sum)(float n))))) | ||
| 523 : | (setq sum (plus sum (caar l))))) | ||
| 524 : | |||
| 525 : | ; | ||
| 526 : | (defun checkxunit (units) | ||
| 527 : | (do ((l units (cdr l)) | ||
| 528 : | (ret)) | ||
| 529 : | ((atom l) | ||
| 530 : | (average ret)) | ||
| 531 : | (and (caaar l)(push `(,(caaar l) .,(cdar l)) ret)))) | ||
| 532 : | (defun checkyunit (units) | ||
| 533 : | (do ((l units (cdr l)) | ||
| 534 : | (ret)) | ||
| 535 : | ((atom l) | ||
| 536 : | (average ret)) | ||
| 537 : | (and (cdaar l)(push `(,(cdaar l) .,(cdar l)) ret)))) | ||
| 538 : | ; | ||
| 539 : | (defun units (prim) | ||
| 540 : | (lets ((findunit (findunit prim)) | ||
| 541 : | (crossunit (car findunit)) | ||
| 542 : | (nocrossunit (cadr findunit)) | ||
| 543 : | (elementunit (caddr findunit)) | ||
| 544 : | (yokosort (yokosort prim)) | ||
| 545 : | (nocrossx)(nocrossx1) | ||
| 546 : | ktanaka | 1.4 | (nocrossy)(nocrossy1)(newxunit)(newyunit)) |
| 547 : | ktanaka | 1.1 | (do ((l nocrossunit (cdr l))) |
| 548 : | ((atom l)) | ||
| 549 : | (and (caaar l)(push `(,(caaar l) .,(cdar l)) nocrossx)) | ||
| 550 : | (and (cdaar l)(push `(,(cdaar l) .,(cdar l)) nocrossy))) | ||
| 551 : | (do ((l nocrossx (cdr l))) | ||
| 552 : | ((atom l)) | ||
| 553 : | (and (nodup (car l) nocrossx) | ||
| 554 : | (push (car l) nocrossx1))) | ||
| 555 : | (setq newxunit (average nocrossx1)) | ||
| 556 : | (cond (yokosort | ||
| 557 : | (setq newyunit yokosort)) | ||
| 558 : | (t | ||
| 559 : | (do ((l nocrossy (cdr l))) | ||
| 560 : | ((atom l)) | ||
| 561 : | (and (nodup (car l) nocrossy) | ||
| 562 : | (push (car l) nocrossy1))) | ||
| 563 : | (setq newyunit (average nocrossy1)))) | ||
| 564 : | ; (print (list newxunit newyunit)) | ||
| 565 : | (cons (or newxunit | ||
| 566 : | (checkxunit elementunit) | ||
| 567 : | (checkxunit crossunit) | ||
| 568 : | (xunit prim)) | ||
| 569 : | (or newyunit | ||
| 570 : | (checkyunit elementunit) | ||
| 571 : | (checkyunit crossunit) | ||
| 572 : | (yunit prim))))) | ||
| 573 : | ; | ||
| 574 : | (defmacro p (n m) | ||
| 575 : | (cond ((minusp m) | ||
| 576 : | (cond ((eq n 1) | ||
| 577 : | `(nth (car (last (cadr e1))) points1)) | ||
| 578 : | ((eq n 2) | ||
| 579 : | `(nth (car (last (cadr e2))) points2)))) | ||
| 580 : | (t | ||
| 581 : | (cond ((eq n 1) | ||
| 582 : | `(nth (nth ,(1- m) (cadr e1)) points1)) | ||
| 583 : | ((eq n 2) | ||
| 584 : | `(nth (nth ,(1- m) (cadr e2)) points2)))))) | ||
| 585 : | ; | ||
| 586 : | (defmacro x (n m) | ||
| 587 : | `(car (p ,n ,m))) | ||
| 588 : | ; | ||
| 589 : | (defmacro y (n m) | ||
| 590 : | `(cadr (p ,n ,m))) | ||
| 591 : | ; | ||
| 592 : | (defun xsection (element points) | ||
| 593 : | (let ((p0 (nth (car (cadr element)) points)) | ||
| 594 : | (p1 (nth (car (last (cadr element))) points))) | ||
| 595 : | (ncons (cons (min (car p0)(car p1))(max (car p0)(car p1)))))) | ||
| 596 : | ; | ||
| 597 : | ; | ||
| 598 : | (defun ysection (element points) | ||
| 599 : | (let ((p0 (nth (car (cadr element)) points)) | ||
| 600 : | (p1 (nth (car (last (cadr element))) points))) | ||
| 601 : | (ncons (cons (min (cadr p0)(cadr p1))(max (cadr p0)(cadr p1)))))) | ||
| 602 : | ; | ||
| 603 : | (defun absdiff (x y) (abs (difference x y))) | ||
| 604 : | ; | ||
| 605 : | (defun elx2y (element points x) | ||
| 606 : | (do ((l (cadr element) (cdr l)) | ||
| 607 : | (p0 (nth (car (cadr element)) points))(p1)(s)) | ||
| 608 : | ((atom (cdr l)) | ||
| 609 : | (print "Fatal error in elx2y" terminal-output) | ||
| 610 : | (break)) | ||
| 611 : | (setq p1 (nth (cadr l) points)) | ||
| 612 : | (cond ((and (=$ (float (car p0)) (float x)) | ||
| 613 : | (=$ (float x)(float (car p1)))) | ||
| 614 : | (exit (times 0.5 (plus (cadr p0) (cadr p1))))) | ||
| 615 : | ((<=$ (float (car p0)) (float x) (float (car p1))) | ||
| 616 : | (setq s (//$ (float (difference x (car p0))) | ||
| 617 : | (float (difference (car p1)(car p0))))) | ||
| 618 : | (exit (plus (times (difference 1 s)(cadr p0))(times s (cadr p1))))) | ||
| 619 : | ((<=$ (float (car p1)) (float x) (float (car p0))) | ||
| 620 : | (setq s (//$ (float (difference x (car p1))) | ||
| 621 : | (float (difference (car p0)(car p1))))) | ||
| 622 : | (exit (plus (times (difference 1 s)(cadr p1))(times s (cadr p0)))))) | ||
| 623 : | (setq p0 p1))) | ||
| 624 : | ; | ||
| 625 : | (defun diffy (e1 points1 e2 points2 xsec) | ||
| 626 : | (lets ((x0 (rm-eq (caar xsec))) | ||
| 627 : | (x1 (rm-eq (cdar xsec))) | ||
| 628 : | (y10 (elx2y e1 points1 x0)) | ||
| 629 : | (y11 (elx2y e1 points1 x1)) | ||
| 630 : | (y20 (elx2y e2 points2 x0)) | ||
| 631 : | (y21 (elx2y e2 points2 x1)) | ||
| 632 : | (diff1 (absdiff y10 y20)) | ||
| 633 : | (diff2 (absdiff y11 y21))) | ||
| 634 : | ; (break) | ||
| 635 : | (cond ((or (greaterp diff1 (times diff2 3.0)) | ||
| 636 : | (greaterp diff2 (times diff1 3.0))) | ||
| 637 : | (max diff1 diff2)) | ||
| 638 : | (t | ||
| 639 : | ; (print diff1 diff2) | ||
| 640 : | (sqrt (times 0.5 (plus (times diff1 diff1)(times diff2 diff2)))))))) | ||
| 641 : | |||
| 642 : | ; | ||
| 643 : | (defun ely2x (element points y) | ||
| 644 : | (do ((l (cadr element) (cdr l)) | ||
| 645 : | (p0 (nth (car (cadr element)) points))(p1)(s)) | ||
| 646 : | ((atom (cdr l)) | ||
| 647 : | (print "Fatal error in ely2x" terminal-output) | ||
| 648 : | (break)) | ||
| 649 : | (setq p1 (nth (cadr l) points)) | ||
| 650 : | (cond ((and (=$ (float (cadr p0)) (float y)) | ||
| 651 : | (=$ (float y)(float (cadr p1)))) | ||
| 652 : | (exit (times 0.5 (plus (car p0) (car p1))))) | ||
| 653 : | ((<=$ (float (cadr p0)) (float y) (float (cadr p1))) | ||
| 654 : | (setq s (//$ (float (difference y (cadr p0))) | ||
| 655 : | (float (difference (cadr p1)(cadr p0))))) | ||
| 656 : | (exit (plus (times (difference 1 s)(car p0))(times s (car p1))))) | ||
| 657 : | ((<=$ (float (cadr p1)) (float y) (float (cadr p0))) | ||
| 658 : | (setq s (//$ (float (difference y (cadr p1))) | ||
| 659 : | (float (difference (cadr p0)(cadr p1))))) | ||
| 660 : | (exit (plus (times (difference 1 s)(car p1))(times s (car p0)))))) | ||
| 661 : | (setq p0 p1))) | ||
| 662 : | ; | ||
| 663 : | (defun xdiff (e1 points1 e2 points2 ysec) | ||
| 664 : | (lets ((y0 (rm-eq (caar ysec))) | ||
| 665 : | (y1 (rm-eq (cdar ysec))) | ||
| 666 : | (x10 (ely2x e1 points1 y0)) | ||
| 667 : | (x11 (ely2x e1 points1 y1)) | ||
| 668 : | (x20 (ely2x e2 points2 y0)) | ||
| 669 : | (x21 (ely2x e2 points2 y1)) | ||
| 670 : | (diff1 (absdiff x10 x20)) | ||
| 671 : | (diff2 (absdiff x11 x21)) | ||
| 672 : | ) | ||
| 673 : | (cond ((or (greaterp diff1 (times diff2 3.0)) | ||
| 674 : | (greaterp diff2 (times diff1 3.0))) | ||
| 675 : | (max diff1 diff2)) | ||
| 676 : | (t | ||
| 677 : | ; (print diff1 diff2) | ||
| 678 : | (sqrt (times 0.5 (plus (times diff1 diff1)(times diff2 diff2)))))))) | ||
| 679 : | ; | ||
| 680 : | (defun nonzerosec (sec sec1 sec2 (ratio 3.0)) | ||
| 681 : | (and sec (<=$ (float (caar sec))(float (cdar sec))) | ||
| 682 : | (or | ||
| 683 : | ; (break) | ||
| 684 : | (>=$ (times ratio (difference (cdar sec)(caar sec))) | ||
| 685 : | (float (difference (cdar sec1)(caar sec1)))) | ||
| 686 : | (>=$ (times ratio (difference (cdar sec)(caar sec))) | ||
| 687 : | (float (difference (cdar sec2)(caar sec2))))))) | ||
| 688 : | ; | ||
| 689 : | (defun standardunit (e1 points1 e2 points2) | ||
| 690 : | (lets ((xsection1 (xsection e1 points1)) | ||
| 691 : | (xsection2 (xsection e2 points2)) | ||
| 692 : | (ysection1 (ysection e1 points1)) | ||
| 693 : | (ysection2 (ysection e2 points2)) | ||
| 694 : | (xsec (andsection xsection1 xsection2)) | ||
| 695 : | (ydiff (and (nonzerosec xsec xsection1 xsection2) | ||
| 696 : | (diffy e1 points1 e2 points2 xsec))) | ||
| 697 : | (ysec (andsection ysection1 ysection2)) | ||
| 698 : | (xdiff (and (nonzerosec ysec ysection1 ysection2) | ||
| 699 : | (xdiff e1 points1 e2 points2 ysec)))) | ||
| 700 : | (cond ((or xdiff ydiff) | ||
| 701 : | `((,xdiff .,ydiff) ,e1 ,e2))))) | ||
| 702 : | ; | ||
| 703 : | (defun timesunit (ratio unit) | ||
| 704 : | (and unit | ||
| 705 : | (lets ((ratiox (car ratio)) | ||
| 706 : | (ratioy (cdr ratio)) | ||
| 707 : | (unitx (caar unit)) | ||
| 708 : | (unity (cdar unit)) | ||
| 709 : | (newx (and unitx ratiox (times ratiox unitx))) | ||
| 710 : | (newy (and unity ratioy (times ratioy unity)))) | ||
| 711 : | `((,newx .,newy).,(cdr unit))))) | ||
| 712 : | ; | ||
| 713 : | (defun tatesection (element points) | ||
| 714 : | (do ((l (cadr element) (cdr l)) | ||
| 715 : | (p0 (nth (caadr element) points) p1) | ||
| 716 : | (p1) | ||
| 717 : | ) | ||
| 718 : | ((atom (cdr l))) | ||
| 719 : | (setq p1 (nth (cadr l) points)) | ||
| 720 : | (cond ((equal (car p0)(car p1)) | ||
| 721 : | (exit `((,(cadr p0) .,(cadr p1)))))))) | ||
| 722 : | ; | ||
| 723 : | (defun tateunit (e1 points1 e2 points2) | ||
| 724 : | (lets ((ysec (andsection | ||
| 725 : | (tatesection e1 points1) | ||
| 726 : | (tatesection e2 points2))) | ||
| 727 : | (xdiff (and (nonzerosec ysec (tatesection e1 points1) | ||
| 728 : | (tatesection e2 points2)) | ||
| 729 : | (xdiff e1 points1 e2 points2 ysec)))) | ||
| 730 : | (cond (xdiff | ||
| 731 : | `((,xdiff) ,e1 ,e2)) | ||
| 732 : | (t (standardunit e1 points1 e2 points2))))) | ||
| 733 : | ; | ||
| 734 : | (defun point-relation (p1 element points) | ||
| 735 : | (let ((epoints (cadr element)) | ||
| 736 : | (lpoints (assq 'link (cddr element)))) | ||
| 737 : | (cond ((eq p1 (car epoints)) | ||
| 738 : | 'start) | ||
| 739 : | ((eq p1 (car (last epoints))) | ||
| 740 : | 'end) | ||
| 741 : | ((memq p1 lpoints) | ||
| 742 : | 'cross) | ||
| 743 : | (t | ||
| 744 : | 'nocross)))) | ||
| 745 : | ; | ||
| 746 : | (defun element-relation (e1 e2 points) | ||
| 747 : | (lets ((points1 (cadr e1)) | ||
| 748 : | (links1 (assq 'link (cddr e1))) | ||
| 749 : | (points2 (cadr e2)) | ||
| 750 : | (links2 (assq 'link (cddr e2))) | ||
| 751 : | (cross (cond ((or (memq (car points1) links2) | ||
| 752 : | (memq (car points1) points2)) | ||
| 753 : | 'start) | ||
| 754 : | ((or (memq (car (last points1)) links2) | ||
| 755 : | (memq (car (last points2)) points2)) | ||
| 756 : | 'end) | ||
| 757 : | ((element-cross e1 e2 points) | ||
| 758 : | 'cross) | ||
| 759 : | (t | ||
| 760 : | 'nocross))) | ||
| 761 : | (start (point-relation (car points2) e1 points)) | ||
| 762 : | (end (point-relation (car (last points2)) e1 points))) | ||
| 763 : | `(,cross ,start ,end))) | ||
| 764 : | |||
| 765 : | |||
| 766 : | ktanaka | 1.4 | ; |
| 767 : | (declare (defnocrossunit defcrossunit defelementunit) special) | ||
| 768 : | ktanaka | 1.1 | ; |
| 769 : | (setq defnocrossunit | ||
| 770 : | '( | ||
| 771 : | ((yoko migiue) (yoko migiue) . standardunit) | ||
| 772 : | ; ((kokoro kagi) | ||
| 773 : | ; (tate magaritate hidari tatehane tsukurihane tatehidari) . tateunit) | ||
| 774 : | ((kokoro kagi) | ||
| 775 : | (tate magaritate tatehane tatehidari tsukurihane) . tateunit) | ||
| 776 : | ((tate magaritate hidari tatehane tatehidari tsukurihane tasuki) | ||
| 777 : | (tate magaritate hidari tatehane tatehidari tsukugihane tasuki) . tateunit) | ||
| 778 : | (migi (tate magaritate hidari tatehane tatehidari) | ||
| 779 : | lambda (a b c d) | ||
| 780 : | (timesunit '(0.7 . 0.7) (standardunit a b c d))) | ||
| 781 : | (ten | ||
| 782 : | (ten yoko hidari tate tatehidari tatehane tsukurihane tasuki | ||
| 783 : | magaritate kokoro migiue) | ||
| 784 : | lambda (a b c d) | ||
| 785 : | (timesunit '(1.6 . 1.6) (standardunit a b c d))) | ||
| 786 : | )) | ||
| 787 : | ; | ||
| 788 : | (setq defelementunit | ||
| 789 : | '( | ||
| 790 : | ((kokoro kagi) | ||
| 791 : | lambda (e1 points1) | ||
| 792 : | `((,(times 0.9 (absdiff (x 1 3)(x 1 2))) | ||
| 793 : | .,(times 0.9 (absdiff (y 1 2)(y 1 1)))) ,e1)) | ||
| 794 : | )) | ||
| 795 : | ; | ||
| 796 : | (setq defcrossunit | ||
| 797 : | '( | ||
| 798 : | (yoko tsukurihane | ||
| 799 : | lambda (e1 points1 e2 points2) | ||
| 800 : | (lets ((p1 (cadr e1)) | ||
| 801 : | (p2 (cadr e2)) | ||
| 802 : | (p12 (second p1)) | ||
| 803 : | (p21 (first p2)) | ||
| 804 : | (p23 (third p2))) | ||
| 805 : | (and (eq p12 p21)(eq points1 points2) | ||
| 806 : | `((nil .,(times 0.8 (difference (cadr (nth p23 points2)) | ||
| 807 : | (cadr (nth p21 points2))))) | ||
| 808 : | ,e1 ,e2)))) | ||
| 809 : | (yoko (tate tatehane tatehidari hidari) | ||
| 810 : | lambda (e1 points1 e2 points2) | ||
| 811 : | ; (print (list e1 e2)) | ||
| 812 : | (lets ((p1 (cadr e1)) | ||
| 813 : | (p2 (cadr e2)) | ||
| 814 : | (l2 (assq 'link (cddr e2))) | ||
| 815 : | (l2 (and l2 (cdr l2)))) | ||
| 816 : | (cond ((not (or (memq (cadr p1) p2) | ||
| 817 : | (memq (cadr p1) l2))) | ||
| 818 : | `((,(times 1.0 (difference (car (nth (cadr p1) points1)) | ||
| 819 : | (car (nth (car p2) points2))))) | ||
| 820 : | ,e1 ,e2))))))) | ||
| 821 : | ; | ||
| 822 : | ; これまでのcrossunit, nocrossunit, elementunitすべてを含む概念 | ||
| 823 : | ; フォーマット : (基本エレメントのリスト オプションエレメントのリスト 関数) | ||
| 824 : | ; | ||
| 825 : | ; | ||
| 826 : | (setq complexunit | ||
| 827 : | '( | ||
| 828 : | (((yoko (yoko (1 nocross right right))) | ||
| 829 : | (not (* (between 1 2)))) | ||
| 830 : | `(nil . 0.7)) | ||
| 831 : | (((yoko (yoko (1 nocross right right))) | ||
| 832 : | (tate (1 start start right) | ||
| 833 : | (2 start left end)) | ||
| 834 : | (tate (1 end start right) | ||
| 835 : | (2 end left end)) | ||
| 836 : | (not (* (between 1 2))) | ||
| 837 : | ) | ||
| 838 : | `(nil . 1.0)) | ||
| 839 : | (((yoko (yoko (1 nocross right right))) | ||
| 840 : | (tate (1 start left right) | ||
| 841 : | (2 end left end)) | ||
| 842 : | (tate (1 start left right) | ||
| 843 : | (2 end left end))) | ||
| 844 : | `(nil . 0.78)))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |