int selectDevice(int devNum)
{
/* Valid to select nullDevice, but that will open a new device.
See ?dev.set.
*/
if((devNum >= 0) && (devNum < R_MaxDevices) &&
(R_Devices[devNum] != NULL) && active[devNum])
{
pGEDevDesc gdd;
if (!NoDevices()) {
pGEDevDesc oldd = GEcurrentDevice();
if (oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev);
}
R_CurrentDevice = devNum;
/* maintain .Device */
gsetVar(R_DeviceSymbol,
elt(getSymbolValue(R_DevicesSymbol), devNum),
R_BaseEnv);
gdd = GEcurrentDevice(); /* will start a device if current is null */
if (!NoDevices()) /* which it always will be */
if (gdd->dev->activate) gdd->dev->activate(gdd->dev);
return devNum;
}
else
return selectDevice(nextDevice(devNum));
}
SEXP devcap(SEXP args)
{
SEXP ans;
int i = 0;
pDevDesc dd = GEcurrentDevice()->dev;
args = CDR(args);
PROTECT(ans = allocVector(INTSXP, 9));
INTEGER(ans)[i] = dd->haveTransparency;
INTEGER(ans)[++i] = dd->haveTransparentBg;
/* These will be NULL if the device does not define them */
INTEGER(ans)[++i] = (dd->raster != NULL) ? dd->haveRaster : 1;
INTEGER(ans)[++i] = (dd->cap != NULL) ? dd->haveCapture : 1;
INTEGER(ans)[++i] = (dd->locator != NULL) ? dd->haveLocator : 1;
INTEGER(ans)[++i] = (int)(dd->canGenMouseDown);
INTEGER(ans)[++i] = (int)(dd->canGenMouseMove);
INTEGER(ans)[++i] = (int)(dd->canGenMouseUp);
INTEGER(ans)[++i] = (int)(dd->canGenKeybd);
/* FIXME: there should be a way for a device to declare its own
events, and return information on how to set them */
UNPROTECT(1);
return ans;
}
SEXP set_current_layer_by_index(SEXP index)
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
ld->SetCurrentLayerByIndex(INTEGER(index)[0]);
return R_NilValue;
}
SEXP do_getGraphicsEvent(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP prompt, onMouseDown, onMouseMove, onMouseUp, onKeybd;
GEDevDesc *dd;
NewDevDesc *nd;
checkArity(op, args);
dd = GEcurrentDevice();
nd = dd->dev;
if (!nd->newDevStruct || !nd->getEvent)
errorcall(call, _("graphics device does not support graphics events"));
prompt = CAR(args);
if (!isString(prompt)) errorcall(call, _("invalid prompt"));
args = CDR(args);
onMouseDown = CAR(args);
if (TYPEOF(onMouseDown) == NILSXP) onMouseDown = NULL;
else if (!nd->canGenMouseDown)
errorcall(call, _("'onMouseDown' not supported"));
else if (TYPEOF(onMouseDown) != CLOSXP ||
TYPEOF(onMouseDown) != RCC_CLOSXP)
errorcall(call, _("invalid 'onMouseDown' callback"));
args = CDR(args);
onMouseMove = CAR(args);
if (TYPEOF(onMouseMove) == NILSXP) onMouseMove = NULL;
else if (!nd->canGenMouseMove)
errorcall(call, _("'onMouseMove' not supported"));
else if (TYPEOF(onMouseMove) != CLOSXP ||
TYPEOF(onMouseDown) != RCC_CLOSXP)
errorcall(call, _("invalid 'onMouseMove' callback"));
args = CDR(args);
onMouseUp = CAR(args);
if (TYPEOF(onMouseUp) == NILSXP) onMouseUp = NULL;
else if (!nd->canGenMouseUp)
errorcall(call, _("'onMouseUp' not supported"));
else if (TYPEOF(onMouseUp) != CLOSXP ||
TYPEOF(onMouseDown) != RCC_CLOSXP)
errorcall(call, _("invalid 'onMouseUp' callback"));
args = CDR(args);
onKeybd = CAR(args);
if (TYPEOF(onKeybd) == NILSXP) onKeybd = NULL;
else if (!nd->canGenKeybd)
errorcall(call, _("'onKeybd' not supported"));
else if (TYPEOF(onKeybd) != CLOSXP ||
TYPEOF(onMouseDown) != RCC_CLOSXP)
errorcall(call, _("invalid 'onKeybd' callback"));
/* NB: cleanup of event handlers must be done by driver in onExit handler */
return(nd->getEvent(env, CHAR(STRING_ELT(prompt,0))));
}
SEXP set_default_font(SEXP fontPath)
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
ld->SetDefaultFontFace(CHAR(STRING_ELT(fontPath, 0)));
return R_NilValue;
}
void GEaddDevice(pGEDevDesc gdd)
{
int i;
Rboolean appnd;
SEXP s, t;
pGEDevDesc oldd;
PROTECT(s = getSymbolValue(R_DevicesSymbol));
if (!NoDevices()) {
oldd = GEcurrentDevice();
if(oldd->dev->deactivate) oldd->dev->deactivate(oldd->dev);
}
/* find empty slot for new descriptor */
i = 1;
if (CDR(s) == R_NilValue)
appnd = TRUE;
else {
s = CDR(s);
appnd = FALSE;
}
while (R_Devices[i] != NULL) {
i++;
if (CDR(s) == R_NilValue)
appnd = TRUE;
else
s = CDR(s);
}
R_CurrentDevice = i;
R_NumDevices++;
R_Devices[i] = gdd;
active[i] = TRUE;
GEregisterWithDevice(gdd);
if(gdd->dev->activate) gdd->dev->activate(gdd->dev);
/* maintain .Devices (.Device has already been set) */
t = PROTECT(duplicate(getSymbolValue(R_DeviceSymbol)));
if (appnd)
SETCDR(s, CONS(t, R_NilValue));
else
SETCAR(s, t);
UNPROTECT(2);
/* In case a device driver did not call R_CheckDeviceAvailable
before starting its allocation, we complete the allocation and
then call killDevice here. This ensures that the device gets a
chance to deallocate its resources and the current active
device is restored to a sane value. */
if (i == R_MaxDevices - 1) {
killDevice(i);
error(_("too many open devices"));
}
}
SEXP devholdflush(SEXP args)
{
pDevDesc dd = GEcurrentDevice()->dev;
args = CDR(args);
int level = asInteger(CAR(args));
if(dd->holdflush && level != NA_INTEGER) level = (dd->holdflush(dd, level));
else level = 0;
return ScalarInteger(level);
}
SEXP add_layer(SEXP layerName)
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
SEXP id;
PROTECT(id = NEW_INTEGER(1));
INTEGER_POINTER(id)[0] = ld->AddLayer(CHAR(STRING_ELT(layerName, 0)));
UNPROTECT(1);
return id;
}
SEXP get_id_count()
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
SEXP idCount;
PROTECT(idCount = NEW_INTEGER(1));
INTEGER_POINTER(idCount)[0] = ld->GetIdCount();
UNPROTECT(1);
return idCount;
}
SEXP devcontrol(SEXP args)
{
int listFlag;
pGEDevDesc gdd = GEcurrentDevice();
args = CDR(args);
listFlag = asLogical(CAR(args));
if(listFlag == NA_LOGICAL) error(_("invalid argument"));
GEinitDisplayList(gdd);
gdd->displayListOn = listFlag ? TRUE: FALSE;
return ScalarLogical(listFlag);
}
SEXP devsize(SEXP args)
{
SEXP ans;
pDevDesc dd = GEcurrentDevice()->dev;
double left, right, bottom, top;
dd->size(&left, &right, &bottom, &top, dd);
ans = allocVector(REALSXP, 2);
REAL(ans)[0] = fabs(right - left);
REAL(ans)[1] = fabs(bottom - top);
return ans;
}
/*Called on startup to loaddefault font, can also be called from R to
* load a user provided font.
*/
static void SWF_LoadFont(const char *fontFile){
//Get the device info by pointer since this can be called from R
pDevDesc deviceInfo = GEcurrentDevice()->dev;
// Shortcut pointers to variables of interest.
swfDevDesc *swfInfo = (swfDevDesc *) deviceInfo->deviceSpecific;
//Load a fdb or ttf font
//XXX - can this work with ttc fonts?
//warning(fontFile);
swfInfo->ss = newSWFFont_fromFile(fontFile);
}
SEXP devAskNewPage(SEXP call, SEXP op, SEXP args, SEXP env)
{
int ask;
pGEDevDesc gdd = GEcurrentDevice();
Rboolean oldask = gdd->ask;
args = CDR(args);
if (!isNull(CAR(args))) {
ask = asLogical(CAR(args));
if (ask == NA_LOGICAL) error(_("invalid '%s' argument"), "ask");
gdd->ask = ask;
R_Visible = FALSE;
} else R_Visible = TRUE;
return ScalarLogical(oldask);
}
void onBeforeExecute(DeviceContext* pDC)
{
// if the shadow device has somehow become the active device
// then switch to the rstudio device. note this can occur if the
// user creates another device such as windows() or postscript() and
// then does a dev.off
pGEDevDesc pCurrentDevice = NoDevices() ? NULL : GEcurrentDevice();
ShadowDeviceData* pShadowDevData = (ShadowDeviceData*)pDC->pDeviceSpecific;
if (pCurrentDevice != NULL && pShadowDevData != NULL)
{
if (pCurrentDevice->dev == pShadowDevData->pShadowPngDevice)
{
// select the rstudio device
selectDevice(ndevNumber(pDC->dev));
}
}
}
SEXP get_current_layer()
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
gint currentIndex = ld->GetCurrentLayerIndex();
SEXP id, layerName, result;
PROTECT(id = NEW_INTEGER(1));
PROTECT(layerName = NEW_CHARACTER(1));
PROTECT(result = NEW_LIST(2));
INTEGER_POINTER(id)[0] =ld->GetLayerIdAt(currentIndex);
SET_STRING_ELT(layerName, 0, Rf_mkChar(ld->GetLayerNameAt(currentIndex)));
SET_VECTOR_ELT(result, 0, id);
SET_VECTOR_ELT(result, 1, layerName);
UNPROTECT(3);
return result;
}
SEXP devcapture(SEXP args)
{
int i, col, row, nrow, ncol, size;
Rboolean native;
pGEDevDesc gdd = GEcurrentDevice();
int *rint;
SEXP raster, image, idim;
args = CDR(args);
native = asLogical(CAR(args));
if (native != TRUE) native = FALSE;
raster = GECap(gdd);
if (isNull(raster)) /* NULL = unsupported */
return raster;
PROTECT(raster);
if (native) {
setAttrib(raster, R_ClassSymbol, mkString("nativeRaster"));
UNPROTECT(1);
return raster;
}
/* non-native, covert to color strings (this is based on grid.cap) */
size = LENGTH(raster);
nrow = INTEGER(getAttrib(raster, R_DimSymbol))[0];
ncol = INTEGER(getAttrib(raster, R_DimSymbol))[1];
PROTECT(image = allocVector(STRSXP, size));
rint = INTEGER(raster);
for (i = 0; i < size; i++) {
col = i % ncol + 1;
row = i / ncol + 1;
SET_STRING_ELT(image, (col - 1) * nrow + row - 1,
mkChar(col2name(rint[i])));
}
PROTECT(idim = allocVector(INTSXP, 2));
INTEGER(idim)[0] = nrow;
INTEGER(idim)[1] = ncol;
setAttrib(image, R_DimSymbol, idim);
UNPROTECT(3);
return image;
}
SEXP get_layers()
{
pGEDevDesc curGE = GEcurrentDevice();
LayerDesc *ld = (LayerDesc *) curGE->dev->deviceSpecific;
SEXP layerIDs, layerNames, result;
PROTECT(layerIDs = NEW_INTEGER(ld->GetLayersCount()));
PROTECT(layerNames = NEW_CHARACTER(ld->GetLayersCount()));
PROTECT(result = NEW_LIST(2));
gint i;
for(i = 0; i < ld->GetLayersCount(); i++)
{
INTEGER_POINTER(layerIDs)[i] = ld->GetLayerIdAt(i);
SET_STRING_ELT(layerNames, i, Rf_mkChar(ld->GetLayerNameAt(i)));
}
SET_VECTOR_ELT(result, 0, layerIDs);
SET_VECTOR_ELT(result, 1, layerNames);
UNPROTECT(3);
return result;
}
/* historically the close was in the [kK]illDevices.
only use findNext = FALSE when shutting R dowm, and .Device[s] are not
updated.
*/
static
void removeDevice(int devNum, Rboolean findNext)
{
/* Not vaild to remove nullDevice */
if((devNum > 0) && (devNum < R_MaxDevices) &&
(R_Devices[devNum] != NULL) && active[devNum])
{
int i;
SEXP s;
pGEDevDesc g = R_Devices[devNum];
active[devNum] = FALSE; /* stops it being selected again */
R_NumDevices--;
if(findNext) {
/* maintain .Devices */
PROTECT(s = getSymbolValue(R_DevicesSymbol));
for (i = 0; i < devNum; i++) s = CDR(s);
SETCAR(s, mkString(""));
UNPROTECT(1);
/* determine new current device */
if (devNum == R_CurrentDevice) {
R_CurrentDevice = nextDevice(R_CurrentDevice);
/* maintain .Device */
gsetVar(R_DeviceSymbol,
elt(getSymbolValue(R_DevicesSymbol), R_CurrentDevice),
R_BaseEnv);
/* activate new current device */
if (R_CurrentDevice) {
pGEDevDesc gdd = GEcurrentDevice();
if(gdd->dev->activate) gdd->dev->activate(gdd->dev);
}
}
}
g->dev->close(g->dev);
GEdestroyDevDesc(g);
R_Devices[devNum] = NULL;
}
}
static void addToDisplayList(SWFDisplayItem item){
//Get the device info by pointer since this can be called from R
pDevDesc deviceInfo = GEcurrentDevice()->dev;
/* Shortcut pointers to variables of interest. */
swfDevDesc *swfInfo = (swfDevDesc *) deviceInfo->deviceSpecific;
DisplayList *newItem;
if ((newItem = malloc(sizeof(DisplayList))) == NULL) { error(""); }
newItem->d = item;
if ( swfInfo->displayListHead == NULL )
swfInfo->displayListHead = newItem;
else
swfInfo->displayListTail->next = newItem;
swfInfo->displayListTail = newItem;
newItem->next = NULL;
}
static SEXP rpy_GetEvent(SEXP rho, const char *prompt)
{
SEXP r_res = R_NilValue;
PyObject *result;
pGEDevDesc dd = GEcurrentDevice();
/* Restore the Python handler */
/* FIXME */
/* PyOS_setsig(SIGINT, python_sighandler); */
PyObject *self = (PyObject *)dd->dev->deviceSpecific;
/* FIXME optimize ? */
#ifdef RPY_DEBUG_GRDEV
printf("FIXME: MetricInfo.\n");
#endif
#if (PY_VERSION_HEX < 0x03010000)
PyObject *py_prompt = PyString_FromString(prompt);
#else
PyObject *py_prompt = PyUnicode_FromString(prompt);
#endif
/* FIXME pass gc ? */
result = PyObject_CallMethodObjArgs(self, GrDev_getevent_name,
py_prompt,
NULL);
rpy_printandclear_error();
/* FIXME: check that the method only returns PySexp ? */
printf("FIXME: check that only PySexp returned.\n");
r_res = RPY_SEXP((PySexpObject *)result);
/* FIXME: handle refcount and protection of the resulting r_res */
printf("FIXME: handle refcount and protection of the resulting r_res");
Py_DECREF(result);
Py_DECREF(py_prompt);
return r_res;
}
SEXP attribute_hidden do_col2RGB(SEXP call, SEXP op, SEXP args, SEXP env)
{
/* colorname, "#rrggbb" or "col.number" to (r,g,b) conversion */
SEXP colors, ans, names, dmns;
double col, bg;
unsigned int icol;
int n, i, i4;
checkArity(op, args);
colors = CAR(args);
if(isString(colors)) PROTECT(colors);
else {
PROTECT(colors = coerceVector(colors, INTSXP));
if (TYPEOF(colors) != INTSXP)
error(_("invalid '%s' value"), "col");
}
n = LENGTH(colors);
/* First set up the output matrix */
PROTECT(ans = allocMatrix(INTSXP, 4, n));
PROTECT(dmns = allocVector(VECSXP, 2));
PROTECT(names = allocVector(STRSXP, 4));
SET_STRING_ELT(names, 0, mkChar("red"));
SET_STRING_ELT(names, 1, mkChar("green"));
SET_STRING_ELT(names, 2, mkChar("blue"));
SET_STRING_ELT(names, 3, mkChar("alpha"));
SET_VECTOR_ELT(dmns, 0, names);
UNPROTECT(1); /*names*/
if ((names = getAttrib(colors, R_NamesSymbol)) != R_NilValue)
SET_VECTOR_ELT(dmns, 1, names);
setAttrib(ans, R_DimNamesSymbol, dmns);
/* avoid looking up the background unless we will need it;
this may avoid opening a new window. Unfortunately, there is no
unavailable colour, so we work with doubles and convert at the
last minute */
#define BG_NEEDED -1.0
bg = BG_NEEDED;
if(isString(colors)) {
for(i = i4 = 0; i < n; i++, i4 += 4) {
col = str2col(CHAR(STRING_ELT(colors, i)), bg);
if (col == BG_NEEDED)
col = bg = dpptr(GEcurrentDevice())->bg;
icol = (unsigned int)col;
INTEGER(ans)[i4 +0] = R_RED(icol);
INTEGER(ans)[i4 +1] = R_GREEN(icol);
INTEGER(ans)[i4 +2] = R_BLUE(icol);
INTEGER(ans)[i4 +3] = R_ALPHA(icol);
}
} else {
for(i = i4 = 0; i < n; i++, i4 += 4) {
col = INTEGER(colors)[i];
if (col == NA_INTEGER) col = R_TRANWHITE;
else if (col == 0) col = bg;
else col = R_ColorTable[(unsigned int)(col-1) % R_ColorTableSize];
if (col == BG_NEEDED)
col = bg = dpptr(GEcurrentDevice())->bg;
icol = (unsigned int)col;
INTEGER(ans)[i4 +0] = R_RED(icol);
INTEGER(ans)[i4 +1] = R_GREEN(icol);
INTEGER(ans)[i4 +2] = R_BLUE(icol);
INTEGER(ans)[i4 +3] = R_ALPHA(icol);
}
}
UNPROTECT(3);
return ans;
}
static SEXP baseCallback(GEevent task, pGEDevDesc dd, SEXP data)
{
GESystemDesc *sd;
baseSystemState *bss, *bss2;
SEXP result = R_NilValue;
switch (task) {
case GE_FinaliseState:
/* called from unregisterOne */
sd = dd->gesd[baseRegisterIndex];
free(sd->systemSpecific);
sd->systemSpecific = NULL;
break;
case GE_InitState:
{
/* called from registerOne */
pDevDesc dev;
GPar *ddp;
sd = dd->gesd[baseRegisterIndex];
dev = dd->dev;
bss = malloc(sizeof(baseSystemState));
sd->systemSpecific = bss;
/* Bail out if necessary */
if (!bss) return result;
/* Make sure initialized, or valgrind may complain. */
memset(bss, 0, sizeof(baseSystemState));
ddp = &(bss->dp);
GInit(ddp);
/* For some things, the device sets the starting value at least. */
ddp->ps = dev->startps;
ddp->col = ddp->fg = dev->startcol;
ddp->bg = dev->startfill;
ddp->font = dev->startfont;
ddp->lty = dev->startlty;
ddp->gamma = dev->startgamma;
/* Initialise the gp settings too: formerly in addDevice. */
copyGPar(ddp, &(bss->gp));
GReset(dd);
/*
* The device has not yet received any base output
*/
bss->baseDevice = FALSE;
/* Indicate success */
result = R_BlankString;
break;
}
case GE_CopyState:
{
/* called from GEcopyDisplayList */
pGEDevDesc curdd = GEcurrentDevice();
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
bss2 = curdd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar(&(bss->dpSaved), &(bss2->dpSaved));
restoredpSaved(curdd);
copyGPar(&(bss2->dp), &(bss2->gp));
GReset(curdd);
break;
}
case GE_SaveState:
/* called from GEinitDisplayList */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar(&(bss->dp), &(bss->dpSaved));
break;
case GE_RestoreState:
/* called from GEplayDisplayList */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
restoredpSaved(dd);
copyGPar(&(bss->dp), &(bss->gp));
GReset(dd);
break;
case GE_SaveSnapshotState:
/* called from GEcreateSnapshot */
{
SEXP pkgName;
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
/* Changed from INTSXP in 2.7.0: but saved graphics lists
are protected by an R version number */
PROTECT(result = allocVector(RAWSXP, sizeof(GPar)));
copyGPar(&(bss->dpSaved), (GPar*) RAW(result));
PROTECT(pkgName = mkString("graphics"));
setAttrib(result, install("pkgName"), pkgName);
UNPROTECT(2);
}
break;
case GE_RestoreSnapshotState:
/* called from GEplaySnapshot */
{
int i, nState = LENGTH(data) - 1;
SEXP graphicsState, snapshotEngineVersion;
PROTECT(graphicsState = R_NilValue);
/* Prior to engine version 11, "pkgName" was not stored.
* (can tell because "engineVersion" was not stored either.)
* Assume 'graphics' is first state in snapshot
* (though this could be fatal).
*/
PROTECT(snapshotEngineVersion =
getAttrib(data, install("engineVersion")));
if (isNull(snapshotEngineVersion)) {
graphicsState = VECTOR_ELT(data, 1);
} else {
for (i=0; i<nState; i++) {
SEXP state = VECTOR_ELT(data, i + 1);
if (!strcmp(CHAR(STRING_ELT(getAttrib(state,
install("pkgName")),
0)),
"graphics")) {
graphicsState = state;
}
}
}
if (!isNull(graphicsState)) {
/* Check that RAW blob being restored is same size
* as GPar struct in current R version.
* Any version difference will have been warned about,
* but a difference here means STOP.
*/
if (LENGTH(graphicsState) != sizeof(GPar)) {
error(_("Incompatible graphics state"));
}
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar((GPar*) RAW(graphicsState), &(bss->dpSaved));
/* These are probably redundant because GE_RestoreState
* will follow from GEplayDisplayList(), but no harm
* is done
* AND there is at least one place that
* depends on this ('gridGraphics' package replays
* an empty DL to do restoredpSaved() on new page)
*/
restoredpSaved(dd);
copyGPar(&(bss->dp), &(bss->gp));
GReset(dd);
/* Make the device "clean" with respect to 'graphics'
* so that the display list replay starts from scratch
*/
bss->baseDevice = FALSE;
}
UNPROTECT(2);
}
break;
case GE_CheckPlot:
/* called from GEcheckState:
Check that the current plotting state is "valid"
*/
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
result = ScalarLogical(bss->baseDevice ?
(bss->gp.state == 1) && bss->gp.valid :
TRUE);
break;
case GE_ScalePS:
{
/* called from GEhandleEvent in devWindows.c */
GPar *ddp, *ddpSaved;
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
ddp = &(bss->dp);
ddpSaved = &(bss->dpSaved);
if (isReal(data) && LENGTH(data) == 1) {
double rf = REAL(data)[0];
ddp->scale *= rf;
/* Modify the saved settings so this effects display list too */
ddpSaved->scale *= rf;
} else
error("event 'GE_ScalePS' requires a single numeric value");
break;
}
}
return result;
}
RestorePreviousGraphicsDeviceScope::RestorePreviousGraphicsDeviceScope()
: pImpl_(new Impl())
{
// save ptr to previously selected device (if there is one)
pImpl_->pPreviousDevice = Rf_NoDevices() ? NULL : GEcurrentDevice();
}
void SWF_addPlayerControls(double *x, double *y){
//Get the device info by pointer since this can be called from R
pDevDesc deviceInfo = GEcurrentDevice()->dev;
// Shortcut pointers to variables of interest.
swfDevDesc *swfInfo = (swfDevDesc *) deviceInfo->deviceSpecific;
// General variables
SWFDisplayItem playd;
SWFDisplayItem stopd;
// Fill styles we create
SWFFillStyle dark_blue_fill;
SWFFillStyle red_fill;
SWFFillStyle green_fill;
// Variables used for the play button
SWFAction play_action;
SWFButton play_button;
SWFButtonRecord play_record_down;
SWFButtonRecord play_record_up;
SWFShape play_shape_down;
SWFShape play_shape_up;
// Variables used for the stop button
SWFAction stop_action;
SWFButton stop_button;
SWFButtonRecord stop_record_down;
SWFButtonRecord stop_record_up;
SWFShape stop_shape_down;
SWFShape stop_shape_up;
if(swfInfo->haveControls == FALSE){
swfInfo->haveControls = TRUE;
// Ensure the movie starts out in the "stopped" state
SWFMovie_add(swfInfo->m, (SWFBlock) newSWFAction("_root.stop();"));
}
swfInfo->ControlsX = *x;
swfInfo->ControlsY = deviceInfo->top - *y;
// Create the fill styles we'll be using
red_fill = newSWFSolidFillStyle(0xf0, 0x00, 0x00, 0x99);
dark_blue_fill = newSWFSolidFillStyle(0x00, 0x00, 0x90, 0x99);
green_fill = newSWFSolidFillStyle(0x00, 0xcc, 0x00, 0x99);
// *** Create the Play button ***
// Create a shape to be used in the play button for its "UP" state
play_shape_up = newSWFShape();
// Use the dark blue fill
SWFShape_setRightFillStyle(play_shape_up, green_fill);
SWFShape_setLine(play_shape_up, 1, 0x00, 0x00, 0x00, 0xff);
SWFShape_movePenTo(play_shape_up, swfInfo->ControlsX-25, swfInfo->ControlsY);
SWFShape_drawLine(play_shape_up, 20, 15);
SWFShape_drawLine(play_shape_up, -20, 15);
SWFShape_drawLine(play_shape_up, 0, -30);
// Create a shape to be used in the play button for its "DOWN" state
play_shape_down = newSWFShape();
// Use the green fill
SWFShape_setRightFillStyle(play_shape_down, dark_blue_fill);
SWFShape_setLine(play_shape_down, 1, 0x00, 0x00, 0x00, 0xff);
SWFShape_movePenTo(play_shape_down, swfInfo->ControlsX-25, swfInfo->ControlsY);
SWFShape_drawLine(play_shape_down, 20, 15);
SWFShape_drawLine(play_shape_down, -20, 15);
SWFShape_drawLine(play_shape_down, 0, -30);
// Create an empty button object we can use
play_button = newSWFButton();
// Add the shapes to the button for its various states
play_record_up = SWFButton_addCharacter(play_button,
(SWFCharacter) play_shape_up,
SWFBUTTON_UP|SWFBUTTON_HIT|SWFBUTTON_OVER);
play_record_down = SWFButton_addCharacter(play_button,
(SWFCharacter) play_shape_down, SWFBUTTON_DOWN);
// Add the Play action to the play button
play_action = newSWFAction("_root.play();");
SWFButton_addAction(play_button, play_action, SWFBUTTON_MOUSEUP);
// *** Create the Stop button ***
// Create a shape to be used in the stop button for its "UP" state
stop_shape_up = newSWFShape();
// Use the green fill
SWFShape_setRightFillStyle(stop_shape_up, red_fill);
SWFShape_setLine(stop_shape_up, 1, 0x00, 0x00, 0x00, 0xff);
SWFShape_movePenTo(stop_shape_up,
swfInfo->ControlsX , swfInfo->ControlsY + 2.5);
SWFShape_drawLine(stop_shape_up, 25, 0);
SWFShape_drawLine(stop_shape_up, 0, 25);
SWFShape_drawLine(stop_shape_up, -25, 0);
SWFShape_drawLine(stop_shape_up, 0, -25);
// Create a shape to be used in the stop button for its "DOWN" state
stop_shape_down = newSWFShape();
// Use the dark blue fill
SWFShape_setRightFillStyle(stop_shape_down, dark_blue_fill);
SWFShape_setLine(stop_shape_down, 1, 0x00, 0x00, 0x00, 0xff);
SWFShape_movePenTo(stop_shape_down,
swfInfo->ControlsX , swfInfo->ControlsY + 2.5);
SWFShape_drawLine(stop_shape_down, 25, 0);
SWFShape_drawLine(stop_shape_down, 0, 25);
SWFShape_drawLine(stop_shape_down, -25, 0);
SWFShape_drawLine(stop_shape_down, 0, -25);
// Create an empty button object we can use
stop_button = newSWFButton();
// Add the shapes to the button for its various states
stop_record_up = SWFButton_addCharacter(stop_button,
(SWFCharacter) stop_shape_up,
SWFBUTTON_UP | SWFBUTTON_HIT | SWFBUTTON_OVER);
stop_record_down = SWFButton_addCharacter(stop_button,
(SWFCharacter) stop_shape_down, SWFBUTTON_DOWN);
// Add the Stop action to the stop button
stop_action = newSWFAction("_root.stop();");
SWFButton_addAction(stop_button, stop_action, SWFBUTTON_MOUSEUP);
// *** Create the movie clip container for the buttons ***
// Embed the buttons in a movie clip
//movie_clip = newSWFMovieClip();
playd = SWFMovie_add(swfInfo->m, (SWFBlock) play_button);
stopd = SWFMovie_add(swfInfo->m, (SWFBlock) stop_button);
addToDisplayList( playd );
addToDisplayList( stopd );
// Advance the movie clip one frame, else it doesn't get displayed
//SWFMovieClip_nextFrame(movie_clip);
// Add the movie clip to the main movie
//buttons_display_item = SWFMovie_add(swfInfo->m, movie_clip);
//addToDisplayList( buttons_display_item );
// Set the movie clip to be shown higher
// in the display stack than the main movie
//SWFDisplayItem_setDepth(buttons_display_item, 100);
}
SEXP devdisplaylist(SEXP args)
{
pGEDevDesc gdd = GEcurrentDevice();
return ScalarLogical(gdd->displayListOn);
}
static SEXP baseCallback(GEevent task, pGEDevDesc dd, SEXP data)
{
GESystemDesc *sd;
baseSystemState *bss, *bss2;
SEXP result = R_NilValue;
switch (task) {
case GE_FinaliseState:
/* called from unregisterOne */
sd = dd->gesd[baseRegisterIndex];
free(sd->systemSpecific);
sd->systemSpecific = NULL;
break;
case GE_InitState:
{
/* called from registerOne */
pDevDesc dev;
GPar *ddp;
sd = dd->gesd[baseRegisterIndex];
dev = dd->dev;
bss = sd->systemSpecific = malloc(sizeof(baseSystemState));
/* Bail out if necessary */
if (!bss) return result;
/* Make sure initialized, or valgrind may complain. */
memset(bss, 0, sizeof(baseSystemState));
ddp = &(bss->dp);
GInit(ddp);
/* For some things, the device sets the starting value at least. */
ddp->ps = dev->startps;
ddp->col = ddp->fg = dev->startcol;
ddp->bg = dev->startfill;
ddp->font = dev->startfont;
ddp->lty = dev->startlty;
ddp->gamma = dev->startgamma;
/* Initialise the gp settings too: formerly in addDevice. */
copyGPar(ddp, &(bss->gp));
GReset(dd);
/*
* The device has not yet received any base output
*/
bss->baseDevice = FALSE;
/* Indicate success */
result = R_BlankString;
break;
}
case GE_CopyState:
{
/* called from GEcopyDisplayList */
pGEDevDesc curdd = GEcurrentDevice();
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
bss2 = curdd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar(&(bss->dpSaved), &(bss2->dpSaved));
restoredpSaved(curdd);
copyGPar(&(bss2->dp), &(bss2->gp));
GReset(curdd);
break;
}
case GE_SaveState:
/* called from GEinitDisplayList */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar(&(bss->dp), &(bss->dpSaved));
break;
case GE_RestoreState:
/* called from GEplayDisplayList */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
restoredpSaved(dd);
copyGPar(&(bss->dp), &(bss->gp));
GReset(dd);
break;
case GE_SaveSnapshotState:
/* called from GEcreateSnapshot */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
/* Changed from INTSXP in 2.7.0: but saved graphics lists
are protected by an R version number */
PROTECT(result = allocVector(RAWSXP, sizeof(GPar)));
copyGPar(&(bss->dpSaved), (GPar*) RAW(result));
UNPROTECT(1);
break;
case GE_RestoreSnapshotState:
/* called from GEplaySnapshot */
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
copyGPar((GPar*) RAW(data), &(bss->dpSaved));
restoredpSaved(dd);
copyGPar(&(bss->dp), &(bss->gp));
GReset(dd);
break;
case GE_CheckPlot:
/* called from GEcheckState:
Check that the current plotting state is "valid"
*/
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
result = ScalarLogical(bss->baseDevice ?
(bss->gp.state == 1) && bss->gp.valid :
TRUE);
break;
case GE_ScalePS:
{
/* called from GEhandleEvent in devWindows.c */
GPar *ddp, *ddpSaved;
bss = dd->gesd[baseRegisterIndex]->systemSpecific;
ddp = &(bss->dp);
ddpSaved = &(bss->dpSaved);
if (isReal(data) && LENGTH(data) == 1) {
double rf = REAL(data)[0];
ddp->scale *= rf;
/* Modify the saved settings so this effects display list too */
ddpSaved->scale *= rf;
} else
error("event 'GE_ScalePS' requires a single numeric value");
break;
}
}
return result;
}