1%
    2% Graphical display of graphs 
    3%
    4% Use:
    5%   display_graph(Graph), where Graph=[arc(v1,v2),...,arc(vn-1,vn)]
    6%
    7% Examples:
    8%   ?- findall(arc(X,Y),(wn_hypernyms(man,List),append(_,[X,Y|_],List)),Graph), display_graph(Graph).
    9%   ?- setof(arc(X,Y),List^H^T^(wn_hypernyms(man,List),append(H,[X,Y|T],List)),Graph), display_graph(Graph).
   10
   11% Requires:
   12% - PDF displayer (as indicated in pdf_displayer/1 fact and accesible in the path).
   13% - dot (part of Graphviz, accesible in the path)
   14% - dot2tex (for generating a LaTeX version of the graph). If LaTeX output is enabled (disabled by default)
   15
   16:- module(wn_display_graph,
   17	  [ display_graph/1
   18	  ]).
   19
   20%%% 'PDFViewer' is a user defined environment variable that must be exported to
   21%%% be accesible by the son process that executes SWI-Prolog. It stores the command
   22%%% to launch the specific PDF viewer of the operating system we are using.
   23pdf_displayer(PDFViewer) :-
   24    getenv('PDFViewer', PDFViewer),
   25    !
   25.
   26
   27pdf_displayer('open -a Preview') :-
   28    current_prolog_flag(apple, true), % MacOS system
   29    !.
   30
   31pdf_displayer('xpdf') :-
   32    current_prolog_flag(unix, true), % Linux system
   33    !.
   34
   35pdf_displayer('acrobat.exe /A "view=Fit"') :-
   36    current_prolog_flag(windows, true), % Windows system
   37    !.
   38
   39:- if((getenv('OSTYPE',OSystem), OSystem = darwin16)).
   41    pdf_displayer('open -a Preview').
   42:- elif((getenv('OSTYPE',OSystem), OSystem = linux-gnu)).
   44    pdf_displayer('xpdf').
   45:- else.
   47    pdf_displayer('acrobat.exe /A "view=Fit"').
   48:- endif.   49
   50% display_graph(+Graph)
   51%   Graph is a list of arc(From,To)
   52%   Displays a PDF containing the graphical representation of Graph
   53%   Creates the files:
   54%   - out.dot: A file with the graph in DOT format (graph description language) 
   55%   - out.pdf: The PDF document with the graph representation
   56%   - out.tex: The LaTeX document with the graph representation. Disabled for now (just uncomment it below for enabling)
   57display_graph(Graph) :-
   58	open('out.dot', write, Handle),
   59	write(Handle, 'digraph G { size="1,1";'), 
   60	nl(Handle),
   61  write_arcs(Handle, Graph),
   62	write(Handle,'}'),
   63	close(Handle),
   64  % shell('dot2tex out.dot > out.tex'),
   65	display_dot_in_pdf.
   66
   67display_dot_in_pdf :-
   68	(write('Displaying graph...'),
   69	 nl,
   70	 shell('dot out.dot -Tpdf -o out.pdf'),
   71	 pdf_displayer(PDFViewer),
   72	 atom_concat(PDFViewer, ' out.pdf', PDFViewerCommand),
   74     (shell(PDFViewerCommand) -> true
   75        ; write('ERROR: Cannot start PDF viewer. Check the environment variable PDFViewer')
   76     ),
   77	 !
   78	 ;
   79	 write('ERROR: Cannot generate PDF output file. Check that the dot program is accesible')
   80    )
   80.
   81
   82write_arcs(_Handle,[]).
   83write_arcs(Handle,[arc(A,B)|R]):-
   84	write(Handle,A), 
   85	write(Handle,' -> '), 
   86	write(Handle,B), 
   87	write(Handle,';'), 
   88	nl(Handle), 
   89	write_arcs(Handle,R)