Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit 8f14cf70 authored by Thierry Martinez's avatar Thierry Martinez
Browse files

Graphviz intregration

parent 00c76b07
......@@ -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
......@@ -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),
!,
......
:- 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)
)
).
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
......
:- 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).
:- module(
png,
[
png/2
]
).
:- use_module('../graphviz').
png(SourceFilename, TargetFilename) :-
agread(SourceFilename, Graph),
gvLayout(Graph, dot),
gvRenderFilename(Graph, png, TargetFilename),
gvFreeLayout(Graph),
agclose(Graph).
:- module(
simple,
[
simple/2
]
).
:- use_module('../graphviz').
simple(SourceFilename, TargetFilename) :-
agread(SourceFilename, Graph),
gvLayout(Graph, dot),
gvRenderFilename(Graph, plain, TargetFilename),
gvFreeLayout(Graph),
agclose(Graph).
:- 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
]
).
......
......@@ -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).
#include <stdio.h>
#include <SWI-Prolog.h>
#include <gvc.h>
#include "graphviz_swiprolog.h"
GVC_t *gvc;
static GVC_t *gvc;
#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;
if (!PL_get_pointer(graph_term, &graph)) {
PL_fail;
}
agclose(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;
if (!PL_get_pointer(graph_term, &graph)) {
PL_fail;
}
if (!PL_get_atom_chars(format_term, &format)) {
PL_fail;
}
if (!PL_get_atom_chars(filename_term, &filename)) {
PL_fail;
}
file = fopen(filename, "w");
gvRender(gvc, graph, format, file);
PL_check(PL_get_graph(graph_term, &graph));
PL_check(PL_get_atom_chars(format_term, &format));
PL_check(PL_get_atom_chars(filename_term, &filename));
PL_check(!gvRenderFilename(gvc, graph, format, filename));
PL_succeed;
}
PL_extension graphviz_predicates[] = {
{ "agattr", 5, pl_agattr, 0 },
{ "agclose", 1, pl_agclose, 0 },
{ "agedge", 6, pl_agedge, 0 },
{ "agget", 3, pl_agget, 0 },
{ "agnode", 4, pl_agnode, 0 },
{ "agopen", 3, pl_agopen, 0 },
{ "agread", 2, pl_agread, 0 },
{ "agset", 3, pl_agset, 0 },
{ "agwrite", 2, pl_agwrite, 0 },
{ "gvFreeLayout", 1, pl_gvFreeLayout, 0 },
{ "gvLayout", 2, pl_gvLayout, 0 },
{ "gvRenderFilename", 3, pl_gvRenderFilename, 0 },
{ NULL, 0, NULL, 0 }
};
install_t
install_graphviz_swiprolog() {
install_graphviz_swiprolog(void) {
gvc = gvContext();
PL_register_foreign("agclose", 1, pl_agclose, 0);
PL_register_foreign("agread", 2, pl_agread, 0);
PL_register_foreign("gvFreeLayout", 1, pl_gvFreeLayout, 0);
PL_register_foreign("gvLayout", 2, pl_gvLayout, 0);
PL_register_foreign("gvRender", 3, pl_gvRender, 0);
PL_register_extensions(graphviz_predicates);
}