repeating buttons

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 3874e3ffdc61001444119934fc2a2d7846adb72f..651a6e08ed34680f1a075142a5af587f13c31f03 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
-- nicer scrollbars with up/down buttons\r
 - only redraw dirty gadgets\r
 - faster mouse tracking\r
 \r

diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index 3b3d3ec33b17e4fba3f2264050454587cb0c6b16..5ad822c78763eae971debeee28ef2fdf32ce0442 100644 (file)
--- a/library/ui/buttons.factor
+++ b/library/ui/buttons.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic kernel lists math namespaces prettyprint sdl
-sequences io sequences styles ;
+USING: generic io kernel lists math namespaces prettyprint sdl
+sequences sequences styles threads ;
 
 : button-down? ( n -- ? ) hand hand-buttons member? ;
 
@@ -26,8 +26,8 @@ sequences io sequences styles ;
 : button-clicked ( button -- )
     #! If the mouse is released while still inside the button,
     #! fire an action gesture.
-    dup mouse-over?
-    [ [ action ] swap handle-gesture drop ] [ drop ] ifte ;
+    dup button-update dup mouse-over?
+    [ [ action ] swap handle-gesture ] when drop ;
 
 : button-theme ( button -- )
     dup { 216 216 216 } background set-paint-prop
@@ -44,14 +44,33 @@ sequences io sequences styles ;
 
 : button-gestures ( button quot -- )
     dupd [ action ] set-action
-    dup [ dup button-update button-clicked ] [ button-up 1 ] set-action
+    dup [ button-clicked ] [ button-up 1 ] set-action
     dup [ button-update ] [ button-down 1 ] set-action
     dup [ button-update ] [ mouse-leave ] set-action
-    dup [ button-update ] [ mouse-enter ] set-action
-    [ drop ] [ drag 1 ] set-action ;
+    [ button-update ] [ mouse-enter ] set-action ;
 
-: <button> ( gadget quot -- button )
-    >r bevel-border dup button-theme dup r> button-gestures ;
+TUPLE: button ;
+
+C: button ( gadget quot -- button )
+    rot bevel-border over set-delegate
+    dup button-theme [ swap button-gestures ] keep ;
 
 : <roll-button> ( gadget quot -- button )
     >r dup roll-button-theme dup r> button-gestures ;
+
+: repeat-button-down ( button -- )
+    dup 100 add-timer button-clicked ;
+
+: repeat-button-up ( button -- )
+    dup button-update remove-timer ;
+
+: repeat-actions ( button -- )
+    dup [ repeat-button-down ] [ button-down 1 ] set-action
+    [ repeat-button-up ] [ button-up 1 ] set-action ;
+
+: <repeat-button> ( gadget quot -- button )
+    #! Button that calls the quotation every 100ms as long as
+    #! the mouse is held down.
+    <button> dup repeat-actions ;
+
+M: button tick ( ms object -- ) nip button-clicked ;

diff --git a/library/ui/listener.factor b/library/ui/listener.factor
index a802da4352b8fbe6598b0b2cc1ad60cece6cadc5..07640efb70c2fc569e2ee8a83f89f9c32a485f91 100644 (file)
--- a/library/ui/listener.factor
+++ b/library/ui/listener.factor
@@ -12,10 +12,12 @@ SYMBOL: callstack-display
 
 TUPLE: display title pane ;
 
+: display-title-theme
+    dup { 216 232 255 } background set-paint-prop
+    << solid f >> interior set-paint-prop ;
+
 : <display-title> ( text -- label )
-    <label>
-    dup << solid f >> interior set-paint-prop
-    dup { 216 232 255 } background set-paint-prop ;
+    <label> dup display-title-theme ;
 
 : add-display-title ( title display -- )
     2dup set-display-title add-top ;

diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index b652465389351390ae7c0c618846785da160b73e..f4f8cd5cc0249c9e75b8d5053a5bf6ade981bd26 100644 (file)
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -25,8 +25,7 @@ USING: generic kernel lists math namespaces sequences ;
     1 <pile> [ add-gadgets ] keep ;
 
 : menu-theme ( menu -- )
-    << gradient f { 1 0 0 } { 240 240 255 } { 216 216 216 } >>
-    interior set-paint-prop ;
+    << solid f >> interior set-paint-prop ;
 
 : <menu> ( assoc -- gadget )
     #! Given an association list mapping labels to quotations.

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 1fce0042f1a151ca02b4ae253e9775fe017757da..280a9971f48555788d2b0c0401d480881317b4d1 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -5,10 +5,10 @@ USING: generic kernel lists math matrices namespaces sequences
 threads vectors styles ;
 
 ! A viewport can be scrolled.
-TUPLE: viewport origin bottom? ;
+TUPLE: viewport origin ;
 
 ! A scroller combines a viewport with two x and y sliders.
-TUPLE: scroller viewport x y ;
+TUPLE: scroller viewport x y bottom? ;
 
 : viewport-dim gadget-child pref-dim ;
 
@@ -23,18 +23,9 @@ C: viewport ( content -- viewport )
 
 M: viewport pref-dim gadget-child pref-dim ;
 
-: viewport-origin* ( viewport -- point )
-    dup viewport-bottom? [
-        f over set-viewport-bottom?
-        dup viewport-dim { 0 -1 0 } v*
-        [ swap set-viewport-origin ] keep
-    ] [
-        viewport-origin
-    ] ifte ;
-
 M: viewport layout* ( viewport -- )
-    dup gadget-child dup prefer
-    >r dup viewport-origin* swap fix-scroll r>
+    dup viewport-origin over fix-scroll
+    swap gadget-child dup prefer
     set-rect-loc ;
 
 M: viewport focusable-child* ( viewport -- gadget )
@@ -71,21 +62,15 @@ M: viewport focusable-child* ( viewport -- gadget )
 
 : add-y-slider 2dup set-scroller-y add-right ;
 
-: (scroll>bottom) ( scroller -- )
-    t swap scroller-viewport set-viewport-bottom? ;
-
 : scroll>bottom ( gadget -- )
-    [ scroll>bottom ] swap handle-gesture drop ;
+    [ scroller? ] find-parent
+    [ t over set-scroller-bottom? relayout ] when* ;
 
-: scroll-by ( amount scroller -- )
-    [ scroller-viewport viewport-origin v+ ] keep scroll ;
+: scroll-up-line scroller-y -1 swap slide-by-line ;
 
-: scroll-up-line { 0 32 0 } swap scroll-by ;
-
-: scroll-down-line { 0 -32 0 } swap scroll-by ;
+: scroll-down-line scroller-y 1 swap slide-by-line ;
 
 : scroller-actions ( scroller -- )
-    dup [ (scroll>bottom) ] [ scroll>bottom ] set-action
     dup [ scroll-up-line ] [ button-down 4 ] set-action
     [ scroll-down-line ] [ button-down 5 ] set-action ;
 
@@ -97,5 +82,11 @@ C: scroller ( gadget -- scroller )
     <y-slider> over add-y-slider
     dup scroller-actions ;
 
-M: scroller focusable-child* ( viewport -- gadget )
+M: scroller focusable-child* ( scroller -- viewport )
     scroller-viewport ;
+
+M: scroller layout* ( scroller -- )
+    dup scroller-bottom? [
+        f over set-scroller-bottom?
+        dup scroller-viewport viewport-dim vneg over scroll
+    ] when delegate layout* ;

diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor
index 5246899e716b2089e092428a4fb2dc8e7ad4cd88..778ed3d7d542d169a0636356da43faa30fbc3702 100644 (file)
--- a/library/ui/sliders.factor
+++ b/library/ui/sliders.factor
@@ -100,12 +100,12 @@ M: elevator pref-dim drop thumb-min ;
 : slide-by-line ( -1/1 slider -- ) >r 32 * r> slide-by ;
 
 : <up-button>
-    <gadget> [ -1 swap slide-by-line ] <button> ;
+    <gadget> [ -1 swap slide-by-line ] <repeat-button> ;
 
 : add-up { 1 1 1 } over slider-vector v- 2unseq set-frame-child ;
 
 : <down-button>
-    <gadget> [ 1 swap slide-by-line ] <button> ;
+    <gadget> [ 1 swap slide-by-line ] <repeat-button> ;
 
 : add-down { 1 1 1 } over slider-vector v+ 2unseq set-frame-child ;
 

diff --git a/library/ui/text.factor b/library/ui/text.factor
index ca2f9361f26d8ac1fd911329b6e6d822eba8d435..86652fc24847d01a2e7a8b0ec5a4984880a2aca5 100644 (file)
--- a/library/ui/text.factor
+++ b/library/ui/text.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien hashtables kernel lists namespaces sdl sequences
-strings styles io ;
+USING: alien hashtables io kernel lists math namespaces sdl
+sequences strings styles ;
 
 : draw-surface ( x y surface -- )
     surface get SDL_UnlockSurface

diff --git a/library/words.factor b/library/words.factor
index 119d44d9505a4bbaa4e2ee67d7c03ec093d04ab9..f68fb18fc85518c17bda6d6467e675cf46d121d5 100644 (file)
--- a/library/words.factor
+++ b/library/words.factor
@@ -118,8 +118,10 @@ M: compound definer drop \ : ;
     [ f swap set-word-prop ] each-with ;
 
 : reset-word ( word -- )
-    { "parsing" "inline" "foldable" "flushable" "predicating" }
-    reset-props ;
+    {
+        "parsing" "inline" "foldable" "flushable" "predicating"
+        "documentation" "stack-effect"
+    } reset-props ;
 
 : reset-generic ( word -- )
     dup reset-word { "methods" "combination" } reset-props ;