gloss-1.13.2.2: Graphics/Gloss/Geometry/Line.hs
{-# 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 (x1, y1) (x2, y2) (xa, ya) (xb, yb)
| x1 < xa, x2 < xa = True
| x1 > xb, x2 > xb = True
| y1 < ya, y2 < ya = True
| y1 > yb, y2 > yb = True
| otherwise = 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 p1 p2 p3
= p1 Pt.+ (u `mulSV` (p2 Pt.- p1))
where u = closestPointOnLineParam p1 p2 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 p1 p2 p3
= (p3 Pt.- p1) `dotV` (p2 Pt.- p1)
/ (p2 Pt.- p1) `dotV` (p2 Pt.- 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 (x1, y1) (x2, y2) (x3, y3) (x4, y4)
= let dx12 = x1 - x2
dx34 = x3 - x4
dy12 = y1 - y2
dy34 = y3 - y4
den = dx12 * dy34 - dy12 * dx34
in if den == 0
then Nothing
else let
det12 = x1*y2 - y1*x2
det34 = x3*y4 - y3*x4
numx = det12 * dx34 - dx12 * det34
numy = det12 * dy34 - dy12 * det34
in Just (numx / den, numy / 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 p1 p2 p3 p4
-- TODO: merge closest point check with intersection, reuse subterms.
| Just p0 <- intersectLineLine p1 p2 p3 p4
, t12 <- closestPointOnLineParam p1 p2 p0
, t12 >= 0 && t12 <= 1
= Just p0
| otherwise
= 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 (x1, y1) (x2, y2) y0
-- seg is on line
| y1 == y0, y2 == y0 = Nothing
-- seg is above line
| y1 > y0, y2 > y0 = Nothing
-- seg is below line
| y1 < y0, y2 < y0 = Nothing
-- seg is a single point on the line.
-- this should be caught by the first case,
-- but we'll test for it anyway.
| y2 - y1 == 0
= Just (x1, y1)
| otherwise
= Just ( (y0 - y1) * (x2 - x1) / (y2 - y1) + x1
, 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 (x1, y1) (x2, y2) x0
-- seg is on line
| x1 == x0, x2 == x0 = Nothing
-- seg is to right of line
| x1 > x0, x2 > x0 = Nothing
-- seg is to left of line
| x1 < x0, x2 < x0 = Nothing
-- seg is a single point on the line.
-- this should be caught by the first case,
-- but we'll test for it anyway.
| x2 - x1 == 0
= Just (x1, y1)
| otherwise
= Just ( x0
, (x0 - x1) * (y2 - y1) / (x2 - x1) + 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 p1 p2 p3 p4
-- TODO: merge closest point checks with intersection, reuse subterms.
| Just p0 <- intersectLineLine p1 p2 p3 p4
, t12 <- closestPointOnLineParam p1 p2 p0
, t23 <- closestPointOnLineParam p3 p4 p0
, t12 >= 0 && t12 <= 1
, t23 >= 0 && t23 <= 1
= Just p0
| otherwise
= 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 p1@(x1, y1) p2@(x2, y2) y0 xa xb
| segClearsBox p1 p2 (xa, y0) (xb, y0)
= Nothing
| x0 < xa = Nothing
| x0 > xb = Nothing
| otherwise = Just (x0, y0)
where x0 | (y2 - y1) == 0 = x1
| otherwise = (y0 - y1) * (x2 - x1) / (y2 - y1) + 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 p1@(x1, y1) p2@(x2, y2) x0 ya yb
| segClearsBox p1 p2 (x0, ya) (x0, yb)
= Nothing
| y0 < ya = Nothing
| y0 > yb = Nothing
| otherwise = Just (x0, y0)
where y0 | (x2 - x1) == 0 = y1
| otherwise = (x0 - x1) * (y2 - y1) / (x2 - x1) + y1