{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Diagrams.TwoD.Arrowheads
-- Copyright   :  (c) 2013 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Standard arrowheads and tails. Each arrowhead or tail is designed
-- to be drawn filled, with a line width of 0, and is normalized to
-- fit inside a circle of diameter 1.
module Diagrams.TwoD.Arrowheads (
  -- * Arrowheads

  -- ** Standard arrowheads
  tri,
  dart,
  halfDart,
  spike,
  thorn,
  lineHead,
  noHead,

  -- ** Configurable arrowheads

  -- | Creates arrowheads of the same shape as the standard heads but
  --   where the angle parameter is used to specify the angle to the top
  --   left point of the arrowhead.
  arrowheadTriangle,
  arrowheadDart,
  arrowheadHalfDart,
  arrowheadSpike,
  arrowheadThorn,

  -- * Arrow tails

  -- ** Standard arrow tails
  tri',
  dart',
  halfDart',
  spike',
  thorn',
  lineTail,
  noTail,
  quill,
  block,

  -- ** Configurable arrow tails
  arrowtailQuill,
  arrowtailBlock,

  -- * Internals
  ArrowHT,
) where

import Control.Lens (both, over, (&), (.~), (<>~), (^.))
import Data.Default
import Data.Monoid (mempty, (<>))

import Diagrams.Angle
import Diagrams.Core

import Diagrams.Path
import Diagrams.Segment
import Diagrams.Trail
import Diagrams.TrailLike (fromOffsets)
import Diagrams.TwoD.Align
import Diagrams.TwoD.Arc (arc')
import Diagrams.TwoD.Path ()
import Diagrams.TwoD.Polygons
import Diagrams.TwoD.Shapes
import Diagrams.TwoD.Transform
import Diagrams.TwoD.Types
import Diagrams.TwoD.Vector (unitX, unit_X, xDir)
import Diagrams.Util ((#))

import Linear.Affine
import Linear.Metric
import Linear.Vector

-----------------------------------------------------------------------------

type ArrowHT n = n -> n -> (Path V2 n, Path V2 n)

closedPath :: OrderedField n => Trail V2 n -> Path V2 n
closedPath :: forall n. OrderedField n => Trail V2 n -> Path V2 n
closedPath = Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail

-- Heads ------------------------------------------------------------------
--   > drawHead h = arrowAt' (with & arrowHead .~ h & shaftStyle %~ lw none
--   >                             & headLength .~ local 0.5)
--   >         origin (r2 (1, 0))
--   >      <> square 0.5 # alignL # lw none # frame 0.1

-- | Isoceles triangle style. The above example specifies an angle of `2/5 Turn`.

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_tri25Ex.svg#diagram=tri25Ex&width=120>>

--   > tri25Ex = arrowAt' (with & arrowHead .~ arrowheadTriangle (2/5 @@ turn)
--   >                          & shaftStyle %~ lw none & headLength .~ local 0.5)
--   >           origin (r2 (0.5, 0))
--   >        <> square 0.6 # alignL # lw none # frame 0.1
arrowheadTriangle :: RealFloat n => Angle n -> ArrowHT n
arrowheadTriangle :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadTriangle Angle n
theta = n -> n -> (Path V2 n, Path V2 n)
aHead
 where
  aHead :: n -> n -> (Path V2 n, Path V2 n)
aHead n
len n
_ = (Path V2 n
p, Path V2 n
forall a. Monoid a => a
mempty)
   where
    psi :: n
psi = n
forall a. Floating a => a
pi n -> n -> n
forall a. Num a => a -> a -> a
- (Angle n
theta Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad)
    r :: n
r = n
len n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ n -> n
forall a. Floating a => a -> a
cos n
psi)
    p :: Path V2 n
p =
      PolygonOpts n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => PolygonOpts n -> t
polygon
        ( PolygonOpts n
forall a. Default a => a
def
            PolygonOpts n -> (PolygonOpts n -> PolygonOpts n) -> PolygonOpts n
forall a b. a -> (a -> b) -> b
& (PolyType n -> Identity (PolyType n))
-> PolygonOpts n -> Identity (PolygonOpts n)
forall n (f :: * -> *).
Functor f =>
(PolyType n -> f (PolyType n))
-> PolygonOpts n -> f (PolygonOpts n)
polyType
              ((PolyType n -> Identity (PolyType n))
 -> PolygonOpts n -> Identity (PolygonOpts n))
-> PolyType n -> PolygonOpts n -> PolygonOpts n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Angle n] -> [n] -> PolyType n
forall n. [Angle n] -> [n] -> PolyType n
PolyPolar
                [Angle n
theta, (-n
2) n -> Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Angle n
theta]
                (n -> [n]
forall a. a -> [a]
repeat n
r)
            PolygonOpts n -> (PolygonOpts n -> PolygonOpts n) -> PolygonOpts n
forall a b. a -> (a -> b) -> b
& (PolyOrientation n -> Identity (PolyOrientation n))
-> PolygonOpts n -> Identity (PolygonOpts n)
forall n (f :: * -> *).
Functor f =>
(PolyOrientation n -> f (PolyOrientation n))
-> PolygonOpts n -> f (PolygonOpts n)
polyOrient ((PolyOrientation n -> Identity (PolyOrientation n))
 -> PolygonOpts n -> Identity (PolygonOpts n))
-> PolyOrientation n -> PolygonOpts n -> PolygonOpts n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PolyOrientation n
forall n. PolyOrientation n
NoOrient
        )
        # alignL

-- | Isoceles triangle with linear concave base. Inkscape type 1 - dart like.
arrowheadDart :: RealFloat n => Angle n -> ArrowHT n
arrowheadDart :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadDart Angle n
theta n
len n
shaftWidth = (Path V2 n
hd Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
sz, Path V2 n
jt)
 where
  hd :: Path V2 n
hd = Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, Traced a,
 HasOrigin a) =>
a -> a
snugL (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path 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 -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [Vn (Trail V2 n)] -> Trail V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn (Trail V2 n)
V2 n
t1, Vn (Trail V2 n)
V2 n
t2, Vn (Trail V2 n)
V2 n
b2, Vn (Trail V2 n)
V2 n
b1]
  jt :: Path V2 n
jt = Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path 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 -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ Trail V2 n
j Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> Trail V2 n -> Trail V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY Trail V2 n
j
  j :: Trail V2 n
j = Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [Vn (Trail V2 n)] -> Trail V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
jLength) n
0, n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
0 (n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2)]
  v :: V2 n
v = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
  (V2 n
t1, V2 n
t2) = (V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unit_X 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
v, n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
0.5) n
0 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
v)
  (V2 n
b1, V2 n
b2) = ASetter (V2 n, V2 n) (V2 n, V2 n) (V2 n) (V2 n)
-> (V2 n -> V2 n) -> (V2 n, V2 n) -> (V2 n, V2 n)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (V2 n, V2 n) (V2 n, V2 n) (V2 n) (V2 n)
Traversal (V2 n, V2 n) (V2 n, V2 n) (V2 n) (V2 n)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (V2 n -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY (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 (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated) (V2 n
t1, V2 n
t2)
  psi :: n
psi = n
forall a. Floating a => a
pi n -> n -> n
forall a. Num a => a -> a -> a
- V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V2 n
t2 V2 n -> Getting n (V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. (Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n)
forall n. RealFloat n => Lens' (V2 n) (Angle n)
Lens' (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta ((Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n))
-> ((n -> Const n n) -> Angle n -> Const n (Angle n))
-> Getting n (V2 n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const n n) -> Angle n -> Const n (Angle n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
  jLength :: n
jLength = n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Floating a => a -> a
tan n
psi)

  -- If the shaft is too wide, set the size to a default value of 1.
  sz :: n
sz = n -> n -> n
forall a. Ord a => a -> a -> a
max n
1 ((n
len n -> n -> n
forall a. Num a => a -> a -> a
- n
jLength) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
1.5)

-- | Top half of an 'arrowheadDart'.
arrowheadHalfDart :: RealFloat n => Angle n -> ArrowHT n
arrowheadHalfDart :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadHalfDart Angle n
theta n
len n
shaftWidth = (Path V2 n
hd, Path V2 n
jt)
 where
  hd :: Path V2 n
hd =
    [Vn (Trail V2 n)] -> Trail V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn (Trail V2 n)
V2 n
t1, Vn (Trail V2 n)
V2 n
t2]
      # closeTrail
      # pathFromTrail
      # translateX 1.5
      # scale sz
      # translateY (-shaftWidth / 2)
      # snugL
  jt :: Path V2 n
jt = Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, Traced a,
 HasOrigin a) =>
a -> a
snugR (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY (-n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2) (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [Vn (Trail V2 n)] -> Trail V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
jLength) n
0, n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
0 n
shaftWidth]
  v :: V2 n
v = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
  (V2 n
t1, V2 n
t2) = (V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unit_X 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
v, (n
0.5 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
unit_X) 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
v)
  psi :: n
psi = n
forall a. Floating a => a
pi n -> n -> n
forall a. Num a => a -> a -> a
- V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V2 n
t2 V2 n -> Getting n (V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. (Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n)
forall n. RealFloat n => Lens' (V2 n) (Angle n)
Lens' (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta ((Angle n -> Const n (Angle n)) -> V2 n -> Const n (V2 n))
-> ((n -> Const n n) -> Angle n -> Const n (Angle n))
-> Getting n (V2 n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> Const n n) -> Angle n -> Const n (Angle n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
  jLength :: n
jLength = n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ n -> n
forall a. Floating a => a -> a
tan n
psi

  -- If the shaft is too wide, set the size to a default value of 1.
  sz :: n
sz = n -> n -> n
forall a. Ord a => a -> a -> a
max n
1 ((n
len n -> n -> n
forall a. Num a => a -> a -> a
- n
jLength) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
1.5)

-- | Isoceles triangle with curved concave base. Inkscape type 2.
arrowheadSpike :: RealFloat n => Angle n -> ArrowHT n
arrowheadSpike :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadSpike Angle n
theta n
len n
shaftWidth = (Path V2 n
hd Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r, Path V2 n
jt Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
r)
 where
  hd :: Path V2 n
hd = Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, Traced a,
 HasOrigin a) =>
a -> a
snugL (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall n. OrderedField n => Trail V2 n -> Path V2 n
closedPath (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ Trail V2 n
l1 Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> Trail V2 n
c Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> Trail V2 n
l2
  jt :: Path V2 n
jt =
    Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignR
      (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerY
      (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail
      (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail
      (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ n -> Direction V2 n -> Angle n -> Trail V2 n
forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
arc' n
1 (Direction V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => Direction v n
xDir 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 n. RealFloat n => Lens' (Direction V2 n) (Angle n)
Lens' (Direction V2 n) (Angle 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
phi) (n
2 n -> Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Angle n
phi)
  l1 :: Trail V2 n
l1 = [Segment Closed V2 n] -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Segment Closed v n] -> Trail v n
trailFromSegments [V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V2 n -> Segment Closed V2 n) -> V2 n -> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unit_X 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
v]
  l2 :: Trail V2 n
l2 = [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 -> Segment Closed V2 n
forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment (Segment Closed V2 n -> Segment Closed V2 n)
-> (V2 n -> Segment Closed V2 n) -> V2 n -> Segment Closed V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V2 n -> Segment Closed V2 n) -> V2 n -> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ (V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unit_X 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 -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY V2 n
v)]
  c :: Trail V2 n
c = n -> Direction V2 n -> Angle n -> Trail V2 n
forall n t.
(InSpace V2 n t, OrderedField n, TrailLike t) =>
n -> Direction V2 n -> Angle n -> t
arc' n
1 (Angle n -> Direction V2 n -> Direction V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
α Direction V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => Direction v n
xDir) ((-n
2) n -> Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Angle n
α)
  α :: Angle n
α = (n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn) Angle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ Angle n
theta
  v :: V2 n
v = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX

  -- The length of the head without its joint is, -2r cos theta and
  -- the length of the joint is r - sqrt (r^2 - y^2). So the total
  -- length of the arrow head is given by r(1 - 2 cos theta)-sqrt (r^2-y^2).
  -- Solving the quadratic gives two roots, we want the larger one.

  -- 1/4 turn < theta < 2/3 turn.
  a :: n
a = n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Floating a => a -> a
cos (Angle n
theta Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad)
  y :: n
y = n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2

  -- If the shaft is too wide for the head, we default the radius r to
  -- 2/3 * len by setting d=1 and phi=pi/2.
  d :: n
d = n -> n -> n
forall a. Ord a => a -> a -> a
max n
1 (n
len n -> n -> n
forall a. Floating a => a -> a -> a
** n
2 n -> n -> n
forall a. Num a => a -> a -> a
+ (n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
a n -> n -> n
forall a. Floating a => a -> a -> a
** n
2) n -> n -> n
forall a. Num a => a -> a -> a
* n
y n -> n -> n
forall a. Floating a => a -> a -> a
** n
2)
  r :: n
r = (n
a n -> n -> n
forall a. Num a => a -> a -> a
* n
len n -> n -> n
forall a. Num a => a -> a -> a
+ n -> n
forall a. Floating a => a -> a
sqrt n
d) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
a n -> n -> n
forall a. Floating a => a -> a -> a
** n
2 n -> n -> n
forall a. Num a => a -> a -> a
- n
1)
  phi :: Angle n
phi = n -> Angle n
forall n. Floating n => n -> Angle n
asinA (n -> n -> n
forall a. Ord a => a -> a -> a
min n
1 (n
y n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
r))

-- | Curved sides, linear concave base. Illustrator CS5 #3
arrowheadThorn :: RealFloat n => Angle n -> ArrowHT n
arrowheadThorn :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadThorn Angle n
theta n
len n
shaftWidth = (Path V2 n
hd Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
sz, Path V2 n
jt)
 where
  hd :: Path V2 n
hd = Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, Traced a,
 HasOrigin a) =>
a -> a
snugL (Path V2 n -> Path V2 n)
-> (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path 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 -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ Trail V2 n
hTop Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> Trail V2 n -> Trail V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY Trail V2 n
hTop
  hTop :: Trail V2 n
hTop = Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail (Trail V2 n -> Trail V2 n)
-> ([Segment Closed V2 n] -> Trail V2 n)
-> [Segment Closed V2 n]
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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] -> Trail V2 n)
-> [Segment Closed V2 n] -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [Segment Closed V2 n
c, Segment Closed V2 n
l]
  jt :: Path V2 n
jt = Trail V2 n -> Path V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> Path v n
pathFromTrail (Trail V2 n -> Path V2 n)
-> (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Path 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 -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ Trail V2 n
j Trail V2 n -> Trail V2 n -> Trail V2 n
forall a. Semigroup a => a -> a -> a
<> Trail V2 n -> Trail V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY Trail V2 n
j
  j :: Trail V2 n
j = Trail V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail v n -> Trail v n
closeTrail (Trail V2 n -> Trail V2 n) -> Trail V2 n -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [Vn (Trail V2 n)] -> Trail V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
jLength) n
0, n -> n -> V2 n
forall a. a -> a -> V2 a
V2 n
0 (n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2)]
  c :: Segment Closed V2 n
c = Angle n -> Segment Closed V2 n
forall n. Floating n => Angle n -> Segment Closed V2 n
curvedSide Angle n
theta
  v :: V2 n
v = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
  l :: Segment Closed V2 n
l = Segment Closed V2 n -> Segment Closed V2 n
forall n (v :: * -> *).
(Num n, Additive v) =>
Segment Closed v n -> Segment Closed v n
reverseSegment (Segment Closed V2 n -> Segment Closed V2 n)
-> (V2 n -> Segment Closed V2 n) -> V2 n -> Segment Closed V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (V2 n -> Segment Closed V2 n) -> V2 n -> Segment Closed V2 n
forall a b. (a -> b) -> a -> b
$ V2 n
t
  t :: V2 n
t = V2 n
v 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
^-^ n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
0.5) n
0
  psi :: Angle n
psi = Angle n
forall v. Floating v => Angle v
fullTurn Angle n -> n -> Angle n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
2 Angle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V2 n
t V2 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 n. RealFloat n => Lens' (V2 n) (Angle n)
Lens' (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta)
  jLength :: n
jLength = n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
2 n -> n -> n
forall a. Num a => a -> a -> a
* Angle n -> n
forall n. Floating n => Angle n -> n
tanA Angle n
psi)

  -- If the shaft if too wide, set the size to a default value of 1.
  sz :: n
sz = n -> n -> n
forall a. Ord a => a -> a -> a
max n
1 ((n
len n -> n -> n
forall a. Num a => a -> a -> a
- n
jLength) n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
1.5)

-- | Make a side for the thorn head.
curvedSide :: Floating n => Angle n -> Segment Closed V2 n
curvedSide :: forall n. Floating n => Angle n -> Segment Closed V2 n
curvedSide Angle n
theta = 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
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
ctrl1 V2 n
ctrl2 V2 n
end
 where
  v0 :: v n
v0 = v n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unit_X
  v1 :: V2 n
v1 = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
  ctrl1 :: v n
ctrl1 = v n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
v0
  ctrl2 :: V2 n
ctrl2 = V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
v0 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
v1
  end :: V2 n
end = V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
v0 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
v1

-- Standard heads ---------------------------------------------------------

-- | A line the same width as the shaft.
lineHead :: RealFloat n => ArrowHT n
lineHead :: forall n. RealFloat n => ArrowHT n
lineHead n
s n
w = (n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square n
1 Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
s Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
w Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignL, Path V2 n
forall a. Monoid a => a
mempty)

noHead :: ArrowHT n
noHead :: forall n. ArrowHT n
noHead n
_ n
_ = (Path V2 n
forall a. Monoid a => a
mempty, Path V2 n
forall a. Monoid a => a
mempty)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_triEx.svg#diagram=triEx&width=100>>

--   > triEx = drawHead tri
tri :: RealFloat n => ArrowHT n
tri :: forall n. RealFloat n => ArrowHT n
tri = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadTriangle (n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
3 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_spikeEx.svg#diagram=spikeEx&width=100>>

--   > spikeEx = drawHead spike
spike :: RealFloat n => ArrowHT n
spike :: forall n. RealFloat n => ArrowHT n
spike = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadSpike (n
3 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
8 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_thornEx.svg#diagram=thornEx&width=100>>

--   > thornEx = drawHead thorn
thorn :: RealFloat n => ArrowHT n
thorn :: forall n. RealFloat n => ArrowHT n
thorn = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadThorn (n
3 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
8 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_dartEx.svg#diagram=dartEx&width=100>>

--   > dartEx = drawHead dart
dart :: RealFloat n => ArrowHT n
dart :: forall n. RealFloat n => ArrowHT n
dart = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadDart (n
2 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
5 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_halfDartEx.svg#diagram=halfDartEx&width=100>>

--   > halfDartEx = drawHead halfDart
halfDart :: RealFloat n => ArrowHT n
halfDart :: forall n. RealFloat n => ArrowHT n
halfDart = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowheadHalfDart (n
2 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
5 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- Tails ------------------------------------------------------------------
--   > drawTail t = arrowAt' (with  & arrowTail .~ t & shaftStyle %~ lw none
--   >                              & arrowHead .~ noHead & tailLength .~ local 0.5)
--   >         origin (r2 (1, 0))
--   >      <> square 0.5 # alignL # lw none # frame 0.1

-- | Utility function to convert any arrowhead to an arrowtail, i.e.
--   attached at the start of the trail.
headToTail :: OrderedField n => ArrowHT n -> ArrowHT n
headToTail :: forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
hd = ArrowHT n
tl
 where
  tl :: ArrowHT n
tl n
sz n
shaftWidth = (Path V2 n
t, Path V2 n
j)
   where
    (Path V2 n
t', Path V2 n
j') = ArrowHT n
hd n
sz n
shaftWidth
    t :: Path V2 n
t = Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
t -> t
reflectX Path V2 n
t'
    j :: Path V2 n
j = Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
t -> t
reflectX Path V2 n
j'

arrowtailBlock :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowtailBlock :: forall n. RealFloat n => Angle n -> ArrowHT n
arrowtailBlock Angle n
theta = n -> n -> (Path V2 n, Path V2 n)
aTail
 where
  aTail :: n -> n -> (Path V2 n, Path V2 n)
aTail n
len n
_ = (Path V2 n
t, Path V2 n
forall a. Monoid a => a
mempty)
   where
    t :: Path V2 n
t = n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
len (n
len n -> n -> n
forall a. Num a => a -> a -> a
* n
x) Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignR
    a' :: V2 n
    a' :: V2 n
a' = Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
    a :: V2 n
a = V2 n
a' 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 -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY V2 n
a'
    x :: n
x = V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
a

-- | The angle is where the top left corner intersects the circle.
arrowtailQuill :: OrderedField n => Angle n -> ArrowHT n
arrowtailQuill :: forall n. OrderedField n => Angle n -> ArrowHT n
arrowtailQuill Angle n
theta = n -> n -> (Path V2 n, Path V2 n)
aTail
 where
  aTail :: n -> n -> (Path V2 n, Path V2 n)
aTail n
len n
shaftWidth = (Path V2 n
t, Path V2 n
j)
   where
    t :: Path V2 n
t =
      Trail V2 n -> Path V2 n
forall n. OrderedField n => Trail V2 n -> Path V2 n
closedPath ([Point V2 n] -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Point v n] -> Trail v n
trailFromVertices [Point V2 n
forall {n}. Fractional n => P2 n
v0, Point V2 n
v1, Point V2 n
v2, Point V2 n
forall {n}. Fractional n => P2 n
v3, Point V2 n
v4, Point V2 n
v5, Point V2 n
forall {n}. Fractional n => P2 n
v0])
        # scale sz
        # alignR
    sz :: n
sz = n
len n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
0.6
    v0 :: P2 n
v0 = (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 (n
0.5, n
0)
    v2 :: Point V2 n
v2 = 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
.+^ (Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
0.5)
    v1 :: Point V2 n
v1 = Point V2 n
v2 Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# n -> Point V2 n -> Point V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX (n
5 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
8)
    v3 :: P2 n
v3 = (n, n) -> P2 n
forall n. (n, n) -> P2 n
p2 (-n
0.1, n
0)
    v4 :: Point V2 n
v4 = Point V2 n
v2 Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# Point V2 n -> Point V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY
    v5 :: Point V2 n
v5 = Point V2 n
v4 Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# n -> Point V2 n -> Point V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX (n
5 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
8)
    s :: n
s = n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
shaftWidth n -> n -> n
forall a. Fractional a => a -> a -> a
/ V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Point V2 n
v1 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
v5)
    n1 :: Point V2 n
n1 = Point V2 n
forall {n}. Fractional n => P2 n
v0 Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# n -> Point V2 n -> Point V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY (n
0.5 n -> n -> n
forall a. Num a => a -> a -> a
* n
shaftWidth)
    n2 :: Point V2 n
n2 = Point V2 n
v1 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
.-^ ((Point V2 n
v1 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
forall {n}. Fractional n => P2 n
v0) V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
s)
    n3 :: Point V2 n
n3 = Point V2 n
v5 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
.-^ ((Point V2 n
v5 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
forall {n}. Fractional n => P2 n
v0) V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
s)
    n4 :: Point V2 n
n4 = Point V2 n
n1 Point V2 n -> (Point V2 n -> Point V2 n) -> Point V2 n
forall a b. a -> (a -> b) -> b
# Point V2 n -> Point V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY
    j :: Path V2 n
j = Trail V2 n -> Path V2 n
forall n. OrderedField n => Trail V2 n -> Path V2 n
closedPath (Trail V2 n -> Path V2 n) -> Trail V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [Point V2 n] -> Trail V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
[Point v n] -> Trail v n
trailFromVertices [Point V2 n
forall {n}. Fractional n => P2 n
v0, Point V2 n
n1, Point V2 n
n2, Point V2 n
forall {n}. Fractional n => P2 n
v0, Point V2 n
n3, Point V2 n
n4, Point V2 n
forall {n}. Fractional n => P2 n
v0]

-- Standard tails ---------------------------------------------------------

-- | A line the same width as the shaft.
lineTail :: RealFloat n => ArrowHT n
lineTail :: forall n. RealFloat n => ArrowHT n
lineTail n
s n
w = (n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square n
1 Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
w Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
s Path V2 n -> (Path V2 n -> Path V2 n) -> Path V2 n
forall a b. a -> (a -> b) -> b
# Path V2 n -> Path V2 n
forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignR, Path V2 n
forall a. Monoid a => a
mempty)

noTail :: ArrowHT n
noTail :: forall n. ArrowHT n
noTail n
_ n
_ = (Path V2 n
forall a. Monoid a => a
mempty, Path V2 n
forall a. Monoid a => a
mempty)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_tri'Ex.svg#diagram=tri'Ex&width=100>>

--   > tri'Ex = drawTail tri'
tri' :: RealFloat n => ArrowHT n
tri' :: forall n. RealFloat n => ArrowHT n
tri' = ArrowHT n -> ArrowHT n
forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
forall n. RealFloat n => ArrowHT n
tri

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_spike'Ex.svg#diagram=spike'Ex&width=100>>

--   > spike'Ex = drawTail spike'
spike' :: RealFloat n => ArrowHT n
spike' :: forall n. RealFloat n => ArrowHT n
spike' = ArrowHT n -> ArrowHT n
forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
forall n. RealFloat n => ArrowHT n
spike

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_thorn'Ex.svg#diagram=thorn'Ex&width=100>>

--   > thorn'Ex = drawTail thorn'
thorn' :: RealFloat n => ArrowHT n
thorn' :: forall n. RealFloat n => ArrowHT n
thorn' = ArrowHT n -> ArrowHT n
forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
forall n. RealFloat n => ArrowHT n
thorn

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_dart'Ex.svg#diagram=dart'Ex&width=100>>

--   > dart'Ex = drawTail dart'
dart' :: RealFloat n => ArrowHT n
dart' :: forall n. RealFloat n => ArrowHT n
dart' = ArrowHT n -> ArrowHT n
forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
forall n. RealFloat n => ArrowHT n
dart

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_halfDart'Ex.svg#diagram=halfDart'Ex&width=100>>

--   > halfDart'Ex = drawTail halfDart'
halfDart' :: RealFloat n => ArrowHT n
halfDart' :: forall n. RealFloat n => ArrowHT n
halfDart' = ArrowHT n -> ArrowHT n
forall n. OrderedField n => ArrowHT n -> ArrowHT n
headToTail ArrowHT n
forall n. RealFloat n => ArrowHT n
halfDart

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_quillEx.svg#diagram=quillEx&width=100>>

--   > quillEx = drawTail quill
quill :: (Floating n, Ord n) => ArrowHT n
quill :: forall n. (Floating n, Ord n) => ArrowHT n
quill = Angle n -> ArrowHT n
forall n. OrderedField n => Angle n -> ArrowHT n
arrowtailQuill (n
2 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
5 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | <<diagrams/src_Diagrams_TwoD_Arrowheads_blockEx.svg#diagram=blockEx&width=100>>

--   > blockEx = drawTail block
block :: RealFloat n => ArrowHT n
block :: forall n. RealFloat n => ArrowHT n
block = Angle n -> ArrowHT n
forall n. RealFloat n => Angle n -> ArrowHT n
arrowtailBlock (n
7 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
16 n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)