diff --git a/library/ui/editors.factor b/library/ui/editors.factor index f22072992b..f1c2dcc0bf 100644 --- a/library/ui/editors.factor +++ b/library/ui/editors.factor @@ -68,7 +68,7 @@ TUPLE: editor line caret font color ; ] with-editor ; : click-editor ( editor -- ) - dup hand get rect-loc relative-loc + dup hand-click-loc get-global relative-loc first over set-caret-x request-focus ; : popup-location ( editor -- loc ) diff --git a/library/ui/hand.factor b/library/ui/hand.factor index 38ecf75de7..800b01be73 100644 --- a/library/ui/hand.factor +++ b/library/ui/hand.factor @@ -14,13 +14,6 @@ SYMBOL: hand-click-loc SYMBOL: hand-buttons V{ } clone hand-buttons set-global -! The hand is a special gadget that holds mouse position and -! mouse button click state. - -! Some comments on the slots: -! - hand-gadget is the gadget under the mouse position -! - hand-clicked is the most recently clicked gadget -! - hand-focus is the gadget holding keyboard focus TUPLE: hand focus ; C: hand ( -- hand ) @@ -89,7 +82,7 @@ C: hand ( -- hand ) r> focus-gestures ; : drag-loc ( gadget -- loc ) - hand get rect-loc relative-loc hand-click-rel v- ; + hand get rect-loc hand-click-loc get-global v- ; : relevant-help ( seq -- help ) [ gadget-help ] map [ ] find nip ; @@ -108,15 +101,9 @@ C: hand ( -- hand ) #! the current gadget, with all parents in between. hand-gadget get-global parents reverse-slice ; -: hand-grab ( world -- gadget ) - hand get rect-loc swap pick-up ; - -: update-hand-gadget ( world -- ) - hand-grab hand-gadget set-global ; - : move-hand ( loc world -- ) - swap under-hand >r hand get set-rect-loc - update-hand-gadget + under-hand >r over hand get set-rect-loc + pick-up hand-gadget set-global under-hand r> hand-gestures update-help ; : update-hand ( world -- ) diff --git a/library/ui/menus.factor b/library/ui/menus.factor index db8f848c9a..61f1b71797 100644 --- a/library/ui/menus.factor +++ b/library/ui/menus.factor @@ -6,16 +6,15 @@ gadgets-labels gadgets-theme generic kernel lists math namespaces sequences ; : retarget-drag ( gadget -- ) - find-world hand get [ hand-gadget ] keep - 2dup hand-clicked eq? [ - 3drop + hand-gadget get-global hand-clicked get-global eq? [ + drop ] [ - set-hand-clicked update-hand + hand-gadget get-global hand-clicked set-global + update-hand ] if ; : retarget-click ( gadget -- ) - find-world dup hide-glass update-hand-gadget - update-clicked ; + find-world dup hide-glass update-hand update-clicked ; : menu-actions ( glass -- ) dup [ retarget-drag ] [ drag ] set-action @@ -30,7 +29,7 @@ namespaces sequences ; over >r menu-loc r> set-rect-loc ; : show-hand-menu ( menu gadget -- ) - hand get rect-loc -rot show-menu ; + hand-click-loc get-global -rot show-menu ; : menu-item-quot ( quot -- quot ) [ keep find-world hide-glass ] curry ; diff --git a/library/ui/sliders.factor b/library/ui/sliders.factor index db56de9df1..d982a98a3b 100644 --- a/library/ui/sliders.factor +++ b/library/ui/sliders.factor @@ -70,7 +70,7 @@ SYMBOL: slider-changed [ slider-page * ] keep slide-by ; : elevator-click ( elevator -- ) - dup hand get rect-loc relative-loc >r find-slider r> + dup hand-click-loc relative-loc >r find-slider r> over gadget-orientation v. over screen>slider over slider-value - sgn swap slide-by-page ;