The R Project SVN R

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
5148 ripley 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
23105 ripley 4 
 *  Copyright (C) 1998--2003  Robert Gentleman, Ross Ihaka and the
5148 ripley 5 
 *                            R Development Core Team
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, write to the Free Software
5458 ripley 19 
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
5148 ripley 20 
 */
21 
 
5187 hornik 22 
#ifdef HAVE_CONFIG_H
7701 hornik 23 
#include <config.h>
5187 hornik 24 
#endif
25 
 
26 
#include <stdio.h>
27 
#include <ctype.h>
28 
 
5148 ripley 29 
#include "Defn.h"
24535 ripley 30 
#include "Rmath.h" /* for rround */
5148 ripley 31 
#include "Graphics.h"
19500 hornik 32 
#include <R_ext/Error.h>
5148 ripley 33 
#include "Fileio.h"
12778 pd 34 
#include <Rdevices.h>
5148 ripley 35 
 
21072 ripley 36 
#ifdef HAVE_ERRNO_H
37 
#include <errno.h>
38 
#else
39 
extern int errno;
40 
#endif
41 
 
15789 iacus 42 
 
15641 ripley 43 
#define INVALID_COL 0xff0a0b0c
44 
 
12778 pd 45 
/* Define this to use hyphen except in -[0-9] */
46 
#undef USE_HYPHEN
47 
/* In ISOLatin1, minus is 45 and hyphen is 173 */
48 
#ifdef USE_HYPHEN
49 
static char PS_hyphen = 173;
50 
#endif
51 
 
10960 ripley 52 
#define USERAFM 999
53 
 
5148 ripley 54 
/* Part 0.  AFM File Names */
55 
 
56 
/* This structure gives the set of font names for each type face. */
10960 ripley 57 
/* They also give the afm file names. */
5148 ripley 58 
 
19912 duncan 59 
static const struct {
60 
    char const *family;
61 
    char const *afmfile[5];
5148 ripley 62 
}
19912 duncan 63 
Family [] = {
5148 ripley 64 
 
65 
    { "AvantGarde",
16834 ripley 66 
      {"agw_____.afm", "agd_____.afm", "agwo____.afm", "agdo____.afm",
67 
       "sy______.afm"}
5148 ripley 68 
    },
8792 ripley 69 
 
5148 ripley 70 
    { "Bookman",
16834 ripley 71 
      {"bkl_____.afm", "bkd_____.afm", "bkli____.afm", "bkdi____.afm",
72 
       "sy______.afm"}
5148 ripley 73 
    },
74 
 
75 
    { "Courier",
16834 ripley 76 
      {"com_____.afm", "cob_____.afm", "coo_____.afm", "cobo____.afm",
77 
       "sy______.afm"}
5148 ripley 78 
    },
8792 ripley 79 
 
5148 ripley 80 
    { "Helvetica",
16837 ripley 81 
      {"hv______.afm", "hvb_____.afm", "hvo_____.afm", "hvbo____.afm",
16834 ripley 82 
       "sy______.afm"}
5148 ripley 83 
    },
84 
 
85 
    { "Helvetica-Narrow",
16834 ripley 86 
      {"hvn_____.afm", "hvnb____.afm", "hvno____.afm", "hvnbo___.afm",
87 
       "sy______.afm"}
5148 ripley 88 
    },
89 
 
90 
    { "NewCenturySchoolbook",
16837 ripley 91 
      {"ncr_____.afm", "ncb_____.afm", "nci_____.afm", "ncbi____.afm",
16834 ripley 92 
       "sy______.afm"}
5148 ripley 93 
    },
94 
 
95 
    { "Palatino",
16834 ripley 96 
      {"por_____.afm", "pob_____.afm", "poi_____.afm", "pobi____.afm",
97 
       "sy______.afm"}
5148 ripley 98 
    },
99 
 
100 
    { "Times",
16837 ripley 101 
      {"tir_____.afm", "tib_____.afm", "tii_____.afm", "tibi____.afm",
16834 ripley 102 
       "sy______.afm"}
5148 ripley 103 
    },
104 
 
16837 ripley 105 
    /* URW equivalents */
106 
    { "URWGothic",
107 
      {"a010013l.afm", "a010015l.afm", "a010033l.afm", "a010035l.afm",
108 
       "s050000l.afm"}
109 
    },
110 
 
111 
    { "URWBookman",
112 
      {"b018012l.afm", "b018015l.afm", "b018032l.afm", "b018035l.afm",
113 
       "s050000l.afm"}
114 
    },
115 
 
116 
    { "NimbusMon",
117 
      {"n022003l.afm", "n022004l.afm", "n022023l.afm", "n022024l.afm",
118 
       "s050000l.afm"}
119 
    },
120 
 
121 
    { "NimbusSan",
122 
      {"n019003l.afm", "n019004l.afm", "n019023l.afm", "n019024l.afm",
123 
       "s050000l.afm"}
124 
    },
125 
 
126 
    { "URWHelvetica",
127 
      {"n019003l.afm", "n019004l.afm", "n019023l.afm", "n019024l.afm",
128 
       "s050000l.afm"}
129 
    },
130 
 
131 
    { "NimbusSanCond",
132 
      {"n019043l.afm", "n019044l.afm", "n019063l.afm", "n019064l.afm",
133 
       "s050000l.afm"}
134 
    },
135 
 
136 
    { "CenturySch",
137 
      {"c059013l.afm", "c059016l.afm", "c059033l.afm", "c059036l.afm",
138 
       "s050000l.afm"}
139 
    },
140 
 
141 
    { "URWPalladio",
142 
      {"p052003l.afm", "p052004l.afm", "p052023l.afm", "p052024l.afm",
143 
       "s050000l.afm"}
144 
    },
145 
 
146 
    { "NimbusRom",
147 
      {"n021003l.afm", "n021004l.afm", "n021023l.afm", "n021024l.afm",
148 
       "s050000l.afm"}
149 
    },
150 
 
151 
   { "URWTimes",
152 
      {"n021003l.afm", "n021004l.afm", "n021023l.afm", "n021024l.afm",
153 
       "s050000l.afm"}
154 
    },
155 
 
156 
    /* Computer Modern as recoded by Brian D'Urso */
157 
    { "ComputerModern",
158 
      {"CM_regular_10.afm", "CM_boldx_10.afm", "CM_italic_10.afm",
159 
       "CM_boldx_italic_10.afm", "CM_symbol_10.afm"}
160 
    },
161 
 
5148 ripley 162 
    { NULL }
163 
};
164 
 
165 
 
10960 ripley 166 
static char familyname[5][50];
5148 ripley 167 
 
168 
/* Part 1.  AFM File Parsing.  */
169 
 
170 
/* These are the basic entities in the AFM file */
171 
 
172 
#define BUFSIZE 512
12241 ripley 173 
#define NA_SHORT -30000
5148 ripley 174 
 
175 
typedef struct {
8813 ripley 176 
    unsigned char c1;
177 
    unsigned char c2;
178 
    short kern;
179 
} KP;
180 
 
181 
typedef struct {
182 
    short FontBBox[4];
183 
    short CapHeight;
184 
    short XHeight;
185 
    short Descender;
186 
    short Ascender;
187 
    struct {
188 
	short WX;
189 
	short BBox[4];
190 
    } CharInfo[256];
191 
    KP *KernPairs;
9040 ripley 192 
    short KPstart[256];
193 
    short KPend[256];
8813 ripley 194 
    short nKP;
5148 ripley 195 
} FontMetricInfo;
196 
 
197 
enum {
198 
    Empty,
199 
    StartFontMetrics,
200 
    Comment,
201 
    FontName,
202 
    EncodingScheme,
203 
    FullName,
204 
    FamilyName,
205 
    Weight,
206 
    ItalicAngle,
207 
    IsFixedPitch,
208 
    UnderlinePosition,
209 
    UnderlineThickness,
210 
    Version,
211 
    Notice,
212 
    FontBBox,
213 
    CapHeight,
214 
    XHeight,
215 
    Descender,
216 
    Ascender,
217 
    StartCharMetrics,
218 
    C,
219 
    EndCharMetrics,
220 
    StartKernData,
221 
    StartKernPairs,
222 
    KPX,
223 
    EndKernPairs,
224 
    EndKernData,
225 
    StartComposites,
226 
    CC,
227 
    EndComposites,
228 
    EndFontMetrics,
229 
    Unknown
230 
};
231 
 
19912 duncan 232 
static const struct {
233 
    const char *keyword;
234 
    const int code;
5148 ripley 235 
}
236 
KeyWordDictionary[] = {
237 
    { "StartFontMetrics",    StartFontMetrics },
238 
    { "Comment",	     Comment },
239 
    { "FontName",	     FontName },
240 
    { "EncodingScheme",	     EncodingScheme },
241 
    { "FullName",	     FullName },
242 
    { "FamilyName",	     FamilyName },
243 
    { "Weight",		     Weight },
244 
    { "ItalicAngle",	     ItalicAngle },
245 
    { "IsFixedPitch",	     IsFixedPitch },
246 
    { "UnderlinePosition",   UnderlinePosition },
247 
    { "UnderlineThickness",  UnderlineThickness },
248 
    { "Version",	     Version },
249 
    { "Notice",		     Notice },
250 
    { "FontBBox",	     FontBBox },
251 
    { "CapHeight",	     CapHeight },
252 
    { "XHeight",	     XHeight },
253 
    { "Descender",	     Descender },
254 
    { "Ascender",	     Ascender },
255 
    { "StartCharMetrics",    StartCharMetrics },
256 
    { "C ",		     C },
257 
    { "EndCharMetrics",	     EndCharMetrics },
258 
    { "StartKernData",	     StartKernData },
259 
    { "StartKernPairs",	     StartKernPairs },
260 
    { "KPX ",		     KPX },
261 
    { "EndKernPairs",	     EndKernPairs },
262 
    { "EndKernData",	     EndKernData },
263 
    { "StartComposites",     StartComposites },
264 
    { "CC ",		     CC },
265 
    { "EndComposites",	     EndComposites },
266 
    { "EndFontMetrics",	     EndFontMetrics },
267 
    { NULL,		     Unknown },
268 
};
269 
 
19912 duncan 270 
static int MatchKey(char const * l, char const * k)
5148 ripley 271 
{
272 
    while (*k)
273 
	if (*k++ != *l++) return 0;
274 
    return 1;
275 
}
276 
 
19912 duncan 277 
static int KeyType(const char * const s)
5148 ripley 278 
{
279 
    int i;
280 
    if (*s == '\n')
281 
	return Empty;
282 
    for (i = 0; KeyWordDictionary[i].keyword; i++)
283 
	if (MatchKey(s, KeyWordDictionary[i].keyword))
284 
	    return KeyWordDictionary[i].code;
285 
    return Unknown;
286 
}
287 
 
288 
static char *SkipToNextItem(char *p)
289 
{
6098 pd 290 
    while (!isspace((int)*p)) p++;
291 
    while (isspace((int)*p)) p++;
5148 ripley 292 
    return p;
293 
}
294 
 
295 
static char *SkipToNextKey(char *p)
296 
{
297 
    while (*p != ';') p++;
298 
    p++;
6098 pd 299 
    while (isspace((int)*p)) p++;
5148 ripley 300 
    return p;
301 
}
302 
 
303 
static int GetFontBBox(char *buf, FontMetricInfo *metrics)
304 
{
305 
    if (sscanf(buf, "FontBBox %hd %hd %hd %hd",
306 
	      &(metrics->FontBBox[0]),
307 
	      &(metrics->FontBBox[1]),
308 
	      &(metrics->FontBBox[2]),
309 
	      &(metrics->FontBBox[3])) != 4) return 0;
310 
#ifdef DEBUG_PS
311 
    Rprintf("FontBBox %d %d %d %d\n",
312 
	    (metrics->FontBBox[0]),
313 
	    (metrics->FontBBox[1]),
314 
	    (metrics->FontBBox[2]),
315 
	    (metrics->FontBBox[3]));
316 
#endif
317 
    return 1;
318 
}
319 
 
8813 ripley 320 
static char charnames[256][25];
12273 ripley 321 
static char encnames[256][25];
8813 ripley 322 
 
12273 ripley 323 
/* If reencode > 0, remap to new encoding */
324 
static int GetCharInfo(char *buf, FontMetricInfo *metrics, int reencode)
5148 ripley 325 
{
10960 ripley 326 
    char *p = buf, charname[25];
12241 ripley 327 
    int nchar, nchar2=-1, i;
10960 ripley 328 
    short WX;
5148 ripley 329 
 
330 
    if (!MatchKey(buf, "C ")) return 0;
331 
    p = SkipToNextItem(p);
332 
    sscanf(p, "%d", &nchar);
12273 ripley 333 
    if (nchar < 0 && !reencode) return 1;
5148 ripley 334 
    p = SkipToNextKey(p);
335 
 
336 
    if (!MatchKey(p, "WX")) return 0;
337 
    p = SkipToNextItem(p);
10960 ripley 338 
    sscanf(p, "%hd", &WX);
5148 ripley 339 
    p = SkipToNextKey(p);
340 
 
341 
    if (!MatchKey(p, "N ")) return 0;
8813 ripley 342 
    p = SkipToNextItem(p);
12273 ripley 343 
    if(reencode) {
10960 ripley 344 
	sscanf(p, "%s", charname);
12241 ripley 345 
#ifdef DEBUG_PS
346 
	Rprintf("char name %s\n", charname);
347 
#endif
348 
	/* a few chars appear twice in ISOLatin1 */
349 
	nchar = nchar2 = -1;
12273 ripley 350 
	for (i = 0; i < 256; i++)
351 
	    if(!strcmp(charname, encnames[i])) {
16837 ripley 352 
		strcpy(charnames[i], charname);
12241 ripley 353 
		if(nchar == -1) nchar = i; else nchar2 = i;
10960 ripley 354 
	    }
12241 ripley 355 
	if (nchar == -1) return 1;
10960 ripley 356 
    } else {
357 
	sscanf(p, "%s", charnames[nchar]);
358 
    }
359 
    metrics->CharInfo[nchar].WX = WX;
5148 ripley 360 
    p = SkipToNextKey(p);
361 
 
362 
    if (!MatchKey(p, "B ")) return 0;
363 
    p = SkipToNextItem(p);
364 
    sscanf(p, "%hd %hd %hd %hd",
365 
	   &(metrics->CharInfo[nchar].BBox[0]),
366 
	   &(metrics->CharInfo[nchar].BBox[1]),
367 
	   &(metrics->CharInfo[nchar].BBox[2]),
368 
	   &(metrics->CharInfo[nchar].BBox[3]));
369 
 
370 
#ifdef DEBUG_PS
371 
    Rprintf("nchar = %d %d %d %d %d %d\n", nchar,
372 
	    metrics->CharInfo[nchar].WX,
373 
	    metrics->CharInfo[nchar].BBox[0],
374 
	    metrics->CharInfo[nchar].BBox[1],
375 
	    metrics->CharInfo[nchar].BBox[2],
376 
	    metrics->CharInfo[nchar].BBox[3]);
377 
#endif
12241 ripley 378 
    if (nchar2 > 0) {
379 
	metrics->CharInfo[nchar2].WX = WX;
380 
	sscanf(p, "%hd %hd %hd %hd",
381 
	       &(metrics->CharInfo[nchar2].BBox[0]),
382 
	       &(metrics->CharInfo[nchar2].BBox[1]),
383 
	       &(metrics->CharInfo[nchar2].BBox[2]),
384 
	       &(metrics->CharInfo[nchar2].BBox[3]));
385 
 
386 
#ifdef DEBUG_PS
387 
	Rprintf("nchar = %d %d %d %d %d %d\n", nchar2,
388 
		metrics->CharInfo[nchar2].WX,
389 
		metrics->CharInfo[nchar2].BBox[0],
390 
		metrics->CharInfo[nchar2].BBox[1],
391 
		metrics->CharInfo[nchar2].BBox[2],
392 
		metrics->CharInfo[nchar2].BBox[3]);
393 
#endif
394 
    }
5148 ripley 395 
    return 1;
396 
}
397 
 
8813 ripley 398 
static int GetKPX(char *buf, int nkp, FontMetricInfo *metrics)
399 
{
400 
    char *p = buf, c1[50], c2[50];
401 
    int i, done = 0;
402 
 
403 
    p = SkipToNextItem(p);
404 
    sscanf(p, "%s %s %hd", c1, c2, &(metrics->KernPairs[nkp].kern));
405 
    for(i = 0; i < 256; i++) {
406 
	if (!strcmp(c1, charnames[i])) {
407 
	    metrics->KernPairs[nkp].c1 = i;
408 
	    done++;
409 
	    break;
410 
	}
411 
    }
412 
    for(i = 0; i < 256; i++)
413 
	if (!strcmp(c2, charnames[i])) {
414 
	    metrics->KernPairs[nkp].c2 = i;
415 
	    done++;
416 
	    break;
417 
	}
418 
    return (done==2);
419 
}
420 
 
12305 ripley 421 
/* Encode File Parsing.  */
422 
/* Statics here are OK, as all the calls are in one initialization
423 
   so no concurrency (until threads?) */
8813 ripley 424 
 
19912 duncan 425 
typedef struct {
426 
  /* Probably can make buf and p0 local variables. Only p needs to be
427 
     stored across calls. Need to investigate this more closely. */
428 
  char buf[1000];
429 
  char *p;
430 
  char *p0;
431 
} EncodingInputState;
432 
 
12305 ripley 433 
/* read in the next encoding item, separated by white space. */
19912 duncan 434 
static int GetNextItem(FILE *fp, char *dest, int c, EncodingInputState *state)
12273 ripley 435 
{
19912 duncan 436 
    if (c < 0) state->p = NULL;
12273 ripley 437 
    while (1) {
19912 duncan 438 
	if (feof(fp)) { state->p = NULL; return 1; }
439 
	if (!state->p || *state->p == '\n' || *state->p == '\0') {
440 
	    state->p = fgets(state->buf, 1000, fp);
12273 ripley 441 
	}
17392 ripley 442 
	/* check for incomplete encoding file */
19912 duncan 443 
	if(!state->p) return 1;
444 
	while (isspace((int)* state->p)) state->p++;
445 
	if (state->p == '\0' || *state->p == '%'|| *state->p == '\n') { state->p = NULL; continue; }
446 
	state->p0 = state->p;
447 
	while (!isspace((int)*state->p)) state->p++;
448 
	if (state->p != '\0') *state->p++ = '\0';
449 
	if(c == 45) strcpy(dest, "/minus"); else strcpy(dest, state->p0);
12273 ripley 450 
	break;
451 
    }
452 
    return 0;
453 
}
454 
 
12305 ripley 455 
static char enccode[5000];
12273 ripley 456 
 
457 
/* Load encoding array from a file: defaults to the R_HOME/afm directory */
10960 ripley 458 
static int
13854 ripley 459 
LoadEncoding(char *encpath, char *encname, Rboolean isPDF)
12273 ripley 460 
{
461 
    char buf[BUFSIZE];
462 
    int i;
463 
    FILE *fp;
19912 duncan 464 
    EncodingInputState state;
465 
    state.p = state.p0 = NULL;
12273 ripley 466 
 
13854 ripley 467 
    if(strchr(encpath, FILESEP[0])) strcpy(buf, encpath);
25313 ripley 468 
    else snprintf(buf, BUFSIZE,"%s%safm%s%s", R_Home, FILESEP, FILESEP, encpath);
12273 ripley 469 
#ifdef DEBUG_PS
470 
    Rprintf("encoding path is %s\n", buf);
471 
#endif
12305 ripley 472 
    if (!(fp = R_fopen(R_ExpandFileName(buf), "r"))) {
473 
	strcat(buf, ".enc");
474 
	if (!(fp = R_fopen(R_ExpandFileName(buf), "r"))) return 0;
475 
    }
19912 duncan 476 
    if (GetNextItem(fp, buf, -1, &state)) return 0; /* encoding name */
16837 ripley 477 
    strcpy(encname, buf+1);
25313 ripley 478 
    if (!isPDF) snprintf(enccode, 5000, "/%s [\n", encname);
12688 ripley 479 
    else enccode[0] = '\0';
19912 duncan 480 
    if (GetNextItem(fp, buf, 0, &state)) { fclose(fp); return 0;} /* [ */
12273 ripley 481 
    for(i = 0; i < 256; i++) {
19912 duncan 482 
	if (GetNextItem(fp, buf, i, &state)) { fclose(fp); return 0; }
12273 ripley 483 
	strcpy(encnames[i], buf+1);
12288 ripley 484 
	strcat(enccode, " /"); strcat(enccode, encnames[i]);
485 
	if(i%8 == 7) strcat(enccode, "\n");
12273 ripley 486 
    }
19912 duncan 487 
    if (GetNextItem(fp, buf, 0, &state)) { fclose(fp); return 0;} /* ] */
12273 ripley 488 
    fclose(fp);
12688 ripley 489 
    if (!isPDF) strcat(enccode,"]\n");
12273 ripley 490 
    return 1;
491 
}
492 
 
493 
 
494 
 
495 
/* Load font metrics from a file: defaults to the R_HOME/afm directory */
496 
 
497 
static int
19912 duncan 498 
PostScriptLoadFontMetrics(const char * const fontpath, FontMetricInfo *metrics,
12273 ripley 499 
			  char *fontname, int reencode)
5148 ripley 500 
{
8813 ripley 501 
    char buf[BUFSIZE], *p;
12241 ripley 502 
    int mode, i = 0, j, ii, nKPX=0;
5148 ripley 503 
    FILE *fp;
504 
 
10960 ripley 505 
    if(strchr(fontpath, FILESEP[0])) strcpy(buf, fontpath);
25313 ripley 506 
    else snprintf(buf, BUFSIZE, "%s%safm%s%s", R_Home, FILESEP, FILESEP, fontpath);
10960 ripley 507 
#ifdef DEBUG_PS
508 
    Rprintf("afmpath is %s\n", buf);
16834 ripley 509 
    Rprintf("reencode is %d\n", reencode);
10960 ripley 510 
#endif
15168 pd 511 
 
12305 ripley 512 
    if (!(fp = R_fopen(R_ExpandFileName(buf), "r"))) return 0;
5148 ripley 513 
 
514 
    mode = 0;
10660 ripley 515 
    for (ii = 0; ii < 256; ii++) {
516 
	charnames[ii][0] = '\0';
12241 ripley 517 
	metrics->CharInfo[ii].WX = NA_SHORT;
518 
	for(j = 0; j < 4; j++) metrics->CharInfo[ii].BBox[j] = 0;
10660 ripley 519 
    }
5148 ripley 520 
    while (fgets(buf, BUFSIZE, fp)) {
521 
	switch(KeyType(buf)) {
522 
 
523 
	case StartFontMetrics:
524 
	    mode = StartFontMetrics;
525 
	    break;
526 
 
527 
	case EndFontMetrics:
528 
	    mode = 0;
529 
	    break;
530 
 
531 
	case FontBBox:
15590 iacus 532 
	    if (!GetFontBBox(buf, metrics)) goto pserror;
5148 ripley 533 
	    break;
534 
 
535 
	case C:
15590 iacus 536 
	    if (mode != StartFontMetrics) goto pserror;
537 
	    if (!GetCharInfo(buf, metrics, reencode)) goto pserror;
5148 ripley 538 
	    break;
539 
 
8813 ripley 540 
	case StartKernData:
541 
	    mode = StartKernData;
542 
	    break;
543 
 
544 
	case StartKernPairs:
15590 iacus 545 
	    if(mode != StartKernData) goto pserror;
10960 ripley 546 
	    p = SkipToNextItem(buf);
8813 ripley 547 
	    sscanf(p, "%d", &nKPX);
17419 ripley 548 
	    if(nKPX > 0) {
549 
		/* nPKX == 0 should not happen, but has */
550 
		metrics->KernPairs = (KP *) malloc(nKPX * sizeof(KP));
551 
		if (!metrics->KernPairs) goto pserror;
552 
	    }
8813 ripley 553 
	    break;
554 
 
555 
	case KPX:
15590 iacus 556 
	    if(mode != StartKernData || i >= nKPX) goto pserror;
8813 ripley 557 
	    if (GetKPX(buf, i, metrics)) i++;
558 
	    break;
559 
 
560 
	case EndKernData:
561 
	    mode = 0;
562 
	    break;
563 
 
5148 ripley 564 
	case Unknown:
10960 ripley 565 
	    warning("unknown AFM entity encountered");
5148 ripley 566 
	    break;
567 
 
10960 ripley 568 
	case FontName:
569 
	    p = SkipToNextItem(buf);
16937 ripley 570 
	    sscanf(p, "%[^\n\f\r]", fontname);
10960 ripley 571 
	    break;
15168 pd 572 
 
5148 ripley 573 
	case Empty:
574 
	default:
575 
	    break;
576 
	}
577 
    }
8813 ripley 578 
    metrics->nKP = i;
5148 ripley 579 
    fclose(fp);
9040 ripley 580 
    /* Make an index for kern-pair searches: relies on having contiguous
581 
       blocks by first char for efficiency, but works in all cases. */
582 
    {
583 
	short ind, tmp;
584 
	for (j = 0; j < 256; j++) {
585 
	    metrics->KPstart[j] = i;
586 
	    metrics->KPend[j] = 0;
587 
	}
588 
	for (j = 0; j < i; j++) {
589 
	    ind = metrics->KernPairs[j].c1;
590 
	    tmp = metrics->KPstart[ind];
591 
	    if(j < tmp) metrics->KPstart[ind] = j;
592 
	    tmp = metrics->KPend[ind];
593 
	    if(j > tmp) metrics->KPend[ind] = j;
594 
	}
595 
    }
5148 ripley 596 
    return 1;
15590 iacus 597 
 pserror:
5148 ripley 598 
    fclose(fp);
599 
    return 0;
600 
}
601 
 
10955 ripley 602 
static double
603 
PostScriptStringWidth(unsigned char *p, FontMetricInfo *metrics)
5148 ripley 604 
{
8813 ripley 605 
    int sum = 0, i;
12241 ripley 606 
    short wx;
8813 ripley 607 
    unsigned char p1, p2;
5148 ripley 608 
    for ( ; *p; p++) {
12778 pd 609 
#ifdef USE_HYPHEN
610 
	if (*p == '-' && !isdigit(p[1]))
611 
	    wx = metrics->CharInfo[(int)PS_hyphen].WX;
612 
	else
613 
#endif
614 
	    wx = metrics->CharInfo[*p].WX;
12241 ripley 615 
	if(wx == NA_SHORT)
12288 ripley 616 
	    warning("font width unknown for character %d", *p);
12241 ripley 617 
	else sum += wx;
15168 pd 618 
 
8813 ripley 619 
	/* check for kerning adjustment */
620 
	p1 = p[0]; p2 = p[1];
9040 ripley 621 
	for (i =  metrics->KPstart[p1]; i < metrics->KPend[p1]; i++)
622 
	/* second test is a safety check: should all start with p1  */
9687 pd 623 
	    if(metrics->KernPairs[i].c2 == p2 &&
9040 ripley 624 
	       metrics->KernPairs[i].c1 == p1) {
8813 ripley 625 
		sum += metrics->KernPairs[i].kern;
626 
		break;
627 
	    }
5148 ripley 628 
    }
629 
    return 0.001 * sum;
630 
}
631 
 
10955 ripley 632 
static void
633 
PostScriptMetricInfo(int c, double *ascent, double *descent,
634 
		     double *width, FontMetricInfo *metrics)
5148 ripley 635 
{
12241 ripley 636 
    short wx;
16837 ripley 637 
 
5148 ripley 638 
    if (c == 0) {
639 
	*ascent = 0.001 * metrics->FontBBox[3];
640 
	*descent = -0.001 * metrics->FontBBox[1];
641 
	*width = 0.001 * (metrics->FontBBox[2] - metrics->FontBBox[0]);
642 
    }
643 
    else {
644 
	*ascent = 0.001 * metrics->CharInfo[c].BBox[3];
645 
	*descent = -0.001 * metrics->CharInfo[c].BBox[1];
12241 ripley 646 
	wx = metrics->CharInfo[c].WX;
647 
	if(wx == NA_SHORT) {
12288 ripley 648 
	    warning("font metrics unknown for character %d", c);
12241 ripley 649 
	    wx = 0;
650 
	}
651 
	*width = 0.001 * wx;
5148 ripley 652 
    }
653 
}
654 
 
655 
 
656 
/*  Part 2.  Graphics Support Code.  */
657 
 
19912 duncan 658 
static const char * const TypeFaceDef[] = { "R", "B", "I", "BI", "S" };
5148 ripley 659 
 
12288 ripley 660 
static void PSEncodeFont(FILE *fp, char *encname)
5148 ripley 661 
{
662 
    int i;
12273 ripley 663 
 
12288 ripley 664 
    /* include encoding unless it is ISOLatin1Encoding, which is predefined */
16837 ripley 665 
    if (strcmp(encname, "ISOLatin1Encoding"))
12273 ripley 666 
	fprintf(fp, "%% begin encoding\n%s def\n%% end encoding\n", enccode);
16837 ripley 667 
 
17122 ripley 668 
    if(strcmp(familyname[4], "CMSY10 CMBSY10 CMMI10") == 0) {
16837 ripley 669 
	/* use different ps fragment for CM fonts */
17122 ripley 670 
	fprintf(fp, "%% begin encoding\n");
671 
	fprintf(fp, "/SymbolEncoding [\n");
672 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
673 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
674 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
675 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
676 
	fprintf(fp, " /space /exclam /universal /numbersign /existential /percent /ampersand /suchthat\n");
677 
	fprintf(fp, " /parenleft /parenright /asteriskmath /plus /comma /minus /period /slash\n");
678 
	fprintf(fp, " /zero /one /two /three /four /five /six /seven\n");
679 
	fprintf(fp, " /eight /nine /colon /semicolon /less /equal /greater /question\n");
680 
	fprintf(fp, " /congruent /Alpha /Beta /Chi /Delta /Epsilon /Phi /Gamma\n");
681 
	fprintf(fp, " /Eta /Iota /theta1 /Kappa /Lambda /Mu /Nu /Omicron\n");
682 
	fprintf(fp, " /Pi /Theta /Rho /Sigma /Tau /Upsilon /sigma1 /Omega\n");
683 
	fprintf(fp, " /Xi /Psi /Zeta /bracketleft /therefore /bracketright /perpendicular /underscore\n");
684 
	fprintf(fp, " /radicalex /alpha /beta /chi /delta /epsilon /phi /gamma\n");
685 
	fprintf(fp, " /eta /iota /phi1 /kappa /lambda /mu /nu /omicron\n");
686 
	fprintf(fp, " /pi /theta /rho /sigma /tau /upsilon /omega1 /omega\n");
687 
	fprintf(fp, " /xi /psi /zeta /braceleft /bar /braceright /similar /.notdef\n");
688 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
689 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
690 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
691 
	fprintf(fp, " /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef\n");
692 
	fprintf(fp, " /Euro /Upsilon1 /minute /lessequal /fraction /infinity /florin /club\n");
693 
	fprintf(fp, " /diamond /heart /spade /arrowboth /arrowleft /arrowup /arrowright /arrowdown\n");
694 
	fprintf(fp, " /degree /plusminus /second /greaterequal /multiply /proportional /partialdiff /bullet\n");
695 
	fprintf(fp, " /divide /notequal /equivalence /approxequal /ellipsis /arrowvertex /arrowhorizex /carriagereturn\n");
696 
	fprintf(fp, " /aleph /Ifraktur /Rfraktur /weierstrass /circlemultiply /circleplus /emptyset /intersection\n");
697 
	fprintf(fp, " /union /propersuperset /reflexsuperset /notsubset /propersubset /reflexsubset /element /notelement\n");
698 
	fprintf(fp, " /angle /gradient /registerserif /copyrightserif /trademarkserif /product /radical /dotmath\n");
699 
	fprintf(fp, " /logicalnot /logicaland /logicalor /arrowdblboth /arrowdblleft /arrowdblup /arrowdblright /arrowdbldown\n");
700 
	fprintf(fp, " /lozenge /angleleft /registersans /copyrightsans /trademarksans /summation /parenlefttp /parenleftex\n");
701 
	fprintf(fp, " /parenleftbt /bracketlefttp /bracketleftex /bracketleftbt /bracelefttp /braceleftmid /braceleftbt /braceex\n");
702 
	fprintf(fp, " /.notdef /angleright /integral /integraltp /integralex /integralbt /parenrighttp /parenrightex\n");
703 
	fprintf(fp, " /parenrightbt /bracketrighttp /bracketrightex /bracketrightbt /bracerighttp /bracerightmid /bracerightbt /.notdef\n");
704 
	fprintf(fp, "] def\n");
705 
	fprintf(fp, "%% end encoding\n");
706 
	fprintf(fp, "/mergefonts\n");
707 
	fprintf(fp, "{ /targetencoding exch def\n");
708 
	fprintf(fp, "  /fontarray exch def\n");
709 
	fprintf(fp, "  fontarray 0 get dup maxlength dict begin\n");
710 
	fprintf(fp, "  { 1 index /FID ne { def } { pop pop } ifelse } forall\n");
711 
	fprintf(fp, "  %% Create a new dictionary\n");
712 
	fprintf(fp, "  /CharStrings 256 dict def\n");
713 
	fprintf(fp, "  %% Add a definition of .notdef\n");
714 
	fprintf(fp, "  fontarray\n");
715 
	fprintf(fp, "  { /CharStrings get dup /.notdef known\n");
716 
	fprintf(fp, "    { /.notdef get /result exch def exit }\n");
717 
	fprintf(fp, "    { pop } ifelse\n");
718 
	fprintf(fp, "  } forall\n");
719 
	fprintf(fp, "  CharStrings /.notdef result put\n");
720 
	fprintf(fp, "  %% Add in the other definitions\n");
721 
	fprintf(fp, "  targetencoding\n");
722 
	fprintf(fp, "  { /code exch def\n");
723 
	fprintf(fp, "    %% Check that it is not a .notdef\n");
724 
	fprintf(fp, "    code /.notdef eq\n");
725 
	fprintf(fp, "    { /.notdef }\n");
726 
	fprintf(fp, "    { fontarray\n");
727 
	fprintf(fp, "      { /CharStrings get dup code known\n");
728 
	fprintf(fp, "        { code get /result exch def /found true def exit }\n");
729 
	fprintf(fp, "        { pop /found false def } ifelse\n");
730 
	fprintf(fp, "      } forall\n");
20059 ripley 731 
	fprintf(fp, "      %% define character if it was found and accumulate encoding\n");
17122 ripley 732 
	fprintf(fp, "      found { CharStrings code result put code } { /.notdef } ifelse\n");
733 
	fprintf(fp, "    } ifelse\n");
734 
	fprintf(fp, "  } forall\n");
735 
	fprintf(fp, "  %% grab new encoding off of stack\n");
736 
	fprintf(fp, "  256 array astore /Encoding exch def\n");
737 
	fprintf(fp, "  %% Undefine some local variables\n");
738 
	fprintf(fp, "  currentdict /fontarray undef\n");
739 
	fprintf(fp, "  currentdict /targetencoding undef\n");
740 
	fprintf(fp, "  currentdict /code undef\n");
741 
	fprintf(fp, "  currentdict /result undef\n");
742 
	fprintf(fp, "  currentdict /found undef\n");
743 
	fprintf(fp, "  %% Leave new font on the stack\n");
744 
	fprintf(fp, "  currentdict\n");
745 
	fprintf(fp, "  end\n");
746 
	fprintf(fp, "} def\n");
747 
	fprintf(fp, "%%%%IncludeResource: font CMR10\n");
748 
	fprintf(fp, "%%%%IncludeResource: font CMSY10\n");
749 
	fprintf(fp, "[ /CMR10 findfont /CMSY10 findfont ] %s mergefonts\n", encname);
750 
	fprintf(fp, "/Font1 exch definefont pop\n");
751 
	fprintf(fp, "%%%%IncludeResource: font CMBX10\n");
752 
	fprintf(fp, "%%%%IncludeResource: font CMBSY10\n");
753 
	fprintf(fp, "[ /CMBX10 findfont /CMBSY10 findfont ] %s mergefonts\n", encname);
754 
	fprintf(fp, "/Font2 exch definefont pop\n");
755 
	fprintf(fp, "%%%%IncludeResource: font CMSL10\n");
756 
	fprintf(fp, "[ /CMSL10 findfont /CMSY10 findfont ] %s mergefonts\n", encname);
757 
	fprintf(fp, "/Font3 exch definefont pop\n");
758 
	fprintf(fp, "%%%%IncludeResource: font CMBXSL10\n");
759 
	fprintf(fp, "[ /CMBXSL10 findfont /CMBSY10 findfont ] %s mergefonts\n", encname);
760 
	fprintf(fp, "/Font4 exch definefont pop\n");
761 
	fprintf(fp, "%%%%IncludeResource: font CMMI10\n");
762 
	fprintf(fp, "[ /CMR10 findfont /CMSY10 findfont /CMMI10 findfont ] SymbolEncoding mergefonts\n");
763 
	fprintf(fp, "/Font5 exch definefont pop\n");
16834 ripley 764 
    } else {
765 
  	for (i = 0; i < 4 ; i++) {
17122 ripley 766 
	    fprintf(fp, "%%%%IncludeResource: font %s\n", familyname[i]);
16834 ripley 767 
	    fprintf(fp, "/%s findfont\n", familyname[i]);
768 
	    fprintf(fp, "dup length dict begin\n");
769 
	    fprintf(fp, "  {1 index /FID ne {def} {pop pop} ifelse} forall\n");
770 
	    fprintf(fp, "  /Encoding %s def\n", encname);
771 
	    fprintf(fp, "  currentdict\n");
772 
	    fprintf(fp, "  end\n");
773 
	    fprintf(fp, "/Font%d exch definefont pop\n", i + 1);
774 
   	}
17122 ripley 775 
	fprintf(fp, "%%%%IncludeResource: font %s\n", familyname[4]);
16834 ripley 776 
   	fprintf(fp, "/%s findfont\n", familyname[4]);
777 
   	fprintf(fp, "dup length dict begin\n");
778 
   	fprintf(fp, "  {1 index /FID ne {def} {pop pop} ifelse} forall\n");
779 
   	fprintf(fp, "  currentdict\n");
780 
   	fprintf(fp, "  end\n");
781 
   	fprintf(fp, "/Font5 exch definefont pop\n");
5148 ripley 782 
    }
783 
}
784 
 
785 
/* The variables "paperwidth" and "paperheight" give the dimensions */
786 
/* of the (unrotated) printer page in points whereas the graphics */
787 
/* region box is for the rotated page. */
788 
 
16837 ripley 789 
static void PSFileHeader(FILE *fp, char* encname,
790 
			 char *papername, double paperwidth,
12288 ripley 791 
			 double paperheight, Rboolean landscape,
18116 ripley 792 
			 int EPSFheader, Rboolean paperspecial,
24535 ripley 793 
			 double left, double bottom, double right, double top,
22279 ripley 794 
			 char *title)
5148 ripley 795 
{
10960 ripley 796 
    int i;
16937 ripley 797 
    SEXP prolog;
10960 ripley 798 
 
8792 ripley 799 
    if(EPSFheader)
6098 pd 800 
	fprintf(fp, "%%!PS-Adobe-3.0 EPSF-3.0\n");
801 
    else
802 
	fprintf(fp, "%%!PS-Adobe-3.0\n");
16834 ripley 803 
    fprintf(fp, "%%%%DocumentNeededResources: font %s\n", familyname[0]);
804 
    for (i = 1; i < 5; i++)
10960 ripley 805 
	fprintf(fp, "%%%%+ font %s\n", familyname[i]);
16837 ripley 806 
 
6098 pd 807 
    if(!EPSFheader)
10955 ripley 808 
	fprintf(fp, "%%%%DocumentMedia: %s %.0f %.0f 0 () ()\n",
6098 pd 809 
		papername, paperwidth, paperheight);
22279 ripley 810 
    fprintf(fp, "%%%%Title: %s\n", title);
5148 ripley 811 
    fprintf(fp, "%%%%Creator: R Software\n");
812 
    fprintf(fp, "%%%%Pages: (atend)\n");
18116 ripley 813 
    if (!EPSFheader && !paperspecial) { /* gs gets confused by this */
814 
	if (landscape)
815 
	    fprintf(fp, "%%%%Orientation: Landscape\n");
816 
	else
817 
	    fprintf(fp, "%%%%Orientation: Portrait\n");
5148 ripley 818 
    }
10955 ripley 819 
    fprintf(fp, "%%%%BoundingBox: %.0f %.0f %.0f %.0f\n",
820 
	    left, bottom, right, top);
5148 ripley 821 
    fprintf(fp, "%%%%EndComments\n");
822 
    fprintf(fp, "%%%%BeginProlog\n");
823 
    if (landscape)
10132 pd 824 
	fprintf(fp, "/bp  { gs %.2f 0 translate 90 rotate gs } def\n", paperwidth);
5148 ripley 825 
    else
10132 pd 826 
	fprintf(fp, "/bp  { gs gs } def\n");
10960 ripley 827 
    prolog = findVar(install(".ps.prolog"), R_GlobalEnv);
27536 ripley 828 
    if(prolog == R_UnboundValue) {
829 
	/* if no object is visible, look in the graphics namespace */
830 
	SEXP graphicsNS = R_FindNamespace(ScalarString(mkChar("graphics")));
831 
	prolog = findVar(install(".ps.prolog"), graphicsNS);
832 
    }
10960 ripley 833 
    if(!isString(prolog))
13500 ripley 834 
	error("Object .ps.prolog is not a character vector");
10960 ripley 835 
    fprintf(fp, "%% begin .ps.prolog\n");
836 
    for (i = 0; i < length(prolog); i++)
837 
	fprintf(fp, "%s\n", CHAR(STRING_ELT(prolog, i)));
838 
    fprintf(fp, "%% end   .ps.prolog\n");
12288 ripley 839 
    PSEncodeFont(fp, encname);
5148 ripley 840 
    fprintf(fp, "%%%%EndProlog\n");
841 
}
842 
 
10955 ripley 843 
static void PostScriptFileTrailer(FILE *fp, int pageno)
5148 ripley 844 
{
845 
    fprintf(fp, "ep\n");
846 
    fprintf(fp, "%%%%Trailer\n");
847 
    fprintf(fp, "%%%%Pages: %d\n", pageno);
848 
    fprintf(fp, "%%%%EOF\n");
849 
}
850 
 
10955 ripley 851 
static void PostScriptStartPage(FILE *fp, int pageno)
5148 ripley 852 
{
853 
    fprintf(fp, "%%%%Page: %d %d\n", pageno, pageno);
854 
    fprintf(fp, "bp\n");
855 
}
856 
 
10955 ripley 857 
static void PostScriptEndPage(FILE *fp)
5148 ripley 858 
{
859 
    fprintf(fp, "ep\n");
860 
}
861 
 
10955 ripley 862 
static void PostScriptSetClipRect(FILE *fp, double x0, double x1,
863 
				  double y0, double y1)
8546 murrell 864 
{
10955 ripley 865 
    fprintf(fp, "%.2f %.2f %.2f %.2f cl\n", x0, y0, x1, y1);
8546 murrell 866 
}
867 
 
10955 ripley 868 
static void PostScriptSetLineWidth(FILE *fp, double linewidth)
5148 ripley 869 
{
870 
    fprintf(fp, "%.2f setlinewidth\n", linewidth);
871 
}
872 
 
10955 ripley 873 
static void PostScriptSetFont(FILE *fp, int typeface, double size)
5148 ripley 874 
{
875 
    fprintf(fp, "/ps %.0f def %s %.0f s\n", size, TypeFaceDef[typeface], size);
876 
}
877 
 
20059 ripley 878 
static void
879 
PostScriptSetLineTexture(FILE *fp, char *dashlist, int nlty, double lwd)
5148 ripley 880 
{
20059 ripley 881 
/* use same macro for Postscript and PDF */
882 
#define PP_SetLineTexture(_CMD_)						\
883 
    double dash;								\
884 
    int i;									\
885 
    fprintf(fp,"[");								\
886 
    for (i = 0; i < nlty; i++) {						\
887 
	dash = (lwd >= 1 ? lwd: 1) *						\
888 
	    ((i % 2) ? dashlist[i] + 1						\
889 
	     :((nlty == 1 && dashlist[i] == 1.) ? 1. : dashlist[i] - 1));	\
890 
	if (dash < 0) dash = 0;							\
891 
	fprintf(fp," %.2f", dash);						\
892 
    }										\
893 
    fprintf(fp,"] 0 %s\n", _CMD_)
894 
 
895 
    PP_SetLineTexture("setdash");
5148 ripley 896 
}
897 
 
898 
 
10955 ripley 899 
static void PostScriptMoveTo(FILE *fp, double x, double y)
5148 ripley 900 
{
901 
    fprintf(fp, "%.2f %.2f m\n", x, y);
902 
}
903 
 
23105 ripley 904 
static void PostScriptRLineTo(FILE *fp, double x0, double y0,
905 
			      double x1, double y1)
5148 ripley 906 
{
24535 ripley 907 
    double x = rround(x1, 2) - rround(x0, 2),
908 
	y = rround(y1, 2) - rround(y0, 2);
24784 ripley 909 
    /* Warning: some machines seem to compute these differently from
910 
       others, and we do want to diff the output.  x and y should be
911 
       above around 0.01 or negligible (1e-14), and it is the latter case
912 
       we are watching out for here.
913 
    */
23105 ripley 914 
 
24784 ripley 915 
    if(fabs(x) < 0.005) fprintf(fp, "0"); else fprintf(fp, "%.2f", x);
916 
    if(fabs(y) < 0.005) fprintf(fp, " 0"); else fprintf(fp, " %.2f", y);
23105 ripley 917 
    fprintf(fp, " l\n");
5148 ripley 918 
}
919 
 
10955 ripley 920 
static void PostScriptStartPath(FILE *fp)
5148 ripley 921 
{
922 
    fprintf(fp, "np\n");
923 
}
924 
 
10955 ripley 925 
static void PostScriptEndPath(FILE *fp)
5148 ripley 926 
{
927 
    fprintf(fp, "o\n");
928 
}
929 
 
10955 ripley 930 
static void PostScriptRectangle(FILE *fp, double x0, double y0,
931 
				double x1, double y1)
5148 ripley 932 
{
23105 ripley 933 
    fprintf(fp, "%.2f %.2f %.2f %.2f r ", x0, y0, x1-x0, y1-y0);
5148 ripley 934 
}
935 
 
10955 ripley 936 
static void PostScriptCircle(FILE *fp, double x, double y, double r)
5148 ripley 937 
{
938 
    fprintf(fp, "%.2f %.2f %.2f c ", x, y, r);
939 
}
940 
 
941 
static void PostScriptWriteString(FILE *fp, char *str)
942 
{
943 
    fputc('(', fp);
944 
    for ( ; *str; str++)
945 
	switch(*str) {
946 
	case '\n':
947 
	    fprintf(fp, "\\n");
948 
	    break;
8176 murrell 949 
	case '\\':
950 
	    fprintf(fp, "\\\\");
951 
	    break;
5148 ripley 952 
	case '-':
12778 pd 953 
#ifdef USE_HYPHEN
954 
	    if (!isdigit((int)str[1]))
955 
		fputc(PS_hyphen, fp);
956 
	    else
957 
#endif
958 
		fputc(*str, fp);
5148 ripley 959 
	    break;
960 
	case '(':
961 
	case ')':
962 
	    fprintf(fp, "\\%c", *str);
963 
	    break;
964 
	default:
965 
	    fputc(*str, fp);
966 
	    break;
967 
	}
968 
    fputc(')', fp);
969 
}
970 
 
10955 ripley 971 
static void PostScriptText(FILE *fp, double x, double y,
972 
			   char *str, double xc, double yc, double rot)
5148 ripley 973 
{
974 
    fprintf(fp, "%.2f %.2f ", x, y);
975 
    PostScriptWriteString(fp, str);
23105 ripley 976 
 
24535 ripley 977 
    if(xc == 0) fprintf(fp, " 0");
978 
    else if(xc == 0.5) fprintf(fp, " .5");
979 
    else if(xc == 1) fprintf(fp, " 1");
23105 ripley 980 
    else fprintf(fp, " %.2f", xc);
981 
 
24535 ripley 982 
    if(yc == 0) fprintf(fp, " 0");
983 
    else if(yc == 0.5) fprintf(fp, " .5");
984 
    else if(yc == 1) fprintf(fp, " 1");
23105 ripley 985 
    else fprintf(fp, " %.2f", yc);
986 
 
24535 ripley 987 
    if(rot == 0) fprintf(fp, " 0");
988 
    else if(rot == 90) fprintf(fp, " 90");
23105 ripley 989 
    else fprintf(fp, " %.2f", rot);
990 
 
991 
    fprintf(fp, " t\n");
5148 ripley 992 
}
993 
 
994 
 
995 
/* Part 3.  Device Driver State. */
996 
 
997 
typedef struct {
8663 ripley 998 
    char filename[PATH_MAX];
8701 ripley 999 
    int open_type;
5148 ripley 1000 
 
11067 maechler 1001 
    char papername[64];	/* paper name */
1002 
    int paperwidth;	/* paper width in big points (1/72 in) */
1003 
    int paperheight;	/* paper height in big points */
1004 
    Rboolean landscape;	/* landscape mode */
1005 
    int pageno;		/* page number */
15168 pd 1006 
 
11067 maechler 1007 
    int fontfamily;	/* font family */
13854 ripley 1008 
    char encpath[PATH_MAX]; /* font encoding file */
1009 
    char encname[100]; /* font encoding */
11067 maechler 1010 
    char **afmpaths;	/* for user-specified family */
5148 ripley 1011 
    int maxpointsize;
1012 
 
11067 maechler 1013 
    double width;	/* plot width in inches */
1014 
    double height;	/* plot height in inches */
1015 
    double pagewidth;	/* page width in inches */
1016 
    double pageheight;	/* page height in inches */
1017 
    Rboolean pagecentre;/* centre image on page? */
1018 
    Rboolean printit;	/* print page at close? */
8701 ripley 1019 
    char command[PATH_MAX];
22279 ripley 1020 
    char title[1024];
5148 ripley 1021 
 
11067 maechler 1022 
    FILE *psfp;		/* output file */
6098 pd 1023 
 
11067 maechler 1024 
    Rboolean onefile;	/* EPSF header etc*/
18116 ripley 1025 
    Rboolean paperspecial;	/* suppress %%Orientation */
10526 pd 1026 
 
10955 ripley 1027 
    /* This group of variables track the current device status.
10526 pd 1028 
     * They should only be set by routines that emit PostScript code. */
10955 ripley 1029 
    struct {
10526 pd 1030 
	double lwd;		 /* line width */
1031 
	int lty;		 /* line type */
1032 
	int fontstyle;	         /* font style, R, B, I, BI, S */
1033 
	int fontsize;	         /* font size in points */
1034 
	rcolor col;		 /* color */
1035 
	rcolor fill;	         /* fill color */
1036 
    } current;
10660 ripley 1037 
 
1038 
    FontMetricInfo metrics[5];	/* font metrics */
5148 ripley 1039 
}
1040 
PostScriptDesc;
1041 
 
1042 
 
1043 
/* Device Driver Actions */
1044 
 
16948 murrell 1045 
static void PS_Activate(NewDevDesc *dd);
1046 
static void PS_Circle(double x, double y, double r,
27236 murrell 1047 
		      R_GE_gcontext *gc,
17165 murrell 1048 
		      NewDevDesc *dd);
20059 ripley 1049 
static void PS_Clip(double x0, double x1, double y0, double y1,
16948 murrell 1050 
		     NewDevDesc *dd);
1051 
static void PS_Close(NewDevDesc *dd);
1052 
static void PS_Deactivate(NewDevDesc *dd);
1053 
static void PS_Hold(NewDevDesc *dd);
1054 
static Rboolean PS_Locator(double *x, double *y, NewDevDesc *dd);
1055 
static void PS_Line(double x1, double y1, double x2, double y2,
27236 murrell 1056 
		    R_GE_gcontext *gc,
17165 murrell 1057 
		    NewDevDesc *dd);
27236 murrell 1058 
static void PS_MetricInfo(int c,
1059 
			  R_GE_gcontext *gc,
1060 
			  double* ascent, double* descent,
1061 
			  double* width, NewDevDesc *dd);
16948 murrell 1062 
static void PS_Mode(int mode, NewDevDesc *dd);
27236 murrell 1063 
static void PS_NewPage(R_GE_gcontext *gc,
1064 
		       NewDevDesc *dd);
16948 murrell 1065 
static Rboolean PS_Open(NewDevDesc*, PostScriptDesc*);
20059 ripley 1066 
static void PS_Polygon(int n, double *x, double *y,
27236 murrell 1067 
		       R_GE_gcontext *gc,
17165 murrell 1068 
		       NewDevDesc *dd);
20059 ripley 1069 
static void PS_Polyline(int n, double *x, double *y,
27236 murrell 1070 
			R_GE_gcontext *gc,
16948 murrell 1071 
			NewDevDesc *dd);
1072 
static void PS_Rect(double x0, double y0, double x1, double y1,
27236 murrell 1073 
		    R_GE_gcontext *gc,
17165 murrell 1074 
		    NewDevDesc *dd);
16948 murrell 1075 
static void PS_Size(double *left, double *right,
1076 
		     double *bottom, double *top,
1077 
		     NewDevDesc *dd);
27236 murrell 1078 
static double PS_StrWidth(char *str,
1079 
			  R_GE_gcontext *gc,
1080 
			  NewDevDesc *dd);
20059 ripley 1081 
static void PS_Text(double x, double y, char *str,
1082 
		    double rot, double hadj,
27236 murrell 1083 
		    R_GE_gcontext *gc,
17165 murrell 1084 
		    NewDevDesc *dd);
5148 ripley 1085 
 
1086 
 
1087 
 
10526 pd 1088 
/* PostScript Support (formerly in PostScript.c) */
5148 ripley 1089 
 
1090 
static void PostScriptSetCol(FILE *fp, double r, double g, double b)
1091 
{
23105 ripley 1092 
    if(r == 0) fprintf(fp, "0");
1093 
    else if (r == 1) fprintf(fp, "1");
1094 
    else fprintf(fp, "%.4f", r);
1095 
    if(g == 0) fprintf(fp, " 0");
1096 
    else if (g == 1) fprintf(fp, " 1");
1097 
    else fprintf(fp, " %.4f", g);
1098 
    if(b == 0) fprintf(fp, " 0");
1099 
    else if (b == 1) fprintf(fp, " 1");
1100 
    else fprintf(fp, " %.4f", b);
1101 
    fprintf(fp," rgb\n");
5148 ripley 1102 
}
1103 
 
1104 
static void PostScriptSetFill(FILE *fp, double r, double g, double b)
1105 
{
23105 ripley 1106 
    fprintf(fp,"/bg { ");
1107 
    if(r == 0) fprintf(fp, "0");
1108 
    else if (r == 1) fprintf(fp, "1");
1109 
    else fprintf(fp, "%.4f", r);
1110 
    if(g == 0) fprintf(fp, " 0");
1111 
    else if (g == 1) fprintf(fp, " 1");
1112 
    else fprintf(fp, " %.4f", g);
1113 
    if(b == 0) fprintf(fp, " 0");
1114 
    else if (b == 1) fprintf(fp, " 1");
1115 
    else fprintf(fp, " %.4f", b);
1116 
    fprintf(fp," } def\n");
5148 ripley 1117 
}
1118 
 
1119 
 
1120 
 
1121 
/* Driver Support Routines */
1122 
 
16948 murrell 1123 
static void SetColor(int, NewDevDesc*);
1124 
static void SetFill(int, NewDevDesc*);
1125 
static void SetFont(int, int, NewDevDesc*);
1126 
static void SetLineStyle(int newlty, double newlwd, NewDevDesc *dd);
1127 
static void Invalidate(NewDevDesc*);
5148 ripley 1128 
static int  MatchFamily(char *name);
1129 
 
1130 
 
16948 murrell 1131 
static Rboolean
1132 
innerPSDeviceDriver(NewDevDesc *dd, char *file, char *paper, char *family,
1133 
		    char **afmpaths, char *encoding,
1134 
		    char *bg, char *fg,
1135 
		    double width, double height,
1136 
		    Rboolean horizontal, double ps,
1137 
		    Rboolean onefile, Rboolean pagecentre,
22279 ripley 1138 
		    Rboolean printit, char *cmd, char *title)
5148 ripley 1139 
{
10960 ripley 1140 
    /* If we need to bail out with some sort of "error"
1141 
       then we must free(dd) */
5148 ripley 1142 
 
1143 
    double xoff, yoff, pointsize;
12288 ripley 1144 
    rcolor setbg, setfg;
10526 pd 1145 
 
5148 ripley 1146 
    PostScriptDesc *pd;
1147 
 
1148 
    /* Check and extract the device parameters */
1149 
 
8663 ripley 1150 
    if(strlen(file) > PATH_MAX - 1) {
5148 ripley 1151 
	free(dd);
8663 ripley 1152 
	error("filename too long in postscript");
5148 ripley 1153 
    }
1154 
 
1155 
    /* allocate new postscript device description */
1156 
    if (!(pd = (PostScriptDesc *) malloc(sizeof(PostScriptDesc))))
11067 maechler 1157 
	return FALSE;
5148 ripley 1158 
 
1159 
    /* from here on, if need to bail out with "error", must also */
1160 
    /* free(pd) */
1161 
 
1162 
    /* initialise postscript device description */
1163 
    strcpy(pd->filename, file);
1164 
    strcpy(pd->papername, paper);
22279 ripley 1165 
    strncpy(pd->title, title, 1024);
10960 ripley 1166 
    pd->fontfamily = strcmp(family, "User") ? MatchFamily(family) : USERAFM;
18560 ripley 1167 
    if(strlen(encoding) > PATH_MAX - 1) {
1168 
	free(dd);
1169 
	free(pd);
1170 
	error("encoding path is too long");
1171 
    }
13854 ripley 1172 
    strcpy(pd->encpath, encoding);
10960 ripley 1173 
    pd->afmpaths = afmpaths;
10526 pd 1174 
 
1175 
    setbg = str2col(bg);
1176 
    setfg = str2col(fg);
1177 
 
5148 ripley 1178 
    pd->width = width;
1179 
    pd->height = height;
1180 
    pd->landscape = horizontal;
1181 
    pointsize = floor(ps);
10526 pd 1182 
    if(setbg == NA_INTEGER && setfg == NA_INTEGER) {
5148 ripley 1183 
	free(dd);
1184 
	free(pd);
5731 ripley 1185 
	error("invalid foreground/background color (postscript)");
5148 ripley 1186 
    }
8701 ripley 1187 
    pd->printit = printit;
18560 ripley 1188 
    if(strlen(cmd) > PATH_MAX - 1) {
1189 
	free(dd);
1190 
	free(pd);
1191 
	error("`command' is too long");
1192 
    }
8701 ripley 1193 
    strcpy(pd->command, cmd);
1194 
    if (printit && strlen(cmd) == 0)
12273 ripley 1195 
	error("postscript(print.it=T) used with an empty print command");
8701 ripley 1196 
    strcpy(pd->command, cmd);
5148 ripley 1197 
 
8701 ripley 1198 
 
5148 ripley 1199 
    /* Deal with paper and plot size and orientation */
1200 
 
18116 ripley 1201 
    pd->paperspecial = FALSE;
5148 ripley 1202 
    if(!strcmp(pd->papername, "Default") ||
1203 
       !strcmp(pd->papername, "default")) {
10172 luke 1204 
	SEXP s = STRING_ELT(GetOption(install("papersize"), R_NilValue), 0);
8681 ripley 1205 
	if(s != NA_STRING && strlen(CHAR(s)) > 0)
1206 
	    strcpy(pd->papername, CHAR(s));
5148 ripley 1207 
	else strcpy(pd->papername, "a4");
1208 
    }
1209 
    if(!strcmp(pd->papername, "A4") ||
1210 
       !strcmp(pd->papername, "a4")) {
1211 
	pd->pagewidth  = 21.0 / 2.54;
1212 
	pd->pageheight = 29.7  /2.54;
1213 
    }
1214 
    else if(!strcmp(pd->papername, "Letter") ||
1215 
	    !strcmp(pd->papername, "letter")) {
1216 
	pd->pagewidth  =  8.5;
1217 
	pd->pageheight = 11.0;
1218 
    }
1219 
    else if(!strcmp(pd->papername, "Legal") ||
1220 
	    !strcmp(pd->papername, "legal")) {
1221 
	pd->pagewidth  =  8.5;
1222 
	pd->pageheight = 14.0;
1223 
    }
1224 
    else if(!strcmp(pd->papername, "Executive") ||
1225 
	    !strcmp(pd->papername, "executive")) {
1226 
	pd->pagewidth  =  7.25;
1227 
	pd->pageheight = 10.5;
1228 
    }
6098 pd 1229 
    else if(!strcmp(pd->papername, "special")) {
1230 
	if(pd->landscape) {
1231 
	    pd->pagewidth  = height;
1232 
	    pd->pageheight =  width;
1233 
	} else {
1234 
	    pd->pagewidth  =  width;
1235 
	    pd->pageheight = height;
1236 
	}
18116 ripley 1237 
	pd->paperspecial = TRUE;
6098 pd 1238 
    }
5148 ripley 1239 
    else {
1240 
	free(dd);
1241 
	free(pd);
8682 ripley 1242 
	error("invalid page type `%s' (postscript)", pd->papername);
5148 ripley 1243 
    }
6098 pd 1244 
    pd->pagecentre = pagecentre;
5148 ripley 1245 
    pd->paperwidth = 72 * pd->pagewidth;
1246 
    pd->paperheight = 72 * pd->pageheight;
8792 ripley 1247 
    pd->onefile = onefile;
5148 ripley 1248 
    if(pd->landscape) {
1249 
	double tmp;
1250 
	tmp = pd->pagewidth;
1251 
	pd->pagewidth = pd->pageheight;
1252 
	pd->pageheight = tmp;
1253 
    }
8792 ripley 1254 
    if(strcmp(pd->papername, "special"))
6098 pd 1255 
    {
1256 
	if(pd->width < 0.1 || pd->width > pd->pagewidth-0.5)
1257 
	    pd->width = pd->pagewidth-0.5;
1258 
	if(pd->height < 0.1 || pd->height > pd->pageheight-0.5)
1259 
	    pd->height = pd->pageheight-0.5;
1260 
    }
8792 ripley 1261 
    if(pagecentre)
6098 pd 1262 
    {
1263 
	xoff = (pd->pagewidth - pd->width)/2.0;
1264 
	yoff = (pd->pageheight - pd->height)/2.0;
1265 
    } else {
1266 
	xoff = yoff = 0.0;
1267 
    }
5148 ripley 1268 
    pd->maxpointsize = 72.0 * ((pd->pageheight > pd->pagewidth) ?
1269 
			       pd->pageheight : pd->pagewidth);
1270 
    pd->pageno = 0;
1271 
 
1272 
    /* Base Pointsize */
1273 
    /* Nominal Character Sizes in Pixels */
1274 
    /* Only right for 12 point font. */
1275 
    /* Max pointsize suggested by Peter Dalgaard */
1276 
 
1277 
    if(pointsize < 6.0) pointsize = 6.0;
1278 
    if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize;
16948 murrell 1279 
    dd->startps = pointsize;
1280 
    dd->startfont = 1;
1281 
    dd->startlty = 0;
1282 
    dd->startfill = setbg;
1283 
    dd->startcol = setfg;
17165 murrell 1284 
    dd->startgamma = 1;
5148 ripley 1285 
 
16948 murrell 1286 
    /* Set graphics parameters that must be set by device driver. */
1287 
    /* Page dimensions in points. */
1288 
 
1289 
    dd->left = 72 * xoff;			/* left */
1290 
    dd->right = 72 * (xoff + pd->width);	/* right */
1291 
    dd->bottom = 72 * yoff;			/* bottom */
1292 
    dd->top = 72 * (yoff + pd->height);	/* top */
1293 
 
1294 
    dd->cra[0] = 0.9 * pointsize;
1295 
    dd->cra[1] = 1.2 * pointsize;
1296 
 
5148 ripley 1297 
    /* Character Addressing Offsets */
1298 
    /* These offsets should center a single */
1299 
    /* plotting character over the plotting point. */
1300 
    /* Pure guesswork and eyeballing ... */
1301 
 
16948 murrell 1302 
    dd->xCharOffset =  0.4900;
1303 
    dd->yCharOffset =  0.3333;
1304 
    dd->yLineBias = 0.2;
5148 ripley 1305 
 
1306 
    /* Inches per Raster Unit */
1307 
    /* We use points (72 dots per inch) */
1308 
 
16948 murrell 1309 
    dd->ipr[0] = 1.0/72.0;
1310 
    dd->ipr[1] = 1.0/72.0;
5148 ripley 1311 
    /* GREset(.)  dd->gp.mkh = dd->gp.cra[0] * dd->gp.ipr[0]; */
1312 
 
16948 murrell 1313 
    dd->canResizePlot = 0;
1314 
    dd->canChangeFont = 1;
1315 
    dd->canRotateText = 1;
1316 
    dd->canResizeText = 1;
1317 
    dd->canClip = 1;
1318 
    dd->canHAdj = 2;
17165 murrell 1319 
    dd->canChangeGamma = FALSE;
5148 ripley 1320 
 
1321 
    /*	Start the driver */
1322 
 
8792 ripley 1323 
    pd->pageno = 0;
5148 ripley 1324 
    if(!PS_Open(dd, pd)) {
1325 
	free(pd);
11067 maechler 1326 
	return FALSE;
5148 ripley 1327 
    }
1328 
 
16948 murrell 1329 
    dd->newDevStruct = 1;
5148 ripley 1330 
 
16948 murrell 1331 
    dd->open	      = PS_Open;
1332 
    dd->close      = PS_Close;
1333 
    dd->activate   = PS_Activate;
1334 
    dd->deactivate = PS_Deactivate;
1335 
    dd->size     = PS_Size;
1336 
    dd->newPage    = PS_NewPage;
1337 
    dd->clip	      = PS_Clip;
1338 
    dd->text	      = PS_Text;
1339 
    dd->strWidth   = PS_StrWidth;
1340 
    dd->metricInfo = PS_MetricInfo;
1341 
    dd->rect	      = PS_Rect;
1342 
    dd->circle     = PS_Circle;
1343 
    dd->line	      = PS_Line;
1344 
    dd->polygon    = PS_Polygon;
1345 
    dd->polyline   = PS_Polyline;
1346 
    dd->locator    = PS_Locator;
1347 
    dd->mode	      = PS_Mode;
1348 
    dd->hold	      = PS_Hold;
1349 
 
5148 ripley 1350 
    dd->deviceSpecific = (void *) pd;
11067 maechler 1351 
    dd->displayListOn = FALSE;
1352 
    return TRUE;
5148 ripley 1353 
}
1354 
 
16948 murrell 1355 
/* Do this to avoid having to change Rdevices.h
1356 
 * This will be cleaned up when GraphicsDevice.h replaces
1357 
 * Rdevices.h
1358 
 */
1359 
Rboolean
1360 
PSDeviceDriver(DevDesc *dd, char *file, char *paper, char *family,
1361 
	       char **afmpaths, char *encoding,
1362 
	       char *bg, char *fg,
1363 
	       double width, double height,
1364 
	       Rboolean horizontal, double ps,
1365 
	       Rboolean onefile, Rboolean pagecentre,
22279 ripley 1366 
	       Rboolean printit, char *cmd, char *title)
16948 murrell 1367 
{
1368 
    return innerPSDeviceDriver((NewDevDesc*) dd, file, paper, family,
20059 ripley 1369 
			       afmpaths, encoding, bg, fg, width, height,
16948 murrell 1370 
			       horizontal, ps, onefile, pagecentre,
22279 ripley 1371 
			       printit, cmd, title);
16948 murrell 1372 
}
1373 
 
5148 ripley 1374 
static int MatchFamily(char *name)
1375 
{
1376 
    int i;
1377 
    for(i = 0; Family[i].family != NULL; i++)
1378 
	if(!strcmp(name, Family[i].family)) return i;
5731 ripley 1379 
    warning("unknown postscript font family, using %s",
5148 ripley 1380 
	    Family[3].family);
1381 
    return 3;
1382 
}
1383 
 
16948 murrell 1384 
static void SetColor(int color, NewDevDesc *dd)
5148 ripley 1385 
{
1386 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
10526 pd 1387 
    if(color != pd->current.col) {
5148 ripley 1388 
	PostScriptSetCol(pd->psfp,
1389 
			 R_RED(color)/255.0,
1390 
			 R_GREEN(color)/255.0,
1391 
			 R_BLUE(color)/255.0);
10526 pd 1392 
	pd->current.col = color;
5148 ripley 1393 
    }
1394 
}
1395 
 
16948 murrell 1396 
static void SetFill(int color, NewDevDesc *dd)
5148 ripley 1397 
{
1398 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
10526 pd 1399 
    if(color != pd->current.fill) {
5148 ripley 1400 
	PostScriptSetFill(pd->psfp,
1401 
			  R_RED(color)/255.0,
1402 
			  R_GREEN(color)/255.0,
1403 
			  R_BLUE(color)/255.0);
10526 pd 1404 
	pd->current.fill = color;
5148 ripley 1405 
    }
1406 
}
1407 
 
1408 
/* Note that the line texture is scaled by the line width. */
1409 
 
16948 murrell 1410 
static void SetLineStyle(int newlty, double newlwd, NewDevDesc *dd)
5148 ripley 1411 
{
1412 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
20059 ripley 1413 
    char dashlist[8];
1414 
    int i;
9687 pd 1415 
 
10526 pd 1416 
    if (pd->current.lty != newlty || pd->current.lwd != newlwd) {
1417 
	pd->current.lwd = newlwd;
1418 
	pd->current.lty = newlty;
1419 
	PostScriptSetLineWidth(pd->psfp, newlwd * 0.75);
9687 pd 1420 
	/* process lty : */
5148 ripley 1421 
	for(i = 0; i < 8 && newlty & 15 ; i++) {
20059 ripley 1422 
	    dashlist[i] = newlty & 15;
5148 ripley 1423 
	    newlty = newlty >> 4;
1424 
	}
20059 ripley 1425 
	PostScriptSetLineTexture(pd->psfp, dashlist, i, newlwd * 0.75);
5148 ripley 1426 
    }
1427 
}
1428 
 
16948 murrell 1429 
static void SetFont(int style, int size, NewDevDesc *dd)
5148 ripley 1430 
{
1431 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
27683 ripley 1432 
    if(style < 1 || style > 5) {
1433 
	warning("attempt to use invalid font %d replaced by font 1", style);
5148 ripley 1434 
	style = 1;
27683 ripley 1435 
    }
5148 ripley 1436 
    if(size < 1 || size > pd->maxpointsize)
1437 
	size = 10;
10526 pd 1438 
    if(size != pd->current.fontsize || style != pd->current.fontstyle) {
5148 ripley 1439 
	PostScriptSetFont(pd->psfp, style-1, size);
10526 pd 1440 
	pd->current.fontsize = size;
1441 
	pd->current.fontstyle = style;
5148 ripley 1442 
    }
1443 
}
1444 
 
18657 ripley 1445 
#ifdef Win32
1446 
/* exists, but does not work on GUI processes */
1447 
# undef HAVE_POPEN
1448 
#endif
1449 
 
16948 murrell 1450 
static Rboolean PS_Open(NewDevDesc *dd, PostScriptDesc *pd)
5148 ripley 1451 
{
19912 duncan 1452 
    char buf[512];
5148 ripley 1453 
    int i;
1454 
 
14172 ripley 1455 
    if (!LoadEncoding(pd->encpath, pd->encname, FALSE)) {
1456 
	warning("problem loading encoding file");
1457 
	return FALSE;
1458 
    }
16834 ripley 1459 
    for(i = 0; i < 5 ; i++) {
19912 duncan 1460 
        char const *p;
10960 ripley 1461 
	if(pd->fontfamily == USERAFM) p = pd->afmpaths[i];
1462 
	else p = Family[pd->fontfamily].afmfile[i];
12273 ripley 1463 
	if(!PostScriptLoadFontMetrics(p, &(pd->metrics[i]),
16834 ripley 1464 
				      familyname[i], (i < 4)?1:0)) {
15168 pd 1465 
	    warning("cannot read afm file %s", p);
11067 maechler 1466 
	    return FALSE;
10514 ripley 1467 
	}
5148 ripley 1468 
    }
1469 
 
8681 ripley 1470 
    if (strlen(pd->filename) == 0) {
8724 ripley 1471 
#ifndef HAVE_POPEN
14172 ripley 1472 
	warning("printing via file = \"\" is not implemented in this version");
11067 maechler 1473 
	return FALSE;
8701 ripley 1474 
#else
11067 maechler 1475 
	if(strlen(pd->command) == 0) return FALSE;
21072 ripley 1476 
        errno = 0;
26152 luke 1477 
	pd->psfp = R_popen(pd->command, "w");
8701 ripley 1478 
	pd->open_type = 1;
21072 ripley 1479 
        if (!pd->psfp || errno != 0) {
1480 
            warning("cannot open `postscript' pipe to `%s'", pd->command);
1481 
            return FALSE;
1482 
        }
8701 ripley 1483 
#endif
8681 ripley 1484 
    } else if (pd->filename[0] == '|') {
8724 ripley 1485 
#ifndef HAVE_POPEN
14172 ripley 1486 
	warning("file = \"|cmd\" is not implemented in this version");
11067 maechler 1487 
	return FALSE;
8701 ripley 1488 
#else
21072 ripley 1489 
	errno = 0;
26152 luke 1490 
	pd->psfp = R_popen(pd->filename + 1, "w");
8701 ripley 1491 
	pd->open_type = 1;
21072 ripley 1492 
	if (!pd->psfp || errno != 0) {
10514 ripley 1493 
	    warning("cannot open `postscript' pipe to `%s'", pd->filename + 1);
11067 maechler 1494 
	    return FALSE;
10514 ripley 1495 
	}
8701 ripley 1496 
#endif
1497 
    } else {
25313 ripley 1498 
	snprintf(buf, 512, pd->filename, pd->pageno + 1); /* page 1 to start */
8792 ripley 1499 
	pd->psfp = R_fopen(R_ExpandFileName(buf), "w");
8701 ripley 1500 
	pd->open_type = 0;
1501 
    }
10514 ripley 1502 
    if (!pd->psfp) {
1503 
	warning("cannot open `postscript' file argument `%s'", buf);
11067 maechler 1504 
	return FALSE;
10514 ripley 1505 
    }
5148 ripley 1506 
 
1507 
    if(pd->landscape)
1508 
	PSFileHeader(pd->psfp,
12273 ripley 1509 
		     pd->encname,
5148 ripley 1510 
		     pd->papername,
1511 
		     pd->paperwidth,
1512 
		     pd->paperheight,
1513 
		     pd->landscape,
8792 ripley 1514 
		     !(pd->onefile),
18116 ripley 1515 
		     pd->paperspecial,
16948 murrell 1516 
		     dd->bottom,
1517 
		     dd->left,
1518 
		     dd->top,
22279 ripley 1519 
		     dd->right,
1520 
		     pd->title);
5148 ripley 1521 
    else
1522 
	PSFileHeader(pd->psfp,
12273 ripley 1523 
		     pd->encname,
5148 ripley 1524 
		     pd->papername,
1525 
		     pd->paperwidth,
1526 
		     pd->paperheight,
1527 
		     pd->landscape,
8792 ripley 1528 
		     !(pd->onefile),
18116 ripley 1529 
		     pd->paperspecial,
16948 murrell 1530 
		     dd->left,
1531 
		     dd->bottom,
1532 
		     dd->right,
22279 ripley 1533 
		     dd->top,
1534 
		     pd->title);
5148 ripley 1535 
 
11067 maechler 1536 
    return TRUE;
5148 ripley 1537 
}
1538 
 
10526 pd 1539 
/* The driver keeps track of the current values of colors, fonts and
1540 
   line parameters, to save emitting some PostScript. In some cases,
1541 
   the state becomes unknown, notably after changing the clipping and
1542 
   at the start of a new page, so we have the following routine to
1543 
   invalidate the saved values, which in turn causes the parameters to
1544 
   be set before usage. */
5148 ripley 1545 
 
16948 murrell 1546 
static void Invalidate(NewDevDesc *dd)
10526 pd 1547 
{
1548 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1549 
 
1550 
    pd->current.fontsize = -1;
1551 
    pd->current.fontstyle = -1;
10955 ripley 1552 
    pd->current.lwd = -1;
1553 
    pd->current.lty = -1;
15641 ripley 1554 
    pd->current.col = INVALID_COL;
1555 
    pd->current.fill = INVALID_COL;
10526 pd 1556 
}
1557 
 
16948 murrell 1558 
static void PS_Clip(double x0, double x1, double y0, double y1, NewDevDesc *dd)
5148 ripley 1559 
{
8546 murrell 1560 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
8792 ripley 1561 
 
8546 murrell 1562 
    PostScriptSetClipRect(pd->psfp, x0, x1, y0, y1);
10526 pd 1563 
    /* clipping does grestore so invalidate monitor variables */
1564 
    Invalidate(dd);
5148 ripley 1565 
}
1566 
 
16948 murrell 1567 
static void PS_Size(double *left, double *right,
1568 
		    double *bottom, double *top,
1569 
		    NewDevDesc *dd)
5148 ripley 1570 
{
16948 murrell 1571 
    *left = dd->left;
1572 
    *right = dd->right;
1573 
    *bottom = dd->bottom;
1574 
    *top = dd->top;
5148 ripley 1575 
}
1576 
 
16948 murrell 1577 
static void PostScriptClose(NewDevDesc *dd);
8792 ripley 1578 
 
27236 murrell 1579 
static void PS_NewPage(R_GE_gcontext *gc,
1580 
		       NewDevDesc *dd)
5148 ripley 1581 
{
1582 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1583 
 
8792 ripley 1584 
 
1585 
    if(pd->onefile) {
1586 
	if(++pd->pageno > 1) PostScriptEndPage(pd->psfp);
1587 
    } else if(pd->pageno > 0) {
1588 
	PostScriptClose(dd);
1589 
	PS_Open(dd, pd);
1590 
	pd->pageno++;
1591 
    } else pd->pageno++;
5148 ripley 1592 
    PostScriptStartPage(pd->psfp, pd->pageno);
10526 pd 1593 
    Invalidate(dd);
1594 
 
27236 murrell 1595 
    if(R_ALPHA(gc->fill) == 0) {
1596 
	/*
1597 
	 * Override some gc settings
1598 
	 */
1599 
	gc->col = NA_INTEGER;
1600 
	PS_Rect(0, 0, 72.0 * pd->pagewidth, 72.0 * pd->pageheight, gc, dd);
5148 ripley 1601 
    }
1602 
}
1603 
 
8701 ripley 1604 
#ifdef Win32
1605 
int   runcmd(char *cmd, int wait, int visible, char *finput);
1606 
#endif
16948 murrell 1607 
static void PostScriptClose(NewDevDesc *dd)
5148 ripley 1608 
{
8701 ripley 1609 
    char buff[PATH_MAX];
1610 
    int err = 0;
1611 
 
5148 ripley 1612 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1613 
 
1614 
    PostScriptFileTrailer(pd->psfp, pd->pageno);
8792 ripley 1615 
    if(pd->open_type == 1)
1616 
	pclose(pd->psfp);
8701 ripley 1617 
    else {
1618 
	fclose(pd->psfp);
1619 
	if (pd->printit) {
1620 
	    strcpy(buff, pd->command);
1621 
	    strcat(buff, " ");
1622 
	    strcat(buff, pd->filename);
1623 
/*	    Rprintf("buff is %s\n", buff); */
1624 
#ifdef Unix
26152 luke 1625 
	    err = R_system(buff);
8701 ripley 1626 
#endif
1627 
#ifdef Win32
1628 
	    err = runcmd(buff, 0, 0, NULL);
1629 
#endif
8792 ripley 1630 
	    if (err)
8701 ripley 1631 
		warning("error from postscript() in running:\n    %s", buff);
1632 
	}
1633 
    }
8792 ripley 1634 
}
1635 
 
16948 murrell 1636 
static void PS_Close(NewDevDesc *dd)
8792 ripley 1637 
{
1638 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1639 
 
1640 
    PostScriptClose(dd);
5148 ripley 1641 
    free(pd);
1642 
}
1643 
 
16948 murrell 1644 
static void PS_Activate(NewDevDesc *dd) {}
1645 
static void PS_Deactivate(NewDevDesc *dd) {}
5148 ripley 1646 
 
27236 murrell 1647 
static double PS_StrWidth(char *str,
1648 
			  R_GE_gcontext *gc,
16948 murrell 1649 
			  NewDevDesc *dd)
5148 ripley 1650 
{
10660 ripley 1651 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
27236 murrell 1652 
    int face = gc->fontface;
16837 ripley 1653 
 
13500 ripley 1654 
    if(face < 1 || face > 5) face = 1;
27236 murrell 1655 
    return floor(gc->cex * gc->ps + 0.5) *
10955 ripley 1656 
	PostScriptStringWidth((unsigned char *)str,
13500 ripley 1657 
			      &(pd->metrics[face-1]));
5148 ripley 1658 
}
1659 
 
27236 murrell 1660 
static void PS_MetricInfo(int c,
1661 
			  R_GE_gcontext *gc,
16948 murrell 1662 
			  double* ascent, double* descent,
1663 
			  double* width, NewDevDesc *dd)
5148 ripley 1664 
{
10660 ripley 1665 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
27680 ripley 1666 
    int face = gc->fontface;
10660 ripley 1667 
 
27680 ripley 1668 
    if(face < 1 || face > 5) face = 1;
1669 
 
10955 ripley 1670 
    PostScriptMetricInfo(c, ascent, descent, width,
27680 ripley 1671 
			 &(pd->metrics[face-1]));
27236 murrell 1672 
    *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent;
1673 
    *descent = floor(gc->cex * gc->ps + 0.5) * *descent;
1674 
    *width = floor(gc->cex * gc->ps + 0.5) * *width;
5148 ripley 1675 
}
1676 
 
16948 murrell 1677 
static void PS_Rect(double x0, double y0, double x1, double y1,
27236 murrell 1678 
		    R_GE_gcontext *gc,
16948 murrell 1679 
		    NewDevDesc *dd)
5148 ripley 1680 
{
1681 
    int code;
1682 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1683 
 
1684 
    /* code is set as follows */
1685 
    /* code == 0, nothing to draw */
1686 
    /* code == 1, outline only */
1687 
    /* code == 2, fill only */
8792 ripley 1688 
    /* code == 3, outline and fill */
5148 ripley 1689 
 
27236 murrell 1690 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
5148 ripley 1691 
 
1692 
    if (code) {
1693 
	if(code & 2)
27236 murrell 1694 
	    SetFill(gc->fill, dd);
5148 ripley 1695 
	if(code & 1) {
27236 murrell 1696 
	    SetColor(gc->col, dd);
1697 
	    SetLineStyle(gc->lty, gc->lwd, dd);
5148 ripley 1698 
	}
1699 
	PostScriptRectangle(pd->psfp, x0, y0, x1, y1);
1700 
	fprintf(pd->psfp, "p%d\n", code);
1701 
    }
1702 
}
1703 
 
16948 murrell 1704 
static void PS_Circle(double x, double y, double r,
27236 murrell 1705 
		      R_GE_gcontext *gc,
16948 murrell 1706 
		      NewDevDesc *dd)
5148 ripley 1707 
{
1708 
    int code;
1709 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1710 
 
1711 
    /* code is set as follows */
1712 
    /* code == 0, nothing to draw */
1713 
    /* code == 1, outline only */
1714 
    /* code == 2, fill only */
8792 ripley 1715 
    /* code == 3, outline and fill */
5148 ripley 1716 
 
27236 murrell 1717 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
5148 ripley 1718 
 
1719 
    if (code) {
1720 
	if(code & 2)
27236 murrell 1721 
	    SetFill(gc->fill, dd);
5148 ripley 1722 
	if(code & 1) {
27236 murrell 1723 
	    SetColor(gc->col, dd);
1724 
	    SetLineStyle(gc->lty, gc->lwd, dd);
5148 ripley 1725 
	}
1726 
	PostScriptCircle(pd->psfp, x, y, r);
1727 
	fprintf(pd->psfp, "p%d\n", code);
1728 
    }
1729 
}
1730 
 
1731 
static void PS_Line(double x1, double y1, double x2, double y2,
27236 murrell 1732 
		    R_GE_gcontext *gc,
16948 murrell 1733 
		    NewDevDesc *dd)
5148 ripley 1734 
{
1735 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1736 
 
1737 
    /* FIXME : clip to the device extents here */
27236 murrell 1738 
    if(R_ALPHA(gc->col) == 0) {
1739 
	SetColor(gc->col, dd);
1740 
	SetLineStyle(gc->lty, gc->lwd, dd);
15641 ripley 1741 
	PostScriptStartPath(pd->psfp);
1742 
	PostScriptMoveTo(pd->psfp, x1, y1);
23105 ripley 1743 
	PostScriptRLineTo(pd->psfp, x1, y1, x2, y2);
1744 
	/* fprintf(pd->psfp, "%.2f %.2f rl\n", x2 - x1, y2 - y1);*/
15641 ripley 1745 
	PostScriptEndPath(pd->psfp);
1746 
    }
5148 ripley 1747 
}
1748 
 
20059 ripley 1749 
static void PS_Polygon(int n, double *x, double *y,
27236 murrell 1750 
		       R_GE_gcontext *gc,
16948 murrell 1751 
		       NewDevDesc *dd)
5148 ripley 1752 
{
1753 
    PostScriptDesc *pd;
1754 
    int i, code;
1755 
 
1756 
    pd = (PostScriptDesc *) dd->deviceSpecific;
1757 
 
1758 
    /* code is set as follows */
1759 
    /* code == 0, nothing to draw */
1760 
    /* code == 1, outline only */
1761 
    /* code == 2, fill only */
12686 ripley 1762 
    /* code == 3, outline and fill */
5148 ripley 1763 
 
27236 murrell 1764 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
5148 ripley 1765 
 
1766 
    if (code) {
1767 
	if(code & 2)
27236 murrell 1768 
	    SetFill(gc->fill, dd);
5148 ripley 1769 
	if(code & 1) {
27236 murrell 1770 
	    SetColor(gc->col, dd);
1771 
	    SetLineStyle(gc->lty, gc->lwd, dd);
5148 ripley 1772 
	}
1773 
	fprintf(pd->psfp, "np\n");
23105 ripley 1774 
	fprintf(pd->psfp, " %.2f %.2f m\n", x[0], y[0]);
1775 
	for(i = 1 ; i < n ; i++)
27340 ripley 1776 
	    if (i % 100 == 0)
1777 
		fprintf(pd->psfp, "%.2f %.2f lineto\n", x[i], y[i]);
1778 
	    else
1779 
		PostScriptRLineTo(pd->psfp, x[i-1], y[i-1], x[i], y[i]);
5148 ripley 1780 
	fprintf(pd->psfp, "cp p%d\n", code);
1781 
    }
1782 
}
1783 
 
20059 ripley 1784 
static void PS_Polyline(int n, double *x, double *y,
27236 murrell 1785 
			R_GE_gcontext *gc,
16948 murrell 1786 
			NewDevDesc *dd)
5148 ripley 1787 
{
1788 
    PostScriptDesc *pd;
1789 
    int i;
1790 
 
1791 
    pd = (PostScriptDesc*) dd->deviceSpecific;
27236 murrell 1792 
    if(R_ALPHA(gc->col) == 0) {
1793 
	SetColor(gc->col, dd);
1794 
	SetLineStyle(gc->lty, gc->lwd, dd);
15641 ripley 1795 
	fprintf(pd->psfp, "np\n");
23105 ripley 1796 
	fprintf(pd->psfp, "%.2f %.2f m\n", x[0], y[0]);
24535 ripley 1797 
	for(i = 1 ; i < n ; i++) {
1798 
	    /* split up solid lines (only) into chunks of size 1000 */
27236 murrell 1799 
	    if(gc->lty == 0 && i%1000 == 0)
24535 ripley 1800 
		fprintf(pd->psfp, "currentpoint o m\n");
27340 ripley 1801 
	    if (i % 100 == 0)
1802 
		fprintf(pd->psfp, "%.2f %.2f lineto\n", x[i], y[i]);
1803 
	    else
1804 
		PostScriptRLineTo(pd->psfp, x[i-1], y[i-1], x[i], y[i]);
24535 ripley 1805 
	}
15641 ripley 1806 
	fprintf(pd->psfp, "o\n");
5148 ripley 1807 
    }
1808 
}
1809 
 
15641 ripley 1810 
 
20059 ripley 1811 
static void PS_Text(double x, double y, char *str,
1812 
		    double rot, double hadj,
27236 murrell 1813 
		    R_GE_gcontext *gc,
16948 murrell 1814 
		    NewDevDesc *dd)
5148 ripley 1815 
{
1816 
    PostScriptDesc *pd = (PostScriptDesc *) dd->deviceSpecific;
1817 
 
27236 murrell 1818 
    SetFont(gc->fontface, (int)floor(gc->cex * gc->ps + 0.5), dd);
1819 
    if(R_ALPHA(gc->col) == 0) {
1820 
	SetColor(gc->col, dd);
15641 ripley 1821 
	PostScriptText(pd->psfp, x, y, str, hadj, 0.0, rot);
1822 
    }
5148 ripley 1823 
}
1824 
 
16948 murrell 1825 
static Rboolean PS_Locator(double *x, double *y, NewDevDesc *dd)
5148 ripley 1826 
{
11067 maechler 1827 
    return FALSE;
5148 ripley 1828 
}
1829 
 
16948 murrell 1830 
static void PS_Mode(int mode, NewDevDesc* dd)
5148 ripley 1831 
{
1832 
}
1833 
 
16948 murrell 1834 
static void PS_Hold(NewDevDesc *dd)
5148 ripley 1835 
{
1836 
}
8792 ripley 1837 
 
1838 
 
1839 
 
1840 
/***********************************************************************
1841 
 
1842 
                 XFig driver shares font handling
1843 
 
1844 
************************************************************************/
1845 
 
1846 
 
1847 
 
1848 
typedef struct {
1849 
    char filename[PATH_MAX];
1850 
 
1851 
    char papername[64];	 /* paper name */
1852 
    int paperwidth;	 /* paper width in big points (1/72 in) */
1853 
    int paperheight;	 /* paper height in big points */
11067 maechler 1854 
    Rboolean landscape;	 /* landscape mode */
8792 ripley 1855 
    int pageno;		 /* page number */
1856 
 
1857 
    int fontfamily;	 /* font family */
1858 
    int fontnum;	 /* font number in XFig */
1859 
    int fontstyle;	 /* font style, R, B, I, BI, S */
1860 
    int fontsize;	 /* font size in points */
1861 
    int maxpointsize;
1862 
 
1863 
    double width;	 /* plot width in inches */
1864 
    double height;	 /* plot height in inches */
1865 
    double pagewidth;	 /* page width in inches */
1866 
    double pageheight;	 /* page height in inches */
11067 maechler 1867 
    Rboolean pagecentre;      /* centre image on page? */
8792 ripley 1868 
 
1869 
    double lwd;		 /* current line width */
1870 
    int lty;		 /* current line type */
1871 
    rcolor col;		 /* current color */
1872 
    rcolor fill;	 /* current fill color */
1873 
    rcolor bg;		 /* background color */
24535 ripley 1874 
    int XFigColors[534];
19912 duncan 1875 
    int nXFigColors;
8792 ripley 1876 
 
1877 
    FILE *psfp;		 /* output file */
1878 
    FILE *tmpfp;         /* temp file */
1879 
    char tmpname[PATH_MAX];
1880 
 
11067 maechler 1881 
    Rboolean onefile;
8792 ripley 1882 
    int ymax;            /* used to invert coord system */
10660 ripley 1883 
 
1884 
    FontMetricInfo metrics[5];	/* font metrics */
1885 
 
8792 ripley 1886 
} XFigDesc;
1887 
 
1888 
static void
11067 maechler 1889 
XF_FileHeader(FILE *fp, char *papername, Rboolean landscape, Rboolean onefile)
8792 ripley 1890 
{
1891 
    fprintf(fp, "#FIG 3.2\n");
11067 maechler 1892 
    fprintf(fp, landscape ? "Landscape\n" : "Portrait\n");
8792 ripley 1893 
    fprintf(fp, "Flush Left\nInches\n");
1894 
    /* Fix */fprintf(fp, "%s\n", papername);
1895 
    fprintf(fp, "100.0\n");
11067 maechler 1896 
    fprintf(fp, onefile ? "Multiple\n" : "Single\n");
8792 ripley 1897 
    fprintf(fp, "-2\n"); /* no background */
1898 
    fprintf(fp, "1200 2\n"); /* coordinate system */
1899 
    fprintf(fp, "# End of XFig header\n");
1900 
}
1901 
 
1902 
static void XF_FileTrailer(FILE *fp)
1903 
{
1904 
    fprintf(fp, "# end of XFig file\n");
1905 
}
1906 
 
1907 
 
1908 
static void XF_EndPage(FILE *fp)
1909 
{
1910 
    fprintf(fp, "# end of XFig page\n");
1911 
}
1912 
 
1913 
static void XF_WriteString(FILE *fp, char *str)
1914 
{
1915 
    unsigned int c;
1916 
    for ( ; *str; str++) {
1917 
	c = (unsigned char)*str;
1918 
	if (c > 127) {
1919 
	    fprintf(fp, "\\%o", c);
1920 
	} else {
1921 
	    switch(*str) {
1922 
	    case '\n':
1923 
		fprintf(fp, "\\n");
1924 
		break;
1925 
	    case '\\':
1926 
		fprintf(fp, "\\\\");
1927 
		break;
1928 
	    default:
1929 
		fputc(*str, fp);
1930 
		break;
1931 
	    }
1932 
	}
1933 
    }
1934 
}
1935 
 
1936 
static int XF_SetColor(int color, XFigDesc *pd)
1937 
{
1938 
    int i;
1939 
    if (color <0 || color > 0xffffff) return -1;
1940 
    for (i = 0; i < pd->nXFigColors; i++)
1941 
    {
1942 
	if(color == pd->XFigColors[i]) return i;
1943 
    }
1944 
    if(pd->nXFigColors == 534) {
1945 
	error("run out of colors in xfig()");
1946 
    }
1947 
    /* new colour */
9687 pd 1948 
    fprintf(pd->psfp, "0 %d #%02x%02x%02x\n", pd->nXFigColors,
8792 ripley 1949 
	    R_RED(color), R_GREEN(color), R_BLUE(color));
1950 
    pd->XFigColors[pd->nXFigColors] = color;
1951 
    return pd->nXFigColors++;
1952 
}
1953 
 
1954 
static void XFconvert(double *x, double *y, XFigDesc *pd)
1955 
{
1956 
    (*x) *= 16.667;
1957 
    (*y) = pd->ymax - 16.667*(*y);
1958 
}
1959 
 
1960 
 
8805 ripley 1961 
static int XF_SetLty(int lty)
8792 ripley 1962 
{
8805 ripley 1963 
    switch(lty) {
1964 
    case LTY_SOLID:
1965 
	return 0;
1966 
    case LTY_DASHED:
1967 
	return 1;
1968 
    case LTY_DOTTED:
1969 
	return 2;
1970 
    case LTY_DOTDASH:
1971 
	return 3;
1972 
    default:
9687 pd 1973 
	warning("unimplemented line texture %u: using Dash-double-dotted",
8805 ripley 1974 
		lty);
1975 
	return 4;
1976 
    }
8792 ripley 1977 
}
1978 
 
1979 
/* Device Driver Actions */
1980 
 
16948 murrell 1981 
static void XFig_Activate(NewDevDesc *dd);
1982 
static void XFig_Circle(double x, double y, double r,
27236 murrell 1983 
			R_GE_gcontext *gc,
1984 
			NewDevDesc *dd);
20059 ripley 1985 
static void XFig_Clip(double x0, double x1, double y0, double y1,
16948 murrell 1986 
		     NewDevDesc *dd);
1987 
static void XFig_Close(NewDevDesc *dd);
1988 
static void XFig_Deactivate(NewDevDesc *dd);
1989 
static void XFig_Hold(NewDevDesc *dd);
1990 
static Rboolean XFig_Locator(double *x, double *y, NewDevDesc *dd);
1991 
static void XFig_Line(double x1, double y1, double x2, double y2,
27236 murrell 1992 
		      R_GE_gcontext *gc,
1993 
		      NewDevDesc *dd);
1994 
static void XFig_MetricInfo(int c,
1995 
			    R_GE_gcontext *gc,
1996 
			    double* ascent, double* descent,
1997 
			    double* width, NewDevDesc *dd);
16948 murrell 1998 
static void XFig_Mode(int mode, NewDevDesc *dd);
27236 murrell 1999 
static void XFig_NewPage(R_GE_gcontext *gc, NewDevDesc *dd);
20059 ripley 2000 
static void XFig_Polygon(int n, double *x, double *y,
27236 murrell 2001 
			 R_GE_gcontext *gc,
2002 
			 NewDevDesc *dd);
20059 ripley 2003 
static void XFig_Polyline(int n, double *x, double *y,
27236 murrell 2004 
			  R_GE_gcontext *gc,
2005 
			  NewDevDesc *dd);
16948 murrell 2006 
static void XFig_Rect(double x0, double y0, double x1, double y1,
27236 murrell 2007 
		      R_GE_gcontext *gc,
2008 
		      NewDevDesc *dd);
16948 murrell 2009 
static void XFig_Size(double *left, double *right,
2010 
		     double *bottom, double *top,
2011 
		     NewDevDesc *dd);
27236 murrell 2012 
static double XFig_StrWidth(char *str,
2013 
			    R_GE_gcontext *gc,
2014 
			    NewDevDesc *dd);
20059 ripley 2015 
static void XFig_Text(double x, double y, char *str,
27236 murrell 2016 
		      double rot, double hadj,
2017 
		      R_GE_gcontext *gc,
2018 
		      NewDevDesc *dd);
16948 murrell 2019 
static Rboolean XFig_Open(NewDevDesc*, XFigDesc*);
8792 ripley 2020 
 
19912 duncan 2021 
static const int XFig_basenums[] = {4, 8, 12, 16, 20, 24, 28, 0};
8792 ripley 2022 
 
2023 
 
2024 
/* Driver Support Routines */
2025 
 
16948 murrell 2026 
static Rboolean
2027 
innerXFigDeviceDriver(NewDevDesc *dd, char *file, char *paper, char *family,
2028 
		      char *bg, char *fg,
2029 
		      double width, double height,
2030 
		      Rboolean horizontal, double ps,
2031 
		      Rboolean onefile, Rboolean pagecentre)
8792 ripley 2032 
{
2033 
    /* If we need to bail out with some sort of "error" */
2034 
    /* then we must free(dd) */
2035 
 
2036 
    double xoff, yoff, pointsize;
2037 
    XFigDesc *pd;
2038 
 
2039 
    /* Check and extract the device parameters */
2040 
 
2041 
    if(strlen(file) > PATH_MAX - 1) {
2042 
	free(dd);
2043 
	error("filename too long in xfig");
2044 
    }
2045 
 
2046 
    /* allocate new xfig device description */
2047 
    if (!(pd = (XFigDesc *) malloc(sizeof(XFigDesc))))
2048 
	return 0;
2049 
 
2050 
    /* from here on, if need to bail out with "error", must also */
2051 
    /* free(pd) */
2052 
 
2053 
    /* initialize xfig device description */
2054 
    strcpy(pd->filename, file);
2055 
    strcpy(pd->papername, paper);
2056 
    pd->fontfamily = MatchFamily(family);
2057 
    pd->fontnum = XFig_basenums[pd->fontfamily];
2058 
    pd->bg = str2col(bg);
2059 
    pd->col = str2col(fg);
2060 
    pd->fill = NA_INTEGER;
2061 
    pd->width = width;
2062 
    pd->height = height;
2063 
    pd->landscape = horizontal;
2064 
    pointsize = floor(ps);
2065 
    if(pd->bg == NA_INTEGER && pd->col == NA_INTEGER) {
2066 
	free(dd);
2067 
	free(pd);
2068 
	error("invalid foreground/background color (xfig)");
2069 
    }
2070 
 
2071 
 
2072 
    /* Deal with paper and plot size and orientation */
2073 
 
2074 
    if(!strcmp(pd->papername, "Default") ||
2075 
       !strcmp(pd->papername, "default")) {
10172 luke 2076 
	SEXP s = STRING_ELT(GetOption(install("papersize"), R_NilValue), 0);
8792 ripley 2077 
	if(s != NA_STRING && strlen(CHAR(s)) > 0)
2078 
	    strcpy(pd->papername, CHAR(s));
2079 
	else strcpy(pd->papername, "A4");
2080 
    }
2081 
    if(!strcmp(pd->papername, "A4") ||
2082 
       !strcmp(pd->papername, "a4")) {
2083 
	strcpy(pd->papername, "A4");
2084 
	pd->pagewidth  = 21.0 / 2.54;
2085 
	pd->pageheight = 29.7 / 2.54;
2086 
    }
2087 
    else if(!strcmp(pd->papername, "Letter") ||
2088 
	    !strcmp(pd->papername, "letter")) {
2089 
	strcpy(pd->papername, "Letter");
2090 
	pd->pagewidth  =  8.5;
2091 
	pd->pageheight = 11.0;
2092 
    }
2093 
    else if(!strcmp(pd->papername, "Legal") ||
2094 
	    !strcmp(pd->papername, "legal")) {
2095 
	strcpy(pd->papername, "Legal");
2096 
	pd->pagewidth  =  8.5;
2097 
	pd->pageheight = 14.0;
2098 
    }
2099 
    else {
2100 
	free(dd);
2101 
	free(pd);
2102 
	error("invalid page type `%s' (xfig)", pd->papername);
2103 
    }
2104 
    pd->pagecentre = pagecentre;
2105 
    pd->paperwidth = 72 * pd->pagewidth;
2106 
    pd->paperheight = 72 * pd->pageheight;
2107 
    if(!onefile) {
2108 
	char *p = strrchr(pd->filename, '%');
2109 
	if(!p)
2110 
	    warning("xfig(%s, onefile=FALSE) will only return the last plot", pd->filename);
2111 
    }
2112 
    if(pd->landscape) {
2113 
	double tmp;
2114 
	tmp = pd->pagewidth;
2115 
	pd->pagewidth = pd->pageheight;
2116 
	pd->pageheight = tmp;
2117 
    }
2118 
    if(pd->width < 0.1 || pd->width > pd->pagewidth-0.5)
2119 
	pd->width = pd->pagewidth-0.5;
2120 
    if(pd->height < 0.1 || pd->height > pd->pageheight-0.5)
2121 
	pd->height = pd->pageheight-0.5;
2122 
    if(pagecentre) {
2123 
	xoff = (pd->pagewidth - pd->width)/2.0;
2124 
	yoff = (pd->pageheight - pd->height)/2.0;
2125 
    } else {
2126 
	xoff = yoff = 0.0;
2127 
    }
8816 ripley 2128 
    if(pagecentre)
2129 
	pd->ymax = (int)(1200.0 * pd->pageheight);
2130 
    else
2131 
	pd->ymax = (int)(1200.0 * pd->height);
2132 
    pd->onefile = onefile;
8792 ripley 2133 
    pd->maxpointsize = 72.0 * ((pd->pageheight > pd->pagewidth) ?
2134 
			       pd->pageheight : pd->pagewidth);
2135 
    pd->pageno = 0;
2136 
    /* Base Pointsize */
2137 
    /* Nominal Character Sizes in Pixels */
2138 
    /* Only right for 12 point font. */
2139 
    /* Max pointsize suggested by Peter Dalgaard */
2140 
 
2141 
    if(pointsize < 6.0) pointsize = 6.0;
2142 
    if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize;
16948 murrell 2143 
    dd->startps = pointsize;
26510 ihaka 2144 
    dd->startlty = LTY_SOLID;
16948 murrell 2145 
    dd->startfont = 1;
2146 
    dd->startfill = pd->bg;
2147 
    dd->startcol = pd->col;
17165 murrell 2148 
    dd->startgamma = 1;
8792 ripley 2149 
 
16948 murrell 2150 
    /* Set graphics parameters that must be set by device driver. */
2151 
    /* Page dimensions in points. */
2152 
 
2153 
    dd->left = 72 * xoff;			/* left */
2154 
    dd->right = 72 * (xoff + pd->width);	/* right */
2155 
    dd->bottom = 72 * yoff;		/* bottom */
2156 
    dd->top = 72 * (yoff + pd->height);	/* top */
2157 
 
2158 
    dd->cra[0] = 0.9 * pointsize;
2159 
    dd->cra[1] = 1.2 * pointsize;
2160 
 
8792 ripley 2161 
    /* Character Addressing Offsets */
2162 
    /* These offsets should center a single */
2163 
    /* plotting character over the plotting point. */
2164 
    /* Pure guesswork and eyeballing ... */
2165 
 
16948 murrell 2166 
    dd->xCharOffset =  0.4900;
2167 
    dd->yCharOffset =  0.3333;
2168 
    dd->yLineBias = 0.2;
8792 ripley 2169 
 
2170 
    /* Inches per Raster Unit */
2171 
    /* 1200 dpi */
16948 murrell 2172 
    dd->ipr[0] = 1.0/72.0;
2173 
    dd->ipr[1] = 1.0/72.0;
8792 ripley 2174 
 
16948 murrell 2175 
    dd->canResizePlot = 0;
2176 
    dd->canChangeFont = 1;
2177 
    dd->canRotateText = 1;
2178 
    dd->canResizeText = 1;
2179 
    dd->canClip = 0;
2180 
    dd->canHAdj = 1; /* 0, 0.5, 1 */
17165 murrell 2181 
    dd->canChangeGamma = FALSE;
8792 ripley 2182 
 
2183 
    pd->XFigColors[7] = 0xffffff;
2184 
    pd->nXFigColors = 32;
2185 
 
2186 
    /*	Start the driver */
2187 
 
2188 
    if(!XFig_Open(dd, pd)) {
2189 
	free(pd);
2190 
	return 0;
2191 
    }
2192 
 
16948 murrell 2193 
    dd->newDevStruct = 1;
8792 ripley 2194 
 
16948 murrell 2195 
    dd->open	      = XFig_Open;
2196 
    dd->close      = XFig_Close;
2197 
    dd->activate   = XFig_Activate;
2198 
    dd->deactivate = XFig_Deactivate;
2199 
    dd->size     = XFig_Size;
2200 
    dd->newPage    = XFig_NewPage;
2201 
    dd->clip	      = XFig_Clip;
2202 
    dd->text	      = XFig_Text;
2203 
    dd->strWidth   = XFig_StrWidth;
2204 
    dd->metricInfo = XFig_MetricInfo;
2205 
    dd->rect	      = XFig_Rect;
2206 
    dd->circle     = XFig_Circle;
2207 
    dd->line	      = XFig_Line;
2208 
    dd->polygon    = XFig_Polygon;
2209 
    dd->polyline   = XFig_Polyline;
2210 
    dd->locator    = XFig_Locator;
2211 
    dd->mode	      = XFig_Mode;
2212 
    dd->hold	      = XFig_Hold;
2213 
 
8792 ripley 2214 
    dd->deviceSpecific = (void *) pd;
11067 maechler 2215 
    dd->displayListOn = FALSE;
8792 ripley 2216 
    return 1;
2217 
}
2218 
 
16948 murrell 2219 
Rboolean
2220 
XFigDeviceDriver(DevDesc *dd, char *file, char *paper, char *family,
2221 
		 char *bg, char *fg,
2222 
		 double width, double height,
2223 
		 Rboolean horizontal, double ps,
2224 
		 Rboolean onefile, Rboolean pagecentre)
2225 
{
20059 ripley 2226 
    return innerXFigDeviceDriver((NewDevDesc*) dd, file, paper, family,
2227 
				 bg, fg, width, height, horizontal,
16948 murrell 2228 
				 ps, onefile, pagecentre);
2229 
}
2230 
 
2231 
static Rboolean XFig_Open(NewDevDesc *dd, XFigDesc *pd)
8792 ripley 2232 
{
10960 ripley 2233 
    char buf[512], name[50];
8792 ripley 2234 
    int i;
2235 
 
12688 ripley 2236 
    if (!LoadEncoding("ISOLatin1.enc", buf, FALSE))
12273 ripley 2237 
	error("problem loading encoding file");
10960 ripley 2238 
    for(i = 0; i < 4 ; i++) {
12273 ripley 2239 
	if(!PostScriptLoadFontMetrics(Family[pd->fontfamily].afmfile[i],
10960 ripley 2240 
				      &(pd->metrics[i]), name, 1)) {
15168 pd 2241 
	    warning("cannot read afm file %s",
2242 
		    Family[pd->fontfamily].afmfile[i]);
11067 maechler 2243 
	    return FALSE;
10960 ripley 2244 
	}
8792 ripley 2245 
    }
15168 pd 2246 
    if(!PostScriptLoadFontMetrics("sy______.afm",
10960 ripley 2247 
				  &(pd->metrics[4]), name, 0)) {
15168 pd 2248 
	warning("cannot read afm file sy______.afm");
11067 maechler 2249 
	return FALSE;
10960 ripley 2250 
    }
8792 ripley 2251 
 
2252 
    if (strlen(pd->filename) == 0) {
2253 
	error("empty file name");
11067 maechler 2254 
	return FALSE;
8792 ripley 2255 
    } else {
25313 ripley 2256 
	snprintf(buf, 512, pd->filename, pd->pageno + 1); /* page 1 to start */
8792 ripley 2257 
	pd->psfp = R_fopen(R_ExpandFileName(buf), "w");
2258 
    }
11067 maechler 2259 
    if (!pd->psfp) return FALSE;
18560 ripley 2260 
    /* assume tmpname is less than PATH_MAX */
23729 murdoch 2261 
    strcpy(pd->tmpname, R_tmpnam("Rxfig", R_TempDir));
8792 ripley 2262 
    pd->tmpfp = R_fopen(pd->tmpname, "w");
2263 
    if (!pd->tmpfp) {
2264 
	fclose(pd->psfp);
11067 maechler 2265 
	return FALSE;
8792 ripley 2266 
    }
2267 
    XF_FileHeader(pd->psfp, pd->papername, pd->landscape, pd->onefile);
2268 
    pd->fontstyle = 1;
2269 
    pd->fontsize = 10;
2270 
    pd->pageno = 0;
11067 maechler 2271 
    return TRUE;
8792 ripley 2272 
}
2273 
 
2274 
 
16948 murrell 2275 
static void XFig_Clip(double x0, double x1, double y0, double y1, NewDevDesc *dd)
8792 ripley 2276 
{
2277 
}
2278 
 
16948 murrell 2279 
static void XFig_Size(double *left, double *right,
2280 
		      double *bottom, double *top,
2281 
		      NewDevDesc *dd)
8792 ripley 2282 
{
16948 murrell 2283 
    *left = dd->left;
2284 
    *right = dd->right;
2285 
    *bottom = dd->bottom;
2286 
    *top = dd->top;
8792 ripley 2287 
}
2288 
 
2289 
#define CHUNK 10000
27236 murrell 2290 
static void XFig_NewPage(R_GE_gcontext *gc,
2291 
			 NewDevDesc *dd)
8792 ripley 2292 
{
2293 
    char buf[PATH_MAX];
2294 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2295 
    FILE *fp = pd->tmpfp;
2296 
 
2297 
    pd->pageno++;
2298 
    if(pd->onefile) {
2299 
	fprintf(pd->tmpfp, "#Start of page %d\n", pd->pageno);
2300 
	if(pd->pageno > 1) XF_EndPage(pd->tmpfp);
2301 
    } else {
2302 
	char buffer[CHUNK];
2303 
	size_t nread;
2304 
	if(pd->pageno == 1) return;
2305 
	XF_FileTrailer(pd->tmpfp);
2306 
	fclose(pd->tmpfp);
2307 
	pd->tmpfp = R_fopen(pd->tmpname, "r");
2308 
	while(1) {
2309 
	    nread = fread(buffer, 1, CHUNK, pd->tmpfp);
2310 
	    if(nread > 0) fwrite(buffer, 1, nread, pd->psfp);
2311 
	    if(nread < CHUNK) break;
2312 
	}
2313 
	fclose(pd->tmpfp);
2314 
	fclose(pd->psfp);
25313 ripley 2315 
	snprintf(buf, PATH_MAX, pd->filename, pd->pageno);
8792 ripley 2316 
	pd->psfp = R_fopen(R_ExpandFileName(buf), "w");
2317 
	pd->tmpfp = R_fopen(pd->tmpname, "w");
2318 
	XF_FileHeader(pd->psfp, pd->papername, pd->landscape, pd->onefile);
2319 
	pd->XFigColors[7] = 0xffffff;
2320 
	pd->nXFigColors = 32;
2321 
    }
27236 murrell 2322 
     if(R_ALPHA(gc->fill) == 0) {
2323 
	 int cbg = XF_SetColor(gc->fill, pd);
8792 ripley 2324 
	 int ix0, iy0, ix1, iy1;
9687 pd 2325 
	 double x0 = 0.0, y0 = 0.0, x1 = 72.0 * pd->pagewidth,
8792 ripley 2326 
	     y1 = 72.0 * pd->pageheight;
2327 
	 XFconvert(&x0, &y0, pd); XFconvert(&x1, &y1, pd);
2328 
	 ix0 = (int)x0; iy0 = (int)y0; ix1 = (int)x1; iy1 = (int)y1;
2329 
	 fprintf(fp, "2 2 "); /* Polyline */
2330 
	 fprintf(fp, "%d %d ", 0, 0); /* style, thickness */
2331 
	 fprintf(fp, "%d %d ", cbg, cbg); /* pen colour fill colour */
2332 
	 fprintf(fp, "200 0 20 4.0 0 0 -1 0 0 ");
2333 
	 fprintf(fp, "%d\n", 5); /* number of points */
2334 
	 fprintf(fp, "%d %d ", ix0, iy0);
2335 
	 fprintf(fp, "%d %d ", ix0, iy1);
2336 
	 fprintf(fp, "%d %d ", ix1, iy1);
2337 
	 fprintf(fp, "%d %d ", ix1, iy0);
2338 
	 fprintf(fp, "%d %d\n", ix0, iy0);
9687 pd 2339 
   }
8792 ripley 2340 
}
2341 
 
2342 
#ifdef HAVE_UNISTD_H
2343 
#include <unistd.h>
2344 
#endif
2345 
 
16948 murrell 2346 
static void XFig_Close(NewDevDesc *dd)
8792 ripley 2347 
{
2348 
    char buf[CHUNK];
2349 
    size_t nread;
2350 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2351 
 
2352 
    XF_FileTrailer(pd->tmpfp);
2353 
    fclose(pd->tmpfp);
2354 
    pd->tmpfp = R_fopen(pd->tmpname, "r");
2355 
    while(1) {
2356 
	nread = fread(buf, 1, CHUNK, pd->tmpfp);
2357 
	if(nread > 0) fwrite(buf, 1, nread, pd->psfp);
2358 
	if(nread < CHUNK) break;
2359 
    }
2360 
    fclose(pd->tmpfp);
2361 
    unlink(pd->tmpname);
2362 
    fclose(pd->psfp);
2363 
    free(pd);
2364 
}
2365 
 
16948 murrell 2366 
static void XFig_Activate(NewDevDesc *dd) {}
2367 
static void XFig_Deactivate(NewDevDesc *dd) {}
8792 ripley 2368 
 
16948 murrell 2369 
static void XFig_Rect(double x0, double y0, double x1, double y1,
27236 murrell 2370 
		      R_GE_gcontext *gc,
16948 murrell 2371 
		      NewDevDesc *dd)
8792 ripley 2372 
{
2373 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2374 
    FILE *fp = pd->tmpfp;
2375 
    int ix0, iy0, ix1, iy1;
27236 murrell 2376 
    int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen,
2377 
	dofill, lty = XF_SetLty(gc->lty), lwd = gc->lwd*0.833 + 0.5;
8792 ripley 2378 
 
27236 murrell 2379 
    cpen = (R_ALPHA(gc->col) == 0)? cfg: -1;
2380 
    dofill = (R_ALPHA(gc->fill) == 0)? 20: -1;
8792 ripley 2381 
 
16948 murrell 2382 
    XFconvert(&x0, &y0, pd);
2383 
    XFconvert(&x1, &y1, pd);
8792 ripley 2384 
    ix0 = (int)x0; iy0 = (int)y0; ix1 = (int)x1; iy1 = (int)y1;
2385 
    fprintf(fp, "2 2 "); /* Polyline */
2386 
    fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */
2387 
    fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */
2388 
    fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */
2389 
    fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */
2390 
    fprintf(fp, "%d\n", 5); /* number of points */
8816 ripley 2391 
    fprintf(fp, "  %d %d ", ix0, iy0);
2392 
    fprintf(fp, "  %d %d ", ix0, iy1);
2393 
    fprintf(fp, "  %d %d ", ix1, iy1);
2394 
    fprintf(fp, "  %d %d ", ix1, iy0);
2395 
    fprintf(fp, "  %d %d\n", ix0, iy0);
8792 ripley 2396 
}
2397 
 
16948 murrell 2398 
static void XFig_Circle(double x, double y, double r,
27236 murrell 2399 
			R_GE_gcontext *gc,
16948 murrell 2400 
			NewDevDesc *dd)
8792 ripley 2401 
{
2402 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2403 
    FILE *fp = pd->tmpfp;
2404 
    int ix, iy, ir;
27236 murrell 2405 
    int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen,
2406 
	dofill, lty = XF_SetLty(gc->lty), lwd = gc->lwd*0.833 + 0.5;
8792 ripley 2407 
 
27236 murrell 2408 
    cpen = (R_ALPHA(gc->col) == 0)? cfg: -1;
2409 
    dofill = (R_ALPHA(gc->fill) == 0)? 20: -1;
8792 ripley 2410 
 
16948 murrell 2411 
    XFconvert(&x, &y, pd);
8792 ripley 2412 
    ix = (int)x; iy = (int)y; ir = (int)(16.667*r);
2413 
 
2414 
    fprintf(fp, "1 3 "); /* Circle + radius */
2415 
    fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */
2416 
    fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */
2417 
    fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */
2418 
    fprintf(fp, "%.2f 1 0 ", 4.0*lwd); /* style value, direction, x, angle */
9687 pd 2419 
    fprintf(fp, "  %d %d %d %d %d %d %d %d \n",
8792 ripley 2420 
	    ix, iy, ir, ir, ix, iy, ix+ir, iy);
2421 
}
2422 
 
2423 
static void XFig_Line(double x1, double y1, double x2, double y2,
27236 murrell 2424 
		      R_GE_gcontext *gc,
16948 murrell 2425 
		      NewDevDesc *dd)
8792 ripley 2426 
{
2427 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2428 
    FILE *fp = pd->tmpfp;
27236 murrell 2429 
    int lty = XF_SetLty(gc->lty), lwd = gc->lwd*0.833 + 0.5;
9687 pd 2430 
 
16948 murrell 2431 
    XFconvert(&x1, &y1, pd);
2432 
    XFconvert(&x2, &y2, pd);
27236 murrell 2433 
    if(R_ALPHA(gc->col) == 0) {
15641 ripley 2434 
	fprintf(fp, "2 1 "); /* Polyline */
2435 
	fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */
27236 murrell 2436 
	fprintf(fp, "%d %d ", XF_SetColor(gc->col, pd), 7);
15641 ripley 2437 
	/* pen colour fill colour */
2438 
	fprintf(fp, "100 0 -1 "); /* depth, pen style, area fill */
2439 
	fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */
2440 
	fprintf(fp, "%d\n", 2); /* number of points */
2441 
	fprintf(fp, "%d %d %d %d\n", (int)x1, (int)y1, (int)x2, (int)y2);
2442 
    }
8792 ripley 2443 
}
2444 
 
20059 ripley 2445 
static void XFig_Polygon(int n, double *x, double *y,
27236 murrell 2446 
			 R_GE_gcontext *gc,
16948 murrell 2447 
			 NewDevDesc *dd)
8792 ripley 2448 
{
2449 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2450 
    FILE *fp = pd->tmpfp;
2451 
    double xx, yy;
2452 
    int i;
27236 murrell 2453 
    int cbg = XF_SetColor(gc->fill, pd), cfg = XF_SetColor(gc->col, pd), cpen,
2454 
	dofill, lty = XF_SetLty(gc->lty), lwd = gc->lwd*0.833 + 0.5;
8792 ripley 2455 
 
27236 murrell 2456 
    cpen = (R_ALPHA(gc->col) == 0)? cfg: -1;
2457 
    dofill = (R_ALPHA(gc->fill) == 0)? 20: -1;
8792 ripley 2458 
 
8813 ripley 2459 
    fprintf(fp, "2 3 "); /* Polyline */
8792 ripley 2460 
    fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */
2461 
    fprintf(fp, "%d %d ", cpen, cbg); /* pen colour fill colour */
2462 
    fprintf(fp, "100 0 %d ", dofill); /* depth, pen style, area fill */
2463 
    fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */
12976 pd 2464 
    fprintf(fp, "%d\n", n+1); /* number of points */
2465 
    /* close the path */
2466 
    for(i = 0 ; i <= n ; i++) {
2467 
	xx = x[i%n];
2468 
	yy = y[i%n];
16948 murrell 2469 
	XFconvert(&xx, &yy, pd);
8816 ripley 2470 
	fprintf(fp, "  %d %d\n", (int)xx, (int)yy);
8792 ripley 2471 
    }
2472 
}
2473 
 
20059 ripley 2474 
static void XFig_Polyline(int n, double *x, double *y,
27236 murrell 2475 
			  R_GE_gcontext *gc,
16948 murrell 2476 
			  NewDevDesc *dd)
8792 ripley 2477 
{
2478 
    XFigDesc *pd = (XFigDesc*) dd->deviceSpecific;
2479 
    FILE *fp = pd->tmpfp;
2480 
    double xx, yy;
27236 murrell 2481 
    int i, lty = XF_SetLty(gc->lty), lwd = gc->lwd*0.833 + 0.5;
8792 ripley 2482 
 
27236 murrell 2483 
    if(R_ALPHA(gc->col) == 0) {
15641 ripley 2484 
	fprintf(fp, "2 1 "); /* Polyline */
2485 
	fprintf(fp, "%d %d ", lty, lwd>0?lwd:1); /* style, thickness */
27236 murrell 2486 
	fprintf(fp, "%d %d ", XF_SetColor(gc->col, pd), 7); /* pen colour fill colour */
15641 ripley 2487 
	fprintf(fp, "100 0 -1 "); /* depth, pen style, area fill */
2488 
	fprintf(fp, "%.2f 0 0 -1 0 0 ", 4.0*lwd); /* style value, join .... */
2489 
	fprintf(fp, "%d\n", n); /* number of points */
2490 
	for(i = 0 ; i < n ; i++) {
2491 
	    xx = x[i];
2492 
	    yy = y[i];
16948 murrell 2493 
	    XFconvert(&xx, &yy, pd);
15641 ripley 2494 
	    fprintf(fp, "  %d %d\n", (int)xx, (int)yy);
2495 
	}
8792 ripley 2496 
    }
2497 
}
2498 
 
19912 duncan 2499 
static const int styles[4] = {0,2,1,3};
8813 ripley 2500 
 
20059 ripley 2501 
static void XFig_Text(double x, double y, char *str,
2502 
		      double rot, double hadj,
27236 murrell 2503 
		      R_GE_gcontext *gc,
16948 murrell 2504 
		      NewDevDesc *dd)
8792 ripley 2505 
{
2506 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
2507 
    FILE *fp = pd->tmpfp;
27236 murrell 2508 
    int fontnum, style = gc->fontface;
2509 
    double size = floor(gc->cex * gc->ps + 0.5);
9687 pd 2510 
 
27683 ripley 2511 
    if(style < 1 || style > 5) {
2512 
	warning("attempt to use invalid font %d replaced by font 1", style);
2513 
	style = 1;
2514 
    }
8792 ripley 2515 
    pd->fontsize = size;
2516 
    pd->fontstyle = style;
2517 
    if(style == 5) fontnum = 32;
8813 ripley 2518 
    else fontnum = pd->fontnum + styles[style-1];
8792 ripley 2519 
 
16948 murrell 2520 
    XFconvert(&x, &y, pd);
27236 murrell 2521 
    if(R_ALPHA(gc->col) == 0) {
15641 ripley 2522 
	fprintf(fp, "4 %d ", (int)floor(2*hadj)); /* Text, how justified */
27236 murrell 2523 
	fprintf(fp, "%d 100 0 ", XF_SetColor(gc->col, pd));
15641 ripley 2524 
	/* color, depth, pen_style */
2525 
	fprintf(fp, "%d %d %.4f 4 ", fontnum, (int)size, rot * DEG2RAD);
2526 
	/* font pointsize angle flags (Postscript font) */
16948 murrell 2527 
	/* FIXME:  Why is this calling GStr[Height|Width] when it
2528 
	 * presumably could be calling XFig_Str[Height|Width] ?
2529 
	 */
20059 ripley 2530 
	fprintf(fp, "%d %d ",
2531 
		(int)(16.667*GStrHeight(str, DEVICE,
16948 murrell 2532 
					GetDevice(devNumber((DevDesc*) dd)))
2533 
		      +0.5),
20059 ripley 2534 
		(int)(16.667*GStrWidth(str, DEVICE,
16948 murrell 2535 
				       GetDevice(devNumber((DevDesc*) dd)))
2536 
		      +0.5));
15641 ripley 2537 
	fprintf(fp, "%d %d ", (int)x, (int)y);
2538 
	XF_WriteString(fp, str);
2539 
	fprintf(fp, "\\001\n");
2540 
    }
8792 ripley 2541 
}
2542 
 
16948 murrell 2543 
static Rboolean XFig_Locator(double *x, double *y, NewDevDesc *dd)
8792 ripley 2544 
{
11067 maechler 2545 
    return FALSE;
8792 ripley 2546 
}
2547 
 
16948 murrell 2548 
static void XFig_Mode(int mode, NewDevDesc* dd)
8792 ripley 2549 
{
2550 
}
2551 
 
16948 murrell 2552 
static void XFig_Hold(NewDevDesc *dd)
8792 ripley 2553 
{
2554 
}
10660 ripley 2555 
 
27236 murrell 2556 
static double XFig_StrWidth(char *str,
2557 
			    R_GE_gcontext *gc,
2558 
			    NewDevDesc *dd)
10660 ripley 2559 
{
2560 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
27683 ripley 2561 
    int face = gc->fontface;
10660 ripley 2562 
 
27683 ripley 2563 
    if(face < 1 || face > 5) face = 1;
2564 
 
27236 murrell 2565 
    return floor(gc->cex * gc->ps + 0.5) *
10955 ripley 2566 
	PostScriptStringWidth((unsigned char *)str,
27683 ripley 2567 
			      &(pd->metrics[face-1]));
10660 ripley 2568 
}
2569 
 
27236 murrell 2570 
static void XFig_MetricInfo(int c,
2571 
			    R_GE_gcontext *gc,
16948 murrell 2572 
			    double* ascent, double* descent,
2573 
			    double* width, NewDevDesc *dd)
10660 ripley 2574 
{
2575 
    XFigDesc *pd = (XFigDesc *) dd->deviceSpecific;
27683 ripley 2576 
    int face = gc->fontface;
10660 ripley 2577 
 
27683 ripley 2578 
    if(face < 1 || face > 5) face = 1;
2579 
 
10955 ripley 2580 
    PostScriptMetricInfo(c, ascent, descent, width,
27683 ripley 2581 
			 &(pd->metrics[face-1]));
27236 murrell 2582 
    *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent;
2583 
    *descent = floor(gc->cex * gc->ps + 0.5) * *descent;
2584 
    *width = floor(gc->cex * gc->ps + 0.5) * *width;
10660 ripley 2585 
}
12288 ripley 2586 
 
12688 ripley 2587 
 
12288 ripley 2588 
/***********************************************************************
2589 
 
2590 
                 PDF driver also shares font handling
2591 
 
2592 
************************************************************************/
2593 
 
12688 ripley 2594 
/* TODO
12692 ripley 2595 
   Flate encoding?
12688 ripley 2596 
*/
2597 
 
2598 
 
12686 ripley 2599 
typedef struct {
2600 
    char filename[PATH_MAX];
2601 
 
2602 
    int pageno;		/* page number */
21055 ripley 2603 
    int fileno;		/* file number */
15168 pd 2604 
 
12686 ripley 2605 
    int fontfamily;	/* font family */
13854 ripley 2606 
    char encpath[PATH_MAX]; /* font encoding */
16837 ripley 2607 
    char encname[100];
12686 ripley 2608 
    char **afmpaths;	/* for user-specified family */
2609 
    int maxpointsize;
2610 
 
2611 
    double width;	/* plot width in inches */
2612 
    double height;	/* plot height in inches */
12688 ripley 2613 
    Rboolean onefile;	/* one file or one file per page? */
12686 ripley 2614 
 
2615 
    FILE *pdffp;		/* output file */
2616 
 
2617 
    FontMetricInfo metrics[5];	/* font metrics */
2618 
 
2619 
    /* This group of variables track the current device status.
14172 ripley 2620 
     * They should only be set by routines that emit PDF. */
12686 ripley 2621 
    struct {
2622 
	double lwd;		 /* line width */
2623 
	int lty;		 /* line type */
2624 
	int fontstyle;	         /* font style, R, B, I, BI, S */
2625 
	int fontsize;	         /* font size in points */
2626 
	rcolor col;		 /* color */
2627 
	rcolor fill;	         /* fill color */
2628 
	rcolor bg;		 /* color */
2629 
    } current;
2630 
 
2631 
    int nobjs;  /* number of objects */
18784 ripley 2632 
    int *pos; /* object positions */
2633 
    int *pageobj; /* page object numbers */
2634 
    int pagemax;
12686 ripley 2635 
    int startstream; /* position of start of current stream */
12688 ripley 2636 
    Rboolean inText;
22279 ripley 2637 
    char title[1024];
12686 ripley 2638 
}
2639 
PDFDesc;
2640 
 
2641 
/* Device Driver Actions */
2642 
 
16948 murrell 2643 
static Rboolean PDF_Open(NewDevDesc*, PDFDesc*);
2644 
static void PDF_Activate(NewDevDesc *dd);
2645 
static void PDF_Circle(double x, double y, double r,
27236 murrell 2646 
		       R_GE_gcontext *gc,
16948 murrell 2647 
		       NewDevDesc *dd);
20059 ripley 2648 
static void PDF_Clip(double x0, double x1, double y0, double y1,
16948 murrell 2649 
		     NewDevDesc *dd);
2650 
static void PDF_Close(NewDevDesc *dd);
2651 
static void PDF_Deactivate(NewDevDesc *dd);
2652 
static void PDF_Hold(NewDevDesc *dd);
2653 
static Rboolean PDF_Locator(double *x, double *y, NewDevDesc *dd);
2654 
static void PDF_Line(double x1, double y1, double x2, double y2,
27236 murrell 2655 
		     R_GE_gcontext *gc,
16948 murrell 2656 
		     NewDevDesc *dd);
27236 murrell 2657 
static void PDF_MetricInfo(int c,
2658 
			   R_GE_gcontext *gc,
2659 
			   double* ascent, double* descent,
2660 
			   double* width, NewDevDesc *dd);
16948 murrell 2661 
static void PDF_Mode(int mode, NewDevDesc *dd);
27236 murrell 2662 
static void PDF_NewPage(R_GE_gcontext *gc, NewDevDesc *dd);
20059 ripley 2663 
static void PDF_Polygon(int n, double *x, double *y,
27236 murrell 2664 
			R_GE_gcontext *gc,
16948 murrell 2665 
			NewDevDesc *dd);
20059 ripley 2666 
static void PDF_Polyline(int n, double *x, double *y,
27236 murrell 2667 
			 R_GE_gcontext *gc,
2668 
			 NewDevDesc *dd);
16948 murrell 2669 
static void PDF_Rect(double x0, double y0, double x1, double y1,
27236 murrell 2670 
		     R_GE_gcontext *gc,
16948 murrell 2671 
		     NewDevDesc *dd);
2672 
static void PDF_Size(double *left, double *right,
2673 
		     double *bottom, double *top,
2674 
		     NewDevDesc *dd);
27236 murrell 2675 
static double PDF_StrWidth(char *str,
2676 
			   R_GE_gcontext *gc,
2677 
			   NewDevDesc *dd);
20059 ripley 2678 
static void PDF_Text(double x, double y, char *str,
2679 
		     double rot, double hadj,
27236 murrell 2680 
		     R_GE_gcontext *gc,
16948 murrell 2681 
		     NewDevDesc *dd);
12686 ripley 2682 
 
16948 murrell 2683 
static Rboolean
2684 
innerPDFDeviceDriver(NewDevDesc* dd, char *file, char *family, char *encoding,
20059 ripley 2685 
		     char *bg, char *fg, double width, double height,
22279 ripley 2686 
		     double ps, int onefile, char *title)
12288 ripley 2687 
{
12686 ripley 2688 
    /* If we need to bail out with some sort of "error" */
2689 
    /* then we must free(dd) */
2690 
 
2691 
    double xoff = 0.0, yoff = 0.0, pointsize;
2692 
    rcolor setbg, setfg;
2693 
 
2694 
    PDFDesc *pd;
2695 
 
2696 
    /* Check and extract the device parameters */
2697 
 
2698 
    if(strlen(file) > PATH_MAX - 1) {
2699 
	free(dd);
2700 
	error("filename too long in pdf");
2701 
    }
2702 
 
2703 
    /* allocate new PDF device description */
2704 
    if (!(pd = (PDFDesc *) malloc(sizeof(PDFDesc))))
2705 
	return 0;
2706 
    /* from here on, if need to bail out with "error", must also */
2707 
    /* free(pd) */
2708 
 
18784 ripley 2709 
    pd->pos = (int *) calloc(350, sizeof(int));
2710 
    if(!pd->pos) {
2711 
	free(pd); free(dd);
2712 
	error("cannot allocate pd->pos");
2713 
    }
2714 
    pd->pageobj = (int *) calloc(100, sizeof(int));
2715 
    if(!pd->pageobj) {
2716 
	free(pd->pos);free(pd); free(dd);
2717 
	error("cannot allocate pd->pageobj");
2718 
    }
2719 
    pd->pagemax = 100;
2720 
 
2721 
 
12686 ripley 2722 
    /* initialize PDF device description */
2723 
    strcpy(pd->filename, file);
22279 ripley 2724 
    strncpy(pd->title, title, 1024);
12686 ripley 2725 
    pd->fontfamily = MatchFamily(family);
18560 ripley 2726 
    if(strlen(encoding) > PATH_MAX - 1) {
2727 
	free(dd);
18784 ripley 2728 
	free(pd->pos); free(pd->pageobj); free(pd);
18560 ripley 2729 
	error("encoding path is too long");
2730 
    }
13854 ripley 2731 
    strcpy(pd->encpath, encoding);
12686 ripley 2732 
    setbg = str2col(bg);
2733 
    setfg = str2col(fg);
2734 
 
2735 
    pd->width = width;
2736 
    pd->height = height;
2737 
    pointsize = floor(ps);
2738 
    if(setbg == NA_INTEGER && setfg  == NA_INTEGER) {
2739 
	free(dd);
18784 ripley 2740 
	free(pd->pos); free(pd->pageobj); free(pd);
12686 ripley 2741 
	error("invalid foreground/background color (pdf)");
2742 
    }
2743 
 
12688 ripley 2744 
    pd->onefile = onefile;
12686 ripley 2745 
    pd->maxpointsize = 72.0 * ((height > width) ? height : width);
21055 ripley 2746 
    pd->pageno = pd->fileno = 0;
12686 ripley 2747 
    /* Base Pointsize */
2748 
    /* Nominal Character Sizes in Pixels */
2749 
    /* Only right for 12 point font. */
2750 
    /* Max pointsize suggested by Peter Dalgaard */
2751 
 
2752 
    if(pointsize < 6.0) pointsize = 6.0;
2753 
    if(pointsize > pd->maxpointsize) pointsize = pd->maxpointsize;
16948 murrell 2754 
    dd->startps = pointsize;
2755 
    dd->startlty = 0;
2756 
    dd->startfont = 1;
2757 
    dd->startfill = setbg;
2758 
    dd->startcol = setfg;
17165 murrell 2759 
    dd->startgamma = 1;
12686 ripley 2760 
 
16948 murrell 2761 
    /* Set graphics parameters that must be set by device driver. */
2762 
    /* Page dimensions in points. */
2763 
 
2764 
    dd->left = 72 * xoff;			/* left */
2765 
    dd->right = 72 * (xoff + pd->width);	/* right */
2766 
    dd->bottom = 72 * yoff;			/* bottom */
2767 
    dd->top = 72 * (yoff + pd->height);	/* top */
2768 
 
2769 
    dd->cra[0] = 0.9 * pointsize;
2770 
    dd->cra[1] = 1.2 * pointsize;
2771 
 
12686 ripley 2772 
    /* Character Addressing Offsets */
2773 
    /* These offsets should center a single */
2774 
    /* plotting character over the plotting point. */
2775 
    /* Pure guesswork and eyeballing ... */
2776 
 
16948 murrell 2777 
    dd->xCharOffset =  0.4900;
2778 
    dd->yCharOffset =  0.3333;
2779 
    dd->yLineBias = 0.2;
12686 ripley 2780 
 
2781 
    /* Inches per Raster Unit */
2782 
    /* 1200 dpi */
16948 murrell 2783 
    dd->ipr[0] = 1.0/72.0;
2784 
    dd->ipr[1] = 1.0/72.0;
12686 ripley 2785 
 
16948 murrell 2786 
    dd->canResizePlot = 0;
2787 
    dd->canChangeFont = 1;
2788 
    dd->canRotateText = 1;
2789 
    dd->canResizeText = 1;
20616 ripley 2790 
    dd->canClip = 1;
16948 murrell 2791 
    dd->canHAdj = 0;
17165 murrell 2792 
    dd->canChangeGamma = FALSE;
12686 ripley 2793 
 
2794 
    /*	Start the driver */
2795 
 
2796 
    if(!PDF_Open(dd, pd)) {
18784 ripley 2797 
	free(pd->pos); free(pd->pageobj); free(pd);
12686 ripley 2798 
	return 0;
2799 
    }
2800 
 
16948 murrell 2801 
    dd->newDevStruct = 1;
12686 ripley 2802 
 
16948 murrell 2803 
    dd->open	      = PDF_Open;
2804 
    dd->close      = PDF_Close;
2805 
    dd->activate   = PDF_Activate;
2806 
    dd->deactivate = PDF_Deactivate;
2807 
    dd->size     = PDF_Size;
2808 
    dd->newPage    = PDF_NewPage;
2809 
    dd->clip	      = PDF_Clip;
2810 
    dd->text	      = PDF_Text;
2811 
    dd->strWidth   = PDF_StrWidth;
2812 
    dd->metricInfo = PDF_MetricInfo;
2813 
    dd->rect	      = PDF_Rect;
2814 
    dd->circle     = PDF_Circle;
2815 
    dd->line	      = PDF_Line;
2816 
    dd->polygon    = PDF_Polygon;
2817 
    dd->polyline   = PDF_Polyline;
2818 
    dd->locator    = PDF_Locator;
2819 
    dd->mode	      = PDF_Mode;
2820 
    dd->hold	      = PDF_Hold;
2821 
 
12686 ripley 2822 
    dd->deviceSpecific = (void *) pd;
2823 
    dd->displayListOn = FALSE;
2824 
    return 1;
12288 ripley 2825 
}
12686 ripley 2826 
 
16948 murrell 2827 
static void PDF_Invalidate(NewDevDesc *dd)
12688 ripley 2828 
{
2829 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
2830 
 
2831 
    pd->current.fontsize = -1;
2832 
    pd->current.fontstyle = -1;
24535 ripley 2833 
    /*
22354 ripley 2834 
     * Paul:  make all these settings "invalid"
2835 
     pd->current.lwd = 1;
2836 
     */
2837 
    pd->current.lwd = -1;
12688 ripley 2838 
    pd->current.lty = -1;
12692 ripley 2839 
    /* page starts with black as the default fill and stroke colours */
24535 ripley 2840 
    /*
22354 ripley 2841 
     * Paul:  make all these settings "invalid"
2842 
     pd->current.col = 0;
24535 ripley 2843 
     pd->current.fill = 0;
22354 ripley 2844 
     */
2845 
    pd->current.col = INVALID_COL;
2846 
    pd->current.fill = INVALID_COL;
15641 ripley 2847 
    pd->current.bg = INVALID_COL;
12688 ripley 2848 
}
2849 
 
16948 murrell 2850 
Rboolean
2851 
PDFDeviceDriver(DevDesc* dd, char *file, char *family, char *encoding,
2852 
		char *bg, char *fg, double width, double height, double ps,
22279 ripley 2853 
		int onefile, char *title)
12686 ripley 2854 
{
16948 murrell 2855 
    return innerPDFDeviceDriver((NewDevDesc*) dd, file, family, encoding,
22279 ripley 2856 
				bg, fg, width, height, ps, onefile, title);
16948 murrell 2857 
}
2858 
 
2859 
static void PDF_SetLineColor(int color, NewDevDesc *dd)
2860 
{
12686 ripley 2861 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
2862 
 
2863 
    if(color != pd->current.col) {
2864 
	fprintf(pd->pdffp, "%.3f %.3f %.3f RG\n",
2865 
		R_RED(color)/255.0,
2866 
		R_GREEN(color)/255.0,
2867 
		R_BLUE(color)/255.0);
2868 
	pd->current.col = color;
2869 
    }
2870 
}
2871 
 
16948 murrell 2872 
static void PDF_SetFill(int color, NewDevDesc *dd)
12686 ripley 2873 
{
2874 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
2875 
    if(color != pd->current.fill) {
2876 
	fprintf(pd->pdffp, "%.3f %.3f %.3f rg\n",
2877 
		   R_RED(color)/255.0,
2878 
		   R_GREEN(color)/255.0,
2879 
		   R_BLUE(color)/255.0);
2880 
	pd->current.fill = color;
2881 
    }
2882 
}
2883 
 
20059 ripley 2884 
/* Note that the line texture is scaled by the line width.*/
2885 
static void PDFSetLineTexture(FILE *fp, char *dashlist, int nlty, double lwd)
12686 ripley 2886 
{
20059 ripley 2887 
    PP_SetLineTexture("d");
12686 ripley 2888 
}
2889 
 
16948 murrell 2890 
static void PDF_SetLineStyle(int newlty, double newlwd, NewDevDesc *dd)
12686 ripley 2891 
{
2892 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
20059 ripley 2893 
    char dashlist[8];
2894 
    int i;
12686 ripley 2895 
 
2896 
    if (pd->current.lty != newlty || pd->current.lwd != newlwd) {
2897 
	pd->current.lwd = newlwd;
2898 
	pd->current.lty = newlty;
2899 
	fprintf(pd->pdffp, "%.2f w\n", newlwd * 0.75);
2900 
	/* process lty : */
2901 
	for(i = 0; i < 8 && newlty & 15 ; i++) {
20059 ripley 2902 
	    dashlist[i] = newlty & 15;
12686 ripley 2903 
	    newlty = newlty >> 4;
2904 
	}
20059 ripley 2905 
	PDFSetLineTexture(pd->pdffp, dashlist, i, newlwd * 0.75);
12686 ripley 2906 
    }
2907 
}
2908 
 
12688 ripley 2909 
static void texton(PDFDesc *pd)
12686 ripley 2910 
{
12688 ripley 2911 
    fprintf(pd->pdffp, "BT\n");
2912 
    pd->inText = TRUE;
2913 
}
2914 
 
2915 
static void textoff(PDFDesc *pd)
2916 
{
2917 
    fprintf(pd->pdffp, "ET\n");
2918 
    pd->inText = FALSE;
2919 
}
2920 
 
2921 
static void PDF_EncodeFont(PDFDesc *pd, int nobj)
2922 
{
2923 
    char *encname = pd->encname;
2924 
 
2925 
    fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Encoding\n", nobj);
16837 ripley 2926 
    if (strcmp(encname, "WinAnsiEncoding") == 0 ||
12688 ripley 2927 
	strcmp(encname, "MacRomanEncoding") == 0 ||
2928 
	strcmp(encname, "PDFDocEncoding") == 0) {
2929 
	fprintf(pd->pdffp, "/BaseEncoding /%s\n", encname);
2930 
	fprintf(pd->pdffp, "/Differences [ 45/minus ]\n");
2931 
    } else if (strcmp(encname, "ISOLatin1Encoding") == 0) {
2932 
	fprintf(pd->pdffp, "/BaseEncoding /PDFDocEncoding\n");
2933 
	fprintf(pd->pdffp, "/Differences [ 45/minus 96/quoteleft\n144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space]\n");
2934 
    } else {
13854 ripley 2935 
	fprintf(pd->pdffp, "/BaseEncoding /PDFDocEncoding\n");
12688 ripley 2936 
	fprintf(pd->pdffp, "/Differences [ 0 %s ]\n", enccode);
2937 
    }
2938 
    fprintf(pd->pdffp, ">>\nendobj\n");
2939 
}
2940 
 
12691 ripley 2941 
#include <time.h>
21827 ripley 2942 
#include <Rversion.h>
12691 ripley 2943 
 
12688 ripley 2944 
static void PDF_startfile(PDFDesc *pd)
2945 
{
12686 ripley 2946 
    int i;
2947 
    struct tm *ltm;
2948 
    time_t ct;
2949 
 
2950 
    pd->nobjs = 0;
2951 
    pd->pageno = 0;
24535 ripley 2952 
    fprintf(pd->pdffp, "%%PDF-1.1\n%%âãÏÓ\r\n");
12686 ripley 2953 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
2954 
 
12692 ripley 2955 
    /* Object 1 is Info node. Date format is from the PDF manual */
12688 ripley 2956 
 
12686 ripley 2957 
    ct = time(NULL);
2958 
    ltm = localtime(&ct);
16837 ripley 2959 
    fprintf(pd->pdffp,
12686 ripley 2960 
	    "1 0 obj\n<<\n/CreationDate (D:%04d%02d%02d%02d%02d%02d)\n",
16837 ripley 2961 
	    1900 + ltm->tm_year, ltm->tm_mon+1, ltm->tm_mday,
12686 ripley 2962 
	    ltm->tm_hour, ltm->tm_min, ltm->tm_sec);
21827 ripley 2963 
    fprintf(pd->pdffp,
2964 
	    "/ModDate (D:%04d%02d%02d%02d%02d%02d)\n",
2965 
	    1900 + ltm->tm_year, ltm->tm_mon+1, ltm->tm_mday,
2966 
	    ltm->tm_hour, ltm->tm_min, ltm->tm_sec);
22279 ripley 2967 
    fprintf(pd->pdffp, "/Title (%s)\n", pd->title);
21827 ripley 2968 
    fprintf(pd->pdffp, "/Producer (R %s.%s)\n/Creator (R)\n>>\nendobj\n",
2969 
	    R_MAJOR, R_MINOR);
12686 ripley 2970 
 
12688 ripley 2971 
    /* Object 2 is the Catalog, pointing to pages list in object 3 (at end) */
2972 
 
12686 ripley 2973 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
2974 
    fprintf(pd->pdffp, "2 0 obj\n<<\n/Type /Catalog\n/Pages 3 0 R\n>>\nendobj\n");
12688 ripley 2975 
 
2976 
    /* Object 3 will be at the end */
2977 
 
2978 
    /* Object 4 is the standard resources dict for each page */
2979 
 
2980 
    ++pd->nobjs;
12686 ripley 2981 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
16837 ripley 2982 
    fprintf(pd->pdffp,
12688 ripley 2983 
	    "4 0 obj\n<<\n/ProcSet [/PDF /Text]\n/Font << %s %s %s %s %s %s >>\n>>\nendobj\n",
2984 
	    "/F1 6 0 R","/F2 7 0 R","/F3 8 0 R","/F4 9 0 R","/F5 10 0 R",
12692 ripley 2985 
	    "/F6 11 0 R");
12688 ripley 2986 
 
2987 
    /* Object 5 is the encoding for text fonts */
2988 
 
12686 ripley 2989 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
12688 ripley 2990 
    PDF_EncodeFont(pd, pd->nobjs);
2991 
 
2992 
    /* Objects 6, 7, 8, 9 are the fonts for the text family */
2993 
    /* Object 10 is the Symbol font */
12692 ripley 2994 
    /* Object 11 is Dingbats, used for (small) circles */
12688 ripley 2995 
 
12686 ripley 2996 
    for (i = 0; i < 4; i++) {
2997 
	pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
16837 ripley 2998 
	fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Font\n/Subtype /Type1\n/Name /F%d\n/BaseFont /%s\n/Encoding 5 0 R\n>>\nendobj\n",
12686 ripley 2999 
		i+6, i+1, familyname[i]);
3000 
    }
3001 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
12692 ripley 3002 
    fprintf(pd->pdffp, "10 0 obj\n<<\n/Type /Font\n/Subtype /Type1\n/Name /F5\n/BaseFont /Symbol\n>>\nendobj\n");
12686 ripley 3003 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
12692 ripley 3004 
    fprintf(pd->pdffp, "11 0 obj\n<<\n/Type /Font\n/Subtype /Type1\n/Name /F6\n/BaseFont /ZapfDingbats\n>>\nendobj\n");
12688 ripley 3005 
}
3006 
 
3007 
static void PDF_endfile(PDFDesc *pd)
3008 
{
3009 
    int i, startxref;
3010 
    /* object 3 lists all the pages */
3011 
 
3012 
    pd->pos[3] = (int) ftell(pd->pdffp);
3013 
    fprintf(pd->pdffp, "3 0 obj\n<<\n/Type /Pages\n/Kids [\n");
3014 
    for(i = 0; i < pd->pageno; i++)
3015 
	fprintf(pd->pdffp, "%d 0 R\n", pd->pageobj[i]);
16837 ripley 3016 
 
3017 
    fprintf(pd->pdffp,
3018 
	    "]\n/Count %d\n/MediaBox [0 0 %d %d]\n>>\nendobj\n",
3019 
	    pd->pageno,
12688 ripley 3020 
	    (int) (0.5 + 72*pd->width), (int) (0.5 + 72*pd->height));
3021 
 
3022 
    /* write out xref table */
3023 
 
3024 
    startxref = (int) ftell(pd->pdffp);
3025 
    /* items here must be exactly 20 bytes including terminator */
3026 
    fprintf(pd->pdffp, "xref\n0 %d\n", pd->nobjs+1);
3027 
    fprintf(pd->pdffp, "0000000000 65535 f \n");
3028 
    for(i = 1; i <= pd->nobjs; i++) {
3029 
	fprintf(pd->pdffp, "%010d 00000 n \n", pd->pos[i]);
3030 
    }
16837 ripley 3031 
    fprintf(pd->pdffp,
3032 
	    "trailer\n<<\n/Size %d\n/Info 1 0 R\n/Root 2 0 R\n>>\nstartxref\n%d\n",
12688 ripley 3033 
	    pd->nobjs+1, startxref);
3034 
    fprintf(pd->pdffp, "%%%%EOF\n");
3035 
 
3036 
    fclose(pd->pdffp);
3037 
}
3038 
 
3039 
 
16948 murrell 3040 
static Rboolean PDF_Open(NewDevDesc *dd, PDFDesc *pd)
12688 ripley 3041 
{
19912 duncan 3042 
    char buf[512];
12688 ripley 3043 
    int i;
3044 
 
14172 ripley 3045 
    if (!LoadEncoding(pd->encpath, pd->encname, TRUE)) {
3046 
	warning("problem loading encoding file");
3047 
	return FALSE;
3048 
    }
12688 ripley 3049 
    for(i = 0; i < 4 ; i++) {
19912 duncan 3050 
	char const *p = Family[pd->fontfamily].afmfile[i];
12688 ripley 3051 
	if(!PostScriptLoadFontMetrics(p, &(pd->metrics[i]),
3052 
				      familyname[i], 1)) {
15168 pd 3053 
	    warning("cannot read afm file %s", p);
12688 ripley 3054 
	    return FALSE;
3055 
	}
3056 
    }
3057 
    if(!PostScriptLoadFontMetrics("sy______.afm", &(pd->metrics[4]),
3058 
				  familyname[4], 0)) {
15168 pd 3059 
	warning("cannot read afm file sy______.afm");
12688 ripley 3060 
	return FALSE;
3061 
    }
3062 
 
3063 
    /* NB: this must be binary to get tell positions and line endings right */
3064 
 
25313 ripley 3065 
    snprintf(buf, 512, pd->filename, pd->fileno + 1); /* file 1 to start */
12688 ripley 3066 
    pd->pdffp = R_fopen(R_ExpandFileName(buf), "wb");
3067 
    if (!pd->pdffp) {
3068 
	warning("cannot open `pdf' file argument `%s'", buf);
3069 
	return FALSE;
3070 
    }
3071 
 
3072 
    PDF_startfile(pd);
12686 ripley 3073 
    return TRUE;
3074 
}
3075 
 
16948 murrell 3076 
static void PDF_Clip(double x0, double x1, double y0, double y1, NewDevDesc *dd)
12686 ripley 3077 
{
20616 ripley 3078 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
12688 ripley 3079 
 
20616 ripley 3080 
    if(pd->inText) textoff(pd);
3081 
    if(x0 != 0.0 || y0 != 0.0 || x1 != 72*pd->width || y1 != 72*pd->height)
20717 ripley 3082 
	fprintf(pd->pdffp, "Q q %.2f %.2f %.2f %.2f re W n\n",
20616 ripley 3083 
		x0, y0, x1 - x0, y1 - y0);
3084 
    else fprintf(pd->pdffp, "Q q\n");
3085 
    PDF_Invalidate(dd);
12686 ripley 3086 
}
3087 
 
16948 murrell 3088 
static void PDF_Size(double *left, double *right,
3089 
		     double *bottom, double *top,
3090 
		     NewDevDesc *dd)
12686 ripley 3091 
{
16948 murrell 3092 
    *left = dd->left;
3093 
    *right = dd->right;
3094 
    *bottom = dd->bottom;
3095 
    *top = dd->top;
12686 ripley 3096 
}
3097 
 
12688 ripley 3098 
static void PDF_endpage(PDFDesc *pd)
3099 
{
3100 
    int here;
3101 
    if(pd->inText) textoff(pd);
3102 
    fprintf(pd->pdffp, "Q\n");
3103 
    here = (int) ftell(pd->pdffp);
3104 
    fprintf(pd->pdffp, "endstream\nendobj\n");
3105 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
3106 
    fprintf(pd->pdffp, "%d 0 obj\n%d\nendobj\n", pd->nobjs,
16837 ripley 3107 
	    here - pd->startstream);
12688 ripley 3108 
}
3109 
 
27236 murrell 3110 
static void PDF_NewPage(R_GE_gcontext *gc,
3111 
			NewDevDesc *dd)
12686 ripley 3112 
{
3113 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
12688 ripley 3114 
    char buf[512];
12686 ripley 3115 
 
18784 ripley 3116 
    if(pd->pageno >= pd->pagemax || pd->nobjs >= 3*pd->pagemax) {
20059 ripley 3117 
	pd->pageobj = (int *)
18784 ripley 3118 
	    realloc(pd->pageobj, 2*pd->pagemax * sizeof(int));
20059 ripley 3119 
	pd->pos = (int *) realloc(pd->pos,
18784 ripley 3120 
				  (6*pd->pagemax + 50) * sizeof(int));
3121 
	if(!pd->pos || !pd->pageobj)
3122 
	    error("unable to increase page limit: please shutdown the pdf device");
3123 
	pd->pagemax *= 2;
3124 
    }
12688 ripley 3125 
 
20059 ripley 3126 
 
12688 ripley 3127 
    if(pd->pageno > 0) {
3128 
	PDF_endpage(pd);
3129 
	if(!pd->onefile) {
3130 
	    PDF_endfile(pd);
21055 ripley 3131 
	    pd->fileno++;
25313 ripley 3132 
	    snprintf(buf, 512, pd->filename, pd->fileno + 1); /* file 1 to start */
12688 ripley 3133 
	    pd->pdffp = R_fopen(R_ExpandFileName(buf), "wb");
3134 
	    if (!pd->pdffp)
3135 
		error("cannot open `pdf' file argument `%s'\n  please shut down the PDFdevice", buf);
3136 
	    PDF_startfile(pd);
3137 
	}
12686 ripley 3138 
    }
16837 ripley 3139 
 
12686 ripley 3140 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
3141 
    pd->pageobj[pd->pageno++] = pd->nobjs;
16837 ripley 3142 
    fprintf(pd->pdffp, "%d 0 obj\n<<\n/Type /Page\n/Parent 3 0 R\n/Contents %d 0 R\n/Resources 4 0 R\n>>\nendobj\n",
12686 ripley 3143 
	    pd->nobjs, pd->nobjs+1);
3144 
    pd->pos[++pd->nobjs] = (int) ftell(pd->pdffp);
16837 ripley 3145 
    fprintf(pd->pdffp, "%d 0 obj\n<<\n/Length %d 0 R\n>>\nstream\r\n",
12686 ripley 3146 
	    pd->nobjs, pd->nobjs + 1);
3147 
    pd->startstream = (int) ftell(pd->pdffp);
12692 ripley 3148 
    fprintf(pd->pdffp, "1 J 1 j 10 M q\n");
12688 ripley 3149 
    PDF_Invalidate(dd);
27236 murrell 3150 
    if(R_ALPHA(gc->fill) == 0) {
3151 
	PDF_SetFill(gc->fill, dd);
12686 ripley 3152 
	fprintf(pd->pdffp, "0 0 %.2f %.2f re f\n",
3153 
		72.0 * pd->width, 72.0 * pd->height);
3154 
    }
12688 ripley 3155 
    pd->inText = FALSE;
12686 ripley 3156 
}
3157 
 
16948 murrell 3158 
static void PDF_Close(NewDevDesc *dd)
12686 ripley 3159 
{
3160 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
16837 ripley 3161 
 
12688 ripley 3162 
    if(pd->pageno > 0) PDF_endpage(pd);
3163 
    PDF_endfile(pd);
18784 ripley 3164 
    free(pd->pos); free(pd->pageobj); free(pd);
12686 ripley 3165 
}
3166 
 
16948 murrell 3167 
static void PDF_Activate(NewDevDesc *dd) {}
3168 
static void PDF_Deactivate(NewDevDesc *dd) {}
12686 ripley 3169 
 
16948 murrell 3170 
static void PDF_Rect(double x0, double y0, double x1, double y1,
27236 murrell 3171 
		     R_GE_gcontext *gc,
3172 
		     NewDevDesc *dd)
12686 ripley 3173 
{
3174 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
3175 
    int code;
3176 
 
27236 murrell 3177 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
12686 ripley 3178 
    if (code) {
12688 ripley 3179 
	if(pd->inText) textoff(pd);
12686 ripley 3180 
	if(code & 2)
27236 murrell 3181 
	    PDF_SetFill(gc->fill, dd);
12686 ripley 3182 
	if(code & 1) {
27236 murrell 3183 
	    PDF_SetLineColor(gc->col, dd);
3184 
	    PDF_SetLineStyle(gc->lty, gc->lwd, dd);
12686 ripley 3185 
	}
3186 
	fprintf(pd->pdffp, "%.2f %.2f %.2f %.2f re", x0, y0, x1-x0, y1-y0);
3187 
	switch(code){
3188 
	case 1: fprintf(pd->pdffp, " S\n"); break;
3189 
	case 2: fprintf(pd->pdffp, " f\n"); break;
3190 
	case 3: fprintf(pd->pdffp, " B\n"); break;
3191 
	}
3192 
    }
3193 
}
3194 
 
3195 
/* r is in device coords */
16948 murrell 3196 
static void PDF_Circle(double x, double y, double r,
27236 murrell 3197 
		       R_GE_gcontext *gc,
16948 murrell 3198 
		       NewDevDesc *dd)
12686 ripley 3199 
{
3200 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
12692 ripley 3201 
    int code, tr;
12688 ripley 3202 
    double xx, yy, a;
12686 ripley 3203 
 
27236 murrell 3204 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
12686 ripley 3205 
 
3206 
    if (code) {
3207 
	if(code & 2)
27236 murrell 3208 
	    PDF_SetFill(gc->fill, dd);
12686 ripley 3209 
	if(code & 1) {
27236 murrell 3210 
	    PDF_SetLineColor(gc->col, dd);
3211 
	    PDF_SetLineStyle(gc->lty, gc->lwd, dd);
12686 ripley 3212 
	}
12692 ripley 3213 
	if(r > 10) { /* somewhat arbitrary, use font up to 20pt */
3214 
            /* Use four Bezier curves, hand-fitted to quadrants */
3215 
	    double s = 0.55 * r;
12688 ripley 3216 
	    if(pd->inText) textoff(pd);
12692 ripley 3217 
	    fprintf(pd->pdffp, "  %.2f %.2f m\n", x - r, y);
16837 ripley 3218 
	    fprintf(pd->pdffp, "  %.2f %.2f %.2f %.2f %.2f %.2f c\n",
12692 ripley 3219 
		   x - r, y + s, x - s, y + r, x, y + r);
16837 ripley 3220 
	    fprintf(pd->pdffp, "  %.2f %.2f %.2f %.2f %.2f %.2f c\n",
12692 ripley 3221 
		   x + s, y + r, x + r, y + s, x + r, y);
16837 ripley 3222 
	    fprintf(pd->pdffp, "  %.2f %.2f %.2f %.2f %.2f %.2f c\n",
12692 ripley 3223 
		   x + r, y - s, x + s, y - r, x, y - r);
16837 ripley 3224 
	    fprintf(pd->pdffp, "  %.2f %.2f %.2f %.2f %.2f %.2f c\n",
12692 ripley 3225 
		   x - s, y - r, x - r, y - s, x - r, y);
12688 ripley 3226 
	    switch(code){
3227 
	    case 1: fprintf(pd->pdffp, "S\n"); break;
3228 
	    case 2: fprintf(pd->pdffp, "f\n"); break;
3229 
	    case 3: fprintf(pd->pdffp, "B\n"); break;
3230 
	    }
3231 
	} else {
3232 
	    /* Use char 108 in Dingbats, which is a solid disc
3233 
	       afm is C 108 ; WX 791 ; N a71 ; B 35 -14 757 708 ;
3234 
	       so diameter = 0.722 * size
12692 ripley 3235 
	       centre = (0.396, 0.347) * size
12688 ripley 3236 
	    */
3237 
	    a = 2./0.722 * r;
3238 
	    xx = x - 0.396*a;
3239 
	    yy = y - 0.347*a;
27236 murrell 3240 
	    tr = (R_ALPHA(gc->fill) == 0) + 2 * (R_ALPHA(gc->col) == 0) - 1;
12688 ripley 3241 
	    if(!pd->inText) texton(pd);
16837 ripley 3242 
	    fprintf(pd->pdffp,
3243 
		    "/F6 1 Tf %d Tr %.2f 0 0 %.2f %.2f %.2f Tm",
12688 ripley 3244 
		    tr, a, a, xx, yy);
16837 ripley 3245 
	    fprintf(pd->pdffp, " (l) Tj 0 Tr\n");
12686 ripley 3246 
	}
3247 
    }
3248 
}
3249 
 
3250 
static void PDF_Line(double x1, double y1, double x2, double y2,
27236 murrell 3251 
		     R_GE_gcontext *gc,
16948 murrell 3252 
		     NewDevDesc *dd)
12686 ripley 3253 
{
3254 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
3255 
 
27236 murrell 3256 
    if(R_ALPHA(gc->col) == 0) {
3257 
	PDF_SetLineColor(gc->col, dd);
3258 
	PDF_SetLineStyle(gc->lty, gc->lwd, dd);
15641 ripley 3259 
	if(pd->inText) textoff(pd);
3260 
	fprintf(pd->pdffp, "%.2f %.2f m %.2f %.2f l S\n", x1, y1, x2, y2);
3261 
    }
12686 ripley 3262 
}
3263 
 
20059 ripley 3264 
static void PDF_Polygon(int n, double *x, double *y,
27236 murrell 3265 
			R_GE_gcontext *gc,
16948 murrell 3266 
			NewDevDesc *dd)
12686 ripley 3267 
{
3268 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
3269 
    double xx, yy;
3270 
    int i, code;
3271 
 
27236 murrell 3272 
    code = 2 * (R_ALPHA(gc->fill) == 0) + (R_ALPHA(gc->col) == 0);
12686 ripley 3273 
 
3274 
    if (code) {
12688 ripley 3275 
	if(pd->inText) textoff(pd);
12686 ripley 3276 
	if(code & 2)
27236 murrell 3277 
	    PDF_SetFill(gc->fill, dd);
12686 ripley 3278 
	if(code & 1) {
27236 murrell 3279 
	    PDF_SetLineColor(gc->col, dd);
3280 
	    PDF_SetLineStyle(gc->lty, gc->lwd, dd);
12686 ripley 3281 
	}
3282 
	xx = x[0];
3283 
	yy = y[0];
3284 
	fprintf(pd->pdffp, "  %.2f %.2f m\n", xx, yy);
3285 
	for(i = 1 ; i < n ; i++) {
3286 
	    xx = x[i];
3287 
	    yy = y[i];
3288 
	    fprintf(pd->pdffp, "  %.2f %.2f l\n", xx, yy);
3289 
	}
3290 
	switch(code){
3291 
	case 1: fprintf(pd->pdffp, "s\n"); break;
3292 
	case 2: fprintf(pd->pdffp, "h f\n"); break;
3293 
	case 3: fprintf(pd->pdffp, "b\n"); break;
3294 
	}
3295 
    }
3296 
 
3297 
}
3298 
 
20059 ripley 3299 
static void PDF_Polyline(int n, double *x, double *y,
27236 murrell 3300 
			 R_GE_gcontext *gc,
16948 murrell 3301 
			 NewDevDesc *dd)
12686 ripley 3302 
{
3303 
    PDFDesc *pd = (PDFDesc*) dd->deviceSpecific;
3304 
    double xx, yy;
3305 
    int i;
3306 
 
12688 ripley 3307 
    if(pd->inText) textoff(pd);
27236 murrell 3308 
    if(R_ALPHA(gc->col) == 0) {
3309 
	PDF_SetLineColor(gc->col, dd);
3310 
	PDF_SetLineStyle(gc->lty, gc->lwd, dd);
15641 ripley 3311 
	xx = x[0];
3312 
	yy = y[0];
3313 
	fprintf(pd->pdffp, "%.2f %.2f m\n", xx, yy);
3314 
	for(i = 1 ; i < n ; i++) {
3315 
	    xx = x[i];
3316 
	    yy = y[i];
3317 
	    fprintf(pd->pdffp, "%.2f %.2f l\n", xx, yy);
3318 
	}
3319 
	fprintf(pd->pdffp, "S\n");
12686 ripley 3320 
    }
3321 
}
3322 
 
12688 ripley 3323 
 
20059 ripley 3324 
static void PDF_Text(double x, double y, char *str,
3325 
		     double rot, double hadj,
27236 murrell 3326 
		     R_GE_gcontext *gc,
16948 murrell 3327 
		     NewDevDesc *dd)
12686 ripley 3328 
{
3329 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
27236 murrell 3330 
    int size = (int)floor(gc->cex * gc->ps + 0.5);
3331 
    int face = gc->fontface;
12686 ripley 3332 
    double a, b, rot1;
3333 
 
27683 ripley 3334 
    if(face < 1 || face > 5) {
3335 
	warning("attempt to use invalid font %d replaced by font 1", face);
3336 
	face = 1;
3337 
    }
12686 ripley 3338 
    rot1 = rot * DEG2RAD;
3339 
    a = size * cos(rot1);
3340 
    b = size * sin(rot1);
12688 ripley 3341 
    if(!pd->inText) texton(pd);
27236 murrell 3342 
    if(R_ALPHA(gc->col) == 0) {
3343 
	PDF_SetFill(gc->col, dd);
16837 ripley 3344 
	fprintf(pd->pdffp, "/F%d 1 Tf %.2f %.2f %.2f %.2f %.2f %.2f Tm ",
15641 ripley 3345 
		face, a, b, -b, a, x, y);
3346 
	PostScriptWriteString(pd->pdffp, str);
3347 
	fprintf(pd->pdffp, " Tj\n");
3348 
    }
12686 ripley 3349 
}
3350 
 
16948 murrell 3351 
static Rboolean PDF_Locator(double *x, double *y, NewDevDesc *dd)
12686 ripley 3352 
{
3353 
    return FALSE;
3354 
}
3355 
 
16948 murrell 3356 
static void PDF_Mode(int mode, NewDevDesc* dd)
12686 ripley 3357 
{
3358 
}
3359 
 
16948 murrell 3360 
static void PDF_Hold(NewDevDesc *dd)
12686 ripley 3361 
{
3362 
}
3363 
 
27236 murrell 3364 
static double PDF_StrWidth(char *str,
3365 
			   R_GE_gcontext *gc,
3366 
			   NewDevDesc *dd)
12686 ripley 3367 
{
3368 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
3369 
 
27236 murrell 3370 
    if(gc->fontface < 1 || gc->fontface > 5) gc->fontface = 1;
3371 
    return floor(gc->cex * gc->ps + 0.5) *
12686 ripley 3372 
	PostScriptStringWidth((unsigned char *)str,
27236 murrell 3373 
			      &(pd->metrics[gc->fontface-1]));
12686 ripley 3374 
}
3375 
 
27236 murrell 3376 
static void PDF_MetricInfo(int c,
3377 
			   R_GE_gcontext *gc,
16948 murrell 3378 
			   double* ascent, double* descent,
3379 
			   double* width, NewDevDesc *dd)
12686 ripley 3380 
{
3381 
    PDFDesc *pd = (PDFDesc *) dd->deviceSpecific;
3382 
 
27236 murrell 3383 
    if(gc->fontface < 1 || gc->fontface > 5) gc->fontface = 1;
12686 ripley 3384 
    PostScriptMetricInfo(c, ascent, descent, width,
27236 murrell 3385 
			 &(pd->metrics[gc->fontface-1]));
3386 
    *ascent = floor(gc->cex * gc->ps + 0.5) * *ascent;
3387 
    *descent = floor(gc->cex * gc->ps + 0.5) * *descent;
3388 
    *width = floor(gc->cex * gc->ps + 0.5) * *width;
12686 ripley 3389 
}