The R Project SVN R

Rev

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