1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
module Rahm.Desktop.Geometry where
import Data.List (minimumBy, intercalate)
import Data.Maybe (listToMaybe)
import Data.Ord (comparing)
import Debug.Trace (trace, traceM)
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
left = rectX cand
right = rectX cand + rectWidth cand
top = rectY cand
bottom = rectY cand + rectHeight cand
dxToSpan
| rx < left = left - rx
| rx > right = rx - right
| otherwise = 0
dyToSpan
| ry < top = top - ry
| ry > bottom = ry - bottom
| otherwise = 0
in case dir of
N -> -- candidate above: nearest point is on its bottom edge
let dx = dxToSpan
dy = ry - bottom
in sqrt (dx*dx + dy*dy)
S -> -- candidate below: nearest point is on its top edge
let dx = dxToSpan
dy = top - ry
in sqrt (dx*dx + dy*dy)
W -> -- candidate left: nearest point is on its right edge
let dy = dyToSpan
dx = rx - right
in sqrt (dx*dx + dy*dy)
E -> -- candidate right: nearest point is on its left edge
let dy = dyToSpan
dx = left - rx
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, Show 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
|
