samer@0: :- module(dot,[
samer@0:       dotrun/4
samer@0: 	,	graph_dot/2
samer@0: 	]).
samer@0: 
samer@0: /** <module> Graphviz language 
samer@0: 	
samer@1:    Produces .dot language graphs from relational and functional schemata.
samer@0: 
samer@0:    Graph strucure is as follows:
samer@0:    ==
samer@0:    digraph  ---> digraph(Name:term, G:list(element)).
samer@0:    subgraph ---> subgraph(Name:term, G:list(element)).
samer@0:    element  ---> subgraph
samer@0:                ; option
samer@0:                ; node_opts(list(option))
samer@0:                ; edge_opts(list(option))
samer@0:                ; with_opts(element, list(option))
samer@0:                ; arrow(term,term)   % directed edge
samer@0:                ; line(term,term)    % undirected edge
samer@0:                ; node(term).
samer@0:    option   ---> opt_name=opt_value.
samer@0:    opt_name  == atom
samer@0:    opt_value == phrase
samer@1:    ==
samer@0:    Graph, node and edge labels can be terms and are written using write/1 for
samer@0:    writing in the dot file.
samer@0: 
samer@0:    ---
samer@1:    Samer Abdallah
samer@1:    Centre for Digital Music, Queen Mary, University of London, 2007
samer@0:    Department of Computer Science, UCL, 2014
samer@0:  */
samer@0: 
samer@0: :- use_module(fileutils).
samer@0: :- use_module(dcgu).
samer@0: 
samer@0: 
samer@0: digraph(Name,G) -->
samer@0: 	"digraph ", wr(Name), cr,
samer@0: 	dotblock([ overlap=at(false)
samer@0:             , spline=at(true)
samer@0:             , contentrate=at(true)
samer@0:             | G]).
samer@0: 
samer@0: subgraph(Name,G) --> "subgraph ", wr(Name), cr, dotblock(G).
samer@0: 
samer@0: dotblock(L) --> brace(( cr, dotlist(L), cr)), cr.
samer@0: dotline(L) --> "\t", L, ";\n".
samer@0: dotlist([]) --> "".
samer@0: dotlist([L|LS]) -->
samer@0: 	if(L=dotblock(B),
samer@0: 		dotblock(B),
samer@0: 		dotline(L)),
samer@0: 	dotlist(LS).
samer@0: 
samer@0: 
samer@0: with_opts(A,Opts) --> phrase(A), sp, sqbr(optlist(Opts)).
samer@0: optlist(L) --> seq(L,",").
samer@0: 
samer@0: node_opts(Opts) --> with_opts(at(node), Opts).
samer@0: edge_opts(Opts) --> with_opts(at(edge), Opts).
samer@0: nq(A)   --> wr(A).
samer@0: node(A) --> qq(wr(A)).
samer@0: arrow(A,B) --> node(A), " -> ", node(B).
samer@0: line(A,B)  --> node(A), " -- ", node(B).
samer@0: (A=B) --> at(A), "=", B.
samer@0: 	
samer@0: 
samer@0: dot_method(M,M) :- member(M,[dot,neato,sfdp,fdp,circo,twopi]).
samer@0: dot_method(unflatten,M) :- dot_method(unflatten([]),M).
samer@0: dot_method(unflatten(Opts),M) :-
samer@0:    phrase(("unflatten",seqmap(uopt,Opts)," | dot"),Codes,[]),
samer@0:    atom_codes(M,Codes).
samer@0: 
samer@0: uopt(l(N)) --> " -l", wr(N).
samer@0: uopt(fl(N)) --> " -f -l", wr(N).
samer@0: uopt(c(N)) --> " -c", wr(N).
samer@0: 
samer@0: %% dotrun( +Method:graphviz_method, +Fmt:atom, G:digraph, +File:atom) is det.
samer@0: %
samer@0: %  Method determines which GraphViz programs are used to render the graph:
samer@0: %  ==
samer@0: %  graphviz_method ---> dot ; neato; fdp ; sfdp ; circo ; twopi
samer@0: %                     ; unflatten
samer@0: %                     ; unflatten(list(unflatten_opt)).
samer@0: %  unflatten_opt   ---> l(N:natural)   % -l<N> 
samer@0: %                     ; fl(N:natural)  % -f -l<N>
samer@0: %                     ; c(natural).    % -c<N> 
samer@0: %  ==
samer@0: %  The unflatten method attempts to alleviate the problem of very wide graphs,
samer@0: %  and implies that dot is used to render the graph. The default option list is empty.
samer@2: %
samer@2: %  Fmt can be any format supported by Graphviz under the -T option, including
samer@2: %  ps, eps, pdf, svg, png.
samer@2: %
samer@0: %  See man page for unflatten for more information.
samer@0: %  TODO: Could add more options for dot.
samer@0: dotrun(Meth1,Fmt,Graph,File) :-
samer@0:    dot_method(Meth1,Meth),
samer@0:    member(Fmt,[ps,eps,pdf]),
samer@0:    format(atom(Cmd),'~w -T~w > "~w.~w"',[Meth,Fmt,File,Fmt]), 
samer@0:    format('Running: ~w ...\n',Cmd),
samer@0: 	with_output_to_file(pipe(Cmd),writedcg(Graph)).
samer@0: 
samer@0: %% graph_dot( +G:digraph, +File:atom) is det.
samer@0: graph_dot(Graph,File) :-
samer@0: 	with_output_to_file(File,writedcg(Graph)).
samer@0: 
samer@0: %%% Options
samer@0: 
samer@0: % Graph options
samer@0: dotopt(graph,[size,page,ratio,margin,nodesep,ranksep,ordering,rankdir,
samer@0: 	pagedir,rank,rotate,center,nslimit,mclimit,layers,color,href,splines,
samer@0: 	start,epsilon,root,overlap, mindist,'K',maxiter]).
samer@0: 
samer@0: 
samer@0: % Node options
samer@0: dotopt(node, [label,fontsize,fontname,shape,color,fillcolor,fontcolor,style,
samer@0: 	layer,regular,peripheries,sides,orientation,distortion,skew,href,target,
samer@0: 	tooltip,root,pin]).
samer@0: 
samer@0: % Edge options
samer@0: dotopt(edge, [minlen,weight,label,fontsize,fontname,fontcolor,style,color,
samer@0: 		dir,tailclip,headclip,href,target,tooltip,arrowhead,arrowtail,
samer@0: 		headlabel,taillabel,labeldistance,port_label_distance,decorate,
samer@0: 		samehead,sametail,constraint,layer,w,len]).
samer@0: 
samer@0: 
samer@0: % Node options values
samer@0: dotopt(node, label, A) :- ground(A).
samer@0: dotopt(node, fontsize, N) :- between(1,256,N). % arbitrary maximum!
samer@0: dotopt(node, fontname, A) :- ground(A).
samer@0: dotopt(node, shape,
samer@0: 	[	plaintext,ellipse,box,circle,egg,triangle,diamond,
samer@0: 		trapezium,parallelogram,house,hexagon,octagon]).
samer@0: dotopt(node, style, [filled,solid,dashed,dotted,bold,invis]).
samer@0: 
samer@0: 
samer@0: % Edge options values
samer@0: dotopt(edge, fontsize, N) :- between(1,256,N). % arbitrary maximum!
samer@0: dotopt(edge, label, A) :- ground(A).
samer@0: dotopt(node, fontname, A) :- ground(A).
samer@0: dotopt(node, style, [solid,dashed,dotted,bold,invis]).