1		% (c) 2009-2023 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(state_as_dot_graph,[
6		print_cstate_graph/2, print_cstate_graph/1]).
7
8		:- use_module(probsrc(module_information)).
9		:- module_info(group,dot).
10		:- module_info(description,'Display canonical form of state graph using dot.').
11
12		:- use_module(extrasrc(state_graph_canon),[state_graph_for_dot/2]).
13
14
15		/* ---------------------------- */
16		/* DOT generation */
17		/* ---------------------------- */
18
19
20		:- use_module(probsrc(error_manager)).
21		:- use_module(probsrc(preferences)).
22		:- use_module(probsrc(state_space),[current_expression/2]).
23		:- use_module(probsrc(tools),[ajoin/2, string_escape/2]).
24
25		print_cstate_graph(File) :-
26		current_expression(_,State),
27		print_cstate_graph(State,File).
28		print_cstate_graph(State,File) :-
29		state_graph_for_dot(State,GCE),
30		open(File,write,Stream,[encoding(utf8)]),
31		(graph2dot(Stream,GCE) -> close(Stream)
32		; close(Stream),
33		add_error(graph_canon,'Dot conversion failed: ',graph2dot(File,GCE))
34		).
35
36
37		graph2dot(Stream,G) :- reset_dot,
38		(get_preference(dot_horizontal_layout,true) -> RDir='LR'; RDir='TB'),
39		PSize='', %(get_preference(dot_with_page_size,true) -> PSize='page="8.5, 11",ratio=fill,size="7.5,10",' ; PSize=''),
40		format(Stream,'digraph state {\n graph [~wfontsize=12]\nrankdir=~w;~n',[PSize,RDir]),
41		edges2dot(G,Stream),
42		nodes2dot(Stream),
43		findall(cluster(Ty,El),cluster(Ty,El),T),
44		clusters2dot(T,Stream),
45		format(Stream,'}~n',[]).
46
47		:- use_module(probsrc(b_global_sets)).
48		cluster(Type,Elements) :- b_global_set(Type),
49		% compute all elements of global sets which are used in current state graph
50		findall(Translation, (enum_global_type_limited(El,Type), node_col(El,Translation,_,_)),Elements).
51		% maybe add boolean ??
52		edges2dot([],_).
53		edges2dot([(A,B,C)|T],Stream) :- /* edge from A -> C with label B */
54		translate_node_value(A,AID),
55		(B = abs_cn(BB,ColBB)
56		-> translate_abs_cn_node(BB,ColBB,EdgeLabel)
57		; EdgeLabel = B),
58		translate_node_value(C,CID),
59		get_col_assoc(edge,EdgeLabel,EdgCol),
60		format(Stream,'\"~w\" -> \"~w\" [label = \"~w\", color = \"~w\"];\n',
61		[AID,CID,EdgeLabel,EdgCol]),
62		edges2dot(T,Stream).
63
64		reset_dot :- retractall(col_association(_,_,_)),
65		retractall(node_col(_,_,_,_)),
66		retractall(cur_col(_,_)),
67		assertz(cur_col(node,0)), assertz(cur_col(edge,99)).
68
69		:- use_module(probsrc(translate),[translate_bvalue_for_dot/2]).
70		translate_node_value(abs_cn(AA,ColAA), Translation) :- !,
71		translate_abs_cn_node(AA,ColAA,Translation).
72		translate_node_value(sg_root,Translation) :- !,
73		Translation = 'ROOT-NODE', add_node(sg_root,Translation).
74		translate_node_value(Val,Translation) :-
75		translate_bvalue_for_dot(Val,Translation),
76		add_node(Val,Translation).
77
78		nodes2dot(Stream) :- node_col(_,Translation,Col,Shape),
79		(Shape=record(Label)
80		-> format(Stream,'\"~w\" [shape=record, label=\"~w\", color = \"~w\", style = \"filled, solid\"]\n',
81		[Translation,Label,Col])
82		; format(Stream,'\"~w\" [color = \"~w\", style = \"filled, solid\", shape = \"~w\"]\n',[Translation,Col,Shape])
83		),
84		fail.
85		nodes2dot(_).
86
87		:- use_module(probsrc(kernel_reals),[is_real/2]).
88		:- dynamic node_col/4.
89		add_node(X,_) :- node_col(X,_,_,_),!. % already processed
90		add_node(sg_root,Translation) :-
91		assertz(node_col(sg_root,Translation,lightblue,diamond)).
92		add_node(fd(X,Type),Translation) :- !,
93		get_col_assoc(node,Type,Col),
94		get_preference(dot_normal_node_shape,Shape),
95		assertz(node_col(fd(X,Type),Translation,Col,Shape)).
96		add_node(int(X),Translation) :- !,
97		Col = 'wheat3', %get_col_assoc(node,integer,Col),
98		get_preference(dot_normal_node_shape,Shape),
99		assertz(node_col(int(X),Translation,Col,Shape)).
100		add_node(string(X),Translation) :- !,
101		Col = 'khaki1', %'lavender' 'burlywood', %get_col_assoc(node,integer,Col),
102		get_preference(dot_normal_node_shape,Shape),
103		assertz(node_col(string(X),Translation,Col,Shape)).
104		add_node(pred_true,T) :- !, assertz(node_col(pred_true,T,'OliveDrab4',ellipse)).
105		add_node(pred_false,T) :- !, assertz(node_col(pred_false,T,brown,ellipse)).
106		add_node(RecordOrPair,Translation) :- get_fields(RecordOrPair,Fields),!,
107		translate_fields(Fields,Atoms),
108		ajoin(['|{ ' | Atoms], RecTranslation),
109		assertz(node_col(RecordOrPair,Translation,burlywood,record(RecTranslation))). % TO DO: maybe use dot record
110		add_node(Val,Translation) :- is_set(Val),!,
111		Col = 'LightSteelBlue1', %get_col_assoc(node,integer,Col),
112		get_preference(dot_normal_node_shape,Shape),
113		assertz(node_col(Val,Translation,Col,Shape)).
114		add_node(Term,Translation) :- is_real(Term,_),!,
115		Col = 'wheat2', %get_col_assoc(node,integer,Col),
116		get_preference(dot_normal_node_shape,Shape),
117		assertz(node_col(Term,Translation,Col,Shape)).
118		add_node(_Val,_Translation).
119
120		% copied from state_graph_canon:
121		list_set([]).
122		list_set([_|_]).
123		is_set(avl_set(_)).
124		is_set(X) :- list_set(X).
125
126		get_fields(rec(Fields),Fields).
127		get_fields((A,B),Fields) :- get_pair_fields((A,B),Fields,[]).
128
129		get_pair_fields((A,B)) --> !, get_pair_fields(A), get_pair_fields(B).
130		get_pair_fields(A) --> [field(prj,A)].
131
132		translate_fields([],[' }|']).
133		translate_fields([field(Name,Value)],Res) :- !,
134		trans_field(Name,VS,Res,[' }|']),
135		translate_bvalue_for_dot(Value,VS).
136		translate_fields([field(Name,Value)|T],Res) :-
137		trans_field(Name,VS,Res,['|' | Rest]),
138		translate_bvalue_for_dot(Value,VS),
139		translate_fields(T,Rest).
140
141		trans_field(prj,VS, [' { ', VS, ' } ' | Rest], Rest) :- !.
142		trans_field(Name,VS, [' { ',Name,' | ', VS, ' } ' | Rest], Rest).
143
144		:- dynamic col_association/3. % store colours used for types, edge labels,...
145		get_col_assoc(Domain,T,Col) :- col_association(Domain,T,Col),!.
146		get_col_assoc(Domain,T,Col) :- get_next_col(Domain,Col),
147		assertz(col_association(Domain,T,Col)).
148
149		get_next_col(Type,Col) :- retract(cur_col(Type,N)),!, N1 is N+1,
150		(default_colours(N1,Col) -> NX=N1
151		; NX = 1, default_colours(1,Col)),
152		assertz(cur_col(Type,NX)).
153		get_next_col(_T,red).
154
155		:- dynamic cur_col/2.
156		cur_col(node,0).
157		cur_col(edge,99).
158		default_colours(1,'#efdf84').
159		default_colours(2,'#bdef6b').
160		default_colours(3,'#5863ee').
161		default_colours(4,'LightSteelBlue1').
162		default_colours(5,gray).
163
164		default_colours(100,firebrick).
165		default_colours(101,sienna).
166		default_colours(102,'SlateBlue4').
167		default_colours(103,black).
168
169		translate_abs_cn_node(AA,ColAA,Translation) :-
170		tools:string_concatenate('_',AA,AID1),
171		tools:string_concatenate(ColAA,AID1,AID2),
172		tools:string_concatenate('abs',AID2,Translation).
173
174		clusters2dot([],_).
175		clusters2dot([cluster(Name,Elements)|T],Stream) :-
176		string_escape(Name,EscName),
177		format(Stream,'subgraph \"cluster_~w\" {node [style=filled,color=white]; label=\"~w\"; style=filled;color=lightgrey; ',[EscName,EscName]),
178		cnodes2dot(Elements,Stream),
179		clusters2dot(T,Stream).
180
181		:- use_module(probsrc(tools),[string_escape/2]).
182		cnodes2dot([],Stream) :- format(Stream,'}~n',[]).
183		cnodes2dot([H|T],Stream) :-
184		translate:translate_params_for_dot([H],HP),
185		string_escape(HP,HPE),
186		format(Stream,'~w; ',[HPE]),
187		cnodes2dot(T,Stream).