From e1ed6caf38e05e476131611ce11136db0947ff6e Mon Sep 17 00:00:00 2001 From: Piotr Justyna Date: Thu, 14 Mar 2024 15:19:28 +0000 Subject: [PATCH] rendering diagrams from step trees --- HelloWorld.hs | 29 ++++++++++++++++------------- hello-world.svg | 2 +- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/HelloWorld.hs b/HelloWorld.hs index cf9c640..6e23e93 100644 --- a/HelloWorld.hs +++ b/HelloWorld.hs @@ -6,7 +6,10 @@ import Diagrams.Prelude import Diagrams.Backend.SVG.CmdLine import Diagrams.TwoD.Text -data Tree a = Leaf a | Node (Tree a) a (Tree a) +data Tree a = + Leaf a + | Node1 a (Tree a) + | Node2 (Tree a) a (Tree a) type StepName = Double @@ -54,17 +57,18 @@ decisionShape x = fromOffsets uniqueName :: Double -> Double -> Double uniqueName x y = x * 10 + (abs y) -steps :: [Step] -steps = - Main.Start (uniqueName 0.0 0.0) (p2 (0.0, 0.0)) - : Main.Decision (uniqueName 0.0 (-1.0)) (p2 (0.0, -1.0)) - : [Main.Command (uniqueName x y) (p2 (x, y)) | x <- [0.0], y <- [-2.0, -3.0, -4.0]] - ++ [Main.End (uniqueName 0.0 (-5.0)) (p2 (0.0, -5.0))] +newSteps :: Tree Step +newSteps = + Node1 + (Main.Start (uniqueName 0.0 0.0) (p2 (0.0, 0.0))) + (Node1 + (Main.Command (uniqueName 0.0 (-1.0)) (p2 (0.0, -1.0))) + (Leaf (Main.End (uniqueName 0.0 (-2.0)) (p2 (0.0, -2.0))))) -connections :: [Step] -> [QDiagram B V2 Double Any -> QDiagram B V2 Double Any] -connections (x1 : x2 : xn) = connectOutside' (with & arrowHead .~ noHead) (stepName x1) (stepName x2) : connections (x2 : xn) -connections (x1 : []) = [] -connections [] = [] +flattenSteps :: Tree Step -> [Step] +flattenSteps (Leaf x) = [x] +flattenSteps (Node1 x y) = [x] ++ flattenSteps y +flattenSteps (Node2 x y z) = flattenSteps x ++ [y] ++ flattenSteps z correctShape :: Step -> Diagram B correctShape (Main.Start x _) = startShape x @@ -73,6 +77,5 @@ correctShape (Main.Decision x _) = decisionShape x correctShape (Main.Command x _) = stepShape x main = mainWith $ - position [(stepOriginCoordinates x, correctShape x) | x <- steps] - # applyAll (connections steps) + position [(stepOriginCoordinates x, correctShape x) | x <- flattenSteps newSteps] # lw veryThin diff --git a/hello-world.svg b/hello-world.svg index 583f1f1..8e1c6d8 100644 --- a/hello-world.svg +++ b/hello-world.svg @@ -1,3 +1,3 @@ endstart \ No newline at end of file + "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">endstart \ No newline at end of file