From b9524ae65644e4b9ade6ec28c262c8b3f3ea160d Mon Sep 17 00:00:00 2001
From: erg <erg@trifocus.net>
Date: Mon, 28 Aug 2006 16:24:16 +0000
Subject: [PATCH] win32 mouse gesture fix

---
 library/ui/windows/ui.factor | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/library/ui/windows/ui.factor b/library/ui/windows/ui.factor
index 3b75db2e5b..f43e82d6ef 100644
--- a/library/ui/windows/ui.factor
+++ b/library/ui/windows/ui.factor
@@ -163,22 +163,23 @@ SYMBOL: hWnd
 : handle-wm-kill-focus ( hWnd uMsg wParam lParam -- )
     3drop window [ unfocus-world ] when* ;
 
-: mouse-button ( uMsg -- n )
-    {
-        { [ dup WM_LBUTTONDOWN = ] [ drop 1 ] }
-        { [ dup WM_LBUTTONUP = ] [ drop 1 ] }
-        { [ dup WM_MBUTTONDOWN = ] [ drop 2 ] }
-        { [ dup WM_MBUTTONUP = ] [ drop 2 ] }
-        { [ dup WM_RBUTTONDOWN = ] [ drop 3 ] }
-        { [ dup WM_RBUTTONUP = ] [ drop 3 ] }
-        { [ t ] [ "bad button" throw ] }
-    } cond ;
-
 : mouse-coordinate ( lParam -- seq ) [ lo-word ] keep hi-word 2array ;
 : mouse-wheel ( lParam -- n ) hi-word 0 > ;
 
-: prepare-mouse ( hWnd uMsg wParam lParam -- world )
-    nip >r mouse-button r> mouse-coordinate rot window ;
+: mouse-event>gesture ( uMsg -- button )
+    key-modifiers swap
+    {
+        { [ dup WM_LBUTTONDOWN = ] [ drop 1 <button-down> ] }
+        { [ dup WM_LBUTTONUP = ] [ drop 1 <button-up> ] }
+        { [ dup WM_MBUTTONDOWN = ] [ drop 2 <button-down> ] }
+        { [ dup WM_MBUTTONUP = ] [ drop 2 <button-up> ] }
+        { [ dup WM_RBUTTONDOWN = ] [ drop 3 <button-down> ] }
+        { [ dup WM_RBUTTONUP = ] [ drop 3 <button-up> ] }
+        { [ t ] [ "bad button" throw ] }
+    } cond ;
+
+: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
+    nip >r mouse-event>gesture r> mouse-coordinate rot window ;
 
 : handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
     >r pick SetCapture drop r>