path: root/libgui/src/tkTablePs.c

/* 
 * 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;
}