{-# 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 Graphics.Gloss.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 Graphics.Gloss.Data.Point
import Graphics.Gloss.Data.Vector
import qualified Graphics.Gloss.Data.Point.Arithmetic as Pt

-- | 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
x1Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y1Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
x2
                det34 :: Float
det34   = Float
x3Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
y4 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y3Float -> 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