/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 2001-3 Paul Murrell
 *                2003-2019 The R 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.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  https://www.R-project.org/Licenses/
 */


#define GRID_MAIN
#include "grid.h"
#include <math.h>
#include <float.h>
#include <string.h>

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

void getDeviceSize(pGEDevDesc 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) > 1e-6) {
	result = TRUE;
	REAL(pvpDevWidthCM)[0] = devWidthCM;
	SET_VECTOR_ELT(currentvp, PVP_DEVWIDTHCM, pvpDevWidthCM);
    }
    if (fabs(REAL(pvpDevHeightCM)[0] - devHeightCM) > 1e-6) {
	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.)
 */
pGEDevDesc getDevice() 
{
    return GEcurrentDevice();
}

/* If this is the first time that a grid operation has occurred for 
 * this device, do some initialisation.
 */
void dirtyGridDevice(pGEDevDesc 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, dd);
	    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 
     */
    pGEDevDesc dd = getDevice();
    dirtyGridDevice(dd);
    return R_NilValue;
}

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

SEXP L_currentViewport() 
{
    /* Get the current device 
     */
    pGEDevDesc 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,
		   pGEDevDesc 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(installTrChar(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 &&
            rotationAngle != 90 &&
            rotationAngle != 270 &&
            rotationAngle != 360) {
	    warning(_("cannot clip to rotated viewport"));
            /* Still need to set clip region for this viewport.
               So "inherit" parent clip region.
               In other words, 'clip=TRUE' + 'rot=15' = 'clip=FALSE'
            */
            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);
        } 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, dd);
	    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);
        /* If we are revisiting a viewport that inherits a clip
         * region from a parent viewport, we may need to reset 
         * the clip region (at worst, we generate a redundant clip)
         */
        if (!pushing) {
	    GESetClip(xx1, yy1, xx2, yy2, dd);
        }
    }
    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 invp, SEXP hasParent)
{
    SEXP vp;
    SEXP pushedvp, fcall;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    /*
     * Duplicate the viewport passed in because we are going
     * to modify it to hell and gone.
     */
    PROTECT(vp = duplicate(invp));
    /* 
     * Call R function pushedvp() 
     */
    PROTECT(fcall = lang2(install("pushedvp"),
			  vp));
    PROTECT(pushedvp = eval(fcall, R_gridEvalEnv)); 
    pushedvp = doSetViewport(pushedvp, !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, pushedvp);
    UNPROTECT(3);
    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(childnames);
    PROTECT(result);
    while (count < n && !found) {
	result = findViewport(name, strict,
			      PROTECT(findVar(installTrChar(STRING_ELT(childnames, count)),
				      children)),
			      depth);
	found = INTEGER(VECTOR_ELT(result, 0))[0] > 0;
	UNPROTECT(1);
	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(2);
    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(installTrChar(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 
     */
    pGEDevDesc 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);    
    } else {
        /* Important to have an error here, rather than back in
         * R code AFTER this point.  Otherwise, an unsuccessful
         * downViewport() will be recorded on the engine DL!
         */
        char msg[1024];
        snprintf(msg, 1024, "Viewport '%s' was not found", 
		 CHAR(STRING_ELT(name, 0)));
        UNPROTECT(1);    
        error(_(msg));
    }
    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(childnames);
    PROTECT(result);
    while (count < n && !found) {
	SEXP vp, newpathsofar;
	PROTECT(vp = findVar(installTrChar(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(2);
    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(installTrChar(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 
     */
    pGEDevDesc 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);    
    } else {
        /* Important to have an error here, rather than back in
         * R code AFTER this point.  Otherwise, an unsuccessful
         * downViewport() will be recorded on the engine DL!
         */
        char msg[1024];
        snprintf(msg, 1024, "Viewport '%s' was not found", 
		 CHAR(STRING_ELT(name, 0)));
        UNPROTECT(1);    
        error(_(msg));
    }
    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 n)
{
    int i;
    double xx1, yy1, xx2, yy2;
    double devWidthCM, devHeightCM;
    SEXP parentClip;
    /* Get the current device 
     */
    pGEDevDesc 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)
     */
    SEXP newvp = VECTOR_ELT(gvp, PVP_PARENT);
    if (isNull(newvp))
	error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)"));
    for (i = 1; i < INTEGER(n)[0]; i++) {
	gvp = newvp;
	newvp = VECTOR_ELT(gvp, PVP_PARENT);
	if (isNull(newvp))
	    error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)"));
    }
    /* 
     * 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.
     */
    PROTECT(gvp); PROTECT(newvp);
    {
	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); /* false, fcall */
    }
    /* Get the current device size 
     */
    getDeviceSize(dd, &devWidthCM, &devHeightCM);
    if (deviceChanged(devWidthCM, devHeightCM, newvp))
	calcViewportTransform(newvp, viewportParent(newvp), 1, dd);
    /* 
     * Enforce the current viewport settings
     */
    setGridStateElement(dd, GSS_GPAR, viewportgpar(newvp));
    /* 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);
    /* 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);
    /* 
     * 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)
     *
     * NOTE: Do NOT do this any earlier or you will
     * remove the PROTECTive benefit of newvp pointing
     * to part of the (global) grid state
     */
    SET_VECTOR_ELT(gvp, PVP_PARENT, R_NilValue);
    UNPROTECT(2); /* gvp, newvp */
    return R_NilValue;
}

/* This is similar to L_unsetviewport, except that it will NOT 
 * modify parent-child relations 
 */
SEXP L_upviewport(SEXP n)
{
    int i;
    double xx1, yy1, xx2, yy2;
    double devWidthCM, devHeightCM;
    SEXP parentClip;
    /* Get the current device 
     */
    pGEDevDesc 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);
    SEXP newvp = VECTOR_ELT(gvp, PVP_PARENT);
    if (isNull(newvp))
	error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)"));
    for (i = 1; i < INTEGER(n)[0]; i++) {
	gvp = newvp;
	newvp = VECTOR_ELT(gvp, PVP_PARENT);
	if (isNull(newvp))
	    error(_("cannot pop the top-level viewport ('grid' and 'graphics' output mixed?)"));
    }
    /* Get the current device size 
     */
    getDeviceSize(dd, &devWidthCM, &devHeightCM);
    if (deviceChanged(devWidthCM, devHeightCM, newvp))
	calcViewportTransform(newvp, viewportParent(newvp), 1, dd);
    /* 
     * Enforce the stored parent gpar settings
     * (not necessarily the parent viewport settings if this viewport
     *  is a childrenvp of a gTree, where the gTree has gpar settings)
     */
    setGridStateElement(dd, GSS_GPAR, VECTOR_ELT(gvp, PVP_PARENTGPAR));
    /* 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);
#if 0
	    /* 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); 
#endif
    /* 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);
    return R_NilValue;
}

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

SEXP L_setDisplayList(SEXP dl) 
{
    /* Get the current device 
     */
    pGEDevDesc 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 
     */
    pGEDevDesc 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 
     */
    pGEDevDesc 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 
     */
    pGEDevDesc dd = getDevice();
    return gridStateElement(dd, GSS_DLINDEX);
}

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

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

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

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

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

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

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

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

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

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

SEXP L_newpagerecording()
{
    pGEDevDesc dd = getDevice();
    if (dd->ask) {
	NewFrameConfirm(dd->dev);
	/*
	 * User may have killed device during pause for prompt
	 */
	if (NoDevices())
	    error(_("attempt to plot on null device"));
	else
	    /* 
	     * Should throw an error if dd != GECurrentDevice ?
	     */
	    dd = GEcurrentDevice();
    }
    GEinitDisplayList(dd);
    return R_NilValue;
}

SEXP L_newpage()
{
    pGEDevDesc dd = getDevice();
    R_GE_gcontext gc;
    /* 
     * Has the device been drawn on yet?
     */
    Rboolean deviceDirty = GEdeviceDirty(dd);
    /*
     * Has the device been drawn on BY GRID yet?
     */
    Rboolean deviceGridDirty = LOGICAL(gridStateElement(dd, 
							GSS_GRIDDEVICE))[0];
    /*
     * Initialise grid on device
     * If no drawing on device yet, does a new page
     */
    if (!deviceGridDirty) {
        dirtyGridDevice(dd);
    } 
    /*
     * If device has previously been drawn on (by grid or other system)
     * do a new page
     */
    if (deviceGridDirty || deviceDirty) {
	SEXP currentgp = gridStateElement(dd, GSS_GPAR);
	gcontextFromgpar(currentgp, 0, &gc, dd);
	GENewPage(&gc, dd);
    }
    return R_NilValue;
}

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

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

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

void getViewportTransform(SEXP currentvp, 
			  pGEDevDesc 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;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    int TOunit, FROMaxis, TOaxis;
    Rboolean relConvert;
    /* 
     * Get the current device 
     */
    pGEDevDesc 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);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    nx = unitLength(x);
    PROTECT(answer = allocVector(REALSXP, nx));
    for (i=0; i<nx; i++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
        TOunit = INTEGER(unitto)[i % LENGTH(unitto)];
        FROMaxis = INTEGER(whatfrom)[0];
        TOaxis = INTEGER(whatto)[0];
        /* 
         * Special case: FROM unit is just a plain, relative unit AND
         *               TO unit is relative AND
         *               NOT converting from 'x' to 'y' (or vice versa) ...
         * 
         *               ... AND relevant widthCM or heightCM is zero
         *
         * In these cases do NOT transform thru INCHES 
         * (to avoid divide-by-zero, but still do something useful)
         */
        relConvert = ((unitUnit(x, i) == L_NATIVE || unitUnit(x, i) == L_NPC) &&
                      (TOunit == L_NATIVE || TOunit == L_NPC) &&
                      ((FROMaxis == TOaxis) ||
                       (FROMaxis == 0 && TOaxis == 2) ||
                       (FROMaxis == 2 && TOaxis == 0) ||
                       (FROMaxis == 1 && TOaxis == 3) ||
                       (FROMaxis == 3 && TOaxis == 1)));
        /* 
         * First, convert the unit object passed in to a value in INCHES
         * (within the current viewport)
         */
        switch (FROMaxis) {
        case 0:
            if (relConvert && vpWidthCM < 1e-6) {
                REAL(answer)[i] = 
                    transformXYtoNPC(unitValue(x, i), unitUnit(x, i),
                                     vpc.xscalemin, vpc.xscalemax);
            } else {
                relConvert = FALSE;
                REAL(answer)[i] = 
                    transformXtoINCHES(x, i, vpc, &gc,
                                       vpWidthCM, vpHeightCM, 
                                       dd);
            }
            break;
        case 1:
            if (relConvert && vpHeightCM < 1e-6) {
                REAL(answer)[i] = 
                    transformXYtoNPC(unitValue(x, i), unitUnit(x, i),
                                     vpc.yscalemin, vpc.yscalemax);
            } else {
                relConvert = FALSE;
                REAL(answer)[i] = 
                    transformYtoINCHES(x, i, vpc, &gc,
                                       vpWidthCM, vpHeightCM, 
                                       dd);
            }
            break;
        case 2:
            if (relConvert && vpWidthCM < 1e-6) {
                REAL(answer)[i] = 
                    transformWHtoNPC(unitValue(x, i), unitUnit(x, i),
                                     vpc.xscalemin, vpc.xscalemax);
            } else {
                relConvert = FALSE;
                REAL(answer)[i] = 
                    transformWidthtoINCHES(x, i, vpc, &gc,
                                           vpWidthCM, vpHeightCM, 
                                           dd);
            }
            break;
        case 3:
            if (relConvert && vpHeightCM < 1e-6) {
                REAL(answer)[i] = 
                    transformWHtoNPC(unitValue(x, i), unitUnit(x, i),
                                     vpc.yscalemin, vpc.yscalemax);
            } else {
                relConvert = FALSE;
                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)
         *
         * BUT do NOT do this step for the special "relConvert" case
         */
        switch (TOaxis) {
        case 0:
            if (relConvert) {
                REAL(answer)[i] = transformXYfromNPC(REAL(answer)[i], TOunit,
                                                     vpc.xscalemin,
                                                     vpc.xscalemax);
            } else {
                REAL(answer)[i] = 
                    transformXYFromINCHES(REAL(answer)[i], TOunit,
                                          vpc.xscalemin,
                                          vpc.xscalemax,
                                          &gc,
                                          vpWidthCM, vpHeightCM, 
                                          dd);
            }
            break;
        case 1:
            if (relConvert) {
                REAL(answer)[i] = transformXYfromNPC(REAL(answer)[i], TOunit,
                                                     vpc.yscalemin,
                                                     vpc.yscalemax);
            } else {
                REAL(answer)[i] = 
                    transformXYFromINCHES(REAL(answer)[i], TOunit,
                                          vpc.yscalemin,
                                          vpc.yscalemax,
                                          &gc,
                                          vpHeightCM, vpWidthCM, 
                                          dd);
            }
            break;
        case 2:
            if (relConvert) {
                REAL(answer)[i] = transformWHfromNPC(REAL(answer)[i], TOunit,
                                                     vpc.xscalemin,
                                                     vpc.xscalemax);
            } else {
                REAL(answer)[i] = 
                    transformWidthHeightFromINCHES(REAL(answer)[i], TOunit,
                                                   vpc.xscalemin,
                                                   vpc.xscalemax,
                                                   &gc,
                                                   vpWidthCM, vpHeightCM, 
                                                   dd);
            }
            break;
        case 3:
            if (relConvert) {
                REAL(answer)[i] = transformWHfromNPC(REAL(answer)[i], TOunit,
                                                     vpc.yscalemin,
                                                     vpc.yscalemax);
            } else {
                REAL(answer)[i] = 
                    transformWidthHeightFromINCHES(REAL(answer)[i], TOunit,
                                                   vpc.yscalemin,
                                                   vpc.yscalemax,
                                                   &gc,
                                                   vpHeightCM, vpWidthCM, 
                                                   dd);
                break;
            }
        }
    }
    UNPROTECT(1);
    return answer;
}

/*
 * Convert locations or dimensions to device inches
 */
SEXP L_devLoc(SEXP x, SEXP y) {
    double xx, yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP devx, devy, result;
    SEXP currentvp, currentgp;
    int i, maxn, ny;
    /* Get the current device 
     */
    pGEDevDesc 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, dd);
    /* Convert the x and y values to device inches locations */
    maxn = unitLength(x); 
    ny = unitLength(y); 
    if (ny > maxn)
	maxn = ny;
    PROTECT(devx = allocVector(REALSXP, maxn));
    PROTECT(devy = allocVector(REALSXP, maxn));
    PROTECT(result = allocVector(VECSXP, 2));
    for (i=0; i<maxn; i++) {
        transformLocn(x, y, i, vpc, &gc,
                      vpWidthCM, vpHeightCM,
                      dd,
                      transform,
                      &xx, &yy);
        REAL(devx)[i] = xx;
        REAL(devy)[i] = yy;
    }
    SET_VECTOR_ELT(result, 0, devx);
    SET_VECTOR_ELT(result, 1, devy);
    UNPROTECT(3);
    return result;
}

SEXP L_devDim(SEXP x, SEXP y) {
    double xx, yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP devx, devy, result;
    SEXP currentvp, currentgp;
    int i, maxn, ny;
    /* Get the current device 
     */
    pGEDevDesc 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, dd);
    /* Convert the x and y values to device inches locations */
    maxn = unitLength(x); 
    ny = unitLength(y); 
    if (ny > maxn)
	maxn = ny;
    PROTECT(devx = allocVector(REALSXP, maxn));
    PROTECT(devy = allocVector(REALSXP, maxn));
    PROTECT(result = allocVector(VECSXP, 2));
    for (i=0; i<maxn; i++) {
        transformDimn(x, y, i, vpc, &gc,
                      vpWidthCM, vpHeightCM,
                      dd, rotationAngle,
                      &xx, &yy);
        REAL(devx)[i] = xx;
        REAL(devy)[i] = yy;
    }
    SET_VECTOR_ELT(result, 0, devx);
    SET_VECTOR_ELT(result, 1, devy);
    UNPROTECT(3);
    return result;
}

/*
 * 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;
    /* 
     * Get the current device 
     */
    pGEDevDesc 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;
}

/***************************
 * EDGE DETECTION 
 ***************************
 */

/*
 * Calculate the point on the edge of a rectangle at angle theta
 * 0 = East, 180 = West, etc ...
 * Assumes that x- and y-values are in INCHES
 * Assumes that theta is within [0, 360)
 */
static void rectEdge(double xmin, double ymin, double xmax, double ymax,
		     double theta,
		     double *edgex, double *edgey) 
{
    double xm = (xmin + xmax)/2;
    double ym = (ymin + ymax)/2;
    double dx = (xmax - xmin)/2;
    double dy = (ymax - ymin)/2;
    /*
     * FIXME: Special case 0 width or 0 height
     */
    /*
     * Special case angles 
     */
    if (theta == 0) {
	*edgex = xmax;
	*edgey = ym;
    } else if (theta == 270) {
	*edgex = xm;
	*edgey = ymin;
    } else if (theta == 180) {
	*edgex = xmin;
	*edgey = ym;
    } else if (theta == 90) {
	*edgex = xm;
	*edgey = ymax;
    } else {
	double cutoff = dy/dx;
	double angle = theta/180*M_PI;
	double tanTheta = tan(angle);
	double cosTheta = cos(angle);
	double sinTheta = sin(angle);
	if (fabs(tanTheta) < cutoff) { /* Intersect with side */
	    if (cosTheta > 0) { /* Right side */
		*edgex = xmax;
		*edgey = ym + tanTheta*dx;
	    } else { /* Left side */
		*edgex = xmin;
		*edgey = ym - tanTheta*dx;
	    }
	} else { /* Intersect with top/bottom */
	    if (sinTheta > 0) { /* Top */
		*edgey = ymax;
		*edgex = xm + dy/tanTheta;
	    } else { /* Bottom */
		*edgey = ymin;
		*edgex = xm - dy/tanTheta;
	    }
	}
    }
}

/*
 * Calculate the point on the edge of a rectangle at angle theta
 * 0 = East, 180 = West, etc ...
 * Assumes that x- and y-values are in INCHES
 * Assumes that theta is within [0, 360)
 */
static void circleEdge(double x, double y, double r,
		       double theta,
		       double *edgex, double *edgey)
{
    double angle = theta/180*M_PI;
    *edgex = x + r*cos(angle);
    *edgey = y + r*sin(angle);
}

/*
 * Calculate the point on the edge of a *convex* polygon at angle theta
 * 0 = East, 180 = West, etc ...
 * Assumes that x- and y-values are in INCHES
 * Assumes that vertices are in clock-wise order
 * Assumes that theta is within [0, 360)
 */
static void polygonEdge(double *x, double *y, int n,
			double theta,
			double *edgex, double *edgey) {
    int i, v1, v2;
    double xm, ym;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    int found = 0;
    double angle = theta/180*M_PI;
    double vangle1, vangle2;
    /*
     * Find "centre" of polygon
     */
    for (i=0; i<n; i++) {
	if (x[i] < xmin)
	    xmin = x[i];
	if (x[i] > xmax)
	    xmax = x[i];
	if (y[i] < ymin)
	    ymin = y[i];
	if (y[i] > ymax)
	    ymax = y[i];
    }
    xm = (xmin + xmax)/2;
    ym = (ymin + ymax)/2;
    /*
     * Special case zero-width or zero-height
     */ 
    if (fabs(xmin - xmax) < 1e-6) {
        *edgex = xmin;
        if (theta == 90) 
	    *edgey = ymax;
	else if (theta == 270)
	    *edgey = ymin;
	else
	    *edgey = ym;
	return;
    }
    if (fabs(ymin - ymax) < 1e-6) {
        *edgey = ymin;
        if (theta == 0) 
	    *edgex = xmax;
	else if (theta == 180)
	    *edgex = xmin;
	else
	    *edgex = xm;
	return;
    }	    
    /*
     * Find edge that intersects line from centre at angle theta
     */
    for (i=0; i<n; i++) {
	v1 = i;
	v2 = v1 + 1;
	if (v2 == n)
	    v2 = 0;
	/*
	 * Result of atan2 is in range -PI, PI so convert to
	 * 0, 360 to correspond to angle
	 */
	vangle1 = atan2(y[v1] - ym, x[v1] - xm);
	if (vangle1 < 0)
	    vangle1 = vangle1 + 2*M_PI;
	vangle2 = atan2(y[v2] - ym, x[v2] - xm);
	if (vangle2 < 0)
	    vangle2 = vangle2 + 2*M_PI;
	/*
	 * If vangle1 < vangle2 then angles are either side of 0
	 * so check is more complicated
	 */
	if ((vangle1 >= vangle2 && 
	     vangle1 >= angle && vangle2 <= angle) || 
	    (vangle1 < vangle2 && 
	     ((vangle1 >= angle && 0 <= angle) ||
	      (vangle2 <= angle && 2*M_PI >= angle)))) {
	    found = 1;
	    break;
	}
    }
    /*
     * Find intersection point of "line from centre to bounding rect"
     * and edge
     */
    if (found) {
	double x1 = xm;
	double y1 = ym;
	double x2, y2;
	double x3 = x[v1];
	double y3 = y[v1];
	double x4 = x[v2];
	double y4 = y[v2];
	double numa, denom, ua;
	rectEdge(xmin, ymin, xmax, ymax, theta,
		 &x2, &y2);
	numa = ((x4 - x3)*(y1 - y3) - (y4 - y3)*(x1 - x3));
	denom = ((y4 - y3)*(x2 - x1) - (x4 - x3)*(y2 - y1));
	ua = numa/denom;
	if (!R_FINITE(ua)) {
	    /*
	     * Should only happen if lines are parallel, which 
	     * shouldn't happen!  Unless, perhaps the polygon has
	     * zero extent vertically or horizontally ... ?
	     */
	    error(_("polygon edge not found (zero-width or zero-height?)"));
	}
	/*
	 * numb = ((x2 - x1)*(y1 - y3) - (y2 - y1)*(x1 - x3));
	 * ub = numb/denom;
	 */
	*edgex = x1 + ua*(x2 - x1);
	*edgey = y1 + ua*(y2 - y1);
    } else {
	error(_("polygon edge not found"));    
    }
}

/*
 * Given a set of points, calculate the convex hull then
 * find the edge of that hull
 *
 * NOTE:  assumes that 'grDevices' package has been loaded 
 * so that chull() is available (grid depends on grDevices)
 */
static void hullEdge(double *x, double *y, int n,
		     double theta,
		     double *edgex, double *edgey) 
{
    const void *vmax;
    int i, nh;
    double *hx, *hy;
    SEXP xin, yin, chullFn, R_fcall, hull;    
    int adjust = 0;
    double *xkeep, *ykeep;
    vmax = vmaxget();
    /* Remove any NA's because chull() can't cope with them */
    xkeep = (double *) R_alloc(n, sizeof(double));
    ykeep = (double *) R_alloc(n, sizeof(double));
    for (i=0; i<n; i++) {
        if (!R_FINITE(x[i]) || !R_FINITE(y[i])) {
            adjust--;
        } else {
            xkeep[i + adjust] = x[i];
            ykeep[i + adjust] = y[i];
        }
    }
    n = n + adjust;
    PROTECT(xin = allocVector(REALSXP, n));
    PROTECT(yin = allocVector(REALSXP, n));
    for (i=0; i<n; i++) {
        REAL(xin)[i] = xkeep[i];
        REAL(yin)[i] = ykeep[i];
    }
    /*
     * Determine convex hull
     */
    PROTECT(chullFn = findFun(install("chull"), R_gridEvalEnv));
    PROTECT(R_fcall = lang3(chullFn, xin, yin));
    PROTECT(hull = eval(R_fcall, R_gridEvalEnv));
    nh = LENGTH(hull);
    hx = (double *) R_alloc(nh, sizeof(double));
    hy = (double *) R_alloc(nh, sizeof(double));
    for (i=0; i<nh; i++) {
	hx[i] = x[INTEGER(hull)[i] - 1];
	hy[i] = y[INTEGER(hull)[i] - 1];
    }
    /*
     * Find edge of that hull
     */
    polygonEdge(hx, hy, nh, theta, 
		edgex, edgey);
    vmaxset(vmax);
    UNPROTECT(5);
}

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

/*
 * Draw an arrow head, given the vertices of the arrow head.
 * Assume vertices are in DEVICE coordinates.
 */
static void drawArrow(double *x, double *y, SEXP type, int i,
		      const pGEcontext gc, pGEDevDesc dd) 
{
    int nt = LENGTH(type);
    switch (INTEGER(type)[i % nt]) {
    case 1:
	GEPolyline(3, x, y, gc, dd);
	break;
    case 2:
	GEPolygon(3, x, y, gc, dd);
	break;
    }
}

/*
 * Calculate vertices for drawing an arrow head.
 * Assumes that x and y locations are in INCHES.
 * Returns vertices in DEVICE coordinates.
 */
static void calcArrow(double x1, double y1,
		      double x2, double y2,
		      SEXP angle, SEXP length, int i,
		      LViewportContext vpc,
		      double vpWidthCM, double vpHeightCM,
		      double *vertx, double *verty,
		      const pGEcontext gc, pGEDevDesc dd) 
{
    int na = LENGTH(angle);
    int nl = LENGTH(length);
    double xc, yc, rot;
    double l1, l2, l, a;
    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];
    xc = x2 - x1;
    yc = y2 - y1;
    rot= atan2(yc, xc);
    vertx[0] = toDeviceX(x1 + l * cos(rot+a),
			 GE_INCHES, dd);
    verty[0] = toDeviceY(y1 + l * sin(rot+a),
			 GE_INCHES, dd);
    vertx[1] = toDeviceX(x1, 
			 GE_INCHES, dd);
    verty[1] = toDeviceY(y1,
			 GE_INCHES, dd);
    vertx[2] = toDeviceX(x1 + l * cos(rot-a),
			 GE_INCHES, dd);
    verty[2] = toDeviceY(y1 + l * sin(rot-a),
			 GE_INCHES, dd);
}

/*
 * Assumes x and y are at least length 2
 * Also assumes x and y are in DEVICE coordinates
 */
static void arrows(double *x, double *y, int n,
		   SEXP arrow, int i,
		   /*
		    * Which ends we are allowed to draw arrow heads on
		    * (we may be drawing a line segment that has been
		    *  broken by NAs)
		    */
		   Rboolean start, Rboolean end,
		   LViewportContext vpc,
		   double vpWidthCM, double vpHeightCM,
		   const pGEcontext gc, pGEDevDesc dd) 
{
    /*
     * Write a checkArrow() function to make
     * sure 'a' is a valid arrow description ?
     * If someone manages to sneak in a
     * corrupt arrow description ... BOOM!
     */			
    SEXP ends = VECTOR_ELT(arrow, GRID_ARROWENDS);
    int ne = LENGTH(ends);
    double vertx[3], verty[3];
    Rboolean first, last;
    if (n < 2)
	error(_("require at least two points to draw arrow"));
    first = TRUE;
    last = TRUE;
    switch (INTEGER(ends)[i % ne]) {
    case 2: 
	first = FALSE;
	break;
    case 1:
	last = FALSE;
	break;
    }
    if (first && start) {
	calcArrow(fromDeviceX(x[0], GE_INCHES, dd),
		  fromDeviceY(y[0], GE_INCHES, dd),
		  fromDeviceX(x[1], GE_INCHES, dd),
		  fromDeviceY(y[1], GE_INCHES, dd),
		  VECTOR_ELT(arrow, GRID_ARROWANGLE), 
		  VECTOR_ELT(arrow, GRID_ARROWLENGTH),
		  i, vpc, vpWidthCM, vpHeightCM, vertx, verty, gc, dd);
	drawArrow(vertx, verty, 
		  VECTOR_ELT(arrow, GRID_ARROWTYPE), i, 
		  gc, dd);
    } 
    if (last && end) {
	calcArrow(fromDeviceX(x[n - 1], GE_INCHES, dd),
		  fromDeviceY(y[n - 1], GE_INCHES, dd),
		  fromDeviceX(x[n - 2], GE_INCHES, dd),
		  fromDeviceY(y[n - 2], GE_INCHES, dd),
		  VECTOR_ELT(arrow, GRID_ARROWANGLE), 
		  VECTOR_ELT(arrow, GRID_ARROWLENGTH),
		  i, vpc, vpWidthCM, vpHeightCM, vertx, verty, gc, dd);
	drawArrow(vertx, verty, 
		  VECTOR_ELT(arrow, GRID_ARROWTYPE), i, 
		  gc, dd);
    }
}

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 
     */
    pGEDevDesc 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, dd);
    /* 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, SEXP arrow)
{
    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 
     */
    pGEDevDesc 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, dd);
    /* 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);
	if (!isNull(arrow)) {
	    double ax[2], ay[2];
	    ax[0] = xx0;
	    ax[1] = xx1;
	    ay[0] = yy0;
	    ay[1] = yy1;
	    arrows(ax, ay, 2,
		   arrow, 0, TRUE, TRUE, 
		   vpc, vpWidthCM, vpHeightCM, &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, SEXP index, SEXP arrow) 
{
    int i, j, nx, nl, start=0;
    double *xx, *yy;
    double xold, yold;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    const void *vmax;
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    GEMode(1, dd);
    /* 
     * Number of lines 
     */
    nl = LENGTH(index);
    for (j=0; j<nl; j++) {
	SEXP indices = VECTOR_ELT(index, j);
        updateGContext(currentgp, j, &gc, dd, gpIsScalar, &gcCache);
	/* 
	 * Number of vertices
	 *
	 * x and y same length forced in R code 
	 */
	nx = LENGTH(indices); 
	/* 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));
	xold = NA_REAL;
	yold = NA_REAL;
	for (i=0; i<nx; i++) {
	    transformLocn(x, y, INTEGER(indices)[i] - 1, 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);
		    if (!isNull(arrow)) {
		        /*
			 * Can draw an arrow at the start if the points
			 * include the first point.
			 * CANNOT draw an arrow at the end point 
			 * because we have just broken the line for an NA.
			 */
		        arrows(xx+start, yy+start, i-start,
			       arrow, j, start == 0, FALSE,
			       vpc, vpWidthCM, vpHeightCM, &gc, dd);
		    }
		}
	    }
	    else if ((R_FINITE(xold) && R_FINITE(yold)) &&
		     (i == nx-1)) {
	        GEPolyline(nx-start, xx+start, yy+start, &gc, dd);
		if (!isNull(arrow)) {
		    /*
		     * Can draw an arrow at the start if the points
		     * include the first point.
		     * Can draw an arrow at the end point.
		     */
 		    arrows(xx+start, yy+start, nx-start, 
			   arrow, j, start == 0, TRUE,
			   vpc, vpWidthCM, vpHeightCM, &gc, dd);
		}
	    } 
	    xold = xx[i];
	    yold = yy[i];
	}
	vmaxset(vmax);
    }
    GEMode(0, dd);
    return R_NilValue;
}

/* We are assuming here that the R code has checked that x and y 
 * are unit objects 
 */
SEXP gridXspline(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, SEXP index,
		 double theta, Rboolean draw, Rboolean trace) 
{
    int i, j, nx, np, nloc;
    double *xx, *yy, *ss;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP tracePts = R_NilValue;
    SEXP result = R_NilValue;
    double edgex, edgey;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    /* 
     * Number of xsplines
     */
    np = LENGTH(index);
    PROTECT(tracePts = allocVector(VECSXP, np));
    nloc = 0;
    for (i=0; i<np; i++) {
	const void *vmax;
	SEXP indices = VECTOR_ELT(index, i);
	SEXP points;
	updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	/* 
	 * 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();
	if (draw)
	    GEMode(1, dd);
	xx = (double *) R_alloc(nx, sizeof(double));
	yy = (double *) R_alloc(nx, sizeof(double));
	ss = (double *) R_alloc(nx, sizeof(double));
	for (j=0; j<nx; j++) {
	    ss[j] = REAL(s)[(INTEGER(indices)[j] - 1) % LENGTH(s)];
	    /*
	     * If drawing, convert to INCHES on device
	     * If just calculating bounds, convert to INCHES within current vp
	     */
	    if (draw) {
		transformLocn(x, y, INTEGER(indices)[j] - 1, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd,
			      transform,
			      &(xx[j]), &(yy[j]));
	    } else {
		xx[j] = transformXtoINCHES(x, INTEGER(indices)[j] - 1,
					   vpc, &gc,
					   vpWidthCM, vpHeightCM, 
					   dd);
		yy[j] = transformYtoINCHES(y, INTEGER(indices)[j] - 1,
					   vpc, &gc,
					   vpWidthCM, vpHeightCM, 
					   dd);	    
	    }
	    /* 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]))) {
		    error(_("non-finite control point in Xspline"));
	    }
	}
	PROTECT(points = GEXspline(nx, xx, yy, ss,
				   LOGICAL(o)[0], LOGICAL(rep)[0],
				   draw, &gc, dd));
        {
            /*
             * In some cases, GEXspline seems to produce identical points 
             * (at least observed at end of spline)
             * so trim identical points from the ends 
             * (so arrow heads are drawn at correct angle)
             */
            int np = LENGTH(VECTOR_ELT(points, 0));
            double *px = REAL(VECTOR_ELT(points, 0));
            double *py = REAL(VECTOR_ELT(points, 1));
            int start = 0;
            int end = np - 1;
            /*
             * DEBUGGING ...
             int k;
             for (k=0; k<np; k++) {
             GESymbol(px[k], py[k], 16, 3, &gc, dd); 
             }
	     * ... DEBUGGING
	     */
	    while (np > 1 && 
		   (px[start] == px[start + 1]) &&
		   (py[start] == py[start + 1])) {
		start++;
		np--;
	    }
	    while (np > 1 && 
		   (px[end] == px[end - 1]) &&
		   (py[end] == py[end - 1])) {
		end--;
		np--;
	    }
            if (trace) {
                int k;
                int count = end - start + 1;
                double *keepXptr, *keepYptr;
                SEXP keepPoints, keepX, keepY;
                PROTECT(keepPoints = allocVector(VECSXP, 2));
                PROTECT(keepX = allocVector(REALSXP, count));
                PROTECT(keepY = allocVector(REALSXP, count));
                keepXptr = REAL(keepX);
                keepYptr = REAL(keepY);
                for (k=start; k<(end + 1); k++) {
                    keepXptr[k - start] = fromDeviceX(px[k], GE_INCHES, dd);
                    keepYptr[k - start] = fromDeviceY(py[k], GE_INCHES, dd);
                }
                SET_VECTOR_ELT(keepPoints, 0, keepX);
                SET_VECTOR_ELT(keepPoints, 1, keepY);
                SET_VECTOR_ELT(tracePts, i, keepPoints);
                UNPROTECT(3); /* keepPoints & keepX & keepY */
            }
            if (draw && !isNull(a) && !isNull(points)) {
                /*
                 * Can draw an arrow at the either end.
                 */
                arrows(&(px[start]), &(py[start]), np,
                       a, i, TRUE, TRUE,
                       vpc, vpWidthCM, vpHeightCM, &gc, dd);
            }
            if (!draw && !trace && !isNull(points)) {
                /*
                 * Update bounds
                 */
                int j, n = LENGTH(VECTOR_ELT(points, 0));
                double *pxx = (double *) R_alloc(n, sizeof(double));
                double *pyy = (double *) R_alloc(n, sizeof(double));
                for (j=0; j<n; j++) {
                    pxx[j] = fromDeviceX(px[j], GE_INCHES, dd);
                    pyy[j] = fromDeviceY(py[j], GE_INCHES, dd);
                    if (R_FINITE(pxx[j]) && R_FINITE(pyy[j])) {
                        if (pxx[j] < xmin)
                            xmin = pxx[j];
                        if (pxx[j] > xmax)
                            xmax = pxx[j];
                        if (pyy[j] < ymin)
                            ymin = pyy[j];
                        if (pyy[j] > ymax)
                            ymax = pyy[j];
                        nloc++;
                    }
                }
                /*
                 * Calculate edgex and edgey for case where this is 
                 * the only xspline
                 */
                hullEdge(pxx, pyy, n, theta, &edgex, &edgey);
            }
        } /* End of trimming-redundant-points code */
	UNPROTECT(1); /* points */
	if (draw)
	    GEMode(0, dd);
	vmaxset(vmax);
    }
    if (!draw && !trace && nloc > 0) {
	PROTECT(result = allocVector(REALSXP, 4));
	/*
	 * If there is more than one xspline, just produce edge
	 * based on bounding rect of all xsplines
	 */
	if (np > 1) {
	    rectEdge(xmin, ymin, xmax, ymax, theta,
		     &edgex, &edgey);
	}
	/*
	 * Reverse the scale adjustment (zoom factor)
	 * when calculating physical value to return to user-level
	 */
	REAL(result)[0] = edgex / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[1] = edgey / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[2] = (xmax - xmin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[3] = (ymax - ymin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
        UNPROTECT(1); /* result */
    } else if (trace) {
        result = tracePts;
    }
    UNPROTECT(1); /* tracePts */
    return result;
}

SEXP L_xspline(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, SEXP index) 
{
    gridXspline(x, y, s, o, a, rep, index, 0, TRUE, FALSE);
    return R_NilValue;
}

SEXP L_xsplineBounds(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, 
		     SEXP index, SEXP theta) 
{
    return gridXspline(x, y, s, o, a, rep, index, REAL(theta)[0], 
                       FALSE, FALSE);
}

SEXP L_xsplinePoints(SEXP x, SEXP y, SEXP s, SEXP o, SEXP a, SEXP rep, 
		     SEXP index, SEXP theta) 
{
    return gridXspline(x, y, s, o, a, rep, index, REAL(theta)[0], 
                       FALSE, TRUE);
}

SEXP L_segments(SEXP x0, SEXP y0, SEXP x1, SEXP y1, SEXP arrow) 
{
    int i, nx0, ny0, nx1, ny1, maxn;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    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;
    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	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);
	    if (!isNull(arrow)) {
		double ax[2], ay[2];
		ax[0] = xx0;
		ax[1] = xx1;
		ay[0] = yy0;
		ay[1] = yy1;
		arrows(ax, ay, 2,
		       arrow, i, TRUE, TRUE,
		       vpc, vpWidthCM, vpHeightCM, &gc, dd);
	    }
	}
    }
    GEMode(0, dd);
    return R_NilValue;
}

static int getArrowN(SEXP x1, SEXP x2, SEXP xnm1, SEXP xn, 
		     SEXP y1, SEXP y2, SEXP ynm1, SEXP yn)
{      
    int 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(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 ne;
    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 
     */
    pGEDevDesc 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);
    ne = LENGTH(ends);
    /* 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 xx1, xx2, xxnm1, xxn, yy1, yy2, yynm1, yyn;
	double vertx[3];
	double verty[3];
	first = TRUE;
	last = TRUE;
	switch (INTEGER(ends)[i % ne]) {
	case 2: 
	    first = FALSE;
	    break;
	case 1:
	    last = FALSE;
	    break;
	}
	gcontextFromgpar(currentgp, i, &gc, dd);
	/*
	 * 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);
	    calcArrow(xx1, yy1, xx2, yy2, angle, length, i,
		      vpc, vpWidthCM, vpHeightCM,
		      vertx, verty, &gc, 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, type, i, &gc, 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);
	    calcArrow(xxn, yyn, xxnm1, yynm1, angle, length, i,
		      vpc, vpWidthCM, vpHeightCM,
		      vertx, verty, &gc, 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, type, i, &gc, 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;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    GEMode(1, dd);
    /* 
     * Number of polygons 
     */
    np = LENGTH(index);
    for (i=0; i<np; i++) {
	const void *vmax;
	SEXP indices = VECTOR_ELT(index, i);
	updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	/* 
	 * 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;
}

static SEXP gridCircle(SEXP x, SEXP y, SEXP r, 
		       double theta, Rboolean draw)
{
    int i, nx, ny, nr, ncirc;
    double xx, yy, rr1, rr2, rr = 0.0 /* -Wall */;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP result = R_NilValue;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    double edgex, edgey;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    nx = unitLength(x); 
    ny = unitLength(y);
    nr = unitLength(r);
    if (ny > nx) 
	nx = ny;
    if (nr > nx)
	nx = nr;
    if (draw) {
	GEMode(1, dd);
    }
    ncirc = 0;
    for (i=0; i<nx; i++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	/*
	 * If drawing, convert to INCHES on device
	 * If just calculating bounds, convert to INCHES within current vp
	 */
	if (draw) {
	    transformLocn(x, y, i, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &xx, &yy);
	} else {
	    xx = transformXtoINCHES(x, i, vpc, &gc,
				    vpWidthCM, vpHeightCM, 
				    dd);
	    yy = transformYtoINCHES(y, i, vpc, &gc,
				    vpWidthCM, vpHeightCM, 
				    dd);	    
	}
	/* 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);
	/*
	 * A negative radius is silently converted to absolute value
	 */
	rr = fmin2(fabs(rr1), fabs(rr2));
	if (R_FINITE(xx) && R_FINITE(yy) && R_FINITE(rr)) {
	    if (draw) {
                /* The graphics engine only takes device coordinates
		 */
                xx = toDeviceX(xx, GE_INCHES, dd);
		yy = toDeviceY(yy, GE_INCHES, dd);
		rr = toDeviceWidth(rr, GE_INCHES, dd);
		GECircle(xx, yy, rr, &gc, dd);
	    } else {
		if (xx + rr < xmin)
		    xmin = xx + rr;
		if (xx + rr > xmax)
		    xmax = xx + rr;
		if (xx - rr < xmin)
		    xmin = xx - rr;
		if (xx - rr > xmax)
		    xmax = xx - rr;
		if (yy + rr < ymin)
		    ymin = yy + rr;
		if (yy + rr > ymax)
		    ymax = yy + rr;
		if (yy - rr < ymin)
		    ymin = yy - rr;
		if (yy - rr > ymax)
		    ymax = yy - rr;
		ncirc++;		
	    }
	}
    }
    if (draw) {
	GEMode(0, dd);
    } else if (ncirc > 0) {
	result = allocVector(REALSXP, 4);
	if (ncirc == 1) {
	    /*
	     * Produce edge of actual circle
	     */
	    circleEdge(xx, yy, rr, theta, &edgex, &edgey);
	} else {
	    /*
	     * Produce edge of rect bounding all circles
	     */
	    rectEdge(xmin, ymin, xmax, ymax, theta,
		     &edgex, &edgey);
	}
	/*
	 * Reverse the scale adjustment (zoom factor)
	 * when calculating physical value to return to user-level
	 */
	REAL(result)[0] = edgex / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[1] = edgey /
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[2] = (xmax - xmin) /
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[3] = (ymax - ymin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
    } 
    return result;
}

SEXP L_circle(SEXP x, SEXP y, SEXP r)
{
    gridCircle(x, y, r, 0, TRUE);
    return R_NilValue;
}

SEXP L_circleBounds(SEXP x, SEXP y, SEXP r, SEXP theta)
{
    return gridCircle(x, y, r, REAL(theta)[0], FALSE);
}

/* 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
 */
static SEXP gridRect(SEXP x, SEXP y, SEXP w, SEXP h, 
		     SEXP hjust, SEXP vjust, double theta, Rboolean draw) 
{
    double xx, yy, ww, hh;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    int i, ny, nw, nh, maxn, nrect;
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP result = R_NilValue;
    double edgex, edgey;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    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;
    if (draw) {
	GEMode(1, dd);
    }
    nrect = 0;
    for (i=0; i<maxn; i++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	/*
	 * If drawing, convert to INCHES on device
	 * If just calculating bounds, convert to INCHES within current vp
	 */
	if (draw) {	
	    transformLocn(x, y, i, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &xx, &yy);
	} else {
	    xx = transformXtoINCHES(x, i, vpc, &gc,
				    vpWidthCM, vpHeightCM, 
				    dd);
	    yy = transformYtoINCHES(y, i, vpc, &gc,
				    vpWidthCM, vpHeightCM, 
				    dd);	    
	}
	ww = transformWidthtoINCHES(w, i, vpc, &gc,
				    vpWidthCM, vpHeightCM,
				    dd);
	hh = transformHeighttoINCHES(h, i, vpc, &gc,
				     vpWidthCM, vpHeightCM,
				     dd);
	/* 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 (draw) {
	    if (rotationAngle == 0) {
		xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]);
		yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]);
		/* 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 zeroInches, xadjInches, yadjInches, wwInches, hhInches;
		int tmpcol;
                PROTECT(zeroInches = unit(0, L_INCHES));
		/* Find bottom-left location */
		justification(ww, hh, 
			      REAL(hjust)[i % LENGTH(hjust)], 
			      REAL(vjust)[i % LENGTH(vjust)], 
			      &xadj, &yadj);
		PROTECT(xadjInches = unit(xadj, L_INCHES));
		PROTECT(yadjInches = unit(yadj, L_INCHES));
		transformDimn(xadjInches, yadjInches, 0, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd, rotationAngle,
			      &dw, &dh);
		xxx[0] = xx + dw;
		yyy[0] = yy + dh;
		/* Find top-left location */
		PROTECT(hhInches = unit(hh, L_INCHES));
		transformDimn(zeroInches, hhInches, 0, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd, rotationAngle,
			      &dw, &dh);
		xxx[1] = xxx[0] + dw;
		yyy[1] = yyy[0] + dh;
		/* Find top-right location */
		PROTECT(wwInches = unit(ww, L_INCHES));
		transformDimn(wwInches, hhInches, 0, vpc, &gc,
			      vpWidthCM, vpHeightCM,
			      dd, rotationAngle,
			      &dw, &dh);
		xxx[2] = xxx[0] + dw;
		yyy[2] = yyy[0] + dh;
		/* Find bottom-right location */
		transformDimn(wwInches, zeroInches, 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 = R_TRANWHITE;
		    GEPolygon(5, xxx, yyy, &gc, dd);
		    gc.col = tmpcol;
		    gc.fill = R_TRANWHITE;
		    GEPolygon(5, xxx, yyy, &gc, dd);
		}
                UNPROTECT(5);
	    }
	} else { /* Just calculating boundary */
	    xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]);
	    yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]);
	    if (R_FINITE(xx) && R_FINITE(yy) && 
		R_FINITE(ww) && R_FINITE(hh)) {
		if (xx < xmin)
		    xmin = xx;
		if (xx > xmax)
		    xmax = xx;
		if (xx + ww < xmin)
		    xmin = xx + ww;
		if (xx + ww > xmax)
		    xmax = xx + ww;
		if (yy < ymin)
		    ymin = yy;
		if (yy > ymax)
		    ymax = yy;
		if (yy + hh < ymin)
		    ymin = yy + hh;
		if (yy + hh > ymax)
		    ymax = yy + hh;
		/*
		 * Calculate edgex and edgey for case where this is 
		 * the only rect
		 */
		rectEdge(xx, yy, xx + ww, yy + hh, theta,
			 &edgex, &edgey);
		nrect++;
	    }
	}
    }
    if (draw) {
	GEMode(0, dd);
    }
    if (nrect > 0) {
	result = allocVector(REALSXP, 4);
	/*
	 * If there is more than one rect, just produce edge
	 * based on bounding rect of all rects
	 */
	if (nrect > 1) {
	    rectEdge(xmin, ymin, xmax, ymax, theta,
		     &edgex, &edgey);
	}
	/*
	 * Reverse the scale adjustment (zoom factor)
	 * when calculating physical value to return to user-level
	 */
	REAL(result)[0] = edgex / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[1] = edgey /
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[2] = (xmax - xmin) /
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[3] = (ymax - ymin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
    } 
    return result;
}

SEXP L_rect(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust) 
{
    gridRect(x, y, w, h, hjust, vjust, 0, TRUE);
    return R_NilValue;    
}

SEXP L_rectBounds(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust,
		  SEXP theta) 
{
    return gridRect(x, y, w, h, hjust, vjust, REAL(theta)[0], FALSE);
}

/* FIXME: need to add L_pathBounds ? */

SEXP L_path(SEXP x, SEXP y, SEXP index, SEXP rule)
{
    int i, j, k, h, npoly, *nper, ntot;
    double *xx, *yy;
    const void *vmax;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    GEMode(1, dd);
    /*
     * Iterate over all paths
     */
    for (h = 0; h < LENGTH(index); h++) {
    	SEXP polyInd = VECTOR_ELT(index, h);
    	/* 
    	 * Number of polygons 
    	 */
    	npoly = LENGTH(polyInd);
    	/* 
    	 * Total number of points and 
    	 * Number of points per polygon
    	 */ 
    	ntot = 0;
    	nper = (int *) R_alloc(npoly, sizeof(int));
    	for (i=0; i < npoly; i++) {
    		nper[i] = LENGTH(VECTOR_ELT(polyInd, i));
    		ntot = ntot + nper[i];
    	}
    	vmax = vmaxget();
    	xx = (double *) R_alloc(ntot, sizeof(double));
    	yy = (double *) R_alloc(ntot, sizeof(double));
    	k = 0;
    	for (i=0; i < npoly; i++) {
            int *indices = INTEGER(VECTOR_ELT(polyInd, i));
            for (j=0; j < nper[i]; j++) {            
                transformLocn(x, y, indices[j] - 1, vpc, &gc,
                              vpWidthCM, vpHeightCM,
                              dd,
                              transform,
                              &(xx[k]), &(yy[k]));
                /* The graphics engine only takes device coordinates
                 */
                xx[k] = toDeviceX(xx[k], GE_INCHES, dd);
                yy[k] = toDeviceY(yy[k], GE_INCHES, dd);
                /* NO NA values allowed in 'x' or 'y'
                 */
                if (!R_FINITE(xx[k]) || !R_FINITE(yy[k]))
                    error(_("non-finite x or y in graphics path"));
                k++;
            }
    	}
    	updateGContext(currentgp, h, &gc, dd, gpIsScalar, &gcCache);
    	GEPath(xx, yy, npoly, nper, INTEGER(rule)[0], &gc, dd);
    	vmaxset(vmax);
    }
    GEMode(0, dd);
    return R_NilValue;
}

/* FIXME: need to add L_rasterBounds */

/* FIXME:  Add more checks on correct inputs,
   e.g., Raster should be a matrix of R colors */
SEXP L_raster(SEXP raster, SEXP x, SEXP y, SEXP w, SEXP h, 
              SEXP hjust, SEXP vjust, SEXP interpolate)
{
    const void *vmax;
    int i, n, ny, nw, nh, maxn;
    double xx, yy, ww, hh;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP dim;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    unsigned int *image;
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    /* Convert the raster matrix to R internal colours */
    n = LENGTH(raster);
    if (n <= 0) {
        error(_("Empty raster"));  
    }
    vmax = vmaxget();
    /* raster is rather inefficient so allow a native representation as
       an integer array which requires no conversion */
    if (inherits(raster, "nativeRaster") && isInteger(raster)) {
	image = (unsigned int*) INTEGER(raster);
    } else {
        image = (unsigned int*) R_alloc(n, sizeof(unsigned int));
        for (i=0; i<n; i++) {
            image[i] = RGBpar3(raster, i, R_TRANWHITE);
        }
    }
    dim = getAttrib(raster, R_DimSymbol);
    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++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
        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);
        if (rotationAngle == 0) {
            xx = justifyX(xx, ww, REAL(hjust)[i % LENGTH(hjust)]);
            yy = justifyY(yy, hh, REAL(vjust)[i % LENGTH(vjust)]);
            /* 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))
                GERaster(image, INTEGER(dim)[1], INTEGER(dim)[0],
                         xx, yy, ww, hh, rotationAngle, 
                         LOGICAL(interpolate)[i % LENGTH(interpolate)], 
                         &gc, dd);
        } else {
            /* We have to do a little bit of work to figure out where the 
             * bottom-left corner of the image is.
             */
            double xbl, ybl, xadj, yadj;
            double dw, dh;
            SEXP xadjInches, yadjInches;
            /* Find bottom-left location */
            justification(ww, hh, 
                          REAL(hjust)[i % LENGTH(hjust)], 
                          REAL(vjust)[i % LENGTH(vjust)], 
                          &xadj, &yadj);
            PROTECT(xadjInches = unit(xadj, L_INCHES));
            PROTECT(yadjInches = unit(yadj, L_INCHES));
            transformDimn(xadjInches, yadjInches, 0, vpc, &gc,
                          vpWidthCM, vpHeightCM,
                          dd, rotationAngle,
                          &dw, &dh);
            xbl = xx + dw;
            ybl = yy + dh;
            xbl = toDeviceX(xbl, GE_INCHES, dd);
            ybl = toDeviceY(ybl, GE_INCHES, dd);
            ww = toDeviceWidth(ww, GE_INCHES, dd);
            hh = toDeviceHeight(hh, GE_INCHES, dd);
            if (R_FINITE(xbl) && R_FINITE(ybl) &&
                R_FINITE(ww) && R_FINITE(hh)) {
                /* The graphics engine only takes device coordinates
                 */
                GERaster(image, INTEGER(dim)[1], INTEGER(dim)[0],
                         xbl, ybl, ww, hh, rotationAngle, 
                         LOGICAL(interpolate)[i % LENGTH(interpolate)], 
                         &gc, dd);
            }
            UNPROTECT(2);
        }
    }
    GEMode(0, dd);
    vmaxset(vmax);
    return R_NilValue;
}

SEXP L_cap()
{
    int i, col, row, nrow, ncol, size;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    int *rint;
    SEXP raster; 
    /* The raster is R internal colours, so convert to 
     * R external colours (strings) 
     * AND the raster is BY ROW so need to rearrange it
     * to be BY COLUMN (though the dimensions are correct) */
    SEXP image, idim;
    
    PROTECT(raster = GECap(dd));
    /* Non-complying devices will return NULL */
    if (isNull(raster)) {
        image = raster;
    } else {
        size = LENGTH(raster);
        nrow = INTEGER(getAttrib(raster, R_DimSymbol))[0];
        ncol = INTEGER(getAttrib(raster, R_DimSymbol))[1];
        
        PROTECT(image = allocVector(STRSXP, size));
        rint = INTEGER(raster);
        for (i=0; i<size; i++) {
            col = i % ncol + 1;
            row = i / ncol + 1;
            SET_STRING_ELT(image, (col - 1)*nrow + row - 1, 
                           mkChar(col2name(rint[i])));
        }
        
        PROTECT(idim = allocVector(INTSXP, 2));
        INTEGER(idim)[0] = nrow;
        INTEGER(idim)[1] = ncol;
        setAttrib(image, R_DimSymbol, idim);
        
        UNPROTECT(2);
    }
    UNPROTECT(1);
    return image;
}

/*
 * Code to draw OR size text
 * Combined to avoid code replication
 */
static SEXP gridText(SEXP label, SEXP x, SEXP y, SEXP hjust, SEXP vjust, 
		     SEXP rot, SEXP checkOverlap, double theta, Rboolean draw)
{
    int i, nx, ny;
    double *xx, *yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP txt, result = R_NilValue;
    double edgex, edgey;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    /* 
     * Bounding rectangles for checking overlapping
     * Initialised to shut up compiler
     */
    LRect *bounds = NULL;
    LRect trect;
    int numBounds = 0;
    int overlapChecking = LOGICAL(checkOverlap)[0];
    const void *vmax;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    nx = unitLength(x); 
    ny = unitLength(y);
    if (ny > nx) 
	nx = ny;
    vmax = vmaxget();
    xx = (double *) R_alloc(nx, sizeof(double));
    yy = (double *) R_alloc(nx, sizeof(double));
    for (i=0; i<nx; i++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	/*
	 * If drawing, convert to INCHES on device
	 * If just calculating bounds, convert to INCHES within current vp
	 */
	if (draw) {	
	    transformLocn(x, y, i, vpc, &gc,
			  vpWidthCM, vpHeightCM,
			  dd,
			  transform,
			  &(xx[i]), &(yy[i]));
	} else {
	    xx[i] = transformXtoINCHES(x, i, vpc, &gc,
				       vpWidthCM, vpHeightCM, 
				       dd);
	    yy[i] = transformYtoINCHES(y, i, vpc, &gc,
				       vpWidthCM, vpHeightCM, 
				       dd);	    
	}
    }
    /* 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);
    UNPROTECT(1);
    PROTECT(txt);
    if (overlapChecking || !draw) {
	bounds = (LRect *) R_alloc(nx, sizeof(LRect));
    }
    /* 
     * Check we have any text to draw
     */
    if (LENGTH(txt) > 0) {
	int ntxt = 0;
	if (draw) {
	    /*
	     * Drawing text
	     */
	    GEMode(1, dd);
	}
	for (i=0; i<nx; i++) {
	    int doDrawing = 1;
	    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	    /* 
	     * Generate bounding boxes when checking for overlap
	     * or sizing text
	     */
	    if (overlapChecking || !draw) {
		int j = 0;
		textRect(xx[i], yy[i], txt, i, &gc,
			 REAL(hjust)[i % LENGTH(hjust)], 
			 REAL(vjust)[i % LENGTH(vjust)], 
			 /*
			  * When calculating bounding rect for text
			  * only consider rotation of text within 
			  * local context, not relative to device
			  * (so don't add rotationAngle)
			  */
			 numeric(rot, i % LENGTH(rot)), 
			 dd, &trect);
		while (doDrawing && (j < numBounds)) 
		    if (intersect(trect, bounds[j++]))
			doDrawing = 0;
		if (doDrawing) {
		    copyRect(trect, &(bounds[numBounds]));
		    numBounds++;
		}
	    }
	    if (draw && doDrawing) {
		/* 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])) {
		    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
		    if (isExpression(txt))
			GEMathText(xx[i], yy[i],
				   VECTOR_ELT(txt, i % LENGTH(txt)),
				   REAL(hjust)[i % LENGTH(hjust)], 
				   REAL(vjust)[i % LENGTH(vjust)], 
				   numeric(rot, i % LENGTH(rot)) + 
				   rotationAngle, 
				   &gc, dd);
		    else
			GEText(xx[i], yy[i], 
			       CHAR(STRING_ELT(txt, i % LENGTH(txt))),
			       (gc.fontface == 5) ? CE_SYMBOL :
			       getCharCE(STRING_ELT(txt, i % LENGTH(txt))),
			       REAL(hjust)[i % LENGTH(hjust)], 
			       REAL(vjust)[i % LENGTH(vjust)], 
			       numeric(rot, i % LENGTH(rot)) + 
			       rotationAngle, 
			       &gc, dd);
		}
	    }
	    if (!draw) {
		double minx, maxx, miny, maxy;
		/*
		 * Sizing text
		 */
		if (R_FINITE(xx[i]) && R_FINITE(yy[i])) {
		    minx = fmin2(trect.x1, 
				 fmin2(trect.x2, 
				       fmin2(trect.x3, trect.x4)));
		    if (minx < xmin)
			xmin = minx;
		    maxx = fmax2(trect.x1, 
				 fmax2(trect.x2, 
				       fmax2(trect.x3, trect.x4)));
		    if (maxx > xmax)
			xmax = maxx;
		    miny = fmin2(trect.y1, 
				 fmin2(trect.y2, 
				       fmin2(trect.y3, trect.y4)));
		    if (miny < ymin)
			ymin = miny;
		    maxy = fmax2(trect.y1, 
				 fmax2(trect.y2, 
				       fmax2(trect.y3, trect.y4)));
		    if (maxy > ymax)
			ymax = maxy;
		    /*
		     * Calculate edgex and edgey for case where this is 
		     * the only rect
		     */
		    {
			double xxx[4], yyy[4];
			/*
			 * Must be in clock-wise order for polygonEdge
			 */
			xxx[0] = trect.x4; yyy[0] = trect.y4;
			xxx[1] = trect.x3; yyy[1] = trect.y3;
			xxx[2] = trect.x2; yyy[2] = trect.y2;
			xxx[3] = trect.x1; yyy[3] = trect.y1;
			polygonEdge(xxx, yyy, 4, theta,
				    &edgex, &edgey);
		    }
		    ntxt++;
		}
	    }
	}
	if (draw) {
	    GEMode(0, dd);
	}
	if (ntxt > 0) {
	    result = allocVector(REALSXP, 4);
	    /*
	     * If there is more than one text, just produce edge
	     * based on bounding rect of all text
	     */
	    if (ntxt > 1) {
		/*
		 * Produce edge of rect bounding all text
		 */
		rectEdge(xmin, ymin, xmax, ymax, theta,
			 &edgex, &edgey);
	    }
	    /*
	     * Reverse the scale adjustment (zoom factor)
	     * when calculating physical value to return to user-level
	     */
	    REAL(result)[0] = edgex / 
		REAL(gridStateElement(dd, GSS_SCALE))[0];
	    REAL(result)[1] = edgey / 
		REAL(gridStateElement(dd, GSS_SCALE))[0];
	    REAL(result)[2] = (xmax - xmin) / 
		REAL(gridStateElement(dd, GSS_SCALE))[0];
	    REAL(result)[3] = (ymax - ymin) / 
		REAL(gridStateElement(dd, GSS_SCALE))[0];
	}
    }
    vmaxset(vmax);
    UNPROTECT(1);
    return result;
}

SEXP L_text(SEXP label, SEXP x, SEXP y, SEXP hjust, SEXP vjust, 
	    SEXP rot, SEXP checkOverlap)
{
    gridText(label, x, y, hjust, vjust, rot, checkOverlap, 0, TRUE);
    return R_NilValue;    
}

/*
 * Return four values representing boundary of text (which may consist
 * of multiple pieces of text, unaligned, and/or rotated) 
 * in INCHES.
 *
 * Result is (xmin, xmax, ymin, ymax)
 *
 * Return NULL if no text to draw;  R code will generate unit from that
 */
SEXP L_textBounds(SEXP label, SEXP x, SEXP y, 
		  SEXP hjust, SEXP vjust, SEXP rot, SEXP theta)
{
    SEXP checkOverlap = allocVector(LGLSXP, 1);
    LOGICAL(checkOverlap)[0] = FALSE;
    return gridText(label, x, y, hjust, vjust, rot, checkOverlap, 
		    REAL(theta)[0], FALSE);
}

SEXP L_points(SEXP x, SEXP y, SEXP pch, SEXP size)
{
    int i, nx, npch, nss;
    /*    double *xx, *yy;*/
    double *xx, *yy, *ss;
    int *ps;
    int pType;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    double symbolSize;
    const void *vmax;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    nx = unitLength(x); 
    npch = LENGTH(pch);
    /*
     * Need to take vector gpar elements into account that may affect unit size 
     * calculations
     */
    nss = unitLength(size) * LENGTH(VECTOR_ELT(currentgp, GP_FONTSIZE)) * 
        LENGTH(VECTOR_ELT(currentgp, GP_CEX)) * 
        LENGTH(VECTOR_ELT(currentgp, GP_LINEHEIGHT));
    nss = nss > nx ? nx : nss;
    /* 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++) {
	updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	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);
    }
    ss = (double *) R_alloc(nss, sizeof(double));
    for (i=0; i < nss; i++) {
        updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
        ss[i] = transformWidthtoINCHES(size, i, vpc, &gc,
                                       vpWidthCM, vpHeightCM, dd);
        ss[i] = toDeviceWidth(ss[i], GE_INCHES, dd);
    }
    ps = (int *) R_alloc(npch, sizeof(int));
    if (isString(pch)) pType = 0;
    else if (isInteger(pch)) pType = 1;
    else if (isReal(pch)) pType = 2;
    else pType = 3;
    for (i=0; i < npch; i++) {
        switch (pType) {
        case 0:
            /* 
             * FIXME:
             * Resolve any differences between this and FixupPch()
             * in plot.c ? 
             */
            ps[i] = GEstring_to_pch(STRING_ELT(pch, i));
            break;
        case 1:
            ps[i] = INTEGER(pch)[i];
            break;
        case 2:
            ps[i] = R_FINITE(REAL(pch)[i]) ? (int) REAL(pch)[i] : NA_INTEGER;
            break;
        }
    }
    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 = NA_INTEGER /* -Wall */;
	    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	    symbolSize = ss[i % nss];
	    if (R_FINITE(symbolSize)) {
	        if (pType == 3) {
	            error(_("invalid plotting symbol"));
	        }
	        ipch = ps[i % npch];
	        /*
	         * special case for pch = "."
	         */
	        if (ipch == 46) symbolSize = gpCex(currentgp, i);
            /*
             * FIXME: 
             * For character-based symbols, we need to modify
             * gc->cex so that the FONT size corresponds to
             * the specified symbolSize.
             */
	        GESymbol(xx[i], yy[i], ipch, symbolSize, &gc, dd);
	    }
	}
    GEMode(0, dd);
    vmaxset(vmax);
    return R_NilValue;
}

SEXP L_clip(SEXP x, SEXP y, SEXP w, SEXP h, SEXP hjust, SEXP vjust) 
{
    double xx, yy, ww, hh;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    LViewportContext vpc;
    R_GE_gcontext gc;
    LTransform transform;
    SEXP currentvp, currentgp, currentClip;
    /* Get the current device 
     */
    pGEDevDesc 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);
    /*
     * Only set ONE clip rectangle (i.e., NOT vectorised)
     */
    gcontextFromgpar(currentgp, 0, &gc, dd);
    transformLocn(x, y, 0, vpc, &gc,
		  vpWidthCM, vpHeightCM,
		  dd,
		  transform,
		  &xx, &yy);
    ww = transformWidthtoINCHES(w, 0, vpc, &gc,
				vpWidthCM, vpHeightCM,
				dd);
    hh = transformHeighttoINCHES(h, 0, vpc, &gc,
				 vpWidthCM, vpHeightCM,
				 dd);
    /* 
     * We can ONLY clip if the total rotation angle is zero.
     */
    if (rotationAngle == 0) {
        xx = justifyX(xx, ww, REAL(hjust)[0]);
	yy = justifyY(yy, hh, REAL(vjust)[0]);
	/* 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)) {
	    GESetClip(xx, yy, xx + ww, yy + hh, dd);
	    /*
	     * ALSO set the current clip region for the 
	     * current viewport so that, if a viewport
	     * is pushed within the current viewport,
	     * when that viewport gets popped again,
	     * the clip region returns to what was set
	     * by THIS clipGrob (NOT to the current
	     * viewport's previous setting)
	     */
	    PROTECT(currentClip = allocVector(REALSXP, 4));
	    REAL(currentClip)[0] = xx;
	    REAL(currentClip)[1] = yy;
	    REAL(currentClip)[2] = xx + ww;
	    REAL(currentClip)[3] = yy + hh;
	    SET_VECTOR_ELT(currentvp, PVP_CLIPRECT, currentClip);
	    UNPROTECT(1);
	}
    } else {
        warning(_("unable to clip to rotated rectangle"));
    }
    GEMode(0, dd);
    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 Rf_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 
     */
    pGEDevDesc dd = getDevice();
    GEMode(2, dd);
    PROTECT(answer = allocVector(REALSXP, 2));
    /*
     * Get a mouse click
     * Fails if user did not click mouse button 1
     */
    if(dd->dev->locator && 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;	
    }
    GEMode(0, dd);
    UNPROTECT(1);
    return answer;
}

/*
 * ****************************************
 * Calculating boundaries of primitives
 *
 * ****************************************
 */

/*
 * Return four values representing boundary of set of locations
 * in INCHES.
 *
 * Result is (xmin, xmax, ymin, ymax)
 *
 * Used for lines, segments, polygons
 */
SEXP L_locnBounds(SEXP x, SEXP y, SEXP theta)
{
    int i, nx, ny, nloc;
    double *xx, *yy;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP result = R_NilValue;
    const void *vmax;
    double xmin = DOUBLE_XMAX;
    double xmax = -DOUBLE_XMAX;
    double ymin = DOUBLE_XMAX;
    double ymax = -DOUBLE_XMAX;
    double edgex, edgey;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    nx = unitLength(x); 
    ny = unitLength(y);
    if (ny > nx) 
	nx = ny;
    nloc = 0;
    vmax = vmaxget();
    if (nx > 0) {
	xx = (double *) R_alloc(nx, sizeof(double));
	yy = (double *) R_alloc(nx, sizeof(double));
	for (i=0; i<nx; i++) {
	    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
	    xx[i] = transformXtoINCHES(x, i, vpc, &gc,
				       vpWidthCM, vpHeightCM, 
				       dd);
	    yy[i] = transformYtoINCHES(y, i, vpc, &gc,
				       vpWidthCM, vpHeightCM, 
				       dd);
	    /*
	     * Determine min/max x/y values
	     */
	    if (R_FINITE(xx[i]) && R_FINITE(yy[i])) {
		if (xx[i] < xmin)
		    xmin = xx[i];
		if (xx[i] > xmax)
		    xmax = xx[i];
		if (yy[i] < ymin)
		    ymin = yy[i];
		if (yy[i] > ymax)
		    ymax = yy[i];
		nloc++;
	    }
	}
    }
    if (nloc > 0) {
	hullEdge(xx, yy, nx, REAL(theta)[0], &edgex, &edgey);
	result = allocVector(REALSXP, 4);
	/*
	 * Reverse the scale adjustment (zoom factor)
	 * when calculating physical value to return to user-level
	 */
	REAL(result)[0] = edgex / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[1] = edgey / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[2] = (xmax - xmin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
	REAL(result)[3] = (ymax - ymin) / 
	    REAL(gridStateElement(dd, GSS_SCALE))[0];
    } 
    vmaxset(vmax);
    return result;
}

/*
 * ****************************************
 * Calculating text metrics
 *
 * ****************************************
 */
SEXP L_stringMetric(SEXP label)
{
    int i, n;
    double vpWidthCM, vpHeightCM;
    double rotationAngle;
    int gpIsScalar[15] = {-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1};
    LViewportContext vpc;
    R_GE_gcontext gc, gcCache;
    LTransform transform;
    SEXP currentvp, currentgp;
    SEXP txt;
    SEXP result = R_NilValue;
    SEXP ascent = R_NilValue;
    SEXP descent = R_NilValue;
    SEXP width = R_NilValue;
    const void *vmax;
    double asc, dsc, wid;
    /* Get the current device 
     */
    pGEDevDesc dd = getDevice();
    currentvp = gridStateElement(dd, GSS_VP);
    currentgp = gridStateElement(dd, GSS_GPAR);
    getViewportTransform(currentvp, dd, 
			 &vpWidthCM, &vpHeightCM, 
			 transform, &rotationAngle);
    getViewportContext(currentvp, &vpc);
    initGContext(currentgp, &gc, dd, gpIsScalar, &gcCache);
    /* The label can be a string or an expression: is protected.
     */
    txt = label;
    if (isSymbol(txt) || isLanguage(txt))
	txt = coerceVector(txt, EXPRSXP);
    else if (!isExpression(txt))
	txt = coerceVector(txt, STRSXP);
    PROTECT(txt);
    n = LENGTH(txt);
    vmax = vmaxget();
    PROTECT(ascent = allocVector(REALSXP, n));
    PROTECT(descent = allocVector(REALSXP, n));
    PROTECT(width = allocVector(REALSXP, n));
    if (n > 0) {
	for (i=0; i<n; i++) {
	    updateGContext(currentgp, i, &gc, dd, gpIsScalar, &gcCache);
            if (isExpression(txt))
                GEExpressionMetric(VECTOR_ELT(txt, i % LENGTH(txt)), &gc, 
                                   &asc, &dsc, &wid,
                                   dd);
            else 
                GEStrMetric(CHAR(STRING_ELT(txt, i)), 
                            getCharCE(STRING_ELT(txt, i)), &gc,
                            &asc, &dsc, &wid,
                            dd);
            /*
             * Reverse the scale adjustment (zoom factor)
             * when calculating physical value to return to user-level
             */
            REAL(ascent)[i] = fromDeviceHeight(asc, GE_INCHES, dd) / 
                REAL(gridStateElement(dd, GSS_SCALE))[0];
            REAL(descent)[i] = fromDeviceHeight(dsc, GE_INCHES, dd) /
                REAL(gridStateElement(dd, GSS_SCALE))[0];
            REAL(width)[i] = fromDeviceWidth(wid, GE_INCHES, dd) /
                REAL(gridStateElement(dd, GSS_SCALE))[0];
	}
    }
    PROTECT(result = allocVector(VECSXP, 3));
    SET_VECTOR_ELT(result, 0, ascent);
    SET_VECTOR_ELT(result, 1, descent);
    SET_VECTOR_ELT(result, 2, width);    
    vmaxset(vmax);
    UNPROTECT(5);
    return result;
}

