From 8676c3830b675c5a10a580d4b3ab076e7605e6ab Mon Sep 17 00:00:00 2001
From: Paul Chiusano <paul.chiusano@gmail.com>
Date: Wed, 17 Sep 2014 13:08:28 -0400
Subject: [PATCH] tweaks to hit testing

---
 editor/Main.elm          |  4 ++--
 editor/Unison/Layout.elm | 44 +++++++++++++++++++++++++++-------------
 2 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/editor/Main.elm b/editor/Main.elm
index d49597ef4..7b8d706b9 100644
--- a/editor/Main.elm
+++ b/editor/Main.elm
@@ -29,11 +29,11 @@ scene : Int -> (Int,Int) -> Element
 scene w (x,y) =
   let layout = E.layout expr { key = "bar", availableWidth = w - 50, metadata h = MD.anonymousTerm }
       dummy = S.codeText "w00t"
-      paths = L.atRanked (Array.length . .path) layout (L.Pt (x-50) (y-100))
+      paths = L.atRanked (Array.length . .path) layout (L.Region (L.Pt (x-48) (y-98)) 2 2)
       isPrefix a b = a.hash == "bar" && Path.startsWith a.path b.path
       region = case paths of
         [] -> Nothing
-        _ -> L.selectableLub .selectable (L.region isPrefix layout (last paths))
+        _ -> L.selectableLub .selectable (L.region isPrefix layout (head (head paths)))
       selection = maybe Element.empty (S.selection layout) region
   in flow down
           [ spacer 50 1 `Element.beside` Element.height 100 (S.codeText ("paths: " ++ show paths))
diff --git a/editor/Unison/Layout.elm b/editor/Unison/Layout.elm
index fbdea130f..05ff456c3 100644
--- a/editor/Unison/Layout.elm
+++ b/editor/Unison/Layout.elm
@@ -134,13 +134,22 @@ region prefixOf l ks =
   in go (Pt 0 0) ks l
 
 {-| Find all tags whose region contains the given point. -}
-at : Layout k -> Pt -> [k]
-at l pt =
+at : Layout k -> Region -> [k]
+at l r =
   let
-    within : Pt -> Int -> Int -> Pt -> Bool
-    within topLeft w h pt =
-      pt.x >= topLeft.x && pt.x <= topLeft.x + w &&
-      pt.y >= topLeft.y && pt.y <= topLeft.y + h
+    bx1 = r.topLeft.x
+    by1 = r.topLeft.y
+    bx2 = bx1 + r.width
+    by2 = by1 + r.height
+
+    -- See http://silentmatt.com/rectangle-intersection/ for why this works
+    intersects : Pt -> Int -> Int -> Bool
+    intersects topLeft w h =
+      let ax1 = topLeft.x
+          ay1 = topLeft.y
+          ax2 = ax1 + w
+          ay2 = ay1 + h
+      in ax1 < bx2 && ax2 > bx1 && ay1 < by2 && ay2 > by1
 
     distinctCons : a -> [a] -> [a]
     distinctCons h t = case t of
@@ -148,7 +157,7 @@ at l pt =
       ht :: tt -> if ht == h then t else h :: t
 
     go origin (Layout layout e k) =
-      if not (within origin (E.widthOf e) (E.heightOf e) pt)
+      if not (intersects origin (E.widthOf e) (E.heightOf e))
       then []
       else k `distinctCons` case layout of
         Beside left right ->
@@ -164,14 +173,21 @@ at l pt =
 
   in go (Pt 0 0) l
 
-{-| Find all tags whose region contains the given point,
-    ordering results by the given ranking function
-    (the highest rank k will be last in the returned list).
+{-| Find all tags whose region intersects the given region,
+    ordering and grouping results by the given ranking function.
+    The first group returned will consist of elements with the
+    highest rank, followed by elements with the next highest rank, etc.
 -}
-atRanked : (k -> Int) -> Layout k -> Pt -> [k]
-atRanked rank l pt =
-  let ks = at l pt ++ at l { pt | x <- pt.x + 1, y <- pt.x + 1 }
-  in sortBy rank ks
+atRanked : (k -> Int) -> Layout k -> Region -> [[k]]
+atRanked rank l r =
+  let f k = (rank k, k)
+      g (i, k) (i2, cur, acc) =
+        if i == i2 then (i2, k :: cur, acc)
+        else            (i, [k], reverse cur :: acc)
+      done (_, cur, acc) = reverse cur :: acc
+  in case map f (at l r) |> sortBy fst of
+    [] -> []
+    (i,k) :: tl -> foldl g (i, [k], []) tl |> done
 
 lub : Region -> Region -> Region
 lub r1 r2 =