static void Specify(const char *what, SEXP value, pGEDevDesc dd)
{
/* If you ADD a NEW par, then do NOT forget to update the code in
* ../library/base/R/par.R
* Parameters in Specify(),
* which can*not* be specified in high-level functions,
* i.e., by Specify2() [below]:
* this list is in \details{.} of ../library/base/man/par.Rd
* ------------------------
* "ask",
* "family", "fig", "fin",
* "lheight",
* "mai", "mar", "mex", "mfrow", "mfcol", "mfg",
* "new",
* "oma", "omd", "omi",
* "pin", "plt", "ps", "pty"
* "usr",
* "xlog", "ylog"
* "ylbias",
*/
double x;
int ix = 0;
char cx = '\0';
/* If we get here, Query has already checked that 'what' is valid */
if (ParCode(what) == 2) {
warning(_("graphical parameter \"%s\" cannot be set"), what);
return;
}
#define FOR_PAR
#include "par-common.c"
#undef FOR_PAR
/* ------------ */
else if (streql(what, "bg")) {
lengthCheck(what, value, 1);
ix = RGBpar3(value, 0, dpptr(dd)->bg);
/* naIntCheck(ix, what); */
R_DEV__(bg) = ix;
R_DEV__(new) = FALSE;
}
static void restoredpSaved(pGEDevDesc dd)
{
/* NOTE that not all params should be restored before playing */
/* the display list (e.g., don't restore the device size) */
/* This could probably now just do a memcpy */
int i, j, nr, nc;
dpptr(dd)->state = dpSavedptr(dd)->state;
/* does not restore 'valid' */
dpptr(dd)->adj = dpSavedptr(dd)->adj;
dpptr(dd)->ann = dpSavedptr(dd)->ann;
dpptr(dd)->bg = dpSavedptr(dd)->bg;
dpptr(dd)->bty = dpSavedptr(dd)->bty;
dpptr(dd)->cex = dpSavedptr(dd)->cex;
gpptr(dd)->lheight = dpSavedptr(dd)->lheight;
dpptr(dd)->col = dpSavedptr(dd)->col;
dpptr(dd)->crt = dpSavedptr(dd)->crt;
dpptr(dd)->err = dpSavedptr(dd)->err;
dpptr(dd)->fg = dpSavedptr(dd)->fg;
strncpy(dpptr(dd)->family, dpSavedptr(dd)->family, 201);
dpptr(dd)->font = dpSavedptr(dd)->font;
dpptr(dd)->gamma = dpSavedptr(dd)->gamma;
dpptr(dd)->lab[0] = dpSavedptr(dd)->lab[0];
dpptr(dd)->lab[1] = dpSavedptr(dd)->lab[1];
dpptr(dd)->lab[2] = dpSavedptr(dd)->lab[2];
dpptr(dd)->las = dpSavedptr(dd)->las;
dpptr(dd)->lty = dpSavedptr(dd)->lty;
dpptr(dd)->lwd = dpSavedptr(dd)->lwd;
dpptr(dd)->lend = dpSavedptr(dd)->lend;
dpptr(dd)->ljoin = dpSavedptr(dd)->ljoin;
dpptr(dd)->lmitre = dpSavedptr(dd)->lmitre;
dpptr(dd)->mgp[0] = dpSavedptr(dd)->mgp[0];
dpptr(dd)->mgp[1] = dpSavedptr(dd)->mgp[1];
dpptr(dd)->mgp[2] = dpSavedptr(dd)->mgp[2];
dpptr(dd)->mkh = dpSavedptr(dd)->mkh;
dpptr(dd)->pch = dpSavedptr(dd)->pch;
dpptr(dd)->ps = dpSavedptr(dd)->ps; /*was commented out --why? Well, it never changes */
dpptr(dd)->smo = dpSavedptr(dd)->smo;
dpptr(dd)->srt = dpSavedptr(dd)->srt;
dpptr(dd)->tck = dpSavedptr(dd)->tck;
dpptr(dd)->tcl = dpSavedptr(dd)->tcl;
dpptr(dd)->xaxp[0] = dpSavedptr(dd)->xaxp[0];
dpptr(dd)->xaxp[1] = dpSavedptr(dd)->xaxp[1];
dpptr(dd)->xaxp[2] = dpSavedptr(dd)->xaxp[2];
dpptr(dd)->xaxs = dpSavedptr(dd)->xaxs;
dpptr(dd)->xaxt = dpSavedptr(dd)->xaxt;
dpptr(dd)->xpd = dpSavedptr(dd)->xpd;
/* not oldxpd, which is a gpptr concept */
dpptr(dd)->xlog = dpSavedptr(dd)->xlog;
dpptr(dd)->yaxp[0] = dpSavedptr(dd)->yaxp[0];
dpptr(dd)->yaxp[1] = dpSavedptr(dd)->yaxp[1];
dpptr(dd)->yaxp[2] = dpSavedptr(dd)->yaxp[2];
dpptr(dd)->yaxs = dpSavedptr(dd)->yaxs;
dpptr(dd)->yaxt = dpSavedptr(dd)->yaxt;
dpptr(dd)->ylog = dpSavedptr(dd)->ylog;
dpptr(dd)->cexbase = dpSavedptr(dd)->cexbase;
dpptr(dd)->cexmain = dpSavedptr(dd)->cexmain;
dpptr(dd)->cexlab = dpSavedptr(dd)->cexlab;
dpptr(dd)->cexsub = dpSavedptr(dd)->cexsub;
dpptr(dd)->cexaxis = dpSavedptr(dd)->cexaxis;
dpptr(dd)->fontmain = dpSavedptr(dd)->fontmain;
dpptr(dd)->fontlab = dpSavedptr(dd)->fontlab;
dpptr(dd)->fontsub = dpSavedptr(dd)->fontsub;
dpptr(dd)->fontaxis = dpSavedptr(dd)->fontaxis;
dpptr(dd)->colmain = dpSavedptr(dd)->colmain;
dpptr(dd)->collab = dpSavedptr(dd)->collab;
dpptr(dd)->colsub = dpSavedptr(dd)->colsub;
dpptr(dd)->colaxis = dpSavedptr(dd)->colaxis;
/* must restore layout parameters; the different graphics */
/* regions and coordinate transformations will be recalculated */
/* but they need all of the layout information restored for this */
/* to happen correctly */
dpptr(dd)->devmode = dpSavedptr(dd)->devmode;
dpptr(dd)->fig[0] = dpSavedptr(dd)->fig[0];
dpptr(dd)->fig[1] = dpSavedptr(dd)->fig[1];
dpptr(dd)->fig[2] = dpSavedptr(dd)->fig[2];
dpptr(dd)->fig[3] = dpSavedptr(dd)->fig[3];
dpptr(dd)->fin[0] = dpSavedptr(dd)->fin[0];
dpptr(dd)->fin[1] = dpSavedptr(dd)->fin[1];
dpptr(dd)->fUnits = dpSavedptr(dd)->fUnits;
dpptr(dd)->defaultFigure = dpSavedptr(dd)->defaultFigure;
dpptr(dd)->mar[0] = dpSavedptr(dd)->mar[0];
dpptr(dd)->mar[1] = dpSavedptr(dd)->mar[1];
dpptr(dd)->mar[2] = dpSavedptr(dd)->mar[2];
dpptr(dd)->mar[3] = dpSavedptr(dd)->mar[3];
dpptr(dd)->mai[0] = dpSavedptr(dd)->mai[0];
dpptr(dd)->mai[1] = dpSavedptr(dd)->mai[1];
dpptr(dd)->mai[2] = dpSavedptr(dd)->mai[2];
dpptr(dd)->mai[3] = dpSavedptr(dd)->mai[3];
dpptr(dd)->mUnits = dpSavedptr(dd)->mUnits;
dpptr(dd)->mex = dpSavedptr(dd)->mex;
nr = dpptr(dd)->numrows = dpSavedptr(dd)->numrows;
nc = dpptr(dd)->numcols = dpSavedptr(dd)->numcols;
dpptr(dd)->currentFigure = dpSavedptr(dd)->currentFigure;
dpptr(dd)->lastFigure = dpSavedptr(dd)->lastFigure;
for (i = 0; i < nr && i < MAX_LAYOUT_ROWS; i++) {
dpptr(dd)->heights[i] = dpSavedptr(dd)->heights[i];
dpptr(dd)->cmHeights[i] = dpSavedptr(dd)->cmHeights[i];
}
for (j = 0; j < nc && j < MAX_LAYOUT_COLS; j++) {
dpptr(dd)->widths[j] = dpSavedptr(dd)->widths[j];
dpptr(dd)->cmWidths[j] = dpSavedptr(dd)->cmWidths[j];
}
for (i = 0; i < nr*nc && i < MAX_LAYOUT_CELLS; i++) {
dpptr(dd)->order[i] = dpSavedptr(dd)->order[i];
dpptr(dd)->respect[i] = dpSavedptr(dd)->respect[i];
}
dpptr(dd)->rspct = dpSavedptr(dd)->rspct;
dpptr(dd)->layout = dpSavedptr(dd)->layout;
dpptr(dd)->mfind = dpSavedptr(dd)->mfind;
dpptr(dd)->new = dpSavedptr(dd)->new;
dpptr(dd)->oma[0] = dpSavedptr(dd)->oma[0];
dpptr(dd)->oma[1] = dpSavedptr(dd)->oma[1];
dpptr(dd)->oma[2] = dpSavedptr(dd)->oma[2];
dpptr(dd)->oma[3] = dpSavedptr(dd)->oma[3];
dpptr(dd)->omi[0] = dpSavedptr(dd)->omi[0];
dpptr(dd)->omi[1] = dpSavedptr(dd)->omi[1];
dpptr(dd)->omi[2] = dpSavedptr(dd)->omi[2];
dpptr(dd)->omi[3] = dpSavedptr(dd)->omi[3];
dpptr(dd)->omd[0] = dpSavedptr(dd)->omd[0];
dpptr(dd)->omd[1] = dpSavedptr(dd)->omd[1];
dpptr(dd)->omd[2] = dpSavedptr(dd)->omd[2];
dpptr(dd)->omd[3] = dpSavedptr(dd)->omd[3];
dpptr(dd)->oUnits = dpSavedptr(dd)->oUnits;
dpptr(dd)->plt[0] = dpSavedptr(dd)->plt[0];
dpptr(dd)->plt[1] = dpSavedptr(dd)->plt[1];
dpptr(dd)->plt[2] = dpSavedptr(dd)->plt[2];
dpptr(dd)->plt[3] = dpSavedptr(dd)->plt[3];
dpptr(dd)->pin[0] = dpSavedptr(dd)->pin[0];
dpptr(dd)->pin[1] = dpSavedptr(dd)->pin[1];
dpptr(dd)->pUnits = dpSavedptr(dd)->pUnits;
dpptr(dd)->defaultPlot = dpSavedptr(dd)->defaultPlot;
dpptr(dd)->pty = dpSavedptr(dd)->pty;
dpptr(dd)->usr[0] = dpSavedptr(dd)->usr[0];
dpptr(dd)->usr[1] = dpSavedptr(dd)->usr[1];
dpptr(dd)->usr[2] = dpSavedptr(dd)->usr[2];
dpptr(dd)->usr[3] = dpSavedptr(dd)->usr[3];
dpptr(dd)->logusr[0] = dpSavedptr(dd)->logusr[0];
dpptr(dd)->logusr[1] = dpSavedptr(dd)->logusr[1];
dpptr(dd)->logusr[2] = dpSavedptr(dd)->logusr[2];
dpptr(dd)->logusr[3] = dpSavedptr(dd)->logusr[3];
}
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;
}
