summaryrefslogtreecommitdiffstats
path: root/generic/tkCanvPs.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkCanvPs.c')
-rw-r--r--generic/tkCanvPs.c335
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);
}
+
/*
*-----------------------------------------------------------