]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix odd Windows mouse wheel behavior
authorU-SLAVA-DFB8FF805\Slava <Slava@slava-dfb8ff805.(none)>
Tue, 2 Dec 2008 00:20:19 +0000 (18:20 -0600)
committerU-SLAVA-DFB8FF805\Slava <Slava@slava-dfb8ff805.(none)>
Tue, 2 Dec 2008 00:20:19 +0000 (18:20 -0600)
basis/ui/windows/windows.factor

index 1d3212c436ad61397971b53f7d76c92f55b814c5..1481287e9599351dd14c4216de13a171a08d0eea 100755 (executable)
@@ -285,12 +285,8 @@ SYMBOL: nc-buttons
     swap [ push ] [ delete ] if ;
 
 : >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
-: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
 
-: mouse-absolute>relative ( lparam handle -- array )
-    [ >lo-hi ] dip
-    "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
-    get-RECT-top-left 2array v- ;
+: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
 
 : mouse-event>gesture ( uMsg -- button )
     key-modifiers swap message>button
@@ -340,9 +336,7 @@ SYMBOL: nc-buttons
     >lo-hi swap window move-hand fire-motion ;
 
 :: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    wParam mouse-wheel
-    lParam hWnd mouse-absolute>relative
-    hWnd window send-wheel ;
+    wParam mouse-wheel hand-loc get hWnd window send-wheel ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     #! message sent if windows needs application to stop dragging