/[dtapublic]/projs/trunk/shared_source/tk_base/tkcanvps.c
ViewVC logotype

Contents of /projs/trunk/shared_source/tk_base/tkcanvps.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 68400 byte(s)
Move shared source code to commonize.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkcanvps.c,v 1.1.1.1 2001/06/13 04:57:25 dtashley Exp $ */
2
3 /*
4 * tkCanvPs.c --
5 *
6 * This module provides Postscript output support for canvases,
7 * including the "postscript" widget command plus a few utility
8 * procedures used for generating Postscript.
9 *
10 * Copyright (c) 1991-1994 The Regents of the University of California.
11 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
12 *
13 * See the file "license.terms" for information on usage and redistribution
14 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 *
16 * RCS: @(#) $Id: tkcanvps.c,v 1.1.1.1 2001/06/13 04:57:25 dtashley Exp $
17 */
18
19 #include "tkInt.h"
20 #include "tkCanvas.h"
21 #include "tkPort.h"
22
23 /*
24 * See tkCanvas.h for key data structures used to implement canvases.
25 */
26
27 /*
28 * One of the following structures is created to keep track of Postscript
29 * output being generated. It consists mostly of information provided on
30 * the widget command line.
31 */
32
33 typedef struct TkPostscriptInfo {
34 int x, y, width, height; /* Area to print, in canvas pixel
35 * coordinates. */
36 int x2, y2; /* x+width and y+height. */
37 char *pageXString; /* String value of "-pagex" option or NULL. */
38 char *pageYString; /* String value of "-pagey" option or NULL. */
39 double pageX, pageY; /* Postscript coordinates (in points)
40 * corresponding to pageXString and
41 * pageYString. Don't forget that y-values
42 * grow upwards for Postscript! */
43 char *pageWidthString; /* Printed width of output. */
44 char *pageHeightString; /* Printed height of output. */
45 double scale; /* Scale factor for conversion: each pixel
46 * maps into this many points. */
47 Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
48 int rotate; /* Non-zero means output should be rotated
49 * on page (landscape mode). */
50 char *fontVar; /* If non-NULL, gives name of global variable
51 * containing font mapping information.
52 * Malloc'ed. */
53 char *colorVar; /* If non-NULL, give name of global variable
54 * containing color mapping information.
55 * Malloc'ed. */
56 char *colorMode; /* Mode for handling colors: "monochrome",
57 * "gray", or "color". Malloc'ed. */
58 int colorLevel; /* Numeric value corresponding to colorMode:
59 * 0 for mono, 1 for gray, 2 for color. */
60 char *fileName; /* Name of file in which to write Postscript;
61 * NULL means return Postscript info as
62 * result. Malloc'ed. */
63 char *channelName; /* If -channel is specified, the name of
64 * the channel to use. */
65 Tcl_Channel chan; /* Open channel corresponding to fileName. */
66 Tcl_HashTable fontTable; /* Hash table containing names of all font
67 * families used in output. The hash table
68 * values are not used. */
69 int prepass; /* Non-zero means that we're currently in
70 * the pre-pass that collects font information,
71 * so the Postscript generated isn't
72 * relevant. */
73 int prolog; /* Non-zero means output should contain
74 the file prolog.ps in the header. */
75 } TkPostscriptInfo;
76
77 /*
78 * The table below provides a template that's used to process arguments
79 * to the canvas "postscript" command and fill in TkPostscriptInfo
80 * structures.
81 */
82
83 static Tk_ConfigSpec configSpecs[] = {
84 {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
85 "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
86 {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
87 "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
88 {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
89 "", Tk_Offset(TkPostscriptInfo, fileName), 0},
90 {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
91 "", Tk_Offset(TkPostscriptInfo, channelName), 0},
92 {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
93 "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
94 {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
95 "", Tk_Offset(TkPostscriptInfo, height), 0},
96 {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
97 "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
98 {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
99 "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
100 {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
101 "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
102 {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
103 "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
104 {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
105 "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
106 {TK_CONFIG_BOOLEAN, "-prolog", (char *) NULL, (char *) NULL,
107 "", Tk_Offset(TkPostscriptInfo, prolog), 0},
108 {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
109 "", Tk_Offset(TkPostscriptInfo, rotate), 0},
110 {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
111 "", Tk_Offset(TkPostscriptInfo, width), 0},
112 {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
113 "", Tk_Offset(TkPostscriptInfo, x), 0},
114 {TK_CONFIG_PIXELS, "-y", (char *) NULL, (char *) NULL,
115 "", Tk_Offset(TkPostscriptInfo, y), 0},
116 {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
117 (char *) NULL, 0, 0}
118 };
119
120 /*
121 * The prolog data. Generated by str2c from prolog.ps
122 * This was split in small chunks by str2c because
123 * some C compiler have limitations on the size of static strings.
124 * (str2c is a small tcl script in tcl's tool directory (source release))
125 */
126 static CONST char * CONST prolog[]= {
127 /* Start of part 1 (2000 characters) */
128 "%%BeginProlog\n\
129 50 dict begin\n\
130 \n\
131 % This is a standard prolog for Postscript generated by Tk's canvas\n\
132 % widget.\n\
133 % RCS: @(#) $Id: tkcanvps.c,v 1.1.1.1 2001/06/13 04:57:25 dtashley Exp $\n\
134 \n\
135 % The definitions below just define all of the variables used in\n\
136 % any of the procedures here. This is needed for obscure reasons\n\
137 % explained on p. 716 of the Postscript manual (Section H.2.7,\n\
138 % \"Initializing Variables,\" in the section on Encapsulated Postscript).\n\
139 \n\
140 /baseline 0 def\n\
141 /stipimage 0 def\n\
142 /height 0 def\n\
143 /justify 0 def\n\
144 /lineLength 0 def\n\
145 /spacing 0 def\n\
146 /stipple 0 def\n\
147 /strings 0 def\n\
148 /xoffset 0 def\n\
149 /yoffset 0 def\n\
150 /tmpstip null def\n\
151 \n\
152 % Define the array ISOLatin1Encoding (which specifies how characters are\n\
153 % encoded for ISO-8859-1 fonts), if it isn't already present (Postscript\n\
154 % level 2 is supposed to define it, but level 1 doesn't).\n\
155 \n\
156 systemdict /ISOLatin1Encoding known not {\n\
157 /ISOLatin1Encoding [\n\
158 /space /space /space /space /space /space /space /space\n\
159 /space /space /space /space /space /space /space /space\n\
160 /space /space /space /space /space /space /space /space\n\
161 /space /space /space /space /space /space /space /space\n\
162 /space /exclam /quotedbl /numbersign /dollar /percent /ampersand\n\
163 /quoteright\n\
164 /parenleft /parenright /asterisk /plus /comma /minus /period /slash\n\
165 /zero /one /two /three /four /five /six /seven\n\
166 /eight /nine /colon /semicolon /less /equal /greater /question\n\
167 /at /A /B /C /D /E /F /G\n\
168 /H /I /J /K /L /M /N /O\n\
169 /P /Q /R /S /T /U /V /W\n\
170 /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore\n\
171 /quoteleft /a /b /c /d /e /f /g\n\
172 /h /i /j /k /l /m /n /o\n\
173 /p /q /r /s /t /u /v /w\n\
174 /x /y /z /braceleft /bar /braceright /asciitilde /space\n\
175 /space /space /space /space /space /space /space /space\n\
176 /space /space /space /space /space /space /space /space\n\
177 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent\n\
178 /dieresis /space /ring /cedilla /space /hungarumlaut /ogonek /caron\n\
179 /space /exclamdown /cent /sterling /currency /yen /brokenbar /section\n\
180 /dieresis /copyright /ordfem",
181 /* End of part 1 */
182
183 /* Start of part 2 (2000 characters) */
184 "inine /guillemotleft /logicalnot /hyphen\n\
185 /registered /macron\n\
186 /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph\n\
187 /periodcentered\n\
188 /cedillar /onesuperior /ordmasculine /guillemotright /onequarter\n\
189 /onehalf /threequarters /questiondown\n\
190 /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla\n\
191 /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex\n\
192 /Idieresis\n\
193 /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply\n\
194 /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn\n\
195 /germandbls\n\
196 /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla\n\
197 /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex\n\
198 /idieresis\n\
199 /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide\n\
200 /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn\n\
201 /ydieresis\n\
202 ] def\n\
203 } if\n\
204 \n\
205 % font ISOEncode font\n\
206 % This procedure changes the encoding of a font from the default\n\
207 % Postscript encoding to ISOLatin1. It's typically invoked just\n\
208 % before invoking \"setfont\". The body of this procedure comes from\n\
209 % Section 5.6.1 of the Postscript book.\n\
210 \n\
211 /ISOEncode {\n\
212 dup length dict begin\n\
213 {1 index /FID ne {def} {pop pop} ifelse} forall\n\
214 /Encoding ISOLatin1Encoding def\n\
215 currentdict\n\
216 end\n\
217 \n\
218 % I'm not sure why it's necessary to use \"definefont\" on this new\n\
219 % font, but it seems to be important; just use the name \"Temporary\"\n\
220 % for the font.\n\
221 \n\
222 /Temporary exch definefont\n\
223 } bind def\n\
224 \n\
225 % StrokeClip\n\
226 %\n\
227 % This procedure converts the current path into a clip area under\n\
228 % the assumption of stroking. It's a bit tricky because some Postscript\n\
229 % interpreters get errors during strokepath for dashed lines. If\n\
230 % this happens then turn off dashes and try again.\n\
231 \n\
232 /StrokeClip {\n\
233 {strokepath} stopped {\n\
234 (This Postscript printer gets limitcheck overflows when) =\n\
235 (stippling dashed lines; lines will be printed solid instead.) =\n\
236 [] 0 setdash strokepath} if\n\
237 clip\n\
238 } bind def\n\
239 \n\
240 % d",
241 /* End of part 2 */
242
243 /* Start of part 3 (2000 characters) */
244 "esiredSize EvenPixels closestSize\n\
245 %\n\
246 % The procedure below is used for stippling. Given the optimal size\n\
247 % of a dot in a stipple pattern in the current user coordinate system,\n\
248 % compute the closest size that is an exact multiple of the device's\n\
249 % pixel size. This allows stipple patterns to be displayed without\n\
250 % aliasing effects.\n\
251 \n\
252 /EvenPixels {\n\
253 % Compute exact number of device pixels per stipple dot.\n\
254 dup 0 matrix currentmatrix dtransform\n\
255 dup mul exch dup mul add sqrt\n\
256 \n\
257 % Round to an integer, make sure the number is at least 1, and compute\n\
258 % user coord distance corresponding to this.\n\
259 dup round dup 1 lt {pop 1} if\n\
260 exch div mul\n\
261 } bind def\n\
262 \n\
263 % width height string StippleFill --\n\
264 %\n\
265 % Given a path already set up and a clipping region generated from\n\
266 % it, this procedure will fill the clipping region with a stipple\n\
267 % pattern. \"String\" contains a proper image description of the\n\
268 % stipple pattern and \"width\" and \"height\" give its dimensions. Each\n\
269 % stipple dot is assumed to be about one unit across in the current\n\
270 % user coordinate system. This procedure trashes the graphics state.\n\
271 \n\
272 /StippleFill {\n\
273 % The following code is needed to work around a NeWSprint bug.\n\
274 \n\
275 /tmpstip 1 index def\n\
276 \n\
277 % Change the scaling so that one user unit in user coordinates\n\
278 % corresponds to the size of one stipple dot.\n\
279 1 EvenPixels dup scale\n\
280 \n\
281 % Compute the bounding box occupied by the path (which is now\n\
282 % the clipping region), and round the lower coordinates down\n\
283 % to the nearest starting point for the stipple pattern. Be\n\
284 % careful about negative numbers, since the rounding works\n\
285 % differently on them.\n\
286 \n\
287 pathbbox\n\
288 4 2 roll\n\
289 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll\n\
290 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll\n\
291 \n\
292 % Stack now: width height string y1 y2 x1 x2\n\
293 % Below is a doubly-nested for loop to iterate across this area\n\
294 % in units of the stipple pattern size, going up columns then\n\
295 % acr",
296 /* End of part 3 */
297
298 /* Start of part 4 (2000 characters) */
299 "oss rows, blasting out a stipple-pattern-sized rectangle at\n\
300 % each position\n\
301 \n\
302 6 index exch {\n\
303 2 index 5 index 3 index {\n\
304 % Stack now: width height string y1 y2 x y\n\
305 \n\
306 gsave\n\
307 1 index exch translate\n\
308 5 index 5 index true matrix tmpstip imagemask\n\
309 grestore\n\
310 } for\n\
311 pop\n\
312 } for\n\
313 pop pop pop pop pop\n\
314 } bind def\n\
315 \n\
316 % -- AdjustColor --\n\
317 % Given a color value already set for output by the caller, adjusts\n\
318 % that value to a grayscale or mono value if requested by the CL\n\
319 % variable.\n\
320 \n\
321 /AdjustColor {\n\
322 CL 2 lt {\n\
323 currentgray\n\
324 CL 0 eq {\n\
325 .5 lt {0} {1} ifelse\n\
326 } if\n\
327 setgray\n\
328 } if\n\
329 } bind def\n\
330 \n\
331 % x y strings spacing xoffset yoffset justify stipple DrawText --\n\
332 % This procedure does all of the real work of drawing text. The\n\
333 % color and font must already have been set by the caller, and the\n\
334 % following arguments must be on the stack:\n\
335 %\n\
336 % x, y - Coordinates at which to draw text.\n\
337 % strings - An array of strings, one for each line of the text item,\n\
338 % in order from top to bottom.\n\
339 % spacing - Spacing between lines.\n\
340 % xoffset - Horizontal offset for text bbox relative to x and y: 0 for\n\
341 % nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se.\n\
342 % yoffset - Vertical offset for text bbox relative to x and y: 0 for\n\
343 % nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se.\n\
344 % justify - 0 for left justification, 0.5 for center, 1 for right justify.\n\
345 % stipple - Boolean value indicating whether or not text is to be\n\
346 % drawn in stippled fashion. If text is stippled,\n\
347 % procedure StippleText must have been defined to call\n\
348 % StippleFill in the right way.\n\
349 %\n\
350 % Also, when this procedure is invoked, the color and font must already\n\
351 % have been set for the text.\n\
352 \n\
353 /DrawText {\n\
354 /stipple exch def\n\
355 /justify exch def\n\
356 /yoffset exch def\n\
357 /xoffset exch def\n\
358 /spacing exch def\n\
359 /strings exch def\n\
360 \n\
361 % First scan through all of the text to find the widest line.\n\
362 \n\
363 /lineLength 0 def\n\
364 strings {\n\
365 stringwidth pop\n\
366 dup lineLength gt {/lineLength exch def}",
367 /* End of part 4 */
368
369 /* Start of part 5 (1546 characters) */
370 " {pop} ifelse\n\
371 newpath\n\
372 } forall\n\
373 \n\
374 % Compute the baseline offset and the actual font height.\n\
375 \n\
376 0 0 moveto (TXygqPZ) false charpath\n\
377 pathbbox dup /baseline exch def\n\
378 exch pop exch sub /height exch def pop\n\
379 newpath\n\
380 \n\
381 % Translate coordinates first so that the origin is at the upper-left\n\
382 % corner of the text's bounding box. Remember that x and y for\n\
383 % positioning are still on the stack.\n\
384 \n\
385 translate\n\
386 lineLength xoffset mul\n\
387 strings length 1 sub spacing mul height add yoffset mul translate\n\
388 \n\
389 % Now use the baseline and justification information to translate so\n\
390 % that the origin is at the baseline and positioning point for the\n\
391 % first line of text.\n\
392 \n\
393 justify lineLength mul baseline neg translate\n\
394 \n\
395 % Iterate over each of the lines to output it. For each line,\n\
396 % compute its width again so it can be properly justified, then\n\
397 % display it.\n\
398 \n\
399 strings {\n\
400 dup stringwidth pop\n\
401 justify neg mul 0 moveto\n\
402 stipple {\n\
403 \n\
404 % The text is stippled, so turn it into a path and print\n\
405 % by calling StippledText, which in turn calls StippleFill.\n\
406 % Unfortunately, many Postscript interpreters will get\n\
407 % overflow errors if we try to do the whole string at\n\
408 % once, so do it a character at a time.\n\
409 \n\
410 gsave\n\
411 /char (X) def\n\
412 {\n\
413 char 0 3 -1 roll put\n\
414 currentpoint\n\
415 gsave\n\
416 char true charpath clip StippleText\n\
417 grestore\n\
418 char stringwidth translate\n\
419 moveto\n\
420 } forall\n\
421 grestore\n\
422 } {show} ifelse\n\
423 0 spacing neg translate\n\
424 } forall\n\
425 } bind def\n\
426 \n\
427 %%EndProlog\n\
428 ",
429 /* End of part 5 */
430
431 NULL /* End of data marker */
432 };
433
434 /*
435 * Forward declarations for procedures defined later in this file:
436 */
437
438 static int GetPostscriptPoints _ANSI_ARGS_((Tcl_Interp *interp,
439 char *string, double *doublePtr));
440
441 /*
442 *--------------------------------------------------------------
443 *
444 * TkCanvPostscriptCmd --
445 *
446 * This procedure is invoked to process the "postscript" options
447 * of the widget command for canvas widgets. See the user
448 * documentation for details on what it does.
449 *
450 * Results:
451 * A standard Tcl result.
452 *
453 * Side effects:
454 * See the user documentation.
455 *
456 *--------------------------------------------------------------
457 */
458
459 /* ARGSUSED */
460 int
461 TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
462 TkCanvas *canvasPtr; /* Information about canvas widget. */
463 Tcl_Interp *interp; /* Current interpreter. */
464 int argc; /* Number of arguments. */
465 char **argv; /* Argument strings. Caller has
466 * already parsed this command enough
467 * to know that argv[1] is
468 * "postscript". */
469 {
470 TkPostscriptInfo psInfo;
471 Tk_PostscriptInfo oldInfoPtr;
472 int result;
473 Tk_Item *itemPtr;
474 #define STRING_LENGTH 400
475 char string[STRING_LENGTH+1], *p;
476 time_t now;
477 size_t length;
478 Tk_Window tkwin = canvasPtr->tkwin;
479 int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of
480 * area to be marked up, measured
481 * in canvas units from the positioning
482 * point on the page (reflects
483 * anchor position). Initial values
484 * needed only to stop compiler
485 * warnings. */
486 Tcl_HashSearch search;
487 Tcl_HashEntry *hPtr;
488 Tcl_DString buffer;
489 CONST char * CONST *chunk;
490
491 /*
492 *----------------------------------------------------------------
493 * Initialize the data structure describing Postscript generation,
494 * then process all the arguments to fill the data structure in.
495 *----------------------------------------------------------------
496 */
497
498 oldInfoPtr = canvasPtr->psInfo;
499 canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo;
500 psInfo.x = canvasPtr->xOrigin;
501 psInfo.y = canvasPtr->yOrigin;
502 psInfo.width = -1;
503 psInfo.height = -1;
504 psInfo.pageXString = NULL;
505 psInfo.pageYString = NULL;
506 psInfo.pageX = 72*4.25;
507 psInfo.pageY = 72*5.5;
508 psInfo.pageWidthString = NULL;
509 psInfo.pageHeightString = NULL;
510 psInfo.scale = 1.0;
511 psInfo.pageAnchor = TK_ANCHOR_CENTER;
512 psInfo.rotate = 0;
513 psInfo.fontVar = NULL;
514 psInfo.colorVar = NULL;
515 psInfo.colorMode = NULL;
516 psInfo.colorLevel = 0;
517 psInfo.fileName = NULL;
518 psInfo.channelName = NULL;
519 psInfo.chan = NULL;
520 psInfo.prepass = 0;
521 psInfo.prolog = 1;
522 Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
523 result = Tk_ConfigureWidget(interp, tkwin,
524 configSpecs, argc-2, argv+2, (char *) &psInfo,
525 TK_CONFIG_ARGV_ONLY);
526 if (result != TCL_OK) {
527 goto cleanup;
528 }
529
530 if (psInfo.width == -1) {
531 psInfo.width = Tk_Width(tkwin);
532 }
533 if (psInfo.height == -1) {
534 psInfo.height = Tk_Height(tkwin);
535 }
536 psInfo.x2 = psInfo.x + psInfo.width;
537 psInfo.y2 = psInfo.y + psInfo.height;
538
539 if (psInfo.pageXString != NULL) {
540 if (GetPostscriptPoints(interp, psInfo.pageXString,
541 &psInfo.pageX) != TCL_OK) {
542 goto cleanup;
543 }
544 }
545 if (psInfo.pageYString != NULL) {
546 if (GetPostscriptPoints(interp, psInfo.pageYString,
547 &psInfo.pageY) != TCL_OK) {
548 goto cleanup;
549 }
550 }
551 if (psInfo.pageWidthString != NULL) {
552 if (GetPostscriptPoints(interp, psInfo.pageWidthString,
553 &psInfo.scale) != TCL_OK) {
554 goto cleanup;
555 }
556 psInfo.scale /= psInfo.width;
557 } else if (psInfo.pageHeightString != NULL) {
558 if (GetPostscriptPoints(interp, psInfo.pageHeightString,
559 &psInfo.scale) != TCL_OK) {
560 goto cleanup;
561 }
562 psInfo.scale /= psInfo.height;
563 } else {
564 psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin));
565 psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin));
566 }
567 switch (psInfo.pageAnchor) {
568 case TK_ANCHOR_NW:
569 case TK_ANCHOR_W:
570 case TK_ANCHOR_SW:
571 deltaX = 0;
572 break;
573 case TK_ANCHOR_N:
574 case TK_ANCHOR_CENTER:
575 case TK_ANCHOR_S:
576 deltaX = -psInfo.width/2;
577 break;
578 case TK_ANCHOR_NE:
579 case TK_ANCHOR_E:
580 case TK_ANCHOR_SE:
581 deltaX = -psInfo.width;
582 break;
583 }
584 switch (psInfo.pageAnchor) {
585 case TK_ANCHOR_NW:
586 case TK_ANCHOR_N:
587 case TK_ANCHOR_NE:
588 deltaY = - psInfo.height;
589 break;
590 case TK_ANCHOR_W:
591 case TK_ANCHOR_CENTER:
592 case TK_ANCHOR_E:
593 deltaY = -psInfo.height/2;
594 break;
595 case TK_ANCHOR_SW:
596 case TK_ANCHOR_S:
597 case TK_ANCHOR_SE:
598 deltaY = 0;
599 break;
600 }
601
602 if (psInfo.colorMode == NULL) {
603 psInfo.colorLevel = 2;
604 } else {
605 length = strlen(psInfo.colorMode);
606 if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
607 psInfo.colorLevel = 0;
608 } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
609 psInfo.colorLevel = 1;
610 } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
611 psInfo.colorLevel = 2;
612 } else {
613 Tcl_AppendResult(interp, "bad color mode \"",
614 psInfo.colorMode, "\": must be monochrome, ",
615 "gray, or color", (char *) NULL);
616 goto cleanup;
617 }
618 }
619
620 if (psInfo.fileName != NULL) {
621
622 /*
623 * Check that -file and -channel are not both specified.
624 */
625
626 if (psInfo.channelName != NULL) {
627 Tcl_AppendResult(interp, "can't specify both -file",
628 " and -channel", (char *) NULL);
629 result = TCL_ERROR;
630 goto cleanup;
631 }
632
633 /*
634 * Check that we are not in a safe interpreter. If we are, disallow
635 * the -file specification.
636 */
637
638 if (Tcl_IsSafe(interp)) {
639 Tcl_AppendResult(interp, "can't specify -file in a",
640 " safe interpreter", (char *) NULL);
641 result = TCL_ERROR;
642 goto cleanup;
643 }
644
645 p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
646 if (p == NULL) {
647 goto cleanup;
648 }
649 psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
650 Tcl_DStringFree(&buffer);
651 if (psInfo.chan == NULL) {
652 goto cleanup;
653 }
654 }
655
656 if (psInfo.channelName != NULL) {
657 int mode;
658
659 /*
660 * Check that the channel is found in this interpreter and that it
661 * is open for writing.
662 */
663
664 psInfo.chan = Tcl_GetChannel(interp, psInfo.channelName,
665 &mode);
666 if (psInfo.chan == (Tcl_Channel) NULL) {
667 result = TCL_ERROR;
668 goto cleanup;
669 }
670 if ((mode & TCL_WRITABLE) == 0) {
671 Tcl_AppendResult(interp, "channel \"",
672 psInfo.channelName, "\" wasn't opened for writing",
673 (char *) NULL);
674 result = TCL_ERROR;
675 goto cleanup;
676 }
677 }
678
679 /*
680 *--------------------------------------------------------
681 * Make a pre-pass over all of the items, generating Postscript
682 * and then throwing it away. The purpose of this pass is just
683 * to collect information about all the fonts in use, so that
684 * we can output font information in the proper form required
685 * by the Document Structuring Conventions.
686 *--------------------------------------------------------
687 */
688
689 psInfo.prepass = 1;
690 for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
691 itemPtr = itemPtr->nextPtr) {
692 if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
693 || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
694 continue;
695 }
696 if (itemPtr->typePtr->postscriptProc == NULL) {
697 continue;
698 }
699 result = (*itemPtr->typePtr->postscriptProc)(interp,
700 (Tk_Canvas) canvasPtr, itemPtr, 1);
701 Tcl_ResetResult(interp);
702 if (result != TCL_OK) {
703 /*
704 * An error just occurred. Just skip out of this loop.
705 * There's no need to report the error now; it can be
706 * reported later (errors can happen later that don't
707 * happen now, so we still have to check for errors later
708 * anyway).
709 */
710 break;
711 }
712 }
713 psInfo.prepass = 0;
714
715 /*
716 *--------------------------------------------------------
717 * Generate the header and prolog for the Postscript.
718 *--------------------------------------------------------
719 */
720
721 if (psInfo.prolog) {
722 Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
723 "%%Creator: Tk Canvas Widget\n", (char *) NULL);
724 #ifdef HAVE_PW_GECOS
725 if (!Tcl_IsSafe(interp)) {
726 struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
727 Tcl_AppendResult(interp, "%%For: ",
728 (pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
729 (char *) NULL);
730 endpwent();
731 }
732 #endif /* HAVE_PW_GECOS */
733 Tcl_AppendResult(interp, "%%Title: Window ",
734 Tk_PathName(tkwin), "\n", (char *) NULL);
735 time(&now);
736 Tcl_AppendResult(interp, "%%CreationDate: ",
737 ctime(&now), (char *) NULL); /* INTL: Native. */
738 if (!psInfo.rotate) {
739 sprintf(string, "%d %d %d %d",
740 (int) (psInfo.pageX + psInfo.scale*deltaX),
741 (int) (psInfo.pageY + psInfo.scale*deltaY),
742 (int) (psInfo.pageX + psInfo.scale*(deltaX + psInfo.width)
743 + 1.0),
744 (int) (psInfo.pageY + psInfo.scale*(deltaY + psInfo.height)
745 + 1.0));
746 } else {
747 sprintf(string, "%d %d %d %d",
748 (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
749 (int) (psInfo.pageY + psInfo.scale*deltaX),
750 (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
751 (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
752 + 1.0));
753 }
754 Tcl_AppendResult(interp, "%%BoundingBox: ", string,
755 "\n", (char *) NULL);
756 Tcl_AppendResult(interp, "%%Pages: 1\n",
757 "%%DocumentData: Clean7Bit\n", (char *) NULL);
758 Tcl_AppendResult(interp, "%%Orientation: ",
759 psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
760 p = "%%DocumentNeededResources: font ";
761 for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
762 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
763 Tcl_AppendResult(interp, p,
764 Tcl_GetHashKey(&psInfo.fontTable, hPtr),
765 "\n", (char *) NULL);
766 p = "%%+ font ";
767 }
768 Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL);
769
770 /*
771 * Insert the prolog
772 */
773 for (chunk=prolog; *chunk; chunk++) {
774 Tcl_AppendResult(interp, *chunk, (char *) NULL);
775 }
776
777 if (psInfo.chan != NULL) {
778 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
779 Tcl_ResetResult(canvasPtr->interp);
780 }
781
782 /*
783 *-----------------------------------------------------------
784 * Document setup: set the color level and include fonts.
785 *-----------------------------------------------------------
786 */
787
788 sprintf(string, "/CL %d def\n", psInfo.colorLevel);
789 Tcl_AppendResult(interp, "%%BeginSetup\n", string,
790 (char *) NULL);
791 for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
792 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
793 Tcl_AppendResult(interp, "%%IncludeResource: font ",
794 Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
795 }
796 Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL);
797
798 /*
799 *-----------------------------------------------------------
800 * Page setup: move to page positioning point, rotate if
801 * needed, set scale factor, offset for proper anchor position,
802 * and set clip region.
803 *-----------------------------------------------------------
804 */
805
806 Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n",
807 (char *) NULL);
808 sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
809 Tcl_AppendResult(interp, string, (char *) NULL);
810 if (psInfo.rotate) {
811 Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL);
812 }
813 sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
814 Tcl_AppendResult(interp, string, (char *) NULL);
815 sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
816 Tcl_AppendResult(interp, string, (char *) NULL);
817 sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
818 psInfo.x,
819 Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
820 psInfo.x2,
821 Tk_PostscriptY((double) psInfo.y, (Tk_PostscriptInfo) &psInfo),
822 psInfo.x2,
823 Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo),
824 psInfo.x,
825 Tk_PostscriptY((double) psInfo.y2, (Tk_PostscriptInfo) &psInfo));
826 Tcl_AppendResult(interp, string,
827 " lineto closepath clip newpath\n", (char *) NULL);
828 }
829 if (psInfo.chan != NULL) {
830 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
831 Tcl_ResetResult(canvasPtr->interp);
832 }
833
834 /*
835 *---------------------------------------------------------------------
836 * Iterate through all the items, having each relevant one draw itself.
837 * Quit if any of the items returns an error.
838 *---------------------------------------------------------------------
839 */
840
841 result = TCL_OK;
842 for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
843 itemPtr = itemPtr->nextPtr) {
844 if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
845 || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
846 continue;
847 }
848 if (itemPtr->typePtr->postscriptProc == NULL) {
849 continue;
850 }
851 if (itemPtr->state == TK_STATE_HIDDEN) {
852 continue;
853 }
854 Tcl_AppendResult(interp, "gsave\n", (char *) NULL);
855 result = (*itemPtr->typePtr->postscriptProc)(interp,
856 (Tk_Canvas) canvasPtr, itemPtr, 0);
857 if (result != TCL_OK) {
858 char msg[64 + TCL_INTEGER_SPACE];
859
860 sprintf(msg, "\n (generating Postscript for item %d)",
861 itemPtr->id);
862 Tcl_AddErrorInfo(interp, msg);
863 goto cleanup;
864 }
865 Tcl_AppendResult(interp, "grestore\n", (char *) NULL);
866 if (psInfo.chan != NULL) {
867 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
868 Tcl_ResetResult(interp);
869 }
870 }
871
872 /*
873 *---------------------------------------------------------------------
874 * Output page-end information, such as commands to print the page
875 * and document trailer stuff.
876 *---------------------------------------------------------------------
877 */
878
879 if (psInfo.prolog) {
880 Tcl_AppendResult(interp, "restore showpage\n\n",
881 "%%Trailer\nend\n%%EOF\n", (char *) NULL);
882 }
883 if (psInfo.chan != NULL) {
884 Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
885 Tcl_ResetResult(canvasPtr->interp);
886 }
887
888 /*
889 * Clean up psInfo to release malloc'ed stuff.
890 */
891
892 cleanup:
893 if (psInfo.pageXString != NULL) {
894 ckfree(psInfo.pageXString);
895 }
896 if (psInfo.pageYString != NULL) {
897 ckfree(psInfo.pageYString);
898 }
899 if (psInfo.pageWidthString != NULL) {
900 ckfree(psInfo.pageWidthString);
901 }
902 if (psInfo.pageHeightString != NULL) {
903 ckfree(psInfo.pageHeightString);
904 }
905 if (psInfo.fontVar != NULL) {
906 ckfree(psInfo.fontVar);
907 }
908 if (psInfo.colorVar != NULL) {
909 ckfree(psInfo.colorVar);
910 }
911 if (psInfo.colorMode != NULL) {
912 ckfree(psInfo.colorMode);
913 }
914 if (psInfo.fileName != NULL) {
915 ckfree(psInfo.fileName);
916 }
917 if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
918 Tcl_Close(interp, psInfo.chan);
919 }
920 if (psInfo.channelName != NULL) {
921 ckfree(psInfo.channelName);
922 }
923 Tcl_DeleteHashTable(&psInfo.fontTable);
924 canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
925 return result;
926 }
927
928 /*
929 *--------------------------------------------------------------
930 *
931 * Tk_PostscriptColor --
932 *
933 * This procedure is called by individual canvas items when
934 * they want to set a color value for output. Given information
935 * about an X color, this procedure will generate Postscript
936 * commands to set up an appropriate color in Postscript.
937 *
938 * Results:
939 * Returns a standard Tcl return value. If an error occurs
940 * then an error message will be left in the interp's result.
941 * If no error occurs, then additional Postscript will be
942 * appended to the interp's result.
943 *
944 * Side effects:
945 * None.
946 *
947 *--------------------------------------------------------------
948 */
949
950 int
951 Tk_PostscriptColor(interp, psInfo, colorPtr)
952 Tcl_Interp *interp;
953 Tk_PostscriptInfo psInfo; /* Postscript info. */
954 XColor *colorPtr; /* Information about color. */
955 {
956 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
957 int tmp;
958 double red, green, blue;
959 char string[200];
960
961 if (psInfoPtr->prepass) {
962 return TCL_OK;
963 }
964
965 /*
966 * If there is a color map defined, then look up the color's name
967 * in the map and use the Postscript commands found there, if there
968 * are any.
969 */
970
971 if (psInfoPtr->colorVar != NULL) {
972 char *cmdString;
973
974 cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
975 Tk_NameOfColor(colorPtr), 0);
976 if (cmdString != NULL) {
977 Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
978 return TCL_OK;
979 }
980 }
981
982 /*
983 * No color map entry for this color. Grab the color's intensities
984 * and output Postscript commands for them. Special note: X uses
985 * a range of 0-65535 for intensities, but most displays only use
986 * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
987 * X scale. This means that there's no way to get perfect white,
988 * since the highest intensity is only 65280 out of 65535. To
989 * work around this problem, rescale the X intensity to a 0-255
990 * scale and use that as the basis for the Postscript colors. This
991 * scheme still won't work if the display only uses 4 bits per color,
992 * but most diplays use at least 8 bits.
993 */
994
995 tmp = colorPtr->red;
996 red = ((double) (tmp >> 8))/255.0;
997 tmp = colorPtr->green;
998 green = ((double) (tmp >> 8))/255.0;
999 tmp = colorPtr->blue;
1000 blue = ((double) (tmp >> 8))/255.0;
1001 sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
1002 red, green, blue);
1003 Tcl_AppendResult(interp, string, (char *) NULL);
1004 return TCL_OK;
1005 }
1006
1007 /*
1008 *--------------------------------------------------------------
1009 *
1010 * Tk_PostscriptFont --
1011 *
1012 * This procedure is called by individual canvas items when
1013 * they want to output text. Given information about an X
1014 * font, this procedure will generate Postscript commands
1015 * to set up an appropriate font in Postscript.
1016 *
1017 * Results:
1018 * Returns a standard Tcl return value. If an error occurs
1019 * then an error message will be left in the interp's result.
1020 * If no error occurs, then additional Postscript will be
1021 * appended to the interp's result.
1022 *
1023 * Side effects:
1024 * The Postscript font name is entered into psInfoPtr->fontTable
1025 * if it wasn't already there.
1026 *
1027 *--------------------------------------------------------------
1028 */
1029
1030 int
1031 Tk_PostscriptFont(interp, psInfo, tkfont)
1032 Tcl_Interp *interp;
1033 Tk_PostscriptInfo psInfo; /* Postscript Info. */
1034 Tk_Font tkfont; /* Information about font in which text
1035 * is to be printed. */
1036 {
1037 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1038 char *end;
1039 char pointString[TCL_INTEGER_SPACE];
1040 Tcl_DString ds;
1041 int i, points;
1042
1043 /*
1044 * First, look up the font's name in the font map, if there is one.
1045 * If there is an entry for this font, it consists of a list
1046 * containing font name and size. Use this information.
1047 */
1048
1049 Tcl_DStringInit(&ds);
1050
1051 if (psInfoPtr->fontVar != NULL) {
1052 char *list, **argv;
1053 int argc;
1054 double size;
1055 char *name;
1056
1057 name = Tk_NameOfFont(tkfont);
1058 list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
1059 if (list != NULL) {
1060 if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
1061 badMapEntry:
1062 Tcl_ResetResult(interp);
1063 Tcl_AppendResult(interp, "bad font map entry for \"", name,
1064 "\": \"", list, "\"", (char *) NULL);
1065 return TCL_ERROR;
1066 }
1067 if (argc != 2) {
1068 goto badMapEntry;
1069 }
1070 size = strtod(argv[1], &end);
1071 if ((size <= 0) || (*end != 0)) {
1072 goto badMapEntry;
1073 }
1074
1075 Tcl_DStringAppend(&ds, argv[0], -1);
1076 points = (int) size;
1077
1078 ckfree((char *) argv);
1079 goto findfont;
1080 }
1081 }
1082
1083 points = Tk_PostscriptFontName(tkfont, &ds);
1084
1085 findfont:
1086 sprintf(pointString, "%d", points);
1087 Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
1088 pointString, " scalefont ", (char *) NULL);
1089 if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
1090 Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
1091 }
1092 Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
1093 Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
1094 Tcl_DStringFree(&ds);
1095
1096 return TCL_OK;
1097 }
1098
1099 /*
1100 *--------------------------------------------------------------
1101 *
1102 * Tk_PostscriptBitmap --
1103 *
1104 * This procedure is called to output the contents of a
1105 * sub-region of a bitmap in proper image data format for
1106 * Postscript (i.e. data between angle brackets, one bit
1107 * per pixel).
1108 *
1109 * Results:
1110 * Returns a standard Tcl return value. If an error occurs
1111 * then an error message will be left in the interp's result.
1112 * If no error occurs, then additional Postscript will be
1113 * appended to the interp's result.
1114 *
1115 * Side effects:
1116 * None.
1117 *
1118 *--------------------------------------------------------------
1119 */
1120
1121 int
1122 Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, startX, startY, width,
1123 height)
1124 Tcl_Interp *interp;
1125 Tk_Window tkwin;
1126 Tk_PostscriptInfo psInfo; /* Postscript info. */
1127 Pixmap bitmap; /* Bitmap for which to generate
1128 * Postscript. */
1129 int startX, startY; /* Coordinates of upper-left corner
1130 * of rectangular region to output. */
1131 int width, height; /* Height of rectangular region. */
1132 {
1133 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1134 XImage *imagePtr;
1135 int charsInLine, x, y, lastX, lastY, value, mask;
1136 unsigned int totalWidth, totalHeight;
1137 char string[100];
1138 Window dummyRoot;
1139 int dummyX, dummyY;
1140 unsigned dummyBorderwidth, dummyDepth;
1141
1142 if (psInfoPtr->prepass) {
1143 return TCL_OK;
1144 }
1145
1146 /*
1147 * The following call should probably be a call to Tk_SizeOfBitmap
1148 * instead, but it seems that we are occasionally invoked by custom
1149 * item types that create their own bitmaps without registering them
1150 * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
1151 * it shouldn't matter here.
1152 */
1153
1154 XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
1155 (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
1156 (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
1157 imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0,
1158 totalWidth, totalHeight, 1, XYPixmap);
1159 Tcl_AppendResult(interp, "<", (char *) NULL);
1160 mask = 0x80;
1161 value = 0;
1162 charsInLine = 0;
1163 lastX = startX + width - 1;
1164 lastY = startY + height - 1;
1165 for (y = lastY; y >= startY; y--) {
1166 for (x = startX; x <= lastX; x++) {
1167 if (XGetPixel(imagePtr, x, y)) {
1168 value |= mask;
1169 }
1170 mask >>= 1;
1171 if (mask == 0) {
1172 sprintf(string, "%02x", value);
1173 Tcl_AppendResult(interp, string, (char *) NULL);
1174 mask = 0x80;
1175 value = 0;
1176 charsInLine += 2;
1177 if (charsInLine >= 60) {
1178 Tcl_AppendResult(interp, "\n", (char *) NULL);
1179 charsInLine = 0;
1180 }
1181 }
1182 }
1183 if (mask != 0x80) {
1184 sprintf(string, "%02x", value);
1185 Tcl_AppendResult(interp, string, (char *) NULL);
1186 mask = 0x80;
1187 value = 0;
1188 charsInLine += 2;
1189 }
1190 }
1191 Tcl_AppendResult(interp, ">", (char *) NULL);
1192 XDestroyImage(imagePtr);
1193 return TCL_OK;
1194 }
1195
1196 /*
1197 *--------------------------------------------------------------
1198 *
1199 * Tk_PostscriptStipple --
1200 *
1201 * This procedure is called by individual canvas items when
1202 * they have created a path that they'd like to be filled with
1203 * a stipple pattern. Given information about an X bitmap,
1204 * this procedure will generate Postscript commands to fill
1205 * the current clip region using a stipple pattern defined by the
1206 * bitmap.
1207 *
1208 * Results:
1209 * Returns a standard Tcl return value. If an error occurs
1210 * then an error message will be left in the interp's result.
1211 * If no error occurs, then additional Postscript will be
1212 * appended to the interp's result.
1213 *
1214 * Side effects:
1215 * None.
1216 *
1217 *--------------------------------------------------------------
1218 */
1219
1220 int
1221 Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap)
1222 Tcl_Interp *interp;
1223 Tk_Window tkwin;
1224 Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript
1225 * or error message. */
1226 Pixmap bitmap; /* Bitmap to use for stippling. */
1227 {
1228 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1229 int width, height;
1230 char string[TCL_INTEGER_SPACE * 2];
1231 Window dummyRoot;
1232 int dummyX, dummyY;
1233 unsigned dummyBorderwidth, dummyDepth;
1234
1235 if (psInfoPtr->prepass) {
1236 return TCL_OK;
1237 }
1238
1239 /*
1240 * The following call should probably be a call to Tk_SizeOfBitmap
1241 * instead, but it seems that we are occasionally invoked by custom
1242 * item types that create their own bitmaps without registering them
1243 * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
1244 * it shouldn't matter here.
1245 */
1246
1247 XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
1248 (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
1249 (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
1250 sprintf(string, "%d %d ", width, height);
1251 Tcl_AppendResult(interp, string, (char *) NULL);
1252 if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0,
1253 width, height) != TCL_OK) {
1254 return TCL_ERROR;
1255 }
1256 Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
1257 return TCL_OK;
1258 }
1259
1260 /*
1261 *--------------------------------------------------------------
1262 *
1263 * Tk_PostscriptY --
1264 *
1265 * Given a y-coordinate in local coordinates, this procedure
1266 * returns a y-coordinate to use for Postscript output.
1267 *
1268 * Results:
1269 * Returns the Postscript coordinate that corresponds to
1270 * "y".
1271 *
1272 * Side effects:
1273 * None.
1274 *
1275 *--------------------------------------------------------------
1276 */
1277
1278 double
1279 Tk_PostscriptY(y, psInfo)
1280 double y; /* Y-coordinate in canvas coords. */
1281 Tk_PostscriptInfo psInfo; /* Postscript info */
1282 {
1283 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1284
1285 return psInfoPtr->y2 - y;
1286 }
1287
1288 /*
1289 *--------------------------------------------------------------
1290 *
1291 * Tk_PostscriptPath --
1292 *
1293 * Given an array of points for a path, generate Postscript
1294 * commands to create the path.
1295 *
1296 * Results:
1297 * Postscript commands get appended to what's in the interp's result.
1298 *
1299 * Side effects:
1300 * None.
1301 *
1302 *--------------------------------------------------------------
1303 */
1304
1305 void
1306 Tk_PostscriptPath(interp, psInfo, coordPtr, numPoints)
1307 Tcl_Interp *interp;
1308 Tk_PostscriptInfo psInfo; /* Canvas on whose behalf Postscript
1309 * is being generated. */
1310 double *coordPtr; /* Pointer to first in array of
1311 * 2*numPoints coordinates giving
1312 * points for path. */
1313 int numPoints; /* Number of points at *coordPtr. */
1314 {
1315 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1316 char buffer[200];
1317
1318 if (psInfoPtr->prepass) {
1319 return;
1320 }
1321 sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
1322 Tk_PostscriptY(coordPtr[1], psInfo));
1323 Tcl_AppendResult(interp, buffer, (char *) NULL);
1324 for (numPoints--, coordPtr += 2; numPoints > 0;
1325 numPoints--, coordPtr += 2) {
1326 sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
1327 Tk_PostscriptY(coordPtr[1], psInfo));
1328 Tcl_AppendResult(interp, buffer, (char *) NULL);
1329 }
1330 }
1331
1332 /*
1333 *--------------------------------------------------------------
1334 *
1335 * GetPostscriptPoints --
1336 *
1337 * Given a string, returns the number of Postscript points
1338 * corresponding to that string.
1339 *
1340 * Results:
1341 * The return value is a standard Tcl return result. If
1342 * TCL_OK is returned, then everything went well and the
1343 * screen distance is stored at *doublePtr; otherwise
1344 * TCL_ERROR is returned and an error message is left in
1345 * the interp's result.
1346 *
1347 * Side effects:
1348 * None.
1349 *
1350 *--------------------------------------------------------------
1351 */
1352
1353 static int
1354 GetPostscriptPoints(interp, string, doublePtr)
1355 Tcl_Interp *interp; /* Use this for error reporting. */
1356 char *string; /* String describing a screen distance. */
1357 double *doublePtr; /* Place to store converted result. */
1358 {
1359 char *end;
1360 double d;
1361
1362 d = strtod(string, &end);
1363 if (end == string) {
1364 error:
1365 Tcl_AppendResult(interp, "bad distance \"", string,
1366 "\"", (char *) NULL);
1367 return TCL_ERROR;
1368 }
1369 while ((*end != '\0') && isspace(UCHAR(*end))) {
1370 end++;
1371 }
1372 switch (*end) {
1373 case 'c':
1374 d *= 72.0/2.54;
1375 end++;
1376 break;
1377 case 'i':
1378 d *= 72.0;
1379 end++;
1380 break;
1381 case 'm':
1382 d *= 72.0/25.4;
1383 end++;
1384 break;
1385 case 0:
1386 break;
1387 case 'p':
1388 end++;
1389 break;
1390 default:
1391 goto error;
1392 }
1393 while ((*end != '\0') && isspace(UCHAR(*end))) {
1394 end++;
1395 }
1396 if (*end != 0) {
1397 goto error;
1398 }
1399 *doublePtr = d;
1400 return TCL_OK;
1401 }
1402
1403 /*
1404 *--------------------------------------------------------------
1405 *
1406 * TkImageGetColor --
1407 *
1408 * This procedure converts a pixel value to three floating
1409 * point numbers, representing the amount of red, green, and
1410 * blue in that pixel on the screen. It makes use of colormap
1411 * data passed as an argument, and should work for all Visual
1412 * types.
1413 *
1414 * Results:
1415 * Returns red, green, and blue color values in the range
1416 * 0 to 1. There are no error returns.
1417 *
1418 * Side effects:
1419 * None.
1420 *
1421 *--------------------------------------------------------------
1422 */
1423
1424 static void
1425 TkImageGetColor(cdata, pixel, red, green, blue)
1426 TkColormapData *cdata; /* Colormap data */
1427 unsigned long pixel; /* Pixel value to look up */
1428 double *red, *green, *blue; /* Color data to return */
1429 {
1430 if (cdata->separated) {
1431 int r = (pixel & cdata->red_mask) >> cdata->red_shift;
1432 int g = (pixel & cdata->green_mask) >> cdata->green_shift;
1433 int b = (pixel & cdata->blue_mask) >> cdata->blue_shift;
1434 *red = cdata->colors[r].red / 65535.0;
1435 *green = cdata->colors[g].green / 65535.0;
1436 *blue = cdata->colors[b].blue / 65535.0;
1437 } else {
1438 *red = cdata->colors[pixel].red / 65535.0;
1439 *green = cdata->colors[pixel].green / 65535.0;
1440 *blue = cdata->colors[pixel].blue / 65535.0;
1441 }
1442 }
1443
1444 /*
1445 *--------------------------------------------------------------
1446 *
1447 * TkPostscriptImage --
1448 *
1449 * This procedure is called to output the contents of an
1450 * image in Postscript, using a format appropriate for the
1451 * current color mode (i.e. one bit per pixel in monochrome,
1452 * one byte per pixel in gray, and three bytes per pixel in
1453 * color).
1454 *
1455 * Results:
1456 * Returns a standard Tcl return value. If an error occurs
1457 * then an error message will be left in interp->result.
1458 * If no error occurs, then additional Postscript will be
1459 * appended to interp->result.
1460 *
1461 * Side effects:
1462 * None.
1463 *
1464 *--------------------------------------------------------------
1465 */
1466
1467 int
1468 TkPostscriptImage(interp, tkwin, psInfo, ximage, x, y, width, height)
1469 Tcl_Interp *interp;
1470 Tk_Window tkwin;
1471 Tk_PostscriptInfo psInfo; /* postscript info */
1472 XImage *ximage; /* Image to draw */
1473 int x, y; /* First pixel to output */
1474 int width, height; /* Width and height of area */
1475 {
1476 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1477 char buffer[256];
1478 int xx, yy, band, maxRows;
1479 double red, green, blue;
1480 int bytesPerLine=0, maxWidth=0;
1481 int level = psInfoPtr->colorLevel;
1482 Colormap cmap;
1483 int i, depth, ncolors;
1484 Visual *visual;
1485 TkColormapData cdata;
1486
1487 if (psInfoPtr->prepass) {
1488 return TCL_OK;
1489 }
1490
1491 cmap = Tk_Colormap(tkwin);
1492 depth = Tk_Depth(tkwin);
1493 visual = Tk_Visual(tkwin);
1494
1495 /*
1496 * Obtain information about the colormap, ie the mapping between
1497 * pixel values and RGB values. The code below should work
1498 * for all Visual types.
1499 */
1500
1501 ncolors = visual->map_entries;
1502 cdata.colors = (XColor *) ckalloc(sizeof(XColor) * ncolors);
1503 cdata.ncolors = ncolors;
1504
1505 if (visual->class == DirectColor || visual->class == TrueColor) {
1506 cdata.separated = 1;
1507 cdata.red_mask = visual->red_mask;
1508 cdata.green_mask = visual->green_mask;
1509 cdata.blue_mask = visual->blue_mask;
1510 cdata.red_shift = 0;
1511 cdata.green_shift = 0;
1512 cdata.blue_shift = 0;
1513 while ((0x0001 & (cdata.red_mask >> cdata.red_shift)) == 0)
1514 cdata.red_shift ++;
1515 while ((0x0001 & (cdata.green_mask >> cdata.green_shift)) == 0)
1516 cdata.green_shift ++;
1517 while ((0x0001 & (cdata.blue_mask >> cdata.blue_shift)) == 0)
1518 cdata.blue_shift ++;
1519 for (i = 0; i < ncolors; i ++)
1520 cdata.colors[i].pixel =
1521 ((i << cdata.red_shift) & cdata.red_mask) |
1522 ((i << cdata.green_shift) & cdata.green_mask) |
1523 ((i << cdata.blue_shift) & cdata.blue_mask);
1524 } else {
1525 cdata.separated=0;
1526 for (i = 0; i < ncolors; i ++)
1527 cdata.colors[i].pixel = i;
1528 }
1529 if (visual->class == StaticGray || visual->class == GrayScale)
1530 cdata.color = 0;
1531 else
1532 cdata.color = 1;
1533
1534
1535 XQueryColors(Tk_Display(tkwin), cmap, cdata.colors, ncolors);
1536
1537 /*
1538 * Figure out which color level to use (possibly lower than the
1539 * one specified by the user). For example, if the user specifies
1540 * color with monochrome screen, use gray or monochrome mode instead.
1541 */
1542
1543 if (!cdata.color && level == 2) {
1544 level = 1;
1545 }
1546
1547 if (!cdata.color && cdata.ncolors == 2) {
1548 level = 0;
1549 }
1550
1551 /*
1552 * Check that at least one row of the image can be represented
1553 * with a string less than 64 KB long (this is a limit in the
1554 * Postscript interpreter).
1555 */
1556
1557 switch (level)
1558 {
1559 case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
1560 case 1: bytesPerLine = width; maxWidth = 60000; break;
1561 case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
1562 }
1563
1564 if (bytesPerLine > 60000) {
1565 Tcl_ResetResult(interp);
1566 sprintf(buffer,
1567 "Can't generate Postscript for images more than %d pixels wide",
1568 maxWidth);
1569 Tcl_AppendResult(interp, buffer, (char *) NULL);
1570 ckfree((char *) cdata.colors);
1571 return TCL_ERROR;
1572 }
1573
1574 maxRows = 60000 / bytesPerLine;
1575
1576 for (band = height-1; band >= 0; band -= maxRows) {
1577 int rows = (band >= maxRows) ? maxRows : band + 1;
1578 int lineLen = 0;
1579 switch (level) {
1580 case 0:
1581 sprintf(buffer, "%d %d 1 matrix {\n<", width, rows);
1582 Tcl_AppendResult(interp, buffer, (char *) NULL);
1583 break;
1584 case 1:
1585 sprintf(buffer, "%d %d 8 matrix {\n<", width, rows);
1586 Tcl_AppendResult(interp, buffer, (char *) NULL);
1587 break;
1588 case 2:
1589 sprintf(buffer, "%d %d 8 matrix {\n<",
1590 width, rows);
1591 Tcl_AppendResult(interp, buffer, (char *) NULL);
1592 break;
1593 }
1594 for (yy = band; yy > band - rows; yy--) {
1595 switch (level) {
1596 case 0: {
1597 /*
1598 * Generate data for image in monochrome mode.
1599 * No attempt at dithering is made--instead, just
1600 * set a threshold.
1601 */
1602 unsigned char mask=0x80;
1603 unsigned char data=0x00;
1604 for (xx = x; xx< x+width; xx++) {
1605 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
1606 &red, &green, &blue);
1607 if (0.30 * red + 0.59 * green + 0.11 * blue > 0.5)
1608 data |= mask;
1609 mask >>= 1;
1610 if (mask == 0) {
1611 sprintf(buffer, "%02X", data);
1612 Tcl_AppendResult(interp, buffer, (char *) NULL);
1613 lineLen += 2;
1614 if (lineLen > 60) {
1615 lineLen = 0;
1616 Tcl_AppendResult(interp, "\n", (char *) NULL);
1617 }
1618 mask=0x80;
1619 data=0x00;
1620 }
1621 }
1622 if ((width % 8) != 0) {
1623 sprintf(buffer, "%02X", data);
1624 Tcl_AppendResult(interp, buffer, (char *) NULL);
1625 mask=0x80;
1626 data=0x00;
1627 }
1628 break;
1629 }
1630 case 1: {
1631 /*
1632 * Generate data in gray mode--in this case, take a
1633 * weighted sum of the red, green, and blue values.
1634 */
1635 for (xx = x; xx < x+width; xx ++) {
1636 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
1637 &red, &green, &blue);
1638 sprintf(buffer, "%02X", (int) floor(0.5 + 255.0 *
1639 (0.30 * red +
1640 0.59 * green +
1641 0.11 * blue)));
1642 Tcl_AppendResult(interp, buffer, (char *) NULL);
1643 lineLen += 2;
1644 if (lineLen > 60) {
1645 lineLen = 0;
1646 Tcl_AppendResult(interp, "\n", (char *) NULL);
1647 }
1648 }
1649 break;
1650 }
1651 case 2: {
1652 /*
1653 * Finally, color mode. Here, just output the red, green,
1654 * and blue values directly.
1655 */
1656 for (xx = x; xx < x+width; xx++) {
1657 TkImageGetColor(&cdata, XGetPixel(ximage, xx, yy),
1658 &red, &green, &blue);
1659 sprintf(buffer, "%02X%02X%02X",
1660 (int) floor(0.5 + 255.0 * red),
1661 (int) floor(0.5 + 255.0 * green),
1662 (int) floor(0.5 + 255.0 * blue));
1663 Tcl_AppendResult(interp, buffer, (char *) NULL);
1664 lineLen += 6;
1665 if (lineLen > 60) {
1666 lineLen = 0;
1667 Tcl_AppendResult(interp, "\n", (char *) NULL);
1668 }
1669 }
1670 break;
1671 }
1672 }
1673 }
1674 switch (level) {
1675 case 0: sprintf(buffer, ">\n} image\n"); break;
1676 case 1: sprintf(buffer, ">\n} image\n"); break;
1677 case 2: sprintf(buffer, ">\n} false 3 colorimage\n"); break;
1678 }
1679 Tcl_AppendResult(interp, buffer, (char *) NULL);
1680 sprintf(buffer, "0 %d translate\n", rows);
1681 Tcl_AppendResult(interp, buffer, (char *) NULL);
1682 }
1683 ckfree((char *) cdata.colors);
1684 return TCL_OK;
1685 }
1686
1687 /*
1688 *--------------------------------------------------------------
1689 *
1690 * Tk_PostscriptPhoto --
1691 *
1692 * This procedure is called to output the contents of a
1693 * photo image in Postscript, using a format appropriate for
1694 * the requested postscript color mode (i.e. one byte per pixel
1695 * in gray, and three bytes per pixel in color).
1696 *
1697 * Results:
1698 * Returns a standard Tcl return value. If an error occurs
1699 * then an error message will be left in interp->result.
1700 * If no error occurs, then additional Postscript will be
1701 * appended to the interpreter's result.
1702 *
1703 * Side effects:
1704 * None.
1705 *
1706 *--------------------------------------------------------------
1707 */
1708 int
1709 Tk_PostscriptPhoto(interp, blockPtr, psInfo, width, height)
1710 Tcl_Interp *interp;
1711 Tk_PhotoImageBlock *blockPtr;
1712 Tk_PostscriptInfo psInfo;
1713 int width, height;
1714 {
1715 TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
1716 int colorLevel = psInfoPtr->colorLevel;
1717 static int codeIncluded = 0;
1718
1719 unsigned char *pixelPtr;
1720 char buffer[256], cspace[40], decode[40];
1721 int bpc;
1722 int xx, yy, lineLen;
1723 float red, green, blue;
1724 int alpha;
1725 int bytesPerLine=0, maxWidth=0;
1726
1727 unsigned char opaque = 255;
1728 unsigned char *alphaPtr;
1729 int alphaOffset, alphaPitch, alphaIncr;
1730
1731 if (psInfoPtr->prepass) {
1732 codeIncluded = 0;
1733 return TCL_OK;
1734 }
1735
1736 /*
1737 * Define the "TkPhoto" function, which is a modified version
1738 * of the original "transparentimage" function posted
1739 * by ian@five-d.com (Ian Kemmish) to comp.lang.postscript.
1740 * For a monochrome colorLevel this is a slightly different
1741 * version that uses the imagemask command instead of image.
1742 */
1743
1744 if( !codeIncluded && (colorLevel != 0) ) {
1745 /*
1746 * Color and gray-scale code.
1747 */
1748
1749 codeIncluded = !0;
1750 Tcl_AppendResult( interp,
1751 "/TkPhoto { \n",
1752 " gsave \n",
1753 " 32 dict begin \n",
1754 " /tinteger exch def \n",
1755 " /transparent 1 string def \n",
1756 " transparent 0 tinteger put \n",
1757 " /olddict exch def \n",
1758 " olddict /DataSource get dup type /filetype ne { \n",
1759 " olddict /DataSource 3 -1 roll \n",
1760 " 0 () /SubFileDecode filter put \n",
1761 " } { \n",
1762 " pop \n",
1763 " } ifelse \n",
1764 " /newdict olddict maxlength dict def \n",
1765 " olddict newdict copy pop \n",
1766 " /w newdict /Width get def \n",
1767 " /crpp newdict /Decode get length 2 idiv def \n",
1768 " /str w string def \n",
1769 " /pix w crpp mul string def \n",
1770 " /substrlen 2 w log 2 log div floor exp cvi def \n",
1771 " /substrs [ \n",
1772 " { \n",
1773 " substrlen string \n",
1774 " 0 1 substrlen 1 sub { \n",
1775 " 1 index exch tinteger put \n",
1776 " } for \n",
1777 " /substrlen substrlen 2 idiv def \n",
1778 " substrlen 0 eq {exit} if \n",
1779 " } loop \n",
1780 " ] def \n",
1781 " /h newdict /Height get def \n",
1782 " 1 w div 1 h div matrix scale \n",
1783 " olddict /ImageMatrix get exch matrix concatmatrix \n",
1784 " matrix invertmatrix concat \n",
1785 " newdict /Height 1 put \n",
1786 " newdict /DataSource pix put \n",
1787 " /mat [w 0 0 h 0 0] def \n",
1788 " newdict /ImageMatrix mat put \n",
1789 " 0 1 h 1 sub { \n",
1790 " mat 5 3 -1 roll neg put \n",
1791 " olddict /DataSource get str readstring pop pop \n",
1792 " /tail str def \n",
1793 " /x 0 def \n",
1794 " olddict /DataSource get pix readstring pop pop \n",
1795 " { \n",
1796 " tail transparent search dup /done exch not def \n",
1797 " {exch pop exch pop} if \n",
1798 " /w1 exch length def \n",
1799 " w1 0 ne { \n",
1800 " newdict /DataSource ",
1801 " pix x crpp mul w1 crpp mul getinterval put \n",
1802 " newdict /Width w1 put \n",
1803 " mat 4 x neg put \n",
1804 " /x x w1 add def \n",
1805 " newdict image \n",
1806 " /tail tail w1 tail length w1 sub getinterval def \n",
1807 " } if \n",
1808 " done {exit} if \n",
1809 " tail substrs { \n",
1810 " anchorsearch {pop} if \n",
1811 " } forall \n",
1812 " /tail exch def \n",
1813 " tail length 0 eq {exit} if \n",
1814 " /x w tail length sub def \n",
1815 " } loop \n",
1816 " } for \n",
1817 " end \n",
1818 " grestore \n",
1819 "} bind def \n\n\n", (char *) NULL);
1820 } else if( !codeIncluded && (colorLevel == 0) ) {
1821 /*
1822 * Monochrome-only code
1823 */
1824
1825 codeIncluded = !0;
1826 Tcl_AppendResult( interp,
1827 "/TkPhoto { \n",
1828 " gsave \n",
1829 " 32 dict begin \n",
1830 " /dummyInteger exch def \n",
1831 " /olddict exch def \n",
1832 " olddict /DataSource get dup type /filetype ne { \n",
1833 " olddict /DataSource 3 -1 roll \n",
1834 " 0 () /SubFileDecode filter put \n",
1835 " } { \n",
1836 " pop \n",
1837 " } ifelse \n",
1838 " /newdict olddict maxlength dict def \n",
1839 " olddict newdict copy pop \n",
1840 " /w newdict /Width get def \n",
1841 " /pix w 7 add 8 idiv string def \n",
1842 " /h newdict /Height get def \n",
1843 " 1 w div 1 h div matrix scale \n",
1844 " olddict /ImageMatrix get exch matrix concatmatrix \n",
1845 " matrix invertmatrix concat \n",
1846 " newdict /Height 1 put \n",
1847 " newdict /DataSource pix put \n",
1848 " /mat [w 0 0 h 0 0] def \n",
1849 " newdict /ImageMatrix mat put \n",
1850 " 0 1 h 1 sub { \n",
1851 " mat 5 3 -1 roll neg put \n",
1852 " 0.000 0.000 0.000 setrgbcolor \n",
1853 " olddict /DataSource get pix readstring pop pop \n",
1854 " newdict /DataSource pix put \n",
1855 " newdict imagemask \n",
1856 " 1.000 1.000 1.000 setrgbcolor \n",
1857 " olddict /DataSource get pix readstring pop pop \n",
1858 " newdict /DataSource pix put \n",
1859 " newdict imagemask \n",
1860 " } for \n",
1861 " end \n",
1862 " grestore \n",
1863 "} bind def \n\n\n", (char *) NULL);
1864 }
1865
1866 /*
1867 * Check that at least one row of the image can be represented
1868 * with a string less than 64 KB long (this is a limit in the
1869 * Postscript interpreter).
1870 */
1871
1872 switch (colorLevel)
1873 {
1874 case 0: bytesPerLine = (width + 7) / 8; maxWidth = 240000; break;
1875 case 1: bytesPerLine = width; maxWidth = 60000; break;
1876 case 2: bytesPerLine = 3 * width; maxWidth = 20000; break;
1877 }
1878 if (bytesPerLine > 60000) {
1879 Tcl_ResetResult(interp);
1880 sprintf(buffer,
1881 "Can't generate Postscript for images more than %d pixels wide",
1882 maxWidth);
1883 Tcl_AppendResult(interp, buffer, (char *) NULL);
1884 return TCL_ERROR;
1885 }
1886
1887 /*
1888 * Set up the postscript code except for the image-data stream.
1889 */
1890
1891 switch (colorLevel) {
1892 case 0:
1893 strcpy( cspace, "/DeviceGray");
1894 strcpy( decode, "[1 0]");
1895 bpc = 1;
1896 break;
1897 case 1:
1898 strcpy( cspace, "/DeviceGray");
1899 strcpy( decode, "[0 1]");
1900 bpc = 8;
1901 break;
1902 default:
1903 strcpy( cspace, "/DeviceRGB");
1904 strcpy( decode, "[0 1 0 1 0 1]");
1905 bpc = 8;
1906 break;
1907 }
1908
1909
1910 Tcl_AppendResult(interp,
1911 cspace, " setcolorspace\n\n", (char *) NULL);
1912
1913 sprintf(buffer,
1914 " /Width %d\n /Height %d\n /BitsPerComponent %d\n",
1915 width, height, bpc);
1916 Tcl_AppendResult(interp,
1917 "<<\n /ImageType 1\n", buffer,
1918 " /DataSource currentfile",
1919 " /ASCIIHexDecode filter\n", (char *) NULL);
1920
1921
1922 sprintf(buffer,
1923 " /ImageMatrix [1 0 0 -1 0 %d]\n", height);
1924 Tcl_AppendResult(interp, buffer,
1925 " /Decode ", decode, "\n>>\n1 TkPhoto\n", (char *) NULL);
1926
1927
1928 /*
1929 * Check the PhotoImageBlock information.
1930 * We assume that:
1931 * if pixelSize is 1,2 or 4, the image is R,G,B,A;
1932 * if pixelSize is 3, the image is R,G,B and offset[3] is bogus.
1933 */
1934
1935 if (blockPtr->pixelSize == 3) {
1936 /*
1937 * No alpha information: the whole image is opaque.
1938 */
1939
1940 alphaPtr = &opaque;
1941 alphaPitch = alphaIncr = alphaOffset = 0;
1942 } else {
1943 /*
1944 * Set up alpha handling.
1945 */
1946
1947 alphaPtr = blockPtr->pixelPtr;
1948 alphaPitch = blockPtr->pitch;
1949 alphaIncr = blockPtr->pixelSize;
1950 alphaOffset = blockPtr->offset[3];
1951 }
1952
1953
1954 for (yy = 0, lineLen=0; yy < height; yy++) {
1955 switch (colorLevel) {
1956 case 0: {
1957 /*
1958 * Generate data for image in monochrome mode.
1959 * No attempt at dithering is made--instead, just
1960 * set a threshold.
1961 * To handle transparecies we need to output two lines:
1962 * one for the black pixels, one for the white ones.
1963 */
1964
1965 unsigned char mask=0x80;
1966 unsigned char data=0x00;
1967 for (xx = 0; xx< width; xx ++) {
1968 pixelPtr = blockPtr->pixelPtr
1969 + (yy * blockPtr->pitch)
1970 + (xx *blockPtr->pixelSize);
1971
1972 red = pixelPtr[blockPtr->offset[0]];
1973 green = pixelPtr[blockPtr->offset[1]];
1974 blue = pixelPtr[blockPtr->offset[2]];
1975
1976 alpha = *(alphaPtr + (yy * alphaPitch)
1977 + (xx * alphaIncr) + alphaOffset);
1978
1979 /*
1980 * If pixel is less than threshold, then it is black.
1981 */
1982
1983 if ((alpha != 0) &&
1984 ( 0.3086 * red
1985 + 0.6094 * green
1986 + 0.082 * blue < 128)) {
1987 data |= mask;
1988 }
1989 mask >>= 1;
1990 if (mask == 0) {
1991 sprintf(buffer, "%02X", data);
1992 Tcl_AppendResult(interp, buffer, (char *) NULL);
1993 lineLen += 2;
1994 if (lineLen >= 60) {
1995 lineLen = 0;
1996 Tcl_AppendResult(interp, "\n", (char *) NULL);
1997 }
1998 mask=0x80;
1999 data=0x00;
2000 }
2001 }
2002 if ((width % 8) != 0) {
2003 sprintf(buffer, "%02X", data);
2004 Tcl_AppendResult(interp, buffer, (char *) NULL);
2005 mask=0x80;
2006 data=0x00;
2007 }
2008
2009 mask=0x80;
2010 data=0x00;
2011 for (xx = 0; xx< width; xx ++) {
2012 pixelPtr = blockPtr->pixelPtr
2013 + (yy * blockPtr->pitch)
2014 + (xx *blockPtr->pixelSize);
2015
2016 red = pixelPtr[blockPtr->offset[0]];
2017 green = pixelPtr[blockPtr->offset[1]];
2018 blue = pixelPtr[blockPtr->offset[2]];
2019
2020 alpha = *(alphaPtr + (yy * alphaPitch)
2021 + (xx * alphaIncr) + alphaOffset);
2022
2023 /*
2024 * If pixel is greater than threshold, then it is white.
2025 */
2026
2027 if ((alpha != 0) &&
2028 ( 0.3086 * red
2029 + 0.6094 * green
2030 + 0.082 * blue >= 128)) {
2031 data |= mask;
2032 }
2033 mask >>= 1;
2034 if (mask == 0) {
2035 sprintf(buffer, "%02X", data);
2036 Tcl_AppendResult(interp, buffer, (char *) NULL);
2037 lineLen += 2;
2038 if (lineLen >= 60) {
2039 lineLen = 0;
2040 Tcl_AppendResult(interp, "\n", (char *) NULL);
2041 }
2042 mask=0x80;
2043 data=0x00;
2044 }
2045 }
2046 if ((width % 8) != 0) {
2047 sprintf(buffer, "%02X", data);
2048 Tcl_AppendResult(interp, buffer, (char *) NULL);
2049 mask=0x80;
2050 data=0x00;
2051 }
2052 break;
2053 }
2054 case 1: {
2055 /*
2056 * Generate transparency data.
2057 * We must prevent a transparent value of 0
2058 * because of a bug in some HP printers.
2059 */
2060
2061 for (xx = 0; xx < width; xx ++) {
2062 alpha = *(alphaPtr + (yy * alphaPitch)
2063 + (xx * alphaIncr) + alphaOffset);
2064 sprintf(buffer, "%02X", alpha | 0x01);
2065 Tcl_AppendResult(interp, buffer, (char *) NULL);
2066 lineLen += 2;
2067 if (lineLen >= 60) {
2068 lineLen = 0;
2069 Tcl_AppendResult(interp, "\n", (char *) NULL);
2070 }
2071 }
2072
2073
2074 /*
2075 * Generate data in gray mode--in this case, take a
2076 * weighted sum of the red, green, and blue values.
2077 */
2078
2079 for (xx = 0; xx < width; xx ++) {
2080 pixelPtr = blockPtr->pixelPtr
2081 + (yy * blockPtr->pitch)
2082 + (xx *blockPtr->pixelSize);
2083
2084 red = pixelPtr[blockPtr->offset[0]];
2085 green = pixelPtr[blockPtr->offset[1]];
2086 blue = pixelPtr[blockPtr->offset[2]];
2087
2088 sprintf(buffer, "%02X", (int) floor(0.5 +
2089 ( 0.3086 * red + 0.6094 * green + 0.0820 * blue)));
2090 Tcl_AppendResult(interp, buffer, (char *) NULL);
2091 lineLen += 2;
2092 if (lineLen >= 60) {
2093 lineLen = 0;
2094 Tcl_AppendResult(interp, "\n", (char *) NULL);
2095 }
2096 }
2097 break;
2098 }
2099 default: {
2100 /*
2101 * Generate transparency data.
2102 * We must prevent a transparent value of 0
2103 * because of a bug in some HP printers.
2104 */
2105
2106 for (xx = 0; xx < width; xx ++) {
2107 alpha = *(alphaPtr + (yy * alphaPitch)
2108 + (xx * alphaIncr) + alphaOffset);
2109 sprintf(buffer, "%02X", alpha | 0x01);
2110 Tcl_AppendResult(interp, buffer, (char *) NULL);
2111 lineLen += 2;
2112 if (lineLen >= 60) {
2113 lineLen = 0;
2114 Tcl_AppendResult(interp, "\n", (char *) NULL);
2115 }
2116 }
2117
2118
2119 /*
2120 * Finally, color mode. Here, just output the red, green,
2121 * and blue values directly.
2122 */
2123
2124 for (xx = 0; xx < width; xx ++) {
2125 pixelPtr = blockPtr->pixelPtr
2126 + (yy * blockPtr->pitch)
2127 + (xx *blockPtr->pixelSize);
2128
2129 sprintf(buffer, "%02X%02X%02X",
2130 pixelPtr[blockPtr->offset[0]],
2131 pixelPtr[blockPtr->offset[1]],
2132 pixelPtr[blockPtr->offset[2]]);
2133 Tcl_AppendResult(interp, buffer, (char *) NULL);
2134 lineLen += 6;
2135 if (lineLen >= 60) {
2136 lineLen = 0;
2137 Tcl_AppendResult(interp, "\n", (char *) NULL);
2138 }
2139 }
2140 break;
2141 }
2142 }
2143 }
2144
2145 Tcl_AppendResult(interp, ">\n", (char *) NULL);
2146 return TCL_OK;
2147 }
2148
2149
2150 /* $History: tkCanvPs.c $
2151 *
2152 * ***************** Version 1 *****************
2153 * User: Dtashley Date: 1/02/01 Time: 2:35a
2154 * Created in $/IjuScripter, IjuConsole/Source/Tk Base
2155 * Initial check-in.
2156 */
2157
2158 /* End of TKCANVPS.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25