/* * 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. * * RCS: @(#) $Id: tkCanvPs.c,v 1.19.2.4 2009/04/10 11:07:32 dkf Exp $ */ #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 { Tk_Window tkwin; /* The canvas being printed. */ 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 * prolog definitions in the header. */ } TkPostscriptInfo; /* * The table below provides a template that's used to process arguments to the * canvas "postscript" command and fill in TkPostscriptInfo structures. */ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-colormap", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, colorVar), 0}, {TK_CONFIG_STRING, "-colormode", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, colorMode), 0}, {TK_CONFIG_STRING, "-file", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, fileName), 0}, {TK_CONFIG_STRING, "-channel", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, channelName), 0}, {TK_CONFIG_STRING, "-fontmap", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, fontVar), 0}, {TK_CONFIG_PIXELS, "-height", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, height), 0}, {TK_CONFIG_ANCHOR, "-pageanchor", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, {TK_CONFIG_STRING, "-pageheight", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, {TK_CONFIG_STRING, "-pagewidth", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, {TK_CONFIG_STRING, "-pagex", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, {TK_CONFIG_STRING, "-pagey", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, {TK_CONFIG_BOOLEAN, "-prolog", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, prolog), 0}, {TK_CONFIG_BOOLEAN, "-rotate", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, rotate), 0}, {TK_CONFIG_PIXELS, "-width", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, width), 0}, {TK_CONFIG_PIXELS, "-x", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, x), 0}, {TK_CONFIG_PIXELS, "-y", NULL, NULL, "", Tk_Offset(TkPostscriptInfo, y), 0}, {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0} }; /* * Forward declarations for functions defined later in this file: */ static int GetPostscriptPoints(Tcl_Interp *interp, char *string, double *doublePtr); /* *-------------------------------------------------------------- * * 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 char string[STRING_LENGTH+1]; CONST char *p; time_t now; size_t length; Tk_Window tkwin = canvasPtr->tkwin; Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; char psenccmd[] = "::tk::ensure_psenc_is_loaded"; 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. */ /* * Initialize the data structure describing Postscript generation, then * process all the arguments to fill the data structure in. */ result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL); if (result != TCL_OK) { return result; } oldInfoPtr = canvasPtr->psInfo; canvasPtr->psInfo = (Tk_PostscriptInfo) psInfoPtr; psInfo.tkwin = canvasPtr->tkwin; 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; 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_AppendResult(interp, "bad color mode \"", psInfo.colorMode, "\": must be monochrome, gray, or color", NULL); 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", 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", 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 == (Tcl_Channel) NULL) { result = TCL_ERROR; goto cleanup; } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendResult(interp, "channel \"", psInfo.channelName, "\" wasn't opened for writing", 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_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", "%%Creator: Tk Canvas Widget\n", NULL); #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ Tcl_AppendResult(interp, "%%For: ", (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", NULL); endpwent(); } #endif /* HAVE_PW_GECOS */ Tcl_AppendResult(interp, "%%Title: Window ", Tk_PathName(tkwin), "\n", NULL); time(&now); Tcl_AppendResult(interp, "%%CreationDate: ", ctime(&now), NULL); /* INTL: Native. */ if (!psInfo.rotate) { sprintf(string, "%d %d %d %d", (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", (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_AppendResult(interp, "%%BoundingBox: ", string, "\n", NULL); Tcl_AppendResult(interp, "%%Pages: 1\n", "%%DocumentData: Clean7Bit\n", NULL); Tcl_AppendResult(interp, "%%Orientation: ", psInfo.rotate ? "Landscape\n" : "Portrait\n", NULL); p = "%%DocumentNeededResources: font "; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_AppendResult(interp, p, Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); p = "%%+ font "; } Tcl_AppendResult(interp, "%%EndComments\n\n", NULL); /* * Insert the prolog */ Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable", TCL_GLOBAL_ONLY), NULL); if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } /* * Document setup: set the color level and include fonts. */ sprintf(string, "/CL %d def\n", psInfo.colorLevel); Tcl_AppendResult(interp, "%%BeginSetup\n", string, NULL); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_AppendResult(interp, "%%IncludeResource: font ", Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", NULL); } Tcl_AppendResult(interp, "%%EndSetup\n\n", NULL); /* * Page setup: move to page positioning point, rotate if needed, set * scale factor, offset for proper anchor position, and set clip * region. */ Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", NULL); sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); Tcl_AppendResult(interp, string, NULL); if (psInfo.rotate) { Tcl_AppendResult(interp, "90 rotate\n", NULL); } sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); Tcl_AppendResult(interp, string, NULL); sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); Tcl_AppendResult(interp, string, NULL); sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", 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)); Tcl_AppendResult(interp, string, " lineto closepath clip newpath\n", NULL); } if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } /* * 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_AppendResult(interp, "gsave\n", NULL); result = (*itemPtr->typePtr->postscriptProc)(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { char msg[64 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (generating Postscript for item %d)", itemPtr->id); Tcl_AddErrorInfo(interp, msg); goto cleanup; } Tcl_AppendResult(interp, "grestore\n", NULL); if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(interp); } } /* * Output page-end information, such as commands to print the page and * document trailer stuff. */ if (psInfo.prolog) { Tcl_AppendResult(interp, "restore showpage\n\n", "%%Trailer\nend\n%%EOF\n", NULL); } if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } /* * 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; return result; } /* *-------------------------------------------------------------- * * 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; int tmp; double red, green, blue; char string[200]; 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; cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); if (cmdString != NULL) { Tcl_AppendResult(interp, cmdString, "\n", 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 setrgbcolor AdjustColor\n", red, green, blue); Tcl_AppendResult(interp, string, NULL); 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; 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. */ 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) { CONST char *fontname; if (Tcl_ListObjGetElements(interp, list, &objc, &objv) != TCL_OK || objc != 2 || Tcl_GetString(objv[0])[0]=='\0' || Tcl_GetDoubleFromObj(interp, objv[1], &size) != TCL_OK || size <= 0) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad font map entry for \"", name, "\": \"", Tcl_GetString(list), "\"", NULL); return TCL_ERROR; } fontname = Tcl_GetString(objv[0]); sprintf(pointString, "%d", (int)size); Tcl_AppendResult(interp, "/", fontname, " findfont ", pointString, " scalefont ", NULL); if (strncasecmp(fontname, "Symbol", 7) != 0) { Tcl_AppendResult(interp, "ISOEncode ", NULL); } Tcl_AppendResult(interp, "setfont\n", NULL); 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); sprintf(pointString, "%d", TkFontGetPoints(psInfoPtr->tkwin, points)); Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", pointString, " scalefont ", NULL); if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { Tcl_AppendResult(interp, "ISOEncode ", NULL); } Tcl_AppendResult(interp, "setfont\n", NULL); 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; XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; char string[100]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; 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 int *) &totalWidth, (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); Tcl_AppendResult(interp, "<", NULL); 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) { sprintf(string, "%02x", value); Tcl_AppendResult(interp, string, NULL); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { Tcl_AppendResult(interp, "\n", NULL); charsInLine = 0; } } } if (mask != 0x80) { sprintf(string, "%02x", value); Tcl_AppendResult(interp, string, NULL); mask = 0x80; value = 0; charsInLine += 2; } } Tcl_AppendResult(interp, ">", NULL); XDestroyImage(imagePtr); return TCL_OK; } /* *-------------------------------------------------------------- * * 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; char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; 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); sprintf(string, "%d %d ", width, height); Tcl_AppendResult(interp, string, NULL); if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, width, height) != TCL_OK) { return TCL_ERROR; } Tcl_AppendResult(interp, " StippleFill\n", NULL); 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; char buffer[200]; if (psInfoPtr->prepass) { return; } sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); Tcl_AppendResult(interp, buffer, NULL); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], Tk_PostscriptY(coordPtr[1], psInfo)); Tcl_AppendResult(interp, buffer, NULL); } } /* *-------------------------------------------------------------- * * 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_AppendResult(interp, "bad distance \"", string, "\"", 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 /* * 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; char buffer[256]; 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; 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 = (XColor *) 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; case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); sprintf(buffer, "Can't generate Postscript for images more than %d pixels wide", maxWidth); Tcl_AppendResult(interp, buffer, NULL); ckfree((char *) cdata.colors); return TCL_ERROR; } maxRows = 60000 / bytesPerLine; for (band = height-1; band >= 0; band -= maxRows) { int rows = (band >= maxRows) ? maxRows : band + 1; int lineLen = 0; switch (level) { case 0: sprintf(buffer, "%d %d 1 matrix {\n<", width, rows); Tcl_AppendResult(interp, buffer, NULL); break; case 1: sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); Tcl_AppendResult(interp, buffer, NULL); break; case 2: sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); Tcl_AppendResult(interp, buffer, NULL); 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) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } mask=0x80; data=0x00; } } if ((width % 8) != 0) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); 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); sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 * (0.30 * red + 0.59 * green + 0.11 * blue))); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen > 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } break; case 2: /* * 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); sprintf(buffer, "%02X%02X%02X", (int) floor(0.5 + 255.0 * red), (int) floor(0.5 + 255.0 * green), (int) floor(0.5 + 255.0 * blue)); Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen > 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } break; } } switch (level) { case 0: case 1: sprintf(buffer, ">\n} image\n"); break; case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break; } Tcl_AppendResult(interp, buffer, NULL); sprintf(buffer, "0 %d translate\n", rows); Tcl_AppendResult(interp, buffer, NULL); } ckfree((char *) 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; static int codeIncluded = 0; unsigned char *pixelPtr; char buffer[256], cspace[40], decode[40]; int bpc; int xx, yy, lineLen; float red, green, blue; int alpha; int bytesPerLine=0, maxWidth=0; unsigned char opaque = 255; unsigned char *alphaPtr; int alphaOffset, alphaPitch, alphaIncr; if (psInfoPtr->prepass) { codeIncluded = 0; return TCL_OK; } /* * Define the "TkPhoto" function, which is a modified version of the * original "transparentimage" function posted by ian@five-d.com (Ian * Kemmish) to comp.lang.postscript. For a monochrome colorLevel this is a * slightly different version that uses the imagemask command instead of * image. */ if (!codeIncluded && (colorLevel != 0)) { /* * Color and gray-scale code. */ codeIncluded = !0; Tcl_AppendResult(interp, "/TkPhoto { \n", " gsave \n", " 32 dict begin \n", " /tinteger exch def \n", " /transparent 1 string def \n", " transparent 0 tinteger put \n", " /olddict exch def \n", " olddict /DataSource get dup type /filetype ne { \n", " olddict /DataSource 3 -1 roll \n", " 0 () /SubFileDecode filter put \n", " } { \n", " pop \n", " } ifelse \n", " /newdict olddict maxlength dict def \n", " olddict newdict copy pop \n", " /w newdict /Width get def \n", " /crpp newdict /Decode get length 2 idiv def \n", " /str w string def \n", " /pix w crpp mul string def \n", " /substrlen 2 w log 2 log div floor exp cvi def \n", " /substrs [ \n", " { \n", " substrlen string \n", " 0 1 substrlen 1 sub { \n", " 1 index exch tinteger put \n", " } for \n", " /substrlen substrlen 2 idiv def \n", " substrlen 0 eq {exit} if \n", " } loop \n", " ] def \n", " /h newdict /Height get def \n", " 1 w div 1 h div matrix scale \n", " olddict /ImageMatrix get exch matrix concatmatrix \n", " matrix invertmatrix concat \n", " newdict /Height 1 put \n", " newdict /DataSource pix put \n", " /mat [w 0 0 h 0 0] def \n", " newdict /ImageMatrix mat put \n", " 0 1 h 1 sub { \n", " mat 5 3 -1 roll neg put \n", " olddict /DataSource get str readstring pop pop \n", " /tail str def \n", " /x 0 def \n", " olddict /DataSource get pix readstring pop pop \n", " { \n", " tail transparent search dup /done exch not def \n", " {exch pop exch pop} if \n", " /w1 exch length def \n", " w1 0 ne { \n", " newdict /DataSource ", " pix x crpp mul w1 crpp mul getinterval put \n", " newdict /Width w1 put \n", " mat 4 x neg put \n", " /x x w1 add def \n", " newdict image \n", " /tail tail w1 tail length w1 sub getinterval def \n", " } if \n", " done {exit} if \n", " tail substrs { \n", " anchorsearch {pop} if \n", " } forall \n", " /tail exch def \n", " tail length 0 eq {exit} if \n", " /x w tail length sub def \n", " } loop \n", " } for \n", " end \n", " grestore \n", "} bind def \n\n\n", NULL); } else if (!codeIncluded && (colorLevel == 0)) { /* * Monochrome-only code */ codeIncluded = !0; Tcl_AppendResult(interp, "/TkPhoto { \n", " gsave \n", " 32 dict begin \n", " /dummyInteger exch def \n", " /olddict exch def \n", " olddict /DataSource get dup type /filetype ne { \n", " olddict /DataSource 3 -1 roll \n", " 0 () /SubFileDecode filter put \n", " } { \n", " pop \n", " } ifelse \n", " /newdict olddict maxlength dict def \n", " olddict newdict copy pop \n", " /w newdict /Width get def \n", " /pix w 7 add 8 idiv string def \n", " /h newdict /Height get def \n", " 1 w div 1 h div matrix scale \n", " olddict /ImageMatrix get exch matrix concatmatrix \n", " matrix invertmatrix concat \n", " newdict /Height 1 put \n", " newdict /DataSource pix put \n", " /mat [w 0 0 h 0 0] def \n", " newdict /ImageMatrix mat put \n", " 0 1 h 1 sub { \n", " mat 5 3 -1 roll neg put \n", " 0.000 0.000 0.000 setrgbcolor \n", " olddict /DataSource get pix readstring pop pop \n", " newdict /DataSource pix put \n", " newdict imagemask \n", " 1.000 1.000 1.000 setrgbcolor \n", " olddict /DataSource get pix readstring pop pop \n", " newdict /DataSource pix put \n", " newdict imagemask \n", " } for \n", " end \n", " grestore \n", "} bind def \n\n\n", NULL); } /* * 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; case 2: bytesPerLine = 3 * width; maxWidth = 20000; break; } if (bytesPerLine > 60000) { Tcl_ResetResult(interp); sprintf(buffer, "Can't generate Postscript for images more than %d pixels wide", maxWidth); Tcl_AppendResult(interp, buffer, NULL); return TCL_ERROR; } /* * Set up the postscript code except for the image-data stream. */ switch (colorLevel) { case 0: strcpy(cspace, "/DeviceGray"); strcpy(decode, "[1 0]"); bpc = 1; break; case 1: strcpy(cspace, "/DeviceGray"); strcpy(decode, "[0 1]"); bpc = 8; break; default: strcpy(cspace, "/DeviceRGB"); strcpy(decode, "[0 1 0 1 0 1]"); bpc = 8; break; } Tcl_AppendResult(interp, cspace, " setcolorspace\n\n", NULL); sprintf(buffer, " /Width %d\n /Height %d\n /BitsPerComponent %d\n", width, height, bpc); Tcl_AppendResult(interp, "<<\n /ImageType 1\n", buffer, " /DataSource currentfile /ASCIIHexDecode filter\n", NULL); sprintf(buffer, " /ImageMatrix [1 0 0 -1 0 %d]\n", height); Tcl_AppendResult(interp, buffer, " /Decode ", decode, "\n>>\n1 TkPhoto\n", NULL); /* * 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) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); mask = 0x80; data = 0x00; } mask = 0x80; data = 0x00; for (xx=0 ; xxpixelPtr + (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) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } mask = 0x80; data = 0x00; } } if ((width % 8) != 0) { sprintf(buffer, "%02X", data); Tcl_AppendResult(interp, buffer, NULL); 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); sprintf(buffer, "%02X", alpha | 0x01); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } /* * 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]]; sprintf(buffer, "%02X", (int) floor(0.5 + ( 0.3086 * red + 0.6094 * green + 0.0820 * blue))); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } 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); sprintf(buffer, "%02X", alpha | 0x01); Tcl_AppendResult(interp, buffer, NULL); lineLen += 2; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } /* * 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); sprintf(buffer, "%02X%02X%02X", pixelPtr[blockPtr->offset[0]], pixelPtr[blockPtr->offset[1]], pixelPtr[blockPtr->offset[2]]); Tcl_AppendResult(interp, buffer, NULL); lineLen += 6; if (lineLen >= 60) { lineLen = 0; Tcl_AppendResult(interp, "\n", NULL); } } break; } } Tcl_AppendResult(interp, ">\n", NULL); return TCL_OK; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */