1		% (c) 2009-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(dot_graph_generator,[gen_dot_graph/6,gen_dot_graph/7,
6		print_graph_header/1,print_graph_footer/0,
7		translate_bvalue_to_colour/2, try_translate_bvalue_to_colour/2,
8		translate_int_col/2]).
9
10		:- use_module(module_information).
11		:- module_info(group,dot).
12		:- module_info(description,'This a few tools for generating dot graphs.').
13
14		:- use_module(library(lists)).
15		:- use_module(preferences).
16
17		:- use_module(debug).
18		:- use_module(self_check).
19
20		/* --------------------------------------------------- */
21		/* MAIN ENTRY POINTS FOR TCL */
22		/* --------------------------------------------------- */
23
24		% note: one can provide none for some of the predicates
25
26		gen_dot_graph(F,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :-
27		gen_dot_graph(F,[with_page_size],Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred).
28
29		gen_dot_graph(F,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :-
30		print('% Generating Dot File: '), print(F),nl,
31		reset_ids,
32		open(F,write,FStream,[encoding('UTF-8')]),
33		(fgen_dot_graph(FStream,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) -> true ; true),
34		close(FStream),
35		print('% Done'),nl.
36
37
38		node_id(Module,P,NodeID) :-
39		node_predicate_call(Module,P,NodeID,_Sub,_NodeDesc,_Shape,_Style,_Color).
40		node_predicate_call(Module,P,TNodeID,SubGraph,NodeDesc,Shape,Style,Color) :-
41		%Call =.. [P,NodeID,SubGraph,NodeDesc,Shape,Style,Color],
42		call(Module:P,NodeID,SubGraph,NodeDesc,Shape,Style,Color),
43		translate_id(NodeID,TNodeID).
44
45		trans_predicate_call(Module,P,TNodeID,Label,TSuccNodeID,Color,Style) :-
46		%Call =.. [P,NodeID,Label,SuccNodeID,Color],
47		call(Module:P,NodeID,Label,SuccNodeID,Color,Style),
48		translate_id(NodeID,TNodeID),
49		translate_id(SuccNodeID,TSuccNodeID).
50
51		same_rank_call(Module,P,TNodes) :- P \= none,
52		%Call =.. [P,Nodes],
53		call(Module:P,Nodes),
54		Nodes \= [], % empty list provides no information
55		maplist(translate_id,Nodes,TNodes).
56		/* should succeed once for every set of NodeIDs which should be of same rank */
57
58		% should succeed once for every subgraph and generate a subgraphID which is passed to the node predicate
59		subgraph_call(Module,P,SubGraphID,Style,Color) :- P \= none,
60		%Call =.. [P,SubGraphID,Style,Color],
61		call(Module:P,SubGraphID,Style,Color).
62		/* Notes: SubGraphID: should be none if not in a subgraph; Style and Color can be none */
63
64		:- dynamic stored_id/2.
65		:- dynamic next_id/1.
66		next_id(0).
67
68		reset_ids :- retractall(stored_id(_,_)), retractall(next_id(_)),
69		assert(next_id(0)).
70
71		% translate ids to numbers; ensure that dot can deal with them
72		translate_id(ID,TransID) :-
73		(number(ID) -> TransID=ID
74		; stored_id(ID,SID) -> TransID=SID
75		; retract(next_id(TransID)),
76		assert(stored_id(ID,TransID)),
77		N1 is TransID+1,
78		assert(next_id(N1))).
79
80		/* ---------------------------------------------------------------------- */
81
82
83		fgen_dot_graph(FStream,WithSize,Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :-
84		print_graph_header(FStream,prob_graph,WithSize),
85		(node_id(Module,NodePredicate,_) -> true
86		; (format(user_error,"No nodes in gen_dot_graph: ~w, ~w, ~w ~w ~w.~n~n",
87		[Module,NodePredicate,TransPredicate,SameRankPred,SubGraphPred]),fail)),
88		print_nodes(FStream,Module,NodePredicate,SubGraphPred),
89		fail.
90		fgen_dot_graph(FStream,_WithSize,Module,_NodePredicate,_TransPredicate,SameRankPred,_SubGraphPred) :-
91		same_rank_call(Module,SameRankPred,Nodes),
92		print_same_ranks(FStream,Nodes),
93		fail.
94		fgen_dot_graph(FStream,_WithSize,Module,_NodePredicate,TransPredicate,_SameRankPred,_SubGraphPred) :-
95		print_transitions(FStream,_NodeID,Module,TransPredicate),
96		fail.
97		fgen_dot_graph(FStream,_,_,_,_,_,_) :-
98		print_graph_footer(FStream).
99
100		/* ---------------------------------------------------------------------- */
101
102		print_graph_header(Type) :- print_graph_header(user_output,Type,[with_page_size]).
103		print_graph_header(FStream,Type,Opts) :-
104		(member(with_page_size,Opts) -> PSize='page="8.5, 11",ratio=fill,size="7.5,10"' ; PSize=''),
105		(member(horizontal,Opts) -> RDir = ' rankdir=LR;' ; RDir=''),
106		format(FStream,'digraph ~w { graph [~w];~w~n',[Type,PSize,RDir]).
107		% print('graph [orientation=landscape, page="8.5, 11",ratio=fill,size="7.5,10"];'),nl,
108
109		print_graph_footer :- print_graph_footer(user_output).
110		print_graph_footer(FStream) :- format(FStream,'}~n',[]).
111
112
113		/* ---------------------------------------------------------------------- */
114
115
116		print_nodes(FStream,Module,NodePredicate,SubGraphPred) :-
117		subgraph_call(Module,SubGraphPred,SubgraphID,Style,Color),
118		format(FStream,' subgraph cluster_~w {~n',[SubgraphID]),
119		(Style = none -> true ; format(FStream,' style="~w";~n',[Style])),
120		(Color = none -> true ; format(FStream,' color="~w";~n',[Color])),
121		format(FStream,' label="~w";~n',[SubgraphID]),
122		print_nodes2(FStream,SubgraphID,Module,NodePredicate),
123		write(FStream,' }'),nl(FStream),
124		fail.
125		print_nodes(FStream,Module,NodePredicate,_SubGraphPred) :-
126		print_nodes2(FStream,none,Module,NodePredicate),
127		nl(FStream).
128
129
130		print_nodes2(FStream,SubGraph,Module,NodePredicate) :-
131		node_predicate_call(Module,NodePredicate,NodeID,SubGraph,NodeDesc,Shape,Style,Color),
132		format(FStream,' ~w [shape=~w',[NodeID,Shape]), /* options: triangle, .... */
133		(Style = none
134		-> true
135		; format(FStream,', style="~w"',[Style]) /* options: filled */
136		),
137		(Color = none
138		-> true
139		; format(FStream,', color="~w"',[Color]) /* options: red,green,... */
140		),
141		get_preference(dot_node_font_size,FSize),
142		format(FStream,', fontsize=~w, label="',[FSize]),
143		((preference(dot_print_node_ids,true),
144		\+ stored_id(_,_), % no translations performed
145		NodeID \= NodeDesc) % otherwise we already print it as description
146		-> format(FStream,'~w:\\n',[NodeID]) ; true),
147		format(FStream,'~w"];~n',[NodeDesc]),
148		fail.
149		print_nodes2(FStream,_Subgraph,_,_) :- nl(FStream).
150
151		print_transitions(FStream,NodeID,Module,TransPredicate) :-
152		trans_predicate_call(Module,TransPredicate,NodeID,Label,SuccID,Color,Style),
153
154		(NodeID=root -> preference(dot_print_root,true) ; true),
155
156		(NodeID \= SuccID -> true ; preference(dot_print_self_loops,true)),
157
158		format(FStream,' ~w -> ~w [',[NodeID,SuccID]),
159		(preference(dot_print_arc_colors,true)
160		-> format(FStream,'color="~w",',[Color])
161		; true
162		),
163		% acceptable styles Style ::= solid, bold, dotted, dashed, invis, arrowhead(none,Style)
164		print_style(Style,FStream),
165		get_preference(dot_edge_font_size,FSize),
166		(Label='' -> format(FStream,'];~n',[])
167		; format(FStream,' label="~w", fontsize=~w];~n',[Label,FSize])),
168		fail.
169		print_transitions(FStream,_NodeID,_,_) :- nl(FStream).
170
171		print_style(solid,_) :- !.
172		print_style(arrowhead(AS,S),FStream) :- !, format(FStream,'arrowhead=~w,',[AS]), print_style(S,FStream).
173		print_style(arrowtail(AS,S),FStream) :- !, format(FStream,'dir=both,arrowtail=~w,',[AS]), print_style(S,FStream).
174		print_style(Style,FStream) :- format(FStream,'style="~w",',[Style]).
175
176		print_same_ranks(FStream,L) :-
177		write(FStream,' { rank=same; '),
178		print_same_ranks2(FStream,L),
179		write(FStream,' }'),nl(FStream).
180
181		print_same_ranks2(_FStream,[]).
182		print_same_ranks2(FStream,[H|T]) :-
183		write(FStream,H), write(FStream,'; '),
184		print_same_ranks2(FStream,T).
185
186
187		% utilities for converting values into colours:
188
189
190
191		translate_bvalue_to_colour(Val,Col) :-
192		(try_translate_bvalue_to_colour(Val,C) -> Col=C; Col=lightgray).
193
194		try_translate_bvalue_to_colour(int(X),Res) :- !, (translate_int_col(X,Colour) -> Res=Colour ; Res=black).
195		try_translate_bvalue_to_colour(string(X),Colour) :- is_of_type(X,rgb_color),!, X=Colour.
196		try_translate_bvalue_to_colour(fd(X,GS),Colour) :- !, translate_fd_col(X,GS,Colour).
197		try_translate_bvalue_to_colour(pred_true,Colour) :- !, Colour=olivedrab2.
198		try_translate_bvalue_to_colour(pred_false,Colour) :- !, Colour=tomato.
199		try_translate_bvalue_to_colour((A,_),Colour) :- !, try_translate_bvalue_to_colour(A,Colour).
200
201		% TO DO : add string conversions, rgb values , ...
202		:- use_module(b_global_sets,[is_b_global_constant/3]).
203
204		translate_fd_col(X,GS,Res) :-
205		is_b_global_constant(GS,X,Colour),
206		is_of_type(Colour,rgb_color),!,
207		Res=Colour.
208		translate_fd_col(X,_,Res) :- number(X), translate_int_col(X,Colour),!, Res=Colour.
209		translate_fd_col(_,_,lightgray).
210
211		translate_int_col(-1,Colour) :- !,Colour=tomato. % special case
212		translate_int_col(Int,Colour) :-
213		Y is abs(Int) mod 15, translate_int_col_aux(Y,Colour).
214		translate_int_col_aux(0,gray95).
215		translate_int_col_aux(1,blue).
216		translate_int_col_aux(2,red).
217		translate_int_col_aux(3,green).
218		translate_int_col_aux(4,lightgray).
219		translate_int_col_aux(5,orange).
220		translate_int_col_aux(6,yellow).
221		translate_int_col_aux(7,brown).
222		translate_int_col_aux(8,violet).
223		translate_int_col_aux(9,tomato).
224		translate_int_col_aux(10,darkslateblue).
225		translate_int_col_aux(11,maroon2).
226		translate_int_col_aux(12,olivedrab2).
227		translate_int_col_aux(13,chartreuse3).
228		translate_int_col_aux(14,grey20).
229		% red,green,blue,yellow,orange,black,white,gray,brown,violet,darkred,tomato,darkblue,
230		% 'DarkGray',darkviolet,darkslateblue,lightblue,lightgray,maroon2,olivedrab2,
231		% steelblue,chartreuse3,chartreuse4