The R Project SVN – R – Diff – /branches/R-NaString/src/main/plot.c

 SEXP do_rect(SEXP call, SEXP op, SEXP args, SEXP env)
+{
     /* rect(xl, yb, xr, yt, col, border, lty, lwd, xpd) */
-    SEXP sxl, sxr, syb, syt, col, lty, lwd, border;
+    SEXP sxl, sxr, syb, syt, sxpd, col, lty, lwd, border;
     double *xl, *xr, *yb, *yt, x0, y0, x1, y1;
     int i, n, nxl, nxr, nyb, nyt, ncol, nlty, nlwd, nborder, xpd;
     SEXP originalArgs = args;
     DevDesc *dd = CurrentDevice();
     PROTECT(lwd = FixupLwd(CAR(args), dd->gp.lwd));
     nlwd = length(lwd);
     args = CDR(args);
-    xpd = asInteger(CAR(args));
+    sxpd = CAR(args);
+    if (sxpd != R_NilValue)
+	xpd = asInteger(sxpd);
+    else
+	xpd = dd->gp.xpd;
     args = CDR(args);
     GSavePars(dd);
     if (xpd == NA_INTEGER)
 SEXP do_arrows(SEXP call, SEXP op, SEXP args, SEXP env)
+{
     /* arrows(x0, y0, x1, y1, length, angle, code, col, lty, lwd, xpd) */
-    SEXP sx0, sx1, sy0, sy1, col, lty, lwd;
+    SEXP sx0, sx1, sy0, sy1, sxpd, col, lty, lwd;
     double *x0, *x1, *y0, *y1;
     double xx0, yy0, xx1, yy1;
     double hlength, angle;
     int code;
     int nx0, nx1, ny0, ny1, i, n, ncol, nlty, nlwd, xpd;
     nlwd = length(lwd);
     if (nlwd == 0)
 	errorcall(call, "'lwd' must be numeric of length >=1");
     args = CDR(args);
-    xpd = asInteger(CAR(args));
+    sxpd = CAR(args);
+    if (sxpd != R_NilValue)
+	xpd = asInteger(sxpd);
+    else
+	xpd = dd->gp.xpd;
     args = CDR(args);
     GSavePars(dd);
     if (xpd == NA_INTEGER)
 /*  abline(a, b, h, v, col, lty, lwd, ...)
     draw lines in intercept/slope form.  */
+static void getxlimits(double *x, DevDesc *dd) {
+    /*
+     * xpd = 0 means clip to current plot region
+     * xpd = 1 means clip to current figure region
+     * xpd = 2 means clip to device region
+     */
+    switch (dd->gp.xpd) {
+    case 0:
+	x[0] = dd->gp.usr[0];
+	x[1] = dd->gp.usr[1];
+	break;
+    case 1:
+	x[0] = GConvertX(0, NFC, USER, dd);
+	x[1] = GConvertX(1, NFC, USER, dd);
+	break;
+    case 2:
+	x[0] = GConvertX(0, NDC, USER, dd);
+	x[1] = GConvertX(1, NDC, USER, dd);
+	break;
+    }
+}
+static void getylimits(double *y, DevDesc *dd) {
+    switch (dd->gp.xpd) {
+    case 0:
+	y[0] = dd->gp.usr[2];
+	y[1] = dd->gp.usr[3];
+	break;
+    case 1:
+	y[0] = GConvertY(0, NFC, USER, dd);
+	y[1] = GConvertY(1, NFC, USER, dd);
+	break;
+    case 2:
+	y[0] = GConvertY(0, NDC, USER, dd);
+	y[1] = GConvertY(1, NDC, USER, dd);
+	break;
+    }
+}
 SEXP do_abline(SEXP call, SEXP op, SEXP args, SEXP env)
+{
     SEXP a, b, h, v, untf, col, lty, lwd;
     int i, ncol, nlines, nlty, nlwd;
     double aa, bb, x[2], y[2];
     PROTECT(lwd = FixupLwd(CAR(args), dd->gp.lwd));     args = CDR(args);
     nlwd = length(lwd);
     GSavePars(dd);
+    ProcessInlinePars(args, dd);
     nlines = 0;
     if (a != R_NilValue) {
 	if (b == R_NilValue) {
 	    if (LENGTH(a) != 2)
 	if (nlty && INTEGER(lty)[0] != NA_INTEGER)
 	    dd->gp.lty = INTEGER(lty)[0];
 	else
 	    dd->gp.lty = dd->dp.lty;
 	GMode(1, dd);
+	/* FIXME?
+	 * Seems like the logic here is just draw from xmin to xmax
+	 * and you're guaranteed to draw at least from ymin to ymax
+	 * This MAY cause a problem at some stage when the line being
+	 * drawn is VERY steep -- and the problem is worse now that
+	 * abline will potentially draw to the extents of the device
+	 * (when xpd=NA).  NOTE that R's internal clipping protects the
+	 * device drivers from stupidly large numbers, BUT there is
+	 * still a risk that we could produce a number which is too
-	x[0] = dd->gp.usr[0];
+	 * big for the computer's brain.
+	 * Paul.
+	 */
-	x[1] = dd->gp.usr[1];
+	getxlimits(x, dd);
 	if (R_FINITE(dd->gp.lwd)) {
 	    if (LOGICAL(untf)[0] == 1 && (dd->gp.xlog || dd->gp.ylog)) {
 		double xx[101], yy[101];
 		double xstep = (x[1] - x[0])/100;
 		for (i = 0; i < 100; i++) {
 	    else
 		dd->gp.lty = dd->dp.lty;
 	    dd->gp.lwd = REAL(lwd)[nlines % nlwd];
 	    aa = REAL(h)[i];
 	    if (R_FINITE(aa) && R_FINITE(dd->gp.lwd)) {
-		x[0] = dd->gp.usr[0];
-		x[1] = dd->gp.usr[1];
+		getxlimits(x, dd);
 		y[0] = aa;
 		y[1] = aa;
 		GLine(x[0], y[0], x[1], y[1], USER, dd);
+	    }
 	    nlines++;
 	    else
 		dd->gp.lty = dd->dp.lty;
 	    dd->gp.lwd = REAL(lwd)[nlines % nlwd];
 	    aa = REAL(v)[i];
 	    if (R_FINITE(aa) && R_FINITE(dd->gp.lwd)) {
-		y[0] = dd->gp.usr[2];
-		y[1] = dd->gp.usr[3];
+		getylimits(y, dd);
 		x[0] = aa;
 		x[1] = aa;
 		GLine(x[0], y[0], x[1], y[1], USER, dd);
+	    }
 	    nlines++;

The R Project SVN R

(root)/branches/R-NaString/src/main/plot.c @ 28362 – Rev 14357 → 15168