1:-module(graphviz,
    2     [add_arc_graph/2,
    3     init_graph/2,
    4     status/2,
    5     draw_graph/3,
    6     close_graph/0]).    7
    8:- ensure_loaded(sciff_options).    9
   10:- dynamic proof_status/2.   11
   12
   13% A is the transition name
   14% B is the content of the new node
   15add_arc_graph(_,_) :-
   16	get_option(graphviz, off), !.
   17add_arc_graph(A,B):-
   18    status(S,_),
   19    draw_graph(S,A,B).
   20
   21
   22init_graph(_, _):-
   23		get_option(graphviz, off), !.
   24init_graph(FileName,Stream):-
   25    open(FileName,write,Stream),
   26    write(Stream,'digraph G {\n'),
   27    assert(proof_status(0,Stream)).
   28
   29status(_,_):-
   30		get_option(graphviz, off), !.
   31status(S,F):-
   32    proof_status(S,F).
   33
   34% draw_graph(+Sin,+Transition,+NewNode)
   35% Sin is the starting node identifier 
   36% Transition is the applied transition (whatever you want, goes to the label of the arc)
   37% NewNode is the representation of the new node (whatever you want, goes in the new node)
   38draw_graph(_,_,_):-
   39		get_option(graphviz, off), !.
   40draw_graph(Sin,Transition,NewNode):-
   41    proof_status(Stemp,Stream),
   42    retract(proof_status(Stemp,Stream)),
   43    Sout is Stemp + 1,
   44    assert(proof_status(Sout,Stream)),
   45    % Write the new node
   46    write(Stream,Sout), write(Stream,' [label="'),
   47    write(Stream,NewNode), write(Stream,'"];\n'),
   48    % write the arc
   49    write(Stream,Sin),
   50    write(Stream,' -> '),
   51    write(Stream,Sout),
   52    write(Stream,' [label="'),
   53    write(Stream,Transition),
   54    write(Stream,'"];\n').
   55
   56close_graph :-
   57		get_option(graphviz, off), !.
   58close_graph :-
   59    status(_,F),
   60    write(F,'\n}\n'),
   61    close(F)