Factor out menu and popup positioning into math.rectangles.positioning, and write tests for it

basis/math/rectangles/positioning/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/math/rectangles/positioning/positioning-tests.factor

@@ -0,0 +1,39 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test math.rectangles math.rectangles.positioning ;
+IN: math.rectangles.positioning.tests
+
+[ { 0 1 } ] [
+    { 0 0 } { 1 1 } <rect>
+    { 30 30 }
+    { 100 100 }
+    popup-loc
+] unit-test
+
+[ { 10 21 } ] [
+    { 10 20 } { 1 1 } <rect>
+    { 30 30 }
+    { 100 100 }
+    popup-loc
+] unit-test
+
+[ { 10 30 } ] [
+    { 10 20 } { 1 10 } <rect>
+    { 30 30 }
+    { 100 100 }
+    popup-loc
+] unit-test
+
+[ { 20 20 } ] [
+    { 40 10 } { 1 10 } <rect>
+    { 80 30 }
+    { 100 100 }
+    popup-loc
+] unit-test
+
+[ { 50 20 } ] [
+    { 50 70 } { 0 0 } <rect>
+    { 50 50 }
+    { 100 100 }
+    popup-loc
+] unit-test

basis/math/rectangles/positioning/positioning.factor

@@ -0,0 +1,25 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences kernel accessors math math.order arrays ;
+IN: math.rectangles.positioning
+
+! Some geometry code for positioning popups and menus
+! in a semi-intelligent manner
+
+: popup-x ( visible-rect popup-dim screen-dim -- x )
+    [ loc>> first ] 2dip swap [ first ] bi@ - min ;
+
+: preferred-y ( visible-rect -- y )
+    [ loc>> ] [ dim>> ] bi [ second ] bi@ + ;
+
+: alternate-y ( visible-rect popup-dim -- y )
+    [ loc>> ] dip [ second ] bi@ - ;
+
+: popup-fits? ( visible-rect popup-dim screen-dim -- ? )
+    [ [ preferred-y ] [ second ] bi* + ] dip second < ;
+
+: popup-y ( visible-rect popup-dim screen-dim -- y )
+    3dup popup-fits? [ 2drop preferred-y ] [ drop alternate-y ] if ;
+
+: popup-loc ( visible-rect popup-dim screen-dim -- loc )
+    [ popup-x ] [ popup-y ] 3bi 2array ;

basis/ui/gadgets/menus/menus.factor

@@ -1,13 +1,15 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: locals accessors kernel math namespaces sequences math.vectors
-colors colors.constants math.rectangles ui.commands ui.operations
-ui.gadgets ui.gadgets.buttons ui.gadgets.worlds ui.gestures
-ui.gadgets.theme ui.gadgets.packs ui.gadgets.glass ui.gadgets.borders ;
+math.rectangles.positioning colors colors.constants math.rectangles
+ui.commands ui.operations ui.gadgets ui.gadgets.buttons
+ui.gadgets.worlds ui.gestures ui.gadgets.theme ui.gadgets.packs
+ui.gadgets.glass ui.gadgets.borders ;
 IN: ui.gadgets.menus
 
 : menu-loc ( world menu -- loc )
-    [ dim>> ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
+    [ hand-loc get { 0 0 } <rect> ] 2dip
+    pref-dim swap dim>> popup-loc ;
 
 : show-menu ( owner menu -- )
     [ find-world ] dip 2dup menu-loc show-glass ;

basis/ui/tools/listener/listener.factor

@@ -91,7 +91,11 @@ M: input (print-input)
     [ string>> H{ { font-style bold } } format ] with-nesting nl ;
 
 M: word (print-input)
-    "Command: " write . ;
+    "Command: "
+    [
+        "sans-serif" font-name set
+        bold font-style set
+    ] H{ } make-assoc format . ;
 
 : print-input ( object interactor -- )
     output>> [ (print-input) ] with-output-stream* ;

basis/ui/tools/listener/popups/popups.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors documents.elements kernel math math.vectors
-sequences ui.gadgets ui.gadgets.editors ui.gadgets.glass
-ui.gadgets.tracks ui.gadgets.wrappers
-ui.gadgets.worlds ui.gestures ;
+math.rectangles math.rectangles.positioning sequences ui.gadgets
+ui.gadgets.editors ui.gadgets.glass ui.gadgets.tracks
+ui.gadgets.wrappers ui.gadgets.worlds ui.gestures ;
 IN: ui.tools.listener.popups
 
 SLOT: popup
@@ -25,34 +25,26 @@ popup H{
     { T{ key-down f f "ESC" } [ hide-popup ] }
 } set-gestures
 
-CONSTANT: popup-offset { -4 0 }
-
-: (popup-loc) ( interactor element -- loc )
+: caret-loc ( interactor element -- loc )
     [ drop screen-loc ] [
         [
             [ [ editor-caret ] [ model>> ] bi ] dip
             prev-elt
         ] [ drop ] 2bi
         loc>point
-    ] 2bi v+ popup-offset v+ ;
+    ] 2bi v+ ;
 
-: popup-loc-1 ( interactor element -- loc )
-    [ (popup-loc) ] [ drop caret-dim ] 2bi v+ ;
+: relevant-rect ( popup -- rect )
+    [ interactor>> ] [ element>> ] bi
+    [ caret-loc ] [ drop caret-dim { 0 1 } v+ ] 2bi
+    <rect> ;
 
-: popup-loc-2 ( interactor element popup -- loc )
-    [ (popup-loc) ] dip pref-dim { 0 1 } v* v- ;
-
-: popup-fits? ( interactor element popup -- ? )
-    [ [ popup-loc-1 ] dip pref-dim v+ ]
-    [ 2drop find-world dim>> ]
-    3bi [ second ] bi@ <= ;
-
-: popup-loc ( popup -- loc )
-    [ interactor>> ] [ element>> ] [ ] tri 3dup popup-fits?
-    [ drop popup-loc-1 ] [ popup-loc-2 ] if ;
+: listener-popup-loc ( popup -- loc )
+    [ relevant-rect ] [ pref-dim ] [ interactor>> find-world dim>> ] tri
+    popup-loc ;
 
 : show-popup ( interactor element popup -- )
     <popup>
     [ dup interactor>> (>>popup) ]
-    [ [ interactor>> find-world ] [ ] [ popup-loc ] tri show-glass ]
+    [ [ interactor>> find-world ] [ ] [ listener-popup-loc ] tri show-glass ]
     bi ;