[graphic-forms-cvs] r396 - in trunk/src: tests/uitoolkit uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Fri Nov 17 23:46:34 UTC 2006
Author: junrue
Date: Fri Nov 17 18:46:33 2006
New Revision: 396
Modified:
trunk/src/tests/uitoolkit/border-layout-unit-tests.lisp
trunk/src/tests/uitoolkit/test-utils.lisp
trunk/src/uitoolkit/widgets/border-layout.lisp
Log:
implemented border-layout margins
Modified: trunk/src/tests/uitoolkit/border-layout-unit-tests.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/border-layout-unit-tests.lisp (original)
+++ trunk/src/tests/uitoolkit/border-layout-unit-tests.lisp Fri Nov 17 18:46:33 2006
@@ -93,6 +93,6 @@
#'make-border-layout *all-border-kids*)
(define-layout-test border-layout-test7
- -1 25 80 25
- '((20 2 40 20) (0 0 80 2) (0 2 20 20) (0 22 80 2) (60 2 20 20))
- #'make-border-layout *all-border-kids*)
+ -1 -1 90 58
+ '((24 8 40 40) (4 3 80 5) (4 8 20 40) (4 48 80 5) (64 8 20 40))
+ #'make-border-layout *all-border-kids* 4 3 6 5)
Modified: trunk/src/tests/uitoolkit/test-utils.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/test-utils.lisp (original)
+++ trunk/src/tests/uitoolkit/test-utils.lisp Fri Nov 17 18:46:33 2006
@@ -48,19 +48,14 @@
(loop for kid in kids do (gfw::append-layout-item layout kid))
layout))
-(defun make-border-layout (kids &optional spacing left-margin top-margin right-margin bottom-margin)
+(defun make-border-layout (kids &optional left-margin top-margin right-margin bottom-margin)
(let ((layout (make-instance 'gfw:border-layout
- :left-margin (or left-margin 0)
+ :left-margin (or left-margin 0)
:top-margin (or top-margin 0)
:right-margin (or right-margin 0)
- :bottom-margin (or bottom-margin 0)))
- (top-kid (first kids))
- (right-kid (second kids))
- (bottom-kid (third kids))
- (left-kid (fourth kids))
- (center-kid (fifth kids)))
+ :bottom-margin (or bottom-margin 0))))
(loop for kid in kids
- for region in '(:top :left :bottom :right :center)
+ for region in '(:top :right :bottom :left :center)
when kid
do (progn
(gfw::append-layout-item layout kid)
Modified: trunk/src/uitoolkit/widgets/border-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/border-layout.lisp (original)
+++ trunk/src/uitoolkit/widgets/border-layout.lisp Fri Nov 17 18:46:33 2006
@@ -93,14 +93,18 @@
(gfs:size-height c-size)
(gfs:size-height r-size))))
(setf (borders-outer-size data)
- (gfs:make-size :width (max (gfs:size-width t-size)
- (gfs:size-width b-size)
- (+ (gfs:size-width l-size)
- (gfs:size-width c-size)
- (gfs:size-width r-size)))
+ (gfs:make-size :width (+ (max (gfs:size-width t-size)
+ (gfs:size-width b-size)
+ (+ (gfs:size-width l-size)
+ (gfs:size-width c-size)
+ (gfs:size-width r-size)))
+ (left-margin-of layout)
+ (right-margin-of layout))
:height (+ (gfs:size-height t-size)
(gfs:size-height (borders-inside-size data))
- (gfs:size-height b-size))))
+ (gfs:size-height b-size)
+ (top-margin-of layout)
+ (bottom-margin-of layout))))
data))
(defun top-border-rect (data)
@@ -108,55 +112,68 @@
(return-from top-border-rect *empty-rect*))
(or (borders-top-rect data)
(setf (borders-top-rect data)
- (gfs:create-rectangle :width (gfs:size-width (borders-outer-size data))
- :height (borders-pref-top-height data)))))
+ (let ((layout (borders-layout data))
+ (size (borders-outer-size data)))
+ (gfs:create-rectangle :x (left-margin-of layout)
+ :y (top-margin-of layout)
+ :width (- (gfs:size-width size)
+ (+ (left-margin-of layout)
+ (right-margin-of layout)))
+ :height (borders-pref-top-height data))))))
(defun bottom-border-rect (data)
(unless (borders-bottom-widget data)
(return-from bottom-border-rect *empty-rect*))
(or (borders-bottom-rect data)
- (let ((ypos (- (gfs:size-height (borders-outer-size data))
- (borders-pref-bottom-height data))))
- (setf (borders-bottom-rect data)
- (gfs:create-rectangle :y ypos
- :width (gfs:size-width (borders-outer-size data))
+ (setf (borders-bottom-rect data)
+ (let ((layout (borders-layout data))
+ (size (borders-outer-size data)))
+ (gfs:create-rectangle :x (left-margin-of layout)
+ :y (- (gfs:size-height size)
+ (borders-pref-bottom-height data)
+ (bottom-margin-of layout))
+ :width (- (gfs:size-width size)
+ (+ (left-margin-of layout)
+ (right-margin-of layout)))
:height (borders-pref-bottom-height data))))))
(defun left-border-rect (data)
(unless (borders-left-widget data)
(return-from left-border-rect *empty-rect*))
(or (borders-left-rect data)
- (let ((ypos (gfs:size-height (gfs:size (top-border-rect data))))
- (inside-height (gfs:size-height (borders-inside-size data))))
+ (let ((layout (borders-layout data)))
(setf (borders-left-rect data)
- (gfs:create-rectangle :y ypos
+ (gfs:create-rectangle :x (left-margin-of layout)
+ :y (+ (top-margin-of layout)
+ (gfs:size-height (gfs:size (top-border-rect data))))
:width (borders-pref-left-width data)
- :height inside-height)))))
+ :height (gfs:size-height (borders-inside-size data)))))))
(defun right-border-rect (data)
(unless (borders-right-widget data)
(return-from right-border-rect *empty-rect*))
(or (borders-right-rect data)
- (let ((xpos (+ (gfs:size-width (gfs:size (left-border-rect data)))
- (gfs:size-width (gfs:size (center-border-rect data)))))
- (ypos (gfs:size-height (gfs:size (top-border-rect data))))
- (inside-height (gfs:size-height (borders-inside-size data))))
+ (let ((layout (borders-layout data)))
(setf (borders-right-rect data)
- (gfs:create-rectangle :x xpos
- :y ypos
+ (gfs:create-rectangle :x (+ (left-margin-of layout)
+ (gfs:size-width (gfs:size (left-border-rect data)))
+ (gfs:size-width (gfs:size (center-border-rect data))))
+ :y (+ (top-margin-of layout)
+ (gfs:size-height (gfs:size (top-border-rect data))))
:width (borders-pref-right-width data)
- :height inside-height)))))
+ :height (gfs:size-height (borders-inside-size data)))))))
(defun center-border-rect (data)
(unless (borders-center-widget data)
(return-from center-border-rect *empty-rect*))
(or (borders-center-rect data)
- (let ((xpos (gfs:size-width (gfs:size (left-border-rect data))))
- (ypos (gfs:size-height (gfs:size (top-border-rect data))))
+ (let ((layout (borders-layout data))
(size (borders-inside-size data)))
(setf (borders-center-rect data)
- (gfs:create-rectangle :x xpos
- :y ypos
+ (gfs:create-rectangle :x (+ (left-margin-of layout)
+ (gfs:size-width (gfs:size (left-border-rect data))))
+ :y (+ (top-margin-of layout)
+ (gfs:size-height (gfs:size (top-border-rect data))))
:width (gfs:size-width size)
:height (gfs:size-height size))))))
More information about the Graphic-forms-cvs
mailing list