[cells-cvs] CVS cells/gui-geometry
ktilton
ktilton at common-lisp.net
Mon Jul 3 00:08:29 UTC 2006
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))
More information about the Cells-cvs
mailing list