The R Project SVN – R – Diff – /trunk/src/gnuwin32/devga.c


/*
 *  R : A Computer Langage for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 1998--2003  Guido Masarotto and Brian Ripley
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */
 
/*--- Device Driver for Windows; this file started from
 *  ../unix/X11/devX11.c --
 */
 
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
 
#include <Defn.h>
#include <Graphics.h>
#include <Rdevices.h>
#include <stdio.h>
#include "opt.h"
#include "graphapp/ga.h"
#include "graphapp/stdimg.h"
#include "console.h"
#include "rui.h"
#include "devga.h"		/* 'Public' routines from here */
#include "windows.h"
 
extern console RConsole;
extern Rboolean AllDevicesKilled;
 
int graphicsx = -25, graphicsy = 0;
 
/* a colour used to represent the background on png if transparent
   NB: used as RGB and BGR
*/
#define PNG_TRANS 0xd6d3d6
 
/* these really are globals: per machine, not per window */
static double user_xpinch = 0.0, user_ypinch = 0.0;
 
void GAsetunits(double xpinch, double ypinch)
{
    user_xpinch = xpinch;
    user_ypinch = ypinch;
}
 
static rgb GArgb(int color, double gamma)
{
    int r, g, b;
    if (gamma != 1) {
	r = (int) (255 * pow(R_RED(color) / 255.0, gamma));
	g = (int) (255 * pow(R_GREEN(color) / 255.0, gamma));
	b = (int) (255 * pow(R_BLUE(color) / 255.0, gamma));
    } else {
	r = R_RED(color);
	g = R_GREEN(color);
	b = R_BLUE(color);
    }
    return rgb(r, g, b);
}
 
 
 
	/********************************************************/
	/* This device driver has been documented so that it be	*/
	/* used as a template for new drivers 			*/
	/********************************************************/
 
#define MM_PER_INCH	25.4	/* mm -> inch conversion */
 
#define TRACEDEVGA(a)
#define CLIP if (xd->clip.width>0) gsetcliprect(_d,xd->clip)
 
static drawing _d;
 
#define DRAW(a) {if(xd->kind != SCREEN) {_d=xd->gawin; CLIP; a;} else {_d=xd->bm; CLIP; a; if(!xd->buffered) {_d=xd->gawin; CLIP; a;} _d=xd->bm; CLIP; a;}}
 
#define SHOW  if(xd->kind==SCREEN) {gbitblt(xd->gawin,xd->bm,pt(0,0),getrect(xd->bm));GALastUpdate=GetTickCount();}
#define SH if(xd->kind==SCREEN && xd->buffered) GA_Timer(xd)
 
 
#define SF 20  /* scrollbar resolution */
 
        /********************************************************/
	/* Each driver can have its own device-specic graphical */
	/* parameters and resources.  these should be wrapped	*/
	/* in a structure (like the gadesc structure below)    */
	/* and attached to the overall device description via 	*/
	/* the dd->deviceSpecific pointer			*/
	/* NOTE that there are generic graphical parameters	*/
	/* which must be set by the device driver, but are	*/
	/* common to all device types (see Graphics.h)		*/
	/* so go in the GPar structure rather than this device- */
	/* specific structure					*/
	/********************************************************/
 
enum DeviceKinds {SCREEN=0, PRINTER, METAFILE, PNG, JPEG, BMP};
 
typedef struct {
    /* R Graphics Parameters */
    /* local device copy so that we can detect */
    /* when parameter changes */
    int   col;			   /* Color */
    int   bg;			   /* Background */
    int   fontface;		   /* Typeface */
    int   fontsize, basefontsize;  /* Size in points */
    double fontangle;
 
    /* devga Driver Specific */
    /* parameters with copy per devga device */
 
    enum DeviceKinds kind;
    int   windowWidth;		/* Window width (pixels) */
    int   windowHeight;		/* Window height (pixels) */
    int   showWidth;		/* device width (pixels) */
    int   showHeight;		/* device height (pixels) */
    int   origWidth, origHeight, xshift, yshift;
    Rboolean resize;		/* Window resized */
    window gawin;		/* Graphics window */
  /*FIXME: we should have union for this stuff and
    maybe change gawin to canvas*/
  /* SCREEN section*/
    popup locpopup, grpopup;
    button  stoploc;
    menubar mbar, mbarloc;
    menu  msubsave;
    menuitem mpng, mbmp, mjpeg50, mjpeg75, mjpeg100;
    menuitem mps, mpdf, mwm, mclpbm, mclpwm, mprint, mclose;
    menuitem mrec, madd, mreplace, mprev, mnext, mclear, msvar, mgvar;
    menuitem mR, mfit, mfix, grmenustayontop;
    Rboolean recording, replaying, needsave;
    bitmap bm;
  /* PNG and JPEG section */
    FILE *fp;
    char filename[512];
    int quality;
    int npage;
    double w, h;
  /* Used to rescale font size so that bitmap devices have 72dpi */
    int truedpi, wanteddpi;
    rgb   fgcolor;		/* Foreground color */
    rgb   bgcolor;		/* Background color */
    rgb   canvascolor;		/* Canvas color */
    rgb   outcolor;		/* Outside canvas color */
    rect  clip;			/* The clipping rectangle */
    Rboolean usefixed;
    font  fixedfont;
    font  font;
    Rboolean locator;
    int clicked; /* {0,1,2} */
    int	px, py, lty, lwd;
    int resizing; /* {1,2,3} */
    double rescale_factor;
    int fast; /* Use fast fixed-width lines? */
    unsigned int pngtrans; /* what PNG_TRANS get mapped to */
    Rboolean buffered;
    int timeafter, timesince;
    SEXP psenv;
} gadesc;
 
rect getregion(gadesc *xd)
{
    rect r = getrect(xd->bm);
    r.x += max(0, xd->xshift);
    r.y += max(0, xd->yshift);
    r.width = min(r.width, xd->showWidth);
    r.height = min(r.height, xd->showHeight);
    return r;
}
 
/* Update the screen 100ms after last plotting call or 500ms after last
   update */
 
static UINT TimerNo = 0;
static gadesc *GA_xd;
static DWORD GALastUpdate = 0;
 
static VOID CALLBACK
GA_timer_proc(HWND hwnd, UINT message, UINT tid, DWORD time)
{
    if ((message != WM_TIMER) || tid != TimerNo || !GA_xd) return;
    gbitblt(GA_xd->gawin, GA_xd->bm, pt(0,0), getrect(GA_xd->bm));
    GALastUpdate = time;
}
 
static void GA_Timer(gadesc *xd)
{
    DWORD now = GetTickCount();
    if(TimerNo != 0) KillTimer(0, TimerNo);
    if(now > GALastUpdate + xd->timesince) {
	gbitblt(xd->gawin, xd->bm, pt(0,0), getrect(xd->bm));
	GALastUpdate = now;
    } else {
	GA_xd = xd;
	TimerNo = SetTimer(0, 0, (UINT) xd->timeafter, GA_timer_proc);
    }
}
 
	/********************************************************/
	/* There are a number of actions that every device 	*/
	/* driver is expected to perform (even if, in some	*/
	/* cases it does nothing - just so long as it doesn't 	*/
	/* crash !).  this is how the graphics engine interacts */
	/* with each device. Each action will be documented 	*/
	/* individually. 					*/
	/* hooks for these actions must be set up when the 	*/
	/* device is first created				*/
	/********************************************************/
 
	/* Device Driver Actions */
 
static void GA_Activate(NewDevDesc *dd);
static void GA_Circle(double x, double y, double r,
		      R_GE_gcontext *gc,
		      NewDevDesc *dd);
static void GA_Clip(double x0, double x1, double y0, double y1,
		     NewDevDesc *dd);
static void GA_Close(NewDevDesc *dd);
static void GA_Deactivate(NewDevDesc *dd);
static void GA_Hold(NewDevDesc *dd);
static Rboolean GA_Locator(double *x, double *y, NewDevDesc *dd);
static void GA_Line(double x1, double y1, double x2, double y2,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd);
static void GA_MetricInfo(int c,
			  R_GE_gcontext *gc,
			  double* ascent, double* descent,
			  double* width, NewDevDesc *dd);
static void GA_Mode(int mode, NewDevDesc *dd);
static void GA_NewPage(R_GE_gcontext *gc,
		       NewDevDesc *dd);
static void GA_Polygon(int n, double *x, double *y,
		       R_GE_gcontext *gc,
		       NewDevDesc *dd);
static void GA_Polyline(int n, double *x, double *y,
			R_GE_gcontext *gc,
			NewDevDesc *dd);
static void GA_Rect(double x0, double y0, double x1, double y1,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd);
static void GA_Size(double *left, double *right,
		    double *bottom, double *top,
		    NewDevDesc *dd);
static void GA_Resize(NewDevDesc *dd);
static double GA_StrWidth(char *str,
			  R_GE_gcontext *gc,
			  NewDevDesc *dd);
static void GA_Text(double x, double y, char *str,
		    double rot, double hadj,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd);
static Rboolean GA_Open(NewDevDesc*, gadesc*, char*, double, double,
			Rboolean, int, int, double, int, int);
 
	/********************************************************/
	/* end of list of required device driver actions 	*/
	/********************************************************/
 
	/* Support Routines */
 
static double pixelHeight(drawing  d);
static double pixelWidth(drawing d);
static void SetColor(int, double, NewDevDesc *);
static void SetFont(int, int, double, NewDevDesc *);
static void SetLinetype(int, double, NewDevDesc *);
static int Load_Rbitmap_Dll();
void UnLoad_Rbitmap_Dll();
static void SaveAsPng(NewDevDesc *dd, char *fn);
static void SaveAsJpeg(NewDevDesc *dd, int quality, char *fn);
static void SaveAsBmp(NewDevDesc *dd, char *fn);
static void SaveAsBitmap(NewDevDesc *dd);
 
static void PrivateCopyDevice(NewDevDesc *dd, NewDevDesc *ndd, char *name)
{
    GEDevDesc* gdd;
    int saveDev = curDevice();
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    gsetcursor(xd->gawin, WatchCursor);
    gsetVar(install(".Device"),
	    mkString(name), R_NilValue);
    gdd = GEcreateDevDesc(ndd);
    addDevice((DevDesc*) gdd);
    GEcopyDisplayList(devNumber((DevDesc*) dd));
    KillDevice((DevDesc*) gdd);
    selectDevice(saveDev);
/*    KillDevice(GetDevice(devNumber((DevDesc*) ndd))); */
    gsetcursor(xd->gawin, ArrowCursor);
    show(xd->gawin);
}
 
static void SaveAsWin(NewDevDesc *dd, char *display)
{
    NewDevDesc *ndd = (NewDevDesc *) calloc(1, sizeof(NewDevDesc));
    GEDevDesc* gdd = (GEDevDesc*) GetDevice(devNumber((DevDesc*) dd));
    if (!ndd) {
	R_ShowMessage("Not enough memory to copy graphics window");
	return;
    }
    if(!R_CheckDeviceAvailableBool()) {
	free(ndd);
	R_ShowMessage("No device available to copy graphics window");
	return;
    }
 
    ndd->displayList = R_NilValue;
    if (GADeviceDriver(ndd, display,
		       fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),
				       GE_INCHES, gdd),
		       fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),
					GE_INCHES, gdd),
		       ((gadesc*) dd->deviceSpecific)->basefontsize,
		       0, 1, White, 1, NA_INTEGER, NA_INTEGER, FALSE,
		       R_GlobalEnv))
        PrivateCopyDevice(dd, ndd, display);
}
 
 
static void SaveAsPostscript(NewDevDesc *dd, char *fn)
{
    SEXP s;
    NewDevDesc *ndd = (NewDevDesc *) calloc(1, sizeof(NewDevDesc));
    GEDevDesc* gdd = (GEDevDesc*) GetDevice(devNumber((DevDesc*) dd));
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    char family[256], encoding[256], paper[256], bg[256], fg[256],
	**afmpaths = NULL;
 
    if (!ndd) {
	R_ShowMessage("Not enough memory to copy graphics window");
	return;
    }
    if(!R_CheckDeviceAvailableBool()) {
	free(ndd);
	R_ShowMessage("No device available to copy graphics window");
	return;
    }
 
 
    ndd->displayList = R_NilValue;
 
    /* Set default values... */
    strcpy(family, "Helvetica");
    strcpy(encoding, "ISOLatin1.enc");
    strcpy(paper, "default");
    strcpy(bg, "transparent");
    strcpy(fg, "black");
    /* and then try to get it from .PostScript.Options */
    s = findVar(install(".PostScript.Options"), xd->psenv);
    if ((s != R_UnboundValue) && (s != R_NilValue)) {
	SEXP names = getAttrib(s, R_NamesSymbol);
	int i,done;
	for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {
	    if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {
		strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	    if(!strcmp("paper", CHAR(STRING_ELT(names, i)))) {
		strcpy(paper, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	    if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {
		strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	    if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {
		strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	}
    }
    if (PSDeviceDriver((DevDesc *) ndd,
		       fn, paper, family, afmpaths, encoding, bg, fg,
		       fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),
				       GE_INCHES, gdd),
		       fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),
					GE_INCHES, gdd),
		       (double)0, ((gadesc*) dd->deviceSpecific)->basefontsize,
		       0, 1, 0, "", "R Graphics Output"))
	/* horizontal=F, onefile=F, pagecentre=T, print.it=F */
	PrivateCopyDevice(dd, ndd, "postscript");
}
 
 
static void SaveAsPDF(NewDevDesc *dd, char *fn)
{
    SEXP s;
    NewDevDesc *ndd = (NewDevDesc *) calloc(1, sizeof(NewDevDesc));
    GEDevDesc* gdd = (GEDevDesc*) GetDevice(devNumber((DevDesc*) dd));
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    char family[256], encoding[256], bg[256], fg[256];
 
    if (!ndd) {
	R_ShowMessage("Not enough memory to copy graphics window");
	return;
    }
    if(!R_CheckDeviceAvailableBool()) {
	free(ndd);
	R_ShowMessage("No device available to copy graphics window");
	return;
    }
 
    ndd->displayList = R_NilValue;
 
    /* Set default values... */
    s = findVar(install(".PostScript.Options"), xd->psenv);
    strcpy(family, "Helvetica");
    strcpy(encoding, "ISOLatin1.enc");
    strcpy(bg, "transparent");
    strcpy(fg, "black");
    /* and then try to get it from .PostScript.Options */
    if ((s != R_UnboundValue) && (s != R_NilValue)) {
	SEXP names = getAttrib(s, R_NamesSymbol);
	int i,done;
	for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {
	    if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {
		strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	    if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {
		strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	    if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {
		strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));
		done += 1;
	    }
	}
    }
    if (PDFDeviceDriver((DevDesc *) ndd, fn, family, encoding, bg, fg,
			fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),
					GE_INCHES, gdd),
			fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),
					 GE_INCHES, gdd),
			((gadesc*) dd->deviceSpecific)->basefontsize,
			1, "R Graphics Output"))
	PrivateCopyDevice(dd, ndd, "PDF");
}
 
 
 
			/* Pixel Dimensions (Inches) */
static double pixelWidth(drawing obj)
{
    return ((double) 1) / devicepixelsx(obj);
}
 
static double pixelHeight(drawing obj)
{
    return ((double) 1) / devicepixelsy(obj);
}
 
			/* Font information array. */
			/* Point sizes: 6-24 */
			/* Faces: plain, bold, oblique, bold-oblique */
			/* Symbol may be added later */
 
#define NFONT 19
#define MAXFONT 32
static int fontnum;
static int fontinitdone = 0;/* in {0,1,2} */
static char *fontname[MAXFONT];
static int fontstyle[MAXFONT];
 
static void RStandardFonts()
{
    int   i;
 
    for (i = 0; i < 4; i++)
	fontname[i] = "Times New Roman";
    fontname[4] = "Symbol";
    fontstyle[0] = fontstyle[4] = Plain;
    fontstyle[1] = Bold;
    fontstyle[2] = Italic;
    fontstyle[3] = BoldItalic;
    fontnum = 5;
    fontinitdone = 2;		/* =fontinit done & fontname must not be
				   free-ed */
}
 
 
static void RFontInit()
{
    int   i, notdone;
    char *opt[2];
    char  oops[256];
 
    sprintf(oops, "%s/Rdevga", getenv("R_USER"));
    notdone = 1;
    fontnum = 0;
    fontinitdone = 1;
    if (!optopenfile(oops)) {
	sprintf(oops, "%s/etc/Rdevga", getenv("R_HOME"));
	if (!optopenfile(oops)) {
	    RStandardFonts();
	    notdone = 0;
	}
    }
    while (notdone) {
	oops[0] = '\0';
	notdone = optread(opt, ':');
	if (notdone == 1)
	    sprintf(oops, "[%s] Error at line %d.", optfile(), optline());
	else if (notdone == 2) {
	    fontname[fontnum] = strdup(opt[0]);
	    if (!fontname[fontnum])
		strcpy(oops, "Insufficient memory. ");
	    else {
		if (!strcmpi(opt[1], "plain"))
		    fontstyle[fontnum] = Plain;
		else if (!strcmpi(opt[1], "bold"))
		    fontstyle[fontnum] = Bold;
		else if (!strcmpi(opt[1], "italic"))
		    fontstyle[fontnum] = Italic;
		else if (!strcmpi(opt[1], "bold&italic"))
		    fontstyle[fontnum] = BoldItalic;
		else
		    sprintf(oops, "Unknown style at line %d. ", optline());
		fontnum += 1;
	    }
	}
	if (oops[0]) {
	    optclosefile();
	    strcat(oops, optfile());
	    strcat(oops, " will be ignored.");
	    R_ShowMessage(oops);
	    for (i = 0; i < fontnum; i++) free(fontname[i]);
	    RStandardFonts();
	    notdone = 0;
	}
	if (fontnum == MAXFONT) {
	    optclosefile();
	    notdone = 0;
	}
    }
}
 
 
 
static int SetBaseFont(gadesc *xd)
{
    xd->fontface = 1;
    xd->fontsize = xd->basefontsize;
    xd->fontangle = 0.0;
    xd->usefixed = FALSE;
    xd->font = gnewfont(xd->gawin, fontname[0], fontstyle[0],
			MulDiv(xd->fontsize, xd->wanteddpi, xd->truedpi), 0.0);
    if (!xd->font) {
	xd->usefixed= TRUE;
	xd->font = xd->fixedfont = FixedFont;
	if (!xd->fixedfont)
	    return 0;
    }
    return 1;
}
 
 
 
/* Set the font size and face */
/* If the font of this size and at that the specified */
/* rotation is not present it is loaded. */
/* 0 = plain text, 1 = bold */
/* 2 = oblique, 3 = bold-oblique */
 
#define SMALLEST 2
#define LARGEST 100
 
static void SetFont(int face, int size, double rot, NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (face < 1 || face > fontnum)
	face = 1;
    if (size < SMALLEST) size = SMALLEST;
    if (size > LARGEST) size = LARGEST;
    size = MulDiv(size, xd->wanteddpi, xd->truedpi);
    if (!xd->usefixed &&
	(size != xd->fontsize || face != xd->fontface ||
	 rot != xd->fontangle)) {
	 del(xd->font); doevent();
	 xd->font = gnewfont(xd->gawin,
			    fontname[face - 1], fontstyle[face - 1],
			    size, rot);
	if (xd->font) {
	    xd->fontface = face;
	    xd->fontsize = size;
	    xd->fontangle = rot;
	} else {
	    SetBaseFont(xd);
	}
    }
}
 
 
static void SetColor(int color, double gamma, NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (color != xd->col) {
	xd->col = color;
	xd->fgcolor = GArgb(color, gamma);
    }
}
 
 
/*
 *	Some Notes on Line Textures
 *
 *	Line textures are stored as an array of 4-bit integers within
 *	a single 32-bit word.  These integers contain the lengths of
 *	lines to be drawn with the pen alternately down and then up.
 *	The device should try to arrange that these values are measured
 *	in points if possible, although pixels is ok on most displays.
 *
 *	If newlty contains a line texture description it is decoded
 *	as follows:
 *
 *		ndash = 0;
 *		for(i=0 ; i<8 && newlty&15 ; i++) {
 *			dashlist[ndash++] = newlty&15;
 *			newlty = newlty>>4;
 *		}
 *		dashlist[0] = length of pen-down segment
 *		dashlist[1] = length of pen-up segment
 *		etc
 *
 *	An integer containing a zero terminates the pattern.  Hence
 *	ndash in this code fragment gives the length of the texture
 *	description.  If a description contains an odd number of
 *	elements it is replicated to create a pattern with an
 *	even number of elements.  (If this is a pain, do something
 *	different its not crucial).
 *
 *	27/5/98 Paul - change to allow lty and lwd to interact:
 *	the line texture is now scaled by the line width so that,
 *	for example, a wide (lwd=2) dotted line (lty=2) has bigger
 *	dots which are more widely spaced.  Previously, such a line
 *	would have "dots" which were wide, but not long, nor widely
 *	spaced.
 */
 
static void SetLinetype(int newlty, double nlwd, NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    int   newlwd;
 
    newlwd = nlwd;
    if (newlwd < 1)
	newlwd = 1;
    xd->lty = newlty;
    xd->lwd = newlwd;
}
 
 
 
/* Callback functions */
 
 
static void HelpResize(window w, rect r)
{
    if (AllDevicesKilled) return;
    {
	NewDevDesc *dd = (NewDevDesc *) getdata(w);
	gadesc *xd = (gadesc *) dd->deviceSpecific;
 
	if (r.width) {
	    if ((xd->windowWidth != r.width) ||
		((xd->windowHeight != r.height))) {
		xd->windowWidth = r.width;
		xd->windowHeight = r.height;
		xd->resize = TRUE;
	    }
	}
    }
}
 
static void HelpClose(window w)
{
    if (AllDevicesKilled) return;
    {
	NewDevDesc *dd = (NewDevDesc *) getdata(w);
	KillDevice(GetDevice(devNumber((DevDesc*) dd)));
    }
}
 
static void HelpExpose(window w, rect r)
{
    if (AllDevicesKilled) return;
    {
	NewDevDesc *dd = (NewDevDesc *) getdata(w);
	GEDevDesc* gdd = (GEDevDesc*) GetDevice(devNumber((DevDesc*) dd));
	gadesc *xd = (gadesc *) dd->deviceSpecific;
 
	if (xd->resize) {
	    GA_Resize(dd);
	    xd->replaying = TRUE;
	    GEplayDisplayList(gdd);
	    xd->replaying = FALSE;
	    R_ProcessEvents();
	} else
	    SHOW;
    }
}
 
static void HelpMouseClick(window w, int button, point pt)
{
    if (AllDevicesKilled) return;
    {
	NewDevDesc *dd = (NewDevDesc *) getdata(w);
	gadesc *xd = (gadesc *) dd->deviceSpecific;
 
	if (!xd->locator)
	    return;
	if (button & LeftButton) {
	    int useBeep = asLogical(GetOption(install("locatorBell"),
					      R_NilValue));
	    if(useBeep) gabeep();
	    xd->clicked = 1;
	    xd->px = pt.x;
	    xd->py = pt.y;
	} else
	    xd->clicked = 2;
    }
}
 
static void menustop(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    if (!xd->locator)
	return;
    xd->clicked = 2;
}
 
void  fixslash(char *);
 
static void menufilebitmap(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    char *fn;
    if (m==xd->mpng) {
      setuserfilter("Png files (*.png)\0*.png\0\0");
      fn = askfilesave("Portable network graphics file", "");
    } else if (m==xd->mbmp) {
      setuserfilter("Windows bitmap files (*.bmp)\0*.bmp\0\0");
      fn = askfilesave("Windows bitmap file", "");
    } else {
      setuserfilter("Jpeg files (*.jpeg,*jpg)\0*.jpeg;*.jpg\0\0");
      fn = askfilesave("Jpeg file", "");
    }
    if (!fn) return;
    fixslash(fn);
    gsetcursor(xd->gawin, WatchCursor);
    show(xd->gawin);
    if (m==xd->mpng) SaveAsPng(dd, fn);
    else if (m==xd->mbmp) SaveAsBmp(dd, fn);
    else if (m==xd->mjpeg50) SaveAsJpeg(dd, 50, fn);
    else if (m==xd->mjpeg75) SaveAsJpeg(dd, 75, fn);
    else SaveAsJpeg(dd, 100, fn);
    gsetcursor(xd->gawin, ArrowCursor);
    show(xd->gawin);
}
 
 
static void menups(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    char  *fn;
 
    setuserfilter("Postscript files (*.ps)\0*.ps\0All files (*.*)\0*.*\0\0");
    fn = askfilesave("Postscript file", "");
    if (!fn) return;
    fixslash(fn);
    SaveAsPostscript(dd, fn);
}
 
 
static void menupdf(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    char  *fn;
 
    setuserfilter("PDF files (*.pdf)\0*.pdf\0All files (*.*)\0*.*\0\0");
    fn = askfilesave("PDF file", "");
    if (!fn) return;
    fixslash(fn);
    SaveAsPDF(dd, fn);
}
 
 
static void menuwm(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    char  display[550], *fn;
 
    setuserfilter("Enhanced metafiles (*.emf)\0*.emf\0All files (*.*)\0*.*\0\0");
    fn = askfilesave("Enhanced metafiles", "");
    if (!fn) return;
    fixslash(fn);
    if(strlen(fn) > 512) {
	askok("file path selected is too long: only 512 bytes are allowed");
	return;
    }
    sprintf(display, "win.metafile:%s", fn);
    SaveAsWin(dd, display);
}
 
 
static void menuclpwm(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    SaveAsWin(dd, "win.metafile");
}
 
static void menuclpbm(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    show(xd->gawin);
    gsetcursor(xd->gawin, WatchCursor);
    copytoclipboard(xd->bm);
    gsetcursor(xd->gawin, ArrowCursor);
}
 
static void menustayontop(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
 
 
    BringToTop(xd->gawin, 2);
 
 
 
 
}
 
static void menuprint(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    SaveAsWin(dd, "win.print:");
}
 
 
 
static void menuclose(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    HelpClose(xd->gawin);
}
 
static void grpopupact(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (ismdi())
    	disable(xd->grmenustayontop);
    else {
    	if (isTopmost(xd->gawin))
     	    check(xd->grmenustayontop);
    	else
    	    uncheck(xd->grmenustayontop);
    }
}
 
/* plot history */
 
 
#ifdef PLOTHISTORY
 
/* extern SEXP savedSnapshot;*/
 
/* NB: this puts .SavedPlots in .GlobalEnv */
#define GROWTH 4
#define GETDL SEXP vDL=findVar(install(".SavedPlots"), R_GlobalEnv)
#define SETDL defineVar(install(".SavedPlots"), vDL, R_GlobalEnv)
/* altered in 1.4.0, as incompatible format */
#define PLOTHISTORYMAGIC 31416
#define pMAGIC      (INTEGER(VECTOR_ELT(vDL, 0))[0])
#define pNUMPLOTS   (INTEGER(VECTOR_ELT(vDL, 1))[0])
#define pMAXPLOTS   (INTEGER(VECTOR_ELT(vDL, 2))[0])
#define pCURRENTPOS (INTEGER(VECTOR_ELT(vDL, 3))[0])
#define pHISTORY    (VECTOR_ELT(vDL, 4))
#define SET_pHISTORY(v)    (SET_VECTOR_ELT(vDL, 4, v))
#define pCURRENT    (VECTOR_ELT(pHISTORY, pCURRENTPOS))
#define pCURRENTdl  (VECTOR_ELT(pCURRENT, 0))
#define pCURRENTgp  (INTEGER(VECTOR_ELT(pCURRENT, 1)))
#define pCURRENTsnapshot (VECTOR_ELT(pCURRENT, 0))
#define pCHECK      if ((TYPEOF(vDL)!=VECSXP)||\
                       (TYPEOF(VECTOR_ELT(vDL, 0))!=INTSXP) ||\
                       (LENGTH(VECTOR_ELT(vDL, 0))!=1) ||\
                       (pMAGIC != PLOTHISTORYMAGIC)) {\
                       R_ShowMessage("Plot history seems corrupted");\
                       return;}
#define pMOVE(a) {pCURRENTPOS+=a;\
                  if(pCURRENTPOS<0) pCURRENTPOS=0;\
                  if(pCURRENTPOS>pNUMPLOTS-1) pCURRENTPOS=pNUMPLOTS-1;\
                  Replay(dd,vDL);SETDL;}
#define pEXIST ((vDL!=R_UnboundValue) && (vDL!=R_NilValue))
#define pMUSTEXIST if(!pEXIST){R_ShowMessage("No plot history!");return;}
 
 
 
 
static SEXP NewPlotHistory(int n)
{
    SEXP  vDL, class;
    int   i;
 
    PROTECT(vDL = allocVector(VECSXP, 5));
    for (i = 0; i < 4; i++)
	PROTECT(SET_VECTOR_ELT(vDL, i, allocVector(INTSXP, 1)));
    PROTECT(SET_pHISTORY (allocVector(VECSXP, n)));
    pMAGIC = PLOTHISTORYMAGIC;
    pNUMPLOTS = 0;
    pMAXPLOTS = n;
    pCURRENTPOS = -1;
    for (i = 0; i < n; i++)
	SET_VECTOR_ELT(pHISTORY, i, R_NilValue);
    PROTECT(class = allocVector(STRSXP, 1));
    SET_STRING_ELT(class, 0, mkChar("SavedPlots"));
    classgets(vDL, class);
    SETDL;
    UNPROTECT(7);
    return vDL;
}
 
static SEXP GrowthPlotHistory(SEXP vDL)
{
    SEXP  vOLD;
    int   i, oldNPlots, oldCurrent;
 
    PROTECT(vOLD = pHISTORY);
    oldNPlots = pNUMPLOTS;
    oldCurrent = pCURRENTPOS;
    PROTECT(vDL = NewPlotHistory(pMAXPLOTS + GROWTH));
    for (i = 0; i < oldNPlots; i++)
	SET_VECTOR_ELT(pHISTORY, i, VECTOR_ELT(vOLD, i));
    pNUMPLOTS = oldNPlots;
    pCURRENTPOS = oldCurrent;
    SETDL;
    UNPROTECT(2);
    return vDL;
}
 
static void AddtoPlotHistory(SEXP snapshot, int replace)
{
    int   where;
    SEXP  class;
 
    GETDL;
/*    if (dl == R_NilValue) {
	R_ShowMessage("Display list is void!");
	return;
	} */
    if (!pEXIST)
	vDL = NewPlotHistory(GROWTH);
    else if (!replace && (pNUMPLOTS == pMAXPLOTS))
	vDL = GrowthPlotHistory(vDL);
    PROTECT(vDL);
    pCHECK;
    if (replace)
	where = pCURRENTPOS;
    else
	where = pNUMPLOTS;
    PROTECT(snapshot);
    PROTECT(class = allocVector(STRSXP, 1));
    SET_STRING_ELT(class, 0, mkChar("recordedplot"));
    classgets(snapshot, class);
    SET_VECTOR_ELT(pHISTORY, where, snapshot);
    pCURRENTPOS = where;
    if (!replace) pNUMPLOTS += 1;
    SETDL;
    UNPROTECT(3);
}
 
 
static void Replay(NewDevDesc *dd, SEXP vDL)
{
    GEDevDesc *gdd = (GEDevDesc *) GetDevice(devNumber((DevDesc*) dd));
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    xd->replaying = TRUE;
    gsetcursor(xd->gawin, WatchCursor);
    GEplaySnapshot(pCURRENT, gdd);
    xd->replaying = FALSE;
    gsetcursor(xd->gawin, ArrowCursor);
}
 
static void menurec(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->recording) {
	xd->recording = FALSE;
	uncheck(m);
    } else {
	xd->recording = TRUE;
	check(m);
    }
}
 
 
static void menuadd(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    GEDevDesc *gdd = (GEDevDesc *) GetDevice(devNumber((DevDesc*) dd));
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    AddtoPlotHistory(GEcreateSnapshot(gdd), 0);
    xd->needsave = FALSE;
}
 
static void menureplace(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    GEDevDesc *gdd = (GEDevDesc *) GetDevice(devNumber((DevDesc*) dd));
 
    GETDL;
    pMUSTEXIST;
    pCHECK;
    if (pCURRENTPOS < 0) {
	R_ShowMessage("No plot to replace!");
	return;
    }
    AddtoPlotHistory(GEcreateSnapshot(gdd), 1);
}
 
static void menunext(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    GETDL;
    if (xd->needsave) return;
    pMUSTEXIST;
    pCHECK;
    if (pCURRENTPOS != (pNUMPLOTS - 1)) pMOVE(1);
}
 
static void menuprev(control m)
{
    NewDevDesc *dd = (NewDevDesc*) getdata(m);
    GEDevDesc *gdd = (GEDevDesc *) GetDevice(devNumber((DevDesc*) dd));
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    GETDL;
    pMUSTEXIST;
    pCHECK;
    if (pNUMPLOTS) {
	if (xd->recording && xd->needsave && (dd->displayList != R_NilValue)) {
	    AddtoPlotHistory(GEcreateSnapshot(gdd), 0);
	    xd->needsave = FALSE;
	}
	pMOVE((xd->needsave) ? 0 : -1);
    }
}
 
static void menuclear(control m)
{
    defineVar(install(".SavedPlots"), R_NilValue, R_GlobalEnv);
}
 
static void menugvar(control m)
{
    SEXP  vDL;
    char *v = askstring("Variable name", "");
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
 
    if (!v)
	return;
    vDL = findVar(install(v), R_GlobalEnv);
    if (!pEXIST || !pNUMPLOTS) {
	R_ShowMessage("Variable doesn't exist or doesn't contain any plots!");
	return;
    }
    pCHECK;
    pCURRENTPOS = 0;
    Replay(dd, vDL);
    SETDL;
}
 
static void menusvar(control m)
{
    char *v;
 
    GETDL;
    pMUSTEXIST;
    pCHECK;
    v = askstring("Name of variable to save to", "");
    if (!v)
	return;
    defineVar(install(v), vDL, R_GlobalEnv);
}
#endif
 
static void menuconsole(control m)
{
   show(RConsole);
}
 
static void menuR(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    check(xd->mR);
    uncheck(xd->mfix);
    uncheck(xd->mfit);
    xd->resizing = 1;
    xd->resize = TRUE;
    HelpExpose(m, getrect(xd->gawin));
}
 
static void menufit(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    uncheck(xd->mR);
    check(xd->mfit);
    uncheck(xd->mfix);
    xd->resizing = 2;
    xd->resize = TRUE;
    HelpExpose(m, getrect(xd->gawin));
}
 
static void menufix(control m)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    uncheck(xd->mR);
    uncheck(xd->mfit);
    check(xd->mfix);
    xd->resizing = 3;
    xd->resize = TRUE;
    HelpExpose(m, getrect(xd->gawin));
}
 
static void CHelpKeyIn(control w, int key)
{
#ifdef PLOTHISTORY
    NewDevDesc *dd = (NewDevDesc *) getdata(w);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->replaying) return;
    switch (key) {
      case INS:
	menuadd(xd->madd);
	break;
      case PGUP:
	menuprev(xd->mprev);
	break;
      case PGDN:
	menunext(xd->mnext);
	break;
    }
#endif
}
 
static void NHelpKeyIn(control w,int key)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(w);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->replaying) return;
    if (ggetkeystate() != CtrlKey)
	return;
    key = 'A' + key - 1;
    if (key == 'C')
	menuclpbm(xd->mclpbm);
    if (dd->displayList == R_NilValue)
	return;
    if (key == 'W')
	menuclpwm(xd->mclpwm);
    if (key == 'P')
	menuprint(xd->mprint);
}
 
static void mbarf(control m)
{
#ifdef PLOTHISTORY
    NewDevDesc *dd = (NewDevDesc *) getdata(m);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    GETDL;
    if (pEXIST && !xd->replaying) {
	enable(xd->mnext);
	enable(xd->mprev);
	if ((pCURRENTPOS >= 0) && (dd->displayList != R_NilValue))
	    enable(xd->mreplace);
	else
	    disable(xd->mreplace);
	enable(xd->msvar);
	enable(xd->mclear);
    } else {
	disable(xd->mnext);
	disable(xd->mprev);
	disable(xd->mreplace);
	disable(xd->msvar);
	disable(xd->mclear);
    }
    if (!xd->replaying)
	enable(xd->mgvar);
    else
	disable(xd->mgvar);
    if ((dd->displayList != R_NilValue) && !xd->replaying) {
	enable(xd->madd);
	enable(xd->mprint);
	enable(xd->mpng);
	enable(xd->mbmp);
	enable(xd->mjpeg50);
	enable(xd->mjpeg75);
	enable(xd->mjpeg100);
	enable(xd->mwm);
	enable(xd->mps);
	enable(xd->mpdf);
	enable(xd->mclpwm);
	enable(xd->mclpbm);
    } else {
	disable(xd->madd);
	disable(xd->mprint);
	disable(xd->msubsave);
	disable(xd->mpng);
	disable(xd->mbmp);
	disable(xd->mjpeg50);
	disable(xd->mjpeg75);
	disable(xd->mjpeg100);
	disable(xd->mwm);
	disable(xd->mps);
	disable(xd->mpdf);
	disable(xd->mclpwm);
	disable(xd->mclpbm);
    }
    draw(xd->mbar);
#endif
}
 
 
        /********************************************************/
	/* device_Open is not usually called directly by the 	*/
	/* graphics engine;  it is usually only called from 	*/
	/* the device-driver entry point.			*/
	/* this function should set up all of the device-	*/
	/* specific resources for a new device			*/
	/* this function is given a new	structure for device-	*/
	/* specific information AND it must FREE the structure 	*/
	/* if anything goes seriously wrong			*/
	/* NOTE that it is perfectly acceptable for this 	*/
	/* function to set generic graphics parameters too	*/
	/* (i.e., override the generic parameter settings	*/
	/* which GInit sets up) all at the author's own risk	*/
	/* of course :)						*/
	/********************************************************/
 
#define MCHECK(m) {if(!(m)) {del(xd->gawin); return 0;}}
 
static void devga_sbf(control c, int pos)
{
    NewDevDesc *dd = (NewDevDesc *) getdata(c);
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    if (pos < 0) {
	pos = -pos-1;
	pos = min(pos*SF, (xd->origWidth - xd->windowWidth + SF-1));
	xd->xshift = -pos;
    } else {
	pos = min(pos*SF, (xd->origHeight - xd->windowHeight + SF-1));
	xd->yshift = -pos;
    }
    xd->resize = 1;
    HelpExpose(c, getrect(xd->gawin));
}
 
 
static int
setupScreenDevice(NewDevDesc *dd, gadesc *xd, double w, double h,
		  Rboolean recording, int resize, int xpos, int ypos)
{
    menu  m;
    int   iw, ih;
    int   cw, ch;
    double dw, dw0, dh, d;
 
    xd->kind = SCREEN;
    if (R_finite(user_xpinch) && user_xpinch > 0.0)
	dw = dw0 = (int) (w * user_xpinch);
    else
	dw = dw0 = (int) (w / pixelWidth(NULL));
    if (R_finite(user_ypinch) && user_ypinch > 0.0)
	dh = (int) (w * user_ypinch);
    else
	dh = (int) (h / pixelHeight(NULL));
 
    if (ismdi()) {
	cw = RgetMDIwidth();
	ch = RgetMDIheight();
    } else {
	cw = devicewidth(NULL);
	ch = deviceheight(NULL);
    }
 
    if (resize != 3) {
	if ((dw / cw) > 0.85) {
	    d = dh / dw;
	    dw = 0.85 * cw;
	    dh = d * dw;
	}
	if ((dh / ch) > 0.85) {
	    d = dw / dh;
	    dh = 0.85 * ch;
	    dw = d * dh;
	}
    } else {
	dw = min(dw, 0.85*cw);
	dh = min(dh, 0.85*ch);
    }
    iw = dw + 0.5;
    ih = dh + 0.5;
    if (resize == 2) xd->rescale_factor = dw/dw0;
    {
	int grx, gry;
	grx = (xpos == NA_INTEGER) ? graphicsx : xpos;
	gry = (ypos == NA_INTEGER) ? graphicsy : ypos;
	if (grx < 0) grx = cw - iw + grx;
	if (gry < 0) gry = ch - ih + gry;
	if (!(xd->gawin = newwindow("R Graphics",
				    rect(grx, gry, iw, ih),
				    Document | StandardWindow | Menubar |
				    VScrollbar | HScrollbar)))
	    return 0;
    }
    gchangescrollbar(xd->gawin, VWINSB, 0, ih/SF-1, ih/SF, 0);
    gchangescrollbar(xd->gawin, HWINSB, 0, iw/SF-1, iw/SF, 0);
 
    addto(xd->gawin);
    gsetcursor(xd->gawin, ArrowCursor);
    if (ismdi() && (RguiMDI & RW_TOOLBAR)) {
	int btsize = 24;
	rect r = rect(2, 2, btsize, btsize);
	control bt, tb;
 
	MCHECK(tb = newtoolbar(btsize + 4));
	gsetcursor(tb, ArrowCursor);
	addto(tb);
 
	MCHECK(bt = newtoolbutton(cam_image, r, menuclpwm));
	MCHECK(addtooltip(bt, "Copy to the clipboard as a metafile"));
	gsetcursor(bt, ArrowCursor);
	setdata(bt, (void *) dd);
	r.x += (btsize + 6);
 
	MCHECK(bt = newtoolbutton(print_image, r, menuprint));
	MCHECK(addtooltip(bt, "Print"));
	gsetcursor(bt, ArrowCursor);
	setdata(bt, (void *) dd);
	r.x += (btsize + 6);
 
	MCHECK(bt = newtoolbutton(console_image, r, menuconsole));
	MCHECK(addtooltip(bt, "Return focus to console"));
	gsetcursor(bt, ArrowCursor);
	setdata(bt, (void *) dd);
	r.x += (btsize + 6);
 
	MCHECK(xd->stoploc = newtoolbutton(stop_image, r, menustop));
	MCHECK(addtooltip(xd->stoploc, "Stop locator"));
	gsetcursor(bt, ArrowCursor);
	setdata(xd->stoploc,(void *) dd);
	hide(xd->stoploc);
    } else
	xd->stoploc = NULL;
 
    /* First we prepare 'locator' menubar and popup */
    addto(xd->gawin);
    MCHECK(xd->mbarloc = newmenubar(NULL));
    MCHECK(newmenu("Stop"));
    MCHECK(m = newmenuitem("Stop locator", 0, menustop));
    setdata(m, (void *) dd);
    MCHECK(xd->locpopup = newpopup(NULL));
    MCHECK(m = newmenuitem("Stop", 0, menustop));
    setdata(m, (void *) dd);
    MCHECK(newmenuitem("Continue", 0, NULL));
 
    /* Normal menubar */
    MCHECK(xd->mbar = newmenubar(mbarf));
    MCHECK(m = newmenu("File"));
    MCHECK(xd->msubsave = newsubmenu(m, "Save as"));
    MCHECK(xd->mwm = newmenuitem("Metafile...", 0, menuwm));
    MCHECK(xd->mps = newmenuitem("Postscript...", 0, menups));
    MCHECK(xd->mpdf = newmenuitem("PDF...", 0, menupdf));
    MCHECK(xd->mpng = newmenuitem("Png...", 0, menufilebitmap));
    MCHECK(xd->mbmp = newmenuitem("Bmp...", 0, menufilebitmap));
    MCHECK(newsubmenu(xd->msubsave,"Jpeg"));
    MCHECK(xd->mjpeg50 = newmenuitem("50% quality...", 0, menufilebitmap));
    MCHECK(xd->mjpeg75 = newmenuitem("75% quality...", 0, menufilebitmap));
    MCHECK(xd->mjpeg100 = newmenuitem("100% quality...", 0, menufilebitmap));
    MCHECK(newsubmenu(m, "Copy to the clipboard"));
    MCHECK(xd->mclpbm = newmenuitem("as a Bitmap\tCTRL+C", 0, menuclpbm));
    MCHECK(xd->mclpwm = newmenuitem("as a Metafile\tCTRL+W", 0, menuclpwm));
    addto(m);
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->mprint = newmenuitem("Print...\tCTRL+P", 0, menuprint));
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->mclose = newmenuitem("close Device", 0, menuclose));
#ifdef PLOTHISTORY
    MCHECK(newmenu("History"));
    MCHECK(xd->mrec = newmenuitem("Recording", 0, menurec));
    if(recording) check(xd->mrec);
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->madd = newmenuitem("Add\tINS", 0, menuadd));
    MCHECK(xd->mreplace = newmenuitem("Replace", 0, menureplace));
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->mprev = newmenuitem("Previous\tPgUp", 0, menuprev));
    MCHECK(xd->mnext = newmenuitem("Next\tPgDown", 0, menunext));
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->msvar = newmenuitem("Save to variable...", 0, menusvar));
    MCHECK(xd->mgvar = newmenuitem("Get from variable...", 0, menugvar));
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->mclear = newmenuitem("Clear history", 0, menuclear));
#endif
    MCHECK(newmenu("Resize"));
    MCHECK(xd->mR = newmenuitem("R mode", 0, menuR));
    if(resize == 1) check(xd->mR);
    MCHECK(xd->mfit = newmenuitem("Fit to window", 0, menufit));
    if(resize == 2) check(xd->mfit);
    MCHECK(xd->mfix = newmenuitem("Fixed size", 0, menufix));
    if(resize == 3) check(xd->mfix);
    newmdimenu();
 
    /* Normal popup */
    MCHECK(xd->grpopup = newpopup(grpopupact));
    setdata(xd->grpopup, (void *) dd);
    MCHECK(m = newmenuitem("Copy as metafile", 0, menuclpwm));
    setdata(m, (void *) dd);
    MCHECK(m = newmenuitem("Copy as bitmap", 0, menuclpbm));
    setdata(m, (void *) dd);
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(m = newmenuitem("Save as metafile...", 0, menuwm));
    setdata(m, (void *) dd);
    MCHECK(m = newmenuitem("Save as postscript...", 0, menups));
    setdata(m, (void *) dd);
 
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(xd->grmenustayontop = newmenuitem("Stay on top", 0, menustayontop));
    setdata(xd->grmenustayontop, (void *) dd);
 
    MCHECK(newmenuitem("-", 0, NULL));
    MCHECK(m = newmenuitem("Print...", 0, menuprint));
    setdata(m, (void *) dd);
    gchangepopup(xd->gawin, xd->grpopup);
 
    MCHECK(xd->bm = newbitmap(getwidth(xd->gawin), getheight(xd->gawin),
			      getdepth(xd->gawin)));
    gfillrect(xd->gawin, xd->outcolor, getrect(xd->gawin));
    gfillrect(xd->bm, xd->outcolor, getrect(xd->bm));
    addto(xd->gawin);
    setdata(xd->mbar, (void *) dd);
    setdata(xd->mpng, (void *) dd);
    setdata(xd->mbmp, (void *) dd);
    setdata(xd->mjpeg50, (void *) dd);
    setdata(xd->mjpeg75, (void *) dd);
    setdata(xd->mjpeg100, (void *) dd);
    setdata(xd->mps, (void *) dd);
    setdata(xd->mpdf, (void *) dd);
    setdata(xd->mwm, (void *) dd);
    setdata(xd->mclpwm, (void *) dd);
    setdata(xd->mclpbm, (void *) dd);
    setdata(xd->mprint, (void *) dd);
    setdata(xd->mclose, (void *) dd);
    setdata(xd->mrec, (void *) dd);
    setdata(xd->mprev, (void *) dd);
    setdata(xd->mnext, (void *) dd);
    setdata(xd->mgvar, (void *) dd);
    setdata(xd->madd, (void *) dd);
    setdata(xd->mreplace, (void *) dd);
    setdata(xd->mR, (void *) dd);
    setdata(xd->mfit, (void *) dd);
    setdata(xd->mfix, (void *) dd);
    show(xd->gawin); /* twice, for a Windows bug */
    show(xd->gawin);
    BringToTop(xd->gawin, 0);
    sethit(xd->gawin, devga_sbf);
    setresize(xd->gawin, HelpResize);
    setredraw(xd->gawin, HelpExpose);
    setmousedown(xd->gawin, HelpMouseClick);
    setkeydown(xd->gawin, NHelpKeyIn);
    setkeyaction(xd->gawin, CHelpKeyIn);
    setclose(xd->gawin, HelpClose);
    xd->recording = recording;
    xd->replaying = FALSE;
    xd->resizing = resize;
 
    return 1;
}
 
static Rboolean GA_Open(NewDevDesc *dd, gadesc *xd, char *dsp,
			double w, double h, Rboolean recording,
			int resize, int canvascolor, double gamma,
			int xpos, int ypos)
{
    rect  rr;
    char buf[600]; /* allow for pageno formats */
 
    if (!fontinitdone)
	RFontInit();
 
    /* Foreground and Background Colors */
    xd->bg = dd->startfill = 0xffffffff; /* transparent */
    xd->col = dd->startcol = R_RGB(0, 0, 0);
 
    xd->fgcolor = Black;
    xd->bgcolor = xd->canvascolor = GArgb(canvascolor, gamma);
    xd->outcolor = myGetSysColor(COLOR_APPWORKSPACE);
    xd->rescale_factor = 1.0;
    xd->fast = 1;  /* Use `cosmetic pens' if available */
    xd->xshift = xd->yshift = 0;
    xd->npage = 0;
    if (!dsp[0]) {
	if (!setupScreenDevice(dd, xd, w, h, recording, resize, xpos, ypos))
	    return FALSE;
    } else if (!strncmp(dsp, "win.print:", 10)) {
	xd->kind = PRINTER;
	xd->gawin = newprinter(MM_PER_INCH * w, MM_PER_INCH * h, &dsp[10]);
	if (!xd->gawin)
	    return FALSE;
    } else if (!strncmp(dsp, "png:", 4) || !strncmp(dsp,"bmp:", 4)) {
	if(R_OPAQUE(canvascolor))
	    xd->bg = dd->startfill = GArgb(canvascolor, 1.0);
	else
	    xd->bg = dd->startfill = canvascolor;
	/* was R_RGB(255, 255, 255); white */
        xd->kind = (dsp[0]=='p') ? PNG : BMP;
	if(strlen(dsp+4) >= 512) error("filename too long in %s() call",
				       (dsp[0]=='p') ? "png" : "bmp");
	strcpy(xd->filename, dsp+4);
	if (!Load_Rbitmap_Dll()) {
	    warning("Unable to load Rbitmap.dll");
	    return FALSE;
	}
	/*
	  Observe that given actual graphapp implementation 256 is
	  irrelevant,i.e., depth of the bitmap is the one of graphic card
	  if required depth > 1
	*/
	if ((xd->gawin = newbitmap(w, h, 256)) == NULL) {
	    warning("Unable to allocate bitmap");
	    return FALSE;
	}
	snprintf(buf, 600, xd->filename, 1);
	if ((xd->fp = fopen(buf, "wb")) == NULL) {
	    del(xd->gawin);
	    warning("Unable to open file `%s' for writing", buf);
	    return FALSE;
	}
    } else if (!strncmp(dsp, "jpeg:", 5)) {
        char *p = strchr(&dsp[5], ':');
	xd->bg = dd->startfill = GArgb(canvascolor, 1.0);
        xd->kind = JPEG;
	if (!p) return FALSE;
	if (!Load_Rbitmap_Dll()) {
	    warning("Unable to load Rbitmap.dll");
	    return FALSE;
	}
	*p = '\0';
	xd->quality = atoi(&dsp[5]);
	*p = ':' ;
	if(strlen(p+1) >= 512) error("filename too long in jpeg() call");
	strcpy(xd->filename, p+1);
	if((xd->gawin = newbitmap(w, h, 256)) == NULL) {
	    warning("Unable to allocate bitmap");
	    return FALSE;
	}
	snprintf(buf, 600, xd->filename, 1);
	if ((xd->fp = fopen(buf, "wb")) == NULL) {
	    del(xd->gawin);
	    warning("Unable to open file `%s' for writing", buf);
	    return FALSE;
	}
    } else {
	/*
	 * win.metafile[:] in memory (for the clipboard)
	 * win.metafile:filename
	 * anything else return FALSE
	 */
	char  *s = "win.metafile";
	int   ls = strlen(s);
	int   ld = strlen(dsp);
 
	if (ls > ld)
	    return FALSE;
	if (strncmp(dsp, s, ls) || (dsp[ls] && (dsp[ls] != ':')))
	    return FALSE;
	if(ld > ls && strlen(&dsp[ls + 1]) >= 512)
	    error("filename too long in win.metafile() call");
	strcpy(xd->filename, (ld > ls) ? &dsp[ls + 1] : "");
	snprintf(buf, 600, xd->filename, 1);
	xd->w = MM_PER_INCH * w;
	xd->h =  MM_PER_INCH * h;
	xd->gawin = newmetafile(buf, MM_PER_INCH * w, MM_PER_INCH * h);
	xd->kind = METAFILE;
	xd->fast = 0; /* use scalable line widths */
	if (!xd->gawin) {
	    if(ld > ls)
		warning("Unable to open metafile `%s' for writing", buf);
	    else
		warning("Unable to open clipboard to write metafile");
	    return FALSE;
	}
    }
    xd->truedpi = devicepixelsy(xd->gawin);
    if ((xd->kind == PNG) || (xd->kind == JPEG) || (xd->kind == BMP))
      xd->wanteddpi = 72 ;
    else
      xd->wanteddpi = xd->truedpi;
    if (!SetBaseFont(xd)) {
	warning("can't find any fonts");
	del(xd->gawin);
	if (xd->kind == SCREEN) del(xd->bm);
	return FALSE;
    }
    rr = getrect(xd->gawin);
    xd->origWidth = xd->showWidth = xd->windowWidth = rr.width;
    xd->origHeight = xd->showHeight = xd->windowHeight = rr.height;
    xd->clip = rr;
    setdata(xd->gawin, (void *) dd);
    xd->needsave = FALSE;
    return TRUE;
}
 
	/********************************************************/
	/* device_StrWidth should return the width of the given */
	/* string in DEVICE units (GStrWidth is responsible for */
	/* converting from DEVICE to whatever units the user 	*/
	/* asked for						*/
	/********************************************************/
 
static double GA_StrWidth(char *str,
			  R_GE_gcontext *gc,
			  NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    double a;
    int   size = gc->cex * gc->ps + 0.5;
 
    SetFont(gc->fontface, size, 0.0, dd);
    a = (double) gstrwidth(xd->gawin, xd->font, str);
    return a;
}
 
 
	/********************************************************/
	/* device_MetricInfo should return height, depth, and 	*/
	/* width information for the given character in DEVICE	*/
	/* units (GMetricInfo does the necessary conversions)	*/
	/* This is used for formatting mathematical expressions	*/
	/********************************************************/
 
	/* Character Metric Information */
	/* Passing c == 0 gets font information */
 
static void GA_MetricInfo(int c,
			  R_GE_gcontext *gc,
			  double* ascent, double* descent,
			  double* width, NewDevDesc *dd)
{
    int   a, d, w;
    int   size = gc->cex * gc->ps + 0.5;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    SetFont(gc->fontface, size, 0.0, dd);
    gcharmetric(xd->gawin, xd->font, c, &a, &d, &w);
    /* Some Windows systems report that space has height and depth,
       so we have a kludge.  Note that 32 is space in symbol font too */
    if(c == 32) {
	*ascent  = 0.0;
	*descent = 0.0;
	*width   = (double) w;
 
    } else {
	*ascent  = (double) a;
	*descent = (double) d;
	*width   = (double) w;
    }
}
 
	/********************************************************/
	/* device_Clip is given the left, right, bottom, and 	*/
	/* top of a rectangle (in DEVICE coordinates).  it 	*/
	/* should have the side-effect that subsequent output	*/
	/* is clipped to the given rectangle			*/
	/********************************************************/
 
static void GA_Clip(double x0, double x1, double y0, double y1, NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    xd->clip = rcanon(rpt(pt(x0, y0), pt(x1, y1)));
    xd->clip.width  += 1;
    xd->clip.height += 1;
}
 
	/********************************************************/
	/* device_Resize is called whenever the device is 	*/
	/* resized.  the function must update the GPar 		*/
	/* parameters (left, right, bottom, and top) for the 	*/
	/* new device size					*/
	/* this is not usually called directly by the graphics	*/
	/* engine because the detection of device resizes	*/
	/* (e.g., a window resize) are usually detected by	*/
	/* device-specific code	(see R_ProcessEvents in ./system.c)*/
	/********************************************************/
 
static void GA_Size(double *left, double *right,
		     double *bottom, double *top,
		     NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    int   iw, ih;
 
    iw = xd->windowWidth;
    ih = xd->windowHeight;
    *left = 0.0;
    *top = 0.0;
    *right = iw;
    *bottom = ih;
}
 
static void GA_Resize(NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    SEXP scale;
    PROTECT(scale = allocVector(REALSXP, 1));
    if (xd->resize) {
	int   iw, ih, iw0 = dd->right - dd->left,
	    ih0 = dd->bottom - dd->top;
	double fw, fh, rf, shift;
 
	iw = xd->windowWidth;
	ih = xd->windowHeight;
	if(xd->resizing == 1) {
	    /* last mode might have been 3, so remove scrollbars */
	    gchangescrollbar(xd->gawin, VWINSB, 0, ih/SF-1, ih/SF, 0);
	    gchangescrollbar(xd->gawin, HWINSB, 0, iw/SF-1, iw/SF, 0);
	    dd->left = 0.0;
	    dd->top = 0.0;
	    dd->right = iw;
	    dd->bottom = ih;
	    xd->showWidth = iw;
	    xd->showHeight =  ih;
	} else if (xd->resizing == 2) {
	    /* last mode might have been 3, so remove scrollbars */
	    gchangescrollbar(xd->gawin, VWINSB, 0, ih/SF-1, ih/SF, 0);
	    gchangescrollbar(xd->gawin, HWINSB, 0, iw/SF-1, iw/SF, 0);
	    fw = (iw + 0.5)/(iw0 + 0.5);
	    fh = (ih + 0.5)/(ih0 + 0.5);
	    rf = min(fw, fh);
	    xd->rescale_factor *= rf;
	    xd->wanteddpi = xd->rescale_factor * xd->truedpi;
	    /* dd->ps *= rf; dd->cra[0] *= rf; dd->cra[1] *= rf; */
	    REAL(scale)[0] = rf;
	    GEHandleEvent(GE_ScalePS, dd, scale);
	    if (fw < fh) {
		dd->left = 0.0;
		xd->showWidth = dd->right = iw;
		xd->showHeight =  ih0*fw;
		shift = (ih - xd->showHeight)/2.0;
		dd->top = shift;
		dd->bottom = ih0*fw + shift;
		xd->xshift = 0; xd->yshift = shift;
	    } else {
		dd->top = 0.0;
		xd->showHeight = dd->bottom = ih;
		xd->showWidth = iw0*fh;
		shift = (iw - xd->showWidth)/2.0;
		dd->left = shift;
		dd->right = iw0*fh + shift;
		xd->xshift = shift; xd->yshift = 0;
	    }
	    xd->clip = getregion(xd);
	} else if (xd->resizing == 3) {
	    if(iw0 < iw) shift = (iw - iw0)/2.0;
	    else shift = min(0, xd->xshift);
	    dd->left = shift;
	    dd->right = iw0 + shift;
	    xd->xshift = shift;
	    gchangescrollbar(xd->gawin, HWINSB, max(-shift,0)/SF,
			     xd->origWidth/SF - 1, xd->windowWidth/SF, 0);
	    if(ih0 < ih) shift = (ih - ih0)/2.0;
	    else shift = min(0, xd->yshift);
	    dd->top = shift;
	    dd->bottom = ih0 + shift;
	    xd->yshift = shift;
	    gchangescrollbar(xd->gawin, VWINSB, max(-shift,0)/SF,
			     xd->origHeight/SF - 1, xd->windowHeight/SF, 0);
	    xd->showWidth = xd->origWidth + min(0, xd->xshift);
	    xd->showHeight = xd->origHeight + min(0,  xd->yshift);
	}
	xd->resize = FALSE;
	if (xd->kind == SCREEN) {
	    del(xd->bm);
	    xd->bm = newbitmap(iw, ih, getdepth(xd->gawin));
	    if (!xd->bm) {
		R_ShowMessage("Insufficient memory for resize. Killing device");
		KillDevice(GetDevice(devNumber((DevDesc*) dd)));
	    }
	    gfillrect(xd->gawin, xd->outcolor, getrect(xd->gawin));
	    gfillrect(xd->bm, xd->outcolor, getrect(xd->bm));
	}
    }
    UNPROTECT(1);
}
 
	/********************************************************/
	/* device_NewPage is called whenever a new plot requires*/
	/* a new page.  a new page might mean just clearing the	*/
	/* device (as in this case) or moving to a new page	*/
	/* (e.g., postscript)					*/
	/********************************************************/
 
static void GA_NewPage(R_GE_gcontext *gc,
		       NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    xd->npage++;
    if ((xd->kind == PRINTER) && xd->needsave)
	nextpage(xd->gawin);
    if ((xd->kind == METAFILE) && xd->needsave) {
	char buf[600];
	if (strlen(xd->filename) == 0)
	    error("A clipboard metafile can store only one figure.");
	else {
	    del(xd->gawin);
	    snprintf(buf, 600, xd->filename, xd->npage);
	    xd->gawin = newmetafile(buf, xd->w, xd->h);
	}
    }
    if ((xd->kind == PNG || xd->kind == JPEG || xd->kind == BMP)
	&& xd->needsave) {
	char buf[600];
	SaveAsBitmap(dd);
	snprintf(buf, 600, xd->filename, xd->npage);
	if ((xd->fp = fopen(buf, "wb")) == NULL)
	    error("Unable to open file `%s' for writing", buf);
    }
    if (xd->kind == SCREEN) {
        if(xd->buffered) SHOW;
#ifdef PLOTHISTORY
	if (xd->recording && xd->needsave)
	    AddtoPlotHistory(dd->savedSnapshot, 0);
	if (xd->replaying)
	    xd->needsave = FALSE;
	else
	    xd->needsave = TRUE;
#endif
    }
    xd->bg = gc->fill;
    if (!R_OPAQUE(xd->bg))
	xd->bgcolor = xd->canvascolor;
    else
	xd->bgcolor = GArgb(xd->bg, gc->gamma);
    if (xd->kind != SCREEN) {
	xd->needsave = TRUE;
	xd->clip = getrect(xd->gawin);
	if(R_OPAQUE(xd->bg) || xd->kind == PNG ||
	   xd->kind == BMP || xd->kind == JPEG )
	    DRAW(gfillrect(_d, R_OPAQUE(xd->bg) ? xd->bgcolor : PNG_TRANS,
			   xd->clip));
	if(xd->kind == PNG) xd->pngtrans = ggetpixel(xd->gawin, pt(0,0));
    } else {
	xd->clip = getregion(xd);
	DRAW(gfillrect(_d, xd->bgcolor, xd->clip));
    }
    SH;
}
 
	/********************************************************/
	/* device_Close is called when the device is killed	*/
	/* this function is responsible for destroying any 	*/
	/* device-specific resources that were created in	*/
	/* device_Open and for FREEing the device-specific	*/
	/* parameters structure					*/
	/********************************************************/
 
static void GA_Close(NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    GEDevDesc *gdd = (GEDevDesc *) GetDevice(devNumber((DevDesc*) dd));
    GETDL;
 
    if (xd->kind == SCREEN) {
	if(xd->recording) {
	    AddtoPlotHistory(GEcreateSnapshot(gdd), 0);
	    pCURRENTPOS++; /* so PgUp goes to the last saved plot
			      when a windows() device is opened */
	}
	hide(xd->gawin);
	del(xd->bm);
	if (xd == GA_xd) GA_xd = NULL;
    } else if ((xd->kind == PNG) || (xd->kind == JPEG) || (xd->kind == BMP)) {
      SaveAsBitmap(dd);
    }
    del(xd->font);
    del(xd->gawin);
/*
 * this is needed since the GraphApp delayed clean-up
 * ,i.e, I want free all resources NOW
 */
    doevent();
    free(xd);
}
 
	/********************************************************/
	/* device_Activate is called when a device becomes the 	*/
	/* active device.  in this case it is used to change the*/
	/* title of a window to indicate the active status of 	*/
	/* the device to the user.  not all device types will 	*/
	/* do anything						*/
	/********************************************************/
 
static unsigned char title[20] = "R Graphics";
 
static void GA_Activate(NewDevDesc *dd)
{
    char  t[50];
    char  num[3];
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->replaying || (xd->kind!=SCREEN))
	return;
    strcpy(t, (char *) title);
    strcat(t, ": Device ");
    sprintf(num, "%i", devNumber((DevDesc*) dd) + 1);
    strcat(t, num);
    strcat(t, " (ACTIVE)");
    settext(xd->gawin, t);
}
 
	/********************************************************/
	/* device_Deactivate is called when a device becomes	*/
	/* inactive.  in this case it is used to change the 	*/
	/* title of a window to indicate the inactive status of */
	/* the device to the user.  not all device types will	*/
	/* do anything						*/
	/********************************************************/
 
static void GA_Deactivate(NewDevDesc *dd)
{
    char  t[50];
    char  num[3];
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->replaying || (xd->kind != SCREEN))
	return;
    strcpy(t, (char *) title);
    strcat(t, ": Device ");
    sprintf(num, "%i", devNumber((DevDesc*) dd) + 1);
    strcat(t, num);
    strcat(t, " (inactive)");
    settext(xd->gawin, t);
}
 
	/********************************************************/
	/* device_Rect should have the side-effect that a 	*/
	/* rectangle is drawn with the given locations for its 	*/
	/* opposite corners.  the border of the rectangle	*/
	/* should be in the given "fg" colour and the rectangle	*/
	/* should be filled with the given "bg" colour		*/
	/* if "fg" is NA_INTEGER then no border should be drawn */
	/* if "bg" is NA_INTEGER then the rectangle should not 	*/
	/* be filled						*/
	/* the locations are in an arbitrary coordinate system	*/
	/* and this function is responsible for converting the	*/
	/* locations to DEVICE coordinates using GConvert	*/
	/********************************************************/
 
static void GA_Rect(double x0, double y0, double x1, double y1,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd)
{
    int   tmp;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    rect  r;
 
    /* These in-place conversions are ok */
    TRACEDEVGA("rect");
 
    if (x0 > x1) {
	tmp = x0;
	x0 = x1;
	x1 = tmp;
    }
    if (y0 > y1) {
	tmp = y0;
	y0 = y1;
	y1 = tmp;
    }
    r = rect((int) x0, (int) y0, (int) x1 - (int) x0, (int) y1 - (int) y0);
    if (R_OPAQUE(gc->fill)) {
	SetColor(gc->fill, gc->gamma, dd);
	DRAW(gfillrect(_d, xd->fgcolor, r));
 
    }
    if (R_OPAQUE(gc->col)) {
	SetColor(gc->col, gc->gamma, dd);
	SetLinetype(gc->lty, gc->lwd, dd);
	DRAW(gdrawrect(_d, xd->lwd, xd->lty, xd->fgcolor, r, 0));
    }
    SH;
}
 
	/********************************************************/
	/* device_Circle should have the side-effect that a	*/
	/* circle is drawn, centred at the given location, with */
	/* the given radius.  the border of the circle should be*/
	/* drawn in the given "col", and the circle should be	*/
	/* filled with the given "border" colour.		*/
	/* if "col" is NA_INTEGER then no border should be drawn*/
	/* if "border" is NA_INTEGER then the circle should not */
	/* be filled						*/
	/* the location is in arbitrary coordinates and the 	*/
	/* function is responsible for converting this to	*/
	/* DEVICE coordinates.  the radius is given in DEVICE	*/
	/* coordinates						*/
	/********************************************************/
 
static void GA_Circle(double x, double y, double r,
		      R_GE_gcontext *gc,
		      NewDevDesc *dd)
{
    int   ir, ix, iy;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    rect  rr;
 
    TRACEDEVGA("circle");
    ir = floor(r + 0.5);
    if (ir < 1) ir = 1;
    /* In-place conversion ok */
 
    ix = (int) x;
    iy = (int) y;
    rr = rect(ix - ir, iy - ir, 2 * ir, 2 * ir);
    if (R_OPAQUE(gc->fill)) {
	SetColor(gc->fill, gc->gamma, dd);
	DRAW(gfillellipse(_d, xd->fgcolor, rr));
    }
    if (R_OPAQUE(gc->col)) {
	SetLinetype(gc->lty, gc->lwd, dd);
	SetColor(gc->col, gc->gamma, dd);
	DRAW(gdrawellipse(_d, xd->lwd, xd->fgcolor, rr, 0));
    }
    SH;
}
 
	/********************************************************/
	/* device_Line should have the side-effect that a single*/
	/* line is drawn (from x1,y1 to x2,y2)			*/
	/* x1, y1, x2, and y2 are in arbitrary coordinates and	*/
	/* the function is responsible for converting them to	*/
	/* DEVICE coordinates using GConvert			*/
	/********************************************************/
 
static void GA_Line(double x1, double y1, double x2, double y2,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd)
{
    int   xx1, yy1, xx2, yy2;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    /* In-place conversion ok */
    TRACEDEVGA("line");
    xx1 = (int) x1;
    yy1 = (int) y1;
    xx2 = (int) x2;
    yy2 = (int) y2;
 
    if (R_OPAQUE(gc->col)) {
	SetColor(gc->col, gc->gamma, dd);
	SetLinetype(gc->lty, gc->lwd, dd);
	DRAW(gdrawline(_d, xd->lwd, xd->lty, xd->fgcolor,
		       pt(xx1, yy1), pt(xx2, yy2), 0));
	SH;
    }
}
 
	/********************************************************/
	/* device_Polyline should have the side-effect that a	*/
	/* series of line segments are drawn using the given x	*/
	/* and y values						*/
	/* the x and y values are in arbitrary coordinates and	*/
	/* the function is responsible for converting them to	*/
	/* DEVICE coordinates using GConvert			*/
	/********************************************************/
 
static void GA_Polyline(int n, double *x, double *y,
			R_GE_gcontext *gc,
			NewDevDesc *dd)
{
    char *vmax = vmaxget();
    point *p = (point *) R_alloc(n, sizeof(point));
    double devx, devy;
    int   i;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    TRACEDEVGA("pl");
    for (i = 0; i < n; i++) {
	devx = x[i];
	devy = y[i];
	p[i].x = (int) devx;
	p[i].y = (int) devy;
    }
    if (R_OPAQUE(gc->col)) {
	SetColor(gc->col, gc->gamma, dd);
	SetLinetype(gc->lty, gc->lwd, dd);
	DRAW(gdrawpolyline(_d, xd->lwd, xd->lty, xd->fgcolor, p, n, 0, 0));
    }
    vmaxset(vmax);
    SH;
}
 
	/********************************************************/
	/* device_Polygon should have the side-effect that a 	*/
	/* polygon is drawn using the given x and y values	*/
	/* the polygon border should be drawn in the "fg" 	*/
	/* colour and filled with the "bg" colour		*/
	/* if "fg" is NA_INTEGER don't draw the border		*/
	/* if "bg" is NA_INTEGER don't fill the polygon		*/
	/* the x and y values are in arbitrary coordinates and 	*/
	/* the function is responsible for converting them to 	*/
	/* DEVICE coordinates using GConvert			*/
	/********************************************************/
 
static void GA_Polygon(int n, double *x, double *y,
		       R_GE_gcontext *gc,
		       NewDevDesc *dd)
{
    char *vmax = vmaxget();
    point *points;
    double devx, devy;
    int   i;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    TRACEDEVGA("plg");
    points = (point *) R_alloc(n , sizeof(point));
    if (!points)
	return;
    for (i = 0; i < n; i++) {
	devx = x[i];
	devy = y[i];
	points[i].x = (int) (devx);
	points[i].y = (int) (devy);
    }
    if (R_OPAQUE(gc->fill)) {
	SetColor(gc->fill, gc->gamma, dd);
	DRAW(gfillpolygon(_d, xd->fgcolor, points, n));
    }
    if (R_OPAQUE(gc->col)) {
	SetColor(gc->col, gc->gamma, dd);
	SetLinetype(gc->lty, gc->lwd, dd);
	DRAW(gdrawpolygon(_d, xd->lwd, xd->lty, xd->fgcolor, points, n, 0 ));
    }
    vmaxset(vmax);
    SH;
}
 
 
	/********************************************************/
	/* device_Text should have the side-effect that the 	*/
	/* given text is drawn at the given location		*/
	/* the text should be rotated according to rot (degrees)*/
	/* the location is in an arbitrary coordinate system	*/
	/* and this function is responsible for converting the	*/
	/* location to DEVICE coordinates using GConvert	*/
	/********************************************************/
 
 
static void GA_Text(double x, double y, char *str,
		    double rot, double hadj,
		    R_GE_gcontext *gc,
		    NewDevDesc *dd)
{
    int   size;
    double pixs, xl, yl, rot1;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    size = gc->cex * gc->ps + 0.5;
    pixs = - 1;
    xl = 0.0;
    yl = -pixs;
    rot1 = rot * DEG2RAD;
    x += -xl * cos(rot1) + yl * sin(rot1);
    y -= -xl * sin(rot1) - yl * cos(rot1);
    SetFont(gc->fontface, size, rot, dd);
    SetColor(gc->col, gc->gamma, dd);
    if (R_OPAQUE(xd->fgcolor)) {
#ifdef NOCLIPTEXT
	gsetcliprect(xd->gawin, getrect(xd->gawin));
	gdrawstr1(xd->gawin, xd->font, xd->fgcolor, pt(x, y), str, hadj);
	if (xd->kind==SCREEN) {
	    gsetcliprect(xd->bm, getrect(xd->bm));
	    gdrawstr1(xd->bm, xd->font, xd->fgcolor, pt(x, y), str, hadj);
	}
#else
	DRAW(gdrawstr1(_d, xd->font, xd->fgcolor, pt(x, y), str, hadj));
#endif
    }
    SH;
}
 
	/********************************************************/
	/* device_Locator should return the location of the next*/
	/* mouse click (in DEVICE coordinates;  GLocator is	*/
	/* responsible for any conversions)			*/
	/* not all devices will do anything (e.g., postscript)	*/
	/********************************************************/
 
static Rboolean GA_Locator(double *x, double *y, NewDevDesc *dd)
{
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (xd->kind != SCREEN)
	return FALSE;
    xd->locator = TRUE;
    xd->clicked = 0;
    show(xd->gawin);
    addto(xd->gawin);
    gchangemenubar(xd->mbarloc);
    if (xd->stoploc) {
      show(xd->stoploc);
      show(xd->gawin);
    }
    gchangepopup(xd->gawin, xd->locpopup);
    gsetcursor(xd->gawin, CrossCursor);
    setstatus("Locator is active");
    while (!xd->clicked) {
	if(xd->buffered) SHOW;
        WaitMessage();
	R_ProcessEvents();
    }
    addto(xd->gawin);
    gchangemenubar(xd->mbar);
    if (xd->stoploc) {
      hide(xd->stoploc);
      show(xd->gawin);
    }
    gsetcursor(xd->gawin, ArrowCursor);
    gchangepopup(xd->gawin, xd->grpopup);
    addto(xd->gawin);
    setstatus("R Graphics");
    xd->locator = FALSE;
    if (xd->clicked == 1) {
	*x = xd->px;
	*y = xd->py;
	return TRUE;
    } else
	return FALSE;
}
 
	/********************************************************/
	/* device_Mode is called whenever the graphics engine 	*/
	/* starts drawing (mode=1) or stops drawing (mode=1)	*/
	/* the device is not required to do anything		*/
	/********************************************************/
 
/* Set Graphics mode - not needed for X11 */
static void GA_Mode(int mode, NewDevDesc *dd)
{
}
 
	/********************************************************/
	/* i don't know what this is for and i can't find it	*/
	/* being used anywhere, but i'm loath to kill it in	*/
	/* case i'm missing something important			*/
	/********************************************************/
 
/* Hold the Picture Onscreen - not needed for X11 */
static void GA_Hold(NewDevDesc *dd)
{
}
 
 
	/********************************************************/
	/* the device-driver entry point is given a device 	*/
	/* description structure that it must set up.  this 	*/
	/* involves several important jobs ...			*/
	/* (1) it must ALLOCATE a new device-specific parameters*/
	/* structure and FREE that structure if anything goes	*/
	/* wrong (i.e., it won't report a successful setup to	*/
	/* the graphics engine (the graphics engine is NOT	*/
	/* responsible for allocating or freeing device-specific*/
	/* resources or parameters)				*/
	/* (2) it must initialise the device-specific resources */
	/* and parameters (mostly done by calling device_Open)	*/
	/* (3) it must initialise the generic graphical 	*/
	/* parameters that are not initialised by GInit (because*/
	/* only the device knows what values they should have)	*/
	/* see Graphics.h for the official list of these	*/
	/* (4) it may reset generic graphics parameters that	*/
	/* have already been initialised by GInit (although you	*/
	/* should know what you are doing if you do this)	*/
	/* (5) it must attach the device-specific parameters	*/
        /* structure to the device description structure	*/
	/* e.g., dd->deviceSpecific = (void *) xd;		*/
	/* (6) it must FREE the overall device description if 	*/
	/* it wants to bail out to the top-level		*/
	/* the graphics engine is responsible for allocating 	*/
	/* the device description and freeing it in most cases	*/
	/* but if the device driver freaks out it needs to do 	*/
	/* the clean-up itself					*/
	/********************************************************/
 
 
 
Rboolean GADeviceDriver(NewDevDesc *dd, char *display, double width,
			double height, double pointsize,
			Rboolean recording, int resize, int canvas,
			double gamma, int xpos, int ypos, Rboolean buffered,
			SEXP psenv)
{
    /* if need to bail out with some sort of "error" then */
    /* must free(dd) */
 
    int   ps;
    gadesc *xd;
    rect  rr;
    int a=0, d=0, w=0;
 
    /* allocate new device description */
    if (!(xd = (gadesc *) malloc(sizeof(gadesc))))
	return FALSE;
 
    /* from here on, if need to bail out with "error", must also */
    /* free(xd) */
 
    /* Font will load at first use  */
 
    ps = pointsize;
    if (ps < 6 || ps > 48)
	ps = 12;
    ps = 2 * (ps / 2);
    xd->fontface = -1;
    xd->fontsize = -1;
    xd->basefontsize = ps ;
    dd->startfont = 1;
    dd->startps = ps;
    dd->startlty = LTY_SOLID;
    dd->startgamma = gamma;
 
    /* Start the Device Driver and Hardcopy.  */
 
    if (!GA_Open(dd, xd, display, width, height, recording, resize, canvas,
		 gamma, xpos, ypos)) {
	free(xd);
	return FALSE;
    }
    dd->deviceSpecific = (void *) xd;
    /* Set up Data Structures  */
 
    dd->newDevStruct = 1;
 
    dd->open = GA_Open;
    dd->close = GA_Close;
    dd->activate = GA_Activate;
    dd->deactivate = GA_Deactivate;
    dd->size = GA_Size;
    dd->newPage = GA_NewPage;
    dd->clip = GA_Clip;
    dd->strWidth = GA_StrWidth;
    dd->text = GA_Text;
    dd->rect = GA_Rect;
    dd->circle = GA_Circle;
    dd->line = GA_Line;
    dd->polyline = GA_Polyline;
    dd->polygon = GA_Polygon;
    dd->locator = GA_Locator;
    dd->mode = GA_Mode;
    dd->hold = GA_Hold;
    dd->metricInfo = GA_MetricInfo;
 
    /* set graphics parameters that must be set by device driver */
    /* Window Dimensions in Pixels */
    rr = getrect(xd->gawin);
    dd->left = (xd->kind == PRINTER) ? rr.x : 0;	/* left */
    dd->right = dd->left + rr.width - 0.0001;	/* right */
    dd->top = (xd->kind == PRINTER) ? rr.y : 0;	/* top */
    dd->bottom = dd->top + rr.height - 0.0001;	/* bottom */
 
    if (resize == 3) { /* might have got a shrunken window */
	int iw = width/pixelWidth(NULL) + 0.5,
	    ih = height/pixelHeight(NULL) + 0.5;
	xd->origWidth = dd->right = iw;
	xd->origHeight = dd->bottom = ih;
    }
 
    /* Nominal Character Sizes in Pixels */
    gcharmetric(xd->gawin, xd->font, -1, &a, &d, &w);
    dd->cra[0] = w * xd->rescale_factor;
    dd->cra[1] = (a + d) * xd->rescale_factor;
    /* Set basefont to full size: now allow for initial re-scale */
    xd->wanteddpi = xd->truedpi * xd->rescale_factor;
 
    /* Character Addressing Offsets */
    /* These are used to plot a single plotting character */
    /* so that it is exactly over the plotting point */
 
    dd->xCharOffset = 0.50;
    dd->yCharOffset = 0.40;
    dd->yLineBias = 0.1;
 
    /* Inches per raster unit */
 
    if (R_finite(user_xpinch) && user_xpinch > 0.0)
	dd->ipr[0] = 1.0/user_xpinch;
    else
	dd->ipr[0] = pixelWidth(xd->gawin);
    if (R_finite(user_ypinch) && user_ypinch > 0.0)
	dd->ipr[1] = 1.0/user_ypinch;
    else
	dd->ipr[1] = pixelHeight(xd->gawin);
 
    /* Device capabilities */
    /* Clipping is problematic for X11 */
    /* Graphics is clipped, text is not */
 
    dd->canResizePlot= TRUE;
    dd->canChangeFont= FALSE;
    dd->canRotateText= TRUE;
    dd->canResizeText= TRUE;
    dd->canClip= TRUE;
    dd->canHAdj = 1; /* 0, 0.5, 1 */
    dd->canChangeGamma = TRUE;
 
    /* initialise device description (most of the work */
    /* has been done in GA_Open) */
 
    xd->resize = (resize == 3);
    xd->locator = FALSE;
    xd->buffered = buffered;
    xd->psenv = psenv;
    {
	SEXP timeouts = GetOption(install("windowsTimeouts"), R_NilValue);
	if(isInteger(timeouts)){
	    xd->timeafter = INTEGER(timeouts)[0];
	    xd->timesince = INTEGER(timeouts)[1];
	} else {
	    warning("option `windowsTimeouts' should be integer");
	    xd->timeafter = 100;
	    xd->timesince = 500;
	}
    }
    dd->displayListOn = (xd->kind == SCREEN);
    if (RConsole && (xd->kind!=SCREEN)) show(RConsole);
    return TRUE;
}
 
SEXP do_saveDevga(SEXP call, SEXP op, SEXP args, SEXP env)
{
    SEXP filename, type;
    char *fn, *tp, display[550];
    int device;
    NewDevDesc* dd;
 
    checkArity(op, args);
    device = asInteger(CAR(args));
    if(device < 1 || device > NumDevices())
	errorcall(call, "invalid device number");
    dd = ((GEDevDesc*) GetDevice(device - 1))->dev;
    if(!dd) errorcall(call, "invalid device");
    filename = CADR(args);
    if (!isString(filename) || LENGTH(filename) != 1)
	errorcall(call, "invalid filename argument");
    fn = CHAR(STRING_ELT(filename, 0));
    fixslash(fn);
    type = CADDR(args);
    if (!isString(type) || LENGTH(type) != 1)
	errorcall(call, "invalid type argument");
    tp = CHAR(STRING_ELT(type, 0));
 
    if(!strcmp(tp, "png")) {
	SaveAsPng(dd, fn);
    } else if (!strcmp(tp,"bmp")) {
        SaveAsBmp(dd,fn);
    } else if(!strcmp(tp, "jpeg") || !strcmp(tp,"jpg")) {
      /*Default quality suggested in libjpeg*/
        SaveAsJpeg(dd, 75, fn);
    } else if (!strcmp(tp, "wmf")) {
	if(strlen(fn) > 512) {
	    askok("file path selected is too long: only 512 bytes are allowed");
	    return R_NilValue;
	}
	sprintf(display, "win.metafile:%s", fn);
	SaveAsWin(dd, display);
    } else if (!strcmp(tp, "ps")) {
	SaveAsPostscript(dd, fn);
    } else if (!strcmp(tp, "pdf")) {
	SaveAsPDF(dd, fn);
    } else
	errorcall(call, "unknown type");
    return R_NilValue;
}
 
 
/* Rbitmap  */
#define BITMAP_DLL_NAME "\\BIN\\RBITMAP.DLL\0"
typedef int (*R_SaveAsBitmap)();
static R_SaveAsBitmap R_SaveAsPng, R_SaveAsJpeg, R_SaveAsBmp;
static int RbitmapAlreadyLoaded = 0;
static HINSTANCE hRbitmapDll;
 
static int Load_Rbitmap_Dll()
{
    if (!RbitmapAlreadyLoaded) {
	char szFullPath[PATH_MAX];
	strcpy(szFullPath, R_HomeDir());
	strcat(szFullPath, BITMAP_DLL_NAME);
	if (((hRbitmapDll = LoadLibrary(szFullPath)) != NULL) &&
	    ((R_SaveAsPng=
	      (R_SaveAsBitmap)GetProcAddress(hRbitmapDll, "R_SaveAsPng"))
	     != NULL) &&
	    ((R_SaveAsBmp=
	      (R_SaveAsBitmap)GetProcAddress(hRbitmapDll, "R_SaveAsBmp"))
	     != NULL) &&
	    ((R_SaveAsJpeg=
	      (R_SaveAsBitmap)GetProcAddress(hRbitmapDll, "R_SaveAsJpeg"))
	     != NULL)) {
	    RbitmapAlreadyLoaded = 1;
	} else {
	    if (hRbitmapDll != NULL) FreeLibrary(hRbitmapDll);
	    RbitmapAlreadyLoaded= -1;
	}
    }
    return (RbitmapAlreadyLoaded>0);
}
 
void UnLoad_Rbitmap_Dll()
{
    if (RbitmapAlreadyLoaded) FreeLibrary(hRbitmapDll);
    RbitmapAlreadyLoaded = 0;
}
 
static int png_rows = 0;
 
static unsigned long privategetpixel2(void *d,int i, int j)
{
    rgb c;
    c = ((rgb *)d)[i*png_rows + j];
    return c;
}
 
/* This is the device version */
static void SaveAsBitmap(NewDevDesc *dd)
{
    rect r, r2;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
    unsigned char *data;
 
    r = ggetcliprect(xd->gawin);
    gsetcliprect(xd->gawin, r2 = getrect(xd->gawin));
    if(xd->fp) {
	getbitmapdata2(xd->gawin, &data);
	if(data) {
	    png_rows = r2.width;
	    if (xd->kind == PNG)
		R_SaveAsPng(data, xd->windowWidth, xd->windowHeight,
			    privategetpixel2, 0, xd->fp,
			    R_OPAQUE(xd->bg) ? 0 : xd->pngtrans) ;
	    else if (xd->kind == JPEG)
		R_SaveAsJpeg(data, xd->windowWidth, xd->windowHeight,
			     privategetpixel2, 0, xd->quality, xd->fp) ;
	    else
		R_SaveAsBmp(data, xd->windowWidth, xd->windowHeight,
			    privategetpixel2, 0, xd->fp);
	    free(data);
	} else
	    warning("processing of the plot ran out of memory");
	fclose(xd->fp);
    }
    gsetcliprect(xd->gawin, r);
    xd->fp = NULL;
}
 
/* These are the menu item versions */
static void SaveAsPng(NewDevDesc *dd,char *fn)
{
    FILE *fp;
    rect r, r2;
    unsigned char *data;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (!Load_Rbitmap_Dll()) {
	R_ShowMessage("Impossible to load Rbitmap.dll");
	return;
    }
    if ((fp=fopen(fn, "wb")) == NULL) {
	char msg[MAX_PATH+32];
 
	strcpy(msg, "Impossible to open ");
	strncat(msg, fn, MAX_PATH);
	R_ShowMessage(msg);
	return;
    }
    r = ggetcliprect(xd->bm);
    gsetcliprect(xd->bm, r2 = getrect(xd->bm));
    getbitmapdata2(xd->bm, &data);
    if(data) {
	png_rows = r2.width;
	R_SaveAsPng(data, xd->windowWidth, xd->windowHeight,
		    privategetpixel2, 0, fp, 0) ;
	free(data);
    } else
	warning("processing of the plot ran out of memory");
    /* R_OPAQUE(xd->bg) ? 0 : xd->canvascolor) ; */
    gsetcliprect(xd->bm, r);
    fclose(fp);
}
 
static void SaveAsJpeg(NewDevDesc *dd,int quality,char *fn)
{
    FILE *fp;
    rect r, r2;
    unsigned char *data;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (!Load_Rbitmap_Dll()) {
	R_ShowMessage("Impossible to load Rbitmap.dll");
	return;
    }
    if ((fp=fopen(fn,"wb")) == NULL) {
	char msg[MAX_PATH+32];
	strcpy(msg, "Impossible to open ");
	strncat(msg, fn, MAX_PATH);
	R_ShowMessage(msg);
	return;
    }
    r = ggetcliprect(xd->bm);
    gsetcliprect(xd->bm, r2 = getrect(xd->bm));
    getbitmapdata2(xd->bm, &data);
    if(data) {
	png_rows = r2.width;
	R_SaveAsJpeg(data,xd->windowWidth, xd->windowHeight,
		     privategetpixel2, 0, quality, fp) ;
	free(data);
    } else
	warning("processing of the plot ran out of memory");
    gsetcliprect(xd->bm, r);
    fclose(fp);
}
 
 
static void SaveAsBmp(NewDevDesc *dd,char *fn)
{
    FILE *fp;
    rect r, r2;
    unsigned char *data;
    gadesc *xd = (gadesc *) dd->deviceSpecific;
 
    if (!Load_Rbitmap_Dll()) {
	R_ShowMessage("Impossible to load Rbitmap.dll");
	return;
    }
    if ((fp=fopen(fn, "wb")) == NULL) {
	char msg[MAX_PATH+32];
 
	strcpy(msg, "Impossible to open ");
	strncat(msg, fn, MAX_PATH);
	R_ShowMessage(msg);
	return;
    }
    r = ggetcliprect(xd->bm);
    gsetcliprect(xd->bm, r2 = getrect(xd->bm));
 
    getbitmapdata2(xd->bm, &data);
    if(data) {
	png_rows = r2.width;
	R_SaveAsBmp(data, xd->windowWidth, xd->windowHeight,
		    privategetpixel2, 0, fp) ;
	free(data);
    } else
	warning("processing of the plot ran out of memory");
    gsetcliprect(xd->bm, r);
    fclose(fp);
}
 
#include "Startup.h"
extern UImode CharacterMode;
 
SEXP do_bringtotop(SEXP call, SEXP op, SEXP args, SEXP env)
{
    int dev, stay;
    GEDevDesc *gdd;
    gadesc *xd;
 
    checkArity(op, args);
    dev = asInteger(CAR(args));
    stay = asInteger(CADR(args));
 
    if(dev == -1) { /* console */
	if(CharacterMode == RGui) BringToTop(RConsole, stay);
    } else {
	if(dev < 1 || dev > R_MaxDevices || dev == NA_INTEGER)
	    errorcall(call, "invalid value of `which'");
	gdd = (GEDevDesc *) GetDevice(dev - 1);
	if(!gdd) errorcall(call, "invalid device");
	xd = (gadesc *) gdd->dev->deviceSpecific;
	if(!xd) errorcall(call, "invalid device");
	if(stay && ismdi()) error("requires SDI mode");
	BringToTop(xd->gawin, stay);
    }
    return R_NilValue;
}

Rev 27662	Rev 27686
1	`/*`	1	`/*`
2	`* R : A Computer Langage for Statistical Data Analysis`	2	`* R : A Computer Langage for Statistical Data Analysis`
3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`	3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`
4	`* Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley`	4	`* Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley`
5	`*`	5	`*`
6	`* This program is free software; you can redistribute it and/or modify`	6	`* This program is free software; you can redistribute it and/or modify`
7	`* it under the terms of the GNU General Public License as published by`	7	`* it under the terms of the GNU General Public License as published by`
8	`* the Free Software Foundation; either version 2 of the License, or`	8	`* the Free Software Foundation; either version 2 of the License, or`
9	`* (at your option) any later version.`	9	`* (at your option) any later version.`
10	`*`	10	`*`
11	`* This program is distributed in the hope that it will be useful,`	11	`* This program is distributed in the hope that it will be useful,`
12	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`	12	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`
13	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`	13	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
14	`* GNU General Public License for more details.`	14	`* GNU General Public License for more details.`
15	`*`	15	`*`
16	`* You should have received a copy of the GNU General Public License`	16	`* You should have received a copy of the GNU General Public License`
17	`* along with this program; if not, write to the Free Software`	17	`* along with this program; if not, write to the Free Software`
18	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`	18	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`
19	`*/`	19	`*/`
20		20
21	`/*--- Device Driver for Windows; this file started from`	21	`/*--- Device Driver for Windows; this file started from`
22	`* ../unix/X11/devX11.c --`	22	`* ../unix/X11/devX11.c --`
23	`*/`	23	`*/`
24		24
25	`#ifdef HAVE_CONFIG_H`	25	`#ifdef HAVE_CONFIG_H`
26	`#include <config.h>`	26	`#include <config.h>`
27	`#endif`	27	`#endif`
28		28
29	`#include <Defn.h>`	29	`#include <Defn.h>`
30	`#include <Graphics.h>`	30	`#include <Graphics.h>`
31	`#include <Rdevices.h>`	31	`#include <Rdevices.h>`
32	`#include <stdio.h>`	32	`#include <stdio.h>`
33	`#include "opt.h"`	33	`#include "opt.h"`
34	`#include "graphapp/ga.h"`	34	`#include "graphapp/ga.h"`
35	`#include "graphapp/stdimg.h"`	35	`#include "graphapp/stdimg.h"`
36	`#include "console.h"`	36	`#include "console.h"`
37	`#include "rui.h"`	37	`#include "rui.h"`
38	`#include "devga.h" /* 'Public' routines from here */`	38	`#include "devga.h" /* 'Public' routines from here */`
39	`#include "windows.h"`	39	`#include "windows.h"`
40		40
41	`extern console RConsole;`	41	`extern console RConsole;`
42	`extern Rboolean AllDevicesKilled;`	42	`extern Rboolean AllDevicesKilled;`
43		43
44	`int graphicsx = -25, graphicsy = 0;`	44	`int graphicsx = -25, graphicsy = 0;`
45		45
46	`/* a colour used to represent the background on png if transparent`	46	`/* a colour used to represent the background on png if transparent`
47	`NB: used as RGB and BGR`	47	`NB: used as RGB and BGR`
48	`*/`	48	`*/`
49	`#define PNG_TRANS 0xd6d3d6`	49	`#define PNG_TRANS 0xd6d3d6`
50		50
51	`/* these really are globals: per machine, not per window */`	51	`/* these really are globals: per machine, not per window */`
52	`static double user_xpinch = 0.0, user_ypinch = 0.0;`	52	`static double user_xpinch = 0.0, user_ypinch = 0.0;`
53		53
54	`void GAsetunits(double xpinch, double ypinch)`	54	`void GAsetunits(double xpinch, double ypinch)`
55	`{`	55	`{`
56	`user_xpinch = xpinch;`	56	`user_xpinch = xpinch;`
57	`user_ypinch = ypinch;`	57	`user_ypinch = ypinch;`
58	`}`	58	`}`
59		59
60	`static rgb GArgb(int color, double gamma)`	60	`static rgb GArgb(int color, double gamma)`
61	`{`	61	`{`
62	`int r, g, b;`	62	`int r, g, b;`
63	`if (gamma != 1) {`	63	`if (gamma != 1) {`
64	`r = (int) (255 * pow(R_RED(color) / 255.0, gamma));`	64	`r = (int) (255 * pow(R_RED(color) / 255.0, gamma));`
65	`g = (int) (255 * pow(R_GREEN(color) / 255.0, gamma));`	65	`g = (int) (255 * pow(R_GREEN(color) / 255.0, gamma));`
66	`b = (int) (255 * pow(R_BLUE(color) / 255.0, gamma));`	66	`b = (int) (255 * pow(R_BLUE(color) / 255.0, gamma));`
67	`} else {`	67	`} else {`
68	`r = R_RED(color);`	68	`r = R_RED(color);`
69	`g = R_GREEN(color);`	69	`g = R_GREEN(color);`
70	`b = R_BLUE(color);`	70	`b = R_BLUE(color);`
71	`}`	71	`}`
72	`return rgb(r, g, b);`	72	`return rgb(r, g, b);`
73	`}`	73	`}`
74		74
75		75
76		76
77	`/********************************************************/`	77	`/********************************************************/`
78	`/* This device driver has been documented so that it be */`	78	`/* This device driver has been documented so that it be */`
79	`/* used as a template for new drivers */`	79	`/* used as a template for new drivers */`
80	`/********************************************************/`	80	`/********************************************************/`
81		81
82	`#define MM_PER_INCH 25.4 /* mm -> inch conversion */`	82	`#define MM_PER_INCH 25.4 /* mm -> inch conversion */`
83		83
84	`#define TRACEDEVGA(a)`	84	`#define TRACEDEVGA(a)`
85	`#define CLIP if (xd->clip.width>0) gsetcliprect(_d,xd->clip)`	85	`#define CLIP if (xd->clip.width>0) gsetcliprect(_d,xd->clip)`
86		86
87	`static drawing _d;`	87	`static drawing _d;`
88		88
89	`#define DRAW(a) {if(xd->kind != SCREEN) {_d=xd->gawin; CLIP; a;} else {_d=xd->bm; CLIP; a; if(!xd->buffered) {_d=xd->gawin; CLIP; a;} _d=xd->bm; CLIP; a;}}`	89	`#define DRAW(a) {if(xd->kind != SCREEN) {_d=xd->gawin; CLIP; a;} else {_d=xd->bm; CLIP; a; if(!xd->buffered) {_d=xd->gawin; CLIP; a;} _d=xd->bm; CLIP; a;}}`
90		90
91	`#define SHOW if(xd->kind==SCREEN) {gbitblt(xd->gawin,xd->bm,pt(0,0),getrect(xd->bm));GALastUpdate=GetTickCount();}`	91	`#define SHOW if(xd->kind==SCREEN) {gbitblt(xd->gawin,xd->bm,pt(0,0),getrect(xd->bm));GALastUpdate=GetTickCount();}`
92	`#define SH if(xd->kind==SCREEN && xd->buffered) GA_Timer(xd)`	92	`#define SH if(xd->kind==SCREEN && xd->buffered) GA_Timer(xd)`
93		93
94		94
95	`#define SF 20 /* scrollbar resolution */`	95	`#define SF 20 /* scrollbar resolution */`
96		96
97	`/********************************************************/`	97	`/********************************************************/`
98	`/* Each driver can have its own device-specic graphical */`	98	`/* Each driver can have its own device-specic graphical */`
99	`/* parameters and resources. these should be wrapped */`	99	`/* parameters and resources. these should be wrapped */`
100	`/* in a structure (like the gadesc structure below) */`	100	`/* in a structure (like the gadesc structure below) */`
101	`/* and attached to the overall device description via */`	101	`/* and attached to the overall device description via */`
102	`/* the dd->deviceSpecific pointer */`	102	`/* the dd->deviceSpecific pointer */`
103	`/* NOTE that there are generic graphical parameters */`	103	`/* NOTE that there are generic graphical parameters */`
104	`/* which must be set by the device driver, but are */`	104	`/* which must be set by the device driver, but are */`
105	`/* common to all device types (see Graphics.h) */`	105	`/* common to all device types (see Graphics.h) */`
106	`/* so go in the GPar structure rather than this device- */`	106	`/* so go in the GPar structure rather than this device- */`
107	`/* specific structure */`	107	`/* specific structure */`
108	`/********************************************************/`	108	`/********************************************************/`
109		109
110	`enum DeviceKinds {SCREEN=0, PRINTER, METAFILE, PNG, JPEG, BMP};`	110	`enum DeviceKinds {SCREEN=0, PRINTER, METAFILE, PNG, JPEG, BMP};`
111		111
112	`typedef struct {`	112	`typedef struct {`
113	`/* R Graphics Parameters */`	113	`/* R Graphics Parameters */`
114	`/* local device copy so that we can detect */`	114	`/* local device copy so that we can detect */`
115	`/* when parameter changes */`	115	`/* when parameter changes */`
116	`int col; /* Color */`	116	`int col; /* Color */`
117	`int bg; /* Background */`	117	`int bg; /* Background */`
118	`int fontface; /* Typeface */`	118	`int fontface; /* Typeface */`
119	`int fontsize, basefontsize; /* Size in points */`	119	`int fontsize, basefontsize; /* Size in points */`
120	`double fontangle;`	120	`double fontangle;`
121		121
122	`/* devga Driver Specific */`	122	`/* devga Driver Specific */`
123	`/* parameters with copy per devga device */`	123	`/* parameters with copy per devga device */`
124		124
125	`enum DeviceKinds kind;`	125	`enum DeviceKinds kind;`
126	`int windowWidth; /* Window width (pixels) */`	126	`int windowWidth; /* Window width (pixels) */`
127	`int windowHeight; /* Window height (pixels) */`	127	`int windowHeight; /* Window height (pixels) */`
128	`int showWidth; /* device width (pixels) */`	128	`int showWidth; /* device width (pixels) */`
129	`int showHeight; /* device height (pixels) */`	129	`int showHeight; /* device height (pixels) */`
130	`int origWidth, origHeight, xshift, yshift;`	130	`int origWidth, origHeight, xshift, yshift;`
131	`Rboolean resize; /* Window resized */`	131	`Rboolean resize; /* Window resized */`
132	`window gawin; /* Graphics window */`	132	`window gawin; /* Graphics window */`
133	`/*FIXME: we should have union for this stuff and`	133	`/*FIXME: we should have union for this stuff and`
134	`maybe change gawin to canvas*/`	134	`maybe change gawin to canvas*/`
135	`/* SCREEN section*/`	135	`/* SCREEN section*/`
136	`popup locpopup, grpopup;`	136	`popup locpopup, grpopup;`
137	`button stoploc;`	137	`button stoploc;`
138	`menubar mbar, mbarloc;`	138	`menubar mbar, mbarloc;`
139	`menu msubsave;`	139	`menu msubsave;`
140	`menuitem mpng, mbmp, mjpeg50, mjpeg75, mjpeg100;`	140	`menuitem mpng, mbmp, mjpeg50, mjpeg75, mjpeg100;`
141	`menuitem mps, mpdf, mwm, mclpbm, mclpwm, mprint, mclose;`	141	`menuitem mps, mpdf, mwm, mclpbm, mclpwm, mprint, mclose;`
142	`menuitem mrec, madd, mreplace, mprev, mnext, mclear, msvar, mgvar;`	142	`menuitem mrec, madd, mreplace, mprev, mnext, mclear, msvar, mgvar;`
143	`menuitem mR, mfit, mfix;`	143	`menuitem mR, mfit, mfix, grmenustayontop;`
144	`Rboolean recording, replaying, needsave;`	144	`Rboolean recording, replaying, needsave;`
145	`bitmap bm;`	145	`bitmap bm;`
146	`/* PNG and JPEG section */`	146	`/* PNG and JPEG section */`
147	`FILE *fp;`	147	`FILE *fp;`
148	`char filename[512];`	148	`char filename[512];`
149	`int quality;`	149	`int quality;`
150	`int npage;`	150	`int npage;`
151	`double w, h;`	151	`double w, h;`
152	`/* Used to rescale font size so that bitmap devices have 72dpi */`	152	`/* Used to rescale font size so that bitmap devices have 72dpi */`
153	`int truedpi, wanteddpi;`	153	`int truedpi, wanteddpi;`
154	`rgb fgcolor; /* Foreground color */`	154	`rgb fgcolor; /* Foreground color */`
155	`rgb bgcolor; /* Background color */`	155	`rgb bgcolor; /* Background color */`
156	`rgb canvascolor; /* Canvas color */`	156	`rgb canvascolor; /* Canvas color */`
157	`rgb outcolor; /* Outside canvas color */`	157	`rgb outcolor; /* Outside canvas color */`
158	`rect clip; /* The clipping rectangle */`	158	`rect clip; /* The clipping rectangle */`
159	`Rboolean usefixed;`	159	`Rboolean usefixed;`
160	`font fixedfont;`	160	`font fixedfont;`
161	`font font;`	161	`font font;`
162	`Rboolean locator;`	162	`Rboolean locator;`
163	`int clicked; /* {0,1,2} */`	163	`int clicked; /* {0,1,2} */`
164	`int px, py, lty, lwd;`	164	`int px, py, lty, lwd;`
165	`int resizing; /* {1,2,3} */`	165	`int resizing; /* {1,2,3} */`
166	`double rescale_factor;`	166	`double rescale_factor;`
167	`int fast; /* Use fast fixed-width lines? */`	167	`int fast; /* Use fast fixed-width lines? */`
168	`unsigned int pngtrans; /* what PNG_TRANS get mapped to */`	168	`unsigned int pngtrans; /* what PNG_TRANS get mapped to */`
169	`Rboolean buffered;`	169	`Rboolean buffered;`
170	`int timeafter, timesince;`	170	`int timeafter, timesince;`
171	`SEXP psenv;`	171	`SEXP psenv;`
172	`} gadesc;`	172	`} gadesc;`
173		173
174	`rect getregion(gadesc *xd)`	174	`rect getregion(gadesc *xd)`
175	`{`	175	`{`
176	`rect r = getrect(xd->bm);`	176	`rect r = getrect(xd->bm);`
177	`r.x += max(0, xd->xshift);`	177	`r.x += max(0, xd->xshift);`
178	`r.y += max(0, xd->yshift);`	178	`r.y += max(0, xd->yshift);`
179	`r.width = min(r.width, xd->showWidth);`	179	`r.width = min(r.width, xd->showWidth);`
180	`r.height = min(r.height, xd->showHeight);`	180	`r.height = min(r.height, xd->showHeight);`
181	`return r;`	181	`return r;`
182	`}`	182	`}`
183		183
184	`/* Update the screen 100ms after last plotting call or 500ms after last`	184	`/* Update the screen 100ms after last plotting call or 500ms after last`
185	`update */`	185	`update */`
186		186
187	`static UINT TimerNo = 0;`	187	`static UINT TimerNo = 0;`
188	`static gadesc *GA_xd;`	188	`static gadesc *GA_xd;`
189	`static DWORD GALastUpdate = 0;`	189	`static DWORD GALastUpdate = 0;`
190		190
191	`static VOID CALLBACK`	191	`static VOID CALLBACK`
192	`GA_timer_proc(HWND hwnd, UINT message, UINT tid, DWORD time)`	192	`GA_timer_proc(HWND hwnd, UINT message, UINT tid, DWORD time)`
193	`{`	193	`{`
194	`if ((message != WM_TIMER) \|\| tid != TimerNo \|\| !GA_xd) return;`	194	`if ((message != WM_TIMER) \|\| tid != TimerNo \|\| !GA_xd) return;`
195	`gbitblt(GA_xd->gawin, GA_xd->bm, pt(0,0), getrect(GA_xd->bm));`	195	`gbitblt(GA_xd->gawin, GA_xd->bm, pt(0,0), getrect(GA_xd->bm));`
196	`GALastUpdate = time;`	196	`GALastUpdate = time;`
197	`}`	197	`}`
198		198
199	`static void GA_Timer(gadesc *xd)`	199	`static void GA_Timer(gadesc *xd)`
200	`{`	200	`{`
201	`DWORD now = GetTickCount();`	201	`DWORD now = GetTickCount();`
202	`if(TimerNo != 0) KillTimer(0, TimerNo);`	202	`if(TimerNo != 0) KillTimer(0, TimerNo);`
203	`if(now > GALastUpdate + xd->timesince) {`	203	`if(now > GALastUpdate + xd->timesince) {`
204	`gbitblt(xd->gawin, xd->bm, pt(0,0), getrect(xd->bm));`	204	`gbitblt(xd->gawin, xd->bm, pt(0,0), getrect(xd->bm));`
205	`GALastUpdate = now;`	205	`GALastUpdate = now;`
206	`} else {`	206	`} else {`
207	`GA_xd = xd;`	207	`GA_xd = xd;`
208	`TimerNo = SetTimer(0, 0, (UINT) xd->timeafter, GA_timer_proc);`	208	`TimerNo = SetTimer(0, 0, (UINT) xd->timeafter, GA_timer_proc);`
209	`}`	209	`}`
210	`}`	210	`}`
211		211
212	`/********************************************************/`	212	`/********************************************************/`
213	`/* There are a number of actions that every device */`	213	`/* There are a number of actions that every device */`
214	`/* driver is expected to perform (even if, in some */`	214	`/* driver is expected to perform (even if, in some */`
215	`/* cases it does nothing - just so long as it doesn't */`	215	`/* cases it does nothing - just so long as it doesn't */`
216	`/* crash !). this is how the graphics engine interacts */`	216	`/* crash !). this is how the graphics engine interacts */`
217	`/* with each device. Each action will be documented */`	217	`/* with each device. Each action will be documented */`
218	`/* individually. */`	218	`/* individually. */`
219	`/* hooks for these actions must be set up when the */`	219	`/* hooks for these actions must be set up when the */`
220	`/* device is first created */`	220	`/* device is first created */`
221	`/********************************************************/`	221	`/********************************************************/`
222		222
223	`/* Device Driver Actions */`	223	`/* Device Driver Actions */`
224		224
225	`static void GA_Activate(NewDevDesc *dd);`	225	`static void GA_Activate(NewDevDesc *dd);`
226	`static void GA_Circle(double x, double y, double r,`	226	`static void GA_Circle(double x, double y, double r,`
227	`R_GE_gcontext *gc,`	227	`R_GE_gcontext *gc,`
228	`NewDevDesc *dd);`	228	`NewDevDesc *dd);`
229	`static void GA_Clip(double x0, double x1, double y0, double y1,`	229	`static void GA_Clip(double x0, double x1, double y0, double y1,`
230	`NewDevDesc *dd);`	230	`NewDevDesc *dd);`
231	`static void GA_Close(NewDevDesc *dd);`	231	`static void GA_Close(NewDevDesc *dd);`
232	`static void GA_Deactivate(NewDevDesc *dd);`	232	`static void GA_Deactivate(NewDevDesc *dd);`
233	`static void GA_Hold(NewDevDesc *dd);`	233	`static void GA_Hold(NewDevDesc *dd);`
234	`static Rboolean GA_Locator(double x, double y, NewDevDesc *dd);`	234	`static Rboolean GA_Locator(double x, double y, NewDevDesc *dd);`
235	`static void GA_Line(double x1, double y1, double x2, double y2,`	235	`static void GA_Line(double x1, double y1, double x2, double y2,`
236	`R_GE_gcontext *gc,`	236	`R_GE_gcontext *gc,`
237	`NewDevDesc *dd);`	237	`NewDevDesc *dd);`
238	`static void GA_MetricInfo(int c,`	238	`static void GA_MetricInfo(int c,`
239	`R_GE_gcontext *gc,`	239	`R_GE_gcontext *gc,`
240	`double* ascent, double* descent,`	240	`double* ascent, double* descent,`
241	`double* width, NewDevDesc *dd);`	241	`double* width, NewDevDesc *dd);`
242	`static void GA_Mode(int mode, NewDevDesc *dd);`	242	`static void GA_Mode(int mode, NewDevDesc *dd);`
243	`static void GA_NewPage(R_GE_gcontext *gc,`	243	`static void GA_NewPage(R_GE_gcontext *gc,`
244	`NewDevDesc *dd);`	244	`NewDevDesc *dd);`
245	`static void GA_Polygon(int n, double x, double y,`	245	`static void GA_Polygon(int n, double x, double y,`
246	`R_GE_gcontext *gc,`	246	`R_GE_gcontext *gc,`
247	`NewDevDesc *dd);`	247	`NewDevDesc *dd);`
248	`static void GA_Polyline(int n, double x, double y,`	248	`static void GA_Polyline(int n, double x, double y,`
249	`R_GE_gcontext *gc,`	249	`R_GE_gcontext *gc,`
250	`NewDevDesc *dd);`	250	`NewDevDesc *dd);`
251	`static void GA_Rect(double x0, double y0, double x1, double y1,`	251	`static void GA_Rect(double x0, double y0, double x1, double y1,`
252	`R_GE_gcontext *gc,`	252	`R_GE_gcontext *gc,`
253	`NewDevDesc *dd);`	253	`NewDevDesc *dd);`
254	`static void GA_Size(double left, double right,`	254	`static void GA_Size(double left, double right,`
255	`double bottom, double top,`	255	`double bottom, double top,`
256	`NewDevDesc *dd);`	256	`NewDevDesc *dd);`
257	`static void GA_Resize(NewDevDesc *dd);`	257	`static void GA_Resize(NewDevDesc *dd);`
258	`static double GA_StrWidth(char *str,`	258	`static double GA_StrWidth(char *str,`
259	`R_GE_gcontext *gc,`	259	`R_GE_gcontext *gc,`
260	`NewDevDesc *dd);`	260	`NewDevDesc *dd);`
261	`static void GA_Text(double x, double y, char *str,`	261	`static void GA_Text(double x, double y, char *str,`
262	`double rot, double hadj,`	262	`double rot, double hadj,`
263	`R_GE_gcontext *gc,`	263	`R_GE_gcontext *gc,`
264	`NewDevDesc *dd);`	264	`NewDevDesc *dd);`
265	`static Rboolean GA_Open(NewDevDesc, gadesc, char*, double, double,`	265	`static Rboolean GA_Open(NewDevDesc, gadesc, char*, double, double,`
266	`Rboolean, int, int, double, int, int);`	266	`Rboolean, int, int, double, int, int);`
267		267
268	`/********************************************************/`	268	`/********************************************************/`
269	`/* end of list of required device driver actions */`	269	`/* end of list of required device driver actions */`
270	`/********************************************************/`	270	`/********************************************************/`
271		271
272	`/* Support Routines */`	272	`/* Support Routines */`
273		273
274	`static double pixelHeight(drawing d);`	274	`static double pixelHeight(drawing d);`
275	`static double pixelWidth(drawing d);`	275	`static double pixelWidth(drawing d);`
276	`static void SetColor(int, double, NewDevDesc *);`	276	`static void SetColor(int, double, NewDevDesc *);`
277	`static void SetFont(int, int, double, NewDevDesc *);`	277	`static void SetFont(int, int, double, NewDevDesc *);`
278	`static void SetLinetype(int, double, NewDevDesc *);`	278	`static void SetLinetype(int, double, NewDevDesc *);`
279	`static int Load_Rbitmap_Dll();`	279	`static int Load_Rbitmap_Dll();`
280	`void UnLoad_Rbitmap_Dll();`	280	`void UnLoad_Rbitmap_Dll();`
281	`static void SaveAsPng(NewDevDesc dd, char fn);`	281	`static void SaveAsPng(NewDevDesc dd, char fn);`
282	`static void SaveAsJpeg(NewDevDesc dd, int quality, char fn);`	282	`static void SaveAsJpeg(NewDevDesc dd, int quality, char fn);`
283	`static void SaveAsBmp(NewDevDesc dd, char fn);`	283	`static void SaveAsBmp(NewDevDesc dd, char fn);`
284	`static void SaveAsBitmap(NewDevDesc *dd);`	284	`static void SaveAsBitmap(NewDevDesc *dd);`
285		285
286	`static void PrivateCopyDevice(NewDevDesc dd, NewDevDesc ndd, char *name)`	286	`static void PrivateCopyDevice(NewDevDesc dd, NewDevDesc ndd, char *name)`
287	`{`	287	`{`
288	`GEDevDesc* gdd;`	288	`GEDevDesc* gdd;`
289	`int saveDev = curDevice();`	289	`int saveDev = curDevice();`
290	`gadesc xd = (gadesc ) dd->deviceSpecific;`	290	`gadesc xd = (gadesc ) dd->deviceSpecific;`
291	`gsetcursor(xd->gawin, WatchCursor);`	291	`gsetcursor(xd->gawin, WatchCursor);`
292	`gsetVar(install(".Device"),`	292	`gsetVar(install(".Device"),`
293	`mkString(name), R_NilValue);`	293	`mkString(name), R_NilValue);`
294	`gdd = GEcreateDevDesc(ndd);`	294	`gdd = GEcreateDevDesc(ndd);`
295	`addDevice((DevDesc*) gdd);`	295	`addDevice((DevDesc*) gdd);`
296	`GEcopyDisplayList(devNumber((DevDesc*) dd));`	296	`GEcopyDisplayList(devNumber((DevDesc*) dd));`
297	`KillDevice((DevDesc*) gdd);`	297	`KillDevice((DevDesc*) gdd);`
298	`selectDevice(saveDev);`	298	`selectDevice(saveDev);`
299	`/* KillDevice(GetDevice(devNumber((DevDesc) ndd))); /`	299	`/* KillDevice(GetDevice(devNumber((DevDesc) ndd))); /`
300	`gsetcursor(xd->gawin, ArrowCursor);`	300	`gsetcursor(xd->gawin, ArrowCursor);`
301	`show(xd->gawin);`	301	`show(xd->gawin);`
302	`}`	302	`}`
303		303
304	`static void SaveAsWin(NewDevDesc dd, char display)`	304	`static void SaveAsWin(NewDevDesc dd, char display)`
305	`{`	305	`{`
306	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`	306	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`
307	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`	307	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`
308	`if (!ndd) {`	308	`if (!ndd) {`
309	`R_ShowMessage("Not enough memory to copy graphics window");`	309	`R_ShowMessage("Not enough memory to copy graphics window");`
310	`return;`	310	`return;`
311	`}`	311	`}`
312	`if(!R_CheckDeviceAvailableBool()) {`	312	`if(!R_CheckDeviceAvailableBool()) {`
313	`free(ndd);`	313	`free(ndd);`
314	`R_ShowMessage("No device available to copy graphics window");`	314	`R_ShowMessage("No device available to copy graphics window");`
315	`return;`	315	`return;`
316	`}`	316	`}`
317		317
318	`ndd->displayList = R_NilValue;`	318	`ndd->displayList = R_NilValue;`
319	`if (GADeviceDriver(ndd, display,`	319	`if (GADeviceDriver(ndd, display,`
320	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`	320	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`
321	`GE_INCHES, gdd),`	321	`GE_INCHES, gdd),`
322	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`	322	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`
323	`GE_INCHES, gdd),`	323	`GE_INCHES, gdd),`
324	`((gadesc*) dd->deviceSpecific)->basefontsize,`	324	`((gadesc*) dd->deviceSpecific)->basefontsize,`
325	`0, 1, White, 1, NA_INTEGER, NA_INTEGER, FALSE,`	325	`0, 1, White, 1, NA_INTEGER, NA_INTEGER, FALSE,`
326	`R_GlobalEnv))`	326	`R_GlobalEnv))`
327	`PrivateCopyDevice(dd, ndd, display);`	327	`PrivateCopyDevice(dd, ndd, display);`
328	`}`	328	`}`
329		329
330		330
331	`static void SaveAsPostscript(NewDevDesc dd, char fn)`	331	`static void SaveAsPostscript(NewDevDesc dd, char fn)`
332	`{`	332	`{`
333	`SEXP s;`	333	`SEXP s;`
334	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`	334	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`
335	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`	335	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`
336	`gadesc xd = (gadesc ) dd->deviceSpecific;`	336	`gadesc xd = (gadesc ) dd->deviceSpecific;`
337	`char family[256], encoding[256], paper[256], bg[256], fg[256],`	337	`char family[256], encoding[256], paper[256], bg[256], fg[256],`
338	`**afmpaths = NULL;`	338	`**afmpaths = NULL;`
339		339
340	`if (!ndd) {`	340	`if (!ndd) {`
341	`R_ShowMessage("Not enough memory to copy graphics window");`	341	`R_ShowMessage("Not enough memory to copy graphics window");`
342	`return;`	342	`return;`
343	`}`	343	`}`
344	`if(!R_CheckDeviceAvailableBool()) {`	344	`if(!R_CheckDeviceAvailableBool()) {`
345	`free(ndd);`	345	`free(ndd);`
346	`R_ShowMessage("No device available to copy graphics window");`	346	`R_ShowMessage("No device available to copy graphics window");`
347	`return;`	347	`return;`
348	`}`	348	`}`
349		349
350		350
351	`ndd->displayList = R_NilValue;`	351	`ndd->displayList = R_NilValue;`
352		352
353	`/* Set default values... */`	353	`/* Set default values... */`
354	`strcpy(family, "Helvetica");`	354	`strcpy(family, "Helvetica");`
355	`strcpy(encoding, "ISOLatin1.enc");`	355	`strcpy(encoding, "ISOLatin1.enc");`
356	`strcpy(paper, "default");`	356	`strcpy(paper, "default");`
357	`strcpy(bg, "transparent");`	357	`strcpy(bg, "transparent");`
358	`strcpy(fg, "black");`	358	`strcpy(fg, "black");`
359	`/* and then try to get it from .PostScript.Options */`	359	`/* and then try to get it from .PostScript.Options */`
360	`s = findVar(install(".PostScript.Options"), xd->psenv);`	360	`s = findVar(install(".PostScript.Options"), xd->psenv);`
361	`if ((s != R_UnboundValue) && (s != R_NilValue)) {`	361	`if ((s != R_UnboundValue) && (s != R_NilValue)) {`
362	`SEXP names = getAttrib(s, R_NamesSymbol);`	362	`SEXP names = getAttrib(s, R_NamesSymbol);`
363	`int i,done;`	363	`int i,done;`
364	`for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {`	364	`for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {`
365	`if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {`	365	`if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {`
366	`strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	366	`strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
367	`done += 1;`	367	`done += 1;`
368	`}`	368	`}`
369	`if(!strcmp("paper", CHAR(STRING_ELT(names, i)))) {`	369	`if(!strcmp("paper", CHAR(STRING_ELT(names, i)))) {`
370	`strcpy(paper, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	370	`strcpy(paper, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
371	`done += 1;`	371	`done += 1;`
372	`}`	372	`}`
373	`if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {`	373	`if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {`
374	`strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	374	`strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
375	`done += 1;`	375	`done += 1;`
376	`}`	376	`}`
377	`if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {`	377	`if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {`
378	`strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	378	`strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
379	`done += 1;`	379	`done += 1;`
380	`}`	380	`}`
381	`}`	381	`}`
382	`}`	382	`}`
383	`if (PSDeviceDriver((DevDesc *) ndd,`	383	`if (PSDeviceDriver((DevDesc *) ndd,`
384	`fn, paper, family, afmpaths, encoding, bg, fg,`	384	`fn, paper, family, afmpaths, encoding, bg, fg,`
385	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`	385	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`
386	`GE_INCHES, gdd),`	386	`GE_INCHES, gdd),`
387	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`	387	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`
388	`GE_INCHES, gdd),`	388	`GE_INCHES, gdd),`
389	`(double)0, ((gadesc*) dd->deviceSpecific)->basefontsize,`	389	`(double)0, ((gadesc*) dd->deviceSpecific)->basefontsize,`
390	`0, 1, 0, "", "R Graphics Output"))`	390	`0, 1, 0, "", "R Graphics Output"))`
391	`/* horizontal=F, onefile=F, pagecentre=T, print.it=F */`	391	`/* horizontal=F, onefile=F, pagecentre=T, print.it=F */`
392	`PrivateCopyDevice(dd, ndd, "postscript");`	392	`PrivateCopyDevice(dd, ndd, "postscript");`
393	`}`	393	`}`
394		394
395		395
396	`static void SaveAsPDF(NewDevDesc dd, char fn)`	396	`static void SaveAsPDF(NewDevDesc dd, char fn)`
397	`{`	397	`{`
398	`SEXP s;`	398	`SEXP s;`
399	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`	399	`NewDevDesc ndd = (NewDevDesc ) calloc(1, sizeof(NewDevDesc));`
400	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`	400	`GEDevDesc* gdd = (GEDevDesc) GetDevice(devNumber((DevDesc) dd));`
401	`gadesc xd = (gadesc ) dd->deviceSpecific;`	401	`gadesc xd = (gadesc ) dd->deviceSpecific;`
402	`char family[256], encoding[256], bg[256], fg[256];`	402	`char family[256], encoding[256], bg[256], fg[256];`
403		403
404	`if (!ndd) {`	404	`if (!ndd) {`
405	`R_ShowMessage("Not enough memory to copy graphics window");`	405	`R_ShowMessage("Not enough memory to copy graphics window");`
406	`return;`	406	`return;`
407	`}`	407	`}`
408	`if(!R_CheckDeviceAvailableBool()) {`	408	`if(!R_CheckDeviceAvailableBool()) {`
409	`free(ndd);`	409	`free(ndd);`
410	`R_ShowMessage("No device available to copy graphics window");`	410	`R_ShowMessage("No device available to copy graphics window");`
411	`return;`	411	`return;`
412	`}`	412	`}`
413		413
414	`ndd->displayList = R_NilValue;`	414	`ndd->displayList = R_NilValue;`
415		415
416	`/* Set default values... */`	416	`/* Set default values... */`
417	`s = findVar(install(".PostScript.Options"), xd->psenv);`	417	`s = findVar(install(".PostScript.Options"), xd->psenv);`
418	`strcpy(family, "Helvetica");`	418	`strcpy(family, "Helvetica");`
419	`strcpy(encoding, "ISOLatin1.enc");`	419	`strcpy(encoding, "ISOLatin1.enc");`
420	`strcpy(bg, "transparent");`	420	`strcpy(bg, "transparent");`
421	`strcpy(fg, "black");`	421	`strcpy(fg, "black");`
422	`/* and then try to get it from .PostScript.Options */`	422	`/* and then try to get it from .PostScript.Options */`
423	`if ((s != R_UnboundValue) && (s != R_NilValue)) {`	423	`if ((s != R_UnboundValue) && (s != R_NilValue)) {`
424	`SEXP names = getAttrib(s, R_NamesSymbol);`	424	`SEXP names = getAttrib(s, R_NamesSymbol);`
425	`int i,done;`	425	`int i,done;`
426	`for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {`	426	`for (i=0, done=0; (done<4) && (i<length(s)) ; i++) {`
427	`if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {`	427	`if(!strcmp("family", CHAR(STRING_ELT(names, i)))) {`
428	`strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	428	`strcpy(family, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
429	`done += 1;`	429	`done += 1;`
430	`}`	430	`}`
431	`if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {`	431	`if(!strcmp("bg", CHAR(STRING_ELT(names, i)))) {`
432	`strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	432	`strcpy(bg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
433	`done += 1;`	433	`done += 1;`
434	`}`	434	`}`
435	`if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {`	435	`if(!strcmp("fg", CHAR(STRING_ELT(names, i)))) {`
436	`strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`	436	`strcpy(fg, CHAR(STRING_ELT(VECTOR_ELT(s, i), 0)));`
437	`done += 1;`	437	`done += 1;`
438	`}`	438	`}`
439	`}`	439	`}`
440	`}`	440	`}`
441	`if (PDFDeviceDriver((DevDesc *) ndd, fn, family, encoding, bg, fg,`	441	`if (PDFDeviceDriver((DevDesc *) ndd, fn, family, encoding, bg, fg,`
442	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`	442	`fromDeviceWidth(toDeviceWidth(1.0, GE_NDC, gdd),`
443	`GE_INCHES, gdd),`	443	`GE_INCHES, gdd),`
444	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`	444	`fromDeviceHeight(toDeviceHeight(-1.0, GE_NDC, gdd),`
445	`GE_INCHES, gdd),`	445	`GE_INCHES, gdd),`
446	`((gadesc*) dd->deviceSpecific)->basefontsize,`	446	`((gadesc*) dd->deviceSpecific)->basefontsize,`
447	`1, "R Graphics Output"))`	447	`1, "R Graphics Output"))`
448	`PrivateCopyDevice(dd, ndd, "PDF");`	448	`PrivateCopyDevice(dd, ndd, "PDF");`
449	`}`	449	`}`
450		450
451		451
452		452
453	`/* Pixel Dimensions (Inches) */`	453	`/* Pixel Dimensions (Inches) */`
454	`static double pixelWidth(drawing obj)`	454	`static double pixelWidth(drawing obj)`
455	`{`	455	`{`
456	`return ((double) 1) / devicepixelsx(obj);`	456	`return ((double) 1) / devicepixelsx(obj);`
457	`}`	457	`}`
458		458
459	`static double pixelHeight(drawing obj)`	459	`static double pixelHeight(drawing obj)`
460	`{`	460	`{`
461	`return ((double) 1) / devicepixelsy(obj);`	461	`return ((double) 1) / devicepixelsy(obj);`
462	`}`	462	`}`
463		463
464	`/* Font information array. */`	464	`/* Font information array. */`
465	`/* Point sizes: 6-24 */`	465	`/* Point sizes: 6-24 */`
466	`/* Faces: plain, bold, oblique, bold-oblique */`	466	`/* Faces: plain, bold, oblique, bold-oblique */`
467	`/* Symbol may be added later */`	467	`/* Symbol may be added later */`
468		468
469	`#define NFONT 19`	469	`#define NFONT 19`
470	`#define MAXFONT 32`	470	`#define MAXFONT 32`
471	`static int fontnum;`	471	`static int fontnum;`
472	`static int fontinitdone = 0;/* in {0,1,2} */`	472	`static int fontinitdone = 0;/* in {0,1,2} */`
473	`static char *fontname[MAXFONT];`	473	`static char *fontname[MAXFONT];`
474	`static int fontstyle[MAXFONT];`	474	`static int fontstyle[MAXFONT];`
475		475
476	`static void RStandardFonts()`	476	`static void RStandardFonts()`
477	`{`	477	`{`
478	`int i;`	478	`int i;`
479		479
480	`for (i = 0; i < 4; i++)`	480	`for (i = 0; i < 4; i++)`
481	`fontname[i] = "Times New Roman";`	481	`fontname[i] = "Times New Roman";`
482	`fontname[4] = "Symbol";`	482	`fontname[4] = "Symbol";`
483	`fontstyle[0] = fontstyle[4] = Plain;`	483	`fontstyle[0] = fontstyle[4] = Plain;`
484	`fontstyle[1] = Bold;`	484	`fontstyle[1] = Bold;`
485	`fontstyle[2] = Italic;`	485	`fontstyle[2] = Italic;`
486	`fontstyle[3] = BoldItalic;`	486	`fontstyle[3] = BoldItalic;`
487	`fontnum = 5;`	487	`fontnum = 5;`
488	`fontinitdone = 2; /* =fontinit done & fontname must not be`	488	`fontinitdone = 2; /* =fontinit done & fontname must not be`
489	`free-ed */`	489	`free-ed */`
490	`}`	490	`}`
491		491
492		492
493	`static void RFontInit()`	493	`static void RFontInit()`
494	`{`	494	`{`
495	`int i, notdone;`	495	`int i, notdone;`
496	`char *opt[2];`	496	`char *opt[2];`
497	`char oops[256];`	497	`char oops[256];`
498		498
499	`sprintf(oops, "%s/Rdevga", getenv("R_USER"));`	499	`sprintf(oops, "%s/Rdevga", getenv("R_USER"));`
500	`notdone = 1;`	500	`notdone = 1;`

The R Project SVN R

(root)/trunk/src/gnuwin32/devga.c @ 28362 – Rev 27662 → 27686