The R Project SVN R

Rev

Rev 29897 | Rev 30186 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 29897 Rev 30129
Line 130... Line 130...
130 
	    s = CDR(s);
 130 
	    s = CDR(s);
131 
	}
 131 
	}
132 
    }
 132 
    }
133 
}
 133 
}
134 
 
 134 
 
- 
 
 135 
/*
- 
 
 136 
 * Extract specified par from list of inline pars
- 
 
 137 
 */
- 
 
 138 
SEXP getInlinePar(SEXP s, char *name)
- 
 
 139 
{
- 
 
 140 
    SEXP result = R_NilValue;
- 
 
 141 
    int found = 0;
- 
 
 142 
    if (isList(s) && !found) {
- 
 
 143 
	while (s != R_NilValue) {
- 
 
 144 
	    if (isList(CAR(s))) {
- 
 
 145 
		result = getInlinePar(CAR(s), name);
- 
 
 146 
		if (result)
- 
 
 147 
		    found = 1;
- 
 
 148 
	    } else
- 
 
 149 
		if (TAG(s) != R_NilValue)
- 
 
 150 
		    if (!strcmp(CHAR(PRINTNAME(TAG(s))), name)) {
- 
 
 151 
			result = CAR(s);
- 
 
 152 
			found = 1;
- 
 
 153 
		    }
- 
 
 154 
	    s = CDR(s);
- 
 
 155 
	}
- 
 
 156 
    }
- 
 
 157 
    return result;
- 
 
 158 
}
- 
 
 159 
 
135 
SEXP FixupPch(SEXP pch, int dflt)
 160 
SEXP FixupPch(SEXP pch, int dflt)
136 
{
 161 
{
137 
    int i, n;
 162 
    int i, n;
138 
    SEXP ans = R_NilValue;/* -Wall*/
 163 
    SEXP ans = R_NilValue;/* -Wall*/
139 
 
 164 
 
Line 371... Line 396...
371 
 */
 396 
 */
372 
static void
 397 
static void
373 
GetTextArg(SEXP call, SEXP spec, SEXP *ptxt,
 398 
GetTextArg(SEXP call, SEXP spec, SEXP *ptxt,
374 
	   int *pcol, double *pcex, int *pfont, SEXP *pvfont)
 399 
	   int *pcol, double *pcex, int *pfont, SEXP *pvfont)
375 
{
 400 
{
376 
    int i, n, col, font;
 401 
    int i, n, col, font, colspecd;
377 
    double cex;
 402 
    double cex;
378 
    SEXP txt, vfont, nms;
 403 
    SEXP txt, vfont, nms;
379 
 
 404 
 
380 
    txt	  = R_NilValue;
 405 
    txt	  = R_NilValue;
381 
    vfont = R_NilValue;
 406 
    vfont = R_NilValue;
382 
    cex	  = NA_REAL;
 407 
    cex	  = NA_REAL;
383 
    col	  = NA_INTEGER;
 408 
    col	  = NA_INTEGER;
- 
 
 409 
    colspecd = 0;
384 
    font  = NA_INTEGER;
 410 
    font  = NA_INTEGER;
385 
    PROTECT(txt);
 411 
    PROTECT(txt);
386 
 
 412 
 
387 
    switch (TYPEOF(spec)) {
 413 
    switch (TYPEOF(spec)) {
388 
    case LANGSXP:
 414 
    case LANGSXP:
Line 411... Line 437...
411 
	       for (i = 0; i < n; i++) {
 437 
	       for (i = 0; i < n; i++) {
412 
		if (!strcmp(CHAR(STRING_ELT(nms, i)), "cex")) {
 438 
		if (!strcmp(CHAR(STRING_ELT(nms, i)), "cex")) {
413 
		    cex = asReal(VECTOR_ELT(spec, i));
 439 
		    cex = asReal(VECTOR_ELT(spec, i));
414 
		}
 440 
		}
415 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) {
 441 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) {
- 
 
 442 
		    SEXP colsxp = VECTOR_ELT(spec, i);
- 
 
 443 
		    if (!isNAcol(colsxp, 0, LENGTH(colsxp))) {
416 
		    col = asInteger(FixupCol(VECTOR_ELT(spec, i), NA_INTEGER));
 444 
			col = asInteger(FixupCol(colsxp, NA_INTEGER));
- 
 
 445 
			colspecd = 1;
- 
 
 446 
		    }
417 
		}
 447 
		}
418 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {
 448 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {
419 
		    font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));
 449 
		    font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));
420 
		}
 450 
		}
421 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "vfont")) {
 451 
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "vfont")) {
Line 447... Line 477...
447 
    }
 477 
    }
448 
    UNPROTECT(1);
 478 
    UNPROTECT(1);
449 
    if (txt != R_NilValue) {
 479 
    if (txt != R_NilValue) {
450 
	*ptxt = txt;
 480 
	*ptxt = txt;
451 
	if (R_FINITE(cex))	 *pcex	 = cex;
 481 
	if (R_FINITE(cex))	 *pcex	 = cex;
452 
	if (col != NA_INTEGER)	 *pcol	 = col;
 482 
	if (colspecd)	         *pcol	 = col;
453 
	if (font != NA_INTEGER)	 *pfont	 = font;
 483 
	if (font != NA_INTEGER)	 *pfont	 = font;
454 
	if (vfont != R_NilValue) *pvfont = vfont;
 484 
	if (vfont != R_NilValue) *pvfont = vfont;
455 
    }
 485 
    }
456 
}/* GetTextArg */
 486 
}/* GetTextArg */
457 
 
 487 
 
Line 1525... Line 1555...
1525 
	for (i = 0; i < n; i++) {
 1555 
	for (i = 0; i < n; i++) {
1526 
	    xx = x[i];
 1556 
	    xx = x[i];
1527 
	    yy = y[i];
 1557 
	    yy = y[i];
1528 
	    GConvert(&xx, &yy, USER, DEVICE, dd);
 1558 
	    GConvert(&xx, &yy, USER, DEVICE, dd);
1529 
	    if (R_FINITE(xx) && R_FINITE(yy)
 1559 
	    if (R_FINITE(xx) && R_FINITE(yy)
1530 
		&& (thiscol = INTEGER(col)[i % ncol]) != NA_INTEGER) {
 1560 
		&& !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol])) {
1531 
		Rf_gpptr(dd)->col = thiscol;
 1561 
		Rf_gpptr(dd)->col = thiscol;
1532 
		GLine(xx, yold, xx, yy, DEVICE, dd);
 1562 
		GLine(xx, yold, xx, yy, DEVICE, dd);
1533 
	    }
 1563 
	    }
1534 
	}
 1564 
	}
1535 
	break;
 1565 
	break;
Line 1549... Line 1579...
1549 
	    yy = y[i];
 1579 
	    yy = y[i];
1550 
	    GConvert(&xx, &yy, USER, DEVICE, dd);
 1580 
	    GConvert(&xx, &yy, USER, DEVICE, dd);
1551 
	    if (R_FINITE(xx) && R_FINITE(yy)) {
 1581 
	    if (R_FINITE(xx) && R_FINITE(yy)) {
1552 
		if (R_FINITE(thiscex = REAL(cex)[i % ncex])
 1582 
		if (R_FINITE(thiscex = REAL(cex)[i % ncex])
1553 
		    && (thispch = INTEGER(pch)[i % npch]) != NA_INTEGER
 1583 
		    && (thispch = INTEGER(pch)[i % npch]) != NA_INTEGER
1554 
		    && (thiscol = INTEGER(col)[i % ncol]) != NA_INTEGER)
 1584 
		    && !R_TRANSPARENT(thiscol = INTEGER(col)[i % ncol]))
1555 
		{
 1585 
		{
1556 
		    Rf_gpptr(dd)->cex = thiscex * Rf_gpptr(dd)->cexbase;
 1586 
		    Rf_gpptr(dd)->cex = thiscex * Rf_gpptr(dd)->cexbase;
1557 
		    Rf_gpptr(dd)->col = thiscol;
 1587 
		    Rf_gpptr(dd)->col = thiscol;
1558 
		    Rf_gpptr(dd)->bg = INTEGER(bg)[i % nbg];
 1588 
		    Rf_gpptr(dd)->bg = INTEGER(bg)[i % nbg];
1559 
		    GSymbol(xx, yy, DEVICE, thispch, dd);
 1589 
		    GSymbol(xx, yy, DEVICE, thispch, dd);
Line 1754... Line 1784...
1754 
 
 1784 
 
1755 
 
 1785 
 
1756 
SEXP do_arrows(SEXP call, SEXP op, SEXP args, SEXP env)
 1786 
SEXP do_arrows(SEXP call, SEXP op, SEXP args, SEXP env)
1757 
{
 1787 
{
1758 
    /* arrows(x0, y0, x1, y1, length, angle, code, col, lty, lwd, xpd) */
 1788 
    /* arrows(x0, y0, x1, y1, length, angle, code, col, lty, lwd, xpd) */
1759 
    SEXP sx0, sx1, sy0, sy1, sxpd, col, lty, lwd;
 1789 
    SEXP sx0, sx1, sy0, sy1, sxpd, col, rawcol, lty, lwd;
1760 
    double *x0, *x1, *y0, *y1;
 1790 
    double *x0, *x1, *y0, *y1;
1761 
    double xx0, yy0, xx1, yy1;
 1791 
    double xx0, yy0, xx1, yy1;
1762 
    double hlength, angle;
 1792 
    double hlength, angle;
1763 
    int code;
 1793 
    int code;
1764 
    int nx0, nx1, ny0, ny1, i, n, ncol, nlty, nlwd, xpd;
 1794 
    int nx0, nx1, ny0, ny1, i, n, ncol, nlty, nlwd, xpd;
Line 1788... Line 1818...
1788 
    code = asInteger(CAR(args));
 1818 
    code = asInteger(CAR(args));
1789 
    if (code == NA_INTEGER || code < 0 || code > 3)
 1819 
    if (code == NA_INTEGER || code < 0 || code > 3)
1790 
	errorcall(call, "invalid arrow head specification");
 1820 
	errorcall(call, "invalid arrow head specification");
1791 
    args = CDR(args);
 1821 
    args = CDR(args);
1792 
 
 1822 
 
- 
 
 1823 
    /*
- 
 
 1824 
     * Need raw colours to be able to check for NAs
- 
 
 1825 
     * FixupCol converts NAs to fully transparent
- 
 
 1826 
     */
- 
 
 1827 
    rawcol = CAR(args);
1793 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));
 1828 
    PROTECT(col = FixupCol(rawcol, NA_INTEGER));
1794 
    ncol = LENGTH(col);
 1829 
    ncol = LENGTH(col);
1795 
    args = CDR(args);
 1830 
    args = CDR(args);
1796 
 
 1831 
 
1797 
    PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));
 1832 
    PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));
1798 
    nlty = length(lty);
 1833 
    nlty = length(lty);
Line 1830... Line 1865...
1830 
	xx1 = x1[i%nx1];
 1865 
	xx1 = x1[i%nx1];
1831 
	yy1 = y1[i%ny1];
 1866 
	yy1 = y1[i%ny1];
1832 
	GConvert(&xx0, &yy0, USER, DEVICE, dd);
 1867 
	GConvert(&xx0, &yy0, USER, DEVICE, dd);
1833 
	GConvert(&xx1, &yy1, USER, DEVICE, dd);
 1868 
	GConvert(&xx1, &yy1, USER, DEVICE, dd);
1834 
	if (R_FINITE(xx0) && R_FINITE(yy0) && R_FINITE(xx1) && R_FINITE(yy1)) {
 1869 
	if (R_FINITE(xx0) && R_FINITE(yy0) && R_FINITE(xx1) && R_FINITE(yy1)) {
1835 
	  Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
 - 
 
1836 
	    if (Rf_gpptr(dd)->col == NA_INTEGER)
 1870 
	    if (isNAcol(rawcol, i, ncol))
1837 
		Rf_gpptr(dd)->col = Rf_dpptr(dd)->col;
 1871 
		Rf_gpptr(dd)->col = Rf_dpptr(dd)->col;
- 
 
 1872 
	    else
- 
 
 1873 
		Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
1838 
	    if (nlty == 0 || INTEGER(lty)[i % nlty] == NA_INTEGER)
 1874 
	    if (nlty == 0 || INTEGER(lty)[i % nlty] == NA_INTEGER)
1839 
		Rf_gpptr(dd)->lty = Rf_dpptr(dd)->lty;
 1875 
		Rf_gpptr(dd)->lty = Rf_dpptr(dd)->lty;
1840 
	    else
 1876 
	    else
1841 
		Rf_gpptr(dd)->lty = INTEGER(lty)[i % nlty];
 1877 
		Rf_gpptr(dd)->lty = INTEGER(lty)[i % nlty];
1842 
	    Rf_gpptr(dd)->lwd = REAL(lwd)[i % nlwd];
 1878 
	    Rf_gpptr(dd)->lwd = REAL(lwd)[i % nlwd];
Line 1956... Line 1992...
1956 
SEXP do_text(SEXP call, SEXP op, SEXP args, SEXP env)
 1992 
SEXP do_text(SEXP call, SEXP op, SEXP args, SEXP env)
1957 
{
 1993 
{
1958 
/* text(xy, labels, adj, pos, offset,
 1994 
/* text(xy, labels, adj, pos, offset,
1959 
 *	vfont, cex, col, font, xpd, ...)
 1995 
 *	vfont, cex, col, font, xpd, ...)
1960 
 */
 1996 
 */
1961 
    SEXP sx, sy, sxy, sxpd, txt, adj, pos, cex, col, font, vfont;
 1997 
    SEXP sx, sy, sxy, sxpd, txt, adj, pos, cex, col, rawcol, font, vfont;
1962 
    int i, n, npos, ncex, ncol, nfont, ntxt, xpd;
 1998 
    int i, n, npos, ncex, ncol, nfont, ntxt, xpd;
1963 
    double adjx = 0, adjy = 0, offset = 0.5;
 1999 
    double adjx = 0, adjy = 0, offset = 0.5;
1964 
    double *x, *y;
 2000 
    double *x, *y;
1965 
    double xx, yy;
 2001 
    double xx, yy;
1966 
    Rboolean vectorFonts = FALSE;
 2002 
    Rboolean vectorFonts = FALSE;
Line 2029... Line 2065...
2029 
 
 2065 
 
2030 
    PROTECT(cex = FixupCex(CAR(args), 1.0));
 2066 
    PROTECT(cex = FixupCex(CAR(args), 1.0));
2031 
    ncex = LENGTH(cex);
 2067 
    ncex = LENGTH(cex);
2032 
    args = CDR(args);
 2068 
    args = CDR(args);
2033 
 
 2069 
 
- 
 
 2070 
    rawcol = CAR(args);
2034 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));
 2071 
    PROTECT(col = FixupCol(rawcol, NA_INTEGER));
2035 
    ncol = LENGTH(col);
 2072 
    ncol = LENGTH(col);
2036 
    args = CDR(args);
 2073 
    args = CDR(args);
2037 
 
 2074 
 
2038 
    PROTECT(font = FixupFont(CAR(args), NA_INTEGER));
 2075 
    PROTECT(font = FixupFont(CAR(args), NA_INTEGER));
2039 
    nfont = LENGTH(font);
 2076 
    nfont = LENGTH(font);
Line 2060... Line 2097...
2060 
    for (i = 0; i < n; i++) {
 2097 
    for (i = 0; i < n; i++) {
2061 
	xx = x[i % n];
 2098 
	xx = x[i % n];
2062 
	yy = y[i % n];
 2099 
	yy = y[i % n];
2063 
	GConvert(&xx, &yy, USER, INCHES, dd);
 2100 
	GConvert(&xx, &yy, USER, INCHES, dd);
2064 
	if (R_FINITE(xx) && R_FINITE(yy)) {
 2101 
	if (R_FINITE(xx) && R_FINITE(yy)) {
2065 
	    if (ncol && INTEGER(col)[i % ncol] != NA_INTEGER)
 2102 
	    if (ncol && !isNAcol(rawcol, i, ncol))
2066 
		Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
 2103 
		Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
2067 
	    else
 2104 
	    else
2068 
		Rf_gpptr(dd)->col = Rf_dpptr(dd)->col;
 2105 
		Rf_gpptr(dd)->col = Rf_dpptr(dd)->col;
2069 
	    if (ncex && R_FINITE(REAL(cex)[i%ncex]))
 2106 
	    if (ncex && R_FINITE(REAL(cex)[i%ncex]))
2070 
		Rf_gpptr(dd)->cex = Rf_gpptr(dd)->cexbase * REAL(cex)[i % ncex];
 2107 
		Rf_gpptr(dd)->cex = Rf_gpptr(dd)->cexbase * REAL(cex)[i % ncex];
Line 2241... Line 2278...
2241 
	 ...) */
 2278 
	 ...) */
2242 
 
 2279 
 
2243 
SEXP do_mtext(SEXP call, SEXP op, SEXP args, SEXP env)
 2280 
SEXP do_mtext(SEXP call, SEXP op, SEXP args, SEXP env)
2244 
{
 2281 
{
2245 
    SEXP text, side, line, outer, at, adj, cex, col, font, vfont, string;
 2282 
    SEXP text, side, line, outer, at, adj, cex, col, font, vfont, string;
- 
 
 2283 
    SEXP rawcol;
2246 
    int ntext, nside, nline, nouter, nat, nadj, ncex, ncol, nfont;
 2284 
    int ntext, nside, nline, nouter, nat, nadj, ncex, ncol, nfont;
2247 
    Rboolean dirtyplot = FALSE, gpnewsave = FALSE, dpnewsave = FALSE;
 2285 
    Rboolean dirtyplot = FALSE, gpnewsave = FALSE, dpnewsave = FALSE;
2248 
    Rboolean vectorFonts = FALSE;
 2286 
    Rboolean vectorFonts = FALSE;
2249 
    int i, n, fontsave, colsave;
 2287 
    int i, n, fontsave, colsave;
2250 
    double cexsave;
 2288 
    double cexsave;
Line 2310... Line 2348...
2310 
    if (ncex <= 0) errorcall(call, "zero length \"cex\" specified");
 2348 
    if (ncex <= 0) errorcall(call, "zero length \"cex\" specified");
2311 
    if (n < ncex) n = ncex;
 2349 
    if (n < ncex) n = ncex;
2312 
    args = CDR(args);
 2350 
    args = CDR(args);
2313 
 
 2351 
 
2314 
    /* Arg8 : col */
 2352 
    /* Arg8 : col */
- 
 
 2353 
    rawcol = CAR(args);
2315 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));
 2354 
    PROTECT(col = FixupCol(rawcol, NA_INTEGER));
2316 
    ncol = length(col);
 2355 
    ncol = length(col);
2317 
    if (ncol <= 0) errorcall(call, "zero length \"col\" specified");
 2356 
    if (ncol <= 0) errorcall(call, "zero length \"col\" specified");
2318 
    if (n < ncol) n = ncol;
 2357 
    if (n < ncol) n = ncol;
2319 
    args = CDR(args);
 2358 
    args = CDR(args);
2320 
 
 2359 
 
Line 2372... Line 2411...
2372 
	/* by mfrow / mfcol specs here.	 I.e. don't */
 2411 
	/* by mfrow / mfcol specs here.	 I.e. don't */
2373 
	/* Rf_gpptr(dd)->cexbase. */
 2412 
	/* Rf_gpptr(dd)->cexbase. */
2374 
	if (R_FINITE(cexval)) Rf_gpptr(dd)->cex = cexval;
 2413 
	if (R_FINITE(cexval)) Rf_gpptr(dd)->cex = cexval;
2375 
	else cexval = cexsave;
 2414 
	else cexval = cexsave;
2376 
	Rf_gpptr(dd)->font = (fontval == NA_INTEGER) ? fontsave : fontval;
 2415 
	Rf_gpptr(dd)->font = (fontval == NA_INTEGER) ? fontsave : fontval;
- 
 
 2416 
	if (isNAcol(rawcol, i, ncol))
2377 
	Rf_gpptr(dd)->col = (colval == NA_INTEGER) ? colsave : colval;
 2417 
	    Rf_gpptr(dd)->col = colsave;
- 
 
 2418 
	else
- 
 
 2419 
	    Rf_gpptr(dd)->col = colval;
2378 
	Rf_gpptr(dd)->adj = ComputeAdjValue(adjval, sideval, Rf_gpptr(dd)->las);
 2420 
	Rf_gpptr(dd)->adj = ComputeAdjValue(adjval, sideval, Rf_gpptr(dd)->las);
2379 
	atval = ComputeAtValue(atval, Rf_gpptr(dd)->adj, sideval, Rf_gpptr(dd)->las,
 2421 
	atval = ComputeAtValue(atval, Rf_gpptr(dd)->adj, sideval, Rf_gpptr(dd)->las,
2380 
			       outerval, dd);
 2422 
			       outerval, dd);
2381 
 
 2423 
 
2382 
	if (vectorFonts) {
 2424 
	if (vectorFonts) {
Line 2853... Line 2895...
2853 
{
 2895 
{
2854 
/*     box(which="plot", lty="solid", ...)
 2896 
/*     box(which="plot", lty="solid", ...)
2855 
       --- which is coded, 1 = plot, 2 = figure, 3 = inner, 4 = outer.
 2897 
       --- which is coded, 1 = plot, 2 = figure, 3 = inner, 4 = outer.
2856 
*/
 2898 
*/
2857 
    int which, col;
 2899 
    int which, col;
- 
 
 2900 
    SEXP colsxp, fgsxp;
2858 
    SEXP originalArgs = args;
 2901 
    SEXP originalArgs = args;
2859 
    DevDesc *dd = CurrentDevice();
 2902 
    DevDesc *dd = CurrentDevice();
2860 
 
 2903 
 
2861 
    GCheckState(dd);
 2904 
    GCheckState(dd);
2862 
    GSavePars(dd);
 2905 
    GSavePars(dd);
2863 
    which = asInteger(CAR(args)); args = CDR(args);
 2906 
    which = asInteger(CAR(args)); args = CDR(args);
2864 
    if (which < 1 || which > 4)
 2907 
    if (which < 1 || which > 4)
2865 
	errorcall(call, "invalid \"which\" specification");
 2908 
	errorcall(call, "invalid \"which\" specification");
- 
 
 2909 
    /*
- 
 
 2910 
     * If specified non-NA col then use that, else ...
- 
 
 2911 
     *
2866 
    col= Rf_gpptr(dd)->col;	Rf_gpptr(dd)->col= NA_INTEGER;
 2912 
     * if specified non-NA fg then use that, else ...
- 
 
 2913 
     *
- 
 
 2914 
     * else use par("col")
- 
 
 2915 
     */
2867 
    Rf_gpptr(dd)->fg = NA_INTEGER;
 2916 
    col= Rf_gpptr(dd)->col;
2868 
    ProcessInlinePars(args, dd, call);
 2917 
    ProcessInlinePars(args, dd, call);
2869 
    if (Rf_gpptr(dd)->col == NA_INTEGER) {/* col := 'fg' or original 'col' */
 2918 
    colsxp = getInlinePar(args, "col");
- 
 
 2919 
    if (isNAcol(colsxp, 0, 1)) {
- 
 
 2920 
	fgsxp = getInlinePar(args, "fg");
2870 
	if (Rf_gpptr(dd)->fg == NA_INTEGER)
 2921 
	if (isNAcol(fgsxp, 0, 1))
2871 
	    Rf_gpptr(dd)->col = col;
 2922 
	    Rf_gpptr(dd)->col = col;
2872 
	else
 2923 
	else
2873 
	    Rf_gpptr(dd)->col = Rf_gpptr(dd)->fg;
 2924 
	    Rf_gpptr(dd)->col = Rf_gpptr(dd)->fg;
2874 
    }
 2925 
    }
2875 
    /* override par("xpd") and force clipping to device region */
 2926 
    /* override par("xpd") and force clipping to device region */
2876 
    Rf_gpptr(dd)->xpd = 2;
 2927 
    Rf_gpptr(dd)->xpd = 2;
2877 
    GMode(1, dd);
 2928 
    GMode(1, dd);
2878 
    GBox(which, dd);
 2929 
    GBox(which, dd);
2879 
    GMode(0, dd);
 2930 
    GMode(0, dd);