arrow envelopes

src/Diagrams/TwoD/Arrow.hs

@@ -113,6 +113,7 @@ import           Diagrams.Core
 import           Diagrams.Core.Types      (QDiaLeaf (..), mkQD')
 
 import           Diagrams.Angle
+import           Diagrams.Combinators     (withEnvelope)
 import           Diagrams.Parametric
 import           Diagrams.Path
 import           Diagrams.Solve           (quadForm)
@@ -348,6 +349,16 @@ scaleFactor tr tw hw t
     hv = hw *^ (tangentAtEnd   tr # normalized)
     v  = trailOffset tr
 
+-- Calculate the approximate envelope of a horizontal arrow
+-- as if the arrow were made only of a shaft.
+arrowEnv :: ArrowOpts -> Double -> Envelope R2
+arrowEnv opts len = getEnvelope horizShaft
+  where
+    horizShaft = shaft # rotate (negateV direction v) # scale (len / m)
+    m = magnitude v
+    v = trailOffset shaft
+    shaft = opts ^. arrowShaft
+
 -- | @arrow len@ creates an arrow of length @len@ with default
 --   parameters, starting at the origin and ending at the point
 --   @(len,0)@.
@@ -362,7 +373,7 @@ arrow' :: Renderable (Path R2) b => ArrowOpts -> Double -> Diagram b R2
 arrow' opts len = mkQD' (DelayedLeaf delayedArrow)
 
       -- Currently arrows have an empty envelope and trace.
-      mempty mempty mempty mempty
+      (arrowEnv opts len) mempty mempty mempty
 
   where
 
@@ -466,7 +477,8 @@ arrowAt s v = arrowAt' def s v
 arrowAt'
   :: Renderable (Path R2) b =>
      ArrowOpts -> P2 -> R2 -> Diagram b R2
-arrowAt' opts s v = arrow' opts len # rotate dir # moveTo s
+arrowAt' opts s v = arrow' opts len
+                  # rotate dir # moveTo s
   where
     len = magnitude v
     dir = direction v