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))))))