steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rename scroll word to set-scroll-position and make it public

db4
Slava Pestov 2009-04-05 23:18:25 -05:00
parent 687e9f90fe
commit 8bf5fde791
4 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/ui/gadgets/scrollers/scrollers-docs.factor
View File

@ -11,11 +11,11 @@ HELP: find-scroller
{ $values { "gadget" gadget } { "scroller/f" { $maybe 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 } "." } ; { $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" } } { $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." } ; { $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: <scroller> HELP: <scroller>
{ $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } } { $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } }
@ -48,8 +48,8 @@ ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets"
{ $subsection scroller } { $subsection scroller }
{ $subsection <scroller> } { $subsection <scroller> }
"Getting and setting the scroll position:" "Getting and setting the scroll position:"
{ $subsection scroller-value } { $subsection scroll-position }
{ $subsection scroll } { $subsection set-scroll-position }
"Writing scrolling-aware gadgets:" "Writing scrolling-aware gadgets:"
{ $subsection scroll>bottom } { $subsection scroll>bottom }
{ $subsection scroll>top } { $subsection scroll>top }

2
basis/ui/gadgets/scrollers/scrollers-tests.factor
View File

@ -74,7 +74,7 @@ dup layout
drop drop
"g2" get scroll>gadget "g2" get scroll>gadget
"s" get layout "s" get layout
"s" get scroller-value "s" get scroll-position
] map [ { 0 0 } = ] all? ] map [ { 0 0 } = ] all?
] unit-test ] unit-test

25
basis/ui/gadgets/scrollers/scrollers.factor
View File

@ -29,6 +29,13 @@ M: gadget viewport-column-header drop f ;
: scroll-down-line ( scroller -- ) y>> 1 swap slide-by-line ; : 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 ;
<PRIVATE <PRIVATE
: do-mouse-scroll ( scroller -- ) : do-mouse-scroll ( scroller -- )
@ -46,21 +53,14 @@ scroller H{
M: viewport pref-dim* gadget-child pref-viewport-dim ; M: viewport pref-dim* gadget-child pref-viewport-dim ;
: scroll ( value scroller -- )
[
viewport>> [ dim>> { 0 0 } ] [ gadget-child pref-dim ] bi
4array flip
] keep
2dup control-value = [ 2drop ] [ set-control-value ] if ;
: (scroll>rect) ( rect scroller -- ) : (scroll>rect) ( rect scroller -- )
{ {
[ scroller-value vneg offset-rect ] [ scroll-position vneg offset-rect ]
[ viewport>> dim>> rect-min ] [ viewport>> dim>> rect-min ]
[ viewport>> loc>> offset-rect ] [ viewport>> loc>> offset-rect ]
[ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ] [ viewport>> [ v- { 0 0 } vmin ] [ v- { 0 0 } vmax ] with-rect-extents v+ ]
[ scroller-value v+ ] [ scroll-position v+ ]
[ scroll ] [ set-scroll-position ]
} cleave ; } cleave ;
: relative-scroll-rect ( rect gadget scroller -- newrect ) : relative-scroll-rect ( rect gadget scroller -- newrect )
@ -72,7 +72,7 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
2&& ; 2&& ;
: (update-scroller) ( scroller -- ) : (update-scroller) ( scroller -- )
[ scroller-value ] keep scroll ; [ scroll-position ] keep set-scroll-position ;
: (scroll>gadget) ( gadget scroller -- ) : (scroll>gadget) ( gadget scroller -- )
2dup swap child? [ 2dup swap child? [
@ -82,7 +82,8 @@ M: viewport pref-dim* gadget-child pref-viewport-dim ;
] [ f >>follows (update-scroller) drop ] if ; ] [ f >>follows (update-scroller) drop ] if ;
: (scroll>bottom) ( scroller -- ) : (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 -- ) GENERIC: update-scroller ( scroller follows -- )

4
basis/ui/gadgets/viewports/viewports.factor
View File

@ -23,7 +23,7 @@ M: viewport layout*
M: viewport focusable-child* M: viewport focusable-child*
gadget-child ; gadget-child ;
: scroller-value ( scroller -- loc ) : scroll-position ( scroller -- loc )
model>> range-value [ >integer ] map ; model>> range-value [ >integer ] map ;
M: viewport model-changed M: viewport model-changed
@ -31,7 +31,7 @@ M: viewport model-changed
[ relayout-1 ] [ relayout-1 ]
[ [
[ gadget-child ] [ gadget-child ]
[ scroller-value vneg ] [ scroll-position vneg ]
[ constraint>> ] [ constraint>> ]
tri v* >>loc drop tri v* >>loc drop
] bi ; ] bi ;