```{-# 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

```