{-# OPTIONS_GHC -fno-warn-orphans #-} -------------------------------------------------------------------------------- -- | -- Module : Data.Geometry.Polygon -- Copyright : (C) Frank Staals -- License : see the LICENSE file -- Maintainer : Frank Staals -- -- A Polygon data type and some basic functions to interact with them. -- -------------------------------------------------------------------------------- module Data.Geometry.Polygon ( -- * Types PolygonType(..) , Polygon(..) , _SimplePolygon, _MultiPolygon , SimplePolygon, MultiPolygon, SomePolygon -- * Conversion , fromPoints , fromCircularVector , simpleFromPoints , simpleFromCircularVector , unsafeFromPoints , unsafeFromCircularVector , unsafeFromVector , toVector , toPoints , isSimple -- * Accessors , size , polygonVertices, listEdges , outerBoundary, outerBoundaryVector , unsafeOuterBoundaryVector , outerBoundaryEdges , outerVertex, outerBoundaryEdge , polygonHoles, polygonHoles' , holeList -- * Properties , area, signedArea , centroid -- * Queries , inPolygon, insidePolygon, onBoundary , isTriangle, isStarShaped , isCounterClockwise , toCounterClockWiseOrder, toCounterClockWiseOrder' , toClockwiseOrder, toClockwiseOrder' , reverseOuterBoundary , rotateLeft , rotateRight , maximumVertexBy , minimumVertexBy -- * Misc , pickPoint , findDiagonal , withIncidentEdges, numberVertices , extremesLinear, cmpExtreme , findRotateTo ) where import Algorithms.Geometry.InPolygon import Algorithms.Geometry.LinearProgramming.LP2DRIC import Algorithms.Geometry.LinearProgramming.Types import Control.Lens hiding (Simple) import Control.Monad.Random.Class import Data.Ext import qualified Data.Foldable as F import Data.Geometry.Boundary import Data.Geometry.HalfSpace (rightOf) import Data.Geometry.Line import Data.Geometry.LineSegment import Data.Geometry.Point import Data.Geometry.Polygon.Core import Data.Geometry.Polygon.Extremes import Data.Geometry.Properties import Data.Ord (comparing) import qualified Data.Sequence as Seq -------------------------------------------------------------------------------- -- * Polygons -- | Test if a Simple polygon is star-shaped. Returns a point in the kernel -- (i.e. from which the entire polygon is visible), if it exists. -- -- -- \(O(n)\) expected time isStarShaped :: (MonadRandom m, Ord r, Fractional r) => SimplePolygon p r -> m (Maybe (Point 2 r)) isStarShaped (toClockwiseOrder -> pg) = solveBoundedLinearProgram $ LinearProgram c (F.toList hs) where c = pg^.outerVertex 1.core.vector -- the first vertex is the intersection point of the two supporting lines -- bounding it, so the first two edges bound the shape in this sirection hs = fmap (rightOf . supportingLine) . outerBoundaryEdges $ pg -------------------------------------------------------------------------------- -- * Instances type instance IntersectionOf (Line 2 r) (Boundary (Polygon t p r)) = '[Seq.Seq (Either (Point 2 r) (LineSegment 2 () r))] type instance IntersectionOf (Point 2 r) (Polygon t p r) = [NoIntersection, Point 2 r] instance (Fractional r, Ord r) => Point 2 r `HasIntersectionWith` Polygon t p r where q `intersects` pg = q `inPolygon` pg /= Outside instance (Fractional r, Ord r) => Point 2 r `IsIntersectableWith` Polygon t p r where nonEmptyIntersection = defaultNonEmptyIntersection q `intersect` pg | q `intersects` pg = coRec q | otherwise = coRec NoIntersection -- instance IsIntersectableWith (Line 2 r) (Boundary (Polygon t p r)) where -- nonEmptyIntersection _ _ (CoRec xs) = null xs -- l `intersect` (Boundary (SimplePolygon vs)) = -- undefined -- l `intersect` (Boundary (MultiPolygon vs hs)) = coRec . -- Seq.sortBy f . Seq.fromList -- . concatMap (unpack . (l `intersect`) . Boundary) -- $ SimplePolygon vs : hs -- where -- unpack (CoRec x) = x -- f = undefined instance (Fractional r, Ord r) => HasSquaredEuclideanDistance (Boundary (Polygon t p r)) where pointClosestToWithDistance q = F.minimumBy (comparing snd) . fmap (pointClosestToWithDistance q) . listEdges . review _Boundary instance (Fractional r, Ord r) => HasSquaredEuclideanDistance (Polygon t p r) where pointClosestToWithDistance q pg | q `intersects` pg = (q, 0) | otherwise = pointClosestToWithDistance q (Boundary pg)