Graphviz intregration

Makefile

@@ -2,16 +2,34 @@ MODULES=$(shell sed -n -E 's/^- (.*\.pl)$$/\1/p' toc.org)
 # load_test_files/1 should make this useless, but I cannot find how to use it
 TEST_MODULES=$(wildcard $(MODULES:.pl=.plt))
 
+$(foreach var, CC PLBASE PLCFLAGS PLLDFLAGS PLLIB, \
+  $(eval \
+    $(shell \
+      swipl -dump-runtime-variables | \
+      grep ^$(var)= | \
+      sed -E 's/="/=/;s/";$$//')))
+
+CFLAGS=-I modules/graphviz -I $(PLBASE)/include $(PLCFLAGS)
+
+LDFLAGS=$(PLLDFLAGS) -L $(wildcard $(PLBASE)/lib/*)
+
+LDLIBS=$(PLLIB) `pkg-config --libs libgvc`
+
 all: biocham biocham_debug test doc
 
 .PHONY: test doc clean
 
-biocham: $(MODULES) toc.org Makefile
-	@echo $(MODULES)
-	swipl -o biocham --goal=start --toplevel=toplevel -c $(MODULES)
+biocham: swipl-biocham $(MODULES) toc.org Makefile
+	./swipl-biocham -o biocham \
+	  --goal=start --toplevel=toplevel -c $(MODULES)
+
+biocham_debug: swipl-biocham $(MODULES) $(TEST_MODULES) toc.org Makefile
+	./swipl-biocham -o biocham_debug \
+	  --goal=initialize -c $(MODULES) $(TEST_MODULES)
+
+swipl-biocham: swipl-biocham.o modules/graphviz/graphviz_swiprolog.o
 
-biocham_debug: $(MODULES) $(TEST_MODULES) toc.org Makefile
-	swipl -o biocham_debug --goal=initialize -c $(MODULES) $(TEST_MODULES)
+swipl-biocham.o: swipl-biocham.c
 
 test: biocham_tests
 	./biocham_tests
@@ -21,7 +39,12 @@ doc: biocham
 
 biocham_tests: $(MODULES) $(TEST_MODULES) Makefile
 	swipl -o biocham_tests \
-		--goal="call_cleanup((run_tests, halt(0)), halt(1))" -c $(MODULES) $(TEST_MODULES)
+		--goal="call_cleanup((run_tests, halt(0)), halt(1))" \
+		-c $(MODULES) $(TEST_MODULES)
 
 clean:
-	-rm -f biocham biocham_debug biocham_tests
+	- rm biocham
+	- rm biocham_debug
+	- rm biocham_tests
+	- rm swipl-biocham
+	- rm swipl-biocham.o

graph_editor.pl

@@ -6,8 +6,6 @@
     set_graph_name/1,
     list_graphs/0,
     select_graph/1,
-    draw_graph/0,
-    export_graph/1,
     add_vertex/1,
     delete_vertex/1,
     edge/1,
@@ -25,6 +23,7 @@
     transition/1,
     get_current_graph/1,
     set_current_graph/1,
+    get_graph_name/2,
     get_attribute/2
   ]
 ).
@@ -69,22 +68,6 @@ select_graph(Name) :-
   set_current_graph(Id).
 
 
-draw_graph :-
-  biocham_command,
-  doc('').
-
-
-export_graph(OutputFile) :-
-  biocham_command,
-  type(OutputFile, output_file),
-  doc('Exports the current graph as a \\texttt{.dot} file.'),
-  setup_call_cleanup(
-    open(OutputFile, write, OutputStream),
-    export_graph_stream(OutputStream),
-    close(OutputStream)
-  ).
-
-
 add_vertex(NameList) :-
   biocham_command(*),
   type(NameList, '*'(name)),
@@ -284,6 +267,10 @@ set_current_graph(Id) :-
   add_dependency(CurrentGraphId, Id).
 
 
+get_graph_name(Id, Name) :-
+  find_item([id: Id, item: Name]).
+
+
 get_attribute(Id, Attribute) :-
   integer(Id),
   !,

graphviz.pl

+:- module(
+  graphviz,
+  [
+    draw_graph/0,
+    draw_graph_png/1,
+    export_graph/1
+  ]
+).
+
+
+:- devdoc('\\section{Commands}').
+
+
+draw_graph :-
+  biocham_command,
+  doc('').
+
+
+draw_graph_png(OutputFile) :-
+  biocham_command,
+  type(OutputFile, output_file),
+  doc('Draws the current graph in a \\texttt{.png} file.'),
+  get_current_graph(GraphId),
+  create_cgraph(GraphId, Graph),
+  gvLayout(Graph, dot),
+  gvRenderFilename(Graph, png, OutputFile),
+  gvFreeLayout(Graph),
+  agclose(Graph).
+
+
+export_graph(OutputFile) :-
+  biocham_command,
+  type(OutputFile, output_file),
+  doc('Exports the current graph as a \\texttt{.dot} file.'),
+  get_current_graph(GraphId),
+  create_cgraph(GraphId, Graph),
+  agwrite(Graph, OutputFile),
+  agclose(Graph).
+
+
+:- devdoc('\\section{Internal predicates}').
+
+
+create_cgraph(GraphId, Graph) :-
+  get_graph_name(GraphId, GraphName),
+  agopen(GraphName, directed, Graph),
+  agattr(Graph, graph, size, '7.5,11', _),
+  agattr(Graph, graph, ratio, fill, _),
+  agattr(Graph, node, shape, circle, _),
+  \+ (
+    item([parent: GraphId, kind: vertex, item: VertexName, id: VertexId]),
+    \+ (
+      agnode(Graph, VertexName, true, Node),
+      (
+        get_attribute(VertexId, kind: transition)
+      ->
+        agset(Node, shape, box)
+      ;
+        true
+      )
+    )
+  ),
+  \+ (
+    item([parent: GraphId, kind: edge, item: Edge]),
+    \+ (
+      format(atom(EdgeName), '~w', [Edge]),
+      Edge = (VertexA -> VertexB),
+      agnode(Graph, VertexA, false, NodeA),
+      agnode(Graph, VertexB, false, NodeB),
+      agedge(Graph, NodeA, NodeB, EdgeName, true, _Edge)
+    )
+  ).

modules/graphviz/Makefile

 CC=swipl-ld
+CFLAGS=`pkg-config --cflags libgvc`
 LDFLAGS=-shared
+LDLIBS=`pkg-config --libs libgvc`
+
+$(foreach var, PLSOEXT, \
+  $(eval \
+    $(shell \
+      swipl -dump-runtime-variables | \
+      grep ^$(var)= | \
+      sed -E 's/="/=/;s/";$$//')))
 
 all: graphviz_swiprolog test
 
 .PHONY: clean test
 
 clean:
-	rm -f graphviz_swiprolog graphviz_swiprolog.so graphviz_swiprolog.o
+	- rm graphviz_swiprolog
+	- rm graphviz_swiprolog.o
 
 graphviz_swiprolog: graphviz_swiprolog.o
-	swipl-ld -shared -o graphviz_swiprolog graphviz_swiprolog.o
-	mv graphviz_swiprolog.so graphviz_swiprolog
+	swipl-ld -shared -o graphviz_swiprolog graphviz_swiprolog.o $(LDLIBS)
+	mv graphviz_swiprolog.$(PLSOEXT) graphviz_swiprolog
 
 graphviz_swiprolog.o: graphviz_swiprolog.c
 

modules/graphviz/examples/digraph.pl

+:- module(
+  digraph,
+  [
+    digraph/1
+  ]
+).
+
+:- use_module('../graphviz').
+
+digraph(TargetFilename) :-
+  agopen('test', directed, Graph),
+  agattr(Graph, graph, size, '7.5,11', _),
+  agattr(Graph, graph, ratio, fill, _),
+  agnode(Graph, 'a', true, NodeA),
+  agnode(Graph, 'b', true, NodeB),
+  agnode(Graph, 'reaction_0', true, Reaction_0),
+  agedge(Graph, NodeA, Reaction_0, 'a -> reaction_0', true, _Edge0),
+  agedge(Graph, Reaction_0, NodeB, 'reaction_0 -> b', true, _Edge1),
+  agattr(Graph, node, shape, circle, _),
+  agset(Reaction_0, shape, box),
+  agwrite(Graph, TargetFilename),
+  agclose(Graph).

modules/graphviz/examples/png.pl

+:- module(
+  png,
+  [
+    png/2
+  ]
+).
+
+:- use_module('../graphviz').
+
+png(SourceFilename, TargetFilename) :-
+  agread(SourceFilename, Graph),
+  gvLayout(Graph, dot),
+  gvRenderFilename(Graph, png, TargetFilename),
+  gvFreeLayout(Graph),
+  agclose(Graph).

modules/graphviz/examples/simple.pl

+:- module(
+  simple,
+  [
+    simple/2
+  ]
+).
+
+:- use_module('../graphviz').
+
+simple(SourceFilename, TargetFilename) :-
+  agread(SourceFilename, Graph),
+  gvLayout(Graph, dot),
+  gvRenderFilename(Graph, plain, TargetFilename),
+  gvFreeLayout(Graph),
+  agclose(Graph).

modules/graphviz/graphviz.pl

 :- module(
   graphviz,
   [
+    agattr/5,
     agclose/1,
+    agedge/6,
+    agget/3,
+    agnode/4,
+    agopen/3,
     agread/2,
+    agset/3,
+    agwrite/2,
     gvFreeLayout/1,
     gvLayout/2,
-    gvRender/3
+    gvRenderFilename/3
   ]
 ).
 

modules/graphviz/graphviz.plt

@@ -2,9 +2,21 @@
 
 :- use_module(graphviz).
 
+:- use_module('examples/digraph').
+
+:- use_module('examples/simple').
+
+:- use_module('examples/png').
+
 :- begin_tests(graphviz).
 
-test(say_hello) :-
-  say_hello('Hello world.').
+test(digraph) :-
+  digraph('test_digraph.dot').
+
+test(simple) :-
+  simple('test.dot', 'target.dot').
+
+test(png) :-
+  png('test_digraph.dot', 'target.png').
 
 :- end_tests(graphviz).

modules/graphviz/graphviz_swiprolog.c

 #include <stdio.h>
 #include <SWI-Prolog.h>
 #include <gvc.h>
+#include "graphviz_swiprolog.h"
 
-GVC_t *gvc;
+static GVC_t *gvc;
 
-static foreign_t
-pl_agclose(term_t graph_term) {
-    Agraph_t *graph;
-    if (!PL_get_pointer(graph_term, &graph)) {
+#define PL_check(result) \
+    if (!(result)) { \
+        PL_fail; \
+    }
+
+int
+PL_get_desc(term_t desc_term, Agdesc_t *desc) {
+    char *desc_string;
+    PL_check(PL_get_atom_chars(desc_term, &desc_string));
+    if (strcmp(desc_string, "undirected") == 0) {
+        *desc = Agundirected;
+    }
+    else if (strcmp(desc_string, "strict_undirected") == 0) {
+        *desc = Agstrictundirected;
+    }
+    else if (strcmp(desc_string, "directed") == 0) {
+        *desc = Agdirected;
+    }
+    else if (strcmp(desc_string, "strict_directed") == 0) {
+        *desc = Agstrictdirected;
+    }
+    else {
         PL_fail;
     }
+    PL_succeed;
+}
+
+int
+PL_get_graph(term_t graph_term, Agraph_t **graph) {
+    return PL_get_pointer(graph_term, (void **) graph);
+}
+
+int
+PL_get_kind(term_t desc_term, int *kind) {
+    char *desc_string;
+    PL_check(PL_get_atom_chars(desc_term, &desc_string));
+    if (strcmp(desc_string, "graph") == 0) {
+        *kind = AGRAPH;
+    }
+    else if (strcmp(desc_string, "node") == 0) {
+        *kind = AGNODE;
+    }
+    else if (strcmp(desc_string, "out_edge") == 0) {
+        *kind = AGOUTEDGE;
+    }
+    else if (strcmp(desc_string, "in_edge") == 0) {
+        *kind = AGINEDGE;
+    }
+    else if (strcmp(desc_string, "edge") == 0) {
+        *kind = AGEDGE;
+    }
+    else {
+        PL_fail;
+    }
+    PL_succeed;
+}
+
+int
+PL_get_node(term_t graph_term, Agnode_t **node) {
+    return PL_get_pointer(graph_term, (void **) node);
+}
+
+int
+PL_unify_graph_or_close(term_t graph_term, Agraph_t *graph) {
+    int result = PL_unify_pointer(graph_term, graph);
+    if (!result) {
         agclose(graph);
+    }
+    return result;
+}
+
+static foreign_t
+pl_agattr(
+    term_t graph_term, term_t kind_term, term_t name_term,
+    term_t value_term, term_t sym_term
+) {
+    Agraph_t *graph;
+    int kind;
+    char *name;
+    char *value;
+    Agsym_t *sym;
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(PL_get_kind(kind_term, &kind));
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(PL_get_atom_chars(value_term, &value));
+    PL_check(sym = agattr(graph, kind, name, value));
+    PL_check(PL_unify_pointer(sym_term, sym));
+    PL_succeed;
+}
+
+static foreign_t
+pl_agclose(term_t graph_term) {
+    Agraph_t *graph;
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(!agclose(graph));
     PL_succeed;
 }
 
+static foreign_t
+pl_agedge(
+    term_t graph_term, term_t node0_term, term_t node1_term, term_t name_term,
+    term_t create_flag_term, term_t edge_term
+) {
+    Agraph_t *graph;
+    Agnode_t *node0;
+    Agnode_t *node1;
+    char *name;
+    int create_flag;
+    Agedge_t *edge;
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(PL_get_node(node0_term, &node0));
+    PL_check(PL_get_node(node1_term, &node1));
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(PL_get_bool(create_flag_term, &create_flag));
+    PL_check(edge = agedge(graph, node0, node1, name, create_flag));
+    PL_check(PL_unify_pointer(edge_term, edge));
+    PL_succeed;
+
+}
+
+static foreign_t
+pl_agget(term_t object_term, term_t name_term, term_t value_term) {
+    void *object;
+    char *name;
+    char *value;
+    PL_check(PL_get_pointer(object_term, &object));
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(value = agget(object, name));
+    PL_check(PL_unify_atom_chars(value_term, value));
+    PL_succeed;
+}
+
+static foreign_t
+pl_agnode(
+    term_t graph_term, term_t name_term, term_t create_flag_term,
+    term_t node_term
+) {
+    Agraph_t *graph;
+    char *name;
+    int create_flag;
+    Agnode_t *node;
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(PL_get_bool(create_flag_term, &create_flag));
+    PL_check(node = agnode(graph, name, create_flag));
+    PL_check(PL_unify_pointer(node_term, node));
+    PL_succeed;
+
+}
+
 static foreign_t
 pl_agread(term_t filename_term, term_t graph_term) {
     char *filename;
     FILE *file;
     Agraph_t *graph;
-    if (!PL_get_atom_chars(filename_term, &filename)) {
-        PL_fail;
-    }
-    file = fopen(filename, "r");
-    graph = agread(file);
-    fclose(file);
-    if (!PL_put_pointer(graph_term, graph)) {
-        agclose(graph);
-        PL_fail;
-    }
+    PL_check(PL_get_atom_chars(filename_term, &filename));
+    PL_check(file = fopen(filename, "r"));
+    PL_check(graph = agread(file, 0));
+    PL_check(!fclose(file));
+    PL_check(PL_unify_graph_or_close(graph_term, graph));
+    PL_succeed;
+}
+
+static foreign_t
+pl_agopen(term_t name_term, term_t desc_term, term_t graph_term) {
+    char *name;
+    char *graph_type;
+    Agdesc_t desc;
+    Agraph_t *graph;
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(PL_get_desc(desc_term, &desc));
+    PL_check(graph = agopen(name, desc, 0));
+    PL_check(PL_unify_graph_or_close(graph_term, graph));
+    PL_succeed;
+}
+
+static foreign_t
+pl_agset(term_t object_term, term_t name_term, term_t value_term) {
+    void *object;
+    char *name;
+    char *value;
+    PL_check(PL_get_pointer(object_term, &object));
+    PL_check(PL_get_atom_chars(name_term, &name));
+    PL_check(PL_get_atom_chars(value_term, &value));
+    PL_check(!agset(object, name, value));
+    PL_succeed;
+}
+
+static foreign_t
+pl_agwrite(term_t graph_term, term_t filename_term) {
+    Agraph_t *graph;
+    char *filename;
+    FILE *file;
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(PL_get_atom_chars(filename_term, &filename));
+    PL_check(file = fopen(filename, "w"));
+    PL_check(!agwrite(graph, file));
+    PL_check(!fclose(file));
     PL_succeed;
 }
 
 static foreign_t
 pl_gvFreeLayout(term_t graph_term) {
     Agraph_t *graph;
-    if (!PL_get_pointer(graph_term, &graph)) {
-        PL_fail;
-    }
-    gvFreeLayout(gvc, graph);
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(!gvFreeLayout(gvc, graph));
     PL_succeed;
 }
 
@@ -46,42 +218,45 @@ static foreign_t
 pl_gvLayout(term_t graph_term, term_t engine_term) {
     Agraph_t *graph;
     char *engine;
-    if (!PL_get_pointer(graph_term, &graph)) {
-        PL_fail;
-    }
-    if (!PL_get_atom_chars(engine_term, &engine)) {
-        PL_fail;
-    }
-    gvLayout(gvc, graph, engine);
+    PL_check(PL_get_graph(graph_term, &graph));
+    PL_check(PL_get_atom_chars(engine_term, &engine));
+    PL_check(!gvLayout(gvc, graph, engine));
     PL_succeed;
 }
 
 static foreign_t
-pl_gvRender(term_t graph_term, term_t format_term, term_t filename) {
+pl_gvRenderFilename(
+    term_t graph_term, term_t format_term, term_t filename_term
+) {
     Agraph_t *graph;
     char *format;
+    char *filename;
     FILE *file;