Author: junrue Date: Wed Oct 11 21:41:12 2006 New Revision: 301

Modified: trunk/src/packages.lisp trunk/src/tests/uitoolkit/scroll-grid-panel.lisp trunk/src/tests/uitoolkit/scroll-text-panel.lisp trunk/src/tests/uitoolkit/widget-tester.lisp trunk/src/uitoolkit/widgets/scrollbar.lisp trunk/src/uitoolkit/widgets/scrolling-event-dispatcher.lisp trunk/src/uitoolkit/widgets/slider.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp Log: simplified concept of scrollbar/slider limits to just be a zero-based maximum position

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Wed Oct 11 21:41:12 2006 @@ -477,7 +477,7 @@ #:obtain-horizontal-scrollbar #:obtain-primary-display #:obtain-vertical-scrollbar - #:outer-limits + #:outer-limit #:owner #:pack #:page-increment

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:41:12 2006 @@ -62,12 +62,10 @@ (panel (gfw::obtain-top-child window)) (panel-size (gfw:size panel)) (scrollbar (gfw:obtain-horizontal-scrollbar window))) - (setf (gfw:outer-limits scrollbar) - (gfs:make-span :end (gfs:size-width panel-size))) + (setf (gfw:outer-limit scrollbar) (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 panel-size))) + (setf (gfw:outer-limit scrollbar) (gfs:size-height panel-size)) (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))

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:41:12 2006 @@ -85,12 +85,10 @@ (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 panel-size))) + (setf (gfw:outer-limit scrollbar) (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 panel-size))) + (setf (gfw:outer-limit scrollbar) (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/tests/uitoolkit/widget-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/widget-tester.lisp (original) +++ trunk/src/tests/uitoolkit/widget-tester.lisp Wed Oct 11 21:41:12 2006 @@ -231,7 +231,7 @@ (setf (gfw:text label-1) (thumb->string slider)))) (sl-1 (make-instance 'gfw:slider :parent panel-1 :callback sl-1-cb - :outer-limits (gfs:make-span :start 0 :end 10))) + :outer-limit 10)) (label-3 (make-instance 'gfw:label :parent panel-1 :text "0 ")) (sb-1-cb (lambda (disp scrollbar axis detail) @@ -239,7 +239,7 @@ (setf (gfw:text label-3) (thumb->string scrollbar)))) (sb-1 (make-instance 'gfw:scrollbar :parent panel-1 :callback sb-1-cb - :outer-limits (gfs:make-span :start 0 :end 10))) + :outer-limit 10)) (panel-2 (make-instance 'gfw:panel :dispatcher panel-disp :parent outer-panel :layout layout3)) @@ -251,7 +251,7 @@ (sl-2 (make-instance 'gfw:slider :parent panel-2 :callback sl-2-cb :style '(:vertical :auto-ticks :ticks-after :ticks-before) - :outer-limits (gfs:make-span :start 0 :end 10))) + :outer-limit 10)) (label-4 (make-instance 'gfw:label :parent panel-2 :text "0 ")) (sb-2-cb (lambda (disp scrollbar axis detail) @@ -260,7 +260,7 @@ (sb-2 (make-instance 'gfw:scrollbar :parent panel-2 :callback sb-2-cb :style '(:vertical) - :outer-limits (gfs:make-span :start 0 :end 10)))) + :outer-limit 10))) (declare (ignore sl-1 sl-2 sb-1 sb-2)) (gfw:pack panel-1) (gfw:pack panel-2)

Modified: trunk/src/uitoolkit/widgets/scrollbar.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/scrollbar.lisp (original) +++ trunk/src/uitoolkit/widgets/scrollbar.lisp Wed Oct 11 21:41:12 2006 @@ -54,13 +54,13 @@ (let ((hwnd (gfs:handle scrollbar))) (cffi:with-foreign-object (info-ptr 'gfs::scrollinfo) (gfs::zero-mem info-ptr gfs::scrollinfo) - (cffi:with-foreign-slots ((gfs::cbsize gfs::fmask gfs::pagesize gfs::pos - gfs::minpos gfs::maxpos gfs::trackpos) + (cffi:with-foreign-slots ((gfs::cbsize gfs::fmask gfs::pagesize + gfs::pos gfs::maxpos gfs::trackpos) info-ptr gfs::scrollinfo) (setf gfs::cbsize (cffi:foreign-type-size 'gfs::scrollinfo) gfs::fmask gfs::+sif-all+) (gfs::get-scroll-info hwnd type info-ptr) - (list (gfs:make-span :start gfs::minpos :end gfs::maxpos) + (list gfs::maxpos gfs::pagesize gfs::pos gfs::trackpos))))) @@ -83,10 +83,10 @@ (gfs::set-scroll-info hwnd type info-ptr 1))) amount)

-(defun sb-set-thumb-limits (scrollbar type span) - (when (or (< (gfs:span-start span) 0) (< (gfs:span-end span) 0)) +(defun sb-set-thumb-limit (scrollbar type limit) + (when (< limit 0) (warn 'gfs:toolkit-warning :detail "negative scrollbar limit") - (return-from sb-set-thumb-limits nil)) + (return-from sb-set-thumb-limit nil)) (if (gfs:disposed-p scrollbar) (error 'gfs:disposed-error)) (let ((hwnd (gfs:handle scrollbar))) @@ -96,17 +96,17 @@ info-ptr gfs::scrollinfo) (setf gfs::cbsize (cffi:foreign-type-size 'gfs::scrollinfo) gfs::fmask gfs::+sif-range+ - gfs::minpos (gfs:span-start span) - gfs::maxpos (gfs:span-end span))) + gfs::minpos 0 + gfs::maxpos limit)) (gfs::set-scroll-info hwnd type info-ptr 1))) - span) + limit)

(defun sb-set-thumb-position (scrollbar type position) (when (< position 0) (warn 'gfs:toolkit-warning :detail "negative scrollbar position") (return-from sb-set-thumb-position 0)) ;; - ;; TODO: should check position against limits, but doing that + ;; TODO: should check position against limit, but doing that ;; is not cheap, whereas the application will be calling this ;; method frequently to maintain the scrollbar's position; ;; more thought needed. @@ -139,18 +139,18 @@ (error 'gfs:toolkit-error :detail "invalid standard scrollbar orientation"))) (setf (slot-value self 'dispatcher) nil)) ; standard scrollbars don't use dispatchers

-(defmethod outer-limits ((self standard-scrollbar)) +(defmethod outer-limit ((self standard-scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self (orientation-of self)) (declare (ignore pagesize pos trackpos)) - limits)) + limit))

-(defmethod (setf outer-limits) (span (self standard-scrollbar)) +(defmethod (setf outer-limit) (limit (self standard-scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (sb-set-thumb-limits self (orientation-of self) span)) + (sb-set-thumb-limit self (orientation-of self) limit))

(defmethod owner ((self standard-scrollbar)) (parent self)) @@ -158,9 +158,9 @@ (defmethod page-increment ((self standard-scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self (orientation-of self)) - (declare (ignore limits pos trackpos)) + (declare (ignore limit pos trackpos)) pagesize))

(defmethod (setf page-increment) (amount (self standard-scrollbar)) @@ -206,9 +206,9 @@ (defmethod thumb-position ((self standard-scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self (orientation-of self)) - (declare (ignore limits pagesize trackpos)) + (declare (ignore limit pagesize trackpos)) pos))

(defmethod (setf thumb-position) (position (self standard-scrollbar)) @@ -219,9 +219,9 @@ (defmethod thumb-track-position ((self standard-scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self (orientation-of self)) - (declare (ignore limits pagesize pos)) + (declare (ignore limit pagesize pos)) trackpos))

;;; @@ -238,25 +238,25 @@ (:vertical (setf std-flags (sb-vertical-flags std-flags))))) (values std-flags 0)))

-(defmethod initialize-instance :after ((self scrollbar) &key outer-limits page-increment parent &allow-other-keys) +(defmethod initialize-instance :after ((self scrollbar) &key outer-limit page-increment parent &allow-other-keys) (create-control self parent "" gfs::+icc-standard-classes+) - (if outer-limits - (setf (outer-limits self) outer-limits)) + (if outer-limit + (setf (outer-limit self) outer-limit)) (if page-increment (setf (page-increment self) page-increment)))

-(defmethod outer-limits ((self scrollbar)) +(defmethod outer-limit ((self scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self gfs::+sb-ctl+) (declare (ignore pagesize pos trackpos)) - limits)) + limit))

-(defmethod (setf outer-limits) (span (self scrollbar)) +(defmethod (setf outer-limit) (span (self scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (sb-set-thumb-limits self gfs::+sb-ctl+ span)) + (sb-set-thumb-limit self gfs::+sb-ctl+ span))

(defmethod owner ((self scrollbar)) (parent self)) @@ -264,9 +264,9 @@ (defmethod page-increment ((self scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self gfs::+sb-ctl+) - (declare (ignore limits pos trackpos)) + (declare (ignore limit pos trackpos)) pagesize))

(defmethod (setf page-increment) (amount (self scrollbar)) @@ -290,9 +290,9 @@ (defmethod thumb-position ((self scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self gfs::+sb-ctl+) - (declare (ignore limits pagesize trackpos)) + (declare (ignore limit pagesize trackpos)) pos))

(defmethod (setf thumb-position) (position (self scrollbar)) @@ -303,7 +303,7 @@ (defmethod thumb-track-position ((self scrollbar)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (destructuring-bind (limits pagesize pos trackpos) + (destructuring-bind (limit pagesize pos trackpos) (sb-get-info self gfs::+sb-ctl+) - (declare (ignore limits pagesize pos)) + (declare (ignore limit pagesize pos)) trackpos))

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:41:12 2006 @@ -43,11 +43,11 @@

(defun update-scrollbar (scrollbar step-size detail) (let ((page-size (page-increment scrollbar)) - (limits (outer-limits scrollbar)) + (limit (outer-limit scrollbar)) (curr-pos (thumb-position scrollbar))) (let ((new-pos (case detail - (:start (gfs:span-start limits)) - (:end (gfs:span-end limits)) + (:start 0) + (:end limit) (:step-back (- curr-pos step-size)) (:step-forward (+ curr-pos step-size)) (:page-back (- curr-pos page-size)) @@ -55,9 +55,7 @@ (:thumb-position curr-pos) (:thumb-track (thumb-track-position scrollbar)) (otherwise curr-pos)))) - (setf new-pos (clamp-scroll-pos new-pos - (- (gfs:span-end limits) (gfs:span-start limits)) - page-size)) + (setf new-pos (clamp-scroll-pos new-pos limit page-size)) (setf (thumb-position scrollbar) new-pos) new-pos)))

@@ -111,9 +109,9 @@ (saved-x (gfs:point-x origin)) (saved-y (gfs:point-y origin)) (delta-x (- (+ (gfs:size-width viewport-size) saved-x) - (gfs:span-end (outer-limits hscrollbar)))) + (outer-limit hscrollbar))) (delta-y (- (+ (gfs:size-height viewport-size) saved-y) - (gfs:span-end (outer-limits vscrollbar))))) + (outer-limit vscrollbar)))) (if (and (> delta-x 0) (> saved-x 0)) (setf (gfs:point-x origin) (max 0 (- saved-x delta-x))) (setf delta-x 0))

Modified: trunk/src/uitoolkit/widgets/slider.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/slider.lisp (original) +++ trunk/src/uitoolkit/widgets/slider.lisp Wed Oct 11 21:41:12 2006 @@ -93,12 +93,12 @@ (setf std-flags (sl-ticks-both-flags std-flags))) (values std-flags 0)))

-(defmethod initialize-instance :after ((self slider) &key outer-limits parent &allow-other-keys) +(defmethod initialize-instance :after ((self slider) &key outer-limit parent &allow-other-keys) (create-control self parent "" gfs::+icc-win95-classes+) (setf (gfg:background-color self) (gfg:rgb->color (gfs::get-sys-color gfs::+color-btnface+))) - (if outer-limits - (setf (outer-limits self) outer-limits))) + (if outer-limit + (setf (outer-limit self) outer-limit)))

(defmethod inner-limits ((self slider)) (if (gfs:disposed-p self) @@ -124,27 +124,19 @@ (gfs::make-lparam end start)))) limits)

-(defmethod outer-limits ((self slider)) +(defmethod outer-limit ((self slider)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) (let ((hwnd (gfs:handle self))) - (gfs:make-span :start (gfs::send-message hwnd gfs::+tbm-getrangemin+ 0 0) - :end (gfs::send-message hwnd gfs::+tbm-getrangemax+ 0 0)))) + (gfs::send-message hwnd gfs::+tbm-getrangemax+ 0 0)))

-(defmethod (setf outer-limits) (limits (self slider)) +(defmethod (setf outer-limit) (limit (self slider)) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) - (let ((start (gfs:span-start limits)) - (end (gfs:span-end limits))) - (if (or (< start 0) (< end 0)) - (error 'gfs:toolkit-error :detail "negative slider thumb limit")) - (gfs::send-message (gfs:handle self) - gfs::+tbm-setrange+ - 1 - (if (<= start end) - (gfs::make-lparam start end) - (gfs::make-lparam end start)))) - limits) + (if (< limit 0) + (error 'gfs:toolkit-error :detail "negative slider thumb limit")) + (gfs::send-message (gfs:handle self) gfs::+tbm-setrange+ 1 (gfs::make-lparam 0 limit)) + limit)

(defmethod page-increment ((self slider)) (if (gfs:disposed-p self) @@ -163,13 +155,12 @@

(defmethod preferred-size ((self slider) width-hint height-hint) (let* ((b-width (* (border-width self) 2)) - (limits (outer-limits self)) - (numticks (- (gfs:span-end limits) (gfs:span-start limits))) + (limit (outer-limit self)) (size (gfs:make-size))) (if (find :vertical (style-of self)) (setf (gfs:size-width size) (floor (* (vertical-scrollbar-width) 5) 2) - (gfs:size-height size) (+ (* 10 numticks) b-width)) - (setf (gfs:size-width size) (+ (* 10 numticks) b-width) + (gfs:size-height size) (+ (* 10 limit) b-width)) + (setf (gfs:size-width size) (+ (* 10 limit) b-width) (gfs:size-height size) (floor (* (horizontal-scrollbar-height) 5) 2))) (if (>= width-hint 0) (setf (gfs:size-width size) width-hint))

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Wed Oct 11 21:41:12 2006 @@ -294,11 +294,11 @@ (defgeneric obtain-vertical-scrollbar (self) (:documentation "Returns a scrollbar object if self has been configured to have one horizontally."))

-(defgeneric outer-limits (self) - (:documentation "Returns the lowest and highest possible positions of self's indicator.")) +(defgeneric outer-limit (self) + (:documentation "Returns the zero-based highest possible position of self's indicator."))

-(defgeneric (setf outer-limits) (span self) - (:documentation "Sets the lowest and highest possible positions of self's indicator.")) +(defgeneric (setf outer-limit) (limit self) + (:documentation "Sets the zero-based highest possible position of self's indicator."))

(defgeneric owner (self) (:documentation "Returns self's owner (which is not necessarily the same as parent)."))