Haskell 图 : arrows with fixed orientation

Question

我需要在两个任意“节点”之间绘制箭头。箭头末端需要从四个基本方向之一进入或离开节点:N、S、E、W。

data Dir = N | S | E | W
     deriving (Eq, Ord, Show)

cir, circles :: Diagram B
cir  = circle 0.3 # showOrigin # lw thick
circles = (cir # named "1") ||| strutX 3 ||| (cir # named "2")

ctrlPoint :: Dir -> V2 Double
ctrlPoint N = r2 (0, 1)
ctrlPoint S = r2 (0, -1)
ctrlPoint E = r2 (1, 0)
ctrlPoint W = r2 (-1, 0)

-- This function should specify an arrow shaft entering nodes from directions dir1 and dir2
shaft :: Dir -> Dir -> Trail V2 Double
shaft dir1 dir2 = trailFromSegments [bézier3 (controlPoint dir1) (controlPoint dir2) (r2 (3, 0))]

example = circles # connect' (with ... & arrowShaft .~ shaft N S ) "1" "2"

在上图中，箭头在第一个圆圈中正确地从北进入，在第二个圆圈中从南进入。但是，如果我垂直设置点，所有内容都会旋转:

circles = (cir # named "1") === strutY 3 === (cir # named "2")

这是不正确的，因为我希望箭头分别从北和南进入。箭杆似乎完全旋转了......如何编写我的函数 shaft::Dir -> Dir -> Trail V2 Double？谢谢

Answer 1

我使用 arrowFromLocatedTrail' 找到了答案:

-- control points for bézier curves
control :: Dir -> V2 Double
control N = r2 (0, 0.5)
control S = r2 (0, -0.5)
control E = r2 (0.5, 0)
control W = r2 (-0.5, 0)

-- shaft of arrows
shaft :: (P2 Double, Dir) -> (P2 Double, Dir) ->  Located (Trail V2 Double)
shaft (p, d) (p', d') = trailFromSegments [bézier3 (control d) ((p' .-. p) - (control d')) (p' .-. p)] `at` p

-- create a single arrow
mkArrow :: (P2 Double, Dir) -> (P2 Double, Dir) -> Diagram B
mkArrow a b = arrowFromLocatedTrail' (with & arrowHead .~ dart
                                    & lengths .~ veryLarge
                                    & shaftStyle %~ lw thick) (shaft a b)

此版本执行必要的转换:

bézier3 (control d) ((p' .-. p) + (control d')) (p' .-. p)

这是bézier的签名:

bézier3 :: v n -> v n -> v n -> Segment Closed v n 

它需要 3 个向量，这里命名为 V1、V2 和 V3。贝塞尔曲线默认不位于图表中，它们只是指定如何移动。

因此，为了绘制贝塞尔曲线，我们设置:

V1 = control d
V2 = (p' .-. p) + (control d')
V3 = p' .-. p

生成的贝塞尔曲线将位于 p。