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