Fix odd Windows mouse wheel behavior
parent
8b106b6a77
commit
6d8d4b3098
|
@ -285,12 +285,8 @@ SYMBOL: nc-buttons
|
|||
swap [ push ] [ delete ] if ;
|
||||
|
||||
: >lo-hi ( WORD -- array ) [ lo-word ] [ hi-word ] bi 2array ;
|
||||
: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
|
||||
|
||||
: mouse-absolute>relative ( lparam handle -- array )
|
||||
[ >lo-hi ] dip
|
||||
"RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
|
||||
get-RECT-top-left 2array v- ;
|
||||
: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
|
||||
|
||||
: mouse-event>gesture ( uMsg -- button )
|
||||
key-modifiers swap message>button
|
||||
|
@ -340,9 +336,7 @@ SYMBOL: nc-buttons
|
|||
>lo-hi swap window move-hand fire-motion ;
|
||||
|
||||
:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
|
||||
wParam mouse-wheel
|
||||
lParam hWnd mouse-absolute>relative
|
||||
hWnd window send-wheel ;
|
||||
wParam mouse-wheel hand-loc get hWnd window send-wheel ;
|
||||
|
||||
: handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
|
||||
#! message sent if windows needs application to stop dragging
|
||||
|
|
Loading…
Reference in New Issue