UI fix

TODO.FACTOR.txt

@@ -7,8 +7,6 @@
 - default library names are not useful
 - fix remaining GL issues
 - fix up the min thumb size hack
-- bug: left click to bring up context menu, click splitter bar
-  and pane grows to 100%
 - bug: click tutorial, full screen, the right-most arrow icon
   loses the vertical bar
 - signal handler should not lose stack pointers

library/ui/events.factor

@@ -9,16 +9,11 @@ GENERIC: handle-event ( event -- )
 M: object handle-event ( event -- )
     drop ;
 
-: button-gesture ( button gesture -- )
-    swap add hand get hand-clicked handle-gesture drop ;
-
 M: button-down-event handle-event ( event -- )
-    button-event-button dup hand get button/
+    button-event-button button/ ;
-    [ button-down ] button-gesture ;
 
 M: button-up-event handle-event ( event -- )
-    button-event-button dup hand get button\
+    button-event-button button\ ;
-    [ button-up ] button-gesture ;
 
 : motion-event-loc ( event -- loc )
     dup motion-event-x swap motion-event-y 0 3array ;

library/ui/hand.factor

@@ -16,14 +16,17 @@ TUPLE: hand click-loc click-rel clicked buttons gadget focus ;
 C: hand ( -- hand )
     dup delegate>gadget V{ } clone over set-hand-buttons ;
 
-: button/ ( n hand -- )
+: button-gesture ( button gesture -- )
-    dup hand-gadget over set-hand-clicked
+    swap add hand get hand-clicked handle-gesture drop ;
-    dup screen-loc over set-hand-click-loc
-    dup hand-gadget over relative over set-hand-click-rel
-    hand-buttons push ;
 
-: button\ ( n hand -- )
+: button/ ( n -- )
-    hand-buttons delete ;
+    update-clicked
+    dup hand get hand-buttons push
+    [ button-down ] button-gesture ;
+
+: button\ ( n -- )
+    dup hand get hand-buttons delete
+    [ button-up ] button-gesture ;
 
 : drag-gesture ( hand gadget gesture -- )
     #! Send a gesture like [ drag 2 ].

library/ui/menus.factor

@@ -9,9 +9,12 @@ namespaces sequences ;
     hand get [ hand-gadget ] keep 2dup hand-clicked eq?
     [ 2dup set-hand-clicked update-hand ] unless 2drop ;
 
+: retarget-click ( -- )
+    update-hand-gadget update-clicked ;
+
 : menu-actions ( glass -- )
     dup [ drop retarget-drag ] [ drag 1 ] set-action
-    [ drop hide-glass ] [ button-down 1 ] set-action ;
+    [ drop hide-glass retarget-click ] [ button-down 1 ] set-action ;
 
 : fit-bounds ( loc dim max -- loc )
     #! Adjust loc to fit inside max.

library/ui/world.factor

@@ -72,14 +72,23 @@ M: f set-message 2drop ;
     #! the current gadget, with all parents in between.
     hand get hand-gadget parents reverse-slice ;
 
+: update-hand-gadget ( -- )
+    hand-grab hand get set-hand-gadget ;
+
 : hand-grab ( -- gadget )
     hand get rect-loc world get pick-up ;
 
 : move-hand ( loc -- )
     under-hand >r hand get set-rect-loc
-    hand-grab hand get set-hand-gadget
+    update-hand-gadget
     under-hand r> hand-gestures update-help ;
 
+: update-clicked ( -- )
+    hand get
+    dup hand-gadget over set-hand-clicked
+    dup screen-loc over set-hand-click-loc
+    dup hand-gadget over relative swap set-hand-click-rel ;
+
 M: motion-event handle-event ( event -- )
     motion-event-loc move-hand ;