From 8bf5fde791b992a73761614e6024982a804317df Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Apr 2009 23:18:25 -0500 Subject: [PATCH] Rename scroll word to set-scroll-position and make it public --- .../gadgets/scrollers/scrollers-docs.factor | 8 +++--- .../gadgets/scrollers/scrollers-tests.factor | 2 +- basis/ui/gadgets/scrollers/scrollers.factor | 25 ++++++++++--------- basis/ui/gadgets/viewports/viewports.factor | 4 +-- 4 files changed, 20 insertions(+), 19 deletions(-) diff --git a/basis/ui/gadgets/scrollers/scrollers-docs.factor b/basis/ui/gadgets/scrollers/scrollers-docs.factor index 8e0131ec31..92831bea00 100644 --- a/basis/ui/gadgets/scrollers/scrollers-docs.factor +++ b/basis/ui/gadgets/scrollers/scrollers-docs.factor @@ -11,11 +11,11 @@ HELP: find-scroller { $values { "gadget" gadget } { "scroller/f" { $maybe scroller } } } { $description "Finds the first parent of " { $snippet "gadget" } " which is a " { $link scroller } ". Outputs " { $link f } " if the gadget is not contained in a " { $link scroller } "." } ; -HELP: scroller-value +HELP: scroll-position { $values { "scroller" scroller } { "loc" "a pair of integers" } } { $description "Outputs the offset of the top-left corner of the scroller's " { $link viewport } "'s child." } ; -{ scroller-value scroll scroll>bottom scroll>top scroll>rect } related-words +{ scroll-position scroll scroll>bottom scroll>top scroll>rect } related-words HELP: { $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } } @@ -48,8 +48,8 @@ ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets" { $subsection scroller } { $subsection } "Getting and setting the scroll position:" -{ $subsection scroller-value } -{ $subsection scroll } +{ $subsection scroll-position } +{ $subsection set-scroll-position } "Writing scrolling-aware gadgets:" { $subsection scroll>bottom } { $subsection scroll>top } diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor index d4cdc95daf..cf63d616be 100644 --- a/basis/ui/gadgets/scrollers/scrollers-tests.factor +++ b/basis/ui/gadgets/scrollers/scrollers-tests.factor @@ -74,7 +74,7 @@ dup layout drop "g2" get scroll>gadget "s" get layout - "s" get scroller-value + "s" get scroll-position ] map [ { 0 0 } = ] all? ] unit-test diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor index a526cc618b..0852a6fe5d 100644 --- a/basis/ui/gadgets/scrollers/scrollers.factor +++ b/basis/ui/gadgets/scrollers/scrollers.factor @@ -29,6 +29,13 @@ M: gadget viewport-column-header drop f ; : scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ; +: set-scroll-position ( value scroller -- ) + [ + viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi + 4array flip + ] keep + 2dup control-value = [ 2drop ] [ set-control-value ] if ; + > [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi - 4array flip - ] keep - 2dup control-value = [ 2drop ] [ set-control-value ] if ; - : (scroll>rect) ( rect scroller -- ) { - [ scroller-value vneg offset-rect ] + [ scroll-position vneg offset-rect ] [ viewport>> dim>> rect-min ] [ viewport>> loc>> offset-rect ] [ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ] - [ scroller-value v+ ] - [ scroll ] + [ scroll-position v+ ] + [ set-scroll-position ] } cleave ; : relative-scroll-rect ( rect gadget scroller -- newrect ) @@ -72,7 +72,7 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ; 2&& ; : (update-scroller) ( scroller -- ) - [ scroller-value ] keep scroll ; + [ scroll-position ] keep set-scroll-position ; : (scroll>gadget) ( gadget scroller -- ) 2dup swap child? [ @@ -82,7 +82,8 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ; ] [ f >>follows (update-scroller) drop ] if ; : (scroll>bottom) ( scroller -- ) - [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep scroll ; + [ viewport>> gadget-child pref-dim { 0 1 } v* ] keep + set-scroll-position ; GENERIC: update-scroller ( scroller follows -- ) diff --git a/basis/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor index c14c7f01fb..b154ef2322 100644 --- a/basis/ui/gadgets/viewports/viewports.factor +++ b/basis/ui/gadgets/viewports/viewports.factor @@ -23,7 +23,7 @@ M: viewport layout* M: viewport focusable-child* gadget-child ; -: scroller-value ( scroller -- loc ) +: scroll-position ( scroller -- loc ) model>> range-value [ >integer ] map ; M: viewport model-changed @@ -31,7 +31,7 @@ M: viewport model-changed [ relayout-1 ] [ [ gadget-child ] - [ scroller-value vneg ] + [ scroll-position vneg ] [ constraint>> ] tri v* >>loc drop ] bi ;