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). |