menu positioning fix

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index a3cacfaf9ab5ba95e3c04243ec2c5afa5676e23e..40e8d2dda489d16c9933a612df3926dcc3a9301e 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -8,10 +8,8 @@
 - fix up the min thumb size hack\r
 - scroll bar: more intuitive behavior when clicking inside the elevator\r
 - nicer scrollbars with up/down buttons\r
-- clicking outside menu doesn't close\r
 - only redraw dirty gadgets\r
 - faster mouse tracking\r
-- better menu positioning\r
 \r
 - off-by-one error in pick-up?\r
 - closing ui does not stop timers\r

diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index 7801b293c1792194ebd7d2bfda9038c8ceeee840..b652465389351390ae7c0c618846785da160b73e 100644 (file)
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -3,8 +3,20 @@
 IN: gadgets
 USING: generic kernel lists math namespaces sequences ;
 
+: menu-actions ( glass -- )
+    [ drop hide-glass ] [ button-down 1 ] set-action ;
+
+: fit-bounds ( loc dim max -- loc )
+    #! Adjust loc to fit inside max.
+    swap v- { 0 0 0 } vmax vmin ;
+
+: menu-loc ( menu -- loc )
+    hand rect-loc swap rect-dim world get rect-dim fit-bounds ;
+
 : show-menu ( menu -- )
-    hand screen-loc over set-rect-loc show-glass ;
+    dup show-glass
+    dup menu-loc swap set-rect-loc
+    world get world-glass menu-actions ;
 
 : menu-items ( assoc -- pile )
     #! Given an association list mapping labels to quotations.

diff --git a/library/ui/world.factor b/library/ui/world.factor
index 153c2f58d1d7dc7353359f74f69b16ffcf9432ab..59994f971afa5b742628500831fafcae63476c2c 100644 (file)
--- a/library/ui/world.factor
+++ b/library/ui/world.factor
@@ -38,8 +38,7 @@ C: world ( -- world )
 
 : show-glass ( gadget -- )
     hide-glass
-    <gadget> dup
-    world get 2dup add-gadget set-world-glass
+    <gadget> dup add-layer dup world get set-world-glass
     dupd add-gadget prefer ;
 
 : draw-world ( world -- )
@@ -54,8 +53,7 @@ DEFER: handle-event
     world get dup world-invalid >r layout-world r>
     [ dup world-hand update-hand draw-world ] [ drop ] ifte ;
 
-: next-event ( -- event ? )
-    <event> dup SDL_PollEvent ;
+: next-event ( -- event ? ) <event> dup SDL_PollEvent ;
 
 : run-world ( -- )
     #! Keep polling for events until there are no more events in