Update of /project/cells/cvsroot/cells/gui-geometry In directory clnet:/tmp/cvs-serv28230/gui-geometry
Modified Files: geo-data-structures.lisp geo-family.lisp gui-geometry.lpr Log Message:
--- /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2006/06/20 14:16:45 1.2 +++ /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2006/06/29 09:54:06 1.3 @@ -27,7 +27,7 @@ (instance-slots (mkv2 1 2))
(defmethod print-object ((self v2) s) - (format s "(~a ~a)" (v2-h self)(v2-v self))) + (format s "~a|~a" (v2-h self)(v2-v self)))
(defun mkv2 (h v) (make-v2 :h h :v v))
@@ -36,17 +36,27 @@ (= (v2-h a)(v2-h b)) (= (v2-v a)(v2-v b))))
-(defun v2-add (p1 p2) - (make-v2 :h (+ (v2-h p1) (v2-h p2)) - :v (+ (v2-v p1) (v2-v p2)))) - -(defun v2-move (p1 x y) - (make-v2 :h (+ (v2-h p1) x) - :v (+ (v2-v p1) y))) - -(defun v2-subtract (p1 p2) - (make-v2 :h (- (v2-h p1) (v2-h p2)) - :v (- (v2-v p1) (v2-v p2)))) +(defun v2-add (p1 p2-or-x &optional y-or-p2-or-x-is-p2) + (if y-or-p2-or-x-is-p2 + (make-v2 :h (+ (v2-h p1) p2-or-x) + :v (+ (v2-v p1) y-or-p2-or-x-is-p2)) + (make-v2 :h (+ (v2-h p1) (v2-h p2-or-x)) + :v (+ (v2-v p1) (v2-v p2-or-x))))) + +(defun v2-subtract (p1 p2-or-x &optional y-or-p2-or-x-is-p2) + (if y-or-p2-or-x-is-p2 + (make-v2 :h (- (v2-h p1) p2-or-x) + :v (- (v2-v p1) y-or-p2-or-x-is-p2)) + (make-v2 :h (- (v2-h p1) (v2-h p2-or-x)) + :v (- (v2-v p1) (v2-v p2-or-x))))) + +(defun v2-nmove (p1 x &optional y) + (if y + (progn + (incf (v2-h p1) x) + (incf (v2-v p1) y)) + (v2-move p1 (v2-h x)(v2-v x))) + p1)
(defun v2-in-rect (v2 r) (mkv2 (min (r-right r) (max (r-left r) (v2-h v2))) --- /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2006/06/25 21:30:34 1.3 +++ /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2006/06/29 09:54:06 1.4 @@ -16,6 +16,9 @@
(in-package :gui-geometry)
+(eval-when (compile load eval) + (export '(geo-inline-lazy))) + ;--------------- geo-inline ----------------------------- ;
@@ -55,6 +58,42 @@ (c? (px-maintain-pl (^prior-sib-pr self (spacing .parent)))))))))))
+(defmodel geo-inline-lazy (geo-zero-tl) + ((orientation :initarg :orientation :initform nil :accessor orientation + :documentation ":vertical (for a column) or :horizontal (row)") + (justify :initarg :justify :accessor justify + :initform (c_? (ecase (orientation self) + (:vertical :left) + (:horizontal :top)))) + (spacing :initarg :spacing :initform 0 :accessor spacing)) + (:default-initargs + :lr (c_? (+ (^outset) + (ecase (orientation self) + (:vertical (loop for k in (^kids) + maximizing (l-width k))) + (:horizontal (bif (lk (last1 (^kids))) + (pr lk) 0))))) + :lb (c_? (+ (downs (^outset)) + (ecase (orientation self) + (:vertical (bif (lk (last1 (^kids))) + (pb lk) 0)) + (:horizontal (downs (loop for k in (^kids) + maximizing (l-height k))))))) + :kid-slots (lambda (self) + (ecase (orientation .parent) + (:vertical (list + (mk-kid-slot (px :if-missing t) + (c_? (^px-self-centered (justify .parent)))) + (mk-kid-slot (py) + (c_? (py-maintain-pt + (^prior-sib-pb self (spacing .parent))))))) + (:horizontal (list + (mk-kid-slot (py :if-missing t) + (c_? (^py-self-centered (justify .parent)))) + (mk-kid-slot (px) + (c_? (px-maintain-pl + (^prior-sib-pr self (spacing .parent))))))))))) +
#| archive
--- /project/cells/cvsroot/cells/gui-geometry/gui-geometry.lpr 2006/06/25 21:30:34 1.2 +++ /project/cells/cvsroot/cells/gui-geometry/gui-geometry.lpr 2006/06/29 09:54:06 1.3 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*-
(in-package :cg-user)