diff options
Diffstat (limited to 'tk8.6/generic/tkCanvPs.c')
| -rw-r--r-- | tk8.6/generic/tkCanvPs.c | 1782 |
1 files changed, 1782 insertions, 0 deletions
diff --git a/tk8.6/generic/tkCanvPs.c b/tk8.6/generic/tkCanvPs.c new file mode 100644 index 0000000..4e41a2a --- /dev/null +++ b/tk8.6/generic/tkCanvPs.c @@ -0,0 +1,1782 @@ +/* + * tkCanvPs.c -- + * + * This module provides Postscript output support for canvases, including + * the "postscript" widget command plus a few utility functions used for + * generating Postscript. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tkInt.h" +#include "tkCanvas.h" +#include "tkFont.h" + +/* + * See tkCanvas.h for key data structures used to implement canvases. + */ + +/* + * The following definition is used in generating postscript for images and + * windows. + */ + +typedef struct TkColormapData { /* Hold color information for a window */ + int separated; /* Whether to use separate color bands */ + int color; /* Whether window is color or black/white */ + int ncolors; /* Number of color values stored */ + XColor *colors; /* Pixel value -> RGB mappings */ + int red_mask, green_mask, blue_mask; /* Masks and shifts for each */ + int red_shift, green_shift, blue_shift; /* color band */ +} TkColormapData; + +/* + * 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 canvas 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. */ + int prepass; /* Non-zero means that we're currently in the + * pre-pass that collects font information, so + * the Postscript generated isn't relevant. */ + int prolog; /* Non-zero means output should contain the + * standard prolog in the header. Generated in + * library/mkpsenc.tcl, stored in the variable + * ::tk::ps_preamable [sic]. */ + Tk_Window tkwin; /* Window to get font pixel/point transform + * from. */ +} TkPostscriptInfo; + +/* + * The table below provides a template that's used to process arguments to the + * canvas "postscript" command and fill in TkPostscriptInfo structures. + */ + +static const Tk_ConfigSpec configSpecs[] = { + {TK_CONFIG_STRING, "-colormap", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, colorVar), 0, NULL}, + {TK_CONFIG_STRING, "-colormode", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, colorMode), 0, NULL}, + {TK_CONFIG_STRING, "-file", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, fileName), 0, NULL}, + {TK_CONFIG_STRING, "-channel", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, channelName), 0, NULL}, + {TK_CONFIG_STRING, "-fontmap", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, fontVar), 0, NULL}, + {TK_CONFIG_PIXELS, "-height", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, height), 0, NULL}, + {TK_CONFIG_ANCHOR, "-pageanchor", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0, NULL}, + {TK_CONFIG_STRING, "-pageheight", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0, NULL}, + {TK_CONFIG_STRING, "-pagewidth", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0, NULL}, + {TK_CONFIG_STRING, "-pagex", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, pageXString), 0, NULL}, + {TK_CONFIG_STRING, "-pagey", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, pageYString), 0, NULL}, + {TK_CONFIG_BOOLEAN, "-prolog", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, prolog), 0, NULL}, + {TK_CONFIG_BOOLEAN, "-rotate", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, rotate), 0, NULL}, + {TK_CONFIG_PIXELS, "-width", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, width), 0, NULL}, + {TK_CONFIG_PIXELS, "-x", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, x), 0, NULL}, + {TK_CONFIG_PIXELS, "-y", NULL, NULL, + "", Tk_Offset(TkPostscriptInfo, y), 0, NULL}, + {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} +}; + +/* + * Forward declarations for functions defined later in this file: + */ + +static int GetPostscriptPoints(Tcl_Interp *interp, + char *string, double *doublePtr); +static void PostscriptBitmap(Tk_Window tkwin, Pixmap bitmap, + int startX, int startY, int width, int height, + Tcl_Obj *psObj); +static inline Tcl_Obj * GetPostscriptBuffer(Tcl_Interp *interp); + +/* + *-------------------------------------------------------------- + * + * TkCanvPostscriptCmd -- + * + * This function is invoked to process the "postscript" options of the + * widget command for canvas widgets. See the user documentation for + * details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *-------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +TkCanvPostscriptCmd( + TkCanvas *canvasPtr, /* Information about canvas widget. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. Caller has already parsed + * this command enough to know that argv[1] is + * "postscript". */ +{ + TkPostscriptInfo psInfo, *psInfoPtr = &psInfo; + Tk_PostscriptInfo oldInfoPtr; + int result; + Tk_Item *itemPtr; +#define STRING_LENGTH 400 + const char *p; + time_t now; + size_t length; + Tk_Window tkwin = canvasPtr->tkwin; + Tcl_HashSearch search; + Tcl_HashEntry *hPtr; + Tcl_DString buffer; + Tcl_Obj *preambleObj; + Tcl_Obj *psObj; + int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of area to be + * marked up, measured in canvas units from + * the positioning point on the page (reflects + * anchor position). Initial values needed + * only to stop compiler warnings. */ + + /* + * Get the generic preamble. We only ever bother with the ASCII encoding; + * the others just make life too complicated and never actually worked as + * such. + */ + + result = Tcl_EvalEx(interp, "::tk::ensure_psenc_is_loaded", -1, 0); + if (result != TCL_OK) { + return result; + } + preambleObj = Tcl_GetVar2Ex(interp, "::tk::ps_preamble", NULL, + TCL_LEAVE_ERR_MSG); + if (preambleObj == NULL) { + return TCL_ERROR; + } + Tcl_IncrRefCount(preambleObj); + Tcl_ResetResult(interp); + psObj = Tcl_NewObj(); + + /* + * Initialize the data structure describing Postscript generation, then + * process all the arguments to fill the data structure in. + */ + + oldInfoPtr = canvasPtr->psInfo; + canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr; + psInfo.x = canvasPtr->xOrigin; + psInfo.y = canvasPtr->yOrigin; + 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.prepass = 0; + psInfo.prolog = 1; + psInfo.tkwin = tkwin; + Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); + result = Tk_ConfigureWidget(interp, tkwin, configSpecs, argc-2, argv+2, + (char *) &psInfo, TK_CONFIG_ARGV_ONLY); + if (result != TCL_OK) { + goto cleanup; + } + + if (psInfo.width == -1) { + psInfo.width = Tk_Width(tkwin); + } + if (psInfo.height == -1) { + psInfo.height = Tk_Height(tkwin); + } + 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(tkwin)); + psInfo.scale /= WidthOfScreen(Tk_Screen(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; + } + + 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_SetObjResult(interp, Tcl_ObjPrintf( + "bad color mode \"%s\": must be monochrome, gray, or color", + psInfo.colorMode)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "COLORMODE", NULL); + result = TCL_ERROR; + goto cleanup; + } + } + + if (psInfo.fileName != NULL) { + /* + * Check that -file and -channel are not both specified. + */ + + if (psInfo.channelName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't specify both -file and -channel", -1)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "USAGE", 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_SetObjResult(interp, Tcl_NewStringObj( + "can't specify -file in a safe interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "PS_FILE", NULL); + result = TCL_ERROR; + goto cleanup; + } + + p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); + if (p == NULL) { + goto cleanup; + } + psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666); + Tcl_DStringFree(&buffer); + if (psInfo.chan == NULL) { + 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 == NULL) { + result = TCL_ERROR; + goto cleanup; + } + if (!(mode & TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't opened for writing", + psInfo.channelName)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "UNWRITABLE",NULL); + result = TCL_ERROR; + goto cleanup; + } + } + + /* + * Make a pre-pass over all of the items, generating Postscript and then + * throwing it away. The purpose of this pass is just 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. + */ + + psInfo.prepass = 1; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) + || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { + continue; + } + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + result = itemPtr->typePtr->postscriptProc(interp, + (Tk_Canvas) canvasPtr, itemPtr, 1); + Tcl_ResetResult(interp); + if (result != TCL_OK) { + /* + * An error just occurred. Just skip out of this loop. There's no + * need to report the error now; it can be reported later (errors + * can happen later that don't happen now, so we still have to + * check for errors later anyway). + */ + + break; + } + } + psInfo.prepass = 0; + + /* + * Generate the header and prolog for the Postscript. + */ + + if (psInfo.prolog) { + Tcl_AppendToObj(psObj, + "%!PS-Adobe-3.0 EPSF-3.0\n" + "%%Creator: Tk Canvas Widget\n", -1); + +#ifdef HAVE_PW_GECOS + if (!Tcl_IsSafe(interp)) { + struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ + + Tcl_AppendPrintfToObj(psObj, + "%%%%For: %s\n", (pwPtr ? pwPtr->pw_gecos : "Unknown")); + endpwent(); + } +#endif /* HAVE_PW_GECOS */ + Tcl_AppendPrintfToObj(psObj, + "%%%%Title: Window %s\n", Tk_PathName(tkwin)); + time(&now); + Tcl_AppendPrintfToObj(psObj, + "%%%%CreationDate: %s", ctime(&now)); /* INTL: Native. */ + if (!psInfo.rotate) { + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %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 { + Tcl_AppendPrintfToObj(psObj, + "%%%%BoundingBox: %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_AppendPrintfToObj(psObj, + "%%%%Pages: 1\n" + "%%%%DocumentData: Clean7Bit\n" + "%%%%Orientation: %s\n", + psInfo.rotate ? "Landscape" : "Portrait"); + p = "%%%%DocumentNeededResources: font %s\n"; + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendPrintfToObj(psObj, p, + Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + p = "%%%%+ font %s\n"; + } + Tcl_AppendToObj(psObj, "%%EndComments\n\n", -1); + + /* + * Insert the prolog + */ + + Tcl_AppendObjToObj(psObj, preambleObj); + + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + channelWriteFailed: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "problem writing postscript data to channel: %s", + Tcl_PosixError(interp))); + result = TCL_ERROR; + goto cleanup; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } + + /* + * Document setup: set the color level and include fonts. + */ + + Tcl_AppendPrintfToObj(psObj, + "%%%%BeginSetup\n/CL %d def\n", psInfo.colorLevel); + for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); + hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + Tcl_AppendPrintfToObj(psObj, + "%%%%IncludeResource: font %s\n", + (char *) Tcl_GetHashKey(&psInfo.fontTable, hPtr)); + } + Tcl_AppendToObj(psObj, "%%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. + */ + + Tcl_AppendToObj(psObj, "%%Page: 1 1\nsave\n", -1); + Tcl_AppendPrintfToObj(psObj, + "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); + if (psInfo.rotate) { + Tcl_AppendToObj(psObj, "90 rotate\n", -1); + } + Tcl_AppendPrintfToObj(psObj, + "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); + Tcl_AppendPrintfToObj(psObj, + "%d %d translate\n", deltaX - psInfo.x, deltaY); + Tcl_AppendPrintfToObj(psObj, + "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g " + "lineto closepath clip newpath\n", + psInfo.x, Tk_PostscriptY((double)psInfo.y, + (Tk_PostscriptInfo)psInfoPtr), + psInfo.x2, Tk_PostscriptY((double)psInfo.y, + (Tk_PostscriptInfo)psInfoPtr), + psInfo.x2, Tk_PostscriptY((double)psInfo.y2, + (Tk_PostscriptInfo)psInfoPtr), + psInfo.x, Tk_PostscriptY((double)psInfo.y2, + (Tk_PostscriptInfo)psInfoPtr)); + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } + } + + /* + * Iterate through all the items, having each relevant one draw itself. + * Quit if any of the items returns an error. + */ + + result = TCL_OK; + for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL; + itemPtr = itemPtr->nextPtr) { + if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x) + || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) { + continue; + } + if (itemPtr->typePtr->postscriptProc == NULL) { + continue; + } + if (itemPtr->state == TK_STATE_HIDDEN) { + continue; + } + + Tcl_ResetResult(interp); + result = itemPtr->typePtr->postscriptProc(interp, + (Tk_Canvas) canvasPtr, itemPtr, 0); + if (result != TCL_OK) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (generating Postscript for item %d)", + itemPtr->id)); + goto cleanup; + } + + Tcl_AppendToObj(psObj, "gsave\n", -1); + Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp)); + Tcl_AppendToObj(psObj, "grestore\n", -1); + + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + Tcl_DecrRefCount(psObj); + psObj = Tcl_NewObj(); + } + } + + /* + * Output page-end information, such as commands to print the page and + * document trailer stuff. + */ + + if (psInfo.prolog) { + Tcl_AppendToObj(psObj, + "restore showpage\n\n" + "%%Trailer\n" + "end\n" + "%%EOF\n", -1); + + if (psInfo.chan != NULL) { + if (Tcl_WriteObj(psInfo.chan, psObj) == -1) { + goto channelWriteFailed; + } + } + } + + if (psInfo.chan == NULL) { + Tcl_SetObjResult(interp, psObj); + psObj = Tcl_NewObj(); + } + + /* + * Clean up psInfo to release malloc'ed stuff. + */ + + cleanup: + 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); + canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; + Tcl_DecrRefCount(preambleObj); + Tcl_DecrRefCount(psObj); + return result; +} + +static inline Tcl_Obj * +GetPostscriptBuffer( + Tcl_Interp *interp) +{ + Tcl_Obj *psObj = Tcl_GetObjResult(interp); + + if (Tcl_IsShared(psObj)) { + psObj = Tcl_DuplicateObj(psObj); + Tcl_SetObjResult(interp, psObj); + } + return psObj; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptColor -- + * + * This function is called by individual canvas items when they want to + * set a color value for output. Given information about an X color, this + * function 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_PostscriptColor( + Tcl_Interp *interp, + Tk_PostscriptInfo psInfo, /* Postscript info. */ + XColor *colorPtr) /* Information about color. */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + double red, green, blue; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + /* + * 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) { + const char *cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, + Tk_NameOfColor(colorPtr), 0); + + if (cmdString != NULL) { + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%s\n", cmdString); + 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. + */ + + red = ((double) (((int) colorPtr->red) >> 8))/255.0; + green = ((double) (((int) colorPtr->green) >> 8))/255.0; + blue = ((double) (((int) colorPtr->blue) >> 8))/255.0; + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "%.3f %.3f %.3f setrgbcolor AdjustColor\n", + red, green, blue); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptFont -- + * + * This function is called by individual canvas items when they want to + * output text. Given information about an X font, this function 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_PostscriptFont( + Tcl_Interp *interp, + Tk_PostscriptInfo psInfo, /* Postscript Info. */ + Tk_Font tkfont) /* Information about font in which text is to + * be printed. */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + Tcl_DString ds; + int i, points; + const char *fontname; + + /* + * 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. + */ + + if (psInfoPtr->fontVar != NULL) { + const char *name = Tk_NameOfFont(tkfont); + Tcl_Obj **objv; + int objc; + double size; + Tcl_Obj *list = Tcl_GetVar2Ex(interp, psInfoPtr->fontVar, name, 0); + + if (list != NULL) { + if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK + || objc != 2 + || (fontname = Tcl_GetString(objv[0]))[0] == '\0' + || strchr(fontname, ' ') != NULL + || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK + || size <= 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad font map entry for \"%s\": \"%s\"", + name, Tcl_GetString(list))); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "FONTMAP", + NULL); + return TCL_ERROR; + } + + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int) size, + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); + Tcl_CreateHashEntry(&psInfoPtr->fontTable, fontname, &i); + return TCL_OK; + } + } + + /* + * Nothing in the font map, so fall back to the old guessing technique. + */ + + Tcl_DStringInit(&ds); + points = Tk_PostscriptFontName(tkfont, &ds); + fontname = Tcl_DStringValue(&ds); + Tcl_AppendPrintfToObj(GetPostscriptBuffer(interp), + "/%s findfont %d scalefont%s setfont\n", + fontname, (int)(TkFontGetPoints(psInfoPtr->tkwin, points) + 0.5), + strncasecmp(fontname, "Symbol", 7) ? " ISOEncode" : ""); + Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); + Tcl_DStringFree(&ds); + + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptBitmap -- + * + * This function is called to output the contents of a sub-region of a + * bitmap in proper image data format for Postscript (i.e. data between + * angle brackets, one bit per pixel). + * + * 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_PostscriptBitmap( + Tcl_Interp *interp, + Tk_Window tkwin, + Tk_PostscriptInfo psInfo, /* Postscript info. */ + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height) /* Height of rectangular region. */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + PostscriptBitmap(tkwin, bitmap, startX, startY, width, height, + GetPostscriptBuffer(interp)); + return TCL_OK; +} + +static void +PostscriptBitmap( + Tk_Window tkwin, + Pixmap bitmap, /* Bitmap for which to generate Postscript. */ + int startX, int startY, /* Coordinates of upper-left corner of + * rectangular region to output. */ + int width, int height, /* Height of rectangular region. */ + Tcl_Obj *psObj) /* Where to append the postscript. */ +{ + XImage *imagePtr; + int charsInLine, x, y, lastX, lastY, value, mask; + unsigned int totalWidth, totalHeight; + Window dummyRoot; + int dummyX, dummyY; + unsigned dummyBorderwidth, dummyDepth; + + /* + * The following call should probably be a call to Tk_SizeOfBitmap + * instead, but it seems that we are occasionally invoked by custom item + * types that create their own bitmaps without registering them with Tk. + * XGetGeometry is a bit slower than Tk_SizeOfBitmap, but it shouldn't + * matter here. + */ + + XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, + (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth, + (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); + imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, + totalWidth, totalHeight, 1, XYPixmap); + + Tcl_AppendToObj(psObj, "<", -1); + mask = 0x80; + value = 0; + charsInLine = 0; + lastX = startX + width - 1; + lastY = startY + height - 1; + for (y = lastY; y >= startY; y--) { + for (x = startX; x <= lastX; x++) { + if (XGetPixel(imagePtr, x, y)) { + value |= mask; + } + mask >>= 1; + if (mask == 0) { + Tcl_AppendPrintfToObj(psObj, "%02x", value); + mask = 0x80; + value = 0; + charsInLine += 2; + if (charsInLine >= 60) { + Tcl_AppendToObj(psObj, "\n", -1); + charsInLine = 0; + } + } + } + if (mask != 0x80) { + Tcl_AppendPrintfToObj(psObj, "%02x", value); + mask = 0x80; + value = 0; + charsInLine += 2; + } + } + Tcl_AppendToObj(psObj, ">", -1); + + XDestroyImage(imagePtr); +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptStipple -- + * + * This function is called by individual canvas items when they have + * created a path that they'd like to be filled with a stipple pattern. + * Given information about an X bitmap, this function will generate + * Postscript commands to fill the current clip region using a stipple + * pattern defined by the bitmap. + * + * 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_PostscriptStipple( + Tcl_Interp *interp, + Tk_Window tkwin, + Tk_PostscriptInfo psInfo, /* Interpreter for returning Postscript or + * error message. */ + Pixmap bitmap) /* Bitmap to use for stippling. */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + int width, height; + Window dummyRoot; + int dummyX, dummyY; + unsigned dummyBorderwidth, dummyDepth; + Tcl_Obj *psObj; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + /* + * The following call should probably be a call to Tk_SizeOfBitmap + * instead, but it seems that we are occasionally invoked by custom item + * types that create their own bitmaps without registering them with Tk. + * XGetGeometry is a bit slower than Tk_SizeOfBitmap, but it shouldn't + * matter here. + */ + + XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, + (int *) &dummyX, (int *) &dummyY, (unsigned *) &width, + (unsigned *) &height, &dummyBorderwidth, &dummyDepth); + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%d %d ", width, height); + PostscriptBitmap(tkwin, bitmap, 0, 0, width, height, psObj); + Tcl_AppendToObj(psObj, " StippleFill\n", -1); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptY -- + * + * Given a y-coordinate in local coordinates, this function returns a + * y-coordinate to use for Postscript output. Required because canvases + * have their origin in the top-left, but postscript pages have their + * origin in the bottom left. + * + * Results: + * Returns the Postscript coordinate that corresponds to "y". + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +double +Tk_PostscriptY( + double y, /* Y-coordinate in canvas coords. */ + Tk_PostscriptInfo psInfo) /* Postscript info */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + + return psInfoPtr->y2 - y; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptPath -- + * + * Given an array of points for a path, generate Postscript commands to + * create the path. + * + * Results: + * Postscript commands get appended to what's in the interp's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +void +Tk_PostscriptPath( + Tcl_Interp *interp, + Tk_PostscriptInfo psInfo, /* Canvas on whose behalf Postscript is being + * generated. */ + double *coordPtr, /* Pointer to first in array of 2*numPoints + * coordinates giving points for path. */ + int numPoints) /* Number of points at *coordPtr. */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + Tcl_Obj *psObj; + + if (psInfoPtr->prepass) { + return; + } + + psObj = GetPostscriptBuffer(interp); + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g moveto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); + for (numPoints--, coordPtr += 2; numPoints > 0; + numPoints--, coordPtr += 2) { + Tcl_AppendPrintfToObj(psObj, "%.15g %.15g lineto\n", + coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); + } +} + +/* + *-------------------------------------------------------------- + * + * 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( + 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) { + goto error; + } + 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; + + error: + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad distance \"%s\"", string)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "POINTS", NULL); + return TCL_ERROR; +} + +/* + *-------------------------------------------------------------- + * + * TkImageGetColor -- + * + * This function converts a pixel value to three floating point numbers, + * representing the amount of red, green, and blue in that pixel on the + * screen. It makes use of colormap data passed as an argument, and + * should work for all Visual types. + * + * This implementation is bogus on Windows because the colormap data is + * never filled in. Instead all postscript generated data coming through + * here is expected to be RGB color data. To handle lower bit-depth + * images properly, XQueryColors must be implemented for Windows. + * + * Results: + * Returns red, green, and blue color values in the range 0 to 1. There + * are no error returns. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +#ifdef _WIN32 +#include <windows.h> + +/* + * We could just define these instead of pulling in windows.h. + #define GetRValue(rgb) ((BYTE)(rgb)) + #define GetGValue(rgb) ((BYTE)(((WORD)(rgb)) >> 8)) + #define GetBValue(rgb) ((BYTE)((rgb)>>16)) + */ + +#else /* !_WIN32 */ + +#define GetRValue(rgb) ((rgb & cdata->red_mask) >> cdata->red_shift) +#define GetGValue(rgb) ((rgb & cdata->green_mask) >> cdata->green_shift) +#define GetBValue(rgb) ((rgb & cdata->blue_mask) >> cdata->blue_shift) + +#endif /* _WIN32 */ + +#if defined(_WIN32) || defined(MAC_OSX_TK) +static void +TkImageGetColor( + TkColormapData *cdata, /* Colormap data */ + unsigned long pixel, /* Pixel value to look up */ + double *red, double *green, double *blue) + /* Color data to return */ +{ + *red = (double) GetRValue(pixel) / 255.0; + *green = (double) GetGValue(pixel) / 255.0; + *blue = (double) GetBValue(pixel) / 255.0; +} +#else /* ! (_WIN32 || MAC_OSX_TK) */ +static void +TkImageGetColor( + TkColormapData *cdata, /* Colormap data */ + unsigned long pixel, /* Pixel value to look up */ + double *red, double *green, double *blue) + /* Color data to return */ +{ + if (cdata->separated) { + int r = GetRValue(pixel); + int g = GetGValue(pixel); + int b = GetBValue(pixel); + + *red = cdata->colors[r].red / 65535.0; + *green = cdata->colors[g].green / 65535.0; + *blue = cdata->colors[b].blue / 65535.0; + } else { + *red = cdata->colors[pixel].red / 65535.0; + *green = cdata->colors[pixel].green / 65535.0; + *blue = cdata->colors[pixel].blue / 65535.0; + } +} +#endif /* _WIN32 || MAC_OSX_TK */ + +/* + *-------------------------------------------------------------- + * + * TkPostscriptImage -- + * + * This function is called to output the contents of an image in + * Postscript, using a format appropriate for the current color mode + * (i.e. one bit per pixel in monochrome, one byte per pixel in gray, and + * three bytes per pixel in color). + * + * Results: + * Returns a standard Tcl return value. If an error occurs then an error + * message will be left in interp->result. If no error occurs, then + * additional Postscript will be appended to interp->result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +TkPostscriptImage( + Tcl_Interp *interp, + Tk_Window tkwin, + Tk_PostscriptInfo psInfo, /* postscript info */ + XImage *ximage, /* Image to draw */ + int x, int y, /* First pixel to output */ + int width, int height) /* Width and height of area */ +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + int xx, yy, band, maxRows; + double red, green, blue; + int bytesPerLine = 0, maxWidth = 0; + int level = psInfoPtr->colorLevel; + Colormap cmap; + int i, ncolors; + Visual *visual; + TkColormapData cdata; + Tcl_Obj *psObj; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + cmap = Tk_Colormap(tkwin); + visual = Tk_Visual(tkwin); + + /* + * Obtain information about the colormap, ie the mapping between pixel + * values and RGB values. The code below should work for all Visual types. + */ + + ncolors = visual->map_entries; + cdata.colors = ckalloc(sizeof(XColor) * ncolors); + cdata.ncolors = ncolors; + + if (visual->class == DirectColor || visual->class == TrueColor) { + cdata.separated = 1; + cdata.red_mask = visual->red_mask; + cdata.green_mask = visual->green_mask; + cdata.blue_mask = visual->blue_mask; + cdata.red_shift = 0; + cdata.green_shift = 0; + cdata.blue_shift = 0; + + while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0) { + cdata.red_shift ++; + } + while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0) { + cdata.green_shift ++; + } + while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0) { + cdata.blue_shift ++; + } + + for (i = 0; i < ncolors; i ++) { + cdata.colors[i].pixel = + ((i << cdata.red_shift) & cdata.red_mask) | + ((i << cdata.green_shift) & cdata.green_mask) | + ((i << cdata.blue_shift) & cdata.blue_mask); + } + } else { + cdata.separated=0; + for (i = 0; i < ncolors; i ++) { + cdata.colors[i].pixel = i; + } + } + + if (visual->class == StaticGray || visual->class == GrayScale) { + cdata.color = 0; + } else { + cdata.color = 1; + } + + XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors); + + /* + * Figure out which color level to use (possibly lower than the one + * specified by the user). For example, if the user specifies color with + * monochrome screen, use gray or monochrome mode instead. + */ + + if (!cdata.color && level >= 2) { + level = 1; + } + + if (!cdata.color && cdata.ncolors == 2) { + level = 0; + } + + /* + * Check that at least one row of the image can be represented with a + * string less than 64 KB long (this is a limit in the Postscript + * interpreter). + */ + + switch (level) { + case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; + case 1: bytesPerLine = width; maxWidth = 60000; break; + default: bytesPerLine = 3 * width; maxWidth = 20000; break; + } + + if (bytesPerLine > 60000) { + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + ckfree(cdata.colors); + return TCL_ERROR; + } + + maxRows = 60000 / bytesPerLine; + psObj = GetPostscriptBuffer(interp); + + for (band = height-1; band >= 0; band -= maxRows) { + int rows = (band >= maxRows) ? maxRows : band + 1; + int lineLen = 0; + + switch (level) { + case 0: + Tcl_AppendPrintfToObj(psObj, "%d %d 1 matrix {\n<", width, rows); + break; + case 1: + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); + break; + default: + Tcl_AppendPrintfToObj(psObj, "%d %d 8 matrix {\n<", width, rows); + break; + } + for (yy = band; yy > band - rows; yy--) { + switch (level) { + case 0: { + /* + * Generate data for image in monochrome mode. No attempt at + * dithering is made--instead, just set a threshold. + */ + + unsigned char mask = 0x80; + unsigned char data = 0x00; + + for (xx = x; xx< x+width; xx++) { + TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), + &red, &green, &blue); + if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5) { + data |= mask; + } + mask >>= 1; + if (mask == 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + lineLen += 2; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + mask = 0x80; + data = 0x00; + } + } + if ((width % 8) != 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; + } + break; + } + case 1: + /* + * Generate data in gray mode; in this case, take a weighted + * sum of the red, green, and blue values. + */ + + for (xx = x; xx < x+width; xx ++) { + TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), + &red, &green, &blue); + Tcl_AppendPrintfToObj(psObj, "%02X", + (int) floor(0.5 + 255.0 * + (0.30 * red + 0.59 * green + 0.11 * blue))); + lineLen += 2; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + break; + default: + /* + * Finally, color mode. Here, just output the red, green, and + * blue values directly. + */ + + for (xx = x; xx < x+width; xx++) { + TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy), + &red, &green, &blue); + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", + (int) floor(0.5 + 255.0 * red), + (int) floor(0.5 + 255.0 * green), + (int) floor(0.5 + 255.0 * blue)); + lineLen += 6; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + break; + } + } + switch (level) { + case 0: case 1: + Tcl_AppendToObj(psObj, ">\n} image\n", -1); break; + default: + Tcl_AppendToObj(psObj, ">\n} false 3 colorimage\n", -1); break; + } + Tcl_AppendPrintfToObj(psObj, "0 %d translate\n", rows); + } + ckfree(cdata.colors); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptPhoto -- + * + * This function is called to output the contents of a photo image in + * Postscript, using a format appropriate for the requested postscript + * color mode (i.e. one byte per pixel in gray, and three bytes per pixel + * in color). + * + * Results: + * Returns a standard Tcl return value. If an error occurs then an error + * message will be left in interp->result. If no error occurs, then + * additional Postscript will be appended to the interpreter's result. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +int +Tk_PostscriptPhoto( + Tcl_Interp *interp, + Tk_PhotoImageBlock *blockPtr, + Tk_PostscriptInfo psInfo, + int width, int height) +{ + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; + int colorLevel = psInfoPtr->colorLevel; + const char *displayOperation, *decode; + unsigned char *pixelPtr; + int bpc, xx, yy, lineLen, alpha; + float red, green, blue; + int bytesPerLine = 0, maxWidth = 0; + unsigned char opaque = 255; + unsigned char *alphaPtr; + int alphaOffset, alphaPitch, alphaIncr; + Tcl_Obj *psObj; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + if (colorLevel != 0) { + /* + * Color and gray-scale code. + */ + + displayOperation = "TkPhotoColor"; + } else { + /* + * Monochrome-only code + */ + + displayOperation = "TkPhotoMono"; + } + + /* + * Check that at least one row of the image can be represented with a + * string less than 64 KB long (this is a limit in the Postscript + * interpreter). + */ + + switch (colorLevel) { + case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break; + case 1: bytesPerLine = width; maxWidth = 60000; break; + default: bytesPerLine = 3 * width; maxWidth = 20000; break; + } + if (bytesPerLine > 60000) { + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't generate Postscript for images more than %d pixels wide", + maxWidth)); + Tcl_SetErrorCode(interp, "TK", "CANVAS", "PS", "MEMLIMIT", NULL); + return TCL_ERROR; + } + + /* + * Set up the postscript code except for the image-data stream. + */ + + psObj = GetPostscriptBuffer(interp); + switch (colorLevel) { + case 0: + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "1 0"; + bpc = 1; + break; + case 1: + Tcl_AppendToObj(psObj, "/DeviceGray setcolorspace\n\n", -1); + decode = "0 1"; + bpc = 8; + break; + default: + Tcl_AppendToObj(psObj, "/DeviceRGB setcolorspace\n\n", -1); + decode = "0 1 0 1 0 1"; + bpc = 8; + break; + } + + Tcl_AppendPrintfToObj(psObj, + "<<\n /ImageType 1\n" + " /Width %d\n /Height %d\n /BitsPerComponent %d\n" + " /DataSource currentfile\n /ASCIIHexDecode filter\n" + " /ImageMatrix [1 0 0 -1 0 %d]\n /Decode [%s]\n>>\n" + "1 %s\n", + width, height, bpc, height, decode, displayOperation); + + /* + * Check the PhotoImageBlock information. We assume that: + * if pixelSize is 1,2 or 4, the image is R,G,B,A; + * if pixelSize is 3, the image is R,G,B and offset[3] is bogus. + */ + + if (blockPtr->pixelSize == 3) { + /* + * No alpha information: the whole image is opaque. + */ + + alphaPtr = &opaque; + alphaPitch = alphaIncr = alphaOffset = 0; + } else { + /* + * Set up alpha handling. + */ + + alphaPtr = blockPtr->pixelPtr; + alphaPitch = blockPtr->pitch; + alphaIncr = blockPtr->pixelSize; + alphaOffset = blockPtr->offset[3]; + } + + for (yy = 0, lineLen=0; yy < height; yy++) { + switch (colorLevel) { + case 0: { + /* + * Generate data for image in monochrome mode. No attempt at + * dithering is made--instead, just set a threshold. To handle + * transparecies we need to output two lines: one for the black + * pixels, one for the white ones. + */ + + unsigned char mask = 0x80; + unsigned char data = 0x00; + + for (xx = 0; xx< width; xx ++) { + pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + + (xx *blockPtr->pixelSize); + + red = pixelPtr[blockPtr->offset[0]]; + green = pixelPtr[blockPtr->offset[1]]; + blue = pixelPtr[blockPtr->offset[2]]; + + alpha = *(alphaPtr + (yy * alphaPitch) + + (xx * alphaIncr) + alphaOffset); + + /* + * If pixel is less than threshold, then it is black. + */ + + if ((alpha != 0) && + (0.3086*red + 0.6094*green + 0.082*blue < 128)) { + data |= mask; + } + mask >>= 1; + if (mask == 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + mask = 0x80; + data = 0x00; + } + } + if ((width % 8) != 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; + } + + mask = 0x80; + data = 0x00; + for (xx=0 ; xx<width ; xx++) { + pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + + (xx *blockPtr->pixelSize); + + red = pixelPtr[blockPtr->offset[0]]; + green = pixelPtr[blockPtr->offset[1]]; + blue = pixelPtr[blockPtr->offset[2]]; + + alpha = *(alphaPtr + (yy * alphaPitch) + + (xx * alphaIncr) + alphaOffset); + + /* + * If pixel is greater than threshold, then it is white. + */ + + if ((alpha != 0) && + (0.3086*red + 0.6094*green + 0.082*blue >= 128)) { + data |= mask; + } + mask >>= 1; + if (mask == 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + mask = 0x80; + data = 0x00; + } + } + if ((width % 8) != 0) { + Tcl_AppendPrintfToObj(psObj, "%02X", data); + mask = 0x80; + data = 0x00; + } + break; + } + case 1: { + /* + * Generate transparency data. We must prevent a transparent value + * of 0 because of a bug in some HP printers. + */ + + for (xx = 0; xx < width; xx ++) { + alpha = *(alphaPtr + (yy * alphaPitch) + + (xx * alphaIncr) + alphaOffset); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + + /* + * Generate data in gray mode; in this case, take a weighted sum + * of the red, green, and blue values. + */ + + for (xx = 0; xx < width; xx ++) { + pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + + (xx *blockPtr->pixelSize); + + red = pixelPtr[blockPtr->offset[0]]; + green = pixelPtr[blockPtr->offset[1]]; + blue = pixelPtr[blockPtr->offset[2]]; + + Tcl_AppendPrintfToObj(psObj, "%02X", (int) floor(0.5 + + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + break; + } + default: + /* + * Generate transparency data. We must prevent a transparent value + * of 0 because of a bug in some HP printers. + */ + + for (xx = 0; xx < width; xx ++) { + alpha = *(alphaPtr + (yy * alphaPitch) + + (xx * alphaIncr) + alphaOffset); + Tcl_AppendPrintfToObj(psObj, "%02X", alpha | 0x01); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + + /* + * Finally, color mode. Here, just output the red, green, and blue + * values directly. + */ + + for (xx = 0; xx < width; xx ++) { + pixelPtr = blockPtr->pixelPtr + (yy * blockPtr->pitch) + + (xx * blockPtr->pixelSize); + + Tcl_AppendPrintfToObj(psObj, "%02X%02X%02X", + pixelPtr[blockPtr->offset[0]], + pixelPtr[blockPtr->offset[1]], + pixelPtr[blockPtr->offset[2]]); + lineLen += 6; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendToObj(psObj, "\n", -1); + } + } + break; + } + } + + /* + * The end-of-data marker. + */ + + Tcl_AppendToObj(psObj, ">\n", -1); + return TCL_OK; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |