The R Project SVN R

Rev

Rev 19169 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 19169 Rev 22913
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 1998	Robert Gentleman and Ross Ihaka
 3 
 *  Copyright (C) 1998	Robert Gentleman and Ross Ihaka
4 
 *  Copyright (C) 1998-2000   The R Development Core Team.
 4 
 *  Copyright (C) 1998-2003   The R Development Core Team.
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.
Line 53... Line 53...
53 
 *  ps		= pointsize
 53 
 *  ps		= pointsize
54 
 *  gamma       = gamma correction
 54 
 *  gamma       = gamma correction
55 
 *  colormodel  = color model
 55 
 *  colormodel  = color model
56 
 */
 56 
 */
57 
 
 57 
 
58 
#ifdef OLD
 - 
 
59 
SEXP do_X11(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
60 
{
 - 
 
61 
    char *display, *vmax, *cname, *devname;
 - 
 
62 
    double height, width, ps, gamma;
 - 
 
63 
    int colormodel, maxcubesize, canvascolor;
 - 
 
64 
    SEXP sc;
 - 
 
65 
 
 - 
 
66 
    gcall = call;
 - 
 
67 
    vmax = vmaxget();
 - 
 
68 
 
 - 
 
69 
    /* Decode the arguments */
 - 
 
70 
    display = SaveString(CAR(args), 0); args = CDR(args);
 - 
 
71 
    width = asReal(CAR(args));	args = CDR(args);
 - 
 
72 
    height = asReal(CAR(args)); args = CDR(args);
 - 
 
73 
    if (width <= 0 || height <= 0)
 - 
 
74 
	errorcall(call, "invalid width or height");
 - 
 
75 
    ps = asReal(CAR(args)); args = CDR(args);
 - 
 
76 
    gamma = asReal(CAR(args)); args = CDR(args);
 - 
 
77 
    if (gamma < 0 || gamma > 100)
 - 
 
78 
	errorcall(call, "invalid gamma value");
 - 
 
79 
 
 - 
 
80 
    if (!isValidString(CAR(args)))
 - 
 
81 
	error("invalid colortype passed to X11 driver");
 - 
 
82 
    cname = CHAR(STRING_ELT(CAR(args), 0));
 - 
 
83 
    if (strcmp(cname, "mono") == 0)
 - 
 
84 
	colormodel = 0;
 - 
 
85 
    else if (strcmp(cname, "gray") == 0 || strcmp(cname, "grey") == 0)
 - 
 
86 
	colormodel = 1;
 - 
 
87 
    else if (strcmp(cname, "pseudo.cube") == 0)
 - 
 
88 
	colormodel = 2;
 - 
 
89 
    else if (strcmp(cname, "pseudo") == 0)
 - 
 
90 
	colormodel = 3;
 - 
 
91 
    else if (strcmp(cname, "true") == 0)
 - 
 
92 
	colormodel = 4;
 - 
 
93 
    else {
 - 
 
94 
	warningcall(call,
- 
 
95 
		    "unknown X11 color/colour model -- using monochrome");
 - 
 
96 
	colormodel = 0;
 - 
 
97 
    }
 - 
 
98 
    args = CDR(args);
 - 
 
99 
    maxcubesize = asInteger(CAR(args));
 - 
 
100 
    if (maxcubesize < 1 || maxcubesize > 256)
 - 
 
101 
        maxcubesize = 256;
 - 
 
102 
    args = CDR(args);
 - 
 
103 
    sc = CAR(args);
 - 
 
104 
    if (!isString(sc) && !isInteger(sc) && !isLogical(sc) && !isReal(sc))
 - 
 
105 
	errorcall(call, "invalid value of `canvas'");
 - 
 
106 
    canvascolor = RGBpar(sc, 0);
 - 
 
107 
 
 - 
 
108 
    devname = "X11";
 - 
 
109 
    if (!strncmp(display, "png::", 5)) devname = "PNG";
 - 
 
110 
    else if (!strncmp(display, "jpeg::", 6)) devname = "JPEG";
 - 
 
111 
    else if (!strcmp(display, "XImage")) devname = "XImage";
 - 
 
112 
 
 - 
 
113 
    Rf_addX11Device(display, width, height, ps, gamma, colormodel,
- 
 
114 
		    maxcubesize, canvascolor, devname, ptr_X11DeviceDriver);
 - 
 
115 
    vmaxset(vmax);
 - 
 
116 
    return R_NilValue;
 - 
 
117 
}
 - 
 
118 
 
 - 
 
119 
 
 - 
 
120 
DevDesc*
 - 
 
121 
Rf_addX11Device(char *display, double width, double height, double ps,
- 
 
122 
		double gamma, int colormodel, int maxcubesize,
 - 
 
123 
		int canvascolor,
 - 
 
124 
		char *devname, X11DeviceDriverRoutine deviceDriverRoutine)
 - 
 
125 
{
 - 
 
126 
    DevDesc *dd = NULL;
 - 
 
127 
    R_CheckDeviceAvailable();
 - 
 
128 
    BEGIN_SUSPEND_INTERRUPTS {
 - 
 
129 
	/* Allocate and initialize the device driver data */
 - 
 
130 
	if (!(dd = (DevDesc*)calloc(1, sizeof(DevDesc))))
 - 
 
131 
	    return 0;
 - 
 
132 
	/* Do this for early redraw attempts */
 - 
 
133 
	dd->displayList = R_NilValue;
 - 
 
134 
	/* Make sure that this is initialised before a GC can occur.
 - 
 
135 
	 * This (and displayList) get protected during GC
 - 
 
136 
	 */
 - 
 
137 
	dev->savedSnapshot = R_NilValue;
 - 
 
138 
	GInit(&dd->dp);
 - 
 
139 
	if (!deviceDriverRoutine ||
- 
 
140 
	    !(deviceDriverRoutine)(dd, display, width, height, ps, gamma,
- 
 
141 
				   colormodel, maxcubesize, canvascolor)) {
 - 
 
142 
	    free(dd);
 - 
 
143 
	    errorcall(gcall, "unable to start device %s", devname);
 - 
 
144 
       	}
 - 
 
145 
	gsetVar(install(".Device"), mkString(devname), R_NilValue);
 - 
 
146 
	addDevice(dd);
 - 
 
147 
	initDisplayList(dd);
 - 
 
148 
    } END_SUSPEND_INTERRUPTS;
 - 
 
149 
 
 - 
 
150 
    return(dd);
 - 
 
151 
}
 - 
 
152 
#endif
 - 
 
153 
 
 - 
 
154 
 
 58 
 
155 
SEXP do_GTK(SEXP call, SEXP op, SEXP args, SEXP env)
 59 
SEXP do_GTK(SEXP call, SEXP op, SEXP args, SEXP env)
156 
{
 60 
{
157 
    NewDevDesc *dev;
 61 
    NewDevDesc *dev;
158 
    GEDevDesc *dd;
 62 
    GEDevDesc *dd;
Line 229... Line 133...
229 
	GEinitDisplayList(dd);
 133 
	GEinitDisplayList(dd);
230 
    } END_SUSPEND_INTERRUPTS;
 134 
    } END_SUSPEND_INTERRUPTS;
231 
    vmaxset(vmax);
 135 
    vmaxset(vmax);
232 
    return R_NilValue;
 136 
    return R_NilValue;
233 
}
 137 
}
234 
 
 - 
 
235 
SEXP do_X11(SEXP call, SEXP op, SEXP args, SEXP env)
 - 
 
236 
{
 - 
 
237 
    char *display, *vmax, *cname, *devname;
 - 
 
238 
    double height, width, ps, gamma;
 - 
 
239 
    int colormodel, maxcubesize, canvascolor;
 - 
 
240 
    SEXP sc;
 - 
 
241 
 
 - 
 
242 
    gcall = call;
 - 
 
243 
    vmax = vmaxget();
 - 
 
244 
 
 - 
 
245 
    /* Decode the arguments */
 - 
 
246 
    display = SaveString(CAR(args), 0); args = CDR(args);
 - 
 
247 
    width = asReal(CAR(args));	args = CDR(args);
 - 
 
248 
    height = asReal(CAR(args)); args = CDR(args);
 - 
 
249 
    if (width <= 0 || height <= 0)
 - 
 
250 
	errorcall(call, "invalid width or height");
 - 
 
251 
    ps = asReal(CAR(args)); args = CDR(args);
 - 
 
252 
    gamma = asReal(CAR(args)); args = CDR(args);
 - 
 
253 
    if (gamma < 0 || gamma > 100)
 - 
 
254 
	errorcall(call, "invalid gamma value");
 - 
 
255 
 
 - 
 
256 
    if (!isValidString(CAR(args)))
 - 
 
257 
	error("invalid colortype passed to X11 driver");
 - 
 
258 
    cname = CHAR(STRING_ELT(CAR(args), 0));
 - 
 
259 
    if (strcmp(cname, "mono") == 0)
 - 
 
260 
	colormodel = 0;
 - 
 
261 
    else if (strcmp(cname, "gray") == 0 || strcmp(cname, "grey") == 0)
 - 
 
262 
	colormodel = 1;
 - 
 
263 
    else if (strcmp(cname, "pseudo.cube") == 0)
 - 
 
264 
	colormodel = 2;
 - 
 
265 
    else if (strcmp(cname, "pseudo") == 0)
 - 
 
266 
	colormodel = 3;
 - 
 
267 
    else if (strcmp(cname, "true") == 0)
 - 
 
268 
	colormodel = 4;
 - 
 
269 
    else {
 - 
 
270 
	warningcall(call,
- 
 
271 
		    "unknown X11 color/colour model -- using monochrome");
 - 
 
272 
	colormodel = 0;
 - 
 
273 
    }
 - 
 
274 
    args = CDR(args);
 - 
 
275 
    maxcubesize = asInteger(CAR(args));
 - 
 
276 
    if (maxcubesize < 1 || maxcubesize > 256)
 - 
 
277 
        maxcubesize = 256;
 - 
 
278 
    args = CDR(args);
 - 
 
279 
    sc = CAR(args);
 - 
 
280 
    if (!isString(sc) && !isInteger(sc) && !isLogical(sc) && !isReal(sc))
 - 
 
281 
	errorcall(call, "invalid value of `canvas'");
 - 
 
282 
    canvascolor = RGBpar(sc, 0);
 - 
 
283 
 
 - 
 
284 
    devname = "X11";
 - 
 
285 
    if (!strncmp(display, "png::", 5)) devname = "PNG";
 - 
 
286 
    else if (!strncmp(display, "jpeg::", 6)) devname = "JPEG";
 - 
 
287 
    else if (!strcmp(display, "XImage")) devname = "XImage";
 - 
 
288 
 
 - 
 
289 
    Rf_addX11Device(display, width, height, ps, gamma, colormodel,
- 
 
290 
		    maxcubesize, canvascolor, devname, ptr_X11DeviceDriver);
 - 
 
291 
    vmaxset(vmax);
 - 
 
292 
    return R_NilValue;
 - 
 
293 
}
 - 
 
294 
 
 - 
 
295 
DevDesc*
- 
 
296 
Rf_addX11Device(char *display, double width, double height, double ps,
- 
 
297 
		double gamma, int colormodel, int maxcubesize,
 - 
 
298 
		int canvascolor,
 - 
 
299 
		char *devname, X11DeviceDriverRoutine deviceDriverRoutine)
 - 
 
300 
{
 - 
 
301 
    NewDevDesc *dev = NULL;
 - 
 
302 
    GEDevDesc *dd;
 - 
 
303 
    R_CheckDeviceAvailable();
 - 
 
304 
    BEGIN_SUSPEND_INTERRUPTS {
 - 
 
305 
	/* Allocate and initialize the device driver data */
 - 
 
306 
	if (!(dev = (NewDevDesc*)calloc(1, sizeof(NewDevDesc))))
 - 
 
307 
	    return 0;
 - 
 
308 
	/* Do this for early redraw attempts */
 - 
 
309 
	dev->newDevStruct = 1;
 - 
 
310 
	dev->displayList = R_NilValue;
 - 
 
311 
	/* Make sure that this is initialised before a GC can occur.
 - 
 
312 
	 * This (and displayList) get protected during GC
 - 
 
313 
	 */
 - 
 
314 
	dev->savedSnapshot = R_NilValue;
 - 
 
315 
	/* Took out the GInit because MOST of it is setting up
 - 
 
316 
	 * R base graphics parameters.
- 
 
317 
	 * This is supposed to happen via addDevice now.
 - 
 
318 
	 */
 - 
 
319 
	if (!(ptr_X11DeviceDriver)((DevDesc*)(dev), display, width, height, ps, gamma,
- 
 
320 
				      colormodel, maxcubesize, canvascolor)) {
 - 
 
321 
	    free(dev);
 - 
 
322 
	    errorcall(gcall, "unable to start device %s", devname);
 - 
 
323 
       	}
 - 
 
324 
	gsetVar(install(".Device"), mkString(devname), R_NilValue);
 - 
 
325 
	dd = GEcreateDevDesc(dev);
 - 
 
326 
	addDevice((DevDesc*) dd);
 - 
 
327 
	GEinitDisplayList(dd);
 - 
 
328 
    } END_SUSPEND_INTERRUPTS;
 - 
 
329
- 
 
330 
    return((DevDesc*) dd);
 - 
 
331 
}
 - 
 
332 
 
 -