From bolker@zoo.ufl.edu  Mon Jan 17 18:59:13 2000
From: bolker@zoo.ufl.edu (Ben Bolker)
Date: Mon, 17 Jan 2000 13:59:13 -0500 (EST)
Subject: lwd patches for "contour"
Message-ID: <Pine.LNX.4.10.10001171353550.13450-100000@bolker.zoo.ufl.edu>


  I found it useful to have contour be able to do line widths ... hope
that the guts haven't changed an enormous amount in the current
development version ...  the patches are relatively trivial, mostly going
by analogy with lty and col (although in my ignorance it took me a while
to figure out what UNPROTECT(2) was and why it should be changed to
UNPROTECT(3) ...  hope this is useful.

  Ben Bolker

*** src/main/names.c.orig	Mon Jan 17 11:23:26 2000
--- src/main/names.c	Mon Jan 17 11:50:54 2000
***************
*** 644,650 ****
  {"identify",	do_identify,	0,	11,	6,	PP_FUNCALL},
  {"strheight",	do_strheight,	0,	11,	3,	PP_FUNCALL},
  {"strwidth",	do_strwidth,	0,	11,	3,	PP_FUNCALL},
! {"contour",	do_contour,	0,	11,	6,	PP_FUNCALL},
  {"image",	do_image,	0,	11,	5,	PP_FUNCALL},
  {"dend",	do_dend,	0,	111,	6,	PP_FUNCALL},
  {"dend.window",	do_dendwindow,	0,	111,	6,	PP_FUNCALL},
--- 644,650 ----
  {"identify",	do_identify,	0,	11,	6,	PP_FUNCALL},
  {"strheight",	do_strheight,	0,	11,	3,	PP_FUNCALL},
  {"strwidth",	do_strwidth,	0,	11,	3,	PP_FUNCALL},
! {"contour",	do_contour,	0,	11,	7,	PP_FUNCALL},
  {"image",	do_image,	0,	11,	5,	PP_FUNCALL},
  {"dend",	do_dend,	0,	111,	6,	PP_FUNCALL},
  {"dend.window",	do_dendwindow,	0,	111,	6,	PP_FUNCALL},

*** src/main/plot3d.c.orig	Mon Jan 17 11:08:08 2000
--- src/main/plot3d.c	Mon Jan 17 13:47:03 2000
***************
*** 396,408 ****
  	}
  }
  
! /* contour(x,y,z, levels, col, lty) */
  
  SEXP do_contour(SEXP call, SEXP op, SEXP args, SEXP env)
  {
!     SEXP oargs, c, x, y, z, col, lty;
!     int i, j, nx, ny, nc, ncol, nlty;
      int ltysave, colsave;
      double atom, zmin, zmax;
      char *vmax, *vmax0;
      DevDesc *dd = CurrentDevice();
--- 396,409 ----
  	}
  }
  
! /* contour(x,y,z, levels, col, lty, lwd) */
  
  SEXP do_contour(SEXP call, SEXP op, SEXP args, SEXP env)
  {
!     SEXP oargs, c, x, y, z, col, lty, lwd;
!     int i, j, nx, ny, nc, ncol, nlty, nlwd;
      int ltysave, colsave;
+     double lwdsave;
      double atom, zmin, zmax;
      char *vmax, *vmax0;
      DevDesc *dd = CurrentDevice();
***************
*** 439,445 ****
      PROTECT(lty = FixupLty(GetPar("lty", args), dd->gp.lty));
      nlty = length(lty);
  
!     /* col, lwd and lty vectors here --- FIXME: "lwd" ???? */
  
      if (nx < 2 || ny < 2)
  	errorcall(call, "insufficient x or y values");
--- 440,447 ----
      PROTECT(lty = FixupLty(GetPar("lty", args), dd->gp.lty));
      nlty = length(lty);
  
!     PROTECT(lwd = FixupLwd(GetPar("lwd", args), dd->gp.lwd));  
!     nlwd = length(lwd);
  
      if (nx < 2 || ny < 2)
  	errorcall(call, "insufficient x or y values");
***************
*** 507,512 ****
--- 509,515 ----
  
      ltysave = dd->gp.lty;
      colsave = dd->gp.col;
+     lwdsave = dd->gp.lwd;
      GMode(1, dd);
      for (i = 0; i < nc; i++) {
  	vmax = vmaxget();
***************
*** 516,521 ****
--- 519,527 ----
  	dd->gp.col = INTEGER(col)[i % ncol];
  	if (dd->gp.col == NA_INTEGER)
  	    dd->gp.col = colsave;
+ 	dd->gp.lwd = REAL(lwd)[i % nlwd];
+ 	if (dd->gp.lwd == NA_REAL)
+ 	    dd->gp.lwd = lwdsave;
  	contour(x, nx, y, ny, z, REAL(c)[i], atom, dd);
  	vmaxset(vmax);
      }
***************
*** 523,529 ****
      vmaxset(vmax0);
      dd->gp.lty = ltysave;
      dd->gp.col = colsave;
!     UNPROTECT(2);
      /* NOTE: only record operation if no "error"  */
      /* NOTE: on replay, call == R_NilValue */
      if (call != R_NilValue)
--- 529,536 ----
      vmaxset(vmax0);
      dd->gp.lty = ltysave;
      dd->gp.col = colsave;
!     dd->gp.lwd = lwdsave;
!     UNPROTECT(3);
      /* NOTE: only record operation if no "error"  */
      /* NOTE: on replay, call == R_NilValue */
      if (call != R_NilValue)

*** src/library/base/R/contour.R.orig	Mon Jan 17 11:12:11 2000
--- src/library/base/R/contour.R	Mon Jan 17 11:43:02 2000
***************
*** 6,12 ****
  	      ylim = range(y, finite = TRUE),
  	  zlim = range(z, finite = TRUE),
  	  labcex = 0,
! 	  col = par("fg"), lty = par("lty"), add = FALSE, ...)
  {
      ## labcex is disregarded since we do NOT yet put  ANY labels...
      if (missing(z)) {
--- 6,12 ----
  	      ylim = range(y, finite = TRUE),
  	  zlim = range(z, finite = TRUE),
  	  labcex = 0,
! 	  col = par("fg"), lty = par("lty"), lwd = par("lwd"), add = FALSE, ...)
  {
      ## labcex is disregarded since we do NOT yet put  ANY labels...
      if (missing(z)) {
***************
*** 34,40 ****
      ##- don't lose  dim(.)
      if (!is.double(z)) storage.mode(z) <- "double"
      .Internal(contour(as.double(x), as.double(y), z, as.double(levels),
! 		      col = col, lty = lty))
      if (!add) {
  	axis(1)
  	axis(2)
--- 34,40 ----
      ##- don't lose  dim(.)
      if (!is.double(z)) storage.mode(z) <- "double"
      .Internal(contour(as.double(x), as.double(y), z, as.double(levels),
! 		      col = col, lty = lty, lwd = as.double(lwd)))
      if (!add) {
  	axis(1)
  	axis(2)

*** src/library/base/man/contour.Rd.orig	Mon Jan 17 11:13:18 2000
--- src/library/base/man/contour.Rd	Mon Jan 17 11:19:05 2000
***************
*** 8,14 ****
          ylim = range(y, finite = TRUE),
          zlim = range(z, finite = TRUE),
          labcex = 0,
!         col = par("fg"), lty = par("lty"), add = FALSE, \dots)
  }
  \alias{contour}
  \arguments{
--- 8,14 ----
          ylim = range(y, finite = TRUE),
          zlim = range(z, finite = TRUE),
          labcex = 0,
!         col = par("fg"), lty = par("lty"), lwd = par("lwd"), add = FALSE, \dots)
  }
  \alias{contour}
  \arguments{
***************
*** 29,34 ****
--- 29,35 ----
    \item{xlim, ylim, zlim}{x-, y- and z-limits for the plot}
    \item{col}{color for the lines drawn}
    \item{lty}{line type for the lines drawn}
+   \item{lwd}{line width for the lines drawn}
    \item{add}{logical. If \code{TRUE}, add to a current plot.}
    \item{\dots}{additional graphical parameters (see \code{\link{par}})
      and the arguments to \code{\link{title}} may also be supplied.}
***************
*** 36,42 ****
  \description{
    Draws contour lines for the desired levels.
    There is currently no documentation about the algorithm.
!   The source code is in \file{\$R\_HOME/src/main/plot.c}.
  }
  \seealso{
    \code{\link{filled.contour}} for ``color-filled'' contours,
--- 37,43 ----
  \description{
    Draws contour lines for the desired levels.
    There is currently no documentation about the algorithm.
!   The source code is in \file{\$R\_HOME/src/main/plot3d.c}.
  }
  \seealso{
    \code{\link{filled.contour}} for ``color-filled'' contours,

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._


lwd patches for "contour"
Ben Bolker