The R Project SVN – R – Diff – /trunk/src/main/base.c


/* 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;
}

Rev 26787	Rev 26857
1	`/* The beginning of code which represents an R base graphics system`	1	`/* The beginning of code which represents an R base graphics system`
2	`* separate from an R graphics engine (separate from R devices)`	2	`* separate from an R graphics engine (separate from R devices)`
3	`*/`	3	`*/`
4		4
-		5	`#ifdef HAVE_CONFIG_H`
-		6	`#include <config.h>`
-		7	`#endif`
-		8
5	`#include <Defn.h>`	9	`#include <Defn.h>`
6	`#include <Graphics.h>`	10	`#include <Graphics.h>`
7	`#include <Rdevices.h>`	11	`#include <Rdevices.h>`
8		12
9	`int baseRegisterIndex = -1;`	13	`int baseRegisterIndex = -1;`
10		14
11	`void restoredpSaved(DevDesc *dd);`	15	`void restoredpSaved(DevDesc *dd);`
12		16
13	`SEXP baseCallback(GEevent task, GEDevDesc *dd, SEXP data) {`	17	`SEXP baseCallback(GEevent task, GEDevDesc *dd, SEXP data) {`
14	`GEDevDesc *curdd;`	18	`GEDevDesc *curdd;`
15	`GESystemDesc *sd;`	19	`GESystemDesc *sd;`
16	`NewDevDesc *dev;`	20	`NewDevDesc *dev;`
17	`GPar *ddp;`	21	`GPar *ddp;`
18	`GPar *ddpSaved;`	22	`GPar *ddpSaved;`
19	`SEXP state;`	23	`SEXP state;`
20	`SEXP valid;`	24	`SEXP valid;`
21	`SEXP result = R_NilValue;`	25	`SEXP result = R_NilValue;`
22	`switch (task) {`	26	`switch (task) {`
23	`case GE_FinaliseState:`	27	`case GE_FinaliseState:`
24	`sd = dd->gesd[baseRegisterIndex];`	28	`sd = dd->gesd[baseRegisterIndex];`
25	`free((baseSystemState*) sd->systemSpecific);`	29	`free((baseSystemState*) sd->systemSpecific);`
26	`sd->systemSpecific = NULL;`	30	`sd->systemSpecific = NULL;`
27	`break;`	31	`break;`
28	`case GE_InitState:`	32	`case GE_InitState:`
29	`sd = dd->gesd[baseRegisterIndex];`	33	`sd = dd->gesd[baseRegisterIndex];`
30	`dev = dd->dev;`	34	`dev = dd->dev;`
31	`sd->systemSpecific = malloc(sizeof(baseSystemState));`	35	`sd->systemSpecific = malloc(sizeof(baseSystemState));`
32	`ddp = &(((baseSystemState*) sd->systemSpecific)->dp);`	36	`ddp = &(((baseSystemState*) sd->systemSpecific)->dp);`
33	`GInit(ddp);`	37	`GInit(ddp);`
34	`/* Some things are set by the device, so copy them across now.`	38	`/* Some things are set by the device, so copy them across now.`
35	`*/`	39	`*/`
36	`ddp->ipr[0] = dev->ipr[0];`	40	`ddp->ipr[0] = dev->ipr[0];`
37	`ddp->ipr[1] = dev->ipr[1];`	41	`ddp->ipr[1] = dev->ipr[1];`
38	`ddp->cra[0] = dev->cra[0];`	42	`ddp->cra[0] = dev->cra[0];`
39	`ddp->cra[1] = dev->cra[1];`	43	`ddp->cra[1] = dev->cra[1];`
40	`ddp->asp = dev->asp;`	44	`ddp->asp = dev->asp;`
41	`ddp->left = dev->left;`	45	`ddp->left = dev->left;`
42	`ddp->right = dev->right;`	46	`ddp->right = dev->right;`
43	`ddp->top = dev->top;`	47	`ddp->top = dev->top;`
44	`ddp->bottom = dev->bottom;`	48	`ddp->bottom = dev->bottom;`
45	`ddp->xCharOffset = dev->xCharOffset;`	49	`ddp->xCharOffset = dev->xCharOffset;`
46	`ddp->yCharOffset = dev->yCharOffset;`	50	`ddp->yCharOffset = dev->yCharOffset;`
47	`ddp->yLineBias = dev->yLineBias;`	51	`ddp->yLineBias = dev->yLineBias;`
48	`ddp->canResizePlot = dev->canResizePlot;`	52	`ddp->canResizePlot = dev->canResizePlot;`
49	`ddp->canChangeFont = dev->canChangeFont;`	53	`ddp->canChangeFont = dev->canChangeFont;`
50	`ddp->canRotateText = dev->canRotateText;`	54	`ddp->canRotateText = dev->canRotateText;`
51	`ddp->canResizeText = dev->canResizeText;`	55	`ddp->canResizeText = dev->canResizeText;`
52	`ddp->canClip = dev->canClip;`	56	`ddp->canClip = dev->canClip;`
53	`ddp->canHAdj = dev->canHAdj;`	57	`ddp->canHAdj = dev->canHAdj;`
54	`/* For some things, the device sets the starting value at least.`	58	`/* For some things, the device sets the starting value at least.`
55	`*/`	59	`*/`
56	`ddp->ps = dev->startps;`	60	`ddp->ps = dev->startps;`
57	`ddp->col = ddp->fg = dev->startcol;`	61	`ddp->col = ddp->fg = dev->startcol;`
58	`ddp->bg = dev->startfill;`	62	`ddp->bg = dev->startfill;`
59	`ddp->font = dev->startfont;`	63	`ddp->font = dev->startfont;`
60	`ddp->lty = dev->startlty;`	64	`ddp->lty = dev->startlty;`
61	`ddp->gamma = dev->startgamma;`	65	`ddp->gamma = dev->startgamma;`
62	`/* Initialise the gp settings too.`	66	`/* Initialise the gp settings too.`
63	`*/`	67	`*/`
64	`/* copyGPar(ddp, &(((baseSystemState) sd->systemSpecific)->gp)); /`	68	`/* copyGPar(ddp, &(((baseSystemState) sd->systemSpecific)->gp)); /`
65	`break;`	69	`break;`
66	`case GE_CopyState:`	70	`case GE_CopyState:`
67	`sd = dd->gesd[baseRegisterIndex];`	71	`sd = dd->gesd[baseRegisterIndex];`
68	`curdd = GEcurrentDevice();`	72	`curdd = GEcurrentDevice();`
69	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),`	73	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),`
70	`&(((baseSystemState*)`	74	`&(((baseSystemState*)`
71	`curdd->gesd[baseRegisterIndex]->systemSpecific)->dpSaved));`	75	`curdd->gesd[baseRegisterIndex]->systemSpecific)->dpSaved));`
72	`restoredpSaved((DevDesc*) curdd);`	76	`restoredpSaved((DevDesc*) curdd);`
73	`copyGPar(&(((baseSystemState*)`	77	`copyGPar(&(((baseSystemState*)`
74	`curdd->gesd[baseRegisterIndex]->systemSpecific)->dp),`	78	`curdd->gesd[baseRegisterIndex]->systemSpecific)->dp),`
75	`&(((baseSystemState*)`	79	`&(((baseSystemState*)`
76	`curdd->gesd[baseRegisterIndex]->systemSpecific)->gp));`	80	`curdd->gesd[baseRegisterIndex]->systemSpecific)->gp));`
77	`GReset((DevDesc*) curdd);`	81	`GReset((DevDesc*) curdd);`
78	`break;`	82	`break;`
79	`case GE_SaveState:`	83	`case GE_SaveState:`
80	`sd = dd->gesd[baseRegisterIndex];`	84	`sd = dd->gesd[baseRegisterIndex];`
81	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`	85	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`
82	`&(((baseSystemState*) sd->systemSpecific)->dpSaved));`	86	`&(((baseSystemState*) sd->systemSpecific)->dpSaved));`
83	`break;`	87	`break;`
84	`case GE_RestoreState:`	88	`case GE_RestoreState:`
85	`sd = dd->gesd[baseRegisterIndex];`	89	`sd = dd->gesd[baseRegisterIndex];`
86	`restoredpSaved((DevDesc*) dd);`	90	`restoredpSaved((DevDesc*) dd);`
87	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`	91	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`
88	`&(((baseSystemState*) sd->systemSpecific)->gp));`	92	`&(((baseSystemState*) sd->systemSpecific)->gp));`
89	`GReset((DevDesc*) dd);`	93	`GReset((DevDesc*) dd);`
90	`break;`	94	`break;`
91	`case GE_SaveSnapshotState:`	95	`case GE_SaveSnapshotState:`
92	`sd = dd->gesd[baseRegisterIndex];`	96	`sd = dd->gesd[baseRegisterIndex];`
93	`PROTECT(state = allocVector(INTSXP,`	97	`PROTECT(state = allocVector(INTSXP,`
94	`/* Got this formula from devga.c`	98	`/* Got this formula from devga.c`
95	`* Not sure why the "+ 1"`	99	`* Not sure why the "+ 1"`
96	`* Rounding up?`	100	`* Rounding up?`
97	`*/`	101	`*/`
98	`1 + sizeof(GPar) / sizeof(int)));`	102	`1 + sizeof(GPar) / sizeof(int)));`
99	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),`	103	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dpSaved),`
100	`(GPar*) INTEGER(state));`	104	`(GPar*) INTEGER(state));`
101	`result = state;`	105	`result = state;`
102	`UNPROTECT(1);`	106	`UNPROTECT(1);`
103	`break;`	107	`break;`
104	`case GE_RestoreSnapshotState:`	108	`case GE_RestoreSnapshotState:`
105	`sd = dd->gesd[baseRegisterIndex];`	109	`sd = dd->gesd[baseRegisterIndex];`
106	`copyGPar((GPar*) INTEGER(data),`	110	`copyGPar((GPar*) INTEGER(data),`
107	`&(((baseSystemState*) sd->systemSpecific)->dpSaved));`	111	`&(((baseSystemState*) sd->systemSpecific)->dpSaved));`
108	`restoredpSaved((DevDesc*) dd);`	112	`restoredpSaved((DevDesc*) dd);`
109	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`	113	`copyGPar(&(((baseSystemState*) sd->systemSpecific)->dp),`
110	`&(((baseSystemState*) sd->systemSpecific)->gp));`	114	`&(((baseSystemState*) sd->systemSpecific)->gp));`
111	`GReset((DevDesc*) dd);`	115	`GReset((DevDesc*) dd);`
112	`break;`	116	`break;`
113	`case GE_CheckPlot:`	117	`case GE_CheckPlot:`
114	`/* Check that the current plotting state is "valid"`	118	`/* Check that the current plotting state is "valid"`
115	`*/`	119	`*/`
116	`sd = dd->gesd[baseRegisterIndex];`	120	`sd = dd->gesd[baseRegisterIndex];`
117	`PROTECT(valid = allocVector(LGLSXP, 1));`	121	`PROTECT(valid = allocVector(LGLSXP, 1));`
118	`LOGICAL(valid)[0] = ((baseSystemState*) sd->systemSpecific)->gp.valid;`	122	`LOGICAL(valid)[0] = ((baseSystemState*) sd->systemSpecific)->gp.valid;`
119	`UNPROTECT(1);`	123	`UNPROTECT(1);`
120	`result = valid;`	124	`result = valid;`
121	`break;`	125	`break;`
122	`case GE_ScalePS:`	126	`case GE_ScalePS:`
123	`sd = dd->gesd[baseRegisterIndex];`	127	`sd = dd->gesd[baseRegisterIndex];`
124	`dev = dd->dev;`	128	`dev = dd->dev;`
125	`ddp = &(((baseSystemState*) sd->systemSpecific)->dp);`	129	`ddp = &(((baseSystemState*) sd->systemSpecific)->dp);`
126	`ddpSaved = &(((baseSystemState*) sd->systemSpecific)->dpSaved);`	130	`ddpSaved = &(((baseSystemState*) sd->systemSpecific)->dpSaved);`
127	`if (isReal(data) && LENGTH(data) == 1) {`	131	`if (isReal(data) && LENGTH(data) == 1) {`
128	`double rf = REAL(data)[0];`	132	`double rf = REAL(data)[0];`
129	`/* The pointsize appears to be being scaled somewhere else`	133	`/* The pointsize appears to be being scaled somewhere else`
130	`* Can't see where yet; this seems to work and will have`	134	`* Can't see where yet; this seems to work and will have`
131	`* to do while we're in feature freeze (!?)`	135	`* to do while we're in feature freeze (!?)`
132	`* ddp->ps *= rf;`	136	`* ddp->ps *= rf;`
133	`*/`	137	`*/`
134	`ddp->cra[0] *= rf;`	138	`ddp->cra[0] *= rf;`
135	`ddp->cra[1] *= rf;`	139	`ddp->cra[1] *= rf;`
136	`/* Modify the saved settings so effects dislpay list too`	140	`/* Modify the saved settings so effects dislpay list too`
137	`*/`	141	`*/`
138	`/* The pointsize appears to be being scaled somewhere else`	142	`/* The pointsize appears to be being scaled somewhere else`
139	`* Can't see where yet; this seems to work and will have`	143	`* Can't see where yet; this seems to work and will have`
140	`* to do while we're in feature freeze (!?)`	144	`* to do while we're in feature freeze (!?)`
141	`* ddpSaved->ps *= rf;`	145	`* ddpSaved->ps *= rf;`
142	`*/`	146	`*/`
143	`ddpSaved->cra[0] *= rf;`	147	`ddpSaved->cra[0] *= rf;`
144	`ddpSaved->cra[1] *= rf;`	148	`ddpSaved->cra[1] *= rf;`
145	`}`	149	`}`
146	`else`	150	`else`
147	`error("Event UpdatePS requires a single numeric value");`	151	`error("Event UpdatePS requires a single numeric value");`
148	`break;`	152	`break;`
149	`}`	153	`}`
150	`return result;`	154	`return result;`
151	`}`	155	`}`
152		156
153	`/* Register the base graphics system with the graphics engine`	157	`/* Register the base graphics system with the graphics engine`
154	`*/`	158	`*/`
155	`void registerBase() {`	159	`void registerBase() {`
156	`GEregisterSystem(baseCallback, &baseRegisterIndex);`	160	`GEregisterSystem(baseCallback, &baseRegisterIndex);`
157	`}`	161	`}`
158		162
159	`/* FIXME: Make this a macro to avoid function call overhead?`	163	`/* FIXME: Make this a macro to avoid function call overhead?`
160	`*/`	164	`*/`
161	`GPar* Rf_gpptr(DevDesc *dd) {`	165	`GPar* Rf_gpptr(DevDesc *dd) {`
162	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`	166	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`
163	`baseRegisterIndex))->gp);`	167	`baseRegisterIndex))->gp);`
164	`}`	168	`}`
165		169
166	`GPar* Rf_dpptr(DevDesc *dd) {`	170	`GPar* Rf_dpptr(DevDesc *dd) {`
167	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`	171	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`
168	`baseRegisterIndex))->dp);`	172	`baseRegisterIndex))->dp);`
169	`}`	173	`}`
170		174
171	`GPar* Rf_dpSavedptr(DevDesc *dd) {`	175	`GPar* Rf_dpSavedptr(DevDesc *dd) {`
172	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`	176	`return &(((baseSystemState) GEsystemState((GEDevDesc) dd,`
173	`baseRegisterIndex))->dpSaved);`	177	`baseRegisterIndex))->dpSaved);`
174	`}`	178	`}`
175		179
176	`SEXP Rf_displayList(DevDesc *dd) {`	180	`SEXP Rf_displayList(DevDesc *dd) {`
177	`return ((GEDevDesc*) dd)->dev->displayList;`	181	`return ((GEDevDesc*) dd)->dev->displayList;`
178	`}`	182	`}`

The R Project SVN R

(root)/trunk/src/main/base.c @ 28362 – Rev 26787 → 26857