Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Fix arrowShaft (Diagrams Library)

I've made a data storage symbol using B.difference and B.union. The one with the red dot in the middle.

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

enter image description here

I've been trying for hours now but can't make an arrow straight between Previous Estimate written inside that symbol and Signal Decomposition (SSA). The goal is to draw the arrow starting at the center right outside of the symbol. Any help is welcome. Thank you very much.

EDIT 1: Added wanted result.

enter image description here

Here's the complete code.

{-# 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
like image 465

1 Answers

I got it. After I scaled down the symbol It becomes easier to adjust the connection.

enter image description here

Here's the changes.

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

NOTE: - Adding arrowTail .~ lineTail is critical.