Update of /project/cells/cvsroot/cells/gui-geometry In directory clnet:/tmp/cvs-serv2729/gui-geometry
Modified Files: geo-data-structures.lisp geo-family.lisp geometer.lisp gui-geometry.lpr Log Message:
--- /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2006/12/12 15:58:42 1.9 +++ /project/cells/cvsroot/cells/gui-geometry/geo-data-structures.lisp 2007/11/30 16:51:19 1.10 @@ -17,7 +17,7 @@ (in-package :gui-geometry)
(eval-now! - (export '(v2 mkv2))) + (export '(v2 mkv2 v2=))) ;-----------------------------
(defstruct v2 --- /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2006/11/13 05:28:08 1.11 +++ /project/cells/cvsroot/cells/gui-geometry/geo-family.lisp 2007/11/30 16:51:19 1.12 @@ -102,6 +102,47 @@ (^prior-sib-pr self (spacing .parent)))))))))))
+(defun ^prior-sib-pb (self &optional (spacing 0)) ;; just keeping with -pt variant till both converted to defun + (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)) + +(defun centered-h? () + (c? (px-maintain-pl (round (- (inset-width .parent) (l-width self)) 2)))) + +(defun centered-v? () + (c? (py-maintain-pt (round (- (l-height .parent) (l-height self)) -2)))) + +;--------------- 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)()) @@ -136,28 +177,8 @@ (pt psib)) 0))))))))
-;--------------- IGRowFlow ---------------------------- +|# + +
-(defmodel geo-row-flow (geo-row) - ((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)) (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)) (l-width .parent)) - 0 - ph)))))))))
-|# --- /project/cells/cvsroot/cells/gui-geometry/geometer.lisp 2006/11/13 05:28:08 1.12 +++ /project/cells/cvsroot/cells/gui-geometry/geometer.lisp 2007/11/30 16:51:19 1.13 @@ -87,18 +87,7 @@ ;(trc "inner outer" inner outer) ))
-(defmacro ^offset-within (inner outer) - (let ((offset-h (gensym)) (offset-v (gensym)) (from (gensym))) - `(let ((,offset-h 0) - (,offset-v 0)) - (do ((,from ,inner (fm-parent ,from))) - ((or (null ,from) - (eql ,from ,outer)) - ; - (mkv2 ,offset-h ,offset-v)) - - (incf ,offset-h (px ,from)) - (incf ,offset-v (py ,from)))))) +
;----------- OfKids ----------------------- ; @@ -127,6 +116,8 @@ (v2-subtract outer-v2 (mkv2 (px inner) (py inner))))))
+(export! h-xlate v-xlate) + (defun h-xlate (outer inner outer-h) (if (eql outer inner) outer-h @@ -212,18 +203,6 @@
;---------------------------------
-(defmacro ^ll-width (width) - `(- (lr self) ,width)) - -(defmacro ^lr-width (width) - `(+ (ll self) ,width)) - -(defmacro ^lt-height (height) - `(- (lb self) ,height)) - -(defmacro ^lb-height (height) - `(+ (lt self) ,height)) - ;----------------------------------
(export! geo-kid-wrap) @@ -235,108 +214,6 @@ ((pr pt) 'fm-max-kid)) self bound) (outset self)))
-(defmacro ll-maintain-pL (pl) - `(- ,pL (^px))) - -(defmacro lr-maintain-pr (pr) - `(- ,pr (^px))) - -(defmacro ^fill-right (upperType &optional (padding 0)) - `(call-^fillRight self (upper self ,upperType) ,padding)) - -;recalc local top based on pT and offset -(defmacro lt-maintain-pT (pT) - `(- ,pT (^py))) - -;recalc local bottom based on pB and offset -(defmacro lb-maintain-pB (pB) - `(- ,pB (^py))) - -;-------------- -;recalc offset based on p and local -(defmacro px-maintain-pL (pL) - (let ((lL (gensym))) - `(- ,pL (let ((,lL (^lL))) - (c-assert ,lL () "^px-maintain-pL sees nil lL for ~a" self) - ,lL)))) - -(defmacro px-maintain-pR (pR) - `(- ,pR (^lR))) - -(defmacro py-maintain-pT (pT) - `(- ,pT (^lT))) - -(defmacro py-maintain-pB (pB) - `(- ,pB (^lB))) - -(defmacro centered-h? () - `(c? (px-maintain-pl (round (- (l-width .parent) (l-width self)) 2)))) - -(defmacro ^centered-v? () - `(c? (py-maintain-pt (round (- (l-height .parent) (l-height self)) 2)))) - -(defmacro ^fill-down (upper-type &optional (padding 0)) - (let ((filled (gensym))) - `(let ((,filled (upper self ,upper-type))) - #+qt (trc "^fillDown sees filledLR less offH" - (lb ,filled) - ,padding - (v2-v (offset-within self ,filled))) - (- (lb ,filled) - ,padding - (v2-v (offset-within self ,filled)))))) - -(defmacro ^lbmax? (&optional (padding 0)) - `(c? (lb-maintain-pb (- (inset-lb .parent) - ,padding)))) - -(defmacro ^lrmax? (&optional (padding 0)) - `(c? (lr-maintain-pr (- (inset-lr .parent) - ,padding)))) - -(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)) - (psib (gensym))) - `(let* ((,kid ,self) - (,psib (find-prior ,kid (kids (fm-parent ,kid))))) - ;(trc "^priorSib-pb > kid, sib" ,kid ,pSib) - (if ,psib - (+ (- (abs ,spacing)) (pt ,psib)) - 0)))) - -; "...return the sib's pL [if ,alignment is :left] or pR, plus optional spacing" - -(defmacro ^prior-sib-pr (self &optional (spacing 0) alignment) - (let ((kid (gensym)) - (psib (gensym))) - `(let* ((,kid ,self) - (,psib (find-prior ,kid (kids (fm-parent ,kid)) :test (lambda (k) (not (collapsed k)))))) - (if ,psib - (case ,alignment - (:left (+ ,spacing (pl ,psib))) - (otherwise (+ ,spacing (pr ,psib)))) - 0)))) - -(defmacro ^px-stay-right-of (other &key (by '0)) - `(px-maintain-pl (+ (pr (fm-other ,other)) ,by))) - -; in use; adjust offset to maintain pL based on ,justify -(defmacro ^px-self-centered (justify) - `(px-maintain-pl - (ecase ,justify - (:left 0) - (:center (floor (- (inset-width .parent) (l-width self)) 2)) - (:right (- (inset-lr .parent) (l-width self)))))) - ; in use; same idea for pT (defun py-self-centered (self justify) (py-maintain-pt @@ -345,9 +222,3 @@ (:center (floor (- (inset-height .parent) (l-height self)) -2)) (:bottom (downs (- (inset-height .parent) (l-height self)))))))
-(defmacro ^fill-parent-right (&optional (inset 0)) - `(lr-maintain-pr (- (inset-lr .parent) ,inset))) - -(defmacro ^fill-parent-down () - `(lb-maintain-pb (inset-lb .parent))) - --- /project/cells/cvsroot/cells/gui-geometry/gui-geometry.lpr 2007/01/29 06:44:03 1.8 +++ /project/cells/cvsroot/cells/gui-geometry/gui-geometry.lpr 2007/11/30 16:51:19 1.9 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jan 22, 2007 8:01)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jan 29, 2007 18:02)"; cg: "1.81"; -*-
(in-package :cg-user)
@@ -6,6 +6,7 @@
(define-project :name :gui-geometry :modules (list (make-instance 'module :name "defpackage.lisp") + (make-instance 'module :name "geo-macros.lisp") (make-instance 'module :name "geo-data-structures.lisp") (make-instance 'module :name "coordinate-xform.lisp")