1/*
2 * tkTablePs.c --
3 *
4 *	This module implements postscript output for table widgets.
5 *	Based off of Tk8.1a2 tkCanvPs.c.
6 *
7 * Copyright (c) 1991-1994 The Regents of the University of California.
8 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9 * changes 1998 Copyright (c) 1998 Jeffrey Hobbs
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 */
15
16#include "tkTable.h"
17
18/* This is for Tcl_DStringAppendAll */
19#if defined(__STDC__) || defined(HAS_STDARG)
20#include <stdarg.h>
21#else
22#include <varargs.h>
23#endif
24
25#ifndef TCL_INTEGER_SPACE
26/* This appears in 8.1 */
27#define TCL_INTEGER_SPACE 24
28#endif
29
30/*
31 * One of the following structures is created to keep track of Postscript
32 * output being generated.  It consists mostly of information provided on
33 * the widget command line.
34 */
35
36typedef struct TkPostscriptInfo {
37  int x, y, width, height;	/* Area to print, in table pixel
38				 * coordinates. */
39  int x2, y2;			/* x+width and y+height. */
40  char *pageXString;		/* String value of "-pagex" option or NULL. */
41  char *pageYString;		/* String value of "-pagey" option or NULL. */
42  double pageX, pageY;		/* Postscript coordinates (in points)
43				 * corresponding to pageXString and
44				 * pageYString. Don't forget that y-values
45				 * grow upwards for Postscript! */
46  char *pageWidthString;	/* Printed width of output. */
47  char *pageHeightString;	/* Printed height of output. */
48  double scale;			/* Scale factor for conversion: each pixel
49				 * maps into this many points. */
50  Tk_Anchor pageAnchor;		/* How to anchor bbox on Postscript page. */
51  int rotate;			/* Non-zero means output should be rotated
52				 * on page (landscape mode). */
53  char *fontVar;		/* If non-NULL, gives name of global variable
54				 * containing font mapping information.
55				 * Malloc'ed. */
56  char *colorVar;		/* If non-NULL, give name of global variable
57				 * containing color mapping information.
58				 * Malloc'ed. */
59  char *colorMode;		/* Mode for handling colors:  "monochrome",
60				 * "gray", or "color".  Malloc'ed. */
61  int colorLevel;		/* Numeric value corresponding to colorMode:
62				 * 0 for mono, 1 for gray, 2 for color. */
63  char *fileName;		/* Name of file in which to write Postscript;
64				 * NULL means return Postscript info as
65				 * result. Malloc'ed. */
66  char *channelName;		/* If -channel is specified, the name of
67                                 * the channel to use. */
68  Tcl_Channel chan;		/* Open channel corresponding to fileName. */
69  Tcl_HashTable fontTable;	/* Hash table containing names of all font
70				 * families used in output.  The hash table
71				 * values are not used. */
72  char *first, *last;		/* table indices to start and end at */
73} TkPostscriptInfo;
74
75/*
76 * The table below provides a template that's used to process arguments
77 * to the table "postscript" command and fill in TkPostscriptInfo
78 * structures.
79 */
80
81static Tk_ConfigSpec configSpecs[] = {
82  {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL, "",
83   Tk_Offset(TkPostscriptInfo, colorVar), 0},
84  {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, "",
85   Tk_Offset(TkPostscriptInfo, colorMode), 0},
86  {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, "",
87   Tk_Offset(TkPostscriptInfo, fileName), 0},
88  {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, "",
89   Tk_Offset(TkPostscriptInfo, channelName), 0},
90  {TK_CONFIG_STRING, "-first", (char *) NULL, (char *) NULL, "",
91   Tk_Offset(TkPostscriptInfo, first), 0},
92  {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, "",
93   Tk_Offset(TkPostscriptInfo, fontVar), 0},
94  {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, "",
95   Tk_Offset(TkPostscriptInfo, height), 0},
96  {TK_CONFIG_STRING, "-last", (char *) NULL, (char *) NULL, "",
97   Tk_Offset(TkPostscriptInfo, last), 0},
98  {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, "",
99   Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
100  {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, "",
101   Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
102  {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, "",
103   Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
104  {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, "",
105   Tk_Offset(TkPostscriptInfo, pageXString), 0},
106  {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, "",
107   Tk_Offset(TkPostscriptInfo, pageYString), 0},
108  {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, "",
109   Tk_Offset(TkPostscriptInfo, rotate), 0},
110  {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, "",
111   Tk_Offset(TkPostscriptInfo, width), 0},
112  {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, "",
113   Tk_Offset(TkPostscriptInfo, x), 0},
114  {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, "",
115   Tk_Offset(TkPostscriptInfo, y), 0},
116  {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
117   (char *) NULL, 0, 0}
118};
119
120/*
121 * The prolog data. Generated by str2c from prolog.ps
122 * This was split in small chunks by str2c because
123 * some C compiler have limitations on the size of static strings.
124 * (str2c is a small tcl script in tcl's tool directory (source release))
125 */
126/*
127 * This is a stripped down version of that found in tkCanvPs.c of Tk8.1a2.
128 * Comments, and stuff pertaining to stipples and other unused entities
129 * have been removed
130 */
131static CONST char * CONST  prolog[]= {
132	/* Start of part 1 */
133	"%%BeginProlog\n\
13450 dict begin\n\
135\n\
136% This is standard prolog for Postscript generated by Tk's table widget.\n\
137% Based of standard prolog for Tk's canvas widget.\n\
138\n\
139% INITIALIZING VARIABLES\n\
140\n\
141/baseline 0 def\n\
142/height 0 def\n\
143/justify 0 def\n\
144/cellHeight 0 def\n\
145/cellWidth 0 def\n\
146/spacing 0 def\n\
147/strings 0 def\n\
148/xoffset 0 def\n\
149/yoffset 0 def\n\
150/x 0 def\n\
151/y 0 def\n\
152\n\
153% Define the array ISOLatin1Encoding, if it isn't already present.\n\
154\n\
155systemdict /ISOLatin1Encoding known not {\n\
156    /ISOLatin1Encoding [\n\
157	/space /space /space /space /space /space /space /space\n\
158	/space /space /space /space /space /space /space /space\n\
159	/space /space /space /space /space /space /space /space\n\
160	/space /space /space /space /space /space /space /space\n\
161	/space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
162	    /quoteright\n\
163	/parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
164	/zero /one /two /three /four /five /six /seven\n\
165	/eight /nine /colon /semicolon /less /equal /greater /question\n\
166	/at /A /B /C /D /E /F /G\n\
167	/H /I /J /K /L /M /N /O\n\
168	/P /Q /R /S /T /U /V /W\n\
169	/X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
170	/quoteleft /a /b /c /d /e /f /g\n\
171	/h /i /j /k /l /m /n /o\n\
172	/p /q /r /s /t /u /v /w\n\
173	/x /y /z /braceleft /bar /braceright /asciitilde /space\n\
174	/space /space /space /space /space /space /space /space\n\
175	/space /space /space /space /space /space /space /space\n\
176	/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
177	/dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
178	/space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
179	/dieresis /copyright /ordfem",
180
181	"inine /guillemotleft /logicalnot /hyphen\n\
182	    /registered /macron\n\
183	/degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
184	    /periodcentered\n\
185	/cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
186	    /onehalf /threequarters /questiondown\n\
187	/Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
188	/Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
189	    /Idieresis\n\
190	/Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
191	/Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
192	    /germandbls\n\
193	/agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
194	/egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
195	    /idieresis\n\
196	/eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
197	/oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
198	    /ydieresis\n\
199    ] def\n\
200} if\n",
201
202	"\n\
203% font ISOEncode font\n\
204% This procedure changes the encoding of a font from the default\n\
205% Postscript encoding to ISOLatin1.  It's typically invoked just\n\
206% before invoking \"setfont\".  The body of this procedure comes from\n\
207% Section 5.6.1 of the Postscript book.\n\
208\n\
209/ISOEncode {\n\
210    dup length dict begin\n\
211	{1 index /FID ne {def} {pop pop} ifelse} forall\n\
212	/Encoding ISOLatin1Encoding def\n\
213	currentdict\n\
214    end\n\
215\n\
216    % I'm not sure why it's necessary to use \"definefont\" on this new\n\
217    % font, but it seems to be important; just use the name \"Temporary\"\n\
218    % for the font.\n\
219\n\
220    /Temporary exch definefont\n\
221} bind def\n\
222\n\
223% -- AdjustColor --\n\
224% Given a color value already set for output by the caller, adjusts\n\
225% that value to a grayscale or mono value if requested by the CL variable.\n\
226\n\
227/AdjustColor {\n\
228    setrgbcolor\n\
229    CL 2 lt {\n\
230	currentgray\n\
231	CL 0 eq {\n\
232	    .5 lt {0} {1} ifelse\n\
233	} if\n\
234	setgray\n\
235    } if\n\
236} bind def\n\
237\n\
238% pointSize fontName SetFont\n\
239% The ISOEncode shouldn't be done to Symbol fonts...\n\
240/SetFont {\n\
241  findfont exch scalefont ISOEncode setfont\n\
242} def\n\
243\n",
244
245	"% x y strings spacing xoffset yoffset justify ... DrawText --\n\
246% This procedure does all of the real work of drawing text.  The\n\
247% color and font must already have been set by the caller, and the\n\
248% following arguments must be on the stack:\n\
249%\n\
250% x, y -	Coordinates at which to draw text.\n\
251% strings -	An array of strings, one for each line of the text item,\n\
252%		in order from top to bottom.\n\
253% spacing -	Spacing between lines.\n\
254% xoffset -	Horizontal offset for text bbox relative to x and y: 0 for\n\
255%		nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
256% yoffset -	Vertical offset for text bbox relative to x and y: 0 for\n\
257%		nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
258% justify -	0 for left justification, 0.5 for center, 1 for right justify.\n\
259% cellWidth -	width for this cell\n\
260% cellHeight -	height for this cell\n\
261%\n\
262% Also, when this procedure is invoked, the color and font must already\n\
263% have been set for the text.\n\
264\n",
265
266	"/DrawCellText {\n\
267    /cellHeight exch def\n\
268    /cellWidth exch def\n\
269    /justify exch def\n\
270    /yoffset exch def\n\
271    /xoffset exch def\n\
272    /spacing exch def\n\
273    /strings exch def\n\
274    /y exch def\n\
275    /x exch def\n\
276\n\
277    % Compute the baseline offset and the actual font height.\n\
278\n\
279    0 0 moveto (TXygqPZ) false charpath\n\
280    pathbbox dup /baseline exch def\n\
281    exch pop exch sub /height exch def pop\n\
282    newpath\n\
283\n\
284    % Translate coordinates first so that the origin is at the upper-left\n\
285    % corner of the text's bounding box. Remember that x and y for\n\
286    % positioning are still on the stack.\n\
287\n\
288    col0 x sub row0 y sub translate\n\
289    cellWidth xoffset mul\n\
290    strings length 1 sub spacing mul height add yoffset mul translate\n\
291\n\
292    % Now use the baseline and justification information to translate so\n\
293    % that the origin is at the baseline and positioning point for the\n\
294    % first line of text.\n\
295\n\
296    justify cellWidth mul baseline neg translate\n\
297\n\
298    % Iterate over each of the lines to output it.  For each line,\n\
299    % compute its width again so it can be properly justified, then\n\
300    % display it.\n\
301\n\
302    strings {\n\
303	dup stringwidth pop\n\
304	justify neg mul 0 moveto\n\
305	show\n\
306	0 spacing neg translate\n\
307    } forall\n\
308} bind def\n\
309\n",
310
311	"%\n\
312% x, y -	Coordinates at which to draw text.\n\
313% strings -	An array of strings, one for each line of the text item,\n\
314%		in order from top to bottom.\n\
315% spacing -	Spacing between lines.\n\
316% xoffset -	Horizontal offset for text bbox relative to x and y: 0 for\n\
317%		nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
318% yoffset -	Vertical offset for text bbox relative to x and y: 0 for\n\
319%		nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
320% justify -	0 for left justification, 0.5 for center, 1 for right justify.\n\
321% cellWidth -	width for this cell\n\
322% cellHeight -	height for this cell\n\
323%\n\
324% Also, when this procedure is invoked, the color and font must already\n\
325% have been set for the text.\n\
326\n\
327/DrawCellTextOld {\n\
328    /cellHeight exch def\n\
329    /cellWidth exch def\n\
330    /justify exch def\n\
331    /yoffset exch def\n\
332    /xoffset exch def\n\
333    /spacing exch def\n\
334    /strings exch def\n\
335\n\
336    % Compute the baseline offset and the actual font height.\n\
337\n\
338    0 0 moveto (TXygqPZ) false charpath\n\
339    pathbbox dup /baseline exch def\n\
340    exch pop exch sub /height exch def pop\n\
341    newpath\n\
342\n\
343    % Translate coordinates first so that the origin is at the upper-left\n\
344    % corner of the text's bounding box. Remember that x and y for\n\
345    % positioning are still on the stack.\n\
346\n\
347    translate\n\
348    cellWidth xoffset mul\n\
349    strings length 1 sub spacing mul height add yoffset mul translate\n\
350\n\
351    % Now use the baseline and justification information to translate so\n\
352    % that the origin is at the baseline and positioning point for the\n\
353    % first line of text.\n\
354\n\
355    justify cellWidth mul baseline neg translate\n\
356\n\
357    % Iterate over each of the lines to output it.  For each line,\n\
358    % compute its width again so it can be properly justified, then\n\
359    % display it.\n\
360\n\
361    strings {\n\
362	dup stringwidth pop\n\
363	justify neg mul 0 moveto\n\
364	show\n\
365	0 spacing neg translate\n\
366    } forall\n\
367} bind def\n\
368\n\
369%%EndProlog\n\
370",
371	/* End of part 5 */
372
373	NULL	/* End of data marker */
374};
375
376/*
377 * Forward declarations for procedures defined later in this file:
378 */
379
380static int	GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
381			char *string, double *doublePtr));
382int		Tk_TablePsFont _ANSI_ARGS_((Tcl_Interp *interp,
383			Table *tablePtr, Tk_Font tkfont));
384int		Tk_TablePsColor _ANSI_ARGS_((Tcl_Interp *interp,
385			Table *tablePtr, XColor *colorPtr));
386static int	TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
387			Table *tablePtr, TableTag *tagPtr, int tagX, int tagY,
388			int width, int height, int row, int col,
389			Tk_TextLayout textLayout));
390
391/*
392 * Tcl could really use some more convenience routines...
393 * This is just Tcl_DStringAppend for multiple lines, including
394 * the full text of each line
395 */
396void
397Tcl_DStringAppendAll TCL_VARARGS_DEF(Tcl_DString *, arg1)
398{
399    va_list argList;
400    Tcl_DString *dstringPtr;
401    char *string;
402
403    dstringPtr = TCL_VARARGS_START(Tcl_DString *, arg1, argList);
404    while ((string = va_arg(argList, char *)) != NULL) {
405      Tcl_DStringAppend(dstringPtr, string, -1);
406    }
407    va_end(argList);
408}
409
410/*
411 *--------------------------------------------------------------
412 *
413 * Table_PostscriptCmd --
414 *
415 *	This procedure is invoked to process the "postscript" options
416 *	of the widget command for table widgets. See the user
417 *	documentation for details on what it does.
418 *
419 * Results:
420 *	A standard Tcl result.
421 *
422 * Side effects:
423 *	See the user documentation.
424 *
425 *--------------------------------------------------------------
426 */
427
428    /* ARGSUSED */
429int
430Table_PostscriptCmd(clientData, interp, objc, objv)
431     ClientData clientData;	/* Information about table widget. */
432     Tcl_Interp *interp;	/* Current interpreter. */
433     int objc;			/* Number of argument objects. */
434     Tcl_Obj *CONST objv[];
435{
436#ifdef _WIN32
437    /*
438     * At the moment, it just doesn't like this code...
439     */
440    return TCL_OK;
441#else
442    register Table *tablePtr = (Table *) clientData;
443    TkPostscriptInfo psInfo, *oldInfoPtr;
444    int result;
445    int row, col, firstRow, firstCol, lastRow, lastCol;
446    /* dimensions of first and last cell to output */
447    int x0, y0, w0, h0, xn, yn, wn, hn;
448    int x, y, w, h, i;
449#define STRING_LENGTH 400
450    char string[STRING_LENGTH+1], *p, **argv;
451    size_t length;
452    int deltaX = 0, deltaY = 0;	/* Offset of lower-left corner of area to
453				 * be marked up, measured in table units
454				 * from the positioning point on the page
455				 * (reflects anchor position).  Initial
456				 * values needed only to stop compiler
457				 * warnings. */
458    Tcl_HashSearch search;
459    Tcl_HashEntry *hPtr;
460    CONST char * CONST *chunk;
461    Tk_TextLayout textLayout = NULL;
462    char *value;
463    int rowHeight, total, *colWidths, iW, iH;
464    TableTag *tagPtr, *colPtr, *rowPtr, *titlePtr;
465    Tcl_DString postscript, buffer;
466
467    if (objc < 2) {
468	Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
469	return TCL_ERROR;
470    }
471
472    /*
473     *----------------------------------------------------------------
474     * Initialize the data structure describing Postscript generation,
475     * then process all the arguments to fill the data structure in.
476     *----------------------------------------------------------------
477     */
478
479    Tcl_DStringInit(&postscript);
480    Tcl_DStringInit(&buffer);
481    oldInfoPtr = tablePtr->psInfoPtr;
482    tablePtr->psInfoPtr = &psInfo;
483    /* This is where in the window that we start printing from */
484    psInfo.x			= 0;
485    psInfo.y			= 0;
486    psInfo.width		= -1;
487    psInfo.height		= -1;
488    psInfo.pageXString		= NULL;
489    psInfo.pageYString		= NULL;
490    psInfo.pageX		= 72*4.25;
491    psInfo.pageY		= 72*5.5;
492    psInfo.pageWidthString	= NULL;
493    psInfo.pageHeightString	= NULL;
494    psInfo.scale		= 1.0;
495    psInfo.pageAnchor		= TK_ANCHOR_CENTER;
496    psInfo.rotate		= 0;
497    psInfo.fontVar		= NULL;
498    psInfo.colorVar		= NULL;
499    psInfo.colorMode		= NULL;
500    psInfo.colorLevel		= 0;
501    psInfo.fileName		= NULL;
502    psInfo.channelName		= NULL;
503    psInfo.chan			= NULL;
504    psInfo.first		= NULL;
505    psInfo.last			= NULL;
506    Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
507
508    /*
509     * The magic StringifyObjects
510     */
511    argv = (char **) ckalloc((objc + 1) * sizeof(char *));
512    for (i = 0; i < objc; i++)
513	argv[i] = Tcl_GetString(objv[i]);
514    argv[i] = NULL;
515
516    result = Tk_ConfigureWidget(interp, tablePtr->tkwin, configSpecs,
517				objc-2, argv+2, (char *) &psInfo,
518				TK_CONFIG_ARGV_ONLY);
519    if (result != TCL_OK) {
520	goto cleanup;
521    }
522
523    if (psInfo.first == NULL) {
524	firstRow = 0;
525	firstCol = 0;
526    } else if (TableGetIndex(tablePtr, psInfo.first, &firstRow, &firstCol)
527	       != TCL_OK) {
528	result = TCL_ERROR;
529	goto cleanup;
530    }
531    if (psInfo.last == NULL) {
532	lastRow = tablePtr->rows-1;
533	lastCol = tablePtr->cols-1;
534    } else if (TableGetIndex(tablePtr, psInfo.last, &lastRow, &lastCol)
535	       != TCL_OK) {
536	result = TCL_ERROR;
537	goto cleanup;
538    }
539
540    if (psInfo.fileName != NULL) {
541	/* Check that -file and -channel are not both specified. */
542	if (psInfo.channelName != NULL) {
543	    Tcl_AppendResult(interp, "can't specify both -file",
544			     " and -channel", (char *) NULL);
545	    result = TCL_ERROR;
546	    goto cleanup;
547	}
548
549	/*
550	 * Check that we are not in a safe interpreter. If we are, disallow
551	 * the -file specification.
552	 */
553	if (Tcl_IsSafe(interp)) {
554	    Tcl_AppendResult(interp, "can't specify -file in a",
555			     " safe interpreter", (char *) NULL);
556	    result = TCL_ERROR;
557	    goto cleanup;
558	}
559
560	p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
561	if (p == NULL) {
562	    result = TCL_ERROR;
563	    goto cleanup;
564	}
565	psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
566	Tcl_DStringFree(&buffer);
567	Tcl_DStringInit(&buffer);
568	if (psInfo.chan == NULL) {
569	    result = TCL_ERROR;
570	    goto cleanup;
571	}
572    }
573
574    if (psInfo.channelName != NULL) {
575	int mode;
576	/*
577	 * Check that the channel is found in this interpreter and that it
578	 * is open for writing.
579	 */
580	psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode);
581	if (psInfo.chan == (Tcl_Channel) NULL) {
582	    result = TCL_ERROR;
583	    goto cleanup;
584	}
585	if ((mode & TCL_WRITABLE) == 0) {
586	    Tcl_AppendResult(interp, "channel \"", psInfo.channelName,
587			     "\" wasn't opened for writing", (char *) NULL);
588	    result = TCL_ERROR;
589	    goto cleanup;
590	}
591    }
592
593    if (psInfo.colorMode == NULL) {
594	psInfo.colorLevel = 2;
595    } else {
596	length = strlen(psInfo.colorMode);
597	if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
598	    psInfo.colorLevel = 0;
599	} else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
600	    psInfo.colorLevel = 1;
601	} else if (strncmp(psInfo.colorMode, "color", length) == 0) {
602	    psInfo.colorLevel = 2;
603	} else {
604	    Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode,
605			     "\": must be monochrome, gray or color", (char *) NULL);
606	    goto cleanup;
607	}
608    }
609
610    TableCellCoords(tablePtr, firstRow, firstCol, &x0, &y0, &w0, &h0);
611    TableCellCoords(tablePtr, lastRow, lastCol, &xn, &yn, &wn, &hn);
612    psInfo.x = x0;
613    psInfo.y = y0;
614    if (psInfo.width == -1) {
615	psInfo.width = xn+wn;
616    }
617    if (psInfo.height == -1) {
618	psInfo.height = yn+hn;
619    }
620    psInfo.x2 = psInfo.x + psInfo.width;
621    psInfo.y2 = psInfo.y + psInfo.height;
622
623    if (psInfo.pageXString != NULL) {
624	if (GetPostscriptPoints(interp, psInfo.pageXString,
625				&psInfo.pageX) != TCL_OK) {
626	    goto cleanup;
627	}
628    }
629    if (psInfo.pageYString != NULL) {
630	if (GetPostscriptPoints(interp, psInfo.pageYString,
631				&psInfo.pageY) != TCL_OK) {
632	    goto cleanup;
633	}
634    }
635    if (psInfo.pageWidthString != NULL) {
636	if (GetPostscriptPoints(interp, psInfo.pageWidthString,
637				&psInfo.scale) != TCL_OK) {
638	    goto cleanup;
639	}
640	psInfo.scale /= psInfo.width;
641    } else if (psInfo.pageHeightString != NULL) {
642	if (GetPostscriptPoints(interp, psInfo.pageHeightString,
643				&psInfo.scale) != TCL_OK) {
644	    goto cleanup;
645	}
646	psInfo.scale /= psInfo.height;
647    } else {
648	psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tablePtr->tkwin))
649	    / WidthOfScreen(Tk_Screen(tablePtr->tkwin));
650    }
651    switch (psInfo.pageAnchor) {
652    case TK_ANCHOR_NW:
653    case TK_ANCHOR_W:
654    case TK_ANCHOR_SW:
655	deltaX = 0;
656	break;
657    case TK_ANCHOR_N:
658    case TK_ANCHOR_CENTER:
659    case TK_ANCHOR_S:
660	deltaX = -psInfo.width/2;
661	break;
662    case TK_ANCHOR_NE:
663    case TK_ANCHOR_E:
664    case TK_ANCHOR_SE:
665	deltaX = -psInfo.width;
666	break;
667    }
668    switch (psInfo.pageAnchor) {
669    case TK_ANCHOR_NW:
670    case TK_ANCHOR_N:
671    case TK_ANCHOR_NE:
672	deltaY = - psInfo.height;
673	break;
674    case TK_ANCHOR_W:
675    case TK_ANCHOR_CENTER:
676    case TK_ANCHOR_E:
677	deltaY = -psInfo.height/2;
678	break;
679    case TK_ANCHOR_SW:
680    case TK_ANCHOR_S:
681    case TK_ANCHOR_SE:
682	deltaY = 0;
683	break;
684    }
685
686    /*
687     *--------------------------------------------------------
688     * Make a PREPASS over all of the tags
689     * to collect information about all the fonts in use, so that
690     * we can output font information in the proper form required
691     * by the Document Structuring Conventions.
692     *--------------------------------------------------------
693     */
694
695    Tk_TablePsFont(interp, tablePtr, tablePtr->defaultTag.tkfont);
696    Tcl_ResetResult(interp);
697    for (hPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
698	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
699	tagPtr = (TableTag *) Tcl_GetHashValue(hPtr);
700	if (tagPtr->tkfont != NULL) {
701	    Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont);
702	}
703    }
704    Tcl_ResetResult(interp);
705
706    /*
707     *--------------------------------------------------------
708     * Generate the header and prolog for the Postscript.
709     *--------------------------------------------------------
710     */
711
712    sprintf(string, " %d,%d => %d,%d\n", firstRow, firstCol, lastRow, lastCol);
713    Tcl_DStringAppendAll(&postscript,
714			 "%!PS-Adobe-3.0 EPSF-3.0\n",
715			 "%%Creator: Tk Table Widget ", TBL_VERSION, "\n",
716			 "%%Title: Window ",
717			 Tk_PathName(tablePtr->tkwin), string,
718			 "%%BoundingBox: ",
719			 (char *) NULL);
720    if (!psInfo.rotate) {
721	sprintf(string, "%d %d %d %d\n",
722		(int) (psInfo.pageX + psInfo.scale*deltaX),
723		(int) (psInfo.pageY + psInfo.scale*deltaY),
724		(int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
725		       + 1.0),
726		(int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
727		       + 1.0));
728    } else {
729	sprintf(string, "%d %d %d %d\n",
730		(int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
731		(int) (psInfo.pageY + psInfo.scale*deltaX),
732		(int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
733		(int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
734		       + 1.0));
735    }
736    Tcl_DStringAppendAll(&postscript, string,
737			 "%%Pages: 1\n%%DocumentData: Clean7Bit\n",
738			 "%%Orientation: ",
739			 psInfo.rotate?"Landscape\n":"Portrait\n",
740			 (char *) NULL);
741    p = "%%DocumentNeededResources: font ";
742    for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
743	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
744	sprintf(string, "%s%s\n", p, Tcl_GetHashKey(&psInfo.fontTable, hPtr));
745	Tcl_DStringAppend(&postscript, string, -1);
746	p = "%%+ font ";
747    }
748    Tcl_DStringAppend(&postscript, "%%EndComments\n\n", -1);
749
750    /*
751     * Insert the prolog
752     */
753    for (chunk=prolog; *chunk; chunk++) {
754	Tcl_DStringAppend(&postscript, *chunk, -1);
755    }
756
757    if (psInfo.chan != NULL) {
758	Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
759	Tcl_DStringFree(&postscript);
760	Tcl_DStringInit(&postscript);
761    }
762
763    /*
764     * Document setup:  set the color level and include fonts.
765     * This is where we start using &postscript
766     */
767
768    sprintf(string, "/CL %d def\n", psInfo.colorLevel);
769    Tcl_DStringAppendAll(&postscript, "%%BeginSetup\n", string, (char *) NULL);
770    for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
771	 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
772	sprintf(string, "%s%s\n", "%%IncludeResource: font ",
773		Tcl_GetHashKey(&psInfo.fontTable, hPtr));
774	Tcl_DStringAppend(&postscript, string, -1);
775    }
776    Tcl_DStringAppend(&postscript, "%%EndSetup\n\n", -1);
777
778    /*
779     * Page setup:  move to page positioning point, rotate if
780     * needed, set scale factor, offset for proper anchor position,
781     * and set clip region.
782     */
783
784    sprintf(string, "%.1f %.1f translate\n",
785	    psInfo.pageX, psInfo.pageY);
786    Tcl_DStringAppendAll(&postscript, "%%Page: 1 1\nsave\n",
787			 string, psInfo.rotate?"90 rotate\n":"",
788			 (char *) NULL);
789    sprintf(string, "%.4g %.4g scale\n%d %d translate\n",
790	    psInfo.scale, psInfo.scale, deltaX - psInfo.x, deltaY);
791    Tcl_DStringAppend(&postscript, string, -1);
792    sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
793	    psInfo.x, (double) psInfo.y2-psInfo.y,
794	    psInfo.x2,(double) psInfo.y2-psInfo.y,
795	    psInfo.x2, 0.0, psInfo.x, 0.0);
796    Tcl_DStringAppend(&postscript, string, -1);
797    Tcl_DStringAppend(&postscript, " lineto closepath clip newpath\n", -1);
798    if (psInfo.chan != NULL) {
799	Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
800	Tcl_DStringFree(&postscript);
801	Tcl_DStringInit(&postscript);
802    }
803
804    /*
805     * Go through each cell, calculating full desired height
806     */
807    result = TCL_OK;
808
809    hPtr = Tcl_FindHashEntry(tablePtr->tagTable, "title");
810    titlePtr = (TableTag *) Tcl_GetHashValue(hPtr);
811
812    total = 0;
813    colWidths = (int *) ckalloc((lastCol-firstCol) * sizeof(int));
814    for (col = 0; col <= lastCol-firstCol; col++) colWidths[col] = 0;
815    Tcl_DStringAppend(&buffer, "gsave\n", -1);
816    for (row = firstRow; row <= lastRow; row++) {
817	rowHeight = 0;
818	rowPtr = FindRowColTag(tablePtr, row+tablePtr->rowOffset, ROW);
819	for (col = firstCol; col <= lastCol; col++) {
820	    /* get the coordinates for the cell */
821	    TableCellCoords(tablePtr, row, col, &x, &y, &w, &h);
822	    if ((x >= psInfo.x2) || (x+w < psInfo.x) ||
823		(y >= psInfo.y2) || (y+h < psInfo.y)) {
824		continue;
825	    }
826
827	    if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
828		value = tablePtr->activeBuf;
829	    } else {
830		value = TableGetCellValue(tablePtr, row+tablePtr->rowOffset,
831					  col+tablePtr->colOffset);
832	    }
833	    if (!strlen(value)) {
834		continue;
835	    }
836
837	    /* Create the tag here */
838	    tagPtr = TableNewTag();
839	    /* First, merge in the default tag */
840	    TableMergeTag(tagPtr, &(tablePtr->defaultTag));
841
842	    colPtr = FindRowColTag(tablePtr, col+tablePtr->colOffset, COL);
843	    if (colPtr != (TableTag *) NULL) TableMergeTag(tagPtr, colPtr);
844	    if (rowPtr != (TableTag *) NULL) TableMergeTag(tagPtr, rowPtr);
845	    /* Am I in the titles */
846	    if (row < tablePtr->topRow || col < tablePtr->leftCol) {
847		TableMergeTag(tagPtr, titlePtr);
848	    }
849	    /* Does this have a cell tag */
850	    TableMakeArrayIndex(row+tablePtr->rowOffset,
851				col+tablePtr->colOffset, string);
852	    hPtr = Tcl_FindHashEntry(tablePtr->cellStyles, string);
853	    if (hPtr != NULL) {
854		TableMergeTag(tagPtr, (TableTag *) Tcl_GetHashValue(hPtr));
855	    }
856
857	    /*
858	     * the use of -1 instead of Tcl_NumUtfChars means we don't
859	     * pass NULLs to postscript
860	     */
861	    textLayout = Tk_ComputeTextLayout(tagPtr->tkfont, value, -1,
862					      (tagPtr->wrap>0) ? w : 0,
863					      tagPtr->justify,
864					      (tagPtr->multiline>0) ? 0 :
865					      TK_IGNORE_NEWLINES, &iW, &iH);
866
867	    rowHeight = MAX(rowHeight, iH);
868	    colWidths[col-firstCol] = MAX(colWidths[col-firstCol], iW);
869
870	    result = TextToPostscript(interp, tablePtr, tagPtr,
871				      x, y, iW, iH, row, col, textLayout);
872	    Tk_FreeTextLayout(textLayout);
873	    if (result != TCL_OK) {
874		char msg[64 + TCL_INTEGER_SPACE];
875
876		sprintf(msg, "\n    (generating Postscript for cell %s)",
877			string);
878		Tcl_AddErrorInfo(interp, msg);
879		goto cleanup;
880	    }
881	    Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
882	}
883	sprintf(string, "/row%d %d def\n",
884		row, tablePtr->psInfoPtr->y2 - total);
885	Tcl_DStringAppend(&postscript, string, -1);
886	total += rowHeight + 2*tablePtr->defaultTag.bd;
887    }
888    Tcl_DStringAppend(&buffer, "grestore\n", -1);
889    sprintf(string, "/row%d %d def\n", row, tablePtr->psInfoPtr->y2 - total);
890    Tcl_DStringAppend(&postscript, string, -1);
891
892    total = tablePtr->defaultTag.bd;
893    for (col = firstCol; col <= lastCol; col++) {
894	sprintf(string, "/col%d %d def\n", col, total);
895	Tcl_DStringAppend(&postscript, string, -1);
896	total += colWidths[col-firstCol] + 2*tablePtr->defaultTag.bd;
897    }
898    sprintf(string, "/col%d %d def\n", col, total);
899    Tcl_DStringAppend(&postscript, string, -1);
900
901    Tcl_DStringAppend(&postscript, Tcl_DStringValue(&buffer), -1);
902
903    /*
904     * Output to channel at the end of it all
905     * This should more incremental, but that can't be avoided in order
906     * to post-define width/height of the cols/rows
907     */
908    if (psInfo.chan != NULL) {
909	Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
910	Tcl_DStringFree(&postscript);
911	Tcl_DStringInit(&postscript);
912    }
913
914    /*
915     *---------------------------------------------------------------------
916     * Output page-end information, such as commands to print the page
917     * and document trailer stuff.
918     *---------------------------------------------------------------------
919     */
920
921    Tcl_DStringAppend(&postscript,
922		      "restore showpage\n\n%%Trailer\nend\n%%EOF\n", -1);
923    if (psInfo.chan != NULL) {
924	Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1);
925	Tcl_DStringFree(&postscript);
926	Tcl_DStringInit(&postscript);
927    }
928
929    /*
930   * Clean up psInfo to release malloc'ed stuff.
931   */
932
933cleanup:
934    ckfree((char *) argv);
935    Tcl_DStringResult(interp, &postscript);
936    Tcl_DStringFree(&postscript);
937    Tcl_DStringFree(&buffer);
938    if (psInfo.first != NULL) {
939	ckfree(psInfo.first);
940    }
941    if (psInfo.last != NULL) {
942	ckfree(psInfo.last);
943    }
944    if (psInfo.pageXString != NULL) {
945	ckfree(psInfo.pageXString);
946    }
947    if (psInfo.pageYString != NULL) {
948	ckfree(psInfo.pageYString);
949    }
950    if (psInfo.pageWidthString != NULL) {
951	ckfree(psInfo.pageWidthString);
952    }
953    if (psInfo.pageHeightString != NULL) {
954	ckfree(psInfo.pageHeightString);
955    }
956    if (psInfo.fontVar != NULL) {
957	ckfree(psInfo.fontVar);
958    }
959    if (psInfo.colorVar != NULL) {
960	ckfree(psInfo.colorVar);
961    }
962    if (psInfo.colorMode != NULL) {
963	ckfree(psInfo.colorMode);
964    }
965    if (psInfo.fileName != NULL) {
966	ckfree(psInfo.fileName);
967    }
968    if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
969	Tcl_Close(interp, psInfo.chan);
970    }
971    if (psInfo.channelName != NULL) {
972	ckfree(psInfo.channelName);
973    }
974    Tcl_DeleteHashTable(&psInfo.fontTable);
975    tablePtr->psInfoPtr = oldInfoPtr;
976    return result;
977#endif
978}
979
980/*
981 *--------------------------------------------------------------
982 *
983 * Tk_TablePsColor --
984 *
985 *	This procedure is called by individual table items when
986 *	they want to set a color value for output.  Given information
987 *	about an X color, this procedure will generate Postscript
988 *	commands to set up an appropriate color in Postscript.
989 *
990 * Results:
991 *	Returns a standard Tcl return value.  If an error occurs
992 *	then an error message will be left in the interp's result.
993 *	If no error occurs, then additional Postscript will be
994 *	appended to the interp's result.
995 *
996 * Side effects:
997 *	None.
998 *
999 *--------------------------------------------------------------
1000 */
1001
1002int
1003Tk_TablePsColor(interp, tablePtr, colorPtr)
1004     Tcl_Interp *interp;		/* Interpreter for returning Postscript
1005					 * or error message. */
1006     Table *tablePtr;			/* Information about table. */
1007     XColor *colorPtr;			/* Information about color. */
1008{
1009    TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr;
1010    int tmp;
1011    double red, green, blue;
1012    char string[200];
1013
1014    /*
1015     * If there is a color map defined, then look up the color's name
1016     * in the map and use the Postscript commands found there, if there
1017     * are any.
1018     */
1019
1020    if (psInfoPtr->colorVar != NULL) {
1021	char *cmdString;
1022
1023	cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
1024				Tk_NameOfColor(colorPtr), 0);
1025	if (cmdString != NULL) {
1026	    Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
1027	    return TCL_OK;
1028	}
1029    }
1030
1031    /*
1032     * No color map entry for this color.  Grab the color's intensities
1033     * and output Postscript commands for them.  Special note:  X uses
1034     * a range of 0-65535 for intensities, but most displays only use
1035     * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
1036     * X scale.  This means that there's no way to get perfect white,
1037     * since the highest intensity is only 65280 out of 65535.  To
1038     * work around this problem, rescale the X intensity to a 0-255
1039     * scale and use that as the basis for the Postscript colors.  This
1040     * scheme still won't work if the display only uses 4 bits per color,
1041     * but most diplays use at least 8 bits.
1042     */
1043
1044    tmp = colorPtr->red;
1045    red = ((double) (tmp >> 8))/255.0;
1046    tmp = colorPtr->green;
1047    green = ((double) (tmp >> 8))/255.0;
1048    tmp = colorPtr->blue;
1049    blue = ((double) (tmp >> 8))/255.0;
1050    sprintf(string, "%.3f %.3f %.3f AdjustColor\n",
1051	    red, green, blue);
1052    Tcl_AppendResult(interp, string, (char *) NULL);
1053    return TCL_OK;
1054}
1055
1056/*
1057 *--------------------------------------------------------------
1058 *
1059 * Tk_TablePsFont --
1060 *
1061 *	This procedure is called by individual table items when
1062 *	they want to output text.  Given information about an X
1063 *	font, this procedure will generate Postscript commands
1064 *	to set up an appropriate font in Postscript.
1065 *
1066 * Results:
1067 *	Returns a standard Tcl return value.  If an error occurs
1068 *	then an error message will be left in the interp's result.
1069 *	If no error occurs, then additional Postscript will be
1070 *	appended to the interp's result.
1071 *
1072 * Side effects:
1073 *	The Postscript font name is entered into psInfoPtr->fontTable
1074 *	if it wasn't already there.
1075 *
1076 *--------------------------------------------------------------
1077 */
1078
1079int
1080Tk_TablePsFont(interp, tablePtr, tkfont)
1081     Tcl_Interp *interp;		/* Interpreter for returning Postscript
1082					 * or error message. */
1083     Table *tablePtr;			/* Information about table. */
1084     Tk_Font tkfont;			/* Information about font in which text
1085					 * is to be printed. */
1086{
1087    TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr;
1088    char *end;
1089    char pointString[TCL_INTEGER_SPACE];
1090    Tcl_DString ds;
1091    int i, points;
1092
1093    /*
1094     * First, look up the font's name in the font map, if there is one.
1095     * If there is an entry for this font, it consists of a list
1096     * containing font name and size.  Use this information.
1097     */
1098
1099    Tcl_DStringInit(&ds);
1100
1101    if (psInfoPtr->fontVar != NULL) {
1102	char *list, **argv;
1103	int objc;
1104	double size;
1105	char *name;
1106
1107	name = Tk_NameOfFont(tkfont);
1108	list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
1109	if (list != NULL) {
1110	    if (Tcl_SplitList(interp, list, &objc, &argv) != TCL_OK) {
1111	    badMapEntry:
1112		Tcl_ResetResult(interp);
1113		Tcl_AppendResult(interp, "bad font map entry for \"", name,
1114				 "\": \"", list, "\"", (char *) NULL);
1115		return TCL_ERROR;
1116	    }
1117	    if (objc != 2) {
1118		goto badMapEntry;
1119	    }
1120	    size = strtod(argv[1], &end);
1121	    if ((size <= 0) || (*end != 0)) {
1122		goto badMapEntry;
1123	    }
1124
1125	    Tcl_DStringAppend(&ds, argv[0], -1);
1126	    points = (int) size;
1127
1128	    ckfree((char *) argv);
1129	    goto findfont;
1130	}
1131    }
1132
1133    points = Tk_PostscriptFontName(tkfont, &ds);
1134
1135findfont:
1136    sprintf(pointString, "%d", points);
1137    Tcl_AppendResult(interp, pointString, " /", Tcl_DStringValue(&ds),
1138		     " SetFont\n", (char *) NULL);
1139    Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
1140    Tcl_DStringFree(&ds);
1141
1142    return TCL_OK;
1143}
1144
1145/*
1146 *--------------------------------------------------------------
1147 *
1148 * GetPostscriptPoints --
1149 *
1150 *	Given a string, returns the number of Postscript points
1151 *	corresponding to that string.
1152 *
1153 * Results:
1154 *	The return value is a standard Tcl return result.  If
1155 *	TCL_OK is returned, then everything went well and the
1156 *	screen distance is stored at *doublePtr;  otherwise
1157 *	TCL_ERROR is returned and an error message is left in
1158 *	the interp's result.
1159 *
1160 * Side effects:
1161 *	None.
1162 *
1163 *--------------------------------------------------------------
1164 */
1165
1166static int
1167GetPostscriptPoints(interp, string, doublePtr)
1168     Tcl_Interp *interp;		/* Use this for error reporting. */
1169     char *string;		/* String describing a screen distance. */
1170     double *doublePtr;		/* Place to store converted result. */
1171{
1172    char *end;
1173    double d;
1174
1175    d = strtod(string, &end);
1176    if (end == string) {
1177    error:
1178	Tcl_AppendResult(interp, "bad distance \"", string,
1179			 "\"", (char *) NULL);
1180	return TCL_ERROR;
1181    }
1182#define UCHAR(c) ((unsigned char) (c))
1183    while ((*end != '\0') && isspace(UCHAR(*end))) {
1184	end++;
1185    }
1186    switch (*end) {
1187    case 'c':
1188	d *= 72.0/2.54;
1189	end++;
1190	break;
1191    case 'i':
1192	d *= 72.0;
1193	end++;
1194	break;
1195    case 'm':
1196	d *= 72.0/25.4;
1197	end++;
1198	break;
1199    case 0:
1200	break;
1201    case 'p':
1202	end++;
1203	break;
1204    default:
1205	goto error;
1206    }
1207    while ((*end != '\0') && isspace(UCHAR(*end))) {
1208	end++;
1209    }
1210    if (*end != 0) {
1211	goto error;
1212    }
1213    *doublePtr = d;
1214    return TCL_OK;
1215}
1216
1217/*
1218 *--------------------------------------------------------------
1219 *
1220 * TextToPostscript --
1221 *
1222 *	This procedure is called to generate Postscript for
1223 *	text items.
1224 *
1225 * Results:
1226 *	The return value is a standard Tcl result.  If an error
1227 *	occurs in generating Postscript then an error message is
1228 *	left in the interp's result, replacing whatever used
1229 *	to be there.  If no error occurs, then Postscript for the
1230 *	item is appended to the result.
1231 *
1232 * Side effects:
1233 *	None.
1234 *
1235 *--------------------------------------------------------------
1236 */
1237
1238static int
1239TextToPostscript(interp, tablePtr, tagPtr, tagX, tagY, width, height,
1240		 row, col, textLayout)
1241     Tcl_Interp *interp;	/* Leave Postscript or error message here. */
1242     Table *tablePtr;		/* Information about overall canvas. */
1243     TableTag *tagPtr;		/*  */
1244     int tagX, tagY;		/*  */
1245     int width, height;		/*  */
1246     int row, col;		/*  */
1247     Tk_TextLayout textLayout;	/*  */
1248{
1249    int x, y;
1250    Tk_FontMetrics fm;
1251    char *justify;
1252    char buffer[500];
1253    Tk_3DBorder fg = tagPtr->fg;
1254
1255    if (fg == NULL) {
1256	fg = tablePtr->defaultTag.fg;
1257    }
1258
1259    if (Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont) != TCL_OK) {
1260	return TCL_ERROR;
1261    }
1262    if (Tk_TablePsColor(interp, tablePtr, Tk_3DBorderColor(fg)) != TCL_OK) {
1263	return TCL_ERROR;
1264    }
1265
1266    sprintf(buffer, "%% %.15g %.15g [\n", (tagX+width)/2.0,
1267	    tablePtr->psInfoPtr->y2 - ((tagY+height)/2.0));
1268    Tcl_AppendResult(interp, buffer, (char *) NULL);
1269    sprintf(buffer, "col%d row%d [\n", col, row);
1270    Tcl_AppendResult(interp, buffer, (char *) NULL);
1271
1272    Tk_TextLayoutToPostscript(interp, textLayout);
1273
1274    x = 0;  y = 0;  justify = NULL;	/* lint. */
1275    switch (tagPtr->anchor) {
1276    case TK_ANCHOR_NW:		x = 0; y = 0;	break;
1277    case TK_ANCHOR_N:		x = 1; y = 0;	break;
1278    case TK_ANCHOR_NE:		x = 2; y = 0;	break;
1279    case TK_ANCHOR_E:		x = 2; y = 1;	break;
1280    case TK_ANCHOR_SE:		x = 2; y = 2;	break;
1281    case TK_ANCHOR_S:		x = 1; y = 2;	break;
1282    case TK_ANCHOR_SW:		x = 0; y = 2;	break;
1283    case TK_ANCHOR_W:		x = 0; y = 1;	break;
1284    case TK_ANCHOR_CENTER:	x = 1; y = 1;	break;
1285    }
1286    switch (tagPtr->justify) {
1287    case TK_JUSTIFY_RIGHT:	justify = "1";	break;
1288    case TK_JUSTIFY_CENTER:	justify = "0.5";break;
1289    case TK_JUSTIFY_LEFT:	justify = "0";
1290    }
1291
1292    Tk_GetFontMetrics(tagPtr->tkfont, &fm);
1293    sprintf(buffer, "] %d %g %g %s %d %d DrawCellText\n",
1294	    fm.linespace, (x / -2.0), (y / 2.0), justify,
1295	    width, height);
1296    Tcl_AppendResult(interp, buffer, (char *) NULL);
1297
1298    return TCL_OK;
1299}
1300