view cpack/dml/api/r_plot.pl @ 0:718306e29690 tip

commiting public release

/* Part of DML (Digital Music Laboratory)
	Copyright 2014-2015 Samer Abdallah, University of London
	 
	This program is free software; you can redistribute it and/or
	modify it under the terms of the GNU General Public License
	as published by the Free Software Foundation; either version 2
	of the License, or (at your option) any later version.

	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
*/

:- module(api_r_plot, []).

:- use_module(library(http/http_dispatch)).
:- use_module(library(http/http_parameters)).
:- use_module(library(sandbox)).
:- use_module(library(insist)).
:- use_module(library(fileutils)).
:- use_module(library(swipe)).
:- use_module(library(httpfiles)).
:- use_module(library(real)).

:- set_prolog_flag(double_quotes,string).
:- set_prolog_flag(back_quotes,symbol_char).

:- http_handler(api(r/render), r_figure_render, []).

:- setting(r_plot:pixels_per_inch,number,150,"Pixels per inch for in browser figures").
:- setting(r_plot:default_figure_format,oneof([png,svg]),svg,"Default R figure rendering method").

%% figure_render(+Request) is det.
%
%  HTTP handler for rendering R figures.
r_figure_render(Request) :-
   setting(r_plot:pixels_per_inch,DefPPI),
   http_parameters(Request,
      [ code(CodeA,[ atom, optional(false), description("Prolog rendering goal")])
      , format(F, [ oneof([eps,svg,pdf,png]), optional(false), description("Output format") ]) 
      , width(W,  [ number, optional(true), default(10), description("Width in cm")])
      , height(H, [ number, optional(true), default(6), description("Height in cm")])
      , font_name(FN,  [ atom, optional(true), default(helvetica) ])
      , font_size(FS,  [ number, optional(true), default(10) ])
      , ppi(PPI,       [ number, optional(true), default(DefPPI), description("PNG resolution")])
      ]),
   debug(r_plot,"Attempting to parse \"~s\".",[CodeA]),
   read_term_from_atom(CodeA,Code,[]),
   (  user_db:logged_on(A)
   -> debug(r_plot,"Logged on as ~w, no checking",[A])
   ;  debug(r_plot,"Checking ~q for safety...",[Code]),
      sandbox:safe_goal(Code),
      debug(r_plot,"Goal is safe.",[])
   ),
   insist(with_temp_dir(Dir, (
      render(F,Code,Dir,File, [size(W,H), ppi(PPI), font_name(FN), font_size(FS) ]),
      debug(r_plot,'Replying with file ~s',[File]),
      reply_file(File,F)
   ))).


render(png,Code,D,PNGPath,Opts) :- !,
   file_name_extension(tmp,png,PNGFile),
   directory_file_path(D,PNGFile,PNGPath),
   render(pdf,Code,D,EPSFile,Opts),
   option(ppi(PPI),Opts,300),
   run(sh(0>>0, "gs -dBATCH -dNumRenderingThreads=2 -dEPSCrop -dNOPAUSE -sDEVICE=pngalpha -sOutputFile=~s -r~d -q ~s",
                     [PNGPath+write,\PPI,EPSFile+read])).

% render(png,Code,D,Opts) :- !, option(ppi(PPI),Opts,300), render(png(PPI),Code,D,Opts).
render(Fmt,Code,Dir,Path,Opts) :- 
   file_name_extension(tmp,Fmt,File),
   directory_file_path(Dir,File,Path),
   debug(r_plot,'Running ~q',[print_fig(Fmt,Code,Path,Opts)]),
   with_mutex(r_plot,api_r_plot:print_fig(Fmt,Code,Path,Opts)).

print_fig(Fmt,Code,Path,Opts) :-
   debug(r_plot,'In print_fig...',[]),
   option(size(Width,Height),Opts),
   maplist(cm_inch,[Width,Height],[WidthInches,HeightInches]),
   debug(r_plot,'Getting device ~w: ~s',[Fmt,Path]),
   dev(Fmt,Path,WidthInches,HeightInches,Dev),
   debug(r_plot,'Got device ~q',[Dev]),
   setup_call_cleanup( 
      r(Dev), 
      call_cleanup( 
         with_output_to(string(_),Code), 
        exception(Ex), 
        debug(r_plot,'Exception running R code: ~q',[Ex])),
      r('dev.off()')).

dev(pdf,Name,W,H,pdf(+Name,width=W,height=H)).
dev(eps,Name,W,H,cairo_ps(+Name,width=W,height=H)).
dev(svg,Name,W,H,svg(+Name,width=W,height=H)).
dev(png(PPI),Name,W,H,png(+Name,width=WP,height=HP)) :- WP is PPI*W, HP is PPI*H.

cm_inch(CM,INCH) :- INCH is CM/2.54.