The R Project SVN R

Rev

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

Rev 45740 Rev 46135
Line 879... Line 879...
879 
}
 879 
}
880 
 
 880 
 
881 
SEXP attribute_hidden do_axis(SEXP call, SEXP op, SEXP args, SEXP env)
 881 
SEXP attribute_hidden do_axis(SEXP call, SEXP op, SEXP args, SEXP env)
882 
{
 882 
{
883 
    /* axis(side, at, labels, tick, line, pos,
 883 
    /* axis(side, at, labels, tick, line, pos,
884 
     *	    outer, font, lty, lwd, col, padj, ...) */
 884 
     	    outer, font, lty, lwd, lwd.ticks, col, col.ticks,
- 
 
 885 
	    hadj, padj, ...)
- 
 
 886 
    */
885 
 
 887 
 
886 
    SEXP at, lab, padj;
 888 
    SEXP at, lab, padj;
887 
    int font, lty, npadj;
 889 
    int font, lty, npadj;
888 
    rcolor col;
 890 
    rcolor col, colticks;
889 
    int i, n, nint = 0, ntmp, side, *ind, outer, lineoff = 0;
 891 
    int i, n, nint = 0, ntmp, side, *ind, outer, lineoff = 0;
890 
    int istart, iend, incr;
 892 
    int istart, iend, incr;
891 
    Rboolean dolabels, doticks, logflag = FALSE;
 893 
    Rboolean dolabels, doticks, logflag = FALSE;
892 
    Rboolean create_at;
 894 
    Rboolean create_at;
893 
    double x, y, temp, tnew, tlast;
 895 
    double x, y, temp, tnew, tlast;
894 
    double axp[3], usr[2], limits[2];
 896 
    double axp[3], usr[2], limits[2];
895 
    double gap, labw, low, high, line, pos, lwd, hadj;
 897 
    double gap, labw, low, high, line, pos, lwd, lwdticks, hadj;
896 
    double axis_base, axis_tick, axis_lab, axis_low, axis_high;
 898 
    double axis_base, axis_tick, axis_lab, axis_low, axis_high;
897 
 
 899 
 
898 
    SEXP originalArgs = args, label;
 900 
    SEXP originalArgs = args, label;
899 
    pGEDevDesc dd = GEcurrentDevice();
 901 
    pGEDevDesc dd = GEcurrentDevice();
900 
 
 902 
 
901 
    /* Arity Check */
 903 
    /* Arity Check */
902 
    /* This is a builtin function, so it should always have */
 904 
    /* This is a builtin function, so it should always have */
903 
    /* the correct arity, but it doesn't hurt to be defensive. */
 905 
    /* the correct arity, but it doesn't hurt to be defensive. */
904 
 
 906 
 
905 
    if (length(args) < 12)
 907 
    if (length(args) < 15)
906 
	error(_("too few arguments"));
 908 
	error(_("too few arguments"));
907 
    GCheckState(dd);
 909 
    GCheckState(dd);
908 
 
 910 
 
909 
    /* Required argument: "side" */
 911 
    /* Required argument: "side" */
910 
    /* Which side of the plot the axis is to appear on. */
 912 
    /* Which side of the plot the axis is to appear on. */
Line 993... Line 995...
993 
    args = CDR(args);
 995 
    args = CDR(args);
994 
 
 996 
 
995 
    /* Optional argument: "lwd" */
 997 
    /* Optional argument: "lwd" */
996 
    lwd = asReal(FixupLwd(CAR(args), 1));
 998 
    lwd = asReal(FixupLwd(CAR(args), 1));
997 
    args = CDR(args);
 999 
    args = CDR(args);
- 
 
 1000 
    lwdticks = asReal(FixupLwd(CAR(args), 1));
- 
 
 1001 
    args = CDR(args);
998 
 
 1002 
 
999 
    /* Optional argument: "col" */
 1003 
    /* Optional argument: "col" */
1000 
    col = asInteger(FixupCol(CAR(args), gpptr(dd)->fg));
 1004 
    col = asInteger(FixupCol(CAR(args), gpptr(dd)->fg));
1001 
    args = CDR(args);
 1005 
    args = CDR(args);
- 
 
 1006 
    colticks = asInteger(FixupCol(CAR(args), col));
- 
 
 1007 
    args = CDR(args);
1002 
 
 1008 
 
1003 
    /* Optional argument: "hadj" */
 1009 
    /* Optional argument: "hadj" */
1004 
    if (length(CAR(args)) != 1)
 1010 
    if (length(CAR(args)) != 1)
1005 
	error(_("'hadj' must be of length one"));
 1011 
	error(_("'hadj' must be of length one"));
1006 
    hadj = asReal(CAR(args));
 1012 
    hadj = asReal(CAR(args));
Line 1107... Line 1113...
1107 
	UNPROTECT(4);
 1113 
	UNPROTECT(4);
1108 
	return R_NilValue;
 1114 
	return R_NilValue;
1109 
    }
 1115 
    }
1110 
 
 1116 
 
1111 
 
 1117 
 
1112 
    /* no! we do allow an `lty' argument -- will not be used often though
 - 
 
1113 
     *	gpptr(dd)->lty = LTY_SOLID; */
 - 
 
1114 
    gpptr(dd)->lty = lty;
 1118 
    gpptr(dd)->lty = lty;
1115 
    gpptr(dd)->lwd = lwd;
 1119 
    gpptr(dd)->lwd = lwd;
1116 
    gpptr(dd)->adj = R_FINITE(hadj) ? hadj : 0.5;
 1120 
    gpptr(dd)->adj = R_FINITE(hadj) ? hadj : 0.5;
1117 
    gpptr(dd)->font = (font == NA_INTEGER)? gpptr(dd)->fontaxis : font;
 1121 
    gpptr(dd)->font = (font == NA_INTEGER)? gpptr(dd)->fontaxis : font;
1118 
    gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexaxis;
 1122 
    gpptr(dd)->cex = gpptr(dd)->cexbase * gpptr(dd)->cexaxis;
1119 
    /* no!   col = gpptr(dd)->col; */
 - 
 
1120 
 
 1123 
 
1121 
    /* Draw the axis */
 1124 
    /* Draw the axis */
1122 
    GMode(1, dd);
 1125 
    GMode(1, dd);
1123 
    switch (side) {
 1126 
    switch (side) {
1124 
    case 1: /*--- x-axis -- horizontal --- */
 1127 
    case 1: /*--- x-axis -- horizontal --- */
Line 1172... Line 1175...
1172 
	    } else
 1175 
	    } else
1173 
		axis_tick = axis_base -
 1176 
		axis_tick = axis_base -
1174 
		    GConvertYUnits(gpptr(dd)->tcl, LINES, NFC, dd);
 1177 
		    GConvertYUnits(gpptr(dd)->tcl, LINES, NFC, dd);
1175 
	}
 1178 
	}
1176 
	if (doticks) {
 1179 
	if (doticks) {
1177 
	    gpptr(dd)->col = col;/*was fg */
 1180 
	    gpptr(dd)->col = col;
- 
 
 1181 
	    if (lwd > 0.0)
1178 
	    GLine(axis_low, axis_base, axis_high, axis_base, NFC, dd);
 1182 
		GLine(axis_low, axis_base, axis_high, axis_base, NFC, dd);
- 
 
 1183 
	    gpptr(dd)->col = colticks;
- 
 
 1184 
	    gpptr(dd)->lwd = lwdticks;
- 
 
 1185 
	    if (lwdticks > 0) {
1179 
	    for (i = 0; i < n; i++) {
 1186 
		for (i = 0; i < n; i++) {
1180 
		x = REAL(at)[i];
 1187 
		    x = REAL(at)[i];
1181 
		if (low <= x && x <= high) {
 1188 
		    if (low <= x && x <= high) {
1182 
		    x = GConvertX(x, USER, NFC, dd);
 1189 
			x = GConvertX(x, USER, NFC, dd);
1183 
		    GLine(x, axis_base, x, axis_tick, NFC, dd);
 1190 
			GLine(x, axis_base, x, axis_tick, NFC, dd);
- 
 
 1191 
		    }
1184 
		}
 1192 
		}
1185 
	    }
 1193 
	    }
1186 
	}
 1194 
	}
1187 
	/* Tickmark labels. */
 1195 
	/* Tickmark labels. */
1188 
	gpptr(dd)->col = gpptr(dd)->colaxis;
 1196 
	gpptr(dd)->col = gpptr(dd)->colaxis;
Line 1307... Line 1315...
1307 
	    } else
 1315 
	    } else
1308 
		axis_tick = axis_base -
 1316 
		axis_tick = axis_base -
1309 
		    GConvertXUnits(gpptr(dd)->tcl, LINES, NFC, dd);
 1317 
		    GConvertXUnits(gpptr(dd)->tcl, LINES, NFC, dd);
1310 
	}
 1318 
	}
1311 
	if (doticks) {
 1319 
	if (doticks) {
1312 
	    gpptr(dd)->col = col;/*was fg */
 1320 
	    gpptr(dd)->col = col;
- 
 
 1321 
	    if (lwd > 0.0)
1313 
	    GLine(axis_base, axis_low, axis_base, axis_high, NFC, dd);
 1322 
		GLine(axis_base, axis_low, axis_base, axis_high, NFC, dd);
- 
 
 1323 
	    gpptr(dd)->col = colticks;
- 
 
 1324 
	    gpptr(dd)->lwd = lwdticks;
- 
 
 1325 
	    if (lwdticks > 0) {
1314 
	    for (i = 0; i < n; i++) {
 1326 
		for (i = 0; i < n; i++) {
1315 
		y = REAL(at)[i];
 1327 
		    y = REAL(at)[i];
1316 
		if (low <= y && y <= high) {
 1328 
		    if (low <= y && y <= high) {
1317 
		    y = GConvertY(y, USER, NFC, dd);
 1329 
			y = GConvertY(y, USER, NFC, dd);
1318 
		    GLine(axis_base, y, axis_tick, y, NFC, dd);
 1330 
			GLine(axis_base, y, axis_tick, y, NFC, dd);
- 
 
 1331 
		    }
1319 
		}
 1332 
		}
1320 
	    }
 1333 
	    }
1321 
	}
 1334 
	}
1322 
	/* Tickmark labels. */
 1335 
	/* Tickmark labels. */
1323 
	gpptr(dd)->col = gpptr(dd)->colaxis;
 1336 
	gpptr(dd)->col = gpptr(dd)->colaxis;