34
35:- module(swish_render_graphviz,
36 [ term_rendering//3, 37 render_dot//3, 38 svg//2 39 ]). 40:- use_module(library(http/html_write)). 41:- use_module(library(http/js_write)). 42:- use_module(library(http/http_dispatch)). 43:- use_module(library(http/http_parameters)). 44:- use_module(library(http/http_path)). 45:- use_module(library(process)). 46:- use_module(library(sgml)). 47:- use_module(library(debug)). 48:- use_module(library(error)). 49:- use_module(library(option)). 50:- use_module(library(lists)). 51:- use_module(library(apply)). 52:- use_module(library(dcg/basics)). 53:- use_module('../render'). 54
55:- register_renderer(graphviz, "Render data using graphviz"). 56
94
95:- http_handler(swish(graphviz), swish_send_graphviz, []). 96
97:- dynamic
98 dot_data/3. 99
107
108term_rendering(Data, Vars, Options) -->
109 { debug(graphviz(vars), 'Data: ~q, vars: ~p', [Data, Vars]),
110 data_to_graphviz_string(Data, DOTString, Program),
111 ( debugging(graphviz(save_dot(File)))
112 -> setup_call_cleanup(
113 open(File, write, Out, [encoding(utf8)]),
114 write(Out, DOTString),
115 close(Out))
116 ; true
117 )
118 },
119 render_dot(DOTString, Program, Options).
120
126
127render_dot(_DOTString, Program, _Options) -->
128 { \+ has_graphviz_renderer(Program) }, !,
129 no_graph_viz(Program).
130render_dot(DOTString, Program, Options) --> 131 { option(svg(object), Options, inline), !,
132 variant_sha1(DOTString, Hash),
133 get_time(Now),
134 assert(dot_data(Hash,
135 _{ program: Program,
136 dot: DOTString
137 }, Now)),
138 remove_old_data(Now),
139 http_link_to_id(swish_send_graphviz,
140 [ hash(Hash),
141 lang(svg),
142 target('_top')
143 ], HREF),
144 Attrs = [] 145 }, !,
146 html([ object([ data(HREF),
147 type('image/svg+xml')
148 | Attrs
149 ],
150 [])
151 ]).
152render_dot(DOTString, Program, _Options) --> 153 { graphviz_stream(_{program:Program, dot:DOTString},
154 PID, XDotOut, ErrorOut),
155 call_cleanup(( read_string(XDotOut, _, SVG),
156 read_string(ErrorOut, _, Error)
157 ),
158 ( process_wait_0(PID),
159 close(ErrorOut, [force(true)]),
160 close(XDotOut)
161 ))
162 },
163 ( { Error == "" }
164 -> html(div([ class(['render-graphviz', 'reactive-size']),
165 'data-render'('As Graphviz graph')
166 ],
167 \svg(SVG, [])))
168 ; html(div(style('color:red;'),
169 [ '~w'-[Program], ': ', Error]))
170 ).
171
172process_wait_0(PID) :-
173 process_wait(PID, Status),
174 ( Status == exit(0)
175 -> true
176 ; print_message(error, format('Process ~q died on ~q', [PID, Status]))
177 ).
178
183
184svg(SVG0, _Options) -->
185 { fix_svg(SVG0, SVG) },
186 html([ \[SVG],
187 \js_script({|javascript||
188(function() {
189 if ( $.ajaxScript ) {
190 var div = $.ajaxScript.parent();
191 var svg = div.find("svg");
192 var data = { w0: svg.width(),
193 h0: svg.height()
194 };
195 var pan;
196
197 function updateSize() {
198 var w = svg.closest("div.answer").innerWidth();
199
200 function reactive() {
201 if ( !data.reactive ) {
202 data.reactive = true;
203 div.on("reactive-resize", updateSize);
204 }
205 }
206
207 w = Math.max(w*0.85, 100);
208 if ( w < data.w0 ) {
209 svg.width(w);
210 svg.height(w = Math.max(w*data.h0/data.w0, w/4));
211 reactive();
212 if ( pan ) {
213 pan.resize();
214 pan.fit();
215 pan.center();
216 }
217 }
218 }
219
220 require(["svg-pan-zoom"], function(svgPanZoom) {
221 updateSize()
222 pan = svgPanZoom(svg[0], {
223 // controlIconsEnabled: true
224 minZoom: 0.1,
225 maxZoom: 50
226 });
227 });
228 }
229 })();
230 |})
231 ]).
232
233
234fix_svg(InS, OutS) :-
235 setup_call_cleanup(
236 open_string(InS, In),
237 load_xml(In, M,
238 [ max_errors(-1),
239 syntax_errors(quiet)
240 ]),
241 close(In)),
242 with_output_to(
243 string(OutS),
244 xml_write(current_output, M,
245 [ layout(false),
246 doctype('svg'),
247 public('-//W3C//DTD SVG 1.1//EN'),
248 system('http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd')
249 ])).
250
251
255
256data_to_graphviz_string(Compound, String, Program) :-
257 compound(Compound),
258 compound_name_arguments(Compound, Program, [Data]),
259 graphviz_program(Program),
260 ( atomic(Data)
261 -> String = Data
262 ; phrase(graph(Data), Codes),
263 string_codes(String, Codes),
264 debug(graphviz, '~s', [String])
265 ).
266data_to_graphviz_string(Compound, String, dot) :-
267 compound(Compound),
268 compound_name_arity(Compound, Type, Arity),
269 graph_type(Type),
270 between(1,2,Arity), !,
271 phrase(graph(Compound), Codes),
272 string_codes(String, Codes),
273 debug(graphviz, '~s', [String]).
274
275
276graphviz_program(dot).
277graphviz_program(neato).
278graphviz_program(fdp).
279graphviz_program(sfdp).
280graphviz_program(twopi).
281graphviz_program(circo).
282graphviz_program(osage).
283graphviz_program(patchwork).
284
285graph_type(graph).
286graph_type(digraph).
287
291
292swish_send_graphviz(Request) :-
293 http_parameters(Request,
294 [ hash(Hash,
295 [ description('Hash-key to the graph-data')
296 ])
297 ]),
298 dot_data(Hash, Data, _),
299 graphviz_stream(Data, PID, XDotOut, ErrorOut),
300 call_cleanup(( load_structure(stream(XDotOut),
301 SVGDom0,
302 [ dialect(xml) ]),
303 read_string(ErrorOut, _, Error)
304 ),
305 ( process_wait_0(PID),
306 close(ErrorOut, [force(true)]),
307 close(XDotOut)
308 )),
309 ( Error == ""
310 -> true
311 ; print_message(error, format('~w', [Error]))
312 ),
313 rewrite_svg_dom(SVGDom0, SVGDom),
314 format('Content-type: ~w~n~n', ['image/svg+xml; charset=UTF-8']),
315 xml_write(current_output, SVGDom,
316 [ layout(false)
317 ]).
318
319graphviz_stream(Data, PID, XDotOut, Error) :-
320 process_create(path(Data.program), ['-Tsvg'],
321 [ stdin(pipe(ToDOT)),
322 stdout(pipe(XDotOut)),
323 stderr(pipe(Error)),
324 process(PID)
325 ]),
326 set_stream(ToDOT, encoding(utf8)),
327 set_stream(XDotOut, encoding(utf8)),
328 thread_create(send_to_dot(Data.dot, ToDOT), _,
329 [ detached(true) ]).
330
331
332rewrite_svg_dom([element(svg, Attrs, Content)],
333 [element(svg, Attrs,
334 [ element(script, ['xlink:href'=SVGPan], []),
335 element(g, [ id=viewport
336 ],
337 Content)
338 ])]) :-
339 http_absolute_location(js('SVGPan.js'), SVGPan, []).
340rewrite_svg_dom(DOM, DOM).
341
342send_to_dot(Data, Out) :-
343 call_cleanup(format(Out, '~s', [Data]),
344 close(Out)), !.
345
349
350remove_old_data(Time) :-
351 ( dot_data(Hash, _, Stamp),
352 Time > Stamp+900,
353 retract(dot_data(Hash, _, Stamp)),
354 fail
355 ; true
356 ).
357
358has_graphviz_renderer(Renderer) :-
359 exe_options(ExeOptions),
360 absolute_file_name(path(Renderer), _,
361 [ file_errors(fail)
362 | ExeOptions
363 ]).
364
365exe_options(Options) :-
366 current_prolog_flag(windows, true), !,
367 Options = [ extensions(['',exe,com]), access(read) ].
368exe_options(Options) :-
369 Options = [ access(execute) ].
370
371no_graph_viz(Renderer) -->
372 html(div([ class('no-graph-viz'),
373 style('color:red;')
374 ],
375 [ 'The server does not have the graphviz program ',
376 code(Renderer), ' installed in PATH. ',
377 'See ', a(href('http://www.graphviz.org/'),
378 'http://www.graphviz.org/'), ' for details.'
379 ])).
380
381
383
384add_defaults(Statements0, Statements) :-
385 \+ memberchk(bgcolor=_, Statements0), !,
386 Statements = [bgcolor=transparent|Statements0].
387add_defaults(Statements, Statements).
388
389
390 393
394graph(graph(Statements)) -->
395 graph(graph([], Statements)).
396graph(digraph(Statements)) -->
397 graph(digraph([], Statements)).
398graph(graph(Options, Statements)) -->
399 {graph_options(Options, graph, Ctx)},
400 graph(Statements, Ctx).
401graph(digraph(Options, Statements)) -->
402 {graph_options(Options, digraph, Ctx)},
403 graph(Statements, Ctx).
404
405graph_options([], Type,
406 gv{type:Type, indent:2}).
407graph_options([strict], Type,
408 gv{strict:true, type:Type, indent:2}).
409graph_options([strict, ID], Type,
410 gv{strict:true, id:ID, type:Type, indent:2}).
411
412graph(Statements, Options) -->
413 { add_defaults(Statements, Statements1) },
414 strict(Options), keyword(Options.type), ws, graph_id(Options),
415 "{", nl,
416 statements(Statements1, Options),
417 "}", nl.
418
419strict(Options) -->
420 { true == Options.get(strict) }, !,
421 keyword(strict).
422strict(_Options) --> [].
423
424graph_id(Options) -->
425 { ID = Options.get(id) }, !,
426 id(ID), ws.
427graph_id(_) --> [].
428
429statements([], _) --> [].
430statements([H|T], Options) -->
431 indent(Options),
432 ( statement(H, Options)
433 -> ";", nl
434 ; {domain_error(graphviz_statement, H)}
435 ),
436 statements(T, Options).
437
438statement(graph(Attrs), O) --> keyword(graph), ws, attributes(Attrs, O).
439statement(edge(Attrs), O) --> keyword(edge), ws, attributes(Attrs, O).
440statement(node(Attrs), O) --> keyword(node), ws, attributes(Attrs, O).
441statement(node(ID, Attrs), O) --> node(ID, O), ws, attributes(Attrs, O).
442statement(edge(Edge, Attrs), O) --> edge(Edge, O), ws, attributes(Attrs, O).
443statement(A - B, O) --> edge(A - B, O).
444statement(A -> B, O) --> edge(A -> B, O).
445statement(Name = Value, O) --> attribute(Name=Value, O).
446statement(subgraph(Statements), O) -->
447 { step_indent(O, O1) },
448 keyword(subgraph), ws, "{", nl,
449 statements(Statements, O1), indent(O), "}".
450statement(subgraph(ID, Statements), O) -->
451 { step_indent(O, O1) },
452 keyword(subgraph), ws, id(ID), ws, "{", nl,
453 statements(Statements, O1), indent(O), "}".
454statement(group(Statements), O) -->
455 { step_indent(O, O1) },
456 "{", nl, statements(Statements, O1), indent(O), "}".
457statement(ID, O) -->
458 node(ID, O).
459
460step_indent(O, O2) :-
461 I is O.indent+2,
462 O2 = O.put(indent, I).
463
464edge((A-B)-C, O) --> !, edge(A-B, O), edgeop(O), id(C).
465edge(A-(B-C), O) --> !, node(A, O), edgeop(O), edge(B-C, O).
466edge(A-B, O) --> node(A, O), edgeop(O), node(B, O).
467edge((A->B)->C, O) --> !, edge(A->B, O), edgeop(O), node(C, O).
468edge(A->(B->C), O) --> !, node(A, O), edgeop(O), edge(B->C, O).
469edge(A->B, O) --> node(A, O), edgeop(O), node(B, O).
470
471edgeop(O) --> { graph == O.type }, !, " -- ".
472edgeop(_) --> " -> ".
473
474node(ID:Port:Compass, _O) --> !,
475 id(ID), ":", id(Port), ":", compass(Compass).
476node(ID:Port, _O) --> !,
477 id(ID), ":", id(Port).
478node(ID, _O) --> !,
479 id(ID).
480
481compass(Compass) -->
482 { compass(Compass) },
483 atom(Compass).
484compass(Compass) -->
485 { domain_error(compass, Compass) }.
486
487compass('_') :- !. 488compass(n).
489compass(ne).
490compass(e).
491compass(se).
492compass(s).
493compass(sw).
494compass(w).
495compass(nw).
496compass(c).
497
498attributes([], _) --> !.
499attributes(List, O) --> "[", attribute_list(List, O), "]".
500
501attribute_list([], _) --> [].
502attribute_list([H|T], O) -->
503 attribute(H, O),
504 ( {T == []}
505 -> []
506 ; ",", attribute_list(T, O)
507 ).
508
509attribute(Var, _) -->
510 { var(Var),
511 instantiation_error(Var)
512 }.
513attribute(html(Value), O) --> !,
514 attribute(label=html(Value), O).
515attribute(Name=html(Value), _, List, Tail) :-
516 atomic(Value), !,
517 format(codes(List,Tail), '~w=<~w>', [Name, Value]).
518attribute(Name=html(Term), _, List, Tail) :-
519 nonvar(Term), !,
520 phrase(html(Term), Tokens0),
521 delete(Tokens0, nl(_), Tokens),
522 with_output_to(string(HTML), print_html(Tokens)),
523 format(codes(List,Tail), '~w=<~w>', [Name, HTML]).
524attribute(Name=Value, _O) --> !,
525 atom(Name),"=",value(Name, Value).
526attribute(NameValue, _O) -->
527 {NameValue =.. [Name,Value]}, !,
528 atom(Name),"=",value(Name, Value).
529attribute(NameValue, _O) -->
530 { domain_error(graphviz_attribute, NameValue) }.
531
535
536value(Name, Value) -->
537 { string_attribute(Name), !,
538 value_codes(Value, Codes)
539 },
540 "\"", cstring(Codes), "\"".
541value(_Name, Number, List, Tail) :-
542 number(Number), !,
543 format(codes(List,Tail), '~w', [Number]).
544value(_Name, (A,B), List, Tail) :-
545 number(A), number(B), !,
546 format(codes(List,Tail), '"~w,~w"', [A, B]).
547value(_Name, Value, List, Tail) :-
548 is_graphviz_id(Value), !,
549 format(codes(List,Tail), '~w', [Value]).
550value(_Name, Value) -->
551 { value_codes(Value, Codes)
552 },
553 "\"", cstring(Codes), "\"".
554
555id(ID) --> { number(ID) }, !, number(ID).
556id(ID) --> { atom(ID), !, atom_codes(ID, Codes) }, "\"", cstring(Codes), "\"".
557id(ID) --> { string(ID), !, string_codes(ID, Codes) }, "\"", cstring(Codes), "\"".
558id(ID) --> { format(codes(Codes), '~p', [ID]) }, "\"", cstring(Codes), "\"".
559
560keyword(Kwd) --> atom(Kwd).
561indent(Options) -->
562 { Level = Options.indent },
563 spaces(Level).
564ws --> " ".
565nl --> "\n".
566
567spaces(0) --> !.
568spaces(N) -->
569 { succ(N2, N) },
570 " ",
571 spaces(N2).
572
573value_codes(Value, Codes) :-
574 atomic(Value), !,
575 format(codes(Codes), '~w', [Value]).
576value_codes(Value, Codes) :-
577 format(codes(Codes), '~p', [Value]).
578
583
584is_graphviz_id(Atom) :-
585 ( atom(Atom)
586 -> true
587 ; string(Atom)
588 ),
589 atom_codes(Atom, Codes),
590 maplist(id_code, Codes),
591 Codes = [C0|_],
592 \+ between(0'0, 0'9, C0).
593
594id_code(C) :- between(0'a, 0'z, C).
595id_code(C) :- between(0'A, 0'Z, C).
596id_code(C) :- between(0'0, 0'9, C).
597id_code(C) :- between(0'_, 0'_, C).
598id_code(C) :- between(8'200, 8'377, C).
599
600
601 604
608
609string_attribute(label).
610string_attribute(xlabel).
611string_attribute(tooltip).
612string_attribute(headtooltip).
613string_attribute(tailtooltip).
614string_attribute(labeltooltip).
615string_attribute(url).
616string_attribute(href).
617string_attribute(id).
618string_attribute('URL').
619string_attribute(fillcolor).
620string_attribute(fontcolor).
621string_attribute(color).
622string_attribute(fontname).
623string_attribute(style).
624string_attribute(size).
625
632
633gv_attr(align, table, oneof([center,left,right])).
634gv_attr(bgcolor, table, atom).
635gv_attr(border, table, atom).
636gv_attr(cellborder, table, atom).
637gv_attr(cellpadding, table, atom).
638gv_attr(cellspacing, table, atom).
639gv_attr(color, table, atom).
640gv_attr(fixedsize, table, boolean).
641gv_attr(height, table, atom).
642gv_attr(href, table, atom).
643gv_attr(port, table, atom).
644gv_attr(target, table, atom).
645gv_attr(title, table, atom).
646gv_attr(tooltip, table, atom).
647gv_attr(valign, table, oneof([middle,bottom,top])).
648gv_attr(width, table, atom).
649
650gv_attr(align, td, oneof([center,left,right,text])).
651gv_attr(balign, td, oneof([center,left,right])).
652gv_attr(bgcolor, td, atom).
653gv_attr(border, td, atom).
654gv_attr(cellpadding, td, atom).
655gv_attr(cellspacing, td, atom).
656gv_attr(color, td, atom).
657gv_attr(colspan, td, integer).
658gv_attr(fixedsize, td, boolean).
659gv_attr(height, td, atom).
660gv_attr(href, td, atom).
661gv_attr(port, td, atom).
662gv_attr(rowspan, td, integer).
663gv_attr(target, td, atom).
664gv_attr(title, td, atom).
665gv_attr(tooltip, td, atom).
666gv_attr(valign, td, oneof([middle,bottom,top])).
667gv_attr(width, td, atom).
668
669gv_attr(color, font, atom).
670gv_attr(face, font, atom).
671gv_attr('point-size', font, integer).
672
673gv_attr(align, br, oneof([center,left,right])).
674
675gv_attr(scale, img, oneof([false,true,width,height,both])).
676gv_attr(src, img, atom).
677
678
682
683cstring([]) -->
684 [].
685cstring([H|T]) -->
686 ( cchar(H)
687 -> []
688 ; [H]
689 ),
690 cstring(T).
691
692cchar(0'") --> "\\\"".
693cchar(0'\n) --> "\\n".
694cchar(0'\t) --> "\\t".
695cchar(0'\b) --> "\\b"