diff options
Diffstat (limited to 'tk/generic/tkCanvPs.c')
| -rw-r--r-- | tk/generic/tkCanvPs.c | 1000 |
1 files changed, 880 insertions, 120 deletions
diff --git a/tk/generic/tkCanvPs.c b/tk/generic/tkCanvPs.c index eb45f87b80b..66b1cc9d7df 100644 --- a/tk/generic/tkCanvPs.c +++ b/tk/generic/tkCanvPs.c @@ -6,7 +6,7 @@ * procedures used for generating Postscript. * * Copyright (c) 1991-1994 The Regents of the University of California. - * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * 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. @@ -68,6 +68,8 @@ typedef struct TkPostscriptInfo { * the pre-pass that collects font information, * so the Postscript generated isn't * relevant. */ + int prolog; /* Non-zero means output should contain + the file prolog.ps in the header. */ } TkPostscriptInfo; /* @@ -99,6 +101,8 @@ static Tk_ConfigSpec configSpecs[] = { "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, + {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL, + "", Tk_Offset(TkPostscriptInfo, prolog), 0}, {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, rotate), 0}, {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, @@ -115,6 +119,7 @@ static Tk_ConfigSpec configSpecs[] = { * The prolog data. Generated by str2c from prolog.ps * This was split in small chunks by str2c because * some C compiler have limitations on the size of static strings. + * (str2c is a small tcl script in tcl's tool directory (source release)) */ static CONST char * CONST prolog[]= { /* Start of part 1 (2000 characters) */ @@ -460,13 +465,15 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * to know that argv[1] is * "postscript". */ { - TkPostscriptInfo psInfo, *oldInfoPtr; + TkPostscriptInfo psInfo; + Tk_PostscriptInfo oldInfoPtr; int result; Tk_Item *itemPtr; #define STRING_LENGTH 400 char string[STRING_LENGTH+1], *p; time_t now; size_t length; + Tk_Window tkwin = canvasPtr->tkwin; int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of * area to be marked up, measured * in canvas units from the positioning @@ -486,8 +493,8 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) *---------------------------------------------------------------- */ - oldInfoPtr = canvasPtr->psInfoPtr; - canvasPtr->psInfoPtr = &psInfo; + oldInfoPtr = canvasPtr->psInfo; + canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo; psInfo.x = canvasPtr->xOrigin; psInfo.y = canvasPtr->yOrigin; psInfo.width = -1; @@ -509,8 +516,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) psInfo.channelName = NULL; psInfo.chan = NULL; psInfo.prepass = 0; + psInfo.prolog = 1; Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); - result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin, + result = Tk_ConfigureWidget(interp, tkwin, configSpecs, argc-2, argv+2, (char *) &psInfo, TK_CONFIG_ARGV_ONLY); if (result != TCL_OK) { @@ -518,41 +526,41 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } if (psInfo.width == -1) { - psInfo.width = Tk_Width(canvasPtr->tkwin); + psInfo.width = Tk_Width(tkwin); } if (psInfo.height == -1) { - psInfo.height = Tk_Height(canvasPtr->tkwin); + psInfo.height = Tk_Height(tkwin); } psInfo.x2 = psInfo.x + psInfo.width; psInfo.y2 = psInfo.y + psInfo.height; if (psInfo.pageXString != NULL) { - if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString, + if (GetPostscriptPoints(interp, psInfo.pageXString, &psInfo.pageX) != TCL_OK) { goto cleanup; } } if (psInfo.pageYString != NULL) { - if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString, + if (GetPostscriptPoints(interp, psInfo.pageYString, &psInfo.pageY) != TCL_OK) { goto cleanup; } } if (psInfo.pageWidthString != NULL) { - if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString, + if (GetPostscriptPoints(interp, psInfo.pageWidthString, &psInfo.scale) != TCL_OK) { goto cleanup; } psInfo.scale /= psInfo.width; } else if (psInfo.pageHeightString != NULL) { - if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString, + 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(canvasPtr->tkwin)); - psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin)); + psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin)); + psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin)); } switch (psInfo.pageAnchor) { case TK_ANCHOR_NW: @@ -600,7 +608,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } else if (strncmp(psInfo.colorMode, "color", length) == 0) { psInfo.colorLevel = 2; } else { - Tcl_AppendResult(canvasPtr->interp, "bad color mode \"", + Tcl_AppendResult(interp, "bad color mode \"", psInfo.colorMode, "\": must be monochrome, ", "gray, or color", (char *) NULL); goto cleanup; @@ -614,7 +622,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) */ if (psInfo.channelName != NULL) { - Tcl_AppendResult(canvasPtr->interp, "can't specify both -file", + Tcl_AppendResult(interp, "can't specify both -file", " and -channel", (char *) NULL); result = TCL_ERROR; goto cleanup; @@ -625,18 +633,18 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * the -file specification. */ - if (Tcl_IsSafe(canvasPtr->interp)) { - Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a", + if (Tcl_IsSafe(interp)) { + Tcl_AppendResult(interp, "can't specify -file in a", " safe interpreter", (char *) NULL); result = TCL_ERROR; goto cleanup; } - p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer); + p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer); if (p == NULL) { goto cleanup; } - psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666); + psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666); Tcl_DStringFree(&buffer); if (psInfo.chan == NULL) { goto cleanup; @@ -651,14 +659,14 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * is open for writing. */ - psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName, + 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(canvasPtr->interp, "channel \"", + Tcl_AppendResult(interp, "channel \"", psInfo.channelName, "\" wasn't opened for writing", (char *) NULL); result = TCL_ERROR; @@ -686,9 +694,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) if (itemPtr->typePtr->postscriptProc == NULL) { continue; } - result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + result = (*itemPtr->typePtr->postscriptProc)(interp, (Tk_Canvas) canvasPtr, itemPtr, 1); - Tcl_ResetResult(canvasPtr->interp); + Tcl_ResetResult(interp); if (result != TCL_OK) { /* * An error just occurred. Just skip out of this loop. @@ -708,22 +716,23 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) *-------------------------------------------------------- */ - Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n", + if (psInfo.prolog) { + Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", "%%Creator: Tk Canvas Widget\n", (char *) NULL); -#if !(defined(__WIN32__) || defined(MAC_TCL)) +#ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { - struct passwd *pwPtr = getpwuid(getuid()); - Tcl_AppendResult(canvasPtr->interp, "%%For: ", + struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ + Tcl_AppendResult(interp, "%%For: ", (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", (char *) NULL); endpwent(); } -#endif /* __WIN32__ || MAC_TCL */ - Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ", - Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL); +#endif /* HAVE_PW_GECOS */ + Tcl_AppendResult(interp, "%%Title: Window ", + Tk_PathName(tkwin), "\n", (char *) NULL); time(&now); - Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ", - ctime(&now), (char *) NULL); + Tcl_AppendResult(interp, "%%CreationDate: ", + ctime(&now), (char *) NULL); /* INTL: Native. */ if (!psInfo.rotate) { sprintf(string, "%d %d %d %d", (int) (psInfo.pageX + psInfo.scale*deltaX), @@ -740,21 +749,21 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width) + 1.0)); } - Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string, + Tcl_AppendResult(interp, "%%BoundingBox: ", string, "\n", (char *) NULL); - Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", + Tcl_AppendResult(interp, "%%Pages: 1\n", "%%DocumentData: Clean7Bit\n", (char *) NULL); - Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ", + Tcl_AppendResult(interp, "%%Orientation: ", psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL); p = "%%DocumentNeededResources: font "; for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(canvasPtr->interp, p, + Tcl_AppendResult(interp, p, Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); p = "%%+ font "; } - Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL); + Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL); /* * Insert the prolog @@ -764,7 +773,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -775,14 +784,14 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) */ sprintf(string, "/CL %d def\n", psInfo.colorLevel); - Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string, + Tcl_AppendResult(interp, "%%BeginSetup\n", string, (char *) NULL); for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { - Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ", + Tcl_AppendResult(interp, "%%IncludeResource: font ", Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); } - Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL); + Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL); /* *----------------------------------------------------------- @@ -792,26 +801,31 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) *----------------------------------------------------------- */ - Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n", + Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n", (char *) NULL); sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY); - Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + Tcl_AppendResult(interp, string, (char *) NULL); if (psInfo.rotate) { - Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL); + Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL); } sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); - Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + Tcl_AppendResult(interp, string, (char *) NULL); sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); - Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); + Tcl_AppendResult(interp, string, (char *) NULL); sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g", - psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y), - psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y), - psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2), - psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2)); - Tcl_AppendResult(canvasPtr->interp, string, + psInfo.x, + Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), + psInfo.x2, + Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo), + psInfo.x2, + Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo), + psInfo.x, + Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo)); + Tcl_AppendResult(interp, string, " lineto closepath clip newpath\n", (char *) NULL); + } if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -832,21 +846,24 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) if (itemPtr->typePtr->postscriptProc == NULL) { continue; } - Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); - result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, + if (itemPtr->state == TK_STATE_HIDDEN) { + continue; + } + Tcl_AppendResult(interp, "gsave\n", (char *) NULL); + result = (*itemPtr->typePtr->postscriptProc)(interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { - char msg[100]; + char msg[64 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (generating Postscript for item %d)", itemPtr->id); - Tcl_AddErrorInfo(canvasPtr->interp, msg); + Tcl_AddErrorInfo(interp, msg); goto cleanup; } - Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); + Tcl_AppendResult(interp, "grestore\n", (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); - Tcl_ResetResult(canvasPtr->interp); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); + Tcl_ResetResult(interp); } } @@ -857,10 +874,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) *--------------------------------------------------------------------- */ - Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n", + if (psInfo.prolog) { + Tcl_AppendResult(interp, "restore showpage\n\n", "%%Trailer\nend\n%%EOF\n", (char *) NULL); + } if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -894,20 +913,20 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) ckfree(psInfo.fileName); } if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) { - Tcl_Close(canvasPtr->interp, psInfo.chan); + Tcl_Close(interp, psInfo.chan); } if (psInfo.channelName != NULL) { ckfree(psInfo.channelName); } Tcl_DeleteHashTable(&psInfo.fontTable); - canvasPtr->psInfoPtr = oldInfoPtr; + canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr; return result; } /* *-------------------------------------------------------------- * - * Tk_CanvasPsColor -- + * Tk_PostscriptColor -- * * This procedure is called by individual canvas items when * they want to set a color value for output. Given information @@ -916,9 +935,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -927,14 +946,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) */ int -Tk_CanvasPsColor(interp, canvas, colorPtr) - Tcl_Interp *interp; /* Interpreter for returning Postscript - * or error message. */ - Tk_Canvas canvas; /* Information about canvas. */ +Tk_PostscriptColor(interp, psInfo, colorPtr) + Tcl_Interp *interp; + Tk_PostscriptInfo psInfo; /* Postscript info. */ XColor *colorPtr; /* Information about color. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int tmp; double red, green, blue; char string[200]; @@ -988,7 +1005,7 @@ Tk_CanvasPsColor(interp, canvas, colorPtr) /* *-------------------------------------------------------------- * - * Tk_CanvasPsFont -- + * Tk_PostscriptFont -- * * This procedure is called by individual canvas items when * they want to output text. Given information about an X @@ -997,9 +1014,9 @@ Tk_CanvasPsColor(interp, canvas, colorPtr) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * 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->result. + * appended to the interp's result. * * Side effects: * The Postscript font name is entered into psInfoPtr->fontTable @@ -1009,17 +1026,15 @@ Tk_CanvasPsColor(interp, canvas, colorPtr) */ int -Tk_CanvasPsFont(interp, canvas, tkfont) - Tcl_Interp *interp; /* Interpreter for returning Postscript - * or error message. */ - Tk_Canvas canvas; /* Information about canvas. */ +Tk_PostscriptFont(interp, psInfo, tkfont) + Tcl_Interp *interp; + Tk_PostscriptInfo psInfo; /* Postscript Info. */ Tk_Font tkfont; /* Information about font in which text * is to be printed. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; char *end; - char pointString[20]; + char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; @@ -1082,7 +1097,7 @@ Tk_CanvasPsFont(interp, canvas, tkfont) /* *-------------------------------------------------------------- * - * Tk_CanvasPsBitmap -- + * Tk_PostscriptBitmap -- * * This procedure is called to output the contents of a * sub-region of a bitmap in proper image data format for @@ -1091,9 +1106,9 @@ Tk_CanvasPsFont(interp, canvas, tkfont) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -1102,18 +1117,18 @@ Tk_CanvasPsFont(interp, canvas, tkfont) */ int -Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) - Tcl_Interp *interp; /* Interpreter for returning Postscript - * or error message. */ - Tk_Canvas canvas; /* Information about canvas. */ +Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width, + height) + Tcl_Interp *interp; + Tk_Window tkwin; + Tk_PostscriptInfo psInfo; /* Postscript info. */ Pixmap bitmap; /* Bitmap for which to generate * Postscript. */ int startX, startY; /* Coordinates of upper-left corner * of rectangular region to output. */ int width, height; /* Height of rectangular region. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; XImage *imagePtr; int charsInLine, x, y, lastX, lastY, value, mask; unsigned int totalWidth, totalHeight; @@ -1134,10 +1149,10 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) * it shouldn't matter here. */ - XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot, + XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth, (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); - imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0, + imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); Tcl_AppendResult(interp, "<", (char *) NULL); mask = 0x80; @@ -1179,7 +1194,7 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) /* *-------------------------------------------------------------- * - * Tk_CanvasPsStipple -- + * Tk_PostscriptStipple -- * * This procedure is called by individual canvas items when * they have created a path that they'd like to be filled with @@ -1190,9 +1205,9 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) * * Results: * Returns a standard Tcl return value. If an error occurs - * then an error message will be left in interp->result. + * then an error message will be left in the interp's result. * If no error occurs, then additional Postscript will be - * appended to interp->result. + * appended to the interp's result. * * Side effects: * None. @@ -1201,16 +1216,16 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height) */ int -Tk_CanvasPsStipple(interp, canvas, bitmap) - Tcl_Interp *interp; /* Interpreter for returning Postscript +Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap) + Tcl_Interp *interp; + Tk_Window tkwin; + Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript * or error message. */ - Tk_Canvas canvas; /* Information about canvas. */ Pixmap bitmap; /* Bitmap to use for stippling. */ { - TkCanvas *canvasPtr = (TkCanvas *) canvas; - TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; int width, height; - char string[100]; + char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; @@ -1227,12 +1242,12 @@ Tk_CanvasPsStipple(interp, canvas, bitmap) * it shouldn't matter here. */ - XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot, + 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, (char *) NULL); - if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0, + if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0, width, height) != TCL_OK) { return TCL_ERROR; } @@ -1243,9 +1258,9 @@ Tk_CanvasPsStipple(interp, canvas, bitmap) /* *-------------------------------------------------------------- * - * Tk_CanvasPsY -- + * Tk_PostscriptY -- * - * Given a y-coordinate in canvas coordinates, this procedure + * Given a y-coordinate in local coordinates, this procedure * returns a y-coordinate to use for Postscript output. * * Results: @@ -1259,12 +1274,11 @@ Tk_CanvasPsStipple(interp, canvas, bitmap) */ double -Tk_CanvasPsY(canvas, y) - Tk_Canvas canvas; /* Token for canvas on whose behalf - * Postscript is being generated. */ +Tk_PostscriptY(y, psInfo) double y; /* Y-coordinate in canvas coords. */ + Tk_PostscriptInfo psInfo; /* Postscript info */ { - TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; return psInfoPtr->y2 - y; } @@ -1272,13 +1286,13 @@ Tk_CanvasPsY(canvas, y) /* *-------------------------------------------------------------- * - * Tk_CanvasPsPath -- + * 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 interp->result. + * Postscript commands get appended to what's in the interp's result. * * Side effects: * None. @@ -1287,29 +1301,28 @@ Tk_CanvasPsY(canvas, y) */ void -Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) - Tcl_Interp *interp; /* Put generated Postscript in this - * interpreter's result field. */ - Tk_Canvas canvas; /* Canvas on whose behalf Postscript +Tk_PostscriptPath(interp, psInfo, coordPtr, numPoints) + 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 = ((TkCanvas *) canvas)->psInfoPtr; + TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo; char buffer[200]; if (psInfoPtr->prepass) { return; } sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], - Tk_CanvasPsY(canvas, coordPtr[1])); + Tk_PostscriptY(coordPtr[1], psInfo)); Tcl_AppendResult(interp, buffer, (char *) NULL); for (numPoints--, coordPtr += 2; numPoints > 0; numPoints--, coordPtr += 2) { sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0], - Tk_CanvasPsY(canvas, coordPtr[1])); + Tk_PostscriptY(coordPtr[1], psInfo)); Tcl_AppendResult(interp, buffer, (char *) NULL); } } @@ -1327,7 +1340,7 @@ Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints) * 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 - * interp->result. + * the interp's result. * * Side effects: * None. @@ -1384,3 +1397,750 @@ GetPostscriptPoints(interp, string, doublePtr) *doublePtr = d; return TCL_OK; } + +/* + *-------------------------------------------------------------- + * + * TkImageGetColor -- + * + * This procedure 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. + * + * Results: + * Returns red, green, and blue color values in the range + * 0 to 1. There are no error returns. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +static void +TkImageGetColor(cdata, pixel, red, green, blue) + TkColormapData *cdata; /* Colormap data */ + unsigned long pixel; /* Pixel value to look up */ + double *red, *green, *blue; /* Color data to return */ +{ + if (cdata->separated) { + int r = (pixel & cdata->red_mask) >> cdata->red_shift; + int g = (pixel & cdata->green_mask) >> cdata->green_shift; + int b = (pixel & cdata->blue_mask) >> cdata->blue_shift; + *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; + } +} + +/* + *-------------------------------------------------------------- + * + * TkPostscriptImage -- + * + * This procedure 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(interp, tkwin, psInfo, ximage, x, y, width, height) + Tcl_Interp *interp; + Tk_Window tkwin; + Tk_PostscriptInfo psInfo; /* postscript info */ + XImage *ximage; /* Image to draw */ + int x, y; /* First pixel to output */ + int width, 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, depth, ncolors; + Visual *visual; + TkColormapData cdata; + + if (psInfoPtr->prepass) { + return TCL_OK; + } + + cmap = Tk_Colormap(tkwin); + depth = Tk_Depth(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, (char *) 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, (char *) NULL); + break; + case 1: + sprintf(buffer, "%d %d 8 matrix {\n<", width, rows); + Tcl_AppendResult(interp, buffer, (char *) NULL); + break; + case 2: + sprintf(buffer, "%d %d 8 matrix {\n<", + width, rows); + Tcl_AppendResult(interp, buffer, (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) NULL); + } + mask=0x80; + data=0x00; + } + } + if ((width % 8) != 0) { + sprintf(buffer, "%02X", data); + Tcl_AppendResult(interp, buffer, (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) 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, (char *) NULL); + lineLen += 6; + if (lineLen > 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) NULL); + } + } + break; + } + } + } + switch (level) { + case 0: sprintf(buffer, ">\n} image\n"); break; + case 1: sprintf(buffer, ">\n} image\n"); break; + case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break; + } + Tcl_AppendResult(interp, buffer, (char *) NULL); + sprintf(buffer, "0 %d translate\n", rows); + Tcl_AppendResult(interp, buffer, (char *) NULL); + } + ckfree((char *) cdata.colors); + return TCL_OK; +} + +/* + *-------------------------------------------------------------- + * + * Tk_PostscriptPhoto -- + * + * This procedure 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(interp, blockPtr, psInfo, width, height) + Tcl_Interp *interp; + Tk_PhotoImageBlock *blockPtr; + Tk_PostscriptInfo psInfo; + int width, 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", (char *) 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", (char *) 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, (char *) 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", (char *) 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", (char *) NULL); + + + sprintf(buffer, + " /ImageMatrix [1 0 0 -1 0 %d]\n", height); + Tcl_AppendResult(interp, buffer, + " /Decode ", decode, "\n>>\n1 TkPhoto\n", (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) NULL); + } + mask=0x80; + data=0x00; + } + } + if ((width % 8) != 0) { + sprintf(buffer, "%02X", data); + Tcl_AppendResult(interp, buffer, (char *) NULL); + 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) { + sprintf(buffer, "%02X", data); + Tcl_AppendResult(interp, buffer, (char *) NULL); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) NULL); + } + mask=0x80; + data=0x00; + } + } + if ((width % 8) != 0) { + sprintf(buffer, "%02X", data); + Tcl_AppendResult(interp, buffer, (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) 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, (char *) NULL); + lineLen += 2; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) 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, (char *) NULL); + lineLen += 6; + if (lineLen >= 60) { + lineLen = 0; + Tcl_AppendResult(interp, "\n", (char *) NULL); + } + } + break; + } + } + } + + Tcl_AppendResult(interp, ">\n", (char *) NULL); + return TCL_OK; +} + |