Holding down the mouse button in a slider's elevator now does timer-based scrolling

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index b6831bd71f6f5a03e9c9ec348a5d6a337481ce2b..04ccc913b90498ebf279cdaf38c2e0db63e9147c 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -8,7 +8,6 @@
 - the editor should fill up the interior of the scroller completely
 - hide empty command groups in $commands
 - ui quick start doc
-- page scrolling should be timer-based too
 - x11: scroll up/down wiggles caret
 - slider needs to be modelized
 - more compact relocation info

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 83fd3147610957ff113dcec2851ef56f8fa0d3a2..840a436868a2012e0574e665360592aa1a9fa6c1 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -97,7 +97,8 @@ M: gadget children-on nip gadget-children ;
     >r gadget-children r> each-with ; inline
 
 : set-gadget-delegate ( delegate gadget -- )
-    dup pick [ set-gadget-parent ] each-child-with set-delegate ;
+    over [ dup pick [ set-gadget-parent ] each-child-with ] when
+    set-delegate ;
 
 : with-gadget ( gadget quot -- )
     [ swap gadget set call ] with-scope ; inline
@@ -126,9 +127,10 @@ C: timer-gadget ( gadget -- gadget )
 M: timer-gadget tick nip timer-gadget-quot call ;
 
 : start-timer-gadget ( gadget quot -- )
+    2dup call
     over >r curry r>
     [ set-timer-gadget-quot ] keep
-    100 add-timer ;
+    100 add-timer ; inline
 
 : stop-timer-gadget ( gadget -- )
     dup remove-timer f swap set-timer-gadget-quot ;

diff --git a/library/ui/gadgets/buttons.factor b/library/ui/gadgets/buttons.factor
index f5074c64ef7dc650143d698915d22482464205fb..963bc217613083c73e8c3bd9d5fdfe02beeef943 100644 (file)
--- a/library/ui/gadgets/buttons.factor
+++ b/library/ui/gadgets/buttons.factor
@@ -63,7 +63,7 @@ TUPLE: repeat-button ;
 
 repeat-button H{
     { T{ button-down } [ [ button-clicked ] start-timer-gadget ] }
-    { T{ button-up } [ stop-timer-gadget ] }
+    { T{ button-up } [ dup stop-timer-gadget button-update ] }
 } set-gestures
 
 C: repeat-button ( gadget quot -- button )

diff --git a/library/ui/gadgets/sliders.factor b/library/ui/gadgets/sliders.factor
index a2002e540beb5bb6c73c31c394ccd35131dc4203..3931185f26bb4e19ab1fd4ab67797ba34e29b017 100644 (file)
--- a/library/ui/gadgets/sliders.factor
+++ b/library/ui/gadgets/sliders.factor
@@ -89,13 +89,15 @@ C: thumb ( vector -- thumb )
     over screen>slider over slider-value - sgn
     swap slide-by-page ;
 
-elevator H{ { T{ button-down } [ elevator-click ] } }
-set-gestures
+elevator H{
+    { T{ button-down } [ [ elevator-click ] start-timer-gadget ] }
+    { T{ button-up } [ stop-timer-gadget ] }
+} set-gestures
 
 C: elevator ( vector -- elevator )
-    dup delegate>gadget
-    dup elevator-theme
-    [ set-gadget-orientation ] keep ;
+    <gadget> <timer-gadget> over set-gadget-delegate
+    [ set-gadget-orientation ] keep
+    dup elevator-theme ;
 
 : (layout-thumb) ( slider n -- n thumb )
     over gadget-orientation n*v swap slider-thumb ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index a01c435324d08e1b0945e348e065335bc3b95825..1b663903776b9dab872f6405f5adef6c3ca43a23 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -172,7 +172,7 @@ M: world-error error.
     "This world has been deactivated to prevent cascading errors." print
     delegate error. ;
 
-: draw-world? ( world -- )
+: draw-world? ( world -- ? )
     #! We don't draw deactivated worlds, or those with 0 size.
     #! On Windows, the latter case results in GL errors.
     dup world-active? swap rect-dim [ zero? not ] all? and ;