The R Project SVN – R – Diff – /branches/R-exp-API/src/main/plot3d.c



    if (nc < 1)
	errorcall(call, "no contour values");
 
    for (i = 0; i < nx; i++) {
	if (!R_FINITE(REAL(x)[i]))
	    errorcall(call, "missing x values");
	if (i > 0 && REAL(x)[i] < REAL(x)[i - 1])
	    errorcall(call, "increasing x values expected");
    }
 
    for (i = 0; i < ny; i++) {
	if (!R_FINITE(REAL(y)[i]))
	    errorcall(call, "missing y values");
	if (i > 0 && REAL(y)[i] < REAL(y)[i - 1])
	    errorcall(call, "increasing y values expected");
    }
 
    ctr_xtol = 1e-3 * fabs(REAL(x)[nx-1]-REAL(x)[0]);
    ctr_ytol = 1e-3 * fabs(REAL(y)[ny-1]-REAL(y)[0]);
 
    for (i = 0; i < nc; i++)
	if (!R_FINITE(REAL(c)[i]))
	    errorcall(call, "illegal NA contour values");
 
    zmin = DBL_MAX;
    zmax = DBL_MIN;
    for (i = 0; i < nx * ny; i++)
	if (R_FINITE(REAL(z)[i])) {

    if (call != R_NilValue)
	recordGraphicOperation(op, oargs, dd);
    return R_NilValue;
 
 badxy:
    errorcall(call, "invalid x / y values or limits");
 badlev:
    errorcall(call, "invalid contour levels");
    return R_NilValue;  /* never used; to keep -Wall happy */
}
 
 
	/*  I m a g e   R e n d e r i n g  */

    internalTypeCheck(call, szlim, REALSXP);
    if (length(szlim) != 2 ||
       !R_FINITE(REAL(szlim)[0]) ||
       !R_FINITE(REAL(szlim)[1]) ||
       (zmin = REAL(szlim)[0]) > (zmax = REAL(szlim)[1]))
	errorcall(call, "invalid z limits");
    if(zmin == zmax) {/* fix them up, as in graphics.c's GScale(): */
	if(zmin == 0) {
	    zmin = -1;
	    zmax =  1;
	}

    if (call != R_NilValue)
	recordGraphicOperation(op, oargs, dd);
    return R_NilValue;
 
  badxy:
    errorcall(call, "invalid x / y values or limits");
    return R_NilValue;/* never used; to keep -Wall happy */
}
 
	/*  P e r s p e c t i v e   S u r f a c e   P l o t s  */
 

 
    /* Parameter Checks */
 
    if (!R_FINITE(theta) || !R_FINITE(phi) || !R_FINITE(r) || !R_FINITE(d) ||
	d < 0 || r < 0)
	errorcall(call, "invalid viewing parameters");
    if (!R_FINITE(expand) || expand < 0)
	errorcall(call, "invalid expand value");
    if (scale == NA_LOGICAL)
	scale = 0;
 
    dd = GNewPlot(call != R_NilValue, NA_LOGICAL);
 
    PROTECT(col = FixupCol(col, dd->gp.bg));
    ncol = LENGTH(col);
    if (ncol < 1) errorcall(call, "invalid col specification");
    PROTECT(border = FixupCol(border, dd->gp.fg));
    if (length(border) < 1) errorcall(call, "invalid border specification");
 
    GSetState(1, dd);
    GSavePars(dd);
    ProcessInlinePars(args, dd);
    if (length(border) > 1)

Rev 6098	Rev 6191
Line 450...	Line 450...
450	`if (nc < 1)`	450	`if (nc < 1)`
451	`errorcall(call, "no contour values");`	451	`errorcall(call, "no contour values");`
452		452
453	`for (i = 0; i < nx; i++) {`	453	`for (i = 0; i < nx; i++) {`
454	`if (!R_FINITE(REAL(x)[i]))`	454	`if (!R_FINITE(REAL(x)[i]))`
455	`errorcall(call, "missing x values\n");`	455	`errorcall(call, "missing x values");`
456	`if (i > 0 && REAL(x)[i] < REAL(x)[i - 1])`	456	`if (i > 0 && REAL(x)[i] < REAL(x)[i - 1])`
457	`errorcall(call, "increasing x values expected");`	457	`errorcall(call, "increasing x values expected");`
458	`}`	458	`}`
459		459
460	`for (i = 0; i < ny; i++) {`	460	`for (i = 0; i < ny; i++) {`
461	`if (!R_FINITE(REAL(y)[i]))`	461	`if (!R_FINITE(REAL(y)[i]))`
462	`errorcall(call, "missing y values\n");`	462	`errorcall(call, "missing y values");`
463	`if (i > 0 && REAL(y)[i] < REAL(y)[i - 1])`	463	`if (i > 0 && REAL(y)[i] < REAL(y)[i - 1])`
464	`errorcall(call, "increasing y values expected");`	464	`errorcall(call, "increasing y values expected");`
465	`}`	465	`}`
466		466
467	`ctr_xtol = 1e-3 * fabs(REAL(x)[nx-1]-REAL(x)[0]);`	467	`ctr_xtol = 1e-3 * fabs(REAL(x)[nx-1]-REAL(x)[0]);`
468	`ctr_ytol = 1e-3 * fabs(REAL(y)[ny-1]-REAL(y)[0]);`	468	`ctr_ytol = 1e-3 * fabs(REAL(y)[ny-1]-REAL(y)[0]);`
469		469
470	`for (i = 0; i < nc; i++)`	470	`for (i = 0; i < nc; i++)`
471	`if (!R_FINITE(REAL(c)[i]))`	471	`if (!R_FINITE(REAL(c)[i]))`
472	`errorcall(call, "illegal NA contour values\n");`	472	`errorcall(call, "illegal NA contour values");`
473		473
474	`zmin = DBL_MAX;`	474	`zmin = DBL_MAX;`
475	`zmax = DBL_MIN;`	475	`zmax = DBL_MIN;`
476	`for (i = 0; i < nx * ny; i++)`	476	`for (i = 0; i < nx * ny; i++)`
477	`if (R_FINITE(REAL(z)[i])) {`	477	`if (R_FINITE(REAL(z)[i])) {`
Line 743...	Line 743...
743	`if (call != R_NilValue)`	743	`if (call != R_NilValue)`
744	`recordGraphicOperation(op, oargs, dd);`	744	`recordGraphicOperation(op, oargs, dd);`
745	`return R_NilValue;`	745	`return R_NilValue;`
746		746
747	`badxy:`	747	`badxy:`
748	`errorcall(call, "invalid x / y values or limits\n");`	748	`errorcall(call, "invalid x / y values or limits");`
749	`badlev:`	749	`badlev:`
750	`errorcall(call, "invalid contour levels\n");`	750	`errorcall(call, "invalid contour levels");`
751	`return R_NilValue; /* never used; to keep -Wall happy */`	751	`return R_NilValue; /* never used; to keep -Wall happy */`
752	`}`	752	`}`
753		753
754		754
755	`/* I m a g e R e n d e r i n g */`	755	`/* I m a g e R e n d e r i n g */`
Line 789...	Line 789...
789	`internalTypeCheck(call, szlim, REALSXP);`	789	`internalTypeCheck(call, szlim, REALSXP);`
790	`if (length(szlim) != 2 \|\|`	790	`if (length(szlim) != 2 \|\|`
791	`!R_FINITE(REAL(szlim)[0]) \|\|`	791	`!R_FINITE(REAL(szlim)[0]) \|\|`
792	`!R_FINITE(REAL(szlim)[1]) \|\|`	792	`!R_FINITE(REAL(szlim)[1]) \|\|`
793	`(zmin = REAL(szlim)[0]) > (zmax = REAL(szlim)[1]))`	793	`(zmin = REAL(szlim)[0]) > (zmax = REAL(szlim)[1]))`
794	`errorcall(call, "invalid z limits\n");`	794	`errorcall(call, "invalid z limits");`
795	`if(zmin == zmax) {/* fix them up, as in graphics.c's GScale(): */`	795	`if(zmin == zmax) {/* fix them up, as in graphics.c's GScale(): */`
796	`if(zmin == 0) {`	796	`if(zmin == 0) {`
797	`zmin = -1;`	797	`zmin = -1;`
798	`zmax = 1;`	798	`zmax = 1;`
799	`}`	799	`}`
Line 869...	Line 869...
869	`if (call != R_NilValue)`	869	`if (call != R_NilValue)`
870	`recordGraphicOperation(op, oargs, dd);`	870	`recordGraphicOperation(op, oargs, dd);`
871	`return R_NilValue;`	871	`return R_NilValue;`
872		872
873	`badxy:`	873	`badxy:`
874	`errorcall(call, "invalid x / y values or limits\n");`	874	`errorcall(call, "invalid x / y values or limits");`
875	`return R_NilValue;/* never used; to keep -Wall happy */`	875	`return R_NilValue;/* never used; to keep -Wall happy */`
876	`}`	876	`}`
877		877
878	`/* P e r s p e c t i v e S u r f a c e P l o t s */`	878	`/* P e r s p e c t i v e S u r f a c e P l o t s */`
879		879
Line 1478...	Line 1478...
1478		1478
1479	`/* Parameter Checks */`	1479	`/* Parameter Checks */`
1480		1480
1481	`if (!R_FINITE(theta) \|\| !R_FINITE(phi) \|\| !R_FINITE(r) \|\| !R_FINITE(d) \|\|`	1481	`if (!R_FINITE(theta) \|\| !R_FINITE(phi) \|\| !R_FINITE(r) \|\| !R_FINITE(d) \|\|`
1482	`d < 0 \|\| r < 0)`	1482	`d < 0 \|\| r < 0)`
1483	`errorcall(call, "invalid viewing parameters\n");`	1483	`errorcall(call, "invalid viewing parameters");`
1484	`if (!R_FINITE(expand) \|\| expand < 0)`	1484	`if (!R_FINITE(expand) \|\| expand < 0)`
1485	`errorcall(call, "invalid expand value\n");`	1485	`errorcall(call, "invalid expand value");`
1486	`if (scale == NA_LOGICAL)`	1486	`if (scale == NA_LOGICAL)`
1487	`scale = 0;`	1487	`scale = 0;`
1488		1488
1489	`dd = GNewPlot(call != R_NilValue, NA_LOGICAL);`	1489	`dd = GNewPlot(call != R_NilValue, NA_LOGICAL);`
1490		1490
1491	`PROTECT(col = FixupCol(col, dd->gp.bg));`	1491	`PROTECT(col = FixupCol(col, dd->gp.bg));`
1492	`ncol = LENGTH(col);`	1492	`ncol = LENGTH(col);`
1493	`if (ncol < 1) errorcall(call, "invalid col specification\n");`	1493	`if (ncol < 1) errorcall(call, "invalid col specification");`
1494	`PROTECT(border = FixupCol(border, dd->gp.fg));`	1494	`PROTECT(border = FixupCol(border, dd->gp.fg));`
1495	`if (length(border) < 1) errorcall(call, "invalid border specification\n");`	1495	`if (length(border) < 1) errorcall(call, "invalid border specification");`
1496		1496
1497	`GSetState(1, dd);`	1497	`GSetState(1, dd);`
1498	`GSavePars(dd);`	1498	`GSavePars(dd);`
1499	`ProcessInlinePars(args, dd);`	1499	`ProcessInlinePars(args, dd);`
1500	`if (length(border) > 1)`	1500	`if (length(border) > 1)`

The R Project SVN R

(root)/branches/R-exp-API/src/main/plot3d.c @ 77458 – Rev 6098 → 6191