The R Project SVN – R – Blame – /trunk/src/main/engine.c

Rev	Author	Line No.	Line
16946	maechler	1	`/*`
		2	`* R : A Computer Language for Statistical Data Analysis`
		3	`* Copyright (C) 2001 The R Development Core Team.`
		4	`*`
		5	`* This program is free software; you can redistribute it and/or modify`
		6	`* it under the terms of the GNU General Public License as published by`
		7	`* the Free Software Foundation; either version 2 of the License, or`
		8	`* (at your option) any later version.`
		9	`*`
		10	`* This program is distributed in the hope that it will be useful,`
		11	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`
		12	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
		13	`* GNU General Public License for more details.`
		14	`*`
		15	`* You should have received a copy of the GNU General Public License`
		16	`* along with this program; if not, write to the Free Software`
		17	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`
		18	`*/`
16876	murrell	19
16946	maechler	20	`#ifdef HAVE_CONFIG_H`
		21	`#include <config.h>`
		22	`#endif`
		23
16876	murrell	24	`#include <Defn.h>`
		25	`/* REALLY shouldn't have to include Graphics.h once engine.h is`
		26	`* properly set up`
		27	`*/`
		28	`#include <Graphics.h>`
		29	`#include <Rdevices.h>`
		30	`#include <R_ext/Applic.h> /* pretty0() */`
		31	`#include <Rmath.h>`
		32
		33	`/* A note on memory management ...`
16946	maechler	34	`* Here (with GEDevDesc's) I have continued the deplorable tradition of`
16876	murrell	35	`* malloc'ing device structures and maintaining global variables to`
		36	`* record the device structures. I believe that what I should`
		37	`* be doing is recording the device structures in R-level objects`
		38	`* (i.e., SEXP's) using Luke's reference pointers to make sure that`
		39	`* nasty things like duplicate copies of device structures do not`
		40	`* occur. The thing stopping me doing "the right thing" right now`
		41	`* is time. Hopefully, I will get time later to come back and do`
		42	`* it properly -- in the meantime I'll just have to burn in hell.`
		43	`* Paul.`
		44	`*/`
		45
		46	`static int numGraphicsSystems = 0;`
		47
		48	`static GESystemDesc* registeredSystems[MAX_GRAPHICS_SYSTEMS];`
		49
		50	`/****************************************************************`
		51	`* GEcreateDevDesc`
		52	`****************************************************************`
		53	`*/`
		54
		55	`/* Create a GEDevDesc, given a NewDevDesc*`
		56	`*/`
16946	maechler	57	`GEDevDesc* GEcreateDevDesc(NewDevDesc* dev)`
16876	murrell	58	`{`
		59	`/* Wrap the device description within a graphics engine`
		60	`* device description (add graphics engine information`
		61	`* to the device description).`
		62	`*/`
17360	murrell	63	`GEDevDesc dd = (GEDevDesc) calloc(1, sizeof(GEDevDesc));`
		64	`/* NULL the gesd array`
		65	`*/`
		66	`int i;`
18963	murrell	67	`if (!dd)`
		68	`error("Not enough memory to allocate device (in addDevice)");`
17360	murrell	69	`for (i=0; i<MAX_GRAPHICS_SYSTEMS; i++)`
		70	`dd->gesd[i] = NULL;`
16876	murrell	71	`dd->newDevStruct = 1;`
		72	`dd->dev = dev;`
		73	`return dd;`
		74	`}`
		75
		76	`/****************************************************************`
		77	`* GEdestroyDevDesc`
		78	`****************************************************************`
		79	`*/`
		80
		81	`static void unregisterOne(GEDevDesc *dd, int systemNumber) {`
		82	`if (dd->gesd[systemNumber] != NULL) {`
17022	murrell	83	`(dd->gesd[systemNumber]->callback)(GE_FinaliseState, dd,`
		84	`R_NilValue);`
16876	murrell	85	`free(dd->gesd[systemNumber]);`
		86	`dd->gesd[systemNumber] = NULL;`
		87	`}`
		88	`}`
		89
		90	`/* NOTE that the NewDevDesc* dev has been shut down by a call`
		91	`* to dev->close within graphics.c`
		92	`*/`
16946	maechler	93	`void GEdestroyDevDesc(GEDevDesc* dd)`
16876	murrell	94	`{`
		95	`int i;`
		96	`if (dd != NULL) {`
		97	`for (i=0; i<numGraphicsSystems; i++)`
		98	`unregisterOne(dd, i);`
		99	`free(dd->dev);`
		100	`dd->dev = NULL;`
		101	`free(dd);`
		102	`}`
		103	`}`
		104
		105	`/****************************************************************`
		106	`* GEsystemState`
		107	`****************************************************************`
		108	`*/`
		109
16946	maechler	110	`void* GEsystemState(GEDevDesc *dd, int index)`
16876	murrell	111	`{`
		112	`return dd->gesd[index]->systemSpecific;`
		113	`}`
		114
		115	`/****************************************************************`
		116	`* GEregisterWithDevice`
		117	`****************************************************************`
		118	`*/`
		119
16946	maechler	120	`/* The guts of adding information about a specific graphics`
16876	murrell	121	`* system to a specific device.`
		122	`*/`
		123	`static void registerOne(GEDevDesc *dd, int systemNumber, GEcallback cb) {`
16946	maechler	124	`dd->gesd[systemNumber] =`
17360	murrell	125	`(GESystemDesc*) calloc(1, sizeof(GESystemDesc));`
16876	murrell	126	`if (dd->gesd[systemNumber] == NULL)`
		127	`error("unable to allocate memory (in GEregister)");`
17022	murrell	128	`cb(GE_InitState, dd, R_NilValue);`
16876	murrell	129	`dd->gesd[systemNumber]->callback = cb;`
		130	`}`
		131
		132	`/* Store the graphics system state and callback information`
		133	`* for a specified device.`
		134	`* This is called when a new device is created.`
		135	`*/`
		136	`void GEregisterWithDevice(GEDevDesc *dd) {`
		137	`int i;`
		138	`for (i=0; i<numGraphicsSystems; i++)`
		139	`/* If a graphics system has unregistered, there might be`
		140	`* "holes" in the array of registeredSystems.`
		141	`*/`
		142	`if (registeredSystems[i] != NULL)`
		143	`registerOne(dd, i, registeredSystems[i]->callback);`
		144	`}`
		145
		146	`/****************************************************************`
		147	`* GEregisterSystem`
		148	`****************************************************************`
		149	`*/`
		150
16946	maechler	151	`/* Record the state and callback information for a new graphics`
16876	murrell	152	`* system.`
		153	`* This is called when a graphics system is loaded.`
		154	`* Return the index of the system's information in the graphic`
		155	`* engine's register.`
		156	`*/`
17360	murrell	157	`void GEregisterSystem(GEcallback cb, int *systemRegisterIndex) {`
16876	murrell	158	`int i, devNum;`
		159	`/* Bit awkward, but I leave GetDevice to return DevDesc for now`
		160	`* Can be fixed once device handling code is in here rather than`
		161	`* in graphics.c`
		162	`*/`
		163	`DevDesc *dd;`
		164	`if (numGraphicsSystems + 1 == MAX_GRAPHICS_SYSTEMS)`
		165	`error("Too many graphics systems registered");`
17360	murrell	166	`/* Set the system register index so that, if there are existing`
		167	`* devices, it will know where to put the system-specific`
		168	`* information in those devices`
		169	`*/`
		170	`*systemRegisterIndex = numGraphicsSystems;`
16876	murrell	171	`/* Run through the existing devices and add the new information`
		172	`* to any GEDevDesc's`
		173	`*/`
		174	`i = 1;`
		175	`if (!NoDevices()) {`
		176	`devNum = curDevice();`
		177	`while (i++ < NumDevices()) {`
		178	`dd = GetDevice(devNum);`
16946	maechler	179	`/* FIXME: won't need this check once engine.c has`
16876	murrell	180	`* replaced graphics.c`
		181	`*/`
		182	`if (dd->newDevStruct) {`
		183	`registerOne((GEDevDesc*) dd, numGraphicsSystems, cb);`
		184	`}`
		185	`devNum = nextDevice(devNum);`
		186	`}`
		187	`}`
		188	`/* Store the information for adding to any new devices`
		189	`*/`
16946	maechler	190	`registeredSystems[numGraphicsSystems] =`
17360	murrell	191	`(GESystemDesc*) calloc(1, sizeof(GESystemDesc));`
16876	murrell	192	`if (registeredSystems[numGraphicsSystems] == NULL)`
		193	`error("unable to allocate memory (in GEregister)");`
		194	`registeredSystems[numGraphicsSystems]->callback = cb;`
		195	`numGraphicsSystems += 1;`
		196	`}`
		197
		198	`/****************************************************************`
		199	`* GEunregisterSystem`
		200	`****************************************************************`
		201	`*/`
		202
		203	`void GEunregisterSystem(int registerIndex)`
		204	`{`
		205	`int i, devNum;`
		206	`/* Bit awkward, but I leave GetDevice to return DevDesc for now`
		207	`* Can be fixed once device handling code is in here rather than`
		208	`* in graphics.c`
		209	`*/`
		210	`DevDesc *dd;`
17076	ripley	211
		212	`/* safety check if called before Ginit() */`
		213	`if(registerIndex < 0) return;`
16876	murrell	214	`if (numGraphicsSystems == 0)`
		215	`error("No graphics system to unregister");`
		216	`/* Run through the existing devices and remove the information`
		217	`* from any GEDevDesc's`
		218	`*/`
		219	`i = 1;`
		220	`if (!NoDevices()) {`
		221	`devNum = curDevice();`
		222	`while (i++ < NumDevices()) {`
		223	`dd = GetDevice(devNum);`
16946	maechler	224	`/* FIXME: won't need this check once engine.c has`
16876	murrell	225	`* replaced graphics.c`
		226	`*/`
		227	`if (dd->newDevStruct) {`
		228	`unregisterOne((GEDevDesc*) dd, registerIndex);`
		229	`}`
		230	`devNum = nextDevice(devNum);`
		231	`}`
		232	`}`
		233	`/* Remove the information from the global record`
		234	`* NOTE that there is no systemSpecific information stored`
		235	`* in the global record -- just the system callback pointer.`
		236	`*/`
		237	`if (registeredSystems[registerIndex] != NULL) {`
		238	`free(registeredSystems[registerIndex]);`
		239	`registeredSystems[registerIndex] = NULL;`
		240	`}`
		241	`/* NOTE that I deliberately do not decrease the number of`
16946	maechler	242	`* registered graphics systems. This means that unloading`
16876	murrell	243	`* a graphics system will create a "hole" in the global`
		244	`* record, but otherwise I have to assume that graphics`
		245	`* systems are unloaded in the reverse order from that which`
		246	`* they were loaded, which may be unreasonable.`
		247	`* The downside to this approach is that if you unload and`
		248	`* reload graphics systems you will run out of room in the`
		249	`* global record -- I'm assuming that unloading and reloading`
16946	maechler	250	`* of graphics systems is something that won't happen that`
16876	murrell	251	`* many times in a session.`
16946	maechler	252	`* Hopefully, all of these problems will go away when I get`
16876	murrell	253	`* around to storing the device structures in SEXP's`
		254	`*/`
		255	`}`
		256
		257	`/****************************************************************`
		258	`* GEHandleEvent`
		259	`****************************************************************`
		260	`*/`
		261
		262	`/* This guy can be called by device drivers.`
		263	`* It calls back to registered graphics systems and passes on the event`
		264	`* so that the graphics systems can respond however they want to.`
		265	`*/`
17022	murrell	266	`SEXP GEHandleEvent(GEevent event, NewDevDesc *dev, SEXP data)`
16876	murrell	267	`{`
		268	`int i;`
		269	`DevDesc* dd = GetDevice(devNumber((DevDesc*) dev));`
16946	maechler	270	`for (i=0; i<numGraphicsSystems; i++)`
		271	`if (registeredSystems[i] != NULL)`
17360	murrell	272	`(registeredSystems[i]->callback)(event, (GEDevDesc*) dd,`
		273	`data);`
		274	`return R_NilValue;`
16876	murrell	275	`}`
		276
		277	`/****************************************************************`
		278	`* Some graphics engine transformations`
		279	`****************************************************************`
		280	`*/`
		281
16946	maechler	282	`double fromDeviceX(double value, GEUnit to, GEDevDesc *dd)`
16876	murrell	283	`{`
		284	`double result = value;`
		285	`switch (to) {`
		286	`case GE_DEVICE:`
		287	`break;`
		288	`case GE_NDC:`
16946	maechler	289	`result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left);`
16876	murrell	290	`break;`
		291	`case GE_INCHES:`
16946	maechler	292	`result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) *`
16876	murrell	293	`fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0];`
		294	`break;`
		295	`case GE_CM:`
16946	maechler	296	`result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) *`
16876	murrell	297	`fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0] * 2.54;`
		298	`}`
		299	`return result;`
		300	`}`
		301
		302	`double toDeviceX(double value, GEUnit from, GEDevDesc *dd)`
		303	`{`
		304	`double result = value;`
		305	`switch (from) {`
		306	`case GE_CM:`
		307	`/* Convert GE_CM to GE_INCHES */`
		308	`result = result / 2.54;`
		309	`case GE_INCHES:`
		310	`/* Convert GE_INCHES to GE_NDC */`
		311	`result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left);`
		312	`case GE_NDC:`
		313	`/* Convert GE_NDC to Dev */`
		314	`result = dd->dev->left + result*(dd->dev->right - dd->dev->left);`
		315	`case GE_DEVICE:`
		316	`/* Do nothing */`
		317	`break;`
		318	`}`
		319	`return result;`
		320	`}`
		321
16946	maechler	322	`double fromDeviceY(double value, GEUnit to, GEDevDesc *dd)`
16876	murrell	323	`{`
		324	`double result = value;`
		325	`switch (to) {`
		326	`case GE_DEVICE:`
		327	`break;`
		328	`case GE_NDC:`
16946	maechler	329	`result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom);`
16876	murrell	330	`break;`
		331	`case GE_INCHES:`
		332	`result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) *`
		333	`fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1];`
		334	`break;`
		335	`case GE_CM:`
		336	`result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) *`
		337	`fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1] * 2.54;`
		338	`}`
		339	`return result;`
		340	`}`
		341
		342	`double toDeviceY(double value, GEUnit from, GEDevDesc *dd)`
		343	`{`
		344	`double result = value;`
		345	`switch (from) {`
		346	`case GE_CM:`
		347	`/* Convert GE_CM to GE_INCHES */`
		348	`result = result / 2.54;`
		349	`case GE_INCHES:`
		350	`/* Convert GE_INCHES to GE_NDC */`
		351	`result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom);`
		352	`case GE_NDC:`
		353	`/* Convert GE_NDC to Dev */`
		354	`result = dd->dev->bottom + result*(dd->dev->top - dd->dev->bottom);`
		355	`case GE_DEVICE:`
		356	`/* Do nothing */`
16896	iacus	357	`break;`
16876	murrell	358	`}`
		359	`return result;`
		360	`}`
		361
16946	maechler	362	`double fromDeviceWidth(double value, GEUnit to, GEDevDesc *dd)`
16876	murrell	363	`{`
		364	`double result = value;`
		365	`switch (to) {`
		366	`case GE_DEVICE:`
		367	`break;`
		368	`case GE_NDC:`
16946	maechler	369	`result = result / (dd->dev->right - dd->dev->left);`
16876	murrell	370	`break;`
		371	`case GE_INCHES:`
		372	`result = result * dd->dev->ipr[0];`
		373	`break;`
		374	`case GE_CM:`
		375	`result = result * dd->dev->ipr[0] * 2.54;`
		376	`}`
		377	`return result;`
		378	`}`
		379
		380	`double toDeviceWidth(double value, GEUnit from, GEDevDesc *dd)`
		381	`{`
		382	`double result = value;`
		383	`switch (from) {`
		384	`case GE_CM:`
		385	`/* Convert GE_CM to GE_INCHES */`
		386	`result = result / 2.54;`
		387	`case GE_INCHES:`
		388	`/* Convert GE_INCHES to GE_NDC */`
		389	`result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left);`
		390	`case GE_NDC:`
		391	`/* Convert GE_NDC to Dev */`
		392	`result = result*(dd->dev->right - dd->dev->left);`
		393	`case GE_DEVICE:`
		394	`/* Do nothing */`
16896	iacus	395	`break;`
16876	murrell	396	`}`
		397	`return result;`
		398	`}`
		399
16946	maechler	400	`double fromDeviceHeight(double value, GEUnit to, GEDevDesc *dd)`
16876	murrell	401	`{`
		402	`double result = value;`
		403	`switch (to) {`
		404	`case GE_DEVICE:`
		405	`break;`
		406	`case GE_NDC:`
16946	maechler	407	`result = result / (dd->dev->top - dd->dev->bottom);`
16876	murrell	408	`break;`
		409	`case GE_INCHES:`
		410	`result = result * dd->dev->ipr[1];`
		411	`break;`
		412	`case GE_CM:`
		413	`result = result * dd->dev->ipr[1] * 2.54;`
		414	`}`
		415	`return result;`
		416	`}`
		417
		418	`double toDeviceHeight(double value, GEUnit from, GEDevDesc *dd)`
		419	`{`
		420	`double result = value;`
		421	`switch (from) {`
		422	`case GE_CM:`
		423	`/* Convert GE_CM to GE_INCHES */`
		424	`result = result / 2.54;`
		425	`case GE_INCHES:`
		426	`/* Convert GE_INCHES to GE_NDC */`
		427	`result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom);`
		428	`case GE_NDC:`
		429	`/* Convert GE_NDC to Dev */`
		430	`result = result*(dd->dev->top - dd->dev->bottom);`
		431	`case GE_DEVICE:`
		432	`/* Do nothing */`
		433	`break;`
		434	`}`
		435	`return result;`
		436	`}`
		437
		438	`/****************************************************************`
		439	`* Code to retrieve current clipping rect from device`
		440	`****************************************************************`
		441	`*/`
		442
		443	`static void getClipRect(double x1, double y1, double x2, double y2,`
		444	`GEDevDesc *dd)`
		445	`{`
		446	`if (dd->dev->clipLeft < dd->dev->clipRight) {`
		447	`*x1 = dd->dev->clipLeft;`
		448	`*x2 = dd->dev->clipRight;`
		449	`} else {`
		450	`*x2 = dd->dev->clipLeft;`
		451	`*x1 = dd->dev->clipRight;`
		452	`}`
		453	`if (dd->dev->clipBottom < dd->dev->clipTop) {`
		454	`*y1 = dd->dev->clipBottom;`
		455	`*y2 = dd->dev->clipTop;`
		456	`} else {`
		457	`*y2 = dd->dev->clipBottom;`
		458	`*y1 = dd->dev->clipTop;`
		459	`}`
		460	`}`
		461
		462	`static void getClipRectToDevice(double x1, double y1, double x2, double y2,`
		463	`GEDevDesc *dd)`
		464	`{`
		465	`if (dd->dev->left < dd->dev->right) {`
		466	`*x1 = dd->dev->left;`
		467	`*x2 = dd->dev->right;`
		468	`} else {`
		469	`*x2 = dd->dev->left;`
		470	`*x1 = dd->dev->right;`
		471	`}`
		472	`if (dd->dev->bottom < dd->dev->top) {`
		473	`*y1 = dd->dev->bottom;`
		474	`*y2 = dd->dev->top;`
		475	`} else {`
		476	`*y2 = dd->dev->bottom;`
		477	`*y1 = dd->dev->top;`
		478	`}`
		479	`}`
		480
		481	`/****************************************************************`
		482	`* GESetClip`
		483	`****************************************************************`
		484	`*/`
		485	`void GESetClip(double x1, double y1, double x2, double y2, GEDevDesc *dd)`
		486	`{`
		487	`dd->dev->clip(x1, x2, y1, y2, dd->dev);`
20424	murrell	488	`/*`
		489	`* Record the current clip rect settings so that calls to`
		490	`* getClipRect get the up-to-date values.`
17306	murrell	491	`*/`
20424	murrell	492	`dd->dev->clipLeft = fmin2(x1, x2);`
		493	`dd->dev->clipRight = fmax2(x1, x2);`
		494	`dd->dev->clipTop = fmax2(y1, y2);`
		495	`dd->dev->clipBottom = fmin2(y1, y2);`
16876	murrell	496	`}`
		497
		498	`/****************************************************************`
		499	`* R code for clipping lines`
		500	`****************************************************************`
		501	`*/`
		502
		503	`/* Draw Line Segments, Clipping to the Viewport */`
		504	`/* Cohen-Sutherland Algorithm */`
		505	`/* Unneeded if the device can do the clipping */`
		506
		507
		508	`#define CS_BOTTOM 001`
		509	`#define CS_LEFT 002`
		510	`#define CS_TOP 004`
		511	`#define CS_RIGHT 010`
		512
		513	`typedef struct {`
		514	`double xl;`
		515	`double xr;`
		516	`double yb;`
		517	`double yt;`
		518	`} cliprect;`
		519
		520
		521	`static int clipcode(double x, double y, cliprect *cr)`
		522	`{`
		523	`int c = 0;`
		524	`if(x < cr->xl)`
		525	`c \|= CS_LEFT;`
		526	`else if(x > cr->xr)`
		527	`c \|= CS_RIGHT;`
		528	`if(y < cr->yb)`
		529	`c \|= CS_BOTTOM;`
		530	`else if(y > cr->yt)`
		531	`c \|= CS_TOP;`
		532	`return c;`
		533	`}`
		534
		535	`static Rboolean`
16946	maechler	536	`CSclipline(double x1, double y1, double x2, double y2,`
		537	`cliprect cr, int clipped1, int *clipped2,`
16876	murrell	538	`GEDevDesc *dd)`
		539	`{`
		540	`int c, c1, c2;`
		541	`double x, y, xl, xr, yb, yt;`
		542
		543	`*clipped1 = 0;`
		544	`*clipped2 = 0;`
		545	`c1 = clipcode(x1, y1, cr);`
		546	`c2 = clipcode(x2, y2, cr);`
		547	`if ( !c1 && !c2 )`
		548	`return TRUE;`
		549
		550	`xl = cr->xl;`
		551	`xr = cr->xr;`
		552	`yb = cr->yb;`
		553	`yt = cr->yt;`
		554	`/* Paul took out the code for (dd->dev->gp.xlog \|\| dd->dev->gp.ylog)`
		555	`* (i) because device holds no state on whether scales are logged`
		556	`* (ii) it appears to be identical to the code for non-log scales !?`
		557	`*/`
		558	`x = xl; /* keep -Wall happy */`
		559	`y = yb; /* keep -Wall happy */`
		560	`while( c1 \|\| c2 ) {`
		561	`if(c1 & c2)`
		562	`return FALSE;`
		563	`if( c1 )`
		564	`c = c1;`
		565	`else`
		566	`c = c2;`
		567	`if( c & CS_LEFT ) {`
		568	`y = y1 + (y2 - y1) (xl - x1) / (x2 - *x1);`
		569	`x = xl;`
		570	`}`
		571	`else if( c & CS_RIGHT ) {`
		572	`y = y1 + (y2 - y1) (xr - x1) / (x2 - *x1);`
		573	`x = xr;`
		574	`}`
		575	`else if( c & CS_BOTTOM ) {`
		576	`x = x1 + (x2 - x1) (yb - y1) / (y2 - *y1);`
		577	`y = yb;`
		578	`}`
		579	`else if( c & CS_TOP ) {`
		580	`x = x1 + (x2 - x1) (yt - y1)/(y2 - *y1);`
		581	`y = yt;`
		582	`}`
16946	maechler	583
16876	murrell	584	`if( c==c1 ) {`
		585	`*x1 = x;`
		586	`*y1 = y;`
		587	`*clipped1 = 1;`
		588	`c1 = clipcode(x, y, cr);`
		589	`}`
		590	`else {`
		591	`*x2 = x;`
		592	`*y2 = y;`
		593	`*clipped2 = 1;`
		594	`c2 = clipcode(x, y, cr);`
		595	`}`
		596	`}`
		597	`return TRUE;`
		598	`}`
		599
		600
		601	`/* Clip the line`
		602	`If toDevice = 1, clip to the device extent (i.e., temporarily ignore`
		603	`dd->dev->gp.xpd) */`
		604	`static Rboolean`
		605	`clipLine(double x1, double y1, double x2, double y2,`
		606	`int toDevice, GEDevDesc *dd)`
		607	`{`
		608	`int dummy1, dummy2;`
		609	`cliprect cr;`
		610
16946	maechler	611	`if (toDevice)`
16876	murrell	612	`getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);`
		613	`else`
		614	`getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);`
		615
		616	`return CSclipline(x1, y1, x2, y2, &cr, &dummy1, &dummy2, dd);`
		617	`}`
		618
		619	`/****************************************************************`
		620	`* GELine`
		621	`****************************************************************`
		622	`*/`
		623	`/* If the device canClip, R clips line to device extent and`
		624	`device does all other clipping. */`
16946	maechler	625	`void GELine(double x1, double y1, double x2, double y2,`
27236	murrell	626	`R_GE_gcontext gc, GEDevDesc dd)`
16876	murrell	627	`{`
		628	`Rboolean clip_ok;`
27236	murrell	629	`if (gc->lty == LTY_BLANK) return;`
16876	murrell	630	`if (dd->dev->canClip) {`
		631	`clip_ok = clipLine(&x1, &y1, &x2, &y2, 1, dd);`
		632	`}`
		633	`else {`
		634	`clip_ok = clipLine(&x1, &y1, &x2, &y2, 0, dd);`
		635	`}`
		636	`if (clip_ok)`
27236	murrell	637	`dd->dev->line(x1, y1, x2, y2, gc, dd->dev);`
16876	murrell	638	`}`
		639
		640	`/****************************************************************`
		641	`* R code for clipping polylines`
		642	`****************************************************************`
		643	`*/`
		644
16946	maechler	645	`static void CScliplines(int n, double x, double y,`
27236	murrell	646	`R_GE_gcontext gc, int toDevice, GEDevDesc dd)`
16876	murrell	647	`{`
		648	`int ind1, ind2;`
		649	`/int firstPoint = 1;/`
		650	`int count = 0;`
		651	`int i = 0;`
16910	ripley	652	`double xx, yy;`
16876	murrell	653	`double x1, y1, x2, y2;`
		654	`cliprect cr;`
		655	`char *vmax = vmaxget();`
		656
16946	maechler	657	`if (toDevice)`
16876	murrell	658	`getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);`
		659	`else`
		660	`getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);`
		661
		662	`xx = (double *) R_alloc(n, sizeof(double));`
		663	`yy = (double *) R_alloc(n, sizeof(double));`
		664	`if (xx == NULL \|\| yy == NULL)`
		665	`error("out of memory while clipping polyline");`
		666
		667	`xx[0] = x1 = x[0];`
		668	`yy[0] = y1 = y[0];`
		669	`count = 1;`
		670
		671	`for (i = 1; i < n; i++) {`
		672	`x2 = x[i];`
		673	`y2 = y[i];`
		674	`if (CSclipline(&x1, &y1, &x2, &y2, &cr, &ind1, &ind2, dd)) {`
		675	`if (ind1 && ind2) {`
		676	`xx[0] = x1;`
		677	`yy[0] = y1;`
		678	`xx[1] = x2;`
		679	`yy[1] = y2;`
27236	murrell	680	`dd->dev->polyline(2, xx, yy, gc, dd->dev);`
16876	murrell	681	`}`
		682	`else if (ind1) {`
		683	`xx[0] = x1;`
		684	`yy[0] = y1;`
		685	`xx[1] = x2;`
		686	`yy[1] = y2;`
		687	`count = 2;`
		688	`if (i == n - 1)`
27236	murrell	689	`dd->dev->polyline(count, xx, yy, gc, dd->dev);`
16876	murrell	690	`}`
		691	`else if (ind2) {`
		692	`xx[count] = x2;`
		693	`yy[count] = y2;`
		694	`count++;`
		695	`if (count > 1)`
27236	murrell	696	`dd->dev->polyline(count, xx, yy, gc, dd->dev);`
16876	murrell	697	`}`
		698	`else {`
		699	`xx[count] = x2;`
		700	`yy[count] = y2;`
		701	`count++;`
		702	`if (i == n - 1 && count > 1)`
27236	murrell	703	`dd->dev->polyline(count, xx, yy, gc, dd->dev);`
16876	murrell	704	`}`
		705	`}`
		706	`x1 = x[i];`
		707	`y1 = y[i];`
		708	`}`
		709
		710	`vmaxset(vmax);`
		711	`}`
		712
		713	`/****************************************************************`
		714	`* GEPolyline`
		715	`****************************************************************`
		716	`*/`
		717	`/* Clip and draw the polyline.`
		718	`If clipToDevice = 0, clip according to dd->dev->gp.xpd`
		719	`If clipToDevice = 1, clip to the device extent */`
		720	`static void clipPolyline(int n, double x, double y,`
27236	murrell	721	`R_GE_gcontext *gc,`
16876	murrell	722	`int clipToDevice, GEDevDesc *dd)`
		723	`{`
27236	murrell	724	`CScliplines(n, x, y, gc, clipToDevice, dd);`
16876	murrell	725	`}`
		726
		727	`/* Draw a series of line segments. */`
		728	`/* If the device canClip, R clips to the device extent and the device`
		729	`does all other clipping */`
16946	maechler	730	`void GEPolyline(int n, double x, double y,`
27236	murrell	731	`R_GE_gcontext *gc,`
16876	murrell	732	`GEDevDesc *dd)`
		733	`{`
27236	murrell	734	`if (gc->lty == LTY_BLANK) return;`
16876	murrell	735	`if (dd->dev->canClip) {`
27236	murrell	736	`clipPolyline(n, x, y, gc, 1, dd); /* clips to device extent`
16876	murrell	737	`then draws */`
		738	`}`
		739	`else`
27236	murrell	740	`clipPolyline(n, x, y, gc, 0, dd);`
16876	murrell	741	`}`
		742
		743	`/****************************************************************`
		744	`* R code for clipping polygons`
		745	`****************************************************************`
		746	`*/`
		747
		748	`typedef enum {`
		749	`Left = 0,`
		750	`Right = 1,`
		751	`Bottom = 2,`
		752	`Top = 3`
		753	`} Edge;`
		754
		755	`/* Clipper State Variables */`
		756	`typedef struct {`
		757	`int first; /* true if we have seen the first point */`
		758	`double fx; /* x coord of the first point */`
		759	`double fy; /* y coord of the first point */`
		760	`double sx; /* x coord of the most recent point */`
		761	`double sy; /* y coord of the most recent point */`
		762	`}`
		763	`GClipState;`
		764
		765	`/* The Clipping Rectangle */`
		766	`typedef struct {`
		767	`double xmin;`
		768	`double xmax;`
		769	`double ymin;`
		770	`double ymax;`
		771	`}`
		772	`GClipRect;`
		773
		774	`static`
		775	`int inside (Edge b, double px, double py, GClipRect *clip)`
		776	`{`
		777	`switch (b) {`
		778	`case Left: if (px < clip->xmin) return 0; break;`
		779	`case Right: if (px > clip->xmax) return 0; break;`
		780	`case Bottom: if (py < clip->ymin) return 0; break;`
		781	`case Top: if (py > clip->ymax) return 0; break;`
		782	`}`
		783	`return 1;`
		784	`}`
		785
		786	`static`
		787	`int cross (Edge b, double x1, double y1, double x2, double y2,`
		788	`GClipRect *clip)`
		789	`{`
		790	`if (inside (b, x1, y1, clip) == inside (b, x2, y2, clip))`
		791	`return 0;`
		792	`else return 1;`
		793	`}`
		794
		795	`static`
		796	`void intersect (Edge b, double x1, double y1, double x2, double y2,`
		797	`double ix, double iy, GClipRect *clip)`
		798	`{`
		799	`double m = 0;`
		800
		801	`if (x1 != x2) m = (y1 - y2) / (x1 - x2);`
		802	`switch (b) {`
		803	`case Left:`
		804	`*ix = clip->xmin;`
		805	`iy = y2 + (clip->xmin - x2) m;`
		806	`break;`
		807	`case Right:`
		808	`*ix = clip->xmax;`
		809	`iy = y2 + (clip->xmax - x2) m;`
		810	`break;`
		811	`case Bottom:`
		812	`*iy = clip->ymin;`
		813	`if (x1 != x2) *ix = x2 + (clip->ymin - y2) / m;`
		814	`else *ix = x2;`
		815	`break;`
		816	`case Top:`
		817	`*iy = clip->ymax;`
		818	`if (x1 != x2) *ix = x2 + (clip->ymax - y2) / m;`
		819	`else *ix = x2;`
		820	`break;`
		821	`}`
		822	`}`
		823
		824	`static`
		825	`void clipPoint (Edge b, double x, double y,`
		826	`double xout, double yout, int *cnt, int store,`
		827	`GClipRect clip, GClipState cs)`
		828	`{`
		829	`double ix, iy;`
		830
		831	`if (!cs[b].first) {`
		832	`/* No previous point exists for this edge. */`
		833	`/* Save this point. */`
		834	`cs[b].first = 1;`
		835	`cs[b].fx = x;`
		836	`cs[b].fy = y;`
		837	`}`
		838	`else`
		839	`/* A previous point exists. */`
		840	`/* If 'p' and previous point cross edge, find intersection. */`
		841	`/* Clip against next boundary, if any. */`
		842	`/* If no more edges, add intersection to output list. */`
		843	`if (cross (b, x, y, cs[b].sx, cs[b].sy, clip)) {`
		844	`intersect (b, x, y, cs[b].sx, cs[b].sy, &ix, &iy, clip);`
		845	`if (b < Top)`
		846	`clipPoint (b + 1, ix, iy, xout, yout, cnt, store,`
		847	`clip, cs);`
		848	`else {`
		849	`if (store) {`
		850	`xout[*cnt] = ix;`
		851	`yout[*cnt] = iy;`
		852	`}`
		853	`(*cnt)++;`
		854	`}`
		855	`}`
		856
		857	`/* Save as most recent point for this edge */`
		858	`cs[b].sx = x;`
		859	`cs[b].sy = y;`
		860
		861	`/* For all, if point is 'inside' */`
		862	`/* proceed to next clip edge, if any */`
		863	`if (inside (b, x, y, clip)) {`
		864	`if (b < Top)`
		865	`clipPoint (b + 1, x, y, xout, yout, cnt, store, clip, cs);`
		866	`else {`
		867	`if (store) {`
		868	`xout[*cnt] = x;`
		869	`yout[*cnt] = y;`
		870	`}`
		871	`(*cnt)++;`
		872	`}`
		873	`}`
		874	`}`
		875
		876	`static`
		877	`void closeClip (double xout, double yout, int *cnt, int store,`
		878	`GClipRect clip, GClipState cs)`
		879	`{`
		880	`double ix, iy;`
		881	`Edge b;`
		882
		883	`for (b = Left; b <= Top; b++) {`
		884	`if (cross (b, cs[b].sx, cs[b].sy, cs[b].fx, cs[b].fy, clip)) {`
		885	`intersect (b, cs[b].sx, cs[b].sy,`
		886	`cs[b].fx, cs[b].fy, &ix, &iy, clip);`
		887	`if (b < Top)`
		888	`clipPoint (b + 1, ix, iy, xout, yout, cnt, store, clip, cs);`
		889	`else {`
		890	`if (store) {`
		891	`xout[*cnt] = ix;`
		892	`yout[*cnt] = iy;`
		893	`}`
		894	`(*cnt)++;`
		895	`}`
		896	`}`
		897	`}`
		898	`}`
		899
		900	`int clipPoly(double x, double y, int n, int store, int toDevice,`
		901	`double xout, double yout, GEDevDesc *dd)`
		902	`{`
		903	`int i, cnt = 0;`
		904	`GClipState cs[4];`
		905	`GClipRect clip;`
		906	`for (i = 0; i < 4; i++)`
		907	`cs[i].first = 0;`
16946	maechler	908	`if (toDevice)`
		909	`getClipRectToDevice(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax,`
16876	murrell	910	`dd);`
		911	`else`
		912	`getClipRect(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax, dd);`
		913	`for (i = 0; i < n; i++)`
		914	`clipPoint (Left, x[i], y[i], xout, yout, &cnt, store, &clip, cs);`
		915	`closeClip (xout, yout, &cnt, store, &clip, cs);`
		916	`return (cnt);`
		917	`}`
		918
		919	`static void clipPolygon(int n, double x, double y,`
27236	murrell	920	`R_GE_gcontext *gc,`
16876	murrell	921	`int toDevice, GEDevDesc *dd)`
		922	`{`
		923	`double xc = NULL, yc = NULL;`
		924	`/* if bg not specified then draw as polyline rather than polygon`
		925	`* to avoid drawing line along border of clipping region */`
27236	murrell	926	`if (gc->fill == NA_INTEGER) {`
16876	murrell	927	`int i;`
		928	`xc = (double*) R_alloc(n + 1, sizeof(double));`
		929	`yc = (double*) R_alloc(n + 1, sizeof(double));`
		930	`for (i=0; i<n; i++) {`
		931	`xc[i] = x[i];`
		932	`yc[i] = y[i];`
		933	`}`
		934	`xc[n] = x[0];`
		935	`yc[n] = y[0];`
27236	murrell	936	`GEPolyline(n+1, xc, yc, gc, dd);`
16876	murrell	937	`}`
		938	`else {`
		939	`int npts;`
		940	`xc = yc = 0; /* -Wall */`
		941	`npts = clipPoly(x, y, n, 0, toDevice, xc, yc, dd);`
		942	`if (npts > 1) {`
		943	`xc = (double*) R_alloc(npts, sizeof(double));`
		944	`yc = (double*) R_alloc(npts, sizeof(double));`
		945	`npts = clipPoly(x, y, n, 1, toDevice, xc, yc, dd);`
27236	murrell	946	`dd->dev->polygon(npts, xc, yc, gc, dd->dev);`
16876	murrell	947	`}`
		948	`}`
		949	`}`
		950
		951	`/****************************************************************`
		952	`* GEPolygon`
		953	`****************************************************************`
		954	`*/`
16946	maechler	955	`void GEPolygon(int n, double x, double y,`
27236	murrell	956	`R_GE_gcontext *gc,`
16876	murrell	957	`GEDevDesc *dd)`
		958	`{`
26787	murrell	959	`/*`
		960	`* Save (and reset below) the heap pointer to clean up`
		961	`* after any R_alloc's done by functions I call.`
		962	`*/`
		963	`char *vmaxsave = vmaxget();`
27236	murrell	964	`if (gc->lty == LTY_BLANK)`
26787	murrell	965	`/* "transparent" border */`
27236	murrell	966	`gc->col = NA_INTEGER;`
16876	murrell	967	`if (dd->dev->canClip) {`
26787	murrell	968	`/*`
		969	`* If the device can clip, then we just clip to the device`
		970	`* boundary and let the device do clipping within that.`
		971	`* We do this to avoid problems where writing WAY off the`
		972	`* device can cause problems for, e.g., ghostview`
		973	`*/`
27236	murrell	974	`clipPolygon(n, x, y, gc, 1, dd);`
16876	murrell	975	`}`
		976	`else`
26787	murrell	977	`/*`
		978	`* If the device can't clip, we have to do all the clipping`
		979	`* ourselves.`
		980	`*/`
27236	murrell	981	`clipPolygon(n, x, y, gc, 0, dd);`
26787	murrell	982	`vmaxset(vmaxsave);`
16876	murrell	983	`}`
		984
		985
		986	`/****************************************************************`
		987	`* R code for clipping circles`
		988	`****************************************************************`
		989	`*/`
		990	`/* Convert a circle into a polygon with specified number of vertices */`
		991	`static void convertCircle(double x, double y, double r,`
		992	`int numVertices, double xc, double yc)`
		993	`{`
		994	`int i;`
		995	`double theta = 2*M_PI/numVertices;`
		996	`for (i=0; i<numVertices; i++) {`
		997	`xc[i] = x + rsin(thetai);`
		998	`yc[i] = y + rcos(thetai);`
		999	`}`
		1000	`xc[numVertices] = x;`
		1001	`yc[numVertices] = y+r;`
		1002	`}`
		1003
		1004	`/* Takes a specification of a circle as input and returns a code indicating`
		1005	`how the circle should be clipped.`
		1006	`The return value will be -1 if the circle is to`
		1007	`be totally clipped out of existence, -2 if the circle is to be`
		1008	`totally left alone, 0 and above if the circle has been converted`
		1009	`into a polygon (in which case, the return value indicates the`
		1010	`number of vertices of the polygon and the function convertCircle()`
		1011	`should be called to obtain the vertices of the polygon). */`
		1012	`static int clipCircleCode(double x, double y, double r,`
		1013	`int toDevice, GEDevDesc *dd)`
		1014	`{`
		1015	`int result;`
		1016	`/* determine clipping region */`
		1017	`double xmin, xmax, ymin, ymax;`
		1018	`if (toDevice)`
		1019	`getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd);`
		1020	`else`
		1021	`getClipRect(&xmin, &ymin, &xmax, &ymax, dd);`
		1022
		1023	`/* if circle is all within clipping rect */`
		1024	`if (x-r > xmin && x+r < xmax && y-r > ymin && y+r < ymax) {`
		1025	`result = -2;`
		1026	`}`
		1027	`/* if circle is all outside clipping rect */`
		1028	`else {`
		1029	`double distance = r*r;`
		1030	`if (x-r > xmax \|\| x+r < xmin \|\| y-r > ymax \|\| y+r < ymin \|\|`
		1031	`(x < xmin && y < ymin &&`
		1032	`((x-xmin)(x-xmin)+(y-ymin)(y-ymin) > distance)) \|\|`
		1033	`(x > xmax && y < ymin &&`
		1034	`((x-xmax)(x-xmax)+(y-ymin)(y-ymin) > distance)) \|\|`
		1035	`(x < xmin && y > ymax &&`
		1036	`((x-xmin)(x-xmin)+(y-ymax)(y-ymax) > distance)) \|\|`
		1037	`(x > xmax && y > ymax &&`
		1038	`((x-xmax)(x-xmax)+(y-ymax)(y-ymax) > distance))) {`
		1039	`result = -1;`
		1040	`}`
		1041	`/* otherwise, convert circle to polygon */`
		1042	`else {`
		1043	`/* Replace circle with polygon.`
		1044
		1045	`Heuristic for number of vertices is to use theta so`
		1046	`that cos(theta)*r ~ r - 1 in device units. This is`
		1047	`roughly const * sqrt(r) so there'd be little point in`
		1048	`enforcing an upper limit. */`
		1049
		1050	`result = (r <= 6) ? 10 : 2 * M_PI/acos(1 - 1/r) ;`
		1051	`}`
		1052	`}`
		1053	`return result;`
		1054	`}`
		1055
		1056	`/****************************************************************`
		1057	`* GECircle`
		1058	`****************************************************************`
		1059	`*/`
		1060	`void GECircle(double x, double y, double radius,`
27236	murrell	1061	`R_GE_gcontext *gc,`
		1062	`GEDevDesc *dd)`
16876	murrell	1063	`{`
		1064	`char *vmax;`
		1065	`double xc, yc;`
		1066	`int result;`
		1067
26787	murrell	1068	`/*`
		1069	`* If the device can clip, then we just clip to the device`
		1070	`* boundary and let the device do clipping within that.`
		1071	`* We do this to avoid problems where writing WAY off the`
		1072	`* device can cause problems for, e.g., ghostview`
		1073	`*`
		1074	`* If the device can't clip, we have to do all the clipping`
		1075	`* ourselves.`
		1076	`*/`
		1077	`result = clipCircleCode(x, y, radius, dd->dev->canClip, dd);`
16876	murrell	1078
		1079	`switch (result) {`
		1080	`case -2: /* No clipping; draw all of circle */`
26787	murrell	1081	`/*`
		1082	`* If we did the clipping, then the circle is entirely`
		1083	`* within the current clipping rect.`
		1084	`*`
		1085	`* If the device can clip then we just clipped to the device`
		1086	`* boundary so the circle is entirely within the device; the`
		1087	`* device will perform the clipping to the current clipping rect.`
		1088	`*/`
27236	murrell	1089	`dd->dev->circle(x, y, radius, gc, dd->dev);`
16876	murrell	1090	`break;`
		1091	`case -1: /* Total clipping; draw nothing */`
26787	murrell	1092	`/*`
		1093	`* If we did the clipping, then the circle is entirely outside`
		1094	`* the current clipping rect, so there is nothing to draw.`
		1095	`*`
		1096	`* If the device can clip then we just determined that the`
		1097	`* circle is entirely outside the device, so again there is`
		1098	`* nothing to draw`
		1099	`*/`
16876	murrell	1100	`break;`
		1101	`default: /* Partial clipping; draw poly[line\|gon] */`
26787	murrell	1102	`/*`
		1103	`* If we did the clipping this means that the circle`
		1104	`* intersects the current clipping rect and we need to`
		1105	`* convert to a poly[line\|gon] and draw that.`
		1106	`*`
		1107	`* If the device can clip then we just determined that the`
		1108	`* circle intersects the device boundary. We assume that the`
		1109	`* circle is not so big that other parts may be WAY off the`
		1110	`* device and just draw a circle.`
		1111	`*/`
		1112	`if (dd->dev->canClip) {`
27236	murrell	1113	`dd->dev->circle(x, y, radius, gc, dd->dev);`
16876	murrell	1114	`}`
		1115	`else {`
		1116	`vmax = vmaxget();`
		1117	`xc = (double*)R_alloc(result+1, sizeof(double));`
		1118	`yc = (double*)R_alloc(result+1, sizeof(double));`
		1119	`convertCircle(x, y, radius, result, xc, yc);`
27236	murrell	1120	`if (gc->fill == NA_INTEGER) {`
		1121	`GEPolyline(result+1, xc, yc, gc, dd);`
16876	murrell	1122	`}`
		1123	`else {`
		1124	`int npts;`
		1125	`double xcc, ycc;`
		1126	`xcc = ycc = 0; /* -Wall */`
		1127	`npts = clipPoly(xc, yc, result, 0, !dd->dev->canClip,`
		1128	`xcc, ycc, dd);`
		1129	`if (npts > 1) {`
		1130	`xcc = (double*)R_alloc(npts, sizeof(double));`
		1131	`ycc = (double*)R_alloc(npts, sizeof(double));`
		1132	`npts = clipPoly(xc, yc, result, 1, !dd->dev->canClip,`
		1133	`xcc, ycc, dd);`
27236	murrell	1134	`dd->dev->polygon(npts, xcc, ycc, gc, dd->dev);`
16876	murrell	1135	`}`
		1136	`}`
		1137	`vmaxset(vmax);`
		1138	`}`
		1139	`}`
		1140	`}`
		1141
		1142	`/****************************************************************`
		1143	`* R code for clipping rectangles`
		1144	`****************************************************************`
		1145	`*/`
		1146	`/* Return a code indicating how the rectangle should be clipped.`
		1147
		1148	`1 means the rectangle is totally inside the clip region`
		1149	`2 means the rectangle intersects the clip region */`
16946	maechler	1150	`static int clipRectCode(double x0, double y0, double x1, double y1,`
16876	murrell	1151	`int toDevice, GEDevDesc *dd)`
		1152	`{`
		1153	`int result;`
		1154	`/* determine clipping region */`
		1155	`double xmin, xmax, ymin, ymax;`
		1156	`if (toDevice)`
		1157	`getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd);`
		1158	`else`
		1159	`getClipRect(&xmin, &ymin, &xmax, &ymax, dd);`
		1160
		1161	`if ((x0 < xmin && x1 < xmin) \|\| (x0 > xmax && x1 > xmax) \|\|`
		1162	`(y0 < ymin && y1 < ymin) \|\| (y0 > ymax && y1 > ymax))`
		1163	`result = 0;`
		1164	`else if ((x0 > xmin && x0 < xmax) && (x1 > xmin && x1 < xmax) &&`
		1165	`(y0 > ymin && y0 < ymax) && (y1 > ymin && y1 < ymax))`
		1166	`result = 1;`
		1167	`else`
		1168	`result = 2;`
16946	maechler	1169
16876	murrell	1170	`return result;`
		1171	`}`
		1172
		1173	`/****************************************************************`
		1174	`* GERect`
		1175	`****************************************************************`
		1176	`*/`
		1177	`/* Filled with color fill and outlined with color col */`
		1178	`/* These may both be NA_INTEGER */`
		1179	`void GERect(double x0, double y0, double x1, double y1,`
27236	murrell	1180	`R_GE_gcontext *gc,`
16876	murrell	1181	`GEDevDesc *dd)`
		1182	`{`
		1183	`char *vmax;`
		1184	`double xc, yc;`
		1185	`int result;`
		1186
26787	murrell	1187	`/*`
		1188	`* For clipping logic, see comments in GECircle`
		1189	`*/`
		1190	`result = clipRectCode(x0, y0, x1, y1, dd->dev->canClip, dd);`
16876	murrell	1191	`switch (result) {`
		1192	`case 0: /* rectangle totally clipped; draw nothing */`
		1193	`break;`
		1194	`case 1: /* rectangle totally inside; draw all */`
27236	murrell	1195	`dd->dev->rect(x0, y0, x1, y1, gc, dd->dev);`
16876	murrell	1196	`break;`
		1197	`case 2: /* rectangle intersects clip region; use polygon clipping */`
26787	murrell	1198	`if (dd->dev->canClip)`
27236	murrell	1199	`dd->dev->rect(x0, y0, x1, y1, gc, dd->dev);`
16876	murrell	1200	`else {`
		1201	`vmax = vmaxget();`
		1202	`xc = (double*)R_alloc(5, sizeof(double));`
		1203	`yc = (double*)R_alloc(5, sizeof(double));`
		1204	`xc[0] = x0; yc[0] = y0;`
		1205	`xc[1] = x0; yc[1] = y1;`
		1206	`xc[2] = x1; yc[2] = y1;`
		1207	`xc[3] = x1; yc[3] = y0;`
		1208	`xc[4] = x0; yc[4] = y0;`
27236	murrell	1209	`if (gc->fill == NA_INTEGER) {`
		1210	`GEPolyline(5, xc, yc, gc, dd);`
16876	murrell	1211	`}`
		1212	`else { /* filled rectangle */`
		1213	`int npts;`
		1214	`double xcc, ycc;`
		1215	`xcc = ycc = 0; /* -Wall */`
		1216	`npts = clipPoly(xc, yc, 4, 0, !dd->dev->canClip, xcc, ycc, dd);`
		1217	`if (npts > 1) {`
		1218	`xcc = (double*)R_alloc(npts, sizeof(double));`
		1219	`ycc = (double*)R_alloc(npts, sizeof(double));`
		1220	`npts = clipPoly(xc, yc, 4, 1, !dd->dev->canClip, xcc, ycc, dd);`
27236	murrell	1221	`dd->dev->polygon(npts, xcc, ycc, gc, dd->dev);`
16876	murrell	1222	`}`
		1223	`}`
		1224	`vmaxset(vmax);`
		1225	`}`
		1226	`}`
		1227	`}`
		1228
		1229	`/****************************************************************`
		1230	`* R code for clipping text`
		1231	`****************************************************************`
		1232	`*/`
		1233
		1234	`/* Return a code indicating how the text should be clipped`
		1235	`NOTE that x, y indicate the bottom-left of the text`
		1236	`NOTE also also that this is a bit crude because it actually uses`
		1237	`a bounding box for the entire text to determine the clipping code.`
		1238	`This will mean that in certain (very rare ?) cases, a piece of`
		1239	`text will be characterised as intersecting with the clipping region`
		1240	`when in fact it lies totally outside the clipping region. But`
		1241	`this is not a problem because the final output will still be correct.`
		1242
		1243	`1 means totally inside clip region`
		1244	`2 means intersects clip region */`
		1245	`static int clipTextCode(double x, double y, char *str,`
16946	maechler	1246	`double rot, double hadj,`
27236	murrell	1247	`R_GE_gcontext *gc,`
16876	murrell	1248	`int toDevice, GEDevDesc *dd)`
		1249	`{`
		1250	`double x0, x1, x2, x3, y0, y1, y2, y3, left, right, bottom, top;`
		1251	`double angle = DEG2RAD * rot;`
		1252	`double theta1 = M_PI/2 - angle;`
27236	murrell	1253	`double width = GEStrWidth(str, gc, dd);`
		1254	`double height = GEStrHeight(str, gc, dd);`
16876	murrell	1255	`#ifdef HAVE_HYPOT`
		1256	`double length = hypot(width, height);`
		1257	`#else`
		1258	`double length = pythag(width, height);`
		1259	`#endif`
		1260	`double theta2 = angle + atan2(height, width);`
		1261	`x -= hadjwidthcos(angle);`
		1262	`y -= hadjwidthsin(angle);`
		1263	`x0 = x + height*cos(theta1);`
		1264	`x1 = x;`
		1265	`x2 = x + length*cos(theta2);`
		1266	`x3 = x + width*cos(angle);`
		1267	`y0 = y + height*sin(theta1);`
		1268	`y1 = y;`
		1269	`y2 = y + length*sin(theta2);`
		1270	`y3 = y + width*sin(angle);`
		1271	`left = fmin2(fmin2(x0, x1), fmin2(x2, x3));`
		1272	`right = fmax2(fmax2(x0, x1), fmax2(x2, x3));`
		1273	`bottom = fmin2(fmin2(y0, y1), fmin2(y2, y3));`
		1274	`top = fmax2(fmax2(y0, y1), fmax2(y2, y3));`
		1275	`return clipRectCode(left, bottom, right, top, toDevice, dd);`
		1276	`}`
		1277
16946	maechler	1278	`static void clipText(double x, double y, char *str, double rot, double hadj,`
27236	murrell	1279	`R_GE_gcontext *gc,`
16876	murrell	1280	`int toDevice, GEDevDesc *dd)`
		1281	`{`
27236	murrell	1282	`int result = clipTextCode(x, y, str, rot, hadj, gc,`
16876	murrell	1283	`toDevice, dd);`
		1284	`switch (result) {`
		1285	`case 0: /* text totally clipped; draw nothing */`
		1286	`break;`
		1287	`case 1: /* text totally inside; draw all */`
21062	murrell	1288	`/*`
		1289	`* FIXME: Pass on the fontfamily, fontface, and`
		1290	`* lineheight so that the device can use them`
		1291	`* if it wants to.`
		1292	`* NOTE: fontface corresponds to old "font"`
		1293	`*/`
27236	murrell	1294	`dd->dev->text(x, y, str, rot, hadj, gc, dd->dev);`
16876	murrell	1295	`break;`
		1296	`case 2: /* text intersects clip region`
		1297	`act according to value of clipToDevice */`
		1298	`if (toDevice) /* Device will do clipping */`
21062	murrell	1299	`/*`
		1300	`* FIXME: Pass on the fontfamily, fontface, and`
		1301	`* lineheight so that the device can use them`
		1302	`* if it wants to.`
		1303	`* NOTE: fontface corresponds to old "font"`
		1304	`*/`
27236	murrell	1305	`dd->dev->text(x, y, str, rot, hadj, gc, dd->dev);`
16876	murrell	1306	`else /* don't draw anything; this could be made less crude :) */`
		1307	`;`
		1308	`}`
		1309	`}`
		1310
		1311	`/****************************************************************`
21062	murrell	1312	`* Code for determining when to branch to vfont code from GEText`
		1313	`****************************************************************`
		1314	`*/`
		1315
		1316	`typedef struct {`
		1317	`char *name;`
		1318	`int minface;`
		1319	`int maxface;`
		1320	`} VFontTab;`
		1321
		1322	`static VFontTab`
		1323	`VFontTable[] = {`
		1324	`{ "HersheySerif", 1, 7 },`
		1325	`/*`
		1326	`HersheySerif`
		1327	`HersheySerif-Italic`
		1328	`HersheySerif-Bold`
		1329	`HersheySerif-BoldItalic`
		1330	`HersheyCyrillic`
		1331	`HersheyCyrillic-Oblique`
		1332	`HersheyEUC`
		1333	`*/`
		1334	`{ "HersheySans", 1, 4 },`
		1335	`/*`
		1336	`HersheySans`
		1337	`HersheySans-Oblique`
		1338	`HersheySans-Bold`
		1339	`HersheySans-BoldOblique`
		1340	`*/`
		1341	`{ "HersheyScript", 1, 4 },`
		1342	`/*`
		1343	`HersheyScript`
		1344	`HersheyScript`
		1345	`HersheyScript-Bold`
		1346	`HersheyScript-Bold`
		1347	`*/`
		1348	`{ "HersheyGothicEnglish", 1, 1 },`
		1349	`{ "HersheyGothicGerman", 1, 1 },`
		1350	`{ "HersheyGothicItalian", 1, 1 },`
		1351	`{ "HersheySymbol", 1, 4 },`
		1352	`/*`
		1353	`HersheySerifSymbol`
		1354	`HersheySerifSymbol-Oblique`
		1355	`HersheySerifSymbol-Bold`
		1356	`HersheySerifSymbol-BoldOblique`
		1357	`*/`
		1358	`{ "HersheySansSymbol", 1, 2 },`
		1359	`/*`
		1360	`HersheySansSymbol`
		1361	`HersheySansSymbol-Oblique`
		1362	`*/`
		1363
		1364	`{ NULL, 0, 0 },`
		1365	`};`
		1366
		1367	`static int VFontFamilyCode(char *fontfamily)`
		1368	`{`
		1369	`int i;`
		1370	`for (i = 0; VFontTable[i].minface; i++)`
		1371	`if (!strcmp(fontfamily, VFontTable[i].name))`
		1372	`return i;`
		1373	`return -1;`
		1374	`}`
		1375
		1376
		1377	`/****************************************************************`
16876	murrell	1378	`* GEText`
		1379	`****************************************************************`
		1380	`*/`
		1381	`/* If you want EXACT centering of text (e.g., like in GSymbol) */`
		1382	`/* then pass NA_REAL for xc and yc */`
		1383	`void GEText(double x, double y, char *str,`
21062	murrell	1384	`double xc, double yc, double rot,`
27236	murrell	1385	`R_GE_gcontext *gc,`
21062	murrell	1386	`GEDevDesc *dd)`
16876	murrell	1387	`{`
21062	murrell	1388	`/*`
		1389	`* If the fontfamily is a Hershey font family, call R_GE_VText`
		1390	`*/`
27236	murrell	1391	`int vfontcode = VFontFamilyCode(gc->fontfamily);`
21062	murrell	1392	`if (vfontcode >= 0) {`
27236	murrell	1393	`gc->fontfamily[0] = vfontcode;`
21062	murrell	1394	`/*`
		1395	`* R's "font" par has historically made 2=bold and 3=italic`
		1396	`* These must be switched to correspond to Hershey fontfaces`
		1397	`*/`
27236	murrell	1398	`if (gc->fontface == 2)`
		1399	`gc->fontface = 3;`
		1400	`else if (gc->fontface == 3)`
		1401	`gc->fontface = 2;`
		1402	`R_GE_VText(x, y, str, xc, yc, rot, gc, dd);`
21062	murrell	1403
		1404	`} else {`
16876	murrell	1405	`char *sbuf = NULL;`
		1406	`if(str && *str) {`
		1407	`char s, sb;`
		1408	`int i, n;`
		1409	`double xoff, yoff, hadj;`
		1410	`double sin_rot, cos_rot;/* sin() & cos() of rot{ation} in radians */`
		1411	`double xleft, ybottom;`
		1412	`/* We work in GE_INCHES */`
16946	maechler	1413	`x = fromDeviceX(x, GE_INCHES, dd);`
16876	murrell	1414	`y = fromDeviceY(y, GE_INCHES, dd);`
		1415	`/* Count the lines of text */`
		1416	`n = 1;`
		1417	`for(s = str; *s ; s++)`
		1418	`if (*s == '\n')`
		1419	`n += 1;`
		1420	`/* Allocate a temporary buffer */`
		1421	`sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char));`
		1422	`sb = sbuf;`
		1423	`i = 0;`
		1424	`sin_rot = DEG2RAD * rot;`
		1425	`cos_rot = cos(sin_rot);`
		1426	`sin_rot = sin(sin_rot);`
		1427	`for(s = str; ; s++) {`
		1428	`if (s == '\n' \|\| s == '\0') {`
		1429	`*sb = '\0';`
		1430	`if (n > 1) {`
		1431	`/* first determine location of THIS line */`
		1432	`if (!R_FINITE(xc))`
		1433	`xc = 0.5;`
		1434	`if (!R_FINITE(yc))`
		1435	`yc = 0.5;`
		1436	`yoff = (1 - yc)*(n - 1) - i;`
20177	murrell	1437	`/* cra is based on the font pointsize at the`
		1438	`* time the device was created.`
		1439	`* Adjust for potentially different current pointsize.`
		1440	`* This is a crude calculation that might be better`
		1441	`* performed using a device call that responds with`
		1442	`* the current font pointsize in device coordinates.`
		1443	`*/`
27236	murrell	1444	`yoff = fromDeviceHeight(yoff * gc->lineheight *`
		1445	`gc->cex * dd->dev->cra[1] *`
		1446	`gc->ps/dd->dev->startps,`
16876	murrell	1447	`GE_INCHES, dd);`
		1448	`xoff = - yoff*sin_rot;`
		1449	`yoff = yoff*cos_rot;`
		1450	`xoff = x + xoff;`
		1451	`yoff = y + yoff;`
		1452	`} else {`
		1453	`xoff = x;`
		1454	`yoff = y;`
		1455	`}`
		1456	`/* now determine bottom-left for THIS line */`
		1457	`if(xc != 0.0 \|\| yc != 0) {`
		1458	`double width, height;`
27236	murrell	1459	`width = fromDeviceWidth(GEStrWidth(sbuf, gc, dd),`
16876	murrell	1460	`GE_INCHES, dd);`
		1461	`if (!R_FINITE(xc))`
		1462	`xc = 0.5;`
		1463	`if (!R_FINITE(yc)) {`
		1464	`/* "exact" vertical centering */`
		1465	`/* If font metric info is available AND */`
		1466	`/* there is only one line, use GMetricInfo & yc=0.5 */`
		1467	`/* Otherwise use GEStrHeight and fiddle yc */`
		1468	`double h, d, w;`
27236	murrell	1469	`GEMetricInfo(0, gc, &h, &d, &w, dd);`
16876	murrell	1470	`if (n>1 \|\| (h==0 && d==0 && w==0)) {`
27236	murrell	1471	`height = fromDeviceHeight(GEStrHeight(sbuf, gc,`
		1472	`dd),`
16876	murrell	1473	`GE_INCHES, dd);`
		1474	`yc = dd->dev->yCharOffset;`
		1475	`} else {`
		1476	`double maxHeight = 0.0;`
		1477	`double maxDepth = 0.0;`
		1478	`char *ss;`
		1479	`int charNum = 0;`
		1480	`for (ss=sbuf; *ss; ss++) {`
27236	murrell	1481	`GEMetricInfo((unsigned char) *ss, gc,`
		1482	`&h, &d, &w, dd);`
18890	murrell	1483	`h = fromDeviceHeight(h, GE_INCHES, dd);`
		1484	`d = fromDeviceHeight(d, GE_INCHES, dd);`
16876	murrell	1485	`/* Set maxHeight and maxDepth from height`
		1486	`and depth of first char.`
		1487	`Must NOT set to 0 in case there is`
		1488	`only 1 char and it has negative`
		1489	`height or depth`
		1490	`*/`
		1491	`if (charNum++ == 0) {`
		1492	`maxHeight = h;`
		1493	`maxDepth = d;`
		1494	`} else {`
		1495	`if (h > maxHeight) maxHeight = h;`
		1496	`if (d > maxDepth) maxDepth = d;`
		1497	`}`
		1498	`}`
		1499	`height = maxHeight - maxDepth;`
		1500	`yc = 0.5;`
		1501	`}`
		1502	`} else {`
27236	murrell	1503	`height = fromDeviceHeight(GEStrHeight(sbuf, gc,`
		1504	`dd),`
16876	murrell	1505	`GE_INCHES, dd);`
		1506	`}`
		1507	`if (dd->dev->canHAdj == 2) hadj = xc;`
		1508	`else if (dd->dev->canHAdj == 1) {`
		1509	`hadj = 0.5 * floor(2*xc + 0.5);`
		1510	`/* limit to 0, 0.5, 1 */`
		1511	`hadj = (hadj > 1.0) ? 1.0 :((hadj < 0.0) ? 0.0 : hadj);`
		1512	`} else hadj = 0.0;`
		1513	`xleft = xoff - (xc-hadj)widthcos_rot + ycheightsin_rot;`
16946	maechler	1514	`ybottom= yoff - (xc-hadj)widthsin_rot -`
16876	murrell	1515	`ycheightcos_rot;`
		1516	`} else { /* xc = yc = 0.0 */`
		1517	`xleft = xoff;`
		1518	`ybottom = yoff;`
		1519	`hadj = 0.0;`
		1520	`}`
		1521	`/* Convert GE_INCHES back to device.`
		1522	`*/`
		1523	`xleft = toDeviceX(xleft, GE_INCHES, dd);`
		1524	`ybottom = toDeviceY(ybottom, GE_INCHES, dd);`
		1525	`if(dd->dev->canClip) {`
27236	murrell	1526	`clipText(xleft, ybottom, sbuf, rot, hadj, gc, 1, dd);`
16876	murrell	1527	`} else`
27236	murrell	1528	`clipText(xleft, ybottom, sbuf, rot, hadj, gc, 0, dd);`
16876	murrell	1529	`sb = sbuf;`
		1530	`i += 1;`
		1531	`}`
		1532	`else sb++ = s;`
		1533	`if (!*s) break;`
		1534	`}`
		1535	`}`
21062	murrell	1536	`}`
16876	murrell	1537	`}`
		1538
		1539	`/****************************************************************`
		1540	`* GEMode`
		1541	`****************************************************************`
		1542	`*/`
		1543	`/* Check that everything is initialized :`
		1544	`Interpretation :`
		1545	`mode = 0, graphics off`
		1546	`mode = 1, graphics on`
		1547	`mode = 2, graphical input on (ignored by most drivers)`
		1548	`*/`
		1549	`void GEMode(int mode, GEDevDesc *dd)`
		1550	`{`
		1551	`if (NoDevices())`
		1552	`error("No graphics device is active");`
		1553	`dd->dev->mode(mode, dd->dev);`
		1554	`}`
		1555
		1556	`/****************************************************************`
		1557	`* GESymbol`
		1558	`****************************************************************`
		1559	`*/`
		1560	`#define SMALL 0.25`
16946	maechler	1561	`#define RADIUS 0.375`
16876	murrell	1562	`#define SQRC 0.88622692545275801364 /* sqrt(pi / 4) */`
		1563	`#define DMDC 1.25331413731550025119 /* sqrt(pi / 4) * sqrt(2) */`
		1564	`#define TRC0 1.55512030155621416073 /* sqrt(4 * pi/(3 * sqrt(3))) */`
		1565	`#define TRC1 1.34677368708859836060 /* TRC0 * sqrt(3) / 2 */`
		1566	`#define TRC2 0.77756015077810708036 /* TRC0 / 2 */`
		1567	`/* Draw one of the R special symbols. */`
		1568	`/* "size" is in device coordinates and is assumed to be a width`
16946	maechler	1569	`* rather than a height.`
16876	murrell	1570	`* This could cause a problem for devices which have ipr[0] != ipr[1]`
		1571	`* The problem would be evident where calculations are done on`
		1572	`* angles -- in those cases, a conversion to and from GE_INCHES is done`
		1573	`* to preserve angles.`
		1574	`*/`
16946	maechler	1575	`void GESymbol(double x, double y, int pch, double size,`
27236	murrell	1576	`R_GE_gcontext *gc,`
16876	murrell	1577	`GEDevDesc *dd)`
		1578	`{`
		1579	`double r, xc, yc;`
		1580	`double xx[4], yy[4];`
		1581	`char str[2];`
		1582
		1583	`/* Special cases for plotting pch="." or pch=<character>`
		1584	`*/`
		1585	`if(' ' <= pch && pch <= 255) {`
		1586	`if (pch == '.') {`
26787	murrell	1587	`/*`
		1588	`* NOTE: we are filling a rect with the current`
		1589	`* colour (we are not drawing the border AND we are`
		1590	`* not using the current fill colour)`
		1591	`*/`
27236	murrell	1592	`gc->fill = gc->col;`
		1593	`gc->col = NA_INTEGER;`
		1594	`GERect(x-.5, y-.5, x+.5, y+.5, gc, dd);`
16876	murrell	1595	`} else {`
		1596	`str[0] = pch;`
		1597	`str[1] = '\0';`
27236	murrell	1598	`GEText(x, y, str, NA_REAL, NA_REAL, 0., gc, dd);`
16876	murrell	1599	`}`
		1600	`}`
		1601	`else {`
		1602	`double GSTR_0 = fromDeviceWidth(size, GE_INCHES, dd);`
		1603
		1604	`switch(pch) {`
		1605
		1606	`case 0: /* S square */`
		1607	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1608	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1609	`gc->fill = NA_INTEGER;`
		1610	`GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);`
16876	murrell	1611	`break;`
		1612
		1613	`case 1: /* S octahedron ( circle) */`
		1614	`xc = RADIUS * size;`
27236	murrell	1615	`gc->fill = NA_INTEGER;`
		1616	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1617	`break;`
		1618
		1619	`case 2: /* S triangle - point up */`
		1620	`xc = RADIUS * GSTR_0;`
		1621	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1622	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
		1623	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1624	`xx[0] = x; yy[0] = y+r;`
		1625	`xx[1] = x+xc; yy[1] = y-yc;`
		1626	`xx[2] = x-xc; yy[2] = y-yc;`
27236	murrell	1627	`gc->fill = NA_INTEGER;`
		1628	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1629	`break;`
		1630
		1631	`case 3: /* S plus */`
		1632	`xc = toDeviceWidth(M_SQRT2RADIUSGSTR_0, GE_INCHES, dd);`
		1633	`yc = toDeviceHeight(M_SQRT2RADIUSGSTR_0, GE_INCHES, dd);`
27236	murrell	1634	`GELine(x-xc, y, x+xc, y, gc, dd);`
		1635	`GELine(x, y-yc, x, y+yc, gc, dd);`
16876	murrell	1636	`break;`
		1637
		1638	`case 4: /* S times */`
		1639	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1640	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1641	`GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);`
		1642	`GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);`
16876	murrell	1643	`break;`
		1644
		1645	`case 5: /* S diamond */`
		1646	`xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);`
		1647	`yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);`
		1648	`xx[0] = x-xc; yy[0] = y;`
		1649	`xx[1] = x; yy[1] = y+yc;`
		1650	`xx[2] = x+xc; yy[2] = y;`
		1651	`xx[3] = x; yy[3] = y-yc;`
27236	murrell	1652	`gc->fill = NA_INTEGER;`
		1653	`GEPolygon(4, xx, yy, gc, dd);`
16876	murrell	1654	`break;`
		1655
		1656	`case 6: /* S triangle - point down */`
		1657	`xc = RADIUS * GSTR_0;`
		1658	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1659	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
		1660	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1661	`xx[0] = x; yy[0] = y-r;`
		1662	`xx[1] = x+xc; yy[1] = y+yc;`
		1663	`xx[2] = x-xc; yy[2] = y+yc;`
27236	murrell	1664	`gc->fill = NA_INTEGER;`
		1665	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1666	`break;`
		1667
		1668	`case 7: /* S square and times superimposed */`
		1669	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1670	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1671	`gc->fill = NA_INTEGER;`
		1672	`GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);`
		1673	`GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);`
		1674	`GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);`
16876	murrell	1675	`break;`
		1676
		1677	`case 8: /* S plus and times superimposed */`
		1678	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1679	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1680	`GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);`
		1681	`GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);`
16876	murrell	1682	`xc = toDeviceWidth(M_SQRT2RADIUSGSTR_0, GE_INCHES, dd);`
		1683	`yc = toDeviceHeight(M_SQRT2RADIUSGSTR_0, GE_INCHES, dd);`
27236	murrell	1684	`GELine(x-xc, y, x+xc, y, gc, dd);`
		1685	`GELine(x, y-yc, x, y+yc, gc, dd);`
16876	murrell	1686	`break;`
		1687
		1688	`case 9: /* S diamond and plus superimposed */`
		1689	`xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);`
		1690	`yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1691	`GELine(x-xc, y, x+xc, y, gc, dd);`
		1692	`GELine(x, y-yc, x, y+yc, gc, dd);`
16876	murrell	1693	`xx[0] = x-xc; yy[0] = y;`
		1694	`xx[1] = x; yy[1] = y+yc;`
		1695	`xx[2] = x+xc; yy[2] = y;`
		1696	`xx[3] = x; yy[3] = y-yc;`
27236	murrell	1697	`gc->fill = NA_INTEGER;`
		1698	`GEPolygon(4, xx, yy, gc, dd);`
16876	murrell	1699	`break;`
		1700
		1701	`case 10: /* S hexagon (circle) and plus superimposed */`
26787	murrell	1702	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1703	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1704	`gc->fill = NA_INTEGER;`
		1705	`GECircle(x, y, xc, gc, dd);`
		1706	`GELine(x-xc, y, x+xc, y, gc, dd);`
		1707	`GELine(x, y-yc, x, y+yc, gc, dd);`
16876	murrell	1708	`break;`
		1709
		1710	`case 11: /* S superimposed triangles */`
		1711	`xc = RADIUS * GSTR_0;`
		1712	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1713	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
26787	murrell	1714	`yc = 0.5 * (yc + r);`
16876	murrell	1715	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1716	`xx[0] = x; yy[0] = y-r;`
		1717	`xx[1] = x+xc; yy[1] = y+yc;`
		1718	`xx[2] = x-xc; yy[2] = y+yc;`
27236	murrell	1719	`gc->fill = NA_INTEGER;`
		1720	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1721	`xx[0] = x; yy[0] = y+r;`
		1722	`xx[1] = x+xc; yy[1] = y-yc;`
		1723	`xx[2] = x-xc; yy[2] = y-yc;`
27236	murrell	1724	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1725	`break;`
		1726
		1727	`case 12: /* S square and plus superimposed */`
26787	murrell	1728	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1729	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1730	`GELine(x-xc, y, x+xc, y, gc, dd);`
		1731	`GELine(x, y-yc, x, y+yc, gc, dd);`
		1732	`gc->fill = NA_INTEGER;`
		1733	`GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);`
16876	murrell	1734	`break;`
		1735
		1736	`case 13: /* S octagon (circle) and times superimposed */`
		1737	`xc = RADIUS * size;`
27236	murrell	1738	`gc->fill = NA_INTEGER;`
		1739	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1740	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1741	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
27236	murrell	1742	`GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);`
		1743	`GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);`
16876	murrell	1744	`break;`
		1745
		1746	`case 14: /* S square and point-up triangle superimposed */`
		1747	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
26787	murrell	1748	`xx[0] = x; yy[0] = y+xc;`
		1749	`xx[1] = x+xc; yy[1] = y-xc;`
		1750	`xx[2] = x-xc; yy[2] = y-xc;`
27236	murrell	1751	`gc->fill = NA_INTEGER;`
		1752	`GEPolygon(3, xx, yy, gc, dd);`
		1753	`GERect(x-xc, y-xc, x+xc, y+xc, gc, dd);`
16876	murrell	1754	`break;`
		1755
		1756	`case 15: /* S filled square */`
		1757	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1758	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
		1759	`xx[0] = x-xc; yy[0] = y-yc;`
		1760	`xx[1] = x+xc; yy[1] = y-yc;`
		1761	`xx[2] = x+xc; yy[2] = y+yc;`
		1762	`xx[3] = x-xc; yy[3] = y+yc;`
27236	murrell	1763	`gc->fill = gc->col;`
		1764	`gc->col = NA_INTEGER;`
		1765	`GEPolygon(4, xx, yy, gc, dd);`
16876	murrell	1766	`break;`
		1767
		1768	`case 16: /* S filled octagon (circle) */`
		1769	`xc = RADIUS * size;`
27236	murrell	1770	`gc->fill = gc->col;`
		1771	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1772	`break;`
		1773
		1774	`case 17: /* S filled point-up triangle */`
		1775	`xc = RADIUS * GSTR_0;`
		1776	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1777	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
		1778	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1779	`xx[0] = x; yy[0] = y+r;`
		1780	`xx[1] = x+xc; yy[1] = y-yc;`
		1781	`xx[2] = x-xc; yy[2] = y-yc;`
27236	murrell	1782	`gc->fill = gc->col;`
		1783	`gc->col = NA_INTEGER;`
		1784	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1785	`break;`
		1786
		1787	`case 18: /* S filled diamond */`
26787	murrell	1788	`xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);`
		1789	`yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);`
16876	murrell	1790	`xx[0] = x-xc; yy[0] = y;`
		1791	`xx[1] = x; yy[1] = y+yc;`
		1792	`xx[2] = x+xc; yy[2] = y;`
		1793	`xx[3] = x; yy[3] = y-yc;`
27236	murrell	1794	`gc->fill = gc->col;`
		1795	`gc->col = NA_INTEGER;`
		1796	`GEPolygon(4, xx, yy, gc, dd);`
16876	murrell	1797	`break;`
		1798
		1799	`case 19: /* R filled circle */`
		1800	`xc = RADIUS * size;`
27236	murrell	1801	`gc->fill = gc->col;`
		1802	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1803	`break;`
		1804
		1805
		1806	case 20: /* R `Dot' (small circle) */
		1807	`xc = SMALL * size;`
27236	murrell	1808	`gc->fill = gc->col;`
		1809	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1810	`break;`
		1811
		1812
		1813	`case 21: /* circles */`
		1814	`xc = RADIUS * size;`
27236	murrell	1815	`GECircle(x, y, xc, gc, dd);`
16876	murrell	1816	`break;`
		1817
		1818	`case 22: /* squares */`
		1819	`xc = toDeviceWidth(RADIUS * SQRC * GSTR_0, GE_INCHES, dd);`
		1820	`yc = toDeviceHeight(RADIUS * SQRC * GSTR_0, GE_INCHES, dd);`
27236	murrell	1821	`GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);`
16876	murrell	1822	`break;`
		1823
		1824	`case 23: /* diamonds */`
		1825	`xc = toDeviceWidth(RADIUS * DMDC * GSTR_0, GE_INCHES, dd);`
		1826	`yc = toDeviceHeight(RADIUS * DMDC * GSTR_0, GE_INCHES, dd);`
		1827	`xx[0] = x ; yy[0] = y-yc;`
		1828	`xx[1] = x+xc; yy[1] = y;`
		1829	`xx[2] = x ; yy[2] = y+yc;`
		1830	`xx[3] = x-xc; yy[3] = y;`
27236	murrell	1831	`GEPolygon(4, xx, yy, gc, dd);`
16876	murrell	1832	`break;`
		1833
		1834	`case 24: /* triangle (point up) */`
		1835	`xc = RADIUS * GSTR_0;`
		1836	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1837	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
		1838	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1839	`xx[0] = x; yy[0] = y+r;`
		1840	`xx[1] = x+xc; yy[1] = y-yc;`
		1841	`xx[2] = x-xc; yy[2] = y-yc;`
27236	murrell	1842	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1843	`break;`
		1844
		1845	`case 25: /* triangle (point down) */`
		1846	`xc = RADIUS * GSTR_0;`
		1847	`r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);`
		1848	`yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);`
		1849	`xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);`
		1850	`xx[0] = x; yy[0] = y-r;`
		1851	`xx[1] = x+xc; yy[1] = y+yc;`
		1852	`xx[2] = x-xc; yy[2] = y+yc;`
27236	murrell	1853	`GEPolygon(3, xx, yy, gc, dd);`
16876	murrell	1854	`break;`
		1855	`}`
		1856	`}`
		1857	`}`
		1858
		1859	`/****************************************************************`
		1860	`* GEPretty`
		1861	`****************************************************************`
		1862	`*/`
		1863	`void GEPretty(double lo, double up, int *ndiv)`
		1864	`{`
		1865	`/* Set scale and ticks for linear scales.`
		1866	`*`
		1867	`* Pre: x1 == lo < up == x2 ; ndiv >= 1`
		1868	`* Post: x1 <= y1 := lo < up =: y2 <= x2; ndiv >= 1`
		1869	`*/`
		1870	`double unit, ns, nu;`
		1871	`double high_u_fact[2] = { .8, 1.7 };`
		1872	`#ifdef DEBUG_PLOT`
		1873	`double x1,x2;`
		1874	`#endif`
		1875
		1876	`if(*ndiv <= 0)`
		1877	`error("invalid axis extents [GEPretty(.,.,n=%d)", *ndiv);`
		1878	`if(lo == R_PosInf \|\| up == R_PosInf \|\|`
		1879	`lo == R_NegInf \|\| up == R_NegInf \|\|`
		1880	`!R_FINITE(up - lo)) {`
		1881	`error("Infinite axis extents [GEPretty(%g,%g,%d)]", lo, up, *ndiv);`
		1882	`return;/-Wall/`
		1883	`}`
		1884
		1885	`ns = lo; nu = up;`
		1886	`#ifdef DEBUG_PLOT`
		1887	`x1 = ns; x2 = nu;`
		1888	`#endif`
		1889	`unit = R_pretty0(&ns, &nu, ndiv, /* min_n = */ 1,`
		1890	`/* shrink_sml = */ 0.25,`
		1891	`high_u_fact,`
		1892	`2, /* do eps_correction in any case */`
		1893
		1894	`/* ==> ../appl/pretty.c */`
		1895
		1896	`/* The following is ugly since it kind of happens already in Rpretty0(..):`
		1897	`*/`
		1898	`#define rounding_eps 1e-7`
		1899	`if(nu >= ns + 1) {`
		1900	`if( ns * unit < lo - rounding_epsunit)`
		1901	`ns++;`
		1902	`if(nu > ns + 1 && nu * unit > up + rounding_epsunit)`
		1903	`nu--;`
		1904	`*ndiv = nu - ns;`
		1905	`}`
		1906	`lo = ns unit;`
		1907	`up = nu unit;`
		1908	`#ifdef non_working_ALTERNATIVE`
		1909	`if(ns * unit > *lo)`
		1910	`lo = ns unit;`
		1911	`if(nu * unit < *up)`
		1912	`up = nu unit;`
		1913	`if(nu - ns >= 1)`
		1914	`*ndiv = nu - ns;`
		1915	`#endif`
		1916
		1917	`#ifdef DEBUG_PLOT`
		1918	`if(*lo < x1)`
		1919	`warning(" .. GEPretty(.): new lo = %g < %g = x1", lo, x1);`
		1920	`if(*up > x2)`
		1921	`warning(" .. GEPretty(.): new up = %g > %g = x2", up, x2);`
		1922	`#endif`
		1923	`}`
		1924
		1925	`/****************************************************************`
		1926	`* GEMetricInfo`
		1927	`****************************************************************`
		1928	`*/`
27236	murrell	1929	`void GEMetricInfo(int c,`
		1930	`R_GE_gcontext *gc,`
16876	murrell	1931	`double ascent, double descent, double *width,`
		1932	`GEDevDesc *dd)`
		1933	`{`
27236	murrell	1934	`dd->dev->metricInfo(c & 0xFF, gc, ascent, descent, width, dd->dev);`
16876	murrell	1935	`}`
		1936
		1937	`/****************************************************************`
		1938	`* GEStrWidth`
		1939	`****************************************************************`
		1940	`*/`
21062	murrell	1941	`double GEStrWidth(char *str,`
27236	murrell	1942	`R_GE_gcontext *gc,`
		1943	`GEDevDesc *dd)`
16876	murrell	1944	`{`
21062	murrell	1945	`/*`
		1946	`* If the fontfamily is a Hershey font family, call R_GE_VStrWidth`
		1947	`*/`
27236	murrell	1948	`int vfontcode = VFontFamilyCode(gc->fontfamily);`
21062	murrell	1949	`if (vfontcode >= 0) {`
27236	murrell	1950	`gc->fontfamily[0] = vfontcode;`
21062	murrell	1951	`/*`
		1952	`* R's "font" par has historically made 2=bold and 3=italic`
		1953	`* These must be switched to correspond to Hershey fontfaces`
		1954	`*/`
27236	murrell	1955	`if (gc->fontface == 2)`
		1956	`gc->fontface = 3;`
		1957	`else if (gc->fontface == 3)`
		1958	`gc->fontface = 2;`
		1959	`return R_GE_VStrWidth((unsigned char *) str, gc, dd);`
21062	murrell	1960	`} else {`
		1961	`double w;`
		1962	`char *sbuf = NULL;`
		1963	`w = 0;`
		1964	`if(str && *str) {`
		1965	`char s, sb;`
		1966	`double wdash;`
		1967	`sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char));`
		1968	`sb = sbuf;`
		1969	`for(s = str; ; s++) {`
		1970	`if (s == '\n' \|\| s == '\0') {`
		1971	`*sb = '\0';`
		1972	`/*`
		1973	`* FIXME: Pass on the fontfamily, fontface, and`
		1974	`* lineheight so that the device can use them`
		1975	`* if it wants to.`
		1976	`* NOTE: fontface corresponds to old "font"`
		1977	`*/`
27236	murrell	1978	`wdash = dd->dev->strWidth(sbuf, gc, dd->dev);`
21062	murrell	1979	`if (wdash > w) w = wdash;`
		1980	`sb = sbuf;`
		1981	`}`
		1982	`else sb++ = s;`
		1983	`if (!*s) break;`
16876	murrell	1984	`}`
		1985	`}`
21062	murrell	1986	`return w;`
16876	murrell	1987	`}`
		1988	`}`
		1989
		1990	`/****************************************************************`
		1991	`* GEStrHeight`
		1992	`****************************************************************`
		1993	`*/`
21062	murrell	1994	`double GEStrHeight(char *str,`
27236	murrell	1995	`R_GE_gcontext *gc,`
		1996	`GEDevDesc *dd)`
16876	murrell	1997	`{`
21062	murrell	1998	`/*`
		1999	`* If the fontfamily is a Hershey font family, call R_GE_VStrHeight`
20177	murrell	2000	`*/`
27236	murrell	2001	`int vfontcode = VFontFamilyCode(gc->fontfamily);`
21062	murrell	2002	`if (vfontcode >= 0) {`
27236	murrell	2003	`gc->fontfamily[0] = vfontcode;`
21062	murrell	2004	`/*`
		2005	`* R's "font" par has historically made 2=bold and 3=italic`
		2006	`* These must be switched to correspond to Hershey fontfaces`
		2007	`*/`
27236	murrell	2008	`if (gc->fontface == 2)`
		2009	`gc->fontface = 3;`
		2010	`else if (gc->fontface == 3)`
		2011	`gc->fontface = 2;`
		2012	`return R_GE_VStrHeight((unsigned char *) str, gc, dd);`
21062	murrell	2013	`} else {`
		2014	`double h;`
		2015	`char *s;`
		2016	`double asc, dsc, wid;`
		2017	`int n;`
		2018	`/* Count the lines of text minus one */`
		2019	`n = 0;`
		2020	`for(s = str; *s ; s++)`
		2021	`if (*s == '\n')`
		2022	`n++;`
		2023	`/* cra is based on the font pointsize at the`
		2024	`* time the device was created.`
		2025	`* Adjust for potentially different current pointsize`
		2026	`* This is a crude calculation that might be better`
		2027	`* performed using a device call that responds with`
		2028	`* the current font pointsize in device coordinates.`
		2029	`*/`
27236	murrell	2030	`h = n * gc->lineheight * gc->cex * dd->dev->cra[1] *`
		2031	`gc->ps/dd->dev->startps;`
21062	murrell	2032	`/* Add in the ascent of the font, if available */`
27236	murrell	2033	`GEMetricInfo('M', gc, &asc, &dsc, &wid, dd);`
21062	murrell	2034	`if ((asc == 0.0) && (dsc == 0.0) && (wid == 0.0))`
27236	murrell	2035	`asc = gc->lineheight * gc->cex * dd->dev->cra[1] *`
		2036	`gc->ps/dd->dev->startps;`
21062	murrell	2037	`h += asc;`
		2038	`return h;`
		2039	`}`
16876	murrell	2040	`}`
		2041
		2042	`/****************************************************************`
		2043	`* GENewPage`
		2044	`****************************************************************`
		2045	`*/`
		2046
27236	murrell	2047	`void GENewPage(R_GE_gcontext gc, GEDevDesc dd)`
16876	murrell	2048	`{`
27236	murrell	2049	`dd->dev->newPage(gc, dd->dev);`
16876	murrell	2050	`}`
		2051
		2052	`/****************************************************************`
17113	murrell	2053	`* GEinitDisplayList`
		2054	`****************************************************************`
		2055	`*/`
		2056
		2057	`void GEinitDisplayList(GEDevDesc *dd)`
		2058	`{`
		2059	`int i;`
18917	murrell	2060	`/* Save the current dislpayList so that, for example, a device`
		2061	`* can maintain a plot history`
		2062	`*/`
		2063	`dd->dev->savedSnapshot = GEcreateSnapshot(dd);`
17113	murrell	2064	`/* Get each graphics system to save state required for`
		2065	`* replaying the display list`
		2066	`*/`
		2067	`for (i=0; i<numGraphicsSystems; i++)`
		2068	`if (dd->gesd[i] != NULL)`
		2069	`(dd->gesd[i]->callback)(GE_SaveState, dd, R_NilValue);`
		2070	`dd->dev->displayList = R_NilValue;`
		2071	`}`
		2072
		2073	`/****************************************************************`
16876	murrell	2074	`* GEplayDisplayList`
		2075	`****************************************************************`
		2076	`*/`
		2077
		2078	`void GEplayDisplayList(GEDevDesc *dd)`
		2079	`{`
17306	murrell	2080	`int i, savedDevice, plotok;`
16876	murrell	2081	`SEXP theList;`
17113	murrell	2082	`/* Get each graphics system to restore state required for`
		2083	`* replaying the display list`
		2084	`*/`
		2085	`for (i=0; i<numGraphicsSystems; i++)`
		2086	`if (dd->gesd[i] != NULL)`
		2087	`(dd->gesd[i]->callback)(GE_RestoreState, dd, R_NilValue);`
		2088	`/* Play the display list`
		2089	`*/`
		2090	`theList = dd->dev->displayList;`
17306	murrell	2091	`plotok = 1;`
16876	murrell	2092	`if (theList != R_NilValue) {`
		2093	`savedDevice = curDevice();`
		2094	`selectDevice(deviceNumber((DevDesc*) dd));`
17306	murrell	2095	`while (theList != R_NilValue && plotok) {`
16876	murrell	2096	`SEXP theOperation = CAR(theList);`
		2097	`SEXP op = CAR(theOperation);`
		2098	`SEXP args = CDR(theOperation);`
		2099	`PRIMFUN(op) (R_NilValue, op, args, R_NilValue);`
17113	murrell	2100	`/* Check with each graphics system that the plotting went ok`
		2101	`*/`
		2102	`for (i=0; i<numGraphicsSystems; i++)`
		2103	`if (dd->gesd[i] != NULL)`
		2104	`if (!LOGICAL((dd->gesd[i]->callback)(GE_CheckPlot, dd,`
		2105	`R_NilValue))[0])`
17306	murrell	2106	`plotok = 0;`
16876	murrell	2107	`theList = CDR(theList);`
		2108	`}`
		2109	`selectDevice(savedDevice);`
		2110	`}`
16946	maechler	2111	`}`
16876	murrell	2112
		2113	`/****************************************************************`
		2114	`* GEcurrentDevice`
		2115	`****************************************************************`
		2116	`*/`
		2117
16965	murrell	2118	`GEDevDesc* GEcurrentDevice()`
16876	murrell	2119	`{`
16965	murrell	2120	`return (GEDevDesc*) CurrentDevice();`
16876	murrell	2121	`}`
16965	murrell	2122
		2123	`/****************************************************************`
		2124	`* GEcopyDisplayList`
		2125	`****************************************************************`
		2126	`*/`
		2127
17019	murrell	2128	`/* We assume that the device being copied TO is the "current" device`
16965	murrell	2129	`*/`
		2130	`/* We assume that BOTH from and to devices are GEDevDesc's`
		2131	`* i.e., this will crash if you try to copy from or to an old DevDesc`
		2132	`*/`
		2133	`void GEcopyDisplayList(int fromDevice)`
		2134	`{`
		2135	`GEDevDesc *dd = GEcurrentDevice();`
		2136	`DevDesc* fromDev = GetDevice(fromDevice);`
		2137	`int i;`
17179	murrell	2138	`dd->dev->displayList = Rf_displayList(fromDev);`
17019	murrell	2139	`/* Get each registered graphics system to copy system state`
		2140	`* information from the "from" device to the current device`
		2141	`*/`
16965	murrell	2142	`for (i=0; i<numGraphicsSystems; i++)`
		2143	`if (dd->gesd[i] != NULL)`
17246	murrell	2144	`(dd->gesd[i]->callback)(GE_CopyState, (GEDevDesc*) fromDev,`
		2145	`R_NilValue);`
16965	murrell	2146	`GEplayDisplayList(dd);`
		2147	`if (!dd->dev->displayListOn)`
17113	murrell	2148	`GEinitDisplayList(dd);`
16965	murrell	2149	`}`
		2150
17022	murrell	2151	`/****************************************************************`
		2152	`* GEcreateSnapshot`
		2153	`****************************************************************`
		2154	`*/`
		2155
		2156	`/* Create a recording of the current display,`
		2157	`* including enough information from each registered`
		2158	`* graphics system to be able to recreate the display`
		2159	`* The structure created is an SEXP which nicely hides the`
		2160	`* internals, because noone should be looking in there anyway`
		2161	`* The product of this call can be stored, but should only`
		2162	`* be used in a call to GEplaySnapshot.`
		2163	`*/`
		2164
		2165	`SEXP GEcreateSnapshot(GEDevDesc *dd)`
		2166	`{`
		2167	`int i;`
		2168	`SEXP snapshot;`
		2169	`SEXP state;`
		2170	`/* Create a list with one spot for the display list`
		2171	`* and one spot each for the registered graphics systems`
		2172	`* to put their graphics state`
		2173	`*/`
		2174	`PROTECT(snapshot = allocVector(VECSXP, 1 + numGraphicsSystems));`
		2175	`/* The first element of the snapshot is the display list.`
		2176	`*/`
		2177	`SET_VECTOR_ELT(snapshot, 0, dd->dev->displayList);`
		2178	`/* For each registered system, obtain state information,`
		2179	`* and store that in the snapshot.`
		2180	`*/`
		2181	`for (i=0; i<numGraphicsSystems; i++)`
		2182	`if (dd->gesd[i] != NULL) {`
		2183	`PROTECT(state = (dd->gesd[i]->callback)(GE_SaveSnapshotState, dd,`
		2184	`R_NilValue));`
		2185	`SET_VECTOR_ELT(snapshot, i + 1, state);`
		2186	`UNPROTECT(1);`
		2187	`}`
		2188	`UNPROTECT(1);`
		2189	`return snapshot;`
		2190	`}`
		2191
		2192	`/****************************************************************`
		2193	`* GEplaySnapshot`
		2194	`****************************************************************`
		2195	`*/`
		2196
		2197	`/* Recreate a saved display using the information in a structure`
		2198	`* created by GEcreateSnapshot.`
		2199	`*/`
		2200
		2201	`void GEplaySnapshot(SEXP snapshot, GEDevDesc* dd)`
		2202	`{`
		2203	`/* Only have to set up information for as many graphics systems`
		2204	`* as were registered when the snapshot was taken.`
		2205	`*/`
		2206	`int i, numSystems = LENGTH(snapshot) - 1;`
		2207	`/* Reset the snapshot state information in each registered`
		2208	`* graphics system`
		2209	`*/`
		2210	`for (i=0; i<numSystems; i++)`
		2211	`if (dd->gesd[i] != NULL)`
		2212	`(dd->gesd[i]->callback)(GE_RestoreSnapshotState, dd,`
		2213	`VECTOR_ELT(snapshot, i + 1));`
		2214	`/* Replay the display list`
		2215	`*/`
		2216	`dd->dev->displayList = VECTOR_ELT(snapshot, 0);`
		2217	`GEplayDisplayList(dd);`
		2218	`if (!dd->dev->displayListOn)`
17113	murrell	2219	`GEinitDisplayList(dd);`
17022	murrell	2220	`}`
		2221

The R Project SVN R

(root)/trunk/src/main/engine.c – Rev 28362