Rename scroll word to set-scroll-position and make it public
parent
687e9f90fe
commit
8bf5fde791
|
@ -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: <scroller>
|
||||
{ $values { "gadget" gadget } { "scroller" "a new " { $link scroller } } }
|
||||
|
@ -48,8 +48,8 @@ ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets"
|
|||
{ $subsection scroller }
|
||||
{ $subsection <scroller> }
|
||||
"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 }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: do-mouse-scroll ( scroller -- )
|
||||
|
@ -46,21 +53,14 @@ scroller H{
|
|||
|
||||
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 -- )
|
||||
{
|
||||
[ 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 -- )
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue