{-# LANGUAGE ConstraintKinds  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}
{-# LANGUAGE ViewPatterns     #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}
  -- for Data.Semigroup

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Arc
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Two-dimensional arcs, approximated by cubic bezier curves.
--
-----------------------------------------------------------------------------

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

-- For details of this approximation see:
--   http://www.tinaja.com/glib/bezcirc2.pdf

-- | @bezierFromSweepQ1 s@ constructs a 'Cubic' segment that starts in
--  the positive y direction and sweeps counterclockwise through an
--  angle @s@.  The approximation is only valid for angles in the
--  first quadrant.
bezierFromSweepQ1 :: Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 :: Angle n -> Segment Closed V2 n
bezierFromSweepQ1 Angle n
s = (V2 n -> V2 n) -> Segment Closed V2 n -> Segment Closed V2 n
forall (v :: * -> *) n (v' :: * -> *) n' c.
(v n -> v' n') -> Segment c v n -> Segment c v' n'
mapSegmentVectors (V2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX) (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 b c a. (b -> c) -> (a -> b) -> a -> c
. Angle n -> Segment Closed V2 n -> Segment Closed V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Angle n
s Angle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
2) (Segment Closed V2 n -> Segment Closed V2 n)
-> Segment Closed V2 n -> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ 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
c2 V2 n
c1 V2 n
p0
  where p0 :: V2 n
p0@(V2 n
x n
y) = Angle n -> V2 n
forall n. Floating n => Angle n -> V2 n
e (Angle n
s Angle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
2)
        c1 :: V2 n
c1          = n -> n -> V2 n
forall a. a -> a -> V2 a
V2 ((n
4n -> n -> n
forall a. Num a => a -> a -> a
-n
x)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
3) ((n
1n -> n -> n
forall a. Num a => a -> a -> a
-n
x)n -> n -> n
forall a. Num a => a -> a -> a
*(n
3n -> n -> n
forall a. Num a => a -> a -> a
-n
x)n -> n -> n
forall a. Fractional a => a -> a -> a
/(n
3n -> n -> n
forall a. Num a => a -> a -> a
*n
y))
        c2 :: V2 n
c2          = V2 n -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY V2 n
c1

-- | @bezierFromSweep s@ constructs a series of 'Cubic' segments that
--   start in the positive y direction and sweep counter clockwise
--   through the angle @s@.  If @s@ is negative, it will start in the
--   negative y direction and sweep clockwise.  When @s@ is less than
--   0.0001 the empty list results.  If the sweep is greater than @fullTurn@
--   later segments will overlap earlier segments.
bezierFromSweep :: OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep :: Angle n -> [Segment Closed V2 n]
bezierFromSweep Angle n
s
  | Angle n
s Angle n -> Angle n -> Bool
forall a. Ord a => a -> a -> Bool
< Angle n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero          = (Segment Closed V2 n -> Segment Closed V2 n)
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment Closed V2 n -> Segment Closed V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY ([Segment Closed V2 n] -> [Segment Closed V2 n])
-> (Angle n -> [Segment Closed V2 n])
-> Angle n
-> [Segment Closed V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle n -> [Segment Closed V2 n]
forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep (Angle n -> [Segment Closed V2 n])
-> Angle n -> [Segment Closed V2 n]
forall a b. (a -> b) -> a -> b
$ Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
s
  | Angle n
s Angle n -> Angle n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0.0001 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Iso' (Angle n) n
rad = []
  | Angle n
s Angle n -> Angle n -> Bool
forall a. Ord a => a -> a -> Bool
< Angle n
forall v. Floating v => Angle v
fullTurnAngle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4   = [Angle n -> Segment Closed V2 n
forall n. Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 Angle n
s]
  | Bool
otherwise         = Angle n -> Segment Closed V2 n
forall n. Floating n => Angle n -> Segment Closed V2 n
bezierFromSweepQ1 (Angle n
forall v. Floating v => Angle v
fullTurnAngle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4)
          Segment Closed V2 n
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall a. a -> [a] -> [a]
: (Segment Closed V2 n -> Segment Closed V2 n)
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> Segment Closed V2 n -> Segment Closed V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
4)) (Angle n -> [Segment Closed V2 n]
forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep (Angle n -> Angle n -> Angle n
forall a. Ord a => a -> a -> a
max (Angle n
s Angle n -> Angle n -> Angle n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Angle n
forall v. Floating v => Angle v
fullTurnAngle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/n
4) Angle n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero))

{-
~~~~ Note [segment spacing]

There are a few obvious options for segment spacing:
   A. Evenly space segments each with sweep less than or equal
      to one quarter of a circle.  This has the benefit of a better approximation
      (at least I think it is better).
   B. Use as much of the sweep in quarter-circle sized segments and one for
      the remainder.  This potentially gives more opportunities for
      consistency (though not as much as option C) as the error in
      approximation would more often match the error from another arc
      in the diagram.
   C. Like option B but fixing the orientation and having a remnant at
      the beginning and the end.

Option B is implemented and this note is for posterity if anyone comes
across a situation with large enough arcs that they can actually see
the approximation error.
-}

-- | Given a start direction @d@ and a sweep angle @s@, @'arcT' d s@
--   is the 'Trail' of a radius one arc starting at @d@ and sweeping out
--   the angle @s@ counterclockwise (for positive s).  The resulting
--   @Trail@ is allowed to wrap around and overlap itself.
arcT :: OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT :: Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
start Angle n
sweep = [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]
bs
  where
    bs :: [Segment Closed V2 n]
bs = (Segment Closed V2 n -> Segment Closed V2 n)
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (Direction V2 n -> Segment Closed V2 n -> Segment Closed V2 n
forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
Direction V2 n -> t -> t
rotateTo Direction V2 n
start) ([Segment Closed V2 n] -> [Segment Closed V2 n])
-> (Angle n -> [Segment Closed V2 n])
-> Angle n
-> [Segment Closed V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle n -> [Segment Closed V2 n]
forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep (Angle n -> [Segment Closed V2 n])
-> Angle n -> [Segment Closed V2 n]
forall a b. (a -> b) -> a -> b
$ Angle n
sweep

-- | Given a start direction @d@ and a sweep angle @s@, @'arc' d s@ is the
--   path of a radius one arc starting at @d@ and sweeping out the angle
--   @s@ counterclockwise (for positive s).  The resulting
--   @Trail@ is allowed to wrap around and overlap itself.
arc :: (InSpace V2 n t, OrderedField n, TrailLike t) => Direction V2 n -> Angle n -> t
arc :: Direction V2 n -> Angle n -> t
arc Direction V2 n
start Angle n
sweep = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t)) -> t
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Angle n -> Trail V2 n
forall n. OrderedField n => Direction V2 n -> Angle n -> Trail V2 n
arcT Direction V2 n
start Angle n
sweep 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` V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)

-- | Given a radus @r@, a start direction @d@ and an angle @s@,
--   @'arc'' r d s@ is the path of a radius @(abs r)@ arc starting at
--   @d@ and sweeping out the angle @s@ counterclockwise (for positive
--   s).  The origin of the arc is its center.
--
--   <<diagrams/src_Diagrams_TwoD_Arc_arc'Ex.svg#diagram=arc'Ex&width=300>>
--
--   > arc'Ex = mconcat [ arc' r xDir (1/4 @@ turn) | r <- [0.5,-1,1.5] ]
--   >        # centerXY # pad 1.1
arc' :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
arc' :: n -> Direction V2 n -> Angle n -> t
arc' (n -> n
forall a. Num a => a -> a
abs -> n
r) Direction V2 n
start Angle n
sweep = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t)) -> t
forall a b. (a -> b) -> a -> b
$ n -> Trail V2 n -> Trail V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r Trail V2 n
ts 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` V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (n
r n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)
  where ts :: Trail V2 n
ts = Direction V2 n -> Angle n -> Trail V2 n
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 :: Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
start Direction V2 n
end = [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]
bs
  where
    bs :: [Segment Closed V2 n]
bs    = (Segment Closed V2 n -> Segment Closed V2 n)
-> [Segment Closed V2 n] -> [Segment Closed V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (Direction V2 n -> Segment Closed V2 n -> Segment Closed V2 n
forall n t.
(InSpace V2 n t, OrderedField n, Transformable t) =>
Direction V2 n -> t -> t
rotateTo Direction V2 n
start) ([Segment Closed V2 n] -> [Segment Closed V2 n])
-> (Angle n -> [Segment Closed V2 n])
-> Angle n
-> [Segment Closed V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle n -> [Segment Closed V2 n]
forall n. OrderedField n => Angle n -> [Segment Closed V2 n]
bezierFromSweep (Angle n -> [Segment Closed V2 n])
-> Angle n -> [Segment Closed V2 n]
forall a b. (a -> b) -> a -> b
$ Angle n
sweep
    sweep :: Angle n
sweep = Angle n -> Angle n
forall n. (Floating n, Real n) => Angle n -> Angle n
normalizeAngle (Angle n -> Angle n) -> Angle n -> Angle n
forall a b. (a -> b) -> a -> b
$ Direction V2 n
end Direction V2 n
-> Getting (Angle n) (Direction V2 n) (Angle n) -> Angle n
forall s a. s -> Getting a s a -> a
^. Getting (Angle n) (Direction V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta Angle n -> Angle n -> Angle n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Direction V2 n
start Direction V2 n
-> Getting (Angle n) (Direction V2 n) (Angle n) -> Angle n
forall s a. s -> Getting a s a -> a
^. Getting (Angle n) (Direction V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta

-- | Given a start direction @s@ and end direction @e@, @arcCCW s e@ is the
--   path of a radius one arc counterclockwise between the two directions.
--   The origin of the arc is its center.
arcCCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
arcCCW :: Direction V2 n -> Direction V2 n -> t
arcCCW Direction V2 n
start Direction V2 n
end = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t)) -> t
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> Direction V2 n -> Trail V2 n
forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
start Direction V2 n
end 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` V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)

-- | Like 'arcAngleCCW' but clockwise.
arcCW :: (InSpace V2 n t, RealFloat n, TrailLike t) => Direction V2 n -> Direction V2 n -> t
arcCW :: Direction V2 n -> Direction V2 n -> t
arcCW Direction V2 n
start Direction V2 n
end = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail (V t) (N t)) -> t)
-> Located (Trail (V t) (N t)) -> t
forall a b. (a -> b) -> a -> b
$
  -- flipped arguments to get the path we want
  -- then reverse the trail to get the cw direction.
  Trail V2 n -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Trail v n
reverseTrail (Direction V2 n -> Direction V2 n -> Trail V2 n
forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Trail V2 n
arcCCWT Direction V2 n
end Direction V2 n
start) 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` V2 n -> Point V2 n
forall (f :: * -> *) a. f a -> Point f a
P (Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
start)

-- | Create a circular wedge of the given radius, beginning at the
--   given direction and extending through the given angle.
--
--   <<diagrams/src_Diagrams_TwoD_Arc_wedgeEx.svg#diagram=wedgeEx&width=400>>
--
--   > wedgeEx = hcat' (with & sep .~ 0.5)
--   >   [ wedge 1 xDir (1/4 @@ turn)
--   >   , wedge 1 (rotate (7/30 @@ turn) xDir) (4/30 @@ turn)
--   >   , wedge 1 (rotate (1/8 @@ turn) xDir) (3/4 @@ turn)
--   >   ]
--   >   # fc blue
--   >   # centerXY # pad 1.1
wedge :: (InSpace V2 n t, OrderedField n, TrailLike t) => n -> Direction V2 n -> Angle n -> t
wedge :: n -> Direction V2 n -> Angle n -> t
wedge n
r Direction V2 n
d Angle n
s = Located (Trail V2 n) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> t)
-> (Trail' Line V2 n -> Located (Trail V2 n))
-> Trail' Line V2 n
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin) (Trail V2 n -> Located (Trail V2 n))
-> (Trail' Line V2 n -> Trail V2 n)
-> Trail' Line V2 n
-> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' Line V2 n -> Trail V2 n)
-> Trail' Line V2 n
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine
              (Trail' Line V2 n -> t) -> Trail' Line V2 n -> t
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
r n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d]
                Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
forall a. Semigroup a => a -> a -> a
<> Direction V2 n -> Angle n -> Trail' Line V2 n
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 Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# n -> Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r
                Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
forall a. Semigroup a => a -> a -> a
<> [Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
r n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
s (V2 n -> V2 n) -> V2 n -> V2 n
forall a b. (a -> b) -> a -> b
$ Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d)]

-- | @arcBetween p q height@ creates an arc beginning at @p@ and
--   ending at @q@, with its midpoint at a distance of @abs height@
--   away from the straight line from @p@ to @q@.  A positive value of
--   @height@ results in an arc to the left of the line from @p@ to
--   @q@; a negative value yields one to the right.
--
--   <<diagrams/src_Diagrams_TwoD_Arc_arcBetweenEx.svg#diagram=arcBetweenEx&width=300>>
--
--   > arcBetweenEx = mconcat
--   >   [ arcBetween origin (p2 (2,1)) ht | ht <- [-0.2, -0.1 .. 0.2] ]
--   >   # centerXY # pad 1.1
arcBetween :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => Point V2 n -> Point V2 n -> n -> t
arcBetween :: Point V2 n -> Point V2 n -> n -> t
arcBetween Point V2 n
p Point V2 n
q n
ht = Located (Trail (V t) (N t)) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n)
a Located (Trail V2 n)
-> (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n)
forall a b. a -> (a -> b) -> b
# Angle n -> Located (Trail V2 n) -> Located (Trail V2 n)
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Diff (Point V2) n
V2 n
vV2 n -> Getting (Angle n) (V2 n) (Angle n) -> Angle n
forall s a. s -> Getting a s a -> a
^.Getting (Angle n) (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta) Located (Trail V2 n)
-> (Located (Trail V2 n) -> Located (Trail V2 n))
-> Located (Trail V2 n)
forall a b. a -> (a -> b) -> b
# 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
p)
  where
    h :: n
h = n -> n
forall a. Num a => a -> a
abs n
ht
    isStraight :: Bool
isStraight = n
h n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
0.00001
    v :: Diff (Point V2) n
v = Point V2 n
q Point V2 n -> Point V2 n -> Diff (Point V2) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
p
    d :: n
d = V2 n -> n
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Point V2 n
q Point V2 n -> Point V2 n -> Diff (Point V2) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
p)
    th :: Angle n
th  = n -> Angle n
forall n. Floating n => n -> Angle n
acosA ((n
dn -> n -> n
forall a. Num a => a -> a -> a
*n
d n -> n -> n
forall a. Num a => a -> a -> a
- n
4n -> n -> n
forall a. Num a => a -> a -> a
*n
hn -> n -> n
forall a. Num a => a -> a -> a
*n
h)n -> n -> n
forall a. Fractional a => a -> a -> a
/(n
dn -> n -> n
forall a. Num a => a -> a -> a
*n
d n -> n -> n
forall a. Num a => a -> a -> a
+ n
4n -> n -> n
forall a. Num a => a -> a -> a
*n
hn -> n -> n
forall a. Num a => a -> a -> a
*n
h))
    r :: n
r = n
dn -> n -> n
forall a. Fractional a => a -> a -> a
/(n
2n -> n -> n
forall a. Num a => a -> a -> a
*Angle n -> n
forall n. Floating n => Angle n -> n
sinA Angle n
th)
    mid :: Direction V2 n
mid | n
ht n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
0    = V2 n -> Direction V2 n
forall (v :: * -> *) n. v n -> Direction v n
direction V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY
        | Bool
otherwise  = V2 n -> Direction V2 n
forall (v :: * -> *) n. v n -> Direction v n
direction V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y
    st :: Direction V2 n
st  = Direction V2 n
mid Direction V2 n
-> (Direction V2 n -> Direction V2 n) -> Direction V2 n
forall a b. a -> (a -> b) -> b
& (Angle n -> Identity (Angle n))
-> Direction V2 n -> Identity (Direction V2 n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta ((Angle n -> Identity (Angle n))
 -> Direction V2 n -> Identity (Direction V2 n))
-> Angle n -> Direction V2 n -> Direction V2 n
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
th
    a :: Located (Trail V2 n)
a | Bool
isStraight
      = [Vn (Located (Trail V2 n))] -> Located (Trail V2 n)
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n
d n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
      | Bool
otherwise
      = Direction V2 n -> Angle n -> Located (Trail V2 n)
forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
st (n
2 n -> Angle n -> Angle n
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)

-- | Create an annular wedge of the given radii, beginning at the
--   first direction and extending through the given sweep angle.
--   The radius of the outer circle is given first.
--
--   <<diagrams/src_Diagrams_TwoD_Arc_annularWedgeEx.svg#diagram=annularWedgeEx&width=400>>
--
--   > annularWedgeEx = hsep 0.50
--   >   [ annularWedge 1 0.5 xDir (1/4 @@ turn)
--   >   , annularWedge 1 0.3 (rotate (7/30 @@ turn) xDir) (4/30 @@ turn)
--   >   , annularWedge 1 0.7 (rotate (1/8 @@ turn) xDir) (3/4 @@ turn)
--   >   ]
--   >   # fc blue
--   >   # centerXY # pad 1.1
annularWedge :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
                n -> n -> Direction V2 n -> Angle n -> t
annularWedge :: n -> n -> Direction V2 n -> Angle n -> t
annularWedge n
r1' n
r2' Direction V2 n
d1 Angle n
s = Located (Trail V2 n) -> t
forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike (Located (Trail V2 n) -> t)
-> (Trail' Line V2 n -> Located (Trail V2 n))
-> Trail' Line V2 n
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
o) (Trail V2 n -> Located (Trail V2 n))
-> (Trail' Line V2 n -> Trail V2 n)
-> Trail' Line V2 n
-> Located (Trail V2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' Line V2 n -> Trail V2 n)
-> Trail' Line V2 n
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine
              (Trail' Line V2 n -> t) -> Trail' Line V2 n -> t
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [(n
r1' n -> n -> n
forall a. Num a => a -> a -> a
- n
r2') n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d1]
                Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
forall a. Semigroup a => a -> a -> a
<> Direction V2 n -> Angle n -> Trail' Line V2 n
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 Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# n -> Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r1'
                Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
forall a. Semigroup a => a -> a -> a
<> [Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [(n
r1' n -> n -> n
forall a. Num a => a -> a -> a
- n
r2') n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (Direction V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Direction V2 n
d2)]
                Trail' Line V2 n -> Trail' Line V2 n -> Trail' Line V2 n
forall a. Semigroup a => a -> a -> a
<> Direction V2 n -> Angle n -> Trail' Line V2 n
forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
Direction V2 n -> Angle n -> t
arc Direction V2 n
d2 (Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
s) Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# n -> Trail' Line V2 n -> Trail' Line V2 n
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 = Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# Vn (Point V2 n) -> Point V2 n -> Point V2 n
forall t. Transformable t => Vn t -> t -> t
translate (n
r2' n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Direction V2 n -> V2 n
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 Direction V2 n
-> (Direction V2 n -> Direction V2 n) -> Direction V2 n
forall a b. a -> (a -> b) -> b
& (Angle n -> Identity (Angle n))
-> Direction V2 n -> Identity (Direction V2 n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta ((Angle n -> Identity (Angle n))
 -> Direction V2 n -> Identity (Direction V2 n))
-> Angle n -> Direction V2 n -> Direction V2 n
forall a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ Angle n
s