diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index dd70bf3139..10379080aa 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -5,7 +5,6 @@ [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 ] - prettier printing of hashtable literals, alists, cond, ... -- x11 double click - menu should stay up if mouse button released - roundoff is still not quite right with tracks - fix compiled gc check diff --git a/library/ui/cocoa/view-utils.factor b/library/ui/cocoa/view-utils.factor index 56040cf46d..3b3d22f464 100644 --- a/library/ui/cocoa/view-utils.factor +++ b/library/ui/cocoa/view-utils.factor @@ -91,16 +91,11 @@ opengl sequences ; : mouse-event>gesture ( event -- modifiers button ) dup event-modifiers swap button ; -: update-click-count ( event -- ) - -> clickCount 1 max hand-click# set-global ; - : send-button-down$ ( view event -- ) - [ update-click-count ] keep [ mouse-event>gesture ] 2keep mouse-location rot window send-button-down ; : send-button-up$ ( view event -- ) - [ update-click-count ] keep [ mouse-event>gesture ] 2keep mouse-location rot window send-button-up ; diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor index 196125f1bb..0aefa99998 100644 --- a/library/ui/gestures.factor +++ b/library/ui/gestures.factor @@ -81,6 +81,9 @@ V{ } clone hand-buttons set-global SYMBOL: scroll-direction { 0 0 } scroll-direction set-global +SYMBOL: double-click-timeout +100 double-click-timeout set-global + : button-gesture ( gesture -- ) hand-clicked get-global 2dup handle-gesture [ >r generalize-gesture r> handle-gesture drop @@ -150,31 +153,30 @@ SYMBOL: scroll-direction : hand-click-rel ( gadget -- loc ) hand-click-loc get-global relative-loc ; -: update-click# ( button -- ) - hand-last-button get = [ - global [ hand-click# inc ] bind - ] [ - 1 hand-click# set-global - ] if ; - -: button-down ( button timeout -- ) - millis hand-last-time get - rot < [ - dup update-click# - ] [ - 1 hand-click# set-global - ] if - hand-last-button set-global - millis hand-last-time set-global ; +: multi-click? ( button -- ? ) + millis hand-last-time get - double-click-timeout get <= + swap hand-last-button get = and ; +: update-click# ( button -- ) + global [ + multi-click? [ + hand-click# inc + ] [ + 1 hand-click# set + ] if + ] bind ; + +: update-clicked ( button -- ) + hand-last-button set-global + hand-gadget get-global hand-clicked set-global + hand-loc get-global hand-click-loc set-global + millis hand-last-time set-global ; + : under-hand ( -- seq ) #! A sequence whose first element is the world and last is #! the current gadget, with all parents in between. hand-gadget get-global parents ; -: update-clicked ( -- ) - hand-gadget get-global hand-clicked set-global - hand-loc get-global hand-click-loc set-global ; - : move-hand ( loc world -- ) dup hand-world set-global under-hand >r over hand-loc set-global @@ -184,8 +186,10 @@ SYMBOL: scroll-direction : send-button-down ( gesture loc world -- ) move-hand - update-clicked - dup button-down-# hand-buttons get-global push + dup button-down-# + dup update-click# + dup update-clicked + hand-buttons get-global push button-gesture ; : send-button-up ( gesture loc world -- ) diff --git a/library/ui/windows/ui.factor b/library/ui/windows/ui.factor index 7b4246be58..57c4e092c3 100644 --- a/library/ui/windows/ui.factor +++ b/library/ui/windows/ui.factor @@ -165,17 +165,14 @@ SYMBOL: hWnd : mouse-lparam ( lParam -- seq ) [ lo-word ] keep hi-word 2array ; : mouse-wheel ( lParam -- n ) mouse-lparam [ sgn neg ] map ; -: win32-button-down ( button -- ) - GetDoubleClickTime dup button-down ; - : mouse-event>gesture ( uMsg -- button ) key-modifiers swap { - { [ dup WM_LBUTTONDOWN = ] [ drop 1 win32-button-down ] } + { [ dup WM_LBUTTONDOWN = ] [ drop 1 ] } { [ dup WM_LBUTTONUP = ] [ drop 1 ] } - { [ dup WM_MBUTTONDOWN = ] [ drop 2 win32-button-down ] } + { [ dup WM_MBUTTONDOWN = ] [ drop 2 ] } { [ dup WM_MBUTTONUP = ] [ drop 2 ] } - { [ dup WM_RBUTTONDOWN = ] [ drop 3 win32-button-down ] } + { [ dup WM_RBUTTONDOWN = ] [ drop 3 ] } { [ dup WM_RBUTTONUP = ] [ drop 3 ] } { [ t ] [ "bad button" throw ] } } cond ; @@ -306,7 +303,8 @@ SYMBOL: hWnd "MSG" msg-obj set random-class-name class-name set class-name get ui-wndproc - register-wndclassex win32-error=0 ; + register-wndclassex win32-error=0 + GetDoubleClickTime double-click-timeout set-global ; : cleanup-win32-ui ( -- ) class-name get f UnregisterClass drop ;