Author: junrue Date: Wed Oct 11 21:20:01 2006 New Revision: 300
Modified: trunk/src/tests/uitoolkit/scroll-grid-panel.lisp trunk/src/tests/uitoolkit/scroll-tester.lisp trunk/src/tests/uitoolkit/scroll-text-panel.lisp trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Log: fixed scrolling regressions
Modified: trunk/src/tests/uitoolkit/scroll-grid-panel.lisp ============================================================================== --- trunk/src/tests/uitoolkit/scroll-grid-panel.lisp (original) +++ trunk/src/tests/uitoolkit/scroll-grid-panel.lisp Wed Oct 11 21:20:01 2006 @@ -68,8 +68,8 @@ (setf scrollbar (gfw:obtain-vertical-scrollbar window)) (setf (gfw:outer-limits scrollbar) (gfs:make-span :end (gfs:size-height panel-size))) - (setf (gfw:step-increments disp) (gfs:make-size :width 1 :height 1)) (setf (gfw:thumb-position scrollbar) 0) + (setf (gfw:step-increments disp) (gfs:make-size :width 1 :height 1)) (setf (slot-value disp 'gfw::viewport-origin) (gfs:make-point)) (gfw:event-resize disp window (gfw:size window) :restored)))
Modified: trunk/src/tests/uitoolkit/scroll-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/scroll-tester.lisp (original) +++ trunk/src/tests/uitoolkit/scroll-tester.lisp Wed Oct 11 21:20:01 2006 @@ -81,9 +81,9 @@ (:item "&Text" :callback select-text))))))) (setf (gfw:menu-bar *scroll-tester-win*) menubar (gfw:top-child-of layout) grid-panel)) - (set-grid-scroll-params *scroll-tester-win*) (setf (gfw:text *scroll-tester-win*) "Scroll Tester" (gfw:size *scroll-tester-win*) (gfs:make-size :width 300 :height 275)) + (set-grid-scroll-params *scroll-tester-win*) (gfw:show *scroll-tester-win* t)))
(defun scroll-tester ()
Modified: trunk/src/tests/uitoolkit/scroll-text-panel.lisp ============================================================================== --- trunk/src/tests/uitoolkit/scroll-text-panel.lisp (original) +++ trunk/src/tests/uitoolkit/scroll-text-panel.lisp Wed Oct 11 21:20:01 2006 @@ -79,19 +79,18 @@ panel))
(defun set-text-scroll-params (window) - (let ((disp (gfw:dispatcher window)) - (panel (gfw::obtain-top-child window))) + (let* ((disp (gfw:dispatcher window)) + (panel (gfw::obtain-top-child window)) + (panel-size (gfw:size panel))) (gfw:with-graphics-context (gc panel) (let ((metrics (gfg:metrics gc (font-of (gfw:dispatcher panel)))) (scrollbar (gfw:obtain-horizontal-scrollbar window))) (setf (gfw:outer-limits scrollbar) - (gfs:make-span :end (* (gfs:size-width *text-model-size*) - (gfg:average-char-width metrics)))) + (gfs:make-span :end (gfs:size-width panel-size))) (setf (gfw:thumb-position scrollbar) 0) (setf scrollbar (gfw:obtain-vertical-scrollbar window)) (setf (gfw:outer-limits scrollbar) - (gfs:make-span :end (* (gfs:size-height *text-model-size*) - (gfg:height metrics)))) + (gfs:make-span :end (gfs:size-height panel-size))) (setf (gfw:thumb-position scrollbar) 0) (setf (gfw:step-increments disp) (gfs:make-size :width (gfg:average-char-width metrics) :height (gfg:height metrics)))))
Modified: trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp (original) +++ trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp Wed Oct 11 21:20:01 2006 @@ -38,7 +38,7 @@ ;;;
(defun clamp-scroll-pos (pos total-steps page-size) - (setf pos (min pos (1+ (- total-steps page-size)))) + (setf pos (min pos (- total-steps page-size))) (max pos 0))
(defun update-scrollbar (scrollbar step-size detail) @@ -61,67 +61,64 @@ (setf (thumb-position scrollbar) new-pos) new-pos)))
-(defun update-scrolling-state (window &optional axis detail) +(defun update-scrolling-state (window axis &optional detail) (unless axis (return-from update-scrolling-state nil)) (unless detail (setf detail :thumb-position)) - (let ((disp (dispatcher window))) + (let ((disp (dispatcher window)) + (hscrollbar (obtain-horizontal-scrollbar window)) + (vscrollbar (obtain-vertical-scrollbar window))) (let ((child (obtain-top-child window)) + (origin (slot-value disp 'viewport-origin)) (h-step (gfs:size-width (step-increments disp))) (v-step (gfs:size-height (step-increments disp))) (new-hpos 0) (new-vpos 0)) (cond - ((or (eql axis :horizontal) (eql axis :both)) - (let ((scrollbar (obtain-horizontal-scrollbar window))) - (setf new-hpos (update-scrollbar scrollbar h-step detail)))) - ((or (eql axis :vertical) (eql axis :both)) - (let ((scrollbar (obtain-vertical-scrollbar window))) - (setf new-vpos (update-scrollbar scrollbar v-step detail))))) - (let* ((origin (slot-value disp 'viewport-origin)) - (delta-x (* (floor (- (gfs:point-x origin) new-hpos) h-step) h-step)) - (delta-y (* (floor (- (gfs:point-y origin) new-vpos) v-step) v-step))) - (decf (gfs:point-x origin) delta-x) - (decf (gfs:point-y origin) delta-y) - (scroll child delta-x delta-y nil 0)))) + ((eql axis :horizontal) + (setf new-hpos (update-scrollbar hscrollbar h-step detail)) + (setf new-vpos (thumb-position vscrollbar))) + ((eql axis :vertical) + (setf new-hpos (thumb-position hscrollbar)) + (setf new-vpos (update-scrollbar vscrollbar v-step detail))) + ((eql axis :both) + (setf new-hpos (update-scrollbar hscrollbar h-step detail)) + (setf new-vpos (update-scrollbar vscrollbar v-step detail)))) + (let ((new-x (* (floor new-hpos h-step) h-step)) + (new-y (* (floor new-vpos v-step) v-step))) + (scroll child (- (gfs:point-x origin) new-x) (- (gfs:point-y origin) new-y) nil 0) + (setf (gfs:point-x origin) new-x) + (setf (gfs:point-y origin) new-y)))) detail)
(defun validate-step-values (amounts) (if (or (<= (gfs:size-width amounts) 0) (<= (gfs:size-height amounts) 0)) (error 'gfs:toolkit-error :detail "invalid step increment")))
-(defun update-scrollbar-page-size (scrollbar viewport-dim top-dim) - (if scrollbar - (setf (page-increment scrollbar) (1+ (min viewport-dim top-dim)))) - scrollbar) - (defun update-scrollbar-page-sizes (window) - (let ((viewport-size (client-size window)) - (top (obtain-top-child window))) - (let ((top-size (if top (size top) viewport-size))) - (update-scrollbar-page-size (obtain-vertical-scrollbar window) - (gfs:size-height viewport-size) - (gfs:size-height top-size)) - (setf viewport-size (client-size window)) - (update-scrollbar-page-size (obtain-horizontal-scrollbar window) - (gfs:size-width viewport-size) - (gfs:size-width top-size))))) + (setf (page-increment (obtain-vertical-scrollbar window)) + (gfs:size-height (client-size window))) + (setf (page-increment (obtain-horizontal-scrollbar window)) + (gfs:size-width (client-size window)))) ; recalculate client size on purpose
(defun update-viewport-origin-for-resize (window) (let* ((top (obtain-top-child window)) (viewport-size (client-size window)) - (top-size (if top (size top) viewport-size)) + (hscrollbar (obtain-horizontal-scrollbar window)) + (vscrollbar (obtain-vertical-scrollbar window)) (origin (slot-value (dispatcher window) 'viewport-origin)) (saved-x (gfs:point-x origin)) (saved-y (gfs:point-y origin)) - (delta-x (- (+ (gfs:size-width viewport-size) (gfs:point-x origin)) (gfs:size-width top-size))) - (delta-y (- (+ (gfs:size-height viewport-size) (gfs:point-y origin)) (gfs:size-height top-size)))) - (if (and (> delta-x 0) (> (gfs:point-x origin) 0)) - (setf (gfs:point-x origin) (max 0 (- (gfs:point-x origin) delta-x))) + (delta-x (- (+ (gfs:size-width viewport-size) saved-x) + (gfs:span-end (outer-limits hscrollbar)))) + (delta-y (- (+ (gfs:size-height viewport-size) saved-y) + (gfs:span-end (outer-limits vscrollbar))))) + (if (and (> delta-x 0) (> saved-x 0)) + (setf (gfs:point-x origin) (max 0 (- saved-x delta-x))) (setf delta-x 0)) - (if (and (> delta-y 0) (> (gfs:point-y origin) 0)) - (setf (gfs:point-y origin) (max 0 (- (gfs:point-y origin) delta-y))) + (if (and (> delta-y 0) (> saved-y 0)) + (setf (gfs:point-y origin) (max 0 (- saved-y delta-y))) (setf delta-y 0)) (if (or (and (zerop (gfs:point-x origin)) (/= saved-x 0)) (and (zerop (gfs:point-y origin)) (/= saved-y 0))) @@ -137,13 +134,21 @@
(defmethod event-pre-resize ((disp scrolling-event-dispatcher) (window window) rect type) (declare (ignore type)) - (let ((h-step (gfs:size-width (step-increments disp))) - (v-step (gfs:size-height (step-increments disp))) - (size (gfs:size rect))) + (let* ((h-step (gfs:size-width (step-increments disp))) + (v-step (gfs:size-height (step-increments disp))) + (outer-size (gfw:size window)) + (client-size (gfw:client-size window)) + (width-diff (- (gfs:size-width outer-size) (gfs:size-width client-size))) + (height-diff (- (gfs:size-height outer-size) (gfs:size-height client-size))) + (size (gfs:size rect))) (if (/= h-step 1) - (setf (gfs:size-width size) (* (floor (gfs:size-width size) h-step) h-step))) + (setf (gfs:size-width size) + (+ (* (floor (- (gfs:size-width size) width-diff) h-step) h-step) + width-diff))) (if (/= v-step 1) - (setf (gfs:size-height size) (* (floor (gfs:size-height size) v-step) v-step))) + (setf (gfs:size-height size) + (+ (* (floor (- (gfs:size-height size) height-diff) v-step) v-step) + height-diff))) (setf (gfs:size rect) size)))
(defmethod event-resize ((disp scrolling-event-dispatcher) (window window) size type)