1/* Part of fileutils
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3	 
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(dot,[
   20      dotrun/4
   21	,	graph_dot/2
   22	]).

digraph  ---> digraph(Name:term, G:list(element)).
subgraph ---> subgraph(Name:term, G:list(element)).
element  ---> subgraph
            ; option
            ; node_opts(list(option))
            ; edge_opts(list(option))
            ; with_opts(element, list(option))
            ; arrow(term,term)   % directed edge
            ; line(term,term)    % undirected edge
            ; node(term).
option   ---> opt_name=opt_value.
opt_name  == atom
opt_value == phrase

   53:- use_module(library(fileutils)).   54:- use_module(library(dcg_core)).   55:- use_module(library(dcg_codes)).   56:- use_module(library(swipe)).   57
   58:- set_prolog_flag(double_quotes, codes).   59
   60digraph(Name,G) -->
   61	"digraph ", wr(Name), cr,
   62	dotblock([ overlap=at(false)
   63            , spline=at(true)
   64            , contentrate=at(true)
   65            | G]).
   66
   67subgraph(Name,G) --> "subgraph ", wr(Name), cr, dotblock(G).
   68
   69dotblock(L) --> brace(( cr, dotlist(L), cr)), cr.
   70dotline(L) --> "\t", L, ";\n".
   71dotlist([]) --> "".
   72dotlist([L|LS]) -->
   73	if(L=dotblock(B),
   74		dotblock(B),
   75		dotline(L)),
   76	dotlist(LS).
   77
   78
   79with_opts(A,Opts) --> phrase(A), " ", sqbr(optlist(Opts)).
   80optlist(L) --> seqmap_with_sep(",",call,L).
   81
   82node_opts(Opts) --> with_opts(at(node), Opts).
   83edge_opts(Opts) --> with_opts(at(edge), Opts).
   84% nq(A)   --> wr(A).
   85node(A) --> qq(wr(A)).
   86arrow(A,B) --> node(A), " -> ", node(B).
   87line(A,B)  --> node(A), " -- ", node(B).
   88(A=B) --> at(A), "=", B.
   89	
   90swipe:def(unflatten(Opts), sh($dot >> $dot,'unflatten~s', [\OptCodes])):-
   91   phrase(seqmap(uopt,Opts),OptCodes).
   92
   93swipe:def(graphviz(unflatten,Fmt), unflatten([]) >> graphviz(dot,Fmt)) :- !.
   94swipe:def(graphviz(unflatten(Opts),Fmt), unflatten(Opts) >> graphviz(dot,Fmt)) :- !.
   95swipe:def(graphviz(Meth,Fmt), sh($dot >> $Fmt, '~w~w -T~w', [\Meth,\Opts,\Fmt])):-
   96   member(Meth,[dot,neato,sfdp,fdp,circo,twopi]), !,
   97   must_be(oneof([svg,png,ps,eps,pdf]),Fmt),
   98   (Fmt=svg -> Opts=' -Gfontnames=svg'; Opts='').
   99
  100uopt(c(N)) --> " -c", wr(N).
  101uopt(l(N)) --> " -l", wr(N).
  102uopt(fl(N)) --> " -f", uopt(l(N)).
  103
  104%% dotrun( +Method:graphviz_method, +Fmt:atom, G:digraph, +File:atom) is det.
  105%
  106%  Method determines which GraphViz programs are used to render the graph:
  107%  ==
  108%  graphviz_method ---> dot ; neato; fdp ; sfdp ; circo ; twopi
  109%                     ; unflatten
  110%                     ; unflatten(list(unflatten_opt)).
  111%  unflatten_opt   ---> l(N:natural)   % -l<N> 
  112%                     ; fl(N:natural)  % -f -l<N>
  113%                     ; c(natural).    % -c<N> 
  114%  ==
  115%  The unflatten method attempts to alleviate the problem of very wide graphs,
  116%  and implies that dot is used to render the graph. The default option list is empty.
  117%
  118%  Fmt can be any format supported by Graphviz under the -T option, including
  119%  ps, eps, pdf, svg, png.
  120%
  121%  See man page for unflatten for more information.
  122%  TODO: Could add more options for dot.
  123dotrun(Meth,Fmt,Graph,File) :-
  124   with_pipe_input(S, graphviz(Meth,Fmt) >: File^Fmt, with_output_to(S,writedcg(Graph))).

 graph_dot(+G:digraph, +File:atom) is det

  128graph_dot(Graph,File) :-
  129	with_output_to_file(File,writedcg(Graph)).
  130
  131%%% Options
  132
  133% Graph options
  134dotopt(graph,[size,page,ratio,margin,nodesep,ranksep,ordering,rankdir,
  135	pagedir,rank,rotate,center,nslimit,mclimit,layers,color,href,splines,
  136	start,epsilon,root,overlap, mindist,'K',maxiter]).
  137
  138
  139% Node options
  140dotopt(node, [label,fontsize,fontname,shape,color,fillcolor,fontcolor,style,
  141	layer,regular,peripheries,sides,orientation,distortion,skew,href,target,
  142	tooltip,root,pin]).
  143
  144% Edge options
  145dotopt(edge, [minlen,weight,label,fontsize,fontname,fontcolor,style,color,
  146		dir,tailclip,headclip,href,target,tooltip,arrowhead,arrowtail,
  147		headlabel,taillabel,labeldistance,port_label_distance,decorate,
  148		samehead,sametail,constraint,layer,w,len]).
  149
  150
  151% Node options values
  152dotopt(node, label, A) :- ground(A).
  153dotopt(node, fontsize, N) :- between(1,256,N). % arbitrary maximum!
  154dotopt(node, fontname, A) :- ground(A).
  155dotopt(node, shape,
  156	[	plaintext,ellipse,box,circle,egg,triangle,diamond,
  157		trapezium,parallelogram,house,hexagon,octagon]).
  158dotopt(node, style, [filled,solid,dashed,dotted,bold,invis]).
  159
  160
  161% Edge options values
  162dotopt(edge, fontsize, N) :- between(1,256,N). % arbitrary maximum!
  163dotopt(edge, label, A) :- ground(A).
  164dotopt(node, fontname, A) :- ground(A).
  165dotopt(node, style, [solid,dashed,dotted,bold,invis])