steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

win32 mouse gesture fix

erg 2006-08-28 16:24:16 +00:00
parent 6076d3f0e0
commit b9524ae656
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
library/ui/windows/ui.factor
View File

@ -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>