修复 arrowShaft（图表库）

Question

我使用 B.difference 和 B.union 制作了一个 数据存储 符号。中间有红点的那个

dataStorage :: Diagram B
dataStorage =  (strokePath $ B.difference Winding  combined  block1) # translateX (-0.3)
  where block1 = (circle 0.5)  # scaleX 0.5 # translateX (-1)
        block2 = rect 2 1
        block3 = (circle 0.5)  # translateX (1)
        combined = B.union Winding $ block2 <> block3

我已经尝试了几个小时了，但无法在写在该符号内的 Previous Estimate 和 Signal Decomposition (SSA) 之间制作一个直线箭头。目标是从符号外的中心开始绘制箭头。欢迎任何帮助。非常感谢。

编辑 1：添加了想要的结果。

这是完整的代码。

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}

module FlowChartTR where

import System.Process
--import Graphics.SVGFonts
import Diagrams.Backend.SVG.CmdLine
import Diagrams.Prelude
import Diagrams.TwoD.Arrow
import qualified Diagrams.TwoD.Path.Boolean as B

oneLineText txt = text txt
twoLineText txt1 txt2 = center $ (text txt1) === strutY 0.2 === (text txt2)
threeLineText txt1 txt2 txt3 = center $
  (text txt1) === strutY 0.2 === (text txt2) === strutY 0.2 === (text txt3)

terminal writeText w h r = (writeText <> roundedRect w h r) # lwL 0.02 # fontSize (local 0.2)
--terminalInput = (text "Input Data" <> roundedRect 1 0.3 0.3) # lwL 0.02 # fontSize (local 0.2)


--process txt w h = (text txt <> rect w h) # lwL 0.02 # fontSize (local 0.2)
process  writeText w h = (writeText <> rect w h) # lwL 0.02 # fontSize (local 0.2)

dataStorage :: Diagram B
dataStorage =  (strokePath $ B.difference Winding  combined  block1) # translateX (-0.3)
  where block1 = (circle 0.5)  # scaleX 0.5 # translateX (-1)
        block2 = rect 2 1
        block3 = (circle 0.5)  # translateX (1)
        combined = B.union Winding $ block2 <> block3

--decision :: Diagram B
--decision = (text "BPM" <> rect  0.4 0.3) # lwL 0.02 # fontSize (local 0.2)

input = (terminal (oneLineText "Input Data") 1.2 0.3 0.3) # named "terminalInput"
bandpass = (process (twoLineText "Bandpass" "Filtering") 1.5 0.5) # named "bandpass"
ssa = (process (threeLineText "Signal" "Decomposition" "(SSA)") 1.5 1) # translateY (-0.3) # named "ssa" # showOrigin
td = (process (twoLineText "Temporal" "Difference") 1 0.5) # named "td"
focuss = (process (threeLineText "Sparse Signal" "Reconstruction" "(FOCUSS)") 1.5 0.8) # named "focuss"
outputBPM = (terminal (oneLineText "Output BPM") 1.2 0.3 0.3) # named "terminalOutput"
spt = (process (threeLineText "Spectral Peak" "Tracking" "Select & Verif") 1.5 0.8) # named "spt"
prior = (oneLineText "Previous Estimate" <> dataStorage) # fontSize (local 0.2) # named "prior" #showOrigin # translateY 1

arrowStyle = (with & arrowHead .~ dart & headLength .~ large & tailLength .~ veryLarge)
ushaft = trailFromVertices (map p2 [(0, 0), (0.5, 0), (0.5, 1), (1, 1)])
arrowStyleU = (with & arrowHead .~ dart & headLength .~ large & tailLength .~ veryLarge & arrowShaft .~ ushaft)


decision :: Diagram B
decision = square 5 # rotate (45 @@ deg) # scaleY 0.5

placeBlocks :: Diagram B
placeBlocks = atPoints [ P (V2 0 0),    -- input
                         P (V2 4 0),    -- bandpass
                         P (V2 8 0),    -- ssa
                         P (V2 8 (-2)), -- td
                         P (V2 8 (-4)), -- focuss
                         P (V2 4 (-4)), -- spt
                         P (V2 0 (-4)), -- outputBPM
                         P (V2 4 (-2))  -- prior
                       ] [input, bandpass,ssa, td, focuss, spt, outputBPM, prior]

flowChart :: Diagram B
flowChart = placeBlocks # connectOutside' arrowStyle "terminalInput" "bandpass"
                        # connectOutside' arrowStyle "bandpass" "ssa"
                        # connectOutside' arrowStyle "ssa" "td"
                        # connectOutside' arrowStyle "td" "focuss"
                        # connectOutside' arrowStyle "focuss" "spt"
                        # connectOutside' arrowStyle "spt" "terminalOutput"
                        # connectOutside' arrowStyle "prior" "spt"
                        # connectOutside' arrowStyleU "prior" "ssa"
                        # pad 1.1

flowChartTR :: IO ()
flowChartTR = mainWith flowChart

Answer 1

我明白了。缩小符号后，调整连接变得更容易。

更改如下。

...
[input, bandpass,ssa, td, focuss, spt, outputBPM, (prior # scale 0.7)]
...
# connectPerim'   arrowStyleU "prior" "ssa" (0 @@ deg)  (205 @@ deg)
...

注意： - 添加 arrowTail .~ lineTail 很关键。

修复 arrowShaft（图表库）

Fix arrowShaft (Diagrams Library)

haskell

haskell-diagrams