working on scroll bar

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 40e8d2dda489d16c9933a612df3926dcc3a9301e..3874e3ffdc61001444119934fc2a2d7846adb72f 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -6,7 +6,6 @@
 + ui:\r
 \r
 - fix up the min thumb size hack\r
-- scroll bar: more intuitive behavior when clicking inside the elevator\r
 - nicer scrollbars with up/down buttons\r
 - only redraw dirty gadgets\r
 - faster mouse tracking\r

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 7921a601aa8aca46cfb00bd4280c8cd147a5fa27..90744bdb400b9ae30a56343e63baa825ddb19c57 100644 (file)
--- 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 f8800500935058d77785779400a9ce32fa2e2c61..a6bdbe43317263f401d5a68d67aa4ec1c451e77f 100644 (file)
--- 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 7ef3afadea7e548e584d30cb5c9b233a67bc4283..17e5f8da760c54d9292b1e815308383b26529aea 100644 (file)
--- 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> ( -- thumb )
-    <gadget> [ drop ] <button>
+    <bevel-gadget> dup button-theme
     t over set-gadget-root?
     dup thumb-actions ;
 
@@ -43,8 +45,23 @@ TUPLE: slider vector elevator thumb value max page ;
     dup << solid f >> interior set-paint-prop
     { 128 128 128 } background set-paint-prop ;
 
+: slide-by ( amount gadget -- )
+    #! The gadget can be any child of a slider.
+    find-slider dup slider-elevator relayout
+    [ slider-value + ] keep set-slider-value ;
+
+: slide-by-page ( -1/1 gadget -- )
+    [ slider-page * ] keep slide-by ;
+
+: elevator-click ( elevator -- )
+    dup relayout
+    dup hand relative >r find-slider r>
+    over slider-vector v.
+    over screen>slider over slider-value - sgn
+    swap slide-by-page ;
+
 : elevator-actions ( elevator -- )
-    [ { 0 0 0 } elevator-click ] [ button-down 1 ] set-action ;
+    [ elevator-click ] [ button-down 1 ] set-action ;
 
 C: elevator ( -- elevator )
     <plain-gadget> over set-delegate
@@ -62,18 +79,22 @@ C: elevator ( -- elevator )
     dup thumb-loc over slider-vector n*v
     over slider-thumb set-rect-loc
     dup thumb-dim over slider-vector n*v thumb-min vmax
-    swap slider-thumb set-rect-dim ;
+    swap slider-thumb set-gadget-dim ;
 
 M: elevator layout* ( elevator -- )
     find-slider layout-thumb ;
 
 M: elevator pref-dim drop thumb-min ;
 
-: <up-button> <gadget> [ drop ] <button> ;
+: slide-by-line ( -1/1 slider -- ) >r 32 * r> slide-by ;
+
+: <up-button>
+    <gadget> [ -1 swap slide-by-line ] <button> ;
 
 : add-up { 1 1 1 } over slider-vector v- 2unseq set-frame-child ;
 
-: <down-button> <gadget> [ drop ] <button> ;
+: <down-button>
+    <gadget> [ 1 swap slide-by-line ] <button> ;
 
 : add-down { 1 1 1 } over slider-vector v+ 2unseq set-frame-child ;
 

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index 6bcc450d5aa39e56f98592fd5c50bdfb9ee43b08..1debe28244c7f3adaab4749472ec4e2b6c63da7f 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -13,7 +13,7 @@ M: divider pref-dim drop divider-size ;
 TUPLE: splitter split ;
 
 : hand>split ( splitter -- n )
-    hand relative hand hand-click-rel v- divider-size 1/2 v*n v+ ;
+    drag-loc divider-size 1/2 v*n v+ ;
 
 : divider-motion ( splitter -- )
     dup hand>split