diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 1d3212c436..1481287e95 100755 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -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" [ 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 diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor old mode 100644 new mode 100755 index b5c71bc3fb..b65236d1f9 --- a/basis/ui/x11/x11.factor +++ b/basis/ui/x11/x11.factor @@ -117,7 +117,7 @@ M: world button-up-event } at ; M: world wheel-event - [ dup mouse-event>scroll-direction swap mouse-event-loc ] dip + [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip send-wheel ; M: world enter-event motion-event ; @@ -125,7 +125,7 @@ M: world enter-event motion-event ; M: world leave-event 2drop forget-rollover ; M: world motion-event - [ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip + [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip move-hand fire-motion ; M: world focus-in-event @@ -146,10 +146,10 @@ M: world selection-notify-event : clipboard-for-atom ( atom -- clipboard ) { - { [ dup XA_PRIMARY = ] [ drop selection get ] } - { [ dup XA_CLIPBOARD = ] [ drop clipboard get ] } + { XA_PRIMARY [ selection get ] } + { XA_CLIPBOARD [ clipboard get ] } [ drop ] - } cond ; + } case ; : encode-clipboard ( string type -- bytes ) XSelectionRequestEvent-target