From: Alexander Ilin <alex.ilin@protonmail.com>
Date: Sun, 25 Feb 2024 14:39:25 +0000 (+0100)
Subject: ui.backend.windows: support horizontal scroll wheel
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=83d2d6c0cb56def021474bb10e703cea0429dd8d

ui.backend.windows: support horizontal scroll wheel
---

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 0d6d31bd7a..9dba6fed92 100644
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -439,6 +439,9 @@ SYMBOL: nc-buttons
 : mouse-scroll ( wParam -- array )
     >lo-hi [ -80 /f ] map ;
 
+: mouse-horizontal-scroll ( wParam -- direction )
+    hi-word 80 /f 0 2array ;
+
 : mouse-event>gesture ( uMsg -- button )
     key-modifiers swap message>button
     [ <button-down> ] [ <button-up> ] if ;
@@ -495,8 +498,14 @@ SYMBOL: nc-buttons
     TrackMouseEvent win32-error=0/f
     >lo-hi swap window move-hand fire-motion ;
 
+: (handle-mousewheel) ( direction hWnd -- )
+    hand-loc get-global swap window send-scroll ; inline
+
 :: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    wParam mouse-scroll hand-loc get-global hWnd window send-scroll ;
+    wParam mouse-scroll hWnd (handle-mousewheel) ;
+
+:: handle-wm-mousehwheel ( hWnd uMsg wParam lParam -- )
+    wParam mouse-horizontal-scroll hWnd (handle-mousewheel) ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     ! message sent if windows needs application to stop dragging
@@ -567,6 +576,7 @@ wm-handlers [
 
         ${ WM_MOUSEMOVE [ handle-wm-mousemove 0 ] }
         ${ WM_MOUSEWHEEL [ handle-wm-mousewheel 0 ] }
+        ${ WM_MOUSEHWHEEL [ handle-wm-mousehwheel 0 ] }
         ${ WM_CANCELMODE [ handle-wm-cancelmode 0 ] }
         ${ WM_MOUSELEAVE [ handle-wm-mouseleave 0 ] }
     } expand-keys-set-at
diff --git a/basis/windows/messages/messages.factor b/basis/windows/messages/messages.factor
index c92afd9b43..1715c5ae88 100644
--- a/basis/windows/messages/messages.factor
+++ b/basis/windows/messages/messages.factor
@@ -169,6 +169,7 @@ CONSTANT: WM_XBUTTONUP 0x020C
 CONSTANT: WM_XBUTTONDBLCLK 0x020D
 CONSTANT: WM_MOUSELAST_5 0x020D
 CONSTANT: WM_MOUSELAST_4 0x020A
+CONSTANT: WM_MOUSEHWHEEL 0x020E
 CONSTANT: WM_MOUSELAST_PRE_4 0x0209
 CONSTANT: WM_PARENTNOTIFY 0x0210
 CONSTANT: WM_ENTERMENULOOP 0x0211