1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2016, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(r_swish,
   36	  [ r_download/0,			% Download all
   37	    r_download/1			% +File
   38	  ]).   39:- use_module(library(pengines)).   40:- use_module(library(debug)).   41:- use_module(library(error)).   42:- use_module(library(apply)).   43:- use_module(library(http/html_write)).   44:- use_module(library(http/js_write)).   45
   46% We publish to the R interface to `swish`
   47:- use_module(swish:library(r/r_call)).   48:- use_module(swish:library(r/r_data)).   49
   50:- use_module(library(r/r_call)).   51:- use_module(library(r/r_serve)).   52:- use_module(download).   53
   54/** <Module> Bind Rserve to SWISH
   55
   56The user must provide the  file  search   path  =rserve=  to local the R
   57connection library.
   58*/
   59
   60:- multifile
   61	r_call:r_console/2,
   62	r_call:r_display_images/1,
   63	r_call:r_console_property/1.   64
   65%%	r_call:r_console(+Stream, ?Data)
   66%
   67%	Relay Rserve captured output to SWISH using writeln.
   68
   69r_call:r_console(stdout, []) :- !.
   70r_call:r_console(stdout, Strings) :-
   71	atomics_to_string(Strings, "\n", String),
   72	send_html(pre(class(['R', console]), String)).
   73
   74send_html(HTML) :-
   75	phrase(html(HTML), Tokens),
   76	with_output_to(string(HTMlString), print_html(Tokens)),
   77	pengine_output(HTMlString).
   78
   79%!	r_call:r_console_property(?Property)
   80%
   81%	Relay the size of the console
   82
   83r_call:r_console_property(size(Rows, Cols)) :-
   84	swish:tty_size(Rows, Cols).
   85
   86%%	r_call:r_display_images(+Images)
   87%
   88%	Relay   received   images   to   the     SWISH   console   using
   89%	pengine_output/1.
   90
   91r_call:r_display_images(Images) :-
   92	svg_html(Images, HTMlString),
   93	pengine_output(HTMlString).
   94
   95%%	svg_html(+Images, -HTMlString) is det.
   96%
   97%	Turn a list of SVG images into an HTML string.
   98
   99svg_html(Images, HTMlString) :-
  100	phrase(svg_html(Images), Tokens),
  101	with_output_to(string(HTMlString), print_html(Tokens)).
  102
  103svg_html(Images) -->
  104	html(div(class('Rplots'), \rplots(Images))).
  105
  106rplots([]) --> [].
  107rplots([H|T]) -->
  108	html(div(class(['reactive-size', 'R', svg]), \plot(H, []))),
  109	rplots(T).
  110
  111
  112plot(svg(SVG), _Options) --> !,
  113	html(\[SVG]),
  114	pan_zoom,
  115	"".
  116plot(Term, _Options) --> !,
  117	{ domain_error(image, Term) }.
  118
  119%%	pan_zoom
  120%
  121%	Add pan and soom behaviour to embedded SVG.  This function also
  122%	renames the `id` attribute and their references.
  123%
  124%	@bug	We need a generic way to fix all references to the ID.
  125%		Is there a list of such attributes?
  126%	@bug	Instead of `"use"`, we should use `"[xlink\\:href]"`,
  127%		but this does not seem to work!?
  128%	@bug	When generalised, this could move into runner.js.
  129
  130pan_zoom -->
  131	html(\js_script({|javascript||
  132var svg  = node.node().find("svg");
  133var data = { w0: svg.width(),
  134	     h0: svg.height()
  135	   };
  136var pan;
  137
  138function fixIDs(node, prefix1) {
  139  var i=0;
  140  node.each(function() {
  141    var prefix = prefix1+(i++)+"_";
  142    var img = $(this);
  143    var hprefix = "#"+prefix;
  144    var re = /(url\()#([^)]*)(\))/;
  145
  146    img.find("[id]").each(function() {
  147      var elem = $(this);
  148      elem.attr("id", prefix+elem.attr("id"));
  149    });
  150    img.find("use").each(function() {
  151      var elem = $(this);
  152      var r = elem.attr("xlink:href");
  153      if ( r.charAt(0) == "#" )
  154	elem.attr("xlink:href", hprefix+r.slice(1));
  155    });
  156    img.find("[clip-path]").each(function() {
  157      var elem = $(this);
  158      var r = elem.attr("clip-path").match(re);
  159      if ( r.length == 4 )
  160	elem.attr("clip-path", r[1]+hprefix+r[2]+r[3]);
  161    });
  162  });
  163}
  164
  165fixIDs(svg, "N"+node.unique_id()+"_");
  166
  167function updateSize() {
  168  var w = svg.closest("div.Rplots").innerWidth();
  169  console.log(data.w0, w);
  170
  171  function reactive() {
  172    if ( !data.reactive ) {
  173      var div = svg.closest("div.reactive-size");
  174      data.reactive = true;
  175      div.on("reactive-resize", updateSize);
  176    }
  177  }
  178
  179  reactive();
  180  w = Math.max(w*0.95, 100);
  181  if ( w < data.w0 ) {
  182    svg.width(w);
  183    svg.height(w = Math.max(w*data.h0/data.w0, w/4));
  184    if ( pan ) {
  185      pan.resize();
  186      pan.fit();
  187      pan.center();
  188    }
  189  }
  190}
  191
  192require(["svg-pan-zoom"], function(svgPanZoom) {
  193  updateSize()
  194  pan = svgPanZoom(svg[0], {
  195    maxZoom: 50
  196  });
  197});
  198		      |})).
  199
  200
  201%%	r_download
  202%
  203%	Provide download buttons for all created  files. First calls the
  204%	R function `graphics.off()` to close all graphics devices.
  205
  206r_download :-
  207	nb_current('R', _), !,
  208	<- graphics.off(),
  209	Files <- list.files(),
  210	maplist(r_download, Files).
  211r_download.
  212
  213%%	r_download(File)
  214%
  215%	Provide a download button for the indicates file.
  216
  217r_download(File) :-
  218	nb_current('R', _), !,
  219	catch(r_read_file($, File, Content), E,
  220	      r_error(E, File)),
  221	(   debugging(r(file))
  222	->  string_length(Content, Len),
  223	    debug(r(file), 'Got ~D bytes from ~p', [Len, File])
  224	;   true
  225	),
  226	file_name_extension(_Name, Ext, File),
  227	download_encoding(Ext, Enc),
  228	download_button(Content,
  229			[ filename(File),
  230			  encoding(Enc)
  231			]).
  232r_download(File) :-
  233	existence_error(r_file, File).
  234
  235r_error(error(r_error(70),_), File) :- !,
  236	existence_error(r_file, File).
  237r_error(Error, _) :- throw(Error).
  238
  239download_encoding(svg, utf8) :- !.
  240download_encoding(csv, utf8) :- !.
  241download_encoding(_,   octet).
  242
  243:- multifile sandbox:safe_primitive/1.  244
  245sandbox:safe_primitive(r_swish:r_download).
  246sandbox:safe_primitive(r_swish:r_download(_))