{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Diagrams.TwoD.Arc
( arc
, arc'
, arcT
, arcCCW
, arcCW
, bezierFromSweep
, wedge
, arcBetween
, annularWedge
) where
import Diagrams.Angle
import Diagrams.Core
import Diagrams.Direction
import Diagrams.Located (at)
import Diagrams.Segment
import Diagrams.Trail
import Diagrams.TrailLike
import Diagrams.TwoD.Transform
import Diagrams.TwoD.Types
import Diagrams.TwoD.Vector (e, unitX, unitY, unit_Y)
import Diagrams.Util (( # ))
import Control.Lens ((&), (<>~), (^.))
import Data.Semigroup
import Linear.Affine
import Linear.Metric
import Linear.Vector
bezierFromSweepQ1 :: Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 :: forall n. Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 Angle n
s = forall (v :: * -> *) n (v' :: * -> *) n' c.
(v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors (forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Angle n
s forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
2) forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 V2 n
c2 V2 n
c1 V2 n
p0
where p0 :: V2 n
p0@(V2 n
x n
y) = forall n. Floating n => Angle n -> V2 n
e (Angle n
s forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
2)
c1 :: V2 n
c1 = forall a. a -> a -> V2 a
V2 ((n
4forall a. Num a => a -> a -> a
-n
x)forall a. Fractional a => a -> a -> a
/n
3) ((n
1forall a. Num a => a -> a -> a
-n
x)forall a. Num a => a -> a -> a
*(n
3forall a. Num a => a -> a -> a
-n
x)forall a. Fractional a => a -> a -> a
/(n
3forall a. Num a => a -> a -> a
*n
y))
c2 :: V2 n
c2 = forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY V2 n
c1
bezierFromSweep :: OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep :: forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep Angle n
s
| Angle n
s forall a. Ord a => a -> a -> Bool
< forall (f :: * -> *) a. (Additive f, Num a) => f a
zero = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
s
| Angle n
s forall a. Ord a => a -> a -> Bool
< n
0.0001 forall b a. b -> AReview a b -> a
@@ forall n. Iso' (Angle n) n
rad = []
| Angle n
s forall a. Ord a => a -> a -> Bool
< forall v. Floating v => Angle v
fullTurnforall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4 = [forall n. Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 Angle n
s]
| Bool
otherwise = forall n. Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 (forall v. Floating v => Angle v
fullTurnforall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4)
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (n
1forall a. Fractional a => a -> a -> a
/n
4)) (forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep (forall a. Ord a => a -> a -> a
max (Angle n
s forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ forall v. Floating v => Angle v
fullTurnforall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4) forall (f :: * -> *) a. (Additive f, Num a) => f a
zero))
arcT :: OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT :: forall n. OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
start Angle n
sweep = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments [Segment Closed V2 n]
bs
where
bs :: [Segment Closed V2 n]
bs = forall a b. (a -> b) -> [a] -> [b]
map (forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
Direction V2 n -> t -> t
rotateTo Direction V2 n
start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep forall a b. (a -> b) -> a -> b
$ Angle n
sweep
arc :: (InSpace V2 n t, OrderedField n, TrailLike t) => Direction V2 n -> Angle n -> t
arc :: forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
start Angle n
sweep = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall a b. (a -> b) -> a -> b
$ forall n. OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
start Angle n
sweep forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. f a -> Point f a
P (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)
arc' :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
arc' :: forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
arc' (forall a. Num a => a -> a
abs -> n
r) Direction V2 n
start Angle n
sweep = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r Trail V2 n
ts forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. f a -> Point f a
P (n
r forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)
where ts :: Trail V2 n
ts = forall n. OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
start Angle n
sweep
arcCCWT :: RealFloat n => Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT :: forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
start Direction V2 n
end = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments [Segment Closed V2 n]
bs
where
bs :: [Segment Closed V2 n]
bs = forall a b. (a -> b) -> [a] -> [b]
map (forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
Direction V2 n -> t -> t
rotateTo Direction V2 n
start) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep forall a b. (a -> b) -> a -> b
$ Angle n
sweep
sweep :: Angle n
sweep = forall n. (Floating n, Real n) => Angle n -> Angle n
normalizeAngle forall a b. (a -> b) -> a -> b
$ Direction V2 n
end forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Direction V2 n
start forall s a. s -> Getting a s a -> a
^. forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta
arcCCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
arcCCW :: forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
arcCCW Direction V2 n
start Direction V2 n
end = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall a b. (a -> b) -> a -> b
$ forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
start Direction V2 n
end forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. f a -> Point f a
P (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)
arcCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
arcCW :: forall n t.
(InSpace V2 n t, RealFloat n, TrailLike t) =>
Direction V2 n -> Direction V2 n -> t
arcCW Direction V2 n
start Direction V2 n
end = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall a b. (a -> b) -> a -> b
$
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
reverseTrail (forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
end Direction V2 n
start) forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. f a -> Point f a
P (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)
wedge :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
wedge :: forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
wedge n
r Direction V2 n
d Angle n
s = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine
forall a b. (a -> b) -> a -> b
$ forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
r forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d]
forall a. Semigroup a => a -> a -> a
<> forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
d Angle n
s forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r
forall a. Semigroup a => a -> a -> a
<> forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
r forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
s forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d)]
arcBetween :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => Point V2 n -> Point V2 n -> n -> t
arcBetween :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
Point V2 n -> Point V2 n -> n -> t
arcBetween Point V2 n
p Point V2 n
q n
ht = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n)
a forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Diff (Point V2) n
vforall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
Point v n -> t -> t
moveTo Point V2 n
p)
where
h :: n
h = forall a. Num a => a -> a
abs n
ht
isStraight :: Bool
isStraight = n
h forall a. Ord a => a -> a -> Bool
< n
0.00001
v :: Diff (Point V2) n
v = Point V2 n
q forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
p
d :: n
d = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Point V2 n
q forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
p)
th :: Angle n
th = forall n. Floating n => n -> Angle n
acosA ((n
dforall a. Num a => a -> a -> a
*n
d forall a. Num a => a -> a -> a
- n
4forall a. Num a => a -> a -> a
*n
hforall a. Num a => a -> a -> a
*n
h)forall a. Fractional a => a -> a -> a
/(n
dforall a. Num a => a -> a -> a
*n
d forall a. Num a => a -> a -> a
+ n
4forall a. Num a => a -> a -> a
*n
hforall a. Num a => a -> a -> a
*n
h))
r :: n
r = n
dforall a. Fractional a => a -> a -> a
/(n
2forall a. Num a => a -> a -> a
*forall n. Floating n => Angle n -> n
sinA Angle n
th)
mid :: Direction V2 n
mid | n
ht forall a. Ord a => a -> a -> Bool
>= n
0 = forall (v :: * -> *) n. v n -> Direction v n
direction forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY
| Bool
otherwise = forall (v :: * -> *) n. v n -> Direction v n
direction forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y
st :: Direction V2 n
st = Direction V2 n
mid forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
th
a :: Located (Trail V2 n)
a | Bool
isStraight
= forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
d forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
| Bool
otherwise
= forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
st (n
2 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Angle n
th)
# scale r
# translateY ((if ht > 0 then negate else id) (r - h))
# translateX (d/2)
# (if ht > 0 then reverseLocTrail else id)
annularWedge :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
n -> n -> Direction V2 n -> Angle n -> t
annularWedge :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
n -> n -> Direction V2 n -> Angle n -> t
annularWedge n
r1' n
r2' Direction V2 n
d1 Angle n
s = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Point (V a) (N a) -> Located a
`at` Point V2 n
o) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
glueTrail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine
forall a b. (a -> b) -> a -> b
$ forall t. TrailLike t => [Vn t] -> t
fromOffsets [(n
r1' forall a. Num a => a -> a -> a
- n
r2') forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d1]
forall a. Semigroup a => a -> a -> a
<> forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
d1 Angle n
s forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r1'
forall a. Semigroup a => a -> a -> a
<> forall t. TrailLike t => [Vn t] -> t
fromOffsets [(n
r1' forall a. Num a => a -> a -> a
- n
r2') forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d2)]
forall a. Semigroup a => a -> a -> a
<> forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
d2 (forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
s) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r2'
where o :: Point V2 n
o = forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall a b. a -> (a -> b) -> b
# forall t. Transformable t => Vn t -> t -> t
translate (n
r2' forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d1)
d2 :: Direction V2 n
d2 = Direction V2 n
d1 forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Angle n
s