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



 *	full computation is captured in the display list.
 */
 
SEXP do_plot_window(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP xlim, ylim, logarg;
    double asp, xmin, xmax, ymin, ymax;
    Rboolean logscale;
    char *p;
    SEXP originalArgs = args;
    DevDesc *dd = CurrentDevice();

    if (!isNumeric(ylim) || LENGTH(ylim) != 2)
	errorcall(call, "invalid ylim");
    args = CDR(args);
 
    logscale = FALSE;
    logarg = CAR(args);
    if (!isString(logarg))
	errorcall(call, "\"log=\" specification must be character");
    p = CHAR(STRING_ELT(logarg, 0));
    while (*p) {
	switch (*p) {
	case 'x':
	    dd->dp.xlog = dd->gp.xlog = logscale = TRUE;
	    break;

	error("invalid type for axis labels");
    }
    return ans;
}
 
SEXP CreateAtVector(double *axp, double *usr, int nint, Rboolean logflag)
{
/*	Create an  'at = ...' vector for  axis(.) / do_axis,
 *	i.e., the vector of tick mark locations,
 *	when none has been specified (= default).
 *

 *	The resulting REAL vector must have length >= 1, ideally >= 2
 */
    SEXP at = R_NilValue;/* -Wall*/
    double umin, umax, dn, rng, small;
    int i, n, ne;
    if (!logflag || axp[2] < 0) { /* ---- linear axis ---- Only use	axp[]  arg. */
	n = fabs(axp[2]) + 0.25;/* >= 0 */
	dn = imax2(1, n);
	rng = axp[1] - axp[0];
	small = fabs(rng)/(100.*dn);
	at = allocVector(REALSXP, n + 1);

    /* Which side of the plot the axis is to appear on. */
    /* side = 1 | 2 | 3 | 4. */
 
    side = asInteger(CAR(args));
    if (side < 1 || side > 4)
	errorcall(call, "invalid axis number %d", side);
    args = CDR(args);
 
    /* Required argument: "at" */
    /* This gives the tick-label locations. */
    /* Note that these are coerced to the correct type below. */

	if (length(lab) == 0)
	    lab = labelformat(at);
	else if (!isExpression(lab))
	    lab = labelformat(lab);
	if (length(at) != length(lab))
	    errorcall(call, "location and label lengths differ, %d != %d",
		      length(at), length(lab));
    }
    PROTECT(lab);
 
    /* Check there are no NA, Inf or -Inf values for tick positions. */
    /* The code here is long-winded.  Couldn't we just inline things */

Rev 12976	Rev 13046
Line 478...	Line 478...
478	`* full computation is captured in the display list.`	478	`* full computation is captured in the display list.`
479	`*/`	479	`*/`
480		480
481	`SEXP do_plot_window(SEXP call, SEXP op, SEXP args, SEXP env)`	481	`SEXP do_plot_window(SEXP call, SEXP op, SEXP args, SEXP env)`
482	`{`	482	`{`
483	`SEXP xlim, ylim, log;`	483	`SEXP xlim, ylim, logarg;`
484	`double asp, xmin, xmax, ymin, ymax;`	484	`double asp, xmin, xmax, ymin, ymax;`
485	`Rboolean logscale;`	485	`Rboolean logscale;`
486	`char *p;`	486	`char *p;`
487	`SEXP originalArgs = args;`	487	`SEXP originalArgs = args;`
488	`DevDesc *dd = CurrentDevice();`	488	`DevDesc *dd = CurrentDevice();`
Line 499...	Line 499...
499	`if (!isNumeric(ylim) \|\| LENGTH(ylim) != 2)`	499	`if (!isNumeric(ylim) \|\| LENGTH(ylim) != 2)`
500	`errorcall(call, "invalid ylim");`	500	`errorcall(call, "invalid ylim");`
501	`args = CDR(args);`	501	`args = CDR(args);`
502		502
503	`logscale = FALSE;`	503	`logscale = FALSE;`
504	`log = CAR(args);`	504	`logarg = CAR(args);`
505	`if (!isString(log))`	505	`if (!isString(logarg))`
506	`errorcall(call, "\"log=\" specification must be character");`	506	`errorcall(call, "\"log=\" specification must be character");`
507	`p = CHAR(STRING_ELT(log, 0));`	507	`p = CHAR(STRING_ELT(logarg, 0));`
508	`while (*p) {`	508	`while (*p) {`
509	`switch (*p) {`	509	`switch (*p) {`
510	`case 'x':`	510	`case 'x':`
511	`dd->dp.xlog = dd->gp.xlog = logscale = TRUE;`	511	`dd->dp.xlog = dd->gp.xlog = logscale = TRUE;`
512	`break;`	512	`break;`
Line 666...	Line 666...
666	`error("invalid type for axis labels");`	666	`error("invalid type for axis labels");`
667	`}`	667	`}`
668	`return ans;`	668	`return ans;`
669	`}`	669	`}`
670		670
671	`SEXP CreateAtVector(double axp, double usr, int nint, Rboolean log)`	671	`SEXP CreateAtVector(double axp, double usr, int nint, Rboolean logflag)`
672	`{`	672	`{`
673	`/* Create an 'at = ...' vector for axis(.) / do_axis,`	673	`/* Create an 'at = ...' vector for axis(.) / do_axis,`
674	`* i.e., the vector of tick mark locations,`	674	`* i.e., the vector of tick mark locations,`
675	`* when none has been specified (= default).`	675	`* when none has been specified (= default).`
676	`*`	676	`*`
Line 679...	Line 679...
679	`* The resulting REAL vector must have length >= 1, ideally >= 2`	679	`* The resulting REAL vector must have length >= 1, ideally >= 2`
680	`*/`	680	`*/`
681	`SEXP at = R_NilValue;/* -Wall*/`	681	`SEXP at = R_NilValue;/* -Wall*/`
682	`double umin, umax, dn, rng, small;`	682	`double umin, umax, dn, rng, small;`
683	`int i, n, ne;`	683	`int i, n, ne;`
684	`if (!log \|\| axp[2] < 0) { /* ---- linear axis ---- Only use axp[] arg. */`	684	`if (!logflag \|\| axp[2] < 0) { /* ---- linear axis ---- Only use axp[] arg. */`
685	`n = fabs(axp[2]) + 0.25;/* >= 0 */`	685	`n = fabs(axp[2]) + 0.25;/* >= 0 */`
686	`dn = imax2(1, n);`	686	`dn = imax2(1, n);`
687	`rng = axp[1] - axp[0];`	687	`rng = axp[1] - axp[0];`
688	`small = fabs(rng)/(100.*dn);`	688	`small = fabs(rng)/(100.*dn);`
689	`at = allocVector(REALSXP, n + 1);`	689	`at = allocVector(REALSXP, n + 1);`
Line 831...	Line 831...
831	`/* Which side of the plot the axis is to appear on. */`	831	`/* Which side of the plot the axis is to appear on. */`
832	`/* side = 1 \| 2 \| 3 \| 4. */`	832	`/* side = 1 \| 2 \| 3 \| 4. */`
833		833
834	`side = asInteger(CAR(args));`	834	`side = asInteger(CAR(args));`
835	`if (side < 1 \|\| side > 4)`	835	`if (side < 1 \|\| side > 4)`
836	`errorcall(call, "invalid axis number");`	836	`errorcall(call, "invalid axis number %d", side);`
837	`args = CDR(args);`	837	`args = CDR(args);`
838		838
839	`/* Required argument: "at" */`	839	`/* Required argument: "at" */`
840	`/* This gives the tick-label locations. */`	840	`/* This gives the tick-label locations. */`
841	`/* Note that these are coerced to the correct type below. */`	841	`/* Note that these are coerced to the correct type below. */`
Line 956...	Line 956...
956	`if (length(lab) == 0)`	956	`if (length(lab) == 0)`
957	`lab = labelformat(at);`	957	`lab = labelformat(at);`
958	`else if (!isExpression(lab))`	958	`else if (!isExpression(lab))`
959	`lab = labelformat(lab);`	959	`lab = labelformat(lab);`
960	`if (length(at) != length(lab))`	960	`if (length(at) != length(lab))`
961	`errorcall(call, "location and label lengths differ");`	961	`errorcall(call, "location and label lengths differ, %d != %d",`
-		962	`length(at), length(lab));`
962	`}`	963	`}`
963	`PROTECT(lab);`	964	`PROTECT(lab);`
964		965
965	`/* Check there are no NA, Inf or -Inf values for tick positions. */`	966	`/* Check there are no NA, Inf or -Inf values for tick positions. */`
966	`/* The code here is long-winded. Couldn't we just inline things */`	967	`/* The code here is long-winded. Couldn't we just inline things */`

The R Project SVN R

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