diff options
Diffstat (limited to 'generic/tkCanvPs.c')
| -rw-r--r-- | generic/tkCanvPs.c | 456 |
1 files changed, 340 insertions, 116 deletions
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index 9bad194..dcc6cee 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -6,12 +6,12 @@ * 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. * - * SCCS: @(#) tkCanvPs.c 1.57 97/10/28 18:08:39 + * SCCS: @(#) tkCanvPs.c 1.62 98/02/10 10:28:12 */ #include "tkInt.h" @@ -112,6 +112,320 @@ 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) */ + "%%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: */ @@ -164,6 +478,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; + CONST char * CONST *chunk; /* *---------------------------------------------------------------- @@ -398,7 +713,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) "%%Creator: Tk Canvas Widget\n", (char *) NULL); #if !(defined(__WIN32__) || defined(MAC_TCL)) if (!Tcl_IsSafe(interp)) { - struct passwd *pwPtr = getpwuid(getuid()); + struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ Tcl_AppendResult(canvasPtr->interp, "%%For: ", (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n", (char *) NULL); @@ -409,7 +724,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL); time(&now); Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ", - ctime(&now), (char *) NULL); + ctime(&now), (char *) NULL); /* INTL: Native. */ if (!psInfo.rotate) { sprintf(string, "%d %d %d %d", (int) (psInfo.pageX + psInfo.scale*deltaX), @@ -443,16 +758,14 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL); /* - * Read a standard prolog file in a native way and insert it into - * the Postscript. + * Insert the prolog */ - - if (TkGetNativeProlog(canvasPtr->interp) != TCL_OK) { - result = TCL_ERROR; - goto cleanup; + for (chunk=prolog; *chunk; chunk++) { + Tcl_AppendResult(interp, *chunk, (char *) NULL); } + if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -499,7 +812,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) 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_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -524,7 +837,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->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); @@ -533,7 +846,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) } Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } } @@ -548,7 +861,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) 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_Write(psInfo.chan, Tcl_GetStringResult(canvasPtr->interp), -1); Tcl_ResetResult(canvasPtr->interp); } @@ -604,9 +917,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. @@ -685,9 +998,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 @@ -707,7 +1020,7 @@ Tk_CanvasPsFont(interp, canvas, tkfont) TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; char *end; - char pointString[20]; + char pointString[TCL_INTEGER_SPACE]; Tcl_DString ds; int i, points; @@ -779,9 +1092,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. @@ -878,9 +1191,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. @@ -898,7 +1211,7 @@ Tk_CanvasPsStipple(interp, canvas, bitmap) TkCanvas *canvasPtr = (TkCanvas *) canvas; TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr; int width, height; - char string[100]; + char string[TCL_INTEGER_SPACE * 2]; Window dummyRoot; int dummyX, dummyY; unsigned dummyBorderwidth, dummyDepth; @@ -966,7 +1279,7 @@ Tk_CanvasPsY(canvas, y) * 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. @@ -1015,7 +1328,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. @@ -1072,92 +1385,3 @@ GetPostscriptPoints(interp, string, doublePtr) *doublePtr = d; return TCL_OK; } - -/* - *-------------------------------------------------------------- - * - * TkGetProlog -- - * - * Locate and load the postscript prolog. - * - * Results: - * A standard Tcl Result. If everything is OK the prolog - * will be located in the result string of the interpreter. - * - * Side effects: - * None. - * - *-------------------------------------------------------------- - */ - -int -TkGetProlog(interp) - Tcl_Interp *interp; /* Places the prolog in the result. */ -{ - char *libDir; - Tcl_Channel chan; - Tcl_DString buffer, buffer2; - char *prologPathParts[2]; - int bufferSize; - char *prologBuffer; - - libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY); - if (libDir == NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't find library directory: ", - "tk_library variable doesn't exist", (char *) NULL); - return TCL_ERROR; - } - Tcl_TranslateFileName(interp, libDir, &buffer); - prologPathParts[0] = buffer.string; - prologPathParts[1] = "prolog.ps"; - Tcl_DStringInit(&buffer2); - Tcl_JoinPath(2, prologPathParts, &buffer2); - Tcl_DStringFree(&buffer); - - /* - * Compute size of file by seeking to the end of the file. This will - * overallocate if we are performing CRLF translation. - */ - - chan = Tcl_OpenFileChannel(NULL, buffer2.string, "r", 0); - if (chan == NULL) { - /* - * We have to set the error message ourselves because the - * interp's result need to be reset. - */ - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "couldn't open \"", - buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - } - - bufferSize = Tcl_Seek(chan, 0L, SEEK_END); - (void) Tcl_Seek(chan, 0L, SEEK_SET); - if (bufferSize < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error seeking to end of file \"", - buffer2.string, "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_Close(NULL, chan); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - - } - prologBuffer = (char *) ckalloc((unsigned) bufferSize+1); - bufferSize = Tcl_Read(chan, prologBuffer, bufferSize); - Tcl_Close(NULL, chan); - if (bufferSize < 0) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "error reading file \"", buffer2.string, - "\": ", Tcl_PosixError(interp), (char *) NULL); - Tcl_DStringFree(&buffer2); - return TCL_ERROR; - } - Tcl_DStringFree(&buffer2); - prologBuffer[bufferSize] = 0; - Tcl_AppendResult(interp, prologBuffer, (char *) NULL); - ckfree(prologBuffer); - - return TCL_OK; -} |