fix mouse wheel capture problems in win32 ui
parent
5096d3c5df
commit
e02c82de32
|
|
@ -177,15 +177,18 @@ SYMBOL: hWnd
|
||||||
{ [ t ] [ "bad button" throw ] }
|
{ [ t ] [ "bad button" throw ] }
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
|
: capture-mouse? ( umsg -- ? )
|
||||||
|
{ WM_LBUTTONDOWN WM_RBUTTONDOWN } member? ;
|
||||||
|
|
||||||
: prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
|
: 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-coordinate rot window ;
|
||||||
|
|
||||||
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
|
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
|
||||||
>r pick SetCapture drop r>
|
>r over capture-mouse? [ pick SetCapture drop ] when r>
|
||||||
prepare-mouse send-button-down ;
|
prepare-mouse send-button-down ;
|
||||||
|
|
||||||
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
|
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
|
||||||
ReleaseCapture drop
|
pick capture-mouse? [ ReleaseCapture drop ] when
|
||||||
prepare-mouse send-button-up ;
|
prepare-mouse send-button-up ;
|
||||||
|
|
||||||
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue