From 972af17993b5057bb749abd5bb7152ffe42ecc8a Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 9 Oct 2006 22:26:05 +0000 Subject: [PATCH] add support for horizontal mouse scrolling in win32 --- library/ui/windows/ui.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/library/ui/windows/ui.factor b/library/ui/windows/ui.factor index b2a56fb146..7f1da11609 100644 --- a/library/ui/windows/ui.factor +++ b/library/ui/windows/ui.factor @@ -162,8 +162,8 @@ SYMBOL: hWnd : handle-wm-kill-focus ( hWnd uMsg wParam lParam -- ) 3drop window [ unfocus-world ] when* ; -: mouse-coordinate ( lParam -- seq ) [ lo-word ] keep hi-word 2array ; -: mouse-wheel ( lParam -- n ) hi-word 0 > ; +: mouse-lparam ( lParam -- seq ) [ lo-word ] keep hi-word 2array ; +: mouse-wheel ( lParam -- n ) mouse-lparam [ sgn neg ] map ; : mouse-event>gesture ( uMsg -- button ) key-modifiers swap @@ -181,7 +181,7 @@ SYMBOL: hWnd { WM_LBUTTONDOWN WM_RBUTTONDOWN } member? ; : prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world ) - nip >r mouse-event>gesture r> mouse-coordinate rot window ; + nip >r mouse-event>gesture r> mouse-lparam rot window ; : handle-wm-buttondown ( hWnd uMsg wParam lParam -- ) >r over capture-mouse? [ pick SetCapture drop ] when r> @@ -201,10 +201,10 @@ SYMBOL: hWnd TrackMouseEvent drop track-mouse-state on ] unless - mouse-coordinate swap window move-hand fire-motion ; + mouse-lparam swap window move-hand fire-motion ; : handle-wm-mousewheel ( hWnd uMsg wParam lParam -- ) - mouse-coordinate >r mouse-wheel nip r> rot window send-wheel ; + mouse-lparam >r mouse-wheel nip r> rot window send-wheel ; : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- ) #! message sent if windows needs application to stop dragging -- 2.34.1