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

Modified Files: defpackage.lisp geo-data-structures.lisp geo-family.lisp geometer.lisp Log Message:

--- /project/cells/cvsroot/cells/gui-geometry/defpackage.lisp 2006/06/23 01:04:57 1.5 +++ /project/cells/cvsroot/cells/gui-geometry/defpackage.lisp 2006/07/03 00:08:29 1.6 @@ -21,7 +21,7 @@ #:px #:py #:ll #:lt #:lr #:lb #:pl #:pt #:pr #:pb #:^px #:^py #:^ll #:^lt #:^lr #:^lb #:u96ths #:udots #:uinches #:uin #:upoints #:upts #:u8ths #:u16ths #:u32nds - #:mkr #:v2-move #:l-height #:mkv2 #:^offset-within #:inset-lr #:v2-v #:v2-h + #:mkr #:v2-nmove #:l-height #:mkv2 #:^offset-within #:inset-lr #:v2-v #:v2-h #:r-bounds #:l-box #:lb #:cs-target-res --- /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2006/06/29 09:54:06 1.3 +++ /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2006/07/03 00:08:29 1.4 @@ -16,6 +16,8 @@

(in-package :gui-geometry)

+(eval-when (compile load eval) + (export '(v2))) ;-----------------------------

(defstruct v2 @@ -55,7 +57,7 @@ (progn (incf (v2-h p1) x) (incf (v2-v p1) y)) - (v2-move p1 (v2-h x)(v2-v x))) + (v2-nmove p1 (v2-h x)(v2-v x))) p1)

(defun v2-in-rect (v2 r) --- /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2006/06/29 09:54:06 1.4 +++ /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2006/07/03 00:08:29 1.5 @@ -21,7 +21,6 @@

;--------------- geo-inline ----------------------------- ; - (defmodel geo-inline (geo-zero-tl) ((orientation :initarg :orientation :initform nil :accessor orientation :documentation ":vertical (for a column) or :horizontal (row)") @@ -37,7 +36,7 @@ maximizing (l-width k))) (:horizontal (bif (lk (last1 (^kids))) (pr lk) 0))))) - :lb (c? (+ (downs (^outset)) + :lb (c? (+ (- (^outset)) (ecase (orientation self) (:vertical (bif (lk (last1 (^kids))) (pb lk) 0)) @@ -73,7 +72,7 @@ maximizing (l-width k))) (:horizontal (bif (lk (last1 (^kids))) (pr lk) 0))))) - :lb (c_? (+ (downs (^outset)) + :lb (c_? (+ (- (^outset)) (ecase (orientation self) (:vertical (bif (lk (last1 (^kids))) (pb lk) 0)) @@ -85,8 +84,10 @@ (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))))))) + (c_? (eko (nil "py" self (^lt) (l-height self)(psib)) + (py-maintain-pt + (eko (nil "psib-pb") + (^prior-sib-pb self (spacing .parent))))))))) (:horizontal (list (mk-kid-slot (py :if-missing t) (c_? (^py-self-centered (justify .parent)))) --- /project/cells/cvsroot/cells/gui-geometry/geometer.lisp 2006/06/23 01:04:57 1.4 +++ /project/cells/cvsroot/cells/gui-geometry/geometer.lisp 2006/07/03 00:08:29 1.5 @@ -16,19 +16,16 @@

(in-package #:gui-geometry)

-(defmodel geometer () - ((inset :cell nil :initarg :inset :reader inset - :unchanged-if 'v2= :initform (mkv2 0 0)) - (outset :initarg :outset :initform 0 :accessor outset) - (collapsed :initarg :collapsed :initform nil :accessor collapsed) - (px :initarg :px :initform nil :accessor px) - (py :initarg :py :initform nil :accessor py) - (ll :initarg :ll :initform nil :accessor ll) - (lt :initarg :lt :initform nil :accessor lt) - (lr :initarg :lr :initform nil :accessor lr) - (lb :initarg :lb :initform nil :accessor lb) - (w-box :cell nil :initform (mkr 0 0 0 0) :accessor w-box - :documentation "bbox in window coordinate system"))) +(eval-when (compile load eval) + (export '(outset ^outset))) + +(defmd geometer () + px py ll lt lr lb + collapsed + (inset (mkv2 0 0) :unchanged-if 'v2=) + (outset 0) + (w-box (mkr 0 0 0 0) :cell nil :accessor w-box + :documentation "bbox in window coordinate system"))

(defmethod collapsed (other) (declare (ignore other)) @@ -40,14 +37,14 @@ () (:default-initargs :ll (c? (- (outset self))) - :lt (c? (ups (outset self))) + :lt (c? (+ (outset self))) :lr (c? (geo-kid-wrap self 'pr)) :lb (c? (geo-kid-wrap self 'pb)) :kid-slots (def-kid-slots (mk-kid-slot (px :if-missing t) (c? (px-maintain-pl 0))) (mk-kid-slot (py :if-missing t) - (c? (py-maintain-pt 0)))))) + (c? (break)(py-maintain-pt 0))))))

(defmodel geo-kid-sized (family) () @@ -206,7 +203,7 @@ (- (lr self) (outset self)))

(defun inset-lb (self) - (ups (lb self) (outset self))) + (+ (lb self) (outset self)))

(defun inset-height (self) (- (l-height self) (outset self) (outset self))) @@ -293,19 +290,14 @@ `(c? (lr-maintain-pr (- (inset-lr .parent) ,padding))))

-(defmacro ^prior-sib-pb (self &optional (spacing 0)) - (let ((kid (gensym)) - (psib (gensym))) - `(let* ((,kid ,self) - (,psib (find-prior ,kid (kids (fm-parent ,kid)) - :test (lambda (sib) - (not (collapsed sib))))) - ) - ;(trc "^priorSib-pb > kid, sib" ,kid ,pSib) - (if ,psib - (+ (- (abs ,spacing)) ;; force spacing to minus(= down for OpenGL) - (pb ,psib)) - 0)))) +(defun ^prior-sib-pb (self &optional (spacing 0)) + (bif (psib (find-prior self (kids .parent) + :test (lambda (sib) + (not (collapsed sib))))) + (eko (nil "^prior-sib-pb spc pb-psib -lt" (- (abs spacing)) (pb psib) (- (^lt))) + (+ (- (abs spacing)) ;; force spacing to minus(= down for OpenGL) + (pb psib))) + 0))

(defmacro ^prior-sib-pt (self &optional (spacing 0)) (let ((kid (gensym))