1 files changed, 108 insertions, 0 deletions
diff --git a/src/Rahm/Desktop/Geometry.hs b/src/Rahm/Desktop/Geometry.hs
new file mode 100644
index 0000000..a0e8c92
--- /dev/null
+++ b/src/Rahm/Desktop/Geometry.hs
@@ -0,0 +1,108 @@
+module Rahm.Desktop.Geometry where
+
+import Data.List (minimumBy)
+import Data.Maybe (listToMaybe)
+import Data.Ord (comparing)
+import Debug.Trace (trace)
+import Text.Printf (printf)
+
+data GeomRectangle = GeomRectangle
+  { rectX, rectY, rectWidth, rectHeight :: Double
+  }
+  deriving (Show, Eq)
+
+data Direction = N | S | E | W
+  deriving (Show, Eq, Enum, Bounded)
+
+center :: GeomRectangle -> (Double, Double)
+center r = (rectX r + rectWidth r / 2, rectY r + rectHeight r / 2)
+
+-- Distance from reference center to the closest point on candidate in the given direction
+-- Assumes candidate is wholly in the given direction (verified elsewhere)
+distanceToEdgeInDirection :: Direction -> GeomRectangle -> GeomRectangle -> Double
+distanceToEdgeInDirection dir ref cand =
+  let (rx, ry) = center ref
+      (cx, cy) = center cand
+      left   = rectX cand
+      right  = rectX cand + rectWidth cand
+      top    = rectY cand
+      bottom = rectY cand + rectHeight cand
+  in case dir of
+       N -> -- candidate is above: closest point is on bottom edge
+            let dx = if rx < left then left - rx else if rx > right then right - rx else 0
+                dy = top - ry
+            in sqrt (dx*dx + dy*dy)
+       S -> -- candidate is below: closest point is on top edge
+            let dx = if rx < left then left - rx else if rx > right then right - rx else 0
+                dy = ry - bottom
+            in sqrt (dx*dx + dy*dy)
+       W -> -- candidate is to the left: closest point is on right edge
+            let dy = if ry < top then top - ry else if ry > bottom then bottom - ry else 0
+                dx = left - rx
+            in sqrt (dx*dx + dy*dy)
+       E -> -- candidate is to the right: closest point is on left edge
+            let dy = if ry < top then top - ry else if ry > bottom then bottom - ry else 0
+                dx = rx - right
+            in sqrt (dx*dx + dy*dy)
+
+
+boundingBox :: [GeomRectangle] -> (Double, Double, Double, Double)
+boundingBox rs =
+  let xs = map rectX rs
+      ys = map rectY rs
+      xMaxes = zipWith (+) (map rectX rs) (map rectWidth rs)
+      yMaxes = zipWith (+) (map rectY rs) (map rectHeight rs)
+   in (minimum xs, minimum ys, maximum xMaxes - minimum xs, maximum yMaxes - minimum ys)
+
+translate :: GeomRectangle -> Double -> Double -> GeomRectangle
+translate r dx dy =
+  GeomRectangle (rectX r + dx) (rectY r + dy) (rectWidth r) (rectHeight r)
+
+-- "Wholly in direction": candidate is completely in direction, with no overlap
+whollyInDirection :: Direction -> GeomRectangle -> GeomRectangle -> Bool
+whollyInDirection N r1 r2 = bottomEdge r1 <= topEdge r2
+whollyInDirection S r1 r2 = topEdge r1 >= bottomEdge r2
+whollyInDirection E r1 r2 = leftEdge r1 >= rightEdge r2
+whollyInDirection W r1 r2 = rightEdge r1 <= leftEdge r2
+
+topEdge, bottomEdge, leftEdge, rightEdge :: GeomRectangle -> Double
+topEdge r = rectY r
+bottomEdge r = rectY r + rectHeight r
+leftEdge r = rectX r
+rightEdge r = rectX r + rectWidth r
+
+-- Generate up to 2 tile copies: original + one tile in direction
+tileCandidates :: Direction -> Double -> Double -> GeomRectangle -> [GeomRectangle]
+tileCandidates dir sw sh r =
+  case dir of
+    N -> [r, translate r 0 (-sh)]
+    S -> [r, translate r 0 sh]
+    W -> [r, translate r (-sw) 0]
+    E -> [r, translate r sw 0]
+
+closestInDirection ::
+  (Eq a) =>
+  [(GeomRectangle, a)] ->
+  a ->
+  Direction ->
+  Maybe (GeomRectangle, a)
+closestInDirection rects tag dir = do
+  ref <- listToMaybe [r | (r, t) <- rects, t == tag]
+  let allRects = map fst rects
+      (_, _, sw, sh) = boundingBox allRects
+      sw' = if sw == 0 then 1 else sw
+      sh' = if sh == 0 then 1 else sh
+
+  let candidates =
+        [ (r, t, distanceToEdgeInDirection dir ref virt)
+          | (r, t) <- rects,
+            t /= tag,
+            virt <- tileCandidates dir sw' sh' r,
+            whollyInDirection dir virt ref
+        ]
+
+  case candidates of
+    [] -> Nothing
+    _ -> Just (r, t)
+      where
+        (r, t, _) = minimumBy (comparing (\(_, _, d) -> d)) candidates