diff options
Diffstat (limited to 'libgui/src/tkTablePs.c')
| -rw-r--r-- | libgui/src/tkTablePs.c | 1299 |
1 files changed, 1299 insertions, 0 deletions
diff --git a/libgui/src/tkTablePs.c b/libgui/src/tkTablePs.c new file mode 100644 index 00000000000..018f0791ec3 --- /dev/null +++ b/libgui/src/tkTablePs.c @@ -0,0 +1,1299 @@ +/* + * tkTablePs.c -- + * + * This module implements postscript output for table widgets. + * Based off of Tk8.1a2 tkCanvPs.c. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * changes 1998 Copyright (c) 1998 Jeffrey Hobbs + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + */ + +#include "tkTable.h" + +/* This is for Tcl_DStringAppendAll */ +#if defined(__STDC__) || defined(HAS_STDARG) +#include <stdarg.h> +#else +#include <varargs.h> +#endif + +#ifndef TCL_INTEGER_SPACE +/* This appears in 8.1 */ +#define TCL_INTEGER_SPACE 24 +#endif + +/* + * One of the following structures is created to keep track of Postscript + * output being generated. It consists mostly of information provided on + * the widget command line. + */ + +typedef struct TkPostscriptInfo { + int x, y, width, height; /* Area to print, in table pixel + * coordinates. */ + int x2, y2; /* x+width and y+height. */ + char *pageXString; /* String value of "-pagex" option or NULL. */ + char *pageYString; /* String value of "-pagey" option or NULL. */ + double pageX, pageY; /* Postscript coordinates (in points) + * corresponding to pageXString and + * pageYString. Don't forget that y-values + * grow upwards for Postscript! */ + char *pageWidthString; /* Printed width of output. */ + char *pageHeightString; /* Printed height of output. */ + double scale; /* Scale factor for conversion: each pixel + * maps into this many points. */ + Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */ + int rotate; /* Non-zero means output should be rotated + * on page (landscape mode). */ + char *fontVar; /* If non-NULL, gives name of global variable + * containing font mapping information. + * Malloc'ed. */ + char *colorVar; /* If non-NULL, give name of global variable + * containing color mapping information. + * Malloc'ed. */ + char *colorMode; /* Mode for handling colors: "monochrome", + * "gray", or "color". Malloc'ed. */ + int colorLevel; /* Numeric value corresponding to colorMode: + * 0 for mono, 1 for gray, 2 for color. */ + char *fileName; /* Name of file in which to write Postscript; + * NULL means return Postscript info as + * result. Malloc'ed. */ + char *channelName; /* If -channel is specified, the name of + * the channel to use. */ + Tcl_Channel chan; /* Open channel corresponding to fileName. */ + Tcl_HashTable fontTable; /* Hash table containing names of all font + * families used in output. The hash table + * values are not used. */ + char *first, *last; /* table indices to start and end at */ +} TkPostscriptInfo; + +/* + * The table below provides a template that's used to process arguments + * to the table "postscript" command and fill in TkPostscriptInfo + * structures. + */ + +static Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, colorVar), 0}, + {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, colorMode), 0}, + {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, fileName), 0}, + {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, channelName), 0}, + {TK_CONFIG_STRING, "-first", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, first), 0}, + {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, fontVar), 0}, + {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, height), 0}, + {TK_CONFIG_STRING, "-last", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, last), 0}, + {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, + {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, + {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, + {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, pageXString), 0}, + {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, pageYString), 0}, + {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, rotate), 0}, + {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, width), 0}, + {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, x), 0}, + {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, "", + Tk_Offset(TkPostscriptInfo, y), 0}, + {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, + (char *) NULL, 0, 0} +}; + +/* + * The prolog data. Generated by str2c from prolog.ps + * This was split in small chunks by str2c because + * some C compiler have limitations on the size of static strings. + * (str2c is a small tcl script in tcl's tool directory (source release)) + */ +/* + * This is a stripped down version of that found in tkCanvPs.c of Tk8.1a2. + * Comments, and stuff pertaining to stipples and other unused entities + * have been removed + */ +static CONST char * CONST prolog[]= { + /* Start of part 1 */ + "%%BeginProlog\n\ +50 dict begin\n\ +\n\ +% This is standard prolog for Postscript generated by Tk's table widget.\n\ +% Based of standard prolog for Tk's canvas widget.\n\ +\n\ +% INITIALIZING VARIABLES\n\ +\n\ +/baseline 0 def\n\ +/height 0 def\n\ +/justify 0 def\n\ +/cellHeight 0 def\n\ +/cellWidth 0 def\n\ +/spacing 0 def\n\ +/strings 0 def\n\ +/xoffset 0 def\n\ +/yoffset 0 def\n\ +/x 0 def\n\ +/y 0 def\n\ +\n\ +% Define the array ISOLatin1Encoding, if it isn't already present.\n\ +\n\ +systemdict /ISOLatin1Encoding known not {\n\ + /ISOLatin1Encoding [\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\ + /quoteright\n\ + /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\ + /zero /one /two /three /four /five /six /seven\n\ + /eight /nine /colon /semicolon /less /equal /greater /question\n\ + /at /A /B /C /D /E /F /G\n\ + /H /I /J /K /L /M /N /O\n\ + /P /Q /R /S /T /U /V /W\n\ + /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\ + /quoteleft /a /b /c /d /e /f /g\n\ + /h /i /j /k /l /m /n /o\n\ + /p /q /r /s /t /u /v /w\n\ + /x /y /z /braceleft /bar /braceright /asciitilde /space\n\ + /space /space /space /space /space /space /space /space\n\ + /space /space /space /space /space /space /space /space\n\ + /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\ + /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\ + /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\ + /dieresis /copyright /ordfem", + + "inine /guillemotleft /logicalnot /hyphen\n\ + /registered /macron\n\ + /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\ + /periodcentered\n\ + /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\ + /onehalf /threequarters /questiondown\n\ + /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\ + /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\ + /Idieresis\n\ + /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\ + /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\ + /germandbls\n\ + /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\ + /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\ + /idieresis\n\ + /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\ + /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\ + /ydieresis\n\ + ] def\n\ +} if\n", + + "\n\ +% font ISOEncode font\n\ +% This procedure changes the encoding of a font from the default\n\ +% Postscript encoding to ISOLatin1. It's typically invoked just\n\ +% before invoking \"setfont\". The body of this procedure comes from\n\ +% Section 5.6.1 of the Postscript book.\n\ +\n\ +/ISOEncode {\n\ + dup length dict begin\n\ + {1 index /FID ne {def} {pop pop} ifelse} forall\n\ + /Encoding ISOLatin1Encoding def\n\ + currentdict\n\ + end\n\ +\n\ + % I'm not sure why it's necessary to use \"definefont\" on this new\n\ + % font, but it seems to be important; just use the name \"Temporary\"\n\ + % for the font.\n\ +\n\ + /Temporary exch definefont\n\ +} bind def\n\ +\n\ +% -- AdjustColor --\n\ +% Given a color value already set for output by the caller, adjusts\n\ +% that value to a grayscale or mono value if requested by the CL variable.\n\ +\n\ +/AdjustColor {\n\ + setrgbcolor\n\ + CL 2 lt {\n\ + currentgray\n\ + CL 0 eq {\n\ + .5 lt {0} {1} ifelse\n\ + } if\n\ + setgray\n\ + } if\n\ +} bind def\n\ +\n\ +% pointSize fontName SetFont\n\ +% The ISOEncode shouldn't be done to Symbol fonts...\n\ +/SetFont {\n\ + findfont exch scalefont ISOEncode setfont\n\ +} def\n\ +\n", + + "% x y strings spacing xoffset yoffset justify ... DrawText --\n\ +% This procedure does all of the real work of drawing text. The\n\ +% color and font must already have been set by the caller, and the\n\ +% following arguments must be on the stack:\n\ +%\n\ +% x, y - Coordinates at which to draw text.\n\ +% strings - An array of strings, one for each line of the text item,\n\ +% in order from top to bottom.\n\ +% spacing - Spacing between lines.\n\ +% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\ +% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\ +% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\ +% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\ +% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\ +% cellWidth - width for this cell\n\ +% cellHeight - height for this cell\n\ +%\n\ +% Also, when this procedure is invoked, the color and font must already\n\ +% have been set for the text.\n\ +\n", + + "/DrawCellText {\n\ + /cellHeight exch def\n\ + /cellWidth exch def\n\ + /justify exch def\n\ + /yoffset exch def\n\ + /xoffset exch def\n\ + /spacing exch def\n\ + /strings exch def\n\ + /y exch def\n\ + /x exch def\n\ +\n\ + % Compute the baseline offset and the actual font height.\n\ +\n\ + 0 0 moveto (TXygqPZ) false charpath\n\ + pathbbox dup /baseline exch def\n\ + exch pop exch sub /height exch def pop\n\ + newpath\n\ +\n\ + % Translate coordinates first so that the origin is at the upper-left\n\ + % corner of the text's bounding box. Remember that x and y for\n\ + % positioning are still on the stack.\n\ +\n\ + col0 x sub row0 y sub translate\n\ + cellWidth xoffset mul\n\ + strings length 1 sub spacing mul height add yoffset mul translate\n\ +\n\ + % Now use the baseline and justification information to translate so\n\ + % that the origin is at the baseline and positioning point for the\n\ + % first line of text.\n\ +\n\ + justify cellWidth mul baseline neg translate\n\ +\n\ + % Iterate over each of the lines to output it. For each line,\n\ + % compute its width again so it can be properly justified, then\n\ + % display it.\n\ +\n\ + strings {\n\ + dup stringwidth pop\n\ + justify neg mul 0 moveto\n\ + show\n\ + 0 spacing neg translate\n\ + } forall\n\ +} bind def\n\ +\n", + + "%\n\ +% x, y - Coordinates at which to draw text.\n\ +% strings - An array of strings, one for each line of the text item,\n\ +% in order from top to bottom.\n\ +% spacing - Spacing between lines.\n\ +% xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\ +% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\ +% yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\ +% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\ +% justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\ +% cellWidth - width for this cell\n\ +% cellHeight - height for this cell\n\ +%\n\ +% Also, when this procedure is invoked, the color and font must already\n\ +% have been set for the text.\n\ +\n\ +/DrawCellTextOld {\n\ + /cellHeight exch def\n\ + /cellWidth exch def\n\ + /justify exch def\n\ + /yoffset exch def\n\ + /xoffset exch def\n\ + /spacing exch def\n\ + /strings exch def\n\ +\n\ + % Compute the baseline offset and the actual font height.\n\ +\n\ + 0 0 moveto (TXygqPZ) false charpath\n\ + pathbbox dup /baseline exch def\n\ + exch pop exch sub /height exch def pop\n\ + newpath\n\ +\n\ + % Translate coordinates first so that the origin is at the upper-left\n\ + % corner of the text's bounding box. Remember that x and y for\n\ + % positioning are still on the stack.\n\ +\n\ + translate\n\ + cellWidth xoffset mul\n\ + strings length 1 sub spacing mul height add yoffset mul translate\n\ +\n\ + % Now use the baseline and justification information to translate so\n\ + % that the origin is at the baseline and positioning point for the\n\ + % first line of text.\n\ +\n\ + justify cellWidth mul baseline neg translate\n\ +\n\ + % Iterate over each of the lines to output it. For each line,\n\ + % compute its width again so it can be properly justified, then\n\ + % display it.\n\ +\n\ + strings {\n\ + dup stringwidth pop\n\ + justify neg mul 0 moveto\n\ + show\n\ + 0 spacing neg translate\n\ + } forall\n\ +} bind def\n\ +\n\ +%%EndProlog\n\ +", + /* End of part 5 */ + + NULL /* End of data marker */ +}; + +/* + * Forward declarations for procedures defined later in this file: + */ + +static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp, + char *string, double *doublePtr)); +int Tk_TablePsFont _ANSI_ARGS_((Tcl_Interp *interp, + Table *tablePtr, Tk_Font tkfont)); +int Tk_TablePsColor _ANSI_ARGS_((Tcl_Interp *interp, + Table *tablePtr, XColor *colorPtr)); +static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp, + Table *tablePtr, TableTag *tagPtr, int tagX, int tagY, + int width, int height, int row, int col, + Tk_TextLayout textLayout)); + +/* + * Tcl could really use some more convenience routines... + * This is just Tcl_DStringAppend for multiple lines, including + * the full text of each line + */ +void +Tcl_DStringAppendAll TCL_VARARGS_DEF(Tcl_DString *, arg1) +{ + va_list argList; + Tcl_DString *dstringPtr; + char *string; + + dstringPtr = TCL_VARARGS_START(Tcl_DString *, arg1, argList); + while ((string = va_arg(argList, char *)) != NULL) { + Tcl_DStringAppend(dstringPtr, string, -1); + } + va_end(argList); +} + +/* + *-------------------------------------------------------------- + * + * Table_PostscriptCmd -- + * + * This procedure is invoked to process the "postscript" options + * of the widget command for table widgets. See the user + * documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +Table_PostscriptCmd(clientData, interp, objc, objv) + ClientData clientData; /* Information about table widget. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of argument objects. */ + Tcl_Obj *CONST objv[]; +{ +#ifdef _WIN32 + /* + * At the moment, it just doesn't like this code... + */ + return TCL_OK; +#else + register Table *tablePtr = (Table *) clientData; + TkPostscriptInfo psInfo, *oldInfoPtr; + int result; + int row, col, firstRow, firstCol, lastRow, lastCol; + /* dimensions of first and last cell to output */ + int x0, y0, w0, h0, xn, yn, wn, hn; + int x, y, w, h, i; +#define STRING_LENGTH 400 + char string[STRING_LENGTH+1], *p, **argv; + size_t length; + int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to + * be marked up, measured in table units + * from the positioning point on the page + * (reflects anchor position). Initial + * values needed only to stop compiler + * warnings. */ + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + CONST char * CONST *chunk; + Tk_TextLayout textLayout = NULL; + char *value; + int rowHeight, total, *colWidths, iW, iH; + TableTag *tagPtr, *colPtr, *rowPtr, *titlePtr; + Tcl_DString postscript, buffer; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?"); + return TCL_ERROR; + } + + /* + *---------------------------------------------------------------- + * Initialize the data structure describing Postscript generation, + * then process all the arguments to fill the data structure in. + *---------------------------------------------------------------- + */ + + Tcl_DStringInit(&postscript); + Tcl_DStringInit(&buffer); + oldInfoPtr = tablePtr->psInfoPtr; + tablePtr->psInfoPtr = &psInfo; + /* This is where in the window that we start printing from */ + psInfo.x = 0; + psInfo.y = 0; + psInfo.width = -1; + psInfo.height = -1; + psInfo.pageXString = NULL; + psInfo.pageYString = NULL; + psInfo.pageX = 72*4.25; + psInfo.pageY = 72*5.5; + psInfo.pageWidthString = NULL; + psInfo.pageHeightString = NULL; + psInfo.scale = 1.0; + psInfo.pageAnchor = TK_ANCHOR_CENTER; + psInfo.rotate = 0; + psInfo.fontVar = NULL; + psInfo.colorVar = NULL; + psInfo.colorMode = NULL; + psInfo.colorLevel = 0; + psInfo.fileName = NULL; + psInfo.channelName = NULL; + psInfo.chan = NULL; + psInfo.first = NULL; + psInfo.last = NULL; + Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); + + /* + * The magic StringifyObjects + */ + argv = (char **) ckalloc((objc + 1) * sizeof(char *)); + for (i = 0; i < objc; i++) + argv[i] = Tcl_GetString(objv[i]); + argv[i] = NULL; + + result = Tk_ConfigureWidget(interp, tablePtr->tkwin, configSpecs, + objc-2, argv+2, (char *) &psInfo, + TK_CONFIG_ARGV_ONLY); + if (result != TCL_OK) { + goto cleanup; + } + + if (psInfo.first == NULL) { + firstRow = 0; + firstCol = 0; + } else if (TableGetIndex(tablePtr, psInfo.first, &firstRow, &firstCol) + != TCL_OK) { + result = TCL_ERROR; + goto cleanup; + } + if (psInfo.last == NULL) { + lastRow = tablePtr->rows-1; + lastCol = tablePtr->cols-1; + } else if (TableGetIndex(tablePtr, psInfo.last, &lastRow, &lastCol) + != TCL_OK) { + result = TCL_ERROR; + goto cleanup; + } + + if (psInfo.fileName != NULL) { + /* Check that -file and -channel are not both specified. */ + if (psInfo.channelName != NULL) { + Tcl_AppendResult(interp, "can't specify both -file", + " and -channel", (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + + /* + * Check that we are not in a safe interpreter. If we are, disallow + * the -file specification. + */ + if (Tcl_IsSafe(interp)) { + Tcl_AppendResult(interp, "can't specify -file in a", + " safe interpreter", (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + + p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); + if (p == NULL) { + result = TCL_ERROR; + goto cleanup; + } + psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666); + Tcl_DStringFree(&buffer); + Tcl_DStringInit(&buffer); + if (psInfo.chan == NULL) { + result = TCL_ERROR; + goto cleanup; + } + } + + if (psInfo.channelName != NULL) { + int mode; + /* + * Check that the channel is found in this interpreter and that it + * is open for writing. + */ + psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName, &mode); + if (psInfo.chan == (Tcl_Channel) NULL) { + result = TCL_ERROR; + goto cleanup; + } + if ((mode & TCL_WRITABLE) == 0) { + Tcl_AppendResult(interp, "channel \"", psInfo.channelName, + "\" wasn't opened for writing", (char *) NULL); + result = TCL_ERROR; + goto cleanup; + } + } + + if (psInfo.colorMode == NULL) { + psInfo.colorLevel = 2; + } else { + length = strlen(psInfo.colorMode); + if (strncmp(psInfo.colorMode, "monochrome", length) == 0) { + psInfo.colorLevel = 0; + } else if (strncmp(psInfo.colorMode, "gray", length) == 0) { + psInfo.colorLevel = 1; + } else if (strncmp(psInfo.colorMode, "color", length) == 0) { + psInfo.colorLevel = 2; + } else { + Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode, + "\": must be monochrome, gray or color", (char *) NULL); + goto cleanup; + } + } + + TableCellCoords(tablePtr, firstRow, firstCol, &x0, &y0, &w0, &h0); + TableCellCoords(tablePtr, lastRow, lastCol, &xn, &yn, &wn, &hn); + psInfo.x = x0; + psInfo.y = y0; + if (psInfo.width == -1) { + psInfo.width = xn+wn; + } + if (psInfo.height == -1) { + psInfo.height = yn+hn; + } + psInfo.x2 = psInfo.x + psInfo.width; + psInfo.y2 = psInfo.y + psInfo.height; + + if (psInfo.pageXString != NULL) { + if (GetPostscriptPoints(interp, psInfo.pageXString, + &psInfo.pageX) != TCL_OK) { + goto cleanup; + } + } + if (psInfo.pageYString != NULL) { + if (GetPostscriptPoints(interp, psInfo.pageYString, + &psInfo.pageY) != TCL_OK) { + goto cleanup; + } + } + if (psInfo.pageWidthString != NULL) { + if (GetPostscriptPoints(interp, psInfo.pageWidthString, + &psInfo.scale) != TCL_OK) { + goto cleanup; + } + psInfo.scale /= psInfo.width; + } else if (psInfo.pageHeightString != NULL) { + if (GetPostscriptPoints(interp, psInfo.pageHeightString, + &psInfo.scale) != TCL_OK) { + goto cleanup; + } + psInfo.scale /= psInfo.height; + } else { + psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tablePtr->tkwin)) + / WidthOfScreen(Tk_Screen(tablePtr->tkwin)); + } + switch (psInfo.pageAnchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_W: + case TK_ANCHOR_SW: + deltaX = 0; + break; + case TK_ANCHOR_N: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_S: + deltaX = -psInfo.width/2; + break; + case TK_ANCHOR_NE: + case TK_ANCHOR_E: + case TK_ANCHOR_SE: + deltaX = -psInfo.width; + break; + } + switch (psInfo.pageAnchor) { + case TK_ANCHOR_NW: + case TK_ANCHOR_N: + case TK_ANCHOR_NE: + deltaY = - psInfo.height; + break; + case TK_ANCHOR_W: + case TK_ANCHOR_CENTER: + case TK_ANCHOR_E: + deltaY = -psInfo.height/2; + break; + case TK_ANCHOR_SW: + case TK_ANCHOR_S: + case TK_ANCHOR_SE: + deltaY = 0; + break; + } + + /* + *-------------------------------------------------------- + * Make a PREPASS over all of the tags + * to collect information about all the fonts in use, so that + * we can output font information in the proper form required + * by the Document Structuring Conventions. + *-------------------------------------------------------- + */ + + Tk_TablePsFont(interp, tablePtr, tablePtr->defaultTag.tkfont); + Tcl_ResetResult(interp); + for (hPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + tagPtr = (TableTag *) Tcl_GetHashValue(hPtr); + if (tagPtr->tkfont != NULL) { + Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont); + } + } + Tcl_ResetResult(interp); + + /* + *-------------------------------------------------------- + * Generate the header and prolog for the Postscript. + *-------------------------------------------------------- + */ + + sprintf(string, " %d,%d => %d,%d\n", firstRow, firstCol, lastRow, lastCol); + Tcl_DStringAppendAll(&postscript, + "%!PS-Adobe-3.0 EPSF-3.0\n", + "%%Creator: Tk Table Widget ", TBL_VERSION, "\n", + "%%Title: Window ", + Tk_PathName(tablePtr->tkwin), string, + "%%BoundingBox: ", + (char *) NULL); + if (!psInfo.rotate) { + sprintf(string, "%d %d %d %d\n", + (int) (psInfo.pageX + psInfo.scale*deltaX), + (int) (psInfo.pageY + psInfo.scale*deltaY), + (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width) + + 1.0), + (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height) + + 1.0)); + } else { + sprintf(string, "%d %d %d %d\n", + (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)), + (int) (psInfo.pageY + psInfo.scale*deltaX), + (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0), + (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + + 1.0)); + } + Tcl_DStringAppendAll(&postscript, string, + "%%Pages: 1\n%%DocumentData: Clean7Bit\n", + "%%Orientation: ", + psInfo.rotate?"Landscape\n":"Portrait\n", + (char *) NULL); + p = "%%DocumentNeededResources: font "; + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + sprintf(string, "%s%s\n", p, Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + Tcl_DStringAppend(&postscript, string, -1); + p = "%%+ font "; + } + Tcl_DStringAppend(&postscript, "%%EndComments\n\n", -1); + + /* + * Insert the prolog + */ + for (chunk=prolog; *chunk; chunk++) { + Tcl_DStringAppend(&postscript, *chunk, -1); + } + + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1); + Tcl_DStringFree(&postscript); + Tcl_DStringInit(&postscript); + } + + /* + * Document setup: set the color level and include fonts. + * This is where we start using &postscript + */ + + sprintf(string, "/CL %d def\n", psInfo.colorLevel); + Tcl_DStringAppendAll(&postscript, "%%BeginSetup\n", string, (char *) NULL); + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + sprintf(string, "%s%s\n", "%%IncludeResource: font ", + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + Tcl_DStringAppend(&postscript, string, -1); + } + Tcl_DStringAppend(&postscript, "%%EndSetup\n\n", -1); + + /* + * Page setup: move to page positioning point, rotate if + * needed, set scale factor, offset for proper anchor position, + * and set clip region. + */ + + sprintf(string, "%.1f %.1f translate\n", + psInfo.pageX, psInfo.pageY); + Tcl_DStringAppendAll(&postscript, "%%Page: 1 1\nsave\n", + string, psInfo.rotate?"90 rotate\n":"", + (char *) NULL); + sprintf(string, "%.4g %.4g scale\n%d %d translate\n", + psInfo.scale, psInfo.scale, deltaX - psInfo.x, deltaY); + Tcl_DStringAppend(&postscript, string, -1); + sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", + psInfo.x, (double) psInfo.y2-psInfo.y, + psInfo.x2,(double) psInfo.y2-psInfo.y, + psInfo.x2, 0.0, psInfo.x, 0.0); + Tcl_DStringAppend(&postscript, string, -1); + Tcl_DStringAppend(&postscript, " lineto closepath clip newpath\n", -1); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1); + Tcl_DStringFree(&postscript); + Tcl_DStringInit(&postscript); + } + + /* + * Go through each cell, calculating full desired height + */ + result = TCL_OK; + + hPtr = Tcl_FindHashEntry(tablePtr->tagTable, "title"); + titlePtr = (TableTag *) Tcl_GetHashValue(hPtr); + + total = 0; + colWidths = (int *) ckalloc((lastCol-firstCol) * sizeof(int)); + for (col = 0; col <= lastCol-firstCol; col++) colWidths[col] = 0; + Tcl_DStringAppend(&buffer, "gsave\n", -1); + for (row = firstRow; row <= lastRow; row++) { + rowHeight = 0; + rowPtr = FindRowColTag(tablePtr, row+tablePtr->rowOffset, ROW); + for (col = firstCol; col <= lastCol; col++) { + /* get the coordinates for the cell */ + TableCellCoords(tablePtr, row, col, &x, &y, &w, &h); + if ((x >= psInfo.x2) || (x+w < psInfo.x) || + (y >= psInfo.y2) || (y+h < psInfo.y)) { + continue; + } + + if (row == tablePtr->activeRow && col == tablePtr->activeCol) { + value = tablePtr->activeBuf; + } else { + value = TableGetCellValue(tablePtr, row+tablePtr->rowOffset, + col+tablePtr->colOffset); + } + if (!strlen(value)) { + continue; + } + + /* Create the tag here */ + tagPtr = TableNewTag(); + /* First, merge in the default tag */ + TableMergeTag(tagPtr, &(tablePtr->defaultTag)); + + colPtr = FindRowColTag(tablePtr, col+tablePtr->colOffset, COL); + if (colPtr != (TableTag *) NULL) TableMergeTag(tagPtr, colPtr); + if (rowPtr != (TableTag *) NULL) TableMergeTag(tagPtr, rowPtr); + /* Am I in the titles */ + if (row < tablePtr->topRow || col < tablePtr->leftCol) { + TableMergeTag(tagPtr, titlePtr); + } + /* Does this have a cell tag */ + TableMakeArrayIndex(row+tablePtr->rowOffset, + col+tablePtr->colOffset, string); + hPtr = Tcl_FindHashEntry(tablePtr->cellStyles, string); + if (hPtr != NULL) { + TableMergeTag(tagPtr, (TableTag *) Tcl_GetHashValue(hPtr)); + } + + /* + * the use of -1 instead of Tcl_NumUtfChars means we don't + * pass NULLs to postscript + */ + textLayout = Tk_ComputeTextLayout(tagPtr->tkfont, value, -1, + (tagPtr->wrap>0) ? w : 0, + tagPtr->justify, + (tagPtr->multiline>0) ? 0 : + TK_IGNORE_NEWLINES, &iW, &iH); + + rowHeight = MAX(rowHeight, iH); + colWidths[col-firstCol] = MAX(colWidths[col-firstCol], iW); + + result = TextToPostscript(interp, tablePtr, tagPtr, + x, y, iW, iH, row, col, textLayout); + Tk_FreeTextLayout(textLayout); + if (result != TCL_OK) { + char msg[64 + TCL_INTEGER_SPACE]; + + sprintf(msg, "\n (generating Postscript for cell %s)", + string); + Tcl_AddErrorInfo(interp, msg); + goto cleanup; + } + Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1); + } + sprintf(string, "/row%d %d def\n", + row, tablePtr->psInfoPtr->y2 - total); + Tcl_DStringAppend(&postscript, string, -1); + total += rowHeight + 2*tablePtr->defaultTag.bd; + } + Tcl_DStringAppend(&buffer, "grestore\n", -1); + sprintf(string, "/row%d %d def\n", row, tablePtr->psInfoPtr->y2 - total); + Tcl_DStringAppend(&postscript, string, -1); + + total = tablePtr->defaultTag.bd; + for (col = firstCol; col <= lastCol; col++) { + sprintf(string, "/col%d %d def\n", col, total); + Tcl_DStringAppend(&postscript, string, -1); + total += colWidths[col-firstCol] + 2*tablePtr->defaultTag.bd; + } + sprintf(string, "/col%d %d def\n", col, total); + Tcl_DStringAppend(&postscript, string, -1); + + Tcl_DStringAppend(&postscript, Tcl_DStringValue(&buffer), -1); + + /* + * Output to channel at the end of it all + * This should more incremental, but that can't be avoided in order + * to post-define width/height of the cols/rows + */ + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1); + Tcl_DStringFree(&postscript); + Tcl_DStringInit(&postscript); + } + + /* + *--------------------------------------------------------------------- + * Output page-end information, such as commands to print the page + * and document trailer stuff. + *--------------------------------------------------------------------- + */ + + Tcl_DStringAppend(&postscript, + "restore showpage\n\n%%Trailer\nend\n%%EOF\n", -1); + if (psInfo.chan != NULL) { + Tcl_Write(psInfo.chan, Tcl_DStringValue(&postscript), -1); + Tcl_DStringFree(&postscript); + Tcl_DStringInit(&postscript); + } + + /* + * Clean up psInfo to release malloc'ed stuff. + */ + +cleanup: + ckfree((char *) argv); + Tcl_DStringResult(interp, &postscript); + Tcl_DStringFree(&postscript); + Tcl_DStringFree(&buffer); + if (psInfo.first != NULL) { + ckfree(psInfo.first); + } + if (psInfo.last != NULL) { + ckfree(psInfo.last); + } + if (psInfo.pageXString != NULL) { + ckfree(psInfo.pageXString); + } + if (psInfo.pageYString != NULL) { + ckfree(psInfo.pageYString); + } + if (psInfo.pageWidthString != NULL) { + ckfree(psInfo.pageWidthString); + } + if (psInfo.pageHeightString != NULL) { + ckfree(psInfo.pageHeightString); + } + if (psInfo.fontVar != NULL) { + ckfree(psInfo.fontVar); + } + if (psInfo.colorVar != NULL) { + ckfree(psInfo.colorVar); + } + if (psInfo.colorMode != NULL) { + ckfree(psInfo.colorMode); + } + if (psInfo.fileName != NULL) { + ckfree(psInfo.fileName); + } + if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) { + Tcl_Close(interp, psInfo.chan); + } + if (psInfo.channelName != NULL) { + ckfree(psInfo.channelName); + } + Tcl_DeleteHashTable(&psInfo.fontTable); + tablePtr->psInfoPtr = oldInfoPtr; + return result; +#endif +} + +/* + *-------------------------------------------------------------- + * + * Tk_TablePsColor -- + * + * This procedure is called by individual table items when + * they want to set a color value for output. Given information + * about an X color, this procedure will generate Postscript + * commands to set up an appropriate color in Postscript. + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_TablePsColor(interp, tablePtr, colorPtr) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Table *tablePtr; /* Information about table. */ + XColor *colorPtr; /* Information about color. */ +{ + TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr; + int tmp; + double red, green, blue; + char string[200]; + + /* + * If there is a color map defined, then look up the color's name + * in the map and use the Postscript commands found there, if there + * are any. + */ + + if (psInfoPtr->colorVar != NULL) { + char *cmdString; + + cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + Tk_NameOfColor(colorPtr), 0); + if (cmdString != NULL) { + Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL); + return TCL_OK; + } + } + + /* + * No color map entry for this color. Grab the color's intensities + * and output Postscript commands for them. Special note: X uses + * a range of 0-65535 for intensities, but most displays only use + * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the + * X scale. This means that there's no way to get perfect white, + * since the highest intensity is only 65280 out of 65535. To + * work around this problem, rescale the X intensity to a 0-255 + * scale and use that as the basis for the Postscript colors. This + * scheme still won't work if the display only uses 4 bits per color, + * but most diplays use at least 8 bits. + */ + + tmp = colorPtr->red; + red = ((double) (tmp >> 8))/255.0; + tmp = colorPtr->green; + green = ((double) (tmp >> 8))/255.0; + tmp = colorPtr->blue; + blue = ((double) (tmp >> 8))/255.0; + sprintf(string, "%.3f %.3f %.3f AdjustColor\n", + red, green, blue); + Tcl_AppendResult(interp, string, (char *) NULL); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_TablePsFont -- + * + * This procedure is called by individual table items when + * they want to output text. Given information about an X + * font, this procedure will generate Postscript commands + * to set up an appropriate font in Postscript. + * + * Results: + * Returns a standard Tcl return value. If an error occurs + * then an error message will be left in the interp's result. + * If no error occurs, then additional Postscript will be + * appended to the interp's result. + * + * Side effects: + * The Postscript font name is entered into psInfoPtr->fontTable + * if it wasn't already there. + * + *-------------------------------------------------------------- + */ + +int +Tk_TablePsFont(interp, tablePtr, tkfont) + Tcl_Interp *interp; /* Interpreter for returning Postscript + * or error message. */ + Table *tablePtr; /* Information about table. */ + Tk_Font tkfont; /* Information about font in which text + * is to be printed. */ +{ + TkPostscriptInfo *psInfoPtr = tablePtr->psInfoPtr; + char *end; + char pointString[TCL_INTEGER_SPACE]; + Tcl_DString ds; + int i, points; + + /* + * First, look up the font's name in the font map, if there is one. + * If there is an entry for this font, it consists of a list + * containing font name and size. Use this information. + */ + + Tcl_DStringInit(&ds); + + if (psInfoPtr->fontVar != NULL) { + char *list, **argv; + int objc; + double size; + char *name; + + name = Tk_NameOfFont(tkfont); + list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0); + if (list != NULL) { + if (Tcl_SplitList(interp, list, &objc, &argv) != TCL_OK) { + badMapEntry: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "bad font map entry for \"", name, + "\": \"", list, "\"", (char *) NULL); + return TCL_ERROR; + } + if (objc != 2) { + goto badMapEntry; + } + size = strtod(argv[1], &end); + if ((size <= 0) || (*end != 0)) { + goto badMapEntry; + } + + Tcl_DStringAppend(&ds, argv[0], -1); + points = (int) size; + + ckfree((char *) argv); + goto findfont; + } + } + + points = Tk_PostscriptFontName(tkfont, &ds); + +findfont: + sprintf(pointString, "%d", points); + Tcl_AppendResult(interp, pointString, " /", Tcl_DStringValue(&ds), + " SetFont\n", (char *) NULL); + Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); + Tcl_DStringFree(&ds); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * GetPostscriptPoints -- + * + * Given a string, returns the number of Postscript points + * corresponding to that string. + * + * Results: + * The return value is a standard Tcl return result. If + * TCL_OK is returned, then everything went well and the + * screen distance is stored at *doublePtr; otherwise + * TCL_ERROR is returned and an error message is left in + * the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +GetPostscriptPoints(interp, string, doublePtr) + Tcl_Interp *interp; /* Use this for error reporting. */ + char *string; /* String describing a screen distance. */ + double *doublePtr; /* Place to store converted result. */ +{ + char *end; + double d; + + d = strtod(string, &end); + if (end == string) { + error: + Tcl_AppendResult(interp, "bad distance \"", string, + "\"", (char *) NULL); + return TCL_ERROR; + } +#define UCHAR(c) ((unsigned char) (c)) + while ((*end != '\0') && isspace(UCHAR(*end))) { + end++; + } + switch (*end) { + case 'c': + d *= 72.0/2.54; + end++; + break; + case 'i': + d *= 72.0; + end++; + break; + case 'm': + d *= 72.0/25.4; + end++; + break; + case 0: + break; + case 'p': + end++; + break; + default: + goto error; + } + while ((*end != '\0') && isspace(UCHAR(*end))) { + end++; + } + if (*end != 0) { + goto error; + } + *doublePtr = d; + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * TextToPostscript -- + * + * This procedure is called to generate Postscript for + * text items. + * + * Results: + * The return value is a standard Tcl result. If an error + * occurs in generating Postscript then an error message is + * left in the interp's result, replacing whatever used + * to be there. If no error occurs, then Postscript for the + * item is appended to the result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static int +TextToPostscript(interp, tablePtr, tagPtr, tagX, tagY, width, height, + row, col, textLayout) + Tcl_Interp *interp; /* Leave Postscript or error message here. */ + Table *tablePtr; /* Information about overall canvas. */ + TableTag *tagPtr; /* */ + int tagX, tagY; /* */ + int width, height; /* */ + int row, col; /* */ + Tk_TextLayout textLayout; /* */ +{ + int x, y; + Tk_FontMetrics fm; + char *justify; + char buffer[500]; + Tk_3DBorder fg = tagPtr->fg; + + if (fg == NULL) { + fg = tablePtr->defaultTag.fg; + } + + if (Tk_TablePsFont(interp, tablePtr, tagPtr->tkfont) != TCL_OK) { + return TCL_ERROR; + } + if (Tk_TablePsColor(interp, tablePtr, Tk_3DBorderColor(fg)) != TCL_OK) { + return TCL_ERROR; + } + + sprintf(buffer, "%% %.15g %.15g [\n", (tagX+width)/2.0, + tablePtr->psInfoPtr->y2 - ((tagY+height)/2.0)); + Tcl_AppendResult(interp, buffer, (char *) NULL); + sprintf(buffer, "col%d row%d [\n", col, row); + Tcl_AppendResult(interp, buffer, (char *) NULL); + + Tk_TextLayoutToPostscript(interp, textLayout); + + x = 0; y = 0; justify = NULL; /* lint. */ + switch (tagPtr->anchor) { + case TK_ANCHOR_NW: x = 0; y = 0; break; + case TK_ANCHOR_N: x = 1; y = 0; break; + case TK_ANCHOR_NE: x = 2; y = 0; break; + case TK_ANCHOR_E: x = 2; y = 1; break; + case TK_ANCHOR_SE: x = 2; y = 2; break; + case TK_ANCHOR_S: x = 1; y = 2; break; + case TK_ANCHOR_SW: x = 0; y = 2; break; + case TK_ANCHOR_W: x = 0; y = 1; break; + case TK_ANCHOR_CENTER: x = 1; y = 1; break; + } + switch (tagPtr->justify) { + case TK_JUSTIFY_RIGHT: justify = "1"; break; + case TK_JUSTIFY_CENTER: justify = "0.5";break; + case TK_JUSTIFY_LEFT: justify = "0"; + } + + Tk_GetFontMetrics(tagPtr->tkfont, &fm); + sprintf(buffer, "] %d %g %g %s %d %d DrawCellText\n", + fm.linespace, (x / -2.0), (y / 2.0), justify, + width, height); + Tcl_AppendResult(interp, buffer, (char *) NULL); + + return TCL_OK; +} |