R-alpha: plotting enhancements and bug fixes

Gregory R. Warnes (warnes@biostat.washington.edu)
Thu, 26 Sep 1996 10:40:26 -0700 (PDT)


Date: Thu, 26 Sep 1996 10:40:26 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: r-testers <r-testers@stat.math.ethz.ch>,
Subject: R-alpha: plotting enhancements and bug fixes


At the end of this message is a  patch against 0.12 for a couple of new
features and bug fixes for the plotting system.  These include:

new feature: plot caching 
=========================
The low-level R plot functions are now cached so that the currently
displayed plot can be redrawn.  This allows the creation of two new
functions, replot(), and ps.print(). Note that when garbage collection
occurs, the plot cache is invalidated and a warning is printed.  I hope
Ross will replace my brain-dead memory management with the real thing, 
then the cache will not need to be invalidated on garbage collection. 

new function: replot()
======================
replot() merely redraws the current plot on the current graphics device. 
It can be used to refresh the window, such as when the window is resized.

new function: ps.print()
========================
ps.print() uses replot() to redraw the current plot to a postscript file.
Note that this has a *neat* feature, thanks to Ross & Robert's 
implementation of the postscript driver: color x11 plots are output as 
correctly colored postscript plots!  Anyone who has attempted to produce 
color postscript plots in Splus will be delighted with this feature of R.
ps.print() uses the same parameters as the postscript() command.

new sub-feature: the X11 window is redrawn on window resize
===========================================================
Previously, when the X11 window was resized, the plot it contained was 
lost and it was nessary to re-issue each plotting command to redraw it.  
This could be a pain if the plot was complicated.  Now, whenever a new 
plotting command is issued, even locator(), the X11 driver checks to see 
if a window resize has occured.  If it has, it uses replot() to redraw 
the current plot before continuing.

locator() bugfix on fvwm virtual desktop
======================================== 
locator() returned non-sensical answers when the X11 window was placed on
a different part of the fvwm virtual desktop (which represents a virtual
"screen" which is 2x or 3x larger than the physical display).  The problem
was when waiting for mouse clicks, the X11 driver did not check to see if
the event it got was actually a mouse click.  The fix should also reduce
the possiblity for other non-sensical behavior. File changed:
$RHOME/src/unix/devX11.c

identify() bugfixes
===================
1) in 0.12 identify() has been unable to locate points corresponding to
the location of the mouse click.  It consistently gave the warning:
"warning:  no point with 0.25 inches".  This was due to the "inches per
raster"  ipr[] values being set to the inverse (1/x) of the correct value. 
Another fix to use the correct conversion from screen pixels to inches was
also required. 

2) identify()'s man page indicated that the parameters should be:
	identify(x, y, labels=seq(along=x), n=length(x),
	             plot=TRUE, offset=0.5, labpos=FALSE)
but the function itself had 
	function (x, y = NULL, text = as.character(seq(x)), pos = FALSE, ...) 
Simply replacing "text" with "labels" in the function seems to be the 
solution.

3) identify had problems generating "labels" if it was called like this:
	> pt _ list(x=1:10, y=1:10)
	> identify(pt)
although
	> identify(pt,labels=as.character(1:10))
worked fine. A slight modification of the default value of labels 
corrected this.

Files changed: $RHOME/src/unix/devX11.c and $RHOME/src/library/base/identify

Greg

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------

//////////////////// PATCH STARTS HERE /////////////////////////////
--- R.orig/src/graphics/Makefile.in	Mon Aug 26 21:08:14 1996
+++ src/graphics/Makefile.in	Sat Sep 21 11:21:53 1996
@@ -22,7 +22,8 @@
 	gsymbol.o \
 	gtext.o \
 	gunits.o \
-	rainbow.o
+	rainbow.o \
+	cacheplot.o
 
 LIB=	../lib/libgraphics.a
 
--- R.orig/src/graphics/gdevice.c	Sat Aug  3 20:34:00 1996
+++ src/graphics/gdevice.c	Sat Sep 21 11:14:08 1996
@@ -47,13 +47,46 @@
 void (*DevFont)();
 void (*DevLinetype)();
 
+/* GRW 9/18/96 */
+/* Backup location to store device functions  */
+int  Dev2Init;
+int  (*Dev2Open)();
+void (*Dev2Close)();
+void (*Dev2Resize)();
+void (*Dev2NewPlot)();
+void (*Dev2Clip)();
+void (*Dev2StartPath)();
+void (*Dev2EndPath)();
+void (*Dev2MoveTo)();
+void (*Dev2LineTo)();
+double (*Dev2StrWidth)();
+void (*Dev2Text)();
+void (*Dev2RText)();
+void (*Dev2Dot)();
+void (*Dev2Rect)();
+void (*Dev2Circle)();
+void (*Dev2Polygon)();
+int  (*Dev2Locator)();
+void (*Dev2Mode)();
+void (*Dev2Hold)();
+void (*Dev2Color)();
+void (*Dev2Font)();
+void (*Dev2Linetype)();
 
+/* Flag: Keep a copy of the current device and preserve graphic parameters? */
+int KeepDevFlag=0;
+
 extern void DevNull();
 
 GPar GParams, DParams;
 GPar *GP = &GParams;
 GPar *DP = &DParams;
 
+/*Backup Graphics State*/
+GPar GParams2, DParams2;
+GPar *GP2 = &GParams2;
+GPar *DP2 = &DParams2;
+
 #ifdef Unix
 int PSDeviceDriver(char**, int, double*, int);
 int X11DeviceDriver(char**, int, double*, int);
@@ -69,7 +102,7 @@
 
 int SetDevice(char *name, char **cpars, int ncpars, double *npars, int nnpars)
 {
-	if(DevInit) KillDevice();
+	if(DevInit & !KeepDevFlag) KillDevice();
 
 	/* Only some devices need to provide these */
 	/* Notable examples are QuickDraw and PostScript */
@@ -103,7 +136,10 @@
 	return 0;
 	
 have_device:
-	GInit();
+	if (!KeepDevFlag) 
+		GInit(); 
+	else 
+		memcpy(DP, GP, sizeof(GPar));
 	return 1;
 }
 
@@ -112,3 +148,81 @@
 	if(DevInit) DevClose();
 	DevInit = 0;
 }
+
+void CacheDevice(void) /* GRW 9/19/96 */
+{
+  /* Copy initialization status */
+  Dev2Init=DevInit;
+
+  /* Make a copy of all the function pointers */
+  Dev2Open=DevOpen;
+  Dev2Close=DevClose;
+  Dev2Resize=DevResize;
+  Dev2NewPlot=DevNewPlot;
+  Dev2Clip=DevClip;
+  Dev2StartPath=DevStartPath;
+  Dev2EndPath=DevEndPath;
+  Dev2MoveTo=DevMoveTo;
+  Dev2LineTo=DevLineTo;
+  Dev2StrWidth=DevStrWidth;
+  Dev2Text=DevText;
+  Dev2RText=DevRText;
+  Dev2Dot=DevDot;
+  Dev2Rect=DevRect;
+  Dev2Circle=DevCircle;
+  Dev2Polygon=DevPolygon;
+  Dev2Locator=DevLocator;
+  Dev2Mode=DevMode;
+  Dev2Hold=DevHold;
+  Dev2Color=DevColor;
+  Dev2Font=DevFont;
+  Dev2Linetype=DevLinetype;
+
+  /* make a copy of the graphics state */
+  memcpy(GP2, GP, sizeof(GPar));  
+  memcpy(DP2, DP, sizeof(GPar));
+
+  /* Set the flag! */
+  KeepDevFlag = 1;
+}
+
+void UnCacheDevice(void)  /* GRW 9/19/96 */
+{
+  /* Copy initialization status */
+  DevInit=Dev2Init;
+
+  /* copy of all the function pointers */
+  DevOpen=Dev2Open;
+  DevClose=Dev2Close;
+  DevResize=Dev2Resize;
+  DevNewPlot=Dev2NewPlot;
+  DevClip=Dev2Clip;
+  DevStartPath=Dev2StartPath;
+  DevEndPath=Dev2EndPath;
+  DevMoveTo=Dev2MoveTo;
+  DevLineTo=Dev2LineTo;
+  DevStrWidth=Dev2StrWidth;
+  DevText=Dev2Text;
+  DevRText=Dev2RText;
+  DevDot=Dev2Dot;
+  DevRect=Dev2Rect;
+  DevCircle=Dev2Circle;
+  DevPolygon=Dev2Polygon;
+  DevLocator=Dev2Locator;
+  DevMode=Dev2Mode;
+  DevHold=Dev2Hold;
+  DevColor=Dev2Color;
+  DevFont=Dev2Font;
+  DevLinetype=Dev2Linetype;
+
+  /* copy the graphics state */
+  memcpy(GP, GP2, sizeof(GPar));  
+  memcpy(DP, DP2, sizeof(GPar));
+
+  /* Set the flag! */
+  KeepDevFlag = 0;
+}
+
+
+
+
--- R.orig/src/graphics/gnewplot.c	Sat Aug  3 20:34:06 1996
+++ src/graphics/gnewplot.c	Mon Sep 23 06:33:40 1996
@@ -55,6 +55,7 @@
 			if(GP->new) {
 				if(GP->ask) NewFrameConfirm();
 				DevNewPlot();
+				reset_cache(0); /* GRW 9/13/96 */
 			}
 			else GP->new =  DP->new = 1;
 		}
@@ -66,6 +67,7 @@
 		if(GP->new) {
 			if(GP->ask) NewFrameConfirm();
 			DevNewPlot();
+			reset_cache(0); /* GRW 9/13/96 */
 		}
 		else GP->new = DP->new = 1;
 		GReset();
--- R.orig/src/graphics/cacheplot.c	Sat Sep 21 11:21:21 1996
+++ src/graphics/cacheplot.c	Thu Sep 26 10:06:34 1996
@@ -0,0 +1,181 @@
+
+#include "Defn.h"
+#include "Graphics.h"
+
+
+/*********** definitions *************/
+
+/* linked list cache entry for each low-level plot command executed */
+typedef struct {
+  void        (*function)();  /* low level function called   */
+  SEXP        call;           /* the actual R call           */
+  SEXP        op;             /* op flag to .Internal        */
+  SEXP        args;           /* arguments to .Internal      */
+  SEXP        env;            /* the appropriate envir       */
+  int         valid;          /* is this a valid entry?      */
+  void *next;          /* pointer to next cache_entry */
+  void *last;          /* pointer to last cache_entry */
+} cache_entry;
+
+cache_entry *cache_plot_head=NULL;    /* Head of cache linked-list */
+
+int replotting=0;
+
+GPar GPBak, DPBak;
+int  BakFilled=0;
+
+/*********** definitions *************/
+
+
+void cache_plot(void        (*function)(),
+		SEXP        call,
+		SEXP        op,
+		SEXP        args,
+		SEXP        env)
+{
+  cache_entry  *current,*last;
+  int   counter=0;
+
+  /* only do caching if we are drawing the plot for the first time */
+  if(replotting)
+    return;
+
+  current=cache_plot_head;  /* start at top of list */
+  last=NULL;
+
+  /* find the first empty node (valid==F) or the end of the list */
+  while ( (current != NULL) && (current->valid == 1))
+    { 
+      last = current;
+      current = current->next;
+      counter++;
+    }
+
+  /*printf("caching call %d...",counter);*/
+
+  /* Did we reach the end of the list? */
+  if (current == NULL)
+    {
+      current = (cache_entry*) calloc(1,sizeof(cache_entry)); 
+      if (current == NULL) /* oops, unable to allocate memory */
+	{
+	  REprintf("warning: unable to allocate memory for plot cache. \n");
+	  REprintf("         psprint will not function correctly.\n");
+	  return;
+	}
+      else
+	{
+	  /* set up linked list pointers */
+	  current->last = last;
+	  current->next = NULL;
+	  if (last != NULL) last->next = current;
+
+	  /* make sure we keep track of top of list! */
+	  if (cache_plot_head==NULL) cache_plot_head = current;
+	}
+    }
+
+    /* fill up node with the details of the call */
+    
+    current->function = function;
+    current->call = duplicate(call);
+    current->op = duplicate(op);
+    current->args = duplicate(args);
+    current->env = duplicate(env);
+
+    current->valid = 1;
+
+    /*printf("done\n");*/
+
+}
+    
+void reset_cache(int notify)
+{
+  int counter=0;
+  cache_entry *current;
+
+  /* only do reset-caching if we are drawing the plot for the first time */
+  if(replotting)
+    return;
+  
+  current = cache_plot_head;
+
+  if (notify && !(current==NULL || current->valid == 0))
+  {
+     REprintf("Warning: Emptying plot cache.  Currently visible plot must be\n");
+     REprintf("         redrawn before it can be printed.\n\n");
+  }
+
+  /* mark everything as invalid */
+  while(current != NULL)
+    {
+      current->valid = 0;
+      current = current->next;
+      /*printf("%d ",counter++);*/
+    }
+
+  /* store GP an DP starting state for restoration IF we have initialized */
+  /* a device                                                             */
+  if (DevInit)
+    {
+      memcpy(&GPBak, GP, sizeof(GPar));
+      memcpy(&DPBak, DP, sizeof(GPar));
+      BakFilled=1;
+    }
+}
+     
+void replot(int clear)
+{
+  cache_entry *current;
+  int counter=0;
+
+  /* avoid replotting within a replot!  */
+  if(replotting)
+    return;
+
+  /* don't do anything if there is no cache */
+  if(cache_plot_head==NULL || cache_plot_head->valid==0)
+    return;
+
+  /* Change flag so we know not to recache all this stuff */
+  /* (avoids an infinite loop)                            */
+  replotting=1;
+
+  /* clear device if we're replotting on the same device */
+  if (clear)
+    DevNewPlot();
+
+  /* Now restore staring graphics state */
+  if(BakFilled)
+    {
+      memcpy(GP, &GPBak, sizeof(GPar));
+      memcpy(DP, &DPBak, sizeof(GPar));
+    }
+
+  /* so do_plot_new (GNewPlot) will start in first row/col` */
+  GP->mfg[0] = DP->mfg[0] = DP->mfg[2] = GP->mfg[2];
+  GP->mfg[1] = DP->mfg[1] = DP->mfg[3] = GP->mfg[3];
+  GP->new = DP->new = 0;
+
+  /* restore plotting scale */
+  GReset();
+
+  current=cache_plot_head;  /* start at top of list */
+
+  /* re-issue each plot command */
+  while ( (current != NULL) && (current->valid == 1))
+    { 
+      /*printf("redoing step %d...", counter++);*/
+      current->function( current->call, current->op, current->args, 
+			 current->env );
+      /*printf("done\n");*/
+
+      current = current->next;
+    }
+
+  replotting=0;  /* reset flag */
+  
+}
+	  
+	  
+
--- R.orig/src/main/par.c	Mon Jul  1 16:08:09 1996
+++ src/main/par.c	Thu Sep 26 08:18:47 1996
@@ -1043,6 +1043,8 @@
 {
 	SEXP ap, vp, value;
 
+	cache_plot(&do_par,call,op,args,env);  /* GRW 9/20/96 */
+
 	if (!DevInit)
 		errorcall(call, "No device is active\n");
 
@@ -1066,5 +1068,6 @@
 		}
 	}
 	UNPROTECT(1);
+
 	return value;
 }
--- R.orig/src/main/plot.c	Wed Sep 18 21:05:26 1996
+++ src/main/plot.c	Thu Sep 26 09:41:53 1996
@@ -96,6 +96,7 @@
 {
 	checkArity(op, args);
 	KillDevice();
+	reset_cache(0);
 }
 
 
@@ -258,6 +259,7 @@
 SEXP do_plot_new(SEXP call, SEXP op, SEXP args, SEXP env)
 {
 	int ask, asksave;
+
 	checkArity(op, args);
 	ask = asLogical(CAR(args));	
 	if(ask == NA_LOGICAL) ask = DP->ask;
@@ -269,6 +271,9 @@
 	xt = Ident;
 	yt = Ident;
 	GP->ask = asksave;
+
+	cache_plot( &do_plot_new, call, op, args, env );
+
 	return R_NilValue;
 }
 
@@ -282,6 +287,7 @@
 	char *p;
 
 	checkArity(op, args);
+	cache_plot( &do_plot_window, call, op, args, env );
 
 	xlim = CAR(args);
 	if(!isNumeric(xlim) || LENGTH(xlim) != 2)
@@ -356,6 +362,7 @@
 
 	if(length(args) < 3)
 		errorcall(call, "too few arguments");
+	cache_plot( &do_axis, call, op, args, env );
 
 		/* Named Arguments */
 
@@ -498,6 +505,7 @@
 
 	if(length(args) < 2)
 		errorcall(call, "too few arguments\n");
+	cache_plot( &do_plot_xy, call, op, args, env );
 
 		/* Named Arguments */
 
@@ -724,6 +732,7 @@
 	int i, n, ncol, colsave, nlty, ltysave;
 
 	if(length(args) < 4) errorcall(call, "too few arguments\n");
+	cache_plot( &do_segments, call, op, args, env );
 
 	xypoints(call, args, &n);
 
@@ -775,6 +784,8 @@
 	int colsave, ltysave;
 
 	if(length(args) < 4) errorcall(call, "too few arguments\n");
+	cache_plot( &do_rect, call, op, args, env );
+
 	xypoints(call, args, &n);
 
 	sxl = CAR(args); nxl = length(sxl); args = CDR(args);
@@ -825,6 +836,7 @@
 	int ncol, colsave, nlty, ltysave, xpd;
 
 	if(length(args) < 4) errorcall(call, "too few arguments\n");
+	cache_plot( &do_arrows, call, op, args, env );
 	xypoints(call, args, &n);
 
 	sx0 = CAR(args); nx0 = length(sx0); args = CDR(args);
@@ -892,6 +904,7 @@
 	char *vmax;
 
 	if(length(args) < 2) errorcall(call, "too few arguments\n");
+	cache_plot( &do_polygon, call, op, args, env );
 
 	if (!isNumeric(CAR(args)) || (nx = LENGTH(CAR(args))) <= 0)
 		errorcall(call, "first argument invalid\n");
@@ -946,6 +959,7 @@
 	double xx, yy;
 
 	if(length(args) < 2) errorcall(call, "too few arguments\n");
+	cache_plot( &do_text, call, op, args, env );
 
 	sxy = CAR(args);
 	if (!isList(sxy) || length(sxy) < 2)
@@ -1037,6 +1051,7 @@
 	int colsave, fontsave, side, outer; short int i;
 
 	if(length(args) < 5) errorcall(call, "too few arguments");
+	cache_plot( &do_mtext, call, op, args, env );
 
 	internalTypeCheck(call, text = CAR(args), STRSXP);
 	if (LENGTH(text) <= 0)
@@ -1121,6 +1136,7 @@
 	double cexsave, x, y;
 
 	if(length(args) < 4) errorcall(call, "too few arguments");
+	cache_plot( &do_title, call, op, args, env );
 
 	main = sub = xlab = ylab = R_NilValue;
 
@@ -1201,6 +1217,7 @@
 	double aa, bb;
 
 	if(length(args) < 4) errorcall(call, "too few arguments\n");
+	cache_plot( &do_abline, call, op, args, env );
 
 	if((a = CAR(args)) != R_NilValue)
 		CAR(args) = a = coerceVector(a, REALSXP);
@@ -1300,6 +1317,7 @@
 	int bty, btysave, col, colsave, lty, ltysave, xpdsave;
 
 	checkArity(op, args);
+	cache_plot( &do_box, call, op, args, env );
 
 	if(isNull(CAR(args))) bty = GP->bty;
 	else {
@@ -1385,6 +1403,77 @@
 	return ans;
 }
 
+/* this function is used to replot the labels produced by do_identify() below */
+/* it should ONLY by called by replot() in that context                       */
+
+SEXP do_reidentify(SEXP call, SEXP op, SEXP args, SEXP env)
+{
+	SEXP ans, x, y, l, ind, pos;
+	double xi, yi, xp, yp, d, dmin, offset;
+	int i, imin, k, n;
+
+	/* NOTE: Don't use checkArity because R thinks this is a call to */
+	/*       do_identify, which has arity *3* .  We want arity *5*   */
+	/*       and should always get it since we only call this        */
+	/*       internally                                              */
+	/* checkArity(op, args);                                         */
+	
+	x = CAR(args);
+	y = CADR(args);
+	l = CADDR(args);
+	ind = CADDDR(args);  /**/
+	pos = CADDDDR(args); /**/
+	if(!isReal(x) || !isReal(y) || !isString(l) || !isLogical(ind) 
+	      || !isInteger(pos) )
+	  errorcall(call, "incorrect argument type\n");
+	if(LENGTH(x) != LENGTH(y) || LENGTH(x) != LENGTH(l))
+	  errorcall(call, "different argument lengths\n");
+
+	n = LENGTH(ind);
+	if(n <= 0) {
+		R_Visible = 0;
+		return NULL;
+	}
+
+	GMode(0);
+	for(k=0; k < n; k++) 
+	  {
+	    if(LOGICAL(ind)[k])
+	      {
+		imin = k;
+		
+		xi = XMAP(xt(REAL(x)[imin]));
+		yi = YMAP(yt(REAL(y)[imin]));
+		
+		switch(INTEGER(pos)[imin]) 
+		  {
+		  case 4: 
+		    xi = xi+xInchtoFig(offset);
+		    GText(xi, yi, CHAR(STRING(l)[imin]), 0.0, GP->yCharOffset, 0.0);
+		    break;
+		  case 2:
+		    xi = xi-xInchtoFig(offset);
+		    GText(xi, yi, CHAR(STRING(l)[imin]), 1.0, GP->yCharOffset, 0.0);
+		    break;
+		  case 3:
+		    yi = yi+yInchtoFig(offset);
+		    GText(xi, yi, CHAR(STRING(l)[imin]), 0.5, 0.0, 0.0);
+		    break;
+		  case 1:
+		    yi = yi-yInchtoFig(offset);
+		    GText(xi, yi, CHAR(STRING(l)[imin]), 0.5, 1-(0.5-GP->yCharOffset), 0.0);
+		    break;
+		  }
+	      }
+	  }
+	ans = allocList(2);
+	CAR(ans) = ind;
+	CADR(ans) = pos;
+	return ans;
+}
+
+
+
 #define THRESHOLD	0.25
 
 #ifdef Macintosh
@@ -1396,7 +1485,7 @@
 
 SEXP do_identify(SEXP call, SEXP op, SEXP args, SEXP env)
 {
-	SEXP ans, x, y, l, ind, pos;
+	SEXP cache,ans, x, y, l, ind, pos;
 	double xi, yi, xp, yp, d, dmin, offset;
 	int i, imin, k, n;
 
@@ -1423,21 +1512,21 @@
 	k = 0;
 	GMode(2);
 	while(k < n) {
-		if(!GLocator(&xp, &yp, 0)) break;
+		if(!GLocator(&xp, &yp, 1)) break;
 		dmin = DBL_MAX;
 		imin = -1;
 		for(i=0 ; i<n ; i++) {
 			xi = xt(REAL(x)[i]);
 			yi = yt(REAL(y)[i]);
 			if(xi == NA_REAL || yi == NA_REAL) continue;
-			d = hypot(xFigtoInch(xp-XMAP(xi)), yFigtoInch(yp-YMAP(yi)));
+			d = hypot(xUsrtoInch(xp-xi), yUsrtoInch(yp-yi));
 			if(d < dmin) {
 				imin = i;
 				dmin = d;
 			}
 		}
 		if(dmin > THRESHOLD)
-			REprintf("warning: no point with %.2f inches\n", THRESHOLD);
+			REprintf("warning: no point within %.2f inches of (%.2lf,%.2lf)\n", THRESHOLD, xp, yp);
 		else if(LOGICAL(ind)[imin])
 			REprintf("warning: nearest point already identified\n");
 		else {
@@ -1471,6 +1560,17 @@
 		}
 	}
 	GMode(0);
+
+	/* cache necessary info to replot selected points */
+	cache = allocList(5);
+	CAR(cache) = x;
+	CADR(cache) = y;
+	CADDR(cache) = l;
+	CADDDR(cache) = ind;
+	CADDDDR(cache) = pos;
+	cache_plot( &do_reidentify, call, op, cache, env );
+	/*****/
+	
 	ans = allocList(2);
 	CAR(ans) = ind;
 	CADR(ans) = pos;
@@ -1487,6 +1587,7 @@
 	double cex, cexsave;
 
 	checkArity(op, args);
+	cache_plot( &do_strwidth, call, op, args, env );
 	str = CAR(args);
 	if(TYPEOF(str) != STRSXP)
 		errorcall(call, "character first argument expected\n");
@@ -1510,3 +1611,71 @@
 	GP->cex = cexsave;
 	return ans;
 }
+
+/* GRW 9/17/96 */
+SEXP do_replot(SEXP call, SEXP op, SEXP args, SEXP env)
+{
+  replot(1);
+}
+
+
+/* GRW 9/18/96 */
+/* Cache current device, start new device, call replot to redraw the  */
+/* current plot, and then restore (uncache) the original device       */
+
+SEXP do_devprint(SEXP call, SEXP op, SEXP args, SEXP env)
+{
+	SEXP s;
+	char *device;
+	int i, ncpars, nnpars;
+	char *cpars[20];
+	double *npars;
+
+		/* NO GARBAGE COLLECTS ALLOWED HERE*/
+		/* WE ARE USING REAL POINTERS */
+		/* SWITCH TO R_ALLOCING IF NECESSARY */
+
+	checkArity(op, args);
+
+	s = CAR(args);
+	if (!isString(s) || length(s) <= 0)
+		errorcall(call, "device name must be a character string\n");
+	device = CHAR(STRING(s)[0]);
+
+	s = CADR(args);
+	if (!isString(s) || length(s) > 20)
+		errorcall(call, "invalid device driver parameters\n");
+	ncpars = LENGTH(s);
+	for(i=0 ; i<LENGTH(s) ; i++)
+		cpars[i] = CHAR(STRING(s)[i]);
+
+	s = CADDR(args);
+	if (!isReal(CADDR(args)))
+		errorcall(call, "width and height must be numeric\n");
+	nnpars = LENGTH(s);
+
+	if( !strcmp(device,"X11") )
+		for(i=0 ; i<nnpars ; i++ ) 
+			if( REAL(s)[i] <= 0 || REAL(s)[i] == NA_REAL )
+				errorcall(call, "invalid device driver parameter\n");
+	npars = REAL(s);
+
+	CacheDevice();  /* Store old graphics info */
+
+	/* Open new device */
+	if (!SetDevice(device, cpars, ncpars, npars, nnpars))
+		errorcall(call, "unable to start device %s\n", device);
+
+	replot(0);  /* redraw plot(s), without clearing  */
+
+	KillDevice();  /* close the device */
+
+	UnCacheDevice();  /* Restore old graphics info */
+
+	/*xt = Ident;*/
+	/*yt = Ident;*/
+	return CAR(args);
+}
+
+
+
--- R.orig/src/main/names.c	Wed Sep 18 21:05:23 1996
+++ src/main/names.c	Thu Sep 26 10:12:29 1996
@@ -456,6 +456,10 @@
 {"linetype",	do_linetype,	0,	1,	1,	PP_FUNCALL,	0},
 {"plot.new",	do_plot_new,	0,	111,	1,	PP_FUNCALL,	0},
 {"plot.window",	do_plot_window,	0,	101,	3,	PP_FUNCALL,	0},
+/* GRW 9/17/96 */
+{"replot",	do_replot,	0,	101,	0,	PP_FUNCALL,	0},
+{"devprint",	do_devprint,	0,	111,	3,	PP_FUNCALL,	0},
+/***/
 {"axis",	do_axis,	0,	111,	7,	PP_FUNCALL,	0},
 {"plot.xy",	do_plot_xy,	0,	111,	6,	PP_FUNCALL,	0},
 {"text",	do_text,	0,	111,	6,	PP_FUNCALL,	0},
@@ -465,11 +469,16 @@
 {"box",		do_box,		0,	111,	3,	PP_FUNCALL,	0},
 {"rect",	do_rect,	0,	111,	6,	PP_FUNCALL,	0},
 {"polygon",	do_polygon,	0,	111,	5,	PP_FUNCALL,	0},
+/* GRW 9/20/96 */
 {"par",		do_par,		0,	11,	1,	PP_FUNCALL,	0},
+/***/
 {"segments",	do_segments,	0,	111,	6,	PP_FUNCALL,	0},
 {"arrows",	do_arrows,	0,	111,	9,	PP_FUNCALL,	0},
 {"locator",	do_locator,	0,	11,	1,	PP_FUNCALL,	0},
-{"identify",	do_identify,	0,	11,	3,	PP_FUNCALL,	0},
+{"identify",	do_identify,	0,	111,	3,	PP_FUNCALL,	0},
+/* GRW 9/26/96 */
+{"reidentify",	do_reidentify,	0,	111,	5,	PP_FUNCALL,	0},
+/***/
 {"strwidth",	do_strwidth,	0,	11,	3,	PP_FUNCALL,	0},
 {"contour",	do_contour,	0,	11,	6,	PP_FUNCALL,	0},
 
--- R.orig/src/main/names.h	Wed Sep 18 21:05:25 1996
+++ src/main/names.h	Thu Sep 26 08:43:40 1996
@@ -85,6 +85,9 @@
 SEXP do_deprecated(SEXP, SEXP, SEXP, SEXP);
 SEXP do_detach(SEXP,SEXP,SEXP,SEXP);
 SEXP do_device(SEXP, SEXP, SEXP, SEXP);
+/* GRW 9/18/96 */
+SEXP do_devprint(SEXP, SEXP, SEXP, SEXP);
+/***/
 SEXP do_devoff(SEXP, SEXP, SEXP, SEXP);
 SEXP do_dim(SEXP, SEXP, SEXP, SEXP);
 SEXP do_dimgets(SEXP, SEXP, SEXP, SEXP);
@@ -113,6 +116,9 @@
 SEXP do_gray(SEXP, SEXP, SEXP, SEXP);
 SEXP do_hsv(SEXP, SEXP, SEXP, SEXP);
 SEXP do_identify(SEXP, SEXP, SEXP, SEXP);
+/* GRW 9/26/96 */
+SEXP do_reidentify(SEXP, SEXP, SEXP, SEXP);
+/***/
 SEXP do_if(SEXP, SEXP, SEXP, SEXP);
 SEXP do_interactive(SEXP, SEXP, SEXP, SEXP);
 SEXP do_internal(SEXP, SEXP, SEXP, SEXP);
@@ -165,6 +171,8 @@
 SEXP do_plot_xy(SEXP, SEXP, SEXP, SEXP);
 SEXP do_plot_new(SEXP, SEXP, SEXP, SEXP);
 SEXP do_plot_window(SEXP, SEXP, SEXP, SEXP);
+SEXP do_replot(SEXP, SEXP, SEXP, SEXP);  /* GRW 9/17/96 */
+SEXP do_devprint(SEXP, SEXP, SEXP, SEXP);  /* GRW 9/17/96 */
 SEXP do_title(SEXP, SEXP, SEXP, SEXP);
 SEXP do_trace(SEXP, SEXP, SEXP, SEXP);
 SEXP do_pmatch(SEXP, SEXP, SEXP, SEXP);
@@ -174,6 +182,9 @@
 SEXP do_printmatrix(SEXP, SEXP, SEXP, SEXP);
 SEXP do_psort(SEXP, SEXP, SEXP, SEXP);
 SEXP do_quit(SEXP, SEXP, SEXP, SEXP);
+/** GRW 9/11/96 **/
+SEXP do_library(SEXP, SEXP, SEXP, SEXP);
+/***/
 SEXP do_random1(SEXP, SEXP, SEXP, SEXP);
 SEXP do_random2(SEXP, SEXP, SEXP, SEXP);
 SEXP do_random3(SEXP, SEXP, SEXP, SEXP);
--- R.orig/src/main/memory.c	Sun Aug  4 21:39:45 1996
+++ src/main/memory.c	Mon Sep 23 06:34:42 1996
@@ -18,6 +18,7 @@
  */
 
 #include "Defn.h"
+#include "Graphics.h"
 
 /*      MEMORY MANAGEMENT
  *
@@ -289,6 +290,7 @@
 	int vcells, vfrac;
 	if (gc_reporting)
 		REprintf("Garbage collection ...");
+	reset_cache(1);  /* GRW 9/23/96 */
 	unmarkPhase();
 	markPhase();
 	compactPhase();
--- R.orig/src/unix/devX11.c	Thu Sep 19 18:45:28 1996
+++ src/unix/devX11.c	Thu Sep 26 09:36:05 1996
@@ -379,6 +379,9 @@
 static double X11_StrWidth(char *str)
 {
 	int size = GP->cex * GP->ps + 0.5;
+
+	ProcessEvents();
+
 	SetFont(GP->font, size);
 	return (double)XTextWidth(font, str, strlen(str));
 }
@@ -387,6 +390,8 @@
 
 static void X11_Clip(int x0, int x1, int y0, int y1)
 {
+	ProcessEvents();
+
 	if (x0 < x1) {
 		clip.x = x0;
 		clip.width = x1 - x0;
@@ -404,6 +409,7 @@
 		clip.height = y0 - y1;
 	}
 	XSetClipRectangles(display, wgc, 0, 0, &clip, 1, Unsorted);
+
 }
 
 static void X11_Resize()
@@ -415,6 +421,7 @@
 		DP->bottom = windowHeight;
 		DP->top = 0.0;
 		resize = 0;
+		replot(0);
 	}
 }
 
@@ -422,6 +429,8 @@
 {
 	int result;
 
+	ProcessEvents();
+
 	if(bg != DP->bg) {
 		bg = DP->bg;
 		bgcolor.red =   ((bg>> 8)&255)<<8;
@@ -457,12 +466,15 @@
 
 static void X11_StartPath()
 {
+        ProcessEvents();
+
 	SetColor(GP->col);
 	SetLinetype(GP->lty);
 }
 
 static void X11_EndPath()
 {
+	ProcessEvents();
 }
 
 static int xlast;
@@ -470,12 +482,16 @@
 
 static void X11_MoveTo(int x, int y)
 {
+	ProcessEvents();
+	
 	xlast = x;
 	ylast = y;
 }
 
 static void X11_LineTo(int x, int y)
 {
+	ProcessEvents();
+
 	XDrawLine(display, window, wgc, xlast, ylast, x, y);
 	xlast = x;
 	ylast = y;
@@ -485,6 +501,8 @@
 static void X11_Rect(int x0, int y0, int x1, int y1, int fill)
 {
 	int tmp;
+	ProcessEvents();
+
 	if (x0 > x1) {
 		tmp = x0;
 		x0 = x1;
@@ -503,6 +521,8 @@
 
 static void X11_Circle(int x, int y, int r, int col, int border)
 {
+	ProcessEvents();
+
 	if(col != NA_INTEGER) {
 		SetColor(col);
 		XFillArc(display, window, wgc, x-r, y-r, 2*r, 2*r, 0, 23040);
@@ -520,6 +540,8 @@
 	char *vmax, *vmaxget();
 	int i;
 	
+	ProcessEvents();
+
 	if((points=(XPoint*)R_alloc(n, sizeof(XPoint))) == NULL)
 		error("out of memory while drawing polygon\n");
 	for(i=0 ; i<n ; i++) {
@@ -540,6 +562,8 @@
 	int len, size;
 	double xx, yy, xl, yl;
 
+	ProcessEvents();
+
 	size = GP->cex * GP->ps + 0.5;
 	SetFont(GP->font, size);
 	SetColor(GP->col);
@@ -560,8 +584,9 @@
 static int X11_Locator(int *x, int *y)
 {
 	ProcessEvents();	/* discard pending events */
+
 	XSync(display, 1);
-	XNextEvent(display, &event);
+	XMaskEvent(display, ButtonPressMask, &event);
 	if (event.xbutton.button == Button1 /* || event.xbutton.button==Button2 */ ) {
 		*x = event.xbutton.x;
 		*y = event.xbutton.y;
@@ -591,11 +616,20 @@
 			resize = 1;
 		}
 	}
+	if (resize) {
+		DP->left = 0.0;
+		DP->right = windowWidth;
+		DP->bottom = windowHeight;
+		DP->top = 0.0;
+		resize = 0;
+		replot(0);
+	}
 }
 
 /* Set Graphics mode - not needed for X11 */
 static void X11_Mode(int mode)
 {
+        ProcessEvents();
 	if(mode == 0) XSync(display, 0);
 }
 
@@ -603,6 +637,7 @@
 /* Hold the Picture Onscreen - not needed for X11 */
 static void X11_Hold()
 {
+        ProcessEvents();
 }
 
 
@@ -677,8 +712,8 @@
 		/* Inches per Raster Unit */
 		/* Using nominal 100dpi */
 
-	GP->ipr[0] = 1.0 / pixelWidth();
-	GP->ipr[1] = 1.0 / pixelHeight();
+	GP->ipr[0] = pixelWidth();  /* GRW 9/26/96 */
+	GP->ipr[1] = pixelHeight(); /* GRW 9/26/96 */
 
 	GP->canResizePlot = 1;
 	GP->canChangeFont = 0;
--- R.orig/src/include/Graphics.h	Sat Aug  3 20:35:59 1996
+++ src/include/Graphics.h	Mon Sep 23 06:33:57 1996
@@ -282,4 +282,13 @@
 double yNDCtoInch(double);
 double yUsrtoInch(double);
 
+
+/***** GRW 9/17/96 ******/
+
+void cache_plot();
+void reset_cache(int);
+void replot(int);
+
 #endif
+
+
--- R.orig/src/include/Defn.h	Sun Sep  1 19:49:52 1996
+++ src/include/Defn.h	Thu Sep 26 08:01:11 1996
@@ -194,6 +194,7 @@
 #define CDDR(e)		CDR(CDR(e))
 #define CADDR(e)	CAR(CDR(CDR(e)))
 #define CADDDR(e)	CAR(CDR(CDR(CDR(e))))
+#define CADDDDR(e)	CAR(CDR(CDR(CDR(CDR(e)))))
 #define CONS(a, b)	cons((a), (b))		/* data lists */
 #define LCONS(a, b)	lcons((a), (b))		/* language lists */
 #define MISSING(x)	((x)->sxpinfo.gp)	/* for closure calls */
--- R.orig/src/library/base/postscript	Mon Jul  1 16:07:54 1996
+++ src/library/base/postscript	Sat Sep 21 11:14:14 1996
@@ -1,8 +1,18 @@
 postscript := function(file="Rplots.ps",
-	paper="A4", landscape=TRUE, width=0, height=0,
+	paper="letter", landscape=TRUE, width=0, height=0,
 	bg="white", fg="black")
 {
 	.Internal(device(
+		"PostScript",
+		as.character(c(file, paper)),
+		c(width, height, landscape, color.rgb(bg), color.rgb(fg))))
+}
+
+ps.print := function(file="Rplots.ps",
+	paper="letter", landscape=TRUE, width=0, height=0,
+	bg="white", fg="black")
+{
+	.Internal(devprint(
 		"PostScript",
 		as.character(c(file, paper)),
 		c(width, height, landscape, color.rgb(bg), color.rgb(fg))))
--- R.orig/src/library/base/identify	Mon Jul  1 16:07:51 1996
+++ src/library/base/identify	Thu Sep 26 09:20:37 1996
@@ -1,8 +1,8 @@
-identify := function(x, y=NULL, text=as.character(seq(x)), pos=FALSE, ...) {
+identify := function(x, y=NULL, labels=as.character(seq(xy$x)), pos=FALSE, ...) {
 	opar <- par(list(...))
 	on.exit(par(opar))
 	xy <- xy.coords(x, y)
-	z <- .Internal(identify(xy$x,xy$y,as.character(text)))
+	z <- .Internal(identify(xy$x,xy$y,as.character(labels)))
 	i <- seq(z[[1]])[z[[1]]]
 	p <- z[[2]][z[[1]]]
 	if(pos) list(ind=i,pos=p) else i
--- R.orig/src/manual/man/postscript	Mon Jul  1 16:08:36 1996
+++ src/manual/man/postscript	Thu Sep 26 10:28:46 1996
@@ -1,12 +1,15 @@
 TITLE(postscript @@ PostScript Graphics)
 USAGE(
-postscript(file="PS", landscape=TRUE, width, height)
+postscript(file="Rplots.ps", paper = "letter", landscape=TRUE, 
+           width, height, bg="white", fg="black")
 )
 ARGUMENTS(
 ARG(file @@ the name of a file to print to, it must be a quoted string.)
+ARG(paper @@ the paper size, one of : "A4", "letter", "legal", "executive")
 ARG(landscape @@ the orientation of the printed image, a logical.)
 ARG(width,height @@ the width, and height of the graphics region in inches.
 The default is to use the entire page.)
+ARG(fg,bg @@ the foreground, background color) 
 )
 DESCRIPTION(
 The file LANG(file) is opened and the PostScript commands needed to 
@@ -15,7 +18,7 @@
 copy.
 )
 SEEALSO(
-LANG(LINK(x11)), LANG(LINK(macintosh)), LANG(LINK(device)).
+LANG(LINK(ps.print)),LANG(LINK(x11)), LANG(LINK(macintosh)), LANG(LINK(device)).
 )
 EXAMPLES(
 # open the file "foo" for graphics output
--- R.orig/src/manual/man/ps.print	Thu Sep 26 10:38:43 1996
+++ src/manual/man/ps.print	Thu Sep 26 10:31:01 1996
@@ -0,0 +1,33 @@
+TITLE(ps.print @@ Print Current Plot to PostScript)
+USAGE(
+ps.print(file="Rplots.ps", paper = "letter", landscape=TRUE, 
+         width, height, bg="white", fg="black")
+)
+ARGUMENTS(
+ARG(file @@ the name of a file to print to, it must be a quoted string.)
+ARG(paper @@ the paper size, one of : "A4", "letter", "legal", "executive")
+ARG(landscape @@ the orientation of the printed image, a logical.)
+ARG(width,height @@ the width, and height of the graphics region in inches.
+The default is to use the entire page.)
+ARG(fg,bg @@ the foreground, background color) 
+)
+DESCRIPTION(
+The file LANG(file) is opened and the PostScript commands needed to 
+plot the currently displayed plot are stored in that file.
+This file can then be printed on a suitable device to obtain hard
+copy.  Note that if the currently displayed plot is in color, the PostScript 
+output will use the same colors.
+)
+SEEALSO(
+LANG(LINK(postscript)), LANG(LINK(x11)), LANG(LINK(macintosh)), LANG(LINK(device)).
+)
+EXAMPLES(
+# open the X11 graphics driver
+x11()
+BLANK
+# produce the desired graph(s)
+plot(x,y)
+BLANK
+# ouptut the current plot to the file "foo" 
+ps.print("foo")
+)

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-