-- Simple rectangular regions

module Rect ( Rect (..)
            , rectFromCorners, rectFromCenterSize, mkRect
            , rectLL, rectUR, rectLR, rectUL
            , rectCenter, rectSize
            , overlapRects,emptyRect,isEmptyRect,unionRect
            , intersectRect, expandRect, rectContains
            , rectHeight, rectWidth,increaseRect
            ) where

import BaseTypes
import Point2
import Vector2
import VectorSpace
import Transform2

-- Rectangular region for cropping.
-- The datatype constructor has lower-left and upper-right
data Rect = RectLLUR Point2 Point2 deriving (Read,Show)

-- Alternative: we might want to ensure that only valid rectangles are
-- constructed, and have a separate EmptyRect constructor.  See Meurig
-- Sage's version.  (Email Nov 5, 1998).
-- 
-- I don't know what's really the best thing to do.  An alternative is to
-- require that rectangles are proper, and then use Maybe Rect where
-- necessary.  (Intersection of rectangles would produce a Maybe Rect.)
-- Another is to interpreting rectangles to be open instead of closed, or
-- maybe closed on the bottom and left but open on the top and right.  An
-- empty rectangle is then one in which top==bottom or left==right.  In
-- such a case the center is as usual.  Intersection however, would be
-- strange: which empty rectangle to use?

isEmptyRect :: Rect -> Bool
isEmptyRect (RectLLUR (Point2XY minx miny) (Point2XY maxx maxy)) =
  maxx < minx || maxy < miny

instance Eq Rect where
 r1@(RectLLUR ll1 ur1) == r2@(RectLLUR ll2 ur2) =
   (isEmptyRect r1 && isEmptyRect r2) || ll1==ll2 && ur1==ur2

overlapRects :: Rect -> Rect -> Bool
overlapRects r1@(RectLLUR (Point2XY x1 y1) (Point2XY x2 y2)) 
             r2@(RectLLUR (Point2XY x3 y3) (Point2XY x4 y4)) = 
  not (isEmptyRect r1) && not (isEmptyRect r2) &&
  olap_ival x1 x2 x3 x4 && olap_ival y1 y2 y3 y4

olap_ival :: Double -> Double -> Double ->Double -> Bool
olap_ival a b c d 
 = if a > c then
      olap_ival c d a b
    else if b < c then
       False
    else
       True

emptyRect :: Rect
emptyRect = RectLLUR (Point2XY 1 1) (Point2XY 0 0)

mkRect :: Point2 -> Vector2 -> Rect
mkRect p v = 
  RectLLUR p (p .+^ v)

rectWidth, rectHeight :: Rect -> RealVal
rectWidth (RectLLUR (Point2XY x1 y1) (Point2XY x2 y2)) = 
 max 0 (x2 - x1)
rectHeight (RectLLUR (Point2XY x1 y1) (Point2XY x2 y2)) = 
 max 0 (y2 - y1)

rectFromCorners :: Point2 -> Point2 -> Rect
rectFromCorners p@(Point2XY x1 y1) (Point2XY x2 y2) =
  RectLLUR (Point2XY (x1 `min` x2) (y1 `min` y2))
           (Point2XY (x1 `max` x2) (y1 `max` y2))

rectLL, rectUR, rectLR, rectUL :: Rect -> Point2
rectLL (RectLLUR ll _) = ll
rectUR (RectLLUR _ ur) = ur

rectLR (RectLLUR (Point2XY minx miny) (Point2XY maxx maxy)) =
 Point2XY maxx miny
rectUL (RectLLUR (Point2XY minx miny) (Point2XY maxx maxy)) =
 Point2XY minx maxy


rectFromCenterSize :: Point2 -> Vector2 -> Rect
rectFromCenterSize p v = RectLLUR (p .-^ halfV) (p .+^ halfV)
 where
   halfV = v ^/ 2

rectCenter :: Rect -> Point2
rectCenter (RectLLUR (Point2XY minx miny) (Point2XY maxx maxy)) =
  Point2XY (minx `av` maxx) (miny `av` maxy)
 where
   a `av` b = (a + b)/2

rectSize :: Rect -> Vector2
rectSize r@(RectLLUR (Point2XY minx miny) (Point2XY maxx maxy)) =
  if isEmptyRect r then 0 else Vector2XY (maxx - minx) (maxy - miny)

intersectRect :: Rect -> Rect -> Rect
intersectRect (RectLLUR (Point2XY minx1 miny1) (Point2XY maxx1 maxy1))
              (RectLLUR (Point2XY minx2 miny2) (Point2XY maxx2 maxy2)) =
  RectLLUR (point2XY (minx1 `max` minx2) (miny1 `max` miny2))
           (point2XY (maxx1 `min` maxx2) (maxy1 `min` maxy2))

unionRect :: Rect -> Rect -> Rect
unionRect r1@(RectLLUR (Point2XY minx1 miny1) (Point2XY maxx1 maxy1))
          r2@(RectLLUR (Point2XY minx2 miny2) (Point2XY maxx2 maxy2))
 | isEmptyRect r1 = r2
 | isEmptyRect r2 = r1
 | otherwise      =
     RectLLUR (point2XY (minx1 `min` minx2) (miny1 `min` miny2))
              (point2XY (maxx1 `max` maxx2) (maxy1 `max` maxy2))


instance Transformable2 Rect where
 xf@(Transform2 _ _ 0) *% RectLLUR ll ur =
   rectFromCorners (xf *% ll) (xf *% ur)
 _ *% _ = error "Rotation not supported on Rect"


-- Expand a rect about its center
expandRect :: RealVal -> Rect -> Rect
expandRect s rect =
  rectFromCenterSize (rectCenter rect)
                     (s *^ rectSize rect)

increaseRect :: Vector2 -> Rect -> Rect
increaseRect v rect = 
  rectFromCenterSize (rectCenter rect) (v ^+^ rectSize rect)

-- Containment, considering the box to be closed
rectContains :: Rect -> Point2 -> Bool
rectContains (RectLLUR (Point2XY minx miny) (Point2XY maxx maxy))
             (Point2XY x y) =
  minx <= x && x <= maxx  &&  miny <= y && y <= maxy


-- Tests.  Comment out the matching "{-" and "-}" lines
{-
r1 = rectFromCorners (point2XY 0   0  ) (point2XY 1   1  )
r2 = rectFromCorners (point2XY 0.5 0.5) (point2XY 1.5 1.5)
r3 = rectFromCorners (point2XY 1.5 1.5) (point2XY 2.5 2.5)

r4 = r1 `unionRect` r2
r5 = r1 `intersectRect` r2
r6 = r1 `intersectRect` r3              -- empty

rb1 = isEmptyRect r4                    -- False
rb2 = isEmptyRect r6                    -- True

r7 = r6 `unionRect` r2
r8 = r6 `intersectRect` r2

rb3 = r7 == r2                          -- True
rb4 = isEmptyRect r8                    -- True
-}
