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)