[graphic-forms-cvs] r41 - in trunk/src: . tests/uitoolkit uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Wed Mar 15 00:18:51 UTC 2006
Author: junrue
Date: Tue Mar 14 19:18:51 2006
New Revision: 41
Modified:
trunk/src/packages.lisp
trunk/src/tests/uitoolkit/layout-tester.lisp
trunk/src/tests/uitoolkit/layout-unit-tests.lisp
trunk/src/uitoolkit/widgets/flow-layout.lisp
trunk/src/uitoolkit/widgets/layout-classes.lisp
Log:
implemented flow layout margins
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Tue Mar 14 19:18:51 2006
@@ -312,6 +312,7 @@
#:background-color
#:background-pattern
#:border-width
+ #:bottom-margin-of
#:caret
#:check
#:check-all
@@ -400,6 +401,7 @@
#:layout
#:layout-of
#:layout-p
+ #:left-margin-of
#:lines-visible-p
#:location
#:lock
@@ -431,6 +433,7 @@
#:replace-selection
#:resizable-p
#:retrieve-span
+ #:right-margin-of
#:run-default-message-loop
#:scroll
#:select
@@ -459,6 +462,7 @@
#:thumb-size
#:tooltip-text
#:top-index
+ #:top-margin-of
#:traverse
#:traverse-order
#:trim-sizes
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/layout-tester.lisp Tue Mar 14 19:18:51 2006
@@ -36,6 +36,7 @@
(defconstant +btn-text-before+ "Push Me")
(defconstant +btn-text-after+ "Again!")
(defconstant +label-text+ "Test Label")
+(defconstant +margin-delta+ 4)
(defconstant +spacing-delta+ 3)
(defvar *widget-counter* 0)
@@ -211,22 +212,102 @@
(incf (gfw:spacing-of layout) +spacing-delta+)
(gfw:layout *layout-tester-win*)))
+(defun enable-left-flow-margin-items (disp menu time)
+ (declare (ignore disp time))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (gfw:enable (gfw:item-at menu 0) (> (gfw:left-margin-of layout) 0))))
+
+(defun enable-top-flow-margin-items (disp menu time)
+ (declare (ignore disp time))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (gfw:enable (gfw:item-at menu 0) (> (gfw:top-margin-of layout) 0))))
+
+(defun enable-right-flow-margin-items (disp menu time)
+ (declare (ignore disp time))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (gfw:enable (gfw:item-at menu 0) (> (gfw:right-margin-of layout) 0))))
+
+(defun enable-bottom-flow-margin-items (disp menu time)
+ (declare (ignore disp time))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (gfw:enable (gfw:item-at menu 0) (> (gfw:bottom-margin-of layout) 0))))
+
+(defun inc-left-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (incf (gfw:left-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun inc-top-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (incf (gfw:top-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun inc-right-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (incf (gfw:right-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun inc-bottom-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (incf (gfw:bottom-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun dec-left-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (decf (gfw:left-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun dec-top-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (decf (gfw:top-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun dec-right-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (decf (gfw:right-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
+(defun dec-bottom-flow-margin (disp item time rect)
+ (declare (ignore disp item time rect))
+ (let ((layout (gfw:layout-of *layout-tester-win*)))
+ (decf (gfw:bottom-margin-of layout) +margin-delta+)
+ (gfw:layout *layout-tester-win*)))
+
(defun flow-mod-callback (disp menu time)
(declare (ignore disp time))
(gfw:clear-all menu)
(let ((it nil)
- (margin-menu (gfw:defmenusystem ((:item "Top"
- :submenu ((:item "Decrease")
- (:item "Increase")))
- (:item "Left"
- :submenu ((:item "Decrease")
- (:item "Increase")))
+ (margin-menu (gfw:defmenusystem ((:item "Left"
+ :callback #'enable-left-flow-margin-items
+ :submenu ((:item "Decrease"
+ :callback #'dec-left-flow-margin)
+ (:item "Increase"
+ :callback #'inc-left-flow-margin)))
+ (:item "Top"
+ :callback #'enable-top-flow-margin-items
+ :submenu ((:item "Decrease"
+ :callback #'dec-top-flow-margin)
+ (:item "Increase"
+ :callback #'inc-top-flow-margin)))
(:item "Right"
- :submenu ((:item "Decrease")
- (:item "Increase")))
+ :callback #'enable-right-flow-margin-items
+ :submenu ((:item "Decrease"
+ :callback #'dec-right-flow-margin)
+ (:item "Increase"
+ :callback #'inc-right-flow-margin)))
(:item "Bottom"
- :submenu ((:item "Decrease")
- (:item "Increase"))))))
+ :callback #'enable-bottom-flow-margin-items
+ :submenu ((:item "Decrease"
+ :callback #'dec-bottom-flow-margin)
+ (:item "Increase"
+ :callback #'inc-bottom-flow-margin))))))
(orient-menu (gfw:defmenusystem ((:item "Horizontal"
:callback #'set-flow-horizontal)
(:item "Vertical"
@@ -257,7 +338,8 @@
:check-test-fn #'gfw:visible-p)))
(setf *layout-tester-win* (make-instance 'gfw:window :dispatcher (make-instance 'layout-tester-events)
:layout (make-instance 'gfw:flow-layout
- :spacing +spacing-delta+)))
+ :spacing +spacing-delta+
+ :margins +margin-delta+)))
(gfw:realize *layout-tester-win* nil :style-workspace)
(setf menubar (gfw:defmenusystem ((:item "&File"
:submenu ((:item "E&xit"
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 Tue Mar 14 19:18:51 2006
@@ -191,3 +191,41 @@
(data (gfw::flow-container-layout layout t *flow-layout-uniform-kids* 30 25))
(expected-rects '((0 0 20 10) (0 14 20 10) (24 0 20 10))))
(validate-layout-rects data expected-rects)))
+
+(define-test flow-layout-test11
+ ;; orient: horizontal
+ ;; wrap: disabled
+ ;; spacing: 0
+ ;; left-margin: 3, top-margin: 3, right-margin: 0, bottom-margin: 0
+ ;; container: unrestricted width and height
+ ;; kids: uniform
+ ;;
+ (let* ((layout (make-instance 'gfw:flow-layout
+ :style '(:horizontal)
+ :left-margin 3
+ :top-margin 3))
+ (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 '((3 3 20 10) (23 3 20 10) (43 3 20 10))))
+ (assert-equal 63 (gfi:size-width size))
+ (assert-equal 13 (gfi:size-height size))
+ (validate-layout-rects data expected-rects)))
+
+(define-test flow-layout-test12
+ ;; orient: vertical
+ ;; wrap: disabled
+ ;; spacing: 0
+ ;; left-margin: 0, top-margin: 0, right-margin: 3, bottom-margin: 3
+ ;; container: unrestricted width and height
+ ;; kids: uniform
+ ;;
+ (let* ((layout (make-instance 'gfw:flow-layout
+ :style '(:vertical)
+ :right-margin 3
+ :bottom-margin 3))
+ (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 23 (gfi:size-width size))
+ (assert-equal 33 (gfi:size-height size))
+ (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 Tue Mar 14 19:18:51 2006
@@ -55,26 +55,28 @@
(incf total (gfi:size-width size))
(if (< max (gfi:size-height size))
(setf max (gfi:size-height size))))))))
- (if (< (spacing-of layout) 0)
- (error 'gfs:toolkit-error :detail "layout spacing must be non-negative"))
(unless (null kids)
(incf total (* (spacing-of layout) (1- (length kids)))))
(if vert-orient
- (gfi:make-size :width max :height total)
- (gfi:make-size :width total :height max))))
+ (progn
+ (incf max (+ (left-margin-of layout) (right-margin-of layout)))
+ (incf total (+ (top-margin-of layout) (bottom-margin-of layout)))
+ (gfi:make-size :width max :height total))
+ (progn
+ (incf total (+ (left-margin-of layout) (right-margin-of layout)))
+ (incf max (+ (top-margin-of layout) (bottom-margin-of layout)))
+ (gfi:make-size :width total :height max)))))
(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)
(spacing (spacing-of layout))
(style (style-of layout))
(vert-orient (find :vertical style))
- (wrap (find :wrap style)))
- (if (< spacing 0)
- (error 'gfs:toolkit-error :detail "layout spacing must be non-negative"))
+ (wrap (find :wrap style))
+ (max-size -1)
+ (next-coord (if vert-orient (top-margin-of layout) (left-margin-of layout)))
+ (wrap-coord (if vert-orient (left-margin-of layout) (top-margin-of layout))))
(loop for kid in kids
do (let ((size (preferred-size kid -1 -1))
(pnt (gfi:make-point)))
@@ -83,10 +85,13 @@
(progn
(when (and wrap
(>= height-hint 0)
- (> (+ next-coord (gfi:size-height size)) height-hint))
+ (> (+ next-coord
+ (gfi:size-height size)
+ (bottom-margin-of layout))
+ height-hint))
(push (reverse curr-flow) flows)
(setf curr-flow nil)
- (setf next-coord 0)
+ (setf next-coord (top-margin-of layout))
(incf wrap-coord (+ max-size spacing))
(setf max-size -1))
(setf (gfi:point-x pnt) wrap-coord)
@@ -97,10 +102,13 @@
(progn
(when (and wrap
(>= width-hint 0)
- (> (+ next-coord (gfi:size-width size)) width-hint))
+ (> (+ next-coord
+ (gfi:size-width size)
+ (right-margin-of layout))
+ width-hint))
(push (reverse curr-flow) flows)
(setf curr-flow nil)
- (setf next-coord 0)
+ (setf next-coord (left-margin-of layout))
(incf wrap-coord (+ max-size spacing))
(setf max-size -1))
(setf (gfi:point-x pnt) next-coord)
@@ -125,9 +133,22 @@
(with-children (win kids)
(flow-container-layout layout (visible-p win) kids width-hint height-hint)))
-(defmethod initialize-instance :after ((layout flow-layout) &key style)
+(defmethod initialize-instance :after ((layout flow-layout)
+ &key style margins horz-margins vert-margins
+ &allow-other-keys)
(unless (listp style)
(setf style (list style)))
(if (and (null (find :horizontal style)) (null (find :vertical style)))
(push :horizontal style))
- (setf (style-of layout) style))
+ (setf (style-of layout) style)
+ (unless (null margins)
+ (setf (left-margin-of layout) margins)
+ (setf (right-margin-of layout) margins)
+ (setf (top-margin-of layout) margins)
+ (setf (bottom-margin-of layout) margins))
+ (unless (null horz-margins)
+ (setf (left-margin-of layout) horz-margins)
+ (setf (right-margin-of layout) horz-margins))
+ (unless (null vert-margins)
+ (setf (top-margin-of layout) vert-margins)
+ (setf (bottom-margin-of layout) vert-margins)))
Modified: trunk/src/uitoolkit/widgets/layout-classes.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/layout-classes.lisp (original)
+++ trunk/src/uitoolkit/widgets/layout-classes.lisp Tue Mar 14 19:18:51 2006
@@ -44,5 +44,21 @@
((spacing
:accessor spacing-of
:initarg :spacing
+ :initform 0)
+ (left-margin
+ :accessor left-margin-of
+ :initarg :left-margin
+ :initform 0)
+ (top-margin
+ :accessor top-margin-of
+ :initarg :top-margin
+ :initform 0)
+ (right-margin
+ :accessor right-margin-of
+ :initarg :right-margin
+ :initform 0)
+ (bottom-margin
+ :accessor bottom-margin-of
+ :initarg :bottom-margin
:initform 0))
(:documentation "Window children are arranged in a row or column."))
More information about the Graphic-forms-cvs
mailing list