brillo-algorithms-2.0.0: Brillo/Data/Extent.hs

{-# LANGUAGE PatternGuards #-}

{-| Represents an integral rectangular area of the 2D plane.
  Using `Int`s (instead of `Float`s) for the bounds means we can safely
  compare extents for equality.
-}
module Brillo.Data.Extent (
  Extent,
  Coord,
  makeExtent,
  takeExtent,
  squareExtent,
  sizeOfExtent,
  isUnitExtent,
  coordInExtent,
  pointInExtent,
  centerCoordOfExtent,
  cutQuadOfExtent,
  quadOfCoord,
  pathToCoord,
  intersectSegExtent,
  touchesSegExtent,
)
where

import Brillo.Data.Point
import Brillo.Data.Quad
import Brillo.Geometry.Line
import Data.Maybe


{-| A rectangular area of the 2D plane.
  We keep the type abstract to ensure that invalid extents cannot be
  constructed.
-}
data Extent
  = Extent Int Int Int Int
  deriving (Eq, Show)


-- | An integral coordinate.
type Coord =
  (Int, Int)


{-| Construct an extent.
     The north value must be > south, and east > west, else `error`.
-}
makeExtent ::
  -- | y max (north)
  Int ->
  -- | y min (south)
  Int ->
  -- | x max (east)
  Int ->
  -- | x min (west)
  Int ->
  Extent
makeExtent n s e w
  | n >= s
  , e >= w =
      Extent n s e w
  | otherwise =
      error "Brillo.Geometry.Extent.makeExtent: invalid extent"


-- | Take the NSEW components of an extent.
takeExtent :: Extent -> (Int, Int, Int, Int)
takeExtent (Extent n s e w) =
  (n, s, e, w)


-- | A square extent of a given size.
squareExtent :: Int -> Extent
squareExtent i =
  Extent i 0 i 0


-- | Get the width and height of an extent.
sizeOfExtent :: Extent -> (Int, Int)
sizeOfExtent (Extent n s e w) =
  (e - w, n - s)


-- | Check if an extent is a square with a width and height of 1.
isUnitExtent :: Extent -> Bool
isUnitExtent extent =
  sizeOfExtent extent == (1, 1)


-- | Check whether a coordinate lies inside an extent.
coordInExtent :: Extent -> Coord -> Bool
coordInExtent (Extent n s e w) (x, y) =
  x >= w
    && x < e
    && y >= s
    && y < n


-- | Check whether a point lies inside an extent.
pointInExtent :: Extent -> Point -> Bool
pointInExtent (Extent n s e w) (x, y) =
  let n' = fromIntegral n
      s' = fromIntegral s
      e' = fromIntegral e
      w' = fromIntegral w
  in  x >= w'
        && x <= e'
        && y >= s'
        && y <= n'


-- | Get the coordinate that lies at the center of an extent.
centerCoordOfExtent :: Extent -> (Int, Int)
centerCoordOfExtent (Extent n s e w) =
  ( w + (e - w) `div` 2
  , s + (n - s) `div` 2
  )


-- | Cut one quadrant out of an extent.
cutQuadOfExtent :: Quad -> Extent -> Extent
cutQuadOfExtent quad (Extent n s e w) =
  let hheight = (n - s) `div` 2
      hwidth = (e - w) `div` 2
  in  case quad of
        NW -> Extent n (s + hheight) (e - hwidth) w
        NE -> Extent n (s + hheight) e (w + hwidth)
        SW -> Extent (n - hheight) s (e - hwidth) w
        SE -> Extent (n - hheight) s e (w + hwidth)


-- | Get the quadrant that this coordinate lies in, if any.
quadOfCoord :: Extent -> Coord -> Maybe Quad
quadOfCoord extent coord =
  listToMaybe $
    filter (\q -> coordInExtent (cutQuadOfExtent q extent) coord) $
      allQuads


-- | Constuct a path to a particular coordinate in an extent.
pathToCoord :: Extent -> Coord -> Maybe [Quad]
pathToCoord extent coord
  | isUnitExtent extent =
      Just []
  | otherwise =
      do
        quad <- quadOfCoord extent coord
        rest <- pathToCoord (cutQuadOfExtent quad extent) coord
        return $ quad : rest


{-| If a line segment (P1-P2) intersects the outer edge of an extent then
  return the intersection point, that is closest to P1, if any.
  If P1 is inside the extent then `Nothing`.

  @
                  P2
                 /
           ----/-
           | /  |
           +    |
          /------
        /
       P1
  @
-}
intersectSegExtent :: Point -> Point -> Extent -> Maybe Point
intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w')
  -- starts below extent
  | y1 < s
  , Just pos <- intersectSegHorzSeg p1 p2 s w e =
      Just pos
  -- starts above extent
  | y1 > n
  , Just pos <- intersectSegHorzSeg p1 p2 n w e =
      Just pos
  -- starts left of extent
  | x1 < w
  , Just pos <- intersectSegVertSeg p1 p2 w s n =
      Just pos
  -- starts right of extent
  | x1 > e
  , Just pos <- intersectSegVertSeg p1 p2 e s n =
      Just pos
  -- must be starting inside extent.
  | otherwise =
      Nothing
  where
    n = fromIntegral n'
    s = fromIntegral s'
    e = fromIntegral e'
    w = fromIntegral w'


{-| Check whether a line segment's endpoints are inside an extent, or if it
  intersects with the boundary.
-}
touchesSegExtent :: Point -> Point -> Extent -> Bool
touchesSegExtent p1 p2 extent =
  pointInExtent extent p1
    || pointInExtent extent p2
    || isJust (intersectSegExtent p1 p2 extent)