Safe Haskell | None |
---|---|
Language | Haskell98 |
Synopsis
- data CubicBezier a = CubicBezier {}
- data QuadBezier a = QuadBezier {}
- data AnyBezier a = AnyBezier (Vector (a, a))
- class GenericBezier b where
- data PathJoin a
- data ClosedPath a = ClosedPath [(Point a, PathJoin a)]
- data OpenPath a = OpenPath [(Point a, PathJoin a)] (Point a)
- class AffineTransform a b | a -> b where
- anyToCubic :: Unbox a => AnyBezier a -> Maybe (CubicBezier a)
- anyToQuad :: Unbox a => AnyBezier a -> Maybe (QuadBezier a)
- openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a]
- closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a]
- curvesToOpen :: [CubicBezier a] -> OpenPath a
- curvesToClosed :: [CubicBezier a] -> ClosedPath a
- consOpenPath :: Point a -> PathJoin a -> OpenPath a -> OpenPath a
- consClosedPath :: Point a -> PathJoin a -> ClosedPath a -> ClosedPath a
- openClosedPath :: ClosedPath a -> OpenPath a
- closeOpenPath :: OpenPath a -> ClosedPath a
- bezierParam :: (Ord a, Num a) => a -> Bool
- bezierParamTolerance :: GenericBezier b => b Double -> Double -> Double
- reorient :: (GenericBezier b, Unbox a) => b a -> b a
- bezierToBernstein :: (GenericBezier b, Unbox a) => b a -> (BernsteinPoly a, BernsteinPoly a)
- evalBezierDerivs :: (GenericBezier b, Unbox a, Fractional a) => b a -> a -> [Point a]
- evalBezier :: (GenericBezier b, Unbox a, Fractional a) => b a -> a -> Point a
- evalBezierDeriv :: (Unbox a, Fractional a) => GenericBezier b => b a -> a -> (Point a, Point a)
- findBezierTangent :: DPoint -> CubicBezier Double -> [Double]
- quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a
- bezierHoriz :: CubicBezier Double -> [Double]
- bezierVert :: CubicBezier Double -> [Double]
- findBezierInflection :: CubicBezier Double -> [Double]
- findBezierCusp :: CubicBezier Double -> [Double]
- bezierArc :: Double -> Double -> CubicBezier Double
- arcLength :: CubicBezier Double -> Double -> Double -> Double
- arcLengthParam :: CubicBezier Double -> Double -> Double -> Double
- splitBezier :: (Unbox a, Fractional a) => GenericBezier b => b a -> a -> (b a, b a)
- bezierSubsegment :: (Ord a, Unbox a, Fractional a) => GenericBezier b => b a -> a -> a -> b a
- splitBezierN :: (Ord a, Unbox a, Fractional a) => GenericBezier b => b a -> [a] -> [b a]
- colinear :: CubicBezier Double -> Double -> Bool
- closest :: CubicBezier Double -> DPoint -> Double -> Double
- findX :: CubicBezier Double -> Double -> Double -> Double
Documentation
data CubicBezier a Source #
A cubic bezier curve.
Instances
data QuadBezier a Source #
A quadratic bezier curve.
Instances
A bezier curve of any degree.
class GenericBezier b where Source #
degree :: Unbox a => b a -> Int Source #
toVector :: Unbox a => b a -> Vector (a, a) Source #
unsafeFromVector :: Unbox a => Vector (a, a) -> b a Source #
Instances
GenericBezier AnyBezier Source # | |
GenericBezier QuadBezier Source # | |
Defined in Geom2D.CubicBezier.Basic degree :: Unbox a => QuadBezier a -> Int Source # toVector :: Unbox a => QuadBezier a -> Vector (a, a) Source # unsafeFromVector :: Unbox a => Vector (a, a) -> QuadBezier a Source # | |
GenericBezier CubicBezier Source # | |
Defined in Geom2D.CubicBezier.Basic degree :: Unbox a => CubicBezier a -> Int Source # toVector :: Unbox a => CubicBezier a -> Vector (a, a) Source # unsafeFromVector :: Unbox a => Vector (a, a) -> CubicBezier a Source # |
Instances
Functor PathJoin Source # | |
Foldable PathJoin Source # | |
Defined in Geom2D.CubicBezier.Basic fold :: Monoid m => PathJoin m -> m # foldMap :: Monoid m => (a -> m) -> PathJoin a -> m # foldr :: (a -> b -> b) -> b -> PathJoin a -> b # foldr' :: (a -> b -> b) -> b -> PathJoin a -> b # foldl :: (b -> a -> b) -> b -> PathJoin a -> b # foldl' :: (b -> a -> b) -> b -> PathJoin a -> b # foldr1 :: (a -> a -> a) -> PathJoin a -> a # foldl1 :: (a -> a -> a) -> PathJoin a -> a # elem :: Eq a => a -> PathJoin a -> Bool # maximum :: Ord a => PathJoin a -> a # minimum :: Ord a => PathJoin a -> a # | |
Traversable PathJoin Source # | |
Show a => Show (PathJoin a) Source # | |
Num a => AffineTransform (PathJoin a) a Source # | |
data ClosedPath a Source #
ClosedPath [(Point a, PathJoin a)] |
Instances
Instances
Functor OpenPath Source # | |
Foldable OpenPath Source # | |
Defined in Geom2D.CubicBezier.Basic fold :: Monoid m => OpenPath m -> m # foldMap :: Monoid m => (a -> m) -> OpenPath a -> m # foldr :: (a -> b -> b) -> b -> OpenPath a -> b # foldr' :: (a -> b -> b) -> b -> OpenPath a -> b # foldl :: (b -> a -> b) -> b -> OpenPath a -> b # foldl' :: (b -> a -> b) -> b -> OpenPath a -> b # foldr1 :: (a -> a -> a) -> OpenPath a -> a # foldl1 :: (a -> a -> a) -> OpenPath a -> a # elem :: Eq a => a -> OpenPath a -> Bool # maximum :: Ord a => OpenPath a -> a # minimum :: Ord a => OpenPath a -> a # | |
Traversable OpenPath Source # | |
Show a => Show (OpenPath a) Source # | |
Semigroup (OpenPath a) Source # | |
Monoid (OpenPath a) Source # | |
Num a => AffineTransform (OpenPath a) a Source # | |
class AffineTransform a b | a -> b where Source #
Instances
Num a => AffineTransform (Polygon a) a Source # | |
Num a => AffineTransform (Transform a) a Source # | |
Num a => AffineTransform (Point a) a Source # | |
Num a => AffineTransform (ClosedPath a) a Source # | |
Defined in Geom2D.CubicBezier.Basic transform :: Transform a -> ClosedPath a -> ClosedPath a Source # | |
Num a => AffineTransform (OpenPath a) a Source # | |
Num a => AffineTransform (PathJoin a) a Source # | |
Num a => AffineTransform (QuadBezier a) a Source # | |
Defined in Geom2D.CubicBezier.Basic transform :: Transform a -> QuadBezier a -> QuadBezier a Source # | |
Num a => AffineTransform (CubicBezier a) a Source # | |
Defined in Geom2D.CubicBezier.Basic transform :: Transform a -> CubicBezier a -> CubicBezier a Source # | |
(Floating a, Eq a) => AffineTransform (Pen a) a Source # | |
anyToCubic :: Unbox a => AnyBezier a -> Maybe (CubicBezier a) Source #
safely convert from AnyBezier
to CubicBezier
anyToQuad :: Unbox a => AnyBezier a -> Maybe (QuadBezier a) Source #
safely convert from AnyBezier
to QuadBezier
openPathCurves :: Fractional a => OpenPath a -> [CubicBezier a] Source #
Return the open path as a list of curves.
closedPathCurves :: Fractional a => ClosedPath a -> [CubicBezier a] Source #
Return the closed path as a list of curves
curvesToOpen :: [CubicBezier a] -> OpenPath a Source #
Make an open path from a list of curves. The last control point of each curve except the last is ignored.
curvesToClosed :: [CubicBezier a] -> ClosedPath a Source #
Make an open path from a list of curves. The last control point of each curve is ignored.
consClosedPath :: Point a -> PathJoin a -> ClosedPath a -> ClosedPath a Source #
construct a closed path
openClosedPath :: ClosedPath a -> OpenPath a Source #
open a closed path
closeOpenPath :: OpenPath a -> ClosedPath a Source #
close an open path, discarding the last point
bezierParam :: (Ord a, Num a) => a -> Bool Source #
Return True if the param lies on the curve, iff it's in the interval [0, 1]
.
bezierParamTolerance :: GenericBezier b => b Double -> Double -> Double Source #
Convert a tolerance from the codomain to the domain of the bezier curve, by dividing by the maximum velocity on the curve. The estimate is conservative, but holds for any value on the curve.
reorient :: (GenericBezier b, Unbox a) => b a -> b a Source #
Reorient to the curve B(1-t).
bezierToBernstein :: (GenericBezier b, Unbox a) => b a -> (BernsteinPoly a, BernsteinPoly a) Source #
Give the bernstein polynomial for each coordinate.
evalBezierDerivs :: (GenericBezier b, Unbox a, Fractional a) => b a -> a -> [Point a] Source #
Evaluate the bezier and all its derivatives using the modified horner algorithm.
evalBezier :: (GenericBezier b, Unbox a, Fractional a) => b a -> a -> Point a Source #
Calculate a value on the bezier curve.
evalBezierDeriv :: (Unbox a, Fractional a) => GenericBezier b => b a -> a -> (Point a, Point a) Source #
Calculate a value and the first derivative on the curve.
findBezierTangent :: DPoint -> CubicBezier Double -> [Double] Source #
findBezierTangent p b
finds the parameters where
the tangent of the bezier curve b
has the same direction as vector p.
quadToCubic :: Fractional a => QuadBezier a -> CubicBezier a Source #
Convert a quadratic bezier to a cubic bezier.
bezierHoriz :: CubicBezier Double -> [Double] Source #
Find the parameter where the bezier curve is horizontal.
bezierVert :: CubicBezier Double -> [Double] Source #
Find the parameter where the bezier curve is vertical.
findBezierInflection :: CubicBezier Double -> [Double] Source #
Find inflection points on the curve. Use the formula B_x''(t) * B_y'(t) - B_y''(t) * B_x'(t) = 0 with B_x'(t) the x value of the first derivative at t, B_y''(t) the y value of the second derivative at t
findBezierCusp :: CubicBezier Double -> [Double] Source #
Find the cusps of a bezier.
bezierArc :: Double -> Double -> CubicBezier Double Source #
bezierArc startAngle endAngle
approximates an arc on the unit circle with
a single cubic béziér curve. Maximum deviation is <0.03% for arcs
90° degrees or less.
arcLength :: CubicBezier Double -> Double -> Double -> Double Source #
@arcLength c t tol finds the arclength of the bezier c at t, within given tolerance tol.
arcLengthParam :: CubicBezier Double -> Double -> Double -> Double Source #
arcLengthParam c len tol finds the parameter where the curve c has the arclength len, within tolerance tol.
splitBezier :: (Unbox a, Fractional a) => GenericBezier b => b a -> a -> (b a, b a) Source #
Split a bezier curve into two curves.
bezierSubsegment :: (Ord a, Unbox a, Fractional a) => GenericBezier b => b a -> a -> a -> b a Source #
Return the subsegment between the two parameters.
splitBezierN :: (Ord a, Unbox a, Fractional a) => GenericBezier b => b a -> [a] -> [b a] Source #
Split a bezier curve into a list of beziers The parameters should be in ascending order or the result is unpredictable.
colinear :: CubicBezier Double -> Double -> Bool Source #
Return False if some points fall outside a line with a thickness of the given tolerance.