Author: junrue Date: Mon Aug 13 01:09:25 2007 New Revision: 471
Modified: trunk/src/tests/uitoolkit/flow-layout-unit-tests.lisp trunk/src/uitoolkit/widgets/flow-layout.lisp trunk/src/uitoolkit/widgets/layout-generics.lisp trunk/src/uitoolkit/widgets/layout.lisp trunk/src/uitoolkit/widgets/window.lisp Log: fixed longstanding regression in calculation of wrapping extents; fixed flow layout unit tests
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 Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; flow-layout-unit-tests.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -59,7 +59,7 @@ #'make-flow-layout *flow-uniform-kids* '(:horizontal :wrap))
(define-layout-test flow-layout-test4 - -1 25 20 20 + -1 25 40 20 nil '((0 0 20 10) (0 10 20 10) (20 0 20 10)) #'make-flow-layout *flow-uniform-kids* '(:vertical :wrap)) @@ -89,13 +89,13 @@ #'make-flow-layout *flow-uniform-kids* '(:vertical) 4)
(define-layout-test flow-layout-test9 - 45 18 0 0 + 45 18 44 24 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 + 30 25 44 24 nil '((0 0 20 10) (0 14 20 10) (24 0 20 10)) #'make-flow-layout *flow-uniform-kids* '(:vertical :wrap) 4)
Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/flow-layout.lisp (original) +++ trunk/src/uitoolkit/widgets/flow-layout.lisp Mon Aug 13 01:09:25 2007 @@ -34,24 +34,38 @@ (in-package :graphic-forms.uitoolkit.widgets)
;;; -;;; helper functions +;;; This implementation attempts to maximize code re-use by handling both +;;; possible orientations with the same logic. Hence the terminology is a +;;; little confusing. Here is a quick primer: +;;; +;;; primary axis -- the axis parallel to the layout's orientation +;;; +;;; secondary axis -- the axis orthogonal to the layout's orientation +;;; +;;; distance -- offset from one point to the next along the primary axis +;;; +;;; extent -- offset from one point to the next along the secondary axis ;;;
(defstruct flow-data - (hint 0) - (kid-sizes nil) - (distance-total 0) - (max-distance 0) - (extent-total 0) - (max-extent 0) - (next-coord 0) - (wrap-coord 0) - (spacing 0) - (distance-fn nil) - (extent-fn nil) - (limit-margin-fn nil) - (start-margin-fn nil) - (current nil)) + (hint 0) ; the width or height hint passed to the layout manager + (kid-sizes nil) ; list of pairs of child widgets and their sizes + (distance-total 0) ; total (un-wrapped) widget size in primary axis + (max-distance 0) ; maximum widget size in primary axis + (max-extent 0) ; maximum widget size in secondary axis + (last-wrap-max-extent 0) ; maximum widget size in secondary axis for previous wrap + (next-coord 0) ; position in primary axis where next widget goes + (wrap-coord 0) ; position in secondary axis where next widget wraps to + (spacing 0) ; layout's spacing attribute + (distance-fn nil) ; either #'gfs:size-width or #'gfs:size-height + (extent-fn nil) ; opposite of distance-fn + (limit-margin-fn nil) ; either #'bottom-margin-of or #'right-margin-of + (start-margin-fn nil) ; either #'top-margin-of or #'left-margin-of + (current nil)) ; flow data list + +;;; +;;; helper functions +;;;
(defun init-flow-data (layout visible items width-hint height-hint) (let ((state (if (find :vertical (style-of layout)) @@ -78,7 +92,6 @@ (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) @@ -98,12 +111,15 @@ (let ((curr-flow (flow-data-current state))) (setf (flow-data-current state) nil) (setf (flow-data-next-coord state) (funcall (flow-data-start-margin-fn state) layout)) - (incf (flow-data-wrap-coord state) (+ (flow-data-max-extent state) (flow-data-spacing state))) + (incf (flow-data-wrap-coord state) (+ (flow-data-last-wrap-max-extent state) + (flow-data-spacing state))) + (setf (flow-data-last-wrap-max-extent state) 0) (reverse curr-flow)))
(defun new-flow-element (state layout kid kid-size) (let ((pnt (gfs:make-point)) - (vertical (find :vertical (style-of layout)))) + (vertical (find :vertical (style-of layout))) + (extent (funcall (flow-data-extent-fn state) kid-size))) (if vertical (setf (gfs:point-x pnt) (flow-data-wrap-coord state) (gfs:point-y pnt) (flow-data-next-coord state)) @@ -111,6 +127,8 @@ (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))) + (if (> extent (flow-data-last-wrap-max-extent state)) + (setf (flow-data-last-wrap-max-extent state) extent)) (cons kid (gfs:make-rectangle :size kid-size :location pnt))))
;;; @@ -118,36 +136,12 @@ ;;;
(defmethod compute-size ((self flow-layout) (container layout-managed) width-hint height-hint) - (cleanup-disposed-items self) - (let ((kid-count (length (data-of self))) - (horz-margin-total (+ (left-margin-of self) (right-margin-of self))) - (vert-margin-total (+ (top-margin-of self) (bottom-margin-of self))) - (vertical (find :vertical (style-of self))) - (horizontal (find :horizontal (style-of self)))) - (let ((spacing-total (* (spacing-of self) (1- kid-count))) - (state (init-flow-data self - (visible-p container) - (data-of self) - (if vertical width-hint -1) - (if vertical -1 height-hint)))) - (if (find :normalize (style-of self)) - (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 self)))))))) + (let ((data (compute-layout self container width-hint height-hint))) + (gfs:size (layout-bounds data + (list (left-margin-of self) + (top-margin-of self) + (right-margin-of self) + (bottom-margin-of self))))))
(defmethod compute-layout ((self flow-layout) (container layout-managed) width-hint height-hint) (cleanup-disposed-items self)
Modified: trunk/src/uitoolkit/widgets/layout-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/layout-generics.lisp Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; layout-generics.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without
Modified: trunk/src/uitoolkit/widgets/layout.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/layout.lisp (original) +++ trunk/src/uitoolkit/widgets/layout.lisp Mon Aug 13 01:09:25 2007 @@ -1,7 +1,7 @@ ;;;; ;;;; layout.lisp ;;;; -;;;; Copyright (C) 2006, Jack D. Unrue +;;;; Copyright (C) 2006-2007, Jack D. Unrue ;;;; All rights reserved. ;;;; ;;;; Redistribution and use in source and binary forms, with or without @@ -127,6 +127,22 @@ (unless (gfs:null-handle-p hdwp) (gfs::end-defer-window-pos hdwp))))
+(defun layout-bounds (children margins) + (multiple-value-bind (min-x min-y max-x max-y) + (loop for entry in children + for location = (gfs:location (cdr entry)) + for size = (gfs:size (cdr entry)) + minimizing (gfs:point-x location) into min-x + minimizing (gfs:point-y location) into min-y + maximizing (+ (gfs:point-x location) (gfs:size-width size)) into max-x + maximizing (+ (gfs:point-y location) (gfs:size-height size)) into max-y + finally (return (values min-x min-y max-x max-y))) + (let ((location (gfs:make-point :x (- min-x (first margins)) + :y (- min-y (second margins)))) + (size (gfs:make-size :width (+ max-x (third margins)) + :height (+ max-y (fourth margins))))) + (gfs:make-rectangle :location location :size size)))) + ;;; ;;; methods ;;; @@ -162,6 +178,4 @@ (defmethod perform ((self layout-manager) (container layout-managed) width-hint height-hint) (if (layout-p container) (arrange-hwnds (compute-layout self container width-hint height-hint) - (lambda (item) - (declare (ignore item)) - +window-pos-flags+)))) + (constantly +window-pos-flags+))))
Modified: trunk/src/uitoolkit/widgets/window.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/window.lisp (original) +++ trunk/src/uitoolkit/widgets/window.lisp Mon Aug 13 01:09:25 2007 @@ -181,7 +181,7 @@ (defmethod gfg:background-color ((self window)) (let ((hwnd (gfs:handle self)) (color nil)) - (if (string= (get-window-class-name self) *toplevel-erasebkgnd-window-classname*) + (if (string= (get-window-class-name hwnd) *toplevel-erasebkgnd-window-classname*) (setf color (gfg:rgb->color (gfs::get-sys-color gfs::+color-appworkspace+))) (setf color (gfg:rgb->color (gfs::get-class-long hwnd gfs::+gclp-hbrbackground+)))) color))