| 1 | % (c) 2009-2024 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/3, gen_dot_graph/5, gen_dot_graph/6, | |
| 6 | dot_no_same_rank/1, dot_no_subgraph/3, | |
| 7 | print_graph_header/1,print_graph_footer/0, | |
| 8 | use_new_dot_attr_pred/7, % annotation for new-style dot predicate | |
| 9 | get_dot_cluster_name/2, | |
| 10 | translate_bvalue_to_colour/2, try_translate_bvalue_to_colour/2, | |
| 11 | translate_int_col/2]). | |
| 12 | ||
| 13 | :- meta_predicate(gen_dot_graph(*,6,5)). | |
| 14 | :- meta_predicate(gen_dot_graph(*,6,5,1,3)). | |
| 15 | :- meta_predicate(gen_dot_graph(*,*,6,5,1,3)). | |
| 16 | :- meta_predicate(node_id(6,*)). | |
| 17 | :- meta_predicate(node_predicate_call(6,*,*,*)). | |
| 18 | :- meta_predicate(trans_predicate_call(:,*,*,*,*,*)). % adds 3 or 5 args | |
| 19 | :- meta_predicate(merged_call5(5,*,*,*,*,*)). % adds 5 args | |
| 20 | :- meta_predicate(same_rank_call(1,*)). | |
| 21 | :- meta_predicate(subgraph_call(3,*,*,*,*,*)). | |
| 22 | :- meta_predicate(fgen_dot_graph(*,*,6,5,1,3)). | |
| 23 | :- meta_predicate(print_nodes(*,6,3)). | |
| 24 | :- meta_predicate(print_nodes2(*,*,6)). | |
| 25 | :- meta_predicate(print_transitions(*,*,*,5)). | |
| 26 | ||
| 27 | :- use_module(probsrc(module_information)). | |
| 28 | :- module_info(group,dot). | |
| 29 | :- module_info(description,'This a few tools for generating dot graphs.'). | |
| 30 | ||
| 31 | :- use_module(library(lists)). | |
| 32 | :- use_module(probsrc(preferences)). | |
| 33 | ||
| 34 | :- use_module(probsrc(debug)). | |
| 35 | :- use_module(probsrc(self_check)). | |
| 36 | :- use_module(probsrc(error_manager),[add_internal_error/2, add_message/3]). | |
| 37 | ||
| 38 | /* --------------------------------------------------- */ | |
| 39 | /* MAIN ENTRY POINTS FOR TCL */ | |
| 40 | /* --------------------------------------------------- */ | |
| 41 | ||
| 42 | gen_dot_graph(F,NodePredicate,TransPredicate) :- | |
| 43 | gen_dot_graph(F,NodePredicate,TransPredicate,dot_no_same_rank,dot_no_subgraph). | |
| 44 | gen_dot_graph(F,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
| 45 | gen_dot_graph(F,[],NodePredicate,TransPredicate,SameRankPred,SubGraphPred). | |
| 46 | ||
| 47 | gen_dot_graph(F,GraphAttrs,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
| 48 | formatsilent('% Generating Dot File: ~w~n',[F]), | |
| 49 | reset_ids, | |
| 50 | (get_preference(dot_horizontal_layout,true), | |
| 51 | \+ has_attribute(rankdir,_,GraphAttrs) -> Opts0 = [rankdir/'LR'|GraphAttrs] ; Opts0 = GraphAttrs), | |
| 52 | (select(no_page_size,Opts0,Opts) -> true | |
| 53 | ; get_preference(dot_with_page_size,true), | |
| 54 | \+ has_attribute(page,_,GraphAttrs), | |
| 55 | \+ has_attribute(size,_,GraphAttrs) | |
| 56 | -> Opts = [with_page_size|Opts0] | |
| 57 | ; Opts = Opts0), | |
| 58 | open(F,write,FStream,[encoding(utf8)]), | |
| 59 | (fgen_dot_graph(FStream,Opts,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) -> true ; true), | |
| 60 | close(FStream), | |
| 61 | formatsilent('% Done~n',[]). | |
| 62 | ||
| 63 | ||
| 64 | % Placeholder predicates for when caller doesn't need SameRankPred and/or SubGraphPred | |
| 65 | dot_no_same_rank(_) :- fail. | |
| 66 | dot_no_subgraph(_, _, _) :- fail. | |
| 67 | ||
| 68 | ||
| 69 | node_id(P,TNodeID) :- | |
| 70 | call(P,NodeID,_,_,_,_,_), | |
| 71 | translate_id(NodeID,TNodeID). | |
| 72 | ||
| 73 | node_predicate_call(Pred,TNodeID,SubGraph,Attributes) :- | |
| 74 | get_new_style_node_pred(Pred,NodePredicate),!, | |
| 75 | call(NodePredicate,NodeID,SubGraph,Attributes), % new style has only 3 arguments with flexible attribute list | |
| 76 | translate_id(NodeID,TNodeID). | |
| 77 | node_predicate_call(NodePredicate,TNodeID,SubGraph,[shape/Shape|Attrs]) :- | |
| 78 | call(NodePredicate,NodeID,SubGraph,NodeDesc,Shape,Style,Color), % has 6 arguments | |
| 79 | translate_id(NodeID,TNodeID), | |
| 80 | (Style = none -> Attrs = Attrs2 ; Attrs = [style/Style|Attrs2]), | |
| 81 | (Color = none -> Attrs2 = Attrs3 ; Attrs2 = [color/Color|Attrs3]), | |
| 82 | %preference(dot_print_node_ids,true) -> we are not interested in internal ids of this module, are we?? | |
| 83 | Attrs3 = [label/NodeDesc]. | |
| 84 | ||
| 85 | get_new_style_node_pred(use_new_dot_attr_pred(NodePredicate),NodePredicate). | |
| 86 | get_new_style_node_pred(_:use_new_dot_attr_pred(NodePredicate),NodePredicate). | |
| 87 | ||
| 88 | % convert a new style Node Predicate which returns a flexible list of attributes | |
| 89 | % dummy call: real conversion is done in node_predicate_call | |
| 90 | use_new_dot_attr_pred(NodePredicate,NodeID,SubGraph,none,none,none,none) :- | |
| 91 | call(NodePredicate,NodeID,SubGraph,_Attributes). | |
| 92 | ||
| 93 | ||
| 94 | % ------- | |
| 95 | ||
| 96 | trans_predicate_call(Pred,_Opts,TNodeID,TSuccNodeID,Style,Attrs2) :- | |
| 97 | get_new_style_node_pred(Pred,NodePredicate),!, | |
| 98 | call(NodePredicate,NodeID,SuccNodeID,Attrs), % new style has only 3 arguments with flexible attribute list | |
| 99 | % TODO: allow to merge_transitions with same Attrs except label | |
| 100 | (select_attribute(style,Style,Attrs,Attrs2) -> true ; Style=solid,Attrs2=Attrs), | |
| 101 | translate_id_for_transition(NodeID,TNodeID), | |
| 102 | translate_id_for_transition(SuccNodeID,TSuccNodeID). | |
| 103 | trans_predicate_call(P,Opts,TNodeID,TSuccNodeID,Style,[color/Color,label/Label]) :- | |
| 104 | (has_attribute(merge_transitions,true,Opts) | |
| 105 | -> merged_call5(P,NodeID,Label,SuccNodeID,Color,Style) | |
| 106 | ; call(P,NodeID,Label,SuccNodeID,Color,Style) | |
| 107 | ), | |
| 108 | translate_id_for_transition(NodeID,TNodeID), | |
| 109 | translate_id_for_transition(SuccNodeID,TSuccNodeID). | |
| 110 | ||
| 111 | :- use_module(probsrc(tools_strings),[ajoin_with_sep/3]). | |
| 112 | :- use_module(probsrc(tools_meta),[setof4/4]). | |
| 113 | % merge all labels with the same origin, destination, color and style | |
| 114 | merged_call5(P,NodeID,Label,SuccNodeID,Color,Style) :- | |
| 115 | % we use setof4 rather than setof, because test 1033 fails on Intel platforms due to different order of sols | |
| 116 | setof4(Lbl,[NodeID,SuccNodeID,Color,Style],call(P,NodeID,Lbl,SuccNodeID,Color,Style), Labels), | |
| 117 | ajoin_with_sep(Labels,',',Label). | |
| 118 | ||
| 119 | ||
| 120 | same_rank_call(_:dot_no_same_rank,_) :- !,fail. | |
| 121 | same_rank_call(P,TNodes) :- | |
| 122 | call(P,Nodes), | |
| 123 | Nodes \= [], % empty list provides no information | |
| 124 | maplist(translate_id,Nodes,TNodes). | |
| 125 | /* should succeed once for every set of NodeIDs which should be of same rank */ | |
| 126 | ||
| 127 | % should succeed once for every subgraph and generate a subgraphID which is passed to the node predicate | |
| 128 | subgraph_call(_:dot_no_subgraph,_,_,_,_,_) :- !, fail. | |
| 129 | subgraph_call(P,SubGraphID,Style,Color,Label,OtherAttrs) :- | |
| 130 | call(P,ID,Style,Color), | |
| 131 | extract_new_attrs(ID,SubGraphID,Attrs), | |
| 132 | (select_attribute(label,Label,Attrs,OtherAttrs) -> true | |
| 133 | ; OtherAttrs=Attrs, Label=SubGraphID). | |
| 134 | /* Notes: SubGraphID: should be none if not in a subgraph; Style and Color can be none */ | |
| 135 | ||
| 136 | extract_new_attrs(sub_graph_with_attributes(ID,Attrs),SubGraphID,OtherAttrs) :- | |
| 137 | !, % new style subgraph predicate: additional info | |
| 138 | SubGraphID=ID, OtherAttrs=Attrs. | |
| 139 | extract_new_attrs(ID,ID,[]). % old style subgraph predicate: ID is just an atom | |
| 140 | ||
| 141 | :- dynamic stored_id/2, additional_id/2. | |
| 142 | :- dynamic next_id/1. | |
| 143 | next_id(0). | |
| 144 | ||
| 145 | reset_ids :- | |
| 146 | retractall(stored_id(_,_)), retractall(next_id(_)), | |
| 147 | retractall(additional_id(_,_)), | |
| 148 | assertz(next_id(0)). | |
| 149 | ||
| 150 | % translate ids to atoms; ensure that dot can deal with them | |
| 151 | translate_id(ID,TransID) :- | |
| 152 | (number(ID) -> TransID=ID | |
| 153 | ; var(ID) -> add_internal_error('Illegal variable identifier for dot:',translate_id(ID,TransID)), | |
| 154 | TransID is -1 | |
| 155 | ; stored_id(ID,SID) -> TransID=SID | |
| 156 | ; gen_new_node_id(NewAtom), | |
| 157 | assertz(stored_id(ID,NewAtom)), | |
| 158 | TransID = NewAtom | |
| 159 | ). | |
| 160 | ||
| 161 | gen_new_node_id(NewAtom) :- | |
| 162 | retract(next_id(NextId)), N1 is NextId+1, | |
| 163 | assertz(next_id(N1)), | |
| 164 | number_codes(NextId,NC), | |
| 165 | append("dot_node_",NC,AC), atom_codes(NewAtom,AC). | |
| 166 | ||
| 167 | % called in transition creation: we can no longer add new nodes: | |
| 168 | translate_id_for_transition(ID,TransID) :- | |
| 169 | (number(ID) -> TransID=ID | |
| 170 | ; var(ID) -> add_internal_error('Illegal variable identifier for dot:',translate_id(ID,TransID)), | |
| 171 | TransID is -1 | |
| 172 | ; stored_id(ID,SID) -> TransID=SID | |
| 173 | ; add_message(dot_graph_generator,'Unknown node: ',ID), | |
| 174 | gen_new_node_id(NewAtom), | |
| 175 | assertz(stored_id(ID,NewAtom)), | |
| 176 | assertz(additional_id(NewAtom,ID)), | |
| 177 | TransID=NewAtom | |
| 178 | ). | |
| 179 | ||
| 180 | print_additional_nodes(FStream) :- | |
| 181 | additional_id(DotAtom,OriginalID), | |
| 182 | format(FStream,' ~w [label="~w"];~n',[DotAtom,OriginalID]), | |
| 183 | fail. | |
| 184 | print_additional_nodes(_). | |
| 185 | ||
| 186 | /* ---------------------------------------------------------------------- */ | |
| 187 | ||
| 188 | ||
| 189 | fgen_dot_graph(FStream,GraphAttrs,NodePredicate,TransPredicate,SameRankPred,SubGraphPred) :- | |
| 190 | print_graph_header(FStream,prob_graph,GraphAttrs), | |
| 191 | (node_id(NodePredicate,_) -> true | |
| 192 | ; (format(user_error,"No nodes in gen_dot_graph: ~w, ~w, ~w, ~w.~n~n", | |
| 193 | [NodePredicate,TransPredicate,SameRankPred,SubGraphPred]),fail)), | |
| 194 | print_nodes(FStream,NodePredicate,SubGraphPred), | |
| 195 | fail. | |
| 196 | fgen_dot_graph(FStream,_GraphAttrs,_NodePredicate,_TransPredicate,SameRankPred,_SubGraphPred) :- | |
| 197 | same_rank_call(SameRankPred,Nodes), | |
| 198 | print_same_ranks(FStream,Nodes), | |
| 199 | fail. | |
| 200 | fgen_dot_graph(FStream,GraphAttrs,_NodePredicate,TransPredicate,_SameRankPred,_SubGraphPred) :- | |
| 201 | print_transitions(FStream,_NodeID,GraphAttrs,TransPredicate), | |
| 202 | fail. | |
| 203 | fgen_dot_graph(FStream,_,_,_,_,_) :- | |
| 204 | print_additional_nodes(FStream), | |
| 205 | print_graph_footer(FStream). | |
| 206 | ||
| 207 | /* ---------------------------------------------------------------------- */ | |
| 208 | ||
| 209 | print_graph_header(Type) :- print_graph_header(user_output,Type,[with_page_size]). | |
| 210 | print_graph_header(FStream,Type,Opts) :- | |
| 211 | (select(with_page_size,Opts,Opts1) | |
| 212 | -> Opts2 = [page/'8.5, 11',ratio/fill,size/'7.5,10'|Opts1] | |
| 213 | ; Opts2=Opts), | |
| 214 | (select(directed/'FALSE',Opts2,Opts3) -> GRAPH = 'graph' | |
| 215 | ; Opts3=Opts2, GRAPH = 'digraph' % directed graph | |
| 216 | ), | |
| 217 | (select(strict/'TRUE',Opts3,Opts4) -> STRICT = 'strict ' | |
| 218 | ; Opts4=Opts3, STRICT = '' | |
| 219 | ), | |
| 220 | format(FStream,'~w~w ~w {~n graph [',[STRICT,GRAPH,Type]), | |
| 221 | % graph [AttrList] sets default attributes | |
| 222 | print_dot_attrs(Opts4,FStream), | |
| 223 | format(FStream,'];~n',[]). | |
| 224 | % print('graph [orientation=landscape, page="8.5, 11",ratio=fill,size="7.5,10"];'),nl, | |
| 225 | ||
| 226 | print_graph_footer :- print_graph_footer(user_output). | |
| 227 | print_graph_footer(FStream) :- format(FStream,'}~n',[]). | |
| 228 | ||
| 229 | is_undirected_graph(GraphAttrs) :- member(directed/FALSE,GraphAttrs),!, FALSE='FALSE'. | |
| 230 | ||
| 231 | /* ---------------------------------------------------------------------- */ | |
| 232 | ||
| 233 | :- use_module(probsrc(tools_strings),[ajoin/2]). | |
| 234 | % get the dot name of a logical cluster, also relevant or lhead/ltail edge attributes | |
| 235 | get_dot_cluster_name(SubGraphID,CN) :- ajoin(['cluster_',SubGraphID],CN). | |
| 236 | ||
| 237 | % write dot nodes to a stream | |
| 238 | print_nodes(FStream,NodePredicate,SubGraphPred) :- | |
| 239 | subgraph_call(SubGraphPred,SubGraphID,Style,Color,Label,OtherAttrs), | |
| 240 | get_dot_cluster_name(SubGraphID,CN), | |
| 241 | format(FStream,' subgraph "~w" {~n',[CN]), | |
| 242 | (Style = none -> true ; format(FStream,' style="~w";~n',[Style])), | |
| 243 | (Color = none -> true ; format(FStream,' color="~w";~n',[Color])), | |
| 244 | simple_dot_string_escape(Label,ESID), | |
| 245 | format(FStream,' label="~w";~n',[ESID]), | |
| 246 | write(FStream, ' '), | |
| 247 | print_dot_attrs1(OtherAttrs,';\n ',';\n ',FStream), | |
| 248 | print_nodes2(FStream,SubGraphID,NodePredicate), | |
| 249 | write(FStream,'}'),nl(FStream), | |
| 250 | fail. | |
| 251 | print_nodes(FStream,NodePredicate,_SubGraphPred) :- | |
| 252 | print_nodes2(FStream,none,NodePredicate), | |
| 253 | nl(FStream). | |
| 254 | ||
| 255 | % If SubGraph can either be none or an ID generated by the subgraph_call | |
| 256 | print_nodes2(FStream,SubGraph,NodePredicate) :- | |
| 257 | node_predicate_call(NodePredicate,NodeID,SubGraph,Attrs), | |
| 258 | print_node(FStream,NodeID,Attrs), | |
| 259 | fail. | |
| 260 | print_nodes2(FStream,_Subgraph,_) :- nl(FStream). | |
| 261 | ||
| 262 | % print an individual DOT node with attributes as list | |
| 263 | print_node(FStream,NodeID,Attributes) :- | |
| 264 | format(FStream,' ~w [',[NodeID]), | |
| 265 | get_preference(dot_node_font_size,FSize), | |
| 266 | opt_add_attribute(fontsize,FSize,Attributes,Attrs2), | |
| 267 | print_dot_attrs(Attrs2,FStream), | |
| 268 | format(FStream,'];~n',[]). | |
| 269 | ||
| 270 | :- use_module(probsrc(tools),[simple_dot_string_escape/2]). | |
| 271 | % print attributes of a node or edge | |
| 272 | print_dot_attrs(List,FStream) :- exclude(is_meta_attribute,List,List1), | |
| 273 | print_dot_attrs1(List1,', ','',FStream). | |
| 274 | print_dot_attrs1([],_,_,_FStream) :- !. | |
| 275 | print_dot_attrs1([H|T],Sep,Term,FStream) :- get_attribute(H,Attr,Val),!, | |
| 276 | simple_dot_string_escape(Val,EVal), | |
| 277 | (T=[] | |
| 278 | -> format(FStream,'~w="~w"~w',[Attr,EVal,Term]) | |
| 279 | ; no_need_to_quote(Val) | |
| 280 | -> format(FStream,'~w=~w~w',[Attr,EVal,Sep]), | |
| 281 | print_dot_attrs1(T,Sep,Term,FStream) | |
| 282 | ; format(FStream,'~w="~w"~w',[Attr,EVal,Sep]), | |
| 283 | print_dot_attrs1(T,Sep,Term,FStream)). | |
| 284 | print_dot_attrs1(Err,Separator,Terminator,_) :- | |
| 285 | add_internal_error('Could not print attr:',print_dot_attrs1(Err,Separator,Terminator)). | |
| 286 | ||
| 287 | get_attribute(Attr/Val,Attr,Val). | |
| 288 | get_attribute(Attr=Val,Attr,Val). | |
| 289 | ||
| 290 | ||
| 291 | no_need_to_quote(Val) :- number(Val). | |
| 292 | no_need_to_quote(record). % mainly for test 1033 | |
| 293 | ||
| 294 | has_attribute(Name,Val,Attrs) :- member(H,Attrs), get_attribute(H,Name,Val). | |
| 295 | select_attribute(Name,Val,Attrs,Rest) :- select(H,Attrs,Rest), get_attribute(H,Name,Val). | |
| 296 | ||
| 297 | is_meta_attribute(H) :- get_attribute(H,Name,_), | |
| 298 | meta_argument(Name). % attributed not meant for dot, just for controlling the dot graph generator | |
| 299 | ||
| 300 | meta_argument(deals_with_pref). | |
| 301 | meta_argument(merge_transitions). | |
| 302 | ||
| 303 | opt_add_attribute(Name,_,Attrs,NewAttrs) :- has_attribute(Name,_,Attrs),!, | |
| 304 | NewAttrs = Attrs. | |
| 305 | opt_add_attribute(Name,Val,Attrs,[Name/Val|Attrs]). | |
| 306 | ||
| 307 | % -------------------------- | |
| 308 | ||
| 309 | ||
| 310 | print_transitions(FStream,NodeID,GraphAttrs,TransPredicate) :- | |
| 311 | (is_undirected_graph(GraphAttrs) -> DotArrow = '--' ; DotArrow = '->'), | |
| 312 | trans_predicate_call(TransPredicate,GraphAttrs,NodeID,SuccID,Style,Attributes), | |
| 313 | ||
| 314 | (NodeID=root -> preference(dot_print_root,true) ; true), | |
| 315 | ||
| 316 | (NodeID \= SuccID -> true | |
| 317 | ; preference(dot_print_self_loops,true) -> true | |
| 318 | ; has_attribute(deals_with_pref,dot_print_self_loops,GraphAttrs) -> true % the command itself processes the pref. | |
| 319 | ), | |
| 320 | ||
| 321 | format(FStream,' ~w ~w ~w [',[NodeID,DotArrow,SuccID]), | |
| 322 | ||
| 323 | (get_preference(dot_edge_penwidth,PenSize),PenSize \= 1 | |
| 324 | -> opt_add_attribute(penwidth,PenSize,Attributes,Attrs1) | |
| 325 | ; Attrs1=Attributes | |
| 326 | ), | |
| 327 | get_preference(dot_edge_font_size,FSize), | |
| 328 | opt_add_attribute(fontsize,FSize,Attrs1,Attrs2), | |
| 329 | (preference(dot_print_arc_colors,false), | |
| 330 | select_attribute(color,_,Attrs2,Attrs3) | |
| 331 | -> true % remove color attribute | |
| 332 | ; Attrs3=Attrs2 | |
| 333 | ), | |
| 334 | % acceptable styles Style ::= solid, bold, dotted, dashed, invis, arrowhead(none,Style), arrowtail(none,Style) | |
| 335 | print_style(Style,FStream), | |
| 336 | ||
| 337 | print_dot_attrs(Attrs3,FStream), | |
| 338 | format(FStream,'];~n',[]), % Note: we may have a trailing comma; but dotty accepts it | |
| 339 | fail. | |
| 340 | print_transitions(FStream,_NodeID,_,_) :- nl(FStream). | |
| 341 | ||
| 342 | % style term from old-style transition predicates | |
| 343 | print_style(solid,_) :- !. | |
| 344 | print_style(arrowhead(AS,S),FStream) :- !, format(FStream,'arrowhead=~w,',[AS]), print_style(S,FStream). | |
| 345 | print_style(arrowtail(AS,S),FStream) :- !, format(FStream,'dir=both,arrowtail=~w,',[AS]), print_style(S,FStream). | |
| 346 | print_style(Style,FStream) :- format(FStream,'style="~w",',[Style]). | |
| 347 | ||
| 348 | print_same_ranks(_,[]) :- !, | |
| 349 | add_message(dot_graph_generator,'Empty same rank result',''). | |
| 350 | print_same_ranks(_,[ID]) :- !, | |
| 351 | add_message(dot_graph_generator,'Singleton same rank result: ',ID). | |
| 352 | print_same_ranks(FStream,L) :- | |
| 353 | write(FStream,' { rank=same; '), | |
| 354 | print_same_ranks2(FStream,L), | |
| 355 | write(FStream,' }'),nl(FStream). | |
| 356 | ||
| 357 | print_same_ranks2(_FStream,[]). | |
| 358 | print_same_ranks2(FStream,[H|T]) :- | |
| 359 | write(FStream,H), write(FStream,'; '), | |
| 360 | print_same_ranks2(FStream,T). | |
| 361 | ||
| 362 | ||
| 363 | % utilities for converting values into colours: | |
| 364 | ||
| 365 | ||
| 366 | ||
| 367 | translate_bvalue_to_colour(Val,Col) :- | |
| 368 | (try_translate_bvalue_to_colour(Val,C) -> Col=C; Col=lightgray). | |
| 369 | ||
| 370 | try_translate_bvalue_to_colour(int(X),Res) :- !, (translate_int_col(X,Colour) -> Res=Colour ; Res=black). | |
| 371 | try_translate_bvalue_to_colour(string(X),Colour) :- is_of_type(X,rgb_color),!, X=Colour. | |
| 372 | try_translate_bvalue_to_colour(fd(X,GS),Colour) :- !, translate_fd_col(X,GS,Colour). | |
| 373 | try_translate_bvalue_to_colour(pred_true,Colour) :- !, Colour=olivedrab2. | |
| 374 | try_translate_bvalue_to_colour(pred_false,Colour) :- !, Colour=tomato. | |
| 375 | try_translate_bvalue_to_colour((A,_),Colour) :- !, try_translate_bvalue_to_colour(A,Colour). | |
| 376 | ||
| 377 | % TO DO : add string conversions, rgb values , ... | |
| 378 | :- use_module(probsrc(b_global_sets),[is_b_global_constant_hash/3]). | |
| 379 | ||
| 380 | translate_fd_col(X,GS,Res) :- | |
| 381 | is_b_global_constant_hash(GS,X,Colour), | |
| 382 | is_of_type(Colour,rgb_color),!, | |
| 383 | Res=Colour. | |
| 384 | translate_fd_col(X,_,Res) :- number(X), translate_int_col(X,Colour),!, Res=Colour. | |
| 385 | translate_fd_col(_,_,lightgray). | |
| 386 | ||
| 387 | translate_int_col(-1,Colour) :- !,Colour=tomato. % special case | |
| 388 | translate_int_col(Int,Colour) :- | |
| 389 | Y is abs(Int) mod 15, translate_int_col_aux(Y,Colour). | |
| 390 | translate_int_col_aux(0,gray95). | |
| 391 | translate_int_col_aux(1,blue). | |
| 392 | translate_int_col_aux(2,red). | |
| 393 | translate_int_col_aux(3,green). | |
| 394 | translate_int_col_aux(4,lightgray). | |
| 395 | translate_int_col_aux(5,orange). | |
| 396 | translate_int_col_aux(6,yellow). | |
| 397 | translate_int_col_aux(7,brown). | |
| 398 | translate_int_col_aux(8,violet). | |
| 399 | translate_int_col_aux(9,tomato). | |
| 400 | translate_int_col_aux(10,darkslateblue). | |
| 401 | translate_int_col_aux(11,maroon2). | |
| 402 | translate_int_col_aux(12,olivedrab2). | |
| 403 | translate_int_col_aux(13,chartreuse3). | |
| 404 | translate_int_col_aux(14,grey20). | |
| 405 | % red,green,blue,yellow,orange,black,white,gray,brown,violet,darkred,tomato,darkblue, | |
| 406 | % 'DarkGray',darkviolet,darkslateblue,lightblue,lightgray,maroon2,olivedrab2, | |
| 407 | % steelblue,chartreuse3,chartreuse4 |