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
6 :- module(state_custom_dot_graph,[tcltk_generate_state_custom_dot_graph/1, state_custom_dot_graph_available/0]).
7
8 :- use_module(module_information).
9 :- module_info(group,dot).
10 :- module_info(description,'This module provides a way to generate custom state graphs (using info from DEFINITIONS).').
11
12 :- use_module(dot_graph_generator).
13
14 %:- use_module(self_check).
15 :- use_module(error_manager).
16
17 :- use_module(state_space,[current_expression/2]).
18 :- use_module(bsyntaxtree, [get_texpr_id/2]).
19 :- use_module(specfile, [state_corresponds_to_fully_setup_b_machine/2]).
20 :- use_module(debug, [debug_println/2]).
21 :- use_module(bmachine, [b_get_machine_custom_nodes_function/2,b_get_machine_custom_edges_function/2]).
22
23 state_custom_dot_graph_available :-
24 b_get_machine_custom_nodes_function(_,_),
25 b_get_machine_custom_edges_function(_,_).
26
27 tcltk_generate_state_custom_dot_graph(File) :-
28 current_expression(_CurID,State),
29 state_corresponds_to_fully_setup_b_machine(State,BState),!,
30 (b_get_machine_custom_nodes_function(_,_)
31 -> true
32 ; add_error_and_fail(tcltk_generate_state_custom_dot_graph,'No CUSTOM_GRAPH_NODES Function in DEFINITIONS')),
33 (b_get_machine_custom_edges_function(_,_)
34 -> true
35 ; add_error_and_fail(tcltk_generate_state_custom_dot_graph,'No CUSTOM_GRAPH_EDGES Function in DEFINITIONS')),
36 retractall(custom_nodes(_,_,_)),
37 retractall(custom_edges(_,_,_)),
38 retractall(custom_node_id(_,_)), retractall(nodectr(_)),
39 retractall(custom_trans_label(_,_)), retractall(trans_ctr(_)), assert(trans_ctr(1)),
40 eval_defs(BState),
41 gen_dot_graph(File,state_custom_dot_graph,node_predicate,trans_predicate,none,none),
42 print(finished),nl.
43 tcltk_generate_state_custom_dot_graph(_) :-
44 add_error_and_fail(tcltk_generate_state_custom_dot_graph,'Only possible for initialised B machine.').
45
46
47 eval_defs(BState) :-
48 b_get_machine_custom_nodes_function(NodesFunction,Nr),
49 eval_definition_fun(NodesFunction, BState, NodesRes),
50 debug_println(19,custom_nodes(Nr,NodesRes)),
51 (get_texpr_id(NodesFunction,EFID)
52 -> assert(custom_nodes(EFID,Nr,NodesRes))
53 ; number_codes(Nr,NC), append("custom",NC,CC), atom_codes(Custom,CC),
54 assert(custom_nodes(Custom,Nr,NodesRes))),
55 fail.
56 eval_defs(BState) :-
57 b_get_machine_custom_edges_function(EdgesFunction,Nr),
58 eval_definition_fun(EdgesFunction, BState, EdgesRes),
59 debug_println(19,custom_edges(Nr,EdgesRes)),
60 (get_texpr_id(EdgesFunction,Label) -> true
61 ; b_get_machine_custom_edges_function(_,Nr2), Nr2 \= Nr % other relation exists; makes sense to use label
62 -> number_codes(Nr,NC), append("custom",NC,CC),
63 atom_codes(Label,CC)
64 ; otherwise -> Label=''
65 ),
66 assert(custom_edges(Label,Nr,EdgesRes)),
67 fail.
68 eval_defs(_).
69
70 :- dynamic custom_nodes/3, custom_edges/3.
71
72
73 :- use_module(tools,[string_escape/2]).
74 :- public node_predicate/6.
75 node_predicate(NodeID,SubGraph,NodeDesc,Shape,Style,Color) :- SubGraph=none,
76 custom_nodes(_ID,_Nr,Nodes),
77 (var(Nodes) -> add_error(node_predicate,'Variable custom_nodes: ',Nodes),fail ; true),
78 get_node_and_colour(Nodes,NodeVal,ColVal,Shape,Style),
79 (translate_value_and_escape(NodeVal,NodeDesc) -> true ; NodeDesc = '???'),
80 translate_bvalue_to_colour(ColVal,Color),
81 %tools:print_message(node(NodeVal,ColVal,Color,NodeID)),
82 gen_id(NodeVal,NodeID). %tools:print_message(nodeid(NodeID)).
83
84 get_node_and_colour(CustomNodes,NodeVal,ColVal,Shape,Style) :-
85 member(Node,CustomNodes),
86 deconstruct_node(Node,NodeVal,ColVal,Shape,Style).
87
88 deconstruct_node(((NodeVal,ShapeVal),ColVal),ResNodeVal,ResColVal,Shape,Style) :-
89 valid_dot_shape(ShapeVal,Shape),
90 !, % we have a triple (Node,"box","colour") = ((Node,"box"),"colour")
91 ResNodeVal=NodeVal,ResColVal=ColVal, Style=filled.
92 deconstruct_node((NodeVal,ColVal),ResNodeVal,ResColVal,Shape,Style) :- !, % we have a pair (Node,"colour")
93 ResNodeVal=NodeVal, ResColVal=ColVal, Shape=box, Style=filled.
94 deconstruct_node(NodeVal,NodeVal,NodeVal,box,filled).
95
96 :- use_module(preferences, [is_of_type/2]).
97 valid_dot_shape(string(Str),Str) :- is_of_type(Str,dot_shape).
98 % triangle,ellipse,box,diamond,hexagon,octagon,house,invtriangle,invhouse,invtrapez,doubleoctagon,egg,parallelogram,pentagon,trapezium...
99
100 :- dynamic custom_node_id/2, nodectr/1.
101 nodectr(0).
102
103 get_ctr(Res) :- retract(nodectr(C)),!, C1 is C+1, assert(nodectr(C1)), Res=C.
104 get_ctr(0) :- assert(nodectr(1)).
105
106 % generate or lookup ID for node
107 gen_id(NodeVal,ID) :-
108 (custom_node_id(NodeVal,ID) -> true
109 ; get_ctr(C),
110 assert(custom_node_id(NodeVal,C)),ID=C).
111
112 % lookup ID and generate message if it does not exist
113 lookup_id(NodeVal,ID) :-
114 (custom_node_id(NodeVal,ID) -> true
115 ; format(user_error,'Node not specified in CUSTOM_GRAPH_NODES: ~w~n',[NodeVal]),
116 gen_id(NodeVal,ID)
117 ).
118
119 :- dynamic custom_trans_label/2, trans_ctr/1.
120 trans_ctr(1).
121 gen_trans_color(Label,Col,IsColor) :- custom_trans_label(Label,C),!,Col=C,IsColor=false.
122 gen_trans_color(Label,Col,IsColor) :- try_translate_bvalue_to_colour(Label,C),!,Col=C,IsColor=true.
123 gen_trans_color(Label,Col,IsColor) :- retract(trans_ctr(Ctr)), C1 is Ctr+1, assert(trans_ctr(C1)),
124 translate_bvalue_to_colour(int(Ctr),C),
125 assert(custom_trans_label(Label,C)), Col=C,IsColor=false.
126
127
128 :- public trans_predicate/5.
129 trans_predicate(NodeID,Label,SuccID,Color,Style) :-
130 custom_edges(DefaultLabel,_,Edges),
131 (var(Edges) -> add_error(trans_predicate,'Variable custom_edges: ',Edges),fail ; true),
132 member((From,To),Edges),
133 trans_pred_aux(From,DefaultLabel,To,NodeID,SuccID,Label,Color,Style).
134
135 % we have a transition where the colour is specified (e.g., CUSTOM_GRAPH_EDGES == {n1,col,n2 | ... }
136 % we assume trans_predicate has been called first
137 trans_pred_aux(FromValue,_DefaultLabel,To,NodeID,SuccID,ELabel,Color,solid) :-
138 get_trans_label_and_color(FromValue,From,Color,ELabel), % the From Value contains color and label
139 !,
140 lookup_id(From,NodeID),
141 lookup_id(To,SuccID).
142 trans_pred_aux(From,_DefaultLabel,(LabelVal,ToVal),NodeID,SuccID,ELabel,Color,solid) :-
143 get_trans_label_and_color((ToVal,LabelVal),To,Color,ELabel), % the To Value contains color and label
144 !,
145 lookup_id(From,NodeID),
146 lookup_id(To,SuccID).
147 trans_pred_aux(From,DefaultLabel,To,NodeID,SuccID,Label,blue,solid) :- Label=DefaultLabel,
148 % no label or color specified in transition pair
149 lookup_id(From,NodeID),
150 lookup_id(To,SuccID).
151
152 % try and decompose a from value, detecting color and label string ((From,"label"),"color")
153 get_trans_label_and_color((FromVal,LabelVal),From,Color,ELabel) :-
154 gen_trans_color(LabelVal,Color,IsColor),
155 (IsColor
156 -> get_trans_label(FromVal,From,ELabel)
157 ; translate_value_and_escape(LabelVal,ELabel),
158 From=FromVal
159 ).
160
161 get_trans_label((From,string(LabelVal)),From,ELabel) :- string_escape(LabelVal,ELabel).
162 get_trans_label(From,From,''). % or should we use DefaultLabel
163
164 translate_value_and_escape(string(S),ELabel) :- !, string_escape(S,ELabel).
165 translate_value_and_escape(LabelVal,ELabel) :-
166 translate:translate_bvalue(LabelVal,Label),string_escape(Label,ELabel).
167
168 :- use_module(b_interpreter,[b_compute_expression_nowf/4]).
169 :- use_module(custom_explicit_sets,[try_expand_custom_set/2]).
170
171 eval_definition_fun(AnimFunction,BState, FunctionRes) :- %trace,
172 b_compute_expression_nowf(AnimFunction,[],BState,FunctionResCl),
173 %nl, print('FunctionResult'(FunctionResCl)),nl,
174 try_expand_custom_set(FunctionResCl, FunctionRes).