1 /*
2  *  A PicTeX device, (C) 1996 Valerio Aimale, for
3  *  R : A Computer Language for Statistical Data Analysis
4  *  Copyright (C) 2001--2020  The R Core Team
5  *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
6  *
7  *  This program is free software; you can redistribute it and/or modify
8  *  it under the terms of the GNU General Public License as published by
9  *  the Free Software Foundation; either version 2 of the License, or
10  *  (at your option) any later version.
11  *
12  *  This program is distributed in the hope that it will be useful,
13  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  *  GNU General Public License for more details.
16  *
17  *  You should have received a copy of the GNU General Public License
18  *  along with this program; if not, a copy is available at
19  *  https://www.R-project.org/Licenses/
20  */
21 
22 #ifdef HAVE_CONFIG_H
23 # include <config.h>
24 #endif
25 
26 #include <Defn.h>
27 
28 # include <rlocale.h> /* includes wchar.h */
29 
30 #define R_USE_PROTOTYPES 1
31 #include <R_ext/GraphicsEngine.h>
32 #include "Fileio.h"
33 #include "grDevices.h"
34 
35 	/* device-specific information per picTeX device */
36 
37 #define DOTSperIN	72.27
38 #define in2dots(x) 	(DOTSperIN * x)
39 
40 typedef struct {
41     FILE *texfp;
42     char filename[128];
43     int pageno;
44     int landscape;
45     double width;
46     double height;
47     double pagewidth;
48     double pageheight;
49     double xlast;
50     double ylast;
51     double clipleft, clipright, cliptop, clipbottom;
52     double clippedx0, clippedy0, clippedx1, clippedy1;
53     int lty;
54     rcolor col;
55     rcolor fill;
56     int fontsize;
57     int fontface;
58     Rboolean debug;
59 } picTeXDesc;
60 
61 
62 	/* Global device information */
63 
64 static const double charwidth[4][128] = {
65 {
66   0.5416690, 0.8333360, 0.7777810, 0.6111145, 0.6666690, 0.7083380, 0.7222240,
67   0.7777810, 0.7222240, 0.7777810, 0.7222240, 0.5833360, 0.5361130, 0.5361130,
68   0.8138910, 0.8138910, 0.2388900, 0.2666680, 0.5000020, 0.5000020, 0.5000020,
69   0.5000020, 0.5000020, 0.6666700, 0.4444460, 0.4805580, 0.7222240, 0.7777810,
70   0.5000020, 0.8611145, 0.9722260, 0.7777810, 0.2388900, 0.3194460, 0.5000020,
71   0.8333360, 0.5000020, 0.8333360, 0.7583360, 0.2777790, 0.3888900, 0.3888900,
72   0.5000020, 0.7777810, 0.2777790, 0.3333340, 0.2777790, 0.5000020, 0.5000020,
73   0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020,
74   0.5000020, 0.5000020, 0.2777790, 0.2777790, 0.3194460, 0.7777810, 0.4722240,
75   0.4722240, 0.6666690, 0.6666700, 0.6666700, 0.6388910, 0.7222260, 0.5972240,
76   0.5694475, 0.6666690, 0.7083380, 0.2777810, 0.4722240, 0.6944480, 0.5416690,
77   0.8750050, 0.7083380, 0.7361130, 0.6388910, 0.7361130, 0.6458360, 0.5555570,
78   0.6805570, 0.6875050, 0.6666700, 0.9444480, 0.6666700, 0.6666700, 0.6111130,
79   0.2888900, 0.5000020, 0.2888900, 0.5000020, 0.2777790, 0.2777790, 0.4805570,
80   0.5166680, 0.4444460, 0.5166680, 0.4444460, 0.3055570, 0.5000020, 0.5166680,
81   0.2388900, 0.2666680, 0.4888920, 0.2388900, 0.7944470, 0.5166680, 0.5000020,
82   0.5166680, 0.5166680, 0.3416690, 0.3833340, 0.3611120, 0.5166680, 0.4611130,
83   0.6833360, 0.4611130, 0.4611130, 0.4347230, 0.5000020, 1.0000030, 0.5000020,
84   0.5000020, 0.5000020
85 },
86 {
87   0.5805590, 0.9166720, 0.8555600, 0.6722260, 0.7333370, 0.7944490, 0.7944490,
88   0.8555600, 0.7944490, 0.8555600, 0.7944490, 0.6416700, 0.5861150, 0.5861150,
89   0.8916720, 0.8916720, 0.2555570, 0.2861130, 0.5500030, 0.5500030, 0.5500030,
90   0.5500030, 0.5500030, 0.7333370, 0.4888920, 0.5652800, 0.7944490, 0.8555600,
91   0.5500030, 0.9472275, 1.0694500, 0.8555600, 0.2555570, 0.3666690, 0.5583360,
92   0.9166720, 0.5500030, 1.0291190, 0.8305610, 0.3055570, 0.4277800, 0.4277800,
93   0.5500030, 0.8555600, 0.3055570, 0.3666690, 0.3055570, 0.5500030, 0.5500030,
94   0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030,
95   0.5500030, 0.5500030, 0.3055570, 0.3055570, 0.3666690, 0.8555600, 0.5194470,
96   0.5194470, 0.7333370, 0.7333370, 0.7333370, 0.7027820, 0.7944490, 0.6416700,
97   0.6111145, 0.7333370, 0.7944490, 0.3305570, 0.5194470, 0.7638930, 0.5805590,
98   0.9777830, 0.7944490, 0.7944490, 0.7027820, 0.7944490, 0.7027820, 0.6111145,
99   0.7333370, 0.7638930, 0.7333370, 1.0388950, 0.7333370, 0.7333370, 0.6722260,
100   0.3430580, 0.5583360, 0.3430580, 0.5500030, 0.3055570, 0.3055570, 0.5250030,
101   0.5611140, 0.4888920, 0.5611140, 0.5111140, 0.3361130, 0.5500030, 0.5611140,
102   0.2555570, 0.2861130, 0.5305590, 0.2555570, 0.8666720, 0.5611140, 0.5500030,
103   0.5611140, 0.5611140, 0.3722250, 0.4216690, 0.4041690, 0.5611140, 0.5000030,
104   0.7444490, 0.5000030, 0.5000030, 0.4763920, 0.5500030, 1.1000060, 0.5500030,
105   0.5500030, 0.550003 },
106 {
107   0.5416690, 0.8333360, 0.7777810, 0.6111145, 0.6666690, 0.7083380, 0.7222240,
108   0.7777810, 0.7222240, 0.7777810, 0.7222240, 0.5833360, 0.5361130, 0.5361130,
109   0.8138910, 0.8138910, 0.2388900, 0.2666680, 0.5000020, 0.5000020, 0.5000020,
110   0.5000020, 0.5000020, 0.7375210, 0.4444460, 0.4805580, 0.7222240, 0.7777810,
111   0.5000020, 0.8611145, 0.9722260, 0.7777810, 0.2388900, 0.3194460, 0.5000020,
112   0.8333360, 0.5000020, 0.8333360, 0.7583360, 0.2777790, 0.3888900, 0.3888900,
113   0.5000020, 0.7777810, 0.2777790, 0.3333340, 0.2777790, 0.5000020, 0.5000020,
114   0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020, 0.5000020,
115   0.5000020, 0.5000020, 0.2777790, 0.2777790, 0.3194460, 0.7777810, 0.4722240,
116   0.4722240, 0.6666690, 0.6666700, 0.6666700, 0.6388910, 0.7222260, 0.5972240,
117   0.5694475, 0.6666690, 0.7083380, 0.2777810, 0.4722240, 0.6944480, 0.5416690,
118   0.8750050, 0.7083380, 0.7361130, 0.6388910, 0.7361130, 0.6458360, 0.5555570,
119   0.6805570, 0.6875050, 0.6666700, 0.9444480, 0.6666700, 0.6666700, 0.6111130,
120   0.2888900, 0.5000020, 0.2888900, 0.5000020, 0.2777790, 0.2777790, 0.4805570,
121   0.5166680, 0.4444460, 0.5166680, 0.4444460, 0.3055570, 0.5000020, 0.5166680,
122   0.2388900, 0.2666680, 0.4888920, 0.2388900, 0.7944470, 0.5166680, 0.5000020,
123   0.5166680, 0.5166680, 0.3416690, 0.3833340, 0.3611120, 0.5166680, 0.4611130,
124   0.6833360, 0.4611130, 0.4611130, 0.4347230, 0.5000020, 1.0000030, 0.5000020,
125   0.5000020, 0.5000020 },
126 {
127   0.5805590, 0.9166720, 0.8555600, 0.6722260, 0.7333370, 0.7944490, 0.7944490,
128   0.8555600, 0.7944490, 0.8555600, 0.7944490, 0.6416700, 0.5861150, 0.5861150,
129   0.8916720, 0.8916720, 0.2555570, 0.2861130, 0.5500030, 0.5500030, 0.5500030,
130   0.5500030, 0.5500030, 0.8002530, 0.4888920, 0.5652800, 0.7944490, 0.8555600,
131   0.5500030, 0.9472275, 1.0694500, 0.8555600, 0.2555570, 0.3666690, 0.5583360,
132   0.9166720, 0.5500030, 1.0291190, 0.8305610, 0.3055570, 0.4277800, 0.4277800,
133   0.5500030, 0.8555600, 0.3055570, 0.3666690, 0.3055570, 0.5500030, 0.5500030,
134   0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030, 0.5500030,
135   0.5500030, 0.5500030, 0.3055570, 0.3055570, 0.3666690, 0.8555600, 0.5194470,
136   0.5194470, 0.7333370, 0.7333370, 0.7333370, 0.7027820, 0.7944490, 0.6416700,
137   0.6111145, 0.7333370, 0.7944490, 0.3305570, 0.5194470, 0.7638930, 0.5805590,
138   0.9777830, 0.7944490, 0.7944490, 0.7027820, 0.7944490, 0.7027820, 0.6111145,
139   0.7333370, 0.7638930, 0.7333370, 1.0388950, 0.7333370, 0.7333370, 0.6722260,
140   0.3430580, 0.5583360, 0.3430580, 0.5500030, 0.3055570, 0.3055570, 0.5250030,
141   0.5611140, 0.4888920, 0.5611140, 0.5111140, 0.3361130, 0.5500030, 0.5611140,
142   0.2555570, 0.2861130, 0.5305590, 0.2555570, 0.8666720, 0.5611140, 0.5500030,
143   0.5611140, 0.5611140, 0.3722250, 0.4216690, 0.4041690, 0.5611140, 0.5000030,
144   0.7444490, 0.5000030, 0.5000030, 0.4763920, 0.5500030, 1.1000060, 0.5500030,
145   0.5500030, 0.550003
146 }
147 };
148 
149 static const char * const fontname[] = {
150     "cmss10",
151     "cmssbx10",
152     "cmssi10",
153     "cmssxi10"
154 };
155 
156 
157 	/* Device driver actions */
158 
159 static void PicTeX_Circle(double x, double y, double r,
160 			  const pGEcontext gc,
161 			  pDevDesc dd);
162 static void PicTeX_Clip(double x0, double x1, double y0, double y1,
163 			pDevDesc dd);
164 static void PicTeX_Close(pDevDesc dd);
165 static void PicTeX_Line(double x1, double y1, double x2, double y2,
166 			const pGEcontext gc,
167 			pDevDesc dd);
168 static void PicTeX_MetricInfo(int c,
169 			      const pGEcontext gc,
170 			      double* ascent, double* descent,
171 			      double* width, pDevDesc dd);
172 static void PicTeX_NewPage(const pGEcontext gc, pDevDesc dd);
173 static void PicTeX_Polygon(int n, double *x, double *y,
174 			   const pGEcontext gc,
175 			   pDevDesc dd);
176 static void PicTeX_Rect(double x0, double y0, double x1, double y1,
177 			const pGEcontext gc,
178 			pDevDesc dd);
179 static void PicTeX_Size(double *left, double *right,
180 			double *bottom, double *top,
181 			pDevDesc dd);
182 static double PicTeX_StrWidth(const char *str,
183 			      const pGEcontext gc,
184 			      pDevDesc dd);
185 static void PicTeX_Text(double x, double y, const char *str,
186 			double rot, double hadj,
187 			const pGEcontext gc,
188 			pDevDesc dd);
189 static SEXP     PicTeX_setPattern(SEXP pattern, pDevDesc dd);
190 static void     PicTeX_releasePattern(SEXP ref, pDevDesc dd);
191 static SEXP     PicTeX_setClipPath(SEXP path, SEXP ref, pDevDesc dd);
192 static void     PicTeX_releaseClipPath(SEXP ref, pDevDesc dd);
193 static SEXP     PicTeX_setMask(SEXP path, SEXP ref, pDevDesc dd);
194 static void     PicTeX_releaseMask(SEXP ref, pDevDesc dd);
195 
196 	/* Support routines */
197 
SetLinetype(int newlty,double newlwd,pDevDesc dd)198 static void SetLinetype(int newlty, double newlwd, pDevDesc dd)
199 {
200     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
201 
202     int i, templty;
203     ptd->lty = newlty;
204     if (ptd->lty) {
205 	fprintf(ptd->texfp,"\\setdashpattern <");
206 	for(i=0 ; i<8 && newlty&15 ; i++) {
207 	    int lwd = (int)newlwd * newlty;
208 	    fprintf(ptd->texfp,"%dpt", lwd & 15);
209 	    templty = newlty>>4;
210 	    if ((i+1)<8 && templty&15) fprintf(ptd->texfp,", ");
211 	    newlty = newlty>>4;
212 	}
213 	fprintf(ptd->texfp,">\n");
214     } else fprintf(ptd->texfp,"\\setsolid\n");
215 }
216 
217 
SetFont(int face,int size,picTeXDesc * ptd)218 static void SetFont(int face, int size, picTeXDesc *ptd)
219 {
220     int lface=face, lsize= size;
221     if(lface < 1 || lface > 4 ) lface = 1;
222     if(lsize < 1 || lsize > 24) lsize = 10;
223     if(lsize != ptd->fontsize || lface != ptd->fontface) {
224 	fprintf(ptd->texfp, "\\font\\picfont %s at %dpt\\picfont\n",
225 		fontname[lface-1], lsize);
226 	ptd->fontsize = lsize;
227 	ptd->fontface = lface;
228     }
229 }
230 
PicTeX_MetricInfo(int c,const pGEcontext gc,double * ascent,double * descent,double * width,pDevDesc dd)231 static void PicTeX_MetricInfo(int c,
232 			      const pGEcontext gc,
233 			      double* ascent, double* descent,
234 			      double* width, pDevDesc dd)
235 {
236     /* metric information not available => return 0,0,0 */
237     *ascent = 0.0;
238     *descent = 0.0;
239     *width = 0.0;
240 }
241 
242 	/* Initialize the device */
243 
244 
245 
246 	/* Interactive Resize */
247 
PicTeX_Size(double * left,double * right,double * bottom,double * top,pDevDesc dd)248 static void PicTeX_Size(double *left, double *right,
249 		     double *bottom, double *top,
250 		     pDevDesc dd)
251 {
252     *left = dd->left;		/* left */
253     *right = dd->right;/* right */
254     *bottom = dd->bottom;		/* bottom */
255     *top = dd->top;/* top */
256 }
257 
PicTeX_Clip(double x0,double x1,double y0,double y1,pDevDesc dd)258 static void PicTeX_Clip(double x0, double x1, double y0, double y1,
259 			pDevDesc dd)
260 {
261     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
262 
263     if(ptd->debug)
264 	fprintf(ptd->texfp, "%% Setting Clip Region to %.2f %.2f %.2f %.2f\n",
265 		x0, y0, x1, y1);
266     ptd->clipleft = x0;
267     ptd->clipright = x1;
268     ptd->clipbottom = y0;
269     ptd->cliptop = y1;
270 }
271 
272 	/* Start a new page */
273 
PicTeX_NewPage(const pGEcontext gc,pDevDesc dd)274 static void PicTeX_NewPage(const pGEcontext gc,
275 			   pDevDesc dd)
276 {
277     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
278 
279     int face, size;
280     if (ptd->pageno) {
281 	fprintf(ptd->texfp, "\\endpicture\n}\n\n\n");
282 	fprintf(ptd->texfp, "\\hbox{\\beginpicture\n");
283 	fprintf(ptd->texfp, "\\setcoordinatesystem units <1pt,1pt>\n");
284 	fprintf(ptd->texfp,
285 		"\\setplotarea x from 0 to %.2f, y from 0 to %.2f\n",
286 		in2dots(ptd->width), in2dots(ptd->height));
287 	fprintf(ptd->texfp,"\\setlinear\n");
288 	fprintf(ptd->texfp, "\\font\\picfont cmss10\\picfont\n");
289     }
290     ptd->pageno++;
291     face = ptd->fontface;
292     size = ptd->fontsize;
293     ptd->fontface = 0;
294     ptd->fontsize = 0;
295     SetFont(face, size, ptd);
296 }
297 
298 	/* Close down the driver */
299 
PicTeX_Close(pDevDesc dd)300 static void PicTeX_Close(pDevDesc dd)
301 {
302     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
303 
304     fprintf(ptd->texfp, "\\endpicture\n}\n");
305     fclose(ptd->texfp);
306 
307     free(ptd);
308 }
309 
310 	/* Draw To */
311 
PicTeX_ClipLine(double x0,double y0,double x1,double y1,picTeXDesc * ptd)312 static void PicTeX_ClipLine(double x0, double y0, double x1, double y1,
313 			    picTeXDesc *ptd)
314 {
315     ptd->clippedx0 = x0; ptd->clippedx1 = x1;
316     ptd->clippedy0 = y0; ptd->clippedy1 = y1;
317 
318     if ((ptd->clippedx0 < ptd->clipleft &&
319 	 ptd->clippedx1 < ptd->clipleft) ||
320 	(ptd->clippedx0 > ptd->clipright &&
321 	 ptd->clippedx1 > ptd->clipright) ||
322 	(ptd->clippedy0 < ptd->clipbottom &&
323 	 ptd->clippedy1 < ptd->clipbottom) ||
324 	(ptd->clippedy0 > ptd->cliptop &&
325 	 ptd->clippedy1 > ptd->cliptop)) {
326 	ptd->clippedx0 = ptd->clippedx1;
327 	ptd->clippedy0 = ptd->clippedy1;
328 	return;
329     }
330 
331     /*Clipping Left */
332     if (ptd->clippedx1 >= ptd->clipleft && ptd->clippedx0 < ptd->clipleft) {
333 	ptd->clippedy0 = ((ptd->clippedy1-ptd->clippedy0) /
334 			  (ptd->clippedx1-ptd->clippedx0) *
335 			  (ptd->clipleft-ptd->clippedx0)) +
336 	    ptd->clippedy0;
337 	ptd->clippedx0 = ptd->clipleft;
338     }
339     if (ptd->clippedx1 <= ptd->clipleft && ptd->clippedx0 > ptd->clipleft) {
340 	ptd->clippedy1 = ((ptd->clippedy1-ptd->clippedy0) /
341 			  (ptd->clippedx1-ptd->clippedx0) *
342 			  (ptd->clipleft-ptd->clippedx0)) +
343 	    ptd->clippedy0;
344 	ptd->clippedx1 = ptd->clipleft;
345     }
346     /* Clipping Right */
347     if (ptd->clippedx1 >= ptd->clipright &&
348 	ptd->clippedx0 < ptd->clipright) {
349 	ptd->clippedy1 = ((ptd->clippedy1-ptd->clippedy0) /
350 			  (ptd->clippedx1-ptd->clippedx0) *
351 			  (ptd->clipright-ptd->clippedx0)) +
352 	    ptd->clippedy0;
353 	ptd->clippedx1 = ptd->clipright;
354     }
355     if (ptd->clippedx1 <= ptd->clipright &&
356 	ptd->clippedx0 > ptd->clipright) {
357 	ptd->clippedy0 = ((ptd->clippedy1-ptd->clippedy0) /
358 			  (ptd->clippedx1-ptd->clippedx0) *
359 			  (ptd->clipright-ptd->clippedx0)) +
360 	    ptd->clippedy0;
361 	ptd->clippedx0 = ptd->clipright;
362     }
363     /*Clipping Bottom */
364     if (ptd->clippedy1 >= ptd->clipbottom  &&
365 	ptd->clippedy0 < ptd->clipbottom ) {
366 	ptd->clippedx0 = ((ptd->clippedx1-ptd->clippedx0) /
367 			  (ptd->clippedy1-ptd->clippedy0) *
368 			  (ptd->clipbottom -ptd->clippedy0)) +
369 	    ptd->clippedx0;
370 	ptd->clippedy0 = ptd->clipbottom ;
371     }
372     if (ptd->clippedy1 <= ptd->clipbottom &&
373 	ptd->clippedy0 > ptd->clipbottom ) {
374 	ptd->clippedx1 = ((ptd->clippedx1-ptd->clippedx0) /
375 			  (ptd->clippedy1-ptd->clippedy0) *
376 			  (ptd->clipbottom -ptd->clippedy0)) +
377 	    ptd->clippedx0;
378 	ptd->clippedy1 = ptd->clipbottom ;
379     }
380     /*Clipping Top */
381     if (ptd->clippedy1 >= ptd->cliptop  && ptd->clippedy0 < ptd->cliptop ) {
382 	ptd->clippedx1 = ((ptd->clippedx1-ptd->clippedx0) /
383 			  (ptd->clippedy1-ptd->clippedy0) *
384 			  (ptd->cliptop -ptd->clippedy0)) +
385 	    ptd->clippedx0;
386 	ptd->clippedy1 = ptd->cliptop ;
387     }
388     if (ptd->clippedy1 <= ptd->cliptop && ptd->clippedy0 > ptd->cliptop ) {
389 	ptd->clippedx0 = ((ptd->clippedx1-ptd->clippedx0) /
390 			  (ptd->clippedy1-ptd->clippedy0) *
391 			  (ptd->cliptop -ptd->clippedy0)) +
392 	    ptd->clippedx0;
393 	ptd->clippedy0 = ptd->cliptop ;
394     }
395 }
396 
PicTeX_Line(double x1,double y1,double x2,double y2,const pGEcontext gc,pDevDesc dd)397 static void PicTeX_Line(double x1, double y1, double x2, double y2,
398 			const pGEcontext gc,
399 			pDevDesc dd)
400 {
401     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
402 
403     if (x1 != x2 || y1 != y2) {
404 	SetLinetype(gc->lty, gc->lwd, dd);
405 	if(ptd->debug)
406 	    fprintf(ptd->texfp,
407 		    "%% Drawing line from %.2f, %.2f to %.2f, %.2f\n",
408 		    x1, y1, x2, y2);
409 	PicTeX_ClipLine(x1, y1, x2, y2, ptd);
410 	if (ptd->debug)
411 	    fprintf(ptd->texfp,
412 		    "%% Drawing clipped line from %.2f, %.2f to %.2f, %.2f\n",
413 		    ptd->clippedx0, ptd->clippedy0,
414 		    ptd->clippedx1, ptd->clippedy1);
415 	fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n",
416 		ptd->clippedx0, ptd->clippedy0,
417 		ptd->clippedx1, ptd->clippedy1);
418     }
419 }
420 
PicTeX_Polyline(int n,double * x,double * y,const pGEcontext gc,pDevDesc dd)421 static void PicTeX_Polyline(int n, double *x, double *y,
422 			    const pGEcontext gc,
423 			    pDevDesc dd)
424 {
425     double x1, y1, x2, y2;
426     int i;
427     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
428 
429     SetLinetype(gc->lty, gc->lwd, dd);
430     x1 = x[0];
431     y1 = y[0];
432     for (i = 1; i < n; i++) {
433 	x2 = x[i];
434 	y2 = y[i];
435 	PicTeX_ClipLine(x1, y1, x2, y2, ptd);
436 	fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n",
437 		ptd->clippedx0, ptd->clippedy0,
438 		ptd->clippedx1, ptd->clippedy1);
439 	x1 = x2;
440 	y1 = y2;
441     }
442 }
443 
444 	/* String Width in Rasters */
445 	/* For the current font in pointsize fontsize */
446 
PicTeX_StrWidth(const char * str,const pGEcontext gc,pDevDesc dd)447 static double PicTeX_StrWidth(const char *str,
448 			      const pGEcontext gc,
449 			      pDevDesc dd)
450 {
451     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
452 
453     const char *p;
454     int size;
455     double sum;
456 
457     size = (int)(gc->cex * gc->ps + 0.5);
458     SetFont(gc->fontface, size, ptd);
459     sum = 0;
460     if(mbcslocale && ptd->fontface != 5) {
461 	/* This version at least uses the state of the MBCS */
462 	size_t i, ucslen = mbcsToUcs2(str, NULL, 0, CE_NATIVE);
463 	if (ucslen != (size_t)-1) {
464 	    R_ucs2_t ucs[ucslen];
465 	    int status = (int) mbcsToUcs2(str, ucs, (int)ucslen, CE_NATIVE);
466 	    if (status >= 0)
467 		for (i = 0; i < ucslen; i++)
468 		    if(ucs[i] < 128) sum += charwidth[ptd->fontface-1][ucs[i]];
469 		    else {
470 #ifdef USE_RI18N_WIDTH
471 			sum += (double) Ri18n_wcwidth(ucs[i]) * 0.5; /* A guess */
472 #else
473 			sum += (double) wcwidth((wchar_t)ucs[i]) * 0.5; /* A guess */
474 #endif
475 		    }
476 	    else
477 		warning(_("invalid string in '%s'"), "PicTeX_StrWidth");
478 	} else
479 	    warning(_("invalid string in '%s'"), "PicTeX_StrWidth");
480     } else
481 	for(p = str; *p; p++)
482 	    sum += charwidth[ptd->fontface-1][(int)*p];
483 
484     return sum * ptd->fontsize;
485 }
486 
487 
488 /* Possibly Filled Rectangle */
PicTeX_Rect(double x0,double y0,double x1,double y1,const pGEcontext gc,pDevDesc dd)489 static void PicTeX_Rect(double x0, double y0, double x1, double y1,
490 			const pGEcontext gc,
491 			pDevDesc dd)
492 {
493     double x[4], y[4];
494 
495     x[0] = x0; y[0] = y0;
496     x[1] = x0; y[1] = y1;
497     x[2] = x1; y[2] = y1;
498     x[3] = x1; y[3] = y0;
499     PicTeX_Polygon(4, x, y, gc, dd);
500 }
501 
502 
PicTeX_Circle(double x,double y,double r,const pGEcontext gc,pDevDesc dd)503 static void PicTeX_Circle(double x, double y, double r,
504 			  const pGEcontext gc,
505 			  pDevDesc dd)
506 {
507     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
508 
509     fprintf(ptd->texfp,
510 	    "\\circulararc 360 degrees from %.2f %.2f center at %.2f %.2f\n",
511 	    x, (y + r), x, y);
512 }
513 
PicTeX_Polygon(int n,double * x,double * y,const pGEcontext gc,pDevDesc dd)514 static void PicTeX_Polygon(int n, double *x, double *y,
515 			   const pGEcontext gc,
516 			   pDevDesc dd)
517 {
518     double x1, y1, x2, y2;
519     int i;
520     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
521 
522     SetLinetype(gc->lty, gc->lwd, dd);
523     x1 = x[0];
524     y1 = y[0];
525     for (i=1; i<n; i++) {
526 	x2 = x[i];
527 	y2 = y[i];
528 	PicTeX_ClipLine(x1, y1, x2, y2, ptd);
529 	fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n",
530 		ptd->clippedx0, ptd->clippedy0,
531 		ptd->clippedx1, ptd->clippedy1);
532 	x1 = x2;
533 	y1 = y2;
534     }
535     x2 = x[0];
536     y2 = y[0];
537     PicTeX_ClipLine(x1, y1, x2, y2, ptd);
538     fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n",
539 	    ptd->clippedx0, ptd->clippedy0,
540 	    ptd->clippedx1, ptd->clippedy1);
541 }
542 
543 /* TeX Text Translations */
textext(const char * str,picTeXDesc * ptd)544 static void textext(const char *str, picTeXDesc *ptd)
545 {
546     fputc('{', ptd->texfp);
547     for( ; *str ; str++)
548 	switch(*str) {
549 	case '$':
550 	    fprintf(ptd->texfp, "\\$");
551 	    break;
552 
553 	case '%':
554 	    fprintf(ptd->texfp, "\\%%");
555 	    break;
556 
557 	case '{':
558 	    fprintf(ptd->texfp, "\\{");
559 	    break;
560 
561 	case '}':
562 	    fprintf(ptd->texfp, "\\}");
563 	    break;
564 
565 	case '^':
566 	    fprintf(ptd->texfp, "\\^{}");
567 	    break;
568 
569 	default:
570 	    fputc(*str, ptd->texfp);
571 	    break;
572 	}
573     fprintf(ptd->texfp,"} ");
574 }
575 
576 /* Rotated Text */
577 
PicTeX_Text(double x,double y,const char * str,double rot,double hadj,const pGEcontext gc,pDevDesc dd)578 static void PicTeX_Text(double x, double y, const char *str,
579 			double rot, double hadj,
580 			const pGEcontext gc,
581 			pDevDesc dd)
582 {
583     int size;
584     double xoff = 0.0, yoff = 0.0;
585     picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
586 
587     size = (int)(gc->cex * gc->ps + 0.5);
588     SetFont(gc->fontface, size, ptd);
589     if(ptd->debug)
590 	fprintf(ptd->texfp,
591 		"%% Writing string of length %.2f, at %.2f %.2f, xc = %.2f yc = %.2f\n",
592 		(double)PicTeX_StrWidth(str, gc, dd),
593 		x, y, 0.0, 0.0);
594 #if 0 /* Original */
595     fprintf(ptd->texfp,"\\put ");
596     textext(str, ptd);
597     if (rot == 90 )
598 	fprintf(ptd->texfp," [rB] <%.2fpt,%.2fpt>", xoff, yoff);
599     else fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff);
600 #else /* use rotatebox */
601     if (rot == 90 ){
602 	fprintf(ptd->texfp,"\\put {\\rotatebox{%d}",(int)rot);
603 	textext(str, ptd);
604 	fprintf(ptd->texfp,"} [rB] <%.2fpt,%.2fpt>", xoff, yoff);
605     } else {
606 	fprintf(ptd->texfp,"\\put ");
607 	textext(str, ptd);
608 	fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff);
609     }
610 #endif
611     fprintf(ptd->texfp," at %.2f %.2f\n", x, y);
612 }
613 
PicTeX_setPattern(SEXP pattern,pDevDesc dd)614 static SEXP PicTeX_setPattern(SEXP pattern, pDevDesc dd) {
615     return R_NilValue;
616 }
617 
PicTeX_releasePattern(SEXP ref,pDevDesc dd)618 static void PicTeX_releasePattern(SEXP ref, pDevDesc dd) {}
619 
PicTeX_setClipPath(SEXP path,SEXP ref,pDevDesc dd)620 static SEXP PicTeX_setClipPath(SEXP path, SEXP ref, pDevDesc dd) {
621     return R_NilValue;
622 }
623 
PicTeX_releaseClipPath(SEXP ref,pDevDesc dd)624 static void PicTeX_releaseClipPath(SEXP ref, pDevDesc dd) {}
625 
PicTeX_setMask(SEXP path,SEXP ref,pDevDesc dd)626 static SEXP PicTeX_setMask(SEXP path, SEXP ref, pDevDesc dd) {
627     return R_NilValue;
628 }
629 
PicTeX_releaseMask(SEXP ref,pDevDesc dd)630 static void PicTeX_releaseMask(SEXP ref, pDevDesc dd) {}
631 
632 
633 static
PicTeXDeviceDriver(pDevDesc dd,const char * filename,const char * bg,const char * fg,double width,double height,Rboolean debug)634 Rboolean PicTeXDeviceDriver(pDevDesc dd, const char *filename,
635 			    const char *bg, const char *fg,
636 			    double width, double height,
637 			    Rboolean debug)
638 {
639     picTeXDesc *ptd;
640 
641     if (!(ptd = (picTeXDesc *) malloc(sizeof(picTeXDesc))))
642 	return FALSE;
643     if (!(ptd->texfp = R_fopen(R_ExpandFileName(filename), "w"))) {
644 	free(ptd);
645 	return FALSE;
646     }
647 
648     strcpy(ptd->filename, filename);
649 
650     dd->startfill = R_GE_str2col(bg);
651     dd->startcol = R_GE_str2col(fg);
652     dd->startps = 10;
653     dd->startlty = 0;
654     dd->startfont = 1;
655     dd->startgamma = 1;
656 
657     dd->close = PicTeX_Close;
658     dd->clip = PicTeX_Clip;
659     dd->size = PicTeX_Size;
660     dd->newPage = PicTeX_NewPage;
661     dd->line = PicTeX_Line;
662     dd->text = PicTeX_Text;
663     dd->strWidth = PicTeX_StrWidth;
664     dd->rect = PicTeX_Rect;
665     dd->circle = PicTeX_Circle;
666     /* dd->path = PicTeX_Path; not implemented */
667     dd->polygon = PicTeX_Polygon;
668     dd->polyline = PicTeX_Polyline;
669     dd->metricInfo = PicTeX_MetricInfo;
670     dd->hasTextUTF8 = FALSE;
671     dd->useRotatedTextInContour = FALSE;
672     dd->setPattern      = PicTeX_setPattern;
673     dd->releasePattern  = PicTeX_releasePattern;
674     dd->setClipPath     = PicTeX_setClipPath;
675     dd->releaseClipPath = PicTeX_releaseClipPath;
676     dd->setMask         = PicTeX_setMask;
677     dd->releaseMask     = PicTeX_releaseMask;
678 
679     /* Screen Dimensions in Pixels */
680 
681     dd->left = 0;		/* left */
682     dd->right = in2dots(width);/* right */
683     dd->bottom = 0;		/* bottom */
684     dd->top = in2dots(height);/* top */
685     dd->clipLeft = dd->left; dd->clipRight = dd->right;
686     dd->clipBottom = dd->bottom; dd->clipTop = dd->top;
687     ptd->width = width;
688     ptd->height = height;
689 
690     // PicTeX_Open():
691     ptd->fontsize = 0;
692     ptd->fontface = 0;
693     ptd->debug = FALSE;
694     fprintf(ptd->texfp, "\\hbox{\\beginpicture\n");
695     fprintf(ptd->texfp, "\\setcoordinatesystem units <1pt,1pt>\n");
696     fprintf(ptd->texfp,
697 	    "\\setplotarea x from 0 to %.2f, y from 0 to %.2f\n",
698 	    in2dots(ptd->width), in2dots(ptd->height));
699     fprintf(ptd->texfp,"\\setlinear\n");
700     fprintf(ptd->texfp, "\\font\\picfont cmss10\\picfont\n");
701     SetFont(1, 10, ptd);
702     ptd->pageno++;
703 
704     /* Base Pointsize */
705     /* Nominal Character Sizes in Pixels */
706 
707     dd->cra[0] =  9;
708     dd->cra[1] = 12;
709 
710     /* Character Addressing Offsets */
711     /* These offsets should center a single */
712     /* plotting character over the plotting point. */
713     /* Pure guesswork and eyeballing ... */
714 
715     dd->xCharOffset =  0; /*0.4900;*/
716     dd->yCharOffset =  0; /*0.3333;*/
717     dd->yLineBias = 0; /*0.1;*/
718 
719     /* Inches per Raster Unit */
720     /* We use printer points, i.e. 72.27 dots per inch : */
721     dd->ipr[0] = dd->ipr[1] = 1./DOTSperIN;
722 
723     dd->canClip = TRUE;
724     dd->canHAdj = 0;
725     dd->canChangeGamma = FALSE;
726 
727     ptd->lty = 1;
728     ptd->pageno = 0;
729     ptd->debug = debug;
730 
731     dd->haveTransparency = 1;
732     dd->haveTransparentBg = 2;
733 
734     dd->deviceSpecific = (void *) ptd;
735     dd->displayListOn = FALSE;
736     dd->deviceVersion = R_GE_definitions;
737 
738     return TRUE;
739 }
740 
741 /*  PicTeX Device Driver Parameters
742  *  --------------------
743  *  file    = output filename
744  *  bg	    = background color
745  *  fg	    = foreground color
746  *  width   = width in inches
747  *  height  = height in inches
748  *  debug   = Rboolean; if TRUE, write TeX-Comments into output.
749  */
750 
PicTeX(SEXP args)751 SEXP PicTeX(SEXP args)
752 {
753     pGEDevDesc dd;
754     const char *file, *bg, *fg;
755     double height, width;
756     Rboolean debug;
757 
758     const void *vmax = vmaxget();
759     args = CDR(args); /* skip entry point name */
760     file = translateCharFP(asChar(CAR(args))); args = CDR(args);
761     bg = CHAR(asChar(CAR(args)));   args = CDR(args);
762     fg = CHAR(asChar(CAR(args)));   args = CDR(args);
763     width = asReal(CAR(args));	     args = CDR(args);
764     height = asReal(CAR(args));	     args = CDR(args);
765     debug = asLogical(CAR(args));    args = CDR(args);
766     if(debug == NA_LOGICAL) debug = FALSE;
767 
768     R_CheckDeviceAvailable();
769     BEGIN_SUSPEND_INTERRUPTS {
770 	pDevDesc dev;
771 	if (!(dev = (pDevDesc) calloc(1, sizeof(DevDesc))))
772 	    return 0;
773 	if(!PicTeXDeviceDriver(dev, file, bg, fg, width, height, debug)) {
774 	    free(dev);
775 	    error(_("unable to start %s() device"), "pictex");
776 	}
777 	dd = GEcreateDevDesc(dev);
778 	GEaddDevice2f(dd, "pictex", file);
779     } END_SUSPEND_INTERRUPTS;
780     vmaxset(vmax);
781     return R_NilValue;
782 }
783