module Rects where
import Geometry

--newtype Region = Region [Rect]

intersectRects :: [Rect] -> Rect -> [Rect]
intersectRects [Rect]
rs (Rect Point
p2 Point
s2) = [Rect] -> [Rect]
ir [Rect]
rs
  where
    br2 :: Point
br2 = Point
p2Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
s2
    ir :: [Rect] -> [Rect]
ir [] = []
    ir (Rect Point
p1 Point
s1:[Rect]
es) =
      let ul :: Point
ul = Point -> Point -> Point
pmax Point
p1 Point
p2
          br :: Point
br = Point -> Point -> Point
pmin (Point
p1Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
s1) Point
br2
	  s :: Point
s@(Point Int
w Int
h) = Point
brPoint -> Point -> Point
forall a. Num a => a -> a -> a
-Point
ul
      in if Int
wInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 Bool -> Bool -> Bool
|| Int
hInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 then [Rect] -> [Rect]
ir [Rect]
es else Point -> Point -> Rect
Rect Point
ul Point
sRect -> [Rect] -> [Rect]
forall a. a -> [a] -> [a]
:[Rect] -> [Rect]
ir [Rect]
es

overlaps :: Rect -> Rect -> Bool
overlaps (Rect (Point Int
x1 Int
y1) (Point Int
w1 Int
h1))
         (Rect (Point Int
x2 Int
y2) (Point Int
w2 Int
h2)) =
  Int
x1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w2 Bool -> Bool -> Bool
&& Int
x2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w1 Bool -> Bool -> Bool
&& Int
y1Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h2 Bool -> Bool -> Bool
&& Int
y2Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h1
--x1<=x2+w2 && x2<=x1+w1 && y1<=y2+h2 && y2<=y1+h1
-- rR 0 0 10 10 doesn't overlap with rR 0 10 10 10

boundingRect :: Rect -> Rect -> Rect
boundingRect r1 :: Rect
r1@(Rect Point
p1 Point
s1) r2 :: Rect
r2@(Rect Point
p2 Point
s2) =
    if Point
s1Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==Point
0 then Rect
r2 else if Point
s2Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
==Point
0 then Rect
r1 else Point -> Point -> Rect
Rect Point
p Point
s
  where p :: Point
p = Point -> Point -> Point
pmin Point
p1 Point
p2
        s :: Point
s = Point -> Point -> Point
pmax (Point
p1Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
s1) (Point
p2Point -> Point -> Point
forall a. Num a => a -> a -> a
+Point
s2) Point -> Point -> Point
forall a. Num a => a -> a -> a
- Point
p

diffRect :: Rect -> Rect -> [Rect]
diffRect Rect
r1 r2 :: Rect
r2@(Rect (Point Int
x2 Int
y2) (Point Int
w2 Int
h2)) =
    if Rect -> Rect -> Bool
overlaps Rect
r1 Rect
r2 -- faster handling of common(?) case
    then [Rect] -> Rect -> [Rect]
intersectRects [Rect]
outside_r2 Rect
r1
    else [Rect
r1]
  where
    u :: Rect
u@(Rect p1 :: Point
p1@(Point Int
x1 Int
y1) s1 :: Point
s1@(Point Int
w1 Int
h1)) = Rect -> Rect -> Rect
boundingRect Rect
r1 Rect
r2
    outside_r2 :: [Rect]
outside_r2 = [Rect
a,Rect
b,Rect
c,Rect
d]
    a :: Rect
a = Point -> Point -> Rect
Rect Point
p1 (Int -> Int -> Point
Point Int
w1 (Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
y1))
    b :: Rect
b = Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x1 Int
y2) (Int -> Int -> Point
Point (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x1) Int
h2)
    c :: Rect
c = Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
xc Int
y2) (Int -> Int -> Point
Point (Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
xc) Int
h2) where xc :: Int
xc = Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w2
    d :: Rect
d = Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x1 Int
yd) (Int -> Int -> Point
Point Int
w1 (Int
y1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
yd)) where yd :: Int
yd = Int
y2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h2

{-
    u:
       +-----------------------------+
       |            a                |
       |                             |
       +--------+-------+------------+
       |   b    |  r2   |     c      |
       |        |       |            |
       +--------+-------+------------+
       |                             |
       |             d               |
       |                             |
       +-----------------------------+
-}