Fixing some problems with Windows keyboard handling

basis/ui/windows/windows.factor

@@ -6,9 +6,10 @@ ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
 ui.gestures io kernel math math.vectors namespaces make
 sequences strings vectors words windows.kernel32 windows.gdi32
 windows.user32 windows.opengl32 windows.messages windows.types
-windows.nt windows threads libc combinators continuations
+windows.nt windows threads libc combinators
-command-line shuffle opengl ui.render unicode.case ascii
+combinators.short-circuit continuations command-line shuffle
-math.bitwise locals symbols accessors math.geometry.rect ;
+opengl ui.render ascii math.bitwise locals symbols accessors
+math.geometry.rect math.order ascii ;
 IN: ui.windows
 
 SINGLETON: windows-ui-backend
@@ -144,11 +145,6 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 : alt? ( -- ? ) left-alt? right-alt? or ;
 : caps-lock? ( -- ? ) VK_CAPITAL GetKeyState zero? not ;
 
-: switch-case ( seq -- seq )
-    dup first CHAR: a >= [ >upper ] [ >lower ] if ;
-
-: switch-case? ( -- ? ) shift? caps-lock? xor not ;
-
 : key-modifiers ( -- seq )
     [
         shift? [ S+ , ] when
@@ -179,33 +175,53 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 : exclude-key-wm-char? ( n -- bool )
     exclude-keys-wm-char key? ;
 
-: keystroke>gesture ( n -- mods sym ? )
+: keystroke>gesture ( n -- mods sym )
-    dup wm-keydown-codes at* [
+    wm-keydown-codes at* [ key-modifiers swap ] [ drop f f ] if ;
-        nip >r key-modifiers r> t
+
-    ] [
+: send-key-gesture ( sym action? quot hWnd -- )
-        drop 1string >r key-modifiers r>
+    [ [ key-modifiers ] 3dip call ] dip
-        C+ pick member? >r A+ pick member? r> or [
+    window-focus propagate-gesture ; inline
-            shift? [ >lower ] unless f
+
-        ] [
+: send-key-down ( sym action? hWnd -- )
-            switch-case? [ switch-case ] when t
+    [ [ <key-down> ] ] dip send-key-gesture ;
-        ] if
+
-    ] if ;
+: send-key-up ( sym action? hWnd -- )
+    [ [ <key-up> ] ] dip send-key-gesture ;
+
+: key-sym ( wParam -- string/f action? )
+    {
+        {
+            [ dup LETTER? ]
+            [ shift? caps-lock? xor [ CHAR: a + CHAR: A - ] unless 1string f ]
+        }
+        { [ dup digit? ] [ 1string f ] }
+        [ wm-keydown-codes at t ]
+    } cond ;
 
 :: handle-wm-keydown ( hWnd uMsg wParam lParam -- )
     wParam exclude-key-wm-keydown? [
-        wParam keystroke>gesture <key-down>
+        wParam key-sym over [
-        hWnd window-focus propagate-gesture
+            dup ctrl? alt? xor or [
+                hWnd send-key-down
+            ] [ 2drop ] if
+        ] [ 2drop ] if
     ] unless ;
 
 :: handle-wm-char ( hWnd uMsg wParam lParam -- )
-    wParam exclude-key-wm-char? ctrl? alt? xor or [
+    wParam exclude-key-wm-char? [
-        wParam 1string
+        ctrl? alt? xor [
-        hWnd window-focus user-input
+            wParam 1string
+            [ f hWnd send-key-down ]
+            [ hWnd window-focus user-input ] bi
+        ] unless
     ] unless ;
 
 :: handle-wm-keyup ( hWnd uMsg wParam lParam -- )
-    wParam keystroke>gesture <key-up>
+    wParam exclude-key-wm-keydown? [
-    hWnd window-focus propagate-gesture ;
+        wParam key-sym over [
+            hWnd send-key-up
+        ] [ 2drop ] if
+    ] unless ;
 
 :: set-window-active ( hwnd uMsg wParam lParam ? -- n )
     ? hwnd window (>>active?)
@@ -241,20 +257,20 @@ M: windows-ui-backend (close-window)
 
 : message>button ( uMsg -- button down? )
     {
-        { [ dup WM_LBUTTONDOWN   = ] [ drop 1 t ] }
+        { WM_LBUTTONDOWN   [ 1 t ] }
-        { [ dup WM_LBUTTONUP     = ] [ drop 1 f ] }
+        { WM_LBUTTONUP     [ 1 f ] }
-        { [ dup WM_MBUTTONDOWN   = ] [ drop 2 t ] }
+        { WM_MBUTTONDOWN   [ 2 t ] }
-        { [ dup WM_MBUTTONUP     = ] [ drop 2 f ] }
+        { WM_MBUTTONUP     [ 2 f ] }
-        { [ dup WM_RBUTTONDOWN   = ] [ drop 3 t ] }
+        { WM_RBUTTONDOWN   [ 3 t ] }
-        { [ dup WM_RBUTTONUP     = ] [ drop 3 f ] }
+        { WM_RBUTTONUP     [ 3 f ] }
 
-        { [ dup WM_NCLBUTTONDOWN = ] [ drop 1 t ] }
+        { WM_NCLBUTTONDOWN [ 1 t ] }
-        { [ dup WM_NCLBUTTONUP   = ] [ drop 1 f ] }
+        { WM_NCLBUTTONUP   [ 1 f ] }
-        { [ dup WM_NCMBUTTONDOWN = ] [ drop 2 t ] }
+        { WM_NCMBUTTONDOWN [ 2 t ] }
-        { [ dup WM_NCMBUTTONUP   = ] [ drop 2 f ] }
+        { WM_NCMBUTTONUP   [ 2 f ] }
-        { [ dup WM_NCRBUTTONDOWN = ] [ drop 3 t ] }
+        { WM_NCRBUTTONDOWN [ 3 t ] }
-        { [ dup WM_NCRBUTTONUP   = ] [ drop 3 f ] }
+        { WM_NCRBUTTONUP   [ 3 f ] }
-    } cond ;
+    } case ;
 
 ! If the user clicks in the window border ("non-client area")
 ! Windows sends us an NC[LMR]BUTTONDOWN message; but if the