From c52ffebffe2b1c7af10de831bf59e2cda9733b09 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 8 Sep 2009 16:23:02 -0500
Subject: [PATCH] math.rectangles.positioning: don't position popups off-screen

---
 .../positioning/positioning-docs.factor       | 13 ++++++++++++
 .../positioning/positioning-tests.factor      | 21 ++++++++++++-------
 .../rectangles/positioning/positioning.factor | 10 ++++++++-
 3 files changed, 36 insertions(+), 8 deletions(-)
 create mode 100644 basis/math/rectangles/positioning/positioning-docs.factor

diff --git a/basis/math/rectangles/positioning/positioning-docs.factor b/basis/math/rectangles/positioning/positioning-docs.factor
new file mode 100644
index 0000000000..f5eb4f079d
--- /dev/null
+++ b/basis/math/rectangles/positioning/positioning-docs.factor
@@ -0,0 +1,13 @@
+USING: help.markup help.syntax math.rectangles ;
+IN: math.rectangles.positioning
+
+HELP: popup-rect
+{ $values { "visible-rect" rect } { "popup-dim" "a pair of real numbers" } { "screen-dim" "a pair of real numbers" } { "rect" rect } }
+{ $description "Calculates the position of a popup with a heuristic:"
+  { $list
+      { "The new rectangle must fit inside " { $snippet "screen-dim" } }
+      { "The new rectangle must not obscure " { $snippet "visible-rect" } }
+      { "The child must otherwise be as close as possible to the edges of " { $snippet "visible-rect" } }
+  }
+  "For example, when displaying a menu, " { $snippet "visible-rect" } " is a single point at the mouse location, and when displaying a completion popup, " { $snippet "visible-rect" } " contains the bounds of the text element being completed."
+} ;
diff --git a/basis/math/rectangles/positioning/positioning-tests.factor b/basis/math/rectangles/positioning/positioning-tests.factor
index a292775494..55ed7147d8 100644
--- a/basis/math/rectangles/positioning/positioning-tests.factor
+++ b/basis/math/rectangles/positioning/positioning-tests.factor
@@ -4,50 +4,57 @@ USING: tools.test math.rectangles math.rectangles.positioning ;
 IN: math.rectangles.positioning.tests
 
 [ T{ rect f { 0 1 } { 30 30 } } ] [
-    { 0 0 } { 1 1 } <rect>
+    T{ rect f { 0 0 } { 1 1 } }
     { 30 30 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 10 21 } { 30 30 } } ] [
-    { 10 20 } { 1 1 } <rect>
+    T{ rect f { 10 20 } { 1 1 } }
     { 30 30 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 10 30 } { 30 30 } } ] [
-    { 10 20 } { 1 10 } <rect>
+    T{ rect f { 10 20 } { 1 10 } }
     { 30 30 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 20 20 } { 80 30 } } ] [
-    { 40 10 } { 1 10 } <rect>
+    T{ rect f { 40 10 } { 1 10 } }
     { 80 30 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 50 20 } { 50 50 } } ] [
-    { 50 70 } { 0 0 } <rect>
+    T{ rect f { 50 70 } { 0 0 } }
     { 50 50 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 0 20 } { 50 50 } } ] [
-    { -50 70 } { 0 0 } <rect>
+    T{ rect f { -50 70 } { 0 0 } }
     { 50 50 }
     { 100 100 }
     popup-rect
 ] unit-test
 
 [ T{ rect f { 0 50 } { 50 50 } } ] [
-    { 0 50 } { 0 0 } <rect>
+    T{ rect f { 0 50 } { 0 0 } }
     { 50 60 }
     { 100 100 }
     popup-rect
+] unit-test
+
+[ T{ rect f { 0 90 } { 10 10 } } ] [
+    T{ rect f { 0 1000 } { 0 0 } }
+    { 10 10 }
+    { 100 100 }
+    popup-rect
 ] unit-test
\ No newline at end of file
diff --git a/basis/math/rectangles/positioning/positioning.factor b/basis/math/rectangles/positioning/positioning.factor
index 4b1a60a627..6b1348ca88 100644
--- a/basis/math/rectangles/positioning/positioning.factor
+++ b/basis/math/rectangles/positioning/positioning.factor
@@ -1,13 +1,18 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences kernel accessors math math.vectors
-math.rectangles math.order arrays locals
+math.rectangles math.order arrays locals fry
 combinators.short-circuit ;
 IN: math.rectangles.positioning
 
 ! Some geometry code for positioning popups and menus
 ! in a semi-intelligent manner
 
+<PRIVATE
+
+: adjust-visible-rect ( visible-rect popup-dim screen-dim -- visible-rect' )
+    [ drop clone ] dip '[ _ vmin ] change-loc ;
+
 : popup-x ( visible-rect popup-dim screen-dim -- x )
     [ loc>> first ] 2dip swap [ first ] bi@ - min 0 max ;
 
@@ -33,5 +38,8 @@ IN: math.rectangles.positioning
 :: popup-dim ( loc popup-dim screen-dim -- dim )
     screen-dim loc v- popup-dim vmin ;
 
+PRIVATE>
+
 : popup-rect ( visible-rect popup-dim screen-dim -- rect )
+    [ adjust-visible-rect ] 2keep
     [ popup-loc dup ] 2keep popup-dim <rect> ;
\ No newline at end of file