hgeometry-0.14: src/Data/Geometry/LineSegment.hs
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------------------
-- |
-- Module : Data.Geometry.LineSegment
-- Copyright : (C) Frank Staals
-- License : see the LICENSE file
-- Maintainer : Frank Staals
--
-- Line segment data type and some basic functions on line segments
--
--------------------------------------------------------------------------------
module Data.Geometry.LineSegment
( LineSegment(LineSegment, LineSegment', ClosedLineSegment, OpenLineSegment)
, endPoints
, _SubLine
, module Data.Geometry.Interval
, toLineSegment
, orderedEndPoints
, segmentLength
, sqSegmentLength
, sqDistanceToSeg, sqDistanceToSegArg
, flipSegment
, interpolate, sampleLineSegment
, ordAtX, ordAtY, xCoordAt, yCoordAt
) where
-- import Control.Lens
import Data.Ext
-- import qualified Data.Foldable as F
import Data.Geometry.Boundary
import Data.Geometry.Box.Internal
import Data.Geometry.Box.Sides
import Data.Geometry.Interval hiding (width, midPoint)
import Data.Geometry.LineSegment.Internal
import Data.Geometry.Point
import Data.Geometry.Properties
-- import Data.Geometry.SubLine
import Data.Util
-- import Data.Vinyl.CoRec
-- import Data.Bifunctor
-- import Data.Either
-- import Data.Maybe (mapMaybe)
--------------------------------------------------------------------------------
type instance IntersectionOf (LineSegment 2 p r) (Boundary (Rectangle q r)) =
[ NoIntersection, Point 2 r, Two (Point 2 r) , LineSegment 2 () r ]
type instance IntersectionOf (LineSegment 2 p r) (Rectangle q r) =
[ NoIntersection, Point 2 r, LineSegment 2 (Maybe p) r ]
instance (Fractional r, Ord r)
=> LineSegment 2 p r `HasIntersectionWith` Boundary (Rectangle q r) where
seg `intersects` (Boundary rect) = any (seg `intersects`) $ sides rect
instance (Fractional r, Ord r) => LineSegment 2 p r `HasIntersectionWith` Rectangle q r where
seg@(LineSegment p q) `intersects` rect =
inRect p || inRect q || any (seg `intersects`) (sides rect) || bothOpenAndOnBoundary seg
where
inRect = \case
Open (a :+ _) -> a `insideBox` rect -- if strictly inside the seg intersects.
Closed (a :+ _) -> a `inBox` rect -- in or on the boundary is fine
-- if somehow the segment is open, and both endpoints lie on
-- different sides of the boundary, (so the segment crosses the
-- interior) it also intersects. Handle that case.
bothOpenAndOnBoundary (LineSegment (Open _) (Open _)) =
interpolate (1/2) seg `intersects` rect
bothOpenAndOnBoundary _ = False
-- instance (Num r, Ord r)
-- => (LineSegment 2 p r) `IsIntersectableWith` (Boundary (Rectangle q r)) where
-- seg `intersect` (Boundary rect) = case partitionEithers res of
-- (s : _, _) -> coRec s -- if we find a segment that should be the
-- -- answer; we shouldn't fine more than one
-- -- by the way.
-- ([], []) -> coRec NoIntersection
-- ([], [p]) -> coRec p
-- ([], (p:q:_)) -> coRec $ Two p q
-- -- more than two points is impossible anwyay
-- where
-- res = mapMaybe (\side -> match (seg `intersect` side) $
-- (H $ \NoIntersection -> Nothing)
-- :& (H $ \(p :: Point 2 r) -> Just $ Right p)
-- :& (H $ \(s :: LineSegment 2 () r) -> Just $ Left s)
-- :& RNil
-- ) . F.toList $ sides rect
-- -- instance (Num r, Ord r) => (LineSegment 2 p r) `IsIntersectableWith` (Rectangle q r) where
-- -- seg@(LineSegment' (p :+ _) (q :+ _)) `intersect` rect =
-- -- case (p `intersects` rect, q `intersects` rect) of
-- -- (True,True) -> coRec seg'
-- -- (False,False) -> match boundaryIntersection $ -- both endpoints outside
-- -- (H $ \NoIntersection -> coRec NoIntersection)
-- -- :& (H $ \(a :: Point 2 r) -> coRec a)
-- -- :& (H $ \(Two a b) -> coRec $ ClosedLineSegment (ext a) (ext b))
-- -- :& (H $ \s -> coRec s)
-- -- :& RNil
-- -- (True,False) -> withInside p (\other -> LineSegment p' (closed other))
-- -- (False,True) -> withInside q (\other -> LineSegment (closed other) q')
-- -- where
-- -- seg'@(LineSegment p' q') = first (const ()) seg
-- -- boundaryIntersection = seg `intersect` (Boundary rect)
-- -- closed :: Point 2 r -> EndPoint (Point 2 r :+ ())
-- -- closed = Closed . ext
-- -- -- the given endpoint endPt is inside the box [*], while the
-- -- -- other endpoint is not. The second arg is a function that
-- -- -- rebuilds the segment given the replacement endpoint, compute
-- -- -- the right segment that is inside the rectangle.
-- -- --
-- -- -- [*] We require that the *point* lies in or on the box. If the
-- -- -- endpoint was open, it may still be the case that we do not
-- -- -- actually intersect the rectangle (i.e. if the open endPoint
-- -- -- was on a corner of the rect).
-- -- -- withInside :: Point 2 r
-- -- -- -> (Point 2 r -> LineSegment 2 () r)
-- -- -- -> IntersectionOf ....
-- -- withInside endPt mkSeg = match boundaryIntersection $
-- -- (H $ \NoIntersection -> coRec NoIntersection)
-- -- -- seems this should happen only if the endpoint that was
-- -- -- suposedly in/on the rect was open.
-- -- :& (H $ \(a :: Point 2 r) -> coRec . mkSeg $ a)
-- -- :& (H $ \(Two a b) -> coRec . mkSeg $ if a == endPt then b else a)
-- -- :& (H $ \s -> coRec s)
-- -- :& RNil