[cells-cvs] CVS cells/gui-geometry

[ktilton]

Update of /project/cells/cvsroot/cells/gui-geometry
In directory clnet:/tmp/cvs-serv5826/gui-geometry

Modified Files:
	geo-family.lisp geo-macros.lisp geometer.lisp 
Log Message:


--- /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp	2007/11/30 16:51:19	1.12
+++ /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp	2008/04/11 09:19:41	1.13
@@ -120,64 +120,35 @@
 ;--------------- geo.row.flow ----------------------------
 (export! geo-row-flow)
 
-(defmodel geo-row-flow (geo-inline)
-  ((spacing-hz :cell nil :initarg :spacing-hz :initform 0 :reader spacing-hz)
-   (spacing-vt :cell nil :initarg :spacing-vt :initform 0 :reader spacing-vt)
-   (aligned :cell nil :initarg :aligned :initform nil :reader aligned))
-  (:default-initargs
-      :lb  (c? (geo-kid-wrap self 'pb))
-    :kid-slots (lambda (self)
-                 (declare (ignore self))
-                 
-                 (list
-                  (mk-kid-slot (py)
-                    (c? (py-maintain-pt
-                         (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
-                           (if (> (+ ph (l-width self)(outset .parent))  (l-width .parent))
-                               (^prior-sib-pb self (spacing-vt .parent))
-                             (^prior-sib-pt self))))))
-                  (mk-kid-slot (px)
-                    (c? (px-maintain-pl
-                         (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
-                           (if (> (+ ph (l-width self)(outset .parent))  (l-width .parent))
-                               0
-                             ph)))))))))
-
-#| archive
-
-(defmodel geo-row-fv (family-values geo-row)())
-(defmodel geo-inline-fv (family-values geo-inline)())
-
-;-------------------------- IMMatrix ------------------------------------------
-
-(defmodel im-matrix (geo-zero-tl)
-  ((columns :cell nil :initarg :columns :initform nil :accessor columns)
-   (indent-hz :cell nil :initarg :indent-hz :initform 0 :accessor indent-hz)
-   (spacing-hz :cell nil :initarg :spacing-hz :initform 0 :accessor spacing-hz)
-   (spacing-vt :cell nil :initarg :spacing-vt :initform 0 :accessor spacing-vt))
-  (:default-initargs
-      :kid-slots (lambda (self)
-                   (declare (ignore self))
-                   (list
-                    (mk-kid-slot (px)
-                                 (c? (let ((parent (fm-parent self)))
-                                       (+ (indent-hz parent)
-                                          (if (zerop (mod (fm-pos self)
-                                                          (or (columns parent)
-                                                              (length (kids parent)))))
-                                              0
-                                            (+ (spacing-hz parent)
-                                               (pr (find-prior self (kids parent)))))))))
-                    (mk-kid-slot (py)
-                                 (c? (let* ((parent (fm-parent self))
-                                            (psib (find-prior self (kids parent))))
-                                       (if (and psib (columns parent))
-                                           (if (zerop (mod (fm-pos self) (columns parent)))
-                                               (+ (- (abs (spacing-vt parent))) (pb psib))
-                                             (pt psib))
-                                         0))))))))
+(defmd geo-row-flow (geo-inline)
+  (spacing-hz  0)
+  (spacing-vt  0)
+  (aligned :cell nil)
+  (row-flow-layout
+   (c? (loop with max-pb = 0 and pl = 0 and pt = 0
+           for k in (^kids)
+           for kpr = (+ pl (l-width k))
+           when (unless (= pl 0)
+                  (> kpr (- (l-width self) (outset self)))) do
+             (setf pl 0
+               pt (+ max-pb (downs (^spacing-vt))))
+
+           collect (cons pl pt) into pxys
+           do (incf pl (+ (l-width k)(^spacing-hz)))
+             (setf max-pb (min max-pb (+ pt (downs (l-height k)))))
+           finally (return (cons max-pb pxys)))))
+  :lb  (c? (+ (bif (xys (^row-flow-layout))
+                (car xys) 0)
+             (downs (outset self))))
+  :kid-slots (lambda (self)
+               (declare (ignore self))
+               (list
+                (mk-kid-slot (px)
+                  (c? (px-maintain-pl (car (nth (kid-no self) (cdr (row-flow-layout .parent)))))))
+                (mk-kid-slot (py)
+                  (c? (py-maintain-pt (cdr (nth (kid-no self) (cdr (row-flow-layout .parent))))))))))
+
 
-|#
 
 
 
--- /project/cells/cvsroot/cells/gui-geometry/geo-macros.lisp	2007/12/11 19:35:16	1.1
+++ /project/cells/cvsroot/cells/gui-geometry/geo-macros.lisp	2008/04/11 09:19:41	1.2
@@ -77,7 +77,7 @@
 (defmacro py-maintain-pB (pB)
   `(- ,pB (^lB)))
 
-(export! centered-h? centered-v?)
+(export! centered-h? centered-v? lb-maintain-pB)
 
 (defmacro ^fill-down (upper-type &optional (padding 0))
   (let ((filled (gensym)))
--- /project/cells/cvsroot/cells/gui-geometry/geometer.lisp	2007/11/30 16:51:19	1.13
+++ /project/cells/cvsroot/cells/gui-geometry/geometer.lisp	2008/04/11 09:19:41	1.14
@@ -110,13 +110,26 @@
 ;sum pXYs up the family tree    ;gave an odd result for cursor display....
 
 (defun v2-xlate (outer inner outer-v2)
-  (if (eql outer inner)
+  (if (eq outer inner)
      outer-v2
      (v2-xlate outer (fm-parent inner)
                (v2-subtract outer-v2
                             (mkv2 (px inner) (py inner))))))
 
-(export! h-xlate v-xlate)
+(defun v2-xlate-out (inner outer inner-v2)
+  (if (eq outer inner)
+      inner-v2
+    (v2-xlate (fm-parent inner) outer
+      (v2-add inner-v2
+        (mkv2 (px inner) (py inner))))))
+
+(defun v2-xlate-between (from-v2 from to)
+  (cond
+   ((fm-includes from to)(v2-xlate from to from-v2))
+   ((fm-includes to from)(v2-xlate-out from to from-v2))
+   (t (break "time to extend v2-xlate-between"))))
+
+(export! h-xlate v-xlate v2-xlate-between)
 
 (defun h-xlate (outer inner outer-h)
   (if (eql outer inner)