ui: use scroll delta information for smoother mouse scrolling on Windows and Mac...

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index 19c451d9096750863c3b718e8564ae0a3b14e636..331f26aa32e0247b4c2ca960b14480b8adc07790 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/basis/ui/backend/cocoa/views/views.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov
+! Copyright (C) 2006, 2010 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.strings
 arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
@@ -90,11 +90,11 @@ CONSTANT: key-codes
     [ drop window ]
     2tri send-button-up ;
 
-: send-wheel$ ( view event -- )
-    [ nip [ -> deltaX ] [ -> deltaY ] bi [ sgn neg ] bi@ 2array ]
+: send-scroll$ ( view event -- )
+    [ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ]
     [ mouse-location ]
     [ drop window ]
-    2tri send-wheel ;
+    2tri send-scroll ;
 
 : send-action$ ( view event gesture -- junk )
     [ drop window ] dip send-action f ;
@@ -206,7 +206,7 @@ CLASS: {
 }
 
 { "scrollWheel:" void { id SEL id }
-    [ nip send-wheel$ ]
+    [ nip send-scroll$ ]
 }
 
 { "keyDown:" void { id SEL id }

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 4e271a82806fddd1ea97db1d6c65ad5b5e3cbc11..9fa73d031142ce07bd4bacfab2b8dbedbc1d1009 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -1,5 +1,5 @@
 ! Copyright (C) 2005, 2006 Doug Coleman.
-! Portions copyright (C) 2007, 2009 Slava Pestov.
+! Portions copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.strings arrays assocs ui
 ui.private ui.gadgets ui.gadgets.private ui.backend
@@ -475,7 +475,8 @@ SYMBOL: nc-buttons
     message>button nc-buttons get
     swap [ push ] [ remove! drop ] if ;
 
-: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
+: mouse-wheel ( wParam -- array )
+    >lo-hi [ -120 /f ] map ;
 
 : mouse-event>gesture ( uMsg -- button )
     key-modifiers swap message>button
@@ -534,7 +535,7 @@ SYMBOL: nc-buttons
     >lo-hi swap window move-hand fire-motion ;
 
 :: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    wParam mouse-wheel hand-loc get hWnd window send-wheel ;
+    wParam mouse-scroll hand-loc get hWnd window send-scroll ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     #! message sent if windows needs application to stop dragging

diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index fc7943efb039b44f002eee8fe3e502bab9c35d7a..ae849610a70fa03d41e3feec1dc2e07fbb13d09c 100644 (file)
--- a/basis/ui/backend/x11/x11.factor
+++ b/basis/ui/backend/x11/x11.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
+! Copyright (C) 2005, 2010 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien.c-types ascii assocs classes.struct combinators
 combinators.short-circuit command-line environment io.encodings.ascii
@@ -151,7 +151,7 @@ M: world button-up-event
 
 M: world wheel-event
     [ [ mouse-event>scroll-direction ] [ event-loc ] bi ] dip
-    send-wheel ;
+    send-scroll ;
 
 M: world enter-event motion-event ;
 

diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index 6851ff4be76b9154466a8459d381aa66526ca875..867a53eb68e871adb8e2cfb8c47bc3dbb755673a 100644 (file)
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs kernel math namespaces sequences
 vectors models models.range math.vectors math.functions quotations
@@ -234,7 +234,7 @@ PRIVATE>
 : <slider> ( range orientation -- slider )
     slider new-track
         swap >>model
-        32 >>line
+        16 >>line
         dup orientation>> {
             [ <slider-pen> >>interior ]
             [ <thumb> >>thumb ]

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 6e8e73ab55ec5e8de65cff8436d7ad1ab9d82356..c3e51c39edf15a311d8e0e78a4fe7bc70446c652 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2009 Slava Pestov.
+! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables math.parser
@@ -304,7 +304,7 @@ SYMBOL: drag-timer
     stop-drag-timer
     button-gesture ;
 
-: send-wheel ( direction loc world -- )
+: send-scroll ( direction loc world -- )
     move-hand
     scroll-direction set-global
     mouse-scroll hand-gadget get-global propagate-gesture ;

diff --git a/basis/x11/events/events.factor b/basis/x11/events/events.factor
index febbbfa13505b4ab4fbc27714153c2082ff2cea9..1a5b94c241670062c607468e2f29c37e92cb2c0a 100644 (file)
--- a/basis/x11/events/events.factor
+++ b/basis/x11/events/events.factor
@@ -16,7 +16,7 @@ GENERIC: enter-event ( event window -- )
 
 GENERIC: leave-event ( event window -- )
 
-GENERIC: wheel-event ( event window -- )
+GENERIC: scroll-event ( event window -- )
 
 GENERIC: motion-event ( event window -- )
 
@@ -42,13 +42,13 @@ GENERIC: client-event ( event window -- )
 
 : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
 
-: wheel? ( event -- ? ) button>> 4 7 between? ;
+: mouse-scroll? ( event -- ? ) button>> 4 7 between? ;
 
 : button-down-event$ ( event window -- )
-    over wheel? [ wheel-event ] [ button-down-event ] if ;
+    over mouse-scroll? [ scroll-event ] [ button-down-event ] if ;
 
 : button-up-event$ ( event window -- )
-    over wheel? [ 2drop ] [ button-up-event ] if ;
+    over mouse-scroll? [ 2drop ] [ button-up-event ] if ;
 
 : handle-event ( event window -- )
     swap dup XAnyEvent>> type>> {