The R Project SVN R

Rev

Rev 61746 | Rev 64513 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
16946 maechler 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
59035 ripley 3 
 *  Copyright (C) 2001-12   The R Core Team.
16946 maechler 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
42307 ripley 16 
 *  along with this program; if not, a copy is available at
17 
 *  http://www.r-project.org/Licenses/
16946 maechler 18 
 */
16876 murrell 19 
 
16946 maechler 20 
#ifdef HAVE_CONFIG_H
21 
#include <config.h>
22 
#endif
23 
 
16876 murrell 24 
#include <Defn.h>
60667 ripley 25 
#include <Internal.h>
44240 ripley 26 
#include <R_ext/GraphicsEngine.h>
61746 ripley 27 
#include <R_ext/Applic.h>	/* pretty() */
16876 murrell 28 
#include <Rmath.h>
29 
 
60260 ripley 30 
# include <rlocale.h>
32397 ripley 31 
 
32815 murrell 32 
int R_GE_getVersion()
33 
{
44240 ripley 34 
    return R_GE_version;
32815 murrell 35 
}
36 
 
37 
void R_GE_checkVersionOrDie(int version)
38 
{
44240 ripley 39 
    if (version != R_GE_version)
32867 ripley 40 
    error(_("Graphics API version mismatch"));
32815 murrell 41 
}
42 
 
16876 murrell 43 
/* A note on memory management ...
16946 maechler 44 
 * Here (with GEDevDesc's) I have continued the deplorable tradition of
16876 murrell 45 
 * malloc'ing device structures and maintaining global variables to
46 
 * record the device structures.  I believe that what I should
47 
 * be doing is recording the device structures in R-level objects
48 
 * (i.e., SEXP's) using Luke's reference pointers to make sure that
49 
 * nasty things like duplicate copies of device structures do not
50 
 * occur.  The thing stopping me doing "the right thing" right now
51 
 * is time.  Hopefully, I will get time later to come back and do
52 
 * it properly -- in the meantime I'll just have to burn in hell.
53 
 * Paul.
54 
 */
55 
 
56 
static int numGraphicsSystems = 0;
57 
 
58 
static GESystemDesc* registeredSystems[MAX_GRAPHICS_SYSTEMS];
59 
 
60 
 
61 
/****************************************************************
62 
 * GEdestroyDevDesc
63 
 ****************************************************************
64 
 */
65 
 
44285 ripley 66 
static void unregisterOne(pGEDevDesc dd, int systemNumber) {
16876 murrell 67 
    if (dd->gesd[systemNumber] != NULL) {
44299 ripley 68 
	(dd->gesd[systemNumber]->callback)(GE_FinaliseState, dd, R_NilValue);
16876 murrell 69 
	free(dd->gesd[systemNumber]);
70 
	dd->gesd[systemNumber] = NULL;
71 
    }
72 
}
73 
 
44572 ripley 74 
/* NOTE that dd->dev has been shut down by a call
75 
 * to dev->close within devices.c
16876 murrell 76 
 */
44285 ripley 77 
void GEdestroyDevDesc(pGEDevDesc dd)
16876 murrell 78 
{
79 
    int i;
80 
    if (dd != NULL) {
48163 murrell 81 
	for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++) unregisterOne(dd, i);
16876 murrell 82 
	free(dd->dev);
83 
	dd->dev = NULL;
84 
	free(dd);
85 
    }
86 
}
87 
 
88 
/****************************************************************
89 
 * GEsystemState
90 
 ****************************************************************
44299 ripley 91 
 
92 
 Currently unused, but future systems might need it.
16876 murrell 93 
 */
94 
 
44285 ripley 95 
void* GEsystemState(pGEDevDesc dd, int index)
16876 murrell 96 
{
97 
    return dd->gesd[index]->systemSpecific;
98 
}
99 
 
100 
/****************************************************************
101 
 * GEregisterWithDevice
102 
 ****************************************************************
103 
 */
104 
 
16946 maechler 105 
/* The guts of adding information about a specific graphics
16876 murrell 106 
 * system to a specific device.
107 
 */
44285 ripley 108 
static void registerOne(pGEDevDesc dd, int systemNumber, GEcallback cb) {
51056 murrell 109 
    SEXP result;
16946 maechler 110 
    dd->gesd[systemNumber] =
17360 murrell 111 
	(GESystemDesc*) calloc(1, sizeof(GESystemDesc));
16876 murrell 112 
    if (dd->gesd[systemNumber] == NULL)
32867 ripley 113 
	error(_("unable to allocate memory (in GEregister)"));
51056 murrell 114 
    result = cb(GE_InitState, dd, R_NilValue);
115 
    if (isNull(result)) {
116 
        /* tidy up */
117 
        free(dd->gesd[systemNumber]);
118 
	error(_("unable to allocate memory (in GEregister)"));
119 
    } else {
120 
        dd->gesd[systemNumber]->callback = cb;
121 
    }
16876 murrell 122 
}
123 
 
124 
/* Store the graphics system state and callback information
125 
 * for a specified device.
126 
 * This is called when a new device is created.
127 
 */
44285 ripley 128 
void GEregisterWithDevice(pGEDevDesc dd) {
16876 murrell 129 
    int i;
48163 murrell 130 
    for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++)
16876 murrell 131 
	/* If a graphics system has unregistered, there might be
132 
	 * "holes" in the array of registeredSystems.
133 
	 */
134 
	if (registeredSystems[i] != NULL)
135 
	    registerOne(dd, i, registeredSystems[i]->callback);
136 
}
137 
 
138 
/****************************************************************
139 
 * GEregisterSystem
140 
 ****************************************************************
141 
 */
142 
 
16946 maechler 143 
/* Record the state and callback information for a new graphics
16876 murrell 144 
 * system.
145 
 * This is called when a graphics system is loaded.
146 
 * Return the index of the system's information in the graphic
147 
 * engine's register.
148 
 */
17360 murrell 149 
void GEregisterSystem(GEcallback cb, int *systemRegisterIndex) {
16876 murrell 150 
    int i, devNum;
44285 ripley 151 
    pGEDevDesc gdd;
16876 murrell 152 
    if (numGraphicsSystems + 1 == MAX_GRAPHICS_SYSTEMS)
33297 ripley 153 
	error(_("too many graphics systems registered"));
17360 murrell 154 
    /* Set the system register index so that, if there are existing
32391 ripley 155 
     * devices, it will know where to put the system-specific
17360 murrell 156 
     * information in those devices
48163 murrell 157 
     * If a graphics system has been unregistered, there might
158 
     * be "holes" in the list of graphics systems, so start
159 
     * from zero and look for the first NULL
17360 murrell 160 
     */
48163 murrell 161 
    *systemRegisterIndex = 0;
162 
    while (registeredSystems[*systemRegisterIndex] != NULL) {
163 
        (*systemRegisterIndex)++;
164 
    }
16876 murrell 165 
    /* Run through the existing devices and add the new information
166 
     * to any GEDevDesc's
167 
     */
168 
    i = 1;
169 
    if (!NoDevices()) {
170 
	devNum = curDevice();
171 
	while (i++ < NumDevices()) {
44412 ripley 172 
	    gdd = GEgetDevice(devNum);
48163 murrell 173 
	    registerOne(gdd, *systemRegisterIndex, cb);
16876 murrell 174 
	    devNum = nextDevice(devNum);
175 
	}
176 
    }
177 
    /* Store the information for adding to any new devices
178 
     */
48163 murrell 179 
    registeredSystems[*systemRegisterIndex] =
17360 murrell 180 
	(GESystemDesc*) calloc(1, sizeof(GESystemDesc));
48163 murrell 181 
    if (registeredSystems[*systemRegisterIndex] == NULL)
32867 ripley 182 
	error(_("unable to allocate memory (in GEregister)"));
48163 murrell 183 
    registeredSystems[*systemRegisterIndex]->callback = cb;
16876 murrell 184 
    numGraphicsSystems += 1;
185 
}
186 
 
187 
/****************************************************************
188 
 * GEunregisterSystem
189 
 ****************************************************************
190 
 */
191 
 
192 
void GEunregisterSystem(int registerIndex)
193 
{
194 
    int i, devNum;
44285 ripley 195 
    pGEDevDesc gdd;
17076 ripley 196 
 
197 
    /* safety check if called before Ginit() */
198 
    if(registerIndex < 0) return;
56032 ripley 199 
    if (numGraphicsSystems == 0) {
200 
	/* This gets called from KillAllDevices, which is called
201 
	   during shutdown.  Prior to 2.14.0 it gave an error, which
202 
	   would inhibit shutdown.  This should not happen, but
203 
	   apparently it did after a segfault:
204 
	   https://stat.ethz.ch/pipermail/r-devel/2011-June/061153.html
205 
	*/
206 
	warning(_("no graphics system to unregister"));
207 
	return;
208 
    }
16876 murrell 209 
    /* Run through the existing devices and remove the information
210 
     * from any GEDevDesc's
211 
     */
212 
    i = 1;
213 
    if (!NoDevices()) {
214 
	devNum = curDevice();
215 
	while (i++ < NumDevices()) {
44412 ripley 216 
	    gdd = GEgetDevice(devNum);
44259 ripley 217 
	    unregisterOne(gdd, registerIndex);
16876 murrell 218 
	    devNum = nextDevice(devNum);
219 
	}
220 
    }
221 
    /* Remove the information from the global record
222 
     * NOTE that there is no systemSpecific information stored
223 
     * in the global record -- just the system callback pointer.
224 
     */
225 
    if (registeredSystems[registerIndex] != NULL) {
226 
	free(registeredSystems[registerIndex]);
227 
	registeredSystems[registerIndex] = NULL;
228 
    }
48163 murrell 229 
    numGraphicsSystems -= 1;
16876 murrell 230 
}
231 
 
232 
/****************************************************************
44347 ripley 233 
 * GEhandleEvent
16876 murrell 234 
 ****************************************************************
235 
 */
236 
 
237 
/* This guy can be called by device drivers.
238 
 * It calls back to registered graphics systems and passes on the event
239 
 * so that the graphics systems can respond however they want to.
44347 ripley 240 
 *
241 
 * Currently only used for GE_ScalePS in devWindows.c
16876 murrell 242 
 */
44347 ripley 243 
SEXP GEhandleEvent(GEevent event, pDevDesc dev, SEXP data)
16876 murrell 244 
{
245 
    int i;
44285 ripley 246 
    pGEDevDesc gdd = desc2GEDesc(dev);
48163 murrell 247 
    for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++)
16946 maechler 248 
	if (registeredSystems[i] != NULL)
44259 ripley 249 
	    (registeredSystems[i]->callback)(event, gdd, data);
17360 murrell 250 
    return R_NilValue;
16876 murrell 251 
}
252 
 
253 
/****************************************************************
254 
 * Some graphics engine transformations
255 
 ****************************************************************
256 
 */
257 
 
44285 ripley 258 
double fromDeviceX(double value, GEUnit to, pGEDevDesc dd)
16876 murrell 259 
{
260 
    double result = value;
261 
    switch (to) {
262 
    case GE_DEVICE:
263 
	break;
264 
    case GE_NDC:
16946 maechler 265 
	result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left);
16876 murrell 266 
	break;
267 
    case GE_INCHES:
16946 maechler 268 
	result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) *
16876 murrell 269 
	    fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0];
270 
	break;
271 
    case GE_CM:
16946 maechler 272 
	result = (result - dd->dev->left) / (dd->dev->right - dd->dev->left) *
16876 murrell 273 
	    fabs(dd->dev->right - dd->dev->left) * dd->dev->ipr[0] * 2.54;
274 
    }
275 
    return result;
276 
}
277 
 
44285 ripley 278 
double toDeviceX(double value, GEUnit from, pGEDevDesc dd)
16876 murrell 279 
{
280 
    double result = value;
281 
    switch (from) {
282 
    case GE_CM:
283 
	/* Convert GE_CM to GE_INCHES */
284 
	result = result / 2.54;
285 
    case GE_INCHES:
286 
	/* Convert GE_INCHES to GE_NDC */
287 
	result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left);
288 
    case GE_NDC:
289 
	/* Convert GE_NDC to Dev */
290 
	result = dd->dev->left + result*(dd->dev->right - dd->dev->left);
291 
    case GE_DEVICE:
292 
	/* Do nothing */
293 
	break;
294 
    }
295 
    return result;
296 
}
297 
 
44285 ripley 298 
double fromDeviceY(double value, GEUnit to, pGEDevDesc dd)
16876 murrell 299 
{
300 
    double result = value;
301 
    switch (to) {
302 
    case GE_DEVICE:
303 
	break;
304 
    case GE_NDC:
16946 maechler 305 
	result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom);
16876 murrell 306 
	break;
307 
    case GE_INCHES:
308 
	result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) *
309 
	    fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1];
310 
	break;
311 
    case GE_CM:
312 
	result = (result - dd->dev->bottom) / (dd->dev->top - dd->dev->bottom) *
313 
	    fabs(dd->dev->top - dd->dev->bottom) * dd->dev->ipr[1] * 2.54;
314 
    }
315 
    return result;
316 
}
317 
 
44285 ripley 318 
double toDeviceY(double value, GEUnit from, pGEDevDesc dd)
16876 murrell 319 
{
320 
    double result = value;
321 
    switch (from) {
322 
    case GE_CM:
323 
	/* Convert GE_CM to GE_INCHES */
324 
	result = result / 2.54;
325 
    case GE_INCHES:
326 
	/* Convert GE_INCHES to GE_NDC */
327 
	result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom);
328 
    case GE_NDC:
329 
	/* Convert GE_NDC to Dev */
330 
	result = dd->dev->bottom + result*(dd->dev->top - dd->dev->bottom);
331 
    case GE_DEVICE:
332 
	/* Do nothing */
16896 iacus 333 
	break;
16876 murrell 334 
    }
335 
    return result;
336 
}
337 
 
44285 ripley 338 
double fromDeviceWidth(double value, GEUnit to, pGEDevDesc dd)
16876 murrell 339 
{
340 
    double result = value;
341 
    switch (to) {
342 
    case GE_DEVICE:
343 
	break;
344 
    case GE_NDC:
16946 maechler 345 
	result = result / (dd->dev->right - dd->dev->left);
16876 murrell 346 
	break;
347 
    case GE_INCHES:
348 
	result = result * dd->dev->ipr[0];
349 
	break;
350 
    case GE_CM:
351 
	result = result * dd->dev->ipr[0] * 2.54;
352 
    }
353 
    return result;
354 
}
355 
 
44285 ripley 356 
double toDeviceWidth(double value, GEUnit from, pGEDevDesc dd)
16876 murrell 357 
{
358 
    double result = value;
359 
    switch (from) {
360 
    case GE_CM:
361 
	/* Convert GE_CM to GE_INCHES */
362 
	result = result / 2.54;
363 
    case GE_INCHES:
364 
	/* Convert GE_INCHES to GE_NDC */
365 
	result = (result / dd->dev->ipr[0]) / fabs(dd->dev->right - dd->dev->left);
366 
    case GE_NDC:
367 
	/* Convert GE_NDC to Dev */
368 
	result = result*(dd->dev->right - dd->dev->left);
369 
    case GE_DEVICE:
370 
	/* Do nothing */
16896 iacus 371 
	break;
16876 murrell 372 
    }
373 
    return result;
374 
}
375 
 
44285 ripley 376 
double fromDeviceHeight(double value, GEUnit to, pGEDevDesc dd)
16876 murrell 377 
{
378 
    double result = value;
379 
    switch (to) {
380 
    case GE_DEVICE:
381 
	break;
382 
    case GE_NDC:
16946 maechler 383 
	result = result / (dd->dev->top - dd->dev->bottom);
16876 murrell 384 
	break;
385 
    case GE_INCHES:
386 
	result = result * dd->dev->ipr[1];
387 
	break;
388 
    case GE_CM:
389 
	result = result * dd->dev->ipr[1] * 2.54;
390 
    }
391 
    return result;
392 
}
393 
 
44285 ripley 394 
double toDeviceHeight(double value, GEUnit from, pGEDevDesc dd)
16876 murrell 395 
{
396 
    double result = value;
397 
    switch (from) {
398 
    case GE_CM:
399 
	/* Convert GE_CM to GE_INCHES */
400 
	result = result / 2.54;
401 
    case GE_INCHES:
402 
	/* Convert GE_INCHES to GE_NDC */
403 
	result = (result / dd->dev->ipr[1]) / fabs(dd->dev->top - dd->dev->bottom);
404 
    case GE_NDC:
405 
	/* Convert GE_NDC to Dev */
406 
	result = result*(dd->dev->top - dd->dev->bottom);
407 
    case GE_DEVICE:
408 
	/* Do nothing */
409 
	break;
410 
    }
411 
    return result;
412 
}
413 
 
414 
/****************************************************************
32391 ripley 415 
 * Code for converting line ends and joins from SEXP to internal
30925 murrell 416 
 * representation
417 
 ****************************************************************
418 
 */
419 
typedef struct {
420 
    char *name;
421 
    R_GE_lineend end;
422 
} LineEND;
423 
 
424 
static LineEND lineend[] = {
425 
    { "round",   GE_ROUND_CAP  },
426 
    { "butt",	 GE_BUTT_CAP   },
427 
    { "square",	 GE_SQUARE_CAP },
428 
    { NULL,	 0	     }
429 
};
430 
 
431 
static int nlineend = (sizeof(lineend)/sizeof(LineEND)-2);
432 
 
44142 ripley 433 
R_GE_lineend GE_LENDpar(SEXP value, int ind)
30925 murrell 434 
{
435 
    int i, code;
436 
    double rcode;
437 
 
438 
    if(isString(value)) {
439 
	for(i = 0; lineend[i].name; i++) { /* is it the i-th name ? */
40705 ripley 440 
	    if(!strcmp(CHAR(STRING_ELT(value, ind)), lineend[i].name)) /*ASCII */
30925 murrell 441 
		return lineend[i].end;
442 
	}
32867 ripley 443 
	error(_("invalid line end")); /*NOTREACHED, for -Wall : */ return 0;
30925 murrell 444 
    }
445 
    else if(isInteger(value)) {
446 
	code = INTEGER(value)[ind];
447 
	if(code == NA_INTEGER || code < 0)
32867 ripley 448 
	    error(_("invalid line end"));
30925 murrell 449 
	if (code > 0)
450 
	    code = (code-1) % nlineend + 1;
451 
	return lineend[code].end;
452 
    }
453 
    else if(isReal(value)) {
454 
	rcode = REAL(value)[ind];
455 
	if(!R_FINITE(rcode) || rcode < 0)
32867 ripley 456 
	    error(_("invalid line end"));
59177 ripley 457 
	code = (int) rcode;
30925 murrell 458 
	if (code > 0)
459 
	    code = (code-1) % nlineend + 1;
460 
	return lineend[code].end;
461 
    }
462 
    else {
32867 ripley 463 
	error(_("invalid line end")); /*NOTREACHED, for -Wall : */ return 0;
30925 murrell 464 
    }
465 
}
466 
 
44142 ripley 467 
SEXP GE_LENDget(R_GE_lineend lend)
30956 murrell 468 
{
469 
    SEXP ans = R_NilValue;
470 
    int i;
471 
 
472 
    for (i = 0; lineend[i].name; i++) {
473 
	if(lineend[i].end == lend)
474 
	    return mkString(lineend[i].name);
475 
    }
476 
 
32867 ripley 477 
    error(_("invalid line end"));
30956 murrell 478 
    /*
479 
     * Should never get here
480 
     */
481 
    return ans;
482 
}
483 
 
30925 murrell 484 
typedef struct {
485 
    char *name;
486 
    R_GE_linejoin join;
487 
} LineJOIN;
488 
 
489 
static LineJOIN linejoin[] = {
490 
    { "round",   GE_ROUND_JOIN },
491 
    { "mitre",	 GE_MITRE_JOIN },
492 
    { "bevel",	 GE_BEVEL_JOIN},
493 
    { NULL,	 0	     }
494 
};
495 
 
496 
static int nlinejoin = (sizeof(linejoin)/sizeof(LineJOIN)-2);
497 
 
44142 ripley 498 
R_GE_linejoin GE_LJOINpar(SEXP value, int ind)
30925 murrell 499 
{
500 
    int i, code;
501 
    double rcode;
502 
 
503 
    if(isString(value)) {
504 
	for(i = 0; linejoin[i].name; i++) { /* is it the i-th name ? */
40705 ripley 505 
	    if(!strcmp(CHAR(STRING_ELT(value, ind)), linejoin[i].name)) /* ASCII */
30925 murrell 506 
		return linejoin[i].join;
507 
	}
32867 ripley 508 
	error(_("invalid line join")); /*NOTREACHED, for -Wall : */ return 0;
30925 murrell 509 
    }
510 
    else if(isInteger(value)) {
511 
	code = INTEGER(value)[ind];
512 
	if(code == NA_INTEGER || code < 0)
32867 ripley 513 
	    error(_("invalid line join"));
30925 murrell 514 
	if (code > 0)
515 
	    code = (code-1) % nlinejoin + 1;
516 
	return linejoin[code].join;
517 
    }
518 
    else if(isReal(value)) {
519 
	rcode = REAL(value)[ind];
520 
	if(!R_FINITE(rcode) || rcode < 0)
32867 ripley 521 
	    error(_("invalid line join"));
59177 ripley 522 
	code = (int) rcode;
30925 murrell 523 
	if (code > 0)
524 
	    code = (code-1) % nlinejoin + 1;
525 
	return linejoin[code].join;
526 
    }
527 
    else {
32867 ripley 528 
	error(_("invalid line join")); /*NOTREACHED, for -Wall : */ return 0;
30925 murrell 529 
    }
530 
}
531 
 
44142 ripley 532 
SEXP GE_LJOINget(R_GE_linejoin ljoin)
30956 murrell 533 
{
534 
    SEXP ans = R_NilValue;
535 
    int i;
536 
 
537 
    for (i = 0; linejoin[i].name; i++) {
538 
	if(linejoin[i].join == ljoin)
539 
	    return mkString(linejoin[i].name);
540 
    }
541 
 
32867 ripley 542 
    error(_("invalid line join"));
30956 murrell 543 
    /*
544 
     * Should never get here
545 
     */
546 
    return ans;
547 
}
548 
 
30925 murrell 549 
/****************************************************************
16876 murrell 550 
 * Code to retrieve current clipping rect from device
551 
 ****************************************************************
552 
 */
553 
 
554 
static void getClipRect(double *x1, double *y1, double *x2, double *y2,
45446 ripley 555 
			pGEDevDesc dd)
16876 murrell 556 
{
46178 ripley 557 
    /* Since these are only set by GESetClip they should be in order */
16876 murrell 558 
    if (dd->dev->clipLeft < dd->dev->clipRight) {
559 
	*x1 = dd->dev->clipLeft;
560 
	*x2 = dd->dev->clipRight;
561 
    } else {
562 
	*x2 = dd->dev->clipLeft;
563 
	*x1 = dd->dev->clipRight;
564 
    }
565 
    if (dd->dev->clipBottom < dd->dev->clipTop) {
566 
	*y1 = dd->dev->clipBottom;
567 
	*y2 = dd->dev->clipTop;
568 
    } else {
569 
	*y2 = dd->dev->clipBottom;
570 
	*y1 = dd->dev->clipTop;
571 
    }
572 
}
573 
 
574 
static void getClipRectToDevice(double *x1, double *y1, double *x2, double *y2,
44285 ripley 575 
				pGEDevDesc dd)
16876 murrell 576 
{
46178 ripley 577 
    /* Devices can have flipped coord systems */
16876 murrell 578 
    if (dd->dev->left < dd->dev->right) {
579 
	*x1 = dd->dev->left;
580 
	*x2 = dd->dev->right;
581 
    } else {
582 
	*x2 = dd->dev->left;
583 
	*x1 = dd->dev->right;
584 
    }
585 
    if (dd->dev->bottom < dd->dev->top) {
586 
	*y1 = dd->dev->bottom;
587 
	*y2 = dd->dev->top;
588 
    } else {
589 
	*y2 = dd->dev->bottom;
590 
	*y1 = dd->dev->top;
591 
    }
592 
}
593 
 
594 
/****************************************************************
595 
 * GESetClip
596 
 ****************************************************************
597 
 */
44285 ripley 598 
void GESetClip(double x1, double y1, double x2, double y2, pGEDevDesc dd)
16876 murrell 599 
{
46178 ripley 600 
    pDevDesc d = dd->dev;
601 
    double dx1 = d->left, dx2 = d->right, dy1 = d->bottom, dy2 = d->top;
602 
 
603 
    /* clip to device region */
604 
    if (dx1 <= dx2) {
605 
	x1 = fmax2(x1, dx1);
606 
	x2 = fmin2(x2, dx2);
607 
    } else {
608 
	x1 = fmin2(x1, dx1);
609 
	x2 = fmax2(x2, dx2);
610 
    }
611 
    if (dy1 <= dy2) {
612 
	y1 = fmax2(y1, dy1);
613 
	y2 = fmin2(y2, dy2);
614 
    } else {
615 
	y1 = fmin2(y1, dy1);
616 
	y2 = fmax2(y2, dy2);
617 
    }
618 
    d->clip(x1, x2, y1, y2, dd->dev);
32391 ripley 619 
    /*
20424 murrell 620 
     * Record the current clip rect settings so that calls to
621 
     * getClipRect get the up-to-date values.
17306 murrell 622 
     */
46178 ripley 623 
    d->clipLeft = fmin2(x1, x2);
624 
    d->clipRight = fmax2(x1, x2);
625 
    d->clipTop = fmax2(y1, y2);
626 
    d->clipBottom = fmin2(y1, y2);
16876 murrell 627 
}
628 
 
629 
/****************************************************************
630 
 * R code for clipping lines
631 
 ****************************************************************
632 
 */
633 
 
634 
/* Draw Line Segments, Clipping to the Viewport */
635 
/* Cohen-Sutherland Algorithm */
636 
/* Unneeded if the device can do the clipping */
637 
 
638 
 
639 
#define	CS_BOTTOM	001
640 
#define	CS_LEFT		002
641 
#define	CS_TOP		004
642 
#define	CS_RIGHT	010
643 
 
644 
typedef struct {
645 
    double xl;
646 
    double xr;
647 
    double yb;
648 
    double yt;
649 
} cliprect;
650 
 
651 
 
652 
static int clipcode(double x, double y, cliprect *cr)
653 
{
654 
    int c = 0;
655 
    if(x < cr->xl)
656 
	c |= CS_LEFT;
657 
    else if(x > cr->xr)
658 
	c |= CS_RIGHT;
659 
    if(y < cr->yb)
660 
	c |= CS_BOTTOM;
661 
    else if(y > cr->yt)
662 
	c |= CS_TOP;
663 
    return c;
664 
}
665 
 
666 
static Rboolean
16946 maechler 667 
CSclipline(double *x1, double *y1, double *x2, double *y2,
668 
	   cliprect *cr, int *clipped1, int *clipped2,
44285 ripley 669 
	   pGEDevDesc dd)
16876 murrell 670 
{
671 
    int c, c1, c2;
672 
    double x, y, xl, xr, yb, yt;
673 
 
674 
    *clipped1 = 0;
675 
    *clipped2 = 0;
676 
    c1 = clipcode(*x1, *y1, cr);
677 
    c2 = clipcode(*x2, *y2, cr);
678 
    if ( !c1 && !c2 )
679 
	return TRUE;
680 
 
681 
    xl = cr->xl;
682 
    xr = cr->xr;
683 
    yb = cr->yb;
684 
    yt = cr->yt;
685 
    /* Paul took out the code for (dd->dev->gp.xlog || dd->dev->gp.ylog)
686 
     * (i) because device holds no state on whether scales are logged
687 
     * (ii) it appears to be identical to the code for non-log scales !?
688 
     */
689 
    x = xl;		/* keep -Wall happy */
690 
    y = yb;		/* keep -Wall happy */
691 
    while( c1 || c2 ) {
692 
	if(c1 & c2)
693 
	    return FALSE;
694 
	if( c1 )
695 
	    c = c1;
696 
	else
697 
	    c = c2;
698 
	if( c & CS_LEFT ) {
699 
	    y = *y1 + (*y2 - *y1) * (xl - *x1) / (*x2 - *x1);
700 
	    x = xl;
701 
	}
702 
	else if( c & CS_RIGHT ) {
703 
	    y = *y1 + (*y2 - *y1) * (xr - *x1) / (*x2 -  *x1);
704 
	    x = xr;
705 
	}
706 
	else if( c & CS_BOTTOM ) {
707 
	    x = *x1 + (*x2 - *x1) * (yb - *y1) / (*y2 - *y1);
708 
	    y = yb;
709 
	}
710 
	else if( c & CS_TOP ) {
711 
	    x = *x1 + (*x2 - *x1) * (yt - *y1)/(*y2 - *y1);
712 
	    y = yt;
713 
	}
16946 maechler 714 
 
16876 murrell 715 
	if( c==c1 ) {
716 
	    *x1 = x;
717 
	    *y1 = y;
718 
	    *clipped1 = 1;
719 
	    c1 = clipcode(x, y, cr);
720 
	}
721 
	else {
722 
	    *x2 = x;
723 
	    *y2 = y;
724 
	    *clipped2 = 1;
725 
	    c2 = clipcode(x, y, cr);
726 
	}
727 
    }
728 
    return TRUE;
729 
}
730 
 
731 
 
732 
/* Clip the line
733 
   If toDevice = 1, clip to the device extent (i.e., temporarily ignore
734 
   dd->dev->gp.xpd) */
735 
static Rboolean
736 
clipLine(double *x1, double *y1, double *x2, double *y2,
44285 ripley 737 
	 int toDevice, pGEDevDesc dd)
16876 murrell 738 
{
739 
    int dummy1, dummy2;
740 
    cliprect cr;
741 
 
16946 maechler 742 
    if (toDevice)
16876 murrell 743 
	getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);
744 
    else
745 
	getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);
746 
 
747 
    return CSclipline(x1, y1, x2, y2, &cr, &dummy1, &dummy2, dd);
748 
}
749 
 
750 
/****************************************************************
751 
 * GELine
752 
 ****************************************************************
753 
 */
754 
/* If the device canClip, R clips line to device extent and
755 
   device does all other clipping. */
16946 maechler 756 
void GELine(double x1, double y1, double x2, double y2,
44500 ripley 757 
	    const pGEcontext gc, pGEDevDesc dd)
16876 murrell 758 
{
759 
    Rboolean clip_ok;
59506 ripley 760 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
761 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 762 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) return;
16876 murrell 763 
    if (dd->dev->canClip) {
764 
	clip_ok = clipLine(&x1, &y1, &x2, &y2, 1, dd);
765 
    }
766 
    else {
767 
	clip_ok = clipLine(&x1, &y1, &x2, &y2, 0, dd);
768 
    }
769 
    if (clip_ok)
27236 murrell 770 
	dd->dev->line(x1, y1, x2, y2, gc, dd->dev);
16876 murrell 771 
}
772 
 
773 
/****************************************************************
774 
 * R code for clipping polylines
775 
 ****************************************************************
776 
 */
777 
 
16946 maechler 778 
static void CScliplines(int n, double *x, double *y,
44500 ripley 779 
			const pGEcontext gc, int toDevice, pGEDevDesc dd)
16876 murrell 780 
{
781 
    int ind1, ind2;
782 
    /*int firstPoint = 1;*/
783 
    int count = 0;
784 
    int i = 0;
16910 ripley 785 
    double *xx, *yy;
16876 murrell 786 
    double x1, y1, x2, y2;
787 
    cliprect cr;
50745 ripley 788 
    const void *vmax = vmaxget();
16876 murrell 789 
 
16946 maechler 790 
    if (toDevice)
16876 murrell 791 
	getClipRectToDevice(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);
792 
    else
793 
	getClipRect(&cr.xl, &cr.yb, &cr.xr, &cr.yt, dd);
794 
 
795 
    xx = (double *) R_alloc(n, sizeof(double));
796 
    yy = (double *) R_alloc(n, sizeof(double));
797 
    if (xx == NULL || yy == NULL)
32867 ripley 798 
	error(_("out of memory while clipping polyline"));
16876 murrell 799 
 
800 
    xx[0] = x1 = x[0];
801 
    yy[0] = y1 = y[0];
802 
    count = 1;
803 
 
804 
    for (i = 1; i < n; i++) {
805 
	x2 = x[i];
806 
	y2 = y[i];
807 
	if (CSclipline(&x1, &y1, &x2, &y2, &cr, &ind1, &ind2, dd)) {
808 
	    if (ind1 && ind2) {
809 
		xx[0] = x1;
810 
		yy[0] = y1;
811 
		xx[1] = x2;
812 
		yy[1] = y2;
27236 murrell 813 
		dd->dev->polyline(2, xx, yy, gc, dd->dev);
16876 murrell 814 
	    }
815 
	    else if (ind1) {
816 
		xx[0] = x1;
817 
		yy[0] = y1;
818 
		xx[1] = x2;
819 
		yy[1] = y2;
820 
		count = 2;
821 
		if (i == n - 1)
27236 murrell 822 
		    dd->dev->polyline(count, xx, yy, gc, dd->dev);
16876 murrell 823 
	    }
824 
	    else if (ind2) {
825 
		xx[count] = x2;
826 
		yy[count] = y2;
827 
		count++;
828 
		if (count > 1)
27236 murrell 829 
		    dd->dev->polyline(count, xx, yy, gc, dd->dev);
16876 murrell 830 
	    }
831 
	    else {
832 
		xx[count] = x2;
833 
		yy[count] = y2;
834 
		count++;
835 
		if (i == n - 1 && count > 1)
27236 murrell 836 
		    dd->dev->polyline(count, xx, yy, gc, dd->dev);
16876 murrell 837 
	    }
838 
	}
839 
	x1 = x[i];
840 
	y1 = y[i];
841 
    }
842 
 
843 
    vmaxset(vmax);
844 
}
845 
 
846 
/****************************************************************
847 
 * GEPolyline
848 
 ****************************************************************
849 
 */
850 
/* Clip and draw the polyline.
851 
   If clipToDevice = 0, clip according to dd->dev->gp.xpd
852 
   If clipToDevice = 1, clip to the device extent */
853 
static void clipPolyline(int n, double *x, double *y,
44500 ripley 854 
			 const pGEcontext gc, int clipToDevice, pGEDevDesc dd)
16876 murrell 855 
{
27236 murrell 856 
    CScliplines(n, x, y, gc, clipToDevice, dd);
16876 murrell 857 
}
858 
 
859 
/* Draw a series of line segments. */
860 
/* If the device canClip, R clips to the device extent and the device
861 
   does all other clipping */
44500 ripley 862 
void GEPolyline(int n, double *x, double *y, const pGEcontext gc, pGEDevDesc dd)
16876 murrell 863 
{
59506 ripley 864 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
865 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 866 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK) return;
16876 murrell 867 
    if (dd->dev->canClip) {
27236 murrell 868 
	clipPolyline(n, x, y, gc, 1, dd);  /* clips to device extent
16876 murrell 869 
						  then draws */
870 
    }
871 
    else
27236 murrell 872 
	clipPolyline(n, x, y, gc, 0, dd);
16876 murrell 873 
}
874 
 
875 
/****************************************************************
876 
 * R code for clipping polygons
877 
 ****************************************************************
878 
 */
879 
 
880 
typedef enum {
881 
    Left = 0,
882 
    Right = 1,
883 
    Bottom = 2,
884 
    Top = 3
885 
} Edge;
886 
 
887 
/* Clipper State Variables */
888 
typedef struct {
889 
    int first;    /* true if we have seen the first point */
890 
    double fx;    /* x coord of the first point */
891 
    double fy;    /* y coord of the first point */
892 
    double sx;    /* x coord of the most recent point */
893 
    double sy;    /* y coord of the most recent point */
894 
}
895 
GClipState;
896 
 
897 
/* The Clipping Rectangle */
898 
typedef struct {
899 
    double xmin;
900 
    double xmax;
901 
    double ymin;
902 
    double ymax;
903 
}
904 
GClipRect;
905 
 
906 
static
907 
int inside (Edge b, double px, double py, GClipRect *clip)
908 
{
909 
    switch (b) {
910 
    case Left:   if (px < clip->xmin) return 0; break;
911 
    case Right:  if (px > clip->xmax) return 0; break;
912 
    case Bottom: if (py < clip->ymin) return 0; break;
913 
    case Top:    if (py > clip->ymax) return 0; break;
914 
    }
915 
    return 1;
916 
}
917 
 
918 
static
919 
int cross (Edge b, double x1, double y1, double x2, double y2,
920 
	   GClipRect *clip)
921 
{
922 
    if (inside (b, x1, y1, clip) == inside (b, x2, y2, clip))
923 
	return 0;
924 
    else return 1;
925 
}
926 
 
927 
static
928 
void intersect (Edge b, double x1, double y1, double x2, double y2,
929 
		double *ix, double *iy, GClipRect *clip)
930 
{
931 
    double m = 0;
932 
 
933 
    if (x1 != x2) m = (y1 - y2) / (x1 - x2);
934 
    switch (b) {
935 
    case Left:
936 
	*ix = clip->xmin;
937 
	*iy = y2 + (clip->xmin - x2) * m;
938 
	break;
939 
    case Right:
940 
	*ix = clip->xmax;
941 
	*iy = y2 + (clip->xmax - x2) * m;
942 
	break;
943 
    case Bottom:
944 
	*iy = clip->ymin;
945 
	if (x1 != x2) *ix = x2 + (clip->ymin - y2) / m;
946 
	else *ix = x2;
947 
	break;
948 
    case Top:
949 
	*iy = clip->ymax;
950 
	if (x1 != x2) *ix = x2 + (clip->ymax - y2) / m;
951 
	else *ix = x2;
952 
	break;
953 
    }
954 
}
955 
 
956 
static
957 
void clipPoint (Edge b, double x, double y,
958 
		double *xout, double *yout, int *cnt, int store,
959 
		GClipRect *clip, GClipState *cs)
960 
{
38813 ripley 961 
    double ix = 0.0, iy = 0.0 /* -Wall */;
16876 murrell 962 
 
963 
    if (!cs[b].first) {
964 
	/* No previous point exists for this edge. */
965 
	/* Save this point. */
966 
	cs[b].first = 1;
967 
	cs[b].fx = x;
968 
	cs[b].fy = y;
969 
    }
970 
    else
971 
	/* A previous point exists.  */
972 
	/* If 'p' and previous point cross edge, find intersection.  */
973 
	/* Clip against next boundary, if any.  */
974 
	/* If no more edges, add intersection to output list. */
975 
	if (cross (b, x, y, cs[b].sx, cs[b].sy, clip)) {
976 
	    intersect (b, x, y, cs[b].sx, cs[b].sy, &ix, &iy, clip);
977 
	    if (b < Top)
978 
		clipPoint (b + 1, ix, iy, xout, yout, cnt, store,
979 
			   clip, cs);
980 
	    else {
981 
		if (store) {
982 
		    xout[*cnt] = ix;
983 
		    yout[*cnt] = iy;
984 
		}
985 
		(*cnt)++;
986 
	    }
987 
	}
988 
 
989 
    /* Save as most recent point for this edge */
990 
    cs[b].sx = x;
991 
    cs[b].sy = y;
992 
 
993 
    /* For all, if point is 'inside' */
994 
    /* proceed to next clip edge, if any */
995 
    if (inside (b, x, y, clip)) {
996 
	if (b < Top)
997 
	    clipPoint (b + 1, x, y, xout, yout, cnt, store, clip, cs);
998 
	else {
999 
	    if (store) {
1000 
		xout[*cnt] = x;
1001 
		yout[*cnt] = y;
1002 
	    }
1003 
	    (*cnt)++;
1004 
	}
1005 
    }
1006 
}
1007 
 
1008 
static
1009 
void closeClip (double *xout, double *yout, int *cnt, int store,
1010 
		GClipRect *clip, GClipState *cs)
1011 
{
38813 ripley 1012 
    double ix = 0.0, iy = 0.0 /* -Wall */;
16876 murrell 1013 
    Edge b;
1014 
 
1015 
    for (b = Left; b <= Top; b++) {
1016 
	if (cross (b, cs[b].sx, cs[b].sy, cs[b].fx, cs[b].fy, clip)) {
1017 
	    intersect (b, cs[b].sx, cs[b].sy,
1018 
		       cs[b].fx, cs[b].fy, &ix, &iy, clip);
1019 
	    if (b < Top)
1020 
		clipPoint (b + 1, ix, iy, xout, yout, cnt, store, clip, cs);
1021 
	    else {
1022 
		if (store) {
1023 
		    xout[*cnt] = ix;
1024 
		    yout[*cnt] = iy;
1025 
		}
1026 
		(*cnt)++;
1027 
	    }
1028 
	}
1029 
    }
1030 
}
1031 
 
38705 ripley 1032 
static int clipPoly(double *x, double *y, int n, int store, int toDevice,
44285 ripley 1033 
		    double *xout, double *yout, pGEDevDesc dd)
16876 murrell 1034 
{
1035 
    int i, cnt = 0;
1036 
    GClipState cs[4];
1037 
    GClipRect clip;
1038 
    for (i = 0; i < 4; i++)
1039 
	cs[i].first = 0;
16946 maechler 1040 
    if (toDevice)
1041 
	getClipRectToDevice(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax,
16876 murrell 1042 
			    dd);
1043 
    else
1044 
	getClipRect(&clip.xmin, &clip.ymin, &clip.xmax, &clip.ymax, dd);
1045 
    for (i = 0; i < n; i++)
1046 
	clipPoint (Left, x[i], y[i], xout, yout, &cnt, store, &clip, cs);
1047 
    closeClip (xout, yout, &cnt, store, &clip, cs);
1048 
    return (cnt);
1049 
}
1050 
 
1051 
static void clipPolygon(int n, double *x, double *y,
44500 ripley 1052 
			const pGEcontext gc, int toDevice, pGEDevDesc dd)
16876 murrell 1053 
{
1054 
    double *xc = NULL, *yc = NULL;
50875 ripley 1055 
    const void *vmax = vmaxget();
1056 
 
16876 murrell 1057 
    /* if bg not specified then draw as polyline rather than polygon
32391 ripley 1058 
     * to avoid drawing line along border of clipping region
30129 murrell 1059 
     * If bg was NA then it has been converted to fully transparent */
1060 
    if (R_TRANSPARENT(gc->fill)) {
16876 murrell 1061 
	int i;
1062 
	xc = (double*) R_alloc(n + 1, sizeof(double));
1063 
	yc = (double*) R_alloc(n + 1, sizeof(double));
1064 
	for (i=0; i<n; i++) {
1065 
	    xc[i] = x[i];
1066 
	    yc[i] = y[i];
1067 
	}
1068 
	xc[n] = x[0];
1069 
	yc[n] = y[0];
27236 murrell 1070 
	GEPolyline(n+1, xc, yc, gc, dd);
16876 murrell 1071 
    }
1072 
    else {
1073 
	int npts;
1074 
	xc = yc = 0;		/* -Wall */
1075 
	npts = clipPoly(x, y, n, 0, toDevice, xc, yc, dd);
1076 
	if (npts > 1) {
1077 
	    xc = (double*) R_alloc(npts, sizeof(double));
1078 
	    yc = (double*) R_alloc(npts, sizeof(double));
1079 
	    npts = clipPoly(x, y, n, 1, toDevice, xc, yc, dd);
27236 murrell 1080 
	    dd->dev->polygon(npts, xc, yc, gc, dd->dev);
16876 murrell 1081 
	}
1082 
    }
50875 ripley 1083 
    vmaxset(vmax);
16876 murrell 1084 
}
1085 
 
1086 
/****************************************************************
1087 
 * GEPolygon
1088 
 ****************************************************************
1089 
 */
44500 ripley 1090 
void GEPolygon(int n, double *x, double *y, const pGEcontext gc, pGEDevDesc dd)
16876 murrell 1091 
{
32391 ripley 1092 
    /*
26787 murrell 1093 
     * Save (and reset below) the heap pointer to clean up
1094 
     * after any R_alloc's done by functions I call.
1095 
     */
50745 ripley 1096 
    const void *vmaxsave = vmaxget();
59506 ripley 1097 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
1098 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 1099 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK)
26787 murrell 1100 
	/* "transparent" border */
30711 murrell 1101 
	gc->col = R_TRANWHITE;
16876 murrell 1102 
    if (dd->dev->canClip) {
32391 ripley 1103 
	/*
26787 murrell 1104 
	 * If the device can clip, then we just clip to the device
1105 
	 * boundary and let the device do clipping within that.
1106 
	 * We do this to avoid problems where writing WAY off the
1107 
	 * device can cause problems for, e.g., ghostview
1108 
	 */
27236 murrell 1109 
	clipPolygon(n, x, y, gc, 1, dd);
16876 murrell 1110 
    }
1111 
    else
26787 murrell 1112 
	/*
1113 
	 * If the device can't clip, we have to do all the clipping
1114 
	 * ourselves.
1115 
	 */
27236 murrell 1116 
	clipPolygon(n, x, y, gc, 0, dd);
26787 murrell 1117 
    vmaxset(vmaxsave);
16876 murrell 1118 
}
1119 
 
1120 
 
1121 
/****************************************************************
1122 
 * R code for clipping circles
1123 
 ****************************************************************
1124 
 */
1125 
/* Convert a circle into a polygon with specified number of vertices */
1126 
static void convertCircle(double x, double y, double r,
1127 
			  int numVertices, double *xc, double *yc)
1128 
{
1129 
    int i;
1130 
    double theta = 2*M_PI/numVertices;
1131 
    for (i=0; i<numVertices; i++) {
1132 
	xc[i] = x + r*sin(theta*i);
1133 
	yc[i] = y + r*cos(theta*i);
1134 
    }
1135 
    xc[numVertices] = x;
1136 
    yc[numVertices] = y+r;
1137 
}
1138 
 
1139 
/* Takes a specification of a circle as input and returns a code indicating
1140 
   how the circle should be clipped.
1141 
   The return value will be -1 if the circle is to
1142 
   be totally clipped out of existence, -2 if the circle is to be
1143 
   totally left alone, 0 and above if the circle has been converted
1144 
   into a polygon (in which case, the return value indicates the
1145 
   number of vertices of the polygon and the function convertCircle()
1146 
   should be called to obtain the vertices of the polygon). */
1147 
static int clipCircleCode(double x, double y, double r,
44285 ripley 1148 
			  int toDevice, pGEDevDesc dd)
16876 murrell 1149 
{
1150 
    int result;
1151 
    /* determine clipping region */
1152 
    double xmin, xmax, ymin, ymax;
1153 
    if (toDevice)
1154 
	getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd);
1155 
    else
1156 
	getClipRect(&xmin, &ymin, &xmax, &ymax, dd);
1157 
 
1158 
    /* if circle is all within clipping rect */
1159 
    if (x-r > xmin && x+r < xmax && y-r > ymin && y+r < ymax) {
1160 
	result = -2;
1161 
    }
1162 
    /* if circle is all outside clipping rect */
1163 
    else {
1164 
	double distance = r*r;
1165 
	if (x-r > xmax || x+r < xmin || y-r > ymax || y+r < ymin ||
45446 ripley 1166 
	    (x < xmin && y < ymin &&
1167 
	     ((x-xmin)*(x-xmin)+(y-ymin)*(y-ymin) > distance)) ||
16876 murrell 1168 
	    (x > xmax && y < ymin &&
45446 ripley 1169 
	     ((x-xmax)*(x-xmax)+(y-ymin)*(y-ymin) > distance)) ||
16876 murrell 1170 
	    (x < xmin && y > ymax &&
1171 
	     ((x-xmin)*(x-xmin)+(y-ymax)*(y-ymax) > distance)) ||
1172 
	    (x > xmax && y > ymax &&
1173 
	     ((x-xmax)*(x-xmax)+(y-ymax)*(y-ymax) > distance))) {
1174 
	    result = -1;
1175 
	}
45446 ripley 1176 
	/* otherwise, convert circle to polygon */
16876 murrell 1177 
	else {
1178 
	    /* Replace circle with polygon.
1179 
 
1180 
	       Heuristic for number of vertices is to use theta so
1181 
	       that cos(theta)*r ~ r - 1 in device units. This is
1182 
	       roughly const * sqrt(r) so there'd be little point in
1183 
	       enforcing an upper limit. */
1184 
 
59177 ripley 1185 
	    result = (r <= 6) ? 10 : (int)(2 * M_PI/acos(1 - 1/r));
16876 murrell 1186 
	}
1187 
    }
1188 
    return result;
1189 
}
1190 
 
1191 
/****************************************************************
1192 
 * GECircle
1193 
 ****************************************************************
1194 
 */
44500 ripley 1195 
void GECircle(double x, double y, double radius, const pGEcontext gc, pGEDevDesc dd)
16876 murrell 1196 
{
50746 ripley 1197 
    const void *vmax;
16876 murrell 1198 
    double *xc, *yc;
1199 
    int result;
1200 
 
58237 ripley 1201 
    /* There is no point in trying to plot a circle of zero radius */
58227 ripley 1202 
    if (radius <= 0.0) return;
1203 
 
59506 ripley 1204 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
1205 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 1206 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK)
37560 murrell 1207 
	/* "transparent" border */
1208 
	gc->col = R_TRANWHITE;
32391 ripley 1209 
    /*
26787 murrell 1210 
     * If the device can clip, then we just clip to the device
1211 
     * boundary and let the device do clipping within that.
1212 
     * We do this to avoid problems where writing WAY off the
1213 
     * device can cause problems for, e.g., ghostview
1214 
     *
1215 
     * If the device can't clip, we have to do all the clipping
1216 
     * ourselves.
1217 
     */
1218 
    result = clipCircleCode(x, y, radius, dd->dev->canClip, dd);
16876 murrell 1219 
 
1220 
    switch (result) {
1221 
    case -2: /* No clipping;  draw all of circle */
32391 ripley 1222 
	/*
26787 murrell 1223 
	 * If we did the clipping, then the circle is entirely
1224 
	 * within the current clipping rect.
1225 
	 *
1226 
	 * If the device can clip then we just clipped to the device
1227 
	 * boundary so the circle is entirely within the device; the
1228 
	 * device will perform the clipping to the current clipping rect.
1229 
	 */
27236 murrell 1230 
	dd->dev->circle(x, y, radius, gc, dd->dev);
16876 murrell 1231 
	break;
1232 
    case -1: /* Total clipping; draw nothing */
32391 ripley 1233 
	/*
26787 murrell 1234 
	 * If we did the clipping, then the circle is entirely outside
1235 
	 * the current clipping rect, so there is nothing to draw.
1236 
	 *
1237 
	 * If the device can clip then we just determined that the
1238 
	 * circle is entirely outside the device, so again there is
1239 
	 * nothing to draw
1240 
	 */
16876 murrell 1241 
	break;
1242 
    default: /* Partial clipping; draw poly[line|gon] */
26787 murrell 1243 
	/*
1244 
	 * If we did the clipping this means that the circle
1245 
	 * intersects the current clipping rect and we need to
1246 
	 * convert to a poly[line|gon] and draw that.
1247 
	 *
32391 ripley 1248 
	 * If the device can clip then we just determined that the
26787 murrell 1249 
	 * circle intersects the device boundary.  We assume that the
1250 
	 * circle is not so big that other parts may be WAY off the
1251 
	 * device and just draw a circle.
1252 
	 */
1253 
	if (dd->dev->canClip) {
27236 murrell 1254 
	    dd->dev->circle(x, y, radius, gc, dd->dev);
16876 murrell 1255 
	}
1256 
	else {
1257 
	    vmax = vmaxget();
1258 
	    xc = (double*)R_alloc(result+1, sizeof(double));
1259 
	    yc = (double*)R_alloc(result+1, sizeof(double));
1260 
	    convertCircle(x, y, radius, result, xc, yc);
30129 murrell 1261 
	    if (R_TRANSPARENT(gc->fill)) {
27236 murrell 1262 
		GEPolyline(result+1, xc, yc, gc, dd);
16876 murrell 1263 
	    }
1264 
	    else {
1265 
		int npts;
1266 
		double *xcc, *ycc;
1267 
		xcc = ycc = 0;	/* -Wall */
1268 
		npts = clipPoly(xc, yc, result, 0, !dd->dev->canClip,
1269 
				    xcc, ycc, dd);
1270 
		if (npts > 1) {
1271 
		    xcc = (double*)R_alloc(npts, sizeof(double));
1272 
		    ycc = (double*)R_alloc(npts, sizeof(double));
1273 
		    npts = clipPoly(xc, yc, result, 1, !dd->dev->canClip,
1274 
					xcc, ycc, dd);
27236 murrell 1275 
		    dd->dev->polygon(npts, xcc, ycc, gc, dd->dev);
16876 murrell 1276 
		}
1277 
	    }
1278 
	    vmaxset(vmax);
1279 
	}
1280 
    }
1281 
}
1282 
 
1283 
/****************************************************************
1284 
 * R code for clipping rectangles
1285 
 ****************************************************************
1286 
 */
1287 
/* Return a code indicating how the rectangle should be clipped.
1288 
 
1289 
   1 means the rectangle is totally inside the clip region
1290 
   2 means the rectangle intersects the clip region */
16946 maechler 1291 
static int clipRectCode(double x0, double y0, double x1, double y1,
44285 ripley 1292 
			int toDevice, pGEDevDesc dd)
16876 murrell 1293 
{
1294 
    int result;
1295 
    /* determine clipping region */
1296 
    double xmin, xmax, ymin, ymax;
1297 
    if (toDevice)
1298 
	getClipRectToDevice(&xmin, &ymin, &xmax, &ymax, dd);
1299 
    else
1300 
	getClipRect(&xmin, &ymin, &xmax, &ymax, dd);
1301 
 
1302 
    if ((x0 < xmin && x1 < xmin) || (x0 > xmax && x1 > xmax) ||
1303 
	(y0 < ymin && y1 < ymin) || (y0 > ymax && y1 > ymax))
1304 
	result = 0;
1305 
    else if ((x0 > xmin && x0 < xmax) && (x1 > xmin && x1 < xmax) &&
1306 
	     (y0 > ymin && y0 < ymax) && (y1 > ymin && y1 < ymax))
1307 
	result = 1;
1308 
    else
1309 
	result = 2;
16946 maechler 1310 
 
16876 murrell 1311 
    return result;
1312 
}
1313 
 
1314 
/****************************************************************
1315 
 * GERect
1316 
 ****************************************************************
1317 
 */
1318 
/* Filled with color fill and outlined with color col  */
30129 murrell 1319 
/* These may both be fully transparent */
16876 murrell 1320 
void GERect(double x0, double y0, double x1, double y1,
44500 ripley 1321 
	    const pGEcontext gc, pGEDevDesc dd)
16876 murrell 1322 
{
50746 ripley 1323 
    const void *vmax;
16876 murrell 1324 
    double *xc, *yc;
1325 
    int result;
1326 
 
59506 ripley 1327 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
1328 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 1329 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK)
37560 murrell 1330 
	/* "transparent" border */
1331 
	gc->col = R_TRANWHITE;
32391 ripley 1332 
    /*
26787 murrell 1333 
     * For clipping logic, see comments in GECircle
1334 
     */
1335 
    result = clipRectCode(x0, y0, x1, y1, dd->dev->canClip, dd);
16876 murrell 1336 
    switch (result) {
1337 
    case 0:  /* rectangle totally clipped; draw nothing */
1338 
	break;
1339 
    case 1:  /* rectangle totally inside;  draw all */
27236 murrell 1340 
	dd->dev->rect(x0, y0, x1, y1, gc, dd->dev);
16876 murrell 1341 
	break;
1342 
    case 2:  /* rectangle intersects clip region;  use polygon clipping */
26787 murrell 1343 
	if (dd->dev->canClip)
27236 murrell 1344 
	    dd->dev->rect(x0, y0, x1, y1, gc, dd->dev);
16876 murrell 1345 
	else {
1346 
	    vmax = vmaxget();
1347 
	    xc = (double*)R_alloc(5, sizeof(double));
1348 
	    yc = (double*)R_alloc(5, sizeof(double));
1349 
	    xc[0] = x0; yc[0] = y0;
1350 
	    xc[1] = x0; yc[1] = y1;
1351 
	    xc[2] = x1; yc[2] = y1;
1352 
	    xc[3] = x1; yc[3] = y0;
1353 
	    xc[4] = x0; yc[4] = y0;
30129 murrell 1354 
	    if (R_TRANSPARENT(gc->fill)) {
27236 murrell 1355 
		GEPolyline(5, xc, yc, gc, dd);
16876 murrell 1356 
	    }
1357 
	    else { /* filled rectangle */
1358 
		int npts;
1359 
		double *xcc, *ycc;
1360 
		xcc = ycc = 0;		/* -Wall */
1361 
		npts = clipPoly(xc, yc, 4, 0, !dd->dev->canClip, xcc, ycc, dd);
1362 
		if (npts > 1) {
1363 
		    xcc = (double*)R_alloc(npts, sizeof(double));
1364 
		    ycc = (double*)R_alloc(npts, sizeof(double));
1365 
		    npts = clipPoly(xc, yc, 4, 1, !dd->dev->canClip, xcc, ycc, dd);
27236 murrell 1366 
		    dd->dev->polygon(npts, xcc, ycc, gc, dd->dev);
16876 murrell 1367 
		}
1368 
	    }
1369 
	    vmaxset(vmax);
1370 
	}
1371 
    }
1372 
}
1373 
 
1374 
/****************************************************************
52406 murrell 1375 
 * GEPath
1376 
 ****************************************************************
1377 
 */
1378 
 
1379 
void GEPath(double *x, double *y,
1380 
            int npoly, int *nper,
1381 
            Rboolean winding,
1382 
            const pGEcontext gc, pGEDevDesc dd)
1383 
{
56855 ripley 1384 
    /* safety check: this will be NULL if the device did not set it. */
1385 
    if (!dd->dev->path) {
60844 ripley 1386 
	warning(_("path rendering is not implemented for this device"));
56855 ripley 1387 
	return;
1388 
    }
52406 murrell 1389 
    /* FIXME: what about clipping? (if the device can't)
1390 
    */
59506 ripley 1391 
    if (gc->lwd == R_PosInf || gc->lwd < 0.0)
1392 
	error(_("'lwd' must be non-negative and finite"));
59525 ripley 1393 
    if (ISNAN(gc->lwd) || gc->lty == LTY_BLANK)
52406 murrell 1394 
	gc->col = R_TRANWHITE;
1395 
    if (npoly > 0) {
1396 
        int i;
1397 
        int draw = 1;
1398 
        for (i=0; i < npoly; i++) {
1399 
            if (nper[i] < 2) {
1400 
                draw = 0;
1401 
            }
1402 
        }
1403 
        if (draw) {
1404 
            dd->dev->path(x, y, npoly, nper, winding, gc, dd->dev);
1405 
        } else {
1406 
	    error(_("Invalid graphics path"));
1407 
        }
1408 
    }
1409 
}
1410 
 
1411 
/****************************************************************
50283 murrell 1412 
 * GERaster
1413 
 ****************************************************************
1414 
 */
1415 
 
1416 
void GERaster(unsigned int *raster, int w, int h,
1417 
              double x, double y,
1418 
              double width, double height,
1419 
              double angle,
1420 
              Rboolean interpolate,
1421 
              const pGEcontext gc, pGEDevDesc dd)
1422 
{
56855 ripley 1423 
    /* safety check: this will be NULL if the device did not set it. */
1424 
    if (!dd->dev->raster) {
60844 ripley 1425 
	warning(_("raster rendering is not implemented for this device"));
56855 ripley 1426 
	return;
1427 
    }
1428 
 
50283 murrell 1429 
    /* FIXME: what about clipping? (if the device can't)
1430 
     * Maybe not too bad because it is just a matter of shaving off
1431 
     * some rows and columns from the image? (because R only does
1432 
     * rectangular clipping regions) */
52280 murrell 1433 
 
1434 
    if (width != 0 && height != 0) {
1435 
        dd->dev->raster(raster, w, h, x, y, width, height,
1436 
                        angle, interpolate, gc, dd->dev);
1437 
    }
50283 murrell 1438 
}
1439 
 
1440 
/****************************************************************
1441 
 * GERaster
1442 
 ****************************************************************
1443 
 */
1444 
 
1445 
SEXP GECap(pGEDevDesc dd)
1446 
{
56855 ripley 1447 
    /* safety check: this will be NULL if the device did not set it. */
1448 
    if (!dd->dev->cap) {
60844 ripley 1449 
	warning(_("raster capture is not available for this device"));
56855 ripley 1450 
	return R_NilValue;
1451 
    }
50283 murrell 1452 
    return dd->dev->cap(dd->dev);
1453 
}
1454 
 
1455 
/****************************************************************
16876 murrell 1456 
 * R code for clipping text
1457 
 ****************************************************************
1458 
 */
1459 
 
1460 
/* Return a code indicating how the text should be clipped
1461 
   NOTE that x, y indicate the bottom-left of the text
1462 
   NOTE also also that this is a bit crude because it actually uses
1463 
   a bounding box for the entire text to determine the clipping code.
1464 
   This will mean that in certain (very rare ?) cases, a piece of
1465 
   text will be characterised as intersecting with the clipping region
1466 
   when in fact it lies totally outside the clipping region.  But
1467 
   this is not a problem because the final output will still be correct.
1468 
 
1469 
   1 means totally inside clip region
1470 
   2 means intersects clip region */
44986 ripley 1471 
static int clipTextCode(double x, double y, const char *str, cetype_t enc,
44411 ripley 1472 
			double width, double height, double rot, double hadj,
44500 ripley 1473 
			const pGEcontext gc, int toDevice, pGEDevDesc dd)
16876 murrell 1474 
{
1475 
    double x0, x1, x2, x3, y0, y1, y2, y3, left, right, bottom, top;
44411 ripley 1476 
    double length, theta2;
16876 murrell 1477 
    double angle = DEG2RAD * rot;
1478 
    double theta1 = M_PI/2 - angle;
53057 murrell 1479 
    double widthInches, heightInches, xInches, yInches;
44411 ripley 1480 
 
1481 
    if (!R_FINITE(width)) width = GEStrWidth(str, enc, gc, dd);
1482 
    if (!R_FINITE(height)) height = GEStrHeight(str, enc, gc, dd);
53057 murrell 1483 
 
1484 
    /* Work in inches */
1485 
    widthInches = fromDeviceWidth(width, GE_INCHES, dd);
1486 
    heightInches = fromDeviceHeight(height, GE_INCHES, dd);
1487 
    xInches = fromDeviceX(x, GE_INCHES, dd);
1488 
    yInches = fromDeviceY(y, GE_INCHES, dd);
1489 
 
1490 
    length = hypot(widthInches, heightInches);
1491 
    theta2 = angle + atan2(heightInches, widthInches);
45446 ripley 1492 
 
53057 murrell 1493 
    x  = xInches - hadj*widthInches*cos(angle);
1494 
    y  = yInches - hadj*widthInches*sin(angle);
1495 
    x0 = x + heightInches*cos(theta1);
16876 murrell 1496 
    x1 = x;
1497 
    x2 = x + length*cos(theta2);
53057 murrell 1498 
    x3 = x + widthInches*cos(angle);
1499 
    y0 = y + heightInches*sin(theta1);
16876 murrell 1500 
    y1 = y;
1501 
    y2 = y + length*sin(theta2);
53057 murrell 1502 
    y3 = y + widthInches*sin(angle);
16876 murrell 1503 
    left = fmin2(fmin2(x0, x1), fmin2(x2, x3));
1504 
    right = fmax2(fmax2(x0, x1), fmax2(x2, x3));
1505 
    bottom = fmin2(fmin2(y0, y1), fmin2(y2, y3));
1506 
    top = fmax2(fmax2(y0, y1), fmax2(y2, y3));
53057 murrell 1507 
    return clipRectCode(toDeviceX(left, GE_INCHES, dd),
1508 
                        toDeviceY(bottom, GE_INCHES, dd),
1509 
                        toDeviceX(right, GE_INCHES, dd),
1510 
                        toDeviceY(top, GE_INCHES, dd),
1511 
                        toDevice, dd);
16876 murrell 1512 
}
1513 
 
44986 ripley 1514 
static void clipText(double x, double y, const char *str, cetype_t enc,
44411 ripley 1515 
		     double width, double height, double rot, double hadj,
44500 ripley 1516 
		     const pGEcontext gc, int toDevice, pGEDevDesc dd)
16876 murrell 1517 
{
44411 ripley 1518 
    int result = clipTextCode(x, y, str, enc, width, height, rot, hadj,
1519 
			      gc, toDevice, dd);
45446 ripley 1520 
    void (*textfn)(double x, double y, const char *str, double rot,
44500 ripley 1521 
		   double hadj, const pGEcontext gc, pDevDesc dd);
44216 ripley 1522 
    /* This guards against uninitialized values, e.g. devices installed
43995 ripley 1523 
       in earlier versions of R */
1524 
    textfn = (dd->dev->hasTextUTF8 ==TRUE) && enc == CE_UTF8 ?
43936 ripley 1525 
	dd->dev->textUTF8 : dd->dev->text;
1526 
 
16876 murrell 1527 
    switch (result) {
1528 
    case 0:  /* text totally clipped; draw nothing */
1529 
	break;
1530 
    case 1:  /* text totally inside;  draw all */
43936 ripley 1531 
	textfn(x, y, str, rot, hadj, gc, dd->dev);
16876 murrell 1532 
	break;
1533 
    case 2:  /* text intersects clip region
1534 
		act according to value of clipToDevice */
1535 
	if (toDevice) /* Device will do clipping */
43936 ripley 1536 
	    textfn(x, y, str, rot, hadj, gc, dd->dev);
16876 murrell 1537 
	else /* don't draw anything; this could be made less crude :) */
1538 
	    ;
1539 
    }
1540 
}
1541 
 
1542 
/****************************************************************
21062 murrell 1543 
 * Code for determining when to branch to vfont code from GEText
1544 
 ****************************************************************
1545 
 */
1546 
 
1547 
typedef struct {
1548 
    char *name;
1549 
    int minface;
1550 
    int maxface;
1551 
} VFontTab;
1552 
 
1553 
static VFontTab
1554 
VFontTable[] = {
1555 
    { "HersheySerif",	          1, 7 },
32391 ripley 1556 
    /*
1557 
       HersheySerif
1558 
       HersheySerif-Italic
1559 
       HersheySerif-Bold
1560 
       HersheySerif-BoldItalic
1561 
       HersheyCyrillic
1562 
       HersheyCyrillic-Oblique
1563 
       HersheyEUC
21062 murrell 1564 
    */
1565 
    { "HersheySans",	          1, 4 },
32391 ripley 1566 
    /*
1567 
       HersheySans
1568 
       HersheySans-Oblique
1569 
       HersheySans-Bold
1570 
       HersheySans-BoldOblique
21062 murrell 1571 
    */
1572 
    { "HersheyScript",	          1, 4 },
1573 
    /*
32391 ripley 1574 
      HersheyScript
1575 
      HersheyScript
21062 murrell 1576 
      HersheyScript-Bold
32391 ripley 1577 
      HersheyScript-Bold
1578 
    */
21062 murrell 1579 
    { "HersheyGothicEnglish",	  1, 1 },
1580 
    { "HersheyGothicGerman",	  1, 1 },
1581 
    { "HersheyGothicItalian",	  1, 1 },
1582 
    { "HersheySymbol",	          1, 4 },
1583 
    /*
32391 ripley 1584 
      HersheySerifSymbol
1585 
      HersheySerifSymbol-Oblique
1586 
      HersheySerifSymbol-Bold
1587 
      HersheySerifSymbol-BoldOblique
1588 
    */
21062 murrell 1589 
    { "HersheySansSymbol",        1, 2 },
1590 
    /*
32391 ripley 1591 
      HersheySansSymbol
1592 
      HersheySansSymbol-Oblique
21062 murrell 1593 
    */
1594 
 
1595 
    { NULL,		          0, 0 },
1596 
};
1597 
 
1598 
static int VFontFamilyCode(char *fontfamily)
1599 
{
43924 ripley 1600 
    int i, j = fontfamily[3];
1601 
 
1602 
    /* Inline vfont is passed down as familycode in fourth byte */
1603 
    if (!strncmp(fontfamily, "Her", 3) && j < 9) return 100 + j;
21062 murrell 1604 
    for (i = 0; VFontTable[i].minface; i++)
31138 murrell 1605 
	if (!strcmp(fontfamily, VFontTable[i].name)) {
43924 ripley 1606 
	    return i+1;
31138 murrell 1607 
	}
21062 murrell 1608 
    return -1;
1609 
}
1610 
 
31138 murrell 1611 
static int VFontFaceCode(int familycode, int fontface) {
1612 
    int face = fontface;
43924 ripley 1613 
    familycode--;  /* Table is 0-based, coding is 1-based */
32391 ripley 1614 
    /*
31138 murrell 1615 
     * R's "font" par has historically made 2=bold and 3=italic
1616 
     * These must be switched to correspond to Hershey fontfaces
1617 
     */
1618 
    if (fontface == 2)
1619 
	face = 3;
1620 
    else if (fontface == 3)
1621 
	face = 2;
1622 
    /*
1623 
     * If font face is outside supported set of faces for font
1624 
     * family, either convert or throw and error
1625 
     */
1626 
    if (!(face >= VFontTable[familycode].minface &&
1627 
	  face <= VFontTable[familycode].maxface)) {
32391 ripley 1628 
	/*
31138 murrell 1629 
	 * Silently convert standard faces to closest match
1630 
	 */
1631 
	switch (face) {
1632 
	    /*
1633 
	     * italic becomes plain (gothic only)
1634 
	     */
1635 
	case 2:
32391 ripley 1636 
	    /*
31138 murrell 1637 
	     * bold becomes plain
1638 
	     */
32391 ripley 1639 
	case 3:
31138 murrell 1640 
	    face = 1;
1641 
	    break;
32391 ripley 1642 
	    /*
31138 murrell 1643 
	     * bold-italic becomes italic for gothic fonts
32391 ripley 1644 
	     * and bold for sans symbol font
31138 murrell 1645 
	     */
32391 ripley 1646 
	case 4:
31138 murrell 1647 
	    if (familycode == 7)
1648 
		face = 2;
1649 
	    else
1650 
		face = 1;
1651 
	    break;
1652 
	default:
32391 ripley 1653 
	    /*
31138 murrell 1654 
	     * Other font faces just too wacky so throw an error
1655 
	     */
33297 ripley 1656 
	    error(_("font face %d not supported for font family '%s'"),
31138 murrell 1657 
		  fontface, VFontTable[familycode].name);
1658 
	}
1659 
    }
1660 
    return face;
1661 
}
32391 ripley 1662 
 
21062 murrell 1663 
/****************************************************************
16876 murrell 1664 
 * GEText
1665 
 ****************************************************************
1666 
 */
1667 
/* If you want EXACT centering of text (e.g., like in GSymbol) */
1668 
/* then pass NA_REAL for xc and yc */
44986 ripley 1669 
void GEText(double x, double y, const char * const str, cetype_t enc,
21062 murrell 1670 
	    double xc, double yc, double rot,
44500 ripley 1671 
	    const pGEcontext gc, pGEDevDesc dd)
16876 murrell 1672 
{
32391 ripley 1673 
    /*
21062 murrell 1674 
     * If the fontfamily is a Hershey font family, call R_GE_VText
1675 
     */
27236 murrell 1676 
    int vfontcode = VFontFamilyCode(gc->fontfamily);
43924 ripley 1677 
    if (vfontcode >= 100) {
43926 ripley 1678 
	R_GE_VText(x, y, str, enc, xc, yc, rot, gc, dd);
43924 ripley 1679 
    } else if (vfontcode >= 0) {
59177 ripley 1680 
	gc->fontfamily[3] = (char) vfontcode;
31138 murrell 1681 
	gc->fontface = VFontFaceCode(vfontcode, gc->fontface);
43926 ripley 1682 
	R_GE_VText(x, y, str, enc, xc, yc, rot, gc, dd);
21062 murrell 1683 
    } else {
55697 ripley 1684 
	/* PR#7397: this seemed to reset R_Visible */
43932 ripley 1685 
	Rboolean savevis = R_Visible;
44337 ripley 1686 
	int noMetricInfo = -1;
40081 ripley 1687 
	char *sbuf = NULL;
1688 
	if(str && *str) {
1689 
	    const char *s;
1690 
	    char *sb;
44986 ripley 1691 
	    int i, n;
1692 
	    cetype_t enc2;
40081 ripley 1693 
	    double xoff, yoff, hadj;
1694 
	    double sin_rot, cos_rot;/* sin() & cos() of rot{ation} in radians */
1695 
	    double xleft, ybottom;
50875 ripley 1696 
	    const void *vmax = vmaxget();
43936 ripley 1697 
 
43957 ripley 1698 
	    enc2 = (gc->fontface == 5) ? CE_SYMBOL : enc;
44147 ripley 1699 
	    if(enc2 != CE_SYMBOL)
1700 
		enc2 = (dd->dev->hasTextUTF8 == TRUE) ? CE_UTF8 : CE_NATIVE;
44325 ripley 1701 
	    else if(dd->dev->wantSymbolUTF8 == TRUE) enc2 = CE_UTF8;
55697 ripley 1702 
	    else if(dd->dev->wantSymbolUTF8 == NA_LOGICAL) {
55696 ripley 1703 
		enc = CE_LATIN1;
1704 
		enc2 = CE_UTF8;
1705 
	    }
55697 ripley 1706 
 
43969 ripley 1707 
#ifdef DEBUG_MI
1708 
	    printf("string %s, enc %d, %d\n", str, enc, enc2);
1709 
#endif
1710 
 
40081 ripley 1711 
	    /* We work in GE_INCHES */
1712 
	    x = fromDeviceX(x, GE_INCHES, dd);
1713 
	    y = fromDeviceY(y, GE_INCHES, dd);
1714 
	    /* Count the lines of text */
1715 
	    n = 1;
1716 
	    for(s = str; *s ; s++)
43932 ripley 1717 
		if (*s == '\n') n++;
40081 ripley 1718 
	    /* Allocate a temporary buffer */
43932 ripley 1719 
	    sb = sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char));
40081 ripley 1720 
	    i = 0;
1721 
	    sin_rot = DEG2RAD * rot;
1722 
	    cos_rot = cos(sin_rot);
1723 
	    sin_rot = sin(sin_rot);
1724 
	    for(s = str; ; s++) {
1725 
		if (*s == '\n' || *s == '\0') {
44411 ripley 1726 
		    double w = NA_REAL, h = NA_REAL;
43932 ripley 1727 
		    const char *str;
40081 ripley 1728 
		    *sb = '\0';
50880 ripley 1729 
		    /* This may R_alloc, but let's assume that
1730 
		       there are not many lines of text per string */
43932 ripley 1731 
		    str = reEnc(sbuf, enc, enc2, 2);
40081 ripley 1732 
		    if (n > 1) {
1733 
			/* first determine location of THIS line */
1734 
			if (!R_FINITE(xc))
1735 
			    xc = 0.5;
1736 
			if (!R_FINITE(yc))
1737 
			    yc = 0.5;
1738 
			yoff = (1 - yc)*(n - 1) - i;
1739 
			/* cra is based on the font pointsize at the
1740 
			 * time the device was created.
1741 
			 * Adjust for potentially different current pointsize.
1742 
			 * This is a crude calculation that might be better
1743 
			 * performed using a device call that responds with
1744 
			 * the current font pointsize in device coordinates.
1745 
			 */
1746 
			yoff = fromDeviceHeight(yoff * gc->lineheight *
1747 
						gc->cex * dd->dev->cra[1] *
1748 
						gc->ps/dd->dev->startps,
1749 
						GE_INCHES, dd);
1750 
			xoff = - yoff*sin_rot;
1751 
			yoff = yoff*cos_rot;
1752 
			xoff = x + xoff;
1753 
			yoff = y + yoff;
1754 
		    } else {
1755 
			xoff = x;
1756 
			yoff = y;
1757 
		    }
1758 
		    /* now determine bottom-left for THIS line */
44411 ripley 1759 
		    if(xc != 0.0 || yc != 0.0) {
1760 
			double width, height = 0.0 /* -Wall */;
1761 
			w  = GEStrWidth(str, enc2, gc, dd);
1762 
			width = fromDeviceWidth(w, GE_INCHES, dd);
40081 ripley 1763 
			if (!R_FINITE(xc))
1764 
			    xc = 0.5;
1765 
			if (!R_FINITE(yc)) {
1766 
			    /* "exact" vertical centering */
1767 
			    /* If font metric info is available AND */
1768 
			    /* there is only one line, use GMetricInfo & yc=0.5 */
1769 
			    /* Otherwise use GEStrHeight and fiddle yc */
1770 
			    double h, d, w;
44337 ripley 1771 
			    if (noMetricInfo < 0) {
1772 
				GEMetricInfo('M', gc, &h, &d, &w, dd);
1773 
				noMetricInfo = (h == 0 && d == 0 && w == 0) ? 1 : 0;
1774 
			    }
1775 
			    if (n > 1 || noMetricInfo) {
44411 ripley 1776 
				h = GEStrHeight(str, enc2, gc, dd);
1777 
				height = fromDeviceHeight(h, GE_INCHES, dd);
40081 ripley 1778 
				yc = dd->dev->yCharOffset;
1779 
			    } else {
1780 
				double maxHeight = 0.0;
1781 
				double maxDepth = 0.0;
43932 ripley 1782 
				const char *ss = str;
40081 ripley 1783 
				int charNum = 0;
43960 ripley 1784 
				Rboolean done = FALSE;
40081 ripley 1785 
				/* Symbol fonts are not encoded in MBCS ever */
44325 ripley 1786 
				if(enc2 != CE_SYMBOL && !strIsASCII(ss)) {
43960 ripley 1787 
				    if(mbcslocale && enc2 == CE_NATIVE) {
1788 
					/* FIXME: This assumes that wchar_t is UCS-2/4,
1789 
					   since that is what GEMetricInfo expects */
59173 ripley 1790 
					size_t n = strlen(ss), used;
43960 ripley 1791 
					wchar_t wc;
1792 
					mbstate_t mb_st;
1793 
					mbs_init(&mb_st);
1794 
					while ((used = mbrtowc(&wc, ss, n, &mb_st)) > 0) {
43969 ripley 1795 
#ifdef DEBUG_MI
1796 
					    printf(" centring %s aka %d in MBCS\n", ss, wc);
1797 
#endif
43960 ripley 1798 
					    GEMetricInfo((int) wc, gc, &h, &d, &w, dd);
1799 
					    h = fromDeviceHeight(h, GE_INCHES, dd);
1800 
					    d = fromDeviceHeight(d, GE_INCHES, dd);
1801 
					    if (charNum++ == 0) {
1802 
						maxHeight = h;
1803 
						maxDepth = d;
1804 
					    } else {
1805 
						if (h > maxHeight) maxHeight = h;
1806 
						if (d > maxDepth) maxDepth = d;
1807 
					    }
1808 
					    ss += used; n -=used;
40081 ripley 1809 
					}
43960 ripley 1810 
					done = TRUE;
1811 
				    } else if (enc2 == CE_UTF8) {
59177 ripley 1812 
					size_t used;
43960 ripley 1813 
					wchar_t wc;
1814 
					while ((used = utf8toucs(&wc, ss)) > 0) {
1815 
					    GEMetricInfo(-(int) wc, gc, &h, &d, &w, dd);
1816 
					    h = fromDeviceHeight(h, GE_INCHES, dd);
1817 
					    d = fromDeviceHeight(d, GE_INCHES, dd);
43969 ripley 1818 
#ifdef DEBUG_MI
1819 
					    printf(" centring %s aka %d in UTF-8, %f %f\n", ss, wc, h, d);
1820 
#endif
43960 ripley 1821 
					    if (charNum++ == 0) {
1822 
						maxHeight = h;
1823 
						maxDepth = d;
1824 
					    } else {
1825 
						if (h > maxHeight) maxHeight = h;
1826 
						if (d > maxDepth) maxDepth = d;
1827 
					    }
59202 ripley 1828 
					    ss += used;
43960 ripley 1829 
					}
1830 
					done = TRUE;
32419 ripley 1831 
				    }
43960 ripley 1832 
				}
1833 
				if(!done) {
43932 ripley 1834 
				    for (ss = str; *ss; ss++) {
40081 ripley 1835 
					GEMetricInfo((unsigned char) *ss, gc,
1836 
						     &h, &d, &w, dd);
1837 
					h = fromDeviceHeight(h, GE_INCHES, dd);
1838 
					d = fromDeviceHeight(d, GE_INCHES, dd);
43969 ripley 1839 
#ifdef DEBUG_MI
1840 
					printf("metric info for %d, %f %f\n",
1841 
					       (unsigned char) *ss, h, d);
1842 
#endif
40081 ripley 1843 
					/* Set maxHeight and maxDepth from height
1844 
					   and depth of first char.
1845 
					   Must NOT set to 0 in case there is
1846 
					   only 1 char and it has negative
1847 
					   height or depth
1848 
					*/
1849 
					if (charNum++ == 0) {
1850 
					    maxHeight = h;
1851 
					    maxDepth = d;
1852 
					} else {
1853 
					    if (h > maxHeight) maxHeight = h;
1854 
					    if (d > maxDepth) maxDepth = d;
1855 
					}
32419 ripley 1856 
				    }
43960 ripley 1857 
				}
40081 ripley 1858 
				height = maxHeight - maxDepth;
1859 
				yc = 0.5;
1860 
			    }
1861 
			} else {
44411 ripley 1862 
			    h = GEStrHeight(str, CE_NATIVE, gc, dd);
1863 
			    height = fromDeviceHeight(h, GE_INCHES, dd);
16876 murrell 1864 
			}
40081 ripley 1865 
			if (dd->dev->canHAdj == 2) hadj = xc;
1866 
			else if (dd->dev->canHAdj == 1) {
1867 
			    hadj = 0.5 * floor(2*xc + 0.5);
1868 
			    /* limit to 0, 0.5, 1 */
1869 
			    hadj = (hadj > 1.0) ? 1.0 :((hadj < 0.0) ? 0.0 : hadj);
1870 
			} else hadj = 0.0;
1871 
			xleft = xoff - (xc-hadj)*width*cos_rot + yc*height*sin_rot;
43932 ripley 1872 
			ybottom = yoff - (xc-hadj)*width*sin_rot -
40081 ripley 1873 
			    yc*height*cos_rot;
1874 
		    } else { /* xc = yc = 0.0 */
1875 
			xleft = xoff;
1876 
			ybottom = yoff;
1877 
			hadj = 0.0;
16876 murrell 1878 
		    }
40081 ripley 1879 
		    /* Convert GE_INCHES back to device.
1880 
		     */
1881 
		    xleft = toDeviceX(xleft, GE_INCHES, dd);
1882 
		    ybottom = toDeviceY(ybottom, GE_INCHES, dd);
44411 ripley 1883 
		    clipText(xleft, ybottom, str, enc2, w, h, rot, hadj,
1884 
			     gc, dd->dev->canClip, dd);
40081 ripley 1885 
		    sb = sbuf;
43932 ripley 1886 
		    i++;
16876 murrell 1887 
		}
40081 ripley 1888 
		else *sb++ = *s;
1889 
		if (!*s) break;
16876 murrell 1890 
	    }
50875 ripley 1891 
	    vmaxset(vmax);
16876 murrell 1892 
	}
40081 ripley 1893 
	R_Visible = savevis;
16876 murrell 1894 
    }
1895 
}
1896 
 
1897 
/****************************************************************
36317 murrell 1898 
 * GEXspline
1899 
 ****************************************************************
1900 
 */
1901 
 
1902 
#include "xspline.c"
1903 
 
36362 murrell 1904 
/*
1905 
 * Draws a "curve" through the specified control points.
1906 
 * Return the vertices of the line that gets drawn.
44417 ripley 1907 
 
1908 
 * NB: this works in device coordinates.  To make it work correctly
1909 
 * with non-square 'pixels' we use the x-dimensions only.
36362 murrell 1910 
 */
1911 
SEXP GEXspline(int n, double *x, double *y, double *s, Rboolean open,
43965 ripley 1912 
	       Rboolean repEnds,
36366 murrell 1913 
	       Rboolean draw, /* May be called just to get points */
44500 ripley 1914 
	       const pGEcontext gc, pGEDevDesc dd)
36317 murrell 1915 
{
1916 
    /*
1917 
     * Use xspline.c code to generate points to draw
1918 
     * Draw polygon or polyline from points
1919 
     */
36362 murrell 1920 
    SEXP result = R_NilValue;
44417 ripley 1921 
    int i;
1922 
    double *ipr = dd->dev->ipr, asp = ipr[0]/ipr[1], *ys;
43965 ripley 1923 
    /*
36317 murrell 1924 
     * Save (and reset below) the heap pointer to clean up
1925 
     * after any R_alloc's done by functions I call.
1926 
     */
50745 ripley 1927 
    const void *vmaxsave = vmaxget();
44417 ripley 1928 
    ys = (double *) R_alloc(n, sizeof(double));
1929 
    for (i = 0; i < n; i++) ys[i] = y[i]*asp;
36317 murrell 1930 
    if (open) {
44417 ripley 1931 
      compute_open_spline(n, x, ys, s, repEnds, LOW_PRECISION, dd);
43313 murrell 1932 
      if (draw) {
36366 murrell 1933 
	  GEPolyline(npoints, xpoints, ypoints, gc, dd);
43313 murrell 1934 
      }
36317 murrell 1935 
    } else {
44417 ripley 1936 
      compute_closed_spline(n, x, ys, s, LOW_PRECISION, dd);
36366 murrell 1937 
      if (draw)
1938 
	  GEPolygon(npoints, xpoints, ypoints, gc, dd);
36317 murrell 1939 
    }
36362 murrell 1940 
    if (npoints > 1) {
1941 
	SEXP xpts, ypts;
1942 
	int i;
1943 
	PROTECT(xpts = allocVector(REALSXP, npoints));
1944 
	PROTECT(ypts = allocVector(REALSXP, npoints));
44417 ripley 1945 
	for (i = 0; i < npoints; i++) {
36362 murrell 1946 
	    REAL(xpts)[i] = xpoints[i];
44417 ripley 1947 
	    REAL(ypts)[i] = ypoints[i]/asp;
36362 murrell 1948 
	}
1949 
	PROTECT(result = allocVector(VECSXP, 2));
1950 
	SET_VECTOR_ELT(result, 0, xpts);
1951 
	SET_VECTOR_ELT(result, 1, ypts);
1952 
	UNPROTECT(3);
43965 ripley 1953 
    }
36317 murrell 1954 
    vmaxset(vmaxsave);
36362 murrell 1955 
    return result;
36317 murrell 1956 
}
1957 
 
1958 
 
1959 
/****************************************************************
16876 murrell 1960 
 * GEMode
1961 
 ****************************************************************
1962 
 */
1963 
/* Check that everything is initialized :
45446 ripley 1964 
	Interpretation :
1965 
	mode = 0, graphics off
1966 
	mode = 1, graphics on
1967 
	mode = 2, graphical input on (ignored by most drivers)
16876 murrell 1968 
*/
44285 ripley 1969 
void GEMode(int mode, pGEDevDesc dd)
16876 murrell 1970 
{
1971 
    if (NoDevices())
33297 ripley 1972 
	error(_("no graphics device is active"));
56857 ripley 1973 
    if(dd->dev->mode) dd->dev->mode(mode, dd->dev);
16876 murrell 1974 
}
1975 
 
1976 
/****************************************************************
1977 
 * GESymbol
1978 
 ****************************************************************
1979 
 */
1980 
#define SMALL	0.25
16946 maechler 1981 
#define RADIUS	0.375
16876 murrell 1982 
#define SQRC	0.88622692545275801364		/* sqrt(pi / 4) */
1983 
#define DMDC	1.25331413731550025119		/* sqrt(pi / 4) * sqrt(2) */
1984 
#define TRC0	1.55512030155621416073		/* sqrt(4 * pi/(3 * sqrt(3))) */
1985 
#define TRC1	1.34677368708859836060		/* TRC0 * sqrt(3) / 2 */
1986 
#define TRC2	0.77756015077810708036		/* TRC0 / 2 */
1987 
/* Draw one of the R special symbols. */
1988 
/* "size" is in device coordinates and is assumed to be a width
16946 maechler 1989 
 * rather than a height.
16876 murrell 1990 
 * This could cause a problem for devices which have ipr[0] != ipr[1]
1991 
 * The problem would be evident where calculations are done on
1992 
 * angles -- in those cases, a conversion to and from GE_INCHES is done
1993 
 * to preserve angles.
1994 
 */
16946 maechler 1995 
void GESymbol(double x, double y, int pch, double size,
44500 ripley 1996 
	      const pGEcontext gc, pGEDevDesc dd)
16876 murrell 1997 
{
1998 
    double r, xc, yc;
1999 
    double xx[4], yy[4];
43969 ripley 2000 
    unsigned int maxchar;
16876 murrell 2001 
 
43969 ripley 2002 
    maxchar = (mbcslocale && gc->fontface != 5) ? 127 : 255;
16876 murrell 2003 
    /* Special cases for plotting pch="." or pch=<character>
2004 
     */
32773 ripley 2005 
    if(pch == NA_INTEGER) /* do nothing */;
43957 ripley 2006 
    else if(pch < 0) {
2007 
	int res;
44179 ripley 2008 
	char str[16];
43957 ripley 2009 
	if(gc->fontface == 5)
2010 
	    error("use of negative pch with symbol font is invalid");
59177 ripley 2011 
	res = (int) ucstoutf8(str, -pch);
44108 ripley 2012 
	if(res == -1) error("invalid multibyte string '%s'", str);
43957 ripley 2013 
	str[res] = '\0';
43965 ripley 2014 
	GEText(x, y, str, CE_UTF8, NA_REAL, NA_REAL, 0., gc, dd);
49591 ripley 2015 
    } else if(' ' <= pch && pch <= maxchar) {
16876 murrell 2016 
	if (pch == '.') {
32391 ripley 2017 
	    /*
26787 murrell 2018 
	     * NOTE:  we are *filling* a rect with the current
2019 
	     * colour (we are not drawing the border AND we are
2020 
	     * not using the current fill colour)
2021 
	     */
27236 murrell 2022 
	    gc->fill = gc->col;
30711 murrell 2023 
	    gc->col = R_TRANWHITE;
43965 ripley 2024 
	    /*
33769 ripley 2025 
	       The idea here is to use a 0.01" square, but to be of
43965 ripley 2026 
	       at least one device unit in each direction,
33769 ripley 2027 
	       assuming that corresponds to pixels. That may be odd if
43965 ripley 2028 
	       pixels are not square, but only on low resolution
33769 ripley 2029 
	       devices where we can do nothing better.
33789 ripley 2030 
 
56406 murdoch 2031 
	       For this symbol only, size is cex (see engine.c).
43965 ripley 2032 
 
33789 ripley 2033 
	       Prior to 2.1.0 the offsets were always 0.5.
33769 ripley 2034 
	    */
33789 ripley 2035 
	    xc = size * fabs(toDeviceWidth(0.005, GE_INCHES, dd));
2036 
	    yc = size * fabs(toDeviceHeight(0.005, GE_INCHES, dd));
56406 murdoch 2037 
	    if(size > 0 && xc < 0.5) xc = 0.5;
2038 
	    if(size > 0 && yc < 0.5) yc = 0.5;
33769 ripley 2039 
	    GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);
16876 murrell 2040 
	} else {
43957 ripley 2041 
	    char str[2];
59177 ripley 2042 
	    str[0] = (char) pch;
43957 ripley 2043 
	    str[1] = '\0';
45446 ripley 2044 
	    GEText(x, y, str,
2045 
		   (gc->fontface == 5) ? CE_SYMBOL : CE_NATIVE,
43969 ripley 2046 
		   NA_REAL, NA_REAL, 0., gc, dd);
16876 murrell 2047 
	}
2048 
    }
43969 ripley 2049 
    else if(pch > maxchar)
2050 
	    warning(_("pch value '%d' is invalid in this locale"), pch);
16876 murrell 2051 
    else {
2052 
	double GSTR_0 = fromDeviceWidth(size, GE_INCHES, dd);
2053 
 
2054 
	switch(pch) {
2055 
 
2056 
	case 0: /* S square */
2057 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2058 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
30711 murrell 2059 
	    gc->fill = R_TRANWHITE;
27236 murrell 2060 
	    GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);
16876 murrell 2061 
	    break;
2062 
 
2063 
	case 1: /* S octahedron ( circle) */
58235 ripley 2064 
	    xc = RADIUS * size; /* NB: could be zero */
30711 murrell 2065 
	    gc->fill = R_TRANWHITE;
27236 murrell 2066 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2067 
	    break;
2068 
 
2069 
	case 2:	/* S triangle - point up */
2070 
	    xc = RADIUS * GSTR_0;
2071 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2072 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
2073 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2074 
	    xx[0] = x; yy[0] = y+r;
2075 
	    xx[1] = x+xc; yy[1] = y-yc;
2076 
	    xx[2] = x-xc; yy[2] = y-yc;
30711 murrell 2077 
	    gc->fill = R_TRANWHITE;
27236 murrell 2078 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2079 
	    break;
2080 
 
2081 
	case 3: /* S plus */
2082 
	    xc = toDeviceWidth(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd);
2083 
	    yc = toDeviceHeight(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd);
27236 murrell 2084 
	    GELine(x-xc, y, x+xc, y, gc, dd);
2085 
	    GELine(x, y-yc, x, y+yc, gc, dd);
16876 murrell 2086 
	    break;
2087 
 
2088 
	case 4: /* S times */
2089 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2090 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
27236 murrell 2091 
	    GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);
2092 
	    GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);
16876 murrell 2093 
	    break;
2094 
 
2095 
	case 5: /* S diamond */
2096 
	    xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);
2097 
	    yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);
2098 
	    xx[0] = x-xc; yy[0] = y;
2099 
	    xx[1] = x; yy[1] = y+yc;
2100 
	    xx[2] = x+xc; yy[2] = y;
2101 
	    xx[3] = x; yy[3] = y-yc;
30711 murrell 2102 
	    gc->fill = R_TRANWHITE;
27236 murrell 2103 
	    GEPolygon(4, xx, yy, gc, dd);
16876 murrell 2104 
	    break;
2105 
 
2106 
	case 6: /* S triangle - point down */
2107 
	    xc = RADIUS * GSTR_0;
2108 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2109 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
2110 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2111 
	    xx[0] = x; yy[0] = y-r;
2112 
	    xx[1] = x+xc; yy[1] = y+yc;
2113 
	    xx[2] = x-xc; yy[2] = y+yc;
30711 murrell 2114 
	    gc->fill = R_TRANWHITE;
27236 murrell 2115 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2116 
	    break;
2117 
 
2118 
	case 7:	/* S square and times superimposed */
2119 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2120 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
30711 murrell 2121 
	    gc->fill = R_TRANWHITE;
27236 murrell 2122 
	    GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);
2123 
	    GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);
2124 
	    GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);
16876 murrell 2125 
	    break;
2126 
 
2127 
	case 8: /* S plus and times superimposed */
2128 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2129 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
27236 murrell 2130 
	    GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);
2131 
	    GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);
16876 murrell 2132 
	    xc = toDeviceWidth(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd);
2133 
	    yc = toDeviceHeight(M_SQRT2*RADIUS*GSTR_0, GE_INCHES, dd);
27236 murrell 2134 
	    GELine(x-xc, y, x+xc, y, gc, dd);
2135 
	    GELine(x, y-yc, x, y+yc, gc, dd);
16876 murrell 2136 
	    break;
2137 
 
2138 
	case 9: /* S diamond and plus superimposed */
2139 
	    xc = toDeviceWidth(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);
2140 
	    yc = toDeviceHeight(M_SQRT2 * RADIUS * GSTR_0, GE_INCHES, dd);
27236 murrell 2141 
	    GELine(x-xc, y, x+xc, y, gc, dd);
2142 
	    GELine(x, y-yc, x, y+yc, gc, dd);
16876 murrell 2143 
	    xx[0] = x-xc; yy[0] = y;
2144 
	    xx[1] = x; yy[1] = y+yc;
2145 
	    xx[2] = x+xc; yy[2] = y;
2146 
	    xx[3] = x; yy[3] = y-yc;
30711 murrell 2147 
	    gc->fill = R_TRANWHITE;
27236 murrell 2148 
	    GEPolygon(4, xx, yy, gc, dd);
16876 murrell 2149 
	    break;
2150 
 
2151 
	case 10: /* S hexagon (circle) and plus superimposed */
26787 murrell 2152 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2153 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
30711 murrell 2154 
	    gc->fill = R_TRANWHITE;
27236 murrell 2155 
	    GECircle(x, y, xc, gc, dd);
2156 
	    GELine(x-xc, y, x+xc, y, gc, dd);
2157 
	    GELine(x, y-yc, x, y+yc, gc, dd);
16876 murrell 2158 
	    break;
2159 
 
2160 
	case 11: /* S superimposed triangles */
2161 
	    xc = RADIUS * GSTR_0;
2162 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2163 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
26787 murrell 2164 
	    yc = 0.5 * (yc + r);
16876 murrell 2165 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2166 
	    xx[0] = x; yy[0] = y-r;
2167 
	    xx[1] = x+xc; yy[1] = y+yc;
2168 
	    xx[2] = x-xc; yy[2] = y+yc;
30711 murrell 2169 
	    gc->fill = R_TRANWHITE;
27236 murrell 2170 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2171 
	    xx[0] = x; yy[0] = y+r;
2172 
	    xx[1] = x+xc; yy[1] = y-yc;
2173 
	    xx[2] = x-xc; yy[2] = y-yc;
27236 murrell 2174 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2175 
	    break;
2176 
 
2177 
	case 12: /* S square and plus superimposed */
26787 murrell 2178 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2179 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
27236 murrell 2180 
	    GELine(x-xc, y, x+xc, y, gc, dd);
2181 
	    GELine(x, y-yc, x, y+yc, gc, dd);
30711 murrell 2182 
	    gc->fill = R_TRANWHITE;
27236 murrell 2183 
	    GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);
16876 murrell 2184 
	    break;
2185 
 
2186 
	case 13: /* S octagon (circle) and times superimposed */
2187 
	    xc = RADIUS * size;
30711 murrell 2188 
	    gc->fill = R_TRANWHITE;
27236 murrell 2189 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2190 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2191 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
27236 murrell 2192 
	    GELine(x-xc, y-yc, x+xc, y+yc, gc, dd);
2193 
	    GELine(x-xc, y+yc, x+xc, y-yc, gc, dd);
16876 murrell 2194 
	    break;
2195 
 
2196 
	case 14: /* S square and point-up triangle superimposed */
2197 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
26787 murrell 2198 
	    xx[0] = x; yy[0] = y+xc;
2199 
	    xx[1] = x+xc; yy[1] = y-xc;
2200 
	    xx[2] = x-xc; yy[2] = y-xc;
30711 murrell 2201 
	    gc->fill = R_TRANWHITE;
27236 murrell 2202 
	    GEPolygon(3, xx, yy, gc, dd);
2203 
	    GERect(x-xc, y-xc, x+xc, y+xc, gc, dd);
16876 murrell 2204 
	    break;
2205 
 
2206 
	case 15: /* S filled square */
2207 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2208 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
2209 
	    xx[0] = x-xc; yy[0] = y-yc;
2210 
	    xx[1] = x+xc; yy[1] = y-yc;
2211 
	    xx[2] = x+xc; yy[2] = y+yc;
2212 
	    xx[3] = x-xc; yy[3] = y+yc;
27236 murrell 2213 
	    gc->fill = gc->col;
30711 murrell 2214 
	    gc->col = R_TRANWHITE;
27236 murrell 2215 
	    GEPolygon(4, xx, yy, gc, dd);
16876 murrell 2216 
	    break;
2217 
 
2218 
	case 16: /* S filled octagon (circle) */
2219 
	    xc = RADIUS * size;
27236 murrell 2220 
	    gc->fill = gc->col;
45788 ripley 2221 
	    gc->col = R_TRANWHITE;
27236 murrell 2222 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2223 
	    break;
2224 
 
2225 
	case 17: /* S filled point-up triangle */
2226 
	    xc = RADIUS * GSTR_0;
2227 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2228 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
2229 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2230 
	    xx[0] = x; yy[0] = y+r;
2231 
	    xx[1] = x+xc; yy[1] = y-yc;
2232 
	    xx[2] = x-xc; yy[2] = y-yc;
27236 murrell 2233 
	    gc->fill = gc->col;
30711 murrell 2234 
	    gc->col = R_TRANWHITE;
27236 murrell 2235 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2236 
	    break;
2237 
 
2238 
	case 18: /* S filled diamond */
26787 murrell 2239 
	    xc = toDeviceWidth(RADIUS * GSTR_0, GE_INCHES, dd);
2240 
	    yc = toDeviceHeight(RADIUS * GSTR_0, GE_INCHES, dd);
16876 murrell 2241 
	    xx[0] = x-xc; yy[0] = y;
2242 
	    xx[1] = x; yy[1] = y+yc;
2243 
	    xx[2] = x+xc; yy[2] = y;
2244 
	    xx[3] = x; yy[3] = y-yc;
27236 murrell 2245 
	    gc->fill = gc->col;
30711 murrell 2246 
	    gc->col = R_TRANWHITE;
27236 murrell 2247 
	    GEPolygon(4, xx, yy, gc, dd);
16876 murrell 2248 
	    break;
2249 
 
2250 
	case 19: /* R filled circle */
2251 
	    xc = RADIUS * size;
27236 murrell 2252 
	    gc->fill = gc->col;
2253 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2254 
	    break;
2255 
 
2256 
 
2257 
	case 20: /* R `Dot' (small circle) */
2258 
	    xc = SMALL * size;
27236 murrell 2259 
	    gc->fill = gc->col;
2260 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2261 
	    break;
2262 
 
2263 
 
2264 
	case 21: /* circles */
2265 
	    xc = RADIUS * size;
27236 murrell 2266 
	    GECircle(x, y, xc, gc, dd);
16876 murrell 2267 
	    break;
2268 
 
2269 
	case  22: /* squares */
2270 
	    xc = toDeviceWidth(RADIUS * SQRC * GSTR_0, GE_INCHES, dd);
2271 
	    yc = toDeviceHeight(RADIUS * SQRC * GSTR_0, GE_INCHES, dd);
27236 murrell 2272 
	    GERect(x-xc, y-yc, x+xc, y+yc, gc, dd);
16876 murrell 2273 
	    break;
2274 
 
2275 
	case 23: /* diamonds */
2276 
	    xc = toDeviceWidth(RADIUS * DMDC * GSTR_0, GE_INCHES, dd);
2277 
	    yc = toDeviceHeight(RADIUS * DMDC * GSTR_0, GE_INCHES, dd);
2278 
	    xx[0] = x	  ; yy[0] = y-yc;
2279 
	    xx[1] = x+xc; yy[1] = y;
2280 
	    xx[2] = x	  ; yy[2] = y+yc;
2281 
	    xx[3] = x-xc; yy[3] = y;
27236 murrell 2282 
	    GEPolygon(4, xx, yy, gc, dd);
16876 murrell 2283 
	    break;
2284 
 
2285 
	case 24: /* triangle (point up) */
2286 
	    xc = RADIUS * GSTR_0;
2287 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2288 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
2289 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2290 
	    xx[0] = x; yy[0] = y+r;
2291 
	    xx[1] = x+xc; yy[1] = y-yc;
2292 
	    xx[2] = x-xc; yy[2] = y-yc;
27236 murrell 2293 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2294 
	    break;
2295 
 
2296 
	case 25: /* triangle (point down) */
2297 
	    xc = RADIUS * GSTR_0;
2298 
	    r = toDeviceHeight(TRC0 * xc, GE_INCHES, dd);
2299 
	    yc = toDeviceHeight(TRC2 * xc, GE_INCHES, dd);
2300 
	    xc = toDeviceWidth(TRC1 * xc, GE_INCHES, dd);
2301 
	    xx[0] = x; yy[0] = y-r;
2302 
	    xx[1] = x+xc; yy[1] = y+yc;
2303 
	    xx[2] = x-xc; yy[2] = y+yc;
27236 murrell 2304 
	    GEPolygon(3, xx, yy, gc, dd);
16876 murrell 2305 
	    break;
32762 ripley 2306 
	default:
32867 ripley 2307 
	    warning(_("unimplemented pch value '%d'"), pch);
16876 murrell 2308 
	}
2309 
    }
2310 
}
2311 
 
2312 
/****************************************************************
2313 
 * GEPretty
2314 
 ****************************************************************
2315 
 */
2316 
void GEPretty(double *lo, double *up, int *ndiv)
2317 
{
2318 
/*	Set scale and ticks for linear scales.
2319 
 *
2320 
 *	Pre:	    x1 == lo < up == x2      ;  ndiv >= 1
2321 
 *	Post: x1 <= y1 := lo < up =: y2 <= x2;	ndiv >= 1
2322 
 */
2323 
    double unit, ns, nu;
2324 
    double high_u_fact[2] = { .8, 1.7 };
2325 
#ifdef DEBUG_PLOT
2326 
    double x1,x2;
2327 
#endif
2328 
 
2329 
    if(*ndiv <= 0)
32867 ripley 2330 
	error(_("invalid axis extents [GEPretty(.,.,n=%d)"), *ndiv);
16876 murrell 2331 
    if(*lo == R_PosInf || *up == R_PosInf ||
2332 
       *lo == R_NegInf || *up == R_NegInf ||
2333 
       !R_FINITE(*up - *lo)) {
33297 ripley 2334 
	error(_("infinite axis extents [GEPretty(%g,%g,%d)]"), *lo, *up, *ndiv);
16876 murrell 2335 
	return;/*-Wall*/
2336 
    }
2337 
 
2338 
    ns = *lo; nu = *up;
2339 
#ifdef DEBUG_PLOT
2340 
    x1 = ns; x2 = nu;
2341 
#endif
61746 ripley 2342 
    unit = R_pretty(&ns, &nu, ndiv, /* min_n = */ 1,
2343 
		    /* shrink_sml = */ 0.25,
2344 
		    high_u_fact,
2345 
		    2, /* do eps_correction in any case */
2346 
 
16876 murrell 2347 
 
2348 
    /* The following is ugly since it kind of happens already in Rpretty0(..):
2349 
     */
2350 
#define rounding_eps 1e-7
2351 
    if(nu >= ns + 1) {
2352 
	if(               ns * unit < *lo - rounding_eps*unit)
2353 
	    ns++;
2354 
	if(nu > ns + 1 && nu * unit > *up + rounding_eps*unit)
2355 
	    nu--;
59177 ripley 2356 
	*ndiv = (int)(nu - ns);
16876 murrell 2357 
    }
2358 
    *lo = ns * unit;
2359 
    *up = nu * unit;
2360 
#ifdef non_working_ALTERNATIVE
2361 
    if(ns * unit > *lo)
2362 
	*lo = ns * unit;
2363 
    if(nu * unit < *up)
2364 
	*up = nu * unit;
2365 
    if(nu - ns >= 1)
2366 
	*ndiv = nu - ns;
2367 
#endif
2368 
 
2369 
#ifdef DEBUG_PLOT
2370 
    if(*lo < x1)
32867 ripley 2371 
	warning(_(" .. GEPretty(.): new *lo = %g < %g = x1"), *lo, x1);
16876 murrell 2372 
    if(*up > x2)
32867 ripley 2373 
	warning(_(" .. GEPretty(.): new *up = %g > %g = x2"), *up, x2);
16876 murrell 2374 
#endif
2375 
}
2376 
 
2377 
/****************************************************************
2378 
 * GEMetricInfo
2379 
 ****************************************************************
2380 
 */
32391 ripley 2381 
/*
44411 ripley 2382 
  If c is negative, -c is a Unicode point.
2383 
  In a MBCS locale, values > 127 are Unicode points (and so really are
2384 
  values 32 ... 126, 127 being unused).
2385 
  In a SBCS locale, values 32 ... 255 are the characters in the encoding.
32391 ripley 2386 
 */
44500 ripley 2387 
void GEMetricInfo(int c, const pGEcontext gc,
16876 murrell 2388 
		  double *ascent, double *descent, double *width,
44285 ripley 2389 
		  pGEDevDesc dd)
16876 murrell 2390 
{
32391 ripley 2391 
    /*
30129 murrell 2392 
     * If the fontfamily is a Hershey font family, call R_GE_VText
2393 
     */
2394 
    int vfontcode = VFontFamilyCode(gc->fontfamily);
2395 
    if (vfontcode >= 0) {
2396 
	/*
2397 
	 * It should be straightforward to figure this out, but
2398 
	 * just haven't got around to it yet
2399 
	 */
44411 ripley 2400 
	*ascent = 0.0;
2401 
	*descent = 0.0;
2402 
	*width = 0.0;
2403 
    } else {
2404 
	/* c = 'M' gets called very often, usually to see if there are
2405 
	   any char metrics available but also in plotmath.  So we
2406 
	   cache that value.  Depends on the context through cex, ps,
2407 
	   fontface, family, and also on the device.
47022 murrell 2408 
 
2409 
           PAUL 2008-11-27
2410 
           The point of checking dd == last_dd is to check for
2411 
           a different TYPE of device (e.g., PDF vs. PNG).
2412 
           Checking just the pGEDevDesc pointer is not a good enough
2413 
           test;  it is possible for that to be the same when one
2414 
           device is closed and a new one is opened (I have seen
2415 
           it happen!).
2416 
           So, ALSO compare dd->dev->close function pointer
2417 
           which really should be different for different devices.
44411 ripley 2418 
	*/
2419 
	static pGEDevDesc last_dd= NULL;
47022 murrell 2420 
#if R_USE_PROTOTYPES
2421 
        static void (*last_close)(pDevDesc dd);
2422 
#else
2423 
        static void (*last_close)();
2424 
#endif
44411 ripley 2425 
	static int last_face = 1;
45446 ripley 2426 
	static double last_cex = 0.0, last_ps = 0.0,
44411 ripley 2427 
	    a = 0.0 , d = 0.0, w = 0.0;
2428 
	static char last_family[201];
47022 murrell 2429 
	if (dd == last_dd && dd->dev->close == last_close && abs(c) == 77
45446 ripley 2430 
	    && gc->cex == last_cex && gc->ps == last_ps
2431 
	    && gc->fontface == last_face
44411 ripley 2432 
	    && streql(gc->fontfamily, last_family)) {
2433 
	    *ascent = a; *descent = d; *width = w; return;
2434 
	}
2435 
	dd->dev->metricInfo(c, gc, ascent, descent, width, dd->dev);
2436 
	if(abs(c) == 77) {
47022 murrell 2437 
	    last_dd = dd;  last_close = dd->dev->close;
2438 
            last_cex = gc->cex; last_ps = gc->ps;
44411 ripley 2439 
	    last_face = gc->fontface;
2440 
	    strcpy(last_family, gc->fontfamily);
2441 
	    a = *ascent; d = *descent; w = *width;
2442 
	}
2443 
    }
16876 murrell 2444 
}
2445 
 
2446 
/****************************************************************
2447 
 * GEStrWidth
2448 
 ****************************************************************
2449 
 */
44986 ripley 2450 
double GEStrWidth(const char *str, cetype_t enc, const pGEcontext gc, pGEDevDesc dd)
16876 murrell 2451 
{
32391 ripley 2452 
    /*
21062 murrell 2453 
     * If the fontfamily is a Hershey font family, call R_GE_VStrWidth
2454 
     */
27236 murrell 2455 
    int vfontcode = VFontFamilyCode(gc->fontfamily);
43924 ripley 2456 
    if (vfontcode >= 100)
43926 ripley 2457 
	return R_GE_VStrWidth(str, enc, gc, dd);
43924 ripley 2458 
    else if (vfontcode >= 0) {
59177 ripley 2459 
	gc->fontfamily[3] = (char) vfontcode;
31138 murrell 2460 
	gc->fontface = VFontFaceCode(vfontcode, gc->fontface);
43926 ripley 2461 
	return R_GE_VStrWidth(str, enc, gc, dd);
21062 murrell 2462 
    } else {
2463 
	double w;
2464 
	char *sbuf = NULL;
2465 
	w = 0;
2466 
	if(str && *str) {
41771 ripley 2467 
	    const char *s;
2468 
	    char *sb;
21062 murrell 2469 
	    double wdash;
44986 ripley 2470 
	    cetype_t enc2;
50875 ripley 2471 
	    const void *vmax = vmaxget();
43936 ripley 2472 
 
43965 ripley 2473 
	    enc2 = (gc->fontface == 5) ? CE_SYMBOL : enc;
44147 ripley 2474 
	    if(enc2 != CE_SYMBOL)
2475 
		enc2 = (dd->dev->hasTextUTF8 == TRUE) ? CE_UTF8 : CE_NATIVE;
44325 ripley 2476 
	    else if(dd->dev->wantSymbolUTF8 == TRUE) enc2 = CE_UTF8;
43965 ripley 2477 
 
43936 ripley 2478 
	    sb = sbuf = (char*) R_alloc(strlen(str) + 1, sizeof(char));
21062 murrell 2479 
	    for(s = str; ; s++) {
2480 
		if (*s == '\n' || *s == '\0') {
43936 ripley 2481 
		    const char *str;
21062 murrell 2482 
		    *sb = '\0';
50880 ripley 2483 
		    /* This may R_alloc, but let's assume that
2484 
		       there are not many lines of text per string */
43936 ripley 2485 
		    str = reEnc(sbuf, enc, enc2, 2);
43995 ripley 2486 
		    if(dd->dev->hasTextUTF8 == TRUE && enc2 == CE_UTF8)
43936 ripley 2487 
			wdash = dd->dev->strWidthUTF8(str, gc, dd->dev);
2488 
		    else
2489 
			wdash = dd->dev->strWidth(str, gc, dd->dev);
21062 murrell 2490 
		    if (wdash > w) w = wdash;
2491 
		    sb = sbuf;
2492 
		}
2493 
		else *sb++ = *s;
2494 
		if (!*s) break;
16876 murrell 2495 
	    }
50875 ripley 2496 
	    vmaxset(vmax);
16876 murrell 2497 
	}
21062 murrell 2498 
	return w;
16876 murrell 2499 
    }
2500 
}
2501 
 
2502 
/****************************************************************
2503 
 * GEStrHeight
2504 
 ****************************************************************
43926 ripley 2505 
 
2506 
 * This does not (currently) depend on the encoding.  It depends on
2507 
 * the string only through the number of lines of text (via embedded
2508 
 * \n) and we assume they are never part of an mbc.
16876 murrell 2509 
 */
44986 ripley 2510 
double GEStrHeight(const char *str, cetype_t enc, const pGEcontext gc, pGEDevDesc dd)
16876 murrell 2511 
{
32391 ripley 2512 
    /*
21062 murrell 2513 
     * If the fontfamily is a Hershey font family, call R_GE_VStrHeight
20177 murrell 2514 
     */
27236 murrell 2515 
    int vfontcode = VFontFamilyCode(gc->fontfamily);
43924 ripley 2516 
    if (vfontcode >= 100)
43926 ripley 2517 
	return R_GE_VStrHeight(str, enc, gc, dd);
43924 ripley 2518 
    else if (vfontcode >= 0) {
59177 ripley 2519 
	gc->fontfamily[3] = (char) vfontcode;
31138 murrell 2520 
	gc->fontface = VFontFaceCode(vfontcode, gc->fontface);
43926 ripley 2521 
	return R_GE_VStrHeight(str, enc, gc, dd);
21062 murrell 2522 
    } else {
2523 
	double h;
41771 ripley 2524 
	const char *s;
21062 murrell 2525 
	double asc, dsc, wid;
2526 
	int n;
2527 
	/* Count the lines of text minus one */
2528 
	n = 0;
2529 
	for(s = str; *s ; s++)
2530 
	    if (*s == '\n')
2531 
		n++;
32391 ripley 2532 
	/* cra is based on the font pointsize at the
21062 murrell 2533 
	 * time the device was created.
2534 
	 * Adjust for potentially different current pointsize
2535 
	 * This is a crude calculation that might be better
2536 
	 * performed using a device call that responds with
2537 
	 * the current font pointsize in device coordinates.
2538 
	 */
32391 ripley 2539 
	h = n * gc->lineheight * gc->cex * dd->dev->cra[1] *
27236 murrell 2540 
	    gc->ps/dd->dev->startps;
21062 murrell 2541 
	/* Add in the ascent of the font, if available */
27236 murrell 2542 
	GEMetricInfo('M', gc, &asc, &dsc, &wid, dd);
21062 murrell 2543 
	if ((asc == 0.0) && (dsc == 0.0) && (wid == 0.0))
32391 ripley 2544 
	    asc = gc->lineheight * gc->cex * dd->dev->cra[1] *
27236 murrell 2545 
		gc->ps/dd->dev->startps;
21062 murrell 2546 
	h += asc;
2547 
	return h;
2548 
    }
16876 murrell 2549 
}
2550 
 
2551 
/****************************************************************
57567 murrell 2552 
 * GEStrMetric
2553 
 ****************************************************************
2554 
 
2555 
 * This does not (currently) depend on the encoding.  It depends on
2556 
 * the string only through the number of lines of text (via embedded
2557 
 * \n) and we assume they are never part of an mbc.
2558 
 */
2559 
void GEStrMetric(const char *str, cetype_t enc, const pGEcontext gc,
2560 
                 double *ascent, double *descent, double *width,
2561 
                 pGEDevDesc dd)
2562 
{
2563 
    /*
2564 
     * If the fontfamily is a Hershey font family, call R_GE_VStrHeight
2565 
     */
2566 
    int vfontcode = VFontFamilyCode(gc->fontfamily);
2567 
    *ascent = 0.0;
2568 
    *descent = 0.0;
2569 
    *width = 0.0;
2570 
    if (vfontcode >= 0) {
2571 
	/*
2572 
	 * It should be straightforward to figure this out, but
2573 
	 * just haven't got around to it yet
2574 
	 */
2575 
    } else {
2576 
	double h;
2577 
	const char *s;
2578 
	double asc, dsc, wid;
2579 
	/* cra is based on the font pointsize at the
2580 
	 * time the device was created.
2581 
	 * Adjust for potentially different current pointsize
2582 
	 * This is a crude calculation that might be better
2583 
	 * performed using a device call that responds with
2584 
	 * the current font pointsize in device coordinates.
2585 
	 */
2586 
        double lineheight = gc->lineheight * gc->cex * dd->dev->cra[1] *
2587 
                            gc->ps/dd->dev->startps;
2588 
	int n;
2589 
	/* Count the lines of text minus one */
2590 
	n = 0;
2591 
	for(s = str; *s ; s++)
2592 
	    if (*s == '\n')
2593 
		n++;
2594 
        /* Where is the start of the last line? */
2595 
        if (n > 0) {
2596 
            while (*s != '\n')
2597 
                s--;
2598 
            s++;
2599 
        } else {
2600 
            s = str;
2601 
        }
2602 
	h = n * lineheight;
2603 
        /* Find the largest ascent and descent for the last line of text
2604 
         */
2605 
        while (*s) {
2606 
            GEMetricInfo(*s, gc, &asc, &dsc, &wid, dd);
2607 
            if (asc > *ascent)
2608 
                *ascent = asc;
2609 
            if (dsc > *descent)
2610 
                *descent = dsc;
2611 
            s++;
2612 
        }
2613 
        *ascent = *ascent + h;
2614 
        *width = GEStrWidth(str, enc, gc ,dd);
2615 
    }
2616 
}
2617 
 
2618 
/****************************************************************
16876 murrell 2619 
 * GENewPage
2620 
 ****************************************************************
2621 
 */
2622 
 
44500 ripley 2623 
void GENewPage(const pGEcontext gc, pGEDevDesc dd)
16876 murrell 2624 
{
27236 murrell 2625 
    dd->dev->newPage(gc, dd->dev);
16876 murrell 2626 
}
2627 
 
2628 
/****************************************************************
30832 murrell 2629 
 * GEdeviceDirty
2630 
 ****************************************************************
32391 ripley 2631 
 *
30832 murrell 2632 
 * Has the device received output from any graphics system?
2633 
 */
2634 
 
44285 ripley 2635 
Rboolean GEdeviceDirty(pGEDevDesc dd)
30832 murrell 2636 
{
2637 
    return dd->dirty;
2638 
}
2639 
 
2640 
/****************************************************************
2641 
 * GEdirtyDevice
2642 
 ****************************************************************
2643 
 *
2644 
 * Indicate that the device has received output from at least one
2645 
 * graphics system.
2646 
 */
2647 
 
44285 ripley 2648 
void GEdirtyDevice(pGEDevDesc dd)
30832 murrell 2649 
{
2650 
    dd->dirty = TRUE;
2651 
}
2652 
 
2653 
/****************************************************************
2654 
 * GEcheckState
2655 
 ****************************************************************
2656 
 *
32391 ripley 2657 
 * Check whether all registered graphics systems are in a
30832 murrell 2658 
 * "valid" state.
2659 
 */
2660 
 
44285 ripley 2661 
Rboolean GEcheckState(pGEDevDesc dd)
30832 murrell 2662 
{
2663 
    int i;
2664 
    Rboolean result = TRUE;
48163 murrell 2665 
    for (i=0; i < MAX_GRAPHICS_SYSTEMS; i++)
30832 murrell 2666 
	if (dd->gesd[i] != NULL)
32391 ripley 2667 
	    if (!LOGICAL((dd->gesd[i]->callback)(GE_CheckPlot, dd,
30832 murrell 2668 
						 R_NilValue))[0])
2669 
		result = FALSE;
2670 
    return result;
2671 
}
2672 
 
2673 
/****************************************************************
31938 murrell 2674 
 * GErecording
2675 
 ****************************************************************
2676 
 */
2677 
 
44285 ripley 2678 
Rboolean GErecording(SEXP call, pGEDevDesc dd)
31938 murrell 2679 
{
2680 
    return (call != R_NilValue && dd->recordGraphics);
2681 
}
2682 
 
2683 
/****************************************************************
30832 murrell 2684 
 * GErecordGraphicOperation
2685 
 ****************************************************************
2686 
 */
2687 
 
44285 ripley 2688 
void GErecordGraphicOperation(SEXP op, SEXP args, pGEDevDesc dd)
30832 murrell 2689 
{
44352 ripley 2690 
    SEXP lastOperation = dd->DLlastElt;
2691 
    if (dd->displayListOn) {
31938 murrell 2692 
	SEXP newOperation = list2(op, args);
31643 murrell 2693 
	if (lastOperation == R_NilValue) {
44352 ripley 2694 
	    dd->displayList = CONS(newOperation, R_NilValue);
2695 
	    dd->DLlastElt = dd->displayList;
31643 murrell 2696 
	} else {
30832 murrell 2697 
	    SETCDR(lastOperation, CONS(newOperation, R_NilValue));
44352 ripley 2698 
	    dd->DLlastElt = CDR(lastOperation);
31643 murrell 2699 
	}
30832 murrell 2700 
    }
2701 
}
2702 
 
2703 
/****************************************************************
17113 murrell 2704 
 * GEinitDisplayList
2705 
 ****************************************************************
2706 
 */
2707 
 
44285 ripley 2708 
void GEinitDisplayList(pGEDevDesc dd)
17113 murrell 2709 
{
2710 
    int i;
44367 ripley 2711 
    /* Save the current displayList so that, for example, a device
18917 murrell 2712 
     * can maintain a plot history
2713 
     */
44352 ripley 2714 
    dd->savedSnapshot = GEcreateSnapshot(dd);
32391 ripley 2715 
    /* Get each graphics system to save state required for
17113 murrell 2716 
     * replaying the display list
2717 
     */
48163 murrell 2718 
    for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++)
17113 murrell 2719 
	if (dd->gesd[i] != NULL)
2720 
	    (dd->gesd[i]->callback)(GE_SaveState, dd, R_NilValue);
44352 ripley 2721 
    dd->displayList = dd->DLlastElt = R_NilValue;
17113 murrell 2722 
}
2723 
 
2724 
/****************************************************************
16876 murrell 2725 
 * GEplayDisplayList
2726 
 ****************************************************************
2727 
 */
2728 
 
61592 ripley 2729 
/* from colors.c */
2730 
void savePalette(Rboolean save);
2731 
 
44285 ripley 2732 
void GEplayDisplayList(pGEDevDesc dd)
16876 murrell 2733 
{
44367 ripley 2734 
    int i, this, savedDevice, plotok;
16876 murrell 2735 
    SEXP theList;
44367 ripley 2736 
 
2737 
    /* If the device is not registered with the engine (which might
2738 
       happen in a device callback before it has been registered or
45446 ripley 2739 
       while it is being killed) we might get the null device and
44367 ripley 2740 
       should do nothing.
2741 
 
2742 
       Also do nothing if displayList is empty (which should be the
2743 
       case for the null device).
2744 
    */
2745 
    this = GEdeviceNumber(dd);
2746 
    if (this == 0) return;
2747 
    theList = dd->displayList;
2748 
    if (theList == R_NilValue) return;
45446 ripley 2749 
 
32391 ripley 2750 
    /* Get each graphics system to restore state required for
17113 murrell 2751 
     * replaying the display list
2752 
     */
48163 murrell 2753 
    for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++)
17113 murrell 2754 
	if (dd->gesd[i] != NULL)
2755 
	    (dd->gesd[i]->callback)(GE_RestoreState, dd, R_NilValue);
2756 
    /* Play the display list
2757 
     */
44367 ripley 2758 
    PROTECT(theList);
17306 murrell 2759 
    plotok = 1;
16876 murrell 2760 
    if (theList != R_NilValue) {
61592 ripley 2761 
	savePalette(TRUE);
16876 murrell 2762 
	savedDevice = curDevice();
44367 ripley 2763 
	selectDevice(this);
17306 murrell 2764 
	while (theList != R_NilValue && plotok) {
16876 murrell 2765 
	    SEXP theOperation = CAR(theList);
2766 
	    SEXP op = CAR(theOperation);
31938 murrell 2767 
	    SEXP args = CADR(theOperation);
62563 murdoch 2768 
	    if (TYPEOF(op) == BUILTINSXP || TYPEOF(op) == SPECIALSXP) {
2769 
	    	PRIMFUN(op) (R_NilValue, op, args, R_NilValue);
2770 
		/* Check with each graphics system that the plotting went ok
2771 
		 */
2772 
		if (!GEcheckState(dd)) {
2773 
		    warning(_("display list redraw incomplete"));
2774 
		    plotok = 0;
2775 
		}
2776 
	    } else {
2777 
	    	warning(_("invalid display list"));
2778 
	    	plotok = 0;
30832 murrell 2779 
	    }
16876 murrell 2780 
	    theList = CDR(theList);
2781 
	}
2782 
	selectDevice(savedDevice);
61592 ripley 2783 
	savePalette(FALSE);
16876 murrell 2784 
    }
39468 murrell 2785 
    UNPROTECT(1);
16946 maechler 2786 
}
16876 murrell 2787 
 
2788 
 
16965 murrell 2789 
/****************************************************************
2790 
 * GEcopyDisplayList
2791 
 ****************************************************************
2792 
 */
2793 
 
17019 murrell 2794 
/* We assume that the device being copied TO is the "current" device
16965 murrell 2795 
 */
2796 
void GEcopyDisplayList(int fromDevice)
2797 
{
30832 murrell 2798 
    SEXP tmp;
44412 ripley 2799 
    pGEDevDesc dd = GEcurrentDevice(), gd = GEgetDevice(fromDevice);
16965 murrell 2800 
    int i;
45446 ripley 2801 
 
44352 ripley 2802 
    tmp = gd->displayList;
2803 
    if(!isNull(tmp)) tmp = duplicate(tmp);
2804 
    dd->displayList = tmp;
2805 
    dd->DLlastElt = lastElt(dd->displayList);
17019 murrell 2806 
    /* Get each registered graphics system to copy system state
2807 
     * information from the "from" device to the current device
2808 
     */
48163 murrell 2809 
    for (i=0; i < MAX_GRAPHICS_SYSTEMS; i++)
16965 murrell 2810 
	if (dd->gesd[i] != NULL)
44285 ripley 2811 
	    (dd->gesd[i]->callback)(GE_CopyState, gd, R_NilValue);
16965 murrell 2812 
    GEplayDisplayList(dd);
44352 ripley 2813 
    if (!dd->displayListOn) GEinitDisplayList(dd);
16965 murrell 2814 
}
2815 
 
17022 murrell 2816 
/****************************************************************
2817 
 * GEcreateSnapshot
2818 
 ****************************************************************
2819 
 */
2820 
 
2821 
/* Create a recording of the current display,
32391 ripley 2822 
 * including enough information from each registered
17022 murrell 2823 
 * graphics system to be able to recreate the display
2824 
 * The structure created is an SEXP which nicely hides the
2825 
 * internals, because noone should be looking in there anyway
2826 
 * The product of this call can be stored, but should only
2827 
 * be used in a call to GEplaySnapshot.
2828 
 */
2829 
 
44285 ripley 2830 
SEXP GEcreateSnapshot(pGEDevDesc dd)
17022 murrell 2831 
{
2832 
    int i;
29450 ripley 2833 
    SEXP snapshot, tmp;
17022 murrell 2834 
    SEXP state;
32391 ripley 2835 
    /* Create a list with one spot for the display list
17022 murrell 2836 
     * and one spot each for the registered graphics systems
2837 
     * to put their graphics state
2838 
     */
2839 
    PROTECT(snapshot = allocVector(VECSXP, 1 + numGraphicsSystems));
2840 
    /* The first element of the snapshot is the display list.
2841 
     */
44352 ripley 2842 
    if(!isNull(dd->displayList)) {
45446 ripley 2843 
	PROTECT(tmp = duplicate(dd->displayList));
2844 
	SET_VECTOR_ELT(snapshot, 0, tmp);
2845 
	UNPROTECT(1);
39468 murrell 2846 
    }
17022 murrell 2847 
    /* For each registered system, obtain state information,
2848 
     * and store that in the snapshot.
2849 
     */
48163 murrell 2850 
    for (i = 0; i < MAX_GRAPHICS_SYSTEMS; i++)
17022 murrell 2851 
	if (dd->gesd[i] != NULL) {
2852 
	    PROTECT(state = (dd->gesd[i]->callback)(GE_SaveSnapshotState, dd,
2853 
						    R_NilValue));
2854 
	    SET_VECTOR_ELT(snapshot, i + 1, state);
2855 
	    UNPROTECT(1);
2856 
	}
2857 
    UNPROTECT(1);
2858 
    return snapshot;
2859 
}
2860 
 
2861 
/****************************************************************
2862 
 * GEplaySnapshot
2863 
 ****************************************************************
2864 
 */
2865 
 
2866 
/* Recreate a saved display using the information in a structure
2867 
 * created by GEcreateSnapshot.
30649 murrell 2868 
 *
2869 
 * The graphics engine assumes that it is getting a snapshot
2870 
 * that was created in THE CURRENT R SESSION
32391 ripley 2871 
 * (Thus, it can assume that registered graphics systems are
2872 
 *  in the same order as they were when the snapshot was
30649 murrell 2873 
 *  created -- in patricular, state information will be sent
44347 ripley 2874 
 *  to the appropriate graphics system.)
2875 
 * [With only two systems and base registered on each device at
2876 
 * creation, that has to be true: and grid does not save any state.]
30649 murrell 2877 
 *
44347 ripley 2878 
 *  It also assumes that the system that created the snapshot is
2879 
 *  still loaded (e.g. the grid namespace has not been unloaded).
2880 
 *
32391 ripley 2881 
 * It is possible to save a snapshot to an R variable
30649 murrell 2882 
 * (and therefore save and reload it between sessions and
2883 
 *  even possibly into a different R version),
32391 ripley 2884 
 * BUT this is strongly discouraged
30649 murrell 2885 
 * (in the documentation for recordPlot() and replayPlot()
2886 
 *  and in the documentation for the Rgui interface on Windows)
17022 murrell 2887 
 */
2888 
 
44285 ripley 2889 
void GEplaySnapshot(SEXP snapshot, pGEDevDesc dd)
17022 murrell 2890 
{
2891 
    /* Only have to set up information for as many graphics systems
2892 
     * as were registered when the snapshot was taken.
2893 
     */
2894 
    int i, numSystems = LENGTH(snapshot) - 1;
32391 ripley 2895 
    /* Reset the snapshot state information in each registered
17022 murrell 2896 
     * graphics system
2897 
     */
44347 ripley 2898 
    for (i = 0; i < numSystems; i++)
17022 murrell 2899 
	if (dd->gesd[i] != NULL)
32391 ripley 2900 
	    (dd->gesd[i]->callback)(GE_RestoreSnapshotState, dd,
17022 murrell 2901 
				    VECTOR_ELT(snapshot, i + 1));
2902 
    /* Replay the display list
2903 
     */
44352 ripley 2904 
    dd->displayList = duplicate(VECTOR_ELT(snapshot, 0));
2905 
    dd->DLlastElt = lastElt(dd->displayList);
17022 murrell 2906 
    GEplayDisplayList(dd);
44352 ripley 2907 
    if (!dd->displayListOn) GEinitDisplayList(dd);
17022 murrell 2908 
}
2909 
 
44343 ripley 2910 
/* recordPlot() */
60710 ripley 2911 
SEXP do_getSnapshot(SEXP call, SEXP op, SEXP args, SEXP env)
44343 ripley 2912 
{
2913 
    checkArity(op, args);
2914 
    return GEcreateSnapshot(GEcurrentDevice());
2915 
}
2916 
 
2917 
/* replayPlot() */
60710 ripley 2918 
SEXP do_playSnapshot(SEXP call, SEXP op, SEXP args, SEXP env)
44343 ripley 2919 
{
2920 
    checkArity(op, args);
2921 
    GEplaySnapshot(CAR(args), GEcurrentDevice());
2922 
    return R_NilValue;
2923 
}
2924 
 
31938 murrell 2925 
/****************************************************************
2926 
 * do_recordGraphics
32391 ripley 2927 
 *
40090 ripley 2928 
 * A ".Internal" R function
32391 ripley 2929 
 *
31938 murrell 2930 
 ****************************************************************
2931 
 */
2932 
 
36990 ripley 2933 
SEXP attribute_hidden do_recordGraphics(SEXP call, SEXP op, SEXP args, SEXP env)
31938 murrell 2934 
{
2935 
    SEXP x, xptr, evalenv, retval;
44285 ripley 2936 
    pGEDevDesc dd = GEcurrentDevice();
31938 murrell 2937 
    Rboolean record = dd->recordGraphics;
2938 
    /*
2939 
     * This function can be run under three conditions:
32391 ripley 2940 
     *
31938 murrell 2941 
     *   (i) a top-level call to do_recordGraphics.
32391 ripley 2942 
     *       In this case, call != R_NilValue and
2943 
     *       dd->recordGraphics = TRUE
31938 murrell 2944 
     *       [so GErecording() returns TRUE]
2945 
     *
2946 
     *   (ii) a nested call to do_recordGraphics.
2947 
     *        In this case, call != R_NilValue but
32391 ripley 2948 
     *        dd->recordGraphics = FALSE
31938 murrell 2949 
     *        [so GErecording() returns FALSE]
2950 
     *
2951 
     *   (iii) a replay of the display list
2952 
     *         In this case, call == R_NilValue and
32391 ripley 2953 
     *         dd->recordGraphics = FALSE
31938 murrell 2954 
     *         [so GErecording() returns FALSE]
2955 
     */
2956 
    /*
2957 
     * First arg is an expression, second arg is a list, third arg is an env
2958 
     */
2959 
    SEXP code = CAR(args);
2960 
    SEXP list = CADR(args);
2961 
    SEXP parentenv = CADDR(args);
2962 
    if (!isLanguage(code))
41686 ripley 2963 
	error(_("'expr' argument must be an expression"));
31938 murrell 2964 
    if (TYPEOF(list) != VECSXP)
41686 ripley 2965 
	error(_("'list' argument must be a list"));
36174 murdoch 2966 
    if (isNull(parentenv)) {
37725 ripley 2967 
	error(_("use of NULL environment is defunct"));
36174 murdoch 2968 
	parentenv = R_BaseEnv;
43965 ripley 2969 
    } else
31938 murrell 2970 
    if (!isEnvironment(parentenv))
41686 ripley 2971 
	error(_("'env' argument must be an environment"));
31938 murrell 2972 
    /*
2973 
     * This conversion of list to env taken from do_eval
2974 
     */
2975 
    PROTECT(x = VectorToPairList(list));
2976 
    for (xptr = x ; xptr != R_NilValue ; xptr = CDR(xptr))
2977 
	SET_NAMED(CAR(xptr) , 2);
2978 
    /*
2979 
     * The environment passed in as the third arg is used as
2980 
     * the parent of the new evaluation environment.
2981 
     */
2982 
    PROTECT(evalenv = NewEnvironment(R_NilValue, x, parentenv));
2983 
    dd->recordGraphics = FALSE;
2984 
    PROTECT(retval = eval(code, evalenv));
2985 
    /*
2986 
     * If there is an error or user-interrupt in the above
32391 ripley 2987 
     * evaluation, dd->recordGraphics is set to TRUE
31938 murrell 2988 
     * on all graphics devices (see GEonExit(); called in errors.c)
2989 
     */
2990 
    dd->recordGraphics = record;
2991 
    if (GErecording(call, dd)) {
2992 
	if (!GEcheckState(dd))
33297 ripley 2993 
	    error(_("invalid graphics state"));
31938 murrell 2994 
	GErecordGraphicOperation(op, args, dd);
2995 
    }
2996 
    UNPROTECT(3);
2997 
    return retval;
2998 
}
2999 
 
3000 
/****************************************************************
3001 
 * GEonExit
3002 
 *
3003 
 * Reset some important graphics state on an error/interrupt
3004 
 ****************************************************************
3005 
 */
3006 
 
32391 ripley 3007 
void GEonExit()
31938 murrell 3008 
{
3009 
  /*
3010 
   * Run through all devices and turn graphics recording back on
3011 
   * in case an error occurred in the middle of a do_recordGraphics
3012 
   * call.
3013 
   * Awkward cos device code still in graphics.c
3014 
   * Can be cleaned up when device code moved here.
3015 
   */
3016 
    int i, devNum;
44285 ripley 3017 
    pGEDevDesc gd;
44299 ripley 3018 
    pDevDesc dd;
31938 murrell 3019 
    i = 1;
3020 
    if (!NoDevices()) {
3021 
	devNum = curDevice();
3022 
	while (i++ < NumDevices()) {
45446 ripley 3023 
	    gd = GEgetDevice(devNum);
3024 
	    gd->recordGraphics = TRUE;
3025 
	    dd = gd->dev;
3026 
	    if (dd->onExit) dd->onExit(dd);
31938 murrell 3027 
	    devNum = nextDevice(devNum);
3028 
	}
3029 
    }
3030 
}
44142 ripley 3031 
 
3032 
/* This is also used in grid. It may be used millions of times on the
3033 
 * same character */
3034 
/* FIXME: should we warn on more than one character here? */
3035 
int GEstring_to_pch(SEXP pch)
3036 
{
3037 
    int ipch = NA_INTEGER;
3038 
    static SEXP last_pch = NULL;
3039 
    static int last_ipch = 0;
3040 
 
3041 
    if (pch == NA_STRING) return NA_INTEGER;
3042 
    if (CHAR(pch)[0] == 0) return NA_INTEGER;  /* pch = "" */
3043 
    if (pch == last_pch) return last_ipch;/* take advantage of CHARSXP cache */
3044 
    ipch = (unsigned char) CHAR(pch)[0];
3045 
    if (IS_LATIN1(pch)) {
3046 
	if (ipch > 127) ipch = -ipch;  /* record as Unicode */
3047 
    } else if (IS_UTF8(pch) || utf8locale) {
3048 
	wchar_t wc = 0;
3049 
	if (ipch > 127) {
3050 
	    if ( (int) utf8toucs(&wc, CHAR(pch)) > 0) ipch = -wc;
3051 
	    else error(_("invalid multibyte char in pch=\"c\""));
3052 
	}
3053 
    } else if(mbcslocale) {
3054 
	/* Could we safely assume that 7-bit first byte means ASCII?
3055 
	   On Windows this only covers CJK locales, so we could.
45446 ripley 3056 
	 */
44142 ripley 3057 
	unsigned int ucs = 0;
3058 
	if ( (int) mbtoucs(&ucs, CHAR(pch), MB_CUR_MAX) > 0) ipch = ucs;
3059 
	else error(_("invalid multibyte char in pch=\"c\""));
3060 
	if (ipch > 127) ipch = -ipch;
3061 
    }
3062 
 
3063 
    last_ipch = ipch; last_pch = pch;
3064 
    return ipch;
3065 
}
3066 
 
3067 
/* moved from graphics.c as used by grid */
3068 
/*  LINE TEXTURE CODE */
3069 
 
3070 
/*
3071 
 *  LINE TEXTURE SPECIFICATION
3072 
 *
3073 
 *  Linetypes are stored internally in integers.  An integer
3074 
 *  is interpreted as containing a sequence of 8 4-bit integers
3075 
 *  which give the lengths of up to 8 on-off line segments.
3076 
 *  The lengths are typically interpreted as pixels on a screen
3077 
 *  and as "points" in postscript.
3078 
 *
3079 
 *  more comments (and LTY_* def.s) in	../include/Rgraphics.h
3080 
 *					----------------------
3081 
 */
3082 
 
3083 
typedef struct {
3084 
    char *name;
3085 
    int pattern;
3086 
} LineTYPE;
3087 
 
3088 
static LineTYPE linetype[] = {
3089 
    { "blank",   LTY_BLANK   },/* -1 */
3090 
    { "solid",	 LTY_SOLID   },/* 1 */
3091 
    { "dashed",	 LTY_DASHED  },/* 2 */
3092 
    { "dotted",	 LTY_DOTTED  },/* 3 */
3093 
    { "dotdash", LTY_DOTDASH },/* 4 */
3094 
    { "longdash",LTY_LONGDASH},/* 5 */
3095 
    { "twodash", LTY_TWODASH },/* 6 */
3096 
    { NULL,	 0	     },
3097 
};
3098 
 
3099 
/* Duplicated from graphics.c */
3100 
static char HexDigits[] = "0123456789ABCDEF";
3101 
static unsigned int hexdigit(int digit)
3102 
{
3103 
    if('0' <= digit && digit <= '9') return digit - '0';
3104 
    if('A' <= digit && digit <= 'F') return 10 + digit - 'A';
3105 
    if('a' <= digit && digit <= 'f') return 10 + digit - 'a';
3106 
    /*else */ error(_("invalid hex digit in 'color' or 'lty'"));
3107 
    return digit; /* never occurs (-Wall) */
3108 
}
3109 
 
3110 
static int nlinetype = (sizeof(linetype)/sizeof(LineTYPE)-2);
3111 
 
3112 
unsigned int GE_LTYpar(SEXP value, int ind)
3113 
{
3114 
    const char *p;
59173 ripley 3115 
    int i, code, shift, digit;
44142 ripley 3116 
    double rcode;
3117 
 
3118 
    if(isString(value)) {
3119 
	for(i = 0; linetype[i].name; i++) { /* is it the i-th name ? */
3120 
	    if(!strcmp(CHAR(STRING_ELT(value, ind)), linetype[i].name))
3121 
		return linetype[i].pattern;
3122 
	}
3123 
	/* otherwise, a string of hex digits: */
3124 
	code = 0;
3125 
	shift = 0;
3126 
	p = CHAR(STRING_ELT(value, ind));
59173 ripley 3127 
	size_t len = strlen(p);
44142 ripley 3128 
	if(len < 2 || len > 8 || len % 2 == 1)
3129 
	    error(_("invalid line type: must be length 2, 4, 6 or 8"));
3130 
	for(; *p; p++) {
3131 
	    digit = hexdigit(*p);
3132 
	    if(digit == 0)
3133 
		error(_("invalid line type: zeroes are not allowed"));
3134 
	    code  |= (digit<<shift);
3135 
	    shift += 4;
3136 
	}
3137 
	return code;
3138 
    }
3139 
    else if(isInteger(value)) {
3140 
	code = INTEGER(value)[ind];
3141 
	if(code == NA_INTEGER || code < 0)
3142 
	    error(_("invalid line type"));
3143 
	if (code > 0)
3144 
	    code = (code-1) % nlinetype + 1;
3145 
	return linetype[code].pattern;
3146 
    }
3147 
    else if(isReal(value)) {
3148 
	rcode = REAL(value)[ind];
3149 
	if(!R_FINITE(rcode) || rcode < 0)
3150 
	    error(_("invalid line type"));
59177 ripley 3151 
	code = (int) rcode;
44142 ripley 3152 
	if (code > 0)
3153 
	    code = (code-1) % nlinetype + 1;
3154 
	return linetype[code].pattern;
3155 
    }
3156 
    else {
3157 
	error(_("invalid line type")); /*NOTREACHED, for -Wall : */ return 0;
3158 
    }
3159 
}
3160 
 
3161 
SEXP GE_LTYget(unsigned int lty)
3162 
{
3163 
    int i, ndash;
3164 
    unsigned char dash[8];
3165 
    unsigned int l;
3166 
    char cbuf[17]; /* 8 hex digits plus nul */
3167 
 
3168 
    for (i = 0; linetype[i].name; i++)
3169 
	if(linetype[i].pattern == lty) return mkString(linetype[i].name);
3170 
 
3171 
    l = lty; ndash = 0;
3172 
    for (i = 0; i < 8 && l & 15; i++) {
3173 
	dash[ndash++] = l & 15;
3174 
	l = l >> 4;
3175 
    }
3176 
    for(i = 0 ; i < ndash ; i++) cbuf[i] = HexDigits[dash[i]];
3177 
    return mkString(cbuf);
3178 
}
50488 murrell 3179 
 
3180 
/****************************************************************
3181 
 *
3182 
 * Some functions for operations on raster images
3183 
 * (for those devices that cannot do these themselves)
3184 
 ****************************************************************
3185 
 */
3186 
 
50554 murrell 3187 
/* Some of this code is based on code from the leptonica library
3188 
 * hence the following notice
3189 
 */
3190 
 
3191 
/*====================================================================*
3192 
-  Copyright (C) 2001 Leptonica.  All rights reserved.
3193 
-  This software is distributed in the hope that it will be
3194 
-  useful, but with NO WARRANTY OF ANY KIND.
3195 
-  No author or distributor accepts responsibility to anyone for the
3196 
-  consequences of using this software, or for whether it serves any
3197 
-  particular purpose or works at all, unless he or she says so in
3198 
-  writing.  Everyone is granted permission to copy, modify and
3199 
-  redistribute this source code, for commercial or non-commercial
3200 
-  purposes, with the following restrictions: (1) the origin of this
3201 
-  source code must not be misrepresented; (2) modified versions must
3202 
-  be plainly marked as such; and (3) this notice may not be removed
3203 
-  or altered from any source or modified source distribution.
3204 
*====================================================================*/
3205 
 
50488 murrell 3206 
/*
3207 
 * Scale a raster image to a desired size using
50554 murrell 3208 
 * nearest-neighbour interpolation
3209 
 
3210 
 * draster must be pre-allocated.
3211 
 */
3212 
void R_GE_rasterScale(unsigned int *sraster, int sw, int sh,
3213 
                      unsigned int *draster, int dw, int dh) {
3214 
    int i, j;
3215 
    int sx, sy;
3216 
    unsigned int pixel;
3217 
 
3218 
    /* Iterate over the destination pixels */
3219 
    for (i = 0; i < dh; i++) {
3220 
        for (j = 0; j < dw; j++) {
3221 
            sy = i * sh / dh;
3222 
            sx = j * sw / dw;
3223 
            if ((sx >= 0) && (sx < sw) && (sy >= 0) && sy < sh) {
3224 
                pixel = sraster[sy * sw + sx];
3225 
            } else {
3226 
                pixel = 0;
3227 
            }
3228 
            draster[i * dw + j] = pixel;
3229 
        }
3230 
    }
3231 
}
3232 
 
3233 
/*
3234 
 * Scale a raster image to a desired size using
50488 murrell 3235 
 * bilinear interpolation
3236 
 * Code based on scaleColorLILow() from leptonica library
3237 
 
3238 
 *  Divide each destination pixel into 16 x 16 sub-pixels.
3239 
 *  Linear interpolation is equivalent to finding the
3240 
 *  fractional area (i.e., number of sub-pixels divided
3241 
 *  by 256) associated with each of the four nearest src pixels,
3242 
 *  and weighting each pixel value by this fractional area.
3243 
 
3244 
 * draster must be pre-allocated.
3245 
 */
3246 
void R_GE_rasterInterpolate(unsigned int *sraster, int sw, int sh,
3247 
                            unsigned int *draster, int dw, int dh) {
3248 
    int i, j;
3249 
    double scx, scy;
3250 
    int wm2, hm2;
3251 
    int xpm, ypm;  /* location in src image, to 1/16 of a pixel */
3252 
    int xp, yp, xf, yf;  /* src pixel and pixel fraction coordinates */
3253 
    int v00r, v01r, v10r, v11r, v00g, v01g, v10g, v11g;
3254 
    int v00b, v01b, v10b, v11b, v00a, v01a, v10a, v11a;
3255 
    int area00, area01, area10, area11;
3256 
    unsigned int pixels1, pixels2, pixels3, pixels4, pixel;
3257 
    unsigned int *sline, *dline;
3258 
 
3259 
    /* (scx, scy) are scaling factors that are applied to the
3260 
     * dest coords to get the corresponding src coords.
3261 
     * We need them because we iterate over dest pixels
3262 
     * and must find the corresponding set of src pixels. */
3263 
    scx = (16. * sw) / dw;
3264 
    scy = (16. * sh) / dh;
3265 
 
3266 
    wm2 = sw - 2;
3267 
    hm2 = sh - 2;
3268 
 
3269 
    /* Iterate over the destination pixels */
3270 
    for (i = 0; i < dh; i++) {
50812 murrell 3271 
        ypm = (int) fmax2(scy * i - 8, 0);
50488 murrell 3272 
        yp = ypm >> 4;
3273 
        yf = ypm & 0x0f;
3274 
        dline = draster + i * dw;
3275 
        sline = sraster + yp * sw;
3276 
        for (j = 0; j < dw; j++) {
50812 murrell 3277 
            xpm = (int) fmax2(scx * j - 8, 0);
50488 murrell 3278 
            xp = xpm >> 4;
3279 
            xf = xpm & 0x0f;
3280 
 
3281 
            pixels1 = *(sline + xp);
3282 
 
3283 
            if (xp > wm2 || yp > hm2) {
3284 
                if (yp > hm2 && xp <= wm2) {  /* pixels near bottom */
3285 
                    pixels2 = *(sline + xp + 1);
3286 
                    pixels3 = pixels1;
3287 
                    pixels4 = pixels2;
3288 
                }
3289 
                else if (xp > wm2 && yp <= hm2) {  /* pixels near right side */
3290 
                    pixels2 = pixels1;
3291 
                    pixels3 = *(sline + sw + xp);
3292 
                    pixels4 = pixels3;
3293 
                }
3294 
                else {  /* pixels at LR corner */
3295 
                    pixels4 = pixels3 = pixels2 = pixels1;
3296 
                }
3297 
            }
3298 
            else {
3299 
                pixels2 = *(sline + xp + 1);
3300 
                pixels3 = *(sline + sw + xp);
3301 
                pixels4 = *(sline + sw + xp + 1);
3302 
            }
3303 
 
3304 
            area00 = (16 - xf) * (16 - yf);
3305 
            area10 = xf * (16 - yf);
3306 
            area01 = (16 - xf) * yf;
3307 
            area11 = xf * yf;
3308 
            v00r = area00 * R_RED(pixels1);
3309 
            v00g = area00 * R_GREEN(pixels1);
3310 
            v00b = area00 * R_BLUE(pixels1);
3311 
            v00a = area00 * R_ALPHA(pixels1);
3312 
            v10r = area10 * R_RED(pixels2);
3313 
            v10g = area10 * R_GREEN(pixels2);
3314 
            v10b = area10 * R_BLUE(pixels2);
3315 
            v10a = area10 * R_ALPHA(pixels2);
3316 
            v01r = area01 * R_RED(pixels3);
3317 
            v01g = area01 * R_GREEN(pixels3);
3318 
            v01b = area01 * R_BLUE(pixels3);
3319 
            v01a = area01 * R_ALPHA(pixels3);
3320 
            v11r = area11 * R_RED(pixels4);
3321 
            v11g = area11 * R_GREEN(pixels4);
3322 
            v11b = area11 * R_BLUE(pixels4);
3323 
            v11a = area11 * R_ALPHA(pixels4);
3324 
            pixel = (((v00r + v10r + v01r + v11r + 128) >>  8) & 0x000000ff) |
3325 
                    (((v00g + v10g + v01g + v11g + 128)      ) & 0x0000ff00) |
3326 
                    (((v00b + v10b + v01b + v11b + 128) <<  8) & 0x00ff0000) |
3327 
                    (((v00a + v10a + v01a + v11a + 128) << 16) & 0xff000000);
3328 
            *(dline + j) = pixel;
3329 
        }
3330 
    }
50554 murrell 3331 
}
50488 murrell 3332 
 
50554 murrell 3333 
/*
3334 
 * Calculate the size needed for rotated image
3335 
 *
3336 
 * Rotate top-right and bottom-right corners
3337 
 * New width/height based on max of rotated corners
3338 
 */
3339 
void R_GE_rasterRotatedSize(int w, int h, double angle,
3340 
                            int *wnew, int *hnew) {
3341 
    double diag = sqrt(w*w + h*h);
3342 
    double theta = atan2((double) h, (double) w);
3343 
    double trx1 = diag*cos(theta + angle);
3344 
    double trx2 = diag*cos(theta - angle);
3345 
    double try1 = diag*sin(theta + angle);
3346 
    double try2 = diag*sin(angle - theta);
3347 
    *wnew = (int) (fmax2(fabs(trx1), fabs(trx2)) + 0.5);
3348 
    *hnew = (int) (fmax2(fabs(try1), fabs(try2)) + 0.5);
58450 murrell 3349 
    /*
3350 
     * Rotated image may be shorter or thinner than original
3351 
     */
3352 
    *wnew = imax2(w, *wnew);
3353 
    *hnew = imax2(h, *hnew);
50488 murrell 3354 
}
50554 murrell 3355 
 
3356 
/*
3357 
 * Calculate offset for (left, bottom) or
3358 
 * (left, top) of image
3359 
 * to account for image rotation
3360 
 */
3361 
void R_GE_rasterRotatedOffset(int w, int h, double angle,
3362 
                              int botleft,
3363 
                              double *xoff, double *yoff) {
3364 
    double hypot = .5*sqrt(w*w + h*h);
3365 
    double theta, dw, dh;
3366 
    if (botleft) {
3367 
        theta = M_PI + atan2(h, w);
3368 
        dw = hypot*cos(theta + angle);
3369 
        dh = hypot*sin(theta + angle);
3370 
        *xoff = dw + w/2;
3371 
        *yoff = dh + h/2;
3372 
    } else {
3373 
        theta = -M_PI - atan2(h, w);
3374 
        dw = hypot*cos(theta + angle);
3375 
        dh = hypot*sin(theta + angle);
3376 
        *xoff = dw + w/2;
3377 
        *yoff = dh - h/2;
3378 
    }
3379 
}
3380 
 
3381 
/*
3382 
 * Copy a raster image into the middle of a larger
3383 
 * raster image (ready for rotation)
3384 
 
3385 
 * newRaster must be pre-allocated.
3386 
 */
3387 
void R_GE_rasterResizeForRotation(unsigned int *sraster,
3388 
                                  int w, int h,
3389 
                                  unsigned int *newRaster,
3390 
                                  int wnew, int hnew,
3391 
                                  const pGEcontext gc)
3392 
{
3393 
    int i, j, inew, jnew;
3394 
    int xoff = (wnew - w)/2;
3395 
    int yoff = (hnew - h)/2;
50608 murrell 3396 
 
50554 murrell 3397 
    for (i=0; i<hnew; i++) {
3398 
        for (j=0; j<wnew; j++) {
3399 
            newRaster[i*wnew + j] = gc->fill;
3400 
        }
3401 
    }
3402 
    for (i=0; i<h; i++) {
3403 
        for (j=0; j<w; j++) {
3404 
            inew = i+yoff;
3405 
            jnew = j+xoff;
3406 
            newRaster[inew*wnew + jnew] = sraster[i*w + j];
3407 
        }
3408 
 
3409 
    }
3410 
}
3411 
 
3412 
/*
3413 
 * Rotate a raster image
3414 
 * Code based on rotateAMColorLow() from leptonica library
3415 
 
3416 
 * draster must be pre-allocated.
50608 murrell 3417 
 
3418 
 * smoothAlpha allows alpha channel to vary smoothly based on
3419 
 * interpolation.  If this is FALSE, then alpha values are
3420 
 * taken from MAX(alpha) of relevant pixels.  This means that
3421 
 * areas of full transparency remain fully transparent,
3422 
 * areas of opacity remain opaque, edges between anything less than opacity
3423 
 * and opacity are opaque, and edges between full transparency
3424 
 * and semitransparency become semitransparent.
50554 murrell 3425 
 */
3426 
void R_GE_rasterRotate(unsigned int *sraster, int w, int h, double angle,
50608 murrell 3427 
                       unsigned int *draster, const pGEcontext gc,
3428 
                       Rboolean smoothAlpha) {
50554 murrell 3429 
    int i, j;
3430 
    int xcen, ycen, wm2, hm2;
3431 
    int xdif, ydif, xpm, ypm, xp, yp, xf, yf;
3432 
    int rval, gval, bval, aval;
3433 
    unsigned int word00, word01, word10, word11;
3434 
    unsigned int *sline, *dline;
3435 
    double sina, cosa;
3436 
 
3437 
    /* 'angle' in leptonica is clockwise */
3438 
    angle = -angle;
3439 
 
3440 
    xcen = w / 2;
3441 
    wm2 = w - 2;
3442 
    ycen = h / 2;
3443 
    hm2 = h - 2;
3444 
    sina = 16. * sin(angle);
3445 
    cosa = 16. * cos(angle);
3446 
 
3447 
    for (i = 0; i < h; i++) {
3448 
        ydif = ycen - i;
3449 
        dline = draster + i * w;
3450 
        for (j = 0; j < w; j++) {
3451 
            xdif = xcen - j;
3452 
            xpm = (int) (-xdif * cosa - ydif * sina);
3453 
            ypm = (int) (-ydif * cosa + xdif * sina);
3454 
            xp = xcen + (xpm >> 4);
3455 
            yp = ycen + (ypm >> 4);
3456 
            xf = xpm & 0x0f;
3457 
            yf = ypm & 0x0f;
3458 
 
3459 
                /* if off the edge, use transparent */
3460 
            if (xp < 0 || yp < 0 || xp > wm2 || yp > hm2) {
3461 
                *(dline + j) = gc->fill;
3462 
                continue;
3463 
            }
3464 
 
3465 
            sline = sraster + yp * w;
3466 
 
3467 
            word00 = *(sline + xp);
3468 
            word10 = *(sline + xp + 1);
3469 
            word01 = *(sline + w + xp);
3470 
            word11 = *(sline + w + xp + 1);
3471 
            rval = ((16 - xf) * (16 - yf) * R_RED(word00) +
3472 
                    xf * (16 - yf) * R_RED(word10) +
3473 
                    (16 - xf) * yf * R_RED(word01) +
3474 
                    xf * yf * R_RED(word11) + 128) / 256;
3475 
            gval = ((16 - xf) * (16 - yf) * R_GREEN(word00) +
3476 
                    xf * (16 - yf) * R_GREEN(word10) +
3477 
                    (16 - xf) * yf * R_GREEN(word01) +
3478 
                    xf * yf * R_GREEN(word11) + 128) / 256;
3479 
            bval = ((16 - xf) * (16 - yf) * R_BLUE(word00) +
3480 
                    xf * (16 - yf) * R_BLUE(word10) +
3481 
                    (16 - xf) * yf * R_BLUE(word01) +
3482 
                    xf * yf * R_BLUE(word11) + 128) / 256;
50608 murrell 3483 
            if (smoothAlpha) {
3484 
                aval = ((16 - xf) * (16 - yf) * R_ALPHA(word00) +
3485 
                        xf * (16 - yf) * R_ALPHA(word10) +
3486 
                        (16 - xf) * yf * R_ALPHA(word01) +
3487 
                        xf * yf * R_ALPHA(word11) + 128) / 256;
3488 
            } else {
59177 ripley 3489 
                aval = (int)fmax2(fmax2(R_ALPHA(word00), R_ALPHA(word10)),
3490 
				  fmax2(R_ALPHA(word01), R_ALPHA(word11)));
50608 murrell 3491 
            }
50554 murrell 3492 
            *(dline + j) = R_RGBA(rval, gval, bval, aval);
3493 
        }
3494 
    }
3495 
}