The R Project SVN – R – Diff – /trunk/src/main/devices.c



 *  ps		= pointsize
 *  onefile     = {TRUE: normal; FALSE: single EPSF page}
 *  pagecentre  = centre plot region on paper?
 *  printit     = `print' after closing device?
 *  command     = `print' command
 *  title       = character string
 */
 
SEXP do_PS(SEXP call, SEXP op, SEXP args, SEXP env)
{
    NewDevDesc *dev = NULL;
    GEDevDesc *dd;
    char *vmax;
    char *file, *paper, *family=NULL, *bg, *fg, *cmd;
    char *afms[5], *encoding, *title;
    int i, horizontal, onefile, pagecentre, printit;
    double height, width, ps;
    SEXP fam;
 
    vmax = vmaxget();

	horizontal = 1;
    ps = asReal(CAR(args));	      args = CDR(args);
    onefile = asLogical(CAR(args));   args = CDR(args);
    pagecentre = asLogical(CAR(args));args = CDR(args);
    printit = asLogical(CAR(args));   args = CDR(args);
    cmd = SaveString(CAR(args), 0, call); args = CDR(args);
    title = SaveString(CAR(args), 0, call);
 
    R_CheckDeviceAvailable();
    BEGIN_SUSPEND_INTERRUPTS {
	if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))
	    return 0;

	 * This (and displayList) get protected during GC
	 */
	dev->savedSnapshot = R_NilValue;
	if(!PSDeviceDriver((DevDesc*) dev, file, paper, family, afms, encoding, bg, fg,
			   width, height, (double)horizontal, ps, onefile,
			   pagecentre, printit, cmd, title)) {
	    free(dev);
	    errorcall(call, "unable to start device PostScript");
	}
	gsetVar(install(".Device"), mkString("postscript"), R_NilValue);
	dd = GEcreateDevDesc(dev);

 *  bg		= background color
 *  fg		= foreground color
 *  width	= width in inches
 *  height	= height in inches
 *  ps		= pointsize
 *  onefile     = {TRUE: normal; FALSE: single page per file}
 *  title
 */
 
SEXP do_PDF(SEXP call, SEXP op, SEXP args, SEXP env)
{
    NewDevDesc *dev = NULL;
    GEDevDesc *dd;
    char *vmax;
    char *file, *encoding, *family, *bg, *fg, *title;
    double height, width, ps;
    int onefile;
 
 
    vmax = vmaxget();

    bg = SaveString(CAR(args), 0, call);    args = CDR(args);
    fg = SaveString(CAR(args), 0, call);    args = CDR(args);
    width = asReal(CAR(args));	      args = CDR(args);
    height = asReal(CAR(args));	      args = CDR(args);
    ps = asReal(CAR(args));           args = CDR(args);
    onefile = asLogical(CAR(args)); args = CDR(args);
    title = SaveString(CAR(args), 0, call);
 
 
    R_CheckDeviceAvailable();
    BEGIN_SUSPEND_INTERRUPTS {
	if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))
	    return 0;

	/* Make sure that this is initialised before a GC can occur.
	 * This (and displayList) get protected during GC
	 */
	dev->savedSnapshot = R_NilValue;
	if(!PDFDeviceDriver((DevDesc*) dev, file, family, encoding, bg, fg, 
			    width, height, ps, onefile, title)) {
	    free(dev);
	    errorcall(call, "unable to start device pdf");
	}
	gsetVar(install(".Device"), mkString("pdf"), R_NilValue);
	dd = GEcreateDevDesc(dev);

Rev 19912	Rev 22279
Line 54...	Line 54...
54	`* ps = pointsize`	54	`* ps = pointsize`
55	`* onefile = {TRUE: normal; FALSE: single EPSF page}`	55	`* onefile = {TRUE: normal; FALSE: single EPSF page}`
56	`* pagecentre = centre plot region on paper?`	56	`* pagecentre = centre plot region on paper?`
57	* printit = `print' after closing device?	57	* printit = `print' after closing device?
58	* command = `print' command	58	* command = `print' command
-		59	`* title = character string`
59	`*/`	60	`*/`
60		61
61	`SEXP do_PS(SEXP call, SEXP op, SEXP args, SEXP env)`	62	`SEXP do_PS(SEXP call, SEXP op, SEXP args, SEXP env)`
62	`{`	63	`{`
63	`NewDevDesc *dev = NULL;`	64	`NewDevDesc *dev = NULL;`
64	`GEDevDesc *dd;`	65	`GEDevDesc *dd;`
65	`char *vmax;`	66	`char *vmax;`
66	`char file, paper, family=NULL, bg, fg, cmd;`	67	`char file, paper, family=NULL, bg, fg, cmd;`
67	`char afms[5], encoding;`	68	`char afms[5], encoding, *title;`
68	`int i, horizontal, onefile, pagecentre, printit;`	69	`int i, horizontal, onefile, pagecentre, printit;`
69	`double height, width, ps;`	70	`double height, width, ps;`
70	`SEXP fam;`	71	`SEXP fam;`
71		72
72	`vmax = vmaxget();`	73	`vmax = vmaxget();`
Line 94...	Line 95...
94	`horizontal = 1;`	95	`horizontal = 1;`
95	`ps = asReal(CAR(args)); args = CDR(args);`	96	`ps = asReal(CAR(args)); args = CDR(args);`
96	`onefile = asLogical(CAR(args)); args = CDR(args);`	97	`onefile = asLogical(CAR(args)); args = CDR(args);`
97	`pagecentre = asLogical(CAR(args));args = CDR(args);`	98	`pagecentre = asLogical(CAR(args));args = CDR(args);`
98	`printit = asLogical(CAR(args)); args = CDR(args);`	99	`printit = asLogical(CAR(args)); args = CDR(args);`
-		100	`cmd = SaveString(CAR(args), 0, call); args = CDR(args);`
99	`cmd = SaveString(CAR(args), 0, call);`	101	`title = SaveString(CAR(args), 0, call);`
100		102
101	`R_CheckDeviceAvailable();`	103	`R_CheckDeviceAvailable();`
102	`BEGIN_SUSPEND_INTERRUPTS {`	104	`BEGIN_SUSPEND_INTERRUPTS {`
103	`if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))`	105	`if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))`
104	`return 0;`	106	`return 0;`
Line 108...	Line 110...
108	`* This (and displayList) get protected during GC`	110	`* This (and displayList) get protected during GC`
109	`*/`	111	`*/`
110	`dev->savedSnapshot = R_NilValue;`	112	`dev->savedSnapshot = R_NilValue;`
111	`if(!PSDeviceDriver((DevDesc*) dev, file, paper, family, afms, encoding, bg, fg,`	113	`if(!PSDeviceDriver((DevDesc*) dev, file, paper, family, afms, encoding, bg, fg,`
112	`width, height, (double)horizontal, ps, onefile,`	114	`width, height, (double)horizontal, ps, onefile,`
113	`pagecentre, printit, cmd)) {`	115	`pagecentre, printit, cmd, title)) {`
114	`free(dev);`	116	`free(dev);`
115	`errorcall(call, "unable to start device PostScript");`	117	`errorcall(call, "unable to start device PostScript");`
116	`}`	118	`}`
117	`gsetVar(install(".Device"), mkString("postscript"), R_NilValue);`	119	`gsetVar(install(".Device"), mkString("postscript"), R_NilValue);`
118	`dd = GEcreateDevDesc(dev);`	120	`dd = GEcreateDevDesc(dev);`
Line 249...	Line 251...
249	`* bg = background color`	251	`* bg = background color`
250	`* fg = foreground color`	252	`* fg = foreground color`
251	`* width = width in inches`	253	`* width = width in inches`
252	`* height = height in inches`	254	`* height = height in inches`
253	`* ps = pointsize`	255	`* ps = pointsize`
-		256	`* onefile = {TRUE: normal; FALSE: single page per file}`
-		257	`* title`
254	`*/`	258	`*/`
255		259
256	`SEXP do_PDF(SEXP call, SEXP op, SEXP args, SEXP env)`	260	`SEXP do_PDF(SEXP call, SEXP op, SEXP args, SEXP env)`
257	`{`	261	`{`
258	`NewDevDesc *dev = NULL;`	262	`NewDevDesc *dev = NULL;`
259	`GEDevDesc *dd;`	263	`GEDevDesc *dd;`
260	`char *vmax;`	264	`char *vmax;`
261	`char file, encoding, family, bg, *fg;`	265	`char file, encoding, family, bg, fg, title;`
262	`double height, width, ps;`	266	`double height, width, ps;`
263	`int onefile;`	267	`int onefile;`
264		268
265		269
266	`vmax = vmaxget();`	270	`vmax = vmaxget();`
Line 270...	Line 274...
270	`bg = SaveString(CAR(args), 0, call); args = CDR(args);`	274	`bg = SaveString(CAR(args), 0, call); args = CDR(args);`
271	`fg = SaveString(CAR(args), 0, call); args = CDR(args);`	275	`fg = SaveString(CAR(args), 0, call); args = CDR(args);`
272	`width = asReal(CAR(args)); args = CDR(args);`	276	`width = asReal(CAR(args)); args = CDR(args);`
273	`height = asReal(CAR(args)); args = CDR(args);`	277	`height = asReal(CAR(args)); args = CDR(args);`
274	`ps = asReal(CAR(args)); args = CDR(args);`	278	`ps = asReal(CAR(args)); args = CDR(args);`
275	`onefile = asLogical(CAR(args));`	279	`onefile = asLogical(CAR(args)); args = CDR(args);`
-		280	`title = SaveString(CAR(args), 0, call);`
-		281
276		282
277	`R_CheckDeviceAvailable();`	283	`R_CheckDeviceAvailable();`
278	`BEGIN_SUSPEND_INTERRUPTS {`	284	`BEGIN_SUSPEND_INTERRUPTS {`
279	`if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))`	285	`if (!(dev = (NewDevDesc *) calloc(1, sizeof(NewDevDesc))))`
280	`return 0;`	286	`return 0;`
Line 283...	Line 289...
283	`/* Make sure that this is initialised before a GC can occur.`	289	`/* Make sure that this is initialised before a GC can occur.`
284	`* This (and displayList) get protected during GC`	290	`* This (and displayList) get protected during GC`
285	`*/`	291	`*/`
286	`dev->savedSnapshot = R_NilValue;`	292	`dev->savedSnapshot = R_NilValue;`
287	`if(!PDFDeviceDriver((DevDesc*) dev, file, family, encoding, bg, fg,`	293	`if(!PDFDeviceDriver((DevDesc*) dev, file, family, encoding, bg, fg,`
288	`width, height, ps, onefile)) {`	294	`width, height, ps, onefile, title)) {`
289	`free(dev);`	295	`free(dev);`
290	`errorcall(call, "unable to start device pdf");`	296	`errorcall(call, "unable to start device pdf");`
291	`}`	297	`}`
292	`gsetVar(install(".Device"), mkString("pdf"), R_NilValue);`	298	`gsetVar(install(".Device"), mkString("pdf"), R_NilValue);`
293	`dd = GEcreateDevDesc(dev);`	299	`dd = GEcreateDevDesc(dev);`

The R Project SVN R

(root)/trunk/src/main/devices.c @ 28362 – Rev 19912 → 22279