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=9c141aaf55a4669b7414d939f98802ec38fdcd68;hb=969bd23cab98a79ca9101af33334000879fb60c5;hp=0000000000000000000000000000000000000000;hpb=866dba5cd5a3929bbeae85991796acb212338a08;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl b/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl
new file mode 100644
index 000000000..9c141aaf5
--- /dev/null
+++ b/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl
@@ -0,0 +1,32 @@
+import "Visualization/Graphviz"
+import "MMap" as MMap
+include "Visualization/Graphviz/Property"
+
+data GGraph a e = GGraph Graph (MMap.T a Node) (a -> <e> [Property])
+
+newGGraph :: [Property] -> (a -> <e> [Property]) -> <Proc> GGraph a e
+newGGraph properties f = GGraph (newGraph properties) (MMap.create ()) f 
+
+@private
+toNode :: GGraph a e -> a -> <e,Proc> 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] -> <e,Proc> Edge
+newGEdge graph r1 r2 properties = edge
+  where
+    edge = newEdge (toNode graph r1) (toNode graph r2) properties
+
+newGNode :: GGraph a e -> a -> <e,Proc> Node
+newGNode = toNode
+
+showGGraph :: GGraph a e -> <Proc> ()
+showGGraph (GGraph graph _ _) = showGraph graph
+
+showGGraphWithAlgorithm :: String -> GGraph a e -> <Proc> ()
+showGGraphWithAlgorithm algorithm (GGraph graph _ _) = showGraphWithAlgorithm graph algorithm