X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.graphviz%2Fscl%2FVisualization%2FGGraph.scl;fp=bundles%2Forg.simantics.graphviz%2Fscl%2FVisualization%2FGGraph.scl;h=58bdc41f240639b5117e8c8c2c18d63c5db96cb8;hb=0ae2b770234dfc3cbb18bd38f324125cf0faca07;hp=9c141aaf55a4669b7414d939f98802ec38fdcd68;hpb=24e2b34260f219f0d1644ca7a138894980e25b14;p=simantics%2Fplatform.git diff --git a/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl b/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl index 9c141aaf5..58bdc41f2 100644 --- a/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl +++ b/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl @@ -1,32 +1,32 @@ -import "Visualization/Graphviz" -import "MMap" as MMap -include "Visualization/Graphviz/Property" - -data GGraph a e = GGraph Graph (MMap.T a Node) (a -> [Property]) - -newGGraph :: [Property] -> (a -> [Property]) -> GGraph a e -newGGraph properties f = GGraph (newGraph properties) (MMap.create ()) f - -@private -toNode :: GGraph a e -> a -> Node -toNode (GGraph graph nodeMap f) r = - match MMap.get nodeMap r with - Just n -> n - Nothing -> do - n = newNode graph (f r) - MMap.put nodeMap r n - n - -newGEdge :: GGraph a e -> a -> a -> [Property] -> Edge -newGEdge graph r1 r2 properties = edge - where - edge = newEdge (toNode graph r1) (toNode graph r2) properties - -newGNode :: GGraph a e -> a -> Node -newGNode = toNode - -showGGraph :: GGraph a e -> () -showGGraph (GGraph graph _ _) = showGraph graph - -showGGraphWithAlgorithm :: String -> GGraph a e -> () -showGGraphWithAlgorithm algorithm (GGraph graph _ _) = showGraphWithAlgorithm graph algorithm +import "Visualization/Graphviz" +import "MMap" as MMap +include "Visualization/Graphviz/Property" + +data GGraph a e = GGraph Graph (MMap.T a Node) (a -> [Property]) + +newGGraph :: [Property] -> (a -> [Property]) -> GGraph a e +newGGraph properties f = GGraph (newGraph properties) (MMap.create ()) f + +@private +toNode :: GGraph a e -> a -> Node +toNode (GGraph graph nodeMap f) r = + match MMap.get nodeMap r with + Just n -> n + Nothing -> do + n = newNode graph (f r) + MMap.put nodeMap r n + n + +newGEdge :: GGraph a e -> a -> a -> [Property] -> Edge +newGEdge graph r1 r2 properties = edge + where + edge = newEdge (toNode graph r1) (toNode graph r2) properties + +newGNode :: GGraph a e -> a -> Node +newGNode = toNode + +showGGraph :: GGraph a e -> () +showGGraph (GGraph graph _ _) = showGraph graph + +showGGraphWithAlgorithm :: String -> GGraph a e -> () +showGGraphWithAlgorithm algorithm (GGraph graph _ _) = showGraphWithAlgorithm graph algorithm