Author: junrue Date: Mon Mar 13 23:37:44 2006 New Revision: 38
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp trunk/src/tests/uitoolkit/layout-unit-tests.lisp trunk/src/uitoolkit/widgets/flow-layout.lisp Log: implemented wrap style for flow layout; refactored flow layout unit tests
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-tester.lisp (original) +++ trunk/src/tests/uitoolkit/layout-tester.lisp Mon Mar 13 23:37:44 2006 @@ -165,14 +165,29 @@
(defun set-flow-horizontal (disp item time rect) (declare (ignorable disp item time rect)) - (let ((layout (gfw:layout-manager *layout-tester-win*))) - (setf (gfw:style-of layout) (list :horizontal)) + (let* ((layout (gfw:layout-manager *layout-tester-win*)) + (style (gfw:style-of layout))) + (setf style (remove :vertical style)) + (push :horizontal style) + (setf (gfw:style-of layout) style) (gfw:layout *layout-tester-win*)))
(defun set-flow-vertical (disp item time rect) (declare (ignorable disp item time rect)) - (let ((layout (gfw:layout-manager *layout-tester-win*))) - (setf (gfw:style-of layout) (list :vertical)) + (let* ((layout (gfw:layout-manager *layout-tester-win*)) + (style (gfw:style-of layout))) + (setf style (remove :horizontal style)) + (push :vertical style) + (setf (gfw:style-of layout) style) + (gfw:layout *layout-tester-win*))) + +(defun set-flow-layout-wrap (disp item time rect) + (declare (ignorable disp item time rect)) + (let* ((layout (gfw:layout-manager *layout-tester-win*)) + (style (gfw:style-of layout))) + (if (find :wrap style) + (setf (gfw:style-of layout) (remove :wrap style)) + (setf (gfw:style-of layout) (push :wrap style))) (gfw:layout *layout-tester-win*)))
(defun flow-mod-callback (disp menu time) @@ -200,9 +215,8 @@ (gfw:append-submenu menu "Margin" margin-menu nil) (gfw:append-submenu menu "Orientation" orient-menu #'check-flow-orient-item) (gfw:append-submenu menu "Spacing" spacing-menu nil) - (setf it (gfw:append-item menu "Fill" nil nil)) - (gfw:check it t) - (gfw:append-item menu "Wrap" nil #'(lambda (a0 a1 a2 a3) (format t "wrap: ~a~%" a2))))) + (setf it (gfw:append-item menu "Wrap" nil #'set-flow-layout-wrap)) + (gfw:check it (find :wrap (gfw:style-of (gfw:layout-manager *layout-tester-win*))))))
(defun exit-layout-callback (disp item time rect) (declare (ignorable disp item time rect))
Modified: trunk/src/tests/uitoolkit/layout-unit-tests.lisp ============================================================================== --- trunk/src/tests/uitoolkit/layout-unit-tests.lisp (original) +++ trunk/src/tests/uitoolkit/layout-unit-tests.lisp Mon Mar 13 23:37:44 2006 @@ -34,50 +34,90 @@ (in-package :graphic-forms.uitoolkit.tests)
(defvar *minsize1* (gfi:make-size :width 20 :height 10)) -(defvar *flow-layout-kids1* (list (make-instance 'mock-widget :min-size *minsize1*) - (make-instance 'mock-widget :min-size *minsize1*) - (make-instance 'mock-widget :min-size *minsize1*))) - -(defun validate-layout-points (actual-entries expected-pnts) - (mapc #'(lambda (pnt entry) - (let ((pnt2 (gfi:location (cdr entry)))) - (assert-true (and (= (gfi:point-x pnt) (gfi:point-x pnt2)) - (= (gfi:point-y pnt) (gfi:point-y pnt2)))))) - expected-pnts - actual-entries)) +(defvar *flow-layout-uniform-kids* (list (make-instance 'mock-widget :min-size *minsize1*) + (make-instance 'mock-widget :min-size *minsize1*) + (make-instance 'mock-widget :min-size *minsize1*))) + +(defun validate-layout-rects (entries expected-rects) + (let ((actual-rects (loop for entry in entries collect (cdr entry)))) + (mapc #'(lambda (expected actual) + (let ((pnt-a (gfi:location actual)) + (sz-a (gfi:size actual))) + (assert-equal (gfi:point-x pnt-a) (first expected)) + (assert-equal (gfi:point-y pnt-a) (second expected)) + (assert-equal (gfi:size-width sz-a) (third expected)) + (assert-equal (gfi:size-height sz-a) (fourth expected)))) + expected-rects + actual-rects)))
(define-test flow-layout-test1 ;; orient: horizontal ;; wrap: disabled - ;; fill: disabled - ;; container: visible + ;; container: unrestricted width and height ;; kids: uniform ;; (let* ((layout (make-instance 'gfw:flow-layout :style '(:horizontal))) - (size (gfw::flow-container-size layout t *flow-layout-kids1* -1 -1)) - (actual (gfw::flow-container-layout layout t *flow-layout-kids1* -1 -1)) - (expected-pnts nil)) - (push (gfi:make-point :x 40 :y 0) expected-pnts) - (push (gfi:make-point :x 20 :y 0) expected-pnts) - (push (gfi:make-point :x 0 :y 0) expected-pnts) + (size (gfw::flow-container-size layout t *flow-layout-uniform-kids* -1 -1)) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* -1 -1)) + (expected-rects '((0 0 20 10) (20 0 20 10) (40 0 20 10)))) (assert-equal 60 (gfi:size-width size)) (assert-equal 10 (gfi:size-height size)) - (validate-layout-points actual expected-pnts))) + (validate-layout-rects data expected-rects)))
(define-test flow-layout-test2 ;; orient: vertical ;; wrap: disabled - ;; fill: disabled - ;; container: visible + ;; container: unrestricted width and height ;; kids: uniform ;; (let* ((layout (make-instance 'gfw:flow-layout :style '(:vertical))) - (size (gfw::flow-container-size layout t *flow-layout-kids1* -1 -1)) - (actual (gfw::flow-container-layout layout t *flow-layout-kids1* -1 -1)) - (expected-pnts nil)) - (push (gfi:make-point :x 0 :y 20) expected-pnts) - (push (gfi:make-point :x 0 :y 10) expected-pnts) - (push (gfi:make-point :x 0 :y 0) expected-pnts) + (size (gfw::flow-container-size layout t *flow-layout-uniform-kids* -1 -1)) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* -1 -1)) + (expected-rects '((0 0 20 10) (0 10 20 10) (0 20 20 10)))) (assert-equal 20 (gfi:size-width size)) (assert-equal 30 (gfi:size-height size)) - (validate-layout-points actual expected-pnts))) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test3 + ;; orient: horizontal + ;; wrap: enabled + ;; container: restricted width, unrestricted height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :style '(:horizontal :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 45 -1)) + (expected-rects '((0 0 20 10) (20 0 20 10) (0 10 20 10)))) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test4 + ;; orient: vertical + ;; wrap: enabled + ;; container: unrestricted width, restricted height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :style '(:vertical :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* -1 25)) + (expected-rects '((0 0 20 10) (0 10 20 10) (20 0 20 10)))) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test5 + ;; orient: horizontal + ;; wrap: enabled + ;; container: restricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :style '(:horizontal :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 45 18)) + (expected-rects '((0 0 20 10) (20 0 20 10) (0 10 20 10)))) + (validate-layout-rects data expected-rects))) + +(define-test flow-layout-test6 + ;; orient: vertical + ;; wrap: enabled + ;; container: restricted width and height + ;; kids: uniform + ;; + (let* ((layout (make-instance 'gfw:flow-layout :style '(:vertical :wrap))) + (data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 30 25)) + (expected-rects '((0 0 20 10) (0 10 20 10) (20 0 20 10)))) + (validate-layout-rects data expected-rects)))
Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/flow-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/flow-layout.lisp Mon Mar 13 23:37:44 2006 @@ -59,35 +59,52 @@ (gfi:make-size :width max :height total) (gfi:make-size :width total :height max))))
-(defun flow-container-layout (layout win-visible kids width-hint height-hint) - (let ((entries nil) - (last-coord 0) - (last-dim 0) - (vert-orient (find :vertical (style-of layout)))) +(defun flow-container-layout (layout visible kids width-hint height-hint) + (let* ((flows nil) + (curr-flow nil) + (max-size -1) + (next-coord 0) + (wrap-coord 0) + (style (style-of layout)) + (vert-orient (find :vertical style)) + (wrap (find :wrap style))) (loop for kid in kids - do (let ((size (preferred-size kid - (if vert-orient width-hint -1) - (if vert-orient -1 height-hint))) + do (let ((size (preferred-size kid -1 -1)) (pnt (gfi:make-point))) - (when (or (visible-p kid) (not win-visible)) + (when (or (visible-p kid) (not visible)) (if vert-orient (progn - (setf (gfi:point-y pnt) (+ last-coord last-dim)) - (if (>= width-hint 0) - (setf (gfi:size-width size) width-hint)) - (setf last-coord (gfi:point-y pnt)) - (setf last-dim (gfi:size-height size))) + (when (and wrap + (>= height-hint 0) + (> (+ next-coord (gfi:size-height size)) height-hint)) + (push (reverse curr-flow) flows) + (setf curr-flow nil) + (setf next-coord 0) + (incf wrap-coord max-size) + (setf max-size -1)) + (setf (gfi:point-x pnt) wrap-coord) + (setf (gfi:point-y pnt) next-coord) + (if (< max-size (gfi:size-width size)) + (setf max-size (gfi:size-width size))) + (incf next-coord (gfi:size-height size))) (progn - (setf (gfi:point-x pnt) (+ last-coord last-dim)) - (if (>= height-hint 0) - (setf (gfi:size-height size) height-hint)) - (setf last-coord (gfi:point-x pnt)) - (setf last-dim (gfi:size-width size)))) - (push (cons kid (make-instance 'gfi:rectangle - :size size - :location pnt)) - entries)))) - (nreverse entries))) + (when (and wrap + (>= width-hint 0) + (> (+ next-coord (gfi:size-width size)) width-hint)) + (push (reverse curr-flow) flows) + (setf curr-flow nil) + (setf next-coord 0) + (incf wrap-coord max-size) + (setf max-size -1)) + (setf (gfi:point-x pnt) next-coord) + (setf (gfi:point-y pnt) wrap-coord) + (if (< max-size (gfi:size-height size)) + (setf max-size (gfi:size-height size))) + (incf next-coord (gfi:size-width size)))) + (push (cons kid (make-instance 'gfi:rectangle :size size :location pnt)) curr-flow)))) + (unless (null curr-flow) + (push (reverse curr-flow) flows)) + (loop for flow in (nreverse flows) append flow)))
;;; ;;; methods @@ -105,5 +122,5 @@ (unless (listp style) (setf style (list style))) (if (and (null (find :horizontal style)) (null (find :vertical style))) - (setf (style-of layout) '(:horizontal)) - (setf (style-of layout) style))) + (push :horizontal style)) + (setf (style-of layout) style))