The R Project SVN R

Rev

Rev 87953 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
5148 ripley 1 
/*
2 
 *  A PicTeX device, (C) 1996 Valerio Aimale, for
3 
 *  R : A Computer Language for Statistical Data Analysis
87832 ripley 4 
 *  Copyright (C) 2001--2025  The R Core Team
5148 ripley 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
42307 ripley 18 
 *  along with this program; if not, a copy is available at
68948 ripley 19 
 *  https://www.R-project.org/Licenses/
5148 ripley 20 
 */
21 
 
5187 hornik 22 
#ifdef HAVE_CONFIG_H
44342 ripley 23 
# include <config.h>
5187 hornik 24 
#endif
25 
 
36498 ripley 26 
#include <Defn.h>
27 
 
60260 ripley 28 
# include <rlocale.h> /* includes wchar.h */
35776 ripley 29 
 
44271 ripley 30 
#define R_USE_PROTOTYPES 1
44249 ripley 31 
#include <R_ext/GraphicsEngine.h>
5148 ripley 32 
#include "Fileio.h"
32879 ripley 33 
#include "grDevices.h"
5148 ripley 34 
 
35 
	/* device-specific information per picTeX device */
36 
 
11067 maechler 37 
#define DOTSperIN	72.27
38 
#define in2dots(x) 	(DOTSperIN * x)
39 
 
5148 ripley 40 
typedef struct {
9004 ripley 41 
    FILE *texfp;
42 
    char filename[128];
43 
    int pageno;
87953 ripley 44 
    int landscape; // unused
9004 ripley 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;
17112 murrell 55 
    rcolor fill;
9004 ripley 56 
    int fontsize;
57 
    int fontface;
87953 ripley 58 
    bool debug;
5148 ripley 59 
} picTeXDesc;
60 
 
61 
 
62 
	/* Global device information */
63 
 
19912 duncan 64 
static const double charwidth[4][128] = {
5148 ripley 65 
{
6844 maechler 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,
5148 ripley 84 
  0.5000020, 0.5000020
85 
},
86 
{
6844 maechler 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 },
5148 ripley 106 
{
6844 maechler 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 },
5148 ripley 126 
{
6844 maechler 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,
5148 ripley 145 
  0.5500030, 0.550003
146 
}
147 
};
148 
 
19912 duncan 149 
static const char * const fontname[] = {
12976 pd 150 
    "cmss10",
151 
    "cmssbx10",
152 
    "cmssi10",
153 
    "cmssxi10"
5148 ripley 154 
};
155 
 
156 
 
157 
	/* Device driver actions */
158 
 
17112 murrell 159 
static void PicTeX_Circle(double x, double y, double r,
44500 ripley 160 
			  const pGEcontext gc,
44299 ripley 161 
			  pDevDesc dd);
17112 murrell 162 
static void PicTeX_Clip(double x0, double x1, double y0, double y1,
44299 ripley 163 
			pDevDesc dd);
164 
static void PicTeX_Close(pDevDesc dd);
17112 murrell 165 
static void PicTeX_Line(double x1, double y1, double x2, double y2,
44500 ripley 166 
			const pGEcontext gc,
44299 ripley 167 
			pDevDesc dd);
27236 murrell 168 
static void PicTeX_MetricInfo(int c,
44500 ripley 169 
			      const pGEcontext gc,
17112 murrell 170 
			      double* ascent, double* descent,
44299 ripley 171 
			      double* width, pDevDesc dd);
44500 ripley 172 
static void PicTeX_NewPage(const pGEcontext gc, pDevDesc dd);
17112 murrell 173 
static void PicTeX_Polygon(int n, double *x, double *y,
44500 ripley 174 
			   const pGEcontext gc,
44299 ripley 175 
			   pDevDesc dd);
27236 murrell 176 
static void PicTeX_Rect(double x0, double y0, double x1, double y1,
44500 ripley 177 
			const pGEcontext gc,
44299 ripley 178 
			pDevDesc dd);
17112 murrell 179 
static void PicTeX_Size(double *left, double *right,
27236 murrell 180 
			double *bottom, double *top,
44299 ripley 181 
			pDevDesc dd);
44271 ripley 182 
static double PicTeX_StrWidth(const char *str,
44500 ripley 183 
			      const pGEcontext gc,
44299 ripley 184 
			      pDevDesc dd);
44271 ripley 185 
static void PicTeX_Text(double x, double y, const char *str,
27236 murrell 186 
			double rot, double hadj,
44500 ripley 187 
			const pGEcontext gc,
44299 ripley 188 
			pDevDesc dd);
78759 murrell 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);
5148 ripley 195 
 
196 
	/* Support routines */
197 
 
59184 ripley 198 
static void SetLinetype(int newlty, double newlwd, pDevDesc dd)
5148 ripley 199 
{
9004 ripley 200 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 201 
 
9004 ripley 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++) {
59184 ripley 207 
	    int lwd = (int)newlwd * newlty;
208 
	    fprintf(ptd->texfp,"%dpt", lwd & 15);
9004 ripley 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");
5148 ripley 215 
}
216 
 
217 
 
218 
static void SetFont(int face, int size, picTeXDesc *ptd)
219 
{
9004 ripley 220 
    int lface=face, lsize= size;
27236 murrell 221 
    if(lface < 1 || lface > 4 ) lface = 1;
9004 ripley 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 
    }
5148 ripley 229 
}
230 
 
27236 murrell 231 
static void PicTeX_MetricInfo(int c,
44500 ripley 232 
			      const pGEcontext gc,
17112 murrell 233 
			      double* ascent, double* descent,
44299 ripley 234 
			      double* width, pDevDesc dd)
5148 ripley 235 
{
6994 pd 236 
    /* metric information not available => return 0,0,0 */
237 
    *ascent = 0.0;
238 
    *descent = 0.0;
239 
    *width = 0.0;
5148 ripley 240 
}
6994 pd 241 
 
5148 ripley 242 
	/* Initialize the device */
243 
 
244 
 
245 
 
246 
	/* Interactive Resize */
247 
 
17112 murrell 248 
static void PicTeX_Size(double *left, double *right,
249 
		     double *bottom, double *top,
44299 ripley 250 
		     pDevDesc dd)
5148 ripley 251 
{
17112 murrell 252 
    *left = dd->left;		/* left */
253 
    *right = dd->right;/* right */
254 
    *bottom = dd->bottom;		/* bottom */
255 
    *top = dd->top;/* top */
5148 ripley 256 
}
257 
 
258 
static void PicTeX_Clip(double x0, double x1, double y0, double y1,
44299 ripley 259 
			pDevDesc dd)
5148 ripley 260 
{
9004 ripley 261 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 262 
 
9004 ripley 263 
    if(ptd->debug)
5148 ripley 264 
	fprintf(ptd->texfp, "%% Setting Clip Region to %.2f %.2f %.2f %.2f\n",
265 
		x0, y0, x1, y1);
9004 ripley 266 
    ptd->clipleft = x0;
267 
    ptd->clipright = x1;
268 
    ptd->clipbottom = y0;
269 
    ptd->cliptop = y1;
5148 ripley 270 
}
271 
 
272 
	/* Start a new page */
273 
 
44500 ripley 274 
static void PicTeX_NewPage(const pGEcontext gc,
44299 ripley 275 
			   pDevDesc dd)
5148 ripley 276 
{
9004 ripley 277 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 278 
 
9004 ripley 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",
11067 maechler 286 
		in2dots(ptd->width), in2dots(ptd->height));
9004 ripley 287 
	fprintf(ptd->texfp,"\\setlinear\n");
288 
	fprintf(ptd->texfp, "\\font\\picfont cmss10\\picfont\n");
289 
    }
11067 maechler 290 
    ptd->pageno++;
9004 ripley 291 
    face = ptd->fontface;
292 
    size = ptd->fontsize;
293 
    ptd->fontface = 0;
294 
    ptd->fontsize = 0;
295 
    SetFont(face, size, ptd);
5148 ripley 296 
}
297 
 
298 
	/* Close down the driver */
299 
 
44299 ripley 300 
static void PicTeX_Close(pDevDesc dd)
5148 ripley 301 
{
12976 pd 302 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 303 
 
12976 pd 304 
    fprintf(ptd->texfp, "\\endpicture\n}\n");
305 
    fclose(ptd->texfp);
5148 ripley 306 
 
12976 pd 307 
    free(ptd);
5148 ripley 308 
}
309 
 
310 
	/* Draw To */
311 
 
312 
static void PicTeX_ClipLine(double x0, double y0, double x1, double y1,
313 
			    picTeXDesc *ptd)
314 
{
9004 ripley 315 
    ptd->clippedx0 = x0; ptd->clippedx1 = x1;
316 
    ptd->clippedy0 = y0; ptd->clippedy1 = y1;
5148 ripley 317 
 
9004 ripley 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 
    }
5148 ripley 330 
 
9004 ripley 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 
    }
5148 ripley 395 
}
396 
 
397 
static void PicTeX_Line(double x1, double y1, double x2, double y2,
44500 ripley 398 
			const pGEcontext gc,
44299 ripley 399 
			pDevDesc dd)
5148 ripley 400 
{
12976 pd 401 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 402 
 
12976 pd 403 
    if (x1 != x2 || y1 != y2) {
27236 murrell 404 
	SetLinetype(gc->lty, gc->lwd, dd);
5148 ripley 405 
	if(ptd->debug)
12976 pd 406 
	    fprintf(ptd->texfp,
407 
		    "%% Drawing line from %.2f, %.2f to %.2f, %.2f\n",
408 
		    x1, y1, x2, y2);
5148 ripley 409 
	PicTeX_ClipLine(x1, y1, x2, y2, ptd);
410 
	if (ptd->debug)
12976 pd 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);
5148 ripley 415 
	fprintf(ptd->texfp, "\\plot %.2f %.2f %.2f %.2f /\n",
416 
		ptd->clippedx0, ptd->clippedy0,
417 
		ptd->clippedx1, ptd->clippedy1);
12976 pd 418 
    }
5148 ripley 419 
}
420 
 
17112 murrell 421 
static void PicTeX_Polyline(int n, double *x, double *y,
44500 ripley 422 
			    const pGEcontext gc,
44299 ripley 423 
			    pDevDesc dd)
5148 ripley 424 
{
9004 ripley 425 
    double x1, y1, x2, y2;
426 
    int i;
427 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 428 
 
27236 murrell 429 
    SetLinetype(gc->lty, gc->lwd, dd);
9004 ripley 430 
    x1 = x[0];
431 
    y1 = y[0];
12976 pd 432 
    for (i = 1; i < n; i++) {
9004 ripley 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);
12976 pd 439 
	x1 = x2;
440 
	y1 = y2;
9004 ripley 441 
    }
5148 ripley 442 
}
443 
 
444 
	/* String Width in Rasters */
445 
	/* For the current font in pointsize fontsize */
446 
 
44271 ripley 447 
static double PicTeX_StrWidth(const char *str,
44500 ripley 448 
			      const pGEcontext gc,
44299 ripley 449 
			      pDevDesc dd)
5148 ripley 450 
{
9004 ripley 451 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 452 
 
44271 ripley 453 
    const char *p;
37387 ripley 454 
    int size;
9004 ripley 455 
    double sum;
37368 ripley 456 
 
59184 ripley 457 
    size = (int)(gc->cex * gc->ps + 0.5);
27236 murrell 458 
    SetFont(gc->fontface, size, ptd);
9004 ripley 459 
    sum = 0;
35825 ripley 460 
    if(mbcslocale && ptd->fontface != 5) {
37368 ripley 461 
	/* This version at least uses the state of the MBCS */
59184 ripley 462 
	size_t i, ucslen = mbcsToUcs2(str, NULL, 0, CE_NATIVE);
37368 ripley 463 
	if (ucslen != (size_t)-1) {
77916 ripley 464 
	    R_ucs2_t ucs[ucslen];
59184 ripley 465 
	    int status = (int) mbcsToUcs2(str, ucs, (int)ucslen, CE_NATIVE);
37370 ripley 466 
	    if (status >= 0)
467 
		for (i = 0; i < ucslen; i++)
468 
		    if(ucs[i] < 128) sum += charwidth[ptd->fontface-1][ucs[i]];
79776 ripley 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 
		    }
37370 ripley 476 
	    else
477 
		warning(_("invalid string in '%s'"), "PicTeX_StrWidth");
37368 ripley 478 
	} else
479 
	    warning(_("invalid string in '%s'"), "PicTeX_StrWidth");
35825 ripley 480 
    } else
481 
	for(p = str; *p; p++)
482 
	    sum += charwidth[ptd->fontface-1][(int)*p];
49591 ripley 483 
 
9004 ripley 484 
    return sum * ptd->fontsize;
5148 ripley 485 
}
486 
 
487 
 
488 
/* Possibly Filled Rectangle */
489 
static void PicTeX_Rect(double x0, double y0, double x1, double y1,
44500 ripley 490 
			const pGEcontext gc,
44299 ripley 491 
			pDevDesc dd)
5148 ripley 492 
{
9004 ripley 493 
    double x[4], y[4];
12976 pd 494 
 
9004 ripley 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;
27236 murrell 499 
    PicTeX_Polygon(4, x, y, gc, dd);
5148 ripley 500 
}
501 
 
52406 murrell 502 
 
17112 murrell 503 
static void PicTeX_Circle(double x, double y, double r,
44500 ripley 504 
			  const pGEcontext gc,
44299 ripley 505 
			  pDevDesc dd)
5148 ripley 506 
{
9004 ripley 507 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 508 
 
9004 ripley 509 
    fprintf(ptd->texfp,
510 
	    "\\circulararc 360 degrees from %.2f %.2f center at %.2f %.2f\n",
511 
	    x, (y + r), x, y);
5148 ripley 512 
}
513 
 
17112 murrell 514 
static void PicTeX_Polygon(int n, double *x, double *y,
44500 ripley 515 
			   const pGEcontext gc,
44299 ripley 516 
			   pDevDesc dd)
5148 ripley 517 
{
9004 ripley 518 
    double x1, y1, x2, y2;
519 
    int i;
520 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 521 
 
27236 murrell 522 
    SetLinetype(gc->lty, gc->lwd, dd);
9004 ripley 523 
    x1 = x[0];
524 
    y1 = y[0];
525 
    for (i=1; i<n; i++) {
526 
	x2 = x[i];
527 
	y2 = y[i];
5148 ripley 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);
9004 ripley 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);
5148 ripley 541 
}
542 
 
543 
/* TeX Text Translations */
44271 ripley 544 
static void textext(const char *str, picTeXDesc *ptd)
5148 ripley 545 
{
9004 ripley 546 
    fputc('{', ptd->texfp);
547 
    for( ; *str ; str++)
548 
	switch(*str) {
549 
	case '$':
550 
	    fprintf(ptd->texfp, "\\$");
551 
	    break;
5148 ripley 552 
 
9004 ripley 553 
	case '%':
554 
	    fprintf(ptd->texfp, "\\%%");
555 
	    break;
5148 ripley 556 
 
9004 ripley 557 
	case '{':
558 
	    fprintf(ptd->texfp, "\\{");
559 
	    break;
5148 ripley 560 
 
9004 ripley 561 
	case '}':
562 
	    fprintf(ptd->texfp, "\\}");
563 
	    break;
5148 ripley 564 
 
9004 ripley 565 
	case '^':
566 
	    fprintf(ptd->texfp, "\\^{}");
567 
	    break;
5148 ripley 568 
 
9004 ripley 569 
	default:
570 
	    fputc(*str, ptd->texfp);
571 
	    break;
572 
	}
573 
    fprintf(ptd->texfp,"} ");
5148 ripley 574 
}
575 
 
576 
/* Rotated Text */
577 
 
44271 ripley 578 
static void PicTeX_Text(double x, double y, const char *str,
27236 murrell 579 
			double rot, double hadj,
44500 ripley 580 
			const pGEcontext gc,
44299 ripley 581 
			pDevDesc dd)
5148 ripley 582 
{
9004 ripley 583 
    int size;
584 
    double xoff = 0.0, yoff = 0.0;
585 
    picTeXDesc *ptd = (picTeXDesc *) dd->deviceSpecific;
5148 ripley 586 
 
59184 ripley 587 
    size = (int)(gc->cex * gc->ps + 0.5);
27236 murrell 588 
    SetFont(gc->fontface, size, ptd);
11067 maechler 589 
    if(ptd->debug)
590 
	fprintf(ptd->texfp,
591 
		"%% Writing string of length %.2f, at %.2f %.2f, xc = %.2f yc = %.2f\n",
27236 murrell 592 
		(double)PicTeX_StrWidth(str, gc, dd),
17112 murrell 593 
		x, y, 0.0, 0.0);
35776 ripley 594 
#if 0 /* Original */
9004 ripley 595 
    fprintf(ptd->texfp,"\\put ");
596 
    textext(str, ptd);
597 
    if (rot == 90 )
12976 pd 598 
	fprintf(ptd->texfp," [rB] <%.2fpt,%.2fpt>", xoff, yoff);
9004 ripley 599 
    else fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff);
35776 ripley 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);
35795 ripley 605 
    } else {
35776 ripley 606 
	fprintf(ptd->texfp,"\\put ");
607 
	textext(str, ptd);
608 
	fprintf(ptd->texfp," [lB] <%.2fpt,%.2fpt>", xoff, yoff);
609 
    }
610 
#endif
9004 ripley 611 
    fprintf(ptd->texfp," at %.2f %.2f\n", x, y);
5148 ripley 612 
}
613 
 
78759 murrell 614 
static SEXP PicTeX_setPattern(SEXP pattern, pDevDesc dd) {
615 
    return R_NilValue;
616 
}
617 
 
618 
static void PicTeX_releasePattern(SEXP ref, pDevDesc dd) {}
619 
 
620 
static SEXP PicTeX_setClipPath(SEXP path, SEXP ref, pDevDesc dd) {
621 
    return R_NilValue;
622 
}
623 
 
624 
static void PicTeX_releaseClipPath(SEXP ref, pDevDesc dd) {}
625 
 
626 
static SEXP PicTeX_setMask(SEXP path, SEXP ref, pDevDesc dd) {
627 
    return R_NilValue;
628 
}
629 
 
630 
static void PicTeX_releaseMask(SEXP ref, pDevDesc dd) {}
631 
 
632 
 
32250 ripley 633 
static
87953 ripley 634 
bool PicTeXDeviceDriver(pDevDesc dd, const char *filename,
635 
			const char *bg, const char *fg,
636 
			double width, double height,
637 
			bool debug)
5148 ripley 638 
{
9004 ripley 639 
    picTeXDesc *ptd;
5148 ripley 640 
 
9004 ripley 641 
    if (!(ptd = (picTeXDesc *) malloc(sizeof(picTeXDesc))))
11067 maechler 642 
	return FALSE;
72944 maechler 643 
    if (!(ptd->texfp = R_fopen(R_ExpandFileName(filename), "w"))) {
644 
	free(ptd);
87953 ripley 645 
	return false;
72944 maechler 646 
    }
5148 ripley 647 
 
9004 ripley 648 
    strcpy(ptd->filename, filename);
5148 ripley 649 
 
44240 ripley 650 
    dd->startfill = R_GE_str2col(bg);
651 
    dd->startcol = R_GE_str2col(fg);
17165 murrell 652 
    dd->startps = 10;
653 
    dd->startlty = 0;
654 
    dd->startfont = 1;
655 
    dd->startgamma = 1;
656 
 
17112 murrell 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;
56857 ripley 666 
    /* dd->path = PicTeX_Path; not implemented */
17112 murrell 667 
    dd->polygon = PicTeX_Polygon;
668 
    dd->polyline = PicTeX_Polyline;
669 
    dd->metricInfo = PicTeX_MetricInfo;
43975 ripley 670 
    dd->hasTextUTF8 = FALSE;
44170 ripley 671 
    dd->useRotatedTextInContour = FALSE;
78759 murrell 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;
5148 ripley 678 
 
9004 ripley 679 
    /* Screen Dimensions in Pixels */
6251 pd 680 
 
17112 murrell 681 
    dd->left = 0;		/* left */
682 
    dd->right = in2dots(width);/* right */
683 
    dd->bottom = 0;		/* bottom */
684 
    dd->top = in2dots(height);/* top */
65257 ripley 685 
    dd->clipLeft = dd->left; dd->clipRight = dd->right;
686 
    dd->clipBottom = dd->bottom; dd->clipTop = dd->top;
9004 ripley 687 
    ptd->width = width;
688 
    ptd->height = height;
5148 ripley 689 
 
72944 maechler 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++;
5148 ripley 703 
 
9004 ripley 704 
    /* Base Pointsize */
705 
    /* Nominal Character Sizes in Pixels */
5148 ripley 706 
 
44444 ripley 707 
    dd->cra[0] =  9;
708 
    dd->cra[1] = 12;
5148 ripley 709 
 
9004 ripley 710 
    /* Character Addressing Offsets */
711 
    /* These offsets should center a single */
712 
    /* plotting character over the plotting point. */
713 
    /* Pure guesswork and eyeballing ... */
5148 ripley 714 
 
17112 murrell 715 
    dd->xCharOffset =  0; /*0.4900;*/
716 
    dd->yCharOffset =  0; /*0.3333;*/
717 
    dd->yLineBias = 0; /*0.1;*/
5148 ripley 718 
 
9004 ripley 719 
    /* Inches per Raster Unit */
11067 maechler 720 
    /* We use printer points, i.e. 72.27 dots per inch : */
17112 murrell 721 
    dd->ipr[0] = dd->ipr[1] = 1./DOTSperIN;
5148 ripley 722 
 
17112 murrell 723 
    dd->canClip = TRUE;
724 
    dd->canHAdj = 0;
17165 murrell 725 
    dd->canChangeGamma = FALSE;
5148 ripley 726 
 
9004 ripley 727 
    ptd->lty = 1;
728 
    ptd->pageno = 0;
729 
    ptd->debug = debug;
5148 ripley 730 
 
56848 ripley 731 
    dd->haveTransparency = 1;
56850 ripley 732 
    dd->haveTransparentBg = 2;
56848 ripley 733 
 
9004 ripley 734 
    dd->deviceSpecific = (void *) ptd;
11067 maechler 735 
    dd->displayListOn = FALSE;
78759 murrell 736 
    dd->deviceVersion = R_GE_definitions;
737 
 
11067 maechler 738 
    return TRUE;
5148 ripley 739 
}
17112 murrell 740 
 
32250 ripley 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
87953 ripley 748 
 *  debug   = if TRUE, write TeX-Comments into output.
32250 ripley 749 
 */
750 
 
32254 ripley 751 
SEXP PicTeX(SEXP args)
17112 murrell 752 
{
44500 ripley 753 
    pGEDevDesc dd;
41781 ripley 754 
    const char *file, *bg, *fg;
32250 ripley 755 
    double height, width;
87953 ripley 756 
    int debug;
32250 ripley 757 
 
63181 ripley 758 
    const void *vmax = vmaxget();
32254 ripley 759 
    args = CDR(args); /* skip entry point name */
85447 ripley 760 
 
761 
     SEXP tmp = asChar(CAR(args));
762 
    if (tmp == NA_STRING)
763 
	error(_("invalid 'file' parameter in %s"), "pictex");
764 
    file = translateCharFP(tmp);  args = CDR(args);
33771 murdoch 765 
    bg = CHAR(asChar(CAR(args)));   args = CDR(args);
766 
    fg = CHAR(asChar(CAR(args)));   args = CDR(args);
32250 ripley 767 
    width = asReal(CAR(args));	     args = CDR(args);
768 
    height = asReal(CAR(args));	     args = CDR(args);
87953 ripley 769 
    debug = asLogical(CAR(args));    args = CDR(args);
32250 ripley 770 
    if(debug == NA_LOGICAL) debug = FALSE;
771 
 
772 
    R_CheckDeviceAvailable();
773 
    BEGIN_SUSPEND_INTERRUPTS {
44299 ripley 774 
	pDevDesc dev;
88803 murrell 775 
	if (!(dev = GEcreateDD()))
87953 ripley 776 
	    error(_("unable to start %s() device"), "pictex");
777 
//	    return 0; // that is not a SEXP
778 
	if(!PicTeXDeviceDriver(dev, file, bg, fg, width, height,
779 
			       (bool) debug)) {
88803 murrell 780 
	    GEfreeDD(dev);
52764 ripley 781 
	    error(_("unable to start %s() device"), "pictex");
32250 ripley 782 
	}
783 
	dd = GEcreateDevDesc(dev);
65632 ripley 784 
	GEaddDevice2f(dd, "pictex", file);
32250 ripley 785 
    } END_SUSPEND_INTERRUPTS;
786 
    vmaxset(vmax);
787 
    return R_NilValue;
17112 murrell 788 
}