Initial commit

SICP/dot.janet

@@ -0,0 +1,129 @@
+(defn node-to-string [node]
+  (def attributes @[])
+  (if (get node :label)
+    (array/push attributes
+      (string/format "label=\"%s\"" (get node :label))))
+  (if (get node :shape)
+    (array/push attributes
+      (string/format "shape=%s" (get node :shape))))
+  (if (get node :color)
+    (array/push attributes
+      (string/format "fillcolor=\"%s\" style=filled" (get node :color))))
+  (string/format "%s [%s];\n"
+    (get node :name)
+    (string/join attributes ",")))
+
+(defn relation-to-string [graph_type relations]
+  (def oper
+    (cond
+      (= graph_type :graph) "--"
+      (= graph_type :digraph) "->"))
+  (string/format "%s;\n"
+    (string/join relations oper)))
+
+(defn create-graph [graph_type name &named rankdir]
+  (def a @{
+    :name name
+    :type graph_type
+    :nodes @[]
+    :relations @[]
+    :subgraphs @[] })
+
+  (when rankdir
+    (set (a :rankdir) rankdir))
+
+  a)
+
+(defn create-subgraph [name &named rankdir]
+  (def s @{
+    :name name
+    :nodes @[]
+    :relations @[]})
+
+  (when rankdir
+    (set (s :rankdir) rankdir))
+
+  s)
+
+(defn add-node [graph name &named label shape color]
+  (def new_node @{:name name})
+  (when label
+    (set (new_node :label) label))
+  (when shape
+    (set (new_node :shape) shape))
+  (when color
+    (set (new_node :color) color))
+
+  (def nodes (get graph :nodes))
+  (array/push nodes new_node))
+
+(defn add-relation [graph & rels]
+  (def relations (get graph :relations))
+  (array/push relations rels))
+
+(defn add-subgraph [graph subgraph]
+  (def subgraphs (get graph :subgraphs))
+  (array/push subgraphs subgraph))
+
+(defn write-graph [graph filename]
+  (def f (file/open filename :w))
+
+  (def name (get graph :name))
+  (def graph_type
+    (cond
+      (= (get graph :type) :graph) "graph"
+      (= (get graph :type) :digraph) "digraph"))
+
+  (file/write f (string/format "%s %s {" graph_type name))
+
+  (if
+    (or
+      (> (length (get graph :nodes)) 0)
+      (> (length (get graph :relations)) 0))
+    (do
+      (file/write f "\n")
+      (when (get graph :rankdir)
+        (file/write f (string/format "rankdir=%s;\n" (get graph :rankdir))))))
+
+  (var i 0)
+  (def nodes (get graph :nodes))
+  (print (length nodes))
+  (while (< i (length nodes))
+    (file/write f (string/format "\t%s" (node-to-string (get nodes i))))
+    (set i (+ i 1)))
+
+  (set i 0)
+  (def relations (get graph :relations))
+  (while (< i (length relations))
+    (file/write f (string/format "\t%s" (relation-to-string
+                    (get graph :type)
+                    (get relations i))))
+    (set i (+ i 1)))
+
+  (set i 0)
+  (def subgraphs (get graph :subgraphs))
+  (while (< i (length subgraphs))
+    (def subgraph (get subgraphs i))
+    (file/write f (string/format "\tsubgraph %s {\n" (get subgraph :name)))
+    (when (get subgraph :rankdir)
+      (file/write f (string/format "\t\trankdir=%s;\n" (get subgraph :rankdir))))
+    (var j 0)
+    (def nodes (get subgraph :nodes))
+    (print (length nodes))
+    (while (< j (length nodes))
+      (file/write f (string/format "\t\t%s" (node-to-string (get nodes j))))
+      (set j (+ j 1)))
+
+    (set j 0)
+    (def relations (get subgraph :relations))
+    (while (< j (length relations))
+      (file/write f (string/format "\t\t%s" (relation-to-string
+                      (get graph :type)
+                      (get relations j))))
+      (set j (+ j 1)))
+    (file/write f "\t}\n")
+    (set i (+ i 1)))
+
+  (file/write f "}")
+  (file/flush f)
+  (file/close f))