The R Project SVN – R – Diff – /trunk/src/main/plot.c



    SEXP txt, vfont, nms;
 
    txt	  = R_NilValue;
    vfont = R_NilValue;
    cex	  = NA_REAL;
    col	  = R_TRANWHITE;
    colspecd = 0;
    font  = NA_INTEGER;
    PROTECT(txt);
 
    switch (TYPEOF(spec)) {

		    cex = asReal(VECTOR_ELT(spec, i));
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) {
		    SEXP colsxp = VECTOR_ELT(spec, i);
		    if (!isNAcol(colsxp, 0, LENGTH(colsxp))) {
			col = asInteger(FixupCol(colsxp, R_TRANWHITE));
			colspecd = 1;
		    }
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {
		    font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));

       the specific drivers. */
 
    PROTECT(col = FixupCol(CAR(args), 0));		args = CDR(args);
    ncol = LENGTH(col);
 
    PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE));	args = CDR(args);
    nbg = LENGTH(bg);
 
    PROTECT(cex = FixupCex(CAR(args), 1.0));		args = CDR(args);
    ncex = LENGTH(cex);
 

    sx0 = CAR(args); nx0 = length(sx0); args = CDR(args);
    sy0 = CAR(args); ny0 = length(sy0); args = CDR(args);
    sx1 = CAR(args); nx1 = length(sx1); args = CDR(args);
    sy1 = CAR(args); ny1 = length(sy1); args = CDR(args);
 
    PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));
    ncol = LENGTH(col); args = CDR(args);
 
    PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));
    nlty = length(lty); args = CDR(args);
 

    sxl = CAR(args); nxl = length(sxl); args = CDR(args);/* x_left */
    syb = CAR(args); nyb = length(syb); args = CDR(args);/* y_bottom */
    sxr = CAR(args); nxr = length(sxr); args = CDR(args);/* x_right */
    syt = CAR(args); nyt = length(syt); args = CDR(args);/* y_top */
 
    PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));
    ncol = LENGTH(col);
    args = CDR(args);
 
    PROTECT(border =  FixupCol(CAR(args), Rf_gpptr(dd)->fg));
    nborder = LENGTH(border);

    /*
     * Need raw colours to be able to check for NAs
     * FixupCol converts NAs to fully transparent
     */
    rawcol = CAR(args);
    PROTECT(col = FixupCol(rawcol, R_TRANWHITE));
    ncol = LENGTH(col);
    args = CDR(args);
 
    PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));
    nlty = length(lty);

    /* (x,y) is checked in R via xy.coords() ; no need here : */
    sx = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
    sy = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
    nx = LENGTH(sx);
 
    PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));	args = CDR(args);
    ncol = LENGTH(col);
 
    PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg));	args = CDR(args);
    nborder = LENGTH(border);
 

    PROTECT(cex = FixupCex(CAR(args), 1.0));
    ncex = LENGTH(cex);
    args = CDR(args);
 
    rawcol = CAR(args);
    PROTECT(col = FixupCol(rawcol, R_TRANWHITE));
    ncol = LENGTH(col);
    args = CDR(args);
 
    PROTECT(font = FixupFont(CAR(args), NA_INTEGER));
    nfont = LENGTH(font);

    if (n < ncex) n = ncex;
    args = CDR(args);
 
    /* Arg8 : col */
    rawcol = CAR(args);
    PROTECT(col = FixupCol(rawcol, R_TRANWHITE));
    ncol = length(col);
    if (ncol <= 0) errorcall(call, "zero length \"col\" specified");
    if (n < ncol) n = ncol;
    args = CDR(args);
 

    if ((untf = CAR(args)) != R_NilValue)
	SETCAR(args, untf = coerceVector(untf, LGLSXP));
    args = CDR(args);
 
 
    PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));	args = CDR(args);
    ncol = LENGTH(col);
 
    PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty)); args = CDR(args);
    nlty = length(lty);
 

{
    SEXP col;
    int ncol;
    DevDesc *dd = CurrentDevice();
    checkArity(op, args);
    PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));
    ncol = LENGTH(col);
    GSavePars(dd);
    GMode(1, dd);
    GRect(0.0, 0.0, 1.0, 1.0, NDC, INTEGER(col)[0], R_TRANWHITE, dd);
    GMode(0, dd);
    GRestorePars(dd);
    UNPROTECT(1);
    return R_NilValue;
}

 
    inches = asReal(CAR(args)); args = CDR(args);
    if (!R_FINITE(inches) || inches < 0)
	inches = 0;
 
    PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);
    nbg = LENGTH(bg);
 
    PROTECT(fg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);
    nfg = LENGTH(fg);
 
    GSavePars(dd);
    ProcessInlinePars(args, dd, call);
 

Rev 30819	Rev 30980
Line 403...	Line 403...
403	`SEXP txt, vfont, nms;`	403	`SEXP txt, vfont, nms;`
404		404
405	`txt = R_NilValue;`	405	`txt = R_NilValue;`
406	`vfont = R_NilValue;`	406	`vfont = R_NilValue;`
407	`cex = NA_REAL;`	407	`cex = NA_REAL;`
408	`col = NA_INTEGER;`	408	`col = R_TRANWHITE;`
409	`colspecd = 0;`	409	`colspecd = 0;`
410	`font = NA_INTEGER;`	410	`font = NA_INTEGER;`
411	`PROTECT(txt);`	411	`PROTECT(txt);`
412		412
413	`switch (TYPEOF(spec)) {`	413	`switch (TYPEOF(spec)) {`
Line 439...	Line 439...
439	`cex = asReal(VECTOR_ELT(spec, i));`	439	`cex = asReal(VECTOR_ELT(spec, i));`
440	`}`	440	`}`
441	`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);`	442	`SEXP colsxp = VECTOR_ELT(spec, i);`
443	`if (!isNAcol(colsxp, 0, LENGTH(colsxp))) {`	443	`if (!isNAcol(colsxp, 0, LENGTH(colsxp))) {`
444	`col = asInteger(FixupCol(colsxp, NA_INTEGER));`	444	`col = asInteger(FixupCol(colsxp, R_TRANWHITE));`
445	`colspecd = 1;`	445	`colspecd = 1;`
446	`}`	446	`}`
447	`}`	447	`}`
448	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {`	448	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {`
449	`font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));`	449	`font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));`
Line 1419...	Line 1419...
1419	`the specific drivers. */`	1419	`the specific drivers. */`
1420		1420
1421	`PROTECT(col = FixupCol(CAR(args), 0)); args = CDR(args);`	1421	`PROTECT(col = FixupCol(CAR(args), 0)); args = CDR(args);`
1422	`ncol = LENGTH(col);`	1422	`ncol = LENGTH(col);`
1423		1423
1424	`PROTECT(bg = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	1424	`PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);`
1425	`nbg = LENGTH(bg);`	1425	`nbg = LENGTH(bg);`
1426		1426
1427	`PROTECT(cex = FixupCex(CAR(args), 1.0)); args = CDR(args);`	1427	`PROTECT(cex = FixupCex(CAR(args), 1.0)); args = CDR(args);`
1428	`ncex = LENGTH(cex);`	1428	`ncex = LENGTH(cex);`
1429		1429
Line 1658...	Line 1658...
1658	`sx0 = CAR(args); nx0 = length(sx0); args = CDR(args);`	1658	`sx0 = CAR(args); nx0 = length(sx0); args = CDR(args);`
1659	`sy0 = CAR(args); ny0 = length(sy0); args = CDR(args);`	1659	`sy0 = CAR(args); ny0 = length(sy0); args = CDR(args);`
1660	`sx1 = CAR(args); nx1 = length(sx1); args = CDR(args);`	1660	`sx1 = CAR(args); nx1 = length(sx1); args = CDR(args);`
1661	`sy1 = CAR(args); ny1 = length(sy1); args = CDR(args);`	1661	`sy1 = CAR(args); ny1 = length(sy1); args = CDR(args);`
1662		1662
1663	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER));`	1663	`PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));`
1664	`ncol = LENGTH(col); args = CDR(args);`	1664	`ncol = LENGTH(col); args = CDR(args);`
1665		1665
1666	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));`	1666	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));`
1667	`nlty = length(lty); args = CDR(args);`	1667	`nlty = length(lty); args = CDR(args);`
1668		1668
Line 1722...	Line 1722...
1722	`sxl = CAR(args); nxl = length(sxl); args = CDR(args);/* x_left */`	1722	`sxl = CAR(args); nxl = length(sxl); args = CDR(args);/* x_left */`
1723	`syb = CAR(args); nyb = length(syb); args = CDR(args);/* y_bottom */`	1723	`syb = CAR(args); nyb = length(syb); args = CDR(args);/* y_bottom */`
1724	`sxr = CAR(args); nxr = length(sxr); args = CDR(args);/* x_right */`	1724	`sxr = CAR(args); nxr = length(sxr); args = CDR(args);/* x_right */`
1725	`syt = CAR(args); nyt = length(syt); args = CDR(args);/* y_top */`	1725	`syt = CAR(args); nyt = length(syt); args = CDR(args);/* y_top */`
1726		1726
1727	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER));`	1727	`PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));`
1728	`ncol = LENGTH(col);`	1728	`ncol = LENGTH(col);`
1729	`args = CDR(args);`	1729	`args = CDR(args);`
1730		1730
1731	`PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg));`	1731	`PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg));`
1732	`nborder = LENGTH(border);`	1732	`nborder = LENGTH(border);`
Line 1831...	Line 1831...
1831	`/*`	1831	`/*`
1832	`* Need raw colours to be able to check for NAs`	1832	`* Need raw colours to be able to check for NAs`
1833	`* FixupCol converts NAs to fully transparent`	1833	`* FixupCol converts NAs to fully transparent`
1834	`*/`	1834	`*/`
1835	`rawcol = CAR(args);`	1835	`rawcol = CAR(args);`
1836	`PROTECT(col = FixupCol(rawcol, NA_INTEGER));`	1836	`PROTECT(col = FixupCol(rawcol, R_TRANWHITE));`
1837	`ncol = LENGTH(col);`	1837	`ncol = LENGTH(col);`
1838	`args = CDR(args);`	1838	`args = CDR(args);`
1839		1839
1840	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));`	1840	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty));`
1841	`nlty = length(lty);`	1841	`nlty = length(lty);`
Line 1932...	Line 1932...
1932	`/* (x,y) is checked in R via xy.coords() ; no need here : */`	1932	`/* (x,y) is checked in R via xy.coords() ; no need here : */`
1933	`sx = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args);`	1933	`sx = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args);`
1934	`sy = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args);`	1934	`sy = SETCAR(args, coerceVector(CAR(args), REALSXP)); args = CDR(args);`
1935	`nx = LENGTH(sx);`	1935	`nx = LENGTH(sx);`
1936		1936
1937	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	1937	`PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);`
1938	`ncol = LENGTH(col);`	1938	`ncol = LENGTH(col);`
1939		1939
1940	`PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg)); args = CDR(args);`	1940	`PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg)); args = CDR(args);`
1941	`nborder = LENGTH(border);`	1941	`nborder = LENGTH(border);`
1942		1942
Line 2079...	Line 2079...
2079	`PROTECT(cex = FixupCex(CAR(args), 1.0));`	2079	`PROTECT(cex = FixupCex(CAR(args), 1.0));`
2080	`ncex = LENGTH(cex);`	2080	`ncex = LENGTH(cex);`
2081	`args = CDR(args);`	2081	`args = CDR(args);`
2082		2082
2083	`rawcol = CAR(args);`	2083	`rawcol = CAR(args);`
2084	`PROTECT(col = FixupCol(rawcol, NA_INTEGER));`	2084	`PROTECT(col = FixupCol(rawcol, R_TRANWHITE));`
2085	`ncol = LENGTH(col);`	2085	`ncol = LENGTH(col);`
2086	`args = CDR(args);`	2086	`args = CDR(args);`
2087		2087
2088	`PROTECT(font = FixupFont(CAR(args), NA_INTEGER));`	2088	`PROTECT(font = FixupFont(CAR(args), NA_INTEGER));`
2089	`nfont = LENGTH(font);`	2089	`nfont = LENGTH(font);`
Line 2362...	Line 2362...
2362	`if (n < ncex) n = ncex;`	2362	`if (n < ncex) n = ncex;`
2363	`args = CDR(args);`	2363	`args = CDR(args);`
2364		2364
2365	`/* Arg8 : col */`	2365	`/* Arg8 : col */`
2366	`rawcol = CAR(args);`	2366	`rawcol = CAR(args);`
2367	`PROTECT(col = FixupCol(rawcol, NA_INTEGER));`	2367	`PROTECT(col = FixupCol(rawcol, R_TRANWHITE));`
2368	`ncol = length(col);`	2368	`ncol = length(col);`
2369	`if (ncol <= 0) errorcall(call, "zero length \"col\" specified");`	2369	`if (ncol <= 0) errorcall(call, "zero length \"col\" specified");`
2370	`if (n < ncol) n = ncol;`	2370	`if (n < ncol) n = ncol;`
2371	`args = CDR(args);`	2371	`args = CDR(args);`
2372		2372
Line 2758...	Line 2758...
2758	`if ((untf = CAR(args)) != R_NilValue)`	2758	`if ((untf = CAR(args)) != R_NilValue)`
2759	`SETCAR(args, untf = coerceVector(untf, LGLSXP));`	2759	`SETCAR(args, untf = coerceVector(untf, LGLSXP));`
2760	`args = CDR(args);`	2760	`args = CDR(args);`
2761		2761
2762		2762
2763	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	2763	`PROTECT(col = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);`
2764	`ncol = LENGTH(col);`	2764	`ncol = LENGTH(col);`
2765		2765
2766	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty)); args = CDR(args);`	2766	`PROTECT(lty = FixupLty(CAR(args), Rf_gpptr(dd)->lty)); args = CDR(args);`
2767	`nlty = length(lty);`	2767	`nlty = length(lty);`
2768		2768
Line 3508...	Line 3508...
3508	`{`	3508	`{`
3509	`SEXP col;`	3509	`SEXP col;`
3510	`int ncol;`	3510	`int ncol;`
3511	`DevDesc *dd = CurrentDevice();`	3511	`DevDesc *dd = CurrentDevice();`
3512	`checkArity(op, args);`	3512	`checkArity(op, args);`
3513	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER));`	3513	`PROTECT(col = FixupCol(CAR(args), R_TRANWHITE));`
3514	`ncol = LENGTH(col);`	3514	`ncol = LENGTH(col);`
3515	`GSavePars(dd);`	3515	`GSavePars(dd);`
3516	`GMode(1, dd);`	3516	`GMode(1, dd);`
3517	`GRect(0.0, 0.0, 1.0, 1.0, NDC, INTEGER(col)[0], NA_INTEGER, dd);`	3517	`GRect(0.0, 0.0, 1.0, 1.0, NDC, INTEGER(col)[0], R_TRANWHITE, dd);`
3518	`GMode(0, dd);`	3518	`GMode(0, dd);`
3519	`GRestorePars(dd);`	3519	`GRestorePars(dd);`
3520	`UNPROTECT(1);`	3520	`UNPROTECT(1);`
3521	`return R_NilValue;`	3521	`return R_NilValue;`
3522	`}`	3522	`}`
Line 3676...	Line 3676...
3676		3676
3677	`inches = asReal(CAR(args)); args = CDR(args);`	3677	`inches = asReal(CAR(args)); args = CDR(args);`
3678	`if (!R_FINITE(inches) \|\| inches < 0)`	3678	`if (!R_FINITE(inches) \|\| inches < 0)`
3679	`inches = 0;`	3679	`inches = 0;`
3680		3680
3681	`PROTECT(bg = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	3681	`PROTECT(bg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);`
3682	`nbg = LENGTH(bg);`	3682	`nbg = LENGTH(bg);`
3683		3683
3684	`PROTECT(fg = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	3684	`PROTECT(fg = FixupCol(CAR(args), R_TRANWHITE)); args = CDR(args);`
3685	`nfg = LENGTH(fg);`	3685	`nfg = LENGTH(fg);`
3686		3686
3687	`GSavePars(dd);`	3687	`GSavePars(dd);`
3688	`ProcessInlinePars(args, dd, call);`	3688	`ProcessInlinePars(args, dd, call);`
3689		3689

The R Project SVN R

(root)/trunk/src/main/plot.c @ 28362 – Rev 30819 → 30980