34
35:- module(swish_render_sldnf,
36 [ term_rendering//3, 37 svg//2 38 ]). 39:- use_module(library(http/html_write)). 40:- use_module(library(http/js_write)). 41:- use_module(library(http/http_dispatch)). 42:- use_module(library(http/http_parameters)). 43:- use_module(library(http/http_path)). 44:- use_module(library(process)). 45:- use_module(library(sgml)). 46:- use_module(library(debug)). 47:- use_module(library(error)). 48:- use_module(library(option)). 49:- use_module(library(lists)). 50:- use_module(library(apply)). 51:- use_module(library(dcg/basics)). 52:- use_module('../render'). 53
54:- register_renderer(sldnf, "Render SLDNF trees").
70term_rendering(Data, Vars, Options) -->
71 { debug(sldnf(vars), 'Data: ~q, vars: ~p', [Data, Vars])
72 },
73 render_latex(Data, Options).
80render_latex(_LatexString,_Options) -->
81 { \+ has_latex_renderer(latex) }, !,
82 no_latex(latex).
83
84render_latex(LatexString, _Options) --> 85 { latex_stream(LatexString,SVG0),
86 random(0,100000,R),
87 number_string(R,Rs),
88 string_concat(Rs,"-glyph",NewGlyph),
89 string_codes(NewGlyph,NewGlyphCodes0),
90 append(NewGlyphCodes0,T,NewGlyphCodes),
91 string_codes(SVG0,SVG0Codes),
92 phrase(rename_ids(NewGlyphCodes,T,SVGCodes),SVG0Codes,_),
93 string_codes(SVG,SVGCodes)
94
95},
96 html(div([ class(['render-latex', 'reactive-size']),
97 'data-render'('As tree')
98 ],
99 \svg(SVG, []))).
100
101
102rename_ids(NewGlyph,O0,O) -->
103 "glyph",!,
104 {copy_term((NewGlyph,O0),(O,T))},
105 rename_ids(NewGlyph,O0,T).
106
107rename_ids(NewGlyph,O,[C|T])-->
108 [C],!,
109 rename_ids(NewGlyph,O,T).
110
111rename_ids(_NewGlyph,_O,[])-->
112 [].
113
114
115
116rename_ids(NewGlyph,[NewGlyph|T]) -->
117 "glyph",!,
118 rename_ids(NewGlyph,T).
119
120rename_ids(NewGlyph,[C|T])-->
121 [C],
122 rename_ids(NewGlyph,T).
130svg(SVG, _Options) -->
131 html([
132 \[SVG],
133 \js_script({|javascript||
134(function() {
135 if ( $.ajaxScript ) {
136 var div = $.ajaxScript.parent();
137 var svg = div.find("svg");
138 var data = { w0: svg.width(),
139 h0: svg.height()
140 };
141 var pan;
142
143 function updateSize() {
144 var w = svg.closest("div.answer").innerWidth();
145
146 function reactive() {
147 if ( !data.reactive ) {
148 data.reactive = true;
149 div.on("reactive-resize", updateSize);
150 }
151 }
152
153 w = Math.max(w*0.85, 100);
154 if ( w < data.w0 ) {
155 svg.width(w);
156 svg.height(w = Math.max(w*data.h0/data.w0, w/4));
157 reactive();
158 if ( pan ) {
159 pan.resize();
160 pan.fit();
161 pan.center();
162 }
163 }
164 }
165
166 require(["svg-pan-zoom"], function(svgPanZoom) {
167 updateSize()
168 pan = svgPanZoom(svg[0], {
169 // controlIconsEnabled: true
170 minZoom: 0.1,
171 maxZoom: 50
172 });
173 });
174 }
175 })();
176
177 |})
178 ]).
179
180
181latex_stream(Latex, SVG) :-
182 tmp_file_stream(utf8,File,Stream),
183 write(Stream,
184"\\documentclass{article}
185\\pagestyle{empty}
186\\usepackage{epic,eepic}
187\\usepackage{ecltree}
188\\begin{document}
189"),
190 write(Stream,Latex),
191 write(Stream,
192"\\end{document}
193"),
194 close(Stream),
195 file_directory_name(File, Directory),
196 atom_concat('-output-directory=',Directory,OutDirOp),
197 process_create(path(latex), [OutDirOp,'-interaction=nonstopmode',File], [stdout(null)]),
198 delete_file(File),
199 atom_concat(File,'.aux',FileAux),
200 atom_concat(File,'.log',FileLog),
201 delete_file(FileAux),
202 delete_file(FileLog),
203 atom_concat(File,'.dvi',FileDvi),
204 atom_concat(File,'.pdf',FilePdf),
205 process_create(path(dvipdf),[FileDvi,FilePdf], [stdout(null)]),
206 atom_concat(File,'cropped.pdf',FileCroppedPdf),
207 atomic_list_concat([pdfcrop,FilePdf,FileCroppedPdf,'>/dev/null'],' ',ShellComm),
208 shell(ShellComm),
210 delete_file(FilePdf),
211 atom_concat(File,'.svg',FileSvg),
212 process_create(path(pdf2svg), [FileCroppedPdf,FileSvg], [stdout(null)]),
213 delete_file(FileCroppedPdf),
214 open(FileSvg,read,StreamSvg),
215 read_string(StreamSvg, _Length, SVG),
216 close(StreamSvg),
217 delete_file(FileSvg).
218
219
220rewrite_sgv_dom([element(svg, Attrs, Content)],
221 [element(svg, Attrs,
222 [ element(script, ['xlink:href'=SVGPan], []),
223 element(g, [ id=viewport
224 ],
225 Content)
226 ])]) :-
227 http_absolute_location(js('SVGPan.js'), SVGPan, []).
228rewrite_sgv_dom(DOM, DOM).
229
230send_to_dot(Data, Out) :-
231 call_cleanup(format(Out, '~s', [Data]),
232 close(Out)), !.
238remove_old_data(Time) :-
239 ( dot_data(Hash, _, Stamp),
240 Time > Stamp+900,
241 retract(dot_data(Hash, _, Stamp)),
242 fail
243 ; true
244 ).
245
246has_latex_renderer(Renderer) :-
247 exe_options(ExeOptions),
248 absolute_file_name(path(Renderer), _,
249 [ file_errors(fail)
250 | ExeOptions
251 ]).
252
253exe_options(Options) :-
254 current_prolog_flag(windows, true), !,
255 Options = [ extensions(['',exe,com]), access(read) ].
256exe_options(Options) :-
257 Options = [ access(execute) ].
258
259no_latex(Renderer) -->
260 html(div([ class('no-latex'),
261 style('color:red;')
262 ],
263 [ 'The server does not have the latex program ',
264 code(Renderer), ' installed in PATH. '
265 ])).
270add_defaults(Statements0, Statements) :-
271 \+ memberchk(bgcolor=_, Statements0), !,
272 Statements = [bgcolor=transparent|Statements0].
273add_defaults(Statements, Statements)
Render SLDNF trees using latex
This renderer exploits latex to render SLDNF trees as SVG images */