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



		REAL(pch)[i] : NA_INTEGER;
    }
    else if (isString(pch)) {
	ans = allocVector(INTSXP, n);
	for (i = 0; i < n; i++)
	    INTEGER(ans)[i] = CHAR(STRING_ELT(pch, i))[0];
    }
    else error("invalid plotting symbol");
    for (i = 0; i < n; i++) {
	if (INTEGER(ans)[i] < 0 && INTEGER(ans)[i] != NA_INTEGER)
	    INTEGER(ans)[i] = dflt;

	}
	else {
	    nms = getAttrib(spec, R_NamesSymbol);
	    n = length(nms);
	    for (i = 0; i < n; i++) {
		if (!strcmp(CHAR(STRING_ELT(nms, i)), "cex")) {
		    cex = asReal(VECTOR_ELT(spec, i));
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) {
		    col = asInteger(FixupCol(VECTOR_ELT(spec, i), NA_INTEGER));
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {
		    font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "vfont")) {
		    vfont = asInteger(FixupVFont(VECTOR_ELT(spec, i)));
		}
		else if (!strcmp(CHAR(STRING_ELT(nms, i)), "")) {
		    txt = VECTOR_ELT(spec, i);
                    if (TYPEOF(txt) == LANGSXP) {
                        UNPROTECT(1);
                        PROTECT(txt = coerceVector(txt, EXPRSXP));
                    }
		    else if (!isExpression(txt)) {

 
    logscale = 0;
    log = CAR(args);
    if (!isString(log))
	errorcall(call, "\"log=\" specification must be character");
    p = CHAR(STRING_ELT(log, 0));
    while (*p) {
	switch (*p) {
	case 'x':
	    dd->dp.xlog = dd->gp.xlog = 1;
	    logscale = 1;

    switch(TYPEOF(labels)) {
    case LGLSXP:
	PROTECT(ans = allocVector(STRSXP, n));
	for (i = 0; i < n; i++) {
	    strp = EncodeLogical(LOGICAL(labels)[i], 0);
	    SET_STRING_ELT(ans, i, mkChar(strp));
	}
	UNPROTECT(1);
	break;
    case INTSXP:
	PROTECT(ans = allocVector(STRSXP, n));
	for (i = 0; i < n; i++) {
	    strp = EncodeInteger(INTEGER(labels)[i], 0);
	    SET_STRING_ELT(ans, i, mkChar(strp));
	}
	UNPROTECT(1);
	break;
    case REALSXP:
	formatReal(REAL(labels), n, &w, &d, &e);
	PROTECT(ans = allocVector(STRSXP, n));
	for (i = 0; i < n; i++) {
	    strp = EncodeReal(REAL(labels)[i], 0, d, e);
	    SET_STRING_ELT(ans, i, mkChar(strp));
	}
	UNPROTECT(1);
	break;
    case CPLXSXP:
	formatComplex(COMPLEX(labels), n, &w, &d, &e, &wi, &di, &ei);
	PROTECT(ans = allocVector(STRSXP, n));
	for (i = 0; i < n; i++) {
	    strp = EncodeComplex(COMPLEX(labels)[i], 0, d, e, 0, di, ei);
	    SET_STRING_ELT(ans, i, mkChar(strp));
	}
	UNPROTECT(1);
	break;
    case STRSXP:
	formatString(STRING_PTR(labels), n, &w, 0);
	PROTECT(ans = allocVector(STRSXP, n));
	for (i = 0; i < n; i++) {
#ifdef OLD
	    strp = EncodeString(CHAR(STRING_ELT(labels, i)), 0, 0, Rprt_adj_left);
	    SET_STRING_ELT(ans, i, mkChar(strp));
#else
	    SET_STRING_ELT(ans, i, STRING_ELT(labels, i));
#endif
	}
	UNPROTECT(1);
	break;
    default:

	    temp = GConvertX(x, USER, NFC, dd);
	    if (dolabels) {
		/* Clip tick labels to user coordinates. */
		if (x > low && x < high) {
		    if (isExpression(lab)) {
			GMMathText(VECTOR_ELT(lab, ind[i]), side,
				   axis_lab, 0, x, dd->gp.las, dd);
		    }
		    else {
			labw = GStrWidth(CHAR(STRING_ELT(lab, ind[i])), NFC, dd);
			tnew = temp - 0.5 * labw;
			/* Check room for perpendicular labels. */
			if (dd->gp.las == 2 || dd->gp.las == 3 ||
			    tnew - tlast >= gap) {
			    GMtext(CHAR(STRING_ELT(lab, ind[i])), side,
				   axis_lab, 0, x, dd->gp.las, dd);
			    tlast = temp + 0.5 *labw;
			}
		    }
		}

	    temp = GConvertY(y, USER, NFC, dd);
	    if (dolabels) {
		/* Clip tick labels to user coordinates. */
		if (y > low && y < high) {
		    if (isExpression(lab)) {
			GMMathText(VECTOR_ELT(lab, ind[i]), side,
				   axis_lab, 0, y, dd->gp.las, dd);
		    }
		    else {
			labw = GStrWidth(CHAR(STRING_ELT(lab, ind[i])), INCHES, dd);
			labw = GConvertYUnits(labw, INCHES, NFC, dd);
			tnew = temp - 0.5 * labw;
			/* Check room for perpendicular labels. */
			if (dd->gp.las == 1 || dd->gp.las == 2 ||
			    tnew - tlast >= gap) {
			    GMtext(CHAR(STRING_ELT(lab, ind[i])), side,
				   axis_lab, 0, y, dd->gp.las, dd);
			    tlast = temp + 0.5 *labw;
			}
		    }
		}

    sy = R_NilValue;            /* -Wall */
 
    /* Required Arguments */
    sxy = CAR(args);
    if (isNewList(sxy) && length(sxy) >= 2) {
	internalTypeCheck(call, sx = VECTOR_ELT(sxy, 0), REALSXP);
	internalTypeCheck(call, sy = VECTOR_ELT(sxy, 1), REALSXP);
    }
    else if (isList(sxy) && length(sxy) >= 2) {
	internalTypeCheck(call, sx = CAR(sxy), REALSXP);
	internalTypeCheck(call, sy = CADR(sxy), REALSXP);
    }

    args = CDR(args);
 
    if (isNull(CAR(args))) type = 'p';
    else {
	if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)
	    type = CHAR(STRING_ELT(CAR(args), 0))[0];
	else errorcall(call, "invalid plot type");
    }
    args = CDR(args);
 
    PROTECT(pch = FixupPch(CAR(args), dd->gp.pch));	args = CDR(args);

{
    int k=0;/* -Wall */
 
    if (!isNumeric(CAR(args)) || (k = LENGTH(CAR(args))) <= 0)
	errorcall(call, "first argument invalid");
    SETCAR(args, coerceVector(CAR(args), REALSXP));
    *n = k;
    args = CDR(args);
 
    if (!isNumeric(CAR(args)) || (k = LENGTH(CAR(args))) <= 0)
	errorcall(call, "second argument invalid");
    SETCAR(args, coerceVector(CAR(args), REALSXP));
    if (k > *n) *n = k;
    args = CDR(args);
 
    if (!isNumeric(CAR(args)) || (k = LENGTH(CAR(args))) <= 0)
	errorcall(call, "third argument invalid");
    SETCAR(args, coerceVector(CAR(args), REALSXP));
    if (k > *n) *n = k;
    args = CDR(args);
 
    if (!isNumeric(CAR(args)) || (k = LENGTH(CAR(args))) <= 0)
	errorcall(call, "fourth argument invalid");
    SETCAR(args, coerceVector(CAR(args), REALSXP));
    if (k > *n) *n = k;
    args = CDR(args);
}
 
 

 
    if (length(args) < 2) errorcall(call, "too few arguments");
 
    if (!isNumeric(CAR(args)) || (nx = LENGTH(CAR(args))) <= 0)
	errorcall(call, "first argument invalid");
    sx = SETCAR(args, coerceVector(CAR(args), REALSXP));
    args = CDR(args);
 
    if (!isNumeric(CAR(args)) || (ny = LENGTH(CAR(args))) <= 0)
	errorcall(call, "second argument invalid");
    sy = SETCAR(args, coerceVector(CAR(args), REALSXP));
    args = CDR(args);
 
    if (ny != nx)
	errorcall(call, "x and y lengths differ in polygon");
 

    sx = R_NilValue;            /* -Wall */
    sy = R_NilValue;            /* -Wall */
 
    sxy = CAR(args);
    if (isNewList(sxy) && length(sxy) >= 2) {
	    internalTypeCheck(call, sx = VECTOR_ELT(sxy, 0), REALSXP);
	    internalTypeCheck(call, sy = VECTOR_ELT(sxy, 1), REALSXP);
    }
    else if (isList(sxy) && length(sxy) >= 2) {
	    internalTypeCheck(call, sx = CAR(sxy), REALSXP);
	    internalTypeCheck(call, sy = CADR(sxy), REALSXP);
    }

		    adjy = dd->gp.yCharOffset;
		    break;
		}
	    }
	    if (vectorFonts)
		GVText(xx, yy, INCHES, CHAR(STRING_ELT(txt, i % ntxt)),
		       INTEGER(vfont)[0], INTEGER(vfont)[1],
		       adjx, adjy, dd->gp.srt, dd);
	    else
		if (isExpression(txt))
		    GMathText(xx, yy, INCHES,
			      VECTOR_ELT(txt, i % ntxt),
			      adjx, adjy, dd->gp.srt, dd);
		else
		    GText(xx, yy, INCHES,
			  CHAR(STRING_ELT(txt, i % ntxt)),
			  adjx, adjy, dd->gp.srt, dd);
	}
    }
    GMode(0, dd);
 

	dd->gp.font = (fontval == NA_INTEGER) ? fontsave : fontval;
	dd->gp.col = (colval == NA_INTEGER) ? colsave : colval;
	dd->gp.adj = ComputeAdjValue(adjval, sideval, dd->gp.las);
	atval = ComputeAtValue(atval, dd->gp.adj, sideval, outerval, dd);
	if (isExpression(text))
	    GMMathText(VECTOR_ELT(text, i%ntext),
		       sideval, lineval, outerval, atval, dd->gp.las, dd);
	else
	    GMtext(CHAR(STRING_ELT(text, i%ntext)),
		   sideval, lineval, outerval, atval, dd->gp.las, dd);
    	if (outerval == 0) dirtyplot = 1;
}
    GMode(0, dd);
 

	    hpos = GConvertX(adj, NPC, USER, dd);
	    where = MAR3;
	}
	if (isExpression(Main)) {
	    GMathText(hpos, vpos, where,
		      VECTOR_ELT(Main, 0), adj, 0.5, 0.0, dd);
	}
	else {
	  n = length(Main);
	  offset = 0.5 * (n - 1) + vpos;
	  for (i = 0; i < n; i++)
	      GText(hpos, offset - i, where,
		    CHAR(STRING_ELT(Main, i)), adj, adjy, 0.0, dd);
	}
    }
    if (sub != R_NilValue) {
	cex = dd->gp.cexsub;
	col = dd->gp.colsub;

	else {
	    hpos = GConvertX(adj, NPC, USER, dd);
	    where = 0;
	}
	if (isExpression(sub))
	    GMMathText(VECTOR_ELT(sub, 0), 1, vpos, where,
		       hpos, 0, dd);
	else {
	    n = length(sub);
	    for (i = 0; i < n; i++)
		GMtext(CHAR(STRING_ELT(sub, i)), 1, vpos, where,
		       hpos, 0, dd);
	}
    }
    if (xlab != R_NilValue) {
	cex = dd->gp.cexlab;

	else {
	    hpos = GConvertX(adj, NPC, USER, dd);
	    where = 0;
	}
	if (isExpression(xlab))
	    GMMathText(VECTOR_ELT(xlab, 0), 1, vpos + i, where,
		       hpos, 0, dd);
	else {
	    n = length(xlab);
	    for (i = 0; i < n; i++)
		GMtext(CHAR(STRING_ELT(xlab, i)), 1, vpos + i, where,
		   hpos, 0, dd);
	}
    }
    if (ylab != R_NilValue) {
	cex = dd->gp.cexlab;

	else {
	    hpos = GConvertY(adj, NPC, USER, dd);
	    where = 0;
	}
	if (isExpression(ylab))
	    GMMathText(VECTOR_ELT(ylab, 0), 2, vpos, where,
		       hpos, 0, dd);
	else {
	    n = length(ylab);
	    for (i = 0; i < n; i++)
		GMtext(CHAR(STRING_ELT(ylab, i)), 2, vpos - i, where,
		       hpos, 0, dd);
	}
    }
    GMode(0, dd);
    GRestorePars(dd);

    GCheckState(dd);
 
    if (length(args) < 5) errorcall(call, "too few arguments");
 
    if ((a = CAR(args)) != R_NilValue)
	SETCAR(args, a = coerceVector(a, REALSXP));
    args = CDR(args);
 
    if ((b = CAR(args)) != R_NilValue)
	SETCAR(args, b = coerceVector(b, REALSXP));
    args = CDR(args);
 
    if ((h = CAR(args)) != R_NilValue)
	SETCAR(args, h = coerceVector(h, REALSXP));
    args = CDR(args);
 
    if ((v = CAR(args)) != R_NilValue)
	SETCAR(args, v = coerceVector(v, REALSXP));
    args = CDR(args);
 
    if ((untf = CAR(args)) != R_NilValue)
	SETCAR(args, untf = coerceVector(untf, LGLSXP));
    args = CDR(args);
 
 
    PROTECT(col = FixupCol(CAR(args), NA_INTEGER));	args = CDR(args);
    ncol = LENGTH(col);

	x = CAR(args); args = CDR(args);
	y = CAR(args); args = CDR(args);
	nobs = CAR(args); args = CDR(args);
	n = INTEGER(nobs)[0];
	stype = CAR(args); args = CDR(args);
	type = CHAR(STRING_ELT(stype, 0))[0];
	if (type != 'n') {
	    GMode(1, dd);
	    for (i=0; i<n; i++) {
		xp = REAL(x)[i];
		yp = REAL(y)[i];

	args = CDR(args);
	if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)
	    stype = CAR(args);
	else
	    errorcall(call, "invalid plot type");
	type = CHAR(STRING_ELT(stype, 0))[0];
	PROTECT(x = allocVector(REALSXP, n));
	PROTECT(y = allocVector(REALSXP, n));
	PROTECT(nobs=allocVector(INTSXP,1));
	i = 0;
 

	    REAL(x)[i] = NA_REAL;
	    REAL(y)[i] = NA_REAL;
	    i += 1;
	}
	PROTECT(ans = allocList(3));
	SETCAR(ans, x);
	SETCADR(ans, y);
	SETCADDR(ans, nobs);
	PROTECT(saveans = allocList(4));
	SETCAR(saveans, x);
	SETCADR(saveans, y);
	SETCADDR(saveans, nobs);
	SETCADDDR(saveans, CAR(args));
	/* Record the points and lines that were drawn in the display list */
	recordGraphicOperation(op, saveans, dd);
	UNPROTECT(5);
	return ans;
    }

		xi = REAL(x)[i];
		yi = REAL(y)[i];
		GConvert(&xi, &yi, USER, INCHES, dd);
		posi = INTEGER(pos)[i];
		offset = GConvertXUnits(asReal(Offset), CHARS, INCHES, dd);
		drawLabel(xi, yi, posi, offset, CHAR(STRING_ELT(l, i)), dd);
	    }
	}
	return R_NilValue;
    }
    else {

			INTEGER(pos)[imin] = 1;
		    }
		}
		if (plot)
		    drawLabel(xi, yi, INTEGER(pos)[imin], offset,
			      CHAR(STRING_ELT(l, imin)), dd);
	    }
	}
	GMode(0, dd);
	PROTECT(ans = allocList(2));
	SETCAR(ans, ind);
	SETCADR(ans, pos);
	PROTECT(saveans = allocList(6));
	SETCAR(saveans, ind);
	SETCADR(saveans, pos);
	SETCADDR(saveans, x);
	SETCADDDR(saveans, y);
	SETCAD4R(saveans, Offset);
	SETCAD4R(CDR(saveans), l);
 
	/* We are recording, so save enough information to be able to
	   redraw the text labels beside identified points */
	if (call != R_NilValue)
	    recordGraphicOperation(op, saveans, dd);

    gw = 0;
    ht = GStrHeight("M", INCHES, dd);
    xmin = DBL_MAX;
    xmax = DBL_MIN;
    for (i = 0; i < n; i++) {
	wd = GStrWidth(CHAR(STRING_ELT(labs, i)), INCHES, dd) / ht;
	if (wd > 0) {
	    if (INTEGER(offset)[i] == 1) {
		if (wd > gw) gw = wd;
	    }
	    else {

    /* NOTE: don't override to _reduce_ clipping region */
    if (dd->gp.xpd < 1)
	xpd = 1;
 
    for (i = 0; i < n; i++) {
	if (strlen(CHAR(STRING_ELT(labs, i))) > 0) {
	    if (LOGICAL(offset)[i])
		GMtext(CHAR(STRING_ELT(labs, i)), 2, gw, 0, (double)(i+1), 2, dd);
	    else
		GMtext(CHAR(STRING_ELT(labs, i)), 2, lw, 0, (double)(i+1), 2, dd);
	}
    }
    dd->gp.adj = adj;
    dd->gp.xpd = xpd;
 

    PROTECT(ans = allocVector(REALSXP, n));
    cexsave = dd->gp.cex;
    dd->gp.cex = cex * dd->gp.cexbase;
    for (i = 0; i < n; i++)
	if (isExpression(str))
	    REAL(ans)[i] = GExpressionHeight(VECTOR_ELT(str, i),
					     GMapUnits(units), dd);
	else
	    REAL(ans)[i] = GStrHeight(CHAR(STRING_ELT(str, i)),
				      GMapUnits(units), dd);
    dd->gp.cex = cexsave;
    UNPROTECT(1);
    return ans;
}

    PROTECT(ans = allocVector(REALSXP, n));
    cexsave = dd->gp.cex;
    dd->gp.cex = cex * dd->gp.cexbase;
    for (i = 0; i < n; i++)
	if (isExpression(str))
	    REAL(ans)[i] = GExpressionWidth(VECTOR_ELT(str, i),
					    GMapUnits(units), dd);
	else
	    REAL(ans)[i] = GStrWidth(CHAR(STRING_ELT(str, i)),
				     GMapUnits(units), dd);
    dd->gp.cex = cexsave;
    UNPROTECT(1);
    return ans;
}

    dnd_hang = dnd_hang * (dnd_hght[dnd_n-1] - dnd_hght[0]);
    args = CDR(args);
 
    if (TYPEOF(CAR(args)) != STRSXP || length(CAR(args)) != dnd_n+1)
	goto badargs;
    dnd_llabels = STRING_PTR(CAR(args));
    args = CDR(args);
 
    GSavePars(dd);
    RecordGraphicsCall(call);
    ProcessInlinePars(args, dd);

    dnd_rptr = &(INTEGER(merge)[n]);
    ymin = REAL(height)[0];
    ymax = REAL(height)[n - 1];
    pin = dd->gp.pin[1];
    for (i = 0; i < n; i++)
	ll[i] = GStrWidth(CHAR(STRING_ELT(llabels, i)), INCHES, dd)
	    + dnd_offset;
    if (dnd_hang >= 0) {
	ymin = ymax - (1 + dnd_hang) * (ymax - ymin);
	yrange = ymax - ymin;
	/* determine leaf heights */

Rev 9615	Rev 9642
Line 149...	Line 149...
149	`REAL(pch)[i] : NA_INTEGER;`	149	`REAL(pch)[i] : NA_INTEGER;`
150	`}`	150	`}`
151	`else if (isString(pch)) {`	151	`else if (isString(pch)) {`
152	`ans = allocVector(INTSXP, n);`	152	`ans = allocVector(INTSXP, n);`
153	`for (i = 0; i < n; i++)`	153	`for (i = 0; i < n; i++)`
154	`INTEGER(ans)[i] = CHAR(STRING(pch)[i])[0];`	154	`INTEGER(ans)[i] = CHAR(STRING_ELT(pch, i))[0];`
155	`}`	155	`}`
156	`else error("invalid plotting symbol");`	156	`else error("invalid plotting symbol");`
157	`for (i = 0; i < n; i++) {`	157	`for (i = 0; i < n; i++) {`
158	`if (INTEGER(ans)[i] < 0 && INTEGER(ans)[i] != NA_INTEGER)`	158	`if (INTEGER(ans)[i] < 0 && INTEGER(ans)[i] != NA_INTEGER)`
159	`INTEGER(ans)[i] = dflt;`	159	`INTEGER(ans)[i] = dflt;`
Line 372...	Line 372...
372	`}`	372	`}`
373	`else {`	373	`else {`
374	`nms = getAttrib(spec, R_NamesSymbol);`	374	`nms = getAttrib(spec, R_NamesSymbol);`
375	`n = length(nms);`	375	`n = length(nms);`
376	`for (i = 0; i < n; i++) {`	376	`for (i = 0; i < n; i++) {`
377	`if (!strcmp(CHAR(STRING(nms)[i]), "cex")) {`	377	`if (!strcmp(CHAR(STRING_ELT(nms, i)), "cex")) {`
378	`cex = asReal(VECTOR(spec)[i]);`	378	`cex = asReal(VECTOR_ELT(spec, i));`
379	`}`	379	`}`
380	`else if (!strcmp(CHAR(STRING(nms)[i]), "col")) {`	380	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "col")) {`
381	`col = asInteger(FixupCol(VECTOR(spec)[i], NA_INTEGER));`	381	`col = asInteger(FixupCol(VECTOR_ELT(spec, i), NA_INTEGER));`
382	`}`	382	`}`
383	`else if (!strcmp(CHAR(STRING(nms)[i]), "font")) {`	383	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "font")) {`
384	`font = asInteger(FixupFont(VECTOR(spec)[i], NA_INTEGER));`	384	`font = asInteger(FixupFont(VECTOR_ELT(spec, i), NA_INTEGER));`
385	`}`	385	`}`
386	`else if (!strcmp(CHAR(STRING(nms)[i]), "vfont")) {`	386	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "vfont")) {`
387	`vfont = asInteger(FixupVFont(VECTOR(spec)[i]));`	387	`vfont = asInteger(FixupVFont(VECTOR_ELT(spec, i)));`
388	`}`	388	`}`
389	`else if (!strcmp(CHAR(STRING(nms)[i]), "")) {`	389	`else if (!strcmp(CHAR(STRING_ELT(nms, i)), "")) {`
390	`txt = VECTOR(spec)[i];`	390	`txt = VECTOR_ELT(spec, i);`
391	`if (TYPEOF(txt) == LANGSXP) {`	391	`if (TYPEOF(txt) == LANGSXP) {`
392	`UNPROTECT(1);`	392	`UNPROTECT(1);`
393	`PROTECT(txt = coerceVector(txt, EXPRSXP));`	393	`PROTECT(txt = coerceVector(txt, EXPRSXP));`
394	`}`	394	`}`
395	`else if (!isExpression(txt)) {`	395	`else if (!isExpression(txt)) {`
Line 504...	Line 504...
504		504
505	`logscale = 0;`	505	`logscale = 0;`
506	`log = CAR(args);`	506	`log = CAR(args);`
507	`if (!isString(log))`	507	`if (!isString(log))`
508	`errorcall(call, "\"log=\" specification must be character");`	508	`errorcall(call, "\"log=\" specification must be character");`
509	`p = CHAR(STRING(log)[0]);`	509	`p = CHAR(STRING_ELT(log, 0));`
510	`while (*p) {`	510	`while (*p) {`
511	`switch (*p) {`	511	`switch (*p) {`
512	`case 'x':`	512	`case 'x':`
513	`dd->dp.xlog = dd->gp.xlog = 1;`	513	`dd->dp.xlog = dd->gp.xlog = 1;`
514	`logscale = 1;`	514	`logscale = 1;`
Line 621...	Line 621...
621	`switch(TYPEOF(labels)) {`	621	`switch(TYPEOF(labels)) {`
622	`case LGLSXP:`	622	`case LGLSXP:`
623	`PROTECT(ans = allocVector(STRSXP, n));`	623	`PROTECT(ans = allocVector(STRSXP, n));`
624	`for (i = 0; i < n; i++) {`	624	`for (i = 0; i < n; i++) {`
625	`strp = EncodeLogical(LOGICAL(labels)[i], 0);`	625	`strp = EncodeLogical(LOGICAL(labels)[i], 0);`
626	`STRING(ans)[i] = mkChar(strp);`	626	`SET_STRING_ELT(ans, i, mkChar(strp));`
627	`}`	627	`}`
628	`UNPROTECT(1);`	628	`UNPROTECT(1);`
629	`break;`	629	`break;`
630	`case INTSXP:`	630	`case INTSXP:`
631	`PROTECT(ans = allocVector(STRSXP, n));`	631	`PROTECT(ans = allocVector(STRSXP, n));`
632	`for (i = 0; i < n; i++) {`	632	`for (i = 0; i < n; i++) {`
633	`strp = EncodeInteger(INTEGER(labels)[i], 0);`	633	`strp = EncodeInteger(INTEGER(labels)[i], 0);`
634	`STRING(ans)[i] = mkChar(strp);`	634	`SET_STRING_ELT(ans, i, mkChar(strp));`
635	`}`	635	`}`
636	`UNPROTECT(1);`	636	`UNPROTECT(1);`
637	`break;`	637	`break;`
638	`case REALSXP:`	638	`case REALSXP:`
639	`formatReal(REAL(labels), n, &w, &d, &e);`	639	`formatReal(REAL(labels), n, &w, &d, &e);`
640	`PROTECT(ans = allocVector(STRSXP, n));`	640	`PROTECT(ans = allocVector(STRSXP, n));`
641	`for (i = 0; i < n; i++) {`	641	`for (i = 0; i < n; i++) {`
642	`strp = EncodeReal(REAL(labels)[i], 0, d, e);`	642	`strp = EncodeReal(REAL(labels)[i], 0, d, e);`
643	`STRING(ans)[i] = mkChar(strp);`	643	`SET_STRING_ELT(ans, i, mkChar(strp));`
644	`}`	644	`}`
645	`UNPROTECT(1);`	645	`UNPROTECT(1);`
646	`break;`	646	`break;`
647	`case CPLXSXP:`	647	`case CPLXSXP:`
648	`formatComplex(COMPLEX(labels), n, &w, &d, &e, &wi, &di, &ei);`	648	`formatComplex(COMPLEX(labels), n, &w, &d, &e, &wi, &di, &ei);`
649	`PROTECT(ans = allocVector(STRSXP, n));`	649	`PROTECT(ans = allocVector(STRSXP, n));`
650	`for (i = 0; i < n; i++) {`	650	`for (i = 0; i < n; i++) {`
651	`strp = EncodeComplex(COMPLEX(labels)[i], 0, d, e, 0, di, ei);`	651	`strp = EncodeComplex(COMPLEX(labels)[i], 0, d, e, 0, di, ei);`
652	`STRING(ans)[i] = mkChar(strp);`	652	`SET_STRING_ELT(ans, i, mkChar(strp));`
653	`}`	653	`}`
654	`UNPROTECT(1);`	654	`UNPROTECT(1);`
655	`break;`	655	`break;`
656	`case STRSXP:`	656	`case STRSXP:`
657	`formatString(STRING(labels), n, &w, 0);`	657	`formatString(STRING_PTR(labels), n, &w, 0);`
658	`PROTECT(ans = allocVector(STRSXP, n));`	658	`PROTECT(ans = allocVector(STRSXP, n));`
659	`for (i = 0; i < n; i++) {`	659	`for (i = 0; i < n; i++) {`
660	`#ifdef OLD`	660	`#ifdef OLD`
661	`strp = EncodeString(CHAR(STRING(labels)[i]), 0, 0, Rprt_adj_left);`	661	`strp = EncodeString(CHAR(STRING_ELT(labels, i)), 0, 0, Rprt_adj_left);`
662	`STRING(ans)[i] = mkChar(strp);`	662	`SET_STRING_ELT(ans, i, mkChar(strp));`
663	`#else`	663	`#else`
664	`STRING(ans)[i] = STRING(labels)[i];`	664	`SET_STRING_ELT(ans, i, STRING_ELT(labels, i));`
665	`#endif`	665	`#endif`
666	`}`	666	`}`
667	`UNPROTECT(1);`	667	`UNPROTECT(1);`
668	`break;`	668	`break;`
669	`default:`	669	`default:`
Line 1067...	Line 1067...
1067	`temp = GConvertX(x, USER, NFC, dd);`	1067	`temp = GConvertX(x, USER, NFC, dd);`
1068	`if (dolabels) {`	1068	`if (dolabels) {`
1069	`/* Clip tick labels to user coordinates. */`	1069	`/* Clip tick labels to user coordinates. */`
1070	`if (x > low && x < high) {`	1070	`if (x > low && x < high) {`
1071	`if (isExpression(lab)) {`	1071	`if (isExpression(lab)) {`
1072	`GMMathText(VECTOR(lab)[ind[i]], side,`	1072	`GMMathText(VECTOR_ELT(lab, ind[i]), side,`
1073	`axis_lab, 0, x, dd->gp.las, dd);`	1073	`axis_lab, 0, x, dd->gp.las, dd);`
1074	`}`	1074	`}`
1075	`else {`	1075	`else {`
1076	`labw = GStrWidth(CHAR(STRING(lab)[ind[i]]), NFC, dd);`	1076	`labw = GStrWidth(CHAR(STRING_ELT(lab, ind[i])), NFC, dd);`
1077	`tnew = temp - 0.5 * labw;`	1077	`tnew = temp - 0.5 * labw;`
1078	`/* Check room for perpendicular labels. */`	1078	`/* Check room for perpendicular labels. */`
1079	`if (dd->gp.las == 2 \|\| dd->gp.las == 3 \|\|`	1079	`if (dd->gp.las == 2 \|\| dd->gp.las == 3 \|\|`
1080	`tnew - tlast >= gap) {`	1080	`tnew - tlast >= gap) {`
1081	`GMtext(CHAR(STRING(lab)[ind[i]]), side,`	1081	`GMtext(CHAR(STRING_ELT(lab, ind[i])), side,`
1082	`axis_lab, 0, x, dd->gp.las, dd);`	1082	`axis_lab, 0, x, dd->gp.las, dd);`
1083	`tlast = temp + 0.5 *labw;`	1083	`tlast = temp + 0.5 *labw;`
1084	`}`	1084	`}`
1085	`}`	1085	`}`
1086	`}`	1086	`}`
Line 1152...	Line 1152...
1152	`temp = GConvertY(y, USER, NFC, dd);`	1152	`temp = GConvertY(y, USER, NFC, dd);`
1153	`if (dolabels) {`	1153	`if (dolabels) {`
1154	`/* Clip tick labels to user coordinates. */`	1154	`/* Clip tick labels to user coordinates. */`
1155	`if (y > low && y < high) {`	1155	`if (y > low && y < high) {`
1156	`if (isExpression(lab)) {`	1156	`if (isExpression(lab)) {`
1157	`GMMathText(VECTOR(lab)[ind[i]], side,`	1157	`GMMathText(VECTOR_ELT(lab, ind[i]), side,`
1158	`axis_lab, 0, y, dd->gp.las, dd);`	1158	`axis_lab, 0, y, dd->gp.las, dd);`
1159	`}`	1159	`}`
1160	`else {`	1160	`else {`
1161	`labw = GStrWidth(CHAR(STRING(lab)[ind[i]]), INCHES, dd);`	1161	`labw = GStrWidth(CHAR(STRING_ELT(lab, ind[i])), INCHES, dd);`
1162	`labw = GConvertYUnits(labw, INCHES, NFC, dd);`	1162	`labw = GConvertYUnits(labw, INCHES, NFC, dd);`
1163	`tnew = temp - 0.5 * labw;`	1163	`tnew = temp - 0.5 * labw;`
1164	`/* Check room for perpendicular labels. */`	1164	`/* Check room for perpendicular labels. */`
1165	`if (dd->gp.las == 1 \|\| dd->gp.las == 2 \|\|`	1165	`if (dd->gp.las == 1 \|\| dd->gp.las == 2 \|\|`
1166	`tnew - tlast >= gap) {`	1166	`tnew - tlast >= gap) {`
1167	`GMtext(CHAR(STRING(lab)[ind[i]]), side,`	1167	`GMtext(CHAR(STRING_ELT(lab, ind[i])), side,`
1168	`axis_lab, 0, y, dd->gp.las, dd);`	1168	`axis_lab, 0, y, dd->gp.las, dd);`
1169	`tlast = temp + 0.5 *labw;`	1169	`tlast = temp + 0.5 *labw;`
1170	`}`	1170	`}`
1171	`}`	1171	`}`
1172	`}`	1172	`}`
Line 1207...	Line 1207...
1207	`sy = R_NilValue; /* -Wall */`	1207	`sy = R_NilValue; /* -Wall */`
1208		1208
1209	`/* Required Arguments */`	1209	`/* Required Arguments */`
1210	`sxy = CAR(args);`	1210	`sxy = CAR(args);`
1211	`if (isNewList(sxy) && length(sxy) >= 2) {`	1211	`if (isNewList(sxy) && length(sxy) >= 2) {`
1212	`internalTypeCheck(call, sx = VECTOR(sxy)[0], REALSXP);`	1212	`internalTypeCheck(call, sx = VECTOR_ELT(sxy, 0), REALSXP);`
1213	`internalTypeCheck(call, sy = VECTOR(sxy)[1], REALSXP);`	1213	`internalTypeCheck(call, sy = VECTOR_ELT(sxy, 1), REALSXP);`
1214	`}`	1214	`}`
1215	`else if (isList(sxy) && length(sxy) >= 2) {`	1215	`else if (isList(sxy) && length(sxy) >= 2) {`
1216	`internalTypeCheck(call, sx = CAR(sxy), REALSXP);`	1216	`internalTypeCheck(call, sx = CAR(sxy), REALSXP);`
1217	`internalTypeCheck(call, sy = CADR(sxy), REALSXP);`	1217	`internalTypeCheck(call, sy = CADR(sxy), REALSXP);`
1218	`}`	1218	`}`
Line 1224...	Line 1224...
1224	`args = CDR(args);`	1224	`args = CDR(args);`
1225		1225
1226	`if (isNull(CAR(args))) type = 'p';`	1226	`if (isNull(CAR(args))) type = 'p';`
1227	`else {`	1227	`else {`
1228	`if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)`	1228	`if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)`
1229	`type = CHAR(STRING(CAR(args))[0])[0];`	1229	`type = CHAR(STRING_ELT(CAR(args), 0))[0];`
1230	`else errorcall(call, "invalid plot type");`	1230	`else errorcall(call, "invalid plot type");`
1231	`}`	1231	`}`
1232	`args = CDR(args);`	1232	`args = CDR(args);`
1233		1233
1234	`PROTECT(pch = FixupPch(CAR(args), dd->gp.pch)); args = CDR(args);`	1234	`PROTECT(pch = FixupPch(CAR(args), dd->gp.pch)); args = CDR(args);`
Line 1413...	Line 1413...
1413	`{`	1413	`{`
1414	`int k=0;/* -Wall */`	1414	`int k=0;/* -Wall */`
1415		1415
1416	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`	1416	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`
1417	`errorcall(call, "first argument invalid");`	1417	`errorcall(call, "first argument invalid");`
1418	`CAR(args) = coerceVector(CAR(args), REALSXP);`	1418	`SETCAR(args, coerceVector(CAR(args), REALSXP));`
1419	`*n = k;`	1419	`*n = k;`
1420	`args = CDR(args);`	1420	`args = CDR(args);`
1421		1421
1422	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`	1422	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`
1423	`errorcall(call, "second argument invalid");`	1423	`errorcall(call, "second argument invalid");`
1424	`CAR(args) = coerceVector(CAR(args), REALSXP);`	1424	`SETCAR(args, coerceVector(CAR(args), REALSXP));`
1425	`if (k > n) n = k;`	1425	`if (k > n) n = k;`
1426	`args = CDR(args);`	1426	`args = CDR(args);`
1427		1427
1428	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`	1428	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`
1429	`errorcall(call, "third argument invalid");`	1429	`errorcall(call, "third argument invalid");`
1430	`CAR(args) = coerceVector(CAR(args), REALSXP);`	1430	`SETCAR(args, coerceVector(CAR(args), REALSXP));`
1431	`if (k > n) n = k;`	1431	`if (k > n) n = k;`
1432	`args = CDR(args);`	1432	`args = CDR(args);`
1433		1433
1434	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`	1434	`if (!isNumeric(CAR(args)) \|\| (k = LENGTH(CAR(args))) <= 0)`
1435	`errorcall(call, "fourth argument invalid");`	1435	`errorcall(call, "fourth argument invalid");`
1436	`CAR(args) = coerceVector(CAR(args), REALSXP);`	1436	`SETCAR(args, coerceVector(CAR(args), REALSXP));`
1437	`if (k > n) n = k;`	1437	`if (k > n) n = k;`
1438	`args = CDR(args);`	1438	`args = CDR(args);`
1439	`}`	1439	`}`
1440		1440
1441		1441
Line 1703...	Line 1703...
1703		1703
1704	`if (length(args) < 2) errorcall(call, "too few arguments");`	1704	`if (length(args) < 2) errorcall(call, "too few arguments");`
1705		1705
1706	`if (!isNumeric(CAR(args)) \|\| (nx = LENGTH(CAR(args))) <= 0)`	1706	`if (!isNumeric(CAR(args)) \|\| (nx = LENGTH(CAR(args))) <= 0)`
1707	`errorcall(call, "first argument invalid");`	1707	`errorcall(call, "first argument invalid");`
1708	`sx = CAR(args) = coerceVector(CAR(args), REALSXP);`	1708	`sx = SETCAR(args, coerceVector(CAR(args), REALSXP));`
1709	`args = CDR(args);`	1709	`args = CDR(args);`
1710		1710
1711	`if (!isNumeric(CAR(args)) \|\| (ny = LENGTH(CAR(args))) <= 0)`	1711	`if (!isNumeric(CAR(args)) \|\| (ny = LENGTH(CAR(args))) <= 0)`
1712	`errorcall(call, "second argument invalid");`	1712	`errorcall(call, "second argument invalid");`
1713	`sy = CAR(args) = coerceVector(CAR(args), REALSXP);`	1713	`sy = SETCAR(args, coerceVector(CAR(args), REALSXP));`
1714	`args = CDR(args);`	1714	`args = CDR(args);`
1715		1715
1716	`if (ny != nx)`	1716	`if (ny != nx)`
1717	`errorcall(call, "x and y lengths differ in polygon");`	1717	`errorcall(call, "x and y lengths differ in polygon");`
1718		1718
Line 1807...	Line 1807...
1807	`sx = R_NilValue; /* -Wall */`	1807	`sx = R_NilValue; /* -Wall */`
1808	`sy = R_NilValue; /* -Wall */`	1808	`sy = R_NilValue; /* -Wall */`
1809		1809
1810	`sxy = CAR(args);`	1810	`sxy = CAR(args);`
1811	`if (isNewList(sxy) && length(sxy) >= 2) {`	1811	`if (isNewList(sxy) && length(sxy) >= 2) {`
1812	`internalTypeCheck(call, sx = VECTOR(sxy)[0], REALSXP);`	1812	`internalTypeCheck(call, sx = VECTOR_ELT(sxy, 0), REALSXP);`
1813	`internalTypeCheck(call, sy = VECTOR(sxy)[1], REALSXP);`	1813	`internalTypeCheck(call, sy = VECTOR_ELT(sxy, 1), REALSXP);`
1814	`}`	1814	`}`
1815	`else if (isList(sxy) && length(sxy) >= 2) {`	1815	`else if (isList(sxy) && length(sxy) >= 2) {`
1816	`internalTypeCheck(call, sx = CAR(sxy), REALSXP);`	1816	`internalTypeCheck(call, sx = CAR(sxy), REALSXP);`
1817	`internalTypeCheck(call, sy = CADR(sxy), REALSXP);`	1817	`internalTypeCheck(call, sy = CADR(sxy), REALSXP);`
1818	`}`	1818	`}`
Line 1930...	Line 1930...
1930	`adjy = dd->gp.yCharOffset;`	1930	`adjy = dd->gp.yCharOffset;`
1931	`break;`	1931	`break;`
1932	`}`	1932	`}`
1933	`}`	1933	`}`
1934	`if (vectorFonts)`	1934	`if (vectorFonts)`
1935	`GVText(xx, yy, INCHES, CHAR(STRING(txt)[i % ntxt]),`	1935	`GVText(xx, yy, INCHES, CHAR(STRING_ELT(txt, i % ntxt)),`
1936	`INTEGER(vfont)[0], INTEGER(vfont)[1],`	1936	`INTEGER(vfont)[0], INTEGER(vfont)[1],`
1937	`adjx, adjy, dd->gp.srt, dd);`	1937	`adjx, adjy, dd->gp.srt, dd);`
1938	`else`	1938	`else`
1939	`if (isExpression(txt))`	1939	`if (isExpression(txt))`
1940	`GMathText(xx, yy, INCHES,`	1940	`GMathText(xx, yy, INCHES,`
1941	`VECTOR(txt)[i % ntxt],`	1941	`VECTOR_ELT(txt, i % ntxt),`
1942	`adjx, adjy, dd->gp.srt, dd);`	1942	`adjx, adjy, dd->gp.srt, dd);`
1943	`else`	1943	`else`
1944	`GText(xx, yy, INCHES,`	1944	`GText(xx, yy, INCHES,`
1945	`CHAR(STRING(txt)[i % ntxt]),`	1945	`CHAR(STRING_ELT(txt, i % ntxt)),`
1946	`adjx, adjy, dd->gp.srt, dd);`	1946	`adjx, adjy, dd->gp.srt, dd);`
1947	`}`	1947	`}`
1948	`}`	1948	`}`
1949	`GMode(0, dd);`	1949	`GMode(0, dd);`
1950		1950
Line 2144...	Line 2144...
2144	`dd->gp.font = (fontval == NA_INTEGER) ? fontsave : fontval;`	2144	`dd->gp.font = (fontval == NA_INTEGER) ? fontsave : fontval;`
2145	`dd->gp.col = (colval == NA_INTEGER) ? colsave : colval;`	2145	`dd->gp.col = (colval == NA_INTEGER) ? colsave : colval;`
2146	`dd->gp.adj = ComputeAdjValue(adjval, sideval, dd->gp.las);`	2146	`dd->gp.adj = ComputeAdjValue(adjval, sideval, dd->gp.las);`
2147	`atval = ComputeAtValue(atval, dd->gp.adj, sideval, outerval, dd);`	2147	`atval = ComputeAtValue(atval, dd->gp.adj, sideval, outerval, dd);`
2148	`if (isExpression(text))`	2148	`if (isExpression(text))`
2149	`GMMathText(VECTOR(text)[i%ntext],`	2149	`GMMathText(VECTOR_ELT(text, i%ntext),`
2150	`sideval, lineval, outerval, atval, dd->gp.las, dd);`	2150	`sideval, lineval, outerval, atval, dd->gp.las, dd);`
2151	`else`	2151	`else`
2152	`GMtext(CHAR(STRING(text)[i%ntext]),`	2152	`GMtext(CHAR(STRING_ELT(text, i%ntext)),`
2153	`sideval, lineval, outerval, atval, dd->gp.las, dd);`	2153	`sideval, lineval, outerval, atval, dd->gp.las, dd);`
2154	`if (outerval == 0) dirtyplot = 1;`	2154	`if (outerval == 0) dirtyplot = 1;`
2155	`}`	2155	`}`
2156	`GMode(0, dd);`	2156	`GMode(0, dd);`
2157		2157
Line 2256...	Line 2256...
2256	`hpos = GConvertX(adj, NPC, USER, dd);`	2256	`hpos = GConvertX(adj, NPC, USER, dd);`
2257	`where = MAR3;`	2257	`where = MAR3;`
2258	`}`	2258	`}`
2259	`if (isExpression(Main)) {`	2259	`if (isExpression(Main)) {`
2260	`GMathText(hpos, vpos, where,`	2260	`GMathText(hpos, vpos, where,`
2261	`VECTOR(Main)[0], adj, adjy, 0.0, dd);`	2261	`VECTOR_ELT(Main, 0), adj, 0.5, 0.0, dd);`
2262	`}`	2262	`}`
2263	`else {`	2263	`else {`
2264	`n = length(Main);`	2264	`n = length(Main);`
2265	`offset = 0.5 * (n - 1) + vpos;`	2265	`offset = 0.5 * (n - 1) + vpos;`
2266	`for (i = 0; i < n; i++)`	2266	`for (i = 0; i < n; i++)`
2267	`GText(hpos, offset - i, where,`	2267	`GText(hpos, offset - i, where,`
2268	`CHAR(STRING(Main)[i]), adj, adjy, 0.0, dd);`	2268	`CHAR(STRING_ELT(Main, i)), adj, adjy, 0.0, dd);`
2269	`}`	2269	`}`
2270	`}`	2270	`}`
2271	`if (sub != R_NilValue) {`	2271	`if (sub != R_NilValue) {`
2272	`cex = dd->gp.cexsub;`	2272	`cex = dd->gp.cexsub;`
2273	`col = dd->gp.colsub;`	2273	`col = dd->gp.colsub;`
Line 2287...	Line 2287...
2287	`else {`	2287	`else {`
2288	`hpos = GConvertX(adj, NPC, USER, dd);`	2288	`hpos = GConvertX(adj, NPC, USER, dd);`
2289	`where = 0;`	2289	`where = 0;`
2290	`}`	2290	`}`
2291	`if (isExpression(sub))`	2291	`if (isExpression(sub))`
2292	`GMMathText(VECTOR(sub)[0], 1, vpos, where,`	2292	`GMMathText(VECTOR_ELT(sub, 0), 1, vpos, where,`
2293	`hpos, 0, dd);`	2293	`hpos, 0, dd);`
2294	`else {`	2294	`else {`
2295	`n = length(sub);`	2295	`n = length(sub);`
2296	`for (i = 0; i < n; i++)`	2296	`for (i = 0; i < n; i++)`
2297	`GMtext(CHAR(STRING(sub)[i]), 1, vpos, where,`	2297	`GMtext(CHAR(STRING_ELT(sub, i)), 1, vpos, where,`
2298	`hpos, 0, dd);`	2298	`hpos, 0, dd);`
2299	`}`	2299	`}`
2300	`}`	2300	`}`
2301	`if (xlab != R_NilValue) {`	2301	`if (xlab != R_NilValue) {`
2302	`cex = dd->gp.cexlab;`	2302	`cex = dd->gp.cexlab;`
Line 2317...	Line 2317...
2317	`else {`	2317	`else {`
2318	`hpos = GConvertX(adj, NPC, USER, dd);`	2318	`hpos = GConvertX(adj, NPC, USER, dd);`
2319	`where = 0;`	2319	`where = 0;`
2320	`}`	2320	`}`
2321	`if (isExpression(xlab))`	2321	`if (isExpression(xlab))`
2322	`GMMathText(VECTOR(xlab)[0], 1, vpos + i, where,`	2322	`GMMathText(VECTOR_ELT(xlab, 0), 1, vpos + i, where,`
2323	`hpos, 0, dd);`	2323	`hpos, 0, dd);`
2324	`else {`	2324	`else {`
2325	`n = length(xlab);`	2325	`n = length(xlab);`
2326	`for (i = 0; i < n; i++)`	2326	`for (i = 0; i < n; i++)`
2327	`GMtext(CHAR(STRING(xlab)[i]), 1, vpos + i, where,`	2327	`GMtext(CHAR(STRING_ELT(xlab, i)), 1, vpos + i, where,`
2328	`hpos, 0, dd);`	2328	`hpos, 0, dd);`
2329	`}`	2329	`}`
2330	`}`	2330	`}`
2331	`if (ylab != R_NilValue) {`	2331	`if (ylab != R_NilValue) {`
2332	`cex = dd->gp.cexlab;`	2332	`cex = dd->gp.cexlab;`
Line 2347...	Line 2347...
2347	`else {`	2347	`else {`
2348	`hpos = GConvertY(adj, NPC, USER, dd);`	2348	`hpos = GConvertY(adj, NPC, USER, dd);`
2349	`where = 0;`	2349	`where = 0;`
2350	`}`	2350	`}`
2351	`if (isExpression(ylab))`	2351	`if (isExpression(ylab))`
2352	`GMMathText(VECTOR(ylab)[0], 2, vpos, where,`	2352	`GMMathText(VECTOR_ELT(ylab, 0), 2, vpos, where,`
2353	`hpos, 0, dd);`	2353	`hpos, 0, dd);`
2354	`else {`	2354	`else {`
2355	`n = length(ylab);`	2355	`n = length(ylab);`
2356	`for (i = 0; i < n; i++)`	2356	`for (i = 0; i < n; i++)`
2357	`GMtext(CHAR(STRING(ylab)[i]), 2, vpos - i, where,`	2357	`GMtext(CHAR(STRING_ELT(ylab, i)), 2, vpos - i, where,`
2358	`hpos, 0, dd);`	2358	`hpos, 0, dd);`
2359	`}`	2359	`}`
2360	`}`	2360	`}`
2361	`GMode(0, dd);`	2361	`GMode(0, dd);`
2362	`GRestorePars(dd);`	2362	`GRestorePars(dd);`
Line 2382...	Line 2382...
2382	`GCheckState(dd);`	2382	`GCheckState(dd);`
2383		2383
2384	`if (length(args) < 5) errorcall(call, "too few arguments");`	2384	`if (length(args) < 5) errorcall(call, "too few arguments");`
2385		2385
2386	`if ((a = CAR(args)) != R_NilValue)`	2386	`if ((a = CAR(args)) != R_NilValue)`
2387	`CAR(args) = a = coerceVector(a, REALSXP);`	2387	`SETCAR(args, a = coerceVector(a, REALSXP));`
2388	`args = CDR(args);`	2388	`args = CDR(args);`
2389		2389
2390	`if ((b = CAR(args)) != R_NilValue)`	2390	`if ((b = CAR(args)) != R_NilValue)`
2391	`CAR(args) = b = coerceVector(b, REALSXP);`	2391	`SETCAR(args, b = coerceVector(b, REALSXP));`
2392	`args = CDR(args);`	2392	`args = CDR(args);`
2393		2393
2394	`if ((h = CAR(args)) != R_NilValue)`	2394	`if ((h = CAR(args)) != R_NilValue)`
2395	`CAR(args) = h = coerceVector(h, REALSXP);`	2395	`SETCAR(args, h = coerceVector(h, REALSXP));`
2396	`args = CDR(args);`	2396	`args = CDR(args);`
2397		2397
2398	`if ((v = CAR(args)) != R_NilValue)`	2398	`if ((v = CAR(args)) != R_NilValue)`
2399	`CAR(args) = v = coerceVector(v, REALSXP);`	2399	`SETCAR(args, v = coerceVector(v, REALSXP));`
2400	`args = CDR(args);`	2400	`args = CDR(args);`
2401		2401
2402	`if ((untf = CAR(args)) != R_NilValue)`	2402	`if ((untf = CAR(args)) != R_NilValue)`
2403	`CAR(args) = untf = coerceVector(untf, LGLSXP);`	2403	`SETCAR(args, untf = coerceVector(untf, LGLSXP));`
2404	`args = CDR(args);`	2404	`args = CDR(args);`
2405		2405
2406		2406
2407	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`	2407	`PROTECT(col = FixupCol(CAR(args), NA_INTEGER)); args = CDR(args);`
2408	`ncol = LENGTH(col);`	2408	`ncol = LENGTH(col);`
Line 2582...	Line 2582...
2582	`x = CAR(args); args = CDR(args);`	2582	`x = CAR(args); args = CDR(args);`
2583	`y = CAR(args); args = CDR(args);`	2583	`y = CAR(args); args = CDR(args);`
2584	`nobs = CAR(args); args = CDR(args);`	2584	`nobs = CAR(args); args = CDR(args);`
2585	`n = INTEGER(nobs)[0];`	2585	`n = INTEGER(nobs)[0];`
2586	`stype = CAR(args); args = CDR(args);`	2586	`stype = CAR(args); args = CDR(args);`
2587	`type = CHAR(STRING(stype)[0])[0];`	2587	`type = CHAR(STRING_ELT(stype, 0))[0];`
2588	`if (type != 'n') {`	2588	`if (type != 'n') {`
2589	`GMode(1, dd);`	2589	`GMode(1, dd);`
2590	`for (i=0; i<n; i++) {`	2590	`for (i=0; i<n; i++) {`
2591	`xp = REAL(x)[i];`	2591	`xp = REAL(x)[i];`
2592	`yp = REAL(y)[i];`	2592	`yp = REAL(y)[i];`
Line 2608...	Line 2608...
2608	`args = CDR(args);`	2608	`args = CDR(args);`
2609	`if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)`	2609	`if (isString(CAR(args)) && LENGTH(CAR(args)) == 1)`
2610	`stype = CAR(args);`	2610	`stype = CAR(args);`
2611	`else`	2611	`else`
2612	`errorcall(call, "invalid plot type");`	2612	`errorcall(call, "invalid plot type");`
2613	`type = CHAR(STRING(stype)[0])[0];`	2613	`type = CHAR(STRING_ELT(stype, 0))[0];`
2614	`PROTECT(x = allocVector(REALSXP, n));`	2614	`PROTECT(x = allocVector(REALSXP, n));`
2615	`PROTECT(y = allocVector(REALSXP, n));`	2615	`PROTECT(y = allocVector(REALSXP, n));`
2616	`PROTECT(nobs=allocVector(INTSXP,1));`	2616	`PROTECT(nobs=allocVector(INTSXP,1));`
2617	`i = 0;`	2617	`i = 0;`
2618		2618
Line 2637...	Line 2637...
2637	`REAL(x)[i] = NA_REAL;`	2637	`REAL(x)[i] = NA_REAL;`
2638	`REAL(y)[i] = NA_REAL;`	2638	`REAL(y)[i] = NA_REAL;`
2639	`i += 1;`	2639	`i += 1;`
2640	`}`	2640	`}`
2641	`PROTECT(ans = allocList(3));`	2641	`PROTECT(ans = allocList(3));`
2642	`CAR(ans) = x;`	2642	`SETCAR(ans, x);`
2643	`CADR(ans) = y;`	2643	`SETCADR(ans, y);`
2644	`CADDR(ans) = nobs;`	2644	`SETCADDR(ans, nobs);`
2645	`PROTECT(saveans = allocList(4));`	2645	`PROTECT(saveans = allocList(4));`
2646	`CAR(saveans) = x;`	2646	`SETCAR(saveans, x);`
2647	`CADR(saveans) = y;`	2647	`SETCADR(saveans, y);`
2648	`CADDR(saveans) = nobs;`	2648	`SETCADDR(saveans, nobs);`
2649	`CADDDR(saveans) = CAR(args);`	2649	`SETCADDDR(saveans, CAR(args));`
2650	`/* Record the points and lines that were drawn in the display list */`	2650	`/* Record the points and lines that were drawn in the display list */`
2651	`recordGraphicOperation(op, saveans, dd);`	2651	`recordGraphicOperation(op, saveans, dd);`
2652	`UNPROTECT(5);`	2652	`UNPROTECT(5);`
2653	`return ans;`	2653	`return ans;`
2654	`}`	2654	`}`
Line 2706...	Line 2706...
2706	`xi = REAL(x)[i];`	2706	`xi = REAL(x)[i];`
2707	`yi = REAL(y)[i];`	2707	`yi = REAL(y)[i];`
2708	`GConvert(&xi, &yi, USER, INCHES, dd);`	2708	`GConvert(&xi, &yi, USER, INCHES, dd);`
2709	`posi = INTEGER(pos)[i];`	2709	`posi = INTEGER(pos)[i];`
2710	`offset = GConvertXUnits(asReal(Offset), CHARS, INCHES, dd);`	2710	`offset = GConvertXUnits(asReal(Offset), CHARS, INCHES, dd);`
2711	`drawLabel(xi, yi, posi, offset, CHAR(STRING(l)[i]), dd);`	2711	`drawLabel(xi, yi, posi, offset, CHAR(STRING_ELT(l, i)), dd);`
2712	`}`	2712	`}`
2713	`}`	2713	`}`
2714	`return R_NilValue;`	2714	`return R_NilValue;`
2715	`}`	2715	`}`
2716	`else {`	2716	`else {`
Line 2785...	Line 2785...
2785	`INTEGER(pos)[imin] = 1;`	2785	`INTEGER(pos)[imin] = 1;`
2786	`}`	2786	`}`
2787	`}`	2787	`}`
2788	`if (plot)`	2788	`if (plot)`
2789	`drawLabel(xi, yi, INTEGER(pos)[imin], offset,`	2789	`drawLabel(xi, yi, INTEGER(pos)[imin], offset,`
2790	`CHAR(STRING(l)[imin]), dd);`	2790	`CHAR(STRING_ELT(l, imin)), dd);`
2791	`}`	2791	`}`
2792	`}`	2792	`}`
2793	`GMode(0, dd);`	2793	`GMode(0, dd);`
2794	`PROTECT(ans = allocList(2));`	2794	`PROTECT(ans = allocList(2));`
2795	`CAR(ans) = ind;`	2795	`SETCAR(ans, ind);`
2796	`CADR(ans) = pos;`	2796	`SETCADR(ans, pos);`
2797	`PROTECT(saveans = allocList(6));`	2797	`PROTECT(saveans = allocList(6));`
2798	`CAR(saveans) = ind;`	2798	`SETCAR(saveans, ind);`
2799	`CADR(saveans) = pos;`	2799	`SETCADR(saveans, pos);`
2800	`CADDR(saveans) = x;`	2800	`SETCADDR(saveans, x);`
2801	`CADDDR(saveans) = y;`	2801	`SETCADDDR(saveans, y);`
2802	`CAD4R(saveans) = Offset;`	2802	`SETCAD4R(saveans, Offset);`
2803	`CAD4R(CDR(saveans)) = l;`	2803	`SETCAD4R(CDR(saveans), l);`
2804		2804
2805	`/* We are recording, so save enough information to be able to`	2805	`/* We are recording, so save enough information to be able to`
2806	`redraw the text labels beside identified points */`	2806	`redraw the text labels beside identified points */`
2807	`if (call != R_NilValue)`	2807	`if (call != R_NilValue)`
2808	`recordGraphicOperation(op, saveans, dd);`	2808	`recordGraphicOperation(op, saveans, dd);`
Line 2847...	Line 2847...
2847	`gw = 0;`	2847	`gw = 0;`
2848	`ht = GStrHeight("M", INCHES, dd);`	2848	`ht = GStrHeight("M", INCHES, dd);`
2849	`xmin = DBL_MAX;`	2849	`xmin = DBL_MAX;`
2850	`xmax = DBL_MIN;`	2850	`xmax = DBL_MIN;`
2851	`for (i = 0; i < n; i++) {`	2851	`for (i = 0; i < n; i++) {`
2852	`wd = GStrWidth(CHAR(STRING(labs)[i]), INCHES, dd) / ht;`	2852	`wd = GStrWidth(CHAR(STRING_ELT(labs, i)), INCHES, dd) / ht;`
2853	`if (wd > 0) {`	2853	`if (wd > 0) {`
2854	`if (INTEGER(offset)[i] == 1) {`	2854	`if (INTEGER(offset)[i] == 1) {`
2855	`if (wd > gw) gw = wd;`	2855	`if (wd > gw) gw = wd;`
2856	`}`	2856	`}`
2857	`else {`	2857	`else {`
Line 2900...	Line 2900...
2900	`/* NOTE: don't override to _reduce_ clipping region */`	2900	`/* NOTE: don't override to _reduce_ clipping region */`
2901	`if (dd->gp.xpd < 1)`	2901	`if (dd->gp.xpd < 1)`
2902	`xpd = 1;`	2902	`xpd = 1;`
2903		2903
2904	`for (i = 0; i < n; i++) {`	2904	`for (i = 0; i < n; i++) {`
2905	`if (strlen(CHAR(STRING(labs)[i])) > 0) {`	2905	`if (strlen(CHAR(STRING_ELT(labs, i))) > 0) {`
2906	`if (LOGICAL(offset)[i])`	2906	`if (LOGICAL(offset)[i])`
2907	`GMtext(CHAR(STRING(labs)[i]), 2, gw, 0, (double)(i+1), 2, dd);`	2907	`GMtext(CHAR(STRING_ELT(labs, i)), 2, gw, 0, (double)(i+1), 2, dd);`
2908	`else`	2908	`else`
2909	`GMtext(CHAR(STRING(labs)[i]), 2, lw, 0, (double)(i+1), 2, dd);`	2909	`GMtext(CHAR(STRING_ELT(labs, i)), 2, lw, 0, (double)(i+1), 2, dd);`
2910	`}`	2910	`}`
2911	`}`	2911	`}`
2912	`dd->gp.adj = adj;`	2912	`dd->gp.adj = adj;`
2913	`dd->gp.xpd = xpd;`	2913	`dd->gp.xpd = xpd;`
2914		2914
Line 2950...	Line 2950...
2950	`PROTECT(ans = allocVector(REALSXP, n));`	2950	`PROTECT(ans = allocVector(REALSXP, n));`
2951	`cexsave = dd->gp.cex;`	2951	`cexsave = dd->gp.cex;`
2952	`dd->gp.cex = cex * dd->gp.cexbase;`	2952	`dd->gp.cex = cex * dd->gp.cexbase;`
2953	`for (i = 0; i < n; i++)`	2953	`for (i = 0; i < n; i++)`
2954	`if (isExpression(str))`	2954	`if (isExpression(str))`
2955	`REAL(ans)[i] = GExpressionHeight(VECTOR(str)[i],`	2955	`REAL(ans)[i] = GExpressionHeight(VECTOR_ELT(str, i),`
2956	`GMapUnits(units), dd);`	2956	`GMapUnits(units), dd);`
2957	`else`	2957	`else`
2958	`REAL(ans)[i] = GStrHeight(CHAR(STRING(str)[i]),`	2958	`REAL(ans)[i] = GStrHeight(CHAR(STRING_ELT(str, i)),`
2959	`GMapUnits(units), dd);`	2959	`GMapUnits(units), dd);`
2960	`dd->gp.cex = cexsave;`	2960	`dd->gp.cex = cexsave;`
2961	`UNPROTECT(1);`	2961	`UNPROTECT(1);`
2962	`return ans;`	2962	`return ans;`
2963	`}`	2963	`}`
Line 2992...	Line 2992...
2992	`PROTECT(ans = allocVector(REALSXP, n));`	2992	`PROTECT(ans = allocVector(REALSXP, n));`
2993	`cexsave = dd->gp.cex;`	2993	`cexsave = dd->gp.cex;`
2994	`dd->gp.cex = cex * dd->gp.cexbase;`	2994	`dd->gp.cex = cex * dd->gp.cexbase;`
2995	`for (i = 0; i < n; i++)`	2995	`for (i = 0; i < n; i++)`
2996	`if (isExpression(str))`	2996	`if (isExpression(str))`
2997	`REAL(ans)[i] = GExpressionWidth(VECTOR(str)[i],`	2997	`REAL(ans)[i] = GExpressionWidth(VECTOR_ELT(str, i),`
2998	`GMapUnits(units), dd);`	2998	`GMapUnits(units), dd);`
2999	`else`	2999	`else`
3000	`REAL(ans)[i] = GStrWidth(CHAR(STRING(str)[i]),`	3000	`REAL(ans)[i] = GStrWidth(CHAR(STRING_ELT(str, i)),`
3001	`GMapUnits(units), dd);`	3001	`GMapUnits(units), dd);`
3002	`dd->gp.cex = cexsave;`	3002	`dd->gp.cex = cexsave;`
3003	`UNPROTECT(1);`	3003	`UNPROTECT(1);`
3004	`return ans;`	3004	`return ans;`
3005	`}`	3005	`}`

The R Project SVN R

(root)/branches/R-GenGC/src/main/plot.c @ 28362 – Rev 9615 → 9642