The R Project SVN R

Rev

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

Rev 23360 Rev 24735
Line 1583... Line 1583...
1583 
	if (R_FINITE(xx[0]) && R_FINITE(yy[0]) &&
 1583 
	if (R_FINITE(xx[0]) && R_FINITE(yy[0]) &&
1584 
	    R_FINITE(xx[1]) && R_FINITE(yy[1]))
 1584 
	    R_FINITE(xx[1]) && R_FINITE(yy[1]))
1585 
	{
 1585 
	{
1586 
	    Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
 1586 
	    Rf_gpptr(dd)->col = INTEGER(col)[i % ncol];
1587 
	    /* NA color should be ok */
 1587 
	    /* NA color should be ok */
1588 
#ifdef till_R_version_1_3
 - 
 
1589 
	    if (Rf_gpptr(dd)->col == NA_INTEGER)
 - 
 
1590 
		Rf_gpptr(dd)->col = Rf_dpptr(dd)->col;
 - 
 
1591 
#endif
 - 
 
1592 
	    Rf_gpptr(dd)->lty = INTEGER(lty)[i % nlty];
 1588 
	    Rf_gpptr(dd)->lty = INTEGER(lty)[i % nlty];
1593 
	    Rf_gpptr(dd)->lwd = REAL(lwd)[i % nlwd];
 1589 
	    Rf_gpptr(dd)->lwd = REAL(lwd)[i % nlwd];
1594 
	    GLine(xx[0], yy[0], xx[1], yy[1], DEVICE, dd);
 1590 
	    GLine(xx[0], yy[0], xx[1], yy[1], DEVICE, dd);
1595 
	}
 1591 
	}
1596 
    }
 1592 
    }
Line 1804... Line 1800...
1804 
 
 1800 
 
1805 
SEXP do_polygon(SEXP call, SEXP op, SEXP args, SEXP env)
 1801 
SEXP do_polygon(SEXP call, SEXP op, SEXP args, SEXP env)
1806 
{
 1802 
{
1807 
    /* polygon(x, y, col, border, lty, xpd, ...) */
 1803 
    /* polygon(x, y, col, border, lty, xpd, ...) */
1808 
    SEXP sx, sy, col, border, lty, sxpd;
 1804 
    SEXP sx, sy, col, border, lty, sxpd;
1809 
#ifdef Older
 - 
 
1810 
    int nx=1, ny=1;
 - 
 
1811 
#else
 - 
 
1812 
    int nx;
 1805 
    int nx;
1813 
#endif
 - 
 
1814 
    int ncol, nborder, nlty, xpd, i, start=0;
 1806 
    int ncol, nborder, nlty, xpd, i, start=0;
1815 
    int num = 0;
 1807 
    int num = 0;
1816 
    double *x, *y, xx, yy, xold, yold;
 1808 
    double *x, *y, xx, yy, xold, yold;
1817 
 
 1809 
 
1818 
    SEXP originalArgs = args;
 1810 
    SEXP originalArgs = args;
1819 
    DevDesc *dd = CurrentDevice();
 1811 
    DevDesc *dd = CurrentDevice();
1820 
 
 1812 
 
1821 
    GCheckState(dd);
 1813 
    GCheckState(dd);
1822 
 
 1814 
 
1823 
    if (length(args) < 2) errorcall(call, "too few arguments");
 1815 
    if (length(args) < 2) errorcall(call, "too few arguments");
1824 
#ifdef Older
 - 
 
1825 
    if (!isNumeric(CAR(args)) || (nx = LENGTH(CAR(args))) <= 0)
 - 
 
1826 
	errorcall(call, "first argument invalid");
 - 
 
1827 
    sx = SETCAR(args, coerceVector(CAR(args), REALSXP));
 - 
 
1828 
    args = CDR(args);
 - 
 
1829 
 
 - 
 
1830 
    if (!isNumeric(CAR(args)) || (ny = LENGTH(CAR(args))) <= 0)
 - 
 
1831 
	errorcall(call, "second argument invalid");
 - 
 
1832 
    sy = SETCAR(args, coerceVector(CAR(args), REALSXP));
 - 
 
1833 
    args = CDR(args);
 - 
 
1834 
 
 - 
 
1835 
    if (ny != nx)
 - 
 
1836 
	errorcall(call, "x and y lengths differ in polygon");
 - 
 
1837 
#else
 - 
 
1838 
    /* (x,y) is checked in R via xy.coords() ; no need here : */
 1816 
    /* (x,y) is checked in R via xy.coords() ; no need here : */
1839 
    sx = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
 1817 
    sx = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
1840 
    sy = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
 1818 
    sy = SETCAR(args, coerceVector(CAR(args), REALSXP));  args = CDR(args);
1841 
    nx = LENGTH(sx);
 1819 
    nx = LENGTH(sx);
1842 
#endif
 - 
 
1843 
 
 1820 
 
1844 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));	args = CDR(args);
 1821 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));	args = CDR(args);
1845 
    ncol = LENGTH(col);
 1822 
    ncol = LENGTH(col);
1846 
 
 1823 
 
1847 
    PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg));	args = CDR(args);
 1824 
    PROTECT(border = FixupCol(CAR(args), Rf_gpptr(dd)->fg));	args = CDR(args);
Line 3472... Line 3449...
3472 
	GEplayDisplayList(dd);
 3449 
	GEplayDisplayList(dd);
3473 
    }
 3450 
    }
3474 
    return R_NilValue;
 3451 
    return R_NilValue;
3475 
}
 3452 
}
3476 
 
 3453 
 
3477 
#ifdef OLD
 - 
 
3478 
SEXP do_getDL(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
3479 
{
 - 
 
3480 
    DevDesc *dd = CurrentDevice();
 - 
 
3481 
    checkArity(op, args);
 - 
 
3482 
    if (dd->newDevStruct)
 - 
 
3483 
	return ((GEDevDesc*) dd)->dev->displayList;
 - 
 
3484 
    else
 - 
 
3485 
	return dd->displayList;
 - 
 
3486 
}
 - 
 
3487 
 
 - 
 
3488 
SEXP do_getGPar(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
3489 
{
 - 
 
3490 
    SEXP GP;
 - 
 
3491 
    int lGPar = 1 + sizeof(GPar) / sizeof(int);
 - 
 
3492 
    DevDesc *dd = CurrentDevice();
 - 
 
3493 
 
 - 
 
3494 
    checkArity(op, args);
 - 
 
3495 
    GP = allocVector(INTSXP, lGPar);
 - 
 
3496 
    copyGPar(Rf_dpSavedptr(dd), (GPar *) INTEGER(GP));
 - 
 
3497 
    return GP;
 - 
 
3498 
}
 - 
 
3499 
#endif
 - 
 
3500 
 
 - 
 
3501 
SEXP do_playDL(SEXP call, SEXP op, SEXP args, SEXP env)
 3454 
SEXP do_playDL(SEXP call, SEXP op, SEXP args, SEXP env)
3502 
{
 3455 
{
3503 
    DevDesc *dd = CurrentDevice();
 3456 
    DevDesc *dd = CurrentDevice();
3504 
    SEXP theList;
 3457 
    SEXP theList;
3505 
    int ask;
 3458 
    int ask;