From 248d2b156940e2619b0e5fa54b18680ef3d35c0f Mon Sep 17 00:00:00 2001 From: Piotr Justyna Date: Wed, 24 Apr 2024 09:31:35 +0000 Subject: [PATCH] consistent colours applied, code cleaned up, troubleshooting mode fleshed out --- README.md | 11 +- app/Main.hs | 207 +++++++++++++++++++++++++------- diagram-troubleshooting-off.svg | 3 + diagram-troubleshooting-on.svg | 3 + hello-world.svg | 3 - run.sh | 2 +- 6 files changed, 180 insertions(+), 49 deletions(-) create mode 100644 diagram-troubleshooting-off.svg create mode 100644 diagram-troubleshooting-on.svg delete mode 100644 hello-world.svg diff --git a/README.md b/README.md index 8548441..cdb4d9c 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,13 @@ Haskell drakon renderer. -![diagram](./hello-world.svg) +## troubleshooting mode off + +![diagram](./diagram-troubleshooting-off.svg) + +## troubleshooting mode on + +![diagram](./diagram-troubleshooting-on.svg) ## terminology @@ -34,7 +40,8 @@ Haskell drakon renderer. * [diagrams](https://archives.haskell.org/projects.haskell.org/diagrams/doc/quickstart.html#introduction) * [diagrams - user manual](https://archives.haskell.org/projects.haskell.org/diagrams/doc/manual.html) * [colours](https://www.colourlovers.com) - * [you will be free](https://www.colourlovers.com/palette/452030/you_will_be_free) +* [colorkit](https://colorkit.co/) + * [default palette](https://colorkit.co/palette/642915-963e20-c7522a-e5c185-fbf2c4-74a892-008585-006464-004343/) * useful haskell modules: * [GHC.Data.Graph.Directed](https://hackage.haskell.org/package/ghc-9.4.7/docs/GHC-Data-Graph-Directed.html) * [GHC.Utils.Outputable](https://hackage.haskell.org/package/ghc-9.4.7/docs/GHC-Utils-Outputable.html) \ No newline at end of file diff --git a/app/Main.hs b/app/Main.hs index bbfbf8c..945e17c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -213,13 +213,6 @@ iconsWithKeys ks = Data.Map.foldrWithKey (\k a acc -> if k `elem` ks then a:acc -- graph manipulation -> -conditionalSuffix :: String -> String -> Bool -> String -conditionalSuffix input suffix condition = if condition then input ++ suffix else input - -conditionalRenderingSuffix :: String -> Int -> Double -> Bool -> String -conditionalRenderingSuffix input renderingOrder maxWidth = - conditionalSuffix input (" | rendering order: " ++ show renderingOrder ++ " | max width: " ++ show maxWidth) - payload :: GHC.Data.Graph.Directed.Node Int Icon -> Icon payload GHC.Data.Graph.Directed.DigraphNode { GHC.Data.Graph.Directed.node_payload = x, GHC.Data.Graph.Directed.node_key = _, GHC.Data.Graph.Directed.node_dependencies = _ } = x @@ -239,12 +232,11 @@ visualGraph = do let startingDepth = 0.0 let firstChildIconDepth = startingDepth + (-1.0) * cellHeight let Icon { iconText = titleIconText, iconType = _ } = payload titleIcon - let conditionalText = conditionalRenderingSuffix titleIconText renderingOrder startingWidth troubleshootingMode let titleIconDependenciesKeys = dependencies titleIcon let titleIconDependencies = iconsWithKeys titleIconDependenciesKeys let (_, _, childSubgraphVisualData) = visualSubgraph titleIconDependencies (renderingOrder + 1) startingWidth firstChildIconDepth startingWidth startingDepth - (Diagrams.Prelude.p2 (0.0, 0.0), titleShape conditionalText) : childSubgraphVisualData + (Diagrams.Prelude.p2 (0.0, 0.0), titleShape titleIconText renderingOrder startingWidth) : childSubgraphVisualData visualSubgraph :: [GHC.Data.Graph.Directed.Node Int Icon] -> @@ -297,7 +289,7 @@ visualSubgraphNode :: Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B) visualSubgraphNode width depth previousIconOriginCoordinateX previousIconOriginCoordinateY icon renderingOrder maxWidth = do let Icon { iconText = x, iconType = y } = icon - (Diagrams.Prelude.p2 (width, depth), correctShape y previousIconOriginCoordinateX previousIconOriginCoordinateY $ conditionalRenderingSuffix x renderingOrder maxWidth troubleshootingMode) + (Diagrams.Prelude.p2 (width, depth), correctShape y previousIconOriginCoordinateX previousIconOriginCoordinateY x renderingOrder maxWidth) -- <- graph manipulation @@ -323,6 +315,38 @@ iconHeight :: Double iconHeight = 0.4 * cellHeight +fontSize :: + Double +fontSize = 0.1 + +backgroundColour :: + Diagrams.Prelude.Colour Double +backgroundColour = Data.Colour.SRGB.sRGB (230.0/255.0) (232.0/255.0) (216.0/255.0) + +fontColour :: + Diagrams.Prelude.Colour Double +fontColour = Data.Colour.SRGB.sRGB (34.0/255.0) (69.0/255.0) (57.0/255.0) + +lineColour :: + Diagrams.Prelude.Colour Double +lineColour = Data.Colour.SRGB.sRGB (34.0/255.0) (69.0/255.0) (57.0/255.0) + +titleIconColour :: + Diagrams.Prelude.Colour Double +titleIconColour = Data.Colour.SRGB.sRGB (69.0/255.0) (173.0/255.0) (127.0/255.0) + +actionIconColour :: + Diagrams.Prelude.Colour Double +actionIconColour = titleIconColour + +questionIconColour :: + Diagrams.Prelude.Colour Double +questionIconColour = titleIconColour + +endIconColour :: + Diagrams.Prelude.Colour Double +endIconColour = titleIconColour + -- <- visual constants titleIconKey :: @@ -355,11 +379,17 @@ correctShape :: Double -> Double -> String -> + Int -> + Double -> Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B -correctShape Title _ _ x = titleShape x -correctShape End parentIconVectorX parentIconVectorY x = endShape parentIconVectorX parentIconVectorY x -correctShape Question parentIconVectorX parentIconVectorY x = questionShape parentIconVectorX parentIconVectorY x -correctShape Action parentIconVectorX parentIconVectorY x = actionShape parentIconVectorX parentIconVectorY x +correctShape Title _ _ titleIconText renderingOrder maxWidth = + titleShape titleIconText renderingOrder maxWidth +correctShape End parentIconVectorX parentIconVectorY endIconText renderingOrder maxWidth = + endShape parentIconVectorX parentIconVectorY endIconText renderingOrder maxWidth +correctShape Question parentIconVectorX parentIconVectorY questionIconText renderingOrder maxWidth = + questionShape parentIconVectorX parentIconVectorY questionIconText renderingOrder maxWidth +correctShape Action parentIconVectorX parentIconVectorY actionIconText renderingOrder maxWidth = + actionShape parentIconVectorX parentIconVectorY actionIconText renderingOrder maxWidth text :: String -> @@ -372,70 +402,113 @@ text translateY = Diagrams.Prelude.text content Diagrams.Prelude.# - Diagrams.Prelude.fontSize (Diagrams.Prelude.local 0.05) + Diagrams.Prelude.fontSize (Diagrams.Prelude.local fontSize) Diagrams.Prelude.# Diagrams.Prelude.light Diagrams.Prelude.# - Diagrams.Prelude.font "courier" + Diagrams.Prelude.font "helvetica" + Diagrams.Prelude.# + Diagrams.Prelude.fc fontColour Diagrams.Prelude.# Diagrams.Prelude.translate (Diagrams.Prelude.r2 (translateX, translateY)) titleShape :: String -> + Int -> + Double -> Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B -titleShape x = do +titleShape + titleIconText + renderingOrder + maxWidth = do let baseShape = Diagrams.Prelude.roundedRect iconWidth iconHeight 0.5 Diagrams.Prelude.# - Diagrams.Prelude.fc (Data.Colour.SRGB.sRGB (236.0/255.0) (249.0/255.0) (254.0/255.0)) + Diagrams.Prelude.fc titleIconColour Diagrams.Prelude.# - Diagrams.Prelude.lw Diagrams.Prelude.none - --- (text x 0.0 0.0 --- Diagrams.Prelude.=== --- (text x 0.0 0.0 <> Diagrams.Prelude.strutY (0.05 * 2.0))) --- <> shape + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin let shape = if troubleshootingMode then Diagrams.Prelude.showOrigin baseShape else baseShape - (text x 0.0 0.0) + if troubleshootingMode then + (text titleIconText 0.0 0.0 + Diagrams.Prelude.=== + (text ("rendering order: " ++ show renderingOrder) 0.0 0.0 <> Diagrams.Prelude.strutY (fontSize * 2.0)) + Diagrams.Prelude.=== + text ("max width: " ++ show maxWidth) 0.0 0.0) + Diagrams.Prelude.# + Diagrams.Prelude.translate (Diagrams.Prelude.r2 (0, fontSize)) + <> shape + else + text titleIconText 0.0 0.0 <> shape actionShape :: Double -> Double -> String -> + Int -> + Double -> Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B actionShape parentIconVectorX parentIconVectorY - x = do + actionIconText + renderingOrder + maxWidth = do let baseShape = Diagrams.Prelude.rect iconWidth iconHeight Diagrams.Prelude.# - Diagrams.Prelude.fc (Data.Colour.SRGB.sRGB (220.0/255.0) (232.0/255.0) (235.0/255.0)) + Diagrams.Prelude.fc actionIconColour + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour Diagrams.Prelude.# - Diagrams.Prelude.lw Diagrams.Prelude.none + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin let shape = if troubleshootingMode - then Diagrams.Prelude.showOrigin $ baseShape + then Diagrams.Prelude.showOrigin baseShape else baseShape - (text x 0.0 0.0) + if troubleshootingMode then + (text actionIconText 0.0 0.0 + Diagrams.Prelude.=== + (text ("rendering order: " ++ show renderingOrder) 0.0 0.0 <> Diagrams.Prelude.strutY (fontSize * 2.0)) + Diagrams.Prelude.=== + text ("max width: " ++ show maxWidth) 0.0 0.0) + Diagrams.Prelude.# + Diagrams.Prelude.translate (Diagrams.Prelude.r2 (0, fontSize)) + <> shape + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin + else + text actionIconText 0.0 0.0 <> shape - <> (connectionToParentIcon parentIconVectorX parentIconVectorY Diagrams.Prelude.# Diagrams.Prelude.lw Diagrams.Prelude.ultraThin) + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin questionShape :: Double -> Double -> String -> + Int -> + Double -> Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B questionShape parentIconVectorX parentIconVectorY - x = do + questionIconText + renderingOrder + maxWidth = do let baseShape = Diagrams.Prelude.fromOffsets [Diagrams.Prelude.V2 (-0.1) (iconHeight * 0.5), @@ -449,9 +522,11 @@ questionShape Diagrams.Prelude.# Diagrams.Prelude.strokeLoop Diagrams.Prelude.# - Diagrams.Prelude.fc (Data.Colour.SRGB.sRGB (203.0/255.0) (219.0/255.0) (224.0/255.0)) + Diagrams.Prelude.fc questionIconColour + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour Diagrams.Prelude.# - Diagrams.Prelude.lw Diagrams.Prelude.none + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin Diagrams.Prelude.# Diagrams.Prelude.translate (Diagrams.Prelude.r2 ((iconWidth - 0.1 - 0.1) * (-0.5), -0.2)) @@ -459,35 +534,81 @@ questionShape then Diagrams.Prelude.showOrigin baseShape else baseShape - (text x 0.0 0.0) + if troubleshootingMode then + (text questionIconText 0.0 0.0 + Diagrams.Prelude.=== + (text ("rendering order: " ++ show renderingOrder) 0.0 0.0 <> Diagrams.Prelude.strutY (fontSize * 2.0)) + Diagrams.Prelude.=== + text ("max width: " ++ show maxWidth) 0.0 0.0) + Diagrams.Prelude.# + Diagrams.Prelude.translate (Diagrams.Prelude.r2 (0, fontSize)) + <> text "yes" (iconWidth * (-0.1)) (iconHeight * (-0.7)) + <> text "no" (iconWidth * 0.55) (iconHeight * 0.15) + <> shape + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin + else + text questionIconText 0.0 0.0 <> text "yes" (iconWidth * (-0.1)) (iconHeight * (-0.7)) <> text "no" (iconWidth * 0.55) (iconHeight * 0.15) <> shape - <> (connectionToParentIcon parentIconVectorX parentIconVectorY Diagrams.Prelude.# Diagrams.Prelude.lw Diagrams.Prelude.ultraThin) + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin endShape :: Double -> Double -> String -> + Int -> + Double -> Diagrams.Prelude.Diagram Diagrams.Backend.SVG.CmdLine.B endShape parentIconVectorX parentIconVectorY - x = do + endIconText + renderingOrder + maxWidth = do let baseShape = Diagrams.Prelude.roundedRect iconWidth iconHeight 0.5 Diagrams.Prelude.# - Diagrams.Prelude.fc (Data.Colour.SRGB.sRGB (190.0/255.0) (210.0/255.0) (217.0/255.0)) + Diagrams.Prelude.fc endIconColour Diagrams.Prelude.# - Diagrams.Prelude.lw Diagrams.Prelude.none + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin let shape = if troubleshootingMode - then Diagrams.Prelude.showOrigin $ baseShape + then Diagrams.Prelude.showOrigin baseShape else baseShape - (text x 0.0 0.0) + if troubleshootingMode then + (text endIconText 0.0 0.0 + Diagrams.Prelude.=== + (text ("rendering order: " ++ show renderingOrder) 0.0 0.0 <> Diagrams.Prelude.strutY (fontSize * 2.0)) + Diagrams.Prelude.=== + text ("max width: " ++ show maxWidth) 0.0 0.0) + Diagrams.Prelude.# + Diagrams.Prelude.translate (Diagrams.Prelude.r2 (0, fontSize)) + <> shape + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin + else + text endIconText 0.0 0.0 <> shape - <> (connectionToParentIcon parentIconVectorX parentIconVectorY Diagrams.Prelude.# Diagrams.Prelude.lw Diagrams.Prelude.ultraThin) + <> connectionToParentIcon parentIconVectorX parentIconVectorY + Diagrams.Prelude.# + Diagrams.Prelude.lc lineColour + Diagrams.Prelude.# + Diagrams.Prelude.lw Diagrams.Prelude.ultraThin main :: IO () @@ -496,6 +617,6 @@ main = do Diagrams.Backend.SVG.CmdLine.mainWith $ Diagrams.Prelude.position visualGraph Diagrams.Prelude.# - Diagrams.Prelude.bg (Data.Colour.SRGB.sRGB (247.0/255.0) (249.0/255.0) (254.0/255.0)) + Diagrams.Prelude.bg backgroundColour Diagrams.Prelude.# Diagrams.Prelude.lw Diagrams.Prelude.none \ No newline at end of file diff --git a/diagram-troubleshooting-off.svg b/diagram-troubleshooting-off.svg new file mode 100644 index 0000000..0be9b03 --- /dev/null +++ b/diagram-troubleshooting-off.svg @@ -0,0 +1,3 @@ + +end 4end 3action 4noyesquestion 3end 2action 3end 1action 2noyesquestion 2action 1noyesquestion 1start \ No newline at end of file diff --git a/diagram-troubleshooting-on.svg b/diagram-troubleshooting-on.svg new file mode 100644 index 0000000..9dd0c58 --- /dev/null +++ b/diagram-troubleshooting-on.svg @@ -0,0 +1,3 @@ + +max width: 6.0rendering order: 12end 4max width: 4.0rendering order: 11end 3max width: 4.0rendering order: 10action 4noyesmax width: 4.0rendering order: 9question 3max width: 2.0rendering order: 8end 2max width: 2.0rendering order: 7action 3max width: 0.0rendering order: 6end 1max width: 0.0rendering order: 5action 2noyesmax width: 0.0rendering order: 4question 2max width: 0.0rendering order: 3action 1noyesmax width: 0.0rendering order: 2question 1max width: 0.0rendering order: 1start \ No newline at end of file diff --git a/hello-world.svg b/hello-world.svg deleted file mode 100644 index d9c4a25..0000000 --- a/hello-world.svg +++ /dev/null @@ -1,3 +0,0 @@ - -end 4 | rendering order: 12 | max width: 6.0end 3 | rendering order: 11 | max width: 4.0action 4 | rendering order: 10 | max width: 4.0noyesquestion 3 | rendering order: 9 | max width: 4.0end 2 | rendering order: 8 | max width: 2.0action 3 | rendering order: 7 | max width: 2.0end 1 | rendering order: 6 | max width: 0.0action 2 | rendering order: 5 | max width: 0.0noyesquestion 2 | rendering order: 4 | max width: 0.0action 1 | rendering order: 3 | max width: 0.0noyesquestion 1 | rendering order: 2 | max width: 0.0start | rendering order: 1 | max width: 0.0 \ No newline at end of file diff --git a/run.sh b/run.sh index 167f02c..ffa5382 100755 --- a/run.sh +++ b/run.sh @@ -1,2 +1,2 @@ #!/bin/zsh -cabal run drakon-renderer -- -o hello-world.svg -w 1500 \ No newline at end of file +cabal run drakon-renderer -- -o diagram-troubleshooting-on.svg -w 1000 \ No newline at end of file