void initVP(pGEDevDesc dd)
{
SEXP vpfnname, vpfn, vp;
SEXP xscale, yscale;
SEXP currentgp = gridStateElement(dd, GSS_GPAR);
SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
PROTECT(vpfnname = findFun(install("grid.top.level.vp"), R_gridEvalEnv));
PROTECT(vpfn = lang1(vpfnname));
PROTECT(vp = eval(vpfn, R_GlobalEnv));
/*
* Set the "native" scale of the top viewport to be the
* natural device coordinate system (e.g., points in
* postscript, pixels in X11, ...)
*/
PROTECT(xscale = allocVector(REALSXP, 2));
REAL(xscale)[0] = dd->dev->left;
REAL(xscale)[1] = dd->dev->right;
SET_VECTOR_ELT(vp, VP_XSCALE, xscale);
PROTECT(yscale = allocVector(REALSXP, 2));
REAL(yscale)[0] = dd->dev->bottom;
REAL(yscale)[1] = dd->dev->top;
SET_VECTOR_ELT(vp, VP_YSCALE, yscale);
SET_VECTOR_ELT(vp, PVP_GPAR, currentgp);
vp = doSetViewport(vp, TRUE, TRUE, dd);
SET_VECTOR_ELT(gsd, GSS_VP, vp);
UNPROTECT(5);
}
void initDL(pGEDevDesc dd)
{
SEXP dl, dlindex;
SEXP vp = gridStateElement(dd, GSS_VP);
SEXP gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
/* The top-level viewport goes at the start of the display list
*/
PROTECT(dl = allocVector(VECSXP, 100));
SET_VECTOR_ELT(dl, 0, vp);
SET_VECTOR_ELT(gsd, GSS_DL, dl);
PROTECT(dlindex = allocVector(INTSXP, 1));
INTEGER(dlindex)[0] = 1;
SET_VECTOR_ELT(gsd, GSS_DLINDEX, dlindex);
UNPROTECT(2);
}
SEXP gridCallback(GEevent task, pGEDevDesc dd, SEXP data) {
SEXP result = R_NilValue;
SEXP valid, scale;
SEXP gridState;
GESystemDesc *sd;
SEXP currentgp;
SEXP gsd;
SEXP devsize;
R_GE_gcontext gc;
switch (task) {
case GE_InitState:
/* Create the initial grid state for a device
*/
PROTECT(gridState = createGridSystemState());
/* Store that state with the device for easy retrieval
*/
sd = dd->gesd[gridRegisterIndex];
sd->systemSpecific = (void*) gridState;
/* Initialise the grid state for a device
*/
fillGridSystemState(gridState, dd);
/* Also store the state beneath a top-level variable so
* that it does not get garbage-collected
*/
globaliseState(gridState);
/* Indicate success */
result = R_BlankString;
UNPROTECT(1);
break;
case GE_FinaliseState:
sd = dd->gesd[gridRegisterIndex];
/* Simply detach the system state from the global variable
* and it will be garbage-collected
*/
deglobaliseState((SEXP) sd->systemSpecific);
/* Also set the device pointer to NULL
*/
sd->systemSpecific = NULL;
break;
case GE_SaveState:
break;
case GE_RestoreState:
gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
PROTECT(devsize = allocVector(REALSXP, 2));
getDeviceSize(dd, &(REAL(devsize)[0]), &(REAL(devsize)[1]));
SET_VECTOR_ELT(gsd, GSS_DEVSIZE, devsize);
UNPROTECT(1);
/* Only bother to do any grid drawing setup
* if there has been grid output
* on this device.
*/
if (LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) {
if (LOGICAL(gridStateElement(dd, GSS_ENGINEDLON))[0]) {
/* The graphics engine is about to replay the display list
* So we "clear" the device and reset the grid graphics state
*/
/* There are two main situations in which this occurs:
* (i) a screen is resized
* In this case, it is ok-ish to do a GENewPage
* because that has the desired effect and no
* undesirable effects because it only happens on
* a screen device -- a new page is the same as
* clearing the screen
* (ii) output on one device is copied to another device
* In this case, a GENewPage is NOT a good thing, however,
* here we will start with a new device and it will not
* have any grid output so this section will not get called
* SO we will not get any unwanted blank pages.
*
* All this is a bit fragile; ultimately, what would be ideal
* is a dev->clearPage primitive for all devices in addition
* to the dev->newPage primitive
*/
currentgp = gridStateElement(dd, GSS_GPAR);
gcontextFromgpar(currentgp, 0, &gc, dd);
GENewPage(&gc, dd);
initGPar(dd);
initVP(dd);
initOtherState(dd);
} else {
/*
* If we have turned off the graphics engine's display list
* then we have to redraw the scene ourselves
*/
SEXP fcall;
PROTECT(fcall = lang1(install("draw.all")));
eval(fcall, R_gridEvalEnv);
UNPROTECT(1);
}
}
break;
case GE_CopyState:
break;
case GE_CheckPlot:
PROTECT(valid = allocVector(LGLSXP, 1));
LOGICAL(valid)[0] = TRUE;
UNPROTECT(1);
result = valid;
case GE_SaveSnapshotState:
break;
case GE_RestoreSnapshotState:
break;
case GE_ScalePS:
/*
* data is a numeric scale factor
*/
PROTECT(scale = allocVector(REALSXP, 1));
REAL(scale)[0] = REAL(gridStateElement(dd, GSS_SCALE))[0]*
REAL(data)[0];
setGridStateElement(dd, GSS_SCALE, scale);
UNPROTECT(1);
break;
}
return result;
}
