{-# LANGUAGE PatternGuards #-}

{-| Geometric functions concerning lines and segments.

  A @Line@ is taken to be infinite in length, while a @Seg@ is finite length
  line segment represented by its two endpoints.
-}
module Brillo.Geometry.Line (
  segClearsBox,

  -- * Closest points
  closestPointOnLine,
  closestPointOnLineParam,

  -- * Line-Line intersection
  intersectLineLine,

  -- * Seg-Line intersection
  intersectSegLine,
  intersectSegHorzLine,
  intersectSegVertLine,

  -- * Seg-Seg intersection
  intersectSegSeg,
  intersectSegHorzSeg,
  intersectSegVertSeg,
)
where

import Brillo.Data.Point
import Brillo.Data.Point.Arithmetic qualified as Pt
import Brillo.Data.Vector


-- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.
segClearsBox
  :: Point
  -- ^ P1 First point of segment.
  -> Point
  -- ^ P2 Second point of segment.
  -> Point
  -- ^ P3 Lower left point of box.
  -> Point
  -- ^ P4 Upper right point of box.
  -> Bool
segClearsBox :: Point -> Point -> Point -> Point -> Bool
segClearsBox (Float
x1, Float
y1) (Float
x2, Float
y2) (Float
xa, Float
ya) (Float
xb, Float
yb)
  | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
xa, Float
x2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
xa = Bool
True
  | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
xb, Float
x2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
xb = Bool
True
  | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
ya, Float
y2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
ya = Bool
True
  | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
yb, Float
y2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
yb = Bool
True
  | Bool
otherwise = Bool
False


{-| Given an infinite line which intersects `P1` and `P1`,
     return the point on that line that is closest to `P3`
-}
closestPointOnLine
  :: Point
  -- ^ `P1`
  -> Point
  -- ^ `P2`
  -> Point
  -- ^ `P3`
  -> Point
  -- ^ the point on the line P1-P2 that is closest to `P3`
{-# INLINE closestPointOnLine #-}
closestPointOnLine :: Point -> Point -> Point -> Point
closestPointOnLine Point
p1 Point
p2 Point
p3 =
  Point
p1 Point -> Point -> Point
Pt.+ (Float
u Float -> Point -> Point
`mulSV` (Point
p2 Point -> Point -> Point
Pt.- Point
p1))
  where
    u :: Float
u = Point -> Point -> Point -> Float
closestPointOnLineParam Point
p1 Point
p2 Point
p3


{-| Given an infinite line which intersects P1 and P2,
     let P4 be the point on the line that is closest to P3.

     Return an indication of where on the line P4 is relative to P1 and P2.

@
     if P4 == P1 then 0
     if P4 == P2 then 1
     if P4 is halfway between P1 and P2 then 0.5
@

@
       |
      P1
       |
    P4 +---- P3
       |
      P2
       |
@
-}
{-# INLINE closestPointOnLineParam #-}
closestPointOnLineParam
  :: Point
  -- ^ `P1`
  -> Point
  -- ^ `P2`
  -> Point
  -- ^ `P3`
  -> Float
closestPointOnLineParam :: Point -> Point -> Point -> Float
closestPointOnLineParam Point
p1 Point
p2 Point
p3 =
  (Point
p3 Point -> Point -> Point
Pt.- Point
p1) Point -> Point -> Float
`dotV` (Point
p2 Point -> Point -> Point
Pt.- Point
p1)
    Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Point
p2 Point -> Point -> Point
Pt.- Point
p1) Point -> Point -> Float
`dotV` (Point
p2 Point -> Point -> Point
Pt.- Point
p1)


-- Line-Line intersection -----------------------------------------------------

{-| Given four points specifying two lines, get the point where the two lines
  cross, if any. Note that the lines extend off to infinity, so the
  intersection point might not line between either of the two pairs of points.

@
    \\      /
     P1  P4
      \\ /
       +
      / \\
     P3  P2
    /     \\
@
-}
intersectLineLine
  :: Point
  -- ^ `P1`
  -> Point
  -- ^ `P2`
  -> Point
  -- ^ `P3`
  -> Point
  -- ^ `P4`
  -> Maybe Point
intersectLineLine :: Point -> Point -> Point -> Point -> Maybe Point
intersectLineLine (Float
x1, Float
y1) (Float
x2, Float
y2) (Float
x3, Float
y3) (Float
x4, Float
y4) =
  let dx12 :: Float
dx12 = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x2
      dx34 :: Float
dx34 = Float
x3 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x4

      dy12 :: Float
dy12 = Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y2
      dy34 :: Float
dy34 = Float
y3 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y4

      den :: Float
den = Float
dx12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy34 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dy12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx34
  in  if Float
den Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
        then Maybe Point
forall a. Maybe a
Nothing
        else
          let
            det12 :: Float
det12 = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x2
            det34 :: Float
det34 = Float
x3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y4 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x4

            numx :: Float
numx = Float
det12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx34 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dx12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
det34
            numy :: Float
numy = Float
det12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy34 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
dy12 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
det34
          in
            Point -> Maybe Point
forall a. a -> Maybe a
Just (Float
numx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
den, Float
numy Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
den)


-- Segment-Line intersection --------------------------------------------------

{-| Get the point where a segment @P1-P2@ crosses an infinite line @P3-P4@,
  if any.
-}
intersectSegLine
  :: Point
  -- ^ `P1`
  -> Point
  -- ^ `P2`
  -> Point
  -- ^ `P3`
  -> Point
  -- ^ `P4`
  -> Maybe Point
intersectSegLine :: Point -> Point -> Point -> Point -> Maybe Point
intersectSegLine Point
p1 Point
p2 Point
p3 Point
p4
  -- TODO: merge closest point check with intersection, reuse subterms.
  | Just Point
p0 <- Point -> Point -> Point -> Point -> Maybe Point
intersectLineLine Point
p1 Point
p2 Point
p3 Point
p4
  , Float
t12 <- Point -> Point -> Point -> Float
closestPointOnLineParam Point
p1 Point
p2 Point
p0
  , Float
t12 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
t12 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1 =
      Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p0
  | Bool
otherwise =
      Maybe Point
forall a. Maybe a
Nothing


{-| Get the point where a segment crosses a horizontal line, if any.

@
               + P1
              /
      -------+---------
            /        y0
        P2 +
@
-}
intersectSegHorzLine
  :: Point
  -- ^ P1 First point of segment.
  -> Point
  -- ^ P2 Second point of segment.
  -> Float
  -- ^ y value of line.
  -> Maybe Point
intersectSegHorzLine :: Point -> Point -> Float -> Maybe Point
intersectSegHorzLine (Float
x1, Float
y1) (Float
x2, Float
y2) Float
y0
  -- seg is on line
  | Float
y1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y0, Float
y2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is above line
  | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
y0, Float
y2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
y0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is below line
  | Float
y1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
y0, Float
y2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
y0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is a single point on the line.
  -- this should be caught by the first case,
  -- but we'll test for it anyway.
  | Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 =
      Point -> Maybe Point
forall a. a -> Maybe a
Just (Float
x1, Float
y1)
  | Bool
otherwise =
      Point -> Maybe Point
forall a. a -> Maybe a
Just
        ( (Float
y0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x1
        , Float
y0
        )


{-| Get the point where a segment crosses a vertical line, if any.

@
             |
             |   + P1
             | /
             +
           / |
      P2 +   |
             | x0
@
-}
intersectSegVertLine
  :: Point
  -- ^ P1 First point of segment.
  -> Point
  -- ^ P2 Second point of segment.
  -> Float
  -- ^ x value of line.
  -> Maybe Point
intersectSegVertLine :: Point -> Point -> Float -> Maybe Point
intersectSegVertLine (Float
x1, Float
y1) (Float
x2, Float
y2) Float
x0
  -- seg is on line
  | Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x0, Float
x2 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is to right of line
  | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
x0, Float
x2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
x0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is to left of line
  | Float
x1 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
x0, Float
x2 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
x0 = Maybe Point
forall a. Maybe a
Nothing
  -- seg is a single point on the line.
  -- this should be caught by the first case,
  -- but we'll test for it anyway.
  | Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1 Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 =
      Point -> Maybe Point
forall a. a -> Maybe a
Just (Float
x1, Float
y1)
  | Bool
otherwise =
      Point -> Maybe Point
forall a. a -> Maybe a
Just
        ( Float
x0
        , (Float
x0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y1
        )


-- Segment-Segment intersection -----------------------------------------------

{-| Get the point where a segment @P1-P2@ crosses another segement @P3-P4@,
  if any.
-}
intersectSegSeg
  :: Point
  -- ^ `P1`
  -> Point
  -- ^ `P2`
  -> Point
  -- ^ `P3`
  -> Point
  -- ^ `P4`
  -> Maybe Point
intersectSegSeg :: Point -> Point -> Point -> Point -> Maybe Point
intersectSegSeg Point
p1 Point
p2 Point
p3 Point
p4
  -- TODO: merge closest point checks with intersection, reuse subterms.
  | Just Point
p0 <- Point -> Point -> Point -> Point -> Maybe Point
intersectLineLine Point
p1 Point
p2 Point
p3 Point
p4
  , Float
t12 <- Point -> Point -> Point -> Float
closestPointOnLineParam Point
p1 Point
p2 Point
p0
  , Float
t23 <- Point -> Point -> Point -> Float
closestPointOnLineParam Point
p3 Point
p4 Point
p0
  , Float
t12 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
t12 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1
  , Float
t23 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
t23 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1 =
      Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p0
  | Bool
otherwise =
      Maybe Point
forall a. Maybe a
Nothing


{-| Check if an arbitrary segment intersects a horizontal segment.

@
                + P2
               /
(xa, y3)  +---+----+ (xb, y3)
             /
         P1 +
@
-}
intersectSegHorzSeg
  :: Point
  -- ^ P1 First point of segment.
  -> Point
  -- ^ P2 Second point of segment.
  -> Float
  -- ^ (y3) y value of horizontal segment.
  -> Float
  -- ^ (xa) Leftmost x value of horizontal segment.
  -> Float
  -- ^ (xb) Rightmost x value of horizontal segment.
  -> Maybe Point
  -- ^ (x3, y3) Intersection point, if any.
intersectSegHorzSeg :: Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegHorzSeg p1 :: Point
p1@(Float
x1, Float
y1) p2 :: Point
p2@(Float
x2, Float
y2) Float
y0 Float
xa Float
xb
  | Point -> Point -> Point -> Point -> Bool
segClearsBox Point
p1 Point
p2 (Float
xa, Float
y0) (Float
xb, Float
y0) =
      Maybe Point
forall a. Maybe a
Nothing
  | Float
x0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
xa = Maybe Point
forall a. Maybe a
Nothing
  | Float
x0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
xb = Maybe Point
forall a. Maybe a
Nothing
  | Bool
otherwise = Point -> Maybe Point
forall a. a -> Maybe a
Just (Float
x0, Float
y0)
  where
    x0 :: Float
x0
      | (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float
x1
      | Bool
otherwise = (Float
y0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x1


{-| Check if an arbitrary segment intersects a vertical segment.

@
     (x3, yb) +
              |   + P1
              | /
              +
            / |
       P2 +   |
              + (x3, ya)
@
-}
intersectSegVertSeg
  :: Point
  -- ^ P1 First point of segment.
  -> Point
  -- ^ P2 Second point of segment.
  -> Float
  -- ^ (x3) x value of vertical segment
  -> Float
  -- ^ (ya) Lowest y value of vertical segment.
  -> Float
  -- ^ (yb) Highest y value of vertical segment.
  -> Maybe Point
  -- ^ (x3, y3) Intersection point, if any.
intersectSegVertSeg :: Point -> Point -> Float -> Float -> Float -> Maybe Point
intersectSegVertSeg p1 :: Point
p1@(Float
x1, Float
y1) p2 :: Point
p2@(Float
x2, Float
y2) Float
x0 Float
ya Float
yb
  | Point -> Point -> Point -> Point -> Bool
segClearsBox Point
p1 Point
p2 (Float
x0, Float
ya) (Float
x0, Float
yb) =
      Maybe Point
forall a. Maybe a
Nothing
  | Float
y0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
ya = Maybe Point
forall a. Maybe a
Nothing
  | Float
y0 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
yb = Maybe Point
forall a. Maybe a
Nothing
  | Bool
otherwise = Point -> Maybe Point
forall a. a -> Maybe a
Just (Float
x0, Float
y0)
  where
    y0 :: Float
y0
      | (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0 = Float
y1
      | Bool
otherwise = (Float
x0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y1