{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Diagrams.TwoD.Offset
(
offsetSegment
, OffsetOpts(..), offsetJoin, offsetMiterLimit, offsetEpsilon
, offsetTrail
, offsetTrail'
, offsetPath
, offsetPath'
, ExpandOpts(..), expandJoin, expandMiterLimit, expandCap, expandEpsilon
, expandTrail
, expandTrail'
, expandPath
, expandPath'
) where
import Control.Applicative
import Control.Lens hiding (at)
import Prelude
import Data.Maybe (catMaybes)
import Data.Monoid
import Data.Monoid.Inf
import Data.Default.Class
import Diagrams.Core
import Diagrams.Attributes
import Diagrams.Direction
import Diagrams.Located
import Diagrams.Parametric
import Diagrams.Path
import Diagrams.Segment
import Diagrams.Trail hiding (isLoop, offset)
import Diagrams.TrailLike
import Diagrams.TwoD.Arc
import Diagrams.TwoD.Curvature
import Diagrams.TwoD.Path ()
import Diagrams.TwoD.Types
import Diagrams.TwoD.Vector hiding (e)
import Linear.Affine
import Linear.Metric
import Linear.Vector
unitPerp :: OrderedField n => V2 n -> V2 n
unitPerp :: forall n. OrderedField n => V2 n -> V2 n
unitPerp = V2 n -> V2 n
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (V2 n -> V2 n) -> (V2 n -> V2 n) -> V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> V2 n
forall a. Num a => V2 a -> V2 a
perp
perpAtParam :: OrderedField n => Segment Closed V2 n -> n -> V2 n
perpAtParam :: forall n. OrderedField n => Segment Closed V2 n -> n -> V2 n
perpAtParam (Linear (OffsetClosed V2 n
a)) n
_ = V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (V2 n -> V2 n) -> V2 n -> V2 n
forall a b. (a -> b) -> a -> b
$ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp V2 n
a
perpAtParam Segment Closed V2 n
cubic n
t = V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (V2 n -> V2 n) -> V2 n -> V2 n
forall a b. (a -> b) -> a -> b
$ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp V2 n
a
where
(Cubic V2 n
a V2 n
_ Offset Closed V2 n
_) = (Segment Closed V2 n, Segment Closed V2 n) -> Segment Closed V2 n
forall a b. (a, b) -> b
snd ((Segment Closed V2 n, Segment Closed V2 n) -> Segment Closed V2 n)
-> (Segment Closed V2 n, Segment Closed V2 n)
-> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ Segment Closed V2 n
-> N (Segment Closed V2 n)
-> (Segment Closed V2 n, Segment Closed V2 n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed V2 n
cubic n
N (Segment Closed V2 n)
t
data OffsetOpts d = OffsetOpts
{ forall d. OffsetOpts d -> LineJoin
_offsetJoin :: LineJoin
, forall d. OffsetOpts d -> d
_offsetMiterLimit :: d
, forall d. OffsetOpts d -> d
_offsetEpsilon :: d
}
deriving instance Eq d => Eq (OffsetOpts d)
deriving instance Show d => Show (OffsetOpts d)
makeLensesWith (lensRules & generateSignatures .~ False) ''OffsetOpts
offsetJoin :: Lens' (OffsetOpts d) LineJoin
offsetMiterLimit :: Lens' (OffsetOpts d) d
offsetEpsilon :: Lens' (OffsetOpts d) d
instance Fractional d => Default (OffsetOpts d) where
def :: OffsetOpts d
def = LineJoin -> d -> d -> OffsetOpts d
forall d. LineJoin -> d -> d -> OffsetOpts d
OffsetOpts LineJoin
forall a. Default a => a
def d
10 d
0.01
data ExpandOpts d = ExpandOpts
{ forall d. ExpandOpts d -> LineJoin
_expandJoin :: LineJoin
, forall d. ExpandOpts d -> d
_expandMiterLimit :: d
, forall d. ExpandOpts d -> LineCap
_expandCap :: LineCap
, forall d. ExpandOpts d -> d
_expandEpsilon :: d
} deriving (ExpandOpts d -> ExpandOpts d -> Bool
(ExpandOpts d -> ExpandOpts d -> Bool)
-> (ExpandOpts d -> ExpandOpts d -> Bool) -> Eq (ExpandOpts d)
forall d. Eq d => ExpandOpts d -> ExpandOpts d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall d. Eq d => ExpandOpts d -> ExpandOpts d -> Bool
== :: ExpandOpts d -> ExpandOpts d -> Bool
$c/= :: forall d. Eq d => ExpandOpts d -> ExpandOpts d -> Bool
/= :: ExpandOpts d -> ExpandOpts d -> Bool
Eq, Int -> ExpandOpts d -> ShowS
[ExpandOpts d] -> ShowS
ExpandOpts d -> String
(Int -> ExpandOpts d -> ShowS)
-> (ExpandOpts d -> String)
-> ([ExpandOpts d] -> ShowS)
-> Show (ExpandOpts d)
forall d. Show d => Int -> ExpandOpts d -> ShowS
forall d. Show d => [ExpandOpts d] -> ShowS
forall d. Show d => ExpandOpts d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall d. Show d => Int -> ExpandOpts d -> ShowS
showsPrec :: Int -> ExpandOpts d -> ShowS
$cshow :: forall d. Show d => ExpandOpts d -> String
show :: ExpandOpts d -> String
$cshowList :: forall d. Show d => [ExpandOpts d] -> ShowS
showList :: [ExpandOpts d] -> ShowS
Show)
makeLensesWith (lensRules & generateSignatures .~ False) ''ExpandOpts
expandJoin :: Lens' (ExpandOpts d) LineJoin
expandMiterLimit :: Lens' (ExpandOpts d) d
expandCap :: Lens' (ExpandOpts d) LineCap
expandEpsilon :: Lens' (ExpandOpts d) d
instance (Fractional d) => Default (ExpandOpts d) where
def :: ExpandOpts d
def = LineJoin -> d -> LineCap -> d -> ExpandOpts d
forall d. LineJoin -> d -> LineCap -> d -> ExpandOpts d
ExpandOpts LineJoin
forall a. Default a => a
def d
10 LineCap
forall a. Default a => a
def d
0.01
offsetSegment :: RealFloat n
=> n
-> n
-> Segment Closed V2 n
-> Located (Trail V2 n)
offsetSegment :: forall n.
RealFloat n =>
n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
offsetSegment n
_ n
r s :: Segment Closed V2 n
s@(Linear (OffsetClosed V2 n
a)) = [Segment Closed V2 n] -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments [Segment Closed V2 n
s] Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 n
Diff (Point V2) n
va
where va :: V2 n
va = (-n
r) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp V2 n
a
offsetSegment n
epsilon n
r s :: Segment Closed V2 n
s@(Cubic V2 n
a V2 n
b (OffsetClosed V2 n
c)) = Trail V2 n
t Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 n
Diff (Point V2) n
va
where
t :: Trail V2 n
t = [Segment Closed V2 n] -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments (Inf Pos n -> [Segment Closed V2 n]
go (Segment Closed V2 n -> n -> Inf Pos n
forall n. RealFloat n => Segment Closed V2 n -> n -> PosInf n
radiusOfCurvature Segment Closed V2 n
s n
0.5))
va :: V2 n
va = (-n
r) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp V2 n
a
vc :: V2 n
vc = (-n
r) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp (V2 n
c V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 n
b)
ss :: [Segment Closed V2 n]
ss = (\(Segment Closed V2 n
x,Segment Closed V2 n
y) -> [Segment Closed V2 n
x,Segment Closed V2 n
y]) ((Segment Closed V2 n, Segment Closed V2 n)
-> [Segment Closed V2 n])
-> (Segment Closed V2 n, Segment Closed V2 n)
-> [Segment Closed V2 n]
forall a b. (a -> b) -> a -> b
$ Segment Closed V2 n
-> N (Segment Closed V2 n)
-> (Segment Closed V2 n, Segment Closed V2 n)
forall p. Sectionable p => p -> N p -> (p, p)
splitAtParam Segment Closed V2 n
s n
N (Segment Closed V2 n)
0.5
subdivided :: [Segment Closed V2 n]
subdivided = (Segment Closed V2 n -> [Segment Closed V2 n])
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Trail V2 n -> [Segment Closed V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> [Segment Closed v n]
trailSegments (Trail V2 n -> [Segment Closed V2 n])
-> (Segment Closed V2 n -> Trail V2 n)
-> Segment Closed V2 n
-> [Segment Closed V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc (Located (Trail V2 n) -> Trail V2 n)
-> (Segment Closed V2 n -> Located (Trail V2 n))
-> Segment Closed V2 n
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
forall n.
RealFloat n =>
n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
offsetSegment n
epsilon n
r) [Segment Closed V2 n]
ss
offset :: n -> Segment Closed V2 n
offset n
factor = V2 n -> V2 n -> V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (V2 n
aV2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^*n
factor) ((V2 n
b V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 n
c)V2 n -> n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^*n
factor V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 n
c V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 n
vc V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 n
va) (V2 n
c V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 n
vc V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 n
va)
go :: Inf Pos n -> [Segment Closed V2 n]
go (Finite n
0) = [Segment Closed V2 n]
subdivided
go Inf Pos n
roc
| Bool
close = [Segment Closed V2 n
o]
| Bool
otherwise = [Segment Closed V2 n]
subdivided
where
o :: Segment Closed V2 n
o = n -> Segment Closed V2 n
offset (n -> Segment Closed V2 n) -> n -> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ case Inf Pos n
roc of
Inf Pos n
Infinity -> n
1
Finite n
sr -> n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ n
r n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
sr
close :: Bool
close = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [n
epsilon n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Num a => a -> a
abs n
r n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Segment Closed V2 n
-> Codomain (Segment Closed V2 n) (N (Segment Closed V2 n))
p Segment Closed V2 n
o V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ V2 n
va V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Segment Closed V2 n
-> Codomain (Segment Closed V2 n) (N (Segment Closed V2 n))
p Segment Closed V2 n
s V2 n -> V2 n -> V2 n
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Segment Closed V2 n -> V2 n
pp Segment Closed V2 n
s)
| n
t' <- [n
0.25, n
0.5, n
0.75]
, let p :: Segment Closed V2 n
-> Codomain (Segment Closed V2 n) (N (Segment Closed V2 n))
p = (Segment Closed V2 n
-> N (Segment Closed V2 n)
-> Codomain (Segment Closed V2 n) (N (Segment Closed V2 n))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (Segment Closed V2 n)
t')
, let pp :: Segment Closed V2 n -> V2 n
pp = (n
r n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^) (V2 n -> V2 n)
-> (Segment Closed V2 n -> V2 n) -> Segment Closed V2 n -> V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed V2 n -> n -> V2 n
forall n. OrderedField n => Segment Closed V2 n -> n -> V2 n
`perpAtParam` n
t')
]
bindLoc :: (Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n, Num n) => (a -> b) -> Located a -> b
bindLoc :: forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc a -> b
f = Located b -> b
forall {t}.
(Transformable t, Additive (V t), Num (N t)) =>
Located t -> t
join' (Located b -> b) -> (Located a -> Located b) -> Located a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Located a -> Located b
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc a -> b
f
where
join' :: Located t -> t
join' (Located t -> (Point (V t) (N t), t)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc -> (Point (V t) (N t)
p,t
a)) = Vn t -> t -> t
forall t. Transformable t => Vn t -> t -> t
translate (Point (V t) (N t)
p Point (V t) (N t) -> Point (V t) (N t) -> Diff (Point (V t)) (N t)
forall a.
Num a =>
Point (V t) a -> Point (V t) a -> Diff (Point (V t)) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point (V t) (N t)
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin) t
a
locatedTrailSegments :: OrderedField n
=> Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
locatedTrailSegments :: forall n.
OrderedField n =>
Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
locatedTrailSegments Located (Trail V2 n)
t = (Segment Closed V2 n
-> Point V2 n -> Located (Segment Closed V2 n))
-> [Segment Closed V2 n]
-> [Point V2 n]
-> [Located (Segment Closed V2 n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Segment Closed V2 n
-> Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
-> Located (Segment Closed V2 n)
Segment Closed V2 n -> Point V2 n -> Located (Segment Closed V2 n)
forall a. a -> Point (V a) (N a) -> Located a
at (Trail V2 n -> [Segment Closed V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> [Segment Closed v n]
trailSegments (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
t)) (Located (Trail V2 n) -> [Point V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints Located (Trail V2 n)
t)
offsetTrail' :: RealFloat n
=> OffsetOpts n
-> n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
offsetTrail' :: forall n.
RealFloat n =>
OffsetOpts n -> n -> Located (Trail V2 n) -> Located (Trail V2 n)
offsetTrail' OffsetOpts n
opts n
r Located (Trail V2 n)
t = n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
forall n.
RealFloat n =>
n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
joinSegments n
eps n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
j Bool
isLoop (OffsetOpts n
optsOffsetOpts n -> Getting n (OffsetOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (OffsetOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> OffsetOpts d -> f (OffsetOpts d)
offsetMiterLimit) n
r [Point V2 n]
ends ([Located (Trail V2 n)] -> Located (Trail V2 n))
-> (Located (Trail V2 n) -> [Located (Trail V2 n)])
-> Located (Trail V2 n)
-> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Located (Trail V2 n)]
offset (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
where
eps :: n
eps = OffsetOpts n
optsOffsetOpts n -> Getting n (OffsetOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (OffsetOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> OffsetOpts d -> f (OffsetOpts d)
offsetEpsilon
offset :: Located (Trail V2 n) -> [Located (Trail V2 n)]
offset = (Located (Segment Closed V2 n) -> Located (Trail V2 n))
-> [Located (Segment Closed V2 n)] -> [Located (Trail V2 n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Segment Closed V2 n -> Located (Trail V2 n))
-> Located (Segment Closed V2 n) -> Located (Trail V2 n)
forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc (n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
forall n.
RealFloat n =>
n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
offsetSegment n
eps n
r)) ([Located (Segment Closed V2 n)] -> [Located (Trail V2 n)])
-> (Located (Trail V2 n) -> [Located (Segment Closed V2 n)])
-> Located (Trail V2 n)
-> [Located (Trail V2 n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
forall n.
OrderedField n =>
Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
locatedTrailSegments
ends :: [Point V2 n]
ends | Bool
isLoop = (\(Point V2 n
a:[Point V2 n]
as) -> [Point V2 n]
as [Point V2 n] -> [Point V2 n] -> [Point V2 n]
forall a. [a] -> [a] -> [a]
++ [Point V2 n
a]) ([Point V2 n] -> [Point V2 n])
-> (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n)
-> [Point V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Point V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n) -> [Point V2 n]
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
| Bool
otherwise = [Point V2 n] -> [Point V2 n]
forall a. HasCallStack => [a] -> [a]
tail ([Point V2 n] -> [Point V2 n])
-> (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n)
-> [Point V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Point V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n) -> [Point V2 n]
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
j :: n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
j = LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
fromLineJoin (OffsetOpts n
optsOffsetOpts n
-> Getting LineJoin (OffsetOpts n) LineJoin -> LineJoin
forall s a. s -> Getting a s a -> a
^.Getting LineJoin (OffsetOpts n) LineJoin
forall d (f :: * -> *).
Functor f =>
(LineJoin -> f LineJoin) -> OffsetOpts d -> f (OffsetOpts d)
offsetJoin)
isLoop :: Bool
isLoop = (Trail' Line V2 n -> Bool)
-> (Trail' Loop V2 n -> Bool) -> Trail V2 n -> Bool
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Bool -> Trail' Line V2 n -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> Trail' Loop V2 n -> Bool
forall a b. a -> b -> a
const Bool
True) (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
t)
offsetTrail :: RealFloat n => n -> Located (Trail V2 n) -> Located (Trail V2 n)
offsetTrail :: forall n.
RealFloat n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n)
offsetTrail = OffsetOpts n -> n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall n.
RealFloat n =>
OffsetOpts n -> n -> Located (Trail V2 n) -> Located (Trail V2 n)
offsetTrail' OffsetOpts n
forall a. Default a => a
def
offsetPath' :: RealFloat n => OffsetOpts n -> n -> Path V2 n -> Path V2 n
offsetPath' :: forall n.
RealFloat n =>
OffsetOpts n -> n -> Path V2 n -> Path V2 n
offsetPath' OffsetOpts n
opts n
r = [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat
([Path V2 n] -> Path V2 n)
-> (Path V2 n -> [Path V2 n]) -> Path V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail V2 n) -> Path V2 n)
-> [Located (Trail V2 n)] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map ((Located (Trail V2 n) -> Path V2 n)
-> Located (Located (Trail V2 n)) -> Path V2 n
forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc (Located (Trail (V (Path V2 n)) (N (Path V2 n))) -> Path V2 n
Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> Path V2 n)
-> (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OffsetOpts n -> n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall n.
RealFloat n =>
OffsetOpts n -> n -> Located (Trail V2 n) -> Located (Trail V2 n)
offsetTrail' OffsetOpts n
opts n
r) (Located (Located (Trail V2 n)) -> Path V2 n)
-> (Located (Trail V2 n) -> Located (Located (Trail V2 n)))
-> Located (Trail V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail V2 n)
-> Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
-> Located (Located (Trail V2 n))
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin))
([Located (Trail V2 n)] -> [Path V2 n])
-> (Path V2 n -> [Located (Trail V2 n)])
-> Path V2 n
-> [Path V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Path V2 n) -> Path V2 n)
-> Path V2 n -> Unwrapped (Path V2 n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op [Located (Trail V2 n)] -> Path V2 n
Unwrapped (Path V2 n) -> Path V2 n
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path
offsetPath :: RealFloat n => n -> Path V2 n -> Path V2 n
offsetPath :: forall n. RealFloat n => n -> Path V2 n -> Path V2 n
offsetPath = OffsetOpts n -> n -> Path V2 n -> Path V2 n
forall n.
RealFloat n =>
OffsetOpts n -> n -> Path V2 n -> Path V2 n
offsetPath' OffsetOpts n
forall a. Default a => a
def
withTrailL :: (Located (Trail' Line V2 n) -> r) -> (Located (Trail' Loop V2 n) -> r) -> Located (Trail V2 n) -> r
withTrailL :: forall n r.
(Located (Trail' Line V2 n) -> r)
-> (Located (Trail' Loop V2 n) -> r) -> Located (Trail V2 n) -> r
withTrailL Located (Trail' Line V2 n) -> r
f Located (Trail' Loop V2 n) -> r
g Located (Trail V2 n)
l = (Trail' Line V2 n -> r)
-> (Trail' Loop V2 n -> r) -> Trail V2 n -> r
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Located (Trail' Line V2 n) -> r
f (Located (Trail' Line V2 n) -> r)
-> (Trail' Line V2 n -> Located (Trail' Line V2 n))
-> Trail' Line V2 n
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Line V2 n
-> Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))
-> Located (Trail' Line V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail V2 n)) (N (Trail V2 n))
Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))
p)) (Located (Trail' Loop V2 n) -> r
g (Located (Trail' Loop V2 n) -> r)
-> (Trail' Loop V2 n -> Located (Trail' Loop V2 n))
-> Trail' Loop V2 n
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail' Loop V2 n
-> Point (V (Trail' Loop V2 n)) (N (Trail' Loop V2 n))
-> Located (Trail' Loop V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail V2 n)) (N (Trail V2 n))
Point (V (Trail' Loop V2 n)) (N (Trail' Loop V2 n))
p)) (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
l)
where
p :: Point (V (Trail V2 n)) (N (Trail V2 n))
p = Located (Trail V2 n) -> Point (V (Trail V2 n)) (N (Trail V2 n))
forall a. Located a -> Point (V a) (N a)
loc Located (Trail V2 n)
l
expandTrail' :: (OrderedField n, RealFloat n, RealFrac n)
=> ExpandOpts n
-> n
-> Located (Trail V2 n)
-> Path V2 n
expandTrail' :: forall n.
(OrderedField n, RealFloat n, RealFrac n) =>
ExpandOpts n -> n -> Located (Trail V2 n) -> Path V2 n
expandTrail' ExpandOpts n
o n
r Located (Trail V2 n)
t
| n
r n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 = String -> Path V2 n
forall a. HasCallStack => String -> a
error String
"expandTrail' with negative radius"
| Bool
otherwise = (Located (Trail' Line V2 n) -> Path V2 n)
-> (Located (Trail' Loop V2 n) -> Path V2 n)
-> Located (Trail V2 n)
-> Path V2 n
forall n r.
(Located (Trail' Line V2 n) -> r)
-> (Located (Trail' Loop V2 n) -> r) -> Located (Trail V2 n) -> r
withTrailL (Located (Trail V2 n) -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> Path v n
pathFromLocTrail (Located (Trail V2 n) -> Path V2 n)
-> (Located (Trail' Line V2 n) -> Located (Trail V2 n))
-> Located (Trail' Line V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpandOpts n
-> n -> Located (Trail' Line V2 n) -> Located (Trail V2 n)
forall n.
RealFloat n =>
ExpandOpts n
-> n -> Located (Trail' Line V2 n) -> Located (Trail V2 n)
expandLine ExpandOpts n
o n
r) (ExpandOpts n -> n -> Located (Trail' Loop V2 n) -> Path V2 n
forall n.
RealFloat n =>
ExpandOpts n -> n -> Located (Trail' Loop V2 n) -> Path V2 n
expandLoop ExpandOpts n
o n
r) Located (Trail V2 n)
t
expandLine :: RealFloat n => ExpandOpts n -> n -> Located (Trail' Line V2 n) -> Located (Trail V2 n)
expandLine :: forall n.
RealFloat n =>
ExpandOpts n
-> n -> Located (Trail' Line V2 n) -> Located (Trail V2 n)
expandLine ExpandOpts n
opts n
r ((Trail' Line V2 n -> Trail V2 n)
-> Located (Trail' Line V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine -> Located (Trail V2 n)
t) = (n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n)
-> n
-> Point V2 n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Located (Trail V2 n)
forall n.
RealFloat n =>
(n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n)
-> n
-> Point V2 n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Located (Trail V2 n)
caps n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
cap n
r Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
s Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
e (n -> Located (Trail V2 n)
f n
r) (n -> Located (Trail V2 n)
f (n -> Located (Trail V2 n)) -> n -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ -n
r)
where
eps :: n
eps = ExpandOpts n
optsExpandOpts n -> Getting n (ExpandOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (ExpandOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> ExpandOpts d -> f (ExpandOpts d)
expandEpsilon
offset :: n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
offset n
r' = (Located (Segment Closed V2 n) -> Located (Trail V2 n))
-> [Located (Segment Closed V2 n)] -> [Located (Trail V2 n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Segment Closed V2 n -> Located (Trail V2 n))
-> Located (Segment Closed V2 n) -> Located (Trail V2 n)
forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc (n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
forall n.
RealFloat n =>
n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
offsetSegment n
eps n
r')) ([Located (Segment Closed V2 n)] -> [Located (Trail V2 n)])
-> (Located (Trail V2 n) -> [Located (Segment Closed V2 n)])
-> Located (Trail V2 n)
-> [Located (Trail V2 n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
forall n.
OrderedField n =>
Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
locatedTrailSegments
f :: n -> Located (Trail V2 n)
f n
r' = n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
forall n.
RealFloat n =>
n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
joinSegments n
eps (LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
fromLineJoin (ExpandOpts n
optsExpandOpts n
-> Getting LineJoin (ExpandOpts n) LineJoin -> LineJoin
forall s a. s -> Getting a s a -> a
^.Getting LineJoin (ExpandOpts n) LineJoin
forall d (f :: * -> *).
Functor f =>
(LineJoin -> f LineJoin) -> ExpandOpts d -> f (ExpandOpts d)
expandJoin)) Bool
False (ExpandOpts n
optsExpandOpts n -> Getting n (ExpandOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (ExpandOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> ExpandOpts d -> f (ExpandOpts d)
expandMiterLimit) n
r' [Point V2 n]
ends
([Located (Trail V2 n)] -> Located (Trail V2 n))
-> (Located (Trail V2 n) -> [Located (Trail V2 n)])
-> Located (Trail V2 n)
-> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
offset n
r' (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
ends :: [Point V2 n]
ends = [Point V2 n] -> [Point V2 n]
forall a. HasCallStack => [a] -> [a]
tail ([Point V2 n] -> [Point V2 n])
-> (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n)
-> [Point V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Point V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n) -> [Point V2 n]
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
s :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
s = Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
t
e :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
e = Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
t
cap :: n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
cap = LineCap
-> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
forall n.
RealFloat n =>
LineCap
-> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
fromLineCap (ExpandOpts n
optsExpandOpts n -> Getting LineCap (ExpandOpts n) LineCap -> LineCap
forall s a. s -> Getting a s a -> a
^.Getting LineCap (ExpandOpts n) LineCap
forall d (f :: * -> *).
Functor f =>
(LineCap -> f LineCap) -> ExpandOpts d -> f (ExpandOpts d)
expandCap)
expandLoop :: RealFloat n => ExpandOpts n -> n -> Located (Trail' Loop V2 n) -> Path V2 n
expandLoop :: forall n.
RealFloat n =>
ExpandOpts n -> n -> Located (Trail' Loop V2 n) -> Path V2 n
expandLoop ExpandOpts n
opts n
r ((Trail' Loop V2 n -> Trail V2 n)
-> Located (Trail' Loop V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop -> Located (Trail V2 n)
t) = Located (Trail (V (Path V2 n)) (N (Path V2 n))) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (n -> Located (Trail V2 n)
f n
r) Path V2 n -> Path V2 n -> Path V2 n
forall a. Semigroup a => a -> a -> a
<> (Located (Trail (V (Path V2 n)) (N (Path V2 n))) -> Path V2 n
Located (Trail V2 n) -> Path V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> Path V2 n)
-> (n -> Located (Trail V2 n)) -> n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> Located (Trail V2 n)
forall p. Sectionable p => p -> p
reverseDomain (Located (Trail V2 n) -> Located (Trail V2 n))
-> (n -> Located (Trail V2 n)) -> n -> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Located (Trail V2 n)
f (n -> Path V2 n) -> n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ -n
r)
where
eps :: n
eps = ExpandOpts n
optsExpandOpts n -> Getting n (ExpandOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (ExpandOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> ExpandOpts d -> f (ExpandOpts d)
expandEpsilon
offset :: n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
offset n
r' = (Located (Segment Closed V2 n) -> Located (Trail V2 n))
-> [Located (Segment Closed V2 n)] -> [Located (Trail V2 n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Segment Closed V2 n -> Located (Trail V2 n))
-> Located (Segment Closed V2 n) -> Located (Trail V2 n)
forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc (n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
forall n.
RealFloat n =>
n -> n -> Segment Closed V2 n -> Located (Trail V2 n)
offsetSegment n
eps n
r')) ([Located (Segment Closed V2 n)] -> [Located (Trail V2 n)])
-> (Located (Trail V2 n) -> [Located (Segment Closed V2 n)])
-> Located (Trail V2 n)
-> [Located (Trail V2 n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
forall n.
OrderedField n =>
Located (Trail V2 n) -> [Located (Segment Closed V2 n)]
locatedTrailSegments
f :: n -> Located (Trail V2 n)
f n
r' = n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
forall n.
RealFloat n =>
n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
joinSegments n
eps (LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
fromLineJoin (ExpandOpts n
optsExpandOpts n
-> Getting LineJoin (ExpandOpts n) LineJoin -> LineJoin
forall s a. s -> Getting a s a -> a
^.Getting LineJoin (ExpandOpts n) LineJoin
forall d (f :: * -> *).
Functor f =>
(LineJoin -> f LineJoin) -> ExpandOpts d -> f (ExpandOpts d)
expandJoin)) Bool
True (ExpandOpts n
optsExpandOpts n -> Getting n (ExpandOpts n) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (ExpandOpts n) n
forall d (f :: * -> *).
Functor f =>
(d -> f d) -> ExpandOpts d -> f (ExpandOpts d)
expandMiterLimit) n
r' [Point V2 n]
ends
([Located (Trail V2 n)] -> Located (Trail V2 n))
-> (Located (Trail V2 n) -> [Located (Trail V2 n)])
-> Located (Trail V2 n)
-> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
offset n
r' (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
ends :: [Point V2 n]
ends = (\(Point V2 n
a:[Point V2 n]
as) -> [Point V2 n]
as [Point V2 n] -> [Point V2 n] -> [Point V2 n]
forall a. [a] -> [a] -> [a]
++ [Point V2 n
a]) ([Point V2 n] -> [Point V2 n])
-> (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n)
-> [Point V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [Point V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [Point v n]
trailPoints (Located (Trail V2 n) -> [Point V2 n])
-> Located (Trail V2 n) -> [Point V2 n]
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
t
expandTrail :: RealFloat n => n -> Located (Trail V2 n) -> Path V2 n
expandTrail :: forall n. RealFloat n => n -> Located (Trail V2 n) -> Path V2 n
expandTrail = ExpandOpts n -> n -> Located (Trail V2 n) -> Path V2 n
forall n.
(OrderedField n, RealFloat n, RealFrac n) =>
ExpandOpts n -> n -> Located (Trail V2 n) -> Path V2 n
expandTrail' ExpandOpts n
forall a. Default a => a
def
expandPath' :: RealFloat n => ExpandOpts n -> n -> Path V2 n -> Path V2 n
expandPath' :: forall n.
RealFloat n =>
ExpandOpts n -> n -> Path V2 n -> Path V2 n
expandPath' ExpandOpts n
opts n
r = [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat
([Path V2 n] -> Path V2 n)
-> (Path V2 n -> [Path V2 n]) -> Path V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail V2 n) -> Path V2 n)
-> [Located (Trail V2 n)] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map ((Located (Trail V2 n) -> Path V2 n)
-> Located (Located (Trail V2 n)) -> Path V2 n
forall b a n.
(Transformable b, V a ~ V b, N a ~ N b, V a ~ V2, N a ~ n,
Num n) =>
(a -> b) -> Located a -> b
bindLoc (ExpandOpts n -> n -> Located (Trail V2 n) -> Path V2 n
forall n.
(OrderedField n, RealFloat n, RealFrac n) =>
ExpandOpts n -> n -> Located (Trail V2 n) -> Path V2 n
expandTrail' ExpandOpts n
opts n
r) (Located (Located (Trail V2 n)) -> Path V2 n)
-> (Located (Trail V2 n) -> Located (Located (Trail V2 n)))
-> Located (Trail V2 n)
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (Trail V2 n)
-> Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
-> Located (Located (Trail V2 n))
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin))
([Located (Trail V2 n)] -> [Path V2 n])
-> (Path V2 n -> [Located (Trail V2 n)])
-> Path V2 n
-> [Path V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (Path V2 n) -> Path V2 n)
-> Path V2 n -> Unwrapped (Path V2 n)
forall s. Wrapped s => (Unwrapped s -> s) -> s -> Unwrapped s
op [Located (Trail V2 n)] -> Path V2 n
Unwrapped (Path V2 n) -> Path V2 n
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path
expandPath :: RealFloat n => n -> Path V2 n -> Path V2 n
expandPath :: forall n. RealFloat n => n -> Path V2 n -> Path V2 n
expandPath = ExpandOpts n -> n -> Path V2 n -> Path V2 n
forall n.
RealFloat n =>
ExpandOpts n -> n -> Path V2 n -> Path V2 n
expandPath' ExpandOpts n
forall a. Default a => a
def
caps :: RealFloat n => (n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n)
-> n -> Point V2 n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Located (Trail V2 n)
caps :: forall n.
RealFloat n =>
(n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n)
-> n
-> Point V2 n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Located (Trail V2 n)
caps n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
cap n
r Point V2 n
s Point V2 n
e Located (Trail V2 n)
fs Located (Trail V2 n)
bs = (Trail V2 n -> Trail V2 n)
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc Trail V2 n -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ [Trail V2 n] -> Trail V2 n
forall a. Monoid a => [a] -> a
mconcat
[ n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
cap n
r Point V2 n
s (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
bs) (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
fs)
, Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
fs
, n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
cap n
r Point V2 n
e (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
fs) (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
bs)
, Trail V2 n -> Trail V2 n
forall p. Sectionable p => p -> p
reverseDomain (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
bs)
] Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
bs
fromLineCap :: RealFloat n => LineCap -> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
fromLineCap :: forall n.
RealFloat n =>
LineCap
-> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
fromLineCap LineCap
c = case LineCap
c of
LineCap
LineCapButt -> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capCut
LineCap
LineCapRound -> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capArc
LineCap
LineCapSquare -> n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capSquare
capCut :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capCut :: forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capCut n
_r Point V2 n
_c Point V2 n
a Point V2 n
b = [Segment Closed (V (Trail V2 n)) (N (Trail V2 n))] -> Trail V2 n
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments [V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (Point V2 n
b Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
a)]
capSquare :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capSquare :: forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capSquare n
_r Point V2 n
c Point V2 n
a Point V2 n
b = Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc (Located (Trail V2 n) -> Trail V2 n)
-> Located (Trail V2 n) -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))]
-> Located (Trail V2 n)
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices [ Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Point V2 n
a, Point V2 n
a Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 n
Diff (Point V2) n
v, Point V2 n
b Point V2 n -> Diff (Point V2) n -> Point V2 n
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 n
Diff (Point V2) n
v, Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Point V2 n
b ]
where
v :: V2 n
v = V2 n -> V2 n
forall a. Num a => V2 a -> V2 a
perp (Point V2 n
a Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
c)
capArc :: RealFloat n => n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capArc :: forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capArc n
r Point V2 n
c Point V2 n
a Point V2 n
b = Located (Trail (V (Trail V2 n)) (N (Trail V2 n))) -> Trail V2 n
Located (Trail V2 n) -> Trail V2 n
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> Trail V2 n)
-> (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n)
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point V2 n
c (Located (Trail V2 n) -> Trail V2 n)
-> Located (Trail V2 n) -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
fs
where
fs :: Located (Trail V2 n)
fs | n
r n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0 = n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale (-n
r) (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Direction V2 n -> Located (Trail V2 n)
forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
arcCW (Point V2 n -> Point V2 n -> Direction V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point V2 n
c Point V2 n
a) (Point V2 n -> Point V2 n -> Direction V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point V2 n
c Point V2 n
b)
| Bool
otherwise = n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Direction V2 n -> Located (Trail V2 n)
forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
arcCCW (Point V2 n -> Point V2 n -> Direction V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point V2 n
c Point V2 n
a) (Point V2 n -> Point V2 n -> Direction V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
Point v n -> Point v n -> Direction v n
dirBetween Point V2 n
c Point V2 n
b)
joinSegments :: RealFloat n
=> n
-> (n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
joinSegments :: forall n.
RealFloat n =>
n
-> (n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n)
-> Bool
-> n
-> n
-> [Point V2 n]
-> [Located (Trail V2 n)]
-> Located (Trail V2 n)
joinSegments n
_ n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
_ Bool
_ n
_ n
_ [Point V2 n]
_ [] = Trail V2 n
forall a. Monoid a => a
mempty Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail V2 n)) (N (Trail V2 n))
Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
joinSegments n
_ n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
_ Bool
_ n
_ n
_ [] [Located (Trail V2 n)]
_ = Trail V2 n
forall a. Monoid a => a
mempty Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail V2 n)) (N (Trail V2 n))
Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
joinSegments n
epsilon n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
j Bool
isLoop n
ml n
r [Point V2 n]
es ts :: [Located (Trail V2 n)]
ts@(Located (Trail V2 n)
t:[Located (Trail V2 n)]
_) = Located (Trail V2 n)
t'
where
t' :: Located (Trail V2 n)
t' | Bool
isLoop = (Trail V2 n -> Trail V2 n)
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc (Trail V2 n -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail (Trail V2 n -> Trail V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> [Maybe (Trail V2 n)] -> Trail V2 n
f (Int -> [Maybe (Trail V2 n)] -> [Maybe (Trail V2 n)]
forall a. Int -> [a] -> [a]
take ([Located (Trail V2 n)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Located (Trail V2 n)]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Maybe (Trail V2 n)] -> [Maybe (Trail V2 n)])
-> [Maybe (Trail V2 n)] -> [Maybe (Trail V2 n)]
forall a b. (a -> b) -> a -> b
$ [Point V2 n] -> [Located (Trail V2 n)] -> [Maybe (Trail V2 n)]
ss [Point V2 n]
es ([Located (Trail V2 n)]
ts [Located (Trail V2 n)]
-> [Located (Trail V2 n)] -> [Located (Trail V2 n)]
forall a. [a] -> [a] -> [a]
++ [Located (Trail V2 n)
t])))) Located (Trail V2 n)
t
| Bool
otherwise = (Trail V2 n -> Trail V2 n)
-> Located (Trail V2 n) -> Located (Trail V2 n)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc (Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> [Maybe (Trail V2 n)] -> Trail V2 n
f ([Point V2 n] -> [Located (Trail V2 n)] -> [Maybe (Trail V2 n)]
ss [Point V2 n]
es [Located (Trail V2 n)]
ts)) Located (Trail V2 n)
t
ss :: [Point V2 n] -> [Located (Trail V2 n)] -> [Maybe (Trail V2 n)]
ss [Point V2 n]
es' [Located (Trail V2 n)]
ts' = [[Maybe (Trail V2 n)]] -> [Maybe (Trail V2 n)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Located (Trail V2 n)
-> Located (Trail V2 n) -> Trail V2 n -> Maybe (Trail V2 n)
test Located (Trail V2 n)
a Located (Trail V2 n)
b (Trail V2 n -> Maybe (Trail V2 n))
-> Trail V2 n -> Maybe (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
j n
ml n
r Point V2 n
e Located (Trail V2 n)
a Located (Trail V2 n)
b, Trail V2 n -> Maybe (Trail V2 n)
forall a. a -> Maybe a
Just (Trail V2 n -> Maybe (Trail V2 n))
-> Trail V2 n -> Maybe (Trail V2 n)
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
b] | (Point V2 n
e,(Located (Trail V2 n)
a,Located (Trail V2 n)
b)) <- [Point V2 n]
-> [(Located (Trail V2 n), Located (Trail V2 n))]
-> [(Point V2 n, (Located (Trail V2 n), Located (Trail V2 n)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Point V2 n]
es' ([(Located (Trail V2 n), Located (Trail V2 n))]
-> [(Point V2 n, (Located (Trail V2 n), Located (Trail V2 n)))])
-> ([Located (Trail V2 n)]
-> [(Located (Trail V2 n), Located (Trail V2 n))])
-> [Located (Trail V2 n)]
-> [(Point V2 n, (Located (Trail V2 n), Located (Trail V2 n)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Located (Trail V2 n)]
-> [Located (Trail V2 n)]
-> [(Located (Trail V2 n), Located (Trail V2 n))]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Located (Trail V2 n)]
-> [Located (Trail V2 n)]
-> [(Located (Trail V2 n), Located (Trail V2 n))])
-> ([Located (Trail V2 n)] -> [Located (Trail V2 n)])
-> [Located (Trail V2 n)]
-> [(Located (Trail V2 n), Located (Trail V2 n))]
forall a b.
([Located (Trail V2 n)] -> a -> b)
-> ([Located (Trail V2 n)] -> a) -> [Located (Trail V2 n)] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Located (Trail V2 n)] -> [Located (Trail V2 n)]
forall a. HasCallStack => [a] -> [a]
tail) ([Located (Trail V2 n)]
-> [(Point V2 n, (Located (Trail V2 n), Located (Trail V2 n)))])
-> [Located (Trail V2 n)]
-> [(Point V2 n, (Located (Trail V2 n), Located (Trail V2 n)))]
forall a b. (a -> b) -> a -> b
$ [Located (Trail V2 n)]
ts']
test :: Located (Trail V2 n)
-> Located (Trail V2 n) -> Trail V2 n -> Maybe (Trail V2 n)
test Located (Trail V2 n)
a Located (Trail V2 n)
b Trail V2 n
tj
| Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
b Point V2 n -> Point V2 n -> n
forall a. Floating a => Point V2 a -> Point V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
`distance` Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
a n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n
epsilon = Trail V2 n -> Maybe (Trail V2 n)
forall a. a -> Maybe a
Just Trail V2 n
tj
| Bool
otherwise = Maybe (Trail V2 n)
forall a. Maybe a
Nothing
f :: [Maybe (Trail V2 n)] -> Trail V2 n
f = [Trail V2 n] -> Trail V2 n
forall a. Monoid a => [a] -> a
mconcat ([Trail V2 n] -> Trail V2 n)
-> ([Maybe (Trail V2 n)] -> [Trail V2 n])
-> [Maybe (Trail V2 n)]
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Trail V2 n)] -> [Trail V2 n]
forall a. [Maybe a] -> [a]
catMaybes
fromLineJoin
:: RealFloat n => LineJoin -> n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n
fromLineJoin :: forall n.
RealFloat n =>
LineJoin
-> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
fromLineJoin LineJoin
j = case LineJoin
j of
LineJoin
LineJoinMiter -> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentIntersect
LineJoin
LineJoinRound -> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentArc
LineJoin
LineJoinBevel -> n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentClip
joinSegmentClip :: RealFloat n
=> n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n
joinSegmentClip :: forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentClip n
_ n
_ Point V2 n
_ Located (Trail V2 n)
a Located (Trail V2 n)
b = [Segment Closed (V (Trail V2 n)) (N (Trail V2 n))] -> Trail V2 n
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments [V (Trail V2 n) (N (Trail V2 n))
-> Segment Closed (V (Trail V2 n)) (N (Trail V2 n))
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V (Trail V2 n) (N (Trail V2 n))
-> Segment Closed (V (Trail V2 n)) (N (Trail V2 n)))
-> V (Trail V2 n) (N (Trail V2 n))
-> Segment Closed (V (Trail V2 n)) (N (Trail V2 n))
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
b Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
a]
joinSegmentArc :: RealFloat n
=> n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n
joinSegmentArc :: forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentArc n
_ n
r Point V2 n
e Located (Trail V2 n)
a Located (Trail V2 n)
b = n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
forall n.
RealFloat n =>
n -> Point V2 n -> Point V2 n -> Point V2 n -> Trail V2 n
capArc n
r Point V2 n
e (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
a) (Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
b)
joinSegmentIntersect
:: RealFloat n => n -> n -> Point V2 n -> Located (Trail V2 n) -> Located (Trail V2 n) -> Trail V2 n
joinSegmentIntersect :: forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentIntersect n
miterLimit n
r Point V2 n
e Located (Trail V2 n)
a Located (Trail V2 n)
b =
if n
cross n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0.000001
then Trail V2 n
clip
else case Point (V (Located (Segment Closed V2 n))) n
-> V (Located (Segment Closed V2 n)) n
-> Located (Segment Closed V2 n)
-> Maybe (Point (V (Located (Segment Closed V2 n))) n)
forall n a.
(n ~ N a, Traced a, Num n) =>
Point (V a) n -> V a n -> a -> Maybe (Point (V a) n)
traceP Point (V (Located (Segment Closed V2 n))) n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pa V (Located (Segment Closed V2 n)) n
V2 n
va Located (Segment Closed V2 n)
t of
Maybe (Point (V (Located (Segment Closed V2 n))) n)
Nothing -> Trail V2 n
clip
Just Point (V (Located (Segment Closed V2 n))) n
p
| Point (V (Located (Segment Closed V2 n))) n
Point V2 n
p Point V2 n -> Point V2 n -> n
forall a. Floating a => Point V2 a -> Point V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a -> a
`distance` Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pb n -> n -> Bool
forall a. Ord a => a -> a -> Bool
> n -> n
forall a. Num a => a -> a
abs (n
miterLimit n -> n -> n
forall a. Num a => a -> a -> a
* n
r) -> Trail V2 n
clip
| Bool
otherwise -> Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc (Located (Trail V2 n) -> Trail V2 n)
-> Located (Trail V2 n) -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))]
-> Located (Trail V2 n)
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices [ Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pa, Point (V (Located (Segment Closed V2 n))) n
Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
p, Point (V (Located (Trail V2 n))) (N (Located (Trail V2 n)))
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pb ]
where
t :: Located (Segment Closed V2 n)
t = V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V2 n -> V2 n
miter V2 n
vb) Segment Closed V2 n
-> Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
-> Located (Segment Closed V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Segment Closed V2 n)) (N (Segment Closed V2 n))
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pb
va :: V2 n
va = V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp (Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pa Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
e)
vb :: V2 n
vb = V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (V2 n -> V2 n) -> V2 n -> V2 n
forall a b. (a -> b) -> a -> b
$ V2 n -> V2 n
forall n. OrderedField n => V2 n -> V2 n
unitPerp (Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pb Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
e)
pa :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pa = Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atEnd Located (Trail V2 n)
a
pb :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
pb = Located (Trail V2 n)
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. EndValues p => p -> Codomain p (N p)
atStart Located (Trail V2 n)
b
miter :: V2 n -> V2 n
miter V2 n
v = n -> n
forall a. Num a => a -> a
abs (n
miterLimit n -> n -> n
forall a. Num a => a -> a -> a
* n
r) n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
v
clip :: Trail V2 n
clip = n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
forall n.
RealFloat n =>
n
-> n
-> Point V2 n
-> Located (Trail V2 n)
-> Located (Trail V2 n)
-> Trail V2 n
joinSegmentClip n
miterLimit n
r Point V2 n
e Located (Trail V2 n)
a Located (Trail V2 n)
b
cross :: n
cross = let (n
xa,n
ya) = V2 n -> (n, n)
forall n. V2 n -> (n, n)
unr2 V2 n
va; (n
xb,n
yb) = V2 n -> (n, n)
forall n. V2 n -> (n, n)
unr2 V2 n
vb in n -> n
forall a. Num a => a -> a
abs (n
xa n -> n -> n
forall a. Num a => a -> a -> a
* n
yb n -> n -> n
forall a. Num a => a -> a -> a
- n
xb n -> n -> n
forall a. Num a => a -> a -> a
* n
ya)