Annotation of /renderer/region.lAnnotation of /renderer/region.l
Parent Directory
| 
Revision Log
Revision: 1.3 - (view) (download)
| 1 : | ktanaka | 1.1 | (defun goodsection1 (section) |
| 2 : | (do ((l (notsection section) (cdr l))(ret)(xx)(yy)) | ||
| 3 : | ((atom l) | ||
| 4 : | (or ret (break)) | ||
| 5 : | ; (prind ret) | ||
| 6 : | ret) | ||
| 7 : | ; (break) | ||
| 8 : | (cond | ||
| 9 : | ((and (numberp (setq xx (rm-eq (caar l)))) | ||
| 10 : | (numberp (setq yy (rm-eq (cdar l)))) | ||
| 11 : | (setq xx (float xx) yy (float yy)) | ||
| 12 : | (cond ((and (<=$ -1.0 xx 0.0)(<=$ 0.0 yy)) | ||
| 13 : | ; (prind (car l)) | ||
| 14 : | (exit (car l))) | ||
| 15 : | ((and (<=$ -1.0 yy)(or (null ret)(<=$ yy 0.0))) | ||
| 16 : | (setq ret (car l)))))) | ||
| 17 : | ((and (null xx) | ||
| 18 : | (numberp (setq yy (cond ((eq t (cdar l)) | ||
| 19 : | 1.0) | ||
| 20 : | (t (rm-eq (cdar l))))))) | ||
| 21 : | (setq yy (float yy)) | ||
| 22 : | (cond ((<=$ 0.0 yy) | ||
| 23 : | ; (prind (car l)) | ||
| 24 : | (exit `(,xx .,yy))) | ||
| 25 : | ((and (<=$ -1.0 yy)(or (null ret)(<=$ yy 0.0))) | ||
| 26 : | (setq ret `(,xx .,yy)))))))) | ||
| 27 : | |||
| 28 : | (defun region-affine (prim1 prim2 alist region) | ||
| 29 : | (lets ((realregion (realregion prim2)) | ||
| 30 : | (rw (float (region-width realregion))) | ||
| 31 : | (rh (float (region-height realregion))) | ||
| 32 : | (xunit (xunit prim2)) | ||
| 33 : | (yunit (yunit prim2)) | ||
| 34 : | (center1 (prim-center prim1)) | ||
| 35 : | (center2 (prim-center prim2)) | ||
| 36 : | (center (and center1 (goodcenter center1 region) center2)) | ||
| 37 : | (affine1 | ||
| 38 : | (cond | ||
| 39 : | (center | ||
| 40 : | (movexy | ||
| 41 : | center1 (times 0.5 (plus (second region)(fourth region))) | ||
| 42 : | (scalexy (cond ((zerop rw)1) | ||
| 43 : | (t (//$ (float (region-width region)) | ||
| 44 : | rw))) | ||
| 45 : | (cond ((zerop rh)1) | ||
| 46 : | (t (//$ (float (region-height region)) | ||
| 47 : | rh))) | ||
| 48 : | (movexy | ||
| 49 : | (minus center2) | ||
| 50 : | (minus (times 0.5 (plus (second realregion) | ||
| 51 : | (fourth realregion)))))))) | ||
| 52 : | (t (region2region realregion region)))) | ||
| 53 : | (rc (region-center region)) | ||
| 54 : | (rc (cond (center `(,center1 ,(cadr rc)))(t rc))) | ||
| 55 : | (scalexy (scaleconv rc)) | ||
| 56 : | (scalex (vector 6 `(1 0 0 0 ,(minus (car rc)) 0))) | ||
| 57 : | (scaley (vector 6 `(0 0 0 1 0 ,(minus (cadr rc))))) | ||
| 58 : | (transx #(0 0 0 0 1 0)) | ||
| 59 : | (transy #(0 0 0 0 0 1))(affine2)(size)) | ||
| 60 : | (and (boundp 'DEBUG1)(prind affine1)) | ||
| 61 : | (setq affine2 (good-scale prim1 prim2 affine1 scalexy xunit yunit alist)) | ||
| 62 : | (setq size (times (vref affine2 0)(vref affine2 3))) | ||
| 63 : | (do ((i 0 (1+ i))(oldsize)(affine3)(affine4)(affine5)(affine6)) | ||
| 64 : | ((and oldsize (lessp (times size 0.98) oldsize)) | ||
| 65 : | (and (boundp 'DEBUG1)(prind `(,size ,oldsize))) | ||
| 66 : | affine2) | ||
| 67 : | (and (boundp 'DEBUG1)(prind affine2)) | ||
| 68 : | (setq affine3 | ||
| 69 : | (cond (center affine2) | ||
| 70 : | (t (good-trans prim1 prim2 affine2 transx xunit yunit alist)))) | ||
| 71 : | (and (boundp 'DEBUG1)(prind affine3)) | ||
| 72 : | (setq affine4 (good-trans prim1 prim2 affine3 transy xunit yunit alist)) | ||
| 73 : | (and (boundp 'DEBUG1)(prind affine4)) | ||
| 74 : | (setq affine5 (good-scale prim1 prim2 affine4 scalexy xunit yunit alist)) | ||
| 75 : | (and (boundp 'DEBUG1)(prind affine5)) | ||
| 76 : | (setq affine6 (good-scale prim1 prim2 affine5 scalex xunit yunit alist)) | ||
| 77 : | (and (boundp 'DEBUG1)(prind affine6)) | ||
| 78 : | (setq affine2 (good-scale prim1 prim2 affine6 scaley xunit yunit alist)) | ||
| 79 : | (setq oldsize size) | ||
| 80 : | (setq size (times (vref affine2 0)(vref affine2 3))) | ||
| 81 : | (and (boundp 'DEBUG1)(prind `(,size ,oldsize))) | ||
| 82 : | ; (break) | ||
| 83 : | ))) | ||
| 84 : | |||
| 85 : | (defun good-trans (prim1 prim2 affine1 conv xunit yunit alist) | ||
| 86 : | (lets ((prim21 (affinepart prim2 affine1)) | ||
| 87 : | (xunit1 (times xunit (vref affine1 0))) | ||
| 88 : | (yunit1 (times yunit (vref affine1 3))) | ||
| 89 : | (xlimitratio (cdr (or (assq 'xlimitratio alist)'(nil . 0.3)))) | ||
| 90 : | (ylimitratio (cdr (or (assq 'ylimitratio alist)'(nil . 0.5)))) | ||
| 91 : | (alist_xlimit (assqcdr 'xlimit alist)) | ||
| 92 : | (alist_ylimit (assqcdr 'ylimit alist)) | ||
| 93 : | (xlimit (times xlimitratio xunit1)) | ||
| 94 : | (ylimit (times ylimitratio yunit1)) | ||
| 95 : | (oldparam `((xlimit .,(or alist_xlimit (cons 0 xlimit))) | ||
| 96 : | (ylimit .,(or alist_ylimit (cons 0 ylimit))))) | ||
| 97 : | (section1 (general-section prim1 prim21 conv | ||
| 98 : | `((xunit 0 .,xunit1) | ||
| 99 : | (yunit 0 .,yunit1).,oldparam))) | ||
| 100 : | (ax (section-plus section1)) | ||
| 101 : | (bx (section-minus section1)) | ||
| 102 : | (cx (quotient (difference ax bx) 2.0)) | ||
| 103 : | (affine2 (times-affine (scale-affine cx conv) affine1))) | ||
| 104 : | ; (prind `(,ax ,bx ,section1)) | ||
| 105 : | affine2)) | ||
| 106 : | |||
| 107 : | (defun good-scale (prim1 prim2 affine1 conv xunit yunit alist) | ||
| 108 : | (lets ((prim21 (affinepart prim2 affine1)) | ||
| 109 : | (xunit1 (times xunit (vref affine1 0))) | ||
| 110 : | (yunit1 (times yunit (vref affine1 3))) | ||
| 111 : | (xlimitratio (cdr (or (assq 'xlimitratio alist)'(nil . 0.3)))) | ||
| 112 : | (ylimitratio (cdr (or (assq 'ylimitratio alist)'(nil . 0.5)))) | ||
| 113 : | (alist_xlimit (assqcdr 'xlimit alist)) | ||
| 114 : | (alist_ylimit (assqcdr 'ylimit alist)) | ||
| 115 : | (xlimit (times xlimitratio xunit1)) | ||
| 116 : | (ylimit (times ylimitratio yunit1)) | ||
| 117 : | (oldparam `((xlimit .,(or alist_xlimit (cons xlimit xlimit))) | ||
| 118 : | (ylimit .,(or alist_ylimit (cons ylimit ylimit))))) | ||
| 119 : | (section1 (general-section prim1 prim21 conv | ||
| 120 : | `((xunit | ||
| 121 : | ,(times xunit1 (vref conv 0)) .,xunit1) | ||
| 122 : | (yunit | ||
| 123 : | ,(times yunit1 (vref conv 3)) .,yunit1).,oldparam))) | ||
| 124 : | (section2 (goodsection1 section1)) | ||
| 125 : | (limit1 (max (difference (times (rm-eq (cdr section2)) 0.95) 0.05) | ||
| 126 : | (times 0.5 (plus (rm-eq (or (car section2) -1000.0)) | ||
| 127 : | (rm-eq (cdr section2)))))) | ||
| 128 : | (affine2 (times-affine (scale-affine limit1 conv) affine1))) | ||
| 129 : | ; (break) | ||
| 130 : | affine2)) | ||
| 131 : | |||
| 132 : | (defun jointtest (prim1 prim2 affine type) | ||
| 133 : | (filltest | ||
| 134 : | (rmlimit (appendpart prim1 | ||
| 135 : | (affinepart prim2 affine))) type)) | ||
| 136 : | (defun rmlimit (x) | ||
| 137 : | (lets ((elements (cadr x))(ret)) | ||
| 138 : | (do ((l elements (cdr l))) | ||
| 139 : | ((atom l)`(,(car x) ,(nreverse ret) .,(cddr x))) | ||
| 140 : | (or (memq (caar l) '(xlimit ylimit))(push (car l) ret))))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |