From adc3d691047a60b712e8813aff1a9d5b94fd3d45 Mon Sep 17 00:00:00 2001 From: Piotr Justyna Date: Thu, 14 Mar 2024 16:41:24 +0000 Subject: [PATCH] first attempt at automatic layouting, debug step names --- HelloWorld.hs | 63 +++++++++++++++++++++++++++---------------------- hello-world.svg | 2 +- 2 files changed, 36 insertions(+), 29 deletions(-) diff --git a/HelloWorld.hs b/HelloWorld.hs index 6e23e93..09f8044 100644 --- a/HelloWorld.hs +++ b/HelloWorld.hs @@ -11,17 +11,17 @@ data Tree a = | Node1 a (Tree a) | Node2 (Tree a) a (Tree a) -type StepName = Double +type Name = String type OriginCoordinates = Point V2 Double data Step = - Start StepName OriginCoordinates - | End StepName OriginCoordinates - | Command StepName OriginCoordinates - | Decision StepName OriginCoordinates + Start Main.Name OriginCoordinates + | End Main.Name OriginCoordinates + | Command Main.Name OriginCoordinates + | Decision Main.Name OriginCoordinates -stepName :: Step -> Double +stepName :: Step -> Main.Name stepName (Main.Start x _) = x stepName (Main.End x _) = x stepName (Main.Command x _) = x @@ -33,38 +33,45 @@ stepOriginCoordinates (Main.End _ x) = x stepOriginCoordinates (Main.Command _ x) = x stepOriginCoordinates (Main.Decision _ x) = x -stepShape :: Double -> Diagram B -stepShape x = rect 0.95 0.4 # showOrigin # named x +stepShape :: Main.Name -> Diagram B +stepShape x = text (show x) # fontSize (local 0.1) # light # font "courier" <> rect 0.95 0.4 # showOrigin # named x -startShape :: Double -> Diagram B -startShape x = text "start" # fontSize (local 0.1) # light # font "courier" <> roundedRect 1.0 0.4 0.5 # showOrigin # named x +startShape :: Main.Name -> Diagram B +startShape x = text ((show x) ++ ": start") # fontSize (local 0.1) # light # font "courier" <> roundedRect 1.0 0.4 0.5 # showOrigin # named x -endShape :: Double -> Diagram B -endShape x = text "end" # fontSize (local 0.1) # thinWeight # font "courier" <> roundedRect 1.0 0.4 0.5 # showOrigin # named x +endShape :: Main.Name -> Diagram B +endShape x = text ((show x) ++ ": end") # fontSize (local 0.1) # thinWeight # font "courier" <> roundedRect 1.0 0.4 0.5 # showOrigin # named x -decisionShape :: Double -> Diagram B -decisionShape x = fromOffsets - [V2 (-0.1) 0.2, - V2 0.1 0.2, - V2 0.8 0.0, - V2 0.1 (-0.2), - V2 (-0.1) (-0.2), - V2 (-0.8) (0.0)] - # translate (r2 ((-0.4), (-0.2))) - # showOrigin - # named x +decisionShape :: Main.Name -> Diagram B +decisionShape x = text (show x) # fontSize (local 0.1) # light # font "courier" <> + fromOffsets + [V2 (-0.1) 0.2, + V2 0.1 0.2, + V2 0.8 0.0, + V2 0.1 (-0.2), + V2 (-0.1) (-0.2), + V2 (-0.8) (0.0)] + # translate (r2 ((-0.4), (-0.2))) + # showOrigin + # named x -uniqueName :: Double -> Double -> Double -uniqueName x y = x * 10 + (abs y) +uniqueName :: Double -> Double -> Main.Name +uniqueName x y = "x" ++ (show x) ++ "y" ++ (show y) 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))) + (Node2 + (Leaf (Main.Command (uniqueName 1.0 (-2.0)) (p2 (1.0, -2.0)))) + (Main.Decision (uniqueName 0.0 (-1.0)) (p2 (0.0, -1.0))) (Leaf (Main.End (uniqueName 0.0 (-2.0)) (p2 (0.0, -2.0))))) +newFlattenSteps :: Tree Step -> Double -> Double -> [(OriginCoordinates, Diagram B)] +newFlattenSteps (Leaf x) currentWidth currentDepth = [(p2 (currentWidth, currentDepth), (correctShape x))] +newFlattenSteps (Node1 x y) currentWidth currentDepth = [(p2 (currentWidth, currentDepth), (correctShape x))] ++ newFlattenSteps y currentWidth (currentDepth - 1.0) +newFlattenSteps (Node2 x y z) currentWidth currentDepth = newFlattenSteps x currentWidth (currentDepth - 1.0) ++ [(p2 (currentWidth, currentDepth), (correctShape y))] ++ newFlattenSteps z (currentWidth + 1) (currentDepth - 1.0) + flattenSteps :: Tree Step -> [Step] flattenSteps (Leaf x) = [x] flattenSteps (Node1 x y) = [x] ++ flattenSteps y @@ -77,5 +84,5 @@ correctShape (Main.Decision x _) = decisionShape x correctShape (Main.Command x _) = stepShape x main = mainWith $ - position [(stepOriginCoordinates x, correctShape x) | x <- flattenSteps newSteps] + position (newFlattenSteps newSteps 0.0 0.0) # lw veryThin diff --git a/hello-world.svg b/hello-world.svg index 8e1c6d8..99515dc 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">"x0.0y-2.0": end"x0.0y-1.0""x1.0y-2.0""x0.0y0.0": start \ No newline at end of file