[cells-cvs] CVS cells/gui-geometry

[ktilton]

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)