[graphic-forms-cvs] r150 - in trunk/src: tests/uitoolkit uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Sun Jun 4 19:50:41 UTC 2006
Author: junrue
Date: Sun Jun 4 15:50:41 2006
New Revision: 150
Modified:
trunk/src/tests/uitoolkit/windlg.lisp
trunk/src/uitoolkit/widgets/flow-layout.lisp
Log:
:normalize style for flow-layout is now working
Modified: trunk/src/tests/uitoolkit/windlg.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/windlg.lisp (original)
+++ trunk/src/tests/uitoolkit/windlg.lisp Sun Jun 4 15:50:41 2006
@@ -154,7 +154,7 @@
(btn-panel (make-instance 'gfw:panel
:layout (make-instance 'gfw:flow-layout
:spacing 4
- :style '(:vertical))
+ :style '(:vertical :normalize))
:parent dlg))
(ok-btn (make-instance 'gfw:button
:callback (lambda (disp btn time rect)
Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/flow-layout.lisp (original)
+++ trunk/src/uitoolkit/widgets/flow-layout.lisp Sun Jun 4 15:50:41 2006
@@ -37,51 +37,13 @@
;;; helper functions
;;;
-(defun flow-container-size (layout visible kids width-hint height-hint)
- (let ((kid-count (length kids))
- (vertical (find :vertical (style-of layout)))
- (horizontal (find :horizontal (style-of layout)))
- (normal (find :normalize (style-of layout)))
- (horz-max 0)
- (horz-total 0)
- (vert-max 0)
- (vert-total 0))
- (loop for kid in kids
- do (let* ((size (preferred-size kid
- (if vertical width-hint -1)
- (if vertical -1 height-hint)))
- (width (gfs:size-width size))
- (height (gfs:size-height size)))
- (when (or (visible-p kid) (not visible))
- (incf horz-total width)
- (incf vert-total height)
- (if (< vert-max height)
- (setf vert-max height))
- (if (< horz-max width)
- (setf horz-max width)))))
- (if (and normal vertical)
- (setf vert-total (* vert-max kid-count))
- (if (and normal horizontal)
- (setf horz-total (* horz-max kid-count))))
- (let ((spacing-total (* (spacing-of layout) (1- kid-count)))
- (horz-margin-total (+ (left-margin-of layout) (right-margin-of layout)))
- (vert-margin-total (+ (top-margin-of layout) (bottom-margin-of layout))))
- (cond
- (vertical
- (gfs:make-size :width (+ horz-max horz-margin-total)
- :height (+ vert-total spacing-total vert-margin-total)))
- (horizontal
- (gfs:make-size :width (+ horz-total spacing-total horz-margin-total)
- :height (+ vert-max vert-margin-total)))
- (t
- (error 'gfs:toolkit-error
- :detail (format nil "unrecognized flow layout style: ~a" (style-of layout))))))))
-
(defstruct flow-data
(hint 0)
(kid-sizes nil)
- (max-extent 0)
+ (distance-total 0)
(max-distance 0)
+ (extent-total 0)
+ (max-extent 0)
(next-coord 0)
(wrap-coord 0)
(spacing 0)
@@ -114,6 +76,8 @@
do (let* ((size (preferred-size kid -1 -1))
(dist (funcall (flow-data-distance-fn state) size))
(extent (funcall (flow-data-extent-fn state) size)))
+ (incf (flow-data-distance-total state) dist)
+ (incf (flow-data-extent-total state) extent)
(if (< (flow-data-max-distance state) dist)
(setf (flow-data-max-distance state) dist))
(if (< (flow-data-max-extent state) extent)
@@ -122,6 +86,37 @@
(setf (flow-data-kid-sizes state) (reverse (flow-data-kid-sizes state)))
state))
+(defun flow-container-size (layout visible kids width-hint height-hint)
+ (let ((kid-count (length kids))
+ (horz-margin-total (+ (left-margin-of layout) (right-margin-of layout)))
+ (vert-margin-total (+ (top-margin-of layout) (bottom-margin-of layout)))
+ (vertical (find :vertical (style-of layout)))
+ (horizontal (find :horizontal (style-of layout))))
+ (let ((spacing-total (* (spacing-of layout) (1- kid-count)))
+ (state (init-flow-data layout
+ visible
+ kids
+ (if vertical width-hint -1)
+ (if vertical -1 height-hint))))
+ (if (find :normalize (style-of layout))
+ (setf (flow-data-distance-total state) (* (flow-data-max-distance state) kid-count)))
+ (cond
+ (horizontal
+ (gfs:make-size :width (+ (flow-data-distance-total state)
+ horz-margin-total
+ spacing-total)
+ :height (+ (flow-data-max-extent state)
+ vert-margin-total)))
+ (vertical
+ (gfs:make-size :width (+ (flow-data-max-extent state)
+ horz-margin-total)
+ :height (+ (flow-data-distance-total state)
+ vert-margin-total
+ spacing-total)))
+ (t
+ (error 'gfs:toolkit-error
+ :detail (format nil "unrecognized flow layout style: ~a" (style-of layout))))))))
+
(defun wrap-needed-p (state layout kid-size)
(and (>= (flow-data-hint state) 0)
(> (+ (flow-data-next-coord state)
@@ -138,39 +133,35 @@
(defun new-flow-element (state layout kid kid-size)
(let ((pnt (gfs:make-point))
- (vertical (find :vertical (style-of layout)))
- (normal (find :normalize (style-of layout))))
- (cond
- ((and vertical normal)
- (setf (gfs:point-x pnt) (flow-data-wrap-coord state)
- (gfs:point-y pnt) (flow-data-next-coord state))
- (setf (gfs:size-width kid-size) (flow-data-max-extent state)
- (gfs:size-height kid-size) (flow-data-max-distance state)))
- ((and vertical (not normal))
- (setf (gfs:point-x pnt) (flow-data-wrap-coord state)
- (gfs:point-y pnt) (flow-data-next-coord state)))
- ((and (not vertical) normal)
- (setf (gfs:point-x pnt) (flow-data-next-coord state)
- (gfs:point-y pnt) (flow-data-wrap-coord state))
- (setf (gfs:size-width kid-size) (flow-data-max-distance state)
- (gfs:size-height kid-size) (flow-data-max-extent state)))
- ((and (not vertical) (not normal))
- (setf (gfs:point-x pnt) (flow-data-next-coord state)
- (gfs:point-y pnt) (flow-data-wrap-coord state))))
+ (vertical (find :vertical (style-of layout))))
+ (if vertical
+ (setf (gfs:point-x pnt) (flow-data-wrap-coord state)
+ (gfs:point-y pnt) (flow-data-next-coord state))
+ (setf (gfs:point-x pnt) (flow-data-next-coord state)
+ (gfs:point-y pnt) (flow-data-wrap-coord state)))
(incf (flow-data-next-coord state) (+ (funcall (flow-data-distance-fn state) kid-size)
(flow-data-spacing state)))
(cons kid (make-instance 'gfs:rectangle :size kid-size :location pnt))))
(defun flow-container-layout (layout visible kids width-hint height-hint)
(let ((flows nil)
+ (normal (find :normalize (style-of layout)))
+ (vertical (find :vertical (style-of layout)))
(state (init-flow-data layout visible kids width-hint height-hint)))
(loop with wrap = (find :wrap (style-of layout))
for (kid kid-size) in (flow-data-kid-sizes state)
- do (if (and wrap
+ do (cond
+ ((and normal vertical)
+ (setf (gfs:size-width kid-size) (flow-data-max-extent state)
+ (gfs:size-height kid-size) (flow-data-max-distance state)))
+ ((and normal (not vertical))
+ (setf (gfs:size-width kid-size) (flow-data-max-distance state)
+ (gfs:size-height kid-size) (flow-data-max-extent state))))
+ (if (and wrap
(flow-data-current state)
(wrap-needed-p state layout kid-size))
(setf flows (append flows (wrap-flow state layout))))
- (push (new-flow-element state layout kid kid-size) (flow-data-current state)))
+ (push (new-flow-element state layout kid kid-size) (flow-data-current state)))
(if (flow-data-current state)
(setf flows (append flows (wrap-flow state layout))))
flows))
More information about the Graphic-forms-cvs
mailing list