/* * tkCanvPs.c -- * * This module provides Postscript output support for canvases, * including the "postscript" widget command plus a few utility * procedures used for generating Postscript. * * Copyright (c) 1991-1994 The Regents of the University of California. * Copyright (c) 1994-1996 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * SCCS: @(#) tkCanvPs.c 1.57 97/10/28 18:08:39 */ #include "tkInt.h" #include "tkCanvas.h" #include "tkPort.h" /* * See tkCanvas.h for key data structures used to implement canvases. */ /* * One of the following structures is created to keep track of Postscript * output being generated. It consists mostly of information provided on * the widget command line. */ typedef struct TkPostscriptInfo { int x, y, width, height; /* Area to print, in canvas pixel * coordinates. */ int x2, y2; /* x+width and y+height. */ char *pageXString; /* String value of "-pagex" option or NULL. */ char *pageYString; /* String value of "-pagey" option or NULL. */ double pageX, pageY; /* Postscript coordinates (in points) * corresponding to pageXString and * pageYString. Don't forget that y-values * grow upwards for Postscript! */ char *pageWidthString; /* Printed width of output. */ char *pageHeightString; /* Printed height of output. */ double scale; /* Scale factor for conversion: each pixel * maps into this many points. */ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */ int rotate; /* Non-zero means output should be rotated * on page (landscape mode). */ char *fontVar; /* If non-NULL, gives name of global variable * containing font mapping information. * Malloc'ed. */ char *colorVar; /* If non-NULL, give name of global variable * containing color mapping information. * Malloc'ed. */ char *colorMode; /* Mode for handling colors: "monochrome", * "gray", or "color". Malloc'ed. */ int colorLevel; /* Numeric value corresponding to colorMode: * 0 for mono, 1 for gray, 2 for color. */ char *fileName; /* Name of file in which to write Postscript; * NULL means return Postscript info as * result. Malloc'ed. */ char *channelName; /* If -channel is specified, the name of * the channel to use. */ Tcl_Channel chan; /* Open channel corresponding to fileName. */ Tcl_HashTable fontTable; /* Hash table containing names of all font * families used in output. The hash table * values are not used. */ int prepass; /* Non-zero means that we're currently in * the pre-pass that collects font information, * so the Postscript generated isn't * relevant. */ } 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", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, colorVar), 0}, {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, colorMode), 0}, {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, fileName), 0}, {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, channelName), 0}, {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, fontVar), 0}, {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, height), 0}, {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0}, {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0}, {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0}, {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageXString), 0}, {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, pageYString), 0}, {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, rotate), 0}, {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, width), 0}, {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, x), 0}, {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL, "", Tk_Offset(TkPostscriptInfo, y), 0}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* * The prolog data. Generated by str2c from prolog.ps * This was split in small chunks by str2c because * some C compiler have limitations on the size of static strings. */ static CONST char * CONST prolog[]= { /* Start of part 1 (2000 characters) */ "%%BeginProlog\n\ 50 dict begin\n\ \n\ % This is a standard prolog for Postscript generated by Tk's canvas\n\ % widget.\n\ % SCCS: @(#) prolog.ps 1.7 96/07/08 17:52:14\n\ \n\ % The definitions below just define all of the variables used in\n\ % any of the procedures here. This is needed for obscure reasons\n\ % explained on p. 716 of the Postscript manual (Section H.2.7,\n\ % \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\ \n\ /baseline 0 def\n\ /stipimage 0 def\n\ /height 0 def\n\ /justify 0 def\n\ /lineLength 0 def\n\ /spacing 0 def\n\ /stipple 0 def\n\ /strings 0 def\n\ /xoffset 0 def\n\ /yoffset 0 def\n\ /tmpstip null def\n\ \n\ % Define the array ISOLatin1Encoding (which specifies how characters are\n\ % encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\ % level 2 is supposed to define it, but level 1 doesn't).\n\ \n\ systemdict /ISOLatin1Encoding known not {\n\ /ISOLatin1Encoding [\n\ /space /space /space /space /space /space /space /space\n\ /space /space /space /space /space /space /space /space\n\ /space /space /space /space /space /space /space /space\n\ /space /space /space /space /space /space /space /space\n\ /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\ /quoteright\n\ /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\ /zero /one /two /three /four /five /six /seven\n\ /eight /nine /colon /semicolon /less /equal /greater /question\n\ /at /A /B /C /D /E /F /G\n\ /H /I /J /K /L /M /N /O\n\ /P /Q /R /S /T /U /V /W\n\ /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\ /quoteleft /a /b /c /d /e /f /g\n\ /h /i /j /k /l /m /n /o\n\ /p /q /r /s /t /u /v /w\n\ /x /y /z /braceleft /bar /braceright /asciitilde /space\n\ /space /space /space /space /space /space /space /space\n\ /space /space /space /space /space /space /space /space\n\ /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\ /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\ /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\ /dieresis /copyright /ordfem", /* End of part 1 */ /* Start of part 2 (2000 characters) */ "inine /guillemotleft /logicalnot /hyphen\n\ /registered /macron\n\ /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\ /periodcentered\n\ /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\ /onehalf /threequarters /questiondown\n\ /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\ /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\ /Idieresis\n\ /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\ /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\ /germandbls\n\ /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\ /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\ /idieresis\n\ /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\ /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\ /ydieresis\n\ ] def\n\ } if\n\ \n\ % font ISOEncode font\n\ % This procedure changes the encoding of a font from the default\n\ % Postscript encoding to ISOLatin1. It's typically invoked just\n\ % before invoking \"setfont\". The body of this procedure comes from\n\ % Section 5.6.1 of the Postscript book.\n\ \n\ /ISOEncode {\n\ dup length dict begin\n\ {1 index /FID ne {def} {pop pop} ifelse} forall\n\ /Encoding ISOLatin1Encoding def\n\ currentdict\n\ end\n\ \n\ % I'm not sure why it's necessary to use \"definefont\" on this new\n\ % font, but it seems to be important; just use the name \"Temporary\"\n\ % for the font.\n\ \n\ /Temporary exch definefont\n\ } bind def\n\ \n\ % StrokeClip\n\ %\n\ % This procedure converts the current path into a clip area under\n\ % the assumption of stroking. It's a bit tricky because some Postscript\n\ % interpreters get errors during strokepath for dashed lines. If\n\ % this happens then turn off dashes and try again.\n\ \n\ /StrokeClip {\n\ {strokepath} stopped {\n\ (This Postscript printer gets limitcheck overflows when) =\n\ (stippling dashed lines; lines will be printed solid instead.) =\n\ [] 0 setdash strokepath} if\n\ clip\n\ } bind def\n\ \n\ % d", /* End of part 2 */ /* Start of part 3 (2000 characters) */ "esiredSize EvenPixels closestSize\n\ %\n\ % The procedure below is used for stippling. Given the optimal size\n\ % of a dot in a stipple pattern in the current user coordinate system,\n\ % compute the closest size that is an exact multiple of the device's\n\ % pixel size. This allows stipple patterns to be displayed without\n\ % aliasing effects.\n\ \n\ /EvenPixels {\n\ % Compute exact number of device pixels per stipple dot.\n\ dup 0 matrix currentmatrix dtransform\n\ dup mul exch dup mul add sqrt\n\ \n\ % Round to an integer, make sure the number is at least 1, and compute\n\ % user coord distance corresponding to this.\n\ dup round dup 1 lt {pop 1} if\n\ exch div mul\n\ } bind def\n\ \n\ % width height string StippleFill --\n\ %\n\ % Given a path already set up and a clipping region generated from\n\ % it, this procedure will fill the clipping region with a stipple\n\ % pattern. \"String\" contains a proper image description of the\n\ % stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\ % stipple dot is assumed to be about one unit across in the current\n\ % user coordinate system. This procedure trashes the graphics state.\n\ \n\ /StippleFill {\n\ % The following code is needed to work around a NeWSprint bug.\n\ \n\ /tmpstip 1 index def\n\ \n\ % Change the scaling so that one user unit in user coordinates\n\ % corresponds to the size of one stipple dot.\n\ 1 EvenPixels dup scale\n\ \n\ % Compute the bounding box occupied by the path (which is now\n\ % the clipping region), and round the lower coordinates down\n\ % to the nearest starting point for the stipple pattern. Be\n\ % careful about negative numbers, since the rounding works\n\ % differently on them.\n\ \n\ pathbbox\n\ 4 2 roll\n\ 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\ 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\ \n\ % Stack now: width height string y1 y2 x1 x2\n\ % Below is a doubly-nested for loop to iterate across this area\n\ % in units of the stipple pattern size, going up columns then\n\ % acr", /* End of part 3 */ /* Start of part 4 (2000 characters) */ "oss rows, blasting out a stipple-pattern-sized rectangle at\n\ % each position\n\ \n\ 6 index exch {\n\ 2 index 5 index 3 index {\n\ % Stack now: width height string y1 y2 x y\n\ \n\ gsave\n\ 1 index exch translate\n\ 5 index 5 index true matrix tmpstip imagemask\n\ grestore\n\ } for\n\ pop\n\ } for\n\ pop pop pop pop pop\n\ } bind def\n\ \n\ % -- AdjustColor --\n\ % Given a color value already set for output by the caller, adjusts\n\ % that value to a grayscale or mono value if requested by the CL\n\ % variable.\n\ \n\ /AdjustColor {\n\ CL 2 lt {\n\ currentgray\n\ CL 0 eq {\n\ .5 lt {0} {1} ifelse\n\ } if\n\ setgray\n\ } if\n\ } bind def\n\ \n\ % x y strings spacing xoffset yoffset justify stipple DrawText --\n\ % This procedure does all of the real work of drawing text. The\n\ % color and font must already have been set by the caller, and the\n\ % following arguments must be on the stack:\n\ %\n\ % x, y - Coordinates at which to draw text.\n\ % strings - An array of strings, one for each line of the text item,\n\ % in order from top to bottom.\n\ % spacing - Spacing between lines.\n\ % xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\ % nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\ % yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\ % nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\ % justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\ % stipple - Boolean value indicating whether or not text is to be\n\ % drawn in stippled fashion. If text is stippled,\n\ % procedure StippleText must have been defined to call\n\ % StippleFill in the right way.\n\ %\n\ % Also, when this procedure is invoked, the color and font must already\n\ % have been set for the text.\n\ \n\ /DrawText {\n\ /stipple exch def\n\ /justify exch def\n\ /yoffset exch def\n\ /xoffset exch def\n\ /spacing exch def\n\ /strings exch def\n\ \n\ % First scan through all of the text to find the widest line.\n\ \n\ /lineLength 0 def\n\ strings {\n\ stringwidth pop\n\ dup lineLength gt {/lineLength exch def}", /* End of part 4 */ /* Start of part 5 (1546 characters) */ " {pop} ifelse\n\ newpath\n\ } forall\n\ \n\ % Compute the baseline offset and the actual font height.\n\ \n\ 0 0 moveto (TXygqPZ) false charpath\n\ pathbbox dup /baseline exch def\n\ exch pop exch sub /height exch def pop\n\ newpath\n\ \n\ % Translate coordinates first so that the origin is at the upper-left\n\ % corner of the text's bounding box. Remember that x and y for\n\ % positioning are still on the stack.\n\ \n\ translate\n\ lineLength xoffset mul\n\ strings length 1 sub spacing mul height add yoffset mul translate\n\ \n\ % Now use the baseline and justification information to translate so\n\ % that the origin is at the baseline and positioning point for the\n\ % first line of text.\n\ \n\ justify lineLength mul baseline neg translate\n\ \n\ % Iterate over each of the lines to output it. For each line,\n\ % compute its width again so it can be properly justified, then\n\ % display it.\n\ \n\ strings {\n\ dup stringwidth pop\n\ justify neg mul 0 moveto\n\ stipple {\n\ \n\ % The text is stippled, so turn it into a path and print\n\ % by calling StippledText, which in turn calls StippleFill.\n\ % Unfortunately, many Postscript interpreters will get\n\ % overflow errors if we try to do the whole string at\n\ % once, so do it a character at a time.\n\ \n\ gsave\n\ /char (X) def\n\ {\n\ char 0 3 -1 roll put\n\ currentpoint\n\ gsave\n\ char true charpath clip StippleText\n\ grestore\n\ char stringwidth translate\n\ moveto\n\ } forall\n\ grestore\n\ } {show} ifelse\n\ 0 spacing neg translate\n\ } forall\n\ } bind def\n\ \n\ %%EndProlog\n\ ", /* End of part 5 */ NULL /* End of data marker */ }; /* * Forward declarations for procedures defined later in this file: */ static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp, char *string, double *doublePtr)); /* *-------------------------------------------------------------- * * TkCanvPostscriptCmd -- * * This procedure 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(canvasPtr, interp, argc, argv) TkCanvas *canvasPtr; /* Information about canvas widget. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ char **argv; /* Argument strings. Caller has * already parsed this command enough * to know that argv[1] is * "postscript". */ { TkPostscriptInfo psInfo, *oldInfoPtr; int result; Tk_Item *itemPtr; #define STRING_LENGTH 400 char string[STRING_LENGTH+1], *p; time_t now; size_t length; 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. */ Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; CONST char * CONST *chunk; /* *---------------------------------------------------------------- * Initialize the data structure describing Postscript generation, * then process all the arguments to fill the data structure in. *---------------------------------------------------------------- */ oldInfoPtr = canvasPtr->psInfoPtr; canvasPtr->psInfoPtr = &psInfo; 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; Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS); result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->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(canvasPtr->tkwin); } if (psInfo.height == -1) { psInfo.height = Tk_Height(canvasPtr->tkwin); } psInfo.x2 = psInfo.x + psInfo.width; psInfo.y2 = psInfo.y + psInfo.height; if (psInfo.pageXString != NULL) { if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString, &psInfo.pageX) != TCL_OK) { goto cleanup; } } if (psInfo.pageYString != NULL) { if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString, &psInfo.pageY) != TCL_OK) { goto cleanup; } } if (psInfo.pageWidthString != NULL) { if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString, &psInfo.scale) != TCL_OK) { goto cleanup; } psInfo.scale /= psInfo.width; } else if (psInfo.pageHeightString != NULL) { if (GetPostscriptPoints(canvasPtr->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)); } 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(canvasPtr->interp, "bad color mode \"", psInfo.colorMode, "\": must be monochrome, ", "gray, or color", (char *) NULL); goto cleanup; } } if (psInfo.fileName != NULL) { /* * Check that -file and -channel are not both specified. */ if (psInfo.channelName != NULL) { Tcl_AppendResult(canvasPtr->interp, "can't specify both -file", " and -channel", (char *) NULL); result = TCL_ERROR; goto cleanup; } /* * Check that we are not in a safe interpreter. If we are, disallow * the -file specification. */ if (Tcl_IsSafe(canvasPtr->interp)) { Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a", " safe interpreter", (char *) NULL); result = TCL_ERROR; goto cleanup; } p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer); if (p == NULL) { goto cleanup; } psInfo.chan = Tcl_OpenFileChannel(canvasPtr->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. */ #ifdef NYI psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName, &mode); #endif if (psInfo.chan == (Tcl_Channel) NULL) { result = TCL_ERROR; goto cleanup; } if ((mode & TCL_WRITABLE) == 0) { Tcl_AppendResult(canvasPtr->interp, "channel \"", psInfo.channelName, "\" wasn't opened for writing", (char *) 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)(canvasPtr->interp, (Tk_Canvas) canvasPtr, itemPtr, 1); Tcl_ResetResult(canvasPtr->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. *-------------------------------------------------------- */ Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n", "%%Creator: Tk Canvas Widget\n", (char *) NULL); #if !(defined(__WIN32__) || defined(MAC_TCL)) if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); Tcl_AppendResult(canvasPtr->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); time(&now); Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ", ctime(&now), (char *) NULL); 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(canvasPtr->interp, "%%BoundingBox: ", string, "\n", (char *) NULL); Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n", "%%DocumentData: Clean7Bit\n", (char *) NULL); Tcl_AppendResult(canvasPtr->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_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); p = "%%+ font "; } Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL); /* * Insert the prolog */ for (chunk=prolog; *chunk; chunk++) { Tcl_AppendResult(interp, *chunk, (char *) NULL); } if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); Tcl_ResetResult(canvasPtr->interp); } /* *----------------------------------------------------------- * Document setup: set the color level and include fonts. *----------------------------------------------------------- */ sprintf(string, "/CL %d def\n", psInfo.colorLevel); Tcl_AppendResult(canvasPtr->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_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL); } Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) 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(canvasPtr->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); if (psInfo.rotate) { Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL); } sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale); Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL); sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY); Tcl_AppendResult(canvasPtr->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, " lineto closepath clip newpath\n", (char *) NULL); if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, canvasPtr->interp->result, -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; } Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL); result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp, (Tk_Canvas) canvasPtr, itemPtr, 0); if (result != TCL_OK) { char msg[100]; sprintf(msg, "\n (generating Postscript for item %d)", itemPtr->id); Tcl_AddErrorInfo(canvasPtr->interp, msg); goto cleanup; } Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); if (psInfo.chan != NULL) { Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); Tcl_ResetResult(canvasPtr->interp); } } /* *--------------------------------------------------------------------- * Output page-end information, such as commands to print the page * and document trailer stuff. *--------------------------------------------------------------------- */ Tcl_AppendResult(canvasPtr->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_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(canvasPtr->interp, psInfo.chan); } if (psInfo.channelName != NULL) { ckfree(psInfo.channelName); } Tcl_DeleteHashTable(&psInfo.fontTable); canvasPtr->psInfoPtr = oldInfoPtr; return result; } /* *-------------------------------------------------------------- * * Tk_CanvasPsColor -- * * This procedure is called by individual canvas items when * they want to set a color value for output. Given information * about an X color, this procedure will generate Postscript * commands to set up an appropriate color in Postscript. * * Results: * Returns a standard Tcl return value. If an error occurs * then an error message will be left in interp->result. * If no error occurs, then additional Postscript will be * appended to interp->result. * * Side effects: * None. * *-------------------------------------------------------------- */ int Tk_CanvasPsColor(interp, canvas, colorPtr) Tcl_Interp *interp; /* Interpreter for returning Postscript * or error message. */ Tk_Canvas canvas; /* Information about canvas. */ XColor *colorPtr; /* Information about color. */ { TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; 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) { char *cmdString; cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar, Tk_NameOfColor(colorPtr), 0); if (cmdString != NULL) { Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL); return TCL_OK; } } /* * No color map entry for this color. Grab the color's intensities * and output Postscript commands for them. Special note: X uses * a range of 0-65535 for intensities, but most displays only use * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the * X scale. This means that there's no way to get perfect white, * since the highest intensity is only 65280 out of 65535. To * work around this problem, rescale the X intensity to a 0-255 * scale and use that as the basis for the Postscript colors. This * scheme still won't work if the display only uses 4 bits per color, * but most diplays use at least 8 bits. */ tmp = colorPtr->red; red = ((double) (tmp >> 8))/255.0; tmp = colorPtr->green; green = ((double) (tmp >> 8))/255.0; tmp = colorPtr->blue; blue = ((double) (tmp >> 8))/255.0; sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n", red, green, blue); Tcl_AppendResult(interp, string, (char *) NULL); return TCL_OK; } /* *-------------------------------------------------------------- * * Tk_CanvasPsFont -- * * This procedure is called by individual canvas items when * they want to output text. Given information about an X * font, this procedure will generate Postscript commands * to set up an appropriate font in Postscript. * * Results: * Returns a standard Tcl return value. If an error occurs * then an error message will be left in interp->result. * If no error occurs, then additional Postscript will be * appended to the interp->result. * * Side effects: * The Postscript font name is entered into psInfoPtr->fontTable * if it wasn't already there. * *-------------------------------------------------------------- */ int Tk_CanvasPsFont(interp, canvas, tkfont) Tcl_Interp *interp; /* Interpreter for returning Postscript * or error message. */ Tk_Canvas canvas; /* Information about canvas. */ Tk_Font tkfont; /* Information about font in which text * is to be printed. */ { TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; char *end; char pointString[20]; Tcl_DString ds; int i, points; /* * First, look up the font's name in the font map, if there is one. * If there is an entry for this font, it consists of a list * containing font name and size. Use this information. */ Tcl_DStringInit(&ds); if (psInfoPtr->fontVar != NULL) { char *list, **argv; int argc; double size; char *name; name = Tk_NameOfFont(tkfont); list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0); if (list != NULL) { if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) { badMapEntry: Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad font map entry for \"", name, "\": \"", list, "\"", (char *) NULL); return TCL_ERROR; } if (argc != 2) { goto badMapEntry; } size = strtod(argv[1], &end); if ((size <= 0) || (*end != 0)) { goto badMapEntry; } Tcl_DStringAppend(&ds, argv[0], -1); points = (int) size; ckfree((char *) argv); goto findfont; } } points = Tk_PostscriptFontName(tkfont, &ds); findfont: sprintf(pointString, "%d", points); Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ", pointString, " scalefont ", (char *) NULL); if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) { Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL); } Tcl_AppendResult(interp, "setfont\n", (char *) NULL); Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i); Tcl_DStringFree(&ds); return TCL_OK; } /* *-------------------------------------------------------------- * * Tk_CanvasPsBitmap -- * * This procedure 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 interp->result. * If no error occurs, then additional Postscript will be * appended to interp->result. * * Side effects: * None. * *-------------------------------------------------------------- */ 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. */ 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; 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(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot, (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth, (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth); imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0, totalWidth, totalHeight, 1, XYPixmap); Tcl_AppendResult(interp, "<", (char *) 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, (char *) NULL); mask = 0x80; value = 0; charsInLine += 2; if (charsInLine >= 60) { Tcl_AppendResult(interp, "\n", (char *) NULL); charsInLine = 0; } } } if (mask != 0x80) { sprintf(string, "%02x", value); Tcl_AppendResult(interp, string, (char *) NULL); mask = 0x80; value = 0; charsInLine += 2; } } Tcl_AppendResult(interp, ">", (char *) NULL); XDestroyImage(imagePtr); return TCL_OK; } /* *-------------------------------------------------------------- * * Tk_CanvasPsStipple -- * * This procedure 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 procedure 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 interp->result. * If no error occurs, then additional Postscript will be * appended to interp->result. * * Side effects: * None. * *-------------------------------------------------------------- */ int Tk_CanvasPsStipple(interp, canvas, bitmap) Tcl_Interp *interp; /* 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; int width, height; 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(Tk_CanvasTkwin(canvas)), 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, width, height) != TCL_OK) { return TCL_ERROR; } Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL); return TCL_OK; } /* *-------------------------------------------------------------- * * Tk_CanvasPsY -- * * Given a y-coordinate in canvas coordinates, this procedure * returns a y-coordinate to use for Postscript output. * * Results: * Returns the Postscript coordinate that corresponds to * "y". * * Side effects: * None. * *-------------------------------------------------------------- */ double Tk_CanvasPsY(canvas, y) Tk_Canvas canvas; /* Token for canvas on whose behalf * Postscript is being generated. */ double y; /* Y-coordinate in canvas coords. */ { TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr; return psInfoPtr->y2 - y; } /* *-------------------------------------------------------------- * * Tk_CanvasPsPath -- * * 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. * * Side effects: * None. * *-------------------------------------------------------------- */ 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 * 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; char buffer[200]; if (psInfoPtr->prepass) { return; } sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0], Tk_CanvasPsY(canvas, coordPtr[1])); 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])); Tcl_AppendResult(interp, buffer, (char *) 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 * interp->result. * * Side effects: * None. * *-------------------------------------------------------------- */ static int GetPostscriptPoints(interp, string, doublePtr) Tcl_Interp *interp; /* Use this for error reporting. */ char *string; /* String describing a screen distance. */ double *doublePtr; /* Place to store converted result. */ { char *end; double d; d = strtod(string, &end); if (end == string) { error: Tcl_AppendResult(interp, "bad distance \"", string, "\"", (char *) NULL); return TCL_ERROR; } 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; }