The R Project SVN R

/* The beginning of code which represents an R base graphics system

 * separate from an R graphics engine (separate from R devices)

 */

#ifdef HAVE_CONFIG_H

#include <config.h>

#endif

#include <Defn.h>

#include <Graphics.h>

#include <Rdevices.h>

int baseRegisterIndex = -1;

void restoredpSaved(DevDesc *dd);

SEXP baseCallback(GEevent task, GEDevDesc *dd, SEXP data) {

    GEDevDesc *curdd;

    GESystemDesc *sd;

    NewDevDesc *dev;

    GPar *ddp;

    GPar *ddpSaved;

    SEXP state;

    SEXP valid;

    SEXP result = R_NilValue;

    switch (task) {

    case GE_FinaliseState:

	sd = dd->gesd[baseRegisterIndex];

	free((baseSystemState*) sd->systemSpecific);

	sd->systemSpecific = NULL;

	break;

    case GE_InitState:

	sd = dd->gesd[baseRegisterIndex];

	dev = dd->dev;

	sd->systemSpecific = malloc(sizeof(baseSystemState));

	ddp = &(((baseSystemState*) sd->systemSpecific)->dp);

	GInit(ddp);

	/* Some things are set by the device, so copy them across now.

	 */

	ddp->ipr[0] = dev->ipr[0];

	ddp->ipr[1] = dev->ipr[1];

	ddp->cra[0] = dev->cra[0];

	ddp->cra[1] = dev->cra[1];

	ddp->asp = dev->asp;

	ddp->left = dev->left;

	ddp->right = dev->right;

	ddp->top = dev->top;

	ddp->bottom = dev->bottom;

	ddp->xCharOffset = dev->xCharOffset;

	ddp->yCharOffset = dev->yCharOffset;

	ddp->yLineBias = dev->yLineBias;

	ddp->canResizePlot = dev->canResizePlot;

	ddp->canChangeFont = dev->canChangeFont;

	ddp->canRotateText = dev->canRotateText;

	ddp->canResizeText = dev->canResizeText;

	ddp->canClip = dev->canClip;

	ddp->canHAdj = dev->canHAdj;

	/* For some things, the device sets the starting value at least.

	 */

	ddp->ps = dev->startps;

	ddp->col = ddp->fg = dev->startcol;

	ddp->bg = dev->startfill;

	ddp->font = dev->startfont; 

	ddp->lty = dev->startlty; 

	ddp->gamma = dev->startgamma;

	/* Initialise the gp settings too.

	 */

	/* copyGPar(ddp, &(((baseSystemState*) sd->systemSpecific)->gp)); */

	break;

    case GE_CopyState:

	sd = dd->gesd[baseRegisterIndex];

	curdd = GEcurrentDevice();

	copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),

		 &(((baseSystemState*) 

		    curdd->gesd[baseRegisterIndex]->systemSpecific)->dpSaved));

	restoredpSaved((DevDesc*) curdd);

	copyGPar(&(((baseSystemState*) 

		    curdd->gesd[baseRegisterIndex]->systemSpecific)->dp),

		 &(((baseSystemState*) 

		    curdd->gesd[baseRegisterIndex]->systemSpecific)->gp));

	GReset((DevDesc*) curdd);

	break;

    case GE_SaveState:

	sd = dd->gesd[baseRegisterIndex];

	copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),

		 &(((baseSystemState*) sd->systemSpecific)->dpSaved));

	break;

    case GE_RestoreState:

	sd = dd->gesd[baseRegisterIndex];

	restoredpSaved((DevDesc*) dd);

	copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),

		 &(((baseSystemState*) sd->systemSpecific)->gp));

	GReset((DevDesc*) dd);

	break;

    case GE_SaveSnapshotState:

	sd = dd->gesd[baseRegisterIndex];

	PROTECT(state = allocVector(INTSXP,

				    /* Got this formula from devga.c

				     * Not sure why the "+ 1"

				     * Rounding up?

				     */

				    1 + sizeof(GPar) / sizeof(int)));

	copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),

		 (GPar*) INTEGER(state));

	result = state;

	UNPROTECT(1);

	break;

    case GE_RestoreSnapshotState:

	sd = dd->gesd[baseRegisterIndex];

	copyGPar((GPar*) INTEGER(data),

		 &(((baseSystemState*) sd->systemSpecific)->dpSaved));	

	restoredpSaved((DevDesc*) dd);

	copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),

		 &(((baseSystemState*) sd->systemSpecific)->gp));

	GReset((DevDesc*) dd);

	break;

    case GE_CheckPlot:

	/* Check that the current plotting state is "valid"

	 */

	sd = dd->gesd[baseRegisterIndex];

	PROTECT(valid = allocVector(LGLSXP, 1));

	LOGICAL(valid)[0] = ((baseSystemState*) sd->systemSpecific)->gp.valid;

	UNPROTECT(1);

	result = valid;

	break;

    case GE_ScalePS:

        sd = dd->gesd[baseRegisterIndex];

        dev = dd->dev;

	ddp = &(((baseSystemState*) sd->systemSpecific)->dp);

	ddpSaved = &(((baseSystemState*) sd->systemSpecific)->dpSaved);

	if (isReal(data) && LENGTH(data) == 1) {

	  double rf = REAL(data)[0];

	  /* The pointsize appears to be being scaled somewhere else

	   * Can't see where yet;  this seems to work and will have

	   * to do while we're in feature freeze (!?)

	   * ddp->ps *= rf;

	   */

	  ddp->cra[0] *= rf; 

	  ddp->cra[1] *= rf;

	  /* Modify the saved settings so effects dislpay list too

	   */

	  /* The pointsize appears to be being scaled somewhere else

	   * Can't see where yet;  this seems to work and will have

	   * to do while we're in feature freeze (!?)

	   * ddpSaved->ps *= rf;

	   */

	  ddpSaved->cra[0] *= rf; 

	  ddpSaved->cra[1] *= rf;

	}

	else 

	  error("Event UpdatePS requires a single numeric value");

	break;

    }

    return result;

}

/* Register the base graphics system with the graphics engine

 */

void registerBase() {

    GEregisterSystem(baseCallback, &baseRegisterIndex);

}

/* FIXME: Make this a macro to avoid function call overhead?

 */

GPar* Rf_gpptr(DevDesc *dd) {

    return &(((baseSystemState*) GEsystemState((GEDevDesc*) dd, 

					       baseRegisterIndex))->gp);

}

GPar* Rf_dpptr(DevDesc *dd) {

    return &(((baseSystemState*) GEsystemState((GEDevDesc*) dd, 

					       baseRegisterIndex))->dp);

}

GPar* Rf_dpSavedptr(DevDesc *dd) {

    return &(((baseSystemState*) GEsystemState((GEDevDesc*) dd, 

					       baseRegisterIndex))->dpSaved);

}

SEXP Rf_displayList(DevDesc *dd) {

    return ((GEDevDesc*) dd)->dev->displayList;

}