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).

   60:- multifile
   61	r_call:r_console/2,
   62	r_call:r_display_images/1,
   63	r_call:r_console_property/1.

 r_call:r_console(+Stream, ?Data)

Relay Rserve captured output to SWISH using writeln.

   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).

 r_call:r_console_property(?Property)

Relay the size of the console

   83r_call:r_console_property(size(Rows, Cols)) :-
   84	swish:tty_size(Rows, Cols).

 r_call:r_display_images(+Images)

Relay received images to the SWISH console using pengine_output/1.

   91r_call:r_display_images(Images) :-
   92	svg_html(Images, HTMlString),
   93	pengine_output(HTMlString).

 svg_html(+Images, -HTMlString) is det

Turn a list of SVG images into an HTML string.

   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) }.

 pan_zoom

Add pan and soom behaviour to embedded SVG. This function also renames the id attribute and their references.

bug

- We need a generic way to fix all references to the ID. Is there a list of such attributes?

- Instead of "use", we should use "[xlink\\:href]", but this does not seem to work!?

- When generalised, this could move into runner.js.

  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		      |})).

 r_download

Provide download buttons for all created files. First calls the R function graphics.off() to close all graphics devices.

  206r_download :-
  207	nb_current('R', _), !,
  208	<- graphics.off(),
  209	Files <- list.files(),
  210	maplist(r_download, Files).
  211r_download.

 r_download(File)

Provide a download button for the indicates file.

  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(_))