*/
/*
+ * The following definition is used in generating postscript for images
+ * and windows.
+ */
+
+typedef struct TkColormapData { /* Hold color information for a window */
+ int separated; /* Whether to use separate color bands */
+ int color; /* Whether window is color or black/white */
+ int ncolors; /* Number of color values stored */
+ XColor *colors; /* Pixel value -> RGB mappings */
+ int red_mask, green_mask, blue_mask; /* Masks and shifts for each */
+ int red_shift, green_shift, blue_shift; /* color band */
+} TkColormapData;
+
+/*
* 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.
};
/*
- * 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$\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:
*/
TkCanvas *canvasPtr; /* Information about canvas widget. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. Caller has
+ CONST char **argv; /* Argument strings. Caller has
* already parsed this command enough
* to know that argv[1] is
* "postscript". */
int result;
Tk_Item *itemPtr;
#define STRING_LENGTH 400
- char string[STRING_LENGTH+1], *p;
+ char string[STRING_LENGTH+1];
+ CONST char *p;
time_t now;
size_t length;
Tk_Window tkwin = canvasPtr->tkwin;
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
Tcl_DString buffer;
- CONST char * CONST *chunk;
+ char psenccmd[]="::tk::ensure_psenc_is_loaded";
/*
*----------------------------------------------------------------
* 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;
*/
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. */
/*
* 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);
}
*/
if (psInfoPtr->colorVar != NULL) {
- char *cmdString;
+ CONST char *cmdString;
cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
Tk_NameOfColor(colorPtr), 0);
Tcl_DStringInit(&ds);
if (psInfoPtr->fontVar != NULL) {
- char *list, **argv;
+ CONST char *list;
int argc;
double size;
- char *name;
+ CONST char **argv;
+ CONST char *name;
name = Tk_NameOfFont(tkfont);
list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
* data passed as an argument, and should work for all Visual
* types.
*
+ * This implementation is bogus on Windows because the colormap
+ * data is never filled in. Instead all postscript generated
+ * data coming through here is expected to be RGB color data.
+ * To handle lower bit-depth images properly, XQueryColors
+ * must be implemented for Windows.
+ *
* Results:
* Returns red, green, and blue color values in the range
* 0 to 1. There are no error returns.
*
*--------------------------------------------------------------
*/
+#ifdef WIN32
+#include <windows.h>
+
+/*
+ * We could just define these instead of pulling in windows.h.
+ #define GetRValue(rgb) ((BYTE)(rgb))
+ #define GetGValue(rgb) ((BYTE)(((WORD)(rgb)) >> 8))
+ #define GetBValue(rgb) ((BYTE)((rgb)>>16))
+*/
static void
TkImageGetColor(cdata, pixel, red, green, blue)
unsigned long pixel; /* Pixel value to look up */
double *red, *green, *blue; /* Color data to return */
{
+ *red = (double) GetRValue(pixel) / 255.0;
+ *green = (double) GetGValue(pixel) / 255.0;
+ *blue = (double) GetBValue(pixel) / 255.0;
+}
+#else
+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;
+ *red = cdata->colors[r].red / 65535.0;
*green = cdata->colors[g].green / 65535.0;
- *blue = cdata->colors[b].blue / 65535.0;
+ *blue = cdata->colors[b].blue / 65535.0;
} else {
- *red = cdata->colors[pixel].red / 65535.0;
+ *red = cdata->colors[pixel].red / 65535.0;
*green = cdata->colors[pixel].green / 65535.0;
- *blue = cdata->colors[pixel].blue / 65535.0;
+ *blue = cdata->colors[pixel].blue / 65535.0;
}
}
+#endif
/*
*--------------------------------------------------------------
else
cdata.color = 1;
-
XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
/*
* Postscript interpreter).
*/
- switch (level)
- {
+ 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;
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)));
+ (0.30 * red + 0.59 * green + 0.11 * blue)));
Tcl_AppendResult(interp, buffer, (char *) NULL);
lineLen += 2;
if (lineLen > 60) {
* Finally, color mode. Here, just output the red, green,
* and blue values directly.
*/
- for (xx = x; xx < x+width; xx++) {
+ for (xx = x; xx < x+width; xx++) {
TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
&red, &green, &blue);
sprintf(buffer, "%02X%02X%02X",
Tcl_AppendResult(interp, ">\n", (char *) NULL);
return TCL_OK;
}
-
OSDN Git Service
