[graphic-forms-cvs] r399 - trunk/src/tests/uitoolkit
junrue at common-lisp.net
junrue at common-lisp.net
Sun Nov 19 22:27:52 UTC 2006
Author: junrue
Date: Sun Nov 19 17:27:49 2006
New Revision: 399
Modified:
trunk/src/tests/uitoolkit/border-layout-unit-tests.lisp
trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp
trunk/src/tests/uitoolkit/test-utils.lisp
Log:
define-layout-test now accepts a function to use to customize the target layout
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 Sun Nov 19 17:27:49 2006
@@ -64,35 +64,59 @@
(define-layout-test border-layout-test1
-1 -1 80 50
+ nil
'((20 5 40 40) (0 0 80 5) (0 5 20 40) (0 45 80 5) (60 5 20 40))
#'make-border-layout *all-border-kids*)
(define-layout-test border-layout-test2
-1 -1 40 20
+ nil
'((0 0 40 5) (0 5 20 10) (0 15 40 5) (20 5 20 10))
#'make-border-layout *outer-border-kids*)
(define-layout-test border-layout-test3
-1 -1 40 40
+ nil
'((0 0 40 40))
#'make-border-layout *center-border-kid*)
(define-layout-test border-layout-test4
-1 -1 25 15
+ nil
'((0 0 25 5) (0 5 20 10))
#'make-border-layout *top-right-border-kids*)
(define-layout-test border-layout-test5
-1 -1 25 10
+ nil
'((0 0 25 5) (0 5 25 5))
#'make-border-layout *top-bottom-border-kids*)
(define-layout-test border-layout-test6
26 -1 26 50
+ nil
'((6 5 13 40) (0 0 26 5) (0 5 6 40) (0 45 26 5) (19 5 6 40))
#'make-border-layout *all-border-kids*)
(define-layout-test border-layout-test7
-1 -1 90 58
+ nil
'((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)
+
+(defun border-layout-spacing (layout)
+ (loop for pair in (gfw::data-of layout)
+ for widget = (first pair)
+ for key = (first (second pair))
+ do (case key
+ ;; note - we leave :center region with default spacing
+ (:top (setf (gfw:layout-attribute layout widget :leading-spacing) 2))
+ (:left (setf (gfw:layout-attribute layout widget :trailing-spacing) 3))
+ (:right (setf (gfw:layout-attribute layout widget :spacing) 4))
+ (:bottom (setf (gfw:layout-attribute layout widget :center-spacing) 5)))))
+
+(define-layout-test border-layout-test8
+ -1 -1 80 50
+ #'border-layout-spacing
+ '((20 5 40 40) (0 0 80 5) (0 5 20 40) (0 45 80 5) (60 5 20 40))
+ #'make-border-layout *all-border-kids*)
Modified: trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp (original)
+++ trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp Sun Nov 19 17:27:49 2006
@@ -42,70 +42,84 @@
(define-layout-test flow-layout-test1
-1 -1 60 10
+ nil
'((0 0 20 10) (20 0 20 10) (40 0 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal))
(define-layout-test flow-layout-test2
-1 -1 20 30
+ nil
'((0 0 20 10) (0 10 20 10) (0 20 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical))
(define-layout-test flow-layout-test3
45 -1 40 20
+ nil
'((0 0 20 10) (20 0 20 10) (0 10 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap))
(define-layout-test flow-layout-test4
-1 25 20 20
+ nil
'((0 0 20 10) (0 10 20 10) (20 0 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical :wrap))
(define-layout-test flow-layout-test5
45 18 40 20
+ nil
'((0 0 20 10) (20 0 20 10) (0 10 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap))
(define-layout-test flow-layout-test6
30 25 40 20
+ nil
'((0 0 20 10) (0 10 20 10) (20 0 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical :wrap))
(define-layout-test flow-layout-test7
-1 -1 68 10
+ nil
'((0 0 20 10) (24 0 20 10) (48 0 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal) 4)
(define-layout-test flow-layout-test8
-1 -1 20 38
+ nil
'((0 0 20 10) (0 14 20 10) (0 28 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical) 4)
(define-layout-test flow-layout-test9
45 18 0 0
+ nil
'((0 0 20 10) (24 0 20 10) (0 14 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap) 4)
(define-layout-test flow-layout-test10
30 25 0 0
+ nil
'((0 0 20 10) (0 14 20 10) (24 0 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical :wrap) 4)
(define-layout-test flow-layout-test11
-1 -1 63 13
+ nil
'((3 3 20 10) (23 3 20 10) (43 3 20 10))
#'make-flow-layout *flow-uniform-kids* '(:horizontal) 0 3 3)
(define-layout-test flow-layout-test12
-1 -1 23 33
+ nil
'((0 0 20 10) (0 10 20 10) (0 20 20 10))
#'make-flow-layout *flow-uniform-kids* '(:vertical) 0 0 0 3 3)
(define-layout-test flow-layout-test13
-1 -1 75 10
+ nil
'((0 0 25 10) (25 0 25 10) (50 0 25 10))
#'make-flow-layout *flow-mixed-kids* '(:horizontal :normalize))
(define-layout-test flow-layout-test14
-1 -1 25 30
+ nil
'((0 0 25 10) (0 10 25 10) (0 20 25 10))
#'make-flow-layout *flow-mixed-kids* '(:vertical :normalize))
Modified: trunk/src/tests/uitoolkit/test-utils.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/test-utils.lisp (original)
+++ trunk/src/tests/uitoolkit/test-utils.lisp Sun Nov 19 17:27:49 2006
@@ -83,13 +83,16 @@
actual-rects)))
(defmacro define-layout-test (name width-hint height-hint
- expected-width expected-height expected-rects
+ expected-width expected-height
+ customizer expected-rects
factory &rest factory-args)
(let ((layout (gensym))
(size (gensym))
+ (dummy (gensym))
(data (gensym)))
`(define-test ,name
(let* ((,layout (apply ,factory (list , at factory-args)))
+ (,dummy (if ,customizer (funcall ,customizer ,layout)))
(,size (gfw::compute-size ,layout *mock-container* ,width-hint ,height-hint))
(,data (gfw::compute-layout ,layout *mock-container* ,width-hint ,height-hint)))
(assert-equal ,expected-width (gfs::size-width ,size))
More information about the Graphic-forms-cvs
mailing list