The R Project SVN – R – Diff – /trunk/src/main/plot.c



	    INTEGER(ans)[i] = INTEGER(pch)[i];
    }
    else if (isReal(pch)) {
	for (i = 0; i < n; i++)
	    INTEGER(ans)[i] = R_FINITE(REAL(pch)[i]) ?
		(int) REAL(pch)[i] : NA_INTEGER;
    }
    else if (isString(pch)) {
	for (i = 0; i < n; i++) {
	    /* New in 2.7.0: negative values indicate Unicode points. */
	    INTEGER(ans)[i] = GEstring_to_pch(STRING_ELT(pch, i));

	}
    }
    else if (isReal(font)) {
	ans = allocVector(INTSXP, n);
	for (i = 0; i < n; i++) {
	    k = (int) REAL(font)[i];
#ifndef Win32
	    if (k < 1 || k > 5) k = NA_INTEGER;
#else
	    if (k < 1 || k > 32) k = NA_INTEGER;
#endif

 */
    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 = (int)(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);
	for (i = 0; i <= n; i++) {

	/* You get the 3 cases below by
	 *  for (y in 1e-5*c(1,2,8))  plot(y, log = "y")
	 */
	switch(n) {
	case 1: /* large range:	1	 * 10^k */
	    i = (int)(floor(log10(axp[1])) - ceil(log10(axp[0])) + 0.25);
	    ne = i / nint + 1;
#ifdef DEBUG_axis
	    REprintf("CreateAtVector [log-axis(), case 1]: (nint, ne) = (%d,%d)\n",
		     nint, ne);
#endif

    }
 
    /* Deferred processing */
    if (!R_FINITE(line)) {
	/* Except that here mgp values are not relative to themselves */
	line = (int) gpptr(dd)->mgp[2];
	lineoff = line;
    }
    if (!R_FINITE(pos)) pos = NA_REAL; else lineoff = 0;
 
    /* Determine the tickmark positions.  Note that these may fall */

    ProcessInlinePars(args, dd, call);
 
    /* Done here so 'vfont' trumps inline 'family' */
    if (!isNull(vfont) && !isExpression(txt)) {
	strncpy(gpptr(dd)->family, "Her ", 201);
	gpptr(dd)->family[3] = (char) INTEGER(vfont)[0];
	vectorFonts = TRUE;
    }
 
    GMode(1, dd);
    if (n == 0 && ntxt > 0)

    ProcessInlinePars(args, dd, call);					\
									\
    /* 'vfont' trumps inline 'family' */				\
    if (!isNull(vfont) && !isExpression(str)) {				\
	strncpy(gpptr(dd)->family, "Her ", 201);			\
	gpptr(dd)->family[3] = (char)INTEGER(vfont)[0];			\
	gpptr(dd)->font = INTEGER(vfont)[1];				\
    } else gpptr(dd)->font = INTEGER(font)[0];				\
									\
    n = LENGTH(str);							\
    PROTECT(ans = allocVector(REALSXP, n));				\

Rev 59167	Rev 59173
Line 93...	Line 93...
93	`INTEGER(ans)[i] = INTEGER(pch)[i];`	93	`INTEGER(ans)[i] = INTEGER(pch)[i];`
94	`}`	94	`}`
95	`else if (isReal(pch)) {`	95	`else if (isReal(pch)) {`
96	`for (i = 0; i < n; i++)`	96	`for (i = 0; i < n; i++)`
97	`INTEGER(ans)[i] = R_FINITE(REAL(pch)[i]) ?`	97	`INTEGER(ans)[i] = R_FINITE(REAL(pch)[i]) ?`
98	`REAL(pch)[i] : NA_INTEGER;`	98	`(int) REAL(pch)[i] : NA_INTEGER;`
99	`}`	99	`}`
100	`else if (isString(pch)) {`	100	`else if (isString(pch)) {`
101	`for (i = 0; i < n; i++) {`	101	`for (i = 0; i < n; i++) {`
102	`/* New in 2.7.0: negative values indicate Unicode points. */`	102	`/* New in 2.7.0: negative values indicate Unicode points. */`
103	`INTEGER(ans)[i] = GEstring_to_pch(STRING_ELT(pch, i));`	103	`INTEGER(ans)[i] = GEstring_to_pch(STRING_ELT(pch, i));`
Line 188...	Line 188...
188	`}`	188	`}`
189	`}`	189	`}`
190	`else if (isReal(font)) {`	190	`else if (isReal(font)) {`
191	`ans = allocVector(INTSXP, n);`	191	`ans = allocVector(INTSXP, n);`
192	`for (i = 0; i < n; i++) {`	192	`for (i = 0; i < n; i++) {`
193	`k = REAL(font)[i];`	193	`k = (int) REAL(font)[i];`
194	`#ifndef Win32`	194	`#ifndef Win32`
195	`if (k < 1 \|\| k > 5) k = NA_INTEGER;`	195	`if (k < 1 \|\| k > 5) k = NA_INTEGER;`
196	`#else`	196	`#else`
197	`if (k < 1 \|\| k > 32) k = NA_INTEGER;`	197	`if (k < 1 \|\| k > 32) k = NA_INTEGER;`
198	`#endif`	198	`#endif`
Line 674...	Line 674...
674	`*/`	674	`*/`
675	`SEXP at = R_NilValue;/* -Wall*/`	675	`SEXP at = R_NilValue;/* -Wall*/`
676	`double umin, umax, dn, rng, small;`	676	`double umin, umax, dn, rng, small;`
677	`int i, n, ne;`	677	`int i, n, ne;`
678	`if (!logflag \|\| axp[2] < 0) { /* --- linear axis --- Only use axp[] arg. */`	678	`if (!logflag \|\| axp[2] < 0) { /* --- linear axis --- Only use axp[] arg. */`
679	`n = fabs(axp[2]) + 0.25;/* >= 0 */`	679	`n = (int)(fabs(axp[2]) + 0.25);/* >= 0 */`
680	`dn = imax2(1, n);`	680	`dn = imax2(1, n);`
681	`rng = axp[1] - axp[0];`	681	`rng = axp[1] - axp[0];`
682	`small = fabs(rng)/(100.*dn);`	682	`small = fabs(rng)/(100.*dn);`
683	`at = allocVector(REALSXP, n + 1);`	683	`at = allocVector(REALSXP, n + 1);`
684	`for (i = 0; i <= n; i++) {`	684	`for (i = 0; i <= n; i++) {`
Line 726...	Line 726...
726	`/* You get the 3 cases below by`	726	`/* You get the 3 cases below by`
727	`* for (y in 1e-5*c(1,2,8)) plot(y, log = "y")`	727	`* for (y in 1e-5*c(1,2,8)) plot(y, log = "y")`
728	`*/`	728	`*/`
729	`switch(n) {`	729	`switch(n) {`
730	`case 1: /* large range: 1 * 10^k */`	730	`case 1: /* large range: 1 * 10^k */`
731	`i = floor(log10(axp[1])) - ceil(log10(axp[0])) + 0.25;`	731	`i = (int)(floor(log10(axp[1])) - ceil(log10(axp[0])) + 0.25);`
732	`ne = i / nint + 1;`	732	`ne = i / nint + 1;`
733	`#ifdef DEBUG_axis`	733	`#ifdef DEBUG_axis`
734	`REprintf("CreateAtVector [log-axis(), case 1]: (nint, ne) = (%d,%d)\n",`	734	`REprintf("CreateAtVector [log-axis(), case 1]: (nint, ne) = (%d,%d)\n",`
735	`nint, ne);`	735	`nint, ne);`
736	`#endif`	736	`#endif`
Line 1071...	Line 1071...
1071	`}`	1071	`}`
1072		1072
1073	`/* Deferred processing */`	1073	`/* Deferred processing */`
1074	`if (!R_FINITE(line)) {`	1074	`if (!R_FINITE(line)) {`
1075	`/* Except that here mgp values are not relative to themselves */`	1075	`/* Except that here mgp values are not relative to themselves */`
1076	`line = gpptr(dd)->mgp[2];`	1076	`line = (int) gpptr(dd)->mgp[2];`
1077	`lineoff = line;`	1077	`lineoff = line;`
1078	`}`	1078	`}`
1079	`if (!R_FINITE(pos)) pos = NA_REAL; else lineoff = 0;`	1079	`if (!R_FINITE(pos)) pos = NA_REAL; else lineoff = 0;`
1080		1080
1081	`/* Determine the tickmark positions. Note that these may fall */`	1081	`/* Determine the tickmark positions. Note that these may fall */`
Line 2327...	Line 2327...
2327	`ProcessInlinePars(args, dd, call);`	2327	`ProcessInlinePars(args, dd, call);`
2328		2328
2329	`/* Done here so 'vfont' trumps inline 'family' */`	2329	`/* Done here so 'vfont' trumps inline 'family' */`
2330	`if (!isNull(vfont) && !isExpression(txt)) {`	2330	`if (!isNull(vfont) && !isExpression(txt)) {`
2331	`strncpy(gpptr(dd)->family, "Her ", 201);`	2331	`strncpy(gpptr(dd)->family, "Her ", 201);`
2332	`gpptr(dd)->family[3] = INTEGER(vfont)[0];`	2332	`gpptr(dd)->family[3] = (char) INTEGER(vfont)[0];`
2333	`vectorFonts = TRUE;`	2333	`vectorFonts = TRUE;`
2334	`}`	2334	`}`
2335		2335
2336	`GMode(1, dd);`	2336	`GMode(1, dd);`
2337	`if (n == 0 && ntxt > 0)`	2337	`if (n == 0 && ntxt > 0)`
Line 3498...	Line 3498...
3498	`ProcessInlinePars(args, dd, call); \`	3498	`ProcessInlinePars(args, dd, call); \`
3499	`\`	3499	`\`
3500	`/* 'vfont' trumps inline 'family' */ \`	3500	`/* 'vfont' trumps inline 'family' */ \`
3501	`if (!isNull(vfont) && !isExpression(str)) { \`	3501	`if (!isNull(vfont) && !isExpression(str)) { \`
3502	`strncpy(gpptr(dd)->family, "Her ", 201); \`	3502	`strncpy(gpptr(dd)->family, "Her ", 201); \`
3503	`gpptr(dd)->family[3] = INTEGER(vfont)[0]; \`	3503	`gpptr(dd)->family[3] = (char)INTEGER(vfont)[0]; \`
3504	`gpptr(dd)->font = INTEGER(vfont)[1]; \`	3504	`gpptr(dd)->font = INTEGER(vfont)[1]; \`
3505	`} else gpptr(dd)->font = INTEGER(font)[0]; \`	3505	`} else gpptr(dd)->font = INTEGER(font)[0]; \`
3506	`\`	3506	`\`
3507	`n = LENGTH(str); \`	3507	`n = LENGTH(str); \`
3508	`PROTECT(ans = allocVector(REALSXP, n)); \`	3508	`PROTECT(ans = allocVector(REALSXP, n)); \`

The R Project SVN R

(root)/trunk/src/main/plot.c @ 63243 – Rev 59167 → 59173