Horizontal scrolling with the mouse wheel is now supported

[factor.git] / library / ui / gadgets / scrolling.factor

diff --git a/library/ui/gadgets/scrolling.factor b/library/ui/gadgets/scrolling.factor
index c2e76140804b0289b9563f08cb80097ec41c6ee2..d760a1904a8d3655428ed657c09fd9effc8f8577 100644 (file)
--- a/library/ui/gadgets/scrolling.factor
+++ b/library/ui/gadgets/scrolling.factor
@@ -16,17 +16,21 @@ TUPLE: scroller viewport x y follows ;
 
 : find-scroller [ scroller? ] find-parent ;
 
+: scroll-up-page scroller-y -1 swap slide-by-page ;
+
+: scroll-down-page scroller-y 1 swap slide-by-page ;
+
 : scroll-up-line scroller-y -1 swap slide-by-line ;
 
 : scroll-down-line scroller-y 1 swap slide-by-line ;
 
-: scroll-up-page scroller-y -1 swap slide-by-page ;
-
-: scroll-down-page scroller-y 1 swap slide-by-page ;
+: do-mouse-scroll ( scroller -- )
+    scroll-direction get-global first2
+    pick scroller-y slide-by-line
+    swap scroller-x slide-by-line ;
 
 scroller H{
-    { T{ wheel-up } [ scroll-up-line ] }
-    { T{ wheel-down } [ scroll-down-line ] }
+    { T{ mouse-scroll } [ do-mouse-scroll ] }
     { T{ slider-changed } [ relayout-1 ] }
 } set-gestures