diff options
Diffstat (limited to 'generic/tkCanvPs.c')
| -rw-r--r-- | generic/tkCanvPs.c | 335 |
1 files changed, 11 insertions, 324 deletions
diff --git a/generic/tkCanvPs.c b/generic/tkCanvPs.c index ea6ec2a..47aa841 100644 --- a/generic/tkCanvPs.c +++ b/generic/tkCanvPs.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCanvPs.c,v 1.8 2002/01/25 21:09:36 dgp Exp $ + * RCS: @(#) $Id: tkCanvPs.c,v 1.9 2002/06/25 16:27:43 a_kovalenko Exp $ */ #include "tkInt.h" @@ -116,320 +116,6 @@ 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\ -% RCS: @(#) $Id: tkCanvPs.c,v 1.8 2002/01/25 21:09:36 dgp Exp $\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: */ @@ -485,7 +171,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) Tcl_HashSearch search; Tcl_HashEntry *hPtr; Tcl_DString buffer; - CONST char * CONST *chunk; + char psenccmd[]="::tk::ensure_psenc_is_loaded"; /* *---------------------------------------------------------------- @@ -493,7 +179,10 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) * then process all the arguments to fill the data structure in. *---------------------------------------------------------------- */ - + result = Tcl_EvalEx(interp,psenccmd,-1,TCL_EVAL_GLOBAL); + if (result != TCL_OK) { + return result; + } oldInfoPtr = canvasPtr->psInfo; canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo; psInfo.x = canvasPtr->xOrigin; @@ -718,8 +407,8 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) */ if (psInfo.prolog) { - Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", - "%%Creator: Tk Canvas Widget\n", (char *) NULL); + Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n", + "%%Creator: Tk Canvas Widget\n", (char *) NULL); #ifdef HAVE_PW_GECOS if (!Tcl_IsSafe(interp)) { struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */ @@ -769,14 +458,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv) /* * Insert the prolog */ - for (chunk=prolog; *chunk; chunk++) { - Tcl_AppendResult(interp, *chunk, (char *) NULL); - } - + Tcl_AppendResult(interp, Tcl_GetVar(interp,"::tk::ps_preamable",TCL_GLOBAL_ONLY), (char *) NULL); if (psInfo.chan != NULL) { - Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); + Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1); Tcl_ResetResult(canvasPtr->interp); } + /* *----------------------------------------------------------- |