// [[Rcpp::export]]
bool XLSX_(std::string file, std::string bg_, double width, double height,
double offx, double offy,
int pointsize,
Rcpp::List aliases,
bool editable, int id,
std::string raster_prefix,
int last_rel_id, int standalone) {
int bg = R_GE_str2col(bg_.c_str());
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
pDevDesc dev = xlsx_driver_new(file, bg, width, height, offx, offy, pointsize,
aliases,
editable,
id,
raster_prefix,
last_rel_id, standalone);
if (dev == NULL)
Rcpp::stop("Failed to start xlsx device");
pGEDevDesc dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, "xlsx_device");
GEinitDisplayList(dd);
} END_SUSPEND_INTERRUPTS;
return true;
}
extern "C" SEXP xaml_graphicsdevice_new(SEXP args) {
args = CDR(args);
SEXP file = CAR(args);
args = CDR(args);
SEXP width = CAR(args);
args = CDR(args);
SEXP height = CAR(args);
const char *f = R_CHAR(STRING_ELT(file, 0));
double *w = REAL(width);
double *h = REAL(height);
int ver = R_GE_getVersion();
if (ver < R_32_GE_version || ver > R_33_GE_version) {
Rf_error("Graphics API version %d is not supported.", ver);
}
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS{
auto dev = xaml_device::create(f, *w, *h);
pGEDevDesc gdd = GEcreateDevDesc(dev->device_desc);
GEaddDevice2f(gdd, "xaml", f);
// Owner is DevDesc::deviceSpecific, and is released in close()
dev.release();
} END_SUSPEND_INTERRUPTS;
return R_NilValue;
}
static GEDevDesc*
createRSceneDevice(double width, double height,
double ps,
RSceneDevice *qdev,
RSceneDeviceCreateFun init_fun)
{
pGEDevDesc gdd;
// pDevDesc dev;
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
pDevDesc dev;
/* Allocate and initialize the device driver data */
if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc))))
return 0; /* or error() */
/* set up device driver or free 'dev' and error() */
if (!init_fun(dev, width, height, ps, qdev)) {
free(dev); // delete qdev; // ??
error("unable to start device");
}
gdd = GEcreateDevDesc(dev);
gdd->displayList = R_NilValue;
// gdd->savedSnapshot = R_NilValue;
GEaddDevice2(gdd, "QTScene");
} END_SUSPEND_INTERRUPTS;
return(gdd);
}
void LayerDevice::AddDeviceToR()
{
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS
{
gdd = GEcreateDevDesc(dd);
GEaddDevice2(gdd, "Layer");
} END_SUSPEND_INTERRUPTS;
gdk_flush();
}
void GEnullDevice()
{
pDevDesc dev = NULL;
pGEDevDesc dd;
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
if (!(dev = (pDevDesc ) calloc(1, sizeof(DevDesc))))
error(_("unable to start NULL device"));
if (!nullDeviceDriver(dev)) {
free(dev);
error(_("unable to start NULL device"));
}
dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, "NULL");
} END_SUSPEND_INTERRUPTS;
}
void GE_RAPHAELDevice(const char* filename, double* width, double* height, double* offx,
double* offy, double ps, int nbplots, const char* fontfamily, int canvas_id, SEXP env) {
pDevDesc dev = NULL;
pGEDevDesc dd;
R_GE_checkVersionOrDie (R_GE_version);
R_CheckDeviceAvailable();
if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc))))
Rf_error("unable to start RAPHAEL device");
if (!RAPHAELDeviceDriver(dev, filename, width, height, offx, offy, ps, nbplots,
fontfamily, canvas_id, env)) {
free(dev);
Rf_error("unable to start RAPHAEL device");
}
dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, "RAPHAEL");
}
void GE_PPTXDevice(const char* filename, double* width, double* height, double* offx,
double* offy, double ps, int nbplots, const char* fontfamily, int id_init_value, int editable) {
pDevDesc dev = NULL;
pGEDevDesc dd;
R_GE_checkVersionOrDie (R_GE_version);
R_CheckDeviceAvailable();
if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc))))
Rf_error("unable to start PPTX device");
if (!PPTXDeviceDriver(dev, filename, width, height, offx, offy, ps, nbplots,
fontfamily, id_init_value, editable)) {
free(dev);
Rf_error("unable to start PPTX device");
}
dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, "PPTX");
}
// [[Rcpp::export]]
bool devSVG_(std::string file, std::string bg_, int width, int height,
int pointsize, bool standalone) {
int bg = R_GE_str2col(bg_.c_str());
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
pDevDesc dev = svg_driver_new(file, bg, width, height, pointsize, standalone);
if (dev == NULL)
Rcpp::stop("Failed to start SVG device");
pGEDevDesc dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, "devSVG");
GEinitDisplayList(dd);
} END_SUSPEND_INTERRUPTS;
return true;
}
static GEDevDesc*
addJavaGDDevice(char *display, double width, double height, int sizeUnit,
double xpinch, double ypinch, int canvas,
double pointsize, double gamma)
{
NewDevDesc *dev = NULL;
GEDevDesc *dd;
char *devname="rj.GD";
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
#ifdef BEGIN_SUSPEND_INTERRUPTS
BEGIN_SUSPEND_INTERRUPTS {
#endif
/* Allocate and initialize the device driver data */
if (!(dev = (NewDevDesc*) calloc(1, sizeof(NewDevDesc))))
return 0;
/* Took out the GInit because MOST of it is setting up
* R base graphics parameters.
* This is supposed to happen via addDevice now.
*/
if (!newJavaGDDeviceDriver(dev, display, width, height, sizeUnit,
xpinch, ypinch, canvas,
pointsize, gamma )) {
free(dev);
error("unable to start device %s", devname);
return 0;
}
dd = GEcreateDevDesc(dev);
GEaddDevice2(dd, devname);
#ifdef JGD_DEBUG
printf("JavaGD> devNum=%d, dd=%lx\n", ndevNumber(dd), (unsigned long)dd);
#endif
openJavaGD(dev);
#ifdef BEGIN_SUSPEND_INTERRUPTS
} END_SUSPEND_INTERRUPTS;
#endif
return(dd);
}
extern "C" SEXP ide_graphicsdevice_new(SEXP args) {
return rhost::util::exceptions_to_errors([&] {
R_GE_checkVersionOrDie(R_GE_version);
if (device_instance != nullptr) {
// TODO: issue some error
return R_NilValue;
}
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS{
auto dev = ide_device::create("png", default_width, default_height);
pGEDevDesc gdd = GEcreateDevDesc(dev->device_desc);
GEaddDevice2(gdd, "ide");
// Owner is DevDesc::deviceSpecific, and is released in close()
dev->closed.connect([&] { device_instance = nullptr; });
device_instance = dev.release();
} END_SUSPEND_INTERRUPTS;
return R_NilValue;
});
/* Function called by R to open swf device */
SEXP swfDevice(SEXP filename_r, SEXP width_r, SEXP height_r,
SEXP bg_r, SEXP fg_r, SEXP frameRate_r, SEXP env_r)
{
/* This is the device object used by graphics engine */
pGEDevDesc gdd;
/* This is the description of graphics device,
including physical characteristics, plotting functions, etc. */
pDevDesc dev;
/* Retrieve information from arguments, and then pass them
to setup function */
const char *filename = CHAR(STRING_ELT(filename_r, 0));
double width = REAL(width_r)[0];
double height = REAL(height_r)[0];
const int *bg = INTEGER(bg_r);
float frameRate = (float) REAL(frameRate_r)[0];
/* Check if the version of graphics engine matches */
R_GE_checkVersionOrDie(R_GE_version);
/* Check if there is enough place to allocate a device */
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
/* Allocate and initialize the device description data */
if(!(dev = (pDevDesc) calloc(1, sizeof(DevDesc))))
return 0;
if(!swfSetup(dev, filename, width, height, bg, frameRate, env_r))
{
free(dev);
Rf_error("unable to start swf device");
}
gdd = GEcreateDevDesc(dev);
GEaddDevice2(gdd, "swf");
} END_SUSPEND_INTERRUPTS;
return R_NilValue;
}
SEXP swfDevice ( SEXP args ){
/*
* Make sure the version number of the R running this
* routine is compatible with the version number of
* the R that compiled this routine.
*/
R_GE_checkVersionOrDie(R_GE_version);
/* Declare local variabls for holding the components of the args SEXP */
const char *fileName;
const char *bg, *fg;
double width, height, frameRate;
SEXP fontFileList;
const char *logFileName;
/*
* pGEDevDesc is a variable provided by the R Graphics Engine
* that contains all device information required by the parent
* R system. It contains one important componant of type pDevDesc
* which containts information specific to the implementation of
* the swf device. The creation and initialization of this component
* is one of the main tasks of this routine.
*/
pGEDevDesc swfDev;
/* Retrieve function arguments from input SEXP. */
/*
* Skip first argument. It holds the name of the R function
* that called this C routine.
*/
args = CDR(args);
/* Recover file name. */
fileName = translateChar(asChar(CAR(args)));
/* Advance to next argument stored in SEXPR. */
args = CDR(args);
/* Recover figure dimensions. */
/* For now these are assumed to be in inches. */
width = asReal(CAR(args)); args = CDR(args);
height = asReal(CAR(args)); args = CDR(args);
/* Recover initial background and foreground colors. */
bg = CHAR(asChar(CAR(args))); args = CDR(args);
fg = CHAR(asChar(CAR(args))); args = CDR(args);
frameRate = asReal(asChar(CAR(args))); args = CDR(args);
fontFileList = CAR(args); args = CDR(args);
logFileName = CHAR(asChar(CAR(args))); args = CDR(args);
/* Ensure there is an empty slot avaliable for a new device. */
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS{
/*
* The pDevDesc variable specifies which funtions and components
* which describe the specifics of this graphics device. After
* setup, this information will be incorporated into the pGEDevDesc
* variable swfDev.
*/
pDevDesc deviceInfo;
/*
* Create the deviceInfo variable. If this operation fails,
* a 0 is returned in order to cause R to shut down due to the
* possibility of corrupted memory.
*/
if( !( deviceInfo = (pDevDesc) calloc(1, sizeof(DevDesc))) )
return 0;
/*
* Call setup routine to initialize deviceInfo and associate
* R graphics function hooks with the appropriate C routines
* in this file.
*/
if( !SWF_Setup( deviceInfo, fileName, width, height, bg, fg,
frameRate, fontFileList, logFileName ) ){
/*
* If setup was unsuccessful, destroy the device and return
* an error message.
*/
free( deviceInfo );
error("SWF device setup was unsuccessful!");
}
/* Create swfDev as a Graphics Engine device using deviceInfo. */
swfDev = GEcreateDevDesc( deviceInfo );
// Register the device as an avaiable graphics device in the R
// Session.
GEaddDevice2( swfDev, "swf output" );
} END_SUSPEND_INTERRUPTS;
return R_NilValue;
}
SEXP canvas_new_device(SEXP args)
{
/* R Graphics Device: in GraphicsDevice.h */
pDevDesc RGD;
/* R Graphics Engine: in GraphicsEngine.h */
pGEDevDesc RGE;
/* canvas Graphics Device */
canvasDesc *cGD;
FILE *fp = NULL;
int width, height, bgcolor;
SEXP v;
args=CDR(args);
v=CAR(args); args=CDR(args);
if (isString(v)){
PROTECT(v);
fp = fopen(CHAR(STRING_ELT(v,0)),"w");
UNPROTECT(1);
if (fp == NULL)
error("could not open file");
} else {
error("file must be a filename");
}
v=CAR(args); args=CDR(args);
if (!isNumeric(v)) {fclose(fp); error("`width' must be a number");}
width=asInteger(v);
v=CAR(args); args=CDR(args);
if (!isNumeric(v)) {fclose(fp); error("`height' must be a number");}
height=asInteger(v);
v=CAR(args); args=CDR(args);
if (!isString(v) && !isInteger(v) && !isLogical(v) && !isReal(v))
error("invalid color specification for `bg'");
bgcolor = RGBpar(v, 0);
#ifdef CANVASDEBUG
Rprintf("canvas_new_device(width=%d,height=%d,fd=%x)\n", width, height, fp);
#endif
R_CheckDeviceAvailable();
if (!(RGD = (pDevDesc)calloc(1, sizeof(NewDevDesc)))){
fclose(fp);
error("calloc failed for canvas device");
}
if (!(cGD = (canvasDesc *)calloc(1, sizeof(canvasDesc)))){
free(RGD);
fclose(fp);
error("calloc failed for canvas device");
}
cGD->fp = fp;
RGD->deviceSpecific = (void *) cGD;
/* Callbacks */
RGD->close = canvasClose;
RGD->activate = canvasActivate;
RGD->deactivate = canvasDeactivate;
RGD->size = canvasSize;
RGD->newPage = canvasNewPage;
RGD->clip = canvasClip;
RGD->strWidth = canvasStrWidth;
RGD->text = canvasText;
RGD->rect = canvasRect;
RGD->circle = canvasCircle;
RGD->line = canvasLine;
RGD->polyline = canvasPolyline;
RGD->polygon = canvasPolygon;
RGD->locator = canvasLocator;
RGD->mode = canvasMode;
RGD->metricInfo = canvasMetricInfo;
RGD->hasTextUTF8 = TRUE;
RGD->strWidthUTF8 = canvasStrWidth;
RGD->textUTF8 = canvasText;
RGD->wantSymbolUTF8 = TRUE;
/* Initialise RGD */
RGD->left = RGD->clipLeft = 0;
RGD->top = RGD->clipTop = 0;
RGD->right = RGD->clipRight = width;
RGD->bottom = RGD->clipBottom = height;
RGD->xCharOffset = 0.4900;
RGD->yCharOffset = 0.3333;
RGD->yLineBias = 0.1;
RGD->ipr[0] = 1.0/72.0;
RGD->ipr[1] = 1.0/72.0;
RGD->cra[0] = 0.9 * 10;
RGD->cra[1] = 1.2 * 10;
RGD->gamma = 1.0;
RGD->canClip = FALSE;
RGD->canChangeGamma = FALSE;
RGD->canHAdj = 2;
RGD->startps = 10.0;
RGD->startcol = R_RGB(0,0,0);
RGD->startfill = bgcolor;
RGD->startlty = LTY_SOLID;
RGD->startfont = 1;
RGD->startgamma = RGD->gamma;
RGD->displayListOn = FALSE;
/* Add to the device list */
RGE = GEcreateDevDesc(RGD);
cGD->RGE = RGE;
GEaddDevice(RGE);
GEinitDisplayList(RGE);
/*return ScalarInteger(1 + GEdeviceNumber(RGE));*/
return R_NilValue;
}
/*
cairo(filename, type, width, height, pointsize, bg, res, antialias,
quality, family)
*/
SEXP in_Cairo(SEXP args)
{
pGEDevDesc gdd;
SEXP sc;
const char *filename, *family;
int type, quality, width, height, pointsize, bgcolor, res, antialias;
const void *vmax = vmaxget();
args = CDR(args); /* skip entry point name */
if (!isString(CAR(args)) || LENGTH(CAR(args)) < 1)
error(_("invalid '%s' argument"), "filename");
filename = translateChar(STRING_ELT(CAR(args), 0));
args = CDR(args);
type = asInteger(CAR(args));
if(type == NA_INTEGER || type <= 0)
error(_("invalid '%s' argument"), "type");
args = CDR(args);
width = asInteger(CAR(args));
if(width == NA_INTEGER || width <= 0)
error(_("invalid '%s' argument"), "width");
args = CDR(args);
height = asInteger(CAR(args));
if(height == NA_INTEGER || height <= 0)
error(_("invalid '%s' argument"), "height");
args = CDR(args);
pointsize = asInteger(CAR(args));
if(pointsize == NA_INTEGER || pointsize <= 0)
error(_("invalid '%s' argument"), "pointsize");
args = CDR(args);
sc = CAR(args);
if (!isString(sc) && !isInteger(sc) && !isLogical(sc) && !isReal(sc))
error(_("invalid '%s' value"), "bg");
bgcolor = RGBpar(sc, 0);
args = CDR(args);
res = asInteger(CAR(args));
args = CDR(args);
antialias = asInteger(CAR(args));
if(antialias == NA_INTEGER)
error(_("invalid '%s' argument"), "antialias");
args = CDR(args);
quality = asInteger(CAR(args));
if(quality == NA_INTEGER || quality < 0 || quality > 100)
error(_("invalid '%s' argument"), "quality");
args = CDR(args);
if (!isString(CAR(args)) || LENGTH(CAR(args)) < 1)
error(_("invalid '%s' argument"), "family");
family = translateChar(STRING_ELT(CAR(args), 0));
R_GE_checkVersionOrDie(R_GE_version);
R_CheckDeviceAvailable();
BEGIN_SUSPEND_INTERRUPTS {
pDevDesc dev;
/* Allocate and initialize the device driver data */
if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc)))) return 0;
if (!BMDeviceDriver(dev, devtable[type].gtype, filename, quality,
width, height, pointsize,
bgcolor, res, antialias, family)) {
free(dev);
error(_("unable to start device '%s'"), devtable[type].name);
}
gdd = GEcreateDevDesc(dev);
GEaddDevice2f(gdd, devtable[type].name, filename);
} END_SUSPEND_INTERRUPTS;
vmaxset(vmax);
return R_NilValue;
}
SEXP Quartz(SEXP args)
{
NewDevDesc *dev = NULL;
GEDevDesc *dd;
char *display, *vmax, *family=NULL;
char fontfamily[255];
double height, width, ps;
Rboolean antialias, autorefresh;
SInt32 macVer;
int quartzpos = 1;
vmax = vmaxget();
args = CDR(args); /* skip entry point name */
display = CHAR(asChar(CAR(args))); args = CDR(args);
width = asReal(CAR(args)); args = CDR(args);
height = asReal(CAR(args)); args = CDR(args);
if (width <= 0 || height <= 0)
error(_("invalid width or height in quartz"));
ps = asReal(CAR(args)); args = CDR(args);
family = CHAR(asChar(CAR(args))); args = CDR(args);
antialias = asLogical(CAR(args)); args = CDR(args);
autorefresh = asLogical(CAR(args));
if(Gestalt(gestaltSystemVersion, &macVer) == noErr)
if (macVer >= 0x1030)
WeAreOnPanther = true;
else
WeAreOnPanther = false;
R_CheckDeviceAvailable();
/* Allocate and initialize the device driver data */
BEGIN_SUSPEND_INTERRUPTS {
if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))
return 0;
/* Do this for early redraw attempts */
dev->displayList = R_NilValue;
/* Make sure that this is initialised before a GC can occur.
* This (and displayList) get protected during GC
*/
dev->savedSnapshot = R_NilValue;
strcpy(fontfamily, family);
#ifdef HAVE_AQUA
if(useaqua)
GetQuartzParameters(&width, &height, &ps, fontfamily, &antialias,
&autorefresh, &quartzpos);
#endif
if (!QuartzDeviceDriver((DevDesc *)dev, display, width, height, ps,
fontfamily, antialias, autorefresh, quartzpos, 0xffffffff)) {
free(dev);
error(_("unable to start device Quartz"));
}
gsetVar(install(".Device"), mkString("quartz"), R_NilValue);
dd = GEcreateDevDesc(dev);
addDevice((DevDesc*)dd);
GEinitDisplayList(dd);
} END_SUSPEND_INTERRUPTS;
vmaxset(vmax);
return R_NilValue;
}