/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2001-3 Paul Murrell
 *                2003 The R Development Core Team
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  A copy of the GNU General Public License is available via WWW at
 *  http://www.gnu.org/copyleft/gpl.html.  You can also obtain it by
 *  writing to the Free Software Foundation, Inc., 59 Temple Place,
 *  Suite 330, Boston, MA  02111-1307  USA.
 */


#define GRID_MAIN
#include "grid.h"

/* NOTE:
 * The extensive use of L or L_ prefixes dates back to when this 
 * package used to be called "lattice"
 */

extern int gridRegisterIndex;

/* FIXME:  Need to query device for this
 */
double devPS = 10;

void getDeviceSize(GEDevDesc *dd, double *devWidthCM, double *devHeightCM) 
{
    double left, right, bottom, top;
    dd->dev->size(&left, &right, &bottom, &top, dd->dev);
    *devWidthCM = fabs(right - left) * dd->dev->ipr[0] * 2.54;
    *devHeightCM = fabs(top - bottom) * dd->dev->ipr[1] * 2.54;
}

static Rboolean deviceChanged(double devWidthCM, double devHeightCM, 
			      SEXP currentvp)
{
    Rboolean result = FALSE;
    SEXP pvpDevWidthCM, pvpDevHeightCM;
    PROTECT(pvpDevWidthCM = VECTOR_ELT(currentvp, PVP_DEVWIDTHCM));
    PROTECT(pvpDevHeightCM = VECTOR_ELT(currentvp, PVP_DEVHEIGHTCM));
    if (fabs(REAL(pvpDevWidthCM)[0] - devWidthCM) > DBL_EPSILON) {
	result = TRUE;
	REAL(pvpDevWidthCM)[0] = devWidthCM;
	SET_VECTOR_ELT(currentvp, PVP_DEVWIDTHCM, pvpDevWidthCM);
    }
    if (fabs(REAL(pvpDevHeightCM)[0] - devHeightCM) > DBL_EPSILON) {
	result = TRUE;
	REAL(pvpDevHeightCM)[0] = devHeightCM;
	SET_VECTOR_ELT(currentvp, PVP_DEVHEIGHTCM, pvpDevHeightCM);
    }
    UNPROTECT(2);
    return result;
}

/* Register grid with R's graphics engine
 */
SEXP L_initGrid(SEXP GridEvalEnv) 
{
    R_gridEvalEnv = GridEvalEnv;
    GEregisterSystem(gridCallback, &gridRegisterIndex);
    return R_NilValue;
}

SEXP L_killGrid() 
{
    GEunregisterSystem(gridRegisterIndex);
    return R_NilValue;
}

/* Get the current device (the graphics engine creates one if nec.)
 */
GEDevDesc* getDevice() 
{
    return GEcurrentDevice();
}

/* If this is the first time that a grid operation has occurred for 
 * this device, do some initialisation.
 */
void dirtyGridDevice(GEDevDesc *dd) {
    if (!LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) {
	SEXP gsd, griddev;
	/* Record the fact that this device has now received grid output
	 */
	gsd = (SEXP) dd->gesd[gridRegisterIndex]->systemSpecific;
	PROTECT(griddev = allocVector(LGLSXP, 1));
	LOGICAL(griddev)[0] = TRUE;
	SET_VECTOR_ELT(gsd, GSS_GRIDDEVICE, griddev);
	UNPROTECT(1);
	/*
	 * Start the first page on the device
	 * (But only if no other graphics system has not already done so)
	 */
	if (!GEdeviceDirty(dd)) {
	    R_GE_gcontext gc;
	    SEXP currentgp = gridStateElement(dd, GSS_GPAR);
	    gcontextFromgpar(currentgp, 0, &gc);
	    GENewPage(&gc, dd);
	    GEdirtyDevice(dd);
	}
	/*
	 * Only initialise viewport once new page has started
	 * (required for postscript output [at least])
	 */
	initVP(dd);
	initDL(dd);
    }
}

SEXP L_gridDirty()
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    dirtyGridDevice(dd);
    /* Ensure that base graphics (the GCheckState call in do_dotgraphics)
     * will not complain.
     * FIXME:
     * This should come out once more changes to base graphics have been made.
     */
    GSetState(1, (DevDesc*) dd);
    return R_NilValue;
}

void getViewportContext(SEXP vp, LViewportContext *vpc)
{
    fillViewportContextFromViewport(vp, vpc);
}

SEXP L_currentViewport() 
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_VP);
}

SEXP doSetViewport(SEXP vp, 
		   /* 
		    * Are we setting the top-level viewport?
		    */
		   Rboolean topLevelVP,
		   /* 
		    * Are we pushing a new viewport?
		    * (or just revisiting an already-pushed viewport?)
		    */
		   Rboolean pushing,
		   GEDevDesc *dd)
{
    int i, j;
    double devWidthCM, devHeightCM;
    double xx1, yy1, xx2, yy2;
    SEXP currentClip, widthCM, heightCM;
    /* Get the current device size 
     */
    getDeviceSize((dd), &devWidthCM, &devHeightCM);
    if (!topLevelVP && pushing) {
	SEXP parent = gridStateElement(dd, GSS_VP);
	/* Set the viewport's parent
	 * Need to do this in here so that redrawing via R BASE display
	 * list works 
	 */
	SET_VECTOR_ELT(vp, PVP_PARENT, parent);
	/*
	 * Make this viewport a child of its parent
	 * This involves assigning a value in the parent's
	 * children slot (which is an environment), using
	 * the viewport's name as the symbol name.
	 * NOTE that we are deliberately using defineVar to
	 * assign the vp SEXP itself, NOT a copy.
	 */
	defineVar(install(CHAR(STRING_ELT(VECTOR_ELT(vp, VP_NAME), 0))),
		  vp, 
		  VECTOR_ELT(parent, PVP_CHILDREN));
    }
    /* Calculate the transformation for the viewport.
     * This will hopefully only involve updating the transformation
     * from the previous viewport.
     * However, if the device has changed size, we will need to
     * recalculate the transformation from the top-level viewport
     * all the way down.
     * NEVER incremental for top-level viewport
     */
    calcViewportTransform(vp, viewportParent(vp), 
			  !topLevelVP &&
			  !deviceChanged(devWidthCM, devHeightCM, 
					 viewportParent(vp)), dd);
    /* 
     * We must "turn off" clipping
     * We set the clip region to be the entire device
     * (actually, as for the top-level viewport, we set it
     *  to be slightly larger than the device to avoid 
     *  "edge effects")
     */
    if (viewportClip(vp) == NA_LOGICAL) {
	xx1 = toDeviceX(-0.5*devWidthCM/2.54, GE_INCHES, dd);
	yy1 = toDeviceY(-0.5*devHeightCM/2.54, GE_INCHES, dd);
	xx2 = toDeviceX(1.5*devWidthCM/2.54, GE_INCHES, dd);
	yy2 = toDeviceY(1.5*devHeightCM/2.54, GE_INCHES, dd);
	GESetClip(xx1, yy1, xx2, yy2, dd);
    }
    /* If we are supposed to clip to this viewport ...
     * NOTE that we will only clip if there is no rotation
     */
    else if (viewportClip(vp)) {
	double rotationAngle = REAL(viewportRotation(vp))[0];
	if (rotationAngle != 0)
	    warning("Cannot clip to rotated viewport");
	else {
	    /* Calculate a clipping region and set it
	     */
	    SEXP x1, y1, x2, y2;
	    LViewportContext vpc;
	    double vpWidthCM = REAL(viewportWidthCM(vp))[0];
	    double vpHeightCM = REAL(viewportHeightCM(vp))[0];
	    R_GE_gcontext gc;
	    LTransform transform;
	    for (i=0; i<3; i++)
		for (j=0; j<3; j++)
		    transform[i][j] = 
			REAL(viewportTransform(vp))[i + 3*j];
	    if (!topLevelVP) {
		PROTECT(x1 = unit(0, L_NPC));
		PROTECT(y1 = unit(0, L_NPC));
		PROTECT(x2 = unit(1, L_NPC));
		PROTECT(y2 = unit(1, L_NPC));
	    } else {
		/* Special case for top-level viewport.
		 * Set clipping region outside device boundaries.
		 * This means that we have set the clipping region to
		 * something, but avoids problems if the nominal device
		 * limits are actually within its physical limits
		 * (e.g., PostScript)
		 */
	        PROTECT(x1 = unit(-.5, L_NPC));
		PROTECT(y1 = unit(-.5, L_NPC));
		PROTECT(x2 = unit(1.5, L_NPC));
		PROTECT(y2 = unit(1.5, L_NPC));
	    }
	    getViewportContext(vp, &vpc);
	    gcontextFromViewport(vp, &gc);
	    transformLocn(x1, y1, 0, vpc, &gc, 
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &xx1, &yy1);
	    transformLocn(x2, y2, 0, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &xx2, &yy2);
	    UNPROTECT(4);  /* unprotect x1, y1, x2, y2 */
	    /* The graphics engine only takes device coordinates
	     */
	    xx1 = toDeviceX(xx1, GE_INCHES, dd);
	    yy1 = toDeviceY(yy1, GE_INCHES, dd);
	    xx2 = toDeviceX(xx2, GE_INCHES, dd);
	    yy2 = toDeviceY(yy2, GE_INCHES, dd);
	    GESetClip(xx1, yy1, xx2, yy2, dd);
	}
    } else {
	/* If we haven't set the clipping region for this viewport
	 * we need to save the clipping region from its parent
	 * so that when we pop this viewport we can restore that.
	 */
	/* NOTE that we are relying on grid.R setting clip=TRUE
	 * for the top-level viewport, else *BOOM*!
	 */
	SEXP parentClip;
	PROTECT(parentClip = viewportClipRect(viewportParent(vp)));
	xx1 = REAL(parentClip)[0];
	yy1 = REAL(parentClip)[1];
	xx2 = REAL(parentClip)[2];
	yy2 = REAL(parentClip)[3];
	UNPROTECT(1);
    }
    PROTECT(currentClip = allocVector(REALSXP, 4));
    REAL(currentClip)[0] = xx1;
    REAL(currentClip)[1] = yy1;
    REAL(currentClip)[2] = xx2;
    REAL(currentClip)[3] = yy2;
    SET_VECTOR_ELT(vp, PVP_CLIPRECT, currentClip);
    /*
     * Save the current device size
     */
    PROTECT(widthCM = allocVector(REALSXP, 1));
    REAL(widthCM)[0] = devWidthCM;
    SET_VECTOR_ELT(vp, PVP_DEVWIDTHCM, widthCM);
    PROTECT(heightCM = allocVector(REALSXP, 1));
    REAL(heightCM)[0] = devHeightCM;
    SET_VECTOR_ELT(vp, PVP_DEVHEIGHTCM, heightCM);
    UNPROTECT(3);
    return vp;
}

SEXP L_setviewport(SEXP vp, SEXP hasParent)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    vp = doSetViewport(vp, !LOGICAL(hasParent)[0], TRUE, dd);
    /* Set the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */
    setGridStateElement(dd, GSS_VP, vp);
    return R_NilValue;
}

/* 
 * Find a viewport in the current viewport tree by name
 *
 * Have to do this in C code so that we get THE SEXP in
 * the tree, NOT a copy of it.
 */

/*
 * Some helper functions to call R code because I have no idea
 * how to do this in C code
 */
static Rboolean noChildren(SEXP children) 
{
    SEXP result, fcall;
    PROTECT(fcall = lang2(install("no.children"),
			  children));
    PROTECT(result = eval(fcall, R_gridEvalEnv)); 
    UNPROTECT(2);
    return LOGICAL(result)[0];
}

static Rboolean childExists(SEXP name, SEXP children) 
{
    SEXP result, fcall;
    PROTECT(fcall = lang3(install("child.exists"),
			  name, children));
    PROTECT(result = eval(fcall, R_gridEvalEnv)); 
    UNPROTECT(2);
    return LOGICAL(result)[0];
}

static SEXP childList(SEXP children) 
{
    SEXP result, fcall;
    PROTECT(fcall = lang2(install("child.list"),
			  children));
    PROTECT(result = eval(fcall, R_gridEvalEnv)); 
    UNPROTECT(2);
    return result;    
}

/*
find.in.children <- function(name, children) {
  cpvps <- ls(env=children)
  ncpvp <- length(cpvps)
  count <- 0
  found <- FALSE
  while (count < ncpvp && !found) {
    result <- find.viewport(name, get(cpvps[count+1], env=children))
    found <- result$found
    count <- count + 1
  }
  if (!found)
    result <- list(found=FALSE, pvp=NULL)
  return(result)
}
*/
static SEXP findViewport(SEXP name, SEXP strict, SEXP vp, int depth);
static SEXP findInChildren(SEXP name, SEXP strict, SEXP children, int depth) 
{
    SEXP childnames = childList(children);
    int n = LENGTH(childnames);
    int count = 0;
    Rboolean found = FALSE;
    SEXP result = R_NilValue;
    PROTECT(result);
    while (count < n && !found) {
	result = findViewport(name, strict,
			      findVar(install(CHAR(STRING_ELT(childnames, count))),
				      children),
			      depth);
	found = INTEGER(VECTOR_ELT(result, 0))[0] > 0;
	count = count + 1;
    }
    if (!found) {
	SEXP temp, zeroDepth;
	PROTECT(temp = allocVector(VECSXP, 2));
	PROTECT(zeroDepth = allocVector(INTSXP, 1));
	INTEGER(zeroDepth)[0] = 0;
	SET_VECTOR_ELT(temp, 0, zeroDepth);
	SET_VECTOR_ELT(temp, 1, R_NilValue);
	UNPROTECT(2);
	result = temp;
    }
    UNPROTECT(1);
    return result;
}
			   
/*
find.viewport <- function(name, pvp) {
  found <- FALSE
  if (length(ls(env=pvp$children)) == 0)
    return(list(found=FALSE, pvp=NULL))
  else 
    if (exists(name, env=pvp$children, inherits=FALSE)) 
      return(list(found=TRUE,
                  pvp=get(name, env=pvp$children, inherits=FALSE)))
    else 
      find.in.children(name, pvp$children)
}
*/
static SEXP findViewport(SEXP name, SEXP strict, SEXP vp, int depth) 
{
    SEXP result, zeroDepth, curDepth;
    PROTECT(result = allocVector(VECSXP, 2));
    PROTECT(zeroDepth = allocVector(INTSXP, 1));
    INTEGER(zeroDepth)[0] = 0;
    PROTECT(curDepth = allocVector(INTSXP, 1));
    INTEGER(curDepth)[0] = depth;
    /* 
     * If there are no children, we fail
     */
    if (noChildren(viewportChildren(vp))) {
	SET_VECTOR_ELT(result, 0, zeroDepth);
	SET_VECTOR_ELT(result, 1, R_NilValue);
    } else if (childExists(name, viewportChildren(vp))) {
	SET_VECTOR_ELT(result, 0, curDepth);
	SET_VECTOR_ELT(result, 1, 
		       /*
			* Does this do inherits=FALSE?
			*/
		       findVar(install(CHAR(STRING_ELT(name, 0))), 
			       viewportChildren(vp)));
    } else {
	/*
	 * If this is a strict match, fail
	 * Otherwise recurse into children
	 */
	if (LOGICAL(strict)[0]) {
	    SET_VECTOR_ELT(result, 0, zeroDepth);
	    SET_VECTOR_ELT(result, 1, R_NilValue);
	} else {
	    result = findInChildren(name, strict, viewportChildren(vp),
				    depth + 1);
	}
    }
    UNPROTECT(3);
    return result;
}

SEXP L_downviewport(SEXP name, SEXP strict) 
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    /* Get the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */    
    SEXP gvp = gridStateElement(dd, GSS_VP);
    /* 
     * Try to find the named viewport
     */
    SEXP found, vp;
    int depth = 1;
    PROTECT(found = findViewport(name, strict, gvp, depth));
    if (INTEGER(VECTOR_ELT(found, 0))[0]) {
	vp = doSetViewport(VECTOR_ELT(found, 1), FALSE, FALSE, dd);
	/* Set the value of the current viewport for the current device
	 * Need to do this in here so that redrawing via R BASE display
	 * list works 
	 */
	setGridStateElement(dd, GSS_VP, vp);
    }
    UNPROTECT(1);    
    return VECTOR_ELT(found, 0);    
}

/* 
 * Find a viewport PATH in the current viewport tree by name
 *
 * Similar to L_downviewport
 */

static Rboolean pathMatch(SEXP path, SEXP pathsofar, SEXP strict) 
{
    SEXP result, fcall;
    PROTECT(fcall = lang4(install("pathMatch"),
			  path, pathsofar, strict));
    PROTECT(result = eval(fcall, R_gridEvalEnv)); 
    UNPROTECT(2);
    return LOGICAL(result)[0];    
}

static SEXP growPath(SEXP pathsofar, SEXP name) 
{
    SEXP result, fcall;
    if (isNull(pathsofar))
	result = name;
    else {
	PROTECT(fcall = lang3(install("growPath"),
			      pathsofar, name));
	PROTECT(result = eval(fcall, R_gridEvalEnv)); 
	UNPROTECT(2);
    }
    return result;    
}

static SEXP findvppath(SEXP path, SEXP name, SEXP strict, 
		       SEXP pathsofar, SEXP vp, int depth);
static SEXP findvppathInChildren(SEXP path, SEXP name, 
				 SEXP strict, SEXP pathsofar,
				 SEXP children, int depth) 
{
    SEXP childnames = childList(children);
    int n = LENGTH(childnames);
    int count = 0;
    Rboolean found = FALSE;
    SEXP result = R_NilValue;
    PROTECT(result);
    while (count < n && !found) {
	SEXP vp, newpathsofar;
	PROTECT(vp = findVar(install(CHAR(STRING_ELT(childnames, count))),
			     children));
	PROTECT(newpathsofar = growPath(pathsofar,
					VECTOR_ELT(vp, VP_NAME)));
	result = findvppath(path, name, strict, newpathsofar, vp, depth);
	found = INTEGER(VECTOR_ELT(result, 0))[0] > 0;
	count = count + 1;
	UNPROTECT(2);
    }
    if (!found) {
	SEXP temp, zeroDepth;
	PROTECT(temp = allocVector(VECSXP, 2));
	PROTECT(zeroDepth = allocVector(INTSXP, 1));
	INTEGER(zeroDepth)[0] = 0;
	SET_VECTOR_ELT(temp, 0, zeroDepth);
	SET_VECTOR_ELT(temp, 1, R_NilValue);
	UNPROTECT(2);
	result = temp;
    }
    UNPROTECT(1);
    return result;
}
			   
static SEXP findvppath(SEXP path, SEXP name, SEXP strict, 
		       SEXP pathsofar, SEXP vp, int depth) 
{
    SEXP result, zeroDepth, curDepth;
    PROTECT(result = allocVector(VECSXP, 2));
    PROTECT(zeroDepth = allocVector(INTSXP, 1));
    INTEGER(zeroDepth)[0] = 0;
    PROTECT(curDepth = allocVector(INTSXP, 1));
    INTEGER(curDepth)[0] = depth;
    /* 
     * If there are no children, we fail
     */
    if (noChildren(viewportChildren(vp))) {
	SET_VECTOR_ELT(result, 0, zeroDepth);
	SET_VECTOR_ELT(result, 1, R_NilValue);
	
    } 
    /* 
     * Check for the viewport name AND whether the rest
     * of the path matches (possibly strictly)
     */
    else if (childExists(name, viewportChildren(vp)) &&
	     pathMatch(path, pathsofar, strict)) {
	SET_VECTOR_ELT(result, 0, curDepth);
	SET_VECTOR_ELT(result, 1, 
		       /*
			* Does this do inherits=FALSE?
			*/
		       findVar(install(CHAR(STRING_ELT(name, 0))), 
			       viewportChildren(vp)));
    } else {
	result = findvppathInChildren(path, name, strict, pathsofar,
				      viewportChildren(vp), depth + 1);
    }
    UNPROTECT(3);
    return result;
}

SEXP L_downvppath(SEXP path, SEXP name, SEXP strict) 
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    /* Get the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */    
    SEXP gvp = gridStateElement(dd, GSS_VP);
    /* 
     * Try to find the named viewport
     */
    SEXP found, vp;
    int depth = 1;
    PROTECT(found = findvppath(path, name, strict, R_NilValue, gvp, depth));
    if (INTEGER(VECTOR_ELT(found, 0))[0]) {
	vp = doSetViewport(VECTOR_ELT(found, 1), FALSE, FALSE, dd);
	/* Set the value of the current viewport for the current device
	 * Need to do this in here so that redrawing via R BASE display
	 * list works 
	 */
	setGridStateElement(dd, GSS_VP, vp);
    }
    UNPROTECT(1);    
    return VECTOR_ELT(found, 0);    
}

/* This is similar to L_setviewport, except that it will NOT 
 * recalculate the viewport transform if the device has not changed size
 */
SEXP L_unsetviewport(SEXP last)
{
    double xx1, yy1, xx2, yy2;
    SEXP parentClip;
    SEXP newvp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    /* Get the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */    
    SEXP gvp = gridStateElement(dd, GSS_VP);
    /* NOTE that the R code has already checked that .grid.viewport$parent
     * is non-NULL
     * 
     * BUT this may not be called from R code !!
     * (e.g., when the graphics engine display list is replayed;
     *  problems can occur when grid output is mixed with base output;
     *  for example, plot.new() is called between a viewport push and pop)
     */
    PROTECT(newvp = VECTOR_ELT(gvp, PVP_PARENT));
    if (isNull(newvp))
      error("Cannot pop the top-level viewport (grid and graphics output mixed?)");
    /* 
     * Remove the parent from the child
     * This is not strictly necessary, but it is conceptually
     * more complete and makes it more likely that we will
     * detect incorrect code elsewhere (because it is likely to
     * trigger a segfault if other code is incorrect)
     */
    SET_VECTOR_ELT(gvp, PVP_PARENT, R_NilValue);
    /* 
     * Remove the child (gvp) from the parent's (newvp) "list" of
     * children
     */
    /* 
     * This has to be done via a call to R-level ...
     *   remove(gvp$name, envir=newvp$children, inherits=FALSE)
     * ... because RemoveVariable in envir.c is not exported (why not?)
     *
     * I tried to model this on the example in the section 
     * "System and foreign language interfaces ... Evaluating R expressions"
     * in the "Writing R Extensions" manual, but the compiler didn't
     * like CAR(t) as an lvalue.
     */
    {
	SEXP fcall, false, t;
	PROTECT(false = allocVector(LGLSXP, 1));
	LOGICAL(false)[0] = FALSE;
	PROTECT(fcall = lang4(install("remove"), 
			      VECTOR_ELT(gvp, VP_NAME),
			      VECTOR_ELT(newvp, PVP_CHILDREN),
			      false));
	t = fcall;
	t = CDR(CDR(t));
	SET_TAG(t, install("envir")); 
	t = CDR(t);
	SET_TAG(t, install("inherits")); 
	eval(fcall, R_gridEvalEnv); 
	UNPROTECT(2);
    }
    if (LOGICAL(last)[0]) {
	double devWidthCM, devHeightCM;
	/* Get the current device size 
	 */
	getDeviceSize(dd, &devWidthCM, &devHeightCM);
	if (deviceChanged(devWidthCM, devHeightCM, newvp))
	    calcViewportTransform(newvp, viewportParent(newvp), 1, dd);
    }
    /* Set the clipping region to the parent's cur.clip
     */
    parentClip = viewportClipRect(newvp);
    xx1 = REAL(parentClip)[0];
    yy1 = REAL(parentClip)[1];
    xx2 = REAL(parentClip)[2];
    yy2 = REAL(parentClip)[3];
    GESetClip(xx1, yy1, xx2, yy2, dd);
	    /* This is a VERY short term fix to avoid mucking
	     * with the core graphics during feature freeze
	     * It should be removed post R 1.4 release
	     */
	    dd->dev->clipLeft = fmin2(xx1, xx2);
	    dd->dev->clipRight = fmax2(xx1, xx2);
	    dd->dev->clipTop = fmax2(yy1, yy2);
	    dd->dev->clipBottom = fmin2(yy1, yy2); 
    /* Set the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */
    setGridStateElement(dd, GSS_VP, newvp);
    UNPROTECT(1);
    return R_NilValue;
}

/* This is similar to L_unsetviewport, except that it will NOT 
 * modify parent-child relations 
 */
SEXP L_upviewport(SEXP last)
{
    double xx1, yy1, xx2, yy2;
    SEXP parentClip;
    SEXP newvp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    /* Get the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */    
    SEXP gvp = gridStateElement(dd, GSS_VP);
    /* NOTE that the R code has already checked that .grid.viewport$parent
     * is non-NULL
     */
    PROTECT(newvp = VECTOR_ELT(gvp, PVP_PARENT));
    if (isNull(newvp))
      error("Cannot up the top-level viewport (grid and graphics output mixed?)");
    if (LOGICAL(last)[0]) {
	double devWidthCM, devHeightCM;
	/* Get the current device size 
	 */
	getDeviceSize(dd, &devWidthCM, &devHeightCM);
	if (deviceChanged(devWidthCM, devHeightCM, newvp))
	    calcViewportTransform(newvp, viewportParent(newvp), 1, dd);
    }
    /* Set the clipping region to the parent's cur.clip
     */
    parentClip = viewportClipRect(newvp);
    xx1 = REAL(parentClip)[0];
    yy1 = REAL(parentClip)[1];
    xx2 = REAL(parentClip)[2];
    yy2 = REAL(parentClip)[3];
    GESetClip(xx1, yy1, xx2, yy2, dd);
	    /* This is a VERY short term fix to avoid mucking
	     * with the core graphics during feature freeze
	     * It should be removed post R 1.4 release
	     */
	    dd->dev->clipLeft = fmin2(xx1, xx2);
	    dd->dev->clipRight = fmax2(xx1, xx2);
	    dd->dev->clipTop = fmax2(yy1, yy2);
	    dd->dev->clipBottom = fmin2(yy1, yy2); 
    /* Set the value of the current viewport for the current device
     * Need to do this in here so that redrawing via R BASE display
     * list works 
     */
    setGridStateElement(dd, GSS_VP, newvp);
    UNPROTECT(1);
    return R_NilValue;
}

SEXP L_getDisplayList() 
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_DL);
}

SEXP L_setDisplayList(SEXP dl) 
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_DL, dl);
    return R_NilValue;
}

/*
 * Get the element at index on the DL
 */
SEXP L_getDLelt(SEXP index)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    SEXP dl, result;
    PROTECT(dl = gridStateElement(dd, GSS_DL));
    result = VECTOR_ELT(dl, INTEGER(index)[0]);
    UNPROTECT(1);
    return result;
}

/* Add an element to the display list at the current location
 * Location is maintained in R code
 */
SEXP L_setDLelt(SEXP value)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    SEXP dl;
    PROTECT(dl = gridStateElement(dd, GSS_DL));
    SET_VECTOR_ELT(dl, INTEGER(gridStateElement(dd, GSS_DLINDEX))[0], value);
    UNPROTECT(1);
    return R_NilValue;
}

SEXP L_getDLindex()
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_DLINDEX);
}

SEXP L_setDLindex(SEXP index)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_DLINDEX, index);
    return R_NilValue;
}

SEXP L_getDLon()
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_DLON);
}

SEXP L_setDLon(SEXP value)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_DLON, value);
    return R_NilValue;
}

SEXP L_getEngineDLon()
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_ENGINEDLON);
}

SEXP L_setEngineDLon(SEXP value)
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_ENGINEDLON, value);
    return R_NilValue;
}

SEXP L_getCurrentGrob() 
{
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_CURRGROB);
}

SEXP L_setCurrentGrob(SEXP value)
{
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_CURRGROB, value);
    return R_NilValue;
}

SEXP L_getEngineRecording() 
{
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_ENGINERECORDING);
}

SEXP L_setEngineRecording(SEXP value)
{
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_ENGINERECORDING, value);
    return R_NilValue;
}

SEXP L_getAsk() 
{
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_ASK);
}

SEXP L_setAsk(SEXP value)
{
    GEDevDesc *dd = getDevice();
    setGridStateElement(dd, GSS_ASK, value);
    return R_NilValue;
}

SEXP L_currentGPar()
{
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    return gridStateElement(dd, GSS_GPAR);
}

SEXP L_newpagerecording()
{
    GEDevDesc *dd = getDevice();
    if (LOGICAL(gridStateElement(dd, GSS_ASK))[0]) {
	NewFrameConfirm();
    }
    GEinitDisplayList(dd);
    return R_NilValue;
}

SEXP L_newpage()
{
    GEDevDesc *dd = getDevice();
    R_GE_gcontext gc;
    if (!LOGICAL(gridStateElement(dd, GSS_GRIDDEVICE))[0]) 
	dirtyGridDevice(dd);
    else {
	SEXP currentgp = gridStateElement(dd, GSS_GPAR);
	gcontextFromgpar(currentgp, 0, &gc);
	GENewPage(&gc, dd);
    }
    return R_NilValue;
}

SEXP L_initGPar()
{
    GEDevDesc *dd = getDevice();
    initGPar(dd);
    return R_NilValue;
}

SEXP L_initViewportStack()
{
    GEDevDesc *dd = getDevice();
    initVP(dd);
    return R_NilValue;
}

SEXP L_initDisplayList()
{
    GEDevDesc *dd = getDevice();
    initDL(dd);
    return R_NilValue;
}

void getViewportTransform(SEXP currentvp, 
			  GEDevDesc *dd, 
			  double *vpWidthCM, double *vpHeightCM,
			  LTransform transform, double *rotationAngle) 
{
    int i, j;
    double devWidthCM, devHeightCM;
    getDeviceSize((dd), &devWidthCM, &devHeightCM) ;
    if (deviceChanged(devWidthCM, devHeightCM, currentvp)) {
	/* IF the device has changed, recalculate the viewport transform
	 */
	calcViewportTransform(currentvp, viewportParent(currentvp), 1, dd); 
    }
    for (i=0; i<3; i++)
	for (j=0; j<3; j++)
	    transform[i][j] = 
		REAL(viewportTransform(currentvp))[i + 3*j];
    *rotationAngle = REAL(viewportRotation(currentvp))[0];
    *vpWidthCM = REAL(viewportWidthCM(currentvp))[0];
    *vpHeightCM = REAL(viewportHeightCM(currentvp))[0];
}


/***************************
 * CONVERSION FUNCTIONS
 ***************************
 */

/*
 * WITHIN THE CURRENT VIEWPORT ... 
 *
 * Given a unit object and whether it is a location/dimension,
 * convert to location/dimension in unit B
 *
 * NOTE: When this is used to convert a mouse click on a device to
 * a location/dimension, the conversion of the mouse click to 
 * a unit within the current viewport has to be done elsewhere.
 * e.g., in interactive.R, this is done by applying the inverse
 * of the current viewport transformation to get a location in
 * inches within the current viewport.
 * 
 * This should ideally create a unit object to ensure that the
 * values it returns are treated as values in the correct 
 * coordinate system.  For now, this is MUCH easier to do in
 * R code, so it is the responsibility of the R code calling this
 * to create the unit object correctly/honestly.
 *
 * NOTE also that the unitto supplied should be a "valid" integer 
 * (the best way to get that is to use the valid.units()
 *  function in unit.R)
 *
 * what = 0 means x, 1 means y, 2 means width, 3 means height
 */
SEXP L_convert(SEXP x, SEXP whatfrom,
	       SEXP whatto, SEXP unitto) {
    int i, nx;
    SEXP answer;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* 
     * Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    /* 
     * We do not need the current transformation, but
     * we need the side effects of calculating it in
     * case the device has been resized (or only just created)
     */
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    nx = unitLength(x);
    PROTECT(answer = allocVector(REALSXP, nx));
    /* 
     * First, convert the unit object passed in to a value in INCHES
     * (within the current viewport)
     */
    switch (INTEGER(whatfrom)[0]) {
    case 0:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformXtoINCHES(x, i, vpc, &gc,
				   vpWidthCM, vpHeightCM, 
				   dd);
	}
	break;
    case 1:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformYtoINCHES(x, i, vpc, &gc,
				   vpWidthCM, vpHeightCM, 
				   dd);
	}
	break;
    case 2:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformWidthtoINCHES(x, i, vpc, &gc,
				       vpWidthCM, vpHeightCM, 
				       dd);
	}
	break;
    case 3:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformHeighttoINCHES(x, i, vpc, &gc,
					vpWidthCM, vpHeightCM, 
					dd);
	}
	break;
    }
    /* 
     * Now, convert the values in INCHES to a value in the specified
     * coordinate system 
     * (within the current viewport)
     */
    switch (INTEGER(whatto)[0]) {
    case 0:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformXYFromINCHES(REAL(answer)[i],
				      INTEGER(unitto)[i % LENGTH(unitto)],
				      vpc.xscalemin,
				      vpc.xscalemax,
				      &gc,
				      vpWidthCM, vpHeightCM, 
				      dd);
	}
	break;
    case 1:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformXYFromINCHES(REAL(answer)[i],
				      INTEGER(unitto)[i % LENGTH(unitto)],
				      vpc.yscalemin,
				      vpc.yscalemax,
				      &gc,
				      vpHeightCM, vpWidthCM, 
				      dd);
	}
	break;
    case 2:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformWidthHeightFromINCHES(REAL(answer)[i],
					       INTEGER(unitto)[i % LENGTH(unitto)],
					       vpc.xscalemin,
					       vpc.xscalemax,
					       &gc,
					       vpWidthCM, vpHeightCM, 
					       dd);
	}
	break;
    case 3:
	for (i=0; i<nx; i++) {
	    gcontextFromgpar(currentgp, i, &gc);
	    REAL(answer)[i] = 
		transformWidthHeightFromINCHES(REAL(answer)[i],
					       INTEGER(unitto)[i % LENGTH(unitto)],
					       vpc.yscalemin,
					       vpc.yscalemax,
					       &gc,
					       vpHeightCM, vpWidthCM, 
					       dd);
	}
	break;
    }
    UNPROTECT(1);
    return answer;
}

/*
 * Given a layout.pos.row and a layout.pos.col, calculate
 * the region allocated by the layout of the current viewport
 *
 * Not a conversion as such, but similarly vulnerable to device resizing
 */
SEXP L_layoutRegion(SEXP layoutPosRow, SEXP layoutPosCol) {
    LViewportLocation vpl;
    SEXP answer;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* 
     * Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    /* 
     * We do not need the current transformation, but
     * we need the side effects of calculating it in
     * case the device has been resized (or only just created)
     */
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    /* 
     * Only proceed if there is a layout currently defined
     */
    if (isNull(viewportLayout(currentvp)))
	error("There is no layout defined");
    /* 
     * The result is a numeric containing left, bottom, width, and height
     */
    PROTECT(answer = allocVector(REALSXP, 4));
    /* 
     * NOTE:  We are assuming here that calcViewportLocationFromLayout
     * returns the allocated region with a ("left", "bottom") 
     * justification.  This is CURRENTLY true, but ...
     */
    calcViewportLocationFromLayout(layoutPosRow,
				   layoutPosCol,
				   currentvp,
				   &vpl);
    /* 
     * I am not returning the units created in C code
     * because they do not have the units attribute set
     * so they do not behave nicely back in R code.
     * Instead, I take the values and my knowledge that they
     * are NPC units and construct real unit objects back in 
     * R code.
     */
    REAL(answer)[0] = unitValue(vpl.x, 0);
    REAL(answer)[1] = unitValue(vpl.y, 0);
    REAL(answer)[2] = unitValue(vpl.width, 0);
    REAL(answer)[3] = unitValue(vpl.height, 0);
    UNPROTECT(1);
    return answer;
}

/***************************
 * DRAWING PRIMITIVES
 ***************************
 */

SEXP L_moveTo(SEXP x, SEXP y)
{    
    double xx, yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP devloc, prevloc;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    PROTECT(prevloc = gridStateElement(dd, GSS_PREVLOC));
    PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC));
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    gcontextFromgpar(currentgp, 0, &gc);
    /* Convert the x and y values to CM locations */
    transformLocn(x, y, 0, vpc, &gc,
		  vpWidthCM, vpHeightCM,
		  dd,
		  transform,
		  &xx, &yy);
    /*
     * Non-finite values are ok here
     * L_lineTo figures out what to draw 
     * when values are non-finite
     */
    REAL(prevloc)[0] = REAL(devloc)[0];
    REAL(prevloc)[1] = REAL(devloc)[1];
    REAL(devloc)[0] = xx;
    REAL(devloc)[1] = yy;
    UNPROTECT(2);
    return R_NilValue;
}

SEXP L_lineTo(SEXP x, SEXP y)
{
    double xx0, yy0, xx1, yy1;
    double xx, yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP devloc, prevloc;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    PROTECT(prevloc = gridStateElement(dd, GSS_PREVLOC));
    PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC));
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    gcontextFromgpar(currentgp, 0, &gc);
    /* Convert the x and y values to CM locations */
    transformLocn(x, y, 0, vpc, &gc,
		  vpWidthCM, vpHeightCM,
		  dd,
		  transform,
		  &xx, &yy);
    REAL(prevloc)[0] = REAL(devloc)[0];
    REAL(prevloc)[1] = REAL(devloc)[1];
    REAL(devloc)[0] = xx;
    REAL(devloc)[1] = yy;
    /* The graphics engine only takes device coordinates
     */
    xx0 = toDeviceX(REAL(prevloc)[0], GE_INCHES, dd);
    yy0 = toDeviceY(REAL(prevloc)[1], GE_INCHES, dd), 
    xx1 = toDeviceX(xx, GE_INCHES, dd);
    yy1 = toDeviceY(yy, GE_INCHES, dd);
    if (R_FINITE(xx0) && R_FINITE(yy0) &&
	R_FINITE(xx1) && R_FINITE(yy1)) {
	GEMode(1, dd);
	GELine(xx0, yy0, xx1, yy1, &gc, dd);
	GEMode(0, dd);
    }
    UNPROTECT(2);
    return R_NilValue;
}

/* We are assuming here that the R code has checked that x and y 
 * are unit objects and that vp is a viewport
 */
SEXP L_lines(SEXP x, SEXP y) 
{
    int i, nx, ny, start=0;
    double *xx, *yy;
    double xold, yold;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    char *vmax;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    gcontextFromgpar(currentgp, 0, &gc);
    nx = unitLength(x);
    ny = unitLength(y); 
    if (ny > nx) 
	nx = ny;
    /* Convert the x and y values to CM locations */
    vmax = vmaxget();
    GEMode(1, dd);
    xx = (double *) R_alloc(nx, sizeof(double));
    yy = (double *) R_alloc(nx, sizeof(double));
    xold = NA_REAL;
    yold = NA_REAL;
    for (i=0; i<nx; i++) {
	transformLocn(x, y, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd,
		      transform,
		      &(xx[i]), &(yy[i]));
	/* The graphics engine only takes device coordinates
	 */
	xx[i] = toDeviceX(xx[i], GE_INCHES, dd);
	yy[i] = toDeviceY(yy[i], GE_INCHES, dd);
	if ((R_FINITE(xx[i]) && R_FINITE(yy[i])) &&
	    !(R_FINITE(xold) && R_FINITE(yold)))
	    start = i;
	else if ((R_FINITE(xold) && R_FINITE(yold)) &&
		 !(R_FINITE(xx[i]) && R_FINITE(yy[i]))) {
	    if (i-start > 1)
		GEPolyline(i-start, xx+start, yy+start, &gc, dd);
	}
	else if ((R_FINITE(xold) && R_FINITE(yold)) &&
		 (i == nx-1))
	    GEPolyline(nx-start, xx+start, yy+start, &gc, dd);
	xold = xx[i];
	yold = yy[i];
    }
    GEMode(0, dd);
    vmaxset(vmax);
    return R_NilValue;
}

SEXP L_segments(SEXP x0, SEXP y0, SEXP x1, SEXP y1) 
{
    int i, nx0, ny0, nx1, ny1, maxn;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    maxn = nx0 = unitLength(x0); 
    ny0 = unitLength(y0);
    nx1 = unitLength(x1);
    ny1 = unitLength(y1);
    if (ny0 > maxn)
	maxn = ny0;
    if (nx1 > maxn)
	maxn = nx1;
    if (ny1 > maxn)
	maxn = ny1;
    /* Convert the x and y values to INCHES locations */
    /* FIXME:  Need to check for NaN's and NA's
     */
    GEMode(1, dd);
    for (i=0; i<maxn; i++) {
	double xx0, yy0, xx1, yy1;
	gcontextFromgpar(currentgp, i, &gc);
	transformLocn(x0, y0, i, vpc, &gc, 
		      vpWidthCM, vpHeightCM,
		      dd, transform, &xx0, &yy0);
	transformLocn(x1, y1, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd, transform, &xx1, &yy1);
	/* The graphics engine only takes device coordinates
	 */
	xx0 = toDeviceX(xx0, GE_INCHES, dd);
	yy0 = toDeviceY(yy0, GE_INCHES, dd);
	xx1 = toDeviceX(xx1, GE_INCHES, dd);
	yy1 = toDeviceY(yy1, GE_INCHES, dd);
	if (R_FINITE(xx0) && R_FINITE(yy0) &&
	    R_FINITE(xx1) && R_FINITE(yy1)) {
	    GELine(xx0, yy0, xx1, yy1, &gc, dd);
	}
    }
    GEMode(0, dd);
    return R_NilValue;
}

static void drawArrow(double *x, double *y, int type, 
		      R_GE_gcontext *gc, int i, GEDevDesc *dd) 
{
    switch (type) {
    case 1:
	GEPolyline(3, x, y, gc, dd);
	break;
    case 2:
	GEPolygon(3, x, y, gc, dd);
	break;
    }
}

static int getArrowN(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, 
		     SEXP y1, SEXP y2, SEXP ynm1, SEXP yn)
{      
    int nx1, nx2, nxnm1, nxn, ny1, ny2, nynm1, nyn, maxn;
    maxn = 0;
    /* 
     * x1, y1, xnm1, and ynm1 could be NULL if this is adding
     * arrows to a line.to
     */
    if (isNull(x1))
	nx1 = 0;
    else
	nx1 = unitLength(x1); 
    if (isNull(y1))
	ny1 = 0;
    else
	ny1 = unitLength(y1);
    nx2 = unitLength(x2);
    ny2 = unitLength(y2);
    if (isNull(xnm1))
	nxnm1 = 0;
    else
	nxnm1 = unitLength(xnm1);
    if (isNull(ynm1))
	nynm1 = 0;
    else
	nynm1 = unitLength(ynm1);
    nxn = unitLength(xn);
    nyn = unitLength(yn);
    if (ny1 > maxn)
	maxn = ny1;
    if (nx2 > maxn)
	maxn = nx2;
    if (ny2 > maxn)
	maxn = ny2;
    if (nxnm1 > maxn)
	maxn = nxnm1;
    if (nynm1 > maxn)
	maxn = nynm1;
    if (nxn > maxn)
	maxn = nxn;
    if (nyn > maxn)
	maxn = nyn;
    return maxn;
}

SEXP L_arrows(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, 
	      SEXP y1, SEXP y2, SEXP ynm1, SEXP yn, 
	      SEXP angle, SEXP length, SEXP ends, SEXP type) 
{
    int i, maxn;
    int na, nl, ne, nt;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    Rboolean first, last;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP devloc = R_NilValue; /* -Wall */
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    maxn = getArrowN(x1, x2, xnm1, xn,
		     y1, y2, ynm1, yn);
    na = LENGTH(angle);
    nl = unitLength(length);
    ne = LENGTH(ends);
    nt = LENGTH(type);
    /* Convert the x and y values to INCHES locations */
    /* FIXME:  Need to check for NaN's and NA's
     */
    GEMode(1, dd);
    for (i=0; i<maxn; i++) {
	double xc, yc, rot;
	double xx1, xx2, xxnm1, xxn, yy1, yy2, yynm1, yyn;
	double vertx[3];
	double verty[3];
	double l1, l2, l, a, t;
	gcontextFromgpar(currentgp, i, &gc);
	l1 = transformWidthtoINCHES(length, i % nl, vpc, &gc,
				    vpWidthCM, vpHeightCM,
				    dd);
	l2 = transformHeighttoINCHES(length, i % nl, vpc, &gc,
				      vpWidthCM, vpHeightCM,
				      dd);
	l = fmin2(l1, l2);
	a = DEG2RAD * REAL(angle)[i % na];
	first = TRUE;
	last = TRUE;
	switch (INTEGER(ends)[i % ne]) {
	case 2: 
	    first = FALSE;
	    break;
	case 1:
	    last = FALSE;
	    break;
	}
	t = INTEGER(type)[i % nt];
	/*
	 * If we're adding arrows to a line.to
	 * x1 will be NULL
	 */
	if (isNull(x1)) 
	    PROTECT(devloc = gridStateElement(dd, GSS_CURRLOC));
	if (first) {
	    if (isNull(x1)) {
		xx1 = REAL(devloc)[0];
		yy1 = REAL(devloc)[1];
	    } else 
		transformLocn(x1, y1, i, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd, transform, &xx1, &yy1);
	    transformLocn(x2, y2, i, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, transform, &xx2, &yy2);
	    xc = xx2 - xx1;
	    yc = yy2 - yy1;
	    rot= atan2(yc, xc);
	    vertx[0] = toDeviceX(xx1 + l * cos(rot+a),
				 GE_INCHES, dd);
	    verty[0] = toDeviceY(yy1 + l * sin(rot+a),
				 GE_INCHES, dd);
	    vertx[1] = toDeviceX(xx1, 
				 GE_INCHES, dd);
	    verty[1] = toDeviceY(yy1,
				 GE_INCHES, dd);
	    vertx[2] = toDeviceX(xx1 + l * cos(rot-a),
				 GE_INCHES, dd);
	    verty[2] = toDeviceY(yy1 + l * sin(rot-a),
				 GE_INCHES, dd);
	    /* 
	     * Only draw arrow if both ends of first segment 
	     * are not non-finite
	     */
	    if (R_FINITE(toDeviceX(xx2, GE_INCHES, dd)) &&
		R_FINITE(toDeviceY(yy2, GE_INCHES, dd)) &&
		R_FINITE(vertx[1]) && R_FINITE(verty[1]))
		drawArrow(vertx, verty, t, &gc, i, dd);
	}
	if (last) {
	    if (isNull(xnm1)) {
		xxnm1 = REAL(devloc)[0];
		yynm1 = REAL(devloc)[1];
	    } else 
		transformLocn(xnm1, ynm1, i, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd, transform, &xxnm1, &yynm1);
	    transformLocn(xn, yn, i, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, transform, &xxn, &yyn);
	    xc = xxnm1 - xxn;
	    yc = yynm1 - yyn;
	    rot= atan2(yc, xc);
	    vertx[0] = toDeviceX(xxn + l * cos(rot+a),
				 GE_INCHES, dd);
	    verty[0] = toDeviceY(yyn + l * sin(rot+a),
				 GE_INCHES, dd);
	    vertx[1] = toDeviceX(xxn, 
				 GE_INCHES, dd);
	    verty[1] = toDeviceY(yyn,
				 GE_INCHES, dd);
	    vertx[2] = toDeviceX(xxn + l * cos(rot-a),
				 GE_INCHES, dd);
	    verty[2] = toDeviceY(yyn + l * sin(rot-a),
				 GE_INCHES, dd);
	    /* 
	     * Only draw arrow if both ends of laste segment are
	     * not non-finite
	     */
	    if (R_FINITE(toDeviceX(xxnm1, GE_INCHES, dd)) &&
		R_FINITE(toDeviceY(yynm1, GE_INCHES, dd)) &&
		R_FINITE(vertx[1]) && R_FINITE(verty[1]))
		drawArrow(vertx, verty, t, &gc, i, dd);
	}
	if (isNull(x1))
	    UNPROTECT(1);
    }
    GEMode(0, dd);
    return R_NilValue;
}

SEXP L_polygon(SEXP x, SEXP y, SEXP index)
{
    int i, j, nx, np, start=0;
    double *xx, *yy;
    double xold, yold;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    GEMode(1, dd);
    /* 
     * Number of polygons 
     */
    np = LENGTH(index);
    for (i=0; i<np; i++) {
	char *vmax;
	SEXP indices = VECTOR_ELT(index, i);
	gcontextFromgpar(currentgp, i, &gc);
	/* 
	 * Number of vertices
	 *
	 * Check in R code that x and y same length
	 */
	nx = LENGTH(indices); 
	/* Convert the x and y values to CM locations */
	vmax = vmaxget();
	xx = (double *) R_alloc(nx + 1, sizeof(double));
	yy = (double *) R_alloc(nx + 1, sizeof(double));
	xold = NA_REAL;
	yold = NA_REAL;
	for (j=0; j<nx; j++) {
	    transformLocn(x, y, INTEGER(indices)[j] - 1, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &(xx[j]), &(yy[j]));
	    /* The graphics engine only takes device coordinates
	     */
	    xx[j] = toDeviceX(xx[j], GE_INCHES, dd);
	    yy[j] = toDeviceY(yy[j], GE_INCHES, dd);
	    if ((R_FINITE(xx[j]) && R_FINITE(yy[j])) &&
		!(R_FINITE(xold) && R_FINITE(yold)))
		start = j; /* first point of current segment */
	    else if ((R_FINITE(xold) && R_FINITE(yold)) &&
		     !(R_FINITE(xx[j]) && R_FINITE(yy[j]))) {
		if (j-start > 1) {
		    GEPolygon(j-start, xx+start, yy+start, &gc, dd);
		}
	    }
	    else if ((R_FINITE(xold) && R_FINITE(yold)) && (j == nx-1)) { 
		/* last */
		GEPolygon(nx-start, xx+start, yy+start, &gc, dd);
	    }
	    xold = xx[j];
	    yold = yy[j];
	}
	vmaxset(vmax);
    }
    GEMode(0, dd);
    return R_NilValue;
}

SEXP L_circle(SEXP x, SEXP y, SEXP r)
{
    int i, nx, ny, nr;
    double xx, yy, rr1, rr2, rr;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    nx = unitLength(x); 
    ny = unitLength(y);
    nr = unitLength(r);
    if (ny > nx) 
	nx = ny;
    if (nr > nx)
	nx = nr;
    /* FIXME:  Need to check for NaN's and NA's
     */
    GEMode(1, dd);
    for (i=0; i<nx; i++) {
	gcontextFromgpar(currentgp, i, &gc);
	transformLocn(x, y, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd,
		      transform,
		      &xx, &yy);
	/* These two will give the same answer unless r is in "native",
	 * "npc", or some other relative units;  in those cases, just
	 * take the smaller of the two values.
	 */
	rr1 = transformWidthtoINCHES(r, i % nr, vpc, &gc,
				     vpWidthCM, vpHeightCM,
				     dd);
	rr2 = transformHeighttoINCHES(r, i % nr, vpc, &gc,
				      vpWidthCM, vpHeightCM,
				      dd);
	rr = fmin2(rr1, rr2);
	rr = toDeviceWidth(rr, GE_INCHES, dd);
	/*
	 * A negative radius is invalid
	 */
	if (rr < 0)
	    error("Invalid circle radius (must be non-negative)");
	/* The graphics engine only takes device coordinates
	 */
	xx = toDeviceX(xx, GE_INCHES, dd);
	yy = toDeviceY(yy, GE_INCHES, dd);
	if (R_FINITE(xx) && R_FINITE(yy) && R_FINITE(rr))
	    GECircle(xx, yy, rr, &gc, dd);
    }
    GEMode(0, dd);
    return R_NilValue;
}

/* We are assuming here that the R code has checked that 
 * x, y, w, and h are all unit objects and that vp is a viewport
 */
SEXP L_rect(SEXP x, SEXP y, SEXP w, SEXP h, SEXP just) 
{
    double xx, yy, ww, hh;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int i, ny, nw, nh, maxn;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    /* FIXME:  Need to check for x, y, w, h all same length
     */
    maxn = unitLength(x); 
    ny = unitLength(y); 
    nw = unitLength(w); 
    nh = unitLength(h); 
    if (ny > maxn)
	maxn = ny;
    if (nw > maxn)
	maxn = nw;
    if (nh > maxn)
	maxn = nh;
    GEMode(1, dd);
    for (i=0; i<maxn; i++) {
	gcontextFromgpar(currentgp, i, &gc);
	transformLocn(x, y, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd,
		      transform,
		      &xx, &yy);
	ww = transformWidthtoINCHES(w, i, vpc, &gc,
				    vpWidthCM, vpHeightCM,
				    dd);
	hh = transformHeighttoINCHES(h, i, vpc, &gc,
				     vpWidthCM, vpHeightCM,
				     dd);
	/* FIXME:  Need to check for NaN's and NA's
	 */
	/* If the total rotation angle is zero then we can draw a 
	 * rectangle as the devices understand rectangles
	 * Otherwise we have to draw a polygon equivalent.
	 */
	if (rotationAngle == 0) {
	    xx = justifyX(xx, ww, INTEGER(just)[0]);
	    yy = justifyY(yy, hh, INTEGER(just)[1]);
	    /* The graphics engine only takes device coordinates
	     */
	    xx = toDeviceX(xx, GE_INCHES, dd);
	    yy = toDeviceY(yy, GE_INCHES, dd);
	    ww = toDeviceWidth(ww, GE_INCHES, dd);
	    hh = toDeviceHeight(hh, GE_INCHES, dd);
	    if (R_FINITE(xx) && R_FINITE(yy) && R_FINITE(ww) && R_FINITE(hh))
		GERect(xx, yy, xx + ww, yy + hh, &gc, dd);
	} else {
	    /* We have to do a little bit of work to figure out where the 
	     * corners of the rectangle are.
	     */
	    double xxx[5], yyy[5], xadj, yadj;
	    double dw, dh;
	    SEXP temp = unit(0, L_INCHES);
	    SEXP www, hhh;
	    int tmpcol;
	    /* Find bottom-left location */
	    justification(ww, hh, INTEGER(just)[0], INTEGER(just)[1], 
			  &xadj, &yadj);
	    www = unit(xadj, L_INCHES);
	    hhh = unit(yadj, L_INCHES);
	    transformDimn(www, hhh, 0, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, rotationAngle,
			  &dw, &dh);
	    xxx[0] = xx + dw;
	    yyy[0] = yy + dh;
	    /* Find top-left location */
	    www = temp;
	    hhh = unit(hh, L_INCHES);
	    transformDimn(www, hhh, 0, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, rotationAngle,
			  &dw, &dh);
	    xxx[1] = xxx[0] + dw;
	    yyy[1] = yyy[0] + dh;
	    /* Find top-right location */
	    www = unit(ww, L_INCHES);
	    hhh = unit(hh, L_INCHES);
	    transformDimn(www, hhh, 0, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, rotationAngle,
			  &dw, &dh);
	    xxx[2] = xxx[0] + dw;
	    yyy[2] = yyy[0] + dh;
	    /* Find bottom-right location */
	    www = unit(ww, L_INCHES);
	    hhh = temp;
	    transformDimn(www, hhh, 0, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd, rotationAngle,
			  &dw, &dh);
	    xxx[3] = xxx[0] + dw;
	    yyy[3] = yyy[0] + dh;
	    if (R_FINITE(xxx[0]) && R_FINITE(yyy[0]) &&
		R_FINITE(xxx[1]) && R_FINITE(yyy[1]) &&
		R_FINITE(xxx[2]) && R_FINITE(yyy[2]) &&
		R_FINITE(xxx[3]) && R_FINITE(yyy[3])) {
		/* The graphics engine only takes device coordinates
		 */
		xxx[0] = toDeviceX(xxx[0], GE_INCHES, dd);
		yyy[0] = toDeviceY(yyy[0], GE_INCHES, dd);
		xxx[1] = toDeviceX(xxx[1], GE_INCHES, dd);
		yyy[1] = toDeviceY(yyy[1], GE_INCHES, dd);
		xxx[2] = toDeviceX(xxx[2], GE_INCHES, dd);
		yyy[2] = toDeviceY(yyy[2], GE_INCHES, dd);
		xxx[3] = toDeviceX(xxx[3], GE_INCHES, dd);
		yyy[3] = toDeviceY(yyy[3], GE_INCHES, dd);
		/* Close the polygon */
		xxx[4] = xxx[0];
		yyy[4] = yyy[0];
		/* Do separate fill and border to avoid border being 
		 * drawn on clipping boundary when there is a fill
		 */
		tmpcol = gc.col;
		gc.col = NA_INTEGER;
		GEPolygon(5, xxx, yyy, &gc, dd);
		gc.col = tmpcol;
		gc.fill = NA_INTEGER;
		GEPolygon(5, xxx, yyy, &gc, dd);
	    }
	}
    }
    GEMode(0, dd);
    return R_NilValue;
}

SEXP L_text(SEXP label, SEXP x, SEXP y, SEXP just, 
	    SEXP rot, SEXP checkOverlap)
{
    int i, nx, ny;
    double *xx, *yy;
    double hjust, vjust;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP txt;
    /* 
     * Bounding rectangles for checking overlapping
     * Initialised to shut up compiler
     */
    LRect *bounds = NULL;
    int numBounds = 0;
    int overlapChecking = LOGICAL(checkOverlap)[0];
    char *vmax;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    nx = unitLength(x); 
    ny = unitLength(y);
    if (ny > nx) 
	nx = ny;
    hjust = convertJust(INTEGER(just)[0]);
    vjust = convertJust(INTEGER(just)[1]);
    vmax = vmaxget();
    xx = (double *) R_alloc(nx, sizeof(double));
    yy = (double *) R_alloc(nx, sizeof(double));
    for (i=0; i<nx; i++) {
	gcontextFromgpar(currentgp, i, &gc);
	transformLocn(x, y, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd,
		      transform,
		      &(xx[i]), &(yy[i]));
    }
    /* The label can be a string or an expression
     */
    PROTECT(txt = label);
    if (isSymbol(txt) || isLanguage(txt))
	txt = coerceVector(txt, EXPRSXP);
    else if (!isExpression(txt))
	txt = coerceVector(txt, STRSXP);
    if (overlapChecking) {
	bounds = (LRect *) R_alloc(nx, sizeof(LRect));
    }
    /* 
     * Check we have any text to draw
     */
    if (LENGTH(txt) > 0) {
	GEMode(1, dd);
	for (i=0; i<nx; i++) {
	    int doDrawing = 1;
	    gcontextFromgpar(currentgp, i, &gc);
	    if (overlapChecking) {
		int j = 0;
		LRect trect;
		textRect(xx[i], yy[i], txt, i, &gc,
			 hjust, vjust, 
			 numeric(rot, i % LENGTH(rot)) + rotationAngle, 
			 dd, &trect);
		while (doDrawing && (j < numBounds)) 
		    if (intersect(trect, bounds[j++]))
			doDrawing = 0;
		if (doDrawing) {
		    copyRect(trect, &(bounds[numBounds]));
		    numBounds++;
		}
	    }
	    if (doDrawing) {
		/* FIXME:  Need to check for NaN's and NA's
		 */
		/* The graphics engine only takes device coordinates
		 */
		xx[i] = toDeviceX(xx[i], GE_INCHES, dd);
		yy[i] = toDeviceY(yy[i], GE_INCHES, dd);
		if (R_FINITE(xx[i]) && R_FINITE(yy[i])) {
		    gcontextFromgpar(currentgp, i, &gc);
		    if (isExpression(txt))
			GEMathText(xx[i], yy[i],
				   VECTOR_ELT(txt, i % LENGTH(txt)),
				   hjust, vjust, 
				   numeric(rot, i % LENGTH(rot)) + 
				   rotationAngle, 
				   &gc, dd);
		    else
			GEText(xx[i], yy[i], 
			       CHAR(STRING_ELT(txt, i % LENGTH(txt))), 
			       hjust, vjust, 
			       numeric(rot, i % LENGTH(rot)) + rotationAngle, 
			       &gc, dd);
		}
	    }
	}
	GEMode(0, dd);
    }
    vmaxset(vmax);
    UNPROTECT(1);
    return R_NilValue;    
}

SEXP L_points(SEXP x, SEXP y, SEXP pch, SEXP size)
{
    int i, nx, npch;
    /*    double *xx, *yy;*/
    double *xx, *yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    double symbolSize;
    char *vmax;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    nx = unitLength(x); 
    npch = LENGTH(pch);
    /* Convert the x and y values to CM locations */
    vmax = vmaxget();
    xx = (double *) R_alloc(nx, sizeof(double));
    yy = (double *) R_alloc(nx, sizeof(double));
    for (i=0; i<nx; i++) {
	gcontextFromgpar(currentgp, i, &gc);
	transformLocn(x, y, i, vpc, &gc,
		      vpWidthCM, vpHeightCM,
		      dd,
		      transform,
		      &(xx[i]), &(yy[i]));
	/* The graphics engine only takes device coordinates
	 */
	xx[i] = toDeviceX(xx[i], GE_INCHES, dd);
	yy[i] = toDeviceY(yy[i], GE_INCHES, dd);
    }
    GEMode(1, dd);
    for (i=0; i<nx; i++)
	if (R_FINITE(xx[i]) && R_FINITE(yy[i])) {
	    /* FIXME:  The symbols will not respond to viewport
	     * rotations !!!
	     */
	    int ipch;
	    gcontextFromgpar(currentgp, i, &gc);
	    symbolSize = transformWidthtoINCHES(size, i, vpc, &gc,
						vpWidthCM, vpHeightCM, dd);
	    /* The graphics engine only takes device coordinates
	     */
	    symbolSize = toDeviceWidth(symbolSize, GE_INCHES, dd);
	    if (R_FINITE(symbolSize)) {
		if (isString(pch))
		    ipch = CHAR(STRING_ELT(pch, i % npch))[0];
		else
		    ipch = INTEGER(pch)[i % npch];
		GESymbol(xx[i], yy[i], ipch, symbolSize, &gc, dd);
	    }
	}
    GEMode(0, dd);
    vmaxset(vmax);
    return R_NilValue;
}

SEXP L_pretty(SEXP scale) {
    double min = numeric(scale, 0);
    double max = numeric(scale, 1);
    double temp;
    /* FIXME:  This is just a dummy pointer because we do not have
     * log scales.  This will cause death and destruction if it is 
     * not addressed when log scales are added !
     */
    double *usr = NULL;
    double axp[3];
    /* FIXME:  Default preferred number of ticks hard coded ! */
    int n = 5;
    Rboolean swap = min > max;
    /* 
     * Feature: 
     * like R, something like  xscale = c(100,0)  just works 
     */
    if(swap) { 
	temp = min; min = max; max = temp;
    }

    GEPretty(&min, &max, &n);

    if(swap) {
	temp = min; min = max; max = temp;
    }

    axp[0] = min;
    axp[1] = max;
    axp[2] = n;
    /* FIXME:  "log" flag hard-coded to FALSE because we do not
     * have log scales yet
     */
    return CreateAtVector(axp, usr, n, FALSE);
}

/* 
 * NOTE: This does not go through the graphics engine, but
 * skips straight to the device to obtain a mouse click.
 * This is because I do not want to put a GELocator in the 
 * graphics engine;  that would be a crappy long term solution.
 * I will wait for a better event-loop/call-back solution before
 * doing something with the graphics engine.
 * This is a stop gap in the meantime.
 * 
 * The answer is in INCHES
 */
SEXP L_locator() {
    double x = 0;
    double y = 0;
    SEXP answer;
    /* Get the current device 
     */
    GEDevDesc *dd = getDevice();
    PROTECT(answer = allocVector(REALSXP, 2));
    /*
     * Get a mouse click
     * Fails if user did not click mouse button 1
     */
    if (dd->dev->locator(&x, &y, dd->dev)) {
	REAL(answer)[0] = fromDeviceX(x, GE_INCHES, dd);
	REAL(answer)[1] = fromDeviceY(y, GE_INCHES, dd);
    } else {
	REAL(answer)[0] = NA_REAL;
	REAL(answer)[1] = NA_REAL;	
    }
    UNPROTECT(1);
    return answer;
}

