1 /*--------------------------------------------------------------------
2  *
3  *	Copyright (c) 2009-2021 by the GMT Team (https://www.generic-mapping-tools.org/team.html)
4  *
5  *	This program is free software; you can redistribute it and/or modify
6  *	it under the terms of the GNU Lesser General Public License as published by
7  *	the Free Software Foundation; version 3 or any later version.
8  *
9  *	This program is distributed in the hope that it will be useful,
10  *	but WITHOUT ANY WARRANTY; without even the implied warranty of
11  *	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  *	GNU Lesser General Public License for more details.
13  *
14  *--------------------------------------------------------------------*/
15 /* 			PSL: PostScript Light
16  *
17  * PSL is a library of plot functions that create PostScript.
18  * All the routines write their output to the same plotting file,
19  * which can be dumped to a Postscript output device (laserwriters).
20  * PSL can handle and mix text, line-drawings, and bit-map graphics
21  * in both black/white and color.  Colors are specified with r,g,b
22  * values in the range 0-1.
23  *
24  * PSL conforms to the Encapsulated PostScript Files Specification V 3.0.
25  *
26  * C considerations:
27  *	Include postscriptlight.h in your program.
28  *	All floating point data are assumed to be of type double.
29  *	All integer data are assumed to be of type long.
30  *
31  * FORTRAN considerations:
32  *	All floating point data are assumed to be DOUBLE PRECISION
33  *	All integer data are assumed to be a long INTEGER, i.e. INTEGER*8
34  *
35  *	When passing (from FORTRAN to C) a fixed-length character variable which has
36  *	blanks at the end, append '\0' (null character) after the last non-blank
37  *	character.  This is so that C will know where the character string ends.
38  *	It is NOT sufficient to pass, for example, "string(1:string_length)".
39  *
40  * List of API functions:
41  *
42  * PSL_beginaxes
43  * PSL_beginclipping	   : Clips plot outside the specified polygon
44  * PSL_beginlayer	   : Place begin object group DSC comment.
45  * PSL_beginplot	   : Initialize parameters for a new plot.
46  * PSL_beginsession	   : Creates a new PSL session
47  * PSL_copy		   : Writes the given string as is to the PS output
48  * PSL_endaxes		   : Turns off mapping of user coordinates to PS units
49  * PSL_endclipping	   : Restores previous clipping path
50  * PSL_endlayer		   : Place end object group DSC comment.
51  * PSL_endplot		   : Close plotfile
52  * PSL_endsession	   : Terminates the PSL session
53  * PSL_getplot		   : Return string with entire PS code
54  * PSL_plotarc		   : Plots a circular arc
55  * PSL_plotaxis		   : Plots an axis with tickmarks and annotation/label
56  * PSL_plotbitimage	   : Plots a 1-bit image or imagemask
57  * PSL_plotcolorimage	   : Plots a 24-bit 2-D image using the colorimage operator
58  * PSL_plotepsimage	   : Inserts EPS image
59  * PSL_plotline		   : Plots a line
60  * PSL_plotparagraph	   : Plots a text paragraph
61  * PSL_plotparagraphbox	   : Plots a box beneath a text paragraph
62  * PSL_plotpoint	   : Absolute or relative move to new position (pen up or down)
63  * PSL_plotpolygon	   : Creates a polygon and optionally fills it
64  * PSL_plotsegment	   : Plots a 2-point straight line segment
65  * PSL_plotsymbol	   : Plots a geometric symbol and [optionally] fills it
66  * PSL_plottext		   : Plots textstring
67  * PSL_plottextbox	   : Draw a filled box around a textstring
68  * PSL_plottextline	   : Place labels along paths (straight or curved), set clip path, draw line
69  * PSL_loadeps		   : Read EPS file into string
70  * PSL_command		   : Writes a given PostScript statement to the plot file
71  * PSL_comment		   : Writes a comment statement to the plot file
72  * PSL_makecolor	   : Returns string with PostScript command to set a new color
73  * PSL_makepen		   : Returns string with PostScript command to set a new pen
74  * PSL_setcolor		   : Sets the pen color or pattern
75  * PSL_setcurrentpoint     : Sets the current point
76  * PSL_setdefaults	   : Change several PSL session default values
77  * PSL_setdash		   : Specify pattern for dashed line
78  * PSL_setfill		   : Sets the fill color or pattern
79  * PSL_setfont		   : Changes current font and possibly re-encodes it to current encoding
80  * PSL_setformat	   : Changes # of decimals used in color and gray specs [3]
81  * PSL_setlinecap	   : Changes the line cap setting
82  * PSL_setlinejoin	   : Changes the line join setting
83  * PSL_setlinewidth	   : Sets a new linewidth
84  * PSL_setmiterlimit	   : Changes the miter limit setting for joins
85  * PSL_setimage		   : Sets up an image pattern fill in PS
86  * PSL_setorigin	   : Translates/rotates the coordinate system
87  * PSL_setparagraph	   : Sets parameters used to typeset text paragraphs
88  * PSL_settransparencymode : Set a new mode for how transparency is understoody
89  * PSL_settransparency     : Set a new transparency
90  * PSL_defpen		   : Encodes a pen with attributes by name in the PS output
91  * PSL_definteger	   : Encodes an integer by name in the PS output
92  * PSL_defpoints	   : Encodes a pointsize by name in the PS output
93  * PSL_defcolor		   : Encodes a rgb color by name in the PS output
94  * PSL_deftextdim	   : Sets variables for text height and width in the PS output
95  * PSL_defunits:	   : Encodes a dimension by name in the PS output
96  *
97  * For information about usage, syntax etc, see the postscriptlight documentation
98  *
99  * Authors:	Paul Wessel, Dept. of Geology and Geophysics, SOEST, U Hawaii
100  *			   pwessel@hawaii.edu
101  *		Remko Scharroo, EUMETSAT, Darmstadt, Germany
102  *			   Remko.Scharroo@eumetsat.int
103  * Date:	13-OCT-2017
104  * Version:	6.0 [64-bit enabled API edition, decoupled from GMT]
105  *
106  * Thanks to J. Goff and L. Parkes for their contributions to an earlier version.
107  *
108  */
109 
110 /*--------------------------------------------------------------------
111  *			SYSTEM HEADER FILES
112  *--------------------------------------------------------------------*/
113 
114 #include <float.h>
115 #include <limits.h>
116 #include <math.h>
117 #include <stdio.h>
118 #include <stdlib.h>
119 #include <string.h>
120 #include <time.h>
121 #include <stdarg.h>
122 #include <stdbool.h>
123 #include <inttypes.h>         /* Exact-width integer types */
124 #include "postscriptlight.h"
125 #ifdef HAVE_CTYPE_H_
126 #	include <ctype.h>
127 #endif
128 #ifdef HAVE_ASSERT_H_
129 #	include <assert.h>
130 #else
131 #	define assert(e) ((void)0)
132 #endif
133 #ifdef HAVE_UNISTD_H_
134 #	include <unistd.h>
135 #endif
136 
137 #ifdef __CYGWIN__	/* See http://gmt.soest.hawaii.edu/boards/1/topics/5428 */
138 #ifdef __x86_64
139 #define lrint(x) ((long int)(int)lrint(x))
140 #endif
141 #endif
142 
143 /*
144  * Windows headers
145  */
146 
147 #ifdef HAVE_IO_H_
148 #	include <io.h>
149 #endif
150 
151 #ifdef HAVE_PROCESS_H_
152 #	include <process.h>
153 #endif
154 
155 
156 #ifdef HAVE_ZLIB
157 #	include <zlib.h>
158 #endif
159 
160 #ifndef PATH_MAX
161 #	define PATH_MAX 1024
162 #endif
163 /* Size prefixes for printf/scanf for size_t and ptrdiff_t */
164 #ifdef _MSC_VER
165 #	define PRIuS "Iu"  /* printf size_t */
166 #else
167 #	define PRIuS "zu"  /* printf size_t */
168 #endif
169 
170 /* Define bswap32 */
171 #undef bswap32
172 #ifdef HAVE___BUILTIN_BSWAP32
173 #	define bswap32 __builtin_bswap32
174 #elif defined __GNUC__ && (defined __i386__ || defined __x86_64__)
175 #	define bswap32 gnuc_bswap32
inline_bswap32(uint32_t x)176 static inline uint32_t inline_bswap32 (uint32_t x) {
177 	return
178 		(((x & 0xFF000000U) >> 24) |
179 		 ((x & 0x00FF0000U) >>  8) |
180 		 ((x & 0x0000FF00U) <<  8) |
181 		 ((x & 0x000000FFU) << 24));
182 }
gnuc_bswap32(uint32_t x)183 	static inline uint32_t gnuc_bswap32(uint32_t x) {
184 		if (__builtin_constant_p(x))
185 			x = inline_bswap32(x);
186 		else
187 			__asm__("bswap %0" : "+r" (x));
188 		return x;
189 	}
190 #elif defined HAVE__BYTESWAP_ULONG /* HAVE___BUILTIN_BSWAP32 */
191 #	define bswap32 _byteswap_ulong
192 #else /* HAVE___BUILTIN_BSWAP32 */
inline_bswap32(uint32_t x)193 	static inline uint32_t inline_bswap32 (uint32_t x) {
194 		return
195 			(((x & 0xFF000000U) >> 24) |
196 			 ((x & 0x00FF0000U) >>  8) |
197 			 ((x & 0x0000FF00U) <<  8) |
198 			 ((x & 0x000000FFU) << 24));
199 	}
200 #	define bswap32 inline_bswap32
201 #endif /* HAVE___BUILTIN_BSWAP32 */
202 
203 #define PSL_M_unused(x) (void)(x)
204 
205 /* ISO Font encodings.  Ensure that the order of PSL_ISO_names matches order of includes below */
206 
207 static char *PSL_ISO_name[] = {
208 	"PSL_Standard",
209 	"PSL_Standard+",
210 	"PSL_ISOLatin1",
211 	"PSL_ISOLatin1+",
212 	"PSL_ISO-8859-1",
213 	"PSL_ISO-8859-2",
214 	"PSL_ISO-8859-3",
215 	"PSL_ISO-8859-4",
216 	"PSL_ISO-8859-5",
217 	"PSL_ISO-8859-6",
218 	"PSL_ISO-8859-7",
219 	"PSL_ISO-8859-8",
220 	"PSL_ISO-8859-9",
221 	"PSL_ISO-8859-10",
222 	"PSL_ISO-8859-11",
223 	"PSL_ISO-8859-13",
224 	"PSL_ISO-8859-14",
225 	"PSL_ISO-8859-15",
226 	"PSL_ISO-8859-16",
227 	NULL
228 };
229 
230 static char *PSL_ISO_encoding[] = {
231 #include "PSL_Standard.h"
232 #include "PSL_Standard+.h"
233 #include "PSL_ISOLatin1.h"
234 #include "PSL_ISOLatin1+.h"
235 #include "PSL_ISO-8859-1.h"
236 #include "PSL_ISO-8859-2.h"
237 #include "PSL_ISO-8859-3.h"
238 #include "PSL_ISO-8859-4.h"
239 #include "PSL_ISO-8859-5.h"
240 #include "PSL_ISO-8859-6.h"
241 #include "PSL_ISO-8859-7.h"
242 #include "PSL_ISO-8859-8.h"
243 #include "PSL_ISO-8859-9.h"
244 #include "PSL_ISO-8859-10.h"
245 #include "PSL_ISO-8859-11.h"
246 #include "PSL_ISO-8859-13.h"
247 #include "PSL_ISO-8859-14.h"
248 #include "PSL_ISO-8859-15.h"
249 #include "PSL_ISO-8859-16.h"
250 NULL
251 };
252 
253 /* Include the 90 hardwired hachure patterns */
254 #include "PSL_patterns.h"
255 
256 /* Listing of "Standard" 35 PostScript fonts found on most PS printers
257  * plus the 4 Japanese fonts we have supported since GMT 3.
258  * The fontheight is the height of A for unit fontsize. */
259 
260 #define PSL_N_STANDARD_FONTS 39
261 static struct PSL_FONT PSL_standard_fonts[PSL_N_STANDARD_FONTS] = {
262 #include "standard_adobe_fonts.h"
263 };
264 
265 /*--------------------------------------------------------------------
266  *		     STANDARD CONSTANTS MACRO DEFINITIONS
267  *--------------------------------------------------------------------*/
268 
269 #ifndef true
270 #define true 1
271 #endif
272 #ifndef false
273 #define false 0
274 #endif
275 #ifndef M_PI
276 #define M_PI            3.14159265358979323846
277 #endif
278 #ifndef R2D
279 #define R2D (180.0/M_PI)
280 #endif
281 #ifndef D2R
282 #define D2R (M_PI/180.0)
283 #endif
284 #ifndef M_SQRT2
285 #define M_SQRT2         1.41421356237309504880
286 #endif
287 #ifndef MIN
288 #define MIN(x, y) (((x) < (y)) ? (x) : (y))
289 #endif
290 #ifndef MAX
291 #define MAX(x, y) (((x) > (y)) ? (x) : (y))
292 #endif
293 
294 /* GMT normally gets these macros from unistd.h */
295 #ifndef HAVE_UNISTD_H_
296 #	define R_OK 4
297 #	define W_OK 2
298 #	ifdef WIN32
299 #		define X_OK R_OK /* X_OK == 1 crashes on Windows */
300 #	else
301 #		define X_OK 1
302 #	endif
303 #	define F_OK 0
304 #endif /* !HAVE_UNISTD_H_ */
305 
306 /* access is usually in unistd.h; we use a macro here
307  * since the same function under WIN32 is prefixed with _
308  * and defined in io.h */
309 #if defined HAVE__ACCESS && !defined HAVE_ACCESS
310 #	define access _access
311 #endif
312 
313 #if defined HAVE_STRTOK_S && !defined HAVE_STRTOK_R
314 #	define strtok_r strtok_s
315 #elif !defined HAVE_STRTOK_R
316 /* define custom function */
317 #endif
318 
319 /* getpid is usually in unistd.h; we use a macro here
320  * since the same function under WIN32 is prefixed with _
321  * and defined in process.h */
322 #if defined HAVE__GETPID && !defined HAVE_GETPID
323 #	define getpid _getpid
324 #endif
325 
326 /*--------------------------------------------------------------------
327  *			PSL CONSTANTS MACRO DEFINITIONS
328  *--------------------------------------------------------------------*/
329 
330 #define PS_LANGUAGE_LEVEL       2
331 #define PSL_Version             "5.0"
332 #define PSL_SMALL               1.0e-10
333 #define PSL_PAGE_HEIGHT_IN_PTS  842     /* A4 height */
334 #define PSL_PEN_LEN		128	/* Style length string */
335 #define PSL_SUBSUP_SIZE		0.7	/* Relative size of sub/sup-script to normal size */
336 #define PSL_SCAPS_SIZE		0.85	/* Relative size of small caps to normal size */
337 #define PSL_SUB_DOWN		0.25	/* Baseline shift down in font size for subscript */
338 #define PSL_SUP_UP_LC		0.35	/* Baseline shift up in font size for superscript after lowercase letter */
339 #define PSL_SUP_UP_UC		0.35	/* Baseline shift up in font size for superscript after uppercase letter */
340 #define PSL_ASCII_ES		27		/* ASCII code for escape (used to prevent +? strings in plain text from being seen as modifiers) */
341 #if 0
342 /* These are potential revisions to some of the settings above but remains to be tested */
343 #define PSL_SUBSUP_SIZE		0.58	/* Relative size of sub/sup-script to normal size */
344 #define PSL_SCAPS_SIZE		0.80	/* Relative size of small caps to normal size */
345 #define PSL_SUB_DOWN		0.25	/* Baseline shift down in font size for subscript */
346 #define PSL_SUP_UP_LC		0.35	/* Baseline shift up in font size for superscript after lowercase letter */
347 #define PSL_SUP_UP_UC		0.45	/* Baseline shift up in font size for superscript after uppercase letter */
348 #define PSL_SUBSUP_SIZE		0.58	/* Relative size of sub/sup-script to normal size */
349 #define PSL_SCAPS_SIZE		0.80	/* Relative size of small caps to normal size */
350 #define PSL_SUB_DOWN		0.33	/* Baseline shift down in font size for subscript */
351 #define PSL_SUP_UP		0.33	/* Baseline shift up in font size for superscript */
352 #endif
353 
354 /*--------------------------------------------------------------------
355  *			PSL FUNCTION MACRO DEFINITIONS
356  *--------------------------------------------------------------------*/
357 
358 #define PSL_s255(s) (s * 255.0)								/* Conversion from 0-1 to 0-255 range */
359 #define PSL_u255(s) ((unsigned char)rint(PSL_s255(s)))					/* Conversion from 0-1 to 0-255 range */
360 #define PSL_t255(t) PSL_u255(t[0]),PSL_u255(t[1]),PSL_u255(t[2])			/* ... same for triplet */
361 #define PSL_q255(q) PSL_u255(q[0]),PSL_u255(q[1]),PSL_u255(q[2]),PSL_u255(q[3])		/* ... same for quadruplet */
362 #define PSL_YIQ(rgb) (0.299 * rgb[0] + 0.587 * rgb[1] + 0.114 * rgb[2])			/* How B/W TV's convert RGB to Gray */
363 #define PSL_eq(a,b) (fabs((a)-(b)) < PSL_SMALL)						/* If two color component are ~identical */
364 #define PSL_is_gray(rgb) (PSL_eq(rgb[0],rgb[1]) && PSL_eq(rgb[1],rgb[2]))		/* If the rgb is a color and not gray */
365 #define PSL_same_rgb(a,b) (PSL_eq(a[0],b[0]) && PSL_eq(a[1],b[1]) && PSL_eq(a[2],b[2]) && PSL_eq(a[3],b[3]))	/* If two colors are ~identical */
366 #define PSL_rgb_copy(a,b) memcpy((void*)a,(void*)b,4*sizeof(double));			/* Copy RGB[T] triplets: a = b */
367 
368 #define PSL_memory(C,ptr,n,type) (type*)psl_memory(C,(void*)ptr,(size_t)(n),sizeof(type))	/* Easier macro for psl_memory */
369 
370 /* Special macros and structure for PSL_plotparagraph */
371 
372 #define PSL_NO_SPACE		0
373 #define PSL_ONE_SPACE		1
374 #define PSL_COMPOSITE_1		8
375 #define PSL_COMPOSITE_2		16
376 #define PSL_COMPOSITE_2_FNT		64
377 #define PSL_SYMBOL_FONT		12
378 #define PSL_CHUNK		2048
379 
380 #define PSL_CLOSE_INTERIOR	16
381 
382 /* Indices for use with PSL->current.sup_up[] */
383 #define PSL_LC	0
384 #define PSL_UC	1
385 
386 struct PSL_WORD {	/* Used for type-setting text */
387 	int font_no;
388 	int flag;
389 	int index;
390 	int baseshift;
391 	int fontsize;
392 	double rgb[4];
393 	char *txt;
394 };
395 
396 struct PSL_COLOR {
397 	double rgb[4];	/* r/g/b plus alpha (PDF only) */
398 };
399 
400 /* Special macros and structure for color(sic) maps-> */
401 
402 #define PSL_INDEX_BITS 8	/* PostScript indices may be 12 bit */
403 			/* But we only do 8 bits for now. */
404 #define PSL_MAX_COLORS (1<<PSL_INDEX_BITS)
405 
406 typedef struct
407 {
408 	size_t ncolors;
409 	unsigned char colors[PSL_MAX_COLORS][3];
410 } *psl_colormap_t;
411 
412 typedef struct
413 {
414 	unsigned char *buffer;
415 	psl_colormap_t colormap;
416 } *psl_indexed_image_t;
417 
418 typedef struct {
419 	size_t nbytes;
420 	int depth;
421 	unsigned char *buffer;
422 } *psl_byte_stream_t;
423 
424 /* These are used when the PDF pdfmark or Ghostscript extensions for transparency is used:
425  * Adobe:       https://www.adobe.com/content/dam/acom/en/devnet/acrobat/pdfs/pdfmarkReference_v9.pdf
426  * Ghostscript: https://www.ghostscript.com/doc/current/Language.htm#Transparency
427  *
428  * From gs 9.53 their transparency model takes two transparencies (stroke and fill) while before
429  * it only took one.  The pdfmark took two but we simply duplicated it since GMT itself only dealt
430  * with one transparency for both.  From GMT 6.2.0 we will allow these two transparencies to be set
431  * individually if the user so selects.  Note: We do not support any of the soft masks/shapes stuff.
432  */
433 
434 #define N_PDF_TRANSPARENCY_MODES	16
435 static const char *PDF_transparency_modes[N_PDF_TRANSPARENCY_MODES] = {
436 	"Color", "ColorBurn", "ColorDodge", "Darken",
437 	"Difference", "Exclusion", "HardLight", "Hue",
438 	"Lighten", "Luminosity", "Multiply", "Normal",
439 	"Overlay", "Saturation", "SoftLight", "Screen"
440 };
441 
442 #ifdef WIN32
443 
444 #ifndef HAVE_STRSEP
445 /* Copyright (C) 2004, 2007, 2009-2012 Free Software Foundation, Inc.
446 
447    Written by Yoann Vandoorselaere <yoann@prelude-ids.org>.
448 
449    This program is free software: you can redistribute it and/or modify
450    it under the terms of the GNU Lesser General Public License as published by
451    the Free Software Foundation; either version 3 of the License, or
452    (at your option) any later version.
453 
454    This program is distributed in the hope that it will be useful,
455    but WITHOUT ANY WARRANTY; without even the implied warranty of
456    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
457    GNU Lesser General Public License for more details.
458 
459    You should have received a copy of the GNU Lesser General Public License
460    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
461 
strsep(char ** stringp,const char * delim)462 char *strsep (char **stringp, const char *delim) {
463 	char *start = *stringp;
464 	char *ptr;
465 
466 	if (start == NULL)
467 		return NULL;
468 
469 	/* Optimize the case of no delimiters.  */
470 	if (delim[0] == '\0') {
471 		*stringp = NULL;
472 		return start;
473     }
474 
475 	/* Optimize the case of one delimiter.  */
476 	if (delim[1] == '\0')
477 		ptr = strchr (start, delim[0]);
478 	else
479 	/* The general case.  */
480 	ptr = strpbrk (start, delim);
481 	if (ptr == NULL) {
482 		*stringp = NULL;
483 		return start;
484 	}
485 
486 	*ptr = '\0';
487 	*stringp = ptr + 1;
488 	return start;
489 }
490 #endif /* ifndef HAVE_STRSEP */
491 
492 /* SUpport for differences between UNIX and DOS paths */
493 
psl_strlshift(char * string,size_t n)494 static void psl_strlshift (char *string, size_t n) {
495 	/* Left shift a string by n characters */
496 	size_t len;
497 	assert (string != NULL); /* NULL pointer */
498 
499 	if ((len = strlen(string)) <= n ) {
500 		/* String shorter than shift width */
501 		*string = '\0'; /* Truncate entire string */
502 		return;
503 	}
504 
505 	/* Move entire string back */
506 	memmove(string, string + n, len + 1);
507 }
508 
psl_strrepc(char * string,int c,int r)509 static void psl_strrepc (char *string, int c, int r) {
510 	/* Replaces all occurrences of c in the string with r */
511 	assert (string != NULL); /* NULL pointer */
512 	do {
513 		if (*string == c)
514 			*string = (char)r;
515 	} while (*(++string)); /* repeat until \0 reached */
516 }
517 
518 /* Turn '/c/dir/...' paths into 'c:/dir/...'
519  * Must do it in a loop since dir may be several ';'-separated dirs */
psl_dos_path_fix(char * dir)520 static void psl_dos_path_fix (char *dir) {
521 	size_t n, k;
522 
523 	if (!dir || (n = strlen (dir)) < 2U)
524 		/* Given NULL or too short dir to work */
525 		return;
526 
527 	if (!strncmp (dir, "/cygdrive/", 10U))
528 		/* May happen for example when Cygwin sets GMT_SHAREDIR */
529 		psl_strlshift (dir, 9); /* Chop '/cygdrive' */
530 
531 	/* Replace dumb backslashes with slashes */
532 	psl_strrepc (dir, '\\', '/');
533 
534 	/* If dir begins with '/' and is 2 long, as in '/c', replace with 'c:' */
535 	if (n == 2U && dir[0] == '/') {
536 		dir[0] = dir[1];
537 		dir[1] = ':';
538 		return;
539 	}
540 
541 	/* If dir is longer than 2 and, e.g., '/c/', replace with 'c:/' */
542 	if (n > 2U && dir[0] == '/' && dir[2] == '/' && isalpha ((int)dir[1])) {
543 		dir[0] = dir[1];
544 		dir[1] = ':';
545 	}
546 
547 	/* Do the same with dirs separated by ';' but do not replace '/c/j/...' with 'c:j:/...' */
548 	for (k = 4; k < n-2; k++) {
549 		if ( (dir[k-1] == ';' && dir[k] == '/' && dir[k+2] == '/' && isalpha ((int)dir[k+1])) ) {
550 			dir[k] = dir[k+1];
551 			dir[k+1] = ':';
552 		}
553 	}
554 
555 	/* Replace ...:C:/... by ...;C:/... as that was a multi-path set by an e.g. bash shell (msys or cygwin) */
556 	for (k = 4; k < n-2; k++) {
557 		if ((dir[k-1] == ':' && dir[k+1] == ':' && dir[k+2] == '/' && isalpha ((int)dir[k])) )
558 			dir[k-1] = ';';
559 		else if ((dir[k-1] == ':' && dir[k] == '/' && dir[k+2] == '/' && isalpha ((int)dir[k+1])) ) {
560 			/* The form ...:/C/... will become ...;C:/... */
561 			dir[k-1] = ';';
562 			dir[k] = dir[k+1];
563 			dir[k+1] = ':';
564 		}
565 	}
566 }
567 #else
568 # define psl_dos_path_fix(e) ((void)0) /* dummy function */
569 #endif
570 
571 /* ----------------------------------------------------------------------
572  * Support functions used in PSL_* functions.
573  * ----------------------------------------------------------------------
574  */
575 
psl_memory(struct PSL_CTRL * PSL,void * prev_addr,size_t nelem,size_t size)576 static void *psl_memory (struct PSL_CTRL *PSL, void *prev_addr, size_t nelem, size_t size) {
577 	/* Multi-functional memory allocation subroutine.
578 	   If prev_addr is NULL, allocate new memory of nelem elements of size bytes.
579 	   	Ignore when nelem == 0.
580 	   If prev_addr exists, reallocate the memory to a larger or smaller chunk of nelem elements of size bytes.
581 	   	When nelem = 0, free the memory.
582 	*/
583 
584 	void *tmp = NULL;
585 	const char *m_unit[4] = {"bytes", "kb", "Mb", "Gb"};
586 	double mem;
587 	int k;
588 
589 	if (prev_addr) {
590 		if (nelem == 0) { /* Take care of n == 0 */
591 			PSL_free (prev_addr);
592 			return (NULL);
593 		}
594 		if ((tmp = realloc ( prev_addr, nelem * size)) == NULL) {
595 			mem = (double)(nelem * size);
596 			k = 0;
597 			while (mem >= 1024.0 && k < 3) mem /= 1024.0, k++;
598 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Could not reallocate more memory [%.2f %s, %" PRIuS " items of %" PRIuS " bytes]\n",
599 			             mem, m_unit[k], nelem, size);
600 			return (NULL);
601 		}
602 	}
603 	else {
604 		if (nelem == 0) return (NULL); /* Take care of n = 0 */
605 		if ((tmp = calloc (nelem, size)) == NULL) {
606 			mem = (double)(nelem * size);
607 			k = 0;
608 			while (mem >= 1024.0 && k < 3) mem /= 1024.0, k++;
609 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Could not allocate memory [%.2f %s, %" PRIuS " items of %" PRIuS " bytes]\n",
610 			             mem, m_unit[k], nelem, size);
611 			return (NULL);
612 		}
613 	}
614 	return (tmp);
615 }
616 
617 /* Things to do with UTF8 */
618 
619 /* Try to convert UTF-8 accented characters to PostScriptLight octal codes.
620  * This depends on which character set we have.  We will limit this to just
621  * Standard, Standard+, ISOILatin1, and ISOLatin1+. Of these, Standard will
622  * only work for some of the encoded letters while the three others should
623  * all be fine.
624  *   We also handle the differences between hyphens and minus symbol.
625  * In ISOLatin1 the hyphen key on the keyboard results in a minus sign while
626  * in Standard it gives a hyphen.  In GMT we want minus signs in annotations
627  * contours and other numerical negative values. This behavior is controlled
628  * by the setting in PSL_settextmode. */
629 
630 
psl_ut8_code_to_ISOLatin(char code)631 static unsigned int psl_ut8_code_to_ISOLatin (char code) {
632 	/* This is called when the previous character in a string has octal 0303 */
633 	unsigned int kode = (unsigned char)code;
634 
635 	return (kode >= 0200 && kode <= 0277) ? kode += 64 : 0;
636 }
637 
psl_fix_utf8(struct PSL_CTRL * PSL,char * in_string)638 static void psl_fix_utf8 (struct PSL_CTRL *PSL, char *in_string) {
639 	/* Given in_string check if UTF8 characters are present and if so replace with PSL octal codes.  Assumes ISOLatin1+ */
640 	unsigned int k, kout, use, utf8_codes = 0;
641 	bool do_minus = (PSL->current.use_minus == PSL_TXTMODE_MINUS);
642 	char *out_string = NULL;
643 
644 	if (!strncmp (PSL->init.encoding, "Standard+", 9U) && do_minus) {	/* For Standard+ encoding we may need to swap leading minus values encoded as hyphen with the actual minus symbol */
645 		for (k = 0; in_string[k]; k++) {
646 			if ((k == 0 || in_string[k-1] != '@') && in_string[k] == 0055)	/* Found a hyphen which we interpret to be a minus sign */
647 				in_string[k] = 0224;	/* Minus is octal 224 in Standard+ but not present in just Standard */
648 		}
649 	}
650 
651 	if (strncmp (PSL->init.encoding, "ISOLatin1", 9U)) return;	/* Do nothing unless ISOLatin[+] */
652 
653 	for (k = 0; in_string[k]; k++) {
654 		if ((unsigned char)(in_string[k]) == 0303 || (unsigned char)(in_string[k]) == 0305)
655 			utf8_codes++;	/* Count them up */
656 		else if (k == 0 || in_string[k-1] != '@') {
657 			if ((unsigned char)in_string[k] == 0255 && do_minus)
658 				in_string[k] = 0055;	/* Minus symbol is octal 0055 in ISOLatin1 */
659 			else if ((unsigned char)in_string[k] == 0055 && !do_minus)
660 				in_string[k] = 0255;	/* Hyphen symbol is octal 0255 in ISOLatin1 */
661 		}
662 	}
663 	if (utf8_codes == 0) return;	/* Nothing to do */
664 
665 	out_string = PSL_memory (PSL, NULL, strlen(in_string) + 1, char);	/* Get a new string of same length (extra byte for '\0') */
666 
667 	for (k = kout = 0; in_string[k]; k++) {
668 		if ((unsigned char)(in_string[k]) == 0303) {    /* Found octal 303 */
669 			k++;	/* Skip the control code */
670 			if ((use = psl_ut8_code_to_ISOLatin (in_string[k])))       /* Found a 2-char utf8 combo, replace with single octal code from our table */
671 				out_string[kout++] = use;
672 			else {    /* Not a recognized code - just output both as they were given */
673 				out_string[kout++] = in_string[k-1];
674 				out_string[kout++] = in_string[k];
675 			}
676 		}
677 		else if ((unsigned char)(in_string[k]) == 0305) {    /* Found Ydieresis, ae, AE, L&l-slash and the S,Z,s,z carons */
678 			k++;	/* Skip the control code */
679 			switch ((unsigned char)in_string[k]) {	/* These 9 chars are placed all over the table so must have individual cases */
680 				case 0201: use = 0203; break;	/* Lslash */
681 				case 0202: use = 0213; break;	/* lslash */
682 				case 0222: use = 0200; break;	/* ae */
683 				case 0223: use = 0210; break;	/* AE */
684 				case 0240: use = 0206; break;	/* Scaron */
685 				case 0241: use = 0177; break;	/* scaron */
686 				case 0270: use = 0211; break;	/* Ydieresis */
687 				case 0275: use = 0212; break;	/* Zcaron */
688 				case 0276: use = 0037; break;	/* zcaron */
689 				default:   use = 0;    break;	/* Not one of the recognized ones in our table */
690 			}
691 			if (use)	/* Found a 2-char utf8 combo */
692 				out_string[kout++] = use;
693 			else  {    /* Not a recognized code - just output both as they were given */
694 				out_string[kout++] = in_string[k-1];
695 				out_string[kout++] = in_string[k];
696 			}
697 		}
698 		else    /* Just output char as was given */
699 			out_string[kout++] = in_string[k];
700 	}
701 	memset (in_string, 0, strlen (in_string));		/* Set old in_string to NULL */
702 	strncpy (in_string, out_string, strlen (out_string));	/* Overwrite old string with possibly adjusted string */
703 	PSL_free (out_string);
704 }
705 
706 /* This one is NOT static since needed in psimage, at least for now */
707 
psl_gray_encode(struct PSL_CTRL * PSL,size_t * nbytes,unsigned char * input)708 unsigned char *psl_gray_encode (struct PSL_CTRL *PSL, size_t *nbytes, unsigned char *input) {
709 	/* Recode RGB stream as gray-scale stream */
710 
711 	size_t in, out, nout;
712 	unsigned char *output = NULL;
713 
714 	nout = *nbytes / 3;
715 	output = PSL_memory (PSL, NULL, nout, unsigned char);
716 
717 	for (in = out = 0; in < *nbytes; out++, in += 3) output[out] = (char) lrint (PSL_YIQ ((&input[in])));
718 	*nbytes = nout;
719 	return (output);
720 }
721 
722 /* Define local (static) support functions called inside the public PSL functions */
723 
psl_ix(struct PSL_CTRL * PSL,double x)724 static int psl_ix (struct PSL_CTRL *PSL, double x) {
725 	/* Convert user x to PS dots */
726 	return (PSL->internal.x0 + (int)lrint (x * PSL->internal.x2ix));
727 }
728 
psl_iy(struct PSL_CTRL * PSL,double y)729 static int psl_iy (struct PSL_CTRL *PSL, double y) {
730 	/* Convert user y to PS dots */
731 	return (PSL->internal.y0 + (int)lrint (y * PSL->internal.y2iy));
732 }
733 
psl_ix10(struct PSL_CTRL * PSL,double x)734 static double psl_ix10 (struct PSL_CTRL *PSL, double x) {
735 	/* Convert user x to PS dots with 1 decimal point */
736 	return (PSL->internal.x0 + 0.1 *lrint (10.0 * x * PSL->internal.x2ix));
737 }
738 
psl_iy10(struct PSL_CTRL * PSL,double y)739 static double psl_iy10 (struct PSL_CTRL *PSL, double y) {
740 	/* Convert user y to PS dots with 1 decimal point */
741 	return (PSL->internal.y0 + 0.1 * lrint (10.0 * y * PSL->internal.y2iy));
742 }
743 
psl_iz(struct PSL_CTRL * PSL,double z)744 static int psl_iz (struct PSL_CTRL *PSL, double z) {
745 	/* Convert user distances to PS dots */
746 	return ((int)lrint (z * PSL->internal.dpu));
747 }
748 
psl_ip(struct PSL_CTRL * PSL,double p)749 static int psl_ip (struct PSL_CTRL *PSL, double p) {
750 	/* Convert PS points to PS dots */
751 	return ((int)lrint (p * PSL->internal.dpp));
752 }
753 
psl_shorten_path_new(struct PSL_CTRL * PSL,double * x,double * y,int n,int * ix,int * iy,int mode)754 static int psl_shorten_path_new (struct PSL_CTRL *PSL, double *x, double *y, int n, int *ix, int *iy, int mode) {
755 	/* Simplifies the (x,y) array by converting it to pixel coordinates (ix,iy)
756 	 * and eliminating repeating points and intermediate points along straight
757 	 * line segments.  The result is the fewest points needed to draw the path
758 	 * and still look exactly like the original path.  However, if mode == 1 we do
759 	 * no shortening. */
760 
761 	int i, k, dx, dy;
762 	int d, db, bx, by, j, ij;
763 
764 	if (n < 2) return (n);	/* Not a path to start with */
765 
766 	for (i = 0; i < n; i++) {	/* Convert all coordinates to integers at current scale */
767 		ix[i] = psl_ix (PSL, x[i]);
768 		iy[i] = psl_iy (PSL, y[i]);
769 	}
770 	if (mode == 1) return (n);
771 
772 	/* Skip intermediate points that are "close" to the line between point i and point j, where
773 	   "close" is defined as less than 1 "dot" (the PostScript resolution) in either direction.
774 	   A point is always close when it coincides with one of the end points (i or j).
775 	   An intermediate point is also considered "far" when it is beyond i or j.
776 	   Algorithm requires that |dx by - bx dy| >= max(|dx|,|dy|) for points to be "far".
777 	*/
778 	for (i = k = 0, j = 2; j < n; j++) {
779 		dx = ix[j] - ix[i];
780 		dy = iy[j] - iy[i];
781 		d = MAX(abs((int)dx),abs((int)dy));
782 		/* We know that d can be zero. That is OK, since it will only happen when (dx,dy) = (0,0).
783 		   And in that cases all intermediate points will always be "far" */
784 		for (ij = j - 1; ij > i; ij--) {
785 			bx = ix[ij] - ix[i];
786 			/* Check if the intermediate point is outside the x-range between points i and j.
787 			   In case of a vertical line, any point with a different x-coordinate is "far" */
788 			if (dx > 0) {
789 				if (bx < 0 || bx > dx) break;
790 			}
791 			else {
792 				if (bx > 0 || bx < dx) break;
793 			}
794 			by = iy[ij] - iy[i];
795 			/* Check if the intermediate point is outside the y-range between points i and j.
796 			   In case of a horizontal line, any point with a different y-coordinate is "far" */
797 			if (dy > 0) {
798 				if (by < 0 || by > dy) break;
799 			}
800 			else {
801 				if (by > 0 || bx < dy) break;
802 			}
803 			/* Generic case where the intermediate point is within the x- and y-range */
804 			db = abs((int)(dx * by) - (int)(bx * dy));
805 			if (db >= d) break; /* Point ij is "far" from line connecting i and j */
806 		}
807 		if (ij > i) {	/* Some intermediate point failed test */
808 			i = j - 1;
809 			k++;
810 			ix[k] = ix[i];
811 			iy[k] = iy[i];
812 		}
813 	}
814 
815 	/* We have gotten to the last point. If this is a duplicate, skip it */
816 	if (ix[k] != ix[n-1] || iy[k] != iy[n-1]) {
817 		k++;
818 		ix[k] = ix[n-1];
819 		iy[k] = iy[n-1];
820 	}
821 	k++;
822 
823 	return (k);
824 }
825 
psl_shorten_path_old(struct PSL_CTRL * PSL,double * x,double * y,int n,int * ix,int * iy,int mode)826 static int psl_shorten_path_old (struct PSL_CTRL *PSL, double *x, double *y, int n, int *ix, int *iy, int mode) {
827 	/* Simplifies the (x,y) array by converting it to pixel coordinates (ix,iy)
828 	 * and eliminating repeating points and intermediate points along straight
829 	 * line segments.  The result is the fewest points needed to draw the path
830 	 * and still look exactly like the original path.  However, if mode == 1 we do
831 	 * no shortening. */
832 
833 	int i, k, dx, dy;
834 	int old_dir = 0, new_dir;
835 	double old_slope = -DBL_MAX, new_slope;
836 	/* These seeds for old_slope and old_dir make sure that first point gets saved */
837 
838 	if (n < 2) return (n);	/* Not a path to start with */
839 
840 	for (i = 0; i < n; i++) {	/* Convert all coordinates to integers at current scale */
841 		ix[i] = psl_ix (PSL, x[i]);
842 		iy[i] = psl_iy (PSL, y[i]);
843 	}
844 	if (mode == 1) return (n);
845 
846 	/* The only truly unique point is the starting point; all else must show increments
847 	 * relative to the previous point */
848 
849 	/* First point is the anchor. We will find at least one point, unless all points are the same */
850 	for (i = k = 0; i < n - 1; i++) {
851 		dx = ix[i+1] - ix[i];
852 		dy = iy[i+1] - iy[i];
853 		if (dx == 0 && dy == 0) continue;	/* Skip duplicates */
854 		new_slope = (dx == 0) ? copysign (DBL_MAX, (double)dy) : ((double)dy) / ((double)dx);
855 		new_dir = (dx >= 0) ? 1 : -1;
856 		if (new_slope != old_slope || new_dir != old_dir) {
857 			ix[k] = ix[i];
858 			iy[k] = iy[i];
859 			k++;
860 			old_slope = new_slope;
861 			old_dir = new_dir;
862 		}
863 	}
864 
865 	/* If all points are the same, we get here with k = 0, so we can exit here now with 1 point */
866 	if (k < 1) return (1);
867 
868 	/* Last point (k cannot be < 1 so k-1 >= 0) */
869 	if (ix[k-1] != ix[n-1] || iy[k-1] != iy[n-1]) {	/* Do not do slope check on last point since we must end there */
870 		ix[k] = ix[n-1];
871 		iy[k] = iy[n-1];
872 		k++;
873 	}
874 
875 	return (k);
876 }
877 
878 /* Addressing issue https://github.com/GenericMappingTools/gmt/issues/439 for long DCW polygons.
879    #define N_LENGTH_THRESHOLD 100000000 meant we only did new path but now we try 50000 as cutoff */
880 #define N_LENGTH_THRESHOLD 50000
psl_shorten_path(struct PSL_CTRL * PSL,double * x,double * y,int n,int * ix,int * iy,int mode)881 static int psl_shorten_path (struct PSL_CTRL *PSL, double *x, double *y, int n, int *ix, int *iy, int mode) {
882 	if (n > N_LENGTH_THRESHOLD)
883 		return psl_shorten_path_old (PSL, x, y, n, ix, iy, mode);
884 	else
885 		return psl_shorten_path_new (PSL, x, y, n, ix, iy, mode);
886 }
887 
psl_forcelinewidth(struct PSL_CTRL * PSL,double linewidth)888 static int psl_forcelinewidth (struct PSL_CTRL *PSL, double linewidth) {
889 	if (linewidth < 0.0) {
890 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Selected linewidth is negative (%g), ignored\n", linewidth);
891 		return (PSL_BAD_WIDTH);
892 	}
893 	PSL_command (PSL, "%d W\n", psl_ip (PSL, linewidth));
894 	PSL->current.linewidth = linewidth;
895 	return (PSL_NO_ERROR);
896 }
897 
psl_set_real_array(struct PSL_CTRL * PSL,const char * prefix,double * array,int n)898 static void psl_set_real_array (struct PSL_CTRL *PSL, const char *prefix, double *array, int n) {
899 	/* These are raw and not scaled */
900 	int i;
901 	PSL_command (PSL, "/PSL_%s [ ", prefix);
902 	for (i = 0; i < n; i++) {
903 		PSL_command (PSL, "%.2f ", array[i]);
904 		if (((i+1)%10) == 0) PSL_command (PSL, "\n\t");
905 	}
906 	PSL_command (PSL, "] def\n");
907 }
908 
psl_set_int_array(struct PSL_CTRL * PSL,const char * prefix,int * array,int n)909 void psl_set_int_array (struct PSL_CTRL *PSL, const char *prefix, int *array, int n) {
910 	/* These are raw and not scaled */
911 	int i;
912 	PSL_command (PSL, "/PSL_%s [ ", prefix);
913 	for (i = 0; i < n; i++) {
914 		PSL_command (PSL, "%d ", array[i]);
915 		if (((i+1)%10) == 0) PSL_command (PSL, "\n\t");
916 	}
917 	PSL_command (PSL, "] def\n");
918 }
919 
psl_set_txt_array(struct PSL_CTRL * PSL,const char * prefix,char * array[],int n)920 void psl_set_txt_array (struct PSL_CTRL *PSL, const char *prefix, char *array[], int n) {
921 	int i;
922 	char *outtext = NULL;
923 	PSL_command (PSL, "/PSL_%s [\n", prefix);
924 	for (i = 0; i < n; i++) {
925 		outtext = psl_prepare_text (PSL, array[i]);	/* Expand escape codes and fix utf-8 characters */
926 		PSL_command (PSL, "\t(%s)\n", outtext);
927 		PSL_free (outtext);
928 	}
929 	PSL_command (PSL, "] def\n", n);
930 }
931 
psl_set_reducedpath_arrays(struct PSL_CTRL * PSL,double * x,double * y,int npath,int * n,int * m,int * node)932 static void psl_set_reducedpath_arrays (struct PSL_CTRL *PSL, double *x, double *y, int npath, int *n, int *m, int *node) {
933 	/* These are used by PSL_plottextline.  We make sure there are no point pairs that would yield dx = dy = 0 (repeat point)
934 	 * at the resolution we are using (0.01 DPI units), hence a new n (possibly shorter) is returned. */
935 	int i, j, k, p, ii, kk, this_i, this_j, last_i, last_j, i_offset = 0, k_offset = 0, n_skipped, ntot = 0, new_tot = 0, *new_n = NULL;
936 	char *use = NULL;
937 	if (x == NULL || y == NULL) return;	/* No path */
938 	for (p = 0; p < npath; p++) ntot += n[p];	/* Determine total number of points */
939 	/* Since we need dx/dy from these we preprocess to avoid any nasty surprises with repeat points */
940 	use = PSL_memory (PSL, NULL, ntot, char);
941 	new_n = PSL_memory (PSL, NULL, npath, int);
942 	for (p = 0; p < npath; p++) {
943 		this_i = this_j = INT_MAX;
944 		for (ii = j = n_skipped = k = 0; ii < n[p]; ii++) {
945 			last_i = this_i;	last_j = this_j;
946 			i = ii + i_offset;	/* Index into concatenated x,y arrays */
947 			this_i = 100 * psl_ix (PSL, x[i]);	/* Simulates the digits written by a %.2lf format */
948 			this_j = 100 * psl_iy (PSL, y[i]);
949 			if (this_i == last_i && this_j == last_j)	/* Repeat point, skip it */
950 				n_skipped++;
951 			else {	/* Not a repeat point, use it */
952 				use[i] = true;
953 				j++;
954 			}
955 			kk = k + k_offset;	/* Index into concatenated node array */
956 			if (k < m[p] && node[kk] == ii && n_skipped) {	/* Adjust node pointer since we are removing points and upsetting the node order */
957 				node[kk++] -= n_skipped;
958 				k++;
959 			}
960 		}
961 		new_n[p] = j;
962 		new_tot += j;
963 		i_offset += n[p];
964 		k_offset += m[p];
965 
966 	}
967 
968 	/* For curved lines for text placement we use 10 times the precision in the coordinates since we will
969 	 * be taking derivatives to compute angles and thus need higher precision than integer PS coordinates */
970 	PSL_comment (PSL, "Set concatenated coordinate arrays for line segments:\n");
971 	PSL_command (PSL, "/PSL_path_x [ ");
972 	for (i = k = 0; i < ntot; i++) {
973 		if (!use[i]) continue;
974 		PSL_command (PSL, "%g ", psl_ix10 (PSL, x[i]));
975 		k++;
976 		if ((k%10) == 0) PSL_command (PSL, "\n\t");
977 	}
978 	PSL_command (PSL, "] def\n");
979 	PSL_command (PSL, "/PSL_path_y [ ");
980 	for (i = k = 0; i < ntot; i++) {
981 		if (!use[i]) continue;
982 		PSL_command (PSL, "%g ", psl_iy10 (PSL, y[i]));
983 		k++;
984 		if ((k%10) == 0) PSL_command (PSL, "\n\t");
985 	}
986 	PSL_command (PSL, "] def\n");
987 	PSL_comment (PSL, "Set array with number of points per line segments:\n");
988 	psl_set_int_array (PSL, "path_n", new_n, npath);
989 	if (k > PSL_MaxOpStack_Size) PSL_message (PSL, PSL_MSG_WARNING, "Warning: PSL array placed has %d items - may exceed gs_init.ps MaxOpStack setting [%d].\n", k, PSL_MaxOpStack_Size);
990 
991 	/* Free up temp arrays */
992 	PSL_free (use);
993 	PSL_free (new_n);
994 	return;
995 }
996 
psl_set_path_arrays(struct PSL_CTRL * PSL,const char * prefix,double * x,double * y,int npath,int * n)997 static void psl_set_path_arrays (struct PSL_CTRL *PSL, const char *prefix, double *x, double *y, int npath, int *n) {
998 	/* Set coordinates arrays in PS units */
999 	int i, ntot = 0;
1000 	char txt[64] = {""};
1001 
1002 	if (x == NULL || y == NULL) return;		/* No path */
1003 	for (i = 0; i < npath; i++) ntot += n[i];	/* Determine total number of points */
1004 
1005 	PSL_comment (PSL, "Set coordinate arrays for text label placements:\n");
1006 	PSL_command (PSL, "/PSL_%s_x [ ", prefix);
1007 	for (i = 0; i < ntot; i++) {
1008 		PSL_command (PSL, "%d ", psl_ix (PSL, x[i]));
1009 		if (((i+1)%10) == 0) PSL_command (PSL, "\n\t");
1010 	}
1011 	PSL_command (PSL, "] def\n");
1012 	PSL_command (PSL, "/PSL_%s_y [ ", prefix);
1013 	for (i = 0; i < ntot; i++) {
1014 		PSL_command (PSL, "%d ", psl_iy (PSL, y[i]));
1015 		if (((i+1)%10) == 0) PSL_command (PSL, "\n\t");
1016 	}
1017 	PSL_command (PSL, "] def\n");
1018 	sprintf (txt, "%s_n", prefix);
1019 	psl_set_int_array (PSL, txt, n, npath);
1020 }
1021 
psl_set_attr_arrays(struct PSL_CTRL * PSL,int * node,double * angle,char ** txt,int npath,int m[])1022 static void psl_set_attr_arrays (struct PSL_CTRL *PSL, int *node, double *angle, char **txt, int npath, int m[]) {
1023 	/* This function sets PSL arrays for attributes needed to place contour labels and quoted text labels.
1024 	 * node:	specifies where along each segments there should be labels [NULL if not curved text]
1025 	 * angle:	specifies angle of text for each item
1026 	 * txt:		is the text labels for each item
1027 	 * npath:	the number of segments (curved text) or number of text items (straight text)
1028 	 * m:		array of length npath with number of labels per segment
1029 	 */
1030 	int i, nlab = 0;
1031 
1032 	for (i = 0; i < npath; i++) nlab += m[i];	/* Determine total number of labels */
1033 	if (node != NULL) {	/* Curved text has node array */
1034 		PSL_comment (PSL, "Set array with nodes of PSL_path_x|y for text placement:\n");
1035 		psl_set_int_array (PSL, "label_node", node, nlab);
1036 		PSL_comment (PSL, "Set array with number of labels per line segment:\n");
1037 		psl_set_int_array (PSL, "label_n", m, npath);
1038 	}
1039 	PSL_comment (PSL, "Set array with baseline angle for each text label:\n");
1040 	psl_set_real_array (PSL, "label_angle", angle, nlab);
1041 	PSL_comment (PSL, "Set array with the text labels:\n");
1042 	psl_set_txt_array (PSL, "label_str", txt, nlab);
1043 
1044 	return;
1045 }
1046 
psl_rgb_to_hsv(double rgb[],double hsv[])1047 static void psl_rgb_to_hsv (double rgb[], double hsv[]) {
1048 	double diff;
1049 	int i, imax = 0, imin = 0;
1050 
1051 	/* This had checks using rgb value in doubles (e.g. (max_v == xr)), which failed always on some compilers.
1052 	   Changed to integer logic: 2009-02-05 by RS.
1053 	*/
1054 	for (i = 1; i < 3; i++) {
1055 		if (rgb[i] > rgb[imax]) imax = i;
1056 		if (rgb[i] < rgb[imin]) imin = i;
1057 	}
1058 	diff = rgb[imax] - rgb[imin];
1059 	hsv[0] = 0.0;
1060 	hsv[1] = (PSL_eq(rgb[imax],0.0)) ? 0.0 : diff / rgb[imax];
1061 	hsv[2] = rgb[imax];
1062 	if (PSL_eq(hsv[1],0.0)) return;	/* Hue is undefined */
1063 	hsv[0] = 120.0 * imax + 60.0 * (rgb[(imax + 1) % 3] - rgb[(imax + 2) % 3]) / diff;
1064 	if (hsv[0] < 0.0) hsv[0] += 360.0;
1065 	if (hsv[0] > 360.0) hsv[0] -= 360.0;
1066 	hsv[0] /= 360.0;	/* All h,s,v values in PostScript are 0-1 range */
1067 }
1068 
1069 #if 0 /* Not used */
1070 static void psl_cmyk_to_rgb (double rgb[], double cmyk[]) {
1071 	/* Plain conversion; no undercolor removal or blackgeneration */
1072 	/* CMYK is in 0-1, RGB will be in 0-1 range */
1073 
1074 	int i;
1075 
1076 	for (i = 0; i < 3; i++) rgb[i] = 1.0 - cmyk[i] - cmyk[3];
1077 }
1078 #endif
psl_rgb_to_cmyk_char(unsigned char rgb[],unsigned char cmyk[])1079 static void psl_rgb_to_cmyk_char (unsigned char rgb[], unsigned char cmyk[]) {
1080 	/* Plain conversion; no undercolor removal or blackgeneration */
1081 	/* RGB is in 0-255, CMYK will be in 0-255 range */
1082 
1083 	int i;
1084 
1085 	for (i = 0; i < 3; i++) cmyk[i] = 255 - rgb[i];
1086 	cmyk[3] = MIN (cmyk[0], MIN (cmyk[1], cmyk[2]));	/* Black */
1087 	for (i = 0; i < 3; i++) cmyk[i] -= cmyk[3];
1088 }
1089 
psl_rgb_to_cmyk(double rgb[],double cmyk[])1090 static void psl_rgb_to_cmyk (double rgb[], double cmyk[]) {
1091 	/* Plain conversion; no undercolor removal or blackgeneration */
1092 	/* RGB is in 0-1, CMYK will be in 0-1 range */
1093 
1094 	int i;
1095 
1096 	for (i = 0; i < 3; i++) cmyk[i] = 1.0 - rgb[i];
1097 	cmyk[3] = MIN (cmyk[0], MIN (cmyk[1], cmyk[2]));	/* Black */
1098 	for (i = 0; i < 3; i++) cmyk[i] -= cmyk[3];
1099 	for (i = 0; i < 4; i++) {
1100 	    if (cmyk[i] < 0.0005) cmyk[i] = 0.0;	/* Needs some explanation... */
1101 	}
1102 }
1103 
psl_cmyk_encode(struct PSL_CTRL * PSL,size_t * nbytes,unsigned char * input)1104 static unsigned char *psl_cmyk_encode (struct PSL_CTRL *PSL, size_t *nbytes, unsigned char *input) {
1105 	/* Recode RGB stream as CMYK stream */
1106 
1107 	size_t in, out, nout;
1108 	unsigned char *output = NULL;
1109 
1110 	nout = *nbytes / 3 * 4;
1111 	output = PSL_memory (PSL, NULL, nout, unsigned char);
1112 
1113 	for (in = out = 0; in < *nbytes; out += 4, in += 3) psl_rgb_to_cmyk_char (&input[in], &output[out]);
1114 	*nbytes = nout;
1115 	return (output);
1116 }
1117 
psl_remove_spaces(char * label[],int n_labels,int m[])1118 static void psl_remove_spaces (char *label[], int n_labels, int m[]) {
1119 	int i, k, j, n_tot = n_labels;
1120 
1121 	if (m)
1122 		for (i = 0; i < n_labels; i++) n_tot += m[i];	/* Count number of labels */
1123 
1124 	for (i = 0; i < n_tot; i++) {	/* Strip leading and trailing blanks */
1125 		for (k = 0; label[i][k] == ' '; k++);	/* Count # of leading blanks */
1126 		if (k > 0) {	/* Shift text to start, eliminating spaces */
1127 			j = 0;
1128 			while (label[i][k]) {
1129 				label[i][j] = label[i][j+k];
1130 				j++;
1131 			}
1132 			label[i][j] = 0;
1133 		}
1134 		/* Then strip off trailing blanks, if any */
1135 		for (j = (int)strlen (label[i]) - 1; label[i][j] == ' '; j--) label[i][j] = 0;
1136 	}
1137 }
1138 
psl_prepare_buffer(struct PSL_CTRL * C,size_t len)1139 static void psl_prepare_buffer (struct PSL_CTRL *C, size_t len) {
1140 	/* Ensure buffer is large enough to accept additional text of length len */
1141 	size_t new_len = C->internal.n + len;       /* Need a buffer at least this large */
1142 	if (new_len < C->internal.n_alloc) return;  /* Already have a buffer that is large enough */
1143 	while (new_len > C->internal.n_alloc)       /* Wind past what is needed, growing by 1.75 */
1144 		C->internal.n_alloc = (size_t)(C->internal.n_alloc * 1.75);
1145 	if ((C->internal.buffer = PSL_memory (C, C->internal.buffer, C->internal.n_alloc, char)) == NULL) {
1146 		PSL_message (C, PSL_MSG_ERROR, "Error: Could not allocate %d additional buffer space - this will not end well\n", len);
1147 	}
1148 }
1149 
psl_a85_encode(struct PSL_CTRL * PSL,const unsigned char * src_buf,size_t nbytes)1150 static size_t psl_a85_encode (struct PSL_CTRL *PSL, const unsigned char *src_buf, size_t nbytes) {
1151 	/* Encode 4-byte binary data from src_buf to 5-byte ASCII85
1152 	 * Special cases: 0x00000000 is encoded as z
1153 	 * Encoded data is stored in dst_buf and written to file in
1154 	 * one go, which is faster than writing one char at a time.
1155 	 * The function returns the output buffer size. */
1156 	size_t dst_buf_size;
1157 	unsigned char *dst_buf, *dst_ptr;
1158 	const unsigned char *src_ptr = src_buf, *src_end = src_buf + nbytes;
1159 	const unsigned int max_line_len = 95; /* number of chars after which a newline is inserted */
1160 
1161 	if (!nbytes)
1162 		/* Ignore empty input */
1163 		return 0;
1164 
1165 	/* dst_buf has to be large enough to hold data + line endings */
1166 	dst_buf_size = (size_t)(nbytes * 1.25 + 1);      /* output buffer is at least 1.25 times larger */
1167 	dst_buf_size += dst_buf_size / max_line_len + 4; /* add more space for '\n' and delimiter */
1168 	dst_ptr = dst_buf = PSL_memory (PSL, NULL, dst_buf_size, unsigned char); /* output buffer */
1169 
1170 	do { /* for each quad in src_buf while src_ptr < src_end */
1171 		const size_t ilen = nbytes > 4 ? 4 : nbytes, olen = ilen + 1;
1172 		static unsigned int line_len = 0;
1173 		unsigned int i, n = 0, byte;
1174 		int j;
1175 		unsigned char quintuple[5] = { 0 };
1176 
1177 		/* Wrap 4 chars into a 4-byte integer */
1178 		for (i = 0; i < ilen; ++i) {
1179 			byte = *src_ptr++;
1180 			n += byte << (24 - 8*i);
1181 		}
1182 
1183 		if (n == 0 && ilen == 4) {
1184 			/* Set the only output byte to "z" */
1185 			*dst_ptr++ = 'z';
1186 			++line_len;
1187 			continue;
1188 		}
1189 
1190 		/* Else determine output 5-tuple */
1191 		for (j = 4; j >= 0; --j) {
1192 			quintuple[j] = (unsigned char) ((n % 85) + '!');
1193 			n = n / 85;
1194 		}
1195 
1196 		/* Copy olen bytes to dst_buf */
1197 		memcpy (dst_ptr, quintuple, olen);
1198 		line_len += (unsigned int)olen;
1199 		dst_ptr += olen;
1200 
1201 		/* Insert newline when line exceeds 95 characters */
1202 		if (line_len + 1 > max_line_len) {
1203 			*dst_ptr++ = '\n';
1204 			line_len = 0;
1205 		}
1206 	} while (nbytes -= 4, src_ptr < src_end); /* end do */
1207 
1208 	{
1209 		/* Mark the end of the Adobe ASCII85-encoded string: */
1210 		const unsigned char delimiter[] = "~>\n";
1211 		memcpy (dst_ptr, delimiter, 3);
1212 		dst_ptr += 3;
1213 	}
1214 
1215 	{
1216 		/* Write buffer to file and clean up */
1217 		const size_t buf_size = dst_ptr - dst_buf;
1218 		assert (buf_size <= dst_buf_size); /* check length */
1219 		if (PSL->internal.memory) {
1220 			psl_prepare_buffer (PSL, buf_size); /* Make sure we have enough memory to hold the entire EPS */
1221 			strncat (&(PSL->internal.buffer[PSL->internal.n]), (const char *)dst_buf, buf_size);
1222 			PSL->internal.n += buf_size;
1223 		}
1224 		else
1225 			fwrite (dst_buf, sizeof(char), buf_size, PSL->internal.fp);
1226 		PSL_free (dst_buf);
1227 		return buf_size;
1228 	}
1229 }
1230 
1231 #define ESC 128
1232 
psl_rle_encode(struct PSL_CTRL * PSL,size_t * nbytes,unsigned char * input)1233 static unsigned char *psl_rle_encode (struct PSL_CTRL *PSL, size_t *nbytes, unsigned char *input) {
1234 	/* Run Length Encode a buffer of nbytes. */
1235 
1236 	size_t count = 0, out = 0, in = 0, i;
1237 	unsigned char pixel, *output = NULL;
1238 
1239 	i = MAX (512, *nbytes) + 136;	/* Maximum output length */
1240 	output = PSL_memory (PSL, NULL, i, unsigned char);
1241 
1242 	/* Loop scanning all input bytes. Abort when inflating after processing at least 512 bytes */
1243 	while (count < *nbytes && (out < in || out < 512)) {
1244 		in = count;
1245 		pixel = input[in++];
1246 		while (in < *nbytes && in - count < 127 && input[in] == pixel) in++;
1247 		if (in - count == 1) {	/* No more duplicates. How many non-duplicates were there? */
1248 			while (in < *nbytes && (in - count) < 127 && ((input[in] != input[in-1] || in > 1) && input[in] != input[in-2])) in++;
1249 			while (in < *nbytes && input[in] == input[in-1]) in--;
1250 			output[out++] = (unsigned char)(in - count - 1);
1251 			for (i = count; i < in; i++) output[out++] = input[i];
1252 		}
1253 		else {		/* Write out a runlength */
1254 			output[out++] = (unsigned char)(count - in + 1);
1255 			output[out++] = pixel;
1256 		}
1257 		count = in;
1258 	}
1259 
1260 	/* Write end of data marker */
1261 	output[out++] = 128;
1262 
1263 	/* Drop the compression when end result is bigger than original */
1264 	if (out > in) {
1265 		PSL_message (PSL, PSL_MSG_INFORMATION, "RLE inflated %d to %d bytes. No compression done.\n", in, out);
1266 		PSL_free (output);
1267 		return (NULL);
1268 	}
1269 
1270 	/* Return number of output bytes and output buffer */
1271 	PSL_message (PSL, PSL_MSG_INFORMATION, "RLE compressed %d to %d bytes (%.1f%% savings)\n", in, out, 100.0f*(1.0f-(float)out/in));
1272 	*nbytes = out;
1273 	return (output);
1274 }
1275 
psl_lzw_putcode(psl_byte_stream_t stream,short int incode)1276 static psl_byte_stream_t psl_lzw_putcode (psl_byte_stream_t stream, short int incode) {
1277 	static short int eod = 257;
1278 	static size_t bit_count = 0;
1279 	static size_t bit_buffer = 0;
1280 
1281 	/* Add incode to buffer and output 1 or 2 bytes */
1282 	bit_buffer |= (size_t) incode << (32 - stream->depth - bit_count);
1283 	bit_count += stream->depth;
1284 	while (bit_count >= 8) {
1285 		stream->buffer[stream->nbytes] = (unsigned char)(bit_buffer >> 24);
1286 		stream->nbytes++;
1287 		bit_buffer <<= 8;
1288 		bit_count -= 8;
1289 	}
1290 	if (incode == eod) {	/* Flush buffer */
1291 		stream->buffer[stream->nbytes] = (unsigned char)(bit_buffer >> 24);
1292 		stream->nbytes++;
1293 		bit_buffer = 0;
1294 		bit_count = 0;
1295 	}
1296 	return (stream);
1297 }
1298 
psl_lzw_encode(struct PSL_CTRL * PSL,size_t * nbytes,unsigned char * input)1299 static unsigned char *psl_lzw_encode (struct PSL_CTRL *PSL, size_t *nbytes, unsigned char *input) {
1300 	/* LZW compress a buffer of nbytes. */
1301 
1302 	static int ncode = 4096*256;
1303 	int i, index;
1304 	size_t in = 0;
1305 	static short int clear = 256, eod = 257;
1306 	short int table = 4095;	/* Initial value forces clearing of table on first byte */
1307 	short int bmax = 0, pre, oldpre, ext, *code = NULL;
1308 	psl_byte_stream_t output;
1309 	unsigned char *buffer = NULL;
1310 
1311 	i = (int)MAX (512, *nbytes) + 8;	/* Maximum output length */
1312 	output = (psl_byte_stream_t)psl_memory (PSL, NULL, 1U, sizeof (*output));
1313 	output->buffer = PSL_memory (PSL, NULL, i, unsigned char);
1314 	code = PSL_memory (PSL, NULL, ncode, short int);
1315 
1316 	output->nbytes = 0;
1317 	output->depth = 9;
1318 	pre = input[in++];
1319 
1320 	/* Loop scanning all input bytes. Abort when inflating after processing at least 512 bytes */
1321 	while (in < *nbytes && (output->nbytes < in || output->nbytes < 512)) {
1322 		if (table >= 4095) {	/* Refresh code table */
1323 			output = psl_lzw_putcode (output, clear);
1324 			memset (code, 0, ncode * sizeof(*code));
1325 			table = eod + 1;
1326 			bmax = clear * 2;
1327 			output->depth = 9;
1328 		}
1329 
1330 		ext = input[in++];
1331 		oldpre = pre;
1332 		index = (pre << 8) + ext;
1333 		pre = code[index];
1334 
1335 		if (pre == 0) {		/* Add new entry to code table */
1336 			code[index] = table;
1337 			table++;
1338 			output = psl_lzw_putcode (output, oldpre);
1339 			pre = ext;
1340 			if (table == bmax) {
1341 				bmax <<= 1;
1342 				output->depth++;
1343 			}
1344 		}
1345 	}
1346 
1347 	/* Output last byte and End-of-Data */
1348 	output = psl_lzw_putcode (output, pre);
1349 	output = psl_lzw_putcode (output, eod);
1350 
1351 	/* Drop the compression when end result is bigger than original */
1352 	if (output->nbytes > in) {
1353 		PSL_message (PSL, PSL_MSG_INFORMATION, "LZW inflated %d to %d bytes. No compression done.\n", in, output->nbytes);
1354 		PSL_free (code);
1355 		PSL_free (output->buffer);
1356 		PSL_free (output);
1357 		return (NULL);
1358 	}
1359 
1360 	/* Return number of output bytes and output buffer; release code table */
1361 	PSL_message (PSL, PSL_MSG_INFORMATION, "LZW compressed %d to %d bytes (%.1f%% savings)\n", in, output->nbytes, 100.0f*(1.0f-(float)output->nbytes/in));
1362 	*nbytes = output->nbytes;
1363 	buffer = output->buffer;
1364 	PSL_free (code);
1365 	PSL_free (output);
1366 	return (buffer);
1367 }
1368 
psl_deflate_encode(struct PSL_CTRL * PSL,size_t * nbytes,unsigned char * input)1369 static unsigned char *psl_deflate_encode (struct PSL_CTRL *PSL, size_t *nbytes, unsigned char *input) {
1370 	/* DEFLATE a buffer of nbytes using ZLIB. */
1371 #ifdef HAVE_ZLIB
1372 	const size_t ilen = *nbytes;
1373 	size_t olen = *nbytes - 1; /* Output buffer is 1 smaller than input */
1374 	unsigned char *output;
1375 	int level = PSL->internal.deflate_level == 0 ? Z_DEFAULT_COMPRESSION : PSL->internal.deflate_level; /* Compression level */
1376 	int zstatus;
1377 	z_stream strm;
1378 
1379 	/* Initialize zlib for compression */
1380 	strm.zalloc = Z_NULL;
1381 	strm.zfree = Z_NULL;
1382 	strm.opaque = Z_NULL;
1383 	if (deflateInit (&strm, level) != Z_OK) {
1384 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Cannot initialize ZLIB stream: %s", strm.msg);
1385 		return NULL;
1386 	}
1387 
1388 	output = PSL_memory (PSL, NULL, olen, unsigned char); /* Allocate output buffer */
1389 
1390 	strm.avail_in  = (int)ilen;   /* number of bytes in input buffer */
1391 	strm.next_in   = input;       /* input buffer */
1392 	strm.avail_out = (int)olen;   /* number of bytes available in output buffer */
1393 	strm.next_out  = output;      /* output buffer */
1394 
1395 	zstatus = deflate (&strm, Z_FINISH); /* deflate whole chunk */
1396 	deflateEnd (&strm);                  /* deallocate zlib memory */
1397 
1398 	if (zstatus != Z_STREAM_END) {
1399 		/* "compressed" size is larger or other failure */
1400 		PSL_message (PSL, PSL_MSG_INFORMATION, "Warning: no deflate compression done.\n");
1401 		PSL_free (output);
1402 		return NULL;
1403 	}
1404 
1405 	/* Return number of output bytes and output buffer */
1406 	olen = olen - strm.avail_out; /* initial size - size left */
1407 	PSL_message (PSL, PSL_MSG_INFORMATION, "DEFLATE compressed %" PRIuS " to %" PRIuS " bytes (%.1f%% savings at compression level %d)\n",
1408 		ilen, olen, 100.0f*(1.0f-(float)olen/ilen), level == Z_DEFAULT_COMPRESSION ? 6 : level);
1409 	*nbytes = olen;
1410 	return output;
1411 
1412 #else /* HAVE_ZLIB */
1413 	/* ZLIB not available */
1414 	PSL_M_unused(nbytes);
1415 	PSL_M_unused(input);
1416 	PSL_message (PSL, PSL_MSG_WARNING, "Cannot DEFLATE because ZLIB is not available.\n");
1417 	return NULL;
1418 #endif /* HAVE_ZLIB */
1419 }
1420 
psl_stream_dump(struct PSL_CTRL * PSL,unsigned char * buffer,int nx,int ny,int nbits,int compress,int encode,int mask)1421 static void psl_stream_dump (struct PSL_CTRL *PSL, unsigned char *buffer, int nx, int ny, int nbits, int compress, int encode, int mask) {
1422 	/* Writes a stream of bytes in ascii85 or hex, performs RGB to CMYK
1423 	 * conversion and compression.
1424 	 * buffer	= stream of bytes
1425 	 * nx, ny	= image dimensions in pixels
1426 	 * nbits	= depth of image pixels in bits
1427 	 * compress	= no (0), rle (1), lzw (2), or deflate (3) compression
1428 	 * encode	= ascii85 (0) or hex (1)
1429 	 * mask		= image (0), imagemask (1), or neither (2)
1430 	 */
1431 	size_t nbytes, i;
1432 	unsigned line_length = 0;
1433 	unsigned char *buffer1 = NULL, *buffer2 = NULL;
1434 	const char *kind_compress[] = {"", "/RunLengthDecode filter", "/LZWDecode filter", "/FlateDecode filter"};
1435 	const char *kind_mask[] = {"image", "imagemask"};
1436 
1437 	nx = abs (nx);
1438 	nbytes = ((size_t)nbits * (size_t)nx + 7) / (size_t)8 * (size_t)ny;
1439 
1440 	/* Transform RGB stream to CMYK or Gray stream */
1441 	if (PSL->internal.color_mode == PSL_CMYK && nbits == 24)
1442 		buffer1 = psl_cmyk_encode (PSL, &nbytes, buffer);
1443 	else if (PSL->internal.color_mode == PSL_GRAY && nbits == 24)
1444 		buffer1 = psl_gray_encode (PSL, &nbytes, buffer);
1445 	else
1446 		buffer1 = buffer;
1447 
1448 	/* Perform selected compression method */
1449 	if (compress == PSL_RLE)
1450 		buffer2 = psl_rle_encode (PSL, &nbytes, buffer1);
1451 	else if (compress == PSL_LZW)
1452 		buffer2 = psl_lzw_encode (PSL, &nbytes, buffer1);
1453 	else if (compress == PSL_DEFLATE)
1454 		buffer2 = psl_deflate_encode (PSL, &nbytes, buffer1);
1455 	else
1456 		buffer2 = NULL;
1457 
1458 	if (!buffer2)	{ /* If compression failed, or no compression requested */
1459 		compress = PSL_NONE;
1460 		buffer2 = buffer1;
1461 	}
1462 
1463 	/* Output image dictionary */
1464 	if (mask < 2) {
1465 		PSL_command (PSL, "/Width %d /Height %d /BitsPerComponent %d\n", nx, ny, MIN(nbits,8));
1466 		PSL_command (PSL, "   /ImageMatrix [%d 0 0 %d 0 %d] /DataSource currentfile", nx, -ny, ny);
1467 		if (encode == PSL_ASCII85) PSL_command (PSL, " /ASCII85Decode filter");
1468 		if (compress) PSL_command (PSL, " %s", kind_compress[compress]);
1469 		PSL_command (PSL, "\n>> %s\n", kind_mask[mask]);
1470 	}
1471 	if (encode == PSL_ASCII85) {
1472 		/* Convert 4-tuples to ASCII85 5-tuples and write buffer to file */
1473 		psl_a85_encode (PSL, buffer2, nbytes);
1474 	}
1475 	else {
1476 		/* Regular hexadecimal encoding */
1477 		for (i = 0; i < nbytes; i++) {
1478 			PSL_command (PSL, "%02X", buffer2[i]); line_length += 2;
1479 			if (line_length > 95) { PSL_command (PSL, "\n"); line_length = 0; }
1480 		}
1481 	}
1482 	if (mask == 2) PSL_command (PSL, "%s", kind_compress[compress]);
1483 
1484 	/* Clear newly created buffers, but maintain original */
1485 	if (buffer2 != buffer1) PSL_free (buffer2);
1486 	if (buffer1 != buffer ) PSL_free (buffer1);
1487 }
1488 
psl_putfont(struct PSL_CTRL * PSL,double fontsize)1489 static int psl_putfont (struct PSL_CTRL *PSL, double fontsize) {
1490 	if (fontsize == PSL->current.fontsize) return (PSL_NO_ERROR);
1491 	PSL->current.fontsize = fontsize;
1492 	PSL_command (PSL, "%d F%d\n", psl_ip (PSL, fontsize), PSL->current.font_no);
1493 	return (PSL_NO_ERROR);
1494 }
1495 
psl_encodefont(struct PSL_CTRL * PSL,int font_no)1496 static int psl_encodefont (struct PSL_CTRL *PSL, int font_no) {
1497 	if (PSL->init.encoding == NULL) return (PSL_NO_ERROR);		/* Already have StandardEncoding by default */
1498 	if (PSL->internal.font[font_no].encoded) return (PSL_NO_ERROR);	/* Already re-encoded or should not be re-encoded ever */
1499 
1500 	/* Re-encode fonts with Standard+ or ISOLatin1[+] encodings */
1501 	PSL_command (PSL, "PSL_font_encode %d get 0 eq {%s_Encoding /%s /%s PSL_reencode PSL_font_encode %d 1 put} if", font_no, PSL->init.encoding, PSL->internal.font[font_no].name, PSL->internal.font[font_no].name, font_no);
1502 	(PSL->internal.comments) ? PSL_command (PSL, "\t%% Set this font\n") : PSL_command (PSL, "\n");
1503 	PSL->internal.font[font_no].encoded = 1;
1504 	return (PSL_NO_ERROR);
1505 }
1506 
1507 /*! . */
psl_getfont(struct PSL_CTRL * PSL,char * name)1508 static int psl_getfont (struct PSL_CTRL *PSL, char *name) {
1509 	int ret = 0;	/* Return Helvetica if we cannot figure it out */
1510 	char *c = NULL;
1511 	/* Return font number from strings like 33% or Helvetica-Bold% */
1512 	if (!name || !name[0] || name[0] == '%') return (-1);
1513 	if ((c = strchr (name, '%'))) c[0] = '\0';	/* Chop off trailing % */
1514 	if (isdigit ((unsigned char) name[0])) {	/* Starts with number */
1515 		if (!isdigit ((unsigned char) name[strlen(name)-1]))
1516 			ret = -1;	/* Starts with digit, ends with something else: cannot be */
1517 		else
1518 			ret = atoi (name);
1519 		if (ret < 0 || ret >= PSL->internal.N_FONTS) {
1520 			PSL_message (PSL, PSL_MSG_ERROR, "Error: font number %s outside the valid range - reset to 0\n", name);
1521 			ret = 0;
1522 		}
1523 	}
1524 	else {	/* Does not start with number. Try known font name */
1525 		int i;
1526 		char q, *m = NULL;
1527 		if ((m = strchr (name, 0255)))
1528 			q = m[0];
1529 		if (m) m[0] = '-';	/* Temporarily replace hyphen with minus */
1530 		for (i = 0; i < PSL->internal.N_FONTS && strcmp (name, PSL->internal.font[i].name); i++);
1531 		if (i < PSL->internal.N_FONTS)
1532 			ret = i;
1533 		else {
1534 			PSL_message (PSL, PSL_MSG_ERROR, "Error: font %s not recognized - reset to %s\n", name, PSL->internal.font[0].name);
1535 			ret = 0;
1536 		}
1537 		if (m) m[0] = q;	/* Restore hyphen */
1538 	}
1539 	if (c) c[0] = '%';	/* Restore trailing % */
1540 	return (ret);
1541 }
1542 
psl_prepare_text(struct PSL_CTRL * PSL,char * text)1543 char *psl_prepare_text (struct PSL_CTRL *PSL, char *text) {
1544 
1545 /*	Adds escapes for misc parenthesis, brackets etc.
1546 	Will also translate to some European characters such as the @a, @e
1547 	etc escape sequences. Calling function must REMEMBER to free memory
1548 	allocated by string */
1549 	const char *psl_scandcodes[16][5] = {	/* Short-hand conversion for some European characters in both Undefined [0], Standard [1], Standard+ [2], ISOLatin1 [3], and ISOLatin1+ [4] encoding */
1550 		{ "AA", "AA"   , "\\375", "\\305", "\\305"},	/* Aring */
1551 		{ "AE", "\\341", "\\341", "\\306", "\\306"},	/* AE */
1552 		{ "OE", "\\351", "\\351", "\\330", "\\330"},	/* Oslash */
1553 		{ "aa", "aa"   , "\\376", "\\345", "\\345"},	/* aring */
1554 		{ "ae", "\\361", "\\361", "\\346", "\\346"},	/* ae */
1555 		{ "oe", "\\371", "\\371", "\\370", "\\370"},	/* oslash */
1556 		{ "C" , "C"    , "\\201", "\\307", "\\307"},	/* Ccedilla */
1557 		{ "N" , "N"    , "\\204", "\\321", "\\321"},	/* Ntilde */
1558 		{ "U" , "UE"   , "\\335", "\\334", "\\334"},	/* Udieresis */
1559 		{ "c" , "c"    , "\\215", "\\347", "\\347"},	/* ccedilla */
1560 		{ "n" , "n"    , "\\227", "\\361", "\\361"},	/* ntilde */
1561 		{ "ss", "\\373", "\\373", "\\337", "\\337"},	/* germandbls */
1562 		{ "u" , "ue"   , "\\370", "\\374", "\\374"},	/* udieresis */
1563 		{ "i" , "i"    , "\\354", "\\355", "\\355"},	/* iaccute */
1564 		{ "@" , "\\100", "\\100", "\\100", "\\100"},	/* atsign */
1565 		{ "*" , "\\312", "\\217", "\\260", "\\260"}	/* degree */
1566 	};
1567 	char *string = NULL;
1568 	int i = 0, j = 0, font;
1569 	int he = 0;		/* PSL Historical Encoding (if any) */
1570 
1571 	if (!text) return NULL;
1572 
1573 	psl_encodefont (PSL, PSL->current.font_no);
1574 
1575 	if (strcmp ("Standard+", PSL->init.encoding) == 0)
1576 		he = 2;
1577 	else if (strcmp ("Standard", PSL->init.encoding) == 0)
1578 		he = 1;
1579 	else if (strcmp ("ISOLatin1+", PSL->init.encoding) == 0)
1580 		he = 4;
1581 	else if (strcmp ("ISOLatin1", PSL->init.encoding) == 0)
1582 		he = 3;
1583 
1584 	string = PSL_memory (PSL, NULL, 2 * PSL_BUFSIZ, char);
1585 	while (text[i]) {
1586 		if (he && text[i] == '@') {
1587 			i++;
1588 			switch (text[i]) {
1589 				case 'A':
1590 					strcat (string, psl_scandcodes[0][he]);
1591 					j += (int)strlen(psl_scandcodes[0][he]); i++;
1592 					break;
1593 				case 'E':
1594 					strcat (string, psl_scandcodes[1][he]);
1595 					j += (int)strlen(psl_scandcodes[1][he]); i++;
1596 					break;
1597 				case 'O':
1598 					strcat (string, psl_scandcodes[2][he]);
1599 					j += (int)strlen(psl_scandcodes[2][he]); i++;
1600 					break;
1601 				case 'a':
1602 					strcat (string, psl_scandcodes[3][he]);
1603 					j += (int)strlen(psl_scandcodes[3][he]); i++;
1604 					break;
1605 				case 'e':
1606 					strcat (string, psl_scandcodes[4][he]);
1607 					j += (int)strlen(psl_scandcodes[4][he]); i++;
1608 					break;
1609 				case 'o':
1610 					strcat (string, psl_scandcodes[5][he]);
1611 					j += (int)strlen(psl_scandcodes[5][he]); i++;
1612 					break;
1613 				case 'C':
1614 					strcat (string, psl_scandcodes[6][he]);
1615 					j += (int)strlen(psl_scandcodes[6][he]); i++;
1616 					break;
1617 				case 'N':
1618 					strcat (string, psl_scandcodes[7][he]);
1619 					j += (int)strlen(psl_scandcodes[7][he]); i++;
1620 					break;
1621 				case 'U':
1622 					strcat (string, psl_scandcodes[8][he]);
1623 					j += (int)strlen(psl_scandcodes[8][he]); i++;
1624 					break;
1625 				case 'c':
1626 					strcat (string, psl_scandcodes[9][he]);
1627 					j += (int)strlen(psl_scandcodes[9][he]); i++;
1628 					break;
1629 				case 'n':
1630 					strcat (string, psl_scandcodes[10][he]);
1631 					j += (int)strlen(psl_scandcodes[10][he]); i++;
1632 					break;
1633 				case 's':
1634 					strcat (string, psl_scandcodes[11][he]);
1635 					j += (int)strlen(psl_scandcodes[11][he]); i++;
1636 					break;
1637 				case 'u':
1638 					strcat (string, psl_scandcodes[12][he]);
1639 					j += (int)strlen(psl_scandcodes[12][he]); i++;
1640 					break;
1641 				case 'i':
1642 					strcat (string, psl_scandcodes[13][he]);
1643 					j += (int)strlen(psl_scandcodes[13][he]); i++;
1644 					break;
1645 				case '@':
1646 					strcat (string, psl_scandcodes[14][he]);
1647 					j += (int)strlen(psl_scandcodes[14][he]); i++;
1648 					break;
1649 				case '.':
1650 					strcat (string, psl_scandcodes[15][he]);
1651 					j += (int)strlen(psl_scandcodes[15][he]); i++;
1652 					break;
1653 				case '%':	/* Font switcher */
1654 					if ((font = psl_getfont (PSL, &text[i+1])) >= 0)
1655 						psl_encodefont (PSL, font);
1656 					string[j++] = '@';
1657 					string[j++] = text[i++];	/* Just copy over the rest */
1658 					while (text[i] != '%') string[j++] = text[i++];
1659 					break;
1660 				case '~':	/* Symbol font toggle */
1661 					psl_encodefont (PSL, PSL_SYMBOL_FONT);
1662 					/* Intentionally fall through - to place the text? */
1663 				default:
1664 					string[j++] = '@';
1665 					string[j++] = text[i++];
1666 					break;
1667 			}
1668 		}
1669 		else {
1670 			switch (text[i]) {    /* NEED TO BE ESCAPED!!!! for PostScript*/
1671 				case '{':
1672 				case '}':
1673 				case '[':
1674 				case ']':
1675 				case '(':
1676 				case ')':
1677 				case '<':
1678 				case '>':
1679 					if (j > 0 && string[MAX(j-1,0)] == '\\')	/* ALREADY ESCAPED... */
1680 						string[j++] = text[i++];
1681 					else {
1682 						strcat(string, "\\"); j++;
1683 						string[j++] = text[i++];
1684 					}
1685 					break;
1686 				default:
1687 					string[j++] = text[i++];
1688 					break;
1689 			}
1690 		}
1691 	}
1692 
1693 	psl_fix_utf8 (PSL, string);
1694 
1695 	return (string);
1696 }
1697 
psl_pattern_cleanup(struct PSL_CTRL * PSL)1698 static int psl_pattern_cleanup (struct PSL_CTRL *PSL) {
1699 	int image_no, k = 0;
1700 
1701 	for (image_no = 0; image_no < PSL_N_PATTERNS * 2; image_no++)
1702 		if (PSL->internal.pattern[image_no].status) k++;
1703 	if (k == 0) return (PSL_NO_ERROR);
1704 	PSL_comment (PSL, "Undefine patterns and images\n");
1705 	for (image_no = 0; image_no < PSL_N_PATTERNS * 2; image_no++) {
1706 		if (PSL->internal.pattern[image_no].status) {
1707 			PSL_command (PSL, "currentdict /image%d undef\n", image_no+1);
1708 			PSL_command (PSL, "currentdict /pattern%d undef\n", image_no+1);
1709 		}
1710 	}
1711 	return (PSL_NO_ERROR);
1712 }
1713 
psl_patch(struct PSL_CTRL * PSL,double * x,double * y,int np)1714 static int psl_patch (struct PSL_CTRL *PSL, double *x, double *y, int np) {
1715 	/* Like PSL_plotpolygon but intended for small polygons (< 20 points).  No checking for
1716 	 * shorter path by calling psl_shorten_path as in PSL_plotpolygon.
1717 	 */
1718 
1719 	int ix[20], iy[20], i, n, n1;
1720 
1721 	if (np > 20) return (PSL_plotpolygon (PSL, x, y, np));	/* Must call PSL_plotpolygon instead */
1722 
1723 	ix[0] = psl_ix (PSL, x[0]);	/* Convert inch to absolute pixel position for start of quadrilateral */
1724 	iy[0] = psl_iy (PSL, y[0]);
1725 
1726 	for (i = n = 1, n1 = 0; i < np; i++) {	/* Same but check if new point represent a different pixel */
1727 		ix[n] = psl_ix (PSL, x[i]);
1728 		iy[n] = psl_iy (PSL, y[i]);
1729 		if (ix[n] != ix[n1] || iy[n] != iy[n1]) n++, n1++;
1730 	}
1731 	if (ix[0] == ix[n1] && iy[0] == iy[n1]) n--, n1--;	/* Closepath will do this automatically */
1732 
1733 	if (n < 1) return (PSL_NO_POLYGON);	/* 0 points don't make a polygon */
1734 
1735 	n1 = --n;
1736 	for (i = n - 1; i >= 0; i--, n--) PSL_command (PSL, "%d %d ", ix[n] - ix[i], iy[n] - iy[i]);
1737 	PSL_command (PSL, "%d %d %d SP\n", n1, ix[0], iy[0]);
1738 	return (PSL_NO_ERROR);
1739 }
1740 
psl_getsharepath(struct PSL_CTRL * PSL,const char * subdir,const char * stem,const char * suffix,char * path)1741 static char *psl_getsharepath (struct PSL_CTRL *PSL, const char *subdir, const char *stem, const char *suffix, char *path) {
1742 	/* stem is the name of the file, e.g., PSL_custom_fonts.txt
1743 	 * subdir is an optional subdirectory name in the PSL->internal.SHAREDIR directory.
1744 	 * suffix is an optional suffix to append to name
1745 	 * path is the full path to the file in question
1746 	 * Returns the full pathname if a workable path was found
1747 	 * Looks for file stem in current directory, PSL->internal.USERDIR, and PSL->internal.SHAREDIR[/subdir]
1748 	 */
1749 
1750 	/* First look in the current working directory */
1751 
1752 	sprintf (path, "%s%s", stem, suffix);
1753 	if (!access (path, R_OK)) return (path);	/* Yes, found it in current directory */
1754 
1755 	/* Do not continue when full pathname is given */
1756 
1757 #ifdef WIN32
1758 	if (stem[0] == '\\' || stem[1] == ':') return (NULL);
1759 #else
1760 	if (stem[0] == '/') return (NULL);
1761 #endif
1762 
1763 	/* Not found, see if there is a file in the user's PSL->internal.USERDIR directory */
1764 
1765 	if (PSL->internal.USERDIR) {
1766 		sprintf (path, "%s/%s%s", PSL->internal.USERDIR, stem, suffix);
1767 		if (!access (path, R_OK)) return (path);
1768         	sprintf (path, "%s/cache/%s%s", PSL->internal.USERDIR, stem, suffix);
1769         	if (!access (path, R_OK)) return (path);
1770 	}
1771 
1772 	/* Try to get file from PSL->internal.SHAREDIR/subdir */
1773 
1774 	if (subdir) {
1775 		sprintf (path, "%s/%s/%s%s", PSL->internal.SHAREDIR, subdir, stem, suffix);
1776 		if (!access (path, R_OK)) return (path);
1777 	}
1778 
1779 	/* Finally try file in PSL->internal.SHAREDIR (for backward compatibility) */
1780 
1781 	sprintf (path, "%s/%s%s", PSL->internal.SHAREDIR, stem, suffix);
1782 	if (!access (path, R_OK)) return (path);
1783 
1784 	return (NULL);	/* No file found, give up */
1785 }
1786 
psl_place_encoding(struct PSL_CTRL * PSL,const char * encoding)1787 static int psl_place_encoding (struct PSL_CTRL *PSL, const char *encoding) {
1788 	/* Write the specified encoding string to file */
1789 	int k = 0, match = 0, err = 0;
1790 	while (PSL_ISO_name[k] && (match = strcmp (encoding, PSL_ISO_name[k])) != 0) k++;
1791 	if (match == 0)
1792 		PSL_command (PSL, "%s", PSL_ISO_encoding[k]);
1793 	else {
1794 		PSL_message (PSL, PSL_MSG_ERROR, "Fatal Error: Could not find ISO encoding %s\n", encoding);
1795 		err = -1;
1796 	}
1797 	return err;
1798 }
1799 
1800 /* psl_bulkcopy copies the given long static string (defined in PSL_strings.h)
1801  * to the postscript output verbatim or after stripping comments.
1802  */
1803 
1804 #include "PSL_strings.h"	/* Static char copies of the three former include files */
1805 
psl_bulkcopy(struct PSL_CTRL * PSL,const char * text)1806 static void psl_bulkcopy (struct PSL_CTRL *PSL, const char *text) {
1807 	char *buf = NULL, *string = NULL;
1808 	int i;
1809 
1810 	if (!strcmp (text, "PSL_label"))
1811 		string = strdup (PSL_label_str);
1812 	else if (!strcmp (text, "PSL_prologue"))
1813 		string = strdup (PSL_prologue_str);
1814 	else if (!strcmp (text, "PSL_text"))
1815 		string = strdup (PSL_text_str);
1816 
1817 	while ((buf = strsep (&string, "\n")) != NULL) {
1818 		if (PSL->internal.comments) {
1819 			/* We copy every line, including the comments, except those starting '%-' */
1820 			if (buf[0] == '%' && buf[1] == '-') continue;
1821 			PSL_command (PSL, "%s\n", buf);
1822 		}
1823 		else {
1824 			/* Here we remove the comments */
1825 			i = 0;
1826 			while (buf[i] && (buf[i] == ' ' || buf[i] == '\t' || buf[i] == '\n')) i++;	/* Find first non-blank character */
1827 			if (!buf[i]) continue;								/* Blank line, skip */
1828 			if (buf[i] == '%' && buf[i+1] != '%') continue;					/* Comment line, skip */
1829 			/* Output this line, but skip trailing comments (while watching for DSC %% comments) */
1830 			/* Find the end of important stuff on the line (i.e., look for start of trailing comments) */
1831 			for (i = 1; buf[i] && !(buf[i] == '%' && buf[i-1] != '%'); i++);
1832 			i--;										/* buf[i] is the last character to be output */
1833 			while (i && (buf[i] == ' ' || buf[i] == '\t' || buf[i] == '\n')) i--;		/* Remove white-space prior to the comment */
1834 			buf[++i] = '\0';			/* Add end-line character and print */
1835 			PSL_command (PSL, "%s\n", buf);
1836 		}
1837 	}
1838 	PSL_free (string);
1839 }
1840 
psl_add_word_part(struct PSL_CTRL * PSL,char * word,int length,int fontno,double fontsize,int sub,int super,int small,int under,int space,double rgb[])1841 static struct PSL_WORD *psl_add_word_part (struct PSL_CTRL *PSL, char *word, int length, int fontno, double fontsize, int sub, int super, int small, int under, int space, double rgb[]) {
1842 	/* For flag: bits 1 and 2 give number of spaces to follow (0, 1, or 2)
1843 	 * bit 3 == 1 [4]  means leading TAB
1844 	 * bit 4 == 1 [8]  means Composite 1 character
1845 	 * bit 5 == 1 [16] means Composite 2 character
1846 	 * bit 6 == 1 [32] means underline word
1847 	 * bit 7 == 1 [64] means Composite 2 character has a different font that Composite 1 character
1848 	 */
1849 
1850 	int i = 0;
1851 	int c;
1852 	int tab = false;
1853 	double fs;
1854 	struct PSL_WORD *new_word = NULL;
1855 
1856 	if (!length) length = (int)strlen (word);
1857 	while (word[i] && word[i] == '\t') {	/* Leading tab(s) means indent once */
1858 		tab = true;
1859 		i++;
1860 		length--;
1861 	}
1862 
1863 	new_word = PSL_memory (PSL, NULL, 1, struct PSL_WORD);
1864 	new_word->txt = PSL_memory (PSL, NULL, length+1, char);
1865 	fs = fontsize * PSL->internal.dpp;
1866 
1867 	strncpy (new_word->txt, &word[i], (size_t)length);
1868 	new_word->font_no = fontno;
1869 	if (small) {	/* Small caps is on */
1870 		new_word->fontsize = (int)lrint (PSL->current.scapssize * fs);
1871 		for (i = 0; new_word->txt[i]; i++) {
1872 			c = (int)new_word->txt[i];
1873 			new_word->txt[i] = (char) toupper (c);
1874 		}
1875 	}
1876 	else if (super) {
1877 		new_word->fontsize = (int)lrint (PSL->current.subsupsize * fs);
1878 		new_word->baseshift = (int)lrint (PSL->current.sup_up[PSL_LC] * fs);
1879 	}
1880 	else if (sub) {
1881 		new_word->fontsize = (int)lrint (PSL->current.subsupsize * fs);
1882 		new_word->baseshift = (int)lrint (-PSL->current.sub_down * fs);
1883 	}
1884 	else
1885 		new_word->fontsize = (int)lrint (fs);
1886 
1887 	new_word->flag = space;
1888 	if (tab) new_word->flag |= 4;	/* 3rd bit indicates tab, then add space after word */
1889 	if (under) new_word->flag |= 32;	/* 6rd bit indicates underline */
1890 	PSL_rgb_copy (new_word->rgb, rgb);
1891 
1892 	return (new_word);
1893 }
1894 
psl_freewords(struct PSL_WORD ** word,int n_words)1895 static void psl_freewords (struct PSL_WORD **word, int n_words) {
1896 	/* Free all the words and their texts */
1897 	int k;
1898 	for (k = 0; k < n_words; k++) {
1899 		PSL_free (word[k]->txt);
1900 		PSL_free (word[k]);
1901 	}
1902 }
1903 
psl_got_composite_fontswitch(struct PSL_CTRL * PSL,char * text)1904 void psl_got_composite_fontswitch (struct PSL_CTRL *PSL, char *text) {
1905 	/* If a composite character is made from two different fonts then we need to flag these.
1906 	 * E.g., Epsilon time-derivative = @!\277@~145@~ using current and Symbol font.
1907 	 * Here we need to switch to symbol font for one char, from whatever font we are using.
1908 	 * We look for such cases and count the occurrences, plus replace the font changing code
1909 	 * @ (either @~ or @%font% with ASCII escape (27)). */
1910 	size_t k;
1911 	int n = 0;
1912 	for (k = 0; k < strlen (text); k++) {
1913 		if (text[k] != '@') continue;
1914 		/* Start of an escape sequence */
1915 		k++;
1916 		if (text[k] != '!') continue;	/* Not a composite character request */
1917 		k++;	/* Step to start of character1 */
1918 		if (text[k] == '\\') k += 4; else k++;	/* Skip the octal or regular first character */
1919 		if (text[k] != '@') continue;	/* No font switching in the composite glyph */
1920 		/* Here we do have such a thing, and we need to avoid the regular string splitting at @ in PSL_plottext and PSL_deftextdim */
1921 		text[k] = PSL_ASCII_ES;	/* Replace @ with ASCII ESC code for now */
1922 		k++;	/* Font code type is ~ or % */
1923 		if (text[k] == '~')	/* Symbol font */
1924 			k++;	/* Step to character2 */
1925 		else {	/* Some random font switch */
1926 			k++;	/* Step past first % */
1927 			while (text[k] != '%') k++;	/* Skip past the font name or number */
1928 			k++;	/* Step to character2 */
1929 		}
1930 		if (text[k] == '\\') k += 4; else k++;	/* Skip the octal or regular second character */
1931 		if (text[k] != '@')	/* Not ideal, user error presumably */
1932 			PSL_message (PSL, PSL_MSG_WARNING, "Warning: psl_got_composite_fontswitch expected a font-change at end of composite character 2\n");
1933 		else	/* Get passed the font return code */
1934 			text[k] = PSL_ASCII_ES;	/* Skip to end of text section */
1935 		n++;	/* Found one of these cases */
1936 	}
1937 	if (n) PSL_message (PSL, PSL_MSG_DEBUG, "psl_got_composite_fontswitch found %d composite characters with different fonts/char sets\n", n);
1938 }
1939 
psl_paragraphprocess(struct PSL_CTRL * PSL,double y,double fontsize,char * paragraph)1940 static int psl_paragraphprocess (struct PSL_CTRL *PSL, double y, double fontsize, char *paragraph) {
1941 	/* Typeset one or more paragraphs.  Separate paragraphs by adding \r to end of last word in a paragraph.
1942 	 * This is a subfunction that simply place all the text attributes on the stack.
1943 	 */
1944 	int n, p, n_scan, last_k = -1, error = 0, old_font, font, font2, after, len, n_alloc_txt, F_flag;
1945 	int *font_unique = NULL;
1946 	unsigned int i, i1, i0, j, k, n_items, n_font_unique, n_rgb_unique;
1947 	size_t n_alloc, n_words = 0;
1948 	double old_size, last_rgb[4] = {0.0, 0.0, 0.0, 0.0}, rgb[4] = {0.0, 0.0, 0.0, 0.0};
1949 	int sub_on, super_on, scaps_on, symbol_on, font_on, size_on, color_on, under_on, plain_word = false, escape;
1950 	char *c = NULL, *clean = NULL, test_char, **text = NULL, *lastp = NULL, *copy = NULL;
1951 	const char *sep = " ";
1952 	struct PSL_WORD **word = NULL, **rgb_unique = NULL;
1953 
1954 	if (fontsize == 0.0) return (PSL_NO_ERROR);	/* Nothing to do if text has zero size */
1955 
1956 	sub_on = super_on = scaps_on = symbol_on = font_on = size_on = color_on = under_on = false;
1957 
1958 
1959 	/* Break input string into words (sorta based on old pstext) */
1960 	n_alloc = PSL_CHUNK;
1961 	text = (char **) PSL_memory (PSL, NULL, n_alloc, char *);
1962 	copy = strdup (paragraph);	/* Need copy since strtok_r will mess with the text */
1963 	psl_got_composite_fontswitch (PSL, copy);
1964 	c = strtok_r (copy, sep, &lastp);	/* Found first word */
1965 	while (c) {	/* Found another word */
1966 		text[n_words] = strdup (c);
1967 		len = (int)strlen(text[n_words]) - 1;
1968 		if (text[n_words][len] == '\r') {	/* New paragraph */
1969 			text[n_words][len] = '\0';	/* chop off CR */
1970 			n_words++;
1971 			if (n_words == n_alloc) {
1972 				n_alloc <<= 1;
1973 				text = (char **) PSL_memory (PSL, text, n_alloc, char *);
1974 			}
1975 			text[n_words] = strdup ("");	/* This adds an empty string */
1976 		}
1977 		n_words++;
1978 		if (n_words == n_alloc) {
1979 			n_alloc <<= 1;
1980 			text = (char **) PSL_memory (PSL, text, n_alloc, char *);
1981 		}
1982 		c = strtok_r (NULL, sep, &lastp);
1983 	}
1984 	text = (char **) PSL_memory (PSL, text, n_words, char *);
1985 	PSL_free (copy);
1986 
1987 	/* Now process the words into pieces we can typeset. */
1988 
1989 	n_alloc = PSL_CHUNK;
1990 	old_font = font = PSL->current.font_no;
1991 	old_size = fontsize;
1992 	PSL_rgb_copy (rgb, PSL->current.rgb[PSL_IS_FONT]);	/* Initial font color is current font color */
1993 
1994 	word = PSL_memory (PSL, NULL, n_alloc, struct PSL_WORD *);
1995 
1996 	for (i = k = 0; i < n_words; i++) {
1997 
1998 		clean = psl_prepare_text (PSL, text[i]);	/* Escape special characters and European character shorthands */
1999 
2000 		if ((c = strchr (clean, '@')) != NULL) {	/* Found a @ escape command */
2001 			i0 = 0;
2002 			i1 = (int) (c - clean);
2003 
2004 			if (i1 > i0)
2005 				word[k++] = psl_add_word_part (PSL, &clean[i0], i1 - i0, font, fontsize, sub_on, super_on, scaps_on, under_on, PSL_NO_SPACE, rgb);
2006 			if (k == n_alloc) {
2007 				n_alloc <<= 1;
2008 				word = PSL_memory (PSL, word, n_alloc, struct PSL_WORD *);
2009 			}
2010 
2011 			i1++;	/* Skip the @ */
2012 
2013 			while (clean[i1]) {
2014 
2015 				escape = (clean[i1-1] == '@');	/* i1 char is an escape argument */
2016 				test_char = (escape) ? clean[i1] : 'A';		/* Only use clean[i1] if it is an escape modifier */
2017 				plain_word = false;
2018 
2019 				switch (test_char) {
2020 
2021 					case '!':	/* 2 Composite characters */
2022 						i1++;
2023 						if (clean[i1] == '\\') { /* First char is Octal code character */
2024 							word[k++] = psl_add_word_part (PSL, &clean[i1], 4, font, fontsize, sub_on, super_on, scaps_on, under_on, PSL_COMPOSITE_1, rgb);
2025 							i1 += 4;
2026 						}
2027 						else {	/* Regular character */
2028 							word[k++] = psl_add_word_part (PSL, &clean[i1], 1, font, fontsize, sub_on, super_on, scaps_on, under_on, PSL_COMPOSITE_1, rgb);
2029 							i1++;
2030 						}
2031 						if (k == n_alloc) {
2032 							n_alloc <<= 1;
2033 							word = PSL_memory (PSL, word, n_alloc, struct PSL_WORD *);
2034 						}
2035 						/* Watch out for escaped font change before 2nd character */
2036 						if (clean[i1] == PSL_ASCII_ES) {	/* Have a font change on either side of 2nd character */
2037 							i1++;
2038 							if (clean[i1] == '~')	/* Toggle the symbol font */
2039 								font2 = PSL_SYMBOL_FONT;
2040 							else {	/* Font switching with @%font% ...@%% */
2041 								i1++;
2042 								font2 = psl_getfont (PSL, &clean[i1]);
2043 								while (clean[i1] != '%') i1++;
2044 							}
2045 							i1++;	/* Now at start of 2nd character */
2046 							F_flag = PSL_COMPOSITE_2 | PSL_COMPOSITE_2_FNT;
2047 						}
2048 						else {	/* No 2nd font */
2049 							font2 = font;
2050 							F_flag = PSL_COMPOSITE_2;
2051 						}
2052 
2053 						if (clean[i1] == '\\') { /* 2nd char is Octal code character */
2054 							word[k] = psl_add_word_part (PSL, &clean[i1], 4, font2, fontsize, sub_on, super_on, scaps_on, under_on, F_flag, rgb);
2055 							i1 += 4;
2056 						}
2057 						else {	/* Regular character */
2058 							word[k] = psl_add_word_part (PSL, &clean[i1], 1, font2, fontsize, sub_on, super_on, scaps_on, under_on, F_flag, rgb);
2059 							i1++;
2060 						}
2061 						if (font2 != font) {	/* Skip past the font switcher */
2062 							i1++;	/* Step over the implicit @ (ASCII 27) */
2063 							if (font2 == PSL_SYMBOL_FONT)
2064 								i1++;	/* Move past the ~ */
2065 							else
2066 								i1 += 2;	/* Move past the %% */
2067 						}
2068 						if (!clean[i1]) word[k]->flag++;	/* New word after this composite */
2069 						k++;
2070 						if (k == n_alloc) {
2071 							n_alloc <<= 1;
2072 							word = PSL_memory (PSL, word, n_alloc, struct PSL_WORD *);
2073 						}
2074 						break;
2075 
2076 					case '~':	/* Toggle symbol font */
2077 						i1++;
2078 						symbol_on = !symbol_on;
2079 						font = (font == PSL_SYMBOL_FONT) ? old_font : PSL_SYMBOL_FONT;
2080 						break;
2081 
2082 					case '%':	/* Switch font option */
2083 						i1++;
2084 						font_on = !font_on;
2085 						if (clean[i1] == '%') {
2086 							font = old_font;
2087 							i1++;
2088 						}
2089 						else {
2090 							old_font = font;
2091 							font = psl_getfont (PSL, &clean[i1]);
2092 							while (clean[i1] != '%') i1++;
2093 							i1++;
2094 						}
2095 						break;
2096 
2097 					case '_':	/* Toggle Underline */
2098 						i1++;
2099 						under_on = !under_on;
2100 						break;
2101 
2102 					case '-':	/* Toggle Subscript */
2103 						i1++;
2104 						sub_on = !sub_on;
2105 						break;
2106 
2107 					case '+':	/* Toggle Subscript */
2108 						i1++;
2109 						super_on = !super_on;
2110 						break;
2111 
2112 					case '#':	/* Toggle Small caps */
2113 						i1++;
2114 						scaps_on = !scaps_on;
2115 						break;
2116 
2117 					case ':':	/* Change font size */
2118 						i1++;
2119 						size_on = !size_on;
2120 						if (clean[i1] == ':') {
2121 							fontsize = old_size;
2122 							i1++;
2123 						}
2124 						else {
2125 							fontsize = atof (&clean[i1]);
2126 							while (clean[i1] != ':') i1++;
2127 							i1++;
2128 						}
2129 						break;
2130 
2131 					case ';':	/* Change font color */
2132 						i1++;
2133 						color_on = !color_on;
2134 						if (clean[i1] == ';') {
2135 							PSL_rgb_copy (rgb, last_rgb);
2136 							i1++;
2137 						}
2138 						else {
2139 							PSL_rgb_copy (last_rgb, rgb);
2140 							j = i1;
2141 							while (clean[j] != ';') j++;
2142 							clean[j] = 0;
2143 							n_scan = sscanf (&clean[i1], "%lg/%lg/%lg", &rgb[0], &rgb[1], &rgb[2]);
2144 							if (n_scan == 1) {	/* Got gray shade */
2145 								rgb[0] /= 255.0;	/* Normalize to 0-1 range */
2146 								rgb[1] = rgb[2] = rgb[0];
2147 								if (rgb[0] < 0.0 || rgb[0] > 1.0) error++;
2148 							}
2149 							else if (n_scan == 3) {	/* Got r/g/b */
2150 								for (p = 0; p < 3; p++) {
2151 									rgb[p] /= 255.0;	/* Normalize to 0-1 range */
2152 									if (rgb[p] < 0.0 || rgb[p] > 1.0) error++;
2153 								}
2154 							}
2155 							else	/* Got crap */
2156 								error++;
2157 
2158 							clean[j] = ';';
2159 							i1 = j + 1;
2160 						}
2161 						break;
2162 
2163 					default:	/* Regular text to copy */
2164 
2165 						j = i1;
2166 						while (clean[j] && clean[j] != '@') j++;
2167 						after = (clean[j]) ? PSL_NO_SPACE : 1;
2168 						plain_word = true;
2169 						word[k++] = psl_add_word_part (PSL, &clean[i1], j-i1, font, fontsize, sub_on, super_on, scaps_on, under_on, after, rgb);
2170 						if (k == n_alloc) {
2171 							n_alloc <<= 1;
2172 							word = PSL_memory (PSL, word, n_alloc, struct PSL_WORD *);
2173 						}
2174 						i1 = (clean[j]) ? j + 1 : j;
2175 						break;
2176 				}
2177 				while (clean[i1] == '@') i1++;	/* SKip @ character */
2178 
2179 			} /* End loop over word with @ in it */
2180 
2181 			if (!plain_word && (last_k = k - 1) >= 0) {	/* Allow space if text ends with @ commands only */
2182 				word[last_k]->flag &= 124;	/* Knock of anything unused */
2183 				word[last_k]->flag |= 1;
2184 			}
2185 		}
2186 		else {	/* Plain word, no worries */
2187 			word[k++] = psl_add_word_part (PSL, clean, 0, font, fontsize, sub_on, super_on, scaps_on, under_on, PSL_ONE_SPACE, rgb);
2188 			if (k == n_alloc) {
2189 				n_alloc <<= 1;
2190 				word = PSL_memory (PSL, word, n_alloc, struct PSL_WORD *);
2191 			}
2192 		}
2193 
2194 		PSL_free (clean);	/* Reclaim this memory */
2195 		PSL_free (text[i]);	/* Since strdup created it */
2196 
2197 	} /* End of word loop */
2198 
2199 	if (sub_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Sub-scripting not terminated [%s]\n", paragraph);
2200 	if (super_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Super-scripting not terminated [%s]\n", paragraph);
2201 	if (scaps_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Small-caps not terminated [%s]\n", paragraph);
2202 	if (symbol_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Symbol font change not terminated [%s]\n", paragraph);
2203 	if (size_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-size change not terminated [%s]\n", paragraph);
2204 	if (color_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-color change not terminated [%s]\n", paragraph);
2205 	if (under_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Text underline not terminated [%s]\n", paragraph);
2206 
2207 	PSL_free (text);	/* Reclaim this memory */
2208 	n_alloc_txt = k;	/* Number of items in word array that might have text allocations */
2209 	k--;			/* Index of last word */
2210 	while (k && !word[k]->txt) k--;	/* Skip any blank lines at end */
2211 	n_items = k + 1;
2212 
2213 	for (i0 = 0, i1 = 1 ; i1 < n_items-1; i1++, i0++) {	/* Loop for periods ending sentences and indicate 2 spaces to follow */
2214 		size_t len = strlen(word[i0]->txt);
2215 		if (len > 0 && isupper ((int)word[i1]->txt[0]) && word[i0]->txt[len-1] == '.') {
2216 			word[i0]->flag &= 60;	/* Sets bits 1 & 2 to zero */
2217 			word[i0]->flag |= 2;	/* Specify 2 spaces */
2218 		}
2219 		if (!word[i1]->txt[0]) {	/* No space at end of paragraph */
2220 			word[i0]->flag &= 60;
2221 			word[i1]->flag &= 60;
2222 		}
2223 	}
2224 	if (i1 >= n_items) i1 = n_items - 1;	/* one-word fix */
2225 	word[i1]->flag &= 60;	/* Last word not followed by anything */
2226 
2227 	/* Set each word's index of the corresponding unique color entry */
2228 
2229 	rgb_unique = PSL_memory (PSL, NULL, n_items, struct PSL_WORD *);
2230 	for (n_rgb_unique = i = 0; i < n_items; i++) {
2231 		for (j = 0; j < n_rgb_unique && !PSL_same_rgb(word[i]->rgb,rgb_unique[j]->rgb); j++) {}
2232 		if (j == n_rgb_unique) rgb_unique[n_rgb_unique++] = word[i];
2233 		word[i]->index = j;
2234 	}
2235 
2236 	/* Replace each word's font with the index of the corresponding unique font entry */
2237 
2238 	font_unique = PSL_memory (PSL, NULL, n_items, int);
2239 	for (n_font_unique = i = 0; i < n_items; i++) {
2240 		for (j = 0; j < n_font_unique && word[i]->font_no != font_unique[j]; j++) {}
2241 		if (j == n_font_unique) font_unique[n_font_unique++] = word[i]->font_no;
2242 		word[i]->font_no = j;
2243 	}
2244 
2245 	/* Time to write out to PS file */
2246 
2247 	/* Load PSL_text procedures from file for now */
2248 
2249 	if (!PSL->internal.text_init) {
2250 		psl_bulkcopy (PSL, "PSL_text");
2251 		PSL->internal.text_init = true;
2252 	}
2253 
2254 	PSL_comment (PSL, "PSL_plotparagraph begin:\n");
2255 
2256 	PSL_comment (PSL, "Define array of fonts:\n");
2257 	PSL_command (PSL, "/PSL_fontname\n");
2258 	for (i = 0 ; i < n_font_unique; i++) PSL_command (PSL, "/%s\n", PSL->internal.font[font_unique[i]].name);
2259 	PSL_command (PSL, "%d array astore def\n", n_font_unique);
2260 	PSL_free (font_unique);
2261 
2262 	PSL_comment (PSL, "Initialize variables:\n");
2263 	PSL_command (PSL, "/PSL_n %d def\n", n_items);
2264 	PSL_command (PSL, "/PSL_n1 %d def\n", n_items - 1);
2265 	PSL_defunits (PSL, "PSL_y0", y);
2266 	PSL_command (PSL, "/PSL_spaces [() ( ) (  ) ] def\n");
2267 	PSL_command (PSL, "/PSL_lastfn -1 def\n/PSL_lastfz -1 def\n/PSL_lastfc -1 def\n");
2268 	PSL_command (PSL, "/PSL_UL 0 def\n/PSL_show {ashow} def\n");
2269 
2270 	PSL_comment (PSL, "Define array of words:\n");
2271 	PSL_command (PSL, "/PSL_word");
2272 	for (i = n = 0 ; i < n_items; i++) {
2273 		PSL_command (PSL, "%c(%s)", (n) ? ' ' : '\n', word[i]->txt);
2274 		n += (int)strlen (word[i]->txt) + 1; if (n >= 60) n = 0;
2275 	}
2276 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2277 
2278 	PSL_comment (PSL, "Define array of word font numbers:\n");
2279 	PSL_command (PSL, "/PSL_fnt");
2280 	for (i = 0 ; i < n_items; i++) PSL_command (PSL, "%c%d", (i%25) ? ' ' : '\n', word[i]->font_no);
2281 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2282 
2283 	PSL_comment (PSL, "Define array of word fontsizes:\n");
2284 	PSL_command (PSL, "/PSL_size");
2285 	for (i = 0 ; i < n_items; i++) PSL_command (PSL, "%c%d", (i%15) ? ' ' : '\n', word[i]->fontsize);
2286 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2287 
2288 	PSL_comment (PSL, "Define array of word spaces to follow:\n");
2289 	PSL_command (PSL, "/PSL_flag");
2290 	for (i = 0 ; i < n_items; i++) PSL_command (PSL, "%c%d", (i%25) ? ' ' : '\n', word[i]->flag);
2291 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2292 
2293 	PSL_comment (PSL, "Define array of word baseline shifts:\n");
2294 	PSL_command (PSL, "/PSL_bshift");
2295 	for (i = 0 ; i < n_items; i++) PSL_command (PSL, "%c%d", (i%25) ? ' ' : '\n', word[i]->baseshift);
2296 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2297 
2298 	PSL_comment (PSL, "Define array of word colors indices:\n");
2299 	PSL_command (PSL, "/PSL_color");
2300 	for (i = 0 ; i < n_items; i++) PSL_command (PSL, "%c%d", (i%25) ? ' ' : '\n', word[i]->index);
2301 	PSL_command (PSL, "\n%d array astore def\n", n_items);
2302 
2303 	PSL_comment (PSL, "Define array of word colors:\n");
2304 	PSL_command (PSL, "/PSL_rgb\n");
2305 	for (i = 0 ; i < n_rgb_unique; i++) PSL_command (PSL, "%.3g %.3g %.3g\n", rgb_unique[i]->rgb[0], rgb_unique[i]->rgb[1], rgb_unique[i]->rgb[2]);
2306 	PSL_command (PSL, "%d array astore def\n", 3 * n_rgb_unique);
2307 	PSL_free (rgb_unique);
2308 
2309 	PSL_comment (PSL, "Define array of word widths:\n");
2310 	PSL_command (PSL, "/PSL_width %d array def\n", n_items);
2311 	PSL_command (PSL, "/PSL_max_word_width 0 def\n");
2312 	PSL_command (PSL, "0 1 PSL_n1 {");
2313 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Determine word width given the font and fontsize for each word\n" : "\n");
2314 	PSL_command (PSL, "  /i edef");
2315 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Loop index i\n" : "\n");
2316 	PSL_command (PSL, "  PSL_size i get PSL_fontname PSL_fnt i get get Y");
2317 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Get and set font and size\n" : "\n");
2318 	PSL_command (PSL, "  PSL_width i PSL_word i get stringwidth pop put");
2319 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Calculate and store width\n": "\n");
2320 	PSL_command (PSL, "  PSL_width i get PSL_max_word_width gt { /PSL_max_word_width PSL_width i get def} if");
2321 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Keep track of widest word\n": "\n");
2322 	PSL_command (PSL, "} for\n");
2323 	PSL_command (PSL, "PSL_max_word_width PSL_parwidth gt { /PSL_parwidth PSL_max_word_width def } if");
2324 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Auto-widen paragraph width if widest word exceeds it\n": "\n");
2325 
2326 	PSL_comment (PSL, "Define array of word char counts:\n");
2327 	PSL_command (PSL, "/PSL_count %d array def\n", n_items);
2328 	PSL_command (PSL, "0 1 PSL_n1 {PSL_count exch dup PSL_word exch get length put} for\n");
2329 
2330 	PSL_comment (PSL, "For composite chars, set width and count to zero for 2nd char:\n");
2331 	PSL_command (PSL, "1 1 PSL_n1 {\n  /k edef\n  PSL_flag k get 16 and 16 eq {\n");
2332 	PSL_command (PSL, "    /k1 k 1 sub def\n    /w1 PSL_width k1 get def\n    /w2 PSL_width k get def\n");
2333 	PSL_command (PSL, "    PSL_width k1 w1 w2 gt {w1} {w2} ifelse put\n    PSL_width k 0 put\n");
2334 	PSL_command (PSL, "    PSL_count k 0 put\n  } if\n} for\n");
2335 
2336 	psl_freewords (word, n_alloc_txt);
2337 	PSL_free (word);
2338 	return (sub_on|super_on|scaps_on|symbol_on|font_on|size_on|color_on|under_on);
2339 }
2340 
psl_get_origin(double xt,double yt,double xr,double yr,double r,double * xo,double * yo,double * b1,double * b2)2341 static void psl_get_origin (double xt, double yt, double xr, double yr, double r, double *xo, double *yo, double *b1, double *b2) {
2342  /* finds origin so that distance is r to the two points given */
2343 	double a0, b0, c0, A, B, C, q, sx1, sx2, sy1, sy2;
2344 
2345 	a0 = (xt - xr) / (yr - yt);
2346 	b0 = 0.5 * (xr*xr + yr*yr - xt*xt - yt*yt)/(yr - yt);
2347 	c0 = b0 - yt;
2348 	A = 1 + a0*a0;
2349 	B = 2*(c0*a0 - xt);
2350 	C = xt*xt - r*r + c0*c0;
2351 	q = sqrt (B*B - 4*A*C);
2352 	sx1 = 0.5* (-B + q)/A;
2353 	sx2 = 0.5* (-B - q)/A;
2354 	sy1 = b0 + a0 * sx1;
2355 	sy2 = b0 + a0 * sx2;
2356 
2357 	if (hypot (sx1, sy1) < r) {
2358 	    *xo = sx1;
2359 	    *yo = sy1;
2360 	}
2361 	else {
2362 	    *xo = sx2;
2363 	    *yo = sy2;
2364 	}
2365 	*b1 = R2D * atan2 (yr - *yo, xr - *xo);
2366 	*b2 = R2D * atan2 (yt - *yo, xt - *xo);
2367 }
2368 
psl_mathrightangle(struct PSL_CTRL * PSL,double x,double y,double param[])2369 static int psl_mathrightangle (struct PSL_CTRL *PSL, double x, double y, double param[]) {
2370 	/* Called from psl_matharc for the special case of right angle only; no heads involved */
2371 	double size, xx[3], yy[3];
2372 
2373 	PSL_comment (PSL, "Start of Math right angle\n");
2374 	PSL_command (PSL, "V %d %d T %.12g R\n", psl_ix (PSL, x), psl_iy (PSL, y), param[1]);
2375 	size = param[0] / M_SQRT2;
2376 
2377 	xx[0] = xx[1] = size;	xx[2] = 0.0;
2378 	yy[0] = 0.0;	yy[1] = yy[2] = size;
2379 	PSL_plotline (PSL, xx, yy, 3, PSL_MOVE|PSL_STROKE);
2380 	PSL_command (PSL, "U \n");
2381 	PSL_comment (PSL, "End of Math right angle\n");
2382 	return (PSL_NO_ERROR);
2383 }
2384 
psl_matharc(struct PSL_CTRL * PSL,double x,double y,double param[])2385 static int psl_matharc (struct PSL_CTRL *PSL, double x, double y, double param[]) {
2386 	/* psl_matharc draws a mathematical opening angle indicator with center at
2387 	 * (x,y), radius, and start,stop angles.  At the ends we may plot a vector
2388 	 * head that is composed of circular arcs. As a special case we can plot
2389 	 * the straight angle symbol when the angles subtend 90 degrees.
2390 	 *
2391 	 * param must hold up to 8 values:
2392 	 * param[PSL_MATHARC_RADIUS] = radius,
2393     * param[PSL_MATHARC_ANGLE_BEGIN] = begin angle1,
2394     * param[PSL_MATHARC_ANGLE_END] = end angle2,
2395 	 * param[PSL_MATHARC_HEAD_LENGTH] = headlength,
2396     * param[PSL_MATHARC_HEAD_WIDTH] = headwidth,
2397     * param[PSL_MATHARC_ARC_PENWIDTH] = penwidth(inch)
2398  	 * param[PSL_MATHARC_HEAD_SHAPE] = vector-shape (0-2),
2399     * param[PSL_MATHARC_STATUS] = status bit flags
2400 	 * param[PSL_MATHARC_HEAD_TYPE_BEGIN] = begin head type;
2401     * param[PSL_MATHARC_HEAD_TYPE_END] = end head type)
2402 	 * param[PSL_MATHARC_TRIM_BEGIN] = begin trim (degrees);
2403     * param[PSL_MATHARC_TRIM_END] = end trim (degrees)
2404 	 * param[PSL_MATHARC_HEAD_PENWIDTH] = head penwidth
2405 	 * add 4 to param[PSL_MATHARC_HEAD_SHAPE] if you want to use a straight angle
2406 	 * symbol if the opening is 90.  */
2407 
2408 	int i, side[2], heads, outline, fill, sign[2] = {+1, -1};
2409 	unsigned int status, kind[2];
2410 	double head_arc_length, head_half_width, arc_width, da, da_c, xt, yt, sa, ca, sb, cb, r, r2, xr, yr, xl, yl, xo, yo, shape, h_penwidth;
2411 	double angle[2], tangle[2], off[2], A, B, bo1, bo2, xi, yi, bi1, bi2, xv, yv, rshift[2] = {0.0, 0.0}, circ_r, xx[2], yy[2], trim[2];
2412 	char *line[2] = {"N", "P S"}, *dump[2] = {"", "fs"}, *end[2] = {"start", "end"};
2413 
2414 	status = (unsigned int)lrint (param[PSL_MATHARC_STATUS]);
2415 	if (status & PSL_VEC_MARC90 && fabs (90.0 - fabs (param[PSL_MATHARC_ANGLE_END]-param[PSL_MATHARC_ANGLE_BEGIN])) < 1.0e-8) {	/* Right angle */
2416 		return (psl_mathrightangle (PSL, x, y, param));
2417 	}
2418 	PSL_comment (PSL, "Start of Math arc\n");
2419 	/* Make any adjustments caused by trim */
2420 	trim[PSL_BEGIN] = (status & PSL_VEC_OFF_BEGIN) ? param[PSL_MATHARC_TRIM_BEGIN] : 0.0;
2421 	trim[PSL_END]   = (status & PSL_VEC_OFF_END)   ? param[PSL_MATHARC_TRIM_END]   : 0.0;
2422 	PSL_command (PSL, "V %d %d T\n", psl_ix (PSL, x), psl_iy (PSL, y));
2423 	kind[PSL_BEGIN] = (unsigned int)lrint (param[PSL_MATHARC_HEAD_TYPE_BEGIN]);
2424 	kind[PSL_END]   = (unsigned int)lrint (param[PSL_MATHARC_HEAD_TYPE_END]);
2425 	r = param[PSL_MATHARC_RADIUS];				  /* Radius of arc in inch */
2426 	angle[PSL_BEGIN] = param[PSL_MATHARC_ANGLE_BEGIN] + trim[PSL_BEGIN];
2427    angle[PSL_END]   = param[PSL_MATHARC_ANGLE_END] - trim[PSL_END]; /* Start/stop angles of arc, possibly adjusted */
2428 	head_arc_length  = param[PSL_MATHARC_HEAD_LENGTH];		  /* Head length in inch */
2429 	head_half_width  = 0.5 * param[PSL_MATHARC_HEAD_WIDTH];	  /* Head half-width in inch */
2430 	arc_width = param[PSL_MATHARC_ARC_PENWIDTH];			  /* Arc width in inch */
2431 	shape = param[PSL_MATHARC_HEAD_SHAPE];			  /* Vector head shape (0-1) */
2432 	h_penwidth = param[PSL_MATHARC_HEAD_PENWIDTH];
2433 	heads = PSL_vec_head (status);		  /* 1 = at beginning, 2 = at end, 3 = both */
2434 	outline = ((status & PSL_VEC_OUTLINE) > 0);
2435 	fill = ((status & PSL_VEC_FILL) > 0);
2436 	circ_r = sqrt (head_arc_length * head_half_width / M_PI);	/* Same area as vector head */
2437 
2438 	da = head_arc_length * 180.0 / (M_PI * r);	/* Angle corresponding to the arc length */
2439 	da_c = circ_r * 180.0 / (M_PI * r);	/* Angle corresponding to the circle length */
2440 
2441 	for (i = 0; i < 2; i++) {	/* Possibly shorten angular arc if arrow heads take up space */
2442 		side[i] = PSL_vec_side (status, i);		  /* -1 = left-only, +1 = right-only, 0 = normal head for this end */
2443 		tangle[i] = angle[i];	/* Angle if no head is present */
2444 		off[i] = (kind[i] == PSL_VEC_ARROW) ? sign[i]*da*(1.0-0.5*shape) : 0.0;		/* Arc length from tip to backstop */
2445 		if ((heads & (i+1)) && side[i] && kind[i] == PSL_VEC_CIRCLE) off[i] -= 0.5 * sign[i] * da_c;
2446 		if (heads & (i+1)) tangle[i] += off[i];	/* Change arc angle by headlength or half-circle arc */
2447 	}
2448 	side[PSL_BEGIN] = -side[PSL_BEGIN];	/* Because of it was initially implemented */
2449 	/* rshift kicks in when we want a half-arrow head.  In that case we don't want it to be
2450 	 * exactly half since the vector line will then stick out 1/2 line thickness.  So we adjust
2451 	 * for this half-thickness by adding/subtracting from the radius accordingly, using r2,
2452 	 * but only if the two heads agree. */
2453 	rshift[PSL_BEGIN] = 0.5 * side[PSL_BEGIN] * arc_width;
2454 	rshift[PSL_END]   = 0.5 * side[PSL_END]   * arc_width;
2455 
2456 	PSL_setlinewidth (PSL, arc_width * PSL_POINTS_PER_INCH);
2457 	PSL_plotarc (PSL, 0.0, 0.0, r, tangle[PSL_BEGIN], tangle[PSL_END], PSL_MOVE | PSL_STROKE);	/* Draw the (possibly shortened) arc */
2458 	if (status & PSL_VEC_MID_FWD) {	/* Want forward-pointing mid-point head instead of at end */
2459 		angle[PSL_END] = 0.5 * (angle[PSL_BEGIN] + angle[PSL_END]);	heads = 2;
2460 		if (kind[PSL_END] == PSL_VEC_ARROW) angle[PSL_END] += 0.5 * da;
2461 		tangle[PSL_END] = angle[PSL_END] + off[PSL_END];
2462 	}
2463 	else if (status & PSL_VEC_MID_BWD) {	/* Want backwards-pointing mid-point head instead of at beginning */
2464 		angle[PSL_BEGIN] = 0.5 * (angle[PSL_BEGIN] + angle[PSL_END]);		heads = 1;
2465 		if (kind[PSL_BEGIN] == PSL_VEC_ARROW) angle[PSL_BEGIN] -= 0.5 * da;
2466 		tangle[PSL_BEGIN] = angle[PSL_BEGIN] + off[PSL_BEGIN];
2467 	}
2468 	if (heads) {	/* Will draw at least one head */
2469 		PSL_setfill (PSL, PSL->current.rgb[PSL_IS_FILL], 1);	/* Set fill for head(s) */
2470 		PSL_command (PSL, "PSL_vecheadpen\n");	/* Switch to vector head pen */
2471 		psl_forcelinewidth (PSL, 2.0 * h_penwidth);	/* Force pen width update; double width due to clipping below */
2472 	}
2473 
2474 	for (i = 0; i < 2; i++) {	/* For both ends */
2475 		if ((heads & (i+1)) == 0) continue;	/* No arrow head at this angle */
2476 		PSL_comment (PSL, "Mathangle head at %s\n", end[i]);
2477 		A = D2R * angle[i];	sa = sin (A);	ca = cos (A);
2478 		r2 = r + sign[i] * rshift[i];
2479 		xt = r2 * ca;	yt = r2 * sa;	/* Tip coordinates */
2480 		switch (kind[i]) {
2481 			case PSL_VEC_ARROW:
2482 				B = D2R * (angle[i] + sign[i] * da);	sb = sin (B);	cb = cos (B);
2483 				PSL_command (PSL, "V\n");	/* Do this inside gsave/restore since we are clipping */
2484 				if (side[i] != +sign[i]) {	/* Need right side of arrow head */
2485 					xr = (r2 + head_half_width) * cb;	yr = (r2 + head_half_width) * sb;	/* Outer flank coordinates */
2486 					psl_get_origin (xt, yt, xr, yr, r2, &xo, &yo, &bo1, &bo2);
2487 					if (i == 0 && bo2 > bo1)
2488 						bo2 -= 360.0;
2489 					else if (i == 1 && bo1 > bo2)
2490 						bo1 -= 360.0;
2491 
2492 					PSL_plotarc (PSL, xo, yo, r2, bo2, bo1, PSL_MOVE);	/* Draw the arrow arc from tip to outside flank */
2493 					A = D2R * (tangle[i]);	sa = sin (A);	ca = cos (A);
2494 					xv = r2 * ca - xr;	yv = r2 * sa - yr;	/* Back point coordinates */
2495 					PSL_plotpoint (PSL, xv, yv, PSL_REL);		/* Connect to back point */
2496 				}
2497 				else {	/* Draw from tip to center back reduced by shape */
2498 					PSL_plotarc (PSL, 0.0, 0.0, r2, angle[i], tangle[i], PSL_MOVE);
2499 				}
2500 				if (side[i] != -sign[i]) {	/* Need left side of arrow head */
2501 					xl = (r2 - head_half_width) * cb;	yl = (r2 - head_half_width) * sb;	/* Inner flank coordinates */
2502 					psl_get_origin (xt, yt, xl, yl, r2, &xi, &yi, &bi1, &bi2);
2503 					if (i == 0 && bi1 < bi2)
2504 						bi1 += 360.0;
2505 					else if (i == 1 && bi1 > bi2)
2506 						bi1 -= 360.0;
2507 					PSL_plotarc (PSL, xi, yi, r2, bi1, bi2, PSL_DRAW);		/* Draw the arrow arc from tip to outside flank */
2508 				}
2509 				else {	/* Draw from center back reduced by shape to tip */
2510 					PSL_plotarc (PSL, 0.0, 0.0, r2, tangle[i], angle[i], PSL_DRAW);
2511 				}
2512 				PSL_command (PSL, "P clip %s %s U\n", dump[fill], line[outline]);
2513 				break;
2514 			case PSL_VEC_CIRCLE:
2515 				PSL_command (PSL, "V\n");	/* Do this inside gsave/restore since we are clipping */
2516 				if (side[i] == -1)	/* Need left side */
2517 					PSL_plotarc (PSL, xt, yt, circ_r, angle[i]+90.0, angle[i]+270.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2518 				else if (side[i] == +1)	/* Need right side */
2519 					PSL_plotarc (PSL, xt, yt, circ_r, angle[i]-90.0, angle[i]+90.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2520 				else
2521 					PSL_plotarc (PSL, xt, yt, circ_r, 0.0, 360.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2522 				PSL_command (PSL, "P clip %s %s U\n", dump[fill], line[outline]);
2523 				break;
2524 			case PSL_VEC_TERMINAL:
2525 				xt = r * ca;	yt = r * sa;	/* Tip coordinates */
2526 		 		xx[0] = xx[1] = xt;	yy[0] = yy[1] = yt;
2527 				if (side[i] == -1)	{	/* Need left side */
2528 				 	xx[0] = (r-head_half_width) * ca;	yy[0] = (r-head_half_width) * sa;
2529 				}
2530 				else if (side[i] == +1) {	/* Need right side */
2531 				 	xx[1] = (r+head_half_width) * ca;	yy[1] = (r+head_half_width) * sa;
2532 				}
2533 				else {
2534 				 	xx[0] = (r-head_half_width) * ca;	yy[0] = (r-head_half_width) * sa;
2535 				 	xx[1] = (r+head_half_width) * ca;	yy[1] = (r+head_half_width) * sa;
2536 				}
2537 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE|PSL_STROKE);	/* Set up path */
2538 				break;
2539 		}
2540 	}
2541 
2542 	PSL_command (PSL, "U \n");
2543 	PSL_comment (PSL, "End of Math arc\n");
2544 	return (PSL_NO_ERROR);
2545 }
2546 
psl_search_userimages(struct PSL_CTRL * PSL,char * imagefile)2547 static int psl_search_userimages (struct PSL_CTRL *PSL, char *imagefile) {
2548 	int i = 0;
2549 	if (imagefile == NULL) return -1;
2550 	while (i < PSL->internal.n_userimages) {
2551 		if (!strcmp (PSL->internal.user_image[i], imagefile))	/* Yes, found it */
2552 			return (i);
2553 		i++;	/* No, go to next */
2554 	}
2555 	return -1;	/* Not found */
2556 }
2557 
psl_pattern_init(struct PSL_CTRL * PSL,int image_no,char * imagefile,unsigned char * image,unsigned int width,unsigned int height,unsigned int depth)2558 static int psl_pattern_init (struct PSL_CTRL *PSL, int image_no, char *imagefile, unsigned char *image, unsigned int width, unsigned int height, unsigned int depth) {
2559 	int k, i;
2560 	unsigned char *picture = NULL;
2561 	/* image_no is 1-90 (PSL_N_PATTERNS) if a standard PSL pattern, else we examine imagefile.
2562 	 * User images are numbered PSL_N_PATTERNS+1,2,3 etc. */
2563 	k = image_no - 1;	/* Array index */
2564 	if ((image_no > 0 && image_no <= PSL_N_PATTERNS)) {	/* Premade pattern yet not used, assign settings */
2565 		if (PSL->internal.pattern[k].status) return (image_no);	/* Already initialized this pattern once, just return */
2566 		picture = PSL_pattern[k];
2567 	}
2568 	else {	/* User image, check to see if already used */
2569 		if (imagefile == NULL) {
2570 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Gave NULL as imagefile name\n");
2571 			return (-1);
2572 		}
2573 		i = psl_search_userimages (PSL, imagefile);	/* i = 0 is the first user image */
2574 		if (i >= 0) return (PSL_N_PATTERNS + i + 1);	/* Already registered, just return number */
2575 		if (PSL->internal.n_userimages > (PSL_N_PATTERNS-1)) {
2576 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Already maintaining %d user images and cannot accept any more\n", PSL->internal.n_userimages+1);
2577 			return (-1);
2578 		}
2579 		/* Must initialize a previously unused image */
2580 		PSL->internal.user_image[PSL->internal.n_userimages] = PSL_memory (PSL, NULL, strlen (imagefile)+1, char);
2581 		strcpy (PSL->internal.user_image[PSL->internal.n_userimages], imagefile);
2582 		PSL->internal.n_userimages++;
2583 		image_no = PSL_N_PATTERNS + PSL->internal.n_userimages;
2584 		k = image_no - 1;	/* Array index */
2585 		picture = image;
2586 	}
2587 
2588 	/* Store size, depth and bogus DPI setting */
2589 	PSL->internal.pattern[k].nx = width;
2590 	PSL->internal.pattern[k].ny = height;
2591 	PSL->internal.pattern[k].depth = depth;
2592 	PSL->internal.pattern[k].status = 1;
2593 	PSL->internal.pattern[k].dpi = -999;
2594 
2595 	PSL_comment (PSL, "Define pattern %d\n", image_no);
2596 
2597 	PSL_command (PSL, "/image%d {<~\n", image_no);
2598 	psl_stream_dump (PSL, picture, PSL->internal.pattern[k].nx, PSL->internal.pattern[k].ny, PSL->internal.pattern[k].depth, PSL->internal.compress, PSL_ASCII85, 2);
2599 	PSL_command (PSL, "} def\n");
2600 
2601 	return (image_no);
2602 }
2603 
2604 #ifdef PSL_WITH_GMT4_SUPPORT
2605 /* This code is included so we may offer backwards compatibility with GMT 4 old-school
2606  * polygon vectors.  It is not documented and should not be used by non-GMT developers.
2607  */
psl_vector_v4(struct PSL_CTRL * PSL,double x,double y,double param[],double rgb[],int outline)2608 void psl_vector_v4 (struct PSL_CTRL *PSL, double x, double y, double param[], double rgb[], int outline)
2609 {
2610 	/* Old GMT4 vector symbol:
2611 	 * param[PSL_VEC_XTIP] = xtip;
2612 	 * param[PSL_VEC_YTIP] = ytip;
2613 	 * param[PSL_VEC_TAIL_WIDTH] = tailwidth;
2614 	 * param[PSL_VEC_HEAD_LENGTH] = headlength;
2615 	 * param[PSL_VEC_HEAD_WIDTH] = headwidth;
2616 	 * param[PSL_VEC_HEAD_SHAPE] = headshape;
2617 	 * Will make sure that arrow has a finite width in PS coordinates */
2618 
2619 	double angle, xtail, ytail, xtip, ytip, tailwidth, headlength, headwidth, headshape;
2620 	int w2, length, hw, hl, hl2, hw2, l2;
2621 
2622 	xtail = x;	ytail = y;
2623    xtip = param[PSL_VEC_XTIP];
2624    ytip = param[PSL_VEC_YTIP];
2625 	length = psl_iz (PSL, hypot (xtail-xtip, ytail-ytip));	/* Vector length in PS units */
2626 	if (length == 0) return;	/* NULL vector */
2627 
2628 	tailwidth  = param[PSL_VEC_TAIL_WIDTH];
2629 	headlength = param[PSL_VEC_HEAD_LENGTH];
2630 	headwidth  = param[PSL_VEC_HEAD_WIDTH];
2631 	headshape  = param[PSL_VEC_HEAD_SHAPE];
2632 	if (outline & 8)
2633 		PSL_setfill (PSL, rgb, outline - 8);
2634 	else
2635 		PSL_setfill (PSL, rgb, outline);
2636 	angle = atan2 ((ytip-ytail),(xtip-xtail)) * R2D;			/* Angle vector makes with horizontal, in radians */
2637 	PSL_command (PSL, "V %d %d T ", psl_ix (PSL, xtail), psl_ix (PSL, ytail));	/* Temporarily set tail point the local origin (0, 0) */
2638 	if (angle != 0.0) PSL_command (PSL, "%.12g R ", angle);		/* Rotate so vector is horizontal in local coordinate system */
2639 	w2 = psl_ix (PSL, 0.5 * tailwidth);	if (w2 == 0) w2 = 1;	/* Half-width of vector tail */
2640 	hw = psl_ix (PSL, headwidth);	if (hw == 0) hw = 1;		/* Width of vector head */
2641 	hl = psl_ix (PSL, headlength);								/* Length of vector head */
2642 	hl2 = psl_ix (PSL, 0.5 * headshape * headlength);			/* Cut-in distance due to slanted back-side of arrow head */
2643 	hw2 = hw - w2;		/* Distance from tail side to head side (vertically) */
2644 	if (outline & 8) {	/* Double-headed vector */
2645 		l2 = length - 2 * hl + 2 * hl2;							/* Inside length between start of heads */
2646 		PSL_command (PSL, "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d Sv U\n",
2647 				hl2, hw2, -l2, hl2, -hw2, -hl, hw, hl, hw, -hl2, -hw2, l2, -hl2, hw2, hl, -hw);
2648 	}
2649 	else {			/* Single-headed vector */
2650 		l2 = length - hl + hl2;								/* Length from tail to start of slanted head */
2651 		PSL_command (PSL, "%d %d %d %d %d %d %d %d %d %d %d SV U\n",
2652 			-l2, hl2, -hw2, -hl, hw, hl, hw, -hl2, -hw2, l2, -w2);
2653 	}
2654 }
2655 #endif
2656 
2657 #define FIN_SLANT_COS	0.707106781187	/* I.e., 45 degrees slant */
2658 #define FIN_LENGTH_SCALE	0.66666667	/* 2/3 the length of the vector */
2659 #define FIN_HEIGHT_SCALE	0.5	/* 1/2 the width of the vector */
2660 
psl_vector(struct PSL_CTRL * PSL,double x,double y,double param[])2661 static int psl_vector (struct PSL_CTRL *PSL, double x, double y, double param[]) {
2662 	/* Will make sure that arrow has a finite width in PS coordinates.
2663 	 * param must hold up to 12 values:
2664 	 * param[PSL_VEC_XTIP] = xtip;
2665     * param[PSL_VEC_YTIP] = ytip;
2666 	 * param[PSL_VEC_TAIL_WIDTH] = tailwidth;
2667     * param[PSL_VEC_HEAD_LENGTH] = headlength;
2668     * param[PSL_VEC_HEAD_WIDTH] = headwidth;
2669 	 * param[5PSL_VEC_HEAD_SHAPE] = headshape;
2670     * param[PSL_VEC_STATUS] = status bit flags
2671 	 * param[PSL_VEC_HEAD_TYPE_BEGIN] = begin head type;
2672     * param[PSL_VEC_HEAD_TYPE_END] = end head type
2673 	 * param[PSL_VEC_TRIM_BEGIN] = begin trim value;
2674     * param[PSL_VEC_TRIM_END] = end trim value.
2675 	 * param[PSL_VEC_HEAD_PENWIDTH] = head penwidth
2676 	 */
2677 
2678 	double angle, xtip, ytip, r, s, tailwidth, headlength, headwidth, headshape, length_inch;
2679 	double xx[6], yy[6], xc[3], yc[3], off[2], yshift[2], trim[2], xp = 0.0, h_penwidth;
2680 	int length, asymmetry[2], n, heads, outline, fill, status;
2681 	unsigned int kind[2];
2682 	char *line[2] = {"N", "P S"}, *dump[2] = {"", "fs"};
2683 
2684 	xtip = param[PSL_VEC_XTIP];	ytip = param[PSL_VEC_YTIP];
2685 	length_inch = hypot (x-xtip, y-ytip);					/* Vector length in inches */
2686 	length = psl_iz (PSL, length_inch);					/* Vector length in PS units */
2687 	if (length == 0) return (PSL_NO_ERROR);					/* NULL vector */
2688 	angle = atan2 (ytip-y, xtip-x) * R2D;					/* Angle vector makes with horizontal, in degrees */
2689 	status = lrint (param[PSL_VEC_STATUS]);
2690 	h_penwidth = param[PSL_VEC_HEAD_PENWIDTH];
2691 	/* Make any adjustments caused by trim */
2692 	trim[PSL_BEGIN] = (status & PSL_VEC_OFF_BEGIN) ? param[PSL_VEC_TRIM_BEGIN] : 0.0;
2693 	trim[PSL_END]   = (status & PSL_VEC_OFF_END)   ? param[PSL_VEC_TRIM_END]   : 0.0;
2694 	if (fabs (angle) == 90.0) {	/* Vertical segment; only adjust y coordinates */
2695 		y += copysign (trim[PSL_BEGIN], angle);	ytip -= copysign (trim[PSL_END], angle);
2696 	}
2697 	else {	/* General case, use trig */
2698 		double s, c, a = angle * D2R;
2699 		s = sin (a);		c = cos (a);
2700 		x += c * trim[PSL_BEGIN];	y += s * trim[PSL_BEGIN];
2701 		xtip -= c * trim[PSL_END];	ytip -= s * trim[PSL_END];
2702 	}
2703 	length_inch = hypot (x-xtip, y-ytip);					/* Recalculate vector length in inches */
2704 	length = psl_iz (PSL, length_inch);					/* Vector length in PS units */
2705 	if (length == 0) return (PSL_NO_ERROR);					/* NULL vector */
2706 	tailwidth = param[PSL_VEC_TAIL_WIDTH];
2707 	headlength = param[PSL_VEC_HEAD_LENGTH];	headwidth = 0.5 * param[PSL_VEC_HEAD_WIDTH];	headshape = param[PSL_VEC_HEAD_SHAPE];
2708 	kind[PSL_BEGIN] = (unsigned int)lrint (param[PSL_VEC_HEAD_TYPE_BEGIN]);
2709 	kind[PSL_END]   = (unsigned int)lrint (param[PSL_VEC_HEAD_TYPE_END]);
2710 	off[PSL_BEGIN] = (kind[PSL_BEGIN] == PSL_VEC_ARROW) ? 0.5 * (2.0 - headshape) * headlength : 0.0;
2711 	off[PSL_END]   = (kind[PSL_END] == PSL_VEC_ARROW)   ? 0.5 * (2.0 - headshape) * headlength : 0.0;
2712 	if (kind[PSL_BEGIN] == PSL_VEC_ARROW_PLAIN) off[PSL_BEGIN] = 0.5 * tailwidth *  headlength / headwidth;
2713 	else if (kind[PSL_BEGIN] == PSL_VEC_TAIL) off[PSL_BEGIN] = FIN_SLANT_COS * headwidth + FIN_LENGTH_SCALE * headlength - tailwidth;
2714 	if (kind[PSL_END] == PSL_VEC_ARROW_PLAIN) off[PSL_END] = 0.5 * tailwidth *  headlength / headwidth;
2715 	else if (kind[PSL_END] == PSL_VEC_TAIL) off[PSL_END] = FIN_SLANT_COS * headwidth + FIN_LENGTH_SCALE * headlength - tailwidth;
2716 	heads = PSL_vec_head (status);		  /* 1 = at beginning, 2 = at end, 3 = both */
2717 	PSL_setlinewidth (PSL, tailwidth * PSL_POINTS_PER_INCH);	/* Inherits color from current pen */
2718 	outline = ((status & PSL_VEC_OUTLINE) > 0);
2719 	fill = ((status & PSL_VEC_FILL) > 0);
2720 	asymmetry[PSL_BEGIN] = -PSL_vec_side (status, 0);	/* -1 = left-only, +1 = right-only, 0 = normal head at beginning */
2721 	asymmetry[PSL_END]   = PSL_vec_side (status, 1);	/* -1 = left-only, +1 = right-only, 0 = normal head at beginning */
2722 	r = sqrt (headlength * headwidth / M_PI);	/* Same circle area as vector head */
2723 	s = sqrt (headlength * headwidth)/2;		/* Same square 	area as vector head */
2724 	PSL_comment (PSL, "Start of Cartesian vector\n");
2725 	PSL_command (PSL, "V %d %d T ", psl_ix (PSL, x), psl_iy (PSL, y));	/* Temporarily set tail point the local origin (0, 0) */
2726 	if (angle != 0.0) PSL_command (PSL, "%.12g R\n", angle);			/* Rotate so vector is horizontal in local coordinate system */
2727 	/* Make any adjustments caused by trim */
2728 	xx[0] = (heads & 1) ? off[PSL_BEGIN] : 0.0;
2729 	xx[1] = (heads & 2) ? length_inch - off[PSL_END] : length_inch;
2730 	if (heads & 1 && asymmetry[PSL_BEGIN] && kind[PSL_BEGIN] == PSL_VEC_CIRCLE) xx[0] = -r;
2731 	if (heads & 2 && asymmetry[PSL_END]   && kind[PSL_END]   == PSL_VEC_CIRCLE) xx[1] += r;
2732 	if (xx[1] > xx[0]) PSL_plotsegment (PSL, xx[0], 0.0, xx[1], 0.0);		/* Draw vector line body unless head length equals or exceeds total length */
2733 
2734 	if (status & PSL_VEC_MID_FWD) {	/* Want forward-pointing mid-point head instead of at end */
2735 		xp = -0.5 * length_inch;	heads = 2;
2736 		if (kind[PSL_END] == PSL_VEC_ARROW) xp += 0.5 * headlength;
2737 	}
2738 	else if (status & PSL_VEC_MID_BWD) {	/* Want backwards-pointing mid-point head instead of at beginning */
2739 		xp = 0.5 * length_inch;	heads = 1;
2740 		if (kind[PSL_BEGIN] == PSL_VEC_ARROW) xp -= 0.5 * headlength;
2741 	}
2742 	if (heads == 0) {	/* No heads requested */
2743 		PSL_command (PSL, "U\n");
2744 		PSL_comment (PSL, "End of Cartesian vector\n");
2745 		return (PSL_NO_ERROR);
2746 	}
2747 
2748 	/* Must switch asymmetry for start head since implemented backwards */
2749 	yshift[PSL_BEGIN] = 0.5 * asymmetry[PSL_BEGIN] * tailwidth;
2750 	yshift[PSL_END]   = 0.5 * asymmetry[PSL_END]   * tailwidth;
2751 
2752 	if (heads & 1) {	/* Need head at beginning, pointing backwards */
2753 		double f = (kind[PSL_BEGIN] == PSL_VEC_ARROW_PLAIN) ? 4.0 : 2.0;
2754 		PSL_comment (PSL, "Cartesian vector head at start\n");
2755 		PSL_command (PSL, "PSL_vecheadpen\n");		/* Switch to vector head pen */
2756 		psl_forcelinewidth (PSL, f * h_penwidth);	/* Force pen width update */
2757 		switch (kind[PSL_BEGIN]) {
2758 			case PSL_VEC_ARROW:
2759 				xx[0] = xp; yy[0] = -yshift[PSL_BEGIN];	n = 1;	/* Vector tip */
2760 				if (asymmetry[PSL_BEGIN] != +1) {	/* Need left side */
2761 					xx[n] = xp + headlength; yy[n++] = -headwidth;
2762 				}
2763 				if (asymmetry[PSL_BEGIN] || headshape != 0.0) {	/* Need center back of head */
2764 					xx[n] = xp + 0.5 * (2.0 - headshape) * headlength; yy[n++] = -yshift[PSL_BEGIN];
2765 				}
2766 				if (asymmetry[PSL_BEGIN] != -1) {	/* Need right side */
2767 					xx[n] = xp + headlength; yy[n++] = headwidth;
2768 				}
2769 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE);	/* Set up path */
2770 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2771 				break;
2772 			case PSL_VEC_ARROW_PLAIN:
2773 				/* Must set up clip path (xc,yc) to ensure tip is at end of vector, AND double
2774 				 * the pen thickness since half will be clipped. */
2775 				n = 0;
2776 				xc[0] = xp + headlength; yc[0] = -headwidth;
2777 				if (asymmetry[PSL_BEGIN] != +1) {	/* Need left side */
2778 					xx[n] = xp + headlength; yy[n++] = -headwidth;
2779 				}
2780 				xx[n] = xp; yy[n++] = -yshift[PSL_BEGIN];	/* Vector tip */
2781 				xc[1] = xp; yc[1] = -yshift[PSL_BEGIN];	/* Vector tip */
2782 				if (asymmetry[PSL_BEGIN] != -1) {	/* Need right side */
2783 					xx[n] = xp + headlength; yy[n++] = headwidth;
2784 				}
2785 				xc[2] = xp + headlength; yc[2] = headwidth;
2786 				PSL_command (PSL, "V "); /* Place under gsave/grestore since changing pen */
2787 				PSL_plotline (PSL, xc, yc, 3, PSL_MOVE);	/* Set up clip path */
2788 				PSL_command (PSL, "P clip N ");
2789 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE|PSL_STROKE);	/* Plot arrow head */
2790 				//PSL_setlinewidth (PSL, tailwidth * PSL_POINTS_PER_INCH);
2791 				PSL_command (PSL, "U\n");
2792 				break;
2793 			case PSL_VEC_TAIL:
2794 				xx[0] = xp + tailwidth + off[PSL_BEGIN]; yy[0] = -yshift[PSL_BEGIN];	n = 1;	/* Vector tip */
2795 				if (asymmetry[PSL_BEGIN] != +1) {	/* Need left side */
2796 					xx[n] = xp + tailwidth - FIN_SLANT_COS * headwidth + off[PSL_BEGIN]; yy[n++] = -FIN_HEIGHT_SCALE * headwidth;
2797 					xx[n] = xx[n-1] - FIN_LENGTH_SCALE * headlength; yy[n++] = -FIN_HEIGHT_SCALE * headwidth;
2798 				}
2799 				xx[n] = xp + tailwidth - FIN_LENGTH_SCALE * headlength + off[PSL_BEGIN]; yy[n++] = -yshift[PSL_BEGIN];
2800 				if (asymmetry[PSL_BEGIN] != -1) {	/* Need right side */
2801 					xx[n] = xp + tailwidth - FIN_SLANT_COS * headwidth - FIN_LENGTH_SCALE * headlength + off[PSL_BEGIN]; yy[n++] = FIN_HEIGHT_SCALE * headwidth;
2802 					xx[n] = xx[n-1] + FIN_LENGTH_SCALE * headlength; yy[n++] = FIN_HEIGHT_SCALE * headwidth;
2803 				}
2804 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE);	/* Set up path */
2805 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2806 				if (asymmetry[PSL_BEGIN] == 0) {	/* Draw feather center */
2807 					PSL_command (PSL, "V 0 W ");
2808 					xx[1] = xp + tailwidth - headlength + off[PSL_BEGIN]; yy[1] = -yshift[PSL_BEGIN];
2809 					PSL_plotsegment (PSL, xx[0], yy[0], xx[1], yy[1]);				/* Draw vector line body */
2810 					PSL_command (PSL, "U\n");
2811 				}
2812 				break;
2813 			case PSL_VEC_TAIL_PLAIN:
2814 				n = 0;
2815 				if (asymmetry[PSL_BEGIN] != +1) {	/* Need left side */
2816 					xx[n] = xp - headlength; yy[n++] = -headwidth;
2817 				}
2818 				xx[n] = xp; yy[n++] = -yshift[PSL_BEGIN];	/* Vector tip */
2819 				if (asymmetry[PSL_BEGIN] != -1) {	/* Need right side */
2820 					xx[n] = xp - headlength; yy[n++] = headwidth;
2821 				}
2822 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE|PSL_STROKE);	/* Set up path */
2823 				break;
2824 			case PSL_VEC_CIRCLE:
2825 				if (asymmetry[PSL_BEGIN] == -1)	/* Need left side */
2826 					PSL_plotarc (PSL, xp, 0.0, r, 0.0, 180.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2827 				else if (asymmetry[PSL_BEGIN] == +1)	/* Need right side */
2828 					PSL_plotarc (PSL, xp, 0.0, r, 180.0, 360.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2829 				else
2830 					PSL_plotarc (PSL, xp, 0.0, r, 0.0, 360.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2831 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2832 				break;
2833 			case PSL_VEC_SQUARE:
2834 				xx[0] = xx[3] = xp - s;	xx[1] = xx[2] = xp + s;
2835 				if (asymmetry[PSL_BEGIN] == -1)	{	/* Left side */
2836 					yy[0] = yy[1] = s;
2837 					yy[2] = yy[3] = 0.0;
2838 				}
2839 				else if (asymmetry[PSL_BEGIN] == +1) {	/* Right side */
2840 					yy[0] = yy[1] = 0.0;
2841 					yy[2] = yy[3] = -s;
2842 				}
2843 				else {
2844 					yy[0] = yy[1] = +s;
2845 					yy[2] = yy[3] = -s;
2846 				}
2847 				PSL_plotline (PSL, xx, yy, 4, PSL_MOVE);	/* Set up path */
2848 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2849 				break;
2850 			case PSL_VEC_TERMINAL:
2851 				xx[0] = xx[1] = xp;	yy[0] = yy[1] = 0.0;	/* Terminal line */
2852 				if (asymmetry[PSL_BEGIN] == -1)	/* Left side */
2853 					yy[1] = headwidth;
2854 				else if (asymmetry[PSL_BEGIN] == +1)	/* Right side */
2855 					yy[1] = -headwidth;
2856 				else {
2857 					yy[0] = -headwidth;
2858 					yy[1] = +headwidth;
2859 				}
2860 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE|PSL_STROKE);	/* Set up path */
2861 				break;
2862 		}
2863 	}
2864 	PSL_command (PSL, "U\n");
2865 	if (heads & 2) {	/* Need head at end, pointing forwards */
2866 		double f = (kind[PSL_END] == PSL_VEC_ARROW_PLAIN) ? 4.0 : 2.0;
2867 		PSL_comment (PSL, "Cartesian vector head at end\n");
2868 		PSL_command (PSL, "V %d %d T ", psl_ix (PSL, xtip), psl_iy (PSL, ytip));	/* Temporarily set head point the local origin (0, 0) */
2869 		if (angle != 0.0) PSL_command (PSL, "%.12g R\n", angle);			/* Rotate so vector is horizontal in local coordinate system */
2870 		PSL_command (PSL, "PSL_vecheadpen\n");		/* Switch to vector head pen */
2871 		psl_forcelinewidth (PSL, f * h_penwidth);	/* Force pen width update */
2872 		switch (kind[PSL_END]) {
2873 			case PSL_VEC_ARROW:
2874 				xx[0] = xp; yy[0] = yshift[PSL_END];	n = 1;	/* Vector tip */
2875 				if (asymmetry[PSL_END] != +1) {	/* Need left side */
2876 					xx[n] = xp - headlength; yy[n++] = headwidth;
2877 				}
2878 				if (asymmetry[PSL_END] || headshape != 0.0) {	/* Need center back of head */
2879 					xx[n] = xp -0.5 * (2.0 - headshape) * headlength; yy[n++] = yshift[PSL_END];
2880 				}
2881 				if (asymmetry[PSL_END] != -1) {	/* Need right side */
2882 					xx[n] = xp - headlength; yy[n++] = -headwidth;
2883 				}
2884 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE);	/* Set up path */
2885 				PSL_command (PSL, "P clip %s %s \n", dump[fill], line[outline]);
2886 				break;	/* Finalize, then reset outline parameter */
2887 			case PSL_VEC_ARROW_PLAIN:
2888 				n = 0;
2889 				xc[0] = xp - headlength; yc[0] = -headwidth;
2890 				if (asymmetry[PSL_END] != +1) {	/* Need left side */
2891 					xx[n] = xp - headlength; yy[n++] = -headwidth;
2892 				}
2893 				xx[n] = xp; yy[n++] = -yshift[PSL_END];	/* Vector tip */
2894 				xc[1] = xp; yc[1] = -yshift[PSL_END];	/* Vector tip */
2895 				if (asymmetry[PSL_END] != -1) {	/* Need right side */
2896 					xx[n] = xp - headlength; yy[n++] = headwidth;
2897 				}
2898 				xc[2] = xp - headlength; yc[2] = headwidth;
2899 				PSL_command (PSL, "V "); /* Place under gsave/grestore since changing pen */
2900 				PSL_plotline (PSL, xc, yc, 3, PSL_MOVE);	/* Set up clip path */
2901 				PSL_command (PSL, "P clip N ");
2902 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE|PSL_STROKE);	/* Plot arrow head */
2903 				//PSL_setlinewidth (PSL, tailwidth * PSL_POINTS_PER_INCH);
2904 				PSL_command (PSL, "U\n");
2905 				break;
2906 			case PSL_VEC_TAIL:
2907 				xx[0] = xp - tailwidth - off[PSL_END]; yy[0] = -yshift[PSL_END];	n = 1;	/* Vector tip */
2908 				if (asymmetry[PSL_END] != +1) {	/* Need left side */
2909 					xx[n] = xp - tailwidth + FIN_SLANT_COS * headwidth - off[PSL_END]; yy[n++] = -FIN_HEIGHT_SCALE * headwidth;
2910 					xx[n] = xx[n-1] + FIN_LENGTH_SCALE * headlength; yy[n++] = -FIN_HEIGHT_SCALE * headwidth;
2911 				}
2912 				xx[n] = xp - tailwidth + FIN_LENGTH_SCALE * headlength - off[PSL_END]; yy[n++] = -yshift[PSL_END];
2913 				if (asymmetry[PSL_END] != -1) {	/* Need right side */
2914 					xx[n] = xp - tailwidth + FIN_SLANT_COS * headwidth + FIN_LENGTH_SCALE * headlength - off[PSL_END]; yy[n++] = FIN_HEIGHT_SCALE * headwidth;
2915 					xx[n] = xx[n-1] - FIN_LENGTH_SCALE * headlength; yy[n++] = FIN_HEIGHT_SCALE * headwidth;
2916 				}
2917 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE);	/* Set up path */
2918 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2919 				if (asymmetry[PSL_END] == 0) {	/* Draw feather center */
2920 					PSL_command (PSL, "V 0 W ");
2921 					xx[1] = xp - tailwidth + headlength - off[PSL_END]; yy[1] = -yshift[PSL_END];
2922 					PSL_plotsegment (PSL, xx[0], yy[0], xx[1], yy[1]);				/* Draw vector line body */
2923 					PSL_command (PSL, "U\n");
2924 				}
2925 				break;
2926 			case PSL_VEC_TAIL_PLAIN:
2927 				n = 0;
2928 				if (asymmetry[PSL_END] != +1) {	/* Need left side */
2929 					xx[n] = xp + headlength; yy[n++] = -headwidth;
2930 				}
2931 				xx[n] = xp; yy[n++] = -yshift[PSL_END];	/* Vector tip */
2932 				if (asymmetry[PSL_END] != -1) {	/* Need right side */
2933 					xx[n] = xp + headlength; yy[n++] = headwidth;
2934 				}
2935 				PSL_plotline (PSL, xx, yy, n, PSL_MOVE|PSL_STROKE);	/* Set up path */
2936 				break;
2937 			case PSL_VEC_CIRCLE:
2938 				if (asymmetry[PSL_END] == -1)	/* Need left side */
2939 					PSL_plotarc (PSL, xp, 0.0, r, 0.0, 180.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2940 				else if (asymmetry[PSL_END] == +1)	/* Need right side */
2941 					PSL_plotarc (PSL, xp, 0.0, r, 180.0, 360.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2942 				else
2943 					PSL_plotarc (PSL, xp, 0.0, r, 0.0, 360.0, PSL_MOVE);	/* Draw the (possibly shortened) arc */
2944 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2945 				break;
2946 			case PSL_VEC_SQUARE:
2947 				xx[0] = xx[3] = xp - s;	xx[1] = xx[2] = xp + s;
2948 				if (asymmetry[PSL_END] == -1)	{	/* Left side */
2949 					yy[0] = yy[1] = s;
2950 					yy[2] = yy[3] = 0.0;
2951 				}
2952 				else if (asymmetry[PSL_END] == +1) {	/* Right side */
2953 					yy[0] = yy[1] = 0.0;
2954 					yy[2] = yy[3] = -s;
2955 				}
2956 				else {
2957 					yy[0] = yy[1] = +s;
2958 					yy[2] = yy[3] = -s;
2959 				}
2960 				PSL_plotline (PSL, xx, yy, 4, PSL_MOVE);	/* Set up path */
2961 				PSL_command (PSL, "P clip %s %s ", dump[fill], line[outline]);
2962 				break;
2963 			case PSL_VEC_TERMINAL:
2964 				xx[0] = xx[1] = xp;	yy[0] = yy[1] = 0.0;	/* Terminal line */
2965 				if (asymmetry[PSL_END] == -1)	/* Left side */
2966 					yy[1] = headwidth;
2967 				else if (asymmetry[PSL_END] == +1)	/* Right side */
2968 					yy[1] = -headwidth;
2969 				else {
2970 					yy[0] = -headwidth;
2971 					yy[1] = +headwidth;
2972 				}
2973 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE|PSL_STROKE);	/* Set up path */
2974 				break;
2975 		}
2976 		PSL_command (PSL, "U\n");
2977 	}
2978 	PSL_comment (PSL, "End of Cartesian vector\n");
2979 	return (PSL_NO_ERROR);
2980 }
2981 
psl_wedge(struct PSL_CTRL * PSL,double x,double y,double param[])2982 static int psl_wedge (struct PSL_CTRL *PSL, double x, double y, double param[]) {
2983 	/* Takes care of plotting a wedge.
2984 	 * param may hold up to 11 values; only 8 used here.
2985 	 * param[PSL_WEDGE_RADIUS_O] = radius;
2986 	 * param[PSL_WEDGE_ANGLE_BEGIN] = start angle;
2987     * param[PSL_WEDGE_ANGLE_END] = end angle;
2988 	 * param[PSL_WEDGE_STATUS] = status bit flags;
2989     * param[PSL_WEDGE_RADIUS_I] = inner_radius [0]
2990 	 * param[PSL_WEDGE_DR] = dr [0];
2991     * param[PSL_WEDGE_DA] = da [0]
2992 	 * param[PSL_WEDGE_ACTION] = do_fill (1) | do_outline (2)
2993 	 */
2994 
2995 	double xx[3], yy[3], sa, ca;
2996 	int status = lrint (param[PSL_WEDGE_STATUS]), flags = lrint (param[PSL_WEDGE_ACTION]);
2997 	bool windshield = (param[PSL_WEDGE_RADIUS_I] > 0.0);	/* Flag that we have an inner-tube */
2998 	bool fill = flags & 1, outline = flags & 2;
2999 
3000 	if (status == 0 && !windshield) {	/* Good old plain pie wedge */
3001 		PSL_command (PSL, "%d %.12g %.12g %d %d Sw\n", psl_iz (PSL, param[PSL_WEDGE_RADIUS_O]), param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], psl_ix (PSL, x), psl_iy (PSL, y));
3002 		return (PSL_NO_ERROR);
3003 	}
3004 	/* Somewhat more involved */
3005 	if (fill) {	/* Paint wedge given fill first but not outline (if desired) */
3006 		if (windshield)
3007 			PSL_command (PSL, "V %d %d T 0 0 %d %.12g %.12g arc 0 0 %d %.12g %.12g arcn P fs U\n", psl_ix (PSL, x), psl_iy (PSL, y),
3008 				psl_iz (PSL, param[PSL_WEDGE_RADIUS_O]), param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], psl_iz (PSL, param[PSL_WEDGE_RADIUS_I]), param[PSL_WEDGE_ANGLE_END], param[PSL_WEDGE_ANGLE_BEGIN]);
3009 		else
3010 			PSL_command (PSL, "%d %.12g %.12g %d %d 2 copy M 5 2 roll arc fs\n", psl_iz (PSL, param[PSL_WEDGE_RADIUS_O]), param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], psl_ix (PSL, x), psl_iy (PSL, y));
3011 	}
3012 	/* Next, if spiderweb is desired we need to set up a save/restore section and change the pen to PSL_spiderpen */
3013 	if (status) PSL_command (PSL, "V PSL_spiderpen\n");
3014 	if (status & 1) {	/* Draw one or more arcs */
3015 		if (param[PSL_WEDGE_DR] > 0.0) {	/* Array of arcs requested */
3016 			double r = (windshield) ? ceil (param[PSL_WEDGE_RADIUS_I] / param[PSL_WEDGE_DR]) * param[PSL_WEDGE_DR] : param[PSL_WEDGE_DR];	/* Either start at first arc inside windshield or the first zero-length arc of wedge */
3017 			while (r <= (param[PSL_WEDGE_RADIUS_O]+PSL_SMALL)) {
3018 				PSL_plotarc (PSL, x, y, r, param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], PSL_MOVE | PSL_STROKE);	/* Draw the arcs */
3019 				r += param[PSL_WEDGE_DR];	/* Go to next radial distance */
3020 			}
3021 		}
3022 		else {	/* Just draw outer and possibly inner arcs */
3023 			PSL_plotarc (PSL, x, y, param[PSL_WEDGE_RADIUS_O], param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], PSL_MOVE | PSL_STROKE);	/* Draw the outer arc */
3024 			if (windshield)	/* Draw the inner arc */
3025 				PSL_plotarc (PSL, x, y, param[PSL_WEDGE_RADIUS_I], param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], PSL_MOVE | PSL_STROKE);
3026 		}
3027 	}
3028 	if (status & 2) {	/* Draw one or more radial lines */
3029 		if (param[PSL_WEDGE_DA] > 0.0) {	/* Array of lines requested */
3030 			double a = ceil (param[PSL_WEDGE_ANGLE_BEGIN] / param[PSL_WEDGE_DA]) * param[PSL_WEDGE_DA];	/* First angle of desired multiple inside range */
3031 			while (a <= (param[PSL_WEDGE_ANGLE_END]+PSL_SMALL)) {
3032             sa = sin (D2R * a);   ca = cos (D2R * a);
3033 				xx[0] = x + param[PSL_WEDGE_RADIUS_I] * ca;	yy[0] = y + param[PSL_WEDGE_RADIUS_I] * sa;
3034 				xx[1] = x + param[PSL_WEDGE_RADIUS_O] * ca;	yy[1] = y + param[PSL_WEDGE_RADIUS_O] * sa;
3035 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE+PSL_STROKE);	/* Plot radial line */
3036 				a += param[PSL_WEDGE_DA];	/* Go to next angle */
3037 			}
3038 		}
3039 		else {	/* Just draw the start and stop radii */
3040 			if (windshield) {	/* These are two separate lines not connecting */
3041 				sa = sin (D2R * param[PSL_WEDGE_ANGLE_BEGIN]);   ca = cos (D2R * param[PSL_WEDGE_ANGLE_BEGIN]);
3042 				xx[0] = x + param[PSL_WEDGE_RADIUS_I] * ca;	yy[0] = y + param[PSL_WEDGE_RADIUS_I] * sa;
3043 				xx[1] = x + param[PSL_WEDGE_RADIUS_O] * ca;	yy[1] = y + param[PSL_WEDGE_RADIUS_O] * sa;
3044 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE+PSL_STROKE);	/* Plot jaw */
3045 				sa = sin (D2R * param[PSL_WEDGE_ANGLE_END]);   ca = cos (D2R * param[PSL_WEDGE_ANGLE_END]);
3046 				xx[0] = x + param[PSL_WEDGE_RADIUS_I] * ca;	yy[0] = y + param[PSL_WEDGE_RADIUS_I] * sa;
3047 				xx[1] = x + param[PSL_WEDGE_RADIUS_O] * ca;	yy[1] = y + param[PSL_WEDGE_RADIUS_O] * sa;
3048 				PSL_plotline (PSL, xx, yy, 2, PSL_MOVE+PSL_STROKE);	/* Plot jaw */
3049 			}
3050 			else {	/* Open triangular jaw */
3051 				xx[0] = x + param[PSL_WEDGE_RADIUS_O] * cos (D2R * param[PSL_WEDGE_ANGLE_BEGIN]);
3052 				yy[0] = y + param[PSL_WEDGE_RADIUS_O] * sin (D2R * param[PSL_WEDGE_ANGLE_BEGIN]);
3053 				xx[1] = x;				yy[1] = y;
3054 				xx[2] = x + param[PSL_WEDGE_RADIUS_O] * cos (D2R * param[PSL_WEDGE_ANGLE_END]);
3055 				yy[2] = y + param[PSL_WEDGE_RADIUS_O] * sin (D2R * param[PSL_WEDGE_ANGLE_END]);
3056 				PSL_plotline (PSL, xx, yy, 3, PSL_MOVE+PSL_STROKE);	/* Plot jaw */
3057 			}
3058 		}
3059 	}
3060 	if (status) PSL_command (PSL, "U\n");	/* Restore graphics state after messing with spiders */
3061 	if (outline) {	/* Draw wedge outline on top */
3062 		if (windshield)
3063 			PSL_command (PSL, "V %d %d T 0 0 %d %.12g %.12g arc 0 0 %d %.12g %.12g arcn P os U\n", psl_ix (PSL, x), psl_iy (PSL, y),
3064 				psl_iz (PSL, param[PSL_WEDGE_RADIUS_O]), param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], psl_iz (PSL, param[PSL_WEDGE_RADIUS_I]), param[PSL_WEDGE_ANGLE_END], param[PSL_WEDGE_ANGLE_BEGIN]);
3065 		else
3066 			PSL_command (PSL, "%d %.12g %.12g %d %d 2 copy M 5 2 roll arc os\n", psl_iz (PSL, param[PSL_WEDGE_RADIUS_O]), param[PSL_WEDGE_ANGLE_BEGIN], param[PSL_WEDGE_ANGLE_END], psl_ix (PSL, x), psl_iy (PSL, y));
3067 	}
3068 	return (PSL_NO_ERROR);
3069 }
3070 
psl_get_uppercase(char * new_c,char * old_c)3071 static void psl_get_uppercase (char *new_c, char *old_c) {
3072 	int i = 0, c;
3073 	while (old_c[i]) {
3074 	 	c = toupper ((int)old_c[i]);
3075 		new_c[i++] = (char)c;
3076 	}
3077 	new_c[i] = 0;
3078 }
3079 
psl_freeplot(struct PSL_CTRL * PSL)3080 static void psl_freeplot (struct PSL_CTRL *PSL) {
3081 	/* Simply eliminate any buffer for memory-writing PS */
3082 	if (PSL->internal.buffer) PSL_free (PSL->internal.buffer);	/* Remove any previous plot buffer */
3083 	PSL->internal.n_alloc = PSL->internal.n = 0;
3084 	PSL->internal.pmode = 0;
3085 }
3086 
3087 #if 0 /* Not used */
3088 static void psl_defunits_array (struct PSL_CTRL *PSL, const char *param, double *array, int n) {
3089 	/* These are used by PSL_plottextline */
3090 	int i;
3091 	PSL_command (PSL, "/%s\n", param);
3092 	for (i = 0; i < n; i++) PSL_command (PSL, "%.2f\n", array[i] * PSL->internal.dpu);
3093 	PSL_command (PSL, "%d array astore def\n", n);
3094 }
3095 #endif
3096 
psl_def_font_encoding(struct PSL_CTRL * PSL)3097 static void psl_def_font_encoding (struct PSL_CTRL *PSL) {
3098 	/* Initialize book-keeping for font encoding and write font macros */
3099 
3100 	int i;
3101 
3102 	/* Initialize T/F array for font reencoding so that we only do it once
3103 	 * for each font that is used */
3104 
3105 	PSL_command (PSL, "/PSL_font_encode ");
3106 	for (i = 0; i < PSL->internal.N_FONTS; i++) PSL_command (PSL, "0 ");
3107 	PSL_command (PSL, "%d array astore def", PSL->internal.N_FONTS);
3108 	(PSL->internal.comments) ? PSL_command (PSL, "\t%% Initially zero\n") : PSL_command (PSL, "\n");
3109 
3110 	/* Define font macros (see postscriptlight.h for details on how to add fonts) */
3111 
3112 	for (i = 0; i < PSL->internal.N_FONTS; i++) PSL_command (PSL, "/F%d {/%s Y}!\n", i, PSL->internal.font[i].name);
3113 }
3114 
psl_bitreduce(struct PSL_CTRL * PSL,unsigned char * buffer,int nx,int ny,size_t ncolors)3115 static int psl_bitreduce (struct PSL_CTRL *PSL, unsigned char *buffer, int nx, int ny, size_t ncolors) {
3116 	/* Reduce an 8-bit stream to 1-, 2- or 4-bit stream */
3117 	int in, out, i, j, nout, nbits;
3118 
3119 	/* Number of colors determines number of bits */
3120 	if (ncolors <= 2)
3121 		nbits = 1;
3122 	else if (ncolors <= 4)
3123 		nbits = 2;
3124 	else if (ncolors <= 16)
3125 		nbits = 4;
3126 	else
3127 		return (8);
3128 
3129 	/* "Compress" bytes line-by-line. The number of bits per line should be multiple of 8
3130 	   But when it isn't overflow is prevent by extra size allocation done in psl_makecolormap */
3131 	out = 0;
3132 	nx = abs (nx);
3133 	nout = (nx * nbits + 7) / 8;
3134 	for (j = 0; j < ny; j++) {
3135 		in = j * nx;
3136 		if (nbits == 1) {
3137 			for (i = 0; i < nout; i++) {
3138 				buffer[out++] = (buffer[in] << 7) + (buffer[in+1] << 6) + (buffer[in+2] << 5) + (buffer[in+3] << 4) + (buffer[in+4] << 3) + (buffer[in+5] << 2) + (buffer[in+6] << 1) + buffer[in+7];
3139 				in += 8;
3140 			}
3141 		}
3142 		else if (nbits == 2) {
3143 			for (i = 0; i < nout; i++) {
3144 				buffer[out++] = (buffer[in] << 6) + (buffer[in+1] << 4) + (buffer[in+2] << 2) + buffer[in+3];
3145 				in += 4;
3146 			}
3147 		}
3148 		else if (nbits == 4) {
3149 			for (i = 0; i < nout; i++) {
3150 				buffer[out++] = (buffer[in] << 4) + buffer[in+1];
3151 				in += 2;
3152 			}
3153 		}
3154 	}
3155 
3156 	PSL_message (PSL, PSL_MSG_INFORMATION, "Image depth reduced to %d bits\n", nbits);
3157 	return (nbits);
3158 }
3159 
psl_bitimage_cmap(struct PSL_CTRL * PSL,double f_rgb[],double b_rgb[])3160 static int psl_bitimage_cmap (struct PSL_CTRL *PSL, double f_rgb[], double b_rgb[]) {
3161 	/* Print colormap for 1-bit image or imagemask. Returns value of "polarity":
3162 	 * 0 = Paint 0 bits foreground color, leave 1 bits transparent
3163 	 * 1 = Paint 1 bits background color, leave 0 bits transparent
3164 	 * 2 = Paint 0 bits foreground color, paint 1 bits background color
3165 	 * ! Note that odd return values indicate that the bitmap has to be
3166 	 * ! inverted before plotting, either explicitly, or through a mapping
3167 	 * ! function in the PostScript image definition.
3168 	 */
3169 	int polarity;
3170 	double f_cmyk[4], b_cmyk[4];
3171 
3172 	PSL_command (PSL, " [/Indexed /Device");
3173 	if (b_rgb[0] < 0.0) {
3174 		/* Background is transparent */
3175 		polarity = 0;
3176 		if (PSL_is_gray (f_rgb))
3177 			PSL_command (PSL, "Gray 0 <%02X>", PSL_u255(f_rgb[0]));
3178 		else if (PSL->internal.color_mode == PSL_GRAY)
3179 			PSL_command (PSL, "Gray 0 <%02X>", PSL_u255(PSL_YIQ(f_rgb)));
3180 		else if (PSL->internal.color_mode == PSL_CMYK) {
3181 			psl_rgb_to_cmyk (f_rgb, f_cmyk);
3182 			PSL_command (PSL, "CMYK 0 <%02X%02X%02X%02X>", PSL_q255(f_cmyk));
3183 		}
3184 		else
3185 			PSL_command (PSL, "RGB 0 <%02X%02X%02X>", PSL_t255(f_rgb));
3186 	}
3187 	else if (f_rgb[0] < 0.0) {
3188 		/* Foreground is transparent */
3189 		polarity = 1;
3190 		if (PSL_is_gray (b_rgb))
3191 			PSL_command (PSL, "Gray 0 <%02X>", PSL_u255(b_rgb[0]));
3192 		else if (PSL->internal.color_mode == PSL_GRAY)
3193 			PSL_command (PSL, "Gray 0 <%02X>", PSL_u255(PSL_YIQ(b_rgb)));
3194 		else if (PSL->internal.color_mode == PSL_CMYK) {
3195 			psl_rgb_to_cmyk (b_rgb, b_cmyk);
3196 			PSL_command (PSL, "CMYK 0 <%02X%02X%02X%02X>", PSL_q255(b_cmyk));
3197 		}
3198 		else
3199 			PSL_command (PSL, "RGB 0 <%02X%02X%02X>", PSL_t255(b_rgb));
3200 	}
3201 	else {
3202 		/* Colored foreground and background */
3203 		polarity = 2;
3204 		if (PSL_is_gray (b_rgb) && PSL_is_gray (f_rgb))
3205 			PSL_command (PSL, "Gray 1 <%02X%02X>", PSL_u255(f_rgb[0]), PSL_u255(b_rgb[0]));
3206 		else if (PSL->internal.color_mode == PSL_GRAY)
3207 			PSL_command (PSL, "Gray 1 <%02X%02X>", PSL_u255(PSL_YIQ(f_rgb)), PSL_u255(PSL_YIQ(b_rgb)));
3208 		else if (PSL->internal.color_mode == PSL_CMYK) {
3209 			psl_rgb_to_cmyk (f_rgb, f_cmyk);
3210 			psl_rgb_to_cmyk (b_rgb, b_cmyk);
3211 			PSL_command (PSL, "CMYK 1 <%02X%02X%02X%02X%02X%02X%02X%02X>", PSL_q255(f_cmyk), PSL_q255(b_cmyk));
3212 		}
3213 		else
3214 			PSL_command (PSL, "RGB 1 <%02X%02X%02X%02X%02X%02X>", PSL_t255(f_rgb), PSL_t255(b_rgb));
3215 	}
3216 	PSL_command (PSL, "] setcolorspace");
3217 
3218 	return (polarity);
3219 }
3220 
3221 /* Make sure that all memory is freed upon return.
3222    This way is simpler than freeing buffer, red, green, blue, entry individually at every return
3223  */
3224 #define Return(code) {PSL_free (buffer); PSL_free (entry); PSL_free (red); PSL_free (green); PSL_free (blue); return (code);}
3225 
psl_get_boundingbox(struct PSL_CTRL * PSL,FILE * fp,int * llx,int * lly,int * trx,int * try,double * hires_llx,double * hires_lly,double * hires_trx,double * hires_try)3226 static int psl_get_boundingbox (struct PSL_CTRL *PSL, FILE *fp, int *llx, int *lly, int *trx, int *try,
3227 	double *hires_llx, double *hires_lly, double *hires_trx, double *hires_try) {
3228 
3229 	int nested = 0;
3230 	char buf[PSL_BUFSIZ];
3231 
3232 	/* Set default BoundingBox and HiResBoundingBox */
3233 
3234 	*hires_llx = *llx = 0; *hires_trx = *trx = 720; *hires_lly = *lly = 0; *hires_try = *try = 720;
3235 
3236 	/* Fish for the BoundingBox and the HiResBoundingBox. It assumes the line with HiResBoundingBox
3237 	   always follows the BoundingBox line. */
3238 
3239 	while (fgets(buf, PSL_BUFSIZ, fp) != NULL) {
3240 		if (!strncmp(buf, "%%Begin", 7U))
3241 			++nested;
3242 		else if (nested && !strncmp(buf, "%%End", 5U))
3243 			--nested;
3244 		else if (!nested) {
3245 			if  (!strncmp(buf, "%%BoundingBox:", 14U) && !strstr(buf, "(atend)")) {
3246 				if (sscanf(strchr(buf, ':') + 1, "%d %d %d %d", llx, lly, trx, try) < 4) return 1;
3247 				*hires_llx = *llx;
3248 				*hires_lly = *lly;
3249 				*hires_trx = *trx;
3250 				*hires_try = *try;
3251 				if (fgets(buf, PSL_BUFSIZ, fp) != NULL) {
3252 					if  (!strncmp(buf, "%%HiResBoundingBox:", 19U) && !strstr(buf, "(atend)")) {
3253 						if (sscanf(strchr(buf, ':') + 1, "%lg %lg %lg %lg", hires_llx, hires_lly, hires_trx, hires_try) < 4) return -1;
3254 					}
3255 				}
3256 				return 0;
3257 			}
3258 		}
3259 	}
3260 
3261 	PSL_message (PSL, PSL_MSG_WARNING, "Warning: No proper BoundingBox, defaults assumed: %d %d %d %d\n", *llx, *lly, *trx, *try);
3262 	return 1;
3263 }
3264 
psl_init_fonts(struct PSL_CTRL * PSL)3265 static int psl_init_fonts (struct PSL_CTRL *PSL) {
3266 	FILE *in = NULL;
3267 	int n_PSL_fonts;
3268 	unsigned int i = 0;
3269 	size_t n_alloc = 64;
3270 	char buf[PSL_BUFSIZ];
3271 	char fullname[PSL_BUFSIZ];
3272 
3273 	PSL->internal.font = PSL_memory (PSL, NULL, n_alloc, struct PSL_FONT);
3274 
3275 	/* Loads the available fonts for this installation */
3276 
3277 	/* First the standard 35 PostScript fonts from Adobe + 4 Japanese fonts */
3278 	memcpy (PSL->internal.font, PSL_standard_fonts, PSL_N_STANDARD_FONTS * sizeof (struct PSL_FONT));
3279 	PSL->internal.N_FONTS = n_PSL_fonts = i = PSL_N_STANDARD_FONTS;
3280 
3281 	/* Then any custom fonts */
3282 
3283 	if (psl_getsharepath (PSL, "postscriptlight", "PSL_custom_fonts", ".txt", fullname)) {
3284 		if ((in = fopen (fullname, "r")) == NULL) {	/* File exist but opening fails? WTF! */
3285 			PSL_message (PSL, PSL_MSG_ERROR, "Fatal Error: ");
3286 			perror (fullname);
3287 			return (EXIT_FAILURE);
3288 		}
3289 
3290 		while (fgets (buf, PSL_BUFSIZ, in)) {
3291 			if (buf[0] == '#' || buf[0] == '\n' || buf[0] == '\r') continue;
3292 			if (sscanf (buf, "%s %lf %d", fullname, &PSL->internal.font[i].height, &PSL->internal.font[i].encoded) != 3) {
3293 				PSL_message (PSL, PSL_MSG_ERROR, "Warning: Trouble decoding custom font info [%s].  Skipping this font\n", buf);
3294 				continue;
3295 			}
3296 			if (strlen (fullname) >= PSL_FONTNAME_LEN) {
3297 				PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font name %s exceeds %d characters and will be truncated\n", fullname, PSL_FONTNAME_LEN);
3298 				fullname[PSL_FONTNAME_LEN-1] = '\0';
3299 			}
3300 			strncpy (PSL->internal.font[i].name, fullname, PSL_FONTNAME_LEN);
3301 			i++;
3302 			if (i == n_alloc) {
3303 				n_alloc <<= 1;
3304 				PSL->internal.font = PSL_memory (PSL, PSL->internal.font, n_alloc, struct PSL_FONT);
3305 			}
3306 		}
3307 		fclose (in);
3308 		PSL->internal.N_FONTS = i;
3309 	}
3310 	else {
3311 		PSL_message (PSL, PSL_MSG_INFORMATION, "No PSL_custom_fonts.txt found\n");
3312 	}
3313 
3314 	/* Final allocation of font array */
3315 	PSL->internal.font = PSL_memory (PSL, PSL->internal.font, PSL->internal.N_FONTS, struct PSL_FONT);
3316 	return PSL_NO_ERROR;
3317 }
3318 
psl_putdash(struct PSL_CTRL * PSL,char * pattern,double offset)3319 static char *psl_putdash (struct PSL_CTRL *PSL, char *pattern, double offset) {
3320 	/* Writes the dash pattern */
3321 	static char text[PSL_BUFSIZ];
3322 	char mark = '[';
3323 	size_t len = 0;
3324 	if (pattern && pattern[0]) {
3325 		while (*pattern) {
3326 			sprintf (&text[len], "%c%d", mark, psl_ip (PSL, atof(pattern)));
3327 			while (*pattern && *pattern != ' ') pattern++;
3328 			while (*pattern && *pattern == ' ') pattern++;
3329 			mark = ' ';
3330 			len = strlen(text);
3331 		}
3332 		sprintf (&text[len], "] %d B", psl_ip (PSL, offset));
3333 	}
3334 	else
3335 		sprintf (text, "[] 0 B");	/* Reset to continuous line */
3336 	return (text);
3337 }
3338 
psl_computeBezierControlPoints(struct PSL_CTRL * PSL,double * K,int n,double ** P1,double ** P2)3339 static void psl_computeBezierControlPoints (struct PSL_CTRL *PSL, double *K, int n, double **P1, double **P2) {
3340 	/* Translated from https://www.particleincell.com/wp-content/uploads/2012/06/bezier-spline.js */
3341 	int i;
3342 	double *p1 = NULL, *p2 = NULL, *a = NULL, *b = NULL, *c = NULL, *r = NULL;
3343 	double m;
3344 	p1 = PSL_memory (PSL, NULL, n, double);
3345 	p2 = PSL_memory (PSL, NULL, n, double);
3346 	a = PSL_memory (PSL, NULL, n, double);
3347 	b = PSL_memory (PSL, NULL, n, double);
3348 	c = PSL_memory (PSL, NULL, n, double);
3349 	r = PSL_memory (PSL, NULL, n, double);
3350 
3351 	n--;	/* Now id of last knot */
3352 
3353 	/* left most segment*/
3354 	a[0] = 0.0;
3355 	b[0] = 2.0;
3356 	c[0] = 1.0;
3357 	r[0] = K[0] + 2.0 * K[1];
3358 
3359 	/* internal segments*/
3360 	for (i = 1; i < n - 1; i++)
3361 	{
3362 		a[i] = 1.0;
3363 		b[i] = 4.0;
3364 		c[i] = 1.0;
3365 		r[i] = 4.0 * K[i] + 2.0 * K[i+1];
3366 	}
3367 
3368 	/* right segment*/
3369 	a[n-1] = 2.0;
3370 	b[n-1] = 7.0;
3371 	c[n-1] = 0.0;
3372 	r[n-1] = 8.0 * K[n-1] + K[n];
3373 
3374 	/* solves Ax=b with the Thomas algorithm (from Wikipedia)*/
3375 	for (i = 1; i < n; i++)
3376 	{
3377 		m = a[i] / b[i-1];
3378 		b[i] = b[i] - m * c[i - 1];
3379 		r[i] = r[i] - m*r[i-1];
3380 	}
3381 
3382 	/* Evaluate p1 */
3383 	p1[n-1] = r[n-1] / b[n-1];
3384 	for (i = n - 2; i >= 0; --i)
3385 		p1[i] = (r[i] - c[i] * p1[i+1]) / b[i];
3386 
3387 	/* we have p1, now compute p2*/
3388 	for (i = 0; i < n-1; i++)
3389 		p2[i] = 2.0 * K[i+1] - p1[i+1];
3390 
3391 	p2[n-1] = 0.5 * (K[n] + p1[n-1]);
3392 
3393 	*P1 = p1;	*P2 = p2;
3394 	PSL_free (a);	PSL_free (b);	PSL_free (c);	PSL_free (r);
3395 }
3396 
psl_makecolormap(struct PSL_CTRL * PSL,unsigned char * buffer,int nx,int ny,int nbits)3397 static psl_indexed_image_t psl_makecolormap (struct PSL_CTRL *PSL, unsigned char *buffer, int nx, int ny, int nbits) {
3398 	/* When image consists of less than PSL_MAX_COLORS colors, the image can be
3399 	 * indexed to safe a significant amount of space.
3400 	 * The image and colormap are returned as a struct psl_indexed_image_t.
3401 	 *
3402 	 * It is important that the first RGB tuple is mapped to index 0.
3403 	 * This is used for color masked images.
3404 	 */
3405 	size_t i, j, npixels;	/* Need 64-bit ints to avoid overflow of int */
3406 	psl_colormap_t colormap;
3407 	psl_indexed_image_t image;
3408 
3409 	if (abs (nbits) != 24) return (NULL);		/* We only index into the RGB colorspace. */
3410 
3411 	npixels = ((size_t)abs (nx)) * ((size_t)ny);
3412 
3413 	colormap = psl_memory (PSL, NULL, 1U, sizeof (*colormap));
3414 	colormap->ncolors = 0;
3415 	image = psl_memory (PSL, NULL, 1U, sizeof (*image));
3416 	image->buffer = psl_memory (PSL, NULL, npixels+8, sizeof (*image->buffer));	/* Add 8 to avoid overflow access in psl_bitreduce() */
3417 	image->colormap = colormap;
3418 
3419 	if (nx < 0) {
3420 		/* Copy the colour mask value into index 0 */
3421 		colormap->colors[0][0] = buffer[0];
3422 		colormap->colors[0][1] = buffer[1];
3423 		colormap->colors[0][2] = buffer[2];
3424 		colormap->ncolors++;
3425 		buffer += 3;		/* Skip to start of image */
3426 	}
3427 
3428 	for (i = 0; i < npixels; i++) {
3429 		for (j = 0; j < colormap->ncolors; j++)
3430 			if (colormap->colors[j][0] == buffer[0] && colormap->colors[j][1] == buffer[1] && colormap->colors[j][2] == buffer[2]) {
3431 				image->buffer[i] = (unsigned char)j;
3432 				break;
3433 			}
3434 
3435 		if (j == colormap->ncolors) {
3436 			if (colormap->ncolors == PSL_MAX_COLORS) {	/* Too many colors to index. */
3437 				PSL_free (image->buffer);
3438 				PSL_free (image);
3439 				PSL_free (colormap);
3440 				PSL_message (PSL, PSL_MSG_INFORMATION, "Too many colors to make colormap - using 24-bit direct color instead.\n");
3441 				return (NULL);
3442 			}
3443 			image->buffer[i] = (unsigned char)j;
3444 			colormap->colors[j][0] = buffer[0];
3445 			colormap->colors[j][1] = buffer[1];
3446 			colormap->colors[j][2] = buffer[2];
3447 			colormap->ncolors++;
3448 		}
3449 		buffer += 3;
3450 	}
3451 
3452 	/* There's no need for a color map when the number of colors is the same as the number of pixels.
3453 	   Then you're better off with a compressed 24-bit color image instead. */
3454 	if (colormap->ncolors >= npixels)  {
3455 		PSL_free (image->buffer);
3456 		PSL_free (image);
3457 		PSL_free (colormap);
3458 		PSL_message (PSL, PSL_MSG_INFORMATION, "Use of colormap is inefficient - using 24-bit direct color instead.\n");
3459 		return (NULL);
3460 	}
3461 
3462 	PSL_message (PSL, PSL_MSG_INFORMATION, "Colormap of %" PRIuS " colors created\n", colormap->ncolors);
3463 	return (image);
3464 }
3465 
psl_putcolor(struct PSL_CTRL * PSL,double rgb[],int force)3466 static char *psl_putcolor (struct PSL_CTRL *PSL, double rgb[], int force) {
3467    /* Pass force = 1 when you want to reset transparency regardless of rgb[3] */
3468 	static char text[PSL_BUFSIZ];
3469 
3470 	if (PSL_eq (rgb[0], -1.0)) {
3471 		/* Ignore, no color set */
3472 		text[0] = '\0';
3473 	}
3474 	else if (PSL_eq (rgb[0], -3.0)) {
3475 		/* Pattern fill */
3476 		sprintf (text, "pattern%ld I", lrint(rgb[1]));
3477 	}
3478 	else if (PSL_is_gray (rgb)) {
3479 		/* Gray scale, since R==G==B */
3480 		sprintf (text, PSL->current.bw_format, rgb[0]);
3481 	}
3482 	else if (PSL->internal.color_mode == PSL_GRAY) {
3483 		/* Gray scale, forced by user */
3484 		sprintf (text, PSL->current.bw_format, PSL_YIQ(rgb));
3485 	}
3486 	else if (PSL->internal.color_mode == PSL_RGB) {
3487 		/* Full color, RGB mode */
3488 		sprintf (text, PSL->current.rgb_format, rgb[0], rgb[1], rgb[2]);
3489 	}
3490 	else if (PSL->internal.color_mode == PSL_CMYK) {
3491 		/* CMYK mode */
3492 		double cmyk[4];
3493 		psl_rgb_to_cmyk (rgb, cmyk);
3494 		sprintf (text, PSL->current.cmyk_format, cmyk[0], cmyk[1], cmyk[2], cmyk[3]);
3495 	}
3496 	else {
3497 		/* HSV mode */
3498 		double hsv[3];
3499 		psl_rgb_to_hsv (rgb, hsv);
3500 		sprintf (text, PSL->current.hsv_format, hsv[0], hsv[1], hsv[2]);
3501 	}
3502 	if (!PSL_eq (rgb[3], 0.0) || force) {
3503 		/* Transparency */
3504 		sprintf (&text[strlen(text)], " %.12g %.12g /%s PSL_transp", 1.0 - rgb[3], 1.0 - rgb[3], PSL->current.transparency_mode);
3505 	}
3506 	return (text);
3507 }
3508 
psl_putusername()3509 static const char *psl_putusername () {
3510 	const char *unknown = "unknown";
3511 #ifdef HAVE_GETPWUID
3512 #include <pwd.h>
3513 	struct passwd *pw = NULL;
3514 	pw = getpwuid (getuid ());
3515 	if (pw) return (pw->pw_name);
3516 #endif
3517 	return (unknown);
3518 }
3519 
3520 /*------------------- PUBLIC PSL API FUNCTIONS--------------------- */
3521 
New_PSL_Ctrl(char * session)3522 struct PSL_CTRL *New_PSL_Ctrl (char *session) {
3523 	struct PSL_CTRL *PSL = NULL;
3524 	unsigned int i;
3525 
3526 	/* Initialize the PSL structure */
3527 
3528 	PSL = calloc (1U, sizeof (struct PSL_CTRL));
3529 	if (session) PSL->init.session = strdup (session);
3530 	for (i = 0; i < 3; i++) PSL->init.page_rgb[i] = -1.0;		/* Not set */
3531 	/* Initialize a few global variables */
3532 	strcpy (PSL->current.bw_format, "%.3lg A");			/* Default format used for grayshade value */
3533 	strcpy (PSL->current.rgb_format, "%.3lg %.3lg %.3lg C");	/* Same, for RGB triplets */
3534 	strcpy (PSL->current.hsv_format, "%.3lg %.3lg %.3lg H");	/* Same, for HSV triplets */
3535 	strcpy (PSL->current.cmyk_format, "%.3lg %.3lg %.3lg %.3lg K");	/* Same, for CMYK quadruples */
3536 
3537 	return (PSL);
3538 }
3539 
PSL_beginsession(struct PSL_CTRL * PSL,unsigned int flags,char * sharedir,char * userdir)3540 int PSL_beginsession (struct PSL_CTRL *PSL, unsigned int flags, char *sharedir, char *userdir) {
3541 	/* Allocate a new common control structure and initialize PSL session
3542 	 * If sharedir, userdir are NULL and flags&1 == 1 then we look for environmental parameters
3543 	 * 		PSL_SHAREDIR and PSL_USERDIR; otherwise we assign then from the args (even if NULL).
3544 	 * If flags&2 == 2 then PSL is being called from an external interface so some things will live
3545 	 *	beyond the end of a module.
3546 	 */
3547 	unsigned int i, search;
3548 	char *this_c = NULL;
3549 
3550 	search = (flags & 1);	/* If 1 then we look for environmental parameters */
3551 	PSL->init.runmode = (flags & 2);	/* If 2 then we are being called from an environment where many modules can be called during a session */
3552 	/* Initialize the PSL structure to default values unless already set */
3553 
3554 	if (PSL->init.err == NULL) PSL->init.err = stderr;		/* Possible redirect of error messages */
3555 	if (PSL->init.unit < 0 || PSL->init.unit > 3) {
3556 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Measure unit %d is not in valid range (0-3)! Using 0 (cm)\n", PSL->init.unit);
3557 		PSL->init.unit = PSL_CM;
3558 	}
3559 	if (PSL->init.copies == 0) PSL->init.copies = 1;		/* Once copy of each plot */
3560 	if (PSL->init.magnify[0] == 0.0) PSL->init.magnify[0] = 1.0;	/* Default magnification global scales */
3561 	if (PSL->init.magnify[1] == 0.0) PSL->init.magnify[1] = 1.0;	/* Default magnification global scales */
3562 	if (PSL->init.page_rgb[0] < 0.0) for (i = 0; i < 3; i++) PSL->init.page_rgb[i] = 1.0;		/* Default paper color */
3563 
3564 	/* Determine SHAREDIR (directory containing the postscriptlight subdirectory)
3565 	 * but only if not passed via argument list */
3566 
3567 	if ((this_c = sharedir) == NULL && search) this_c = getenv ("PSL_SHAREDIR");
3568 	if (this_c) {	/* Did find a sharedir */
3569 		PSL->internal.SHAREDIR = strdup (this_c);
3570 		psl_dos_path_fix (PSL->internal.SHAREDIR);
3571 		if (access(PSL->internal.SHAREDIR, R_OK)) {
3572 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Could not access PSL_SHAREDIR %s.\n", PSL->internal.SHAREDIR);
3573 			return (EXIT_FAILURE);
3574 		}
3575 	}
3576 	else {	/* No sharedir found */
3577 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Could not locate PSL_SHAREDIR.\n");
3578 		return (EXIT_FAILURE);
3579 	}
3580 
3581 	/* Determine USERDIR (directory containing user replacements contents in SHAREDIR) */
3582 
3583 	if ((this_c = userdir) == NULL && search) this_c = getenv ("PSL_USERDIR");
3584 	if (this_c) {	/* Did find a userdir */
3585 		PSL->internal.USERDIR = strdup (this_c);
3586 		psl_dos_path_fix (PSL->internal.USERDIR);
3587 		if (access (PSL->internal.USERDIR, R_OK)) {
3588 			PSL_message (PSL, PSL_MSG_ERROR, "Warning: Could not access PSL_USERDIR %s.\n", PSL->internal.USERDIR);
3589 			PSL_free (PSL->internal.USERDIR);
3590 		}
3591 	}
3592 
3593 	if (!PSL->init.encoding) PSL->init.encoding = strdup ("Standard");		/* Character encoding to use */
3594 	return (psl_init_fonts (PSL));								/* Load the available font information */
3595 }
3596 
PSL_endsession(struct PSL_CTRL * PSL)3597 int PSL_endsession (struct PSL_CTRL *PSL) {
3598 	/* Free up memory used by the PSL control structure */
3599 	int i;
3600 	if (!PSL) return (PSL_NO_SESSION);	/* Never was allocated */
3601 
3602 	psl_freeplot (PSL);
3603 	PSL_free (PSL->internal.font);
3604 	for (i = 0; i < PSL->internal.n_userimages; i++) PSL_free (PSL->internal.user_image[i]);
3605 	PSL_free (PSL->internal.SHAREDIR);
3606 	PSL_free (PSL->internal.USERDIR);
3607 	PSL_free (PSL->init.encoding);
3608 	PSL_free (PSL->init.session);
3609 	PSL_free (PSL);
3610 	return (PSL_NO_ERROR);
3611 }
3612 
PSL_beginlayer(struct PSL_CTRL * PSL,int layer)3613 int PSL_beginlayer (struct PSL_CTRL *PSL, int layer) {
3614  	/* Issue begin group command */
3615 	PSL_command (PSL, "%%%%BeginObject PSL_Layer_%d\n", layer);
3616 	return (PSL_NO_ERROR);
3617 }
3618 
PSL_endlayer(struct PSL_CTRL * PSL)3619 int PSL_endlayer (struct PSL_CTRL *PSL) {
3620 	/* Issue end group command */
3621 	PSL_command (PSL, "%%%%EndObject\n");
3622 	return (PSL_NO_ERROR);
3623 }
3624 
PSL_copy(struct PSL_CTRL * PSL,const char * txt)3625 int PSL_copy (struct PSL_CTRL *PSL, const char *txt) {
3626 	/* Just copies the given text as is to the PSL output stream or buffer */
3627 	if (PSL->internal.memory) {
3628 		size_t len = strlen (txt);
3629 		psl_prepare_buffer (PSL, len); /* Make sure we have enough memory to hold the text */
3630 		strncat (&(PSL->internal.buffer[PSL->internal.n]), txt, len);
3631 		PSL->internal.n += len;
3632 	}
3633 	else	/* Just write to the PS file */
3634 		fprintf (PSL->internal.fp, "%s\n", txt);
3635 	return (PSL_NO_ERROR);
3636 }
3637 
PSL_plotarc(struct PSL_CTRL * PSL,double x,double y,double radius,double az1,double az2,int type)3638 int PSL_plotarc (struct PSL_CTRL *PSL, double x, double y, double radius, double az1, double az2, int type) {
3639 	/* Plot an arc with radius running in azimuth from az1 to az2.
3640 	 * Type is a combination of the following:
3641 	 * PSL_DRAW   (0) : Draw a line segment
3642 	 * PSL_MOVE   (1) : Move to the new anchor point (x,y) first
3643 	 * PSL_STROKE (2) : Stroke the line
3644 	 */
3645 	int ir;
3646 
3647 	if (fabs (az1 - az2) > 360.0) return (PSL_BAD_RANGE);
3648 	if (radius < 0.0) return (PSL_BAD_SIZE);
3649 	ir = psl_iz (PSL, radius);
3650 	if (type & PSL_MOVE) PSL_command (PSL, "N ");
3651 	PSL_command (PSL, "%d %d %d %.12g %.12g arc", psl_ix(PSL, x), psl_iy(PSL, y), ir, az1, az2);
3652 	if (az1 > az2) PSL_command(PSL, "n");
3653 	PSL_command (PSL, (type & PSL_STROKE) ? " S\n" : "\n");
3654 	return (PSL_NO_ERROR);
3655 }
3656 
PSL_plotaxis(struct PSL_CTRL * PSL,double annotation_int,char * label,double annotfontsize,int side)3657 int PSL_plotaxis (struct PSL_CTRL *PSL, double annotation_int, char *label, double annotfontsize, int side) {
3658 	/* Expects PSL_beginaxes to have been called first */
3659 	int annot_justify, label_justify, i, j, ndig = 0, k, reverse = false;
3660 	double angle, dy, scl, val, annot_off, label_off, xx, sign, x, y, length, val0, val1;
3661 	char text[PSL_BUFSIZ], format[PSL_BUFSIZ];
3662 
3663 	k = 2 * (side % 2);	/* Start index for x [0] or y [2] in axis_limit */
3664 	/* Get position and limit values from PSL_beginaxes settings */
3665 	x = PSL->internal.axis_pos[0];	y = PSL->internal.axis_pos[1];
3666 	val0 = MIN(PSL->internal.axis_limit[k], PSL->internal.axis_limit[k+1]);
3667 	val1 = MAX(PSL->internal.axis_limit[k], PSL->internal.axis_limit[k+1]);
3668 	if ((val1 - val0) == 0.0) {
3669 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Axis val0 == val1!\n");
3670 		return (PSL_BAD_RANGE);
3671 	}
3672 	reverse = (PSL->internal.axis_limit[k] > PSL->internal.axis_limit[k+1]);
3673 
3674 	sprintf (text, "%g", annotation_int);	/* Try to compute a useful format */
3675 	for (i = 0; text[i] && text[i] != '.'; i++);
3676 	if (text[i]) {	/* Found a decimal point */
3677 		for (j = i + 1; text[j]; j++);
3678 		ndig = j - i - 1;
3679 	}
3680 	if (ndig > 0)
3681 		sprintf (format, "%%.%df", ndig);
3682 	else
3683 		strcpy (format, "%g");
3684 
3685 	if (side == 1) x += PSL->internal.axis_dim[0];	/* Right y-axis */
3686 	if (side == 2) y += PSL->internal.axis_dim[1];	/* Top x-axis */
3687 	length = PSL->internal.axis_dim[side%2];	/* Length of this axis */
3688 	angle = (side%2) ? 90.0 : 0.0;			/* May have to rotate 90 degrees */
3689 	sign = (side < 2) ? -1.0 : 1.0;			/* Which side of axis to annotate/tick */
3690 	annot_justify = label_justify = (side < 2) ? -10 : -2;	/* And how to justify */
3691 	dy = sign * annotfontsize * PSL->internal.p2u;	/* Font size in user units */
3692 
3693 	PSL_command (PSL, "\nV %d %d T %.12g R\n", psl_iz (PSL, x), psl_iz (PSL, y), angle);
3694 	PSL_command (PSL, "N 0 0 M %d 0 D S\n", psl_iz (PSL, length));
3695 	scl = length / (val1 - val0);
3696 	annot_off = dy;
3697 	label_off = 2.5 * dy;	/* Label offset is 250% of annotation font size */
3698 	dy *= 0.5;
3699 
3700 	val = ceil (val0 / annotation_int) * annotation_int;	/* Start at multiple of annotation interval */
3701 	while (val <= (val1+PSL_SMALL)) {
3702 		xx = (val - val0) * scl;
3703 		if (reverse) xx = length - xx;
3704 		PSL_command (PSL, "%d 0 M 0 %d D S\n", psl_iz (PSL, xx), psl_iz (PSL, dy));
3705 		PSL_command (PSL, "%d %d M ", psl_iz (PSL, xx), psl_iz (PSL, annot_off));
3706 		sprintf (text, format, val);
3707 		PSL_plottext (PSL, xx, annot_off, -annotfontsize, text, 0.0, annot_justify, 0);
3708 		val += annotation_int;
3709 	}
3710 	length *= 0.5;	/* Half-point on axis for plotting label at 150% the annotation font size */
3711 	PSL_command (PSL, "%d %d M ", psl_iz (PSL, length), psl_iz (PSL, label_off));
3712 	PSL_plottext (PSL, length, label_off, -annotfontsize*1.5, label, 0.0, label_justify, 0);
3713 	PSL_command (PSL, "U\n");
3714 	return (PSL_NO_ERROR);
3715 }
3716 
PSL_plotbitimage(struct PSL_CTRL * PSL,double x,double y,double xsize,double ysize,int justify,unsigned char * buffer,int nx,int ny,double f_rgb[],double b_rgb[])3717 int PSL_plotbitimage (struct PSL_CTRL *PSL, double x, double y, double xsize, double ysize, int justify, unsigned char *buffer, int nx, int ny, double f_rgb[], double b_rgb[]) {
3718 	/* Plots a 1-bit image or imagemask.
3719 	 * x, y		: Position of image (in units)
3720 	 * xsize, ysize	: image size in units (if 0, adjust to keep the original aspect ratio)
3721 	 * justify	: Indicate which corner x,y refers to (see graphic)
3722 	 * buffer	: Image bit buffer
3723 	 * nx, ny	: Size of image (in pixels)
3724 	 * f_rgb	: Foreground color for 1 bits (if f_rgb[0] < 0, make transparent)
3725 	 * b_rgb	: Background color for 0 bits (if b_rgb[0] < 0, make transparent)
3726 	 *
3727 	 *   9       10      11
3728 	 *   |----------------|
3729 	 *   5    <image>     7
3730 	 *   |----------------|
3731 	 *   1       2        3
3732 	 */
3733 	int inv;
3734 
3735 	/* If one of [xy]size is 0, keep the aspect ratio */
3736 	if (PSL_eq (xsize, 0.0)) xsize = (ysize * nx) / ny;
3737 	if (PSL_eq (ysize, 0.0)) ysize = (xsize * ny) / nx;
3738 
3739 	/* Correct origin (x,y) in case of justification */
3740 	if (justify > 1) {      /* Move the new origin so (0,0) is lower left of box */
3741 		x -= 0.5 * ((justify + 3) % 4) * xsize;
3742 		y -= 0.5 * (int)(justify / 4) * ysize;
3743 	}
3744 
3745 	PSL_comment (PSL, "Start of 1-bit image\n");
3746 	PSL_command (PSL, "V N %d %d T %d %d scale", psl_ix(PSL, x), psl_iy(PSL, y), psl_iz (PSL, xsize), psl_iz (PSL, ysize));
3747 	inv = psl_bitimage_cmap (PSL, f_rgb, b_rgb) % 2;
3748 	PSL_command (PSL, "\n<< /ImageType 1 /Decode [%d %d] ", inv, 1-inv);
3749 	psl_stream_dump (PSL, buffer, nx, ny, 1, PSL->internal.compress, PSL_ASCII85, (int)(f_rgb[0] < 0.0 || b_rgb[0] < 0.0));
3750 
3751 	PSL_command (PSL, "U\n");
3752 	PSL_comment (PSL, "End of 1-bit image\n");
3753 	return (PSL_NO_ERROR);
3754 }
3755 
PSL_endclipping(struct PSL_CTRL * PSL,int n)3756 int PSL_endclipping (struct PSL_CTRL *PSL, int n) {
3757 	/* n > 0 means restore clipping n times
3758 	 * n == PSL_ALL_CLIP restores all current clippings.
3759 	 */
3760 
3761 	if (n == PSL_ALL_CLIP) {	/* Undo all recorded levels of clipping paths */
3762 		PSL_command (PSL, "PSL_nclip {PSL_cliprestore} repeat\n");	/* Undo all levels of clipping and reset clip count */
3763 		PSL_comment (PSL, "Clipping is currently OFF\n");
3764 		PSL->current.nclip = 0;
3765 	}
3766 	else if (n == 1) {	/* Undo one level of clipping paths */
3767 		PSL_command (PSL, "PSL_cliprestore\n");	/* Undo mode levels of clipping and reduce clip count */
3768 		PSL_comment (PSL, "Clipping reduced by 1 level\n");
3769 		PSL->current.nclip--;
3770 	}
3771 	else if (n > 0) {	/* Undo mode levels of clipping paths */
3772 		PSL_command (PSL, "%d {PSL_cliprestore} repeat\n", n);	/* Undo mode levels of clipping and reduce clip count */
3773 		PSL_comment (PSL, "Clipping reduced by %d levels\n", n);
3774 		PSL->current.nclip -= n;
3775 	}
3776 	return (PSL_NO_ERROR);
3777 }
3778 
PSL_beginclipping(struct PSL_CTRL * PSL,double * x,double * y,int n,double rgb[],int flag)3779 int PSL_beginclipping (struct PSL_CTRL *PSL, double *x, double *y, int n, double rgb[], int flag) {
3780 	/* Any plotting outside the path defined by x,y will be clipped.
3781 	 * use PSL_endclipping to restore the original clipping path.
3782 	 * n    : number of x,y pairs (i.e. path length)
3783 	 * rgb  : optional paint (use rgb[0] = -1 to avoid paint)
3784 	 * flag : 0 = continue adding pieces to the clipping path
3785 	 *        1 = start new clipping path (more follows)
3786 	 *        2 = end clipping path (this is the last segment)
3787 	 *        3 = this is the complete clipping path (start to end)
3788 	 * 	  Add 4 to omit use even-odd clipping [nonzero-winding rule].
3789 	 */
3790 	if (flag & 1) {	/* First segment in (possibly multi-segmented) clip-path */
3791 		PSL_comment (PSL, "Start of polygon clip path\n");
3792 		PSL_command (PSL, "clipsave\n");
3793 	}
3794 
3795 	if (n > 0) {
3796 		int close_interior = 0;
3797 		if ((flag & 3) != 3) close_interior = PSL_CLOSE_INTERIOR;
3798 		PSL_plotline (PSL, x, y, n, PSL_MOVE | close_interior);	/* Must not close path since first point not given ! */
3799 	}
3800 
3801 	if (flag & 2) {	/* End path and [optionally] fill */
3802 		if (!PSL_eq(rgb[0],-1.0)) PSL_command (PSL, "V %s eofill U ", psl_putcolor (PSL, rgb, 0));
3803 		PSL->current.nclip++;
3804 		PSL_command (PSL, (flag & 4) ? "PSL_eoclip N\n" : "PSL_clip N\n");
3805 		PSL_comment (PSL, "End of polygon clip path.  Polygon clipping is currently ON\n");
3806 	}
3807 	return (PSL_NO_ERROR);
3808 }
3809 
PSL_plotcolorimage(struct PSL_CTRL * PSL,double x,double y,double xsize,double ysize,int justify,unsigned char * buffer,int nx,int ny,int nbits)3810 int PSL_plotcolorimage (struct PSL_CTRL *PSL, double x, double y, double xsize, double ysize, int justify, unsigned char *buffer, int nx, int ny, int nbits) {
3811 	/* Plots a 24-bit color image in Grayscale, RGB or CMYK mode.
3812 	 * When the number of unique colors does not exceed PSL_MAX_COLORS, the routine will index
3813 	 * 24-bit RGB images and then attempt to reduce the depth of the indexed image to 1, 2 or 4 bits.
3814 	 *
3815 	 * x, y		: lower left position of image in plot units
3816 	 * xsize, ysize	: image size in units (if 0, adjust to keep the original aspect ratio)
3817 	 * justify	: indicates what corner x,y refers to (see graphic below)
3818 	 * buffer	: contains the bytes for the image
3819 	 * nx, ny	: pixel dimension
3820 	 * nbits	: number of bits per pixel (1, 2, 4, 8, 24)
3821 	 *
3822 	 * Special cases:
3823 	 * nx < 0	: 8- or 24-bit image contains a color mask (first 1 or 3 bytes)
3824 	 * nbits < 0	: "Hardware" interpolation requested
3825 	 *
3826 	 *   9       10      11
3827 	 *   |----------------|
3828 	 *   5    <image>     7
3829 	 *   |----------------|
3830 	 *   1       2        3
3831 	 */
3832 	int id, it;
3833 	const char *colorspace[3] = {"Gray", "RGB", "CMYK"};			/* What kind of image we are writing */
3834 	const char *decode[3] = {"0 1", "0 1 0 1 0 1", "0 1 0 1 0 1 0 1"};	/* What kind of color decoding */
3835 	const char *type[3] = {"1", "4 /MaskColor[0]", "1 /Interpolate true"};
3836 	psl_indexed_image_t image;
3837 
3838 	/* If one of [xy]size is 0, keep the aspect ratio */
3839 	if (PSL_eq (xsize, 0.0)) xsize = (ysize * nx) / ny;
3840 	if (PSL_eq (ysize, 0.0)) ysize = (xsize * ny) / nx;
3841 
3842 	/* Correct origin (x,y) in case of justification */
3843 	if (justify > 1) {      /* Move the new origin so (0,0) is lower left of box */
3844 		x -= 0.5 * ((justify + 3) % 4) * xsize;
3845 		y -= 0.5 * (int)(justify / 4) * ysize;
3846 	}
3847 
3848 	/* Gray scale, CMYK or RGB encoding/colorspace */
3849 	id = (PSL->internal.color_mode == PSL_GRAY || abs (nbits) < 24) ? 0 : (PSL->internal.color_mode == PSL_CMYK ? 2 : 1);
3850 	/* Colormask or interpolate */
3851 	it = nx < 0 ? 1 : (nbits < 0 ? 2 : 0);
3852 
3853 	if (PSL->internal.color_mode != PSL_GRAY && (image = psl_makecolormap (PSL, buffer, nx, ny, nbits))) {
3854 		/* Creation of colormap was successful */
3855 		nbits = psl_bitreduce (PSL, image->buffer, nx, ny, image->colormap->ncolors);
3856 
3857 		PSL_comment (PSL, "Start of indexed %s image [%d bit]\n", colorspace[id], nbits);
3858 		PSL_command (PSL, "V N %d %d T %d %d scale [/Indexed /Device%s %" PRIuS " <\n", psl_ix(PSL, x), psl_iy(PSL, y), psl_iz (PSL, xsize), psl_iz (PSL, ysize), colorspace[id], image->colormap->ncolors - 1);
3859 		psl_stream_dump (PSL, &image->colormap->colors[0][0], (int)image->colormap->ncolors, 1, 24, 0, PSL_HEX, 2);
3860 		PSL_command (PSL, ">] setcolorspace\n<< /ImageType %s /Decode [0 %d] ", type[it], (1<<nbits)-1);
3861 		psl_stream_dump (PSL, image->buffer, nx, ny, nbits, PSL->internal.compress, PSL_ASCII85, 0);
3862 		PSL_command (PSL, "U\n");
3863 		PSL_comment (PSL, "End of indexed %s image\n", colorspace[id]);
3864 
3865 		/* Clear the newly created image buffer and colormap */
3866 		PSL_free (image->buffer);
3867 		PSL_free (image->colormap);
3868 		PSL_free (image);
3869 	}
3870 	else {
3871 		/* Export full gray scale, RGB or CMYK image */
3872 		nbits = abs (nbits);
3873 
3874 		PSL_comment (PSL, "Start of %s image [%d bit]\n", colorspace[id], nbits);
3875 		PSL_command (PSL, "V N %d %d T %d %d scale /Device%s setcolorspace", psl_ix(PSL, x), psl_iy(PSL, y), psl_iz (PSL, xsize), psl_iz (PSL, ysize),  colorspace[id]);
3876 
3877 		if (it == 1 && nbits == 24) {	/* Do PS Level 3 image type 4 with colormask */
3878 			PSL_command (PSL, "\n<< /ImageType 4 /MaskColor [%d %d %d]", (int)buffer[0], (int)buffer[1], (int)buffer[2]);
3879 			buffer += 3;
3880 		}
3881 		else if (it == 1 && nbits == 8) {	/* Do PS Level 3 image type 4 with colormask */
3882 			PSL_command (PSL, "\n<< /ImageType 4 /MaskColor [%d]", (int)buffer[0]);
3883 			buffer++;
3884 		}
3885 		else		/* Do PS Level 2 image, optionally with interpolation */
3886 			PSL_command (PSL, "\n<< /ImageType %s", type[it]);
3887 
3888 		PSL_command (PSL, " /Decode [%s] ", decode[id]);
3889 		psl_stream_dump (PSL, buffer, nx, ny, nbits, PSL->internal.compress, PSL_ASCII85, 0);
3890 		PSL_command (PSL, "U\n");
3891 		PSL_comment (PSL, "End of %s image\n", colorspace[id]);
3892 	}
3893 	return (PSL_NO_ERROR);
3894 }
3895 
PSL_free_nonmacro(void * addr)3896 int PSL_free_nonmacro (void *addr) {
3897 	PSL_free (addr);
3898 	return (PSL_NO_ERROR);
3899 }
3900 
PSL_beginaxes(struct PSL_CTRL * PSL,double llx,double lly,double width,double height,double x0,double y0,double x1,double y1)3901 int PSL_beginaxes (struct PSL_CTRL *PSL, double llx, double lly, double width, double height, double x0, double y0, double x1, double y1) {
3902 	/* Set the box location and user x and y ranges */
3903 	double range;
3904 	PSL->internal.axis_limit[0] = x0;	PSL->internal.axis_limit[1] = x1;
3905 	PSL->internal.axis_limit[2] = y0;	PSL->internal.axis_limit[3] = y1;
3906 	PSL->internal.axis_pos[0] = llx;	PSL->internal.axis_pos[1] = lly;
3907 	PSL->internal.axis_dim[0] = width;	PSL->internal.axis_dim[1] = height;
3908 	range = x1 - x0;
3909 	PSL->internal.x0 = psl_ix (PSL, llx - x0 * width / range);
3910 	PSL->internal.x2ix = (width / range) * PSL->internal.dpu;
3911 	range = y1 - y0;
3912 	PSL->internal.y0 = psl_iy (PSL, lly - y0 * height / range);
3913 	PSL->internal.y2iy = (height / range) * PSL->internal.dpu;
3914 	return (PSL_NO_ERROR);
3915 }
3916 
PSL_endaxes(struct PSL_CTRL * PSL)3917 int PSL_endaxes (struct PSL_CTRL *PSL) {
3918 	/* Turn off user coordinates to PS coordinates scaling */
3919 	memset (PSL->internal.axis_limit, 0, 4 * sizeof (double));
3920 	PSL->internal.x0 = PSL->internal.y0 = 0;
3921 	PSL->internal.x2ix = PSL->internal.y2iy = PSL->internal.dpu;
3922 	return (PSL_NO_ERROR);
3923 }
3924 
PSL_plotsymbol(struct PSL_CTRL * PSL,double x,double y,double size[],int symbol)3925 int PSL_plotsymbol (struct PSL_CTRL *PSL, double x, double y, double size[], int symbol) {
3926 	/* Plotting standard symbols
3927 	 * A) 6 non-fillable symbols +-mpxy,
3928 	 * B) 9 fillable symbol codes acdhignst, and
3929 	 * C) The 7 fillable and multi-parameter symbols ejmrRwv.
3930 	 * For A and B, size[0] holds the diameter of the circumscribing circle,
3931 	 * whereas for C other parameters are contained in the array (see below).
3932 	 */
3933 	int status = PSL_NO_ERROR;
3934 
3935 	switch (symbol) {
3936 		/* Line-only symbols. size[0] = diameter of circumscribing circle. */
3937 
3938 		case PSL_CROSS:		/* Cross */
3939 		case PSL_DOT:		/* Single dot */
3940 		case PSL_PLUS:		/* Plus */
3941 		case PSL_XDASH:		/* Horizontal line segment */
3942 		case PSL_YDASH:		/* Vertical line segment */
3943 			PSL_command (PSL, "%d %d %d S%c\n", psl_iz (PSL, 0.5 * size[0]), psl_ix (PSL, x), psl_iy (PSL, y), (char)symbol);
3944 			break;
3945 
3946 		/* One-parameter Fillable symbols. size[0] = diameter of circumscribing circle. */
3947 
3948 		case PSL_STAR:		/* Star */
3949 		case PSL_CIRCLE:	/* Circle */
3950 		case PSL_DIAMOND:	/* Diamond */
3951 		case PSL_HEXAGON:	/* Hexagon */
3952 		case PSL_INVTRIANGLE:	/* Inverted triangle */
3953 		case PSL_OCTAGON:	/* Octagon */
3954 		case PSL_PENTAGON:	/* Pentagon */
3955 		case PSL_SQUARE:	/* Square */
3956 		case PSL_TRIANGLE:	/* Triangle */
3957 			PSL_command (PSL, "%d %d %d S%c\n", psl_iz (PSL, 0.5 * size[0]), psl_ix (PSL, x), psl_iy (PSL, y), (char)symbol);
3958 			break;
3959 
3960 		/* Multi-parameter fillable symbols */
3961 
3962 		case PSL_WEDGE:		/* A wedge or pie-slice. size[0] = radius, size[1..2] = azimuth range of arc */
3963 			psl_wedge (PSL, x, y, size);
3964 #if 0
3965 			PSL_command (PSL, "%d %.12g %.12g %d %d Sw\n", psl_iz (PSL, size[0]), size[1], size[2], psl_ix (PSL, x), psl_iy (PSL, y));
3966 #endif
3967 			break;
3968 		case PSL_MARC:		/* An arc with optional arrows. size[0] = radius, size[1..2] = azimuth range of arc, size[3] = shape, size[4] = arrows (0 = none, 1 = backward, 2 = forward, 3 = both) */
3969 			psl_matharc (PSL, x, y, size);
3970 			break;
3971 		case PSL_ELLIPSE:	/* An ellipse. size[0] = angle of major axis, size[1..2] = length of major and minor axis */
3972 			PSL_command (PSL, "%d %d %.12g %d %d Se\n", psl_iz (PSL, 0.5 * size[1]), psl_iz (PSL, 0.5 * size[2]), size[0], psl_ix (PSL, x), psl_iy (PSL, y));
3973 			break;
3974 		case PSL_RECT:		/* A rectangle. size[0..1] = width and height */
3975 			PSL_command (PSL, "%d %d %d %d Sr\n", psl_iz (PSL, size[1]), psl_iz (PSL, size[0]), psl_ix (PSL, x), psl_iy (PSL, y));
3976 			break;
3977 		case PSL_RNDRECT:	/* A rounded rectangle. size[0..1] = width and height, size[2] = radius */
3978 			PSL_command (PSL, "%d %d %d %d %d SR\n", psl_iz (PSL, size[1]), psl_iz (PSL, size[0]), psl_iz (PSL, size[2]), psl_ix (PSL, x), psl_iy (PSL, y));
3979 			break;
3980 		case PSL_ROTRECT:	/* A rotated rectangle. size[0] = angle, size[1..2] = width and height */
3981 			PSL_command (PSL, "%d %d %.12g %d %d Sj\n", psl_iz (PSL, size[2]), psl_iz (PSL, size[1]), size[0], psl_ix (PSL, x), psl_iy (PSL, y));
3982 			break;
3983 		case PSL_VECTOR:	/* A zero-, one- or two-headed vector (x,y = tail coordinates) */
3984 			status = psl_vector (PSL, x, y, size);
3985 			break;
3986 		default:
3987 			status = PSL_BAD_SYMBOL;
3988 			PSL_message (PSL, PSL_MSG_ERROR, "Error: Unknown symbol code %c\n", (int)symbol);
3989 			break;
3990 	}
3991 	return (status);
3992 }
3993 
PSL_plotsegment(struct PSL_CTRL * PSL,double x0,double y0,double x1,double y1)3994 int PSL_plotsegment (struct PSL_CTRL *PSL, double x0, double y0, double x1, double y1) {
3995 	/* Short line segment */
3996 	int ix, iy;
3997 
3998 	ix = psl_ix (PSL, x0);
3999 	iy = psl_iy (PSL, y0);
4000 	PSL->internal.ix = psl_ix (PSL, x1);
4001 	PSL->internal.iy = psl_iy (PSL, y1);
4002 	PSL_command (PSL, "N %d %d M %d %d D S\n", ix, iy, PSL->internal.ix - ix, PSL->internal.iy - iy);
4003 	return (PSL_NO_ERROR);
4004 }
4005 
PSL_setcurrentpoint(struct PSL_CTRL * PSL,double x,double y)4006 int PSL_setcurrentpoint (struct PSL_CTRL *PSL, double x, double y) {
4007 	/* Set the current point only */
4008 	PSL->internal.ix = psl_ix (PSL, x);
4009 	PSL->internal.iy = psl_iy (PSL, y);
4010 	PSL_command (PSL, "%d %d M\n", PSL->internal.ix, PSL->internal.iy);
4011 	return (PSL_NO_ERROR);
4012 }
4013 
PSL_settransparency(struct PSL_CTRL * PSL,double transparency)4014 int PSL_settransparency (struct PSL_CTRL *PSL, double transparency) {
4015 	/* Updates the current PDF transparency only (for both fill and stroke transparency) */
4016 	if (transparency < 0.0 || transparency > 1.0) {
4017 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Bad transparency value [%g] - ignored\n", transparency);
4018 		return (PSL_BAD_RANGE);
4019 	}
4020 	if (transparency == PSL->current.transparency) return (PSL_NO_ERROR);	/* Quietly return if same as before */
4021 
4022 	PSL_command (PSL, "%.12g %.12g /%s PSL_transp\n", 1.0 - transparency, 1.0 - transparency, PSL->current.transparency_mode);
4023 	PSL->current.transparency = transparency;	/* Remember current setting */
4024 	return (PSL_NO_ERROR);
4025 }
4026 
PSL_settransparencies(struct PSL_CTRL * PSL,double * transparencies)4027 int PSL_settransparencies (struct PSL_CTRL *PSL, double *transparencies) {
4028 	/* Updates the current PDF transparencies only (fill and stroke separately) */
4029 	if (transparencies[0] < 0.0 || transparencies[0] > 1.0) {
4030 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Bad fill transparency value [%g] - ignored\n", transparencies[0]);
4031 		return (PSL_BAD_RANGE);
4032 	}
4033 	if (transparencies[1] < 0.0 || transparencies[1] > 1.0) {
4034 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Bad stroke transparency value [%g] - ignored\n", transparencies[1]);
4035 		return (PSL_BAD_RANGE);
4036 	}
4037 	if (transparencies[0] == PSL->current.transparencies[0] && transparencies[1] == PSL->current.transparencies[1]) return (PSL_NO_ERROR);	/* Quietly return if same as before */
4038 
4039 	PSL_command (PSL, "%.12g %.12g /%s PSL_transp\n", 1.0 - transparencies[0], 1.0 - transparencies[1], PSL->current.transparency_mode);
4040 	PSL->current.transparencies[0] = transparencies[0];	/* Remember current settings */
4041 	PSL->current.transparencies[1] = transparencies[1];	/* Remember current settings */
4042 	return (PSL_NO_ERROR);
4043 }
4044 
PSL_settransparencymode(struct PSL_CTRL * PSL,const char * mode)4045 int PSL_settransparencymode (struct PSL_CTRL *PSL, const char *mode) {
4046 	/* Updates the current PDF transparency mode */
4047 	int k, ok;
4048 	if (!mode || !mode[0]) return (PSL_NO_ERROR);	/* Quietly returned if not given an argument */
4049 	for (k = ok = 0; !ok && k < N_PDF_TRANSPARENCY_MODES; k++)
4050 		if (!strcmp (PDF_transparency_modes[k], mode)) ok = 1;
4051 	if (!ok) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Unknown PDF transparency mode %s - ignored\n", mode);
4052 
4053 	strncpy (PSL->current.transparency_mode, mode, 15U);	/* Keep one character for null terminator */
4054 	return (PSL_NO_ERROR);
4055 }
4056 
PSL_setfill(struct PSL_CTRL * PSL,double rgb[],int outline)4057 int PSL_setfill (struct PSL_CTRL *PSL, double rgb[], int outline) {
4058 	/* Set fill style for polygons and switch outline on or off.
4059 	 * rgb[0] = -3: set fill pattern, rgb[1] is pattern number
4060 	 * rgb[0] = -2: ignore. Do not change fill. Leave untouched.
4061 	 * rgb[0] = -1: switch off filling of polygons
4062 	 * rgb[0] >= 0: rgb is the fill color with R G B in 0-1 range.
4063 	 * outline = -2: ignore. Do not change outline setting.
4064 	 * outline =  0: switch outline off.
4065 	 * outline =  1: switch outline on
4066 	 */
4067 
4068 	if (PSL_eq (rgb[0], -2.0))
4069 		{ /* Skipped, no fill specified */ }
4070 	else if (PSL_same_rgb (rgb, PSL->current.rgb[PSL_IS_FILL]))
4071 		{ /* Skipped, fill already set */ }
4072 	else if (PSL_eq (rgb[0], -1.0)) {
4073 		PSL_command (PSL, "FQ\n");
4074 		PSL_rgb_copy (PSL->current.rgb[PSL_IS_FILL], rgb);
4075 	}
4076 	else if (PSL_eq (rgb[3], 0.0) && !PSL_eq (PSL->current.rgb[PSL_IS_STROKE][3], 0.0)) {
4077 		/* If stroke color is transparent and fill is not, explicitly set transparency for fill */
4078 		PSL_command (PSL, "{%s 1 1 /Normal PSL_transp} FS\n", psl_putcolor (PSL, rgb, 0));
4079 		PSL_rgb_copy (PSL->current.rgb[PSL_IS_FILL], rgb);
4080 	}
4081 	else {	/* Set new r/g/b fill, after possibly changing fill transparency */
4082 		PSL_command (PSL, "{%s} FS\n", psl_putcolor (PSL, rgb, 0));
4083 		PSL_rgb_copy (PSL->current.rgb[PSL_IS_FILL], rgb);
4084 	}
4085 
4086 	if (outline <= -2)
4087 		{ /* Skipped, no change of outline */ }
4088 	else if (PSL->current.outline != outline) {
4089 		assert (outline == 0 || outline == 1);
4090 		PSL_command (PSL, "O%d\n", outline);
4091 		PSL->current.outline = outline;
4092 	}
4093 
4094 	return (PSL_NO_ERROR);
4095 }
4096 
PSL_setpattern(struct PSL_CTRL * PSL,int image_no,char * imagefile,int image_dpi,double f_rgb[],double b_rgb[])4097 int PSL_setpattern (struct PSL_CTRL *PSL, int image_no, char *imagefile, int image_dpi, double f_rgb[], double b_rgb[]) {
4098 	/* Set up pattern fill, either by using image number or imagefile name
4099 	 * image_no:	Number of the standard PSL fill pattern (use negative when file name used instead)
4100 	 * imagefile:	Name of image file
4101 	 * image_dpi:	Resolution of image on the page
4102 	 * f_rgb:	Foreground color used for set bits (1) (1-bit only)
4103 	 * b_rgb:	Background color used for unset bits (0) (1-bit only)
4104 	 * Returns image number
4105 	 * DEPRECATED
4106 	 */
4107 	(void)(image_no); (void)(imagefile); (void)(image_dpi); (void)(f_rgb); (void)(b_rgb);
4108 	PSL_message (PSL, PSL_MSG_ERROR, "Warning: PSL_setpattern has been deprecated - see PSL_setimage instead\n");
4109 	return (PSL_NO_ERROR);
4110 }
4111 
PSL_loadimage(struct PSL_CTRL * PSL,char * file,struct imageinfo * header,unsigned char ** image)4112 int PSL_loadimage (struct PSL_CTRL *PSL, char *file, struct imageinfo *header, unsigned char **image) {
4113 	/* DEPRECATED */
4114 	(void)(file); (void)(header); (void)(image);
4115 	PSL_message (PSL, PSL_MSG_ERROR, "Warning: PSL_loadimage has been deprecated - see PSL_loadeps instead\n");
4116 	return (PSL_NO_ERROR);
4117 }
4118 
PSL_setimage(struct PSL_CTRL * PSL,int image_no,char * imagefile,unsigned char * image,int image_dpi,unsigned int dim[],double f_rgb[],double b_rgb[])4119 int PSL_setimage (struct PSL_CTRL *PSL, int image_no, char *imagefile, unsigned char *image, int image_dpi, unsigned int dim[], double f_rgb[], double b_rgb[]) {
4120 	/* Set up image pattern fill
4121 	 * image_no:	Number of the standard PSL fill pattern (use negative when file name used instead)
4122 	 * imagefile:	Name of image file (not used if image_no = [1,90])
4123 	 * image:	The bytestream making up the image (not used if image_no = [1,90])
4124 	 * image_dpi:	Resolution of image on the page
4125 	 * dim:		Image number of columns, rows, and bit depth (not used if image_no = [1,90])
4126 	 * f_rgb:	Foreground color used for set bits (1) (1-bit only)
4127 	 * b_rgb:	Background color used for unset bits (0) (1-bit only)
4128 	 * Returns image number
4129 	 */
4130 
4131 	int mask, id, inv, k;
4132 	uint64_t nx, ny;
4133 	const char *colorspace[3] = {"Gray", "RGB", "CMYK"};			/* What kind of image we are writing */
4134 	const char *decode[3] = {"0 1", "0 1 0 1 0 1", "0 1 0 1 0 1 0 1"};	/* What kind of color decoding */
4135 	const char *kind_mask[2] = {"image", "imagemask"};
4136 
4137 	/* Determine if image was used before */
4138 
4139 	if ((image_no > 0 && image_no <= PSL_N_PATTERNS) && !PSL->internal.pattern[image_no-1].status) {	/* Unused predefined */
4140 		if ((image_no = psl_pattern_init (PSL, image_no, NULL, NULL, 64, 64, 1)) < 0) return -1;	/* Error in psl_pattern_init */
4141 	}
4142 	else if (image_no < 0) {	/* User image, check if already used */
4143 		int i = psl_search_userimages (PSL, imagefile);	/* i = 0 is the first user image */
4144 		if (i == -1)	/* Not found or no previous user images loaded */
4145 			image_no = psl_pattern_init (PSL, -1, imagefile, image, dim[0], dim[1], dim[2]);
4146 		else
4147 			image_no = PSL_N_PATTERNS + i + 1;
4148 		if (image_no < 0) return -1;	/* Error in psl_pattern_init */
4149 	}
4150 	k = image_no - 1;	/* Image array index */
4151 	nx = PSL->internal.pattern[k].nx;
4152 	ny = PSL->internal.pattern[k].ny;
4153 
4154 	id = (PSL->internal.color_mode == PSL_CMYK) ? 2 : 1;
4155 	mask = (PSL->internal.pattern[k].depth == 1 && (f_rgb[0] < 0.0 || b_rgb[0] < 0.0));
4156 
4157 	/* When DPI or colors have changed, the /pattern procedure needs to be rewritten */
4158 
4159 	if (PSL->internal.pattern[k].dpi != image_dpi ||
4160 		!PSL_same_rgb(PSL->internal.pattern[k].f_rgb,f_rgb) ||
4161 		!PSL_same_rgb(PSL->internal.pattern[k].b_rgb,b_rgb)) {
4162 
4163 		PSL_comment (PSL, "Setup %s fill using pattern %d\n", kind_mask[mask], image_no);
4164 		if (image_dpi) {	/* Use given DPI */
4165 			nx = lrint (nx * PSL->internal.dpu / image_dpi);
4166 			ny = lrint (ny * PSL->internal.dpu / image_dpi);
4167 		}
4168 		PSL_command (PSL, "/pattern%d {V %" PRIu64 " %" PRIu64 " scale", image_no, nx, ny);
4169 		PSL_command (PSL, "\n<< /PaintType 1 /PatternType 1 /TilingType 1 /BBox [0 0 1 1] /XStep 1 /YStep 1 /PaintProc\n   {begin");
4170 
4171 		if (PSL->internal.pattern[k].depth == 1) {	/* 1-bit bitmap basis */
4172 			inv = psl_bitimage_cmap (PSL, f_rgb, b_rgb) % 2;
4173 			PSL_command (PSL, "\n<< /ImageType 1 /Decode [%d %d]", inv, 1-inv);
4174 		}
4175 		else
4176 			PSL_command (PSL, " /Device%s setcolorspace\n<< /ImageType 1 /Decode [%s]", colorspace[id], decode[id]);
4177 		PSL_command (PSL, " /Width %d /Height %d /BitsPerComponent %d",
4178 		             PSL->internal.pattern[k].nx, PSL->internal.pattern[k].ny, MIN(PSL->internal.pattern[k].depth,8));
4179 		PSL_command (PSL, "\n   /ImageMatrix [%d 0 0 %d 0 %d] /DataSource image%d\n>> %s end}\n>> matrix makepattern U} def\n",
4180 		             PSL->internal.pattern[k].nx, -PSL->internal.pattern[k].ny, PSL->internal.pattern[k].ny,
4181 		             image_no, kind_mask[mask]);
4182 
4183 		PSL->internal.pattern[k].dpi = image_dpi;
4184 		PSL_rgb_copy (PSL->internal.pattern[k].f_rgb, f_rgb);
4185 		PSL_rgb_copy (PSL->internal.pattern[k].b_rgb, b_rgb);
4186 	}
4187 
4188 	return (image_no);
4189 }
4190 
PSL_plotepsimage(struct PSL_CTRL * PSL,double x,double y,double xsize,double ysize,int justify,unsigned char * buffer,struct imageinfo * h)4191 int PSL_plotepsimage (struct PSL_CTRL *PSL, double x, double y, double xsize, double ysize, int justify, unsigned char *buffer, struct imageinfo *h) {
4192 	/* Plots an EPS image
4193 	 * x,y		: Position of image (in plot coordinates)
4194 	 * xsize, ysize	: Size of image (in user units)
4195 	 * justify	: Indicate which corner (x,y) refers to (see graphic)
4196 	 * buffer	: EPS file (buffered)
4197 	 * h        : Image buffer header
4198 	 *
4199 	 *   9       10      11
4200 	 *   |----------------|
4201 	 *   5    <image>     7
4202 	 *   |----------------|
4203 	 *   1       2        3
4204 	 */
4205 	double width, height;
4206 
4207 	/* If one of [xy]size is 0, keep the aspect ratio */
4208 	width = h->trx - h->llx;
4209 	height = h->try - h->lly;
4210 	if (PSL_eq (xsize, 0.0)) xsize = ysize * width / height;
4211 	if (PSL_eq (ysize, 0.0)) ysize = xsize * height / width;
4212 
4213 	/* Correct origin (x,y) in case of justification */
4214 	if (justify > 1) {      /* Move the new origin so (0,0) is lower left of box */
4215 		x -= 0.5 * ((justify + 3) % 4) * xsize;
4216 		y -= 0.5 * (int)(justify / 4) * ysize;
4217 	}
4218 
4219 	PSL_command (PSL, "PSL_eps_begin\n");
4220 	PSL_command (PSL, "%d %d T %.12g %.12g scale\n", psl_ix (PSL, x), psl_iy (PSL, y), xsize * PSL->internal.dpu / width, ysize * PSL->internal.dpu / height);
4221 	PSL_command (PSL, "%.12g %.12g T\n", -h->llx, -h->lly);
4222 	PSL_command (PSL, "N %.12g %.12g M %.12g %.12g L %.12g %.12g L %.12g %.12g L P clip N\n", h->llx, h->lly, h->trx, h->lly, h->trx, h->try, h->llx, h->try);
4223 	PSL_command (PSL, "%%%%BeginDocument: psimage.eps\n");
4224 	if (PSL->internal.memory) {
4225 		psl_prepare_buffer (PSL, h->length); /* Make sure we have enough memory to hold the EPS */
4226 		strncat (&(PSL->internal.buffer[PSL->internal.n]), (char *)buffer, h->length);
4227 		PSL->internal.n += h->length;
4228 	}
4229 	else
4230 		fwrite (buffer, 1U, (size_t)h->length, PSL->internal.fp);
4231 	PSL_command (PSL, "%%%%EndDocument\n");
4232 	PSL_command (PSL, "PSL_eps_end\n");
4233 	return (PSL_NO_ERROR);
4234 }
4235 
PSL_plotlatexeps(struct PSL_CTRL * PSL,double x,double y,double xsize,double ysize,int justify,unsigned char * buffer,double * rgb,struct imageinfo * h)4236 int PSL_plotlatexeps (struct PSL_CTRL *PSL, double x, double y, double xsize, double ysize, int justify, unsigned char *buffer, double *rgb, struct imageinfo *h) {
4237    /* Plots an Latex EPS image
4238     * x,y      : Position of image (in plot coordinates)
4239     * xsize, ysize   : Size of image (in user units)
4240     * justify  : Indicate which corner (x,y) refers to (see graphic)
4241     * buffer   : EPS file (buffered)
4242     * rgb      : Font color
4243     * h        : Image buffer header
4244     *
4245     *   9       10      11
4246     *   |----------------|
4247     *   5    <image>     7
4248     *   |----------------|
4249     *   1       2        3
4250     */
4251    double width, height;
4252 
4253    /* If one of [xy]size is 0, keep the aspect ratio */
4254    width = h->trx - h->llx;
4255    height = h->try - h->lly;
4256    if (PSL_eq (xsize, 0.0)) xsize = ysize * width / height;
4257    if (PSL_eq (ysize, 0.0)) ysize = xsize * height / width;
4258 
4259    /* Correct origin (x,y) in case of justification */
4260    if (justify > 1) {      /* Move the new origin so (0,0) is lower left of box */
4261       x -= 0.5 * ((justify + 3) % 4) * xsize;
4262       y -= 0.5 * (int)(justify / 4) * ysize;
4263    }
4264 
4265    PSL_command (PSL, "PSL_eps_begin\n");
4266    PSL_command (PSL, "%s\n", psl_putcolor (PSL, rgb, 0));
4267    PSL_command (PSL, "%d %d T %.12g %.12g scale\n", psl_ix (PSL, x), psl_iy (PSL, y), xsize * PSL->internal.dpu / width, ysize * PSL->internal.dpu / height);
4268    PSL_command (PSL, "%.12g %.12g T\n", -h->llx, -h->lly);
4269    PSL_command (PSL, "N %.12g %.12g M %.12g %.12g L %.12g %.12g L %.12g %.12g L P clip N\n", h->llx, h->lly, h->trx, h->lly, h->trx, h->try, h->llx, h->try);
4270    PSL_command (PSL, "%%%%BeginDocument: psimage.eps\n");
4271    if (PSL->internal.memory) {
4272       psl_prepare_buffer (PSL, h->length); /* Make sure we have enough memory to hold the EPS */
4273       strncat (&(PSL->internal.buffer[PSL->internal.n]), (char *)buffer, h->length);
4274       PSL->internal.n += h->length;
4275    }
4276    else
4277       fwrite (buffer, 1U, (size_t)h->length, PSL->internal.fp);
4278    PSL_command (PSL, "%%%%EndDocument\n");
4279    PSL_command (PSL, "PSL_eps_end\n");
4280    return (PSL_NO_ERROR);
4281 }
4282 
PSL_plotline(struct PSL_CTRL * PSL,double * x,double * y,int n,int type)4283 int PSL_plotline (struct PSL_CTRL *PSL, double *x, double *y, int n, int type) {
4284 	/* Plot a (portion of a) line. This can be a line from start to finish, or a portion of it, depending
4285 	 * on the type argument. Optionally, the line can be stroked (using the current pen), closed.
4286 	 * Type is a combination of the following:
4287 	 * PSL_DRAW   (0) : Draw a line segment
4288 	 * PSL_MOVE   (1) : Move to a new anchor point (x[0], y[0]) first
4289 	 * PSL_STROKE (2) : Stroke the line
4290 	 * PSL_CLOSE  (8) : Close the line back to the beginning of this segment, this is done automatically
4291 	 *                  when the first and last point are the same and PSL_MOVE is on.
4292 	 */
4293 	int i, i0 = 0, *ix = NULL, *iy = NULL;
4294 
4295 	if (n < 1) return (PSL_NO_ERROR);	/* Cannot deal with empty lines */
4296 	if (type < 0) type = -type;		/* Should be obsolete now */
4297 
4298 	/* First remove unnecessary points that have zero curvature */
4299 
4300 	ix = PSL_memory (PSL, NULL, n, int);
4301 	iy = PSL_memory (PSL, NULL, n, int);
4302 
4303 	n = psl_shorten_path (PSL, x, y, n, ix, iy, 0);
4304 
4305 	/* If first and last point are the same, close the polygon and drop the last point
4306 	 * (but only if this segment runs start to finish)
4307 	 */
4308 
4309 	if (n > 1 && (type & PSL_MOVE) && (ix[0] == ix[n-1] && iy[0] == iy[n-1]) && (type & PSL_CLOSE_INTERIOR) == 0) {n--; type |= PSL_CLOSE;}
4310 
4311 	if (type & PSL_MOVE) {
4312 		PSL_command (PSL, "%d %d M\n", ix[0], iy[0]);
4313 		PSL->internal.ix = ix[0];
4314 		PSL->internal.iy = iy[0];
4315 		i0++;
4316 		if (n == 1) PSL_command (PSL, "0 0 D\n");	/* Add at least a zero length line */
4317 	}
4318 
4319 	for (i = i0; i < n; i++) {
4320 		if (ix[i] != PSL->internal.ix || iy[i] != PSL->internal.iy)
4321 			PSL_command (PSL, "%d %d D\n", ix[i] - PSL->internal.ix, iy[i] - PSL->internal.iy);
4322 		PSL->internal.ix = ix[i];
4323 		PSL->internal.iy = iy[i];
4324 	}
4325 	if (type & PSL_STROKE && type & PSL_CLOSE)
4326 		PSL_command (PSL, "P S\n");	/* Close and stroke the path */
4327 	else if (type & PSL_CLOSE)
4328 		PSL_command (PSL, "P\n");	/* Close the path */
4329 	else if (type & PSL_STROKE)
4330 		PSL_command (PSL, "S\n");	/* Stroke the path */
4331 
4332 	PSL_free (ix);
4333 	PSL_free (iy);
4334 
4335 	return (PSL_NO_ERROR);
4336 }
4337 
PSL_plotcurve(struct PSL_CTRL * PSL,double * x,double * y,int n,int type)4338 int PSL_plotcurve (struct PSL_CTRL *PSL, double *x, double *y, int n, int type) {
4339 	/* Plot a (portion of a) Bezier curve. This can be a line from start to finish, or a portion of it, depending
4340 	 * on the type argument. Optionally, the line can be stroked (using the current pen), closed.
4341 	 * Type is a combination of the following:
4342 	 * PSL_DRAW   (0) : Draw a line segment
4343 	 * PSL_MOVE   (1) : Move to a new anchor point (x[0], y[0]) first [REQUIRED]
4344 	 * PSL_STROKE (2) : Stroke the line
4345 	 * PSL_CLOSE  (8) : Close the line back to the beginning of this segment, this is done automatically
4346 	 *                  when the first and last point are the same and PSL_MOVE is on.
4347 	 */
4348 	int i = 0, *ix = NULL, *iy = NULL;
4349 	double *Px1 = NULL, *Py1 = NULL, *Px2 = NULL, *Py2 = NULL;
4350 
4351 	if (n < 1) return (PSL_NO_ERROR);	/* Cannot deal with empty lines */
4352 	if (type < 0) type = -type;		/* Should be obsolete now */
4353 
4354 	psl_computeBezierControlPoints (PSL, x, n, &Px1, &Px2);
4355 	psl_computeBezierControlPoints (PSL, y, n, &Py1, &Py2);
4356 
4357 	/* First convert knots to integers */
4358 
4359 	ix = PSL_memory (PSL, NULL, n, int);
4360 	iy = PSL_memory (PSL, NULL, n, int);
4361 
4362 	n = psl_shorten_path (PSL, x, y, n, ix, iy, 1);
4363 
4364 	/* If first and last point are the same, close the polygon and drop the last point
4365 	 * (but only if this segment runs start to finish)
4366 	 */
4367 
4368 	if (n > 1 && (type & PSL_MOVE) && (ix[0] == ix[n-1] && iy[0] == iy[n-1])) type |= PSL_CLOSE;
4369 
4370 	/* Move to (and set) currentpoint */
4371 	PSL_command (PSL, "%d %d M\n", ix[0], iy[0]);
4372 	n--;
4373 	while (i < n) {
4374 		PSL_command (PSL, "%d %d ", psl_ix (PSL, Px1[i]), psl_iy (PSL, Py1[i]));
4375 		PSL_command (PSL, "%d %d ", psl_ix (PSL, Px2[i]), psl_iy (PSL, Py2[i]));
4376 		i++;	/* Go to end point of segment */
4377 		PSL_command (PSL, "%d %d curveto\n", ix[i], iy[i]);
4378 	}
4379 	PSL_free (Px1);	PSL_free (Py1);	PSL_free (Px2);	PSL_free (Py2);
4380 	i--;	/* ID of last point */
4381 	PSL->internal.ix = ix[i];
4382 	PSL->internal.iy = iy[i];
4383 	if (type & PSL_STROKE && type & PSL_CLOSE)
4384 		PSL_command (PSL, "P S\n");	/* Close and stroke the path */
4385 	else if (type & PSL_CLOSE)
4386 		PSL_command (PSL, "P\n");	/* Close the path */
4387 	else if (type & PSL_STROKE)
4388 		PSL_command (PSL, "S\n");	/* Stroke the path */
4389 
4390 	PSL_free (ix);
4391 	PSL_free (iy);
4392 
4393 	return (PSL_NO_ERROR);
4394 }
4395 
PSL_plotpoint(struct PSL_CTRL * PSL,double x,double y,int pen)4396 int PSL_plotpoint (struct PSL_CTRL *PSL, double x, double y, int pen) {
4397 	int ix, iy, idx, idy;
4398 
4399 	/* Convert user coordinates to dots */
4400 	ix = psl_ix (PSL, x);
4401 	iy = psl_iy (PSL, y);
4402 
4403 	if (pen & PSL_REL) {
4404 		/* Relative move or relative draw */
4405 		if (pen & PSL_STROKE) {
4406 			/* Always draw-stroke even when displacement is 0 */
4407 			PSL_command (PSL, "%d %d D S\n", ix, iy);
4408 		}
4409 		else if (ix == 0 && iy == 0)
4410 			return (PSL_NO_ERROR);
4411 		else if (pen & PSL_MOVE)
4412 			PSL_command (PSL, "%d %d G\n", ix, iy);
4413 		else
4414 			PSL_command (PSL, "%d %d D\n", ix, iy);
4415 		PSL->internal.ix += ix;	/* Update absolute position */
4416 		PSL->internal.iy += iy;
4417 	}
4418 	else {
4419 		/* Absolute move or absolute draw converted to relative */
4420 		idx = ix - PSL->internal.ix;
4421 		idy = iy - PSL->internal.iy;
4422 		if (pen & PSL_STROKE) {
4423 			/* Always draw-stroke even when displacement is 0 */
4424 			PSL_command (PSL, "%d %d D S\n", idx, idy);
4425 		}
4426 		else if (pen & PSL_MOVE) {
4427 			/* Do this always, even if idx = idy = 0, just to be sure we are where we are supposed to be */
4428 			PSL_command (PSL, "%d %d M\n", ix, iy);
4429 		}
4430 		else if (idx == 0 && idy == 0)
4431 			return (PSL_NO_ERROR);
4432 		else {
4433 			/* Convert to relative draw to have smaller numbers */
4434 			PSL_command (PSL, "%d %d D\n", idx, idy);
4435 		}
4436 		PSL->internal.ix = ix;	/* Update absolute position */
4437 		PSL->internal.iy = iy;
4438 	}
4439 	return (PSL_NO_ERROR);
4440 }
4441 
PSL_endplot(struct PSL_CTRL * PSL,int lastpage)4442 int PSL_endplot (struct PSL_CTRL *PSL, int lastpage) {
4443 	/* Finalizes the current plot layer; see PSL_endsession for terminating PSL session. */
4444 
4445 	if (PSL->init.runmode == 0) {
4446 		psl_pattern_cleanup (PSL);
4447 		memset (PSL->internal.pattern, 0, 2*PSL_N_PATTERNS*sizeof (struct PSL_PATTERN));	/* Reset all pattern info since the file is now closed */
4448 	}
4449 	PSL_setdash (PSL, NULL, 0.0);
4450 	if (!PSL_eq (PSL->current.rgb[PSL_IS_STROKE][3], 0.0)) PSL_command (PSL, "1 1 /Normal PSL_transp\n");
4451 
4452 	if (lastpage) {
4453 		PSL_command (PSL, "\ngrestore\n");	/* End encapsulation of main body for this plot */
4454 		PSL_comment (PSL, "Run PSL movie label completion function, if defined\n");
4455 		PSL_command (PSL, "PSL_movie_label_completion /PSL_movie_label_completion {} def\n");	/* Run then make it a null function */
4456 		PSL_comment (PSL, "Run PSL movie progress indicator completion function, if defined\n");
4457 		PSL_command (PSL, "PSL_movie_prog_indicator_completion /PSL_movie_prog_indicator_completion {} def\n");	/* Run then make it a null function */
4458 		PSL_command (PSL, "%%PSL_Begin_Trailer\n");
4459 		PSL_command (PSL, "%%%%PageTrailer\n");
4460 		if (PSL->init.runmode) {
4461 			psl_pattern_cleanup (PSL);
4462 			memset (PSL->internal.pattern, 0, 2*PSL_N_PATTERNS*sizeof (struct PSL_PATTERN));	/* Reset all pattern info since the file is now closed */
4463 		}
4464 		PSL_comment (PSL, "Reset transformations and call showpage\n");
4465 		PSL_command (PSL, "U\nshowpage\n");
4466 		PSL_command (PSL, "\n%%%%Trailer\n");
4467 		PSL_command (PSL, "\nend\n");
4468 		PSL_command (PSL, "%%%%EOF\n");
4469 	}
4470 	else if (PSL->internal.origin[0] == 'a' || PSL->internal.origin[1] == 'a') {	/* Restore the origin of the plotting */
4471 		if (PSL->internal.comments)  PSL_command (PSL, "%% Reset plot origin:\n");
4472 		PSL_command (PSL, "%d %d TM\n", PSL->internal.origin[0] == 'a' ? -psl_iz(PSL, PSL->internal.offset[0]) : 0,
4473 			PSL->internal.origin[1] == 'a' ? -psl_iz(PSL, PSL->internal.offset[1]) : 0);
4474 	}
4475 	if (PSL->internal.memory) {	/* Finalize memory buffer allocation */
4476 		memset (&PSL->internal.buffer[PSL->internal.n], 0, (PSL->internal.n_alloc-PSL->internal.n)*sizeof (char));	/* Wipe the unused stuff */
4477 		PSL->internal.n_alloc = PSL->internal.n;	/* Shrink allocated memory to what is needed to hold the PS */
4478 		PSL->internal.buffer  = PSL_memory (PSL, PSL->internal.buffer, PSL->internal.n_alloc, char);
4479 		if (lastpage) PSL->internal.pmode |= 2;	/* We provided a trailer */
4480 	}
4481 	else {	/* Dealing with files or stdout */
4482 		if (PSL->internal.fp != stdout && PSL->internal.call_level == 1) {
4483 			fclose (PSL->internal.fp);	/* Only level 1 can close the file (if not stdout) */
4484 			PSL->internal.fp = NULL;
4485 		}
4486 	}
4487 	PSL->internal.offset[0] = PSL->internal.prev_offset[0];
4488 	PSL->internal.offset[1] = PSL->internal.prev_offset[1];
4489 
4490 	PSL->internal.call_level--;	/* Done with this module call */
4491 	return (PSL_NO_ERROR);
4492 }
4493 
PSL_getplot(struct PSL_CTRL * PSL)4494 char * PSL_getplot (struct PSL_CTRL *PSL) {
4495 	/* Simply pass the plot back to caller  */
4496 	if (!PSL->internal.memory) {
4497 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Cannot get a plot since memory output was not activated!\n");
4498 		return (NULL);
4499 	}
4500 	if (!PSL->internal.buffer) {
4501 		PSL_message (PSL, PSL_MSG_ERROR, "Error: No plot in memory available!\n");
4502 		return (NULL);
4503 	}
4504 	return (PSL->internal.buffer);
4505 }
4506 
PSL_beginplot(struct PSL_CTRL * PSL,FILE * fp,int orientation,int overlay,int color_mode,char origin[],double offset[],double page_size[],char * title,int font_no[])4507 int PSL_beginplot (struct PSL_CTRL *PSL, FILE *fp, int orientation, int overlay, int color_mode, char origin[], double offset[], double page_size[], char *title, int font_no[]) {
4508 /* fp:		Output stream or NULL for standard output
4509    orientation:	0 = landscape, 1 = portrait.  If orientation &2 then we write to memory array [Default is to fp]
4510 		If orientation&4 then we must reissue font encoding due to a change in charset
4511    overlay:	true if this is an overlay plot [false means print headers and macros first]
4512    color_mode:	0 = RGB color, 1 = CMYK color, 2 = HSV color, 3 = Gray scale
4513    origin:	Two characters indicating origin of new position for x and y respectively:
4514 		'r' = Relative to old position (default)
4515 		'a' = Relative to old position and resets at PSL_endplot
4516 		'f' = Relative to lower left corner of the page
4517 		'c' = Relative to center of the page
4518    offset:	Location of new origin relative to what is specified by "origin" (in user units)
4519    page_size:	Physical width and height of paper used in points
4520    title:	Title of the plot (or NULL if not specified)
4521    font_no:	Array of font numbers used in the document (or NULL if not determined)
4522 */
4523 	int i, manual_feed = false, err = 0, change_charset = 0;
4524 	double no_rgb[4] = {-1.0, -1.0, -1.0, 0.0}, dummy_rgb[4] = {-2.0, -2.0, -2.0, 0.0}, black[4] = {0.0, 0.0, 0.0, 0.0}, scl;
4525 	time_t right_now;
4526 	const char *uname[4] = {"cm", "inch", "meter", "point"}, xy[2] = {'x', 'y'};
4527 	const double units_per_inch[4] = {2.54, 1.0, 0.0254, 72.0};	/* cm, inch, m, points per inch */
4528 	char PSL_encoding[64] = {""};
4529 
4530 	if (!PSL) return (PSL_NO_SESSION);	/* Never was allocated */
4531 
4532 	PSL->internal.memory = (orientation & PSL_MEMORY);	/* true if we wish to write PS to memory instead of to file */
4533 	if (PSL->internal.memory) orientation -= PSL_MEMORY;
4534 	change_charset = (orientation & PSL_CHANGESET);	/* true if we must update the character set */
4535 	if (change_charset) orientation -= PSL_CHANGESET;
4536 
4537 	/* Save original initialization settings */
4538 
4539 	PSL->internal.call_level++;	/* Becomes 1 for first module calling it, 2 if that module calls for plotting, etc */
4540 	if (PSL->internal.call_level == 1)
4541 		PSL->internal.fp = (fp == NULL) ? stdout : fp;	/* For higher levels we reuse existing file pointer */
4542 	PSL->internal.overlay = overlay;
4543 	memcpy (PSL->init.page_size, page_size, 2 * sizeof(double));
4544 
4545 	PSL->internal.color_mode = color_mode;
4546 	if (!origin)
4547 		PSL->internal.origin[0] = PSL->internal.origin[1] = 'r';
4548 	else
4549 		PSL->internal.origin[0] = origin[0], PSL->internal.origin[1] = origin[1];
4550 	PSL->internal.p_width  = fabs (page_size[0]);
4551 	PSL->internal.p_height = fabs (page_size[1]);
4552 	manual_feed = (page_size[0] < 0.0);			/* Want Manual Request for paper */
4553 	PSL_settransparencymode (PSL, "Normal");		/* Default PDF transparency mode */
4554 	PSL_setfontdims (PSL, PSL_SUBSUP_SIZE, PSL_SCAPS_SIZE, PSL_SUP_UP_LC, PSL_SUP_UP_UC, PSL_SUB_DOWN);	/* Default sub/sup/scaps dimensions */
4555 
4556 	PSL->current.linewidth = -1.0;				/* Will be changed by PSL_setlinewidth */
4557 	PSL_rgb_copy (PSL->current.rgb[PSL_IS_STROKE], dummy_rgb);		/* Will be changed by PSL_setcolor */
4558 	PSL->current.outline = -1;				/* Will be changed by PSL_setfill */
4559 	PSL_rgb_copy (PSL->current.rgb[PSL_IS_FILL], dummy_rgb);	/* Will be changed by PSL_setfill */
4560 
4561 	PSL->internal.dpu = PSL_DOTS_PER_INCH / units_per_inch[PSL->init.unit];	/* Dots per unit resolution of output device */
4562 	PSL->internal.dpp = PSL_DOTS_PER_INCH / units_per_inch[PSL_PT];		/* Dots per point resolution of output device */
4563 	PSL->internal.x2ix = PSL->internal.dpu;					/* Scales x coordinates to dots */
4564 	PSL->internal.y2iy = PSL->internal.dpu;					/* Scales y coordinates to dots */
4565 	PSL->internal.x0 = PSL->internal.y0 = 0;				/* Offsets for x and y when mapping user x,y to PS ix,iy */
4566 	PSL->internal.p2u = PSL->internal.dpp / PSL->internal.dpu;		/* Converts dimensions in points to user units */
4567 
4568 	right_now = time ((time_t *)0);
4569 	PSL->internal.landscape = !(overlay || orientation);	/* Only rotate if not overlay and not Portrait */
4570 	PSL->internal.prev_offset[0] = PSL->internal.offset[0];
4571 	PSL->internal.prev_offset[1] = PSL->internal.offset[1];
4572 	PSL->internal.offset[0] = offset[0];
4573 	PSL->internal.offset[1] = offset[1];
4574 
4575 	/* Initialize global variables */
4576 	strcpy (PSL->current.bw_format, "%.3lg A");			/* Default format used for grayshade value */
4577 	strcpy (PSL->current.rgb_format, "%.3lg %.3lg %.3lg C");	/* Same, for RGB triplets */
4578 	strcpy (PSL->current.hsv_format, "%.3lg %.3lg %.3lg H");	/* Same, for HSV triplets */
4579 	strcpy (PSL->current.cmyk_format, "%.3lg %.3lg %.3lg %.3lg K");	/* Same, for CMYK quadruples */
4580 
4581 	/* In case this is the last overlay, set the Bounding box coordinates to be used atend */
4582 
4583 	if (overlay) {	/* Must issue PSL header - this is the start of a new panel */
4584 		if (change_charset) {
4585 			PSL_comment (PSL, "Encode fonts using selected character set: %s\n", PSL->init.encoding);
4586 			sprintf (PSL_encoding, "PSL_%s", PSL->init.encoding);	/* Prepend the PSL_ prefix */
4587 			err = psl_place_encoding (PSL, PSL_encoding);
4588 			if (err) return err;
4589 			psl_def_font_encoding (PSL);		/* Initialize book-keeping for font encoding and write font macros */
4590 		}
4591 		if (PSL->current.complete) {	/* Execute the panel completion function, then disable again */
4592 			PSL_comment (PSL, "Run PSL completion function from last overlay, if defined\n");
4593 			PSL_command (PSL, "PSL_plot_completion /PSL_plot_completion {} def\n");	/* Run then make it a null function */
4594 			PSL->current.complete = 0;
4595 		}
4596 	}
4597 	else {	/* Must issue PSL header - this is the start of a new plot */
4598 
4599 		if (PSL->internal.memory) {	/* Will be writing to memory so need to set that up */
4600 			psl_freeplot (PSL);	/* Free any previous plot laying around */
4601 			PSL->internal.buffer  = PSL_memory (PSL, NULL, PSL_MEM_ALLOC, char);
4602 			PSL->internal.n_alloc = PSL_MEM_ALLOC;
4603 			PSL->internal.n	      = 0;
4604 			PSL->internal.pmode   = 1;	/*	Header of plot will be written below */
4605 		}
4606 
4607 		PSL_command (PSL, "%%!PS-Adobe-3.0\n");
4608 
4609 		/* Write definitions of macros to plotfile */
4610 
4611 		PSL_command (PSL, "%%%%BoundingBox: 0 0 %d %d\n", lrint (PSL->internal.p_width), lrint (PSL->internal.p_height));
4612 		/* The spaces below are to accommodate eventual need by psconvert when working with in-memory-PS */
4613 		PSL_command (PSL, "%%%%HiResBoundingBox: 0 0 %.4lf %.4lf             \n", PSL->internal.p_width, PSL->internal.p_height);
4614 		if (title) {
4615 			PSL_command (PSL, "%%%%Title: %s\n", title);
4616 			PSL_command (PSL, "%%%%Creator: %s\n", PSL->init.session);
4617 		}
4618 		else {
4619 			PSL_command (PSL, "%%%%Title: PSL v%s document\n", PSL_Version);
4620 			PSL_command (PSL, "%%%%Creator: PSL\n");
4621 		}
4622 		PSL_command (PSL, "%%%%For: %s\n", psl_putusername());
4623 		if (font_no) {
4624 			PSL_command (PSL, "%%%%DocumentNeededResources: font");
4625 			for (i = 0; i < PSL_MAX_EPS_FONTS && font_no[i] != -1; i++) PSL_command (PSL, " %s", PSL->internal.font[font_no[i]].name);
4626 			PSL_command (PSL, "\n");
4627 		}
4628 
4629 		PSL_command (PSL, "%%%%CreationDate: %s", ctime(&right_now));
4630 		PSL_command (PSL, "%%%%LanguageLevel: %d\n", PS_LANGUAGE_LEVEL);
4631 		PSL_command (PSL, "%%%%DocumentData: Clean7Bit\n");
4632 		if (PSL->internal.landscape)
4633 			PSL_command (PSL, "%%%%Orientation: Landscape\n");
4634 		else
4635 			PSL_command (PSL, "%%%%Orientation: Portrait\n");
4636 		PSL_command (PSL, "%%%%Pages: 1\n");
4637 		PSL_command (PSL, "%%%%EndComments\n\n");
4638 
4639 		PSL_command (PSL, "%%%%BeginProlog\n");
4640 		psl_bulkcopy (PSL, "PSL_prologue");	/* General PS code */
4641 		sprintf (PSL_encoding, "PSL_%s", PSL->init.encoding);	/* Prepend the PSL_ prefix */
4642 		err = psl_place_encoding (PSL, PSL_encoding);
4643 		if (err) return err;
4644 		psl_def_font_encoding (PSL);		/* Initialize book-keeping for font encoding and write font macros */
4645 
4646 		psl_bulkcopy (PSL, "PSL_label");	/* PS code for label line annotations and clipping */
4647 		PSL_command (PSL, "%%%%EndProlog\n\n");
4648 
4649 		PSL_command (PSL, "%%%%BeginSetup\n");
4650 		PSL_command (PSL, "/PSLevel /languagelevel where {pop languagelevel} {1} ifelse def\n");
4651 		PSL_command (PSL, "PSLevel 1 gt { << /WhiteIsOpaque true >> setpagedevice } if\n");
4652 		if (manual_feed)	/* Manual media feed requested */
4653 			PSL_command (PSL, "PSLevel 1 gt { << /ManualFeed true >> setpagedevice } if\n");
4654 		else if (PSL->internal.p_width > 0.0 && PSL->internal.p_height > 0.0)	/* Specific media selected */
4655 			PSL_command (PSL, "PSLevel 1 gt { << /PageSize [%.12g %.12g] /ImagingBBox null >> setpagedevice } if\n",
4656 			             PSL->internal.p_width, PSL->internal.p_height);
4657 		if (PSL->init.copies > 1) PSL_command (PSL, "/#copies %d def\n", PSL->init.copies);
4658 		PSL_command (PSL, "%%%%EndSetup\n\n");
4659 
4660 		PSL_command (PSL, "%%%%Page: 1 1\n\n");
4661 
4662 		PSL_command (PSL, "%%%%BeginPageSetup\n");
4663 		PSL_comment (PSL, "Init coordinate system and scales\n");
4664 		scl = 1.0 / PSL->internal.dpp;
4665 		PSL_comment (PSL, "Scale initialized to %.12g, so 1 %s equals %.12g Postscript units\n", scl, uname[PSL->init.unit], PSL->internal.dpu);
4666 
4667 		PSL_command (PSL, "V ");
4668 		if (PSL->internal.landscape) PSL_command (PSL, "%.12g 0 T 90 R ", PSL->internal.p_width);
4669 		PSL_command (PSL, "%.12g %.12g scale\n", PSL->init.magnify[0] * scl, PSL->init.magnify[1] * scl);
4670 		PSL_command (PSL, "%%%%EndPageSetup\n\n");
4671 
4672 		if (!(PSL_is_gray(PSL->init.page_rgb) && PSL_eq(PSL->init.page_rgb[0],1.0)))	/* Change background color from white but not if PSL_no_pagefill is set via psconvert */
4673 			PSL_command (PSL, "systemdict /PSL_no_pagefill known not {clippath %s F N} if\n", psl_putcolor (PSL, PSL->init.page_rgb, 0));
4674 		PSL_comment (PSL, "End of PSL header\n");
4675 
4676 		/* Save page size */
4677 		PSL_defpoints (PSL, "PSL_page_xsize", PSL->internal.landscape ? PSL->internal.p_height : PSL->internal.p_width);
4678 		PSL_defpoints (PSL, "PSL_page_ysize", PSL->internal.landscape ? PSL->internal.p_width : PSL->internal.p_height);
4679 
4680 		PSL_command (PSL, "/PSL_plot_completion {} def\n");	/* Initialize custom procedure as a null function */
4681 		PSL_command (PSL, "/PSL_movie_label_completion {} def\n");	/* Initialize custom procedure as a null function */
4682 		PSL_command (PSL, "/PSL_movie_prog_indicator_completion {} def\n");	/* Initialize custom procedure as a null function */
4683 
4684 		/* Write out current settings for cap, join, and miter; these may be changed by user at any time later */
4685 		i = PSL->internal.line_cap;	PSL->internal.line_cap = PSL_BUTT_CAP;		PSL_setlinecap (PSL, i);
4686 		i = PSL->internal.line_join;	PSL->internal.line_join = PSL_MITER_JOIN;	PSL_setlinejoin (PSL, i);
4687 		i = PSL->internal.miter_limit;	PSL->internal.miter_limit = PSL_MITER_DEFAULT;	PSL_setmiterlimit (PSL, i);
4688 		PSL_command (PSL, "%%PSL_End_Header\n");
4689 		PSL_command (PSL, "gsave\n");	/* Begin encapsulation of main body for this plot */
4690 	}
4691 
4692 	/* Set default line color and no-rgb */
4693 	PSL_setcolor (PSL, black, PSL_IS_STROKE);
4694 	PSL_setfill (PSL, no_rgb, 0);
4695 
4696 	/* Set origin of the plot */
4697 
4698 	if (PSL->internal.comments)  PSL_command (PSL, "%% Set plot origin:\n");
4699 	for (i = 0; i < 2; i++) {
4700 		switch (PSL->internal.origin[i]) {
4701 			case 'f': PSL_command (PSL, "%d PSL_%corig sub ", psl_iz (PSL, offset[i]), xy[i]); break;
4702 			case 'c': PSL_command (PSL, "%d PSL_%corig sub PSL_page_%csize 2 div add ", psl_iz (PSL, offset[i]), xy[i], xy[i]); break;
4703 			default : PSL_command (PSL, "%d ", psl_iz (PSL, offset[i])); break;
4704 		}
4705 	}
4706 	PSL_command (PSL, "TM\n");
4707 
4708 	return (PSL_NO_ERROR);
4709 }
4710 
PSL_setlinecap(struct PSL_CTRL * PSL,int cap)4711 int PSL_setlinecap (struct PSL_CTRL *PSL, int cap) {
4712 	if (cap != PSL->internal.line_cap) {
4713 		PSL_command (PSL, "%d setlinecap\n", cap);
4714 		PSL->internal.line_cap = cap;
4715 	}
4716 	return (PSL_NO_ERROR);
4717 }
4718 
PSL_setlinejoin(struct PSL_CTRL * PSL,int join)4719 int PSL_setlinejoin (struct PSL_CTRL *PSL, int join) {
4720 	if (join != PSL->internal.line_join) {
4721 		PSL_command (PSL, "%d setlinejoin\n", join);
4722 		PSL->internal.line_join = join;
4723 	}
4724 	return (PSL_NO_ERROR);
4725 }
4726 
PSL_setmiterlimit(struct PSL_CTRL * PSL,int limit)4727 int PSL_setmiterlimit (struct PSL_CTRL *PSL, int limit) {
4728 	if (limit != PSL->internal.miter_limit) {
4729 		PSL_command (PSL, "%.12g setmiterlimit\n", (limit == 0) ? 10.0 : 1.0 / sin (0.5 * limit * D2R));
4730 		PSL->internal.miter_limit = limit;
4731 	}
4732 	return (PSL_NO_ERROR);
4733 }
4734 
PSL_plotbox(struct PSL_CTRL * PSL,double x0,double y0,double x1,double y1)4735 int PSL_plotbox (struct PSL_CTRL *PSL, double x0, double y0, double x1, double y1) {
4736 	/* Draw rectangle with corners (x0,y0) and (x1,y1) */
4737 	int llx, lly;
4738 	llx = psl_ix (PSL, x0);
4739 	lly = psl_iy (PSL, y0);
4740 	PSL_command (PSL, "%d %d %d %d Sb\n", psl_iy (PSL, y1) - lly, psl_ix (PSL, x1) - llx, llx, lly);
4741 	return (PSL_NO_ERROR);
4742 }
4743 
PSL_plotpolygon(struct PSL_CTRL * PSL,double * x,double * y,int n)4744 int PSL_plotpolygon (struct PSL_CTRL *PSL, double *x, double *y, int n) {
4745 	/* Draw and optionally fill polygons. If 20 or fewer points we use
4746 	 * the more expedited psl_patch function
4747 	 */
4748 
4749 	if (n <= 20)
4750 		psl_patch (PSL, x, y, n);	/* Small polygons can use the patch function */
4751 	else {
4752 		PSL_plotline (PSL, x, y, n, PSL_MOVE);	/* No stroke or close path yet; see next line */
4753 		PSL_command (PSL, "FO\n");		/* Close polygon and stroke/fill as set by PSL_setfill */
4754 	}
4755 
4756 	return (PSL_NO_ERROR);
4757 }
4758 
PSL_setexec(struct PSL_CTRL * PSL,int action)4759 int PSL_setexec (struct PSL_CTRL *PSL, int action) {
4760 	/* Enables of disables the execution of a PSL_plot_completion function at start of a PSL_plotinit overlay */
4761 	PSL->current.complete = (action) ? 1 : 0;
4762 	return (PSL_NO_ERROR);
4763 }
4764 
PSL_setdash(struct PSL_CTRL * PSL,char * style,double offset)4765 int PSL_setdash (struct PSL_CTRL *PSL, char *style, double offset) {
4766 	/* Line structure in points
4767 	 * offset from currentpoint in points
4768 	 * style = "1 2", offset = 0:
4769 	 *   1 point of line, 2 points of space, start at current point
4770 	 * style = "5 3 1 3", offset = 2:
4771 	 *   5 points line, 3 points space, 1 points line, 3 points space,
4772 	 *   starting 2 points from current point.
4773 	 */
4774 
4775 	if (PSL->current.style[0] == '\0') { /* No previous style, so previous offset does not matters */
4776 		if (!style || style[0] == '\0') return (PSL_NO_ERROR);	/* No new style given, so just return */
4777 	}
4778 	/* Here, we have a previous non-NULL style */
4779 	if (!style || style[0] == '\0') {	/* No style wanted going forwards, so we do a full reset */
4780 		memset (PSL->current.style, 0, PSL_PEN_LEN);
4781 		PSL->current.offset = 0;
4782 		PSL_command (PSL, "[] 0 B\n");
4783 		return (PSL_NO_ERROR);
4784 	}
4785 	/* Here we have a previous style AND we have specified a (possibly) new style */
4786 	if (PSL_eq(offset,PSL->current.offset) && !strcmp (style, PSL->current.style)) return (PSL_NO_ERROR);	/* Same as before, so just return */
4787 	/* Finally, a new style has been given that differs from the previous and we need to update our settings */
4788 	PSL->current.offset = offset;
4789 	strncpy (PSL->current.style, style, PSL_PEN_LEN);
4790 	PSL_command (PSL, "%s\n", psl_putdash (PSL, style, offset));
4791 	return (PSL_NO_ERROR);
4792 }
4793 
PSL_setfont(struct PSL_CTRL * PSL,int font_no)4794 int PSL_setfont (struct PSL_CTRL *PSL, int font_no) {
4795 	if (font_no == PSL->current.font_no) return (PSL_NO_ERROR);	/* Already set */
4796 	if (font_no < 0 || font_no >= PSL->internal.N_FONTS) {
4797 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Selected font (%d) out of range (0-%d); reset to 0\n", font_no, PSL->internal.N_FONTS-1);
4798 		font_no = 0;
4799 	}
4800 	PSL->current.font_no = font_no;
4801 	PSL->current.fontsize = 0.0;	/* Forces "%d F%d" to be written on next call to psl_putfont */
4802 	/* Encoding will be done by subsequent calls inside the text-producing routines through calls to psl_encodefont [PS: testing line below] */
4803 	psl_encodefont (PSL, PSL->current.font_no);
4804 
4805 	return (PSL_NO_ERROR);
4806 }
4807 
PSL_setfontdims(struct PSL_CTRL * PSL,double supsub,double scaps,double sup_lc,double sup_uc,double sdown)4808 int PSL_setfontdims (struct PSL_CTRL *PSL, double supsub, double scaps, double sup_lc, double sup_uc, double sdown) {
4809 	/* Adjust settings of sub/super/small caps attributes */
4810 	if (supsub <= 0.0 || supsub >= 1.0) {
4811 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Size of sub/super-script (%g) exceed allowable range, reset to %^g\n", supsub, PSL_SUBSUP_SIZE);
4812 		supsub = PSL_SUBSUP_SIZE;
4813 	}
4814 	if (scaps <= 0.0 || scaps >= 1.0) {
4815 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Size of small caps text (%g) exceed allowable range, reset to %^g\n", scaps, PSL_SCAPS_SIZE);
4816 		scaps = PSL_SUBSUP_SIZE;
4817 	}
4818 	if (sup_lc <= 0.0 || sup_lc >= 1.0) {
4819 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Amount of baseline shift for lower-case super-scripts (%g) exceed allowable range, reset to %^g\n",
4820 		             sup_lc, PSL_SUP_UP_LC);
4821 		sup_lc = PSL_SUBSUP_SIZE;
4822 	}
4823 	if (sup_uc <= 0.0 || sup_uc >= 1.0) {
4824 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Amount of baseline shift for upper-case super-scripts (%g) exceed allowable range, reset to %^g\n",
4825 		             sup_uc, PSL_SUP_UP_UC);
4826 		sup_uc = PSL_SUBSUP_SIZE;
4827 	}
4828 	if (sdown <= 0.0 || sdown >= 1.0) {
4829 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Amount of baseline shift for sub-scripts (%g) exceed allowable range, reset to %^g\n",
4830 		             sdown, PSL_SUB_DOWN);
4831 		sdown = PSL_SUBSUP_SIZE;
4832 	}
4833 	PSL->current.subsupsize = supsub;
4834 	PSL->current.scapssize  = scaps;
4835 	PSL->current.sub_down   = sdown;
4836 	PSL->current.sup_up[PSL_LC] = sup_lc;
4837 	PSL->current.sup_up[PSL_UC] = sup_uc;
4838 
4839 	return (PSL_NO_ERROR);
4840 }
4841 
PSL_setformat(struct PSL_CTRL * PSL,int n_decimals)4842 int PSL_setformat (struct PSL_CTRL *PSL, int n_decimals) {
4843 	/* Sets number of decimals used for rgb/gray specifications [3] */
4844 	if (n_decimals < 1 || n_decimals > 3)
4845 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Selected decimals for color out of range (%d), ignored\n", n_decimals);
4846 	else {
4847 		sprintf (PSL->current.bw_format, "%%.%df A", n_decimals);
4848 		sprintf (PSL->current.rgb_format, "%%.%df %%.%df %%.%df C", n_decimals, n_decimals, n_decimals);
4849 		sprintf (PSL->current.hsv_format, "%%.%df %%.%df %%.%df H", n_decimals, n_decimals, n_decimals);
4850 		sprintf (PSL->current.cmyk_format, "%%.%df %%.%df %%.%df %%.%df K", n_decimals, n_decimals, n_decimals, n_decimals);
4851 	}
4852 	return (PSL_NO_ERROR);
4853 }
4854 
PSL_setlinewidth(struct PSL_CTRL * PSL,double linewidth)4855 int PSL_setlinewidth (struct PSL_CTRL *PSL, double linewidth) {
4856 	if (linewidth < 0.0) {
4857 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Selected linewidth is negative (%g), ignored\n", linewidth);
4858 		return (PSL_BAD_WIDTH);
4859 	}
4860 	if (linewidth == PSL->current.linewidth) return (PSL_NO_ERROR);
4861 
4862 	PSL_command (PSL, "%d W\n", psl_ip (PSL, linewidth));
4863 	PSL->current.linewidth = linewidth;
4864 	return (PSL_NO_ERROR);
4865 }
4866 
PSL_setcolor(struct PSL_CTRL * PSL,double rgb[],int mode)4867 int PSL_setcolor (struct PSL_CTRL *PSL, double rgb[], int mode) {
4868 	/* Set the pen (PSL_IS_STROKE) color or fill (PSL_IS_FILL) color or pattern
4869 	 * rgb[0] = -3: set pattern, rgb[1] is pattern number setup by PSL_setpattern
4870 	 * rgb[0] = -2: ignore. Do not change pen color. Leave untouched.
4871 	 * rgb[0] = -1: ignore. Do not change pen color. Leave untouched.
4872 	 * rgb[0] >= 0: rgb is the color with R G B in 0-1 range.
4873 	 */
4874 	if (!rgb) return (PSL_NO_ERROR);	/* NULL args to be ignored */
4875 	if (mode == PSL_IS_FONT) {	/* Internally update font color but set stroke color */
4876 		PSL_rgb_copy (PSL->current.rgb[mode], rgb);
4877 		mode = PSL_IS_STROKE;
4878 	}
4879 	if (PSL_eq (rgb[0], -2.0) || PSL_eq (rgb[0], -1.0)) return (PSL_NO_ERROR);	/* Settings to be ignored */
4880 	if (PSL_same_rgb (rgb, PSL->current.rgb[mode])) return (PSL_NO_ERROR);	/* Same color as already set */
4881 
4882 	/* Because psl_putcolor does not set transparency if it is 0%, we reset it here when needed */
4883 	if (PSL_eq (rgb[3], 0.0) && !PSL_eq (PSL->current.rgb[mode][3], 0.0)) PSL_command (PSL, "1 1 /Normal PSL_transp ");
4884 
4885 	/* Then, finally, set the color using psl_putcolor */
4886 	PSL_command (PSL, "%s\n", psl_putcolor (PSL, rgb, 0));
4887 
4888 	/* Update the current stroke/fill color information */
4889 
4890 	PSL_rgb_copy (PSL->current.rgb[mode], rgb);
4891 	return (PSL_NO_ERROR);
4892 }
4893 
PSL_makepen(struct PSL_CTRL * PSL,double linewidth,double rgb[],char * pattern,double offset)4894 char * PSL_makepen (struct PSL_CTRL *PSL, double linewidth, double rgb[], char *pattern, double offset) {
4895 	/* Creates a text string with the corresponding PS command to set the pen */
4896 	static char buffer[PSL_BUFSIZ];
4897 	sprintf (buffer, "%d W %s %s", psl_ip (PSL, linewidth), psl_putcolor (PSL, rgb, 0), psl_putdash (PSL, pattern, offset));
4898 	return (buffer);
4899 }
4900 
PSL_makefont(struct PSL_CTRL * PSL,double size,double rgb[])4901 char * PSL_makefont (struct PSL_CTRL *PSL, double size, double rgb[]) {
4902 	/* Creates a text string with the corresponding PS command to set the font (current font) */
4903 	static char buffer[PSL_BUFSIZ];
4904 	sprintf (buffer, "%s %d F%d", psl_putcolor (PSL, rgb, 0), psl_ip (PSL, size), PSL->current.font_no);
4905 	return (buffer);
4906 }
4907 
PSL_makefontsize(struct PSL_CTRL * PSL,double size)4908 char * PSL_makefontsize (struct PSL_CTRL *PSL, double size) {
4909 	/* Creates a text string with the corresponding PS command to set the font (current font) with no color info */
4910 	static char buffer[PSL_BUFSIZ];
4911 	sprintf (buffer, "%d F%d", psl_ip (PSL, size), PSL->current.font_no);
4912 	return (buffer);
4913 }
4914 
PSL_makecolor(struct PSL_CTRL * PSL,double rgb[])4915 char * PSL_makecolor (struct PSL_CTRL *PSL, double rgb[]) {
4916 	/* Creates a text string with the corresponding PS command to set the color */
4917 	static char buffer[PSL_BUFSIZ];
4918 	sprintf (buffer, "%s", psl_putcolor (PSL, rgb, 0));
4919 	return (buffer);
4920 }
4921 
PSL_settextmode(struct PSL_CTRL * PSL,int mode)4922 int PSL_settextmode (struct PSL_CTRL *PSL, int mode) {
4923 	/* Change from laissez-faire to replacing hyphens with minus sign char code */
4924 	switch (mode) {
4925 		case PSL_TXTMODE_HYPHEN:
4926 			PSL->current.use_minus = PSL_TXTMODE_HYPHEN;
4927 			break;
4928 		case PSL_TXTMODE_MINUS:
4929 			PSL->current.use_minus = PSL_TXTMODE_MINUS;
4930 			break;
4931 		default:
4932 			PSL_message (PSL, PSL_MSG_ERROR, "Error: bad argument passed to PSL_settextmode (%d)!\n", mode);
4933 			return (PSL_BAD_FLAG);
4934 			break;
4935 	}
4936 	return (PSL_NO_ERROR);
4937 }
4938 
PSL_setdefaults(struct PSL_CTRL * PSL,double xyscales[],double page_rgb[],char * encoding)4939 int PSL_setdefaults (struct PSL_CTRL *PSL, double xyscales[], double page_rgb[], char *encoding) {
4940 	/* Changes the standard PSL defaults for:
4941 	 * xyscales:	Global x- and y-scale magnifier [1.0, 1.0]
4942 	 * page_rgb:	Page color [white = 1/1/1]; give NULL to leave unchanged.
4943 	 *
4944 	 * Only non-zero values will result in a change */
4945 
4946 	if (xyscales[0] != 0.0) PSL->init.magnify[0] = xyscales[0];	/* Change plot x magnifier */
4947 	if (xyscales[1] != 0.0) PSL->init.magnify[1] = xyscales[1];	/* Change plot y magnifier */
4948 	if (page_rgb) PSL_rgb_copy (PSL->init.page_rgb, page_rgb);	/* Change media color */
4949 	if (PSL->init.encoding && encoding && strcmp (PSL->init.encoding, encoding)) {
4950 		PSL_free (PSL->init.encoding);
4951 		PSL->init.encoding = strdup (encoding);
4952 	}
4953 	else if (!PSL->init.encoding)
4954 		PSL->init.encoding = (encoding) ? strdup (encoding) : strdup ("Standard");
4955 	return (PSL_NO_ERROR);
4956 }
4957 
PSL_plottextbox(struct PSL_CTRL * PSL,double x,double y,double fontsize,char * text,double angle,int justify,double offset[],int mode)4958 int PSL_plottextbox (struct PSL_CTRL *PSL, double x, double y, double fontsize, char *text, double angle, int justify, double offset[], int mode) {
4959 	/* Plot a box to be later filled with text. The box is
4960 	 * filled according to the current fill style (set by PSL_setfill).
4961 	 * Note that this routine does not actually show the text. Use
4962 	 * PSL_plottext for that after calling PSL_plottextbox
4963 	 * x,y = location of string
4964 	 * fontsize = fontsize in points. Use negative to indicate that anchor has already been set.
4965 	 * text = text to be boxed in
4966 	 * angle = angle with baseline (horizontal)
4967 	 * justify indicates what x,y refers to, see fig below
4968 	 * mode = 1 makes rounded corners (if offset is nonzero); 0 gives straight corners
4969 	 * offset[0-1] = Horizontal/vertical space between box border and text
4970 	 *
4971 	 *
4972 	 *   9       10      11
4973 	 *   |----------------|
4974 	 *   5  <textstring>  7
4975 	 *   |----------------|
4976 	 *   1       2        3
4977 	 */
4978 
4979 	/* PS strings to be used dependent on "justify%4". Empty string added for unused value. */
4980 	const char *align[4] = {"0", "-2 div", "neg", ""};
4981 	int i = 0, j, x_just, y_just, new_anchor;
4982 	double dx, dy;
4983 
4984 	if (fontsize == 0.0) return (PSL_NO_ERROR);	/* Nothing to do if text has zero size */
4985 	new_anchor = (fontsize > 0.0);
4986 	fontsize = fabs (fontsize);
4987 
4988 	if (strlen (text) >= (PSL_BUFSIZ-1)) {
4989 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: text_item > %d long!\n", PSL_BUFSIZ);
4990 		return (PSL_BAD_TEXT);
4991 	}
4992 
4993 	dx = offset[0];	dy = offset[1];
4994 	if (dx <= 0.0 || dy <= 0.0) mode = false;
4995 	PSL_comment (PSL, "PSL_plottextbox begin:\n");
4996 	psl_encodefont (PSL, PSL->current.font_no);
4997 	psl_putfont (PSL, fontsize);
4998 	PSL_command (PSL, "V\n");
4999 
5000 	if (justify < 0)  {	/* Strip leading and trailing blanks */
5001 		for (i = 0; text[i] == ' '; i++);
5002 		for (j = (int)strlen (text) - 1; text[j] == ' '; j--) text[j] = 0;
5003 		justify = -justify;
5004 	}
5005 
5006 	PSL_deftextdim (PSL, "PSL_dim", fontsize, &text[i]);	/* Set the string dimensions in PS */
5007 	PSL_defunits (PSL, "PSL_dx", dx);
5008 	PSL_defunits (PSL, "PSL_dy", dy);
5009 
5010 	/* Got to anchor point */
5011 
5012 	if (new_anchor) {	/* Set a new anchor point */
5013 		PSL->internal.ix = psl_ix (PSL, x);
5014 		PSL->internal.iy = psl_iy (PSL, y);
5015 		PSL_command (PSL, "%d %d T ", PSL->internal.ix, PSL->internal.iy);
5016 	}
5017 
5018 	if (angle != 0.0) PSL_command (PSL, "%.12g R ", angle);
5019 	if (justify > 1) {			/* Move the new origin so (0,0) is lower left of box */
5020 		x_just = (justify + 3) % 4;	/* Gives 0 (left justify, i.e., do nothing), 1 (center), or 2 (right justify) */
5021 		y_just = justify / 4;		/* Gives 0 (bottom justify, i.e., do nothing), 1 (middle), or 2 (top justify) */
5022 		(x_just) ? PSL_command (PSL, "PSL_dim_w %s ", align[x_just]) : PSL_command (PSL, "0 ");
5023 		(y_just) ? PSL_command (PSL, "PSL_dim_h %s ", align[y_just]) : PSL_command (PSL, "0 ");
5024 		PSL_command (PSL, "T\n");
5025 	}
5026 	/* Here, (0,0) is lower point of textbox with no clearance yet */
5027 	PSL_command (PSL, "PSL_dim_h PSL_dim_d sub PSL_dy 2 mul add PSL_dim_x1 PSL_dim_x0 sub PSL_dx 2 mul add ");
5028 	if (mode)
5029 		PSL_command (PSL, "%d PSL_dim_x0 PSL_dx sub PSL_dim_d PSL_dy sub SB\n", psl_iz (PSL, MIN (dx, dy)));
5030 	else
5031 		PSL_command (PSL, "PSL_dim_x0 PSL_dx sub PSL_dim_d PSL_dy sub Sb\n");
5032 	PSL_command (PSL, "U\n");
5033 	PSL_comment (PSL, "PSL_plottextbox end:\n");
5034 	strncpy (PSL->current.string, &text[i], PSL_BUFSIZ - 1);	/* Save the string with one left for null terminator */
5035 	return (PSL_NO_ERROR);
5036 }
5037 
PSL_deftextdim(struct PSL_CTRL * PSL,const char * dim,double fontsize,char * text)5038 int PSL_deftextdim (struct PSL_CTRL *PSL, const char *dim, double fontsize, char *text) {
5039 	/* Will calculate the dimension of the given text string.
5040 	 * Because of possible escape sequences we need to examine the string
5041 	 * carefully.  The dimensions will be set in PostScript as dim_w, dim_h, dim_d
5042 	 * The width (dim_w) is determined by "stringwidth" and includes some whitespace, making,
5043 	 * for example, all numerical digits the same width (which we want). The height (dim_h)
5044 	 * is measured from the baseline and does not include any depth (below the baseline).
5045 	 * Finally, dim_d is the (negative) depth.
5046 	 * We try to produce the "stringwidth" result also when the string includes
5047 	 * escape sequences.
5048 	 * If dim is given as "-w", "-h", "-d" or "-b", do not assign dimensions, but leave width, height,
5049 	 * depth or both width and height on the PostScript stack.
5050 	 */
5051 
5052 	char *tempstring = NULL, *piece = NULL, *piece2 = NULL, *ptr = NULL, *string = NULL, *plast = NULL, previous[BUFSIZ] = {""}, c;
5053 	int dy, font, font2, sub_on, super_on, scaps_on, symbol_on, font_on, size_on, color_on, under_on, old_font, last_chr, kase = PSL_LC;
5054 	bool last_sub = false, last_sup = false, supersub, composite;
5055 	double orig_size, small_size, size, scap_size, ustep[2], dstep;
5056 
5057 	if (strlen (text) >= (PSL_BUFSIZ-1)) {
5058 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: text_item > %d long!\n", PSL_BUFSIZ);
5059 		return (PSL_BAD_TEXT);
5060 	}
5061 
5062 	string = psl_prepare_text (PSL, text);	/* Check for escape sequences */
5063 
5064 	psl_encodefont (PSL, PSL->current.font_no);
5065 	psl_putfont (PSL, fontsize);
5066 
5067 	if (!strchr (string, '@')) {	/* Plain text string */
5068 		if (dim[0] == '-')
5069 			PSL_command (PSL, "(%s) s%c ", string, dim[1]);
5070 		else
5071 			PSL_command (PSL, "(%s) V MU 0 0 M E /%s_w edef FP pathbbox N /%s_h edef /%s_x1 edef /%s_d edef /%s_x0 edef U\n",
5072 			             string, dim, dim, dim, dim, dim);
5073 		PSL_free (string);
5074 		return (PSL_NO_ERROR);
5075 	}
5076 
5077 	psl_got_composite_fontswitch (PSL, string);
5078 
5079 	/* Here, we have special request for Symbol font and sub/superscript
5080 	 * @~ toggles between Symbol font and default font
5081 	 * @%<fontno>% switches font number <fontno>; give @%% to reset
5082 	 * @- toggles between subscript and normal text
5083 	 * @+ toggles between superscript and normal text
5084 	 * @# toggles between Small caps and normal text
5085 	 * @! will make a composite character of next two characters
5086 	 * Use @@ to print a single @
5087 	 */
5088 
5089 	piece  = PSL_memory (PSL, NULL, 2 * PSL_BUFSIZ, char);
5090 	piece2 = PSL_memory (PSL, NULL, PSL_BUFSIZ, char);
5091 
5092 	font = font2 = old_font = PSL->current.font_no;
5093 	orig_size = size = fontsize;
5094 	small_size = size * PSL->current.subsupsize;	/* Sub-script/Super-script set at given fraction of font size */
5095 	scap_size = size * PSL->current.scapssize;	/* Small caps set at given fraction of font size */
5096 	ustep[PSL_LC] = PSL->current.sup_up[PSL_LC] * size;	/* Super-script baseline raised by given fraction of font size for lower case*/
5097 	ustep[PSL_UC] = PSL->current.sup_up[PSL_UC] * size;	/* Super-script baseline raised by given fraction of font size for upper case */
5098 	dstep = PSL->current.sub_down * size;		/* Sub-script baseline lowered by given fraction of font size */
5099 	sub_on = super_on = scaps_on = symbol_on = font_on = size_on = color_on = under_on = composite = false;
5100 	supersub = (strstr (string, "@-@+") || strstr (string, "@+@-"));	/* Check for sub/super combo */
5101 	tempstring = PSL_memory (PSL, NULL, strlen(string)+1, char);	/* Since strtok steps on it */
5102 	strcpy (tempstring, string);
5103 	ptr = strtok_r (tempstring, "@", &plast);
5104 	PSL_command (PSL, "V MU 0 0 M ");	/* Initialize currentpoint */
5105 	if (string[0] != '@') {
5106 		PSL_command (PSL, "(%s) FP ", ptr);
5107 		last_chr = ptr[strlen(ptr)-1];
5108 		ptr = strtok_r (NULL, "@", &plast);
5109 		kase = ((last_chr > 0 && last_chr < 255) && islower (last_chr)) ? PSL_LC : PSL_UC;
5110 	}
5111 
5112 	while (ptr) {
5113 		if (ptr[0] == '!') {	/* Composite character. Only use the second character to measure width */
5114 			ptr++;
5115 			if (ptr[0] == '\\')	/* Octal code */
5116 				ptr += 4;
5117 			else
5118 				ptr++;
5119 			/* Watch out for escaped font change before 2nd character */
5120 			if (ptr[0] == PSL_ASCII_ES) {	/* Have a font change on either side of 2nd character */
5121 				ptr++;
5122 				if (ptr[0] == '~')	/* Toggle the symbol font */
5123 					font2 = PSL_SYMBOL_FONT;
5124 				else {	/* Font switching with @%font% ...@%% */
5125 					ptr++;
5126 					font2 = psl_getfont (PSL, ptr);
5127 					while (*ptr != '%') ptr++;
5128 				}
5129 				ptr++;	/* Now at start of 2nd character */
5130 			}
5131 			else	/* No 2nd font */
5132 				font2 = font;
5133 			if (ptr[0] == '\\') {	/* Octal code */
5134 				c = ptr[4];
5135 				ptr[4] = '\0';	/* Temporary chop at end of this code */
5136 			}
5137 			else {
5138 				c = ptr[1];
5139 				ptr[1] = '\0';	/* Temporary chop at end of char */
5140 			}
5141 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);	/* Picked character2 */
5142 			if (ptr[0] == '\\')	{	/* Octal code */
5143 				ptr[4] = c;	/* Restore code */
5144 				ptr += 4;
5145 			}
5146 			else {
5147 				ptr[1] = c;	/* Restore char */
5148 				ptr++;
5149 			}
5150 			if (font2 != font) {	/* Skip past the font switcher */
5151 				ptr++;	/* Step over the implicit @ (ASCII 27) */
5152 				if (font2 == PSL_SYMBOL_FONT)
5153 					ptr++;	/* Move past the ~ */
5154 				else
5155 					ptr += 2;	/* Move past the %% */
5156 			}
5157 			composite = true;	/* Flag this case */
5158 		}
5159 		else if (ptr[0] == '~') {	/* Symbol font toggle */
5160 			symbol_on = !symbol_on;
5161 			font = (font == PSL_SYMBOL_FONT) ? old_font : PSL_SYMBOL_FONT;
5162 			ptr++;
5163 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5164 		}
5165 		else if (ptr[0] == '%') {	/* Switch font option */
5166 			font_on = !font_on;
5167 			ptr++;
5168 			if (ptr[0] == '%')
5169 				font = old_font;
5170 			else if (ptr[0]) {
5171 				old_font = font;
5172 				font = psl_getfont (PSL, ptr);
5173 			}
5174 			while (*ptr != '%') ptr++;
5175 			ptr++;
5176 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5177 		}
5178 		else if (ptr[0] == '-') {	/* Subscript toggle  */
5179 			ptr++;
5180 			sub_on = !sub_on;
5181 			if (sub_on) {
5182 				if (last_sup)	/* Just did a super-script, must reset horizontal position */
5183 					PSL_command (PSL, "PSL_last_width neg 0 G ");	/* Rewind position to orig baseline */
5184 				else if (supersub)	/* Need to remember the width of the subscript */
5185 					PSL_command (PSL, "/PSL_last_width %d F%d (%s) sw def\n", psl_ip (PSL, small_size), font, ptr);	/* Compute width of subscript text */
5186 				if (ptr[0]) strcpy (previous, ptr);	/* Keep copy of possibly previous text */
5187 			}
5188 			else
5189 				last_sub = (last_sup || ptr[0] == 0) ? supersub : false;	/* Only true when this is a possibility */
5190 			size = (sub_on) ? small_size : fontsize;
5191 			dy = (sub_on) ? -psl_ip (PSL, dstep) : psl_ip (PSL, dstep);
5192 			PSL_command (PSL, "0 %d G ", dy);
5193 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5194 		}
5195 		else if (ptr[0] == '+') {	/* Superscript toggle */
5196 			ptr++;
5197 			super_on = !super_on;
5198 			if (super_on) {
5199 				if (last_sub)	/* Just did a sub-script, must reset horizontal position */
5200 					PSL_command (PSL, "PSL_last_width neg 0 G ");	/* Rewind position to orig baseline */
5201 				else if (supersub)	/* Need to remember the width of the superscript */
5202 					PSL_command (PSL, "/PSL_last_width %d F%d (%s) sw def\n", psl_ip (PSL, small_size), font, ptr);	/* Compute width of subscript text */
5203 				if (ptr[0]) strcpy (previous, ptr);	/* Keep copy of possibly previous text */
5204 			}
5205 			else
5206 				last_sup = (last_sub || ptr[0] == 0) ? supersub : false;	/* Only true when this is a possibility */
5207 			size = (super_on) ? small_size : fontsize;
5208 			dy = (super_on) ? psl_ip (PSL, ustep[kase]) : -psl_ip (PSL, ustep[kase]);
5209 			PSL_command (PSL, "0 %d G ", dy);
5210 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5211 		}
5212 		else if (ptr[0] == '#') {	/* Small caps toggle */
5213 			scaps_on = !scaps_on;
5214 			size = (scaps_on) ? scap_size : fontsize;
5215 			ptr++;
5216 			(scaps_on) ? psl_get_uppercase (piece, ptr) : (void) strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5217 		}
5218 		else if (ptr[0] == ':') {	/* Font size change */
5219 			size_on = !size_on;
5220 			ptr++;
5221 			if (ptr[0] == ':')
5222 				size = fontsize = orig_size;
5223 			else {
5224 				size = fontsize = atof (ptr);
5225 				while (*ptr != ':') ptr++;
5226 			}
5227 			small_size = size * PSL->current.subsupsize;
5228 			scap_size = size * PSL->current.scapssize;
5229 			ptr++;
5230 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5231 		}
5232 		else if (ptr[0] == ';') {	/* Color change */
5233 			color_on = !color_on;
5234 			ptr++;
5235 			while (*ptr != ';') ptr++;
5236 			ptr++;
5237 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5238 		}
5239 		else if (ptr[0] == '_') {	/* Small caps toggle */
5240 			under_on = !under_on;
5241 			ptr++;
5242 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5243 		}
5244 		else {	/* Not recognized or @@ for a single @ */
5245 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5246 			last_sub = last_sup = false;
5247 		}
5248 		if (strlen (piece) > 0) {
5249 			if (last_sub && last_sup) {	/* May possibly need to move currentpoint a bit to the widest piece */
5250 				PSL_command (PSL, "/PSL_last_width PSL_last_width (%s) sw sub dup 0 lt {pop 0} if def\n", previous);	/* Compute width of superscript text and see if we must move a bit */
5251 				PSL_command (PSL, "PSL_last_width 0 G ");	/* Rewind position to orig baseline */
5252 				last_sub = last_sup = false;
5253 			}
5254 			if (ptr && composite) {
5255 				strcat (piece, ptr);
5256 				composite = false;
5257 			}
5258 			PSL_command (PSL, "%d F%d (%s) FP ", psl_ip (PSL, size), font, piece);
5259 			last_chr = ptr[strlen(piece)-1];
5260 			if (!super_on && (last_chr > 0 && last_chr < 255)) kase = (islower (last_chr)) ? PSL_LC : PSL_UC;
5261 		}
5262 		ptr = strtok_r (NULL, "@", &plast);
5263 	}
5264 
5265 	if (dim[0] == '-' && dim[1] == 'w')
5266 		PSL_command (PSL, "pathbbox N pop exch pop add U ");
5267 	else if (dim[0] == '-' && dim[1] == 'h')
5268 		PSL_command (PSL, "pathbbox N 4 1 roll pop pop pop U ");
5269 	else if (dim[0] == '-' && dim[1] == 'd')
5270 		PSL_command (PSL, "pathbbox N pop pop exch pop U ");
5271 	else if (dim[0] == '-' && dim[1] == 'H')
5272 		PSL_command (PSL, "pathbbox N exch pop exch sub exch pop U ");
5273 	else if (dim[0] == '-' && dim[1] == 'b')
5274 		PSL_command (PSL, "pathbbox N 4 1 roll exch pop add exch U ");
5275 	else
5276 		PSL_command (PSL, "pathbbox N /%s_h edef /%s_x1 edef /%s_d edef /%s_x0 edef /%s_w %s_x1 %s_x0 add def U\n",
5277 		             dim, dim, dim, dim, dim, dim, dim);
5278 
5279 	PSL_free (tempstring);
5280 	PSL_free (piece);
5281 	PSL_free (piece2);
5282 	PSL_free (string);
5283 
5284 	if (sub_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Sub-scripting not terminated [%s]\n", text);
5285 	if (super_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Super-scripting not terminated [%s]\n", text);
5286 	if (scaps_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Small-caps not terminated [%s]\n", text);
5287 	if (symbol_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Symbol font change not terminated [%s]\n", text);
5288 	if (size_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-size change not terminated [%s]\n", text);
5289 	if (color_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-color change not terminated [%s]\n", text);
5290 	if (under_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Text underline not terminated [%s]\n", text);
5291 
5292 	return (sub_on|super_on|scaps_on|symbol_on|font_on|size_on|color_on|under_on);
5293 }
5294 
PSL_plottext(struct PSL_CTRL * PSL,double x,double y,double fontsize,char * text,double angle,int justify,int mode)5295 int PSL_plottext (struct PSL_CTRL *PSL, double x, double y, double fontsize, char *text, double angle, int justify, int mode) {
5296 	/* General purpose text plotter for single line of text.  For paragraphs, see PSL_plotparagraph.
5297 	* PSL_plottext positions and justifies the text string according to the parameters given.
5298 	* The adjustments requires knowledge of font metrics and characteristics; hence all such
5299 	* adjustments are passed on to the PostScript interpreter who will calculate the offsets.
5300 	* The arguments to PSL_plottext are as follows:
5301 	*
5302 	* x,y:		location of string
5303 	* fontsize:	fontsize in points.  If negative, assume currentpoint is already set,
5304 	*		else we use x, y to set a new currentpoint.
5305 	* text:		text string to be plotted in the current color (set by PSL_setcolor).
5306 	*		If NULL is given then we assume PSL_plottextbox has just been called.
5307 	* angle:	angle between text baseline and the horizontal.
5308 	* justify:	indicates where on the textstring the x,y point refers to, see fig below.
5309 	*		If negative then we strip leading and trailing blanks from the text.
5310 	*		0 means no justification (already done separately).
5311 	* mode:	0 = normal text filled with solid color; 1 = draw outline of text using
5312 	*		the current line width and color; the text is filled with the current fill
5313 	*		(if set, otherwise no filling is taking place); 2 = no outline, but text fill
5314 	*		is a pattern so we use the outline path and not the show operator;
5315 	*       3 = same as 1, except that half the outline width is plotted on the outside
5316 	*       of the filled text, so none of the text font is obscured by the outline
5317 	*		(If the text is not filled, 1 operates the same as 3).
5318 	*
5319 	*   9	    10      11
5320 	*   |----------------|
5321 	*   5       6        7
5322 	*   |----------------|
5323 	*   1	    2	     3
5324 	*/
5325 
5326 	char *piece = NULL, *piece2 = NULL, *ptr = NULL, *string = NULL, previous[BUFSIZ] = {""}, *plast = NULL;
5327 	/* PS strings to be used dependent on "mode" */
5328 	const char *op[4] = {"Z", "false charpath fs", "false charpath fs", "false charpath V S U fs"};
5329 	/* PS strings to be used dependent on "justify". Empty strings added for unused values. */
5330 	const char *justcmd[12] = {"", "bl ", "bc ", "br ", "", "ml ", "mc ", "mr ", "", "tl ", "tc ", "tr "};
5331 	/* PS strings to be used dependent on "justify%4". Empty string added for unused value. */
5332 	const char *align[4] = {"0", "-2 div", "neg", ""};
5333 	int dy, i = 0, j, font, font2, x_just, y_just, upen, ugap;
5334 	int sub_on, super_on, scaps_on, symbol_on, font_on, size_on, color_on, under_on, old_font, n_uline, start_uline, stop_uline, last_chr, kase = PSL_LC;
5335 	bool last_sub = false, last_sup = false, supersub;
5336 	double orig_size, small_size, size, scap_size, ustep[2], dstep, last_rgb[4] = {0.0, 0.0, 0.0, 0.0};
5337 
5338 	if (fontsize == 0.0) return (PSL_NO_ERROR);	/* Nothing to do if text has zero size */
5339 
5340 	if (fontsize > 0.0) {	/* Set a new anchor point */
5341 		PSL->internal.ix = psl_ix (PSL, x);
5342 		PSL->internal.iy = psl_iy (PSL, y);
5343 		PSL_command (PSL, "%d %d M ", PSL->internal.ix, PSL->internal.iy);
5344 	}
5345 	else
5346 		fontsize = -fontsize;
5347 	psl_encodefont (PSL, PSL->current.font_no);
5348 	psl_putfont (PSL, fontsize);
5349 
5350 	if (text) {
5351 		if (strlen (text) >= (PSL_BUFSIZ-1)) {	/* We gotta have some limit on how long a single string can be... */
5352 			PSL_message (PSL, PSL_MSG_ERROR, "Warning: text_item > %d long - text not plotted!\n", PSL_BUFSIZ);
5353 			return (PSL_BAD_TEXT);
5354 		}
5355 		if (justify < 0)  {	/* Strip leading and trailing blanks */
5356 			for (i = 0; text[i] == ' '; i++);
5357 			for (j = (int)strlen (text) - 1; text[j] == ' '; j--) text[j] = 0;
5358 			justify = -justify;
5359 		}
5360 		string = psl_prepare_text (PSL, &text[i]);	/* Check for escape sequences */
5361 	}
5362 	else {
5363 		justify = abs (justify);	/* Just make sure since the stripping has already occurred */
5364 		string = psl_prepare_text (PSL, PSL->current.string);	/* Check for escape sequences */
5365 	}
5366 
5367 	if (angle != 0.0) PSL_command (PSL, "V %.12g R ", angle);
5368 
5369 	if (!strchr (string, '@')) {	/* Plain text ... this is going to be easy! */
5370 		PSL_command (PSL, "(%s) %s%s", string, justcmd[justify], op[mode]);
5371 		if (mode == 1) PSL_command (PSL, " S");
5372 		else if (mode > 1) PSL_command (PSL, " N");
5373 		PSL_command (PSL, (angle != 0.0 ) ? " U\n" : "\n");
5374 		PSL_free (string);
5375 		return (PSL_NO_ERROR);
5376 	}
5377 
5378 	psl_got_composite_fontswitch (PSL, string);
5379 
5380 	/* For more difficult cases we use the PSL_deftextdim machinery to get the size of the font box */
5381 
5382 	if (justify > 1) {
5383 		x_just = (justify + 3) % 4;	/* Gives 0 (left justify, i.e., do nothing), 1 (center), or 2 (right justify) */
5384 		y_just = justify / 4;		/* Gives 0 (bottom justify, i.e., do nothing), 1 (middle), or 2 (top justify) */
5385 		if (x_just && y_just) {
5386 			PSL_deftextdim (PSL, "-b", fontsize, string);	/* Get width and height of string */
5387 			PSL_command (PSL, "%s exch %s exch G\n", align[y_just], align[x_just]);
5388 		}
5389 		else if (x_just) {
5390 			PSL_deftextdim (PSL, "-w", fontsize, string);	/* Get width of string */
5391 			PSL_command (PSL, "%s 0 G\n", align[x_just]);
5392 		}
5393 		else {
5394 			PSL_deftextdim (PSL, "-h", fontsize, string);	/* Get height of string */
5395 			PSL_command (PSL, "%s 0 exch G\n", align[y_just]);
5396 		}
5397 	}
5398 
5399 	/* Here, we have special request for Symbol font and sub/superscript
5400 	 * @~ toggles between Symbol font and default font
5401 	 * @%<fontno>% switches font number <fontno>; give @%% to reset
5402 	 * @- toggles between subscript and normal text
5403 	 * @+ toggles between superscript and normal text
5404 	 * @# toggles between Small caps and normal text
5405 	 * @! will make a composite character of next two characters
5406 	 * Use @@ to print a single @
5407 	 */
5408 
5409 	piece  = PSL_memory (PSL, NULL, 2 * PSL_BUFSIZ, char);
5410 	piece2 = PSL_memory (PSL, NULL, PSL_BUFSIZ, char);
5411 
5412 	/* Now we can start printing text items */
5413 
5414 	supersub = (strstr (string, "@-@+") || strstr (string, "@+@-"));	/* Check for sub/super combo */
5415 	ptr = strtok_r (string, "@", &plast);
5416 	if(string[0] != '@') {	/* String has @ but not at start - must deal with first piece explicitly */
5417 		PSL_command (PSL, "(%s) %s\n", ptr, op[mode]);
5418 		last_chr = ptr[strlen(ptr)-1];
5419 		ptr = strtok_r (NULL, "@", &plast);
5420 		kase = ((last_chr > 0 && last_chr < 255) && islower (last_chr)) ? PSL_LC : PSL_UC;
5421 	}
5422 
5423 	font = old_font = PSL->current.font_no;
5424 	sub_on = super_on = scaps_on = symbol_on = font_on = size_on = color_on = under_on = false;
5425 	size = orig_size = fontsize;
5426 	small_size = size * PSL->current.subsupsize;
5427 	scap_size = size * PSL->current.scapssize;
5428 	ustep[PSL_LC] = PSL->current.sup_up[PSL_LC] * size;	/* Super-script baseline raised by given fraction of font size for lower case*/
5429 	ustep[PSL_UC] = PSL->current.sup_up[PSL_UC] * size;	/* Super-script baseline raised by given fraction of font size for upper case */
5430 	dstep = PSL->current.sub_down * size;
5431 	upen = psl_ip (PSL, 0.025 * size);	/* Underline pen thickness */
5432 	ugap = psl_ip (PSL, 0.075 * size);	/* Underline shift */
5433 	start_uline = stop_uline = n_uline = 0;
5434 
5435 	while (ptr) {	/* Loop over all the sub-text items separated by escape characters */
5436 		if (ptr[0] == '!') {	/* Composite character */
5437 			ptr++;
5438 			if (ptr[0] == '\\') {	/* Octal code */
5439 				strncpy (piece, ptr, 4U);
5440 				piece[4] = 0;
5441 				ptr += 4;
5442 			}
5443 			else {
5444 				piece[0] = ptr[0];	piece[1] = 0;
5445 				ptr++;
5446 			}
5447 			/* Watch out for escaped font change before 2nd character */
5448 			if (ptr[0] == PSL_ASCII_ES) {	/* Have a font change on either side of 2nd character */
5449 				ptr++;
5450 				if (ptr[0] == '~')	/* Toggle the symbol font */
5451 					font2 = PSL_SYMBOL_FONT;
5452 				else {	/* Font switching with @%font% ...@%% */
5453 					ptr++;
5454 					font2 = psl_getfont (PSL, ptr);
5455 					psl_encodefont (PSL, font);
5456 					while (*ptr != '%') ptr++;
5457 				}
5458 				ptr++;	/* Now at start of 2nd character */
5459 			}
5460 			else
5461 				font2 = font;
5462 			if (ptr[0] == '\\') {	/* Octal code again */
5463 				strncpy (piece2, ptr, 4U);
5464 				piece2[4] = 0;
5465 				ptr += 4;
5466 			}
5467 			else {
5468 				piece2[0] = ptr[0];	piece2[1] = 0;
5469 				ptr++;
5470 			}
5471 			if (font2 != font) {	/* Skip past the font switcher */
5472 				ptr++;	/* Step over the implicit @ (ascii 27) */
5473 				if (font2 == PSL_SYMBOL_FONT)
5474 					ptr++;	/* Move past the ~ */
5475 				else
5476 					ptr += 2;	/* Move past the %% */
5477 			}
5478 			/* Try to center justify these two character to make a composite character - may not be right */
5479 			PSL_command (PSL, "%d F%d (%s) E exch %s -2 div dup 0 G\n", psl_ip (PSL, size), font2, piece2, op[mode]);
5480 			if (font2 != font)	/* Must switch font in the call */
5481 				PSL_command (PSL, "%d F%d\n", psl_ip (PSL, size), font);
5482 			PSL_command (PSL, "(%s) E -2 div dup 0 G exch %s sub neg dup 0 lt {pop 0} if 0 G\n", piece, op[mode]);
5483 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5484 		}
5485 		else if (ptr[0] == '~') {	/* Symbol font */
5486 			symbol_on = !symbol_on;
5487 			font = (font == PSL_SYMBOL_FONT) ? old_font : PSL_SYMBOL_FONT;
5488 			ptr++;
5489 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5490 		}
5491 		else if (ptr[0] == '%') {	/* Switch font option */
5492 			font_on = !font_on;
5493 			ptr++;
5494 			if (*ptr == '%')
5495 				font = old_font;
5496 			else if (*ptr) {
5497 				old_font = font;
5498 				font = psl_getfont (PSL, ptr);
5499 				psl_encodefont (PSL, font);
5500 			}
5501 			while (*ptr != '%') ptr++;
5502 			ptr++;
5503 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5504 		}
5505 		else if (ptr[0] == '-') {	/* Subscript toggle  */
5506 			ptr++;
5507 			sub_on = !sub_on;
5508 			if (sub_on) {
5509 				if (last_sup)	/* Just did a super-script, must reset horizontal position */
5510 					PSL_command (PSL, "PSL_last_width neg 0 G ");	/* Rewind position to orig baseline */
5511 				else if (supersub)	/* Need to remember the width of the subscript */
5512 					PSL_command (PSL, "/PSL_last_width %d F%d (%s) sw def\n", psl_ip (PSL, small_size), font, ptr);	/* Compute width of subscript text */
5513 				if (ptr[0]) strcpy (previous, ptr);	/* Keep copy of possibly previous text */
5514 			}
5515 			else
5516 				last_sub = (last_sup || ptr[0] == 0) ? supersub : false;	/* Only true when this is a possibility */
5517 			size = (sub_on) ? small_size : fontsize;
5518 			dy = (sub_on) ? -psl_ip (PSL, dstep) : psl_ip (PSL, dstep);
5519 			PSL_command (PSL, "0 %d G ", dy);
5520 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5521 		}
5522 		else if (ptr[0] == '+') {	/* Superscript toggle */
5523 			ptr++;
5524 			super_on = !super_on;
5525 			if (super_on) {
5526 				if (last_sub)	/* Just did a sub-script, must reset horizontal position */
5527 					PSL_command (PSL, "PSL_last_width neg 0 G ");	/* Rewind position to orig baseline */
5528 				else if (supersub)	/* Need to remember the width of the superscript */
5529 					PSL_command (PSL, "/PSL_last_width %d F%d (%s) sw def\n", psl_ip (PSL, small_size), font, ptr);	/* Compute width of subscript text */
5530 				if (ptr[0]) strcpy (previous, ptr);	/* Keep copy of possibly previous text */
5531 			}
5532 			else
5533 				last_sup = (last_sub || ptr[0] == 0) ? supersub : false;	/* Only true when this is a possibility */
5534 			size = (super_on) ? small_size : fontsize;
5535 			dy = (super_on) ? psl_ip (PSL, ustep[kase]) : -psl_ip (PSL, ustep[kase]);
5536 			PSL_command (PSL, "0 %d G ", dy);
5537 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5538 		}
5539 		else if (ptr[0] == '#') {	/* Small caps */
5540 			scaps_on = !scaps_on;
5541 			size = (scaps_on) ? scap_size : fontsize;
5542 			ptr++;
5543 			(scaps_on) ? psl_get_uppercase (piece, ptr) : (void) strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5544 		}
5545 		else if (ptr[0] == ':') {	/* Font size change */
5546 			size_on = !size_on;
5547 			ptr++;
5548 			if (ptr[0] == ':')	/* Reset size */
5549 				size = fontsize = orig_size;
5550 			else {
5551 				size = fontsize = atof (ptr);
5552 				while (*ptr != ':') ptr++;
5553 			}
5554 			small_size = size * PSL->current.subsupsize;	scap_size = size * PSL->current.scapssize;
5555 			ustep[PSL_LC] = PSL->current.sup_up[PSL_LC] * size;
5556 			ustep[PSL_UC] = PSL->current.sup_up[PSL_UC] * size;
5557 			dstep = PSL->current.sub_down * size;
5558 			upen = psl_ip (PSL, 0.025 * size);	/* Underline pen thickness */
5559 			ugap = psl_ip (PSL, 0.075 * size);	/* Underline shift */
5560 			ptr++;
5561 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5562 		}
5563 		else if (ptr[0] == ';') {	/* Font color change. r/g/b in 0-255 */
5564 			int n_scan, k, error = false;
5565 			double rgb[4];
5566 			color_on = !color_on;
5567 			ptr++;
5568 			if (ptr[0] == ';') {	/* Reset color to previous value */
5569 				PSL_command (PSL, "%s ", psl_putcolor (PSL, last_rgb, 0));
5570 				PSL_rgb_copy (PSL->current.rgb[PSL_IS_FONT], last_rgb);	/* Update present color */
5571 			}
5572 			else {
5573 				char *s = NULL;
5574 				j = 0;
5575 				while (ptr[j] != ';') j++;
5576 				ptr[j] = 0;
5577 				if ((s = strchr (ptr, '@')) != NULL) {	/* Also gave transparency */
5578 					rgb[3] = atof (&s[1]) / 100.0;
5579 					s[0] = 0;
5580 				}
5581 				else
5582 					rgb[3] = 0.0;
5583 				n_scan = sscanf (ptr, "%lg/%lg/%lg", &rgb[0], &rgb[1], &rgb[2]);
5584 				if (n_scan == 1) {	/* Got gray shade */
5585 					rgb[0] /= 255.0;	/* Normalize to 0-1 */
5586 					rgb[1] = rgb[2] = rgb[0];
5587 					if (rgb[0] < 0.0 || rgb[0] > 1.0) error++;
5588 				}
5589 				else if (n_scan == 3) {	/* Got r/g/b */
5590 					for (k = 0; k < 3; k++) {
5591 						rgb[k] /= 255.0;	/* Normalize to 0-1 */
5592 						if (rgb[k] < 0.0 || rgb[k] > 1.0) error++;
5593 					}
5594 				}
5595 				else {	/* Got crap */
5596 					PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad color change (%s) - ignored\n", ptr);
5597 					error++;
5598 				}
5599 
5600 				ptr[j] = ';';
5601 				if (s) s[0] = '@';
5602 				while (*ptr != ';') ptr++;
5603 				if (!error) {
5604 					PSL_command (PSL, "%s ", psl_putcolor (PSL, rgb, 0));
5605 					PSL_rgb_copy (last_rgb, PSL->current.rgb[PSL_IS_FONT]);	/* Save previous color */
5606 					PSL_rgb_copy (PSL->current.rgb[PSL_IS_FONT], rgb);	/* Update present color */
5607 				}
5608 			}
5609 			ptr++;
5610 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5611 		}
5612 		else if (ptr[0] == '_') {	/* Toggle underline */
5613 			under_on = !under_on;
5614 			n_uline++;
5615 			if (n_uline%2)
5616 				start_uline = true;
5617 			else
5618 				stop_uline = true;
5619 			ptr++;
5620 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5621 		}
5622 		else
5623 			strncpy (piece, ptr, 2 * PSL_BUFSIZ);
5624 		if (start_uline) PSL_command (PSL, "currentpoint /y0_u edef /x0_u edef\n");
5625 		if (stop_uline) PSL_command (PSL, "V %d W currentpoint pop /x1_u edef x0_u y0_u %d sub M x1_u x0_u sub 0 D S x1_u y0_u M U\n", upen, ugap);
5626 		start_uline = stop_uline = false;
5627 		if (strlen (piece) > 0) {
5628 			if (last_sub && last_sup) {	/* May possibly need to move currentpoint a bit to the widest piece */
5629 				PSL_command (PSL, "/PSL_last_width PSL_last_width (%s) sw sub dup 0 lt {pop 0} if def\n", previous);	/* Compute width of superscript text and see if we must move a bit */
5630 				PSL_command (PSL, "PSL_last_width 0 G ");	/* Rewind position to orig baseline */
5631 				last_sub = last_sup = false;
5632 			}
5633 			PSL_command (PSL, "%d F%d (%s) %s\n", psl_ip (PSL, size), font, piece, op[mode]);
5634 			last_chr = ptr[strlen(piece)-1];
5635 			if (!super_on && (last_chr > 0 && last_chr < 255)) kase = (islower(last_chr)) ? PSL_LC : PSL_UC;
5636 		}
5637 		ptr = strtok_r (NULL, "@", &plast);
5638 	}
5639 	if (mode == 1) PSL_command (PSL, "S\n");
5640 	else if (mode > 1) PSL_command (PSL, "N\n");
5641 	if (angle != 0.0) PSL_command (PSL, "U\n");
5642 	PSL->current.fontsize = 0.0;	/* Force reset */
5643 
5644 	PSL_free (piece);
5645 	PSL_free (piece2);
5646 	PSL_free (string);
5647 
5648 	if (sub_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Sub-scripting not terminated [%s]\n", text);
5649 	if (super_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Super-scripting not terminated [%s]\n", text);
5650 	if (scaps_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Small-caps not terminated [%s]\n", text);
5651 	if (symbol_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Symbol font change not terminated [%s]\n", text);
5652 	if (size_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-size change not terminated [%s]\n", text);
5653 	if (color_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Font-color change not terminated [%s]\n", text);
5654 	if (under_on) PSL_message (PSL, PSL_MSG_ERROR, "Warning: Text underline not terminated [%s]\n", text);
5655 
5656 	return (sub_on|super_on|scaps_on|symbol_on|font_on|size_on|color_on|under_on);
5657 }
5658 
PSL_plottextline(struct PSL_CTRL * PSL,double x[],double y[],int np[],int n_segments,void * arg1,void * arg2,char * label[],double angle[],int nlabel_per_seg[],double fontsize,int justify,double offset[],int mode)5659 int PSL_plottextline (struct PSL_CTRL *PSL, double x[], double y[], int np[], int n_segments, void *arg1, void *arg2, char *label[], double angle[], int nlabel_per_seg[], double fontsize, int justify, double offset[], int mode) {
5660 	/* Placing text along lines, setting up text clippaths, and drawing the lines */
5661 	/* x,y		Array containing the concatenated label path of all segments
5662 	 * np		Array containing length of each label path segment in concatenated path
5663 	 * n_segments	Number of line segments
5664 	 * arg1, arg2   These are pointers to two arrays, depending on whether we have curved or straight baselines:
5665 	 *  If curved baselines then
5666 	 *  arg1 = node		Index into x/y array of label plot positions per segment (i.e., start from 0 for each new segment)
5667 	 *  arg2 = NULL		Not used
5668 	 *  If straight text baselines then
5669 	 *  arg1 = xp		Array of x coordinates of where labels will be placed
5670 	 *  arg2 = yp		Array of y coordinates of where labels will be placed
5671 	 * label	Array of text labels
5672 	 * angle	Text angle for each label
5673 	 * nlabel_per_seg	Array containing number of labels per segment
5674 	 * fontsize	Constant fontsize of all label texts [font use is the current font set with PSL_setfont]
5675 	 * just		Justification of text relative to label coordinates [constant for all labels]
5676 	 * offset	Clearances between text and textbox [constant]
5677 	 * mode		= 1: We place all the PSL variables required to use the text for clipping of painting.
5678 	 * 			= 2: We paint the text that is stored in the PSL variables.
5679 	 * 			= 4: We use the text stored in the PSL variables to set up a clip path.  Clipping is turned ON.
5680 	 * 			= 8: We draw the paths.
5681 	 * 			= 16: We turn clip path OFF.
5682 	 * 			= 32: We want rounded rectangles instead of straight rectangular boxes [straight text only].
5683 	 * 			= 64: Typeset text along path [straight text].
5684 	 * 			= 128: Fill box
5685 	 * 			= 256: Draw box
5686 	 * 			= 512: Fill & outline font, fill first, then outline
5687 	 * 			= 1024: Fill & outline font, outline first, then fill
5688 	 */
5689 
5690 	bool curved = ((mode & PSL_TXT_CURVED) == PSL_TXT_CURVED);	/* True if baseline must follow line path */
5691 	int extras, kind = (curved) ? 1 : 0;
5692 	char *name[2] = {"straight", "curved"}, *ext[2] = {"clip", "labels"};
5693 
5694 	if (mode & 1) {	/* Lay down PSL variables */
5695 		int i = 0, n_labels = 0;
5696 
5697 		if (n_segments <= 0) return (PSL_NO_ERROR);	/* Nothing to do yet */
5698 		if (fontsize == 0.0) return (PSL_NO_ERROR);	/* Nothing to do if text has zero size */
5699 
5700 		if (justify < 0) psl_remove_spaces (label, n_segments, nlabel_per_seg);	/* Strip leading and trailing spaces */
5701 		for (i = 0; i < n_segments; i++) n_labels += nlabel_per_seg[i];	/* Count number of labels */
5702 
5703 		/* Set clearance and text height parameters */
5704 		PSL_comment (PSL, "Set constants for textbox clearance:\n");
5705 		PSL_defunits (PSL, "PSL_gap_x", offset[0]);		/* Set text clearance in x direction */
5706 		PSL_defunits (PSL, "PSL_gap_y", offset[1]);		/* Set text clearance in y direction */
5707 
5708 		/* Set PSL arrays and constants for this set of lines and labels */
5709 		if (curved)	/* Set PSL array for curved baselines [also used to draw lines if selected] */
5710 			psl_set_reducedpath_arrays (PSL, x, y, n_segments, np, nlabel_per_seg, arg1);
5711 		psl_set_attr_arrays (PSL, (curved) ? arg1 : NULL, angle, label, n_segments, nlabel_per_seg);
5712 		psl_set_int_array   (PSL, "label_n", nlabel_per_seg, n_segments);
5713 		PSL_definteger (PSL, "PSL_n_paths", n_segments);
5714 		PSL_definteger (PSL, "PSL_n_labels", n_labels);
5715 		if (!curved)	/* Set PSL array for text location with straight baselines */
5716 			psl_set_path_arrays (PSL, "txt", arg1, arg2, 1, &n_labels);
5717 		PSL_comment (PSL, "Estimate text heights:\n");
5718 		PSL_command (PSL, "PSL_set_label_heights\n");	/* Estimate text heights */
5719 	}
5720 
5721 	extras = mode & (PSL_TXT_ROUND | PSL_TXT_FILLBOX | PSL_TXT_DRAWBOX | PSL_TXT_DRAWBOX | PSL_TXT_FILLPEN | PSL_TXT_PENFILL);	/* This just gets these bit settings, if present */
5722 	if (mode & PSL_TXT_SHOW) {	/* Lay down visible text */
5723 		PSL_comment (PSL, "Display the texts:\n");
5724 		PSL_command (PSL, "%d PSL_%s_path_labels\n", PSL_TXT_SHOW|extras, name[kind]);
5725 	}
5726 	if (mode & PSL_TXT_CLIP_ON) {	/* Set up text clip paths and turn clipping ON */
5727 		PSL_comment (PSL, "Set up text clippath and turn clipping ON:\n");
5728 		if (mode & PSL_TXT_CLIP_OFF) PSL_command (PSL, "V\n");
5729 		PSL_command (PSL, "%d PSL_%s_path_%s\n", PSL_TXT_CLIP_ON|extras, name[kind], ext[kind]);
5730 		PSL->current.nclip++;	/* Increment clip level */
5731 	}
5732 	if (mode & PSL_TXT_DRAW) {	/* Draw the lines whose coordinates are in the PSL already */
5733 		PSL_comment (PSL, "Draw the text line segments:\n");
5734 		if (curved) 	/* The coordinates are in the PSL already so use PLS function */
5735 			PSL_command (PSL, "PSL_draw_path_lines N\n");
5736 		else {	/* Must draw lines here instead with PSL_plotline */
5737 			int k, offset = 0;
5738 			for (k = 0; k < n_segments; k++) {	/* Draw each segment line */
5739 				PSL_command (PSL, "PSL_path_pen %d get cvx exec\n", k);	/* Set this segment's pen */
5740 				PSL_plotline (PSL, &x[offset], &y[offset], np[k], PSL_MOVE|PSL_STROKE);
5741 				offset += np[k];
5742 			}
5743 		}
5744 	}
5745 	PSL->current.font_no = -1;	/* To force setting of next font since the PSL stuff might have changed it */
5746 	if (mode & PSL_TXT_CLIP_OFF) {	/* Turn OFF Clipping and bail */
5747 		PSL_comment (PSL, "Turn label clipping OFF:\n");
5748 		PSL_endclipping (PSL, 1);	/* Decrease clipping by one level */
5749 		PSL_command (PSL, "U\n");
5750 	}
5751 	return (PSL_NO_ERROR);
5752 }
5753 
PSL_setorigin(struct PSL_CTRL * PSL,double x,double y,double angle,int mode)5754 int PSL_setorigin (struct PSL_CTRL *PSL, double x, double y, double angle, int mode) {
5755 	/* mode = PSL_FWD: Translate origin, then rotate axes.
5756 	 * mode = PSL_INV: Rotate axes, then translate origin. */
5757 
5758 	if (mode != PSL_FWD && !PSL_eq(angle,0.0)) PSL_command (PSL, "%.12g R\n", angle);
5759 	if (!PSL_eq(x,0.0) || !PSL_eq(y,0.0)) PSL_command (PSL, "%d %d T\n", psl_ix (PSL, x), psl_iy (PSL, y));
5760 	if (mode == PSL_FWD && !PSL_eq(angle,0.0)) PSL_command (PSL, "%.12g R\n", angle);
5761 	return (PSL_NO_ERROR);
5762 }
5763 
PSL_setparagraph(struct PSL_CTRL * PSL,double line_space,double par_width,int par_just)5764 int PSL_setparagraph (struct PSL_CTRL *PSL, double line_space, double par_width, int par_just) {
5765 	/* Initializes PSL parameters used to typeset paragraphs with PSL_plotparagraph */
5766 
5767 	if (par_just < PSL_BL || par_just > PSL_JUST) {
5768 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad paragraph justification (%d)\n", par_just);
5769 		return (PSL_BAD_JUST);
5770 	}
5771 	if (line_space <= 0.0) {
5772 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad line spacing (%g)\n", line_space);
5773 		return (PSL_BAD_VALUE);
5774 	}
5775 	if (par_width <= 0.0) {
5776 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad paragraph width (%g)\n", par_width);
5777 		return (PSL_BAD_VALUE);
5778 	}
5779 
5780 	PSL_comment (PSL, "PSL_setparagraph settings:\n");
5781 	PSL_defunits (PSL, "PSL_linespace", line_space);
5782 	PSL_defunits (PSL, "PSL_parwidth", par_width);
5783 	PSL_command (PSL, "/PSL_parjust %d def\n", par_just);
5784 	return (PSL_NO_ERROR);
5785 }
5786 
PSL_plotparagraphbox(struct PSL_CTRL * PSL,double x,double y,double fontsize,char * paragraph,double angle,int justify,double offset[],int mode)5787 int PSL_plotparagraphbox (struct PSL_CTRL *PSL, double x, double y, double fontsize, char *paragraph, double angle, int justify, double offset[], int mode) {
5788 	/* Determines the text box that fits the given typeset paragraph and fills/strokes with current fill/pen.
5789 	 * mode = 0 (PSL_RECT_STRAIGHT), 1 (PSL_RECT_ROUNDED), 2 (PSL_RECT_CONVEX) or 3 (PSL_RECT_CONCAVE).
5790 	 */
5791 	int error = 0;
5792 	if (offset[0] < 0.0 || offset[1] < 0.0) {
5793 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad paragraphbox text offset (%g/%g)\n", offset[0], offset[1]);
5794 		return (PSL_BAD_VALUE);
5795 	}
5796 	if (mode < PSL_RECT_STRAIGHT || mode > PSL_RECT_CONCAVE) {
5797 		PSL_message (PSL, PSL_MSG_ERROR, "Warning: Bad paragraphbox mode (%d)\n", mode);
5798 		return (PSL_BAD_VALUE);
5799 	}
5800 
5801 	if ((error = psl_paragraphprocess (PSL, y, fontsize, paragraph)) != PSL_NO_ERROR) return (error);
5802 
5803 	PSL_command (PSL, "V ");
5804 	PSL_setorigin (PSL, x, y, angle, PSL_FWD);		/* To original point */
5805 
5806 	/* Do the relative horizontal justification */
5807 
5808 	PSL_defunits (PSL, "PSL_xgap", offset[0]);
5809 	PSL_defunits (PSL, "PSL_ygap", offset[1]);
5810 
5811 	PSL_command (PSL, "0 0 M\n0 PSL_textjustifier");
5812 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Just get paragraph height\n" : "\n");
5813 
5814 	/* Adjust origin for box justification */
5815 
5816 	PSL_command (PSL, "/PSL_justify %d def\n", justify);
5817 	PSL_command (PSL, "/PSL_x0 PSL_parwidth PSL_justify 1 sub 4 mod 0.5 mul neg mul def\n");
5818 	if (justify > 8)	/* Top row */
5819 		PSL_command (PSL, "/PSL_y0 0 def\n");
5820 	else if (justify > 4)	/* Middle row */
5821 		PSL_command (PSL, "/PSL_y0 PSL_parheight 2 div def\n");
5822 	else			/* Bottom row */
5823 		PSL_command (PSL, "/PSL_y0 PSL_parheight def\n");
5824 	PSL_command (PSL, "/PSL_txt_y0 PSL_top neg def\n");
5825 
5826 	/* Make upper left textbox corner the origin */
5827 
5828 	PSL_command (PSL, "PSL_x0 PSL_y0 T\n");
5829 
5830 	PSL_comment (PSL, "Start PSL box beneath text block:\n");
5831 	if (mode == PSL_RECT_CONVEX) {	/* Create convex box path */
5832 		PSL_command (PSL, "/PSL_h PSL_parheight 2 div PSL_ygap add def\n");
5833 		PSL_command (PSL, "/PSL_w PSL_parwidth 2 div PSL_xgap add def\n");
5834 		PSL_command (PSL, "/PSL_rx PSL_w PSL_w mul PSL_xgap PSL_xgap mul add 2 PSL_xgap mul div def\n");
5835 		PSL_command (PSL, "/PSL_ry PSL_h PSL_h mul PSL_ygap PSL_ygap mul add 2 PSL_ygap mul div def\n");
5836 		PSL_command (PSL, "/PSL_ax PSL_w PSL_rx PSL_xgap sub atan def\n");
5837 		PSL_command (PSL, "/PSL_ay PSL_h PSL_ry PSL_ygap sub atan def\n");
5838 		PSL_comment (PSL, "PSL_path:\n");
5839 		PSL_command (PSL, "PSL_xgap neg PSL_ygap M\n");
5840 		PSL_command (PSL, "PSL_ry PSL_xgap 2 mul sub PSL_parheight 2 div neg PSL_ry 180 PSL_ay sub 180 PSL_ay add arc\n");
5841 		PSL_command (PSL, "PSL_parwidth 2 div PSL_parheight 2 PSL_ygap mul add PSL_rx sub neg PSL_rx 270 PSL_ax sub 270 PSL_ax add arc\n");
5842 		PSL_command (PSL, "PSL_parwidth PSL_xgap 2 mul add PSL_ry sub PSL_parheight 2 div neg PSL_ry PSL_ay dup neg exch arc\n");
5843 		PSL_command (PSL, "PSL_parwidth 2 div PSL_ygap 2 mul PSL_rx sub PSL_rx 90 PSL_ax sub 90 PSL_ax add arc\n");
5844 	}
5845 	else if (mode == PSL_RECT_CONCAVE) {	/* Create concave box path */
5846 		PSL_command (PSL, "/PSL_h PSL_parheight 2 div PSL_ygap 2 mul add def\n");
5847 		PSL_command (PSL, "/PSL_w PSL_parwidth 2 div PSL_xgap 2 mul add def\n");
5848 		PSL_command (PSL, "/PSL_rx PSL_w PSL_w mul PSL_xgap PSL_xgap mul add 2 PSL_xgap mul div def\n");
5849 		PSL_command (PSL, "/PSL_ry PSL_h PSL_h mul PSL_ygap PSL_ygap mul add 2 PSL_ygap mul div def\n");
5850 		PSL_command (PSL, "/PSL_ax PSL_w PSL_rx PSL_xgap sub atan def\n");
5851 		PSL_command (PSL, "/PSL_ay PSL_h PSL_ry PSL_ygap sub atan def\n");
5852 		PSL_comment (PSL, "PSL_path:\n");
5853 		PSL_command (PSL, "PSL_xgap 2 mul neg PSL_ygap 2 mul M\n");
5854 		PSL_command (PSL, "PSL_xgap PSL_ry add neg PSL_parheight 2 div neg PSL_ry PSL_ay dup neg arcn\n");
5855 		PSL_command (PSL, "PSL_parwidth 2 div PSL_parheight PSL_ygap add PSL_rx add neg PSL_rx 90 PSL_ax add 90 PSL_ax sub arcn\n");
5856 		PSL_command (PSL, "PSL_parwidth PSL_xgap add PSL_ry add PSL_parheight 2 div neg PSL_ry 180 PSL_ay add 180 PSL_ay sub arcn\n");
5857 		PSL_command (PSL, "PSL_parwidth 2 div PSL_ygap PSL_rx add PSL_rx 270 PSL_ax add 270 PSL_ax sub arcn\n");
5858 	}
5859 	else if (mode == PSL_RECT_ROUNDED) {	/* Create rounded box path */
5860 		PSL_command (PSL, "/XL PSL_xgap neg def\n");
5861 		PSL_command (PSL, "/XR PSL_parwidth PSL_xgap add def\n");
5862 		PSL_command (PSL, "/YT PSL_ygap def\n");
5863 		PSL_command (PSL, "/YB PSL_parheight PSL_ygap add neg def\n");
5864 		PSL_command (PSL, "/PSL_r PSL_xgap PSL_ygap lt {PSL_xgap} {PSL_ygap} ifelse def\n");
5865 		PSL_comment (PSL, "PSL_path:\n");
5866 		PSL_command (PSL, "XL PSL_r add YB M\n");
5867 		PSL_command (PSL, "XR YB XR YT PSL_r arct XR YT XL YT PSL_r arct\n");
5868 		PSL_command (PSL, "XL YT XL YB PSL_r arct XL YB XR YB PSL_r arct\n");
5869 	}
5870 	else {	/* PSL_RECT_STRAIGHT */
5871 		PSL_command (PSL, "/XL PSL_xgap neg def\n");
5872 		PSL_command (PSL, "/XR PSL_parwidth PSL_xgap add def\n");
5873 		PSL_command (PSL, "/YT PSL_ygap def\n");
5874 		PSL_command (PSL, "/YB PSL_parheight PSL_ygap add neg def\n");
5875 		PSL_comment (PSL, "PSL_path:\n");
5876 		PSL_command (PSL, "XL YT M XL YB L XR YB L XR YT L\n");
5877 	}
5878 	PSL_command (PSL, "FO U\n");
5879 	PSL_comment (PSL, "End PSL box beneath text block:\n");
5880 
5881 	return (PSL_NO_ERROR);
5882 }
5883 
PSL_plotparagraph(struct PSL_CTRL * PSL,double x,double y,double fontsize,char * paragraph,double angle,int justify)5884 int PSL_plotparagraph (struct PSL_CTRL *PSL, double x, double y, double fontsize, char *paragraph, double angle, int justify) {
5885 	/* Typeset one or more paragraphs.  Separate paragraphs by adding \r to end of last word in a paragraph.
5886  	 * To lay down a text box first, see PSL_plotparagraphbox. */
5887 	int error = 0;
5888 
5889 	if (fontsize == 0.0) return (PSL_NO_ERROR);	/* Nothing to do if text has zero size */
5890 
5891 	/* If paragraph is NULL then PSL_plotparagraphbox has been called so we don't need to write the paragraph info to the PS file */
5892 	if (paragraph && (error = psl_paragraphprocess (PSL, y, fontsize, paragraph)) != PSL_NO_ERROR) return (error);
5893 
5894 	PSL_command (PSL, "V ");
5895 	PSL_setorigin (PSL, x, y, angle, PSL_FWD);		/* To original point */
5896 
5897 	/* Do the relative horizontal justification */
5898 
5899 	PSL_command (PSL, "0 0 M\n0 PSL_textjustifier");
5900 	(PSL->internal.comments) ? PSL_command (PSL, "\t%% Just get paragraph height\n") : PSL_command (PSL, "\n");
5901 
5902 	/* Adjust origin for box justification */
5903 
5904 	PSL_command (PSL, "/PSL_justify %d def\n", justify);
5905 	PSL_command (PSL, "/PSL_x0 PSL_parwidth PSL_justify 1 sub 4 mod 0.5 mul neg mul def\n");
5906 	if (justify > 8)	/* Top row */
5907 		PSL_command (PSL, "/PSL_y0 0 def\n");
5908 	else if (justify > 4)	/* Middle row */
5909 		PSL_command (PSL, "/PSL_y0 PSL_parheight 2 div def\n");
5910 	else			/* Bottom row */
5911 		PSL_command (PSL, "/PSL_y0 PSL_parheight def\n");
5912 	PSL_command (PSL, "/PSL_txt_y0 PSL_top neg def\n");
5913 
5914 	/* Make upper left textbox corner the origin */
5915 
5916 	PSL_command (PSL, "PSL_x0 PSL_y0 T\n");
5917 
5918 	/* Adjust origin so 0,0 is lower left corner of first character on baseline */
5919 
5920 	PSL_command (PSL, "0 PSL_txt_y0 T");
5921 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Move to col 0 on first baseline\n" : "\n");
5922 	PSL_command (PSL, "0 0 M\n1 PSL_textjustifier U");
5923 	PSL_command (PSL, (PSL->internal.comments) ? "\t%% Place the paragraph\n" : "\n");
5924 
5925 	return (PSL_NO_ERROR);
5926 }
5927 
PSL_defunits(struct PSL_CTRL * PSL,const char * param,double value)5928 int PSL_defunits (struct PSL_CTRL *PSL, const char *param, double value) {
5929 	PSL_command (PSL, "/%s %d def\n", param, psl_iz (PSL, value));
5930 	return (PSL_NO_ERROR);
5931 }
5932 
PSL_defpoints(struct PSL_CTRL * PSL,const char * param,double fontsize)5933 int PSL_defpoints (struct PSL_CTRL *PSL, const char *param, double fontsize) {
5934 	PSL_command (PSL, "/%s %d def\n", param, psl_ip (PSL, fontsize));
5935 	return (PSL_NO_ERROR);
5936 }
5937 
PSL_definteger(struct PSL_CTRL * PSL,const char * param,int value)5938 int PSL_definteger (struct PSL_CTRL *PSL, const char *param, int value) {
5939 	PSL_command (PSL, "/%s %d def\n", param, value);
5940 	return (PSL_NO_ERROR);
5941 }
5942 
PSL_defpen(struct PSL_CTRL * PSL,const char * param,double linewidth,char * style,double offset,double rgb[])5943 int PSL_defpen (struct PSL_CTRL *PSL, const char *param, double linewidth, char *style, double offset, double rgb[]) {
5944    /* Function to set line pen attributes. We force any transparency change since this is all inside a gsave/hrestore */
5945    PSL_command (PSL, "/%s {%d W %s %s} def\n", param, psl_ip (PSL, linewidth), psl_putcolor (PSL, rgb, 1), psl_putdash (PSL, style, offset));
5946    return (PSL_NO_ERROR);
5947 }
5948 
PSL_defcolor(struct PSL_CTRL * PSL,const char * param,double rgb[])5949 int PSL_defcolor (struct PSL_CTRL *PSL, const char *param, double rgb[]) {
5950 	PSL_command (PSL, "/%s {%s} def\n", param, psl_putcolor (PSL, rgb, 0));
5951 	return (PSL_NO_ERROR);
5952 }
5953 
5954 /* Helpers to make sure fp is closed and tmp_file is removed on return. */
5955 #define Return1(x) {code = x; fclose (fp); return (code);}
5956 #define Return2(x) {code = x; fclose (fp); remove (tmp_file); return (code);}
5957 
PSL_loadeps(struct PSL_CTRL * PSL,char * file,struct imageinfo * h,unsigned char ** picture)5958 int PSL_loadeps (struct PSL_CTRL *PSL, char *file, struct imageinfo *h, unsigned char **picture) {
5959 	/* PSL_loadeps reads an Encapsulated PostScript file, If picture == NULL we just return h. */
5960 
5961 	int n, p, llx, lly, trx, try, BLOCKSIZE=4096;
5962 	int32_t value;
5963 	unsigned char *buffer = NULL;
5964 	FILE *fp = NULL;
5965 
5966 	/* Open PostScript file */
5967 
5968 	if ((fp = fopen (file, "rb")) == NULL) {
5969 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Cannot open image file %s!\n", file);
5970 		return (PSL_READ_FAILURE);
5971 	}
5972 
5973 	/* Check magic key */
5974 
5975 	if (fread (&value, sizeof (int32_t), 1, fp) != 1) {
5976 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Failure reading EPS magic key from %s\n", file);
5977 		fclose (fp);
5978 		return (-1);
5979 	}
5980 #ifndef WORDS_BIGENDIAN
5981 	value = bswap32 (value);
5982 #endif
5983 	if (value != EPS_MAGIC) {
5984 		PSL_message (PSL, PSL_MSG_ERROR, "Error: Could not find EPS magic key in %s\n", file);
5985 		fclose (fp);
5986 		return (-1);
5987 	}
5988 	h->magic = (int)value;
5989 
5990 	/* Scan for BoundingBox */
5991 
5992 	psl_get_boundingbox (PSL, fp, &llx, &lly, &trx, &try, &h->llx, &h->lly, &h->trx, &h->try);
5993 
5994 	/* Fill header struct with appropriate values */
5995 	h->magic = EPS_MAGIC;
5996 	h->width = trx - llx;
5997 	h->height = try - lly;
5998 	h->depth = 0;
5999 	h->length = 0;	/* Not read yet */
6000 	h->type = RT_EPS;
6001 	h->maptype = RMT_NONE;
6002 	h->maplength = 0;
6003 	h->xorigin = llx;
6004 	h->yorigin = lly;
6005 
6006 	if (picture == NULL) {
6007 		fclose (fp);
6008 		return (0);	/* Just wanted dimensions */
6009 	}
6010 
6011 	/* Rewind and load into buffer */
6012 
6013 	n=0;
6014 	fseek (fp, (off_t)0, SEEK_SET);
6015 	buffer = PSL_memory (PSL, NULL, BLOCKSIZE, unsigned char);
6016 	while ((p = (int)fread ((unsigned char *)buffer + n, 1U, (size_t)BLOCKSIZE, fp)) == BLOCKSIZE) {
6017 		n+=BLOCKSIZE;
6018 		buffer = PSL_memory (PSL, buffer, n+BLOCKSIZE, unsigned char);
6019 	}
6020 	fclose (fp);
6021 
6022 	n += p;
6023 	buffer = PSL_memory (PSL, buffer, n, unsigned char);
6024 
6025 	/* Now set length */
6026 	h->length = n;
6027 
6028 	*picture = buffer;
6029 	return (0);
6030 }
6031 
6032 /* Due to the DLL boundary cross problem on Windows we are forced to have the following, otherwise
6033    defined as macros, implemented as functions. However, macros proved to be problematic too
6034    on Unixes, so now we have functions only. */
PSL_command(struct PSL_CTRL * C,const char * format,...)6035 int PSL_command (struct PSL_CTRL *C, const char *format, ...) {
6036 	va_list args;
6037 	va_start (args, format);
6038 	if (C->internal.memory) {	/* Send command to memory buffer */
6039 		char tmp_buffer[4096] = {""};		/* Have to use this large array because sometimes we get the char encoding array, which is large. */
6040 		size_t len = vsnprintf (tmp_buffer, 4096, format, args);
6041 		psl_prepare_buffer (C, len);
6042 		C->internal.buffer[C->internal.n] = '\0';	/* Play safe before the strcat of next line. Otherwise trash in the middle may occur */
6043 		strncat (&(C->internal.buffer[C->internal.n]), tmp_buffer, len);
6044 		C->internal.n += len;
6045 	}
6046 	else	/* Write command to stream */
6047 		vfprintf (C->internal.fp, format, args);
6048 	va_end (args);
6049 	return (0);
6050 }
6051 
PSL_comment(struct PSL_CTRL * C,const char * format,...)6052 int PSL_comment (struct PSL_CTRL *C, const char *format, ...) {
6053 	va_list args;
6054 	if (!C->internal.comments) return (0);
6055 	va_start (args, format);
6056 	if (C->internal.memory) {	/* Send comments to memory buffer */
6057 		char tmp_buffer[PSL_BUFSIZ] = {""};
6058 		size_t len = vsnprintf (tmp_buffer, PSL_BUFSIZ, format, args);
6059 		psl_prepare_buffer (C, len + 6); /* The string plus the leading 4 and trailing 2 chars */
6060 		strncat (&(C->internal.buffer[C->internal.n]), "%\n% ", 4U);
6061 		C->internal.n += 4;
6062 		strncat (&(C->internal.buffer[C->internal.n]), tmp_buffer, len);
6063 		C->internal.n += len;
6064 		strncat (&(C->internal.buffer[C->internal.n]), "%\n", 2U);
6065 		C->internal.n += 2;
6066 	}
6067 	else {	/* Write comments to stream */
6068 		fprintf (C->internal.fp, "%%\n%% ");
6069 		vfprintf (C->internal.fp, format, args);
6070 		fprintf (C->internal.fp, "%%\n");
6071 	}
6072 	va_end (args);
6073 	return (0);
6074 }
6075 
PSL_initerr(struct PSL_CTRL * C,const char * format,...)6076 int PSL_initerr (struct PSL_CTRL *C, const char *format, ...) {
6077 	va_list args;
6078 	va_start (args, format);
6079 	vfprintf (C->init.err, format, args);
6080 	va_end (args);
6081 	return (0);
6082 }
6083 
PSL_message(struct PSL_CTRL * C,int level,const char * format,...)6084 int PSL_message (struct PSL_CTRL *C, int level, const char *format, ...) {
6085 	va_list args;
6086 	FILE *fp = (C == NULL) ? stderr : C->init.err;
6087 	if (C && level > C->internal.verbose) return (0);
6088 #ifdef DEBUG
6089 	fprintf (fp, "PSL:%s:%d: ", __FILE__, __LINE__);
6090 #else
6091 	fprintf (fp, "PSL: ");
6092 #endif
6093 	va_start (args, format);
6094 	vfprintf (fp, format, args);
6095 	va_end (args);
6096 	return (0);
6097 }
6098 
PSL_fopen(struct PSL_CTRL * C,char * file,char * mode)6099 FILE *PSL_fopen (struct PSL_CTRL *C, char *file, char *mode) {
6100 	if (C->internal.fp == NULL) {	/* Open the plot file unless fp already set */
6101 		if ((C->internal.fp = fopen (file, mode)) == NULL) {
6102 			PSL_message (C, PSL_MSG_ERROR, "PSL_fopen error: Unable to open file %s with mode %s!\n", file, mode);
6103 		}
6104 	}
6105 	return (C->internal.fp);
6106 }
6107 
PSL_fclose(struct PSL_CTRL * C)6108 int PSL_fclose (struct PSL_CTRL *C) {
6109 	/* Close except if stdout */
6110 	int err = 0;
6111 	if (C->internal.fp && C->internal.fp != stdout)
6112 		err = fclose (C->internal.fp);
6113 	C->internal.fp = NULL;
6114 	return (err);
6115 }
6116 
6117 #ifndef HAVE_RINT
6118 #include "s_rint.c"
6119 #endif
6120