SEXP 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;
unsigned int col;
int n, i, i4;
checkArity(op, args);
PROTECT(colors = coerceVector(CAR(args),STRSXP));
n = LENGTH(colors);
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);
for(i = i4 = 0; i < n; i++, i4 += 4) {
col = str2col(CHAR(STRING_ELT(colors, i)));
INTEGER(ans)[i4 +0] = R_RED(col);
INTEGER(ans)[i4 +1] = R_GREEN(col);
INTEGER(ans)[i4 +2] = R_BLUE(col);
INTEGER(ans)[i4 +3] = R_ALPHA(col);
}
UNPROTECT(3);
return ans;
}
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;
}
