diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 40e8d2dda4..3874e3ffdc 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -6,7 +6,6 @@ + ui: - fix up the min thumb size hack -- scroll bar: more intuitive behavior when clicking inside the elevator - nicer scrollbars with up/down buttons - only redraw dirty gadgets - faster mouse tracking diff --git a/library/ui/hand.factor b/library/ui/hand.factor index 7921a601aa..90744bdb40 100644 --- a/library/ui/hand.factor +++ b/library/ui/hand.factor @@ -72,3 +72,6 @@ C: hand ( world -- hand ) focusable-child hand dup hand-focus parents-down >r dupd set-hand-focus parents-down r> focus-gestures ; + +: drag-loc ( gadget -- loc ) + hand [ relative ] keep hand-click-rel v- ; diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor index f880050093..a6bdbe4331 100644 --- a/library/ui/scrolling.factor +++ b/library/ui/scrolling.factor @@ -52,9 +52,11 @@ M: viewport focusable-child* ( viewport -- gadget ) dup scroller-y swap update-slider ; : scroll ( origin scroller -- ) - dup update-sliders - scroller-viewport - [ [ fix-scroll ] keep set-viewport-origin ] keep relayout ; + [ + scroller-viewport [ fix-scroll ] keep + [ set-viewport-origin ] keep + relayout + ] keep update-sliders ; : add-viewport 2dup set-scroller-viewport add-center ; @@ -68,12 +70,12 @@ M: viewport focusable-child* ( viewport -- gadget ) : scroll>bottom ( gadget -- ) [ scroll>bottom ] swap handle-gesture drop ; -: scroll-by ( scroller amount -- ) - over scroller-viewport viewport-origin v+ swap scroll ; +: scroll-by ( amount scroller -- ) + [ scroller-viewport viewport-origin v+ ] keep scroll ; -: scroll-up-line { 0 32 0 } scroll-by ; +: scroll-up-line { 0 32 0 } swap scroll-by ; -: scroll-down-line { 0 -32 0 } scroll-by ; +: scroll-down-line { 0 -32 0 } swap scroll-by ; : scroller-actions ( scroller -- ) dup [ (scroll>bottom) ] [ scroll>bottom ] set-action diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor index 7ef3afadea..17e5f8da76 100644 --- a/library/ui/sliders.factor +++ b/library/ui/sliders.factor @@ -25,17 +25,19 @@ TUPLE: slider vector elevator thumb value max page ; : screen>slider slider-scale / ; -: elevator-click ( elevator pos -- ) - 2drop ; - -: elevator-motion ( elevator -- ) - hand hand-click-rel elevator-click ; +: elevator-drag ( elevator -- ) + dup relayout + dup drag-loc >r find-slider r> over slider-vector v. + over screen>slider + swap set-slider-value ; : thumb-actions ( thumb -- ) - [ find-elevator elevator-motion ] [ drag 1 ] set-action ; + dup [ drop ] [ button-up 1 ] set-action + dup [ drop ] [ button-down 1 ] set-action + [ find-elevator elevator-drag ] [ drag 1 ] set-action ; : ( -- thumb ) - [ drop ]