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