]> gerrit.simantics Code Review - simantics/platform.git/blobdiff - bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl
Migrated source code from Simantics SVN
[simantics/platform.git] / bundles / org.simantics.graphviz / scl / Visualization / GGraph.scl
diff --git a/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl b/bundles/org.simantics.graphviz/scl/Visualization/GGraph.scl
new file mode 100644 (file)
index 0000000..9c141aa
--- /dev/null
@@ -0,0 +1,32 @@
+import "Visualization/Graphviz"\r
+import "MMap" as MMap\r
+include "Visualization/Graphviz/Property"\r
+\r
+data GGraph a e = GGraph Graph (MMap.T a Node) (a -> <e> [Property])\r
+\r
+newGGraph :: [Property] -> (a -> <e> [Property]) -> <Proc> GGraph a e\r
+newGGraph properties f = GGraph (newGraph properties) (MMap.create ()) f \r
+\r
+@private\r
+toNode :: GGraph a e -> a -> <e,Proc> Node\r
+toNode (GGraph graph nodeMap f) r =\r
+    match MMap.get nodeMap r with\r
+        Just n -> n\r
+        Nothing -> do\r
+            n = newNode graph (f r)\r
+            MMap.put nodeMap r n\r
+            n\r
+\r
+newGEdge :: GGraph a e -> a -> a -> [Property] -> <e,Proc> Edge\r
+newGEdge graph r1 r2 properties = edge\r
+  where\r
+    edge = newEdge (toNode graph r1) (toNode graph r2) properties\r
+\r
+newGNode :: GGraph a e -> a -> <e,Proc> Node\r
+newGNode = toNode\r
+\r
+showGGraph :: GGraph a e -> <Proc> ()\r
+showGGraph (GGraph graph _ _) = showGraph graph\r
+\r
+showGGraphWithAlgorithm :: String -> GGraph a e -> <Proc> ()\r
+showGGraphWithAlgorithm algorithm (GGraph graph _ _) = showGraphWithAlgorithm graph algorithm\r