Copyright | (C) Frank Staals |
---|---|
License | see the LICENSE file |
Maintainer | Frank Staals |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- newtype PolyLine d p r = PolyLine {}
- points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2))
- fromPoints :: [Point d r :+ p] -> Maybe (PolyLine d p r)
- fromPointsUnsafe :: [Point d r :+ p] -> PolyLine d p r
- fromPointsUnsafe' :: Monoid p => [Point d r] -> PolyLine d p r
- fromLineSegment :: LineSegment d p r -> PolyLine d p r
- asLineSegment :: PolyLine d p r -> LineSegment d p r
- asLineSegment' :: PolyLine d p r -> Maybe (LineSegment d p r)
- edgeSegments :: Arity d => PolyLine d p r -> LSeq 1 (LineSegment d p r)
- interpolatePoly :: (RealFrac r, Arity d) => r -> PolyLine d p r -> Point d r
Documentation
>>>
:{
let myPolyLine = fromPointsUnsafe $ map ext [origin, Point2 10.0 10.0, Point2 10.0 20.0] :}
d-dimensional Polygonal Lines (PolyLines)
newtype PolyLine d p r Source #
A Poly line in R^d has at least 2 vertices
Instances
points :: Iso (PolyLine d1 p1 r1) (PolyLine d2 p2 r2) (LSeq 2 (Point d1 r1 :+ p1)) (LSeq 2 (Point d2 r2 :+ p2)) Source #
PolyLines are isomorphic to a sequence of points with at least 2 members.
fromPoints :: [Point d r :+ p] -> Maybe (PolyLine d p r) Source #
Builds a Polyline from a list of points, if there are sufficiently many points
fromPointsUnsafe :: [Point d r :+ p] -> PolyLine d p r Source #
pre: The input list contains at least two points
fromPointsUnsafe' :: Monoid p => [Point d r] -> PolyLine d p r Source #
pre: The input list contains at least two points. All extra vields are initialized with mempty.
fromLineSegment :: LineSegment d p r -> PolyLine d p r Source #
We consider the line-segment as closed.
asLineSegment :: PolyLine d p r -> LineSegment d p r Source #
Convert to a closed line segment by taking the first two points.
asLineSegment' :: PolyLine d p r -> Maybe (LineSegment d p r) Source #
Stricter version of asLineSegment that fails if the Polyline contains more than two points.
edgeSegments :: Arity d => PolyLine d p r -> LSeq 1 (LineSegment d p r) Source #
Computes the edges, as linesegments, of an LSeq
interpolatePoly :: (RealFrac r, Arity d) => r -> PolyLine d p r -> Point d r Source #
Linearly interpolate the polyline with a value in the range \([0,n-1]\), where \(n\) is the number of vertices of the polyline.
running time: \(O(\log n)\)
>>>
interpolatePoly 0.5 myPolyLine
Point2 5.0 5.0>>>
interpolatePoly 1.5 myPolyLine
Point2 10.0 15.0